From 282cbcb517ddfe6fc04401dc407839a54c2aab0c Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Tue, 22 Sep 2020 15:32:26 +0200 Subject: [PATCH 01/17] UG0W0 OK --- input/options | 2 +- src/QuAcK/G0W0.f90 | 3 +- src/QuAcK/QuAcK.f90 | 2 +- src/QuAcK/UG0W0.f90 | 74 +++++----- src/QuAcK/print_G0W0.f90 | 10 +- src/QuAcK/self_energy_correlation_diag.f90 | 4 +- src/QuAcK/unrestricted_excitation_density.f90 | 57 ++++---- src/QuAcK/unrestricted_linear_response.f90 | 113 ++++++++++++++++ .../unrestricted_linear_response_A_matrix.f90 | 126 ++++++++++++++++++ .../unrestricted_linear_response_B_matrix.f90 | 123 +++++++++++++++++ ...estricted_self_energy_correlation_diag.f90 | 12 +- 11 files changed, 437 insertions(+), 89 deletions(-) create mode 100644 src/QuAcK/unrestricted_linear_response.f90 create mode 100644 src/QuAcK/unrestricted_linear_response_A_matrix.f90 create mode 100644 src/QuAcK/unrestricted_linear_response_B_matrix.f90 diff --git a/input/options b/input/options index daaa7f4..52b183f 100644 --- a/input/options +++ b/input/options @@ -13,6 +13,6 @@ # ACFDT: AC Kx XBS F F T # BSE: BSE dBSE dTDA evDyn - T T F F + F T F F # MCMP2: nMC nEq nWalk dt nPrint iSeed doDrift 1000000 100000 10 0.3 10000 1234 T diff --git a/src/QuAcK/G0W0.f90 b/src/QuAcK/G0W0.f90 index bd76850..1b32919 100644 --- a/src/QuAcK/G0W0.f90 +++ b/src/QuAcK/G0W0.f90 @@ -1,6 +1,6 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold,linearize,eta, & - nBas,nC,nO,nV,nR,nS,ENuc,ERHF,Hc,H,ERI,PHF,cHF,eHF,eGW) + nBas,nC,nO,nV,nR,nS,ENuc,ERHF,Hc,ERI,PHF,cHF,eHF,eGW) ! Perform G0W0 calculation @@ -33,7 +33,6 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, double precision,intent(in) :: cHF(nBas,nBas) double precision,intent(in) :: PHF(nBas,nBas) double precision,intent(in) :: Hc(nBas,nBas) - double precision,intent(in) :: H(nBas,nBas) double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) ! Local variables diff --git a/src/QuAcK/QuAcK.f90 b/src/QuAcK/QuAcK.f90 index d7f4fbc..c9cd58e 100644 --- a/src/QuAcK/QuAcK.f90 +++ b/src/QuAcK/QuAcK.f90 @@ -4,7 +4,7 @@ program QuAcK include 'parameters.h' logical :: doSph - logical :: unrestricted + logical :: unrestricted = .false. logical :: doRHF,doUHF,doMOM logical :: doMP2,doMP3,doMP2F12 logical :: doCCD,doCCSD,doCCSDT diff --git a/src/QuAcK/UG0W0.f90 b/src/QuAcK/UG0W0.f90 index b71122b..cdce17f 100644 --- a/src/QuAcK/UG0W0.f90 +++ b/src/QuAcK/UG0W0.f90 @@ -51,16 +51,14 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev integer :: nSa integer :: nSb integer :: nSt - double precision :: EcRPA(nspin) - double precision :: EcBSE(nspin) + double precision :: EcRPA + double precision :: EcBSE double precision :: EcAC(nspin) double precision,allocatable :: SigC(:,:) double precision,allocatable :: Z(:,:) double precision,allocatable :: Omega(:) - double precision,allocatable :: XpY_a(:,:) - double precision,allocatable :: XpY_b(:,:) - double precision,allocatable :: XmY_a(:,:) - double precision,allocatable :: XmY_b(:,:) + double precision,allocatable :: XpY(:,:) + double precision,allocatable :: XmY(:,:) double precision,allocatable :: rho(:,:,:,:) double precision,allocatable :: eGWlin(:,:) @@ -80,7 +78,7 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev ! Initialization - EcRPA(:) = 0d0 + EcRPA = 0d0 ! COHSEX approximation @@ -103,53 +101,45 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev nSb = nS(2) nSt = nSa + nSb - allocate(SigC(nBas,nspin),Z(nBas,nspin),Omega(nSt),XpY_a(nSa,nSa),XpY_b(nSb,nSb),XmY_a(nSa,nSa),XmY_b(nSb,nSb), & + allocate(SigC(nBas,nspin),Z(nBas,nspin),Omega(nSt),XpY(nSt,nSt),XmY(nSt,nSt), & rho(nBas,nBas,nSt,nspin),eGWlin(nBas,nspin)) -! Compute linear response +!-------------------! +! Compute screening ! +!-------------------! -!---------------------------------------------- -! alpha-alpha block -!---------------------------------------------- +! Spin-conserving transition - ispin = 1 - iblock = 3 + ispin = 1 - call linear_response(iblock,.true.,TDA_W,.false.,eta,nBas,nC(ispin),nO(ispin),nV(ispin),nR(ispin),nSa,1d0, & - eHF(:,ispin),ERI_aa,rho(:,:,1:nSa,ispin),EcRPA(ispin),Omega(1:nSa),XpY_a,XmY_a) + call unrestricted_linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,1d0, & + eHF,ERI_aa,ERI_ab,ERI_bb,rho(:,:,:,ispin),EcRPA,Omega,XpY,XmY) - if(print_W) call print_excitation('RPA@HF alpha',iblock,nSa,Omega(1:nSa)) + if(print_W) call print_excitation('RPA@UHF',3,nSt,Omega) -!---------------------------------------------- -! alpha-beta block -!---------------------------------------------- - - ispin = 2 - iblock = 3 - - call linear_response(iblock,.true.,TDA_W,.false.,eta,nBas,nC(ispin),nO(ispin),nV(ispin),nR(ispin),nSb,1d0, & - eHF(:,ispin),ERI_bb,rho(:,:,nSa+1:nSt,ispin),EcRPA(ispin),Omega(nSa+1:nSt),XpY_b,XmY_b) - - if(print_W) call print_excitation('RPA@HF beta ',iblock,nSb,Omega(nSa+1:nSt)) - -!---------------------------------------------- -! Excitation densities for alpha self-energy -!---------------------------------------------- +!----------------------! +! Excitation densities ! +!----------------------! - call unrestricted_excitation_density(nBas,nC,nO,nR,nSa,nSb,nSt,ERI_aa,ERI_ab,ERI_bb,XpY_a,XpY_b,rho) + call unrestricted_excitation_density(nBas,nC,nO,nR,nSa,nSb,nSt,ERI_aa,ERI_ab,ERI_bb,XpY,rho) -!---------------------- -! Compute self-energy -!---------------------- +!---------------------! +! Compute self-energy ! +!---------------------! call unrestricted_self_energy_correlation_diag(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,eHF,Omega,rho,SigC) -! Compute renormalization factor +!--------------------------------! +! Compute renormalization factor ! +!--------------------------------! ! call renormalization_factor(COHSEX,SOSEX,eta,nBas,nC,nO,nV,nR,nS,eHF, & ! Omega(:,ispin),rho(:,:,:,ispin),rhox(:,:,:,ispin),Z(:)) -! Solve the quasi-particle equation +!-----------------------------------! +! Solve the quasi-particle equation ! +!-----------------------------------! + Z(:,:) = 1d0 eGWlin(:,:) = eHF(:,:) + Z(:,:)*SigC(:,:) @@ -174,7 +164,7 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev ! Dump results do ispin=1,nspin - call print_G0W0(nBas,nO(ispin),eHF(:,ispin),ENuc,EUHF,SigC(:,ispin),Z(:,ispin),eGW(:,ispin),EcRPA(ispin)) + call print_G0W0(nBas,nO(ispin),eHF(:,ispin),ENuc,EUHF,SigC(:,ispin),Z(:,ispin),eGW(:,ispin),EcRPA) end do ! Compute the RPA correlation energy @@ -184,10 +174,8 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev write(*,*) write(*,*)'-------------------------------------------------------------------------------' - write(*,'(2X,A50,F20.10)') 'Tr@RPA@G0W0 correlation energy (singlet) =',EcRPA(1) - write(*,'(2X,A50,F20.10)') 'Tr@RPA@G0W0 correlation energy (triplet) =',EcRPA(2) - write(*,'(2X,A50,F20.10)') 'Tr@RPA@G0W0 correlation energy =',EcRPA(1) + EcRPA(2) - write(*,'(2X,A50,F20.10)') 'Tr@RPA@G0W0 total energy =',ENuc + EUHF + EcRPA(1) + EcRPA(2) + write(*,'(2X,A50,F20.10)') 'Tr@RPA@G0W0 correlation energy =',EcRPA + write(*,'(2X,A50,F20.10)') 'Tr@RPA@G0W0 total energy =',ENuc + EUHF + EcRPA write(*,*)'-------------------------------------------------------------------------------' write(*,*) diff --git a/src/QuAcK/print_G0W0.f90 b/src/QuAcK/print_G0W0.f90 index 95d1051..d1ee3f4 100644 --- a/src/QuAcK/print_G0W0.f90 +++ b/src/QuAcK/print_G0W0.f90 @@ -40,11 +40,11 @@ subroutine print_G0W0(nBas,nO,e,ENuc,EHF,SigmaC,Z,eGW,EcRPA,EcGM) write(*,'(2X,A30,F15.6)') 'G0W0 LUMO energy (eV):',eGW(LUMO)*HaToeV write(*,'(2X,A30,F15.6)') 'G0W0 HOMO-LUMO gap (eV):',Gap*HaToeV write(*,*)'-------------------------------------------------------------------------------' -! write(*,'(2X,A30,F15.6)') 'RPA@G0W0 total energy =',ENuc + EHF + EcRPA -! write(*,'(2X,A30,F15.6)') 'RPA@G0W0 correlation energy =',EcRPA -! write(*,'(2X,A30,F15.6)') 'GM@G0W0 total energy =',ENuc + EHF + EcGM -! write(*,'(2X,A30,F15.6)') 'GM@G0W0 correlation energy =',EcGM -! write(*,*)'-------------------------------------------------------------------------------' + write(*,'(2X,A30,F15.6)') 'RPA@HF total energy =',ENuc + EHF + EcRPA + write(*,'(2X,A30,F15.6)') 'RPA@HF correlation energy =',EcRPA + write(*,'(2X,A30,F15.6)') 'GM@G0W0 total energy =',ENuc + EHF + EcGM + write(*,'(2X,A30,F15.6)') 'GM@G0W0 correlation energy =',EcGM + write(*,*)'-------------------------------------------------------------------------------' write(*,*) end subroutine print_G0W0 diff --git a/src/QuAcK/self_energy_correlation_diag.f90 b/src/QuAcK/self_energy_correlation_diag.f90 index 03afb7a..441806d 100644 --- a/src/QuAcK/self_energy_correlation_diag.f90 +++ b/src/QuAcK/self_energy_correlation_diag.f90 @@ -66,7 +66,7 @@ subroutine self_energy_correlation_diag(COHSEX,SOSEX,eta,nBas,nC,nO,nV,nR,nS,e,O EcGM = 0d0 do i=nC+1,nO - EcGM = EcGM + 0.5d0*SigC(i) + EcGM = EcGM - SigC(i) end do !----------------------------- @@ -143,7 +143,7 @@ subroutine self_energy_correlation_diag(COHSEX,SOSEX,eta,nBas,nC,nO,nV,nR,nS,e,O do a=nO+1,nBas-nR do jb=1,nS eps = e(a) - e(i) + Omega(jb) - EcGM = EcGM - 2d0*rho(a,i,jb)*rho(a,i,jb)*eps/(eps**2 + eta**2) + EcGM = EcGM - 4d0*rho(a,i,jb)*rho(a,i,jb)*eps/(eps**2 + eta**2) end do end do end do diff --git a/src/QuAcK/unrestricted_excitation_density.f90 b/src/QuAcK/unrestricted_excitation_density.f90 index a705278..5ea602b 100644 --- a/src/QuAcK/unrestricted_excitation_density.f90 +++ b/src/QuAcK/unrestricted_excitation_density.f90 @@ -1,4 +1,4 @@ -subroutine unrestricted_excitation_density(nBas,nC,nO,nR,nSa,nSb,nSt,ERI_aa,ERI_ab,ERI_bb,XpY_a,XpY_b,rho) +subroutine unrestricted_excitation_density(nBas,nC,nO,nR,nSa,nSb,nSt,ERI_aa,ERI_ab,ERI_bb,XpY,rho) ! Compute excitation densities for unrestricted reference @@ -17,8 +17,7 @@ subroutine unrestricted_excitation_density(nBas,nC,nO,nR,nSa,nSb,nSt,ERI_aa,ERI_ double precision,intent(in) :: ERI_aa(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_ab(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_bb(nBas,nBas,nBas,nBas) - double precision,intent(in) :: XpY_a(nSa,nSa) - double precision,intent(in) :: XpY_b(nSb,nSb) + double precision,intent(in) :: XpY(nSt,nSt) ! Local variables @@ -32,34 +31,34 @@ subroutine unrestricted_excitation_density(nBas,nC,nO,nR,nSa,nSb,nSt,ERI_aa,ERI_ rho(:,:,:,:) = 0d0 -!------------- -! alpha block -!------------- +!-------------! +! alpha block ! +!-------------! do p=nC(1)+1,nBas-nR(1) do q=nC(1)+1,nBas-nR(1) ! Same-spin contribution - do ia=1,nSa + do ia=1,nSt jb = 0 do j=nC(1)+1,nO(1) do b=nO(1)+1,nBas-nR(1) jb = jb + 1 - rho(p,q,ia,1) = rho(p,q,ia,1) + ERI_aa(p,j,q,b)*XpY_a(ia,jb) + rho(p,q,ia,1) = rho(p,q,ia,1) + ERI_aa(p,j,q,b)*XpY(ia,jb) enddo enddo enddo ! Opposite-spin contribution - do ia=1,nSb - jb = 0 + do ia=1,nSt + jb = nSa do j=nC(2)+1,nO(2) do b=nO(2)+1,nBas-nR(2) jb = jb + 1 - rho(p,q,nSa+ia,1) = rho(p,q,nSa+ia,1) + ERI_ab(p,j,q,b)*XpY_b(ia,jb) + rho(p,q,ia,1) = rho(p,q,ia,1) + ERI_ab(p,j,q,b)*XpY(ia,jb) enddo enddo @@ -68,34 +67,34 @@ subroutine unrestricted_excitation_density(nBas,nC,nO,nR,nSa,nSb,nSt,ERI_aa,ERI_ enddo enddo -!------------ -! Beta block -!------------ +!------------! +! Beta block ! +!------------! do p=nC(2)+1,nBas-nR(2) do q=nC(2)+1,nBas-nR(2) - ! Same-spin contribution - do ia=1,nSb - jb = 0 - do j=nC(2)+1,nO(2) - do b=nO(2)+1,nBas-nR(2) - jb = jb + 1 - - rho(p,q,ia,2) = rho(p,q,ia,2) + ERI_bb(p,j,q,b)*XpY_b(ia,jb) - - enddo - enddo - enddo - ! Opposite-spin contribution - do ia=1,nSa + do ia=1,nSt jb = 0 do j=nC(1)+1,nO(1) do b=nO(1)+1,nBas-nR(1) jb = jb + 1 - rho(p,q,nSb+ia,2) = rho(p,q,nSb+ia,2) + ERI_ab(j,p,b,q)*XpY_a(ia,jb) + rho(p,q,ia,2) = rho(p,q,ia,2) + ERI_ab(j,p,b,q)*XpY(ia,jb) + + enddo + enddo + enddo + + ! Same-spin contribution + do ia=1,nSt + jb = nSa + do j=nC(2)+1,nO(2) + do b=nO(2)+1,nBas-nR(2) + jb = jb + 1 + + rho(p,q,ia,2) = rho(p,q,ia,2) + ERI_bb(p,j,q,b)*XpY(ia,jb) enddo enddo diff --git a/src/QuAcK/unrestricted_linear_response.f90 b/src/QuAcK/unrestricted_linear_response.f90 new file mode 100644 index 0000000..0a547da --- /dev/null +++ b/src/QuAcK/unrestricted_linear_response.f90 @@ -0,0 +1,113 @@ +subroutine unrestricted_linear_response(ispin,dRPA,TDA,BSE,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda, & + e,ERI_aa,ERI_ab,ERI_bb,rho,EcRPA,Omega,XpY,XmY) + +! Compute linear response for unrestricted formalism + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: ispin + logical,intent(in) :: dRPA + logical,intent(in) :: TDA + logical,intent(in) :: BSE + double precision,intent(in) :: eta + integer,intent(in) :: nBas + integer,intent(in) :: nC(nspin) + integer,intent(in) :: nO(nspin) + integer,intent(in) :: nV(nspin) + integer,intent(in) :: nR(nspin) + integer,intent(in) :: nSa + integer,intent(in) :: nSb + integer,intent(in) :: nSt + double precision,intent(in) :: lambda + double precision,intent(in) :: e(nBas,nspin) + double precision,intent(in) :: rho(nBas,nBas,nSt,nspin) + double precision,intent(in) :: ERI_aa(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_ab(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_bb(nBas,nBas,nBas,nBas) + +! Local variables + + integer :: ia + double precision :: trace_matrix + double precision,allocatable :: A(:,:) + double precision,allocatable :: B(:,:) + double precision,allocatable :: ApB(:,:) + double precision,allocatable :: AmB(:,:) + double precision,allocatable :: AmBSq(:,:) + double precision,allocatable :: AmBIv(:,:) + double precision,allocatable :: Z(:,:) + +! Output variables + + double precision,intent(out) :: EcRPA + double precision,intent(out) :: Omega(nSt) + double precision,intent(out) :: XpY(nSt,nSt) + double precision,intent(out) :: XmY(nSt,nSt) + +! Memory allocation + + allocate(A(nSt,nSt),B(nSt,nSt),ApB(nSt,nSt),AmB(nSt,nSt),AmBSq(nSt,nSt),AmBIv(nSt,nSt),Z(nSt,nSt)) + +! Build A and B matrices + + call unrestricted_linear_response_A_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda,e,ERI_aa,ERI_ab,ERI_bb,A) + +! if(BSE) call Bethe_Salpeter_A_matrix(eta,nBas,nC,nO,nV,nR,nS,lambda,ERI,Omega,rho,A) + +! Tamm-Dancoff approximation + + B = 0d0 + if(.not. TDA) then + + call unrestricted_linear_response_B_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda,ERI_aa,ERI_ab,ERI_bb,B) + +! if(BSE) call Bethe_Salpeter_B_matrix(eta,nBas,nC,nO,nV,nR,nS,lambda,ERI,Omega,rho,B) + + end if + +! Build A + B and A - B matrices + + ApB = A + B + AmB = A - B + +! Diagonalize linear response matrix + + call diagonalize_matrix(nSt,AmB,Omega) + + if(minval(Omega) < 0d0) & + call print_warning('You may have instabilities in linear response: A-B is not positive definite!!') + + do ia=1,nSt + if(Omega(ia) < 0d0) Omega(ia) = 0d0 + end do + + call ADAt(nSt,AmB,1d0*sqrt(Omega),AmBSq) + call ADAt(nSt,AmB,1d0/sqrt(Omega),AmBIv) + + Z = matmul(AmBSq,matmul(ApB,AmBSq)) + + call diagonalize_matrix(nSt,Z,Omega) + + if(minval(Omega) < 0d0) & + call print_warning('You may have instabilities in linear response: negative excitations!!') + + do ia=1,nSt + if(Omega(ia) < 0d0) Omega(ia) = 0d0 + end do + + Omega = sqrt(Omega) + + XpY = matmul(transpose(Z),AmBSq) + call DA(nSt,1d0/sqrt(Omega),XpY) + + XmY = matmul(transpose(Z),AmBIv) + call DA(nSt,1d0*sqrt(Omega),XmY) + +! Compute the RPA correlation energy + + EcRPA = 0.5d0*(sum(Omega) - trace_matrix(nSt,A)) + +end subroutine unrestricted_linear_response diff --git a/src/QuAcK/unrestricted_linear_response_A_matrix.f90 b/src/QuAcK/unrestricted_linear_response_A_matrix.f90 new file mode 100644 index 0000000..60d2d87 --- /dev/null +++ b/src/QuAcK/unrestricted_linear_response_A_matrix.f90 @@ -0,0 +1,126 @@ +subroutine unrestricted_linear_response_A_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda, & + e,ERI_aa,ERI_ab,ERI_bb,A_lr) + +! Compute linear response + + implicit none + include 'parameters.h' + +! Input variables + + logical,intent(in) :: dRPA + integer,intent(in) :: ispin + integer,intent(in) :: nBas + integer,intent(in) :: nC(nspin) + integer,intent(in) :: nO(nspin) + integer,intent(in) :: nV(nspin) + integer,intent(in) :: nR(nspin) + integer,intent(in) :: nSa + integer,intent(in) :: nSb + integer,intent(in) :: nSt + double precision,intent(in) :: lambda + double precision,intent(in) :: e(nBas,nspin) + double precision,intent(in) :: ERI_aa(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_ab(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_bb(nBas,nBas,nBas,nBas) + +! Local variables + + double precision :: delta_dRPA + double precision,external :: Kronecker_delta + + integer :: i,j,a,b,ia,jb + +! Output variables + + double precision,intent(out) :: A_lr(nSt,nSt) + +! Direct RPA + + delta_dRPA = 0d0 + if(dRPA) delta_dRPA = 1d0 + +!----------------------------------------------- +! Build A matrix for spin-conserving transitions +!----------------------------------------------- + + if(ispin == 1) then + + ! alpha-alpha block + + ia = 0 + do i=nC(1)+1,nO(1) + do a=nO(1)+1,nBas-nR(1) + ia = ia + 1 + jb = 0 + do j=nC(1)+1,nO(1) + do b=nO(1)+1,nBas-nR(1) + jb = jb + 1 + + A_lr(ia,jb) = (e(a,1) - e(i,1))*Kronecker_delta(i,j)*Kronecker_delta(a,b) & + + lambda*ERI_aa(i,b,a,j) - (1d0 - delta_dRPA)*lambda*ERI_aa(i,b,j,a) + + end do + end do + end do + end do + + ! alpha-beta block + + ia = 0 + do i=nC(1)+1,nO(1) + do a=nO(1)+1,nBas-nR(1) + ia = ia + 1 + jb = 0 + do j=nC(2)+1,nO(2) + do b=nO(2)+1,nBas-nR(2) + jb = jb + 1 + + A_lr(ia,nSa+jb) = lambda*ERI_ab(i,b,a,j) + + end do + end do + end do + end do + + ! beta-alpha block + + ia = 0 + do i=nC(2)+1,nO(2) + do a=nO(2)+1,nBas-nR(2) + ia = ia + 1 + jb = 0 + do j=nC(1)+1,nO(1) + do b=nO(1)+1,nBas-nR(1) + jb = jb + 1 + + A_lr(nSa+ia,jb) = lambda*ERI_ab(b,i,j,a) + + end do + end do + end do + end do + + ! beta-beta block + + ia = 0 + do i=nC(2)+1,nO(2) + do a=nO(2)+1,nBas-nR(2) + ia = ia + 1 + jb = 0 + do j=nC(2)+1,nO(2) + do b=nO(2)+1,nBas-nR(2) + jb = jb + 1 + + A_lr(nSa+ia,nSa+jb) = (e(a,2) - e(i,2))*Kronecker_delta(i,j)*Kronecker_delta(a,b) & + + lambda*ERI_bb(i,b,a,j) - (1d0 - delta_dRPA)*lambda*ERI_bb(i,b,j,a) + + end do + end do + end do + end do + + end if + + +end subroutine unrestricted_linear_response_A_matrix diff --git a/src/QuAcK/unrestricted_linear_response_B_matrix.f90 b/src/QuAcK/unrestricted_linear_response_B_matrix.f90 new file mode 100644 index 0000000..22213df --- /dev/null +++ b/src/QuAcK/unrestricted_linear_response_B_matrix.f90 @@ -0,0 +1,123 @@ +subroutine unrestricted_linear_response_B_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda, & + ERI_aa,ERI_ab,ERI_bb,B_lr) + +! Compute linear response + + implicit none + include 'parameters.h' + +! Input variables + + logical,intent(in) :: dRPA + integer,intent(in) :: ispin + integer,intent(in) :: nBas + integer,intent(in) :: nC(nspin) + integer,intent(in) :: nO(nspin) + integer,intent(in) :: nV(nspin) + integer,intent(in) :: nR(nspin) + integer,intent(in) :: nSa + integer,intent(in) :: nSb + integer,intent(in) :: nSt + double precision,intent(in) :: lambda + double precision,intent(in) :: ERI_aa(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_ab(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_bb(nBas,nBas,nBas,nBas) + +! Local variables + + double precision :: delta_dRPA + double precision,external :: Kronecker_delta + + integer :: i,j,a,b,ia,jb + +! Output variables + + double precision,intent(out) :: B_lr(nSt,nSt) + +! Direct RPA + + delta_dRPA = 0d0 + if(dRPA) delta_dRPA = 1d0 + +!----------------------------------------------- +! Build A matrix for spin-conserving transitions +!----------------------------------------------- + + if(ispin == 1) then + + ! alpha-alpha block + + ia = 0 + do i=nC(1)+1,nO(1) + do a=nO(1)+1,nBas-nR(1) + ia = ia + 1 + jb = 0 + do j=nC(1)+1,nO(1) + do b=nO(1)+1,nBas-nR(1) + jb = jb + 1 + + B_lr(ia,jb) = lambda*ERI_aa(i,j,a,b) - (1d0 - delta_dRPA)*lambda*ERI_aa(i,j,b,a) + + end do + end do + end do + end do + + ! alpha-beta block + + ia = 0 + do i=nC(1)+1,nO(1) + do a=nO(1)+1,nBas-nR(1) + ia = ia + 1 + jb = 0 + do j=nC(2)+1,nO(2) + do b=nO(2)+1,nBas-nR(2) + jb = jb + 1 + + B_lr(ia,nSa+jb) = lambda*ERI_ab(i,j,a,b) + + end do + end do + end do + end do + + ! beta-alpha block + + ia = 0 + do i=nC(2)+1,nO(2) + do a=nO(2)+1,nBas-nR(2) + ia = ia + 1 + jb = 0 + do j=nC(1)+1,nO(1) + do b=nO(1)+1,nBas-nR(1) + jb = jb + 1 + + B_lr(nSa+ia,jb) = lambda*ERI_ab(j,i,b,a) + + end do + end do + end do + end do + + ! beta-beta block + + ia = 0 + do i=nC(2)+1,nO(2) + do a=nO(2)+1,nBas-nR(2) + ia = ia + 1 + jb = 0 + do j=nC(2)+1,nO(2) + do b=nO(2)+1,nBas-nR(2) + jb = jb + 1 + + B_lr(nSa+ia,nSa+jb) = lambda*ERI_bb(i,j,a,b) - (1d0 - delta_dRPA)*lambda*ERI_bb(i,j,b,a) + + end do + end do + end do + end do + + end if + + +end subroutine unrestricted_linear_response_B_matrix diff --git a/src/QuAcK/unrestricted_self_energy_correlation_diag.f90 b/src/QuAcK/unrestricted_self_energy_correlation_diag.f90 index 3c91767..123ec23 100644 --- a/src/QuAcK/unrestricted_self_energy_correlation_diag.f90 +++ b/src/QuAcK/unrestricted_self_energy_correlation_diag.f90 @@ -33,9 +33,9 @@ subroutine unrestricted_self_energy_correlation_diag(eta,nBas,nC,nO,nV,nR,nSa,nS SigC(:,:) = 0d0 -!-------------- -! Spin-up part -!-------------- +!--------------! +! Spin-up part ! +!--------------! ! Occupied part of the correlation self-energy @@ -59,9 +59,9 @@ subroutine unrestricted_self_energy_correlation_diag(eta,nBas,nC,nO,nV,nR,nSa,nS end do end do -!---------------- -! Spin-down part -!---------------- +!----------------! +! Spin-down part ! +!----------------! ! Occupied part of the correlation self-energy From 2a6f83dbf902c47904fc05fd3d7ebd4a7d5e223b Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Tue, 22 Sep 2020 22:13:51 +0200 Subject: [PATCH 02/17] UBSE --- input/options | 4 +- src/QuAcK/G0W0.f90 | 24 +++-- src/QuAcK/QuAcK.f90 | 22 ++--- src/QuAcK/UG0W0.f90 | 59 ++++++------ src/QuAcK/print_UG0W0.f90 | 57 ++++++++---- src/QuAcK/print_excitation.f90 | 10 +- src/QuAcK/renormalization_factor.f90 | 74 +++++++-------- src/QuAcK/unrestricted_excitation_density.f90 | 16 ++-- src/QuAcK/unrestricted_linear_response.f90 | 18 ++-- .../unrestricted_linear_response_A_matrix.f90 | 26 ++++-- .../unrestricted_linear_response_B_matrix.f90 | 26 ++++-- .../unrestricted_renormalization_factor.f90 | 93 +++++++++++++++++++ 12 files changed, 287 insertions(+), 142 deletions(-) create mode 100644 src/QuAcK/unrestricted_renormalization_factor.f90 diff --git a/input/options b/input/options index 52b183f..a5abf91 100644 --- a/input/options +++ b/input/options @@ -9,10 +9,10 @@ # 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 - 256 0.00001 T 5 T 0.0 F F F F F + 256 0.00001 T 5 T 0.001 F F F F F # ACFDT: AC Kx XBS F F T # BSE: BSE dBSE dTDA evDyn - F T F F + T F F F # MCMP2: nMC nEq nWalk dt nPrint iSeed doDrift 1000000 100000 10 0.3 10000 1234 T diff --git a/src/QuAcK/G0W0.f90 b/src/QuAcK/G0W0.f90 index 1b32919..b6ffcbc 100644 --- a/src/QuAcK/G0W0.f90 +++ b/src/QuAcK/G0W0.f90 @@ -71,23 +71,31 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, ! SOSEX correction - if(SOSEX) write(*,*) 'SOSEX correction activated!' - write(*,*) + if(SOSEX) then + write(*,*) 'SOSEX correction activated!' + write(*,*) + end if ! COHSEX approximation - if(COHSEX) write(*,*) 'COHSEX approximation activated!' - write(*,*) + if(COHSEX) then + write(*,*) 'COHSEX approximation activated!' + write(*,*) + end if ! TDA for W - if(TDA_W) write(*,*) 'Tamm-Dancoff approximation for dynamic screening!' - write(*,*) + if(TDA_W) then + write(*,*) 'Tamm-Dancoff approximation for dynamic screening!' + write(*,*) + end if ! TDA - if(TDA) write(*,*) 'Tamm-Dancoff approximation activated!' - write(*,*) + if(TDA) then + write(*,*) 'Tamm-Dancoff approximation activated!' + write(*,*) + end if ! Spin manifold diff --git a/src/QuAcK/QuAcK.f90 b/src/QuAcK/QuAcK.f90 index c9cd58e..0bb56a2 100644 --- a/src/QuAcK/QuAcK.f90 +++ b/src/QuAcK/QuAcK.f90 @@ -57,9 +57,9 @@ program QuAcK double precision,allocatable :: ERI_MO(:,:,:,:) integer :: bra integer :: ket - double precision,allocatable :: ERI_MO_aa(:,:,:,:) - double precision,allocatable :: ERI_MO_ab(:,:,:,:) - double precision,allocatable :: ERI_MO_bb(:,:,:,:) + double precision,allocatable :: ERI_MO_aaaa(:,:,:,:) + double precision,allocatable :: ERI_MO_aabb(:,:,:,:) + double precision,allocatable :: ERI_MO_bbbb(:,:,:,:) double precision,allocatable :: ERI_ERF_AO(:,:,:,:) double precision,allocatable :: ERI_ERF_MO(:,:,:,:) double precision,allocatable :: F12(:,:,:,:),Yuk(:,:,:,:),FC(:,:,:,:,:,:) @@ -330,25 +330,25 @@ program QuAcK ! Memory allocation - allocate(ERI_MO_aa(nBas,nBas,nBas,nBas),ERI_MO_ab(nBas,nBas,nBas,nBas),ERI_MO_bb(nBas,nBas,nBas,nBas)) + allocate(ERI_MO_aaaa(nBas,nBas,nBas,nBas),ERI_MO_aabb(nBas,nBas,nBas,nBas),ERI_MO_bbbb(nBas,nBas,nBas,nBas)) ! 4-index transform for (aa|aa) block bra = 1 ket = 1 - call AOtoMO_integral_transform(bra,ket,nBas,cHF,ERI_AO,ERI_MO_aa) + call AOtoMO_integral_transform(bra,ket,nBas,cHF,ERI_AO,ERI_MO_aaaa) - ! 4-index transform for (bb|bb) block + ! 4-index transform for (aa|bb) block bra = 1 ket = 2 - call AOtoMO_integral_transform(bra,ket,nBas,cHF,ERI_AO,ERI_MO_ab) + call AOtoMO_integral_transform(bra,ket,nBas,cHF,ERI_AO,ERI_MO_aabb) - ! 4-index transform for (aa|bb) block + ! 4-index transform for (bb|bb) block bra = 2 ket = 2 - call AOtoMO_integral_transform(bra,ket,nBas,cHF,ERI_AO,ERI_MO_bb) + call AOtoMO_integral_transform(bra,ket,nBas,cHF,ERI_AO,ERI_MO_bbbb) else @@ -382,7 +382,7 @@ program QuAcK if(unrestricted) then - call UMP2(nBas,nC,nO,nV,nR,ERI_MO_aa,ERI_MO_ab,ERI_MO_bb,ENuc,EUHF,eHF,EcMP2) + call UMP2(nBas,nC,nO,nV,nR,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,ENuc,EUHF,eHF,EcMP2) else @@ -749,7 +749,7 @@ program QuAcK call UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,evDyn, & singlet_manifold,triplet_manifold,linGW,eta_GW,nBas,nC,nO,nV,nR,nS, & - ENuc,EUHF,Hc,ERI_MO_aa,ERI_MO_ab,ERI_MO_bb,PHF,cHF,eHF,eG0W0) + ENuc,EUHF,Hc,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,PHF,cHF,eHF,eG0W0) else call G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & diff --git a/src/QuAcK/UG0W0.f90 b/src/QuAcK/UG0W0.f90 index cdce17f..0e0b38e 100644 --- a/src/QuAcK/UG0W0.f90 +++ b/src/QuAcK/UG0W0.f90 @@ -1,6 +1,6 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,evDyn, & - singlet_manifold,triplet_manifold,linearize,eta,nBas,nC,nO,nV,nR,nS, & - ENuc,EUHF,Hc,ERI_aa,ERI_ab,ERI_bb,PHF,cHF,eHF,eGW) + spin_conserved,spin_flip,linearize,eta,nBas,nC,nO,nV,nR,nS, & + ENuc,EUHF,Hc,ERI_aaaa,ERI_aabb,ERI_bbbb,PHF,cHF,eHF,eGW) ! Perform unrestricted G0W0 calculation @@ -20,8 +20,8 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev logical,intent(in) :: dBSE logical,intent(in) :: dTDA logical,intent(in) :: evDyn - logical,intent(in) :: singlet_manifold - logical,intent(in) :: triplet_manifold + logical,intent(in) :: spin_conserved + logical,intent(in) :: spin_flip logical,intent(in) :: linearize double precision,intent(in) :: eta @@ -37,9 +37,9 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev double precision,intent(in) :: cHF(nBas,nBas,nspin) double precision,intent(in) :: PHF(nBas,nBas,nspin) double precision,intent(in) :: Hc(nBas,nBas,nspin) - double precision,intent(in) :: ERI_aa(nBas,nBas,nBas,nBas) - double precision,intent(in) :: ERI_ab(nBas,nBas,nBas,nBas) - double precision,intent(in) :: ERI_bb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) ! Local variables @@ -82,18 +82,24 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev ! COHSEX approximation - if(COHSEX) write(*,*) 'COHSEX approximation activated!' - write(*,*) + if(COHSEX) then + write(*,*) 'COHSEX approximation activated!' + write(*,*) + end if ! TDA for W - if(TDA_W) write(*,*) 'Tamm-Dancoff approximation for dynamic screening!' - write(*,*) + if(TDA_W) then + write(*,*) 'Tamm-Dancoff approximation for dynamic screening!' + write(*,*) + end if ! TDA - if(TDA) write(*,*) 'Tamm-Dancoff approximation activated!' - write(*,*) + if(TDA) then + write(*,*) 'Tamm-Dancoff approximation activated!' + write(*,*) + end if ! Memory allocation @@ -113,15 +119,15 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev ispin = 1 call unrestricted_linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,1d0, & - eHF,ERI_aa,ERI_ab,ERI_bb,rho(:,:,:,ispin),EcRPA,Omega,XpY,XmY) + eHF,ERI_aaaa,ERI_aabb,ERI_bbbb,rho,EcRPA,Omega,XpY,XmY) - if(print_W) call print_excitation('RPA@UHF',3,nSt,Omega) + if(print_W) call print_excitation('RPA@UHF',5,nSt,Omega) !----------------------! ! Excitation densities ! !----------------------! - call unrestricted_excitation_density(nBas,nC,nO,nR,nSa,nSb,nSt,ERI_aa,ERI_ab,ERI_bb,XpY,rho) + call unrestricted_excitation_density(nBas,nC,nO,nR,nSa,nSb,nSt,ERI_aaaa,ERI_aabb,ERI_bbbb,XpY,rho) !---------------------! ! Compute self-energy ! @@ -133,14 +139,12 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev ! Compute renormalization factor ! !--------------------------------! -! call renormalization_factor(COHSEX,SOSEX,eta,nBas,nC,nO,nV,nR,nS,eHF, & -! Omega(:,ispin),rho(:,:,:,ispin),rhox(:,:,:,ispin),Z(:)) + call unrestricted_renormalization_factor(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,eHF,Omega,rho,Z) !-----------------------------------! ! Solve the quasi-particle equation ! !-----------------------------------! - Z(:,:) = 1d0 eGWlin(:,:) = eHF(:,:) + Z(:,:)*SigC(:,:) if(linearize) then @@ -163,14 +167,12 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev ! Dump results - do ispin=1,nspin - call print_G0W0(nBas,nO(ispin),eHF(:,ispin),ENuc,EUHF,SigC(:,ispin),Z(:,ispin),eGW(:,ispin),EcRPA) - end do + call print_UG0W0(nBas,nO,eHF,ENuc,EUHF,SigC,Z,eGW,EcRPA) ! Compute the RPA correlation energy -! call linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI, & -! rho(:,:,:,ispin),EcRPA(ispin),Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + call unrestricted_linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,1d0, & + eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,rho,EcRPA,Omega,XpY,XmY) write(*,*) write(*,*)'-------------------------------------------------------------------------------' @@ -181,10 +183,11 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev ! Perform BSE calculation -! if(BSE) then + if(BSE) then -! call Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold,eta, & -! nBas,nC,nO,nV,nR,nS,ERI,eHF,eGW,Omega,XpY,XmY,rho,EcRPA,EcBSE) + call unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta, & + nBas,nC,nO,nV,nR,nSa,nSb,nSt,ERI_aaaa,ERI_aabb,ERI_bbbb, & + eHF,eGW,Omega,XpY,XmY,rho,EcRPA,EcBSE) ! if(exchange_kernel) then ! @@ -239,6 +242,6 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev ! end if -! end if + end if end subroutine UG0W0 diff --git a/src/QuAcK/print_UG0W0.f90 b/src/QuAcK/print_UG0W0.f90 index b73e886..3cd21cd 100644 --- a/src/QuAcK/print_UG0W0.f90 +++ b/src/QuAcK/print_UG0W0.f90 @@ -1,44 +1,61 @@ -subroutine print_UG0W0(nBas,nO,e,ENuc,EHF,SigmaC,Z,eGW,EcRPA) +subroutine print_UG0W0(nBas,nO,e,ENuc,EHF,SigC,Z,eGW,EcRPA) ! Print one-electron energies and other stuff for G0W0 implicit none include 'parameters.h' - integer,intent(in) :: nBas,nO + integer,intent(in) :: nBas + integer,intent(in) :: nO(nspin) double precision,intent(in) :: ENuc double precision,intent(in) :: EHF double precision,intent(in) :: EcRPA - double precision,intent(in) :: e(nBas),SigmaC(nBas),Z(nBas),eGW(nBas) + double precision,intent(in) :: e(nBas,nspin) + double precision,intent(in) :: SigC(nBas,nspin) + double precision,intent(in) :: Z(nBas,nspin) + double precision,intent(in) :: eGW(nBas,nspin) - integer :: x,HOMO,LUMO + integer :: p + double precision :: HOMO + double precision :: LUMO double precision :: Gap ! HOMO and LUMO - HOMO = nO - LUMO = HOMO + 1 - Gap = eGW(LUMO)-eGW(HOMO) + HOMO = max(eGW(nO(1),1),eGW(nO(2),2)) + LUMO = min(eGW(nO(1)+1,1),eGW(nO(2)+1,2)) + Gap = LUMO - HOMO ! Dump results - write(*,*)'-------------------------------------------------------------------------------' - write(*,*)' One-shot G0W0 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_HF (eV)','|','Sigma_c (eV)','|','Z','|','e_QP (eV)','|' - write(*,*)'-------------------------------------------------------------------------------' + write(*,*)'-------------------------------------------------------------------------------& + -------------------------------------------------' + write(*,*)' Unrestricted one-shot G0W0 calculation (eV)' + write(*,*)'-------------------------------------------------------------------------------& + -------------------------------------------------' + write(*,'(A1,A3,A1,2A15,A1,2A15,A1,2A15,A1,2A15,A1)') & + '|','#','|','e_HF up','e_HF dw','|','Sig_c up','Sig_c dw','|', & + 'Z up','Z dw','|','e_QP up','e_QP dw','|' + write(*,*)'-------------------------------------------------------------------------------& + -------------------------------------------------' - do x=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)') & - '|',x,'|',e(x)*HaToeV,'|',SigmaC(x)*HaToeV,'|',Z(x),'|',eGW(x)*HaToeV,'|' + do p=1,nBas + write(*,'(A1,I3,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1)') & + '|',p,'|',e(p,1)*HaToeV,e(p,2)*HaToeV,'|',SigC(p,1)*HaToeV,SigC(p,2)*HaToeV,'|', & + Z(p,1),Z(p,2),'|',eGW(p,1)*HaToeV,eGW(p,2)*HaToeV,'|' enddo - write(*,*)'-------------------------------------------------------------------------------' - write(*,'(2X,A30,F15.6)') 'G0W0 HOMO energy (eV):',eGW(HOMO)*HaToeV - write(*,'(2X,A30,F15.6)') 'G0W0 LUMO energy (eV):',eGW(LUMO)*HaToeV + write(*,*)'-------------------------------------------------------------------------------& + -------------------------------------------------' + write(*,'(2X,A30,F15.6)') 'G0W0 HOMO energy (eV):',HOMO*HaToeV + write(*,'(2X,A30,F15.6)') 'G0W0 LUMO energy (eV):',LUMO*HaToeV write(*,'(2X,A30,F15.6)') 'G0W0 HOMO-LUMO gap (eV):',Gap*HaToeV - write(*,*)'-------------------------------------------------------------------------------' + write(*,*)'-------------------------------------------------------------------------------& + -------------------------------------------------' + write(*,'(2X,A30,F15.6)') 'RPA@HF total energy =',ENuc + EHF + EcRPA + write(*,'(2X,A30,F15.6)') 'RPA@HF correlation energy =',EcRPA + write(*,*)'-------------------------------------------------------------------------------& + -------------------------------------------------' write(*,*) end subroutine print_UG0W0 diff --git a/src/QuAcK/print_excitation.f90 b/src/QuAcK/print_excitation.f90 index ea8fa8b..e5ce17b 100644 --- a/src/QuAcK/print_excitation.f90 +++ b/src/QuAcK/print_excitation.f90 @@ -13,18 +13,20 @@ subroutine print_excitation(method,ispin,nS,Omega) ! Local variables - character*7 :: spin_manifold + character*14 :: spin_manifold integer,parameter :: maxS = 32 integer :: ia if(ispin == 1) spin_manifold = 'singlet' if(ispin == 2) spin_manifold = 'triplet' - if(ispin == 3) spin_manifold = 'alp-bet' - if(ispin == 4) spin_manifold = 'alp-alp' + if(ispin == 3) spin_manifold = 'alpha-beta' + if(ispin == 4) spin_manifold = 'alpha-alpha' + if(ispin == 5) spin_manifold = 'spin-conserved' + if(ispin == 6) spin_manifold = 'spin-flip' write(*,*) write(*,*)'-------------------------------------------------------------' - write(*,'(1X,A1,1X,A14,A14,A7,A9,A15)')'|',method,' calculation: ',spin_manifold,' manifold',' |' + write(*,'(1X,A1,1X,A14,A14,A14,A9,A13)')'|',method,' calculation: ',spin_manifold,' manifold',' |' write(*,*)'-------------------------------------------------------------' write(*,'(1X,A1,1X,A5,1X,A1,1X,A23,1X,A1,1X,A23,1X,A1,1X)') & '|','State','|',' Excitation energy (au) ','|',' Excitation energy (eV) ','|' diff --git a/src/QuAcK/renormalization_factor.f90 b/src/QuAcK/renormalization_factor.f90 index 070c1e5..15e3bf2 100644 --- a/src/QuAcK/renormalization_factor.f90 +++ b/src/QuAcK/renormalization_factor.f90 @@ -35,42 +35,10 @@ subroutine renormalization_factor(COHSEX,SOSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega,r Z(:) = 1d0 return - - end if - -! Occupied part of the correlation self-energy - - do x=nC+1,nBas-nR - do i=nC+1,nO - jb = 0 - do j=nC+1,nO - do b=nO+1,nBas-nR - jb = jb + 1 - eps = e(x) - e(i) + Omega(jb) - Z(x) = Z(x) - 2d0*rho(x,i,jb)**2*(eps/(eps**2 + eta**2))**2 - end do - end do - end do - end do - -! Virtual part of the correlation self-energy - - do x=nC+1,nBas-nR - do a=nO+1,nBas-nR - jb = 0 - do j=nC+1,nO - do b=nO+1,nBas-nR - jb = jb + 1 - eps = e(x) - e(a) - Omega(jb) - Z(x) = Z(x) - 2d0*rho(x,a,jb)**2*(eps/(eps**2 + eta**2))**2 - end do - end do - end do - end do - - ! SOSEX correction - - if(SOSEX) then + +! SOSEX correction + + elseif(SOSEX) then ! Occupied part of the correlation self-energy @@ -102,7 +70,39 @@ subroutine renormalization_factor(COHSEX,SOSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega,r end do end do - endif + else + + ! Occupied part of the correlation self-energy + + do x=nC+1,nBas-nR + do i=nC+1,nO + jb = 0 + do j=nC+1,nO + do b=nO+1,nBas-nR + jb = jb + 1 + eps = e(x) - e(i) + Omega(jb) + Z(x) = Z(x) - 2d0*rho(x,i,jb)**2*(eps/(eps**2 + eta**2))**2 + end do + end do + end do + end do + + ! Virtual part of the correlation self-energy + + do x=nC+1,nBas-nR + do a=nO+1,nBas-nR + jb = 0 + do j=nC+1,nO + do b=nO+1,nBas-nR + jb = jb + 1 + eps = e(x) - e(a) - Omega(jb) + Z(x) = Z(x) - 2d0*rho(x,a,jb)**2*(eps/(eps**2 + eta**2))**2 + end do + end do + end do + end do + + end if ! Compute renormalization factor from derivative of SigC diff --git a/src/QuAcK/unrestricted_excitation_density.f90 b/src/QuAcK/unrestricted_excitation_density.f90 index 5ea602b..5822d65 100644 --- a/src/QuAcK/unrestricted_excitation_density.f90 +++ b/src/QuAcK/unrestricted_excitation_density.f90 @@ -1,4 +1,4 @@ -subroutine unrestricted_excitation_density(nBas,nC,nO,nR,nSa,nSb,nSt,ERI_aa,ERI_ab,ERI_bb,XpY,rho) +subroutine unrestricted_excitation_density(nBas,nC,nO,nR,nSa,nSb,nSt,ERI_aaaa,ERI_aabb,ERI_bbbb,XpY,rho) ! Compute excitation densities for unrestricted reference @@ -14,9 +14,9 @@ subroutine unrestricted_excitation_density(nBas,nC,nO,nR,nSa,nSb,nSt,ERI_aa,ERI_ integer,intent(in) :: nSa integer,intent(in) :: nSb integer,intent(in) :: nSt - double precision,intent(in) :: ERI_aa(nBas,nBas,nBas,nBas) - double precision,intent(in) :: ERI_ab(nBas,nBas,nBas,nBas) - double precision,intent(in) :: ERI_bb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) double precision,intent(in) :: XpY(nSt,nSt) ! Local variables @@ -45,7 +45,7 @@ subroutine unrestricted_excitation_density(nBas,nC,nO,nR,nSa,nSb,nSt,ERI_aa,ERI_ do b=nO(1)+1,nBas-nR(1) jb = jb + 1 - rho(p,q,ia,1) = rho(p,q,ia,1) + ERI_aa(p,j,q,b)*XpY(ia,jb) + rho(p,q,ia,1) = rho(p,q,ia,1) + ERI_aaaa(p,j,q,b)*XpY(ia,jb) enddo enddo @@ -58,7 +58,7 @@ subroutine unrestricted_excitation_density(nBas,nC,nO,nR,nSa,nSb,nSt,ERI_aa,ERI_ do b=nO(2)+1,nBas-nR(2) jb = jb + 1 - rho(p,q,ia,1) = rho(p,q,ia,1) + ERI_ab(p,j,q,b)*XpY(ia,jb) + rho(p,q,ia,1) = rho(p,q,ia,1) + ERI_aabb(p,j,q,b)*XpY(ia,jb) enddo enddo @@ -81,7 +81,7 @@ subroutine unrestricted_excitation_density(nBas,nC,nO,nR,nSa,nSb,nSt,ERI_aa,ERI_ do b=nO(1)+1,nBas-nR(1) jb = jb + 1 - rho(p,q,ia,2) = rho(p,q,ia,2) + ERI_ab(j,p,b,q)*XpY(ia,jb) + rho(p,q,ia,2) = rho(p,q,ia,2) + ERI_aabb(j,p,b,q)*XpY(ia,jb) enddo enddo @@ -94,7 +94,7 @@ subroutine unrestricted_excitation_density(nBas,nC,nO,nR,nSa,nSb,nSt,ERI_aa,ERI_ do b=nO(2)+1,nBas-nR(2) jb = jb + 1 - rho(p,q,ia,2) = rho(p,q,ia,2) + ERI_bb(p,j,q,b)*XpY(ia,jb) + rho(p,q,ia,2) = rho(p,q,ia,2) + ERI_bbbb(p,j,q,b)*XpY(ia,jb) enddo enddo diff --git a/src/QuAcK/unrestricted_linear_response.f90 b/src/QuAcK/unrestricted_linear_response.f90 index 0a547da..b8d8d52 100644 --- a/src/QuAcK/unrestricted_linear_response.f90 +++ b/src/QuAcK/unrestricted_linear_response.f90 @@ -1,5 +1,5 @@ subroutine unrestricted_linear_response(ispin,dRPA,TDA,BSE,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda, & - e,ERI_aa,ERI_ab,ERI_bb,rho,EcRPA,Omega,XpY,XmY) + e,ERI_aaaa,ERI_aabb,ERI_bbbb,rho,EcRPA,Omega,XpY,XmY) ! Compute linear response for unrestricted formalism @@ -24,9 +24,9 @@ subroutine unrestricted_linear_response(ispin,dRPA,TDA,BSE,eta,nBas,nC,nO,nV,nR, double precision,intent(in) :: lambda double precision,intent(in) :: e(nBas,nspin) double precision,intent(in) :: rho(nBas,nBas,nSt,nspin) - double precision,intent(in) :: ERI_aa(nBas,nBas,nBas,nBas) - double precision,intent(in) :: ERI_ab(nBas,nBas,nBas,nBas) - double precision,intent(in) :: ERI_bb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) ! Local variables @@ -53,18 +53,20 @@ subroutine unrestricted_linear_response(ispin,dRPA,TDA,BSE,eta,nBas,nC,nO,nV,nR, ! Build A and B matrices - call unrestricted_linear_response_A_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda,e,ERI_aa,ERI_ab,ERI_bb,A) + call unrestricted_linear_response_A_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda,e,ERI_aaaa,ERI_aabb,ERI_bbbb,A) -! if(BSE) call Bethe_Salpeter_A_matrix(eta,nBas,nC,nO,nV,nR,nS,lambda,ERI,Omega,rho,A) + if(BSE) & + call unrestricted_Bethe_Salpeter_A_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda,ERI_aaaa,ERI_aabb,ERI_bbbb,Omega,rho,A) ! Tamm-Dancoff approximation B = 0d0 if(.not. TDA) then - call unrestricted_linear_response_B_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda,ERI_aa,ERI_ab,ERI_bb,B) + call unrestricted_linear_response_B_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda,ERI_aaaa,ERI_aabb,ERI_bbbb,B) -! if(BSE) call Bethe_Salpeter_B_matrix(eta,nBas,nC,nO,nV,nR,nS,lambda,ERI,Omega,rho,B) + if(BSE) & + call unrestricted_Bethe_Salpeter_B_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda,ERI_aaaa,ERI_aabb,ERI_bbbb,Omega,rho,B) end if diff --git a/src/QuAcK/unrestricted_linear_response_A_matrix.f90 b/src/QuAcK/unrestricted_linear_response_A_matrix.f90 index 60d2d87..75c63b0 100644 --- a/src/QuAcK/unrestricted_linear_response_A_matrix.f90 +++ b/src/QuAcK/unrestricted_linear_response_A_matrix.f90 @@ -1,5 +1,5 @@ subroutine unrestricted_linear_response_A_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda, & - e,ERI_aa,ERI_ab,ERI_bb,A_lr) + e,ERI_aaaa,ERI_aabb,ERI_bbbb,A_lr) ! Compute linear response @@ -20,9 +20,9 @@ subroutine unrestricted_linear_response_A_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa integer,intent(in) :: nSt double precision,intent(in) :: lambda double precision,intent(in) :: e(nBas,nspin) - double precision,intent(in) :: ERI_aa(nBas,nBas,nBas,nBas) - double precision,intent(in) :: ERI_ab(nBas,nBas,nBas,nBas) - double precision,intent(in) :: ERI_bb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) ! Local variables @@ -58,7 +58,7 @@ subroutine unrestricted_linear_response_A_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa jb = jb + 1 A_lr(ia,jb) = (e(a,1) - e(i,1))*Kronecker_delta(i,j)*Kronecker_delta(a,b) & - + lambda*ERI_aa(i,b,a,j) - (1d0 - delta_dRPA)*lambda*ERI_aa(i,b,j,a) + + lambda*ERI_aaaa(i,b,a,j) - (1d0 - delta_dRPA)*lambda*ERI_aaaa(i,b,j,a) end do end do @@ -76,7 +76,7 @@ subroutine unrestricted_linear_response_A_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa do b=nO(2)+1,nBas-nR(2) jb = jb + 1 - A_lr(ia,nSa+jb) = lambda*ERI_ab(i,b,a,j) + A_lr(ia,nSa+jb) = lambda*ERI_aabb(i,b,a,j) end do end do @@ -94,7 +94,7 @@ subroutine unrestricted_linear_response_A_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa do b=nO(1)+1,nBas-nR(1) jb = jb + 1 - A_lr(nSa+ia,jb) = lambda*ERI_ab(b,i,j,a) + A_lr(nSa+ia,jb) = lambda*ERI_aabb(b,i,j,a) end do end do @@ -113,7 +113,7 @@ subroutine unrestricted_linear_response_A_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa jb = jb + 1 A_lr(nSa+ia,nSa+jb) = (e(a,2) - e(i,2))*Kronecker_delta(i,j)*Kronecker_delta(a,b) & - + lambda*ERI_bb(i,b,a,j) - (1d0 - delta_dRPA)*lambda*ERI_bb(i,b,j,a) + + lambda*ERI_bbbb(i,b,a,j) - (1d0 - delta_dRPA)*lambda*ERI_bbbb(i,b,j,a) end do end do @@ -122,5 +122,15 @@ subroutine unrestricted_linear_response_A_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa end if +!----------------------------------------------- +! Build A matrix for spin-flip transitions +!----------------------------------------------- + + if(ispin == 2) then + + print*,'spin-flip transition NYI' + + end if + end subroutine unrestricted_linear_response_A_matrix diff --git a/src/QuAcK/unrestricted_linear_response_B_matrix.f90 b/src/QuAcK/unrestricted_linear_response_B_matrix.f90 index 22213df..400a498 100644 --- a/src/QuAcK/unrestricted_linear_response_B_matrix.f90 +++ b/src/QuAcK/unrestricted_linear_response_B_matrix.f90 @@ -1,5 +1,5 @@ subroutine unrestricted_linear_response_B_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda, & - ERI_aa,ERI_ab,ERI_bb,B_lr) + ERI_aaaa,ERI_aabb,ERI_bbbb,B_lr) ! Compute linear response @@ -19,9 +19,9 @@ subroutine unrestricted_linear_response_B_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa integer,intent(in) :: nSb integer,intent(in) :: nSt double precision,intent(in) :: lambda - double precision,intent(in) :: ERI_aa(nBas,nBas,nBas,nBas) - double precision,intent(in) :: ERI_ab(nBas,nBas,nBas,nBas) - double precision,intent(in) :: ERI_bb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) ! Local variables @@ -56,7 +56,7 @@ subroutine unrestricted_linear_response_B_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa do b=nO(1)+1,nBas-nR(1) jb = jb + 1 - B_lr(ia,jb) = lambda*ERI_aa(i,j,a,b) - (1d0 - delta_dRPA)*lambda*ERI_aa(i,j,b,a) + B_lr(ia,jb) = lambda*ERI_aaaa(i,j,a,b) - (1d0 - delta_dRPA)*lambda*ERI_aaaa(i,j,b,a) end do end do @@ -74,7 +74,7 @@ subroutine unrestricted_linear_response_B_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa do b=nO(2)+1,nBas-nR(2) jb = jb + 1 - B_lr(ia,nSa+jb) = lambda*ERI_ab(i,j,a,b) + B_lr(ia,nSa+jb) = lambda*ERI_aabb(i,j,a,b) end do end do @@ -92,7 +92,7 @@ subroutine unrestricted_linear_response_B_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa do b=nO(1)+1,nBas-nR(1) jb = jb + 1 - B_lr(nSa+ia,jb) = lambda*ERI_ab(j,i,b,a) + B_lr(nSa+ia,jb) = lambda*ERI_aabb(j,i,b,a) end do end do @@ -110,7 +110,7 @@ subroutine unrestricted_linear_response_B_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa do b=nO(2)+1,nBas-nR(2) jb = jb + 1 - B_lr(nSa+ia,nSa+jb) = lambda*ERI_bb(i,j,a,b) - (1d0 - delta_dRPA)*lambda*ERI_bb(i,j,b,a) + B_lr(nSa+ia,nSa+jb) = lambda*ERI_bbbb(i,j,a,b) - (1d0 - delta_dRPA)*lambda*ERI_bbbb(i,j,b,a) end do end do @@ -119,5 +119,15 @@ subroutine unrestricted_linear_response_B_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa end if +!----------------------------------------------- +! Build A matrix for spin-flip transitions +!----------------------------------------------- + + if(ispin == 2) then + + print*,'spin-flip transition NYI' + + end if + end subroutine unrestricted_linear_response_B_matrix diff --git a/src/QuAcK/unrestricted_renormalization_factor.f90 b/src/QuAcK/unrestricted_renormalization_factor.f90 new file mode 100644 index 0000000..403060d --- /dev/null +++ b/src/QuAcK/unrestricted_renormalization_factor.f90 @@ -0,0 +1,93 @@ +subroutine unrestricted_renormalization_factor(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,e,Omega,rho,Z) + +! Compute the renormalization factor in the unrestricted formalism + + implicit none + include 'parameters.h' + +! Input variables + + double precision,intent(in) :: eta + integer,intent(in) :: nBas + integer,intent(in) :: nC(nspin) + integer,intent(in) :: nO(nspin) + integer,intent(in) :: nV(nspin) + integer,intent(in) :: nR(nspin) + integer,intent(in) :: nSa + integer,intent(in) :: nSb + integer,intent(in) :: nSt + double precision,intent(in) :: e(nBas,nspin) + double precision,intent(in) :: Omega(nSt) + double precision,intent(in) :: rho(nBas,nBas,nSt,nspin) + +! Local variables + + integer :: i,j,a,b,p,q,jb + double precision :: eps + +! Output variables + + double precision,intent(out) :: Z(nBas,nspin) + +! Initialize + + Z(:,:) = 0d0 + +!--------------! +! Spin-up part ! +!--------------! + + ! Occupied part of the renormalization factor + + do p=nC(1)+1,nBas-nR(1) + do i=nC(1)+1,nO(1) + do jb=1,nSt + eps = e(p,1) - e(i,1) + Omega(jb) + Z(p,1) = Z(p,1) + rho(p,i,jb,1)**2*(eps/(eps**2 + eta**2))**2 + end do + end do + end do + + ! Virtual part of the correlation self-energy + + do p=nC(1)+1,nBas-nR(1) + do a=nO(1)+1,nBas-nR(1) + do jb=1,nSt + eps = e(p,1) - e(a,1) - Omega(jb) + Z(p,1) = Z(p,1) + rho(p,a,jb,1)**2*(eps/(eps**2 + eta**2))**2 + end do + end do + end do + +!----------------! +! Spin-down part ! +!----------------! + + ! Occupied part of the correlation self-energy + + do p=nC(2)+1,nBas-nR(2) + do i=nC(2)+1,nO(2) + do jb=1,nSt + eps = e(p,2) - e(i,2) + Omega(jb) + Z(p,2) = Z(p,2) + rho(p,i,jb,2)**2*(eps/(eps**2 + eta**2))**2 + end do + end do + end do + + ! Virtual part of the correlation self-energy + + do p=nC(2)+1,nBas-nR(2) + do a=nO(2)+1,nBas-nR(2) + do jb=1,nSt + eps = e(p,2) - e(a,2) - Omega(jb) + Z(p,2) = Z(p,2) + rho(p,a,jb,2)**2*(eps/(eps**2 + eta**2))**2 + end do + end do + end do + +! Final rescaling + + Z(:,:) = 1d0/(1d0 + Z(:,:)) + + +end subroutine unrestricted_renormalization_factor From 8f5b1779de2eb7b18f07f85f4a145b8636780991 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Tue, 22 Sep 2020 22:14:08 +0200 Subject: [PATCH 03/17] UBSE --- src/QuAcK/unrestricted_Bethe_Salpeter.f90 | 151 ++++++++++++++++++ .../unrestricted_Bethe_Salpeter_A_matrix.f90 | 140 ++++++++++++++++ .../unrestricted_Bethe_Salpeter_B_matrix.f90 | 136 ++++++++++++++++ 3 files changed, 427 insertions(+) create mode 100644 src/QuAcK/unrestricted_Bethe_Salpeter.f90 create mode 100644 src/QuAcK/unrestricted_Bethe_Salpeter_A_matrix.f90 create mode 100644 src/QuAcK/unrestricted_Bethe_Salpeter_B_matrix.f90 diff --git a/src/QuAcK/unrestricted_Bethe_Salpeter.f90 b/src/QuAcK/unrestricted_Bethe_Salpeter.f90 new file mode 100644 index 0000000..a75c9a7 --- /dev/null +++ b/src/QuAcK/unrestricted_Bethe_Salpeter.f90 @@ -0,0 +1,151 @@ +subroutine unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta, & + nBas,nC,nO,nV,nR,nSa,nSb,nSt,ERI_aaaa,ERI_aabb,ERI_bbbb, & + eW,eGW,OmRPA,XpY_RPA,XmY_RPA,rho_RPA,EcRPA,EcBSE) + +! Compute the Bethe-Salpeter excitation energies + + implicit none + include 'parameters.h' + +! Input variables + + logical,intent(in) :: TDA_W + logical,intent(in) :: TDA + logical,intent(in) :: dBSE + logical,intent(in) :: dTDA + logical,intent(in) :: evDyn + logical,intent(in) :: spin_conserved + logical,intent(in) :: spin_flip + + double precision,intent(in) :: eta + integer,intent(in) :: nBas + integer,intent(in) :: nC(nspin) + integer,intent(in) :: nO(nspin) + integer,intent(in) :: nV(nspin) + integer,intent(in) :: nR(nspin) + integer,intent(in) :: nSa + integer,intent(in) :: nSb + integer,intent(in) :: nSt + double precision,intent(in) :: eW(nBas,nspin) + double precision,intent(in) :: eGW(nBas,nspin) + double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) + + double precision :: OmRPA(nSt) + double precision :: XpY_RPA(nSt,nSt) + double precision :: XmY_RPA(nSt,nSt) + double precision :: rho_RPA(nBas,nBas,nSt,nspin) + +! Local variables + + integer :: ispin + integer :: isp_W + double precision,allocatable :: OmBSE(:) + double precision,allocatable :: XpY_BSE(:,:) + double precision,allocatable :: XmY_BSE(:,:) + +! Output variables + + double precision,intent(out) :: EcRPA + double precision,intent(out) :: EcBSE + +! Memory allocation + + allocate(OmBSE(nSt),XpY_BSE(nSt,nSt),XmY_BSE(nSt,nSt)) + +!----------------------------! +! Spin-conserved excitations ! +!----------------------------! + + if(spin_conserved) then + + ispin = 1 + isp_W = 1 + EcBSE = 0d0 + + ! Compute spin-conserved RPA screening + + call unrestricted_linear_response(isp_W,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,1d0, & + eW,ERI_aaaa,ERI_aabb,ERI_bbbb,rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA) + + call unrestricted_excitation_density(nBas,nC,nO,nR,nSa,nSb,nSt,ERI_aaaa,ERI_aabb,ERI_bbbb,XpY_RPA,rho_RPA) + + ! Compute BSE excitation energies + + OmBSE(:) = OmRPA(:) + + call unrestricted_linear_response(ispin,.true.,TDA,.true.,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,1d0, & + eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,rho_RPA,EcBSE,OmBSE,XpY_BSE,XmY_BSE) + + call print_excitation('BSE@UG0W0',5,nSt,OmBSE) + + !------------------------------------------------- + ! Compute the dynamical screening at the BSE level + !------------------------------------------------- + +! if(dBSE) then + +! ! Compute dynamic correction for BSE via perturbation theory (iterative or renormalized) +! +! if(evDyn) then +! +! call Bethe_Salpeter_dynamic_perturbation_iterative(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW(:),OmRPA(:,ispin),OmBSE(:,ispin), & +! XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin),rho_RPA(:,:,:,ispin)) +! else +! +! call Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW(:),OmRPA(:,ispin),OmBSE(:,ispin), & +! XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin),rho_RPA(:,:,:,ispin)) +! end if + +! end if + + end if + +!-----------------------! +! Spin-flip excitations ! +!-----------------------! + +!if(spin_flip) then + +! ispin = 2 +! isp_W = 1 +! EcBSE(ispin) = 0d0 + +! ! Compute (singlet) RPA screening + +! call linear_response(isp_W,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eW,ERI, & +! rho_RPA(:,:,:,ispin),EcRPA(ispin),OmRPA(:,ispin),XpY_RPA(:,:,ispin),XmY_RPA(:,:,ispin)) +! call excitation_density(nBas,nC,nO,nR,nS,ERI,XpY_RPA(:,:,ispin),rho_RPA(:,:,:,ispin)) + +! ! Compute BSE excitation energies + +! OmBSE(:,ispin) = OmRPA(:,ispin) + +! call linear_response(ispin,.true.,TDA,.true.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI, & +! rho_RPA(:,:,:,ispin),EcBSE(ispin),OmBSE(:,ispin),XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin)) +! call print_excitation('BSE ',ispin,nS,OmBSE(:,ispin)) + + !------------------------------------------------- + ! Compute the dynamical screening at the BSE level + !------------------------------------------------- + +! if(dBSE) then + +! ! Compute dynamic correction for BSE via perturbation theory (iterative or renormalized) + +! if(evDyn) then +! +! call Bethe_Salpeter_dynamic_perturbation_iterative(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA(:,ispin),OmBSE(:,ispin), & +! XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin),rho_RPA(:,:,:,ispin)) +! else +! +! call Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA(:,ispin),OmBSE(:,ispin), & +! XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin),rho_RPA(:,:,:,ispin)) +! end if + +! end if + +! end if + +end subroutine unrestricted_Bethe_Salpeter diff --git a/src/QuAcK/unrestricted_Bethe_Salpeter_A_matrix.f90 b/src/QuAcK/unrestricted_Bethe_Salpeter_A_matrix.f90 new file mode 100644 index 0000000..82a551b --- /dev/null +++ b/src/QuAcK/unrestricted_Bethe_Salpeter_A_matrix.f90 @@ -0,0 +1,140 @@ +subroutine unrestricted_Bethe_Salpeter_A_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda,ERI_aaaa,ERI_aabb,ERI_bbbb,Omega,rho,A_lr) + +! Compute the extra term for Bethe-Salpeter equation for linear response in the unrestricted formalism + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nBas + integer,intent(in) :: nC(nspin) + integer,intent(in) :: nO(nspin) + integer,intent(in) :: nV(nspin) + integer,intent(in) :: nR(nspin) + integer,intent(in) :: nSa + integer,intent(in) :: nSb + integer,intent(in) :: nSt + double precision,intent(in) :: eta + double precision,intent(in) :: lambda + double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: Omega(nSt) + double precision,intent(in) :: rho(nBas,nBas,nSt,nspin) + +! Local variables + + double precision :: chi + double precision :: eps + integer :: i,j,a,b,ia,jb,kc + +! Output variables + + double precision,intent(out) :: A_lr(nSt,nSt) + +!--------------------------------! +! Build part A of the BSE matrix ! +!--------------------------------! + + ! alpha-alpha block + + ia = 0 + do i=nC(1)+1,nO(1) + do a=nO(1)+1,nBas-nR(1) + ia = ia + 1 + jb = 0 + do j=nC(1)+1,nO(1) + do b=nO(1)+1,nBas-nR(1) + jb = jb + 1 + + chi = 0d0 + do kc=1,nSt + eps = Omega(kc)**2 + eta**2 + chi = chi + rho(i,j,kc,1)*rho(a,b,kc,1)*Omega(kc)/eps & + + rho(i,j,kc,2)*rho(a,b,kc,2)*Omega(kc)/eps + enddo + + A_lr(ia,jb) = A_lr(ia,jb) - lambda*ERI_aaaa(i,b,j,a) + 2d0*lambda*chi + + enddo + enddo + enddo + enddo + + ! alpha-beta block + + ia = 0 + do i=nC(1)+1,nO(1) + do a=nO(1)+1,nBas-nR(1) + ia = ia + 1 + jb = 0 + do j=nC(2)+1,nO(2) + do b=nO(2)+1,nBas-nR(2) + jb = jb + 1 + + chi = 0d0 + do kc=1,nSt + eps = Omega(kc)**2 + eta**2 + chi = chi + rho(i,j,kc,1)*rho(a,b,kc,1)*Omega(kc)/eps & + + rho(i,j,kc,2)*rho(a,b,kc,2)*Omega(kc)/eps + enddo + + A_lr(ia,nSa+jb) = A_lr(ia,nSa+jb) - lambda*ERI_aabb(i,b,j,a) + 2d0*lambda*chi + + enddo + enddo + enddo + enddo + + ! beta-alpha block + + ia = 0 + do i=nC(2)+1,nO(2) + do a=nO(2)+1,nBas-nR(2) + ia = ia + 1 + jb = 0 + do j=nC(1)+1,nO(1) + do b=nO(1)+1,nBas-nR(1) + jb = jb + 1 + + chi = 0d0 + do kc=1,nSt + eps = Omega(kc)**2 + eta**2 + chi = chi + rho(i,j,kc,1)*rho(a,b,kc,1)*Omega(kc)/eps & + + rho(i,j,kc,2)*rho(a,b,kc,2)*Omega(kc)/eps + enddo + + A_lr(nSa+ia,jb) = A_lr(nSa+ia,jb) - lambda*ERI_aabb(b,i,a,j) + 2d0*lambda*chi + + enddo + enddo + enddo + enddo + + ! beta-beta block + + ia = 0 + do i=nC(2)+1,nO(2) + do a=nO(2)+1,nBas-nR(2) + ia = ia + 1 + jb = 0 + do j=nC(2)+1,nO(2) + do b=nO(2)+1,nBas-nR(2) + jb = jb + 1 + + chi = 0d0 + do kc=1,nSt + eps = Omega(kc)**2 + eta**2 + chi = chi + rho(i,j,kc,1)*rho(a,b,kc,1)*Omega(kc)/eps & + + rho(i,j,kc,2)*rho(a,b,kc,2)*Omega(kc)/eps + enddo + + A_lr(nSa+ia,nSa+jb) = A_lr(nSa+ia,nSa+jb) - lambda*ERI_bbbb(i,b,j,a) + 2d0*lambda*chi + + enddo + enddo + enddo + enddo + +end subroutine unrestricted_Bethe_Salpeter_A_matrix diff --git a/src/QuAcK/unrestricted_Bethe_Salpeter_B_matrix.f90 b/src/QuAcK/unrestricted_Bethe_Salpeter_B_matrix.f90 new file mode 100644 index 0000000..476cde8 --- /dev/null +++ b/src/QuAcK/unrestricted_Bethe_Salpeter_B_matrix.f90 @@ -0,0 +1,136 @@ +subroutine unrestricted_Bethe_Salpeter_B_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda,ERI_aaaa,ERI_aabb,ERI_bbbb,Omega,rho,B_lr) + +! Compute the extra term for Bethe-Salpeter equation for linear response + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nBas + integer,intent(in) :: nC(nspin) + integer,intent(in) :: nO(nspin) + integer,intent(in) :: nV(nspin) + integer,intent(in) :: nR(nspin) + integer,intent(in) :: nSa + integer,intent(in) :: nSb + integer,intent(in) :: nSt + double precision,intent(in) :: eta + double precision,intent(in) :: lambda + double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: Omega(nSt) + double precision,intent(in) :: rho(nBas,nBas,nSt,nspin) + +! Local variables + + double precision :: chi + double precision :: eps + integer :: i,j,a,b,ia,jb,kc + +! Output variables + + double precision,intent(out) :: B_lr(nSt,nSt) + + ! alpha-alpha block + + ia = 0 + do i=nC(1)+1,nO(1) + do a=nO(1)+1,nBas-nR(1) + ia = ia + 1 + jb = 0 + do j=nC(1)+1,nO(1) + do b=nO(1)+1,nBas-nR(1) + jb = jb + 1 + + chi = 0d0 + do kc=1,nSt + eps = Omega(kc)**2 + eta**2 + chi = chi + rho(i,b,kc,1)*rho(a,j,kc,1)*Omega(kc)/eps & + + rho(i,b,kc,2)*rho(a,j,kc,2)*Omega(kc)/eps + enddo + + B_lr(ia,jb) = B_lr(ia,jb) - lambda*ERI_aaaa(i,j,b,a) + 2d0*lambda*chi + + enddo + enddo + enddo + enddo + + ! alpha-beta block + + ia = 0 + do i=nC(1)+1,nO(1) + do a=nO(1)+1,nBas-nR(1) + ia = ia + 1 + jb = 0 + do j=nC(2)+1,nO(2) + do b=nO(2)+1,nBas-nR(2) + jb = jb + 1 + + chi = 0d0 + do kc=1,nSt + eps = Omega(kc)**2 + eta**2 + chi = chi + rho(i,b,kc,1)*rho(a,j,kc,1)*Omega(kc)/eps & + + rho(i,b,kc,2)*rho(a,j,kc,2)*Omega(kc)/eps + enddo + + B_lr(ia,nSa+jb) = B_lr(ia,nSa+jb) - lambda*ERI_aabb(i,j,b,a) + 2d0*lambda*chi + + enddo + enddo + enddo + enddo + + ! beta-alpha block + + ia = 0 + do i=nC(2)+1,nO(2) + do a=nO(2)+1,nBas-nR(2) + ia = ia + 1 + jb = 0 + do j=nC(1)+1,nO(1) + do b=nO(1)+1,nBas-nR(1) + jb = jb + 1 + + chi = 0d0 + do kc=1,nSt + eps = Omega(kc)**2 + eta**2 + chi = chi + rho(i,b,kc,1)*rho(a,j,kc,1)*Omega(kc)/eps & + + rho(i,b,kc,2)*rho(a,j,kc,2)*Omega(kc)/eps + enddo + + B_lr(nSa+ia,jb) = B_lr(nSa+ia,jb) - lambda*ERI_aabb(j,i,a,b) + 2d0*lambda*chi + + enddo + enddo + enddo + enddo + + ! beta-beta block + + ia = 0 + do i=nC(2)+1,nO(2) + do a=nO(2)+1,nBas-nR(2) + ia = ia + 1 + jb = 0 + do j=nC(2)+1,nO(2) + do b=nO(2)+1,nBas-nR(2) + jb = jb + 1 + + chi = 0d0 + do kc=1,nSt + eps = Omega(kc)**2 + eta**2 + chi = chi + rho(i,b,kc,1)*rho(a,j,kc,1)*Omega(kc)/eps & + + rho(i,b,kc,2)*rho(a,j,kc,2)*Omega(kc)/eps + enddo + + B_lr(nSa+ia,nSa+jb) = B_lr(nSa+ia,nSa+jb) - lambda*ERI_bbbb(i,j,b,a) + 2d0*lambda*chi + + enddo + enddo + enddo + enddo + +end subroutine unrestricted_Bethe_Salpeter_B_matrix From b8bf488a9a1e0e11fffe26673f23e438c8307cf2 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Tue, 22 Sep 2020 23:08:47 +0200 Subject: [PATCH 04/17] spin conserved and spin flip --- input/options | 4 +- src/QuAcK/AOtoMO_integral_transform.f90 | 16 ++-- src/QuAcK/QuAcK.f90 | 94 +++++++++++++++-------- src/QuAcK/UG0W0.f90 | 53 ++++++------- src/QuAcK/qsGW.f90 | 2 +- src/QuAcK/read_options.f90 | 26 ++++--- src/QuAcK/unrestricted_Bethe_Salpeter.f90 | 60 ++++++++------- 7 files changed, 143 insertions(+), 112 deletions(-) diff --git a/input/options b/input/options index a5abf91..7be6358 100644 --- a/input/options +++ b/input/options @@ -4,8 +4,8 @@ # CC: maxSCF thresh DIIS n_diis 64 0.0000001 T 5 -# spin: singlet triplet TDA - T T F +# spin: singlet triplet spin_conserved spinf_flip TDA + T T T F F # 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/QuAcK/AOtoMO_integral_transform.f90 b/src/QuAcK/AOtoMO_integral_transform.f90 index 23e4198..dabeee8 100644 --- a/src/QuAcK/AOtoMO_integral_transform.f90 +++ b/src/QuAcK/AOtoMO_integral_transform.f90 @@ -1,15 +1,15 @@ -subroutine AOtoMO_integral_transform(bra,ket,nBas,c,ERI_AO_basis,ERI_MO_basis) +subroutine AOtoMO_integral_transform(bra1,bra2,ket1,ket2,nBas,c,ERI_AO_basis,ERI_MO_basis) ! AO to MO transformation of two-electron integrals via the semi-direct O(N^5) algorithm -! bra and ket are the spin of (bra|ket) +! bra and ket are the spin of (bra1 bra2|ket1 ket2) implicit none include 'parameters.h' ! Input variables - integer,intent(in) :: bra - integer,intent(in) :: ket + integer,intent(in) :: bra1,bra2 + integer,intent(in) :: ket1,ket2 integer,intent(in) :: nBas double precision,intent(in) :: ERI_AO_basis(nBas,nBas,nBas,nBas),c(nBas,nBas,nspin) @@ -35,7 +35,7 @@ subroutine AOtoMO_integral_transform(bra,ket,nBas,c,ERI_AO_basis,ERI_MO_basis) do la=1,nBas do nu=1,nBas do mu=1,nBas - scr(mu,nu,la,l) = scr(mu,nu,la,l) + ERI_AO_basis(mu,nu,la,si)*c(si,l,ket) + scr(mu,nu,la,l) = scr(mu,nu,la,l) + ERI_AO_basis(mu,nu,la,si)*c(si,l,ket2) enddo enddo enddo @@ -49,7 +49,7 @@ subroutine AOtoMO_integral_transform(bra,ket,nBas,c,ERI_AO_basis,ERI_MO_basis) do nu=1,nBas do i=1,nBas do mu=1,nBas - ERI_MO_basis(i,nu,la,l) = ERI_MO_basis(i,nu,la,l) + c(mu,i,bra)*scr(mu,nu,la,l) + ERI_MO_basis(i,nu,la,l) = ERI_MO_basis(i,nu,la,l) + c(mu,i,bra1)*scr(mu,nu,la,l) enddo enddo enddo @@ -63,7 +63,7 @@ subroutine AOtoMO_integral_transform(bra,ket,nBas,c,ERI_AO_basis,ERI_MO_basis) do la=1,nBas do nu=1,nBas do i=1,nBas - scr(i,nu,k,l) = scr(i,nu,k,l) + ERI_MO_basis(i,nu,la,l)*c(la,k,bra) + scr(i,nu,k,l) = scr(i,nu,k,l) + ERI_MO_basis(i,nu,la,l)*c(la,k,bra2) enddo enddo enddo @@ -77,7 +77,7 @@ subroutine AOtoMO_integral_transform(bra,ket,nBas,c,ERI_AO_basis,ERI_MO_basis) do j=1,nBas do i=1,nBas do nu=1,nBas - ERI_MO_basis(i,j,k,l) = ERI_MO_basis(i,j,k,l) + c(nu,j,ket)*scr(i,nu,k,l) + ERI_MO_basis(i,j,k,l) = ERI_MO_basis(i,j,k,l) + c(nu,j,ket1)*scr(i,nu,k,l) enddo ! print*,i,k,j,l,ERI_MO_basis(i,j,k,l) enddo diff --git a/src/QuAcK/QuAcK.f90 b/src/QuAcK/QuAcK.f90 index 0bb56a2..6f62482 100644 --- a/src/QuAcK/QuAcK.f90 +++ b/src/QuAcK/QuAcK.f90 @@ -55,11 +55,12 @@ program QuAcK double precision,allocatable :: S(:,:),T(:,:),V(:,:),Hc(:,:),H(:,:),X(:,:) double precision,allocatable :: ERI_AO(:,:,:,:) double precision,allocatable :: ERI_MO(:,:,:,:) - integer :: bra - integer :: ket + integer :: bra1,bra2 + integer :: ket1,ket2 double precision,allocatable :: ERI_MO_aaaa(:,:,:,:) double precision,allocatable :: ERI_MO_aabb(:,:,:,:) double precision,allocatable :: ERI_MO_bbbb(:,:,:,:) + double precision,allocatable :: ERI_MO_abab(:,:,:,:) double precision,allocatable :: ERI_ERF_AO(:,:,:,:) double precision,allocatable :: ERI_ERF_MO(:,:,:,:) double precision,allocatable :: F12(:,:,:,:),Yuk(:,:,:,:),FC(:,:,:,:,:,:) @@ -101,8 +102,10 @@ program QuAcK double precision :: thresh_CC logical :: DIIS_CC - logical :: singlet_manifold - logical :: triplet_manifold + logical :: singlet + logical :: triplet + logical :: spin_conserved + logical :: spin_flip logical :: TDA integer :: maxSCF_GF,n_diis_GF,renormGF @@ -156,7 +159,7 @@ program QuAcK call read_options(maxSCF_HF,thresh_HF,DIIS_HF,n_diis_HF,guess_type,ortho_type, & maxSCF_CC,thresh_CC,DIIS_CC,n_diis_CC, & - singlet_manifold,triplet_manifold,TDA, & + singlet,triplet,spin_conserved,spin_flip,TDA, & maxSCF_GF,thresh_GF,DIIS_GF,n_diis_GF,linGF,eta_GF,renormGF, & maxSCF_GW,thresh_GW,DIIS_GW,n_diis_GW,linGW,eta_GW, & COHSEX,SOSEX,TDA_W,G0W,GW0, & @@ -334,21 +337,42 @@ program QuAcK ! 4-index transform for (aa|aa) block - bra = 1 - ket = 1 - call AOtoMO_integral_transform(bra,ket,nBas,cHF,ERI_AO,ERI_MO_aaaa) + bra1 = 1 + bra2 = 1 + ket1 = 1 + ket2 = 1 + call AOtoMO_integral_transform(bra1,bra2,ket1,ket2,nBas,cHF,ERI_AO,ERI_MO_aaaa) ! 4-index transform for (aa|bb) block - bra = 1 - ket = 2 - call AOtoMO_integral_transform(bra,ket,nBas,cHF,ERI_AO,ERI_MO_aabb) + bra1 = 1 + bra2 = 1 + ket1 = 2 + ket2 = 2 + call AOtoMO_integral_transform(bra1,bra2,ket1,ket2,nBas,cHF,ERI_AO,ERI_MO_aabb) ! 4-index transform for (bb|bb) block - bra = 2 - ket = 2 - call AOtoMO_integral_transform(bra,ket,nBas,cHF,ERI_AO,ERI_MO_bbbb) + bra1 = 2 + bra2 = 2 + ket1 = 2 + ket2 = 2 + call AOtoMO_integral_transform(bra1,bra2,ket1,ket2,nBas,cHF,ERI_AO,ERI_MO_bbbb) + + if(spin_flip) then + + allocate(ERI_MO_abab(nBas,nBas,nBas,nBas)) + + ! 4-index transform for (ab|ab) block + + bra1 = 1 + bra2 = 2 + ket1 = 1 + ket2 = 2 + call AOtoMO_integral_transform(bra1,bra2,ket1,ket2,nBas,cHF,ERI_AO,ERI_MO_abab) + + end if + else @@ -358,9 +382,11 @@ program QuAcK ! 4-index transform - bra = 1 - ket = 1 - call AOtoMO_integral_transform(bra,ket,nBas,cHF,ERI_AO,ERI_MO) + bra1 = 1 + bra2 = 1 + ket1 = 1 + ket2 = 1 + call AOtoMO_integral_transform(bra1,bra2,ket1,ket2,nBas,cHF,ERI_AO,ERI_MO) end if @@ -560,7 +586,7 @@ program QuAcK if(doCIS) then call cpu_time(start_CIS) - call CIS(singlet_manifold,triplet_manifold,nBas,nC,nO,nV,nR,nS,ERI_MO,eHF) + call CIS(singlet,triplet,nBas,nC,nO,nV,nR,nS,ERI_MO,eHF) call cpu_time(end_CIS) t_CIS = end_CIS - start_CIS @@ -576,7 +602,7 @@ program QuAcK if(doCID) then call cpu_time(start_CID) -! call CID(singlet_manifold,triplet_manifold,nBas,nC,nO,nV,nR,ERI_MO,eHF) +! call CID(singlet,triplet,nBas,nC,nO,nV,nR,ERI_MO,eHF) call cpu_time(end_CID) t_CID = end_CID - start_CID @@ -592,7 +618,7 @@ program QuAcK if(doCISD) then call cpu_time(start_CISD) - call CISD(singlet_manifold,triplet_manifold,nBas,nC,nO,nV,nR,ERI_MO,eHF) + call CISD(singlet,triplet,nBas,nC,nO,nV,nR,ERI_MO,eHF) call cpu_time(end_CISD) t_CISD = end_CISD - start_CISD @@ -608,7 +634,7 @@ program QuAcK if(doRPA) then call cpu_time(start_RPA) - call RPA(doACFDT,exchange_kernel,singlet_manifold,triplet_manifold,0d0, & + call RPA(doACFDT,exchange_kernel,singlet,triplet,0d0, & nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF) call cpu_time(end_RPA) @@ -625,7 +651,7 @@ program QuAcK if(doRPAx) then call cpu_time(start_RPAx) - call RPAx(doACFDT,exchange_kernel,singlet_manifold,triplet_manifold,0d0, & + call RPAx(doACFDT,exchange_kernel,singlet,triplet,0d0, & nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF) call cpu_time(end_RPAx) @@ -642,7 +668,7 @@ program QuAcK if(doppRPA) then call cpu_time(start_ppRPA) - call ppRPA(singlet_manifold,triplet_manifold, & + call ppRPA(singlet,triplet, & nBas,nC,nO,nV,nR,ENuc,ERHF,ERI_MO,eHF) call cpu_time(end_ppRPA) @@ -659,7 +685,7 @@ program QuAcK ! if(doADC) then ! call cpu_time(start_ADC) -! call ADC(singlet_manifold,triplet_manifold,maxSCF_GF,thresh_GF,n_diis_GF, & +! call ADC(singlet,triplet,maxSCF_GF,thresh_GF,n_diis_GF, & ! nBas,nC,nO,nV,nR,eHF,ERI_MO) ! call cpu_time(end_ADC) @@ -676,7 +702,7 @@ program QuAcK if(doG0F2) then call cpu_time(start_GF2) - call G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold,linGF, & + call G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet,linGF, & eta_GF,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF) call cpu_time(end_GF2) @@ -694,7 +720,7 @@ program QuAcK call cpu_time(start_GF2) call evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF_GF,thresh_GF,n_diis_GF, & - singlet_manifold,triplet_manifold,linGF, & + singlet,triplet,linGF, & eta_GF,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF) call cpu_time(end_GF2) @@ -748,12 +774,12 @@ program QuAcK if(unrestricted) then call UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,evDyn, & - singlet_manifold,triplet_manifold,linGW,eta_GW,nBas,nC,nO,nV,nR,nS, & + spin_conserved,spin_flip,linGW,eta_GW,nBas,nC,nO,nV,nR,nS, & ENuc,EUHF,Hc,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,PHF,cHF,eHF,eG0W0) else call G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & - dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold,linGW,eta_GW, & + dBSE,dTDA,evDyn,singlet,triplet,linGW,eta_GW, & nBas,nC,nO,nV,nR,nS,ENuc,ERHF,Hc,ERI_MO,PHF,cHF,eHF,eG0W0) end if @@ -774,7 +800,7 @@ program QuAcK call cpu_time(start_evGW) call evGW(maxSCF_GW,thresh_GW,n_diis_GW,doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX, & - BSE,TDA_W,TDA,G0W,GW0,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold,eta_GW, & + BSE,TDA_W,TDA,G0W,GW0,dBSE,dTDA,evDyn,singlet,triplet,eta_GW, & nBas,nC,nO,nV,nR,nS,ENuc,ERHF,Hc,H,ERI_MO,PHF,cHF,eHF,eG0W0) call cpu_time(end_evGW) @@ -792,7 +818,7 @@ program QuAcK call cpu_time(start_qsGW) call qsGW(maxSCF_GW,thresh_GW,n_diis_GW,doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX, & - BSE,TDA_W,TDA,G0W,GW0,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold,eta_GW, & + BSE,TDA_W,TDA,G0W,GW0,dBSE,dTDA,evDyn,singlet,triplet,eta_GW, & nBas,nC,nO,nV,nR,nS,ENuc,ERHF,S,X,T,V,Hc,ERI_AO,ERI_MO,PHF,cHF,eHF) call cpu_time(end_qsGW) @@ -812,7 +838,7 @@ program QuAcK call cpu_time(start_G0T0) call G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA, & - dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold,linGW,eta_GW, & + dBSE,dTDA,evDyn,singlet,triplet,linGW,eta_GW, & nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF,eG0T0) call cpu_time(end_G0T0) @@ -830,7 +856,7 @@ program QuAcK call cpu_time(start_evGT) call evGT(maxSCF_GW,thresh_GW,n_diis_GW,doACFDT,exchange_kernel,doXBS, & - BSE,TDA_W,TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold,eta_GW, & + BSE,TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta_GW, & nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF,eG0T0) call cpu_time(end_evGT) @@ -947,7 +973,7 @@ program QuAcK call cpu_time(start_G0W0) call G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & - dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold,linGW,eta_GW, & + dBSE,dTDA,evDyn,singlet,triplet,linGW,eta_GW, & nBas,nC,nO,nV,nR,nS,ENuc,ERHF,Hc,ERI_ERF_MO,PHF,cHF,eHF,eG0W0) call cpu_time(end_G0W0) @@ -961,7 +987,7 @@ program QuAcK call cpu_time(start_G0T0) call G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn, & - singlet_manifold,triplet_manifold,linGW,eta_GW, & + singlet,triplet,linGW,eta_GW, & nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_ERF_MO,eHF,eG0T0) call cpu_time(end_G0T0) diff --git a/src/QuAcK/UG0W0.f90 b/src/QuAcK/UG0W0.f90 index 0e0b38e..07de370 100644 --- a/src/QuAcK/UG0W0.f90 +++ b/src/QuAcK/UG0W0.f90 @@ -45,21 +45,13 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev logical :: print_W = .true. integer :: ispin - integer :: iblock - integer :: bra - integer :: ket - integer :: nSa - integer :: nSb - integer :: nSt - double precision :: EcRPA - double precision :: EcBSE + double precision :: EcRPA(nspin) + double precision :: EcBSE(nspin) double precision :: EcAC(nspin) double precision,allocatable :: SigC(:,:) double precision,allocatable :: Z(:,:) - double precision,allocatable :: Omega(:) - double precision,allocatable :: XpY(:,:) - double precision,allocatable :: XmY(:,:) - double precision,allocatable :: rho(:,:,:,:) + integer :: nS_aa,nS_bb,nS_sc + double precision,allocatable :: Omega_sc(:),XpY_sc(:,:),XmY_sc(:,:),rho_sc(:,:,:,:) double precision,allocatable :: eGWlin(:,:) @@ -103,12 +95,12 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev ! Memory allocation - nSa = nS(1) - nSb = nS(2) - nSt = nSa + nSb + nS_aa = nS(1) + nS_bb = nS(2) + nS_sc = nS_aa + nS_bb - allocate(SigC(nBas,nspin),Z(nBas,nspin),Omega(nSt),XpY(nSt,nSt),XmY(nSt,nSt), & - rho(nBas,nBas,nSt,nspin),eGWlin(nBas,nspin)) + allocate(SigC(nBas,nspin),Z(nBas,nspin),Omega_sc(nS_sc),XpY_sc(nS_sc,nS_sc),XmY_sc(nS_sc,nS_sc), & + rho_sc(nBas,nBas,nS_sc,nspin),eGWlin(nBas,nspin)) !-------------------! ! Compute screening ! @@ -118,28 +110,28 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev ispin = 1 - call unrestricted_linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,1d0, & - eHF,ERI_aaaa,ERI_aabb,ERI_bbbb,rho,EcRPA,Omega,XpY,XmY) + call unrestricted_linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,1d0, & + eHF,ERI_aaaa,ERI_aabb,ERI_bbbb,rho_sc,EcRPA(ispin),Omega_sc,XpY_sc,XmY_sc) - if(print_W) call print_excitation('RPA@UHF',5,nSt,Omega) + if(print_W) call print_excitation('RPA@UHF',5,nS_sc,Omega_sc) !----------------------! ! Excitation densities ! !----------------------! - call unrestricted_excitation_density(nBas,nC,nO,nR,nSa,nSb,nSt,ERI_aaaa,ERI_aabb,ERI_bbbb,XpY,rho) + call unrestricted_excitation_density(nBas,nC,nO,nR,nS_aa,nS_bb,nS_sc,ERI_aaaa,ERI_aabb,ERI_bbbb,XpY_sc,rho_sc) !---------------------! ! Compute self-energy ! !---------------------! - call unrestricted_self_energy_correlation_diag(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,eHF,Omega,rho,SigC) + call unrestricted_self_energy_correlation_diag(eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,eHF,Omega_sc,rho_sc,SigC) !--------------------------------! ! Compute renormalization factor ! !--------------------------------! - call unrestricted_renormalization_factor(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,eHF,Omega,rho,Z) + call unrestricted_renormalization_factor(eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,eHF,Omega_sc,rho_sc,Z) !-----------------------------------! ! Solve the quasi-particle equation ! @@ -171,23 +163,26 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev ! Compute the RPA correlation energy - call unrestricted_linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,1d0, & - eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,rho,EcRPA,Omega,XpY,XmY) + call unrestricted_linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,1d0, & + eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,rho_sc,EcRPA(ispin),Omega_sc,XpY_sc,XmY_sc) write(*,*) write(*,*)'-------------------------------------------------------------------------------' - write(*,'(2X,A50,F20.10)') 'Tr@RPA@G0W0 correlation energy =',EcRPA - write(*,'(2X,A50,F20.10)') 'Tr@RPA@G0W0 total energy =',ENuc + EUHF + EcRPA + write(*,'(2X,A50,F20.10)') 'Tr@RPA@G0W0 correlation energy =',EcRPA(ispin) + write(*,'(2X,A50,F20.10)') 'Tr@RPA@G0W0 total energy =',ENuc + EUHF + EcRPA(ispin) write(*,*)'-------------------------------------------------------------------------------' write(*,*) +! Free memory + + deallocate(Omega_sc,XpY_sc,XmY_sc,rho_sc) + ! Perform BSE calculation if(BSE) then call unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta, & - nBas,nC,nO,nV,nR,nSa,nSb,nSt,ERI_aaaa,ERI_aabb,ERI_bbbb, & - eHF,eGW,Omega,XpY,XmY,rho,EcRPA,EcBSE) + nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,ERI_bbbb,eHF,eGW,EcRPA,EcBSE) ! if(exchange_kernel) then ! diff --git a/src/QuAcK/qsGW.f90 b/src/QuAcK/qsGW.f90 index 8191c4b..dad60a5 100644 --- a/src/QuAcK/qsGW.f90 +++ b/src/QuAcK/qsGW.f90 @@ -149,7 +149,7 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, ! AO to MO transformation of two-electron integrals - call AOtoMO_integral_transform(nBas,c,ERI_AO_basis,ERI_MO_basis) + call AOtoMO_integral_transform(1,1,1,1,nBas,c,ERI_AO_basis,ERI_MO_basis) ! Compute linear response diff --git a/src/QuAcK/read_options.f90 b/src/QuAcK/read_options.f90 index e5e8e14..c9e72f3 100644 --- a/src/QuAcK/read_options.f90 +++ b/src/QuAcK/read_options.f90 @@ -1,6 +1,6 @@ subroutine read_options(maxSCF_HF,thresh_HF,DIIS_HF,n_diis_HF,guess_type,ortho_type, & maxSCF_CC,thresh_CC,DIIS_CC,n_diis_CC, & - singlet_manifold,triplet_manifold,TDA, & + singlet,triplet,spin_conserved,spin_flip,TDA, & maxSCF_GF,thresh_GF,DIIS_GF,n_diis_GF,linGF,eta_GF,renormGF, & maxSCF_GW,thresh_GW,DIIS_GW,n_diis_GW,linGW,eta_GW, & COHSEX,SOSEX,TDA_W,G0W,GW0, & @@ -26,8 +26,10 @@ subroutine read_options(maxSCF_HF,thresh_HF,DIIS_HF,n_diis_HF,guess_type,ortho_t logical,intent(out) :: DIIS_CC integer,intent(out) :: n_diis_CC - logical,intent(out) :: singlet_manifold - logical,intent(out) :: triplet_manifold + logical,intent(out) :: singlet + logical,intent(out) :: triplet + logical,intent(out) :: spin_conserved + logical,intent(out) :: spin_flip logical,intent(out) :: TDA integer,intent(out) :: maxSCF_GF @@ -113,16 +115,20 @@ subroutine read_options(maxSCF_HF,thresh_HF,DIIS_HF,n_diis_HF,guess_type,ortho_t ! Read excited state options - singlet_manifold = .false. - triplet_manifold = .false. - TDA = .false. + singlet = .false. + triplet = .false. + spin_conserved = .false. + spin_flip = .false. + TDA = .false. read(1,*) - read(1,*) answer1,answer2,answer3 + read(1,*) answer1,answer2,answer3,answer4,answer5 - if(answer1 == 'T') singlet_manifold = .true. - if(answer2 == 'T') triplet_manifold = .true. - if(answer3 == 'T') TDA = .true. + if(answer1 == 'T') singlet = .true. + if(answer2 == 'T') triplet = .true. + if(answer3 == 'T') spin_conserved = .true. + if(answer4 == 'T') spin_flip = .true. + if(answer5 == 'T') TDA = .true. ! Read Green function options diff --git a/src/QuAcK/unrestricted_Bethe_Salpeter.f90 b/src/QuAcK/unrestricted_Bethe_Salpeter.f90 index a75c9a7..ef85215 100644 --- a/src/QuAcK/unrestricted_Bethe_Salpeter.f90 +++ b/src/QuAcK/unrestricted_Bethe_Salpeter.f90 @@ -1,6 +1,5 @@ subroutine unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta, & - nBas,nC,nO,nV,nR,nSa,nSb,nSt,ERI_aaaa,ERI_aabb,ERI_bbbb, & - eW,eGW,OmRPA,XpY_RPA,XmY_RPA,rho_RPA,EcRPA,EcBSE) + nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,ERI_bbbb,eW,eGW,EcRPA,EcBSE) ! Compute the Bethe-Salpeter excitation energies @@ -23,36 +22,32 @@ subroutine unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved, integer,intent(in) :: nO(nspin) integer,intent(in) :: nV(nspin) integer,intent(in) :: nR(nspin) - integer,intent(in) :: nSa - integer,intent(in) :: nSb - integer,intent(in) :: nSt + integer,intent(in) :: nS(nspin) double precision,intent(in) :: eW(nBas,nspin) double precision,intent(in) :: eGW(nBas,nspin) double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) - double precision :: OmRPA(nSt) - double precision :: XpY_RPA(nSt,nSt) - double precision :: XmY_RPA(nSt,nSt) - double precision :: rho_RPA(nBas,nBas,nSt,nspin) ! Local variables integer :: ispin integer :: isp_W - double precision,allocatable :: OmBSE(:) - double precision,allocatable :: XpY_BSE(:,:) - double precision,allocatable :: XmY_BSE(:,:) + integer :: nS_aa,nS_bb,nS_sc + integer :: nS_ab,nS_ba,nS_sf + double precision,allocatable :: OmRPA_sc(:) + double precision,allocatable :: XpY_RPA_sc(:,:) + double precision,allocatable :: XmY_RPA_sc(:,:) + double precision,allocatable :: rho_RPA_sc(:,:,:,:) + double precision,allocatable :: OmBSE_sc(:) + double precision,allocatable :: XpY_BSE_sc(:,:) + double precision,allocatable :: XmY_BSE_sc(:,:) ! Output variables - double precision,intent(out) :: EcRPA - double precision,intent(out) :: EcBSE - -! Memory allocation - - allocate(OmBSE(nSt),XpY_BSE(nSt,nSt),XmY_BSE(nSt,nSt)) + double precision,intent(out) :: EcRPA(nspin) + double precision,intent(out) :: EcBSE(nspin) !----------------------------! ! Spin-conserved excitations ! @@ -62,23 +57,32 @@ subroutine unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved, ispin = 1 isp_W = 1 - EcBSE = 0d0 + EcBSE(ispin) = 0d0 - ! Compute spin-conserved RPA screening + ! Memory allocation - call unrestricted_linear_response(isp_W,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,1d0, & - eW,ERI_aaaa,ERI_aabb,ERI_bbbb,rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA) + nS_aa = nS(1) + nS_bb = nS(2) + nS_sc = nS_aa + nS_bb + + allocate(OmRPA_sc(nS_sc),XpY_RPA_sc(nS_sc,nS_sc),XmY_RPA_sc(nS_sc,nS_sc),rho_RPA_sc(nBas,nBas,nS_sc,nspin)) + allocate(OmBSE_sc(nS_sc),XpY_BSE_sc(nS_sc,nS_sc),XmY_BSE_sc(nS_sc,nS_sc)) - call unrestricted_excitation_density(nBas,nC,nO,nR,nSa,nSb,nSt,ERI_aaaa,ERI_aabb,ERI_bbbb,XpY_RPA,rho_RPA) + ! Compute spin-conserved RPA screening - ! Compute BSE excitation energies + call unrestricted_linear_response(isp_W,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,1d0, & + eW,ERI_aaaa,ERI_aabb,ERI_bbbb,rho_RPA_sc,EcRPA(ispin),OmRPA_sc,XpY_RPA_sc,XmY_RPA_sc) - OmBSE(:) = OmRPA(:) + call unrestricted_excitation_density(nBas,nC,nO,nR,nS_aa,nS_bb,nS_sc,ERI_aaaa,ERI_aabb,ERI_bbbb,XpY_RPA_sc,rho_RPA_sc) - call unrestricted_linear_response(ispin,.true.,TDA,.true.,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,1d0, & - eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,rho_RPA,EcBSE,OmBSE,XpY_BSE,XmY_BSE) + ! Compute spin-conserved BSE excitation energies - call print_excitation('BSE@UG0W0',5,nSt,OmBSE) + OmBSE_sc(:) = OmRPA_sc(:) + + call unrestricted_linear_response(ispin,.true.,TDA,.true.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,1d0, & + eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,rho_RPA_sc,EcBSE(ispin),OmBSE_sc,XpY_BSE_sc,XmY_BSE_sc) + + call print_excitation('BSE@UG0W0',5,nS_sc,OmBSE_sc) !------------------------------------------------- ! Compute the dynamical screening at the BSE level From 2b7f31a340503c2c3d7020c459f9ec27eca59819 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Tue, 22 Sep 2020 23:46:33 +0200 Subject: [PATCH 05/17] BSE and spin --- input/options | 4 +- src/QuAcK/QuAcK.f90 | 2 +- src/QuAcK/UG0W0.f90 | 10 ++-- src/QuAcK/unrestricted_Bethe_Salpeter.f90 | 13 +++-- .../unrestricted_Bethe_Salpeter_A_matrix.f90 | 5 +- .../unrestricted_Bethe_Salpeter_B_matrix.f90 | 5 +- src/QuAcK/unrestricted_linear_response.f90 | 15 ++++-- .../unrestricted_linear_response_A_matrix.f90 | 51 +++++++++++++++--- .../unrestricted_linear_response_B_matrix.f90 | 53 ++++++++++++++++--- 9 files changed, 126 insertions(+), 32 deletions(-) diff --git a/input/options b/input/options index 7be6358..23ac893 100644 --- a/input/options +++ b/input/options @@ -4,8 +4,8 @@ # CC: maxSCF thresh DIIS n_diis 64 0.0000001 T 5 -# spin: singlet triplet spin_conserved spinf_flip TDA - T T T F F +# spin: singlet triplet spin_conserved spin_flip TDA + T T T T F # 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/QuAcK/QuAcK.f90 b/src/QuAcK/QuAcK.f90 index 6f62482..d65bfcc 100644 --- a/src/QuAcK/QuAcK.f90 +++ b/src/QuAcK/QuAcK.f90 @@ -775,7 +775,7 @@ program QuAcK call UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,evDyn, & spin_conserved,spin_flip,linGW,eta_GW,nBas,nC,nO,nV,nR,nS, & - ENuc,EUHF,Hc,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,PHF,cHF,eHF,eG0W0) + ENuc,EUHF,Hc,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,ERI_MO_abab,PHF,cHF,eHF,eG0W0) else call G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & diff --git a/src/QuAcK/UG0W0.f90 b/src/QuAcK/UG0W0.f90 index 07de370..453f326 100644 --- a/src/QuAcK/UG0W0.f90 +++ b/src/QuAcK/UG0W0.f90 @@ -1,6 +1,6 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,evDyn, & spin_conserved,spin_flip,linearize,eta,nBas,nC,nO,nV,nR,nS, & - ENuc,EUHF,Hc,ERI_aaaa,ERI_aabb,ERI_bbbb,PHF,cHF,eHF,eGW) + ENuc,EUHF,Hc,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,PHF,cHF,eHF,eGW) ! Perform unrestricted G0W0 calculation @@ -40,6 +40,7 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_abab(nBas,nBas,nBas,nBas) ! Local variables @@ -111,7 +112,7 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev ispin = 1 call unrestricted_linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,1d0, & - eHF,ERI_aaaa,ERI_aabb,ERI_bbbb,rho_sc,EcRPA(ispin),Omega_sc,XpY_sc,XmY_sc) + eHF,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,rho_sc,EcRPA(ispin),Omega_sc,XpY_sc,XmY_sc) if(print_W) call print_excitation('RPA@UHF',5,nS_sc,Omega_sc) @@ -164,7 +165,7 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev ! Compute the RPA correlation energy call unrestricted_linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,1d0, & - eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,rho_sc,EcRPA(ispin),Omega_sc,XpY_sc,XmY_sc) + eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,rho_sc,EcRPA(ispin),Omega_sc,XpY_sc,XmY_sc) write(*,*) write(*,*)'-------------------------------------------------------------------------------' @@ -182,7 +183,8 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev if(BSE) then call unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta, & - nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,ERI_bbbb,eHF,eGW,EcRPA,EcBSE) + nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab, & + eHF,eGW,EcRPA,EcBSE) ! if(exchange_kernel) then ! diff --git a/src/QuAcK/unrestricted_Bethe_Salpeter.f90 b/src/QuAcK/unrestricted_Bethe_Salpeter.f90 index ef85215..38b36ee 100644 --- a/src/QuAcK/unrestricted_Bethe_Salpeter.f90 +++ b/src/QuAcK/unrestricted_Bethe_Salpeter.f90 @@ -1,5 +1,6 @@ subroutine unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta, & - nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,ERI_bbbb,eW,eGW,EcRPA,EcBSE) + nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab, & + eW,eGW,EcRPA,EcBSE) ! Compute the Bethe-Salpeter excitation energies @@ -28,6 +29,7 @@ subroutine unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved, double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_abab(nBas,nBas,nBas,nBas) ! Local variables @@ -71,16 +73,19 @@ subroutine unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved, ! Compute spin-conserved RPA screening call unrestricted_linear_response(isp_W,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,1d0, & - eW,ERI_aaaa,ERI_aabb,ERI_bbbb,rho_RPA_sc,EcRPA(ispin),OmRPA_sc,XpY_RPA_sc,XmY_RPA_sc) + eW,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,rho_RPA_sc,EcRPA(ispin), & + OmRPA_sc,XpY_RPA_sc,XmY_RPA_sc) - call unrestricted_excitation_density(nBas,nC,nO,nR,nS_aa,nS_bb,nS_sc,ERI_aaaa,ERI_aabb,ERI_bbbb,XpY_RPA_sc,rho_RPA_sc) + call unrestricted_excitation_density(nBas,nC,nO,nR,nS_aa,nS_bb,nS_sc,ERI_aaaa,ERI_aabb,ERI_bbbb, & + XpY_RPA_sc,rho_RPA_sc) ! Compute spin-conserved BSE excitation energies OmBSE_sc(:) = OmRPA_sc(:) call unrestricted_linear_response(ispin,.true.,TDA,.true.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,1d0, & - eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,rho_RPA_sc,EcBSE(ispin),OmBSE_sc,XpY_BSE_sc,XmY_BSE_sc) + eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,rho_RPA_sc,EcBSE(ispin), & + OmBSE_sc,XpY_BSE_sc,XmY_BSE_sc) call print_excitation('BSE@UG0W0',5,nS_sc,OmBSE_sc) diff --git a/src/QuAcK/unrestricted_Bethe_Salpeter_A_matrix.f90 b/src/QuAcK/unrestricted_Bethe_Salpeter_A_matrix.f90 index 82a551b..e3f5813 100644 --- a/src/QuAcK/unrestricted_Bethe_Salpeter_A_matrix.f90 +++ b/src/QuAcK/unrestricted_Bethe_Salpeter_A_matrix.f90 @@ -1,4 +1,6 @@ -subroutine unrestricted_Bethe_Salpeter_A_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda,ERI_aaaa,ERI_aabb,ERI_bbbb,Omega,rho,A_lr) +subroutine unrestricted_Bethe_Salpeter_A_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda, & + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab, & + Omega,rho,A_lr) ! Compute the extra term for Bethe-Salpeter equation for linear response in the unrestricted formalism @@ -20,6 +22,7 @@ subroutine unrestricted_Bethe_Salpeter_A_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_abab(nBas,nBas,nBas,nBas) double precision,intent(in) :: Omega(nSt) double precision,intent(in) :: rho(nBas,nBas,nSt,nspin) diff --git a/src/QuAcK/unrestricted_Bethe_Salpeter_B_matrix.f90 b/src/QuAcK/unrestricted_Bethe_Salpeter_B_matrix.f90 index 476cde8..250978d 100644 --- a/src/QuAcK/unrestricted_Bethe_Salpeter_B_matrix.f90 +++ b/src/QuAcK/unrestricted_Bethe_Salpeter_B_matrix.f90 @@ -1,4 +1,6 @@ -subroutine unrestricted_Bethe_Salpeter_B_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda,ERI_aaaa,ERI_aabb,ERI_bbbb,Omega,rho,B_lr) +subroutine unrestricted_Bethe_Salpeter_B_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda, & + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab, & + Omega,rho,B_lr) ! Compute the extra term for Bethe-Salpeter equation for linear response @@ -20,6 +22,7 @@ subroutine unrestricted_Bethe_Salpeter_B_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_abab(nBas,nBas,nBas,nBas) double precision,intent(in) :: Omega(nSt) double precision,intent(in) :: rho(nBas,nBas,nSt,nspin) diff --git a/src/QuAcK/unrestricted_linear_response.f90 b/src/QuAcK/unrestricted_linear_response.f90 index b8d8d52..29a6dfe 100644 --- a/src/QuAcK/unrestricted_linear_response.f90 +++ b/src/QuAcK/unrestricted_linear_response.f90 @@ -1,5 +1,5 @@ subroutine unrestricted_linear_response(ispin,dRPA,TDA,BSE,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda, & - e,ERI_aaaa,ERI_aabb,ERI_bbbb,rho,EcRPA,Omega,XpY,XmY) + e,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,rho,EcRPA,Omega,XpY,XmY) ! Compute linear response for unrestricted formalism @@ -27,6 +27,7 @@ subroutine unrestricted_linear_response(ispin,dRPA,TDA,BSE,eta,nBas,nC,nO,nV,nR, double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_abab(nBas,nBas,nBas,nBas) ! Local variables @@ -53,20 +54,24 @@ subroutine unrestricted_linear_response(ispin,dRPA,TDA,BSE,eta,nBas,nC,nO,nV,nR, ! Build A and B matrices - call unrestricted_linear_response_A_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda,e,ERI_aaaa,ERI_aabb,ERI_bbbb,A) + call unrestricted_linear_response_A_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda,e, & + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,A) if(BSE) & - call unrestricted_Bethe_Salpeter_A_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda,ERI_aaaa,ERI_aabb,ERI_bbbb,Omega,rho,A) + call unrestricted_Bethe_Salpeter_A_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda, & + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega,rho,A) ! Tamm-Dancoff approximation B = 0d0 if(.not. TDA) then - call unrestricted_linear_response_B_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda,ERI_aaaa,ERI_aabb,ERI_bbbb,B) + call unrestricted_linear_response_B_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda, & + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,B) if(BSE) & - call unrestricted_Bethe_Salpeter_B_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda,ERI_aaaa,ERI_aabb,ERI_bbbb,Omega,rho,B) + call unrestricted_Bethe_Salpeter_B_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda, & + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega,rho,B) end if diff --git a/src/QuAcK/unrestricted_linear_response_A_matrix.f90 b/src/QuAcK/unrestricted_linear_response_A_matrix.f90 index 75c63b0..ded4c78 100644 --- a/src/QuAcK/unrestricted_linear_response_A_matrix.f90 +++ b/src/QuAcK/unrestricted_linear_response_A_matrix.f90 @@ -1,5 +1,5 @@ subroutine unrestricted_linear_response_A_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda, & - e,ERI_aaaa,ERI_aabb,ERI_bbbb,A_lr) + e,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,A_lr) ! Compute linear response @@ -23,6 +23,7 @@ subroutine unrestricted_linear_response_A_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_abab(nBas,nBas,nBas,nBas) ! Local variables @@ -46,7 +47,7 @@ subroutine unrestricted_linear_response_A_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa if(ispin == 1) then - ! alpha-alpha block + ! aaaa block ia = 0 do i=nC(1)+1,nO(1) @@ -65,7 +66,7 @@ subroutine unrestricted_linear_response_A_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa end do end do - ! alpha-beta block + ! aabb block ia = 0 do i=nC(1)+1,nO(1) @@ -83,7 +84,7 @@ subroutine unrestricted_linear_response_A_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa end do end do - ! beta-alpha block + ! bbaa block ia = 0 do i=nC(2)+1,nO(2) @@ -101,7 +102,7 @@ subroutine unrestricted_linear_response_A_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa end do end do - ! beta-beta block + ! bbbb block ia = 0 do i=nC(2)+1,nO(2) @@ -128,7 +129,45 @@ subroutine unrestricted_linear_response_A_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa if(ispin == 2) then - print*,'spin-flip transition NYI' + A_lr(:,:) = 0d0 + + ! abab block + + ia = 0 + do i=nC(1)+1,nO(1) + do a=nO(2)+1,nBas-nR(2) + ia = ia + 1 + jb = 0 + do j=nC(1)+1,nO(1) + do b=nO(2)+1,nBas-nR(2) + jb = jb + 1 + + A_lr(ia,jb) = (e(a,2) - e(i,1))*Kronecker_delta(i,j)*Kronecker_delta(a,b) & + + lambda*ERI_abab(i,b,a,j) - (1d0 - delta_dRPA)*lambda*ERI_abab(i,b,j,a) + + end do + end do + end do + end do + + ! baba block + + ia = 0 + do i=nC(2)+1,nO(2) + do a=nO(1)+1,nBas-nR(1) + ia = ia + 1 + jb = 0 + do j=nC(2)+1,nO(2) + do b=nO(1)+1,nBas-nR(1) + jb = jb + 1 + + A_lr(nSa+ia,nSa+jb) = (e(a,1) - e(i,2))*Kronecker_delta(i,j)*Kronecker_delta(a,b) & + + lambda*ERI_abab(b,i,j,a) - (1d0 - delta_dRPA)*lambda*ERI_abab(b,i,a,j) + + end do + end do + end do + end do end if diff --git a/src/QuAcK/unrestricted_linear_response_B_matrix.f90 b/src/QuAcK/unrestricted_linear_response_B_matrix.f90 index 400a498..5ac615d 100644 --- a/src/QuAcK/unrestricted_linear_response_B_matrix.f90 +++ b/src/QuAcK/unrestricted_linear_response_B_matrix.f90 @@ -1,5 +1,5 @@ subroutine unrestricted_linear_response_B_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda, & - ERI_aaaa,ERI_aabb,ERI_bbbb,B_lr) + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,B_lr) ! Compute linear response @@ -22,6 +22,7 @@ subroutine unrestricted_linear_response_B_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_abab(nBas,nBas,nBas,nBas) ! Local variables @@ -40,12 +41,12 @@ subroutine unrestricted_linear_response_B_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa if(dRPA) delta_dRPA = 1d0 !----------------------------------------------- -! Build A matrix for spin-conserving transitions +! Build B matrix for spin-conserving transitions !----------------------------------------------- if(ispin == 1) then - ! alpha-alpha block + ! aaaa block ia = 0 do i=nC(1)+1,nO(1) @@ -63,7 +64,7 @@ subroutine unrestricted_linear_response_B_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa end do end do - ! alpha-beta block + ! aabb block ia = 0 do i=nC(1)+1,nO(1) @@ -81,7 +82,7 @@ subroutine unrestricted_linear_response_B_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa end do end do - ! beta-alpha block + ! bbaa block ia = 0 do i=nC(2)+1,nO(2) @@ -99,7 +100,7 @@ subroutine unrestricted_linear_response_B_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa end do end do - ! beta-beta block + ! bbbb block ia = 0 do i=nC(2)+1,nO(2) @@ -120,12 +121,48 @@ subroutine unrestricted_linear_response_B_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa end if !----------------------------------------------- -! Build A matrix for spin-flip transitions +! Build B matrix for spin-flip transitions !----------------------------------------------- if(ispin == 2) then - print*,'spin-flip transition NYI' + B_lr(:,:) = 0d0 + + ! abab block + + ia = 0 + do i=nC(1)+1,nO(1) + do a=nO(2)+1,nBas-nR(2) + ia = ia + 1 + jb = 0 + do j=nC(2)+1,nO(2) + do b=nO(2)+1,nBas-nR(2) + jb = jb + 1 + + B_lr(ia,jb) = lambda*ERI_abab(i,j,a,b) - (1d0 - delta_dRPA)*lambda*ERI_abab(i,j,b,a) + + end do + end do + end do + end do + + ! bbbb block + + ia = 0 + do i=nC(2)+1,nO(2) + do a=nO(1)+1,nBas-nR(1) + ia = ia + 1 + jb = 0 + do j=nC(2)+1,nO(2) + do b=nO(1)+1,nBas-nR(1) + jb = jb + 1 + + B_lr(nSa+ia,nSa+jb) = lambda*ERI_abab(j,i,b,a) - (1d0 - delta_dRPA)*lambda*ERI_abab(j,i,a,b) + + end do + end do + end do + end do end if From ce10bbaf5631b5397c1ca98bcc056aea1978a27f Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Wed, 23 Sep 2020 09:46:44 +0200 Subject: [PATCH 06/17] URPA --- input/methods | 4 +- src/QuAcK/QuAcK.f90 | 24 ++++- src/QuAcK/RPAx.f90 | 13 ++- src/QuAcK/URPAx.f90 | 152 ++++++++++++++++++++++++++++++++ src/QuAcK/UdRPA.f90 | 152 ++++++++++++++++++++++++++++++++ src/QuAcK/{RPA.f90 => dRPA.f90} | 4 +- 6 files changed, 334 insertions(+), 15 deletions(-) create mode 100644 src/QuAcK/URPAx.f90 create mode 100644 src/QuAcK/UdRPA.f90 rename src/QuAcK/{RPA.f90 => dRPA.f90} (97%) diff --git a/input/methods b/input/methods index ba17592..022df90 100644 --- a/input/methods +++ b/input/methods @@ -9,11 +9,11 @@ # CIS CID CISD F F F # RPA RPAx ppRPA - F F F + T F F # G0F2 evGF2 G0F3 evGF3 F F F F # G0W0 evGW qsGW - T F F + F F F # G0T0 evGT qsGT F F F # MCMP2 diff --git a/src/QuAcK/QuAcK.f90 b/src/QuAcK/QuAcK.f90 index d65bfcc..3bc4577 100644 --- a/src/QuAcK/QuAcK.f90 +++ b/src/QuAcK/QuAcK.f90 @@ -634,8 +634,16 @@ program QuAcK if(doRPA) then call cpu_time(start_RPA) - call RPA(doACFDT,exchange_kernel,singlet,triplet,0d0, & - nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF) + if(unrestricted) then + + call UdRPA(doACFDT,exchange_kernel,spin_conserved,spin_flip,0d0,nBas,nC,nO,nV,nR,nS,ENuc,EUHF, & + ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,ERI_MO_abab,eHF) + + else + + call dRPA(doACFDT,exchange_kernel,singlet,triplet,0d0,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF) + + end if call cpu_time(end_RPA) t_RPA = end_RPA - start_RPA @@ -651,8 +659,16 @@ program QuAcK if(doRPAx) then call cpu_time(start_RPAx) - call RPAx(doACFDT,exchange_kernel,singlet,triplet,0d0, & - nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF) + if(unrestricted) then + + call URPAx(doACFDT,exchange_kernel,spin_conserved,spin_flip,0d0,nBas,nC,nO,nV,nR,nS,ENuc,EUHF, & + ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,ERI_MO_abab,eHF) + + else + + call RPAx(doACFDT,exchange_kernel,singlet,triplet,0d0,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF) + + end if call cpu_time(end_RPAx) t_RPAx = end_RPAx - start_RPAx diff --git a/src/QuAcK/RPAx.f90 b/src/QuAcK/RPAx.f90 index 8afd56d..06c298a 100644 --- a/src/QuAcK/RPAx.f90 +++ b/src/QuAcK/RPAx.f90 @@ -1,5 +1,4 @@ -subroutine RPAx(doACFDT,exchange_kernel,singlet_manifold,triplet_manifold,eta, & - nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,e) +subroutine RPAx(doACFDT,exchange_kernel,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,e) ! Perform random phase approximation calculation with exchange (aka TDHF) @@ -11,9 +10,9 @@ subroutine RPAx(doACFDT,exchange_kernel,singlet_manifold,triplet_manifold,eta, & logical,intent(in) :: doACFDT logical,intent(in) :: exchange_kernel - logical,intent(in) :: singlet_manifold + logical,intent(in) :: singlet double precision,intent(in) :: eta - logical,intent(in) :: triplet_manifold + logical,intent(in) :: triplet integer,intent(in) :: nBas integer,intent(in) :: nC integer,intent(in) :: nO @@ -55,7 +54,7 @@ subroutine RPAx(doACFDT,exchange_kernel,singlet_manifold,triplet_manifold,eta, & ! Singlet manifold - if(singlet_manifold) then + if(singlet) then ispin = 1 @@ -69,7 +68,7 @@ subroutine RPAx(doACFDT,exchange_kernel,singlet_manifold,triplet_manifold,eta, & ! Triplet manifold - if(triplet_manifold) then + if(triplet) then ispin = 2 @@ -105,7 +104,7 @@ subroutine RPAx(doACFDT,exchange_kernel,singlet_manifold,triplet_manifold,eta, & write(*,*) '-------------------------------------------------------' write(*,*) - call ACFDT(exchange_kernel,.false.,.false.,.false.,.false.,.false.,singlet_manifold,triplet_manifold,eta, & + call ACFDT(exchange_kernel,.false.,.false.,.false.,.false.,.false.,singlet,triplet,eta, & nBas,nC,nO,nV,nR,nS,ERI,e,e,Omega,XpY,XmY,rho,EcAC) if(exchange_kernel) then diff --git a/src/QuAcK/URPAx.f90 b/src/QuAcK/URPAx.f90 new file mode 100644 index 0000000..4ae48cc --- /dev/null +++ b/src/QuAcK/URPAx.f90 @@ -0,0 +1,152 @@ +subroutine URPAx(doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,nC,nO,nV,nR,nS,ENuc,EUHF, & + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,e) + +! Perform random phase approximation calculation with exchange (aka TDHF) in the unrestricted formalism + + implicit none + include 'parameters.h' + include 'quadrature.h' + +! Input variables + + double precision,intent(in) :: eta + logical,intent(in) :: doACFDT + logical,intent(in) :: exchange_kernel + logical,intent(in) :: spin_conserved + logical,intent(in) :: spin_flip + integer,intent(in) :: nBas + integer,intent(in) :: nC(nspin) + integer,intent(in) :: nO(nspin) + integer,intent(in) :: nV(nspin) + integer,intent(in) :: nR(nspin) + integer,intent(in) :: nS(nspin) + double precision,intent(in) :: ENuc + double precision,intent(in) :: EUHF + double precision,intent(in) :: e(nBas,nspin) + double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_abab(nBas,nBas,nBas,nBas) + +! Local variables + + integer :: ispin + + integer :: nS_aa,nS_bb,nS_sc + double precision,allocatable :: Omega_sc(:) + double precision,allocatable :: XpY_sc(:,:) + double precision,allocatable :: XmY_sc(:,:) + + integer :: nS_ab,nS_ba,nS_sf + double precision,allocatable :: Omega_sf(:) + double precision,allocatable :: XpY_sf(:,:) + double precision,allocatable :: XmY_sf(:,:) + + double precision :: rho_sc,rho_sf + double precision :: EcRPAx(nspin) + double precision :: EcAC(nspin) + +! Hello world + + write(*,*) + write(*,*)'*********************************************************************' + write(*,*)'| Unrestricted random phase approximation calculation with exchange |' + write(*,*)'*********************************************************************' + write(*,*) + +! Initialization + + EcRPAx(:) = 0d0 + EcAC(:) = 0d0 + +! Spin-conserved transitions + + if(spin_conserved) then + + ispin = 1 + + ! Memory allocation + + nS_aa = nS(1) + nS_bb = nS(2) + nS_sc = nS_aa + nS_bb + + allocate(Omega_sc(nS_sc),XpY_sc(nS_sc,nS_sc),XmY_sc(nS_sc,nS_sc)) + + call unrestricted_linear_response(ispin,.false.,.false.,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,1d0,e, & + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,rho_sc,EcRPAx(ispin),Omega_sc,XpY_sc,XmY_sc) + call print_excitation('URPAx ',5,nS_sc,Omega_sc) +! call print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + + + endif + +! Spin-flip transitions + + if(spin_flip) then + + ispin = 2 + + ! Memory allocation + + nS_ab = (nO(1) - nC(1))*(nV(2) - nR(2)) + nS_ba = (nO(2) - nC(2))*(nV(1) - nR(1)) + nS_sf = nS_ab + nS_ba + + allocate(Omega_sf(nS_sf),XpY_sf(nS_sf,nS_sf),XmY_sf(nS_sf,nS_sf)) + + call unrestricted_linear_response(ispin,.false.,.false.,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sf,1d0,e, & + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,rho_sf,EcRPAx(ispin),Omega_sf,XpY_sf,XmY_sf) + call print_excitation('URPAx ',6,nS_sf,Omega_sf) +! call print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + + + endif + +! if(exchange_kernel) then + +! EcRPAx(1) = 0.5d0*EcRPAx(1) +! EcRPAx(2) = 1.5d0*EcRPAx(2) + +! end if + + write(*,*) + write(*,*)'-------------------------------------------------------------------------------' + write(*,'(2X,A50,F20.10)') 'Tr@URPAx correlation energy (spin-conserved) =',EcRPAx(1) + write(*,'(2X,A50,F20.10)') 'Tr@URPAx correlation energy (spin-flip) =',EcRPAx(2) + write(*,'(2X,A50,F20.10)') 'Tr@URPAx correlation energy =',EcRPAx(1) + EcRPAx(2) + write(*,'(2X,A50,F20.10)') 'Tr@URPAx total energy =',ENuc + EUHF + EcRPAx(1) + EcRPAx(2) + write(*,*)'-------------------------------------------------------------------------------' + write(*,*) + +! Compute the correlation energy via the adiabatic connection + +! if(doACFDT) then + +! write(*,*) '-------------------------------------------------------' +! write(*,*) 'Adiabatic connection version of RPAx correlation energy' +! write(*,*) '-------------------------------------------------------' +! write(*,*) + +! call ACFDT(exchange_kernel,.false.,.false.,.false.,.false.,.false.,singlet,triplet,eta, & +! nBas,nC,nO,nV,nR,nS,ERI,e,e,Omega,XpY,XmY,rho,EcAC) + +! if(exchange_kernel) then + +! EcAC(1) = 0.5d0*EcAC(1) +! EcAC(2) = 1.5d0*EcAC(2) + +! end if + +! write(*,*) +! write(*,*)'-------------------------------------------------------------------------------' +! write(*,'(2X,A50,F20.10)') 'AC@RPAx correlation energy (singlet) =',EcAC(1) +! write(*,'(2X,A50,F20.10)') 'AC@RPAx correlation energy (triplet) =',EcAC(2) +! write(*,'(2X,A50,F20.10)') 'AC@RPAx correlation energy =',EcAC(1) + EcAC(2) +! write(*,'(2X,A50,F20.10)') 'AC@RPAx total energy =',ENuc + EUHF + EcAC(1) + EcAC(2) +! write(*,*)'-------------------------------------------------------------------------------' +! write(*,*) + +! end if + +end subroutine URPAx diff --git a/src/QuAcK/UdRPA.f90 b/src/QuAcK/UdRPA.f90 new file mode 100644 index 0000000..da3d019 --- /dev/null +++ b/src/QuAcK/UdRPA.f90 @@ -0,0 +1,152 @@ +subroutine UdRPA(doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,nC,nO,nV,nR,nS,ENuc,EUHF, & + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,e) + +! Perform random phase approximation calculation with exchange (aka TDHF) in the unrestricted formalism + + implicit none + include 'parameters.h' + include 'quadrature.h' + +! Input variables + + double precision,intent(in) :: eta + logical,intent(in) :: doACFDT + logical,intent(in) :: exchange_kernel + logical,intent(in) :: spin_conserved + logical,intent(in) :: spin_flip + integer,intent(in) :: nBas + integer,intent(in) :: nC(nspin) + integer,intent(in) :: nO(nspin) + integer,intent(in) :: nV(nspin) + integer,intent(in) :: nR(nspin) + integer,intent(in) :: nS(nspin) + double precision,intent(in) :: ENuc + double precision,intent(in) :: EUHF + double precision,intent(in) :: e(nBas,nspin) + double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_abab(nBas,nBas,nBas,nBas) + +! Local variables + + integer :: ispin + + integer :: nS_aa,nS_bb,nS_sc + double precision,allocatable :: Omega_sc(:) + double precision,allocatable :: XpY_sc(:,:) + double precision,allocatable :: XmY_sc(:,:) + + integer :: nS_ab,nS_ba,nS_sf + double precision,allocatable :: Omega_sf(:) + double precision,allocatable :: XpY_sf(:,:) + double precision,allocatable :: XmY_sf(:,:) + + double precision :: rho_sc,rho_sf + double precision :: EcRPA(nspin) + double precision :: EcAC(nspin) + +! Hello world + + write(*,*) + write(*,*)'**************************************************************' + write(*,*)'| Unrestricted direct random phase approximation calculation |' + write(*,*)'**************************************************************' + write(*,*) + +! Initialization + + EcRPA(:) = 0d0 + EcAC(:) = 0d0 + +! Spin-conserved transitions + + if(spin_conserved) then + + ispin = 1 + + ! Memory allocation + + nS_aa = nS(1) + nS_bb = nS(2) + nS_sc = nS_aa + nS_bb + + allocate(Omega_sc(nS_sc),XpY_sc(nS_sc,nS_sc),XmY_sc(nS_sc,nS_sc)) + + call unrestricted_linear_response(ispin,.true.,.false.,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,1d0,e, & + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,rho_sc,EcRPA(ispin),Omega_sc,XpY_sc,XmY_sc) + call print_excitation('URPA ',5,nS_sc,Omega_sc) +! call print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + + + endif + +! Spin-flip transitions + + if(spin_flip) then + + ispin = 2 + + ! Memory allocation + + nS_ab = (nO(1) - nC(1))*(nV(2) - nR(2)) + nS_ba = (nO(2) - nC(2))*(nV(1) - nR(1)) + nS_sf = nS_ab + nS_ba + + allocate(Omega_sf(nS_sf),XpY_sf(nS_sf,nS_sf),XmY_sf(nS_sf,nS_sf)) + + call unrestricted_linear_response(ispin,.true.,.false.,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sf,1d0,e, & + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,rho_sf,EcRPA(ispin),Omega_sf,XpY_sf,XmY_sf) + call print_excitation('URPA ',6,nS_sf,Omega_sf) +! call print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + + + endif + +! if(exchange_kernel) then + +! EcRPA(1) = 0.5d0*EcRPA(1) +! EcRPA(2) = 1.5d0*EcRPA(2) + +! end if + + write(*,*) + write(*,*)'-------------------------------------------------------------------------------' + write(*,'(2X,A50,F20.10)') 'Tr@URPA correlation energy (spin-conserved) =',EcRPA(1) + write(*,'(2X,A50,F20.10)') 'Tr@URPA correlation energy (spin-flip) =',EcRPA(2) + write(*,'(2X,A50,F20.10)') 'Tr@URPA correlation energy =',EcRPA(1) + EcRPA(2) + write(*,'(2X,A50,F20.10)') 'Tr@URPA total energy =',ENuc + EUHF + EcRPA(1) + EcRPA(2) + write(*,*)'-------------------------------------------------------------------------------' + write(*,*) + +! Compute the correlation energy via the adiabatic connection + +! if(doACFDT) then + +! write(*,*) '-------------------------------------------------------' +! write(*,*) 'Adiabatic connection version of RPA correlation energy' +! write(*,*) '-------------------------------------------------------' +! write(*,*) + +! call ACFDT(exchange_kernel,.false.,.false.,.false.,.false.,.false.,singlet,triplet,eta, & +! nBas,nC,nO,nV,nR,nS,ERI,e,e,Omega,XpY,XmY,rho,EcAC) + +! if(exchange_kernel) then + +! EcAC(1) = 0.5d0*EcAC(1) +! EcAC(2) = 1.5d0*EcAC(2) + +! end if + +! write(*,*) +! write(*,*)'-------------------------------------------------------------------------------' +! write(*,'(2X,A50,F20.10)') 'AC@RPA correlation energy (singlet) =',EcAC(1) +! write(*,'(2X,A50,F20.10)') 'AC@RPA correlation energy (triplet) =',EcAC(2) +! write(*,'(2X,A50,F20.10)') 'AC@RPA correlation energy =',EcAC(1) + EcAC(2) +! write(*,'(2X,A50,F20.10)') 'AC@RPA total energy =',ENuc + EUHF + EcAC(1) + EcAC(2) +! write(*,*)'-------------------------------------------------------------------------------' +! write(*,*) + +! end if + +end subroutine UdRPA diff --git a/src/QuAcK/RPA.f90 b/src/QuAcK/dRPA.f90 similarity index 97% rename from src/QuAcK/RPA.f90 rename to src/QuAcK/dRPA.f90 index 32d9587..b807497 100644 --- a/src/QuAcK/RPA.f90 +++ b/src/QuAcK/dRPA.f90 @@ -1,4 +1,4 @@ -subroutine RPA(doACFDT,exchange_kernel,singlet_manifold,triplet_manifold,eta, & +subroutine dRPA(doACFDT,exchange_kernel,singlet_manifold,triplet_manifold,eta, & nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,e) ! Perform a direct random phase approximation calculation @@ -125,4 +125,4 @@ subroutine RPA(doACFDT,exchange_kernel,singlet_manifold,triplet_manifold,eta, & end if -end subroutine RPA +end subroutine dRPA From 2b1b2096c424f468638ea53f532bb6e9a1c11684 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Wed, 23 Sep 2020 14:23:40 +0200 Subject: [PATCH 07/17] graph sol for UGW --- input/methods | 4 +- input/options | 4 +- src/QuAcK/SigmaC.f90 | 26 ++---- src/QuAcK/UG0W0.f90 | 13 +-- src/QuAcK/USigmaC.f90 | 48 +++++++++++ src/QuAcK/dUSigmaC.f90 | 50 +++++++++++ src/QuAcK/unrestricted_Bethe_Salpeter.f90 | 2 + .../unrestricted_Bethe_Salpeter_A_matrix.f90 | 19 ++--- .../unrestricted_Bethe_Salpeter_B_matrix.f90 | 8 +- src/QuAcK/unrestricted_QP_graph.f90 | 83 +++++++++++++++++++ .../unrestricted_renormalization_factor.f90 | 5 +- ...estricted_self_energy_correlation_diag.f90 | 4 +- 12 files changed, 218 insertions(+), 48 deletions(-) create mode 100644 src/QuAcK/USigmaC.f90 create mode 100644 src/QuAcK/dUSigmaC.f90 create mode 100644 src/QuAcK/unrestricted_QP_graph.f90 diff --git a/input/methods b/input/methods index 022df90..ba17592 100644 --- a/input/methods +++ b/input/methods @@ -9,11 +9,11 @@ # CIS CID CISD F F F # RPA RPAx ppRPA - T F F + F F F # G0F2 evGF2 G0F3 evGF3 F F F F # G0W0 evGW qsGW - F F F + T F F # G0T0 evGT qsGT F F F # MCMP2 diff --git a/input/options b/input/options index 23ac893..d55ed53 100644 --- a/input/options +++ b/input/options @@ -5,11 +5,11 @@ # CC: maxSCF thresh DIIS n_diis 64 0.0000001 T 5 # spin: singlet triplet spin_conserved spin_flip TDA - T T T T F + T T T F F # 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 - 256 0.00001 T 5 T 0.001 F F F F F + 256 0.00001 T 5 F 0.0 F F F F F # ACFDT: AC Kx XBS F F T # BSE: BSE dBSE dTDA evDyn diff --git a/src/QuAcK/SigmaC.f90 b/src/QuAcK/SigmaC.f90 index 32a07ca..10eddc2 100644 --- a/src/QuAcK/SigmaC.f90 +++ b/src/QuAcK/SigmaC.f90 @@ -1,4 +1,4 @@ -double precision function SigmaC(x,w,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho) +double precision function SigmaC(p,w,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho) ! Compute diagonal of the correlation part of the self-energy @@ -7,7 +7,7 @@ double precision function SigmaC(x,w,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho) ! Input variables - integer,intent(in) :: x + integer,intent(in) :: p double precision,intent(in) :: w double precision,intent(in) :: eta integer,intent(in) :: nBas @@ -22,7 +22,7 @@ double precision function SigmaC(x,w,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho) ! Local variables - integer :: i,j,a,b,p,jb + integer :: i,a,jb double precision :: eps ! Initialize @@ -32,26 +32,18 @@ double precision function SigmaC(x,w,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho) ! Occupied part of the correlation self-energy do i=nC+1,nO - jb = 0 - do j=nC+1,nO - do b=nO+1,nBas-nR - jb = jb + 1 - eps = w - e(i) + Omega(jb) - SigmaC = SigmaC + 2d0*rho(x,i,jb)**2*eps/(eps**2 + eta**2) - enddo + do jb=1,nS + eps = w - e(i) + Omega(jb) + SigmaC = SigmaC + 2d0*rho(p,i,jb)**2*eps/(eps**2 + eta**2) enddo enddo ! Virtual part of the correlation self-energy do a=nO+1,nBas-nR - jb = 0 - do j=nC+1,nO - do b=nO+1,nBas-nR - jb = jb + 1 - eps = w - e(a) - Omega(jb) - SigmaC = SigmaC + 2d0*rho(x,a,jb)**2*eps/(eps**2 + eta**2) - enddo + do jb=1,nS + eps = w - e(a) - Omega(jb) + SigmaC = SigmaC + 2d0*rho(p,a,jb)**2*eps/(eps**2 + eta**2) enddo enddo diff --git a/src/QuAcK/UG0W0.f90 b/src/QuAcK/UG0W0.f90 index 453f326..ac808cd 100644 --- a/src/QuAcK/UG0W0.f90 +++ b/src/QuAcK/UG0W0.f90 @@ -45,6 +45,7 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev ! Local variables logical :: print_W = .true. + integer :: is integer :: ispin double precision :: EcRPA(nspin) double precision :: EcBSE(nspin) @@ -126,13 +127,13 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev ! Compute self-energy ! !---------------------! - call unrestricted_self_energy_correlation_diag(eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,eHF,Omega_sc,rho_sc,SigC) + call unrestricted_self_energy_correlation_diag(eta,nBas,nC,nO,nV,nR,nS_sc,eHF,Omega_sc,rho_sc,SigC) !--------------------------------! ! Compute renormalization factor ! !--------------------------------! - call unrestricted_renormalization_factor(eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,eHF,Omega_sc,rho_sc,Z) + call unrestricted_renormalization_factor(eta,nBas,nC,nO,nV,nR,nS_sc,eHF,Omega_sc,rho_sc,Z) !-----------------------------------! ! Solve the quasi-particle equation ! @@ -151,10 +152,10 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev ! Find graphical solution of the QP equation -! do is=1,nspin -! call QP_graph(nBas,nC(:,is),nO(:,is),nV(:,is),nR(:,is),nS(:,is),eta,eHF(:,is),Omega(:,is), & -! rho(:,:,:,ispin),eGWlin(:,is),eGW(:,is)) -! end do + do is=1,nspin + call unrestricted_QP_graph(nBas,nC(is),nO(is),nV(is),nR(is),nS_sc,eta,eHF(:,is),Omega_sc, & + rho_sc,eGWlin(:,is),eGW(:,is)) + end do end if diff --git a/src/QuAcK/USigmaC.f90 b/src/QuAcK/USigmaC.f90 new file mode 100644 index 0000000..d701cd7 --- /dev/null +++ b/src/QuAcK/USigmaC.f90 @@ -0,0 +1,48 @@ +double precision function USigmaC(p,w,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho) + +! Compute diagonal of the correlation part of the self-energy + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: p + double precision,intent(in) :: w + 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) :: e(nBas) + double precision,intent(in) :: Omega(nS) + double precision,intent(in) :: rho(nBas,nBas,nS,nspin) + +! Local variables + + integer :: i,a,jb + double precision :: eps + +! Initialize + + USigmaC = 0d0 + +! Occupied part of the correlation self-energy + + do i=nC+1,nO + do jb=1,nS + eps = w - e(i) + Omega(jb) + USigmaC = uSigmaC + rho(p,i,jb,1)**2*eps/(eps**2 + eta**2) + end do + end do + + do a=nO+1,nBas-nR + do jb=1,nS + eps = w - e(a) - Omega(jb) + USigmaC = USigmaC + rho(p,a,jb,1)**2*eps/(eps**2 + eta**2) + end do + end do + +end function USigmaC diff --git a/src/QuAcK/dUSigmaC.f90 b/src/QuAcK/dUSigmaC.f90 new file mode 100644 index 0000000..cbd0cdb --- /dev/null +++ b/src/QuAcK/dUSigmaC.f90 @@ -0,0 +1,50 @@ +double precision function dUSigmaC(p,w,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho) + +! Compute the derivative of the correlation part of the self-energy + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: p + double precision,intent(in) :: w + 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) :: e(nBas) + double precision,intent(in) :: Omega(nS) + double precision,intent(in) :: rho(nBas,nBas,nS,nspin) + +! Local variables + + integer :: i,a,jb + double precision :: eps + +! Initialize + + dUSigmaC = 0d0 + +! Occupied part of the correlation self-energy + + do i=nC+1,nO + do jb=1,nS + eps = w - e(i) + Omega(jb) + dUSigmaC = dUSigmaC + rho(p,i,jb,1)**2*(eps/(eps**2 + eta**2))**2 + end do + end do + +! Virtual part of the correlation self-energy + + do a=nO+1,nBas-nR + do jb=1,nS + eps = w - e(a) - Omega(jb) + dUSigmaC = dUSigmaC + rho(p,a,jb,1)**2*(eps/(eps**2 + eta**2))**2 + end do + end do + +end function dUSigmaC diff --git a/src/QuAcK/unrestricted_Bethe_Salpeter.f90 b/src/QuAcK/unrestricted_Bethe_Salpeter.f90 index 38b36ee..42e7d6d 100644 --- a/src/QuAcK/unrestricted_Bethe_Salpeter.f90 +++ b/src/QuAcK/unrestricted_Bethe_Salpeter.f90 @@ -76,6 +76,8 @@ subroutine unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved, eW,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,rho_RPA_sc,EcRPA(ispin), & OmRPA_sc,XpY_RPA_sc,XmY_RPA_sc) +! call print_excitation('RPA@UG0W0',5,nS_sc,OmRPA_sc) + call unrestricted_excitation_density(nBas,nC,nO,nR,nS_aa,nS_bb,nS_sc,ERI_aaaa,ERI_aabb,ERI_bbbb, & XpY_RPA_sc,rho_RPA_sc) diff --git a/src/QuAcK/unrestricted_Bethe_Salpeter_A_matrix.f90 b/src/QuAcK/unrestricted_Bethe_Salpeter_A_matrix.f90 index e3f5813..175704a 100644 --- a/src/QuAcK/unrestricted_Bethe_Salpeter_A_matrix.f90 +++ b/src/QuAcK/unrestricted_Bethe_Salpeter_A_matrix.f90 @@ -1,6 +1,5 @@ subroutine unrestricted_Bethe_Salpeter_A_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda, & - ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab, & - Omega,rho,A_lr) + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega,rho,A_lr) ! Compute the extra term for Bethe-Salpeter equation for linear response in the unrestricted formalism @@ -40,7 +39,7 @@ subroutine unrestricted_Bethe_Salpeter_A_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt ! Build part A of the BSE matrix ! !--------------------------------! - ! alpha-alpha block + ! aaaa block ia = 0 do i=nC(1)+1,nO(1) @@ -55,7 +54,7 @@ subroutine unrestricted_Bethe_Salpeter_A_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt do kc=1,nSt eps = Omega(kc)**2 + eta**2 chi = chi + rho(i,j,kc,1)*rho(a,b,kc,1)*Omega(kc)/eps & - + rho(i,j,kc,2)*rho(a,b,kc,2)*Omega(kc)/eps + + rho(i,j,kc,1)*rho(a,b,kc,1)*Omega(kc)/eps enddo A_lr(ia,jb) = A_lr(ia,jb) - lambda*ERI_aaaa(i,b,j,a) + 2d0*lambda*chi @@ -65,7 +64,7 @@ subroutine unrestricted_Bethe_Salpeter_A_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt enddo enddo - ! alpha-beta block + ! aabb block ia = 0 do i=nC(1)+1,nO(1) @@ -90,7 +89,7 @@ subroutine unrestricted_Bethe_Salpeter_A_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt enddo enddo - ! beta-alpha block + ! bbaa block ia = 0 do i=nC(2)+1,nO(2) @@ -104,8 +103,8 @@ subroutine unrestricted_Bethe_Salpeter_A_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt chi = 0d0 do kc=1,nSt eps = Omega(kc)**2 + eta**2 - chi = chi + rho(i,j,kc,1)*rho(a,b,kc,1)*Omega(kc)/eps & - + rho(i,j,kc,2)*rho(a,b,kc,2)*Omega(kc)/eps + chi = chi + rho(i,j,kc,2)*rho(a,b,kc,2)*Omega(kc)/eps & + + rho(i,j,kc,1)*rho(a,b,kc,1)*Omega(kc)/eps enddo A_lr(nSa+ia,jb) = A_lr(nSa+ia,jb) - lambda*ERI_aabb(b,i,a,j) + 2d0*lambda*chi @@ -115,7 +114,7 @@ subroutine unrestricted_Bethe_Salpeter_A_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt enddo enddo - ! beta-beta block + ! bbbb block ia = 0 do i=nC(2)+1,nO(2) @@ -129,7 +128,7 @@ subroutine unrestricted_Bethe_Salpeter_A_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt chi = 0d0 do kc=1,nSt eps = Omega(kc)**2 + eta**2 - chi = chi + rho(i,j,kc,1)*rho(a,b,kc,1)*Omega(kc)/eps & + chi = chi + rho(i,j,kc,2)*rho(a,b,kc,2)*Omega(kc)/eps & + rho(i,j,kc,2)*rho(a,b,kc,2)*Omega(kc)/eps enddo diff --git a/src/QuAcK/unrestricted_Bethe_Salpeter_B_matrix.f90 b/src/QuAcK/unrestricted_Bethe_Salpeter_B_matrix.f90 index 250978d..20dd14e 100644 --- a/src/QuAcK/unrestricted_Bethe_Salpeter_B_matrix.f90 +++ b/src/QuAcK/unrestricted_Bethe_Salpeter_B_matrix.f90 @@ -51,7 +51,7 @@ subroutine unrestricted_Bethe_Salpeter_B_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt do kc=1,nSt eps = Omega(kc)**2 + eta**2 chi = chi + rho(i,b,kc,1)*rho(a,j,kc,1)*Omega(kc)/eps & - + rho(i,b,kc,2)*rho(a,j,kc,2)*Omega(kc)/eps + + rho(i,b,kc,1)*rho(a,j,kc,1)*Omega(kc)/eps enddo B_lr(ia,jb) = B_lr(ia,jb) - lambda*ERI_aaaa(i,j,b,a) + 2d0*lambda*chi @@ -100,8 +100,8 @@ subroutine unrestricted_Bethe_Salpeter_B_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt chi = 0d0 do kc=1,nSt eps = Omega(kc)**2 + eta**2 - chi = chi + rho(i,b,kc,1)*rho(a,j,kc,1)*Omega(kc)/eps & - + rho(i,b,kc,2)*rho(a,j,kc,2)*Omega(kc)/eps + chi = chi + rho(i,b,kc,2)*rho(a,j,kc,2)*Omega(kc)/eps & + + rho(i,b,kc,1)*rho(a,j,kc,1)*Omega(kc)/eps enddo B_lr(nSa+ia,jb) = B_lr(nSa+ia,jb) - lambda*ERI_aabb(j,i,a,b) + 2d0*lambda*chi @@ -125,7 +125,7 @@ subroutine unrestricted_Bethe_Salpeter_B_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt chi = 0d0 do kc=1,nSt eps = Omega(kc)**2 + eta**2 - chi = chi + rho(i,b,kc,1)*rho(a,j,kc,1)*Omega(kc)/eps & + chi = chi + rho(i,b,kc,2)*rho(a,j,kc,2)*Omega(kc)/eps & + rho(i,b,kc,2)*rho(a,j,kc,2)*Omega(kc)/eps enddo diff --git a/src/QuAcK/unrestricted_QP_graph.f90 b/src/QuAcK/unrestricted_QP_graph.f90 new file mode 100644 index 0000000..96585a9 --- /dev/null +++ b/src/QuAcK/unrestricted_QP_graph.f90 @@ -0,0 +1,83 @@ +subroutine unrestricted_QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,Omega,rho,eGWlin,eGW) + +! Compute the graphical solution of the QP equation + + implicit none + include 'parameters.h' + +! Input variables + + 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) :: eta + double precision,intent(in) :: eHF(nBas) + double precision,intent(in) :: Omega(nS) + double precision,intent(in) :: rho(nBas,nBas,nS,nspin) + + double precision,intent(in) :: eGWlin(nBas) + +! Local variables + + integer :: p + integer :: nIt + integer,parameter :: maxIt = 10 + double precision,parameter :: thresh = 1d-6 + double precision,external :: USigmaC,dUSigmaC + double precision :: sig,dsig + double precision :: f,df + double precision :: w + +! Output variables + + double precision,intent(out) :: eGW(nBas) + +! Run Newton's algorithm to find the root + + do p=nC+1,nBas-nR + + write(*,*) '-----------------' + write(*,'(A10,I3)') 'Orbital ',p + write(*,*) '-----------------' + + w = eGWlin(p) + nIt = 0 + f = 1d0 + write(*,'(A3,I3,A1,1X,3F15.9)') 'It.',nIt,':',w*HaToeV,f + + do while (abs(f) > thresh .and. nIt < maxIt) + + nIt = nIt + 1 + + sig = USigmaC(p,w,eta,nBas,nC,nO,nV,nR,nS,eHF,Omega,rho) + dsig = dUSigmaC(p,w,eta,nBas,nC,nO,nV,nR,nS,eHF,Omega,rho) + f = w - eHF(p) - sig + df = 1d0 - dsig + + w = w - f/df + + write(*,'(A3,I3,A1,1X,3F15.9)') 'It.',nIt,':',w*HaToeV,f,sig + + + end do + + if(nIt == maxIt) then + + write(*,*) 'Newton root search has not converged!' + eGW(p) = eGWlin(p) + + else + + eGW(p) = w + + write(*,'(A32,F16.10)') 'Quasiparticle energy (eV) ',eGW(p)*HaToeV + write(*,*) + + end if + + end do + +end subroutine unrestricted_QP_graph diff --git a/src/QuAcK/unrestricted_renormalization_factor.f90 b/src/QuAcK/unrestricted_renormalization_factor.f90 index 403060d..f175d93 100644 --- a/src/QuAcK/unrestricted_renormalization_factor.f90 +++ b/src/QuAcK/unrestricted_renormalization_factor.f90 @@ -1,4 +1,4 @@ -subroutine unrestricted_renormalization_factor(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,e,Omega,rho,Z) +subroutine unrestricted_renormalization_factor(eta,nBas,nC,nO,nV,nR,nSt,e,Omega,rho,Z) ! Compute the renormalization factor in the unrestricted formalism @@ -13,8 +13,6 @@ subroutine unrestricted_renormalization_factor(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt, integer,intent(in) :: nO(nspin) integer,intent(in) :: nV(nspin) integer,intent(in) :: nR(nspin) - integer,intent(in) :: nSa - integer,intent(in) :: nSb integer,intent(in) :: nSt double precision,intent(in) :: e(nBas,nspin) double precision,intent(in) :: Omega(nSt) @@ -89,5 +87,4 @@ subroutine unrestricted_renormalization_factor(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt, Z(:,:) = 1d0/(1d0 + Z(:,:)) - end subroutine unrestricted_renormalization_factor diff --git a/src/QuAcK/unrestricted_self_energy_correlation_diag.f90 b/src/QuAcK/unrestricted_self_energy_correlation_diag.f90 index 123ec23..fa4084c 100644 --- a/src/QuAcK/unrestricted_self_energy_correlation_diag.f90 +++ b/src/QuAcK/unrestricted_self_energy_correlation_diag.f90 @@ -1,4 +1,4 @@ -subroutine unrestricted_self_energy_correlation_diag(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,e,Omega,rho,SigC) +subroutine unrestricted_self_energy_correlation_diag(eta,nBas,nC,nO,nV,nR,nSt,e,Omega,rho,SigC) ! Compute diagonal of the correlation part of the self-energy @@ -13,8 +13,6 @@ subroutine unrestricted_self_energy_correlation_diag(eta,nBas,nC,nO,nV,nR,nSa,nS integer,intent(in) :: nO(nspin) integer,intent(in) :: nV(nspin) integer,intent(in) :: nR(nspin) - integer,intent(in) :: nSa - integer,intent(in) :: nSb integer,intent(in) :: nSt double precision,intent(in) :: e(nBas,nspin) double precision,intent(in) :: Omega(nSt) From 08f3567d205d0935955e00bb937e26755e8d3682 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Wed, 23 Sep 2020 22:48:54 +0200 Subject: [PATCH 08/17] sf-BSE --- input/options | 4 +- src/QuAcK/UG0W0.f90 | 8 +- src/QuAcK/UHF.f90 | 3 +- src/QuAcK/URPAx.f90 | 8 +- src/QuAcK/UdRPA.f90 | 8 +- src/QuAcK/unrestricted_Bethe_Salpeter.f90 | 82 ++++---- .../unrestricted_Bethe_Salpeter_A_matrix.f90 | 180 +++++++++-------- .../unrestricted_Bethe_Salpeter_B_matrix.f90 | 185 ++++++++++-------- src/QuAcK/unrestricted_linear_response.f90 | 17 +- .../unrestricted_linear_response_A_matrix.f90 | 4 +- .../unrestricted_linear_response_B_matrix.f90 | 14 +- 11 files changed, 275 insertions(+), 238 deletions(-) diff --git a/input/options b/input/options index d55ed53..337b5e1 100644 --- a/input/options +++ b/input/options @@ -5,11 +5,11 @@ # CC: maxSCF thresh DIIS n_diis 64 0.0000001 T 5 # spin: singlet triplet spin_conserved spin_flip TDA - T T T F F + T T T T F # 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 - 256 0.00001 T 5 F 0.0 F F F F F + 256 0.00001 T 5 T 0.0 F F F F F # ACFDT: AC Kx XBS F F T # BSE: BSE dBSE dTDA evDyn diff --git a/src/QuAcK/UG0W0.f90 b/src/QuAcK/UG0W0.f90 index ac808cd..10b2b58 100644 --- a/src/QuAcK/UG0W0.f90 +++ b/src/QuAcK/UG0W0.f90 @@ -112,8 +112,8 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev ispin = 1 - call unrestricted_linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,1d0, & - eHF,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,rho_sc,EcRPA(ispin),Omega_sc,XpY_sc,XmY_sc) + call unrestricted_linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0, & + eHF,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega_sc,rho_sc,EcRPA(ispin),Omega_sc,XpY_sc,XmY_sc) if(print_W) call print_excitation('RPA@UHF',5,nS_sc,Omega_sc) @@ -165,8 +165,8 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev ! Compute the RPA correlation energy - call unrestricted_linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,1d0, & - eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,rho_sc,EcRPA(ispin),Omega_sc,XpY_sc,XmY_sc) + call unrestricted_linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0, & + eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega_sc,rho_sc,EcRPA(ispin),Omega_sc,XpY_sc,XmY_sc) write(*,*) write(*,*)'-------------------------------------------------------------------------------' diff --git a/src/QuAcK/UHF.f90 b/src/QuAcK/UHF.f90 index 28fc3c8..8559d03 100644 --- a/src/QuAcK/UHF.f90 +++ b/src/QuAcK/UHF.f90 @@ -232,6 +232,7 @@ subroutine UHF(maxSCF,thresh,max_diis,guess_type,nBas,nO,S,T,V,Hc,ERI,X,ENuc,EUH ! Compute final UHF energy - call print_UHF(nBas,nO(:),e(:,:),c(:,:,:),ENuc,ET(:),EV(:),EJ(:),Ex(:),EUHF) + call matout(nBas,2,e) + call print_UHF(nBas,nO,e,c,ENuc,ET,EV,EJ,Ex,EUHF) end subroutine UHF diff --git a/src/QuAcK/URPAx.f90 b/src/QuAcK/URPAx.f90 index 4ae48cc..149c62d 100644 --- a/src/QuAcK/URPAx.f90 +++ b/src/QuAcK/URPAx.f90 @@ -73,8 +73,8 @@ subroutine URPAx(doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,nC,nO allocate(Omega_sc(nS_sc),XpY_sc(nS_sc,nS_sc),XmY_sc(nS_sc,nS_sc)) - call unrestricted_linear_response(ispin,.false.,.false.,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,1d0,e, & - ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,rho_sc,EcRPAx(ispin),Omega_sc,XpY_sc,XmY_sc) + call unrestricted_linear_response(ispin,.false.,.false.,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0,e, & + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega_sc,rho_sc,EcRPAx(ispin),Omega_sc,XpY_sc,XmY_sc) call print_excitation('URPAx ',5,nS_sc,Omega_sc) ! call print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) @@ -95,8 +95,8 @@ subroutine URPAx(doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,nC,nO allocate(Omega_sf(nS_sf),XpY_sf(nS_sf,nS_sf),XmY_sf(nS_sf,nS_sf)) - call unrestricted_linear_response(ispin,.false.,.false.,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sf,1d0,e, & - ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,rho_sf,EcRPAx(ispin),Omega_sf,XpY_sf,XmY_sf) + call unrestricted_linear_response(ispin,.false.,.false.,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sf,nS_sf,1d0,e, & + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega_sf,rho_sf,EcRPAx(ispin),Omega_sf,XpY_sf,XmY_sf) call print_excitation('URPAx ',6,nS_sf,Omega_sf) ! call print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) diff --git a/src/QuAcK/UdRPA.f90 b/src/QuAcK/UdRPA.f90 index da3d019..9fff2be 100644 --- a/src/QuAcK/UdRPA.f90 +++ b/src/QuAcK/UdRPA.f90 @@ -73,8 +73,8 @@ subroutine UdRPA(doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,nC,nO allocate(Omega_sc(nS_sc),XpY_sc(nS_sc,nS_sc),XmY_sc(nS_sc,nS_sc)) - call unrestricted_linear_response(ispin,.true.,.false.,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,1d0,e, & - ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,rho_sc,EcRPA(ispin),Omega_sc,XpY_sc,XmY_sc) + call unrestricted_linear_response(ispin,.true.,.false.,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0,e, & + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega_sc,rho_sc,EcRPA(ispin),Omega_sc,XpY_sc,XmY_sc) call print_excitation('URPA ',5,nS_sc,Omega_sc) ! call print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) @@ -95,8 +95,8 @@ subroutine UdRPA(doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,nC,nO allocate(Omega_sf(nS_sf),XpY_sf(nS_sf,nS_sf),XmY_sf(nS_sf,nS_sf)) - call unrestricted_linear_response(ispin,.true.,.false.,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sf,1d0,e, & - ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,rho_sf,EcRPA(ispin),Omega_sf,XpY_sf,XmY_sf) + call unrestricted_linear_response(ispin,.true.,.false.,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sf,nS_sf,1d0,e, & + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega_sf,rho_sf,EcRPA(ispin),Omega_sf,XpY_sf,XmY_sf) call print_excitation('URPA ',6,nS_sf,Omega_sf) ! call print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) diff --git a/src/QuAcK/unrestricted_Bethe_Salpeter.f90 b/src/QuAcK/unrestricted_Bethe_Salpeter.f90 index 42e7d6d..992ee9b 100644 --- a/src/QuAcK/unrestricted_Bethe_Salpeter.f90 +++ b/src/QuAcK/unrestricted_Bethe_Salpeter.f90 @@ -36,8 +36,8 @@ subroutine unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved, integer :: ispin integer :: isp_W + integer :: nS_aa,nS_bb,nS_sc - integer :: nS_ab,nS_ba,nS_sf double precision,allocatable :: OmRPA_sc(:) double precision,allocatable :: XpY_RPA_sc(:,:) double precision,allocatable :: XmY_RPA_sc(:,:) @@ -46,6 +46,11 @@ subroutine unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved, double precision,allocatable :: XpY_BSE_sc(:,:) double precision,allocatable :: XmY_BSE_sc(:,:) + integer :: nS_ab,nS_ba,nS_sf + double precision,allocatable :: OmBSE_sf(:) + double precision,allocatable :: XpY_BSE_sf(:,:) + double precision,allocatable :: XmY_BSE_sf(:,:) + ! Output variables double precision,intent(out) :: EcRPA(nspin) @@ -55,38 +60,41 @@ subroutine unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved, ! Spin-conserved excitations ! !----------------------------! - if(spin_conserved) then + isp_W = 1 + + ! Memory allocation + + nS_aa = nS(1) + nS_bb = nS(2) + nS_sc = nS_aa + nS_bb + + allocate(OmRPA_sc(nS_sc),XpY_RPA_sc(nS_sc,nS_sc),XmY_RPA_sc(nS_sc,nS_sc),rho_RPA_sc(nBas,nBas,nS_sc,nspin)) + + ! Compute spin-conserved RPA screening + + call unrestricted_linear_response(isp_W,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0, & + eW,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,OmRPA_sc,rho_RPA_sc,EcRPA(isp_W), & + OmRPA_sc,XpY_RPA_sc,XmY_RPA_sc) + +! call print_excitation('RPA@UG0W0',5,nS_sc,OmRPA_sc) + + call unrestricted_excitation_density(nBas,nC,nO,nR,nS_aa,nS_bb,nS_sc,ERI_aaaa,ERI_aabb,ERI_bbbb, & + XpY_RPA_sc,rho_RPA_sc) + + if(spin_conserved) then ispin = 1 - isp_W = 1 + EcBSE(ispin) = 0d0 - ! Memory allocation - - nS_aa = nS(1) - nS_bb = nS(2) - nS_sc = nS_aa + nS_bb - - allocate(OmRPA_sc(nS_sc),XpY_RPA_sc(nS_sc,nS_sc),XmY_RPA_sc(nS_sc,nS_sc),rho_RPA_sc(nBas,nBas,nS_sc,nspin)) allocate(OmBSE_sc(nS_sc),XpY_BSE_sc(nS_sc,nS_sc),XmY_BSE_sc(nS_sc,nS_sc)) - ! Compute spin-conserved RPA screening - - call unrestricted_linear_response(isp_W,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,1d0, & - eW,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,rho_RPA_sc,EcRPA(ispin), & - OmRPA_sc,XpY_RPA_sc,XmY_RPA_sc) - -! call print_excitation('RPA@UG0W0',5,nS_sc,OmRPA_sc) - - call unrestricted_excitation_density(nBas,nC,nO,nR,nS_aa,nS_bb,nS_sc,ERI_aaaa,ERI_aabb,ERI_bbbb, & - XpY_RPA_sc,rho_RPA_sc) - ! Compute spin-conserved BSE excitation energies OmBSE_sc(:) = OmRPA_sc(:) - call unrestricted_linear_response(ispin,.true.,TDA,.true.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,1d0, & - eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,rho_RPA_sc,EcBSE(ispin), & + call unrestricted_linear_response(ispin,.true.,TDA,.true.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0, & + eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,OmRPA_sc,rho_RPA_sc,EcBSE(ispin), & OmBSE_sc,XpY_BSE_sc,XmY_BSE_sc) call print_excitation('BSE@UG0W0',5,nS_sc,OmBSE_sc) @@ -117,25 +125,25 @@ subroutine unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved, ! Spin-flip excitations ! !-----------------------! -!if(spin_flip) then + if(spin_flip) then -! ispin = 2 -! isp_W = 1 -! EcBSE(ispin) = 0d0 + ispin = 2 -! ! Compute (singlet) RPA screening + EcBSE(ispin) = 0d0 -! call linear_response(isp_W,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eW,ERI, & -! rho_RPA(:,:,:,ispin),EcRPA(ispin),OmRPA(:,ispin),XpY_RPA(:,:,ispin),XmY_RPA(:,:,ispin)) -! call excitation_density(nBas,nC,nO,nR,nS,ERI,XpY_RPA(:,:,ispin),rho_RPA(:,:,:,ispin)) + ! Memory allocation -! ! Compute BSE excitation energies + nS_ab = (nO(1) - nC(1))*(nV(2) - nR(2)) + nS_ba = (nO(2) - nC(2))*(nV(1) - nR(1)) + nS_sf = nS_ab + nS_ba + + allocate(OmBSE_sf(nS_sf),XpY_BSE_sf(nS_sf,nS_sf),XmY_BSE_sf(nS_sf,nS_sf)) -! OmBSE(:,ispin) = OmRPA(:,ispin) + call unrestricted_linear_response(ispin,.true.,TDA,.true.,eta,nBas,nC,nO,nV,nR,nS_ab,nS_ba,nS_sf,nS_sc,1d0, & + eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,OmRPA_sc,rho_RPA_sc,EcBSE(ispin), & + OmBSE_sf,XpY_BSE_sf,XmY_BSE_sf) -! call linear_response(ispin,.true.,TDA,.true.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI, & -! rho_RPA(:,:,:,ispin),EcBSE(ispin),OmBSE(:,ispin),XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin)) -! call print_excitation('BSE ',ispin,nS,OmBSE(:,ispin)) + call print_excitation('BSE@UG0W0',6,nS_sf,OmBSE_sf) !------------------------------------------------- ! Compute the dynamical screening at the BSE level @@ -157,6 +165,6 @@ subroutine unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved, ! end if -! end if + end if end subroutine unrestricted_Bethe_Salpeter diff --git a/src/QuAcK/unrestricted_Bethe_Salpeter_A_matrix.f90 b/src/QuAcK/unrestricted_Bethe_Salpeter_A_matrix.f90 index 175704a..55d9a25 100644 --- a/src/QuAcK/unrestricted_Bethe_Salpeter_A_matrix.f90 +++ b/src/QuAcK/unrestricted_Bethe_Salpeter_A_matrix.f90 @@ -1,4 +1,4 @@ -subroutine unrestricted_Bethe_Salpeter_A_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda, & +subroutine unrestricted_Bethe_Salpeter_A_matrix(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nSsc,lambda, & ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega,rho,A_lr) ! Compute the extra term for Bethe-Salpeter equation for linear response in the unrestricted formalism @@ -8,6 +8,7 @@ subroutine unrestricted_Bethe_Salpeter_A_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt ! Input variables + integer,intent(in) :: ispin integer,intent(in) :: nBas integer,intent(in) :: nC(nspin) integer,intent(in) :: nO(nspin) @@ -16,14 +17,15 @@ subroutine unrestricted_Bethe_Salpeter_A_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt integer,intent(in) :: nSa integer,intent(in) :: nSb integer,intent(in) :: nSt + integer,intent(in) :: nSsc double precision,intent(in) :: eta double precision,intent(in) :: lambda double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_abab(nBas,nBas,nBas,nBas) - double precision,intent(in) :: Omega(nSt) - double precision,intent(in) :: rho(nBas,nBas,nSt,nspin) + double precision,intent(in) :: Omega(nSsc) + double precision,intent(in) :: rho(nBas,nBas,nSsc,nspin) ! Local variables @@ -35,108 +37,116 @@ subroutine unrestricted_Bethe_Salpeter_A_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt double precision,intent(out) :: A_lr(nSt,nSt) -!--------------------------------! -! Build part A of the BSE matrix ! -!--------------------------------! +!--------------------------------------------------! +! Build BSE matrix for spin-conserving transitions ! +!--------------------------------------------------! - ! aaaa block + if(ispin == 1) then - ia = 0 - do i=nC(1)+1,nO(1) - do a=nO(1)+1,nBas-nR(1) - ia = ia + 1 - jb = 0 - do j=nC(1)+1,nO(1) - do b=nO(1)+1,nBas-nR(1) - jb = jb + 1 + ! aaaa block + + ia = 0 + do i=nC(1)+1,nO(1) + do a=nO(1)+1,nBas-nR(1) + ia = ia + 1 + jb = 0 + do j=nC(1)+1,nO(1) + do b=nO(1)+1,nBas-nR(1) + jb = jb + 1 + + chi = 0d0 + do kc=1,nSsc + eps = Omega(kc)**2 + eta**2 + chi = chi + rho(i,j,kc,1)*rho(a,b,kc,1)*Omega(kc)/eps + enddo + + A_lr(ia,jb) = A_lr(ia,jb) - lambda*ERI_aaaa(i,b,j,a) + 4d0*lambda*chi - chi = 0d0 - do kc=1,nSt - eps = Omega(kc)**2 + eta**2 - chi = chi + rho(i,j,kc,1)*rho(a,b,kc,1)*Omega(kc)/eps & - + rho(i,j,kc,1)*rho(a,b,kc,1)*Omega(kc)/eps enddo - - A_lr(ia,jb) = A_lr(ia,jb) - lambda*ERI_aaaa(i,b,j,a) + 2d0*lambda*chi - enddo enddo enddo - enddo - ! aabb block - - ia = 0 - do i=nC(1)+1,nO(1) - do a=nO(1)+1,nBas-nR(1) - ia = ia + 1 - jb = 0 - do j=nC(2)+1,nO(2) - do b=nO(2)+1,nBas-nR(2) - jb = jb + 1 + ! bbbb block + + ia = 0 + do i=nC(2)+1,nO(2) + do a=nO(2)+1,nBas-nR(2) + ia = ia + 1 + jb = 0 + do j=nC(2)+1,nO(2) + do b=nO(2)+1,nBas-nR(2) + jb = jb + 1 + + chi = 0d0 + do kc=1,nSsc + eps = Omega(kc)**2 + eta**2 + chi = chi + rho(i,j,kc,2)*rho(a,b,kc,2)*Omega(kc)/eps + enddo + + A_lr(nSa+ia,nSa+jb) = A_lr(nSa+ia,nSa+jb) - lambda*ERI_bbbb(i,b,j,a) + 4d0*lambda*chi - chi = 0d0 - do kc=1,nSt - eps = Omega(kc)**2 + eta**2 - chi = chi + rho(i,j,kc,1)*rho(a,b,kc,1)*Omega(kc)/eps & - + rho(i,j,kc,2)*rho(a,b,kc,2)*Omega(kc)/eps enddo - - A_lr(ia,nSa+jb) = A_lr(ia,nSa+jb) - lambda*ERI_aabb(i,b,j,a) + 2d0*lambda*chi - enddo enddo enddo - enddo - ! bbaa block + end if - ia = 0 - do i=nC(2)+1,nO(2) - do a=nO(2)+1,nBas-nR(2) - ia = ia + 1 - jb = 0 - do j=nC(1)+1,nO(1) - do b=nO(1)+1,nBas-nR(1) - jb = jb + 1 - - chi = 0d0 - do kc=1,nSt - eps = Omega(kc)**2 + eta**2 - chi = chi + rho(i,j,kc,2)*rho(a,b,kc,2)*Omega(kc)/eps & - + rho(i,j,kc,1)*rho(a,b,kc,1)*Omega(kc)/eps - enddo +!--------------------------------------------! +! Build BSE matrix for spin-flip transitions ! +!--------------------------------------------! - A_lr(nSa+ia,jb) = A_lr(nSa+ia,jb) - lambda*ERI_aabb(b,i,a,j) + 2d0*lambda*chi + if(ispin == 2) then - enddo - enddo - enddo - enddo + ! abab block - ! bbbb block + ia = 0 + do i=nC(1)+1,nO(1) + do a=nO(2)+1,nBas-nR(2) + ia = ia + 1 + jb = 0 + do j=nC(1)+1,nO(1) + do b=nO(2)+1,nBas-nR(2) + jb = jb + 1 - ia = 0 - do i=nC(2)+1,nO(2) - do a=nO(2)+1,nBas-nR(2) - ia = ia + 1 - jb = 0 - do j=nC(2)+1,nO(2) - do b=nO(2)+1,nBas-nR(2) - jb = jb + 1 - - chi = 0d0 - do kc=1,nSt - eps = Omega(kc)**2 + eta**2 - chi = chi + rho(i,j,kc,2)*rho(a,b,kc,2)*Omega(kc)/eps & - + rho(i,j,kc,2)*rho(a,b,kc,2)*Omega(kc)/eps - enddo + chi = 0d0 + do kc=1,nSsc + eps = Omega(kc)**2 + eta**2 + chi = chi + rho(i,j,kc,1)*rho(a,b,kc,2)*Omega(kc)/eps + enddo - A_lr(nSa+ia,nSa+jb) = A_lr(nSa+ia,nSa+jb) - lambda*ERI_bbbb(i,b,j,a) + 2d0*lambda*chi + A_lr(ia,jb) = A_lr(ia,jb) - lambda*ERI_abab(i,b,j,a) + 4d0*lambda*chi - enddo - enddo - enddo - enddo + end do + end do + end do + end do + + ! baba block + + ia = 0 + do i=nC(2)+1,nO(2) + do a=nO(1)+1,nBas-nR(1) + ia = ia + 1 + jb = 0 + do j=nC(2)+1,nO(2) + do b=nO(1)+1,nBas-nR(1) + jb = jb + 1 + + chi = 0d0 + do kc=1,nSsc + eps = Omega(kc)**2 + eta**2 + chi = chi + rho(i,j,kc,2)*rho(a,b,kc,1)*Omega(kc)/eps + enddo + + A_lr(nSa+ia,nSa+jb) = A_lr(nSa+ia,nSa+jb) - lambda*ERI_abab(b,i,a,j) + 4d0*lambda*chi + + end do + end do + end do + end do + + end if end subroutine unrestricted_Bethe_Salpeter_A_matrix diff --git a/src/QuAcK/unrestricted_Bethe_Salpeter_B_matrix.f90 b/src/QuAcK/unrestricted_Bethe_Salpeter_B_matrix.f90 index 20dd14e..e954814 100644 --- a/src/QuAcK/unrestricted_Bethe_Salpeter_B_matrix.f90 +++ b/src/QuAcK/unrestricted_Bethe_Salpeter_B_matrix.f90 @@ -1,6 +1,5 @@ -subroutine unrestricted_Bethe_Salpeter_B_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda, & - ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab, & - Omega,rho,B_lr) +subroutine unrestricted_Bethe_Salpeter_B_matrix(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nSsc,lambda, & + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega,rho,B_lr) ! Compute the extra term for Bethe-Salpeter equation for linear response @@ -9,6 +8,7 @@ subroutine unrestricted_Bethe_Salpeter_B_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt ! Input variables + integer,intent(in) :: ispin integer,intent(in) :: nBas integer,intent(in) :: nC(nspin) integer,intent(in) :: nO(nspin) @@ -17,14 +17,15 @@ subroutine unrestricted_Bethe_Salpeter_B_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt integer,intent(in) :: nSa integer,intent(in) :: nSb integer,intent(in) :: nSt + integer,intent(in) :: nSsc double precision,intent(in) :: eta double precision,intent(in) :: lambda double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_abab(nBas,nBas,nBas,nBas) - double precision,intent(in) :: Omega(nSt) - double precision,intent(in) :: rho(nBas,nBas,nSt,nspin) + double precision,intent(in) :: Omega(nSsc) + double precision,intent(in) :: rho(nBas,nBas,nSsc,nspin) ! Local variables @@ -36,104 +37,118 @@ subroutine unrestricted_Bethe_Salpeter_B_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt double precision,intent(out) :: B_lr(nSt,nSt) - ! alpha-alpha block +!--------------------------------------------------! +! Build BSE matrix for spin-conserving transitions ! +!--------------------------------------------------! - ia = 0 - do i=nC(1)+1,nO(1) - do a=nO(1)+1,nBas-nR(1) - ia = ia + 1 - jb = 0 - do j=nC(1)+1,nO(1) - do b=nO(1)+1,nBas-nR(1) - jb = jb + 1 + if(ispin == 1) then + + ! aaaa block + + ia = 0 + do i=nC(1)+1,nO(1) + do a=nO(1)+1,nBas-nR(1) + ia = ia + 1 + jb = 0 + do j=nC(1)+1,nO(1) + do b=nO(1)+1,nBas-nR(1) + jb = jb + 1 + + chi = 0d0 + do kc=1,nSsc + eps = Omega(kc)**2 + eta**2 + chi = chi + rho(i,b,kc,1)*rho(a,j,kc,1)*Omega(kc)/eps + enddo + + B_lr(ia,jb) = B_lr(ia,jb) - lambda*ERI_aaaa(i,j,b,a) + 4d0*lambda*chi - chi = 0d0 - do kc=1,nSt - eps = Omega(kc)**2 + eta**2 - chi = chi + rho(i,b,kc,1)*rho(a,j,kc,1)*Omega(kc)/eps & - + rho(i,b,kc,1)*rho(a,j,kc,1)*Omega(kc)/eps enddo - - B_lr(ia,jb) = B_lr(ia,jb) - lambda*ERI_aaaa(i,j,b,a) + 2d0*lambda*chi - enddo enddo enddo - enddo - - ! alpha-beta block - - ia = 0 - do i=nC(1)+1,nO(1) - do a=nO(1)+1,nBas-nR(1) - ia = ia + 1 - jb = 0 - do j=nC(2)+1,nO(2) - do b=nO(2)+1,nBas-nR(2) - jb = jb + 1 - chi = 0d0 - do kc=1,nSt - eps = Omega(kc)**2 + eta**2 - chi = chi + rho(i,b,kc,1)*rho(a,j,kc,1)*Omega(kc)/eps & - + rho(i,b,kc,2)*rho(a,j,kc,2)*Omega(kc)/eps + + ! bbbb block + + ia = 0 + do i=nC(2)+1,nO(2) + do a=nO(2)+1,nBas-nR(2) + ia = ia + 1 + jb = 0 + do j=nC(2)+1,nO(2) + do b=nO(2)+1,nBas-nR(2) + jb = jb + 1 + + chi = 0d0 + do kc=1,nSsc + eps = Omega(kc)**2 + eta**2 + chi = chi + rho(i,b,kc,2)*rho(a,j,kc,2)*Omega(kc)/eps + enddo + + B_lr(nSa+ia,nSa+jb) = B_lr(nSa+ia,nSa+jb) - lambda*ERI_bbbb(i,j,b,a) + 4d0*lambda*chi + enddo - - B_lr(ia,nSa+jb) = B_lr(ia,nSa+jb) - lambda*ERI_aabb(i,j,b,a) + 2d0*lambda*chi - enddo enddo enddo - enddo - ! beta-alpha block + end if - ia = 0 - do i=nC(2)+1,nO(2) - do a=nO(2)+1,nBas-nR(2) - ia = ia + 1 - jb = 0 - do j=nC(1)+1,nO(1) - do b=nO(1)+1,nBas-nR(1) - jb = jb + 1 - - chi = 0d0 - do kc=1,nSt - eps = Omega(kc)**2 + eta**2 - chi = chi + rho(i,b,kc,2)*rho(a,j,kc,2)*Omega(kc)/eps & - + rho(i,b,kc,1)*rho(a,j,kc,1)*Omega(kc)/eps - enddo - B_lr(nSa+ia,jb) = B_lr(nSa+ia,jb) - lambda*ERI_aabb(j,i,a,b) + 2d0*lambda*chi +!--------------------------------------------! +! Build BSE matrix for spin-flip transitions ! +!--------------------------------------------! - enddo - enddo - enddo - enddo + if(ispin == 2) then - ! beta-beta block + ! abba block - ia = 0 - do i=nC(2)+1,nO(2) - do a=nO(2)+1,nBas-nR(2) - ia = ia + 1 - jb = 0 - do j=nC(2)+1,nO(2) - do b=nO(2)+1,nBas-nR(2) - jb = jb + 1 - - chi = 0d0 - do kc=1,nSt - eps = Omega(kc)**2 + eta**2 - chi = chi + rho(i,b,kc,2)*rho(a,j,kc,2)*Omega(kc)/eps & - + rho(i,b,kc,2)*rho(a,j,kc,2)*Omega(kc)/eps - enddo + ia = 0 + do i=nC(1)+1,nO(1) + do a=nO(2)+1,nBas-nR(2) + ia = ia + 1 + jb = 0 + do j=nC(2)+1,nO(2) + do b=nO(1)+1,nBas-nR(1) + jb = jb + 1 - B_lr(nSa+ia,nSa+jb) = B_lr(nSa+ia,nSa+jb) - lambda*ERI_bbbb(i,j,b,a) + 2d0*lambda*chi + chi = 0d0 + do kc=1,nSsc + eps = Omega(kc)**2 + eta**2 + chi = chi + rho(i,b,kc,1)*rho(a,j,kc,2)*Omega(kc)/eps + enddo - enddo - enddo - enddo - enddo + B_lr(ia,nSa+jb) = B_lr(ia,nSa+jb) - lambda*ERI_abab(i,a,b,j) + 4d0*lambda*chi + + end do + end do + end do + end do + + ! baab block + + ia = 0 + do i=nC(2)+1,nO(2) + do a=nO(1)+1,nBas-nR(1) + ia = ia + 1 + jb = 0 + do j=nC(1)+1,nO(1) + do b=nO(2)+1,nBas-nR(2) + jb = jb + 1 + + chi = 0d0 + do kc=1,nSsc + eps = Omega(kc)**2 + eta**2 + chi = chi + rho(i,b,kc,2)*rho(a,j,kc,1)*Omega(kc)/eps + enddo + + B_lr(nSa+ia,jb) = B_lr(nSa+ia,jb) - lambda*ERI_abab(b,j,i,a) + 4d0*lambda*chi + + end do + end do + end do + end do + + end if end subroutine unrestricted_Bethe_Salpeter_B_matrix diff --git a/src/QuAcK/unrestricted_linear_response.f90 b/src/QuAcK/unrestricted_linear_response.f90 index 29a6dfe..b61cb38 100644 --- a/src/QuAcK/unrestricted_linear_response.f90 +++ b/src/QuAcK/unrestricted_linear_response.f90 @@ -1,5 +1,5 @@ -subroutine unrestricted_linear_response(ispin,dRPA,TDA,BSE,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda, & - e,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,rho,EcRPA,Omega,XpY,XmY) +subroutine unrestricted_linear_response(ispin,dRPA,TDA,BSE,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nSsc,lambda, & + e,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega_RPA,rho_RPA,EcRPA,Omega,XpY,XmY) ! Compute linear response for unrestricted formalism @@ -21,13 +21,16 @@ subroutine unrestricted_linear_response(ispin,dRPA,TDA,BSE,eta,nBas,nC,nO,nV,nR, integer,intent(in) :: nSa integer,intent(in) :: nSb integer,intent(in) :: nSt + integer,intent(in) :: nSsc double precision,intent(in) :: lambda double precision,intent(in) :: e(nBas,nspin) - double precision,intent(in) :: rho(nBas,nBas,nSt,nspin) double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_abab(nBas,nBas,nBas,nBas) + + double precision,intent(in) :: Omega_RPA(nSsc) + double precision,intent(in) :: rho_RPA(nBas,nBas,nSsc,nspin) ! Local variables @@ -58,8 +61,8 @@ subroutine unrestricted_linear_response(ispin,dRPA,TDA,BSE,eta,nBas,nC,nO,nV,nR, ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,A) if(BSE) & - call unrestricted_Bethe_Salpeter_A_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda, & - ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega,rho,A) + call unrestricted_Bethe_Salpeter_A_matrix(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nSsc,lambda, & + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega_RPA,rho_RPA,A) ! Tamm-Dancoff approximation @@ -70,8 +73,8 @@ subroutine unrestricted_linear_response(ispin,dRPA,TDA,BSE,eta,nBas,nC,nO,nV,nR, ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,B) if(BSE) & - call unrestricted_Bethe_Salpeter_B_matrix(eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,lambda, & - ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega,rho,B) + call unrestricted_Bethe_Salpeter_B_matrix(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nSsc,lambda, & + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega_RPA,rho_RPA,B) end if diff --git a/src/QuAcK/unrestricted_linear_response_A_matrix.f90 b/src/QuAcK/unrestricted_linear_response_A_matrix.f90 index ded4c78..6c282e5 100644 --- a/src/QuAcK/unrestricted_linear_response_A_matrix.f90 +++ b/src/QuAcK/unrestricted_linear_response_A_matrix.f90 @@ -143,7 +143,7 @@ subroutine unrestricted_linear_response_A_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa jb = jb + 1 A_lr(ia,jb) = (e(a,2) - e(i,1))*Kronecker_delta(i,j)*Kronecker_delta(a,b) & - + lambda*ERI_abab(i,b,a,j) - (1d0 - delta_dRPA)*lambda*ERI_abab(i,b,j,a) + - (1d0 - delta_dRPA)*lambda*ERI_abab(i,b,j,a) end do end do @@ -162,7 +162,7 @@ subroutine unrestricted_linear_response_A_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa jb = jb + 1 A_lr(nSa+ia,nSa+jb) = (e(a,1) - e(i,2))*Kronecker_delta(i,j)*Kronecker_delta(a,b) & - + lambda*ERI_abab(b,i,j,a) - (1d0 - delta_dRPA)*lambda*ERI_abab(b,i,a,j) + - (1d0 - delta_dRPA)*lambda*ERI_abab(b,i,a,j) end do end do diff --git a/src/QuAcK/unrestricted_linear_response_B_matrix.f90 b/src/QuAcK/unrestricted_linear_response_B_matrix.f90 index 5ac615d..5cf001c 100644 --- a/src/QuAcK/unrestricted_linear_response_B_matrix.f90 +++ b/src/QuAcK/unrestricted_linear_response_B_matrix.f90 @@ -128,7 +128,7 @@ subroutine unrestricted_linear_response_B_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa B_lr(:,:) = 0d0 - ! abab block + ! abba block ia = 0 do i=nC(1)+1,nO(1) @@ -136,28 +136,28 @@ subroutine unrestricted_linear_response_B_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa ia = ia + 1 jb = 0 do j=nC(2)+1,nO(2) - do b=nO(2)+1,nBas-nR(2) + do b=nO(1)+1,nBas-nR(1) jb = jb + 1 - B_lr(ia,jb) = lambda*ERI_abab(i,j,a,b) - (1d0 - delta_dRPA)*lambda*ERI_abab(i,j,b,a) + B_lr(ia,nSa+jb) = - (1d0 - delta_dRPA)*lambda*ERI_abab(i,a,b,j) end do end do end do end do - ! bbbb block + ! baab block ia = 0 do i=nC(2)+1,nO(2) do a=nO(1)+1,nBas-nR(1) ia = ia + 1 jb = 0 - do j=nC(2)+1,nO(2) - do b=nO(1)+1,nBas-nR(1) + do j=nC(1)+1,nO(1) + do b=nO(2)+1,nBas-nR(2) jb = jb + 1 - B_lr(nSa+ia,nSa+jb) = lambda*ERI_abab(j,i,b,a) - (1d0 - delta_dRPA)*lambda*ERI_abab(j,i,a,b) + B_lr(nSa+ia,jb) = - (1d0 - delta_dRPA)*lambda*ERI_abab(b,j,i,a) end do end do From 8910ead99fd8a7c128869c60186ce58570b26b5e Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Thu, 24 Sep 2020 11:56:06 +0200 Subject: [PATCH 09/17] big cleaning --- examples/molecule.H2 | 2 +- input/basis | 55 ++++---- input/methods | 4 +- input/molecule | 4 +- input/molecule.xyz | 2 +- input/options | 2 +- src/QuAcK/ACFDT.f90 | 67 ++++++---- src/QuAcK/BSE2.f90 | 4 +- src/QuAcK/Bethe_Salpeter.f90 | 82 ++++++------ .../Bethe_Salpeter_AB_matrix_dynamic.f90 | 25 ++-- src/QuAcK/Bethe_Salpeter_A_matrix_dynamic.f90 | 10 +- src/QuAcK/Bethe_Salpeter_B_matrix.f90 | 10 +- .../Bethe_Salpeter_ZAB_matrix_dynamic.f90 | 20 +-- .../Bethe_Salpeter_ZA_matrix_dynamic.f90 | 8 +- .../Bethe_Salpeter_dynamic_perturbation.f90 | 12 +- ...alpeter_dynamic_perturbation_iterative.f90 | 11 +- src/QuAcK/G0W0.f90 | 123 +++++++++--------- src/QuAcK/RPAx.f90 | 22 +--- src/QuAcK/dRPA.f90 | 34 ++--- src/QuAcK/evGW.f90 | 119 +++++++++-------- src/QuAcK/linear_response.f90 | 10 +- src/QuAcK/plot_GW.f90 | 4 +- src/QuAcK/print_G0W0.f90 | 4 +- src/QuAcK/print_evGW.f90 | 26 ++-- src/QuAcK/print_excitation.f90 | 2 +- src/QuAcK/print_qsGW.f90 | 5 +- src/QuAcK/qsGW.f90 | 91 +++++++------ src/QuAcK/renormalization_factor.f90 | 38 +----- src/QuAcK/self_energy_correlation.f90 | 42 ++---- src/QuAcK/self_energy_correlation_diag.f90 | 43 +----- 30 files changed, 402 insertions(+), 479 deletions(-) diff --git a/examples/molecule.H2 b/examples/molecule.H2 index 81c624a..779d849 100644 --- a/examples/molecule.H2 +++ b/examples/molecule.H2 @@ -2,4 +2,4 @@ 2 1 1 0 0 # Znuc x y z H 0. 0. 0. - H 0. 0. 1.4 + H 0. 0. 1.399 diff --git a/input/basis b/input/basis index b2b2293..6f3d2a9 100644 --- a/input/basis +++ b/input/basis @@ -1,30 +1,39 @@ -1 6 +1 10 S 8 - 1 1469.0000000 0.0007660 - 2 220.5000000 0.0058920 - 3 50.2600000 0.0296710 - 4 14.2400000 0.1091800 - 5 4.5810000 0.2827890 - 6 1.5800000 0.4531230 - 7 0.5640000 0.2747740 - 8 0.0734500 0.0097510 + 1 24350.0000000 0.0005020 + 2 3650.0000000 0.0038810 + 3 829.6000000 0.0199970 + 4 234.0000000 0.0784180 + 5 75.6100000 0.2296760 + 6 26.7300000 0.4327220 + 7 9.9270000 0.3506420 + 8 1.1020000 -0.0076450 S 8 - 1 1469.0000000 -0.0001200 - 2 220.5000000 -0.0009230 - 3 50.2600000 -0.0046890 - 4 14.2400000 -0.0176820 - 5 4.5810000 -0.0489020 - 6 1.5800000 -0.0960090 - 7 0.5640000 -0.1363800 - 8 0.0734500 0.5751020 + 1 24350.0000000 -0.0001180 + 2 3650.0000000 -0.0009150 + 3 829.6000000 -0.0047370 + 4 234.0000000 -0.0192330 + 5 75.6100000 -0.0603690 + 6 26.7300000 -0.1425080 + 7 9.9270000 -0.1777100 + 8 1.1020000 0.6058360 S 1 - 1 0.0280500 1.0000000 + 1 2.8360000 1.0000000 +S 1 + 1 0.3782000 1.0000000 P 3 - 1 1.5340000 0.0227840 - 2 0.2749000 0.1391070 - 3 0.0736200 0.5003750 + 1 54.7000000 0.0171510 + 2 12.4300000 0.1076560 + 3 3.6790000 0.3216810 P 1 - 1 0.0240300 1.0000000 + 1 1.1430000 1.0000000 +P 1 + 1 0.3300000 1.0000000 D 1 - 1 0.1239000 1.0000000 + 1 4.0140000 1.0000000 +D 1 + 1 1.0960000 1.0000000 +F 1 + 1 2.5440000 1.0000000 + diff --git a/input/methods b/input/methods index ba17592..478a02f 100644 --- a/input/methods +++ b/input/methods @@ -1,5 +1,5 @@ # RHF UHF MOM - F T F + T F F # MP2 MP3 MP2-F12 F F F # CCD CCSD CCSD(T) @@ -13,7 +13,7 @@ # G0F2 evGF2 G0F3 evGF3 F F F F # G0W0 evGW qsGW - T F F + F F T # G0T0 evGT qsGT F F F # MCMP2 diff --git a/input/molecule b/input/molecule index 058d6dd..edeba31 100644 --- a/input/molecule +++ b/input/molecule @@ -1,4 +1,4 @@ # nAt nEla nElb nCore nRyd - 1 2 1 0 0 + 1 5 5 0 0 # Znuc x y z - Li 0.0 0.0 0.0 + Ne 0.0 0.0 0.0 diff --git a/input/molecule.xyz b/input/molecule.xyz index c9a5a65..1c70680 100644 --- a/input/molecule.xyz +++ b/input/molecule.xyz @@ -1,3 +1,3 @@ 1 - Li 0.0000000000 0.0000000000 0.0000000000 + Ne 0.0000000000 0.0000000000 0.0000000000 diff --git a/input/options b/input/options index 337b5e1..6af6fdb 100644 --- a/input/options +++ b/input/options @@ -13,6 +13,6 @@ # ACFDT: AC Kx XBS F F T # BSE: BSE dBSE dTDA evDyn - T F F F + T F T T # MCMP2: nMC nEq nWalk dt nPrint iSeed doDrift 1000000 100000 10 0.3 10000 1234 T diff --git a/src/QuAcK/ACFDT.f90 b/src/QuAcK/ACFDT.f90 index 3e5b6a5..cd8843b 100644 --- a/src/QuAcK/ACFDT.f90 +++ b/src/QuAcK/ACFDT.f90 @@ -1,5 +1,4 @@ -subroutine ACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,singlet_manifold,triplet_manifold,eta, & - nBas,nC,nO,nV,nR,nS,ERI,eW,e,Omega,XpY,XmY,rho,EcAC) +subroutine ACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,eW,e,EcAC) ! Compute the correlation energy via the adiabatic connection fluctuation dissipation theorem @@ -15,8 +14,8 @@ subroutine ACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,singlet_manifold,tripl logical,intent(in) :: TDA_W logical,intent(in) :: TDA logical,intent(in) :: BSE - logical,intent(in) :: singlet_manifold - logical,intent(in) :: triplet_manifold + logical,intent(in) :: singlet + logical,intent(in) :: triplet double precision,intent(in) :: eta integer,intent(in) :: nBas,nC,nO,nV,nR,nS @@ -24,11 +23,6 @@ subroutine ACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,singlet_manifold,tripl double precision,intent(in) :: e(nBas) double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) - double precision :: Omega(nS,nspin) - double precision :: XpY(nS,nS,nspin) - double precision :: XmY(nS,nS,nspin) - double precision :: rho(nBas,nBas,nS,nspin) - ! Local variables integer :: ispin @@ -37,6 +31,16 @@ subroutine ACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,singlet_manifold,tripl double precision :: lambda double precision,allocatable :: Ec(:,:) + double precision :: EcRPA + double precision,allocatable :: OmRPA(:) + double precision,allocatable :: XpY_RPA(:,:) + double precision,allocatable :: XmY_RPA(:,:) + double precision,allocatable :: rho_RPA(:,:,:) + + double precision,allocatable :: Omega(:,:) + double precision,allocatable :: XpY(:,:,:) + double precision,allocatable :: XmY(:,:,:) + ! Output variables double precision,intent(out) :: EcAC(nspin) @@ -44,6 +48,8 @@ subroutine ACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,singlet_manifold,tripl ! Memory allocation allocate(Ec(nAC,nspin)) + allocate(OmRPA(nS),XpY_RPA(nS,nS),XmY_RPA(nS,nS),rho_RPA(nBas,nBas,nS)) + allocate(Omega(nS,nspin),XpY(nS,nS,nspin),XmY(nS,nS,nspin)) ! Antisymmetrized kernel version @@ -58,12 +64,20 @@ subroutine ACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,singlet_manifold,tripl EcAC(:) = 0d0 Ec(:,:) = 0d0 +! Compute (singlet) RPA screening + + isp_W = 1 + EcRPA = 0d0 + + call linear_response(isp_W,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eW,ERI,OmRPA, & + rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA) + call excitation_density(nBas,nC,nO,nR,nS,ERI,XpY_RPA,rho_RPA) + ! Singlet manifold - if(singlet_manifold) then + if(singlet) then ispin = 1 - isp_W = 1 write(*,*) '--------------' write(*,*) 'Singlet states' @@ -80,17 +94,17 @@ subroutine ACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,singlet_manifold,tripl if(doXBS) then - call linear_response(isp_W,dRPA,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,lambda,eW,ERI, & - rho(:,:,:,ispin),EcAC(ispin),Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) - call excitation_density(nBas,nC,nO,nR,nS,ERI,XpY(:,:,ispin),rho(:,:,:,ispin)) + call linear_response(isp_W,dRPA,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,lambda,eW,ERI,OmRPA, & + rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA) + call excitation_density(nBas,nC,nO,nR,nS,ERI,XpY_RPA,rho_RPA) end if - call linear_response(ispin,dRPA,TDA,BSE,eta,nBas,nC,nO,nV,nR,nS,lambda,e,ERI, & - rho(:,:,:,ispin),EcAC(ispin),Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + call linear_response(ispin,dRPA,TDA,BSE,eta,nBas,nC,nO,nV,nR,nS,lambda,e,ERI,OmRPA, & + rho_RPA,EcAC(ispin),Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) call ACFDT_correlation_energy(ispin,exchange_kernel,nBas,nC,nO,nV,nR,nS, & - ERI(:,:,:,:),XpY(:,:,ispin),XmY(:,:,ispin),Ec(iAC,ispin)) + ERI,XpY(:,:,ispin),XmY(:,:,ispin),Ec(iAC,ispin)) write(*,'(2X,F15.6,1X,F30.15,1X,F30.15)') lambda,EcAC(ispin),Ec(iAC,ispin) @@ -98,6 +112,8 @@ subroutine ACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,singlet_manifold,tripl EcAC(ispin) = 0.5d0*dot_product(wAC,Ec(:,ispin)) + if(exchange_kernel) EcAC(ispin) = 0.5d0*EcAC(ispin) + write(*,*) '-----------------------------------------------------------------------------------' write(*,'(2X,A50,1X,F15.6)') ' Ec(AC) via Gauss-Legendre quadrature:',EcAC(ispin) write(*,*) '-----------------------------------------------------------------------------------' @@ -107,7 +123,7 @@ subroutine ACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,singlet_manifold,tripl ! Triplet manifold - if(triplet_manifold) then + if(triplet) then ispin = 2 isp_W = 1 @@ -127,17 +143,16 @@ subroutine ACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,singlet_manifold,tripl if(doXBS) then - call linear_response(isp_W,dRPA,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,lambda,eW,ERI, & - rho(:,:,:,ispin),EcAC(ispin),Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) - call excitation_density(nBas,nC,nO,nR,nS,ERI,XpY(:,:,ispin),rho(:,:,:,ispin)) + call linear_response(isp_W,dRPA,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,lambda,eW,ERI,OmRPA, & + rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA) + call excitation_density(nBas,nC,nO,nR,nS,ERI,XpY_RPA,rho_RPA) end if - call linear_response(ispin,dRPA,TDA,BSE,eta,nBas,nC,nO,nV,nR,nS,lambda,e,ERI, & - rho(:,:,:,ispin),EcAC(ispin),Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + call linear_response(ispin,dRPA,TDA,BSE,eta,nBas,nC,nO,nV,nR,nS,lambda,e,ERI,OmRPA, & + rho_RPA,EcAC(ispin),Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) - call ACFDT_correlation_energy(ispin,exchange_kernel,nBas,nC,nO,nV,nR,nS, & - ERI(:,:,:,:),XpY(:,:,ispin),XmY(:,:,ispin),Ec(iAC,ispin)) + call ACFDT_correlation_energy(ispin,exchange_kernel,nBas,nC,nO,nV,nR,nS,ERI,XpY(:,:,ispin),XmY(:,:,ispin),Ec(iAC,ispin)) write(*,'(2X,F15.6,1X,F30.15,1X,F30.15)') lambda,EcAC(ispin),Ec(iAC,ispin) @@ -145,6 +160,8 @@ subroutine ACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,singlet_manifold,tripl EcAC(ispin) = 0.5d0*dot_product(wAC,Ec(:,ispin)) + if(exchange_kernel) EcAC(ispin) = 1.5d0*EcAC(ispin) + write(*,*) '-----------------------------------------------------------------------------------' write(*,'(2X,A50,1X,F15.6)') ' Ec(AC) via Gauss-Legendre quadrature:',EcAC(ispin) write(*,*) '-----------------------------------------------------------------------------------' diff --git a/src/QuAcK/BSE2.f90 b/src/QuAcK/BSE2.f90 index cff9aef..64a9e8c 100644 --- a/src/QuAcK/BSE2.f90 +++ b/src/QuAcK/BSE2.f90 @@ -54,7 +54,7 @@ subroutine BSE2(TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold, & ! Compute BSE2 excitation energies call linear_response(ispin,.false.,TDA,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGF(:),ERI(:,:,:,:), & - rho,EcBSE(ispin),OmBSE(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + OmBSE(:,ispin),rho,EcBSE(ispin),OmBSE(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) call print_excitation('BSE2 ',ispin,nS,OmBSE(:,ispin)) ! Compute dynamic correction for BSE via perturbation theory @@ -88,7 +88,7 @@ subroutine BSE2(TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold, & ! Compute BSE2 excitation energies call linear_response(ispin,.false.,TDA,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGF(:),ERI(:,:,:,:), & - rho,EcBSE(ispin),OmBSE(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + OmBSE(:,ispin),rho,EcBSE(ispin),OmBSE(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) call print_excitation('BSE2 ',ispin,nS,OmBSE(:,ispin)) ! Compute dynamic correction for BSE via perturbation theory diff --git a/src/QuAcK/Bethe_Salpeter.f90 b/src/QuAcK/Bethe_Salpeter.f90 index d01f978..d0763ee 100644 --- a/src/QuAcK/Bethe_Salpeter.f90 +++ b/src/QuAcK/Bethe_Salpeter.f90 @@ -1,5 +1,4 @@ -subroutine Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold,eta, & - nBas,nC,nO,nV,nR,nS,ERI,eW,eGW,OmRPA,XpY_RPA,XmY_RPA,rho_RPA,EcRPA,EcBSE) +subroutine Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,eW,eGW,EcBSE) ! Compute the Bethe-Salpeter excitation energies @@ -13,8 +12,8 @@ subroutine Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_man logical,intent(in) :: dBSE logical,intent(in) :: dTDA logical,intent(in) :: evDyn - logical,intent(in) :: singlet_manifold - logical,intent(in) :: triplet_manifold + logical,intent(in) :: singlet + logical,intent(in) :: triplet double precision,intent(in) :: eta integer,intent(in) :: nBas,nC,nO,nV,nR,nS @@ -22,51 +21,55 @@ subroutine Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_man double precision,intent(in) :: eGW(nBas) double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) - double precision :: OmRPA(nS,nspin) - double precision :: XpY_RPA(nS,nS,nspin) - double precision :: XmY_RPA(nS,nS,nspin) - double precision :: rho_RPA(nBas,nBas,nS,nspin) - ! Local variables integer :: ispin integer :: isp_W + + double precision :: EcRPA + double precision,allocatable :: OmRPA(:) + double precision,allocatable :: XpY_RPA(:,:) + double precision,allocatable :: XmY_RPA(:,:) + double precision,allocatable :: rho_RPA(:,:,:) + double precision,allocatable :: OmBSE(:,:) double precision,allocatable :: XpY_BSE(:,:,:) double precision,allocatable :: XmY_BSE(:,:,:) ! Output variables - double precision,intent(out) :: EcRPA(nspin) double precision,intent(out) :: EcBSE(nspin) ! Memory allocation + allocate(OmRPA(nS),XpY_RPA(nS,nS),XmY_RPA(nS,nS),rho_RPA(nBas,nBas,nS)) allocate(OmBSE(nS,nspin),XpY_BSE(nS,nS,nspin),XmY_BSE(nS,nS,nspin)) +!--------------------------------- +! Compute (singlet) RPA screening +!--------------------------------- + + isp_W = 1 + EcRPA = 0d0 + + call linear_response(isp_W,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eW,ERI,OmRPA, & + rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA) + call excitation_density(nBas,nC,nO,nR,nS,ERI,XpY_RPA,rho_RPA) + !------------------- ! Singlet manifold !------------------- - if(singlet_manifold) then + if(singlet) then ispin = 1 - isp_W = 1 EcBSE(ispin) = 0d0 - ! Compute (singlet) RPA screening - - call linear_response(isp_W,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eW,ERI, & - rho_RPA(:,:,:,ispin),EcRPA(ispin),OmRPA(:,ispin),XpY_RPA(:,:,ispin),XmY_RPA(:,:,ispin)) - call excitation_density(nBas,nC,nO,nR,nS,ERI,XpY_RPA(:,:,ispin),rho_RPA(:,:,:,ispin)) - ! Compute BSE excitation energies - OmBSE(:,ispin) = OmRPA(:,ispin) - - call linear_response(ispin,.true.,TDA,.true.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI, & - rho_RPA(:,:,:,ispin),EcBSE(ispin),OmBSE(:,ispin),XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin)) - call print_excitation('BSE ',ispin,nS,OmBSE(:,ispin)) + call linear_response(ispin,.true.,TDA,.true.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI,OmRPA, & + rho_RPA,EcBSE(ispin),OmBSE(:,ispin),XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin)) + call print_excitation('BSE@GW ',ispin,nS,OmBSE(:,ispin)) !------------------------------------------------- ! Compute the dynamical screening at the BSE level @@ -78,12 +81,12 @@ subroutine Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_man if(evDyn) then - call Bethe_Salpeter_dynamic_perturbation_iterative(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW(:),OmRPA(:,ispin),OmBSE(:,ispin), & - XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin),rho_RPA(:,:,:,ispin)) + call Bethe_Salpeter_dynamic_perturbation_iterative(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA, & + OmBSE(:,ispin),XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin)) else - call Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW(:),OmRPA(:,ispin),OmBSE(:,ispin), & - XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin),rho_RPA(:,:,:,ispin)) + call Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA, & + OmBSE(:,ispin),XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin)) end if end if @@ -94,25 +97,16 @@ subroutine Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_man ! Triplet manifold !------------------- - if(triplet_manifold) then + if(triplet) then ispin = 2 - isp_W = 1 EcBSE(ispin) = 0d0 - ! Compute (singlet) RPA screening - - call linear_response(isp_W,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eW,ERI, & - rho_RPA(:,:,:,ispin),EcRPA(ispin),OmRPA(:,ispin),XpY_RPA(:,:,ispin),XmY_RPA(:,:,ispin)) - call excitation_density(nBas,nC,nO,nR,nS,ERI,XpY_RPA(:,:,ispin),rho_RPA(:,:,:,ispin)) - ! Compute BSE excitation energies - OmBSE(:,ispin) = OmRPA(:,ispin) - - call linear_response(ispin,.true.,TDA,.true.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI, & - rho_RPA(:,:,:,ispin),EcBSE(ispin),OmBSE(:,ispin),XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin)) - call print_excitation('BSE ',ispin,nS,OmBSE(:,ispin)) + call linear_response(ispin,.true.,TDA,.true.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI,OmRPA, & + rho_RPA,EcBSE(ispin),OmBSE(:,ispin),XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin)) + call print_excitation('BSE@GW ',ispin,nS,OmBSE(:,ispin)) !------------------------------------------------- ! Compute the dynamical screening at the BSE level @@ -124,12 +118,12 @@ subroutine Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_man if(evDyn) then - call Bethe_Salpeter_dynamic_perturbation_iterative(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA(:,ispin),OmBSE(:,ispin), & - XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin),rho_RPA(:,:,:,ispin)) + call Bethe_Salpeter_dynamic_perturbation_iterative(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA, & + OmBSE(:,ispin),XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin)) else - call Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA(:,ispin),OmBSE(:,ispin), & - XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin),rho_RPA(:,:,:,ispin)) + call Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA, & + OmBSE(:,ispin),XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin)) end if end if diff --git a/src/QuAcK/Bethe_Salpeter_AB_matrix_dynamic.f90 b/src/QuAcK/Bethe_Salpeter_AB_matrix_dynamic.f90 index 25e7dea..2d82750 100644 --- a/src/QuAcK/Bethe_Salpeter_AB_matrix_dynamic.f90 +++ b/src/QuAcK/Bethe_Salpeter_AB_matrix_dynamic.f90 @@ -1,5 +1,4 @@ -subroutine Bethe_Salpeter_AB_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,lambda,eGW,OmRPA,OmBSE,rho, & - Ap,Am,Bp,Bm) +subroutine Bethe_Salpeter_AB_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,lambda,eGW,OmRPA,rhO_RPA,OmBSE,Ap,Am,Bp,Bm) ! Compute the dynamic part of the Bethe-Salpeter equation matrices @@ -13,8 +12,8 @@ subroutine Bethe_Salpeter_AB_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,lambda,eGW,O double precision,intent(in) :: lambda double precision,intent(in) :: eGW(nBas) double precision,intent(in) :: OmRPA(nS) + double precision,intent(in) :: rho_RPA(nBas,nBas,nS) double precision,intent(in) :: OmBSE - double precision,intent(in) :: rho(nBas,nBas,nS) ! Local variables @@ -60,8 +59,8 @@ subroutine Bethe_Salpeter_AB_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,lambda,eGW,O do kc=1,maxS - chi_A = chi_A + rho(i,j,kc)*rho(a,b,kc)*OmRPA(kc)/(OmRPA(kc)**2 + eta**2) - chi_B = chi_B + rho(i,b,kc)*rho(a,j,kc)*OmRPA(kc)/(OmRPA(kc)**2 + eta**2) + chi_A = chi_A + rho_RPA(i,j,kc)*rho_RPA(a,b,kc)*OmRPA(kc)/(OmRPA(kc)**2 + eta**2) + chi_B = chi_B + rho_RPA(i,b,kc)*rho_RPA(a,j,kc)*OmRPA(kc)/(OmRPA(kc)**2 + eta**2) enddo @@ -80,28 +79,28 @@ subroutine Bethe_Salpeter_AB_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,lambda,eGW,O do kc=1,maxS eps_Ap = + OmBSE - OmRPA(kc) - (eGW(a) - eGW(j)) - chi_Ap = chi_Ap + rho(i,j,kc)*rho(a,b,kc)*eps_Ap/(eps_Ap**2 + eta**2) + chi_Ap = chi_Ap + rho_RPA(i,j,kc)*rho_RPA(a,b,kc)*eps_Ap/(eps_Ap**2 + eta**2) eps_Ap = + OmBSE - OmRPA(kc) - (eGW(b) - eGW(i)) - chi_Ap = chi_Ap + rho(i,j,kc)*rho(a,b,kc)*eps_Ap/(eps_Ap**2 + eta**2) + chi_Ap = chi_Ap + rho_RPA(i,j,kc)*rho_RPA(a,b,kc)*eps_Ap/(eps_Ap**2 + eta**2) eps_Am = - OmBSE - OmRPA(kc) - (eGW(a) - eGW(j)) - chi_Am = chi_Am + rho(i,j,kc)*rho(a,b,kc)*eps_Am/(eps_Am**2 + eta**2) + chi_Am = chi_Am + rho_RPA(i,j,kc)*rho_RPA(a,b,kc)*eps_Am/(eps_Am**2 + eta**2) eps_Am = - OmBSE - OmRPA(kc) - (eGW(b) - eGW(i)) - chi_Am = chi_Am + rho(i,j,kc)*rho(a,b,kc)*eps_Am/(eps_Am**2 + eta**2) + chi_Am = chi_Am + rho_RPA(i,j,kc)*rho_RPA(a,b,kc)*eps_Am/(eps_Am**2 + eta**2) eps_Bp = + OmBSE - OmRPA(kc) - (eGW(a) - eGW(b)) - chi_Bp = chi_Bp + rho(i,b,kc)*rho(a,j,kc)*eps_Bp/(eps_Bp**2 + eta**2) + chi_Bp = chi_Bp + rho_RPA(i,b,kc)*rho_RPA(a,j,kc)*eps_Bp/(eps_Bp**2 + eta**2) eps_Bp = + OmBSE - OmRPA(kc) - (eGW(j) - eGW(i)) - chi_Bp = chi_Bp + rho(i,b,kc)*rho(a,j,kc)*eps_Bp/(eps_Bp**2 + eta**2) + chi_Bp = chi_Bp + rho_RPA(i,b,kc)*rho_RPA(a,j,kc)*eps_Bp/(eps_Bp**2 + eta**2) eps_Bm = - OmBSE - OmRPA(kc) - (eGW(a) - eGW(b)) - chi_Bm = chi_Bm + rho(i,b,kc)*rho(a,j,kc)*eps_Bm/(eps_Bm**2 + eta**2) + chi_Bm = chi_Bm + rho_RPA(i,b,kc)*rho_RPA(a,j,kc)*eps_Bm/(eps_Bm**2 + eta**2) eps_Bm = - OmBSE - OmRPA(kc) - (eGW(j) - eGW(i)) - chi_Bm = chi_Bm + rho(i,b,kc)*rho(a,j,kc)*eps_Bm/(eps_Bm**2 + eta**2) + chi_Bm = chi_Bm + rho_RPA(i,b,kc)*rho_RPA(a,j,kc)*eps_Bm/(eps_Bm**2 + eta**2) enddo diff --git a/src/QuAcK/Bethe_Salpeter_A_matrix_dynamic.f90 b/src/QuAcK/Bethe_Salpeter_A_matrix_dynamic.f90 index 61dfa01..634323f 100644 --- a/src/QuAcK/Bethe_Salpeter_A_matrix_dynamic.f90 +++ b/src/QuAcK/Bethe_Salpeter_A_matrix_dynamic.f90 @@ -1,4 +1,4 @@ -subroutine Bethe_Salpeter_A_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,lambda,eGW,OmRPA,OmBSE,rho,A_dyn) +subroutine Bethe_Salpeter_A_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,lambda,eGW,OmRPA,rho_RPA,OmBSE,A_dyn) ! Compute the dynamic part of the Bethe-Salpeter equation matrices @@ -12,8 +12,8 @@ subroutine Bethe_Salpeter_A_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,lambda,eGW,Om double precision,intent(in) :: lambda double precision,intent(in) :: eGW(nBas) double precision,intent(in) :: OmRPA(nS) + double precision,intent(in) :: rho_RPA(nBas,nBas,nS) double precision,intent(in) :: OmBSE - double precision,intent(in) :: rho(nBas,nBas,nS) ! Local variables @@ -48,7 +48,7 @@ subroutine Bethe_Salpeter_A_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,lambda,eGW,Om chi = 0d0 do kc=1,maxS - chi = chi + rho(i,j,kc)*rho(a,b,kc)*OmRPA(kc)/(OmRPA(kc)**2 + eta**2) + chi = chi + rho_RPA(i,j,kc)*rho_RPA(a,b,kc)*OmRPA(kc)/(OmRPA(kc)**2 + eta**2) enddo @@ -58,10 +58,10 @@ subroutine Bethe_Salpeter_A_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,lambda,eGW,Om do kc=1,maxS eps = + OmBSE - OmRPA(kc) - (eGW(a) - eGW(j)) - chi = chi + rho(i,j,kc)*rho(a,b,kc)*eps/(eps**2 + eta**2) + chi = chi + rho_RPA(i,j,kc)*rho_RPA(a,b,kc)*eps/(eps**2 + eta**2) eps = + OmBSE - OmRPA(kc) - (eGW(b) - eGW(i)) - chi = chi + rho(i,j,kc)*rho(a,b,kc)*eps/(eps**2 + eta**2) + chi = chi + rho_RPA(i,j,kc)*rho_RPA(a,b,kc)*eps/(eps**2 + eta**2) enddo diff --git a/src/QuAcK/Bethe_Salpeter_B_matrix.f90 b/src/QuAcK/Bethe_Salpeter_B_matrix.f90 index c323753..7e000ee 100644 --- a/src/QuAcK/Bethe_Salpeter_B_matrix.f90 +++ b/src/QuAcK/Bethe_Salpeter_B_matrix.f90 @@ -1,4 +1,4 @@ -subroutine Bethe_Salpeter_B_matrix(eta,nBas,nC,nO,nV,nR,nS,lambda,ERI,Omega,rho,B_lr) +subroutine Bethe_Salpeter_B_matrix(eta,nBas,nC,nO,nV,nR,nS,lambda,ERI,OmRPA,rho_RPA,B_lr) ! Compute the extra term for Bethe-Salpeter equation for linear response @@ -11,8 +11,8 @@ subroutine Bethe_Salpeter_B_matrix(eta,nBas,nC,nO,nV,nR,nS,lambda,ERI,Omega,rho, double precision,intent(in) :: eta double precision,intent(in) :: lambda double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) - double precision,intent(in) :: Omega(nS) - double precision,intent(in) :: rho(nBas,nBas,nS) + double precision,intent(in) :: OmRPA(nS) + double precision,intent(in) :: rho_RPA(nBas,nBas,nS) ! Local variables @@ -35,8 +35,8 @@ subroutine Bethe_Salpeter_B_matrix(eta,nBas,nC,nO,nV,nR,nS,lambda,ERI,Omega,rho, chi = 0d0 do kc=1,nS - eps = Omega(kc)**2 + eta**2 - chi = chi + rho(i,b,kc)*rho(a,j,kc)*Omega(kc)/eps + eps = OmRPA(kc)**2 + eta**2 + chi = chi + rho_RPA(i,b,kc)*rho_RPA(a,j,kc)*OmRPA(kc)/eps enddo B_lr(ia,jb) = B_lr(ia,jb) - lambda*ERI(i,j,b,a) + 4d0*lambda*chi diff --git a/src/QuAcK/Bethe_Salpeter_ZAB_matrix_dynamic.f90 b/src/QuAcK/Bethe_Salpeter_ZAB_matrix_dynamic.f90 index 14cd120..c7550da 100644 --- a/src/QuAcK/Bethe_Salpeter_ZAB_matrix_dynamic.f90 +++ b/src/QuAcK/Bethe_Salpeter_ZAB_matrix_dynamic.f90 @@ -1,4 +1,4 @@ -subroutine Bethe_Salpeter_ZAB_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,lambda,eGW,OmRPA,OmBSE,rho, & +subroutine Bethe_Salpeter_ZAB_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,lambda,eGW,OmRPA,rho_RPA,OmBSE, & ZAp,ZAm,ZBp,ZBm) ! Compute the dynamic part of the renormalization for the Bethe-Salpeter equation matrices @@ -13,8 +13,8 @@ subroutine Bethe_Salpeter_ZAB_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,lambda,eGW, double precision,intent(in) :: lambda double precision,intent(in) :: eGW(nBas) double precision,intent(in) :: OmRPA(nS) + double precision,intent(in) :: rho_RPA(nBas,nBas,nS) double precision,intent(in) :: OmBSE - double precision,intent(in) :: rho(nBas,nBas,nS) ! Local variables @@ -63,28 +63,28 @@ subroutine Bethe_Salpeter_ZAB_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,lambda,eGW, do kc=1,maxS eps_Ap = + OmBSE - OmRPA(kc) - (eGW(a) - eGW(j)) - chi_Ap = chi_Ap + rho(i,j,kc)*rho(a,b,kc)*(eps_Ap**2 - eta**2)/(eps_Ap**2 + eta**2)**2 + chi_Ap = chi_Ap + rho_RPA(i,j,kc)*rho_RPA(a,b,kc)*(eps_Ap**2 - eta**2)/(eps_Ap**2 + eta**2)**2 eps_Ap = + OmBSE - OmRPA(kc) - (eGW(b) - eGW(i)) - chi_Ap = chi_Ap + rho(i,j,kc)*rho(a,b,kc)*(eps_Ap**2 - eta**2)/(eps_Ap**2 + eta**2)**2 + chi_Ap = chi_Ap + rho_RPA(i,j,kc)*rho_RPA(a,b,kc)*(eps_Ap**2 - eta**2)/(eps_Ap**2 + eta**2)**2 eps_Am = - OmBSE - OmRPA(kc) - (eGW(a) - eGW(j)) - chi_Am = chi_Am + rho(i,j,kc)*rho(a,b,kc)*(eps_Am**2 - eta**2)/(eps_Am**2 + eta**2)**2 + chi_Am = chi_Am + rho_RPA(i,j,kc)*rho_RPA(a,b,kc)*(eps_Am**2 - eta**2)/(eps_Am**2 + eta**2)**2 eps_Am = - OmBSE - OmRPA(kc) - (eGW(b) - eGW(i)) - chi_Am = chi_Am + rho(i,j,kc)*rho(a,b,kc)*(eps_Am**2 - eta**2)/(eps_Am**2 + eta**2)**2 + chi_Am = chi_Am + rho_RPA(i,j,kc)*rho_RPA(a,b,kc)*(eps_Am**2 - eta**2)/(eps_Am**2 + eta**2)**2 eps_Bp = + OmBSE - OmRPA(kc) - (eGW(a) - eGW(b)) - chi_Bp = chi_Bp + rho(i,b,kc)*rho(a,j,kc)*(eps_Bp**2 - eta**2)/(eps_Bp**2 + eta**2)**2 + chi_Bp = chi_Bp + rho_RPA(i,b,kc)*rho_RPA(a,j,kc)*(eps_Bp**2 - eta**2)/(eps_Bp**2 + eta**2)**2 eps_Bp = + OmBSE - OmRPA(kc) - (eGW(j) - eGW(i)) - chi_Bp = chi_Bp + rho(i,b,kc)*rho(a,j,kc)*(eps_Bp**2 - eta**2)/(eps_Bp**2 + eta**2)**2 + chi_Bp = chi_Bp + rho_RPA(i,b,kc)*rho_RPA(a,j,kc)*(eps_Bp**2 - eta**2)/(eps_Bp**2 + eta**2)**2 eps_Bm = - OmBSE - OmRPA(kc) - (eGW(a) - eGW(b)) - chi_Bm = chi_Bm + rho(i,b,kc)*rho(a,j,kc)*(eps_Bm**2 - eta**2)/(eps_Bm**2 + eta**2)**2 + chi_Bm = chi_Bm + rho_RPA(i,b,kc)*rho_RPA(a,j,kc)*(eps_Bm**2 - eta**2)/(eps_Bm**2 + eta**2)**2 eps_Bm = - OmBSE - OmRPA(kc) - (eGW(j) - eGW(i)) - chi_Bm = chi_Bm + rho(i,b,kc)*rho(a,j,kc)*(eps_Bm**2 - eta**2)/(eps_Bm**2 + eta**2)**2 + chi_Bm = chi_Bm + rho_RPA(i,b,kc)*rho_RPA(a,j,kc)*(eps_Bm**2 - eta**2)/(eps_Bm**2 + eta**2)**2 enddo diff --git a/src/QuAcK/Bethe_Salpeter_ZA_matrix_dynamic.f90 b/src/QuAcK/Bethe_Salpeter_ZA_matrix_dynamic.f90 index eb71cb4..e15677d 100644 --- a/src/QuAcK/Bethe_Salpeter_ZA_matrix_dynamic.f90 +++ b/src/QuAcK/Bethe_Salpeter_ZA_matrix_dynamic.f90 @@ -1,4 +1,4 @@ -subroutine Bethe_Salpeter_ZA_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,lambda,eGW,OmRPA,OmBSE,rho,ZA_dyn) +subroutine Bethe_Salpeter_ZA_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,lambda,eGW,OmRPA,rho_RPA,OmBSE,ZA_dyn) ! Compute the dynamic part of the Bethe-Salpeter equation matrices @@ -12,8 +12,8 @@ subroutine Bethe_Salpeter_ZA_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,lambda,eGW,O double precision,intent(in) :: lambda double precision,intent(in) :: eGW(nBas) double precision,intent(in) :: OmRPA(nS) + double precision,intent(in) :: rho_RPA(nBas,nBas,nS) double precision,intent(in) :: OmBSE - double precision,intent(in) :: rho(nBas,nBas,nS) ! Local variables @@ -49,10 +49,10 @@ subroutine Bethe_Salpeter_ZA_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,lambda,eGW,O do kc=1,maxS eps = + OmBSE - OmRPA(kc) - (eGW(a) - eGW(j)) - chi = chi + rho(i,j,kc)*rho(a,b,kc)*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + chi = chi + rho_RPA(i,j,kc)*rho_RPA(a,b,kc)*(eps**2 - eta**2)/(eps**2 + eta**2)**2 eps = + OmBSE - OmRPA(kc) - (eGW(b) - eGW(i)) - chi = chi + rho(i,j,kc)*rho(a,b,kc)*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + chi = chi + rho_RPA(i,j,kc)*rho_RPA(a,b,kc)*(eps**2 - eta**2)/(eps**2 + eta**2)**2 enddo diff --git a/src/QuAcK/Bethe_Salpeter_dynamic_perturbation.f90 b/src/QuAcK/Bethe_Salpeter_dynamic_perturbation.f90 index d01e611..ba0d2dd 100644 --- a/src/QuAcK/Bethe_Salpeter_dynamic_perturbation.f90 +++ b/src/QuAcK/Bethe_Salpeter_dynamic_perturbation.f90 @@ -1,4 +1,4 @@ -subroutine Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,OmBSE,XpY,XmY,rho) +subroutine Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA,OmBSE,XpY,XmY) ! Compute dynamical effects via perturbation theory for BSE @@ -18,10 +18,10 @@ subroutine Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW, double precision,intent(in) :: eGW(nBas) double precision,intent(in) :: OmRPA(nS) + double precision,intent(in) :: rho_RPA(nBas,nBas,nS) double precision,intent(in) :: OmBSE(nS) double precision,intent(in) :: XpY(nS,nS) double precision,intent(in) :: XmY(nS,nS) - double precision,intent(in) :: rho(nBas,nBas,nS) ! Local variables @@ -84,11 +84,11 @@ subroutine Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW, ! Resonant part of the BSE correction for dynamical TDA - call Bethe_Salpeter_A_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,OmRPA,OmBSE(ia),rho,Ap_dyn) + call Bethe_Salpeter_A_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,OmRPA,rho_RPA,OmBSE(ia),Ap_dyn) ! Renormalization factor of the resonant parts for dynamical TDA - call Bethe_Salpeter_ZA_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,OmRPA,OmBSE(ia),rho,ZAp_dyn) + call Bethe_Salpeter_ZA_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,OmRPA,rho_RPA,OmBSE(ia),ZAp_dyn) ZDyn(ia) = dot_product(X,matmul(ZAp_dyn,X)) OmDyn(ia) = dot_product(X,matmul( Ap_dyn,X)) @@ -97,12 +97,12 @@ subroutine Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW, ! Resonant and anti-resonant part of the BSE correction - call Bethe_Salpeter_AB_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,OmRPA,OmBSE(ia),rho, & + call Bethe_Salpeter_AB_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,OmRPA,rho_RPA,OmBSE(ia), & Ap_dyn,Am_dyn,Bp_dyn,Bm_dyn) ! Renormalization factor of the resonant and anti-resonant parts - call Bethe_Salpeter_ZAB_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,OmRPA,OmBSE(ia),rho, & + call Bethe_Salpeter_ZAB_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,OmRPA,rho_RPA,OmBSE(ia), & ZAp_dyn,ZAm_dyn,ZBp_dyn,ZBm_dyn) ZDyn(ia) = dot_product(X,matmul(ZAp_dyn,X)) & diff --git a/src/QuAcK/Bethe_Salpeter_dynamic_perturbation_iterative.f90 b/src/QuAcK/Bethe_Salpeter_dynamic_perturbation_iterative.f90 index 9435c09..72b5e88 100644 --- a/src/QuAcK/Bethe_Salpeter_dynamic_perturbation_iterative.f90 +++ b/src/QuAcK/Bethe_Salpeter_dynamic_perturbation_iterative.f90 @@ -1,4 +1,4 @@ -subroutine Bethe_Salpeter_dynamic_perturbation_iterative(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,OmBSE,XpY,XmY,rho) +subroutine Bethe_Salpeter_dynamic_perturbation_iterative(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA,OmBSE,XpY,XmY) ! Compute self-consistently the dynamical effects via perturbation theory for BSE @@ -18,10 +18,10 @@ subroutine Bethe_Salpeter_dynamic_perturbation_iterative(dTDA,eta,nBas,nC,nO,nV, double precision,intent(in) :: eGW(nBas) double precision,intent(in) :: OmRPA(nS) + double precision,intent(in) :: rho_RPA(nBas,nBas,nS) double precision,intent(in) :: OmBSE(nS) double precision,intent(in) :: XpY(nS,nS) double precision,intent(in) :: XmY(nS,nS) - double precision,intent(in) :: rho(nBas,nBas,nS) ! Local variables @@ -97,8 +97,7 @@ subroutine Bethe_Salpeter_dynamic_perturbation_iterative(dTDA,eta,nBas,nC,nO,nV, ! Resonant part of the BSE correction - call Bethe_Salpeter_A_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,1d0,eGW(:),OmRPA(:),OmOld(ia),rho(:,:,:), & - Ap_dyn(:,:)) + call Bethe_Salpeter_A_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,OmRPA,rho_RPA,OmOld(ia),Ap_dyn) OmDyn(ia) = dot_product(X(:),matmul(Ap_dyn(:,:),X(:))) @@ -106,8 +105,8 @@ subroutine Bethe_Salpeter_dynamic_perturbation_iterative(dTDA,eta,nBas,nC,nO,nV, ! Anti-resonant part of the BSE correction - call Bethe_Salpeter_AB_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,1d0,eGW(:),OmRPA(:),OmOld(ia),rho(:,:,:), & - Ap_dyn(:,:),Am_dyn(:,:),Bp_dyn(:,:),Bm_dyn(:,:)) + call Bethe_Salpeter_AB_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,OmRPA,rho_RPA,OmOld(ia), & + Ap_dyn,Am_dyn,Bp_dyn,Bm_dyn) OmDyn(ia) = dot_product(X(:),matmul(Ap_dyn(:,:),X(:))) & - dot_product(Y(:),matmul(Am_dyn(:,:),Y(:))) & diff --git a/src/QuAcK/G0W0.f90 b/src/QuAcK/G0W0.f90 index b6ffcbc..a01c21b 100644 --- a/src/QuAcK/G0W0.f90 +++ b/src/QuAcK/G0W0.f90 @@ -1,5 +1,5 @@ -subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & - dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold,linearize,eta, & +subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & + dBSE,dTDA,evDyn,singlet,triplet,linearize,eta, & nBas,nC,nO,nV,nR,nS,ENuc,ERHF,Hc,ERI,PHF,cHF,eHF,eGW) ! Perform G0W0 calculation @@ -21,8 +21,8 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, logical,intent(in) :: dBSE logical,intent(in) :: dTDA logical,intent(in) :: evDyn - logical,intent(in) :: singlet_manifold - logical,intent(in) :: triplet_manifold + logical,intent(in) :: singlet + logical,intent(in) :: triplet logical,intent(in) :: linearize double precision,intent(in) :: eta @@ -39,17 +39,16 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, logical :: print_W = .true. integer :: ispin - double precision :: EcRPA(nspin) + double precision :: EcRPA double precision :: EcBSE(nspin) double precision :: EcAC(nspin) double precision :: EcGM double precision,allocatable :: SigC(:) double precision,allocatable :: Z(:) - double precision,allocatable :: Omega(:,:) - double precision,allocatable :: XpY(:,:,:) - double precision,allocatable :: XmY(:,:,:) - double precision,allocatable :: rho(:,:,:,:) - double precision,allocatable :: rhox(:,:,:,:) + double precision,allocatable :: OmRPA(:) + double precision,allocatable :: XpY_RPA(:,:) + double precision,allocatable :: XmY_RPA(:,:) + double precision,allocatable :: rho_RPA(:,:,:) double precision,allocatable :: eGWlin(:) @@ -67,13 +66,13 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, ! Initialization - EcRPA(:) = 0d0 + EcRPA = 0d0 ! SOSEX correction if(SOSEX) then - write(*,*) 'SOSEX correction activated!' - write(*,*) + write(*,*) 'SOSEX correction activated but BUG!' + stop end if ! COHSEX approximation @@ -103,34 +102,43 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, ! Memory allocation - allocate(SigC(nBas),Z(nBas),Omega(nS,nspin),XpY(nS,nS,nspin),XmY(nS,nS,nspin), & - rho(nBas,nBas,nS,nspin),rhox(nBas,nBas,nS,nspin),eGWlin(nBas)) + allocate(SigC(nBas),Z(nBas),OmRPA(nS),XpY_RPA(nS,nS),XmY_RPA(nS,nS),rho_RPA(nBas,nBas,nS),eGWlin(nBas)) -! Compute linear response +!-------------------! +! Compute screening ! +!-------------------! - call linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI, & - rho(:,:,:,ispin),EcRPA(ispin),Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + call linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0, & + eHF,ERI,OmRPA,rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA) - if(print_W) call print_excitation('RPA@HF ',ispin,nS,Omega(:,ispin)) + if(print_W) call print_excitation('RPA@HF ',ispin,nS,OmRPA) -! Compute correlation part of the self-energy +!--------------------------! +! Compute spectral weights ! +!--------------------------! - call excitation_density(nBas,nC,nO,nR,nS,ERI,XpY(:,:,ispin),rho(:,:,:,ispin)) + call excitation_density(nBas,nC,nO,nR,nS,ERI,XpY_RPA,rho_RPA) - if(SOSEX) call excitation_density_SOSEX(nBas,nC,nO,nR,nS,ERI,XpY(:,:,ispin),rhox(:,:,:,ispin)) +!------------------------! +! Compute GW self-energy ! +!------------------------! - call self_energy_correlation_diag(COHSEX,SOSEX,eta,nBas,nC,nO,nV,nR,nS,eHF, & - Omega(:,ispin),rho(:,:,:,ispin),rhox(:,:,:,ispin),EcGM,SigC) + call self_energy_correlation_diag(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,EcGM,SigC) -! Compute renormalization factor +!--------------------------------! +! Compute renormalization factor ! +!--------------------------------! - call renormalization_factor(COHSEX,SOSEX,eta,nBas,nC,nO,nV,nR,nS,eHF, & - Omega(:,ispin),rho(:,:,:,ispin),rhox(:,:,:,ispin),Z(:)) + call renormalization_factor(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,Z) -! Solve the quasi-particle equation +!-----------------------------------! +! Solve the quasi-particle equation ! +!-----------------------------------! eGWlin(:) = eHF(:) + Z(:)*SigC(:) + ! Linearized or graphical solution? + if(linearize) then write(*,*) ' *** Quasiparticle energies obtained by linearization *** ' @@ -138,51 +146,48 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, eGW(:) = eGWlin(:) -! Find all the roots of the QP equation if necessary - -! call QP_roots(nBas,nC,nO,nV,nR,nS,eta,eHF,Omega,rho,eGWlin) - else - - ! Find graphical solution of the QP equation - call QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,Omega,rho,eGWlin,eGW) + write(*,*) ' *** Quasiparticle energies obtained by root search (experimental) *** ' + write(*,*) + + call QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,OmRPA,rho_RPA,eGWlin,eGW) + + ! Find all the roots of the QP equation if necessary + + ! call QP_roots(nBas,nC,nO,nV,nR,nS,eta,eHF,Omega,rho,eGWlin) end if -! Dump results - - call print_G0W0(nBas,nO,eHF,ENuc,ERHF,SigC,Z,eGW,EcRPA(ispin),EcGM) - ! Compute the RPA correlation energy - call linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI, & - rho(:,:,:,ispin),EcRPA(ispin),Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + call linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI,OmRPA, & + rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA) - write(*,*) - write(*,*)'-------------------------------------------------------------------------------' - write(*,'(2X,A50,F20.10)') 'Tr@RPA@G0W0 correlation energy (singlet) =',EcRPA(1) - write(*,'(2X,A50,F20.10)') 'Tr@RPA@G0W0 correlation energy (triplet) =',EcRPA(2) - write(*,'(2X,A50,F20.10)') 'Tr@RPA@G0W0 correlation energy =',EcRPA(1) + EcRPA(2) - write(*,'(2X,A50,F20.10)') 'Tr@RPA@G0W0 total energy =',ENuc + ERHF + EcRPA(1) + EcRPA(2) - write(*,*)'-------------------------------------------------------------------------------' - write(*,*) +!--------------! +! Dump results ! +!--------------! + + call print_G0W0(nBas,nO,eHF,ENuc,ERHF,SigC,Z,eGW,EcRPA,EcGM) + +! Deallocate memory + + deallocate(SigC,Z,OmRPA,XpY_RPA,XmY_RPA,rho_RPA,eGWlin) ! Plot stuff -! call plot_GW(nBas,nC,nO,nV,nR,nS,eHF,eGW,Omega(:,ispin),rho(:,:,:,ispin),rhox(:,:,:,ispin)) +! call plot_GW(nBas,nC,nO,nV,nR,nS,eHF,eGW,OmRPA,rho_RPA) ! Perform BSE calculation if(BSE) then - call Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold,eta, & - nBas,nC,nO,nV,nR,nS,ERI,eHF,eGW,Omega,XpY,XmY,rho,EcRPA,EcBSE) + call Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,eHF,eGW,EcBSE) if(exchange_kernel) then - EcRPA(1) = 0.5d0*EcRPA(1) - EcRPA(2) = 1.5d0*EcRPA(1) + EcBSE(1) = 0.5d0*EcBSE(1) + EcBSE(2) = 1.5d0*EcBSE(2) end if @@ -211,15 +216,7 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, end if - call ACFDT(exchange_kernel,doXBS,.true.,TDA_W,TDA,BSE,singlet_manifold,triplet_manifold,eta, & - nBas,nC,nO,nV,nR,nS,ERI,eHF,eGW,Omega,XpY,XmY,rho,EcAC) - - if(exchange_kernel) then - - EcAC(1) = 0.5d0*EcAC(1) - EcAC(2) = 1.5d0*EcAC(1) - - end if + call ACFDT(exchange_kernel,doXBS,.true.,TDA_W,TDA,BSE,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,eHF,eGW,EcAC) write(*,*) write(*,*)'-------------------------------------------------------------------------------' diff --git a/src/QuAcK/RPAx.f90 b/src/QuAcK/RPAx.f90 index 06c298a..ca9f709 100644 --- a/src/QuAcK/RPAx.f90 +++ b/src/QuAcK/RPAx.f90 @@ -1,4 +1,4 @@ -subroutine RPAx(doACFDT,exchange_kernel,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,e) +subroutine RPAx(doACFDT,exchange_kernel,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF) ! Perform random phase approximation calculation with exchange (aka TDHF) @@ -21,7 +21,7 @@ subroutine RPAx(doACFDT,exchange_kernel,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS, integer,intent(in) :: nS double precision,intent(in) :: ENuc double precision,intent(in) :: ERHF - double precision,intent(in) :: e(nBas) + double precision,intent(in) :: eHF(nBas) double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) ! Local variables @@ -58,12 +58,11 @@ subroutine RPAx(doACFDT,exchange_kernel,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS, ispin = 1 - call linear_response(ispin,.false.,.false.,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,e,ERI,rho, & + call linear_response(ispin,.false.,.false.,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,Omega(:,ispin),rho, & EcRPAx(ispin),Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) - call print_excitation('RPAx ',ispin,nS,Omega(:,ispin)) + call print_excitation('RPAx@HF ',ispin,nS,Omega(:,ispin)) call print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) - endif ! Triplet manifold @@ -72,9 +71,9 @@ subroutine RPAx(doACFDT,exchange_kernel,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS, ispin = 2 - call linear_response(ispin,.false.,.false.,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,e,ERI,rho, & + call linear_response(ispin,.false.,.false.,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,rho,Omega(:,ispin), & EcRPAx(ispin),Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) - call print_excitation('RPAx ',ispin,nS,Omega(:,ispin)) + call print_excitation('RPAx@HF ',ispin,nS,Omega(:,ispin)) call print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) endif @@ -105,14 +104,7 @@ subroutine RPAx(doACFDT,exchange_kernel,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS, write(*,*) call ACFDT(exchange_kernel,.false.,.false.,.false.,.false.,.false.,singlet,triplet,eta, & - nBas,nC,nO,nV,nR,nS,ERI,e,e,Omega,XpY,XmY,rho,EcAC) - - if(exchange_kernel) then - - EcAC(1) = 0.5d0*EcAC(1) - EcAC(2) = 1.5d0*EcAC(2) - - end if + nBas,nC,nO,nV,nR,nS,ERI,eHF,eHF,EcAC) write(*,*) write(*,*)'-------------------------------------------------------------------------------' diff --git a/src/QuAcK/dRPA.f90 b/src/QuAcK/dRPA.f90 index b807497..d17ed51 100644 --- a/src/QuAcK/dRPA.f90 +++ b/src/QuAcK/dRPA.f90 @@ -1,5 +1,5 @@ -subroutine dRPA(doACFDT,exchange_kernel,singlet_manifold,triplet_manifold,eta, & - nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,e) +subroutine dRPA(doACFDT,exchange_kernel,singlet,triplet,eta, & + nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF) ! Perform a direct random phase approximation calculation @@ -11,8 +11,8 @@ subroutine dRPA(doACFDT,exchange_kernel,singlet_manifold,triplet_manifold,eta, & logical,intent(in) :: doACFDT logical,intent(in) :: exchange_kernel - logical,intent(in) :: singlet_manifold - logical,intent(in) :: triplet_manifold + logical,intent(in) :: singlet + logical,intent(in) :: triplet double precision,intent(in) :: eta integer,intent(in) :: nBas integer,intent(in) :: nC @@ -22,7 +22,7 @@ subroutine dRPA(doACFDT,exchange_kernel,singlet_manifold,triplet_manifold,eta, & integer,intent(in) :: nS double precision,intent(in) :: ENuc double precision,intent(in) :: ERHF - double precision,intent(in) :: e(nBas) + double precision,intent(in) :: eHF(nBas) double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) ! Local variables @@ -40,7 +40,7 @@ subroutine dRPA(doACFDT,exchange_kernel,singlet_manifold,triplet_manifold,eta, & write(*,*) write(*,*)'***********************************************' - write(*,*)'| random-phase approximation calculation |' + write(*,*)'| Random-phase approximation calculation |' write(*,*)'***********************************************' write(*,*) @@ -55,32 +55,34 @@ subroutine dRPA(doACFDT,exchange_kernel,singlet_manifold,triplet_manifold,eta, & ! Singlet manifold - if(singlet_manifold) then + if(singlet) then ispin = 1 - call linear_response(ispin,.true.,.false.,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,e,ERI,rho, & + call linear_response(ispin,.true.,.false.,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,rho,Omega(:,ispin), & EcRPA(ispin),Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) - call print_excitation('RPA ',ispin,nS,Omega(:,ispin)) + call print_excitation('RPA@HF ',ispin,nS,Omega(:,ispin)) + call print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) endif ! Triplet manifold - if(triplet_manifold) then + if(triplet) then ispin = 2 - call linear_response(ispin,.true.,.false.,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,e,ERI,rho, & + call linear_response(ispin,.true.,.false.,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,rho,Omega(:,ispin), & EcRPA(ispin),Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) - call print_excitation('RPA ',ispin,nS,Omega(:,ispin)) + call print_excitation('RPA@HF ',ispin,nS,Omega(:,ispin)) + call print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) endif if(exchange_kernel) then EcRPA(1) = 0.5d0*EcRPA(1) - EcRPA(2) = 1.5d0*EcRPA(1) + EcRPA(2) = 1.5d0*EcRPA(2) end if @@ -103,13 +105,13 @@ subroutine dRPA(doACFDT,exchange_kernel,singlet_manifold,triplet_manifold,eta, & write(*,*) '------------------------------------------------------' write(*,*) - call ACFDT(exchange_kernel,.false.,.true.,.false.,.false.,.false.,singlet_manifold,triplet_manifold,eta, & - nBas,nC,nO,nV,nR,nS,ERI,e,e,Omega,XpY,XmY,rho,EcAC) + call ACFDT(exchange_kernel,.false.,.true.,.false.,.false.,.false.,singlet,triplet,eta, & + nBas,nC,nO,nV,nR,nS,ERI,eHF,eHF,EcAC) if(exchange_kernel) then EcAC(1) = 0.5d0*EcAC(1) - EcAC(2) = 1.5d0*EcAC(1) + EcAC(2) = 1.5d0*EcAC(2) end if diff --git a/src/QuAcK/evGW.f90 b/src/QuAcK/evGW.f90 index 625c1fa..79f2dc2 100644 --- a/src/QuAcK/evGW.f90 +++ b/src/QuAcK/evGW.f90 @@ -1,5 +1,6 @@ -subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,G0W,GW0, & - singlet_manifold,triplet_manifold,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,Hc,H,ERI,PHF,cHF,eHF,eG0W0) +subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & + G0W,GW0,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,Hc,H, & + ERI,PHF,cHF,eHF,eG0W0) ! Perform self-consistent eigenvalue-only GW calculation @@ -26,8 +27,8 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE logical,intent(in) :: evDyn logical,intent(in) :: G0W logical,intent(in) :: GW0 - logical,intent(in) :: singlet_manifold - logical,intent(in) :: triplet_manifold + logical,intent(in) :: singlet + logical,intent(in) :: triplet double precision,intent(in) :: eta integer,intent(in) :: nBas,nC,nO,nV,nR,nS double precision,intent(in) :: eHF(nBas) @@ -46,7 +47,7 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE integer :: n_diis double precision :: rcond double precision :: Conv - double precision :: EcRPA(nspin) + double precision :: EcRPA double precision :: EcBSE(nspin) double precision :: EcAC(nspin) double precision :: EcGM @@ -57,11 +58,10 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE double precision,allocatable :: eOld(:) double precision,allocatable :: Z(:) double precision,allocatable :: SigC(:) - double precision,allocatable :: Omega(:,:) - double precision,allocatable :: XpY(:,:,:) - double precision,allocatable :: XmY(:,:,:) - double precision,allocatable :: rho(:,:,:,:) - double precision,allocatable :: rhox(:,:,:,:) + double precision,allocatable :: OmRPA(:) + double precision,allocatable :: XpY_RPA(:,:) + double precision,allocatable :: XmY_RPA(:,:) + double precision,allocatable :: rho_RPA(:,:,:) ! Hello world @@ -73,23 +73,45 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE ! SOSEX correction - if(SOSEX) write(*,*) 'SOSEX correction activated!' - write(*,*) + if(SOSEX) then + write(*,*) 'SOSEX correction activated but BUG!' + stop + end if ! COHSEX approximation - if(COHSEX) write(*,*) 'COHSEX approximation activated!' - write(*,*) + if(COHSEX) then + write(*,*) 'COHSEX approximation activated!' + write(*,*) + end if ! TDA for W - if(TDA_W) write(*,*) 'Tamm-Dancoff approximation for dynamic screening!' - write(*,*) + if(TDA_W) then + write(*,*) 'Tamm-Dancoff approximation for dynamic screening!' + write(*,*) + end if ! TDA - if(TDA) write(*,*) 'Tamm-Dancoff approximation activated!' - write(*,*) + if(TDA) then + write(*,*) 'Tamm-Dancoff approximation activated!' + write(*,*) + end if + +! GW0 + + if(GW0) then + write(*,*) 'GW0 scheme activated!' + write(*,*) + end if + +! G0W + + if(G0W) then + write(*,*) 'G0W scheme activated!' + write(*,*) + end if ! Linear mixing @@ -98,10 +120,8 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE ! Memory allocation - allocate(eGW(nBas),eOld(nBas),Z(nBas),SigC(nBas),Omega(nS,nspin), & - XpY(nS,nS,nspin),XmY(nS,nS,nspin), & - rho(nBas,nBas,nS,nspin),rhox(nBas,nBas,nS,nspin), & - error_diis(nBas,max_diis),e_diis(nBas,max_diis)) + allocate(eGW(nBas),eOld(nBas),Z(nBas),SigC(nBas),OmRPA(nS),XpY_RPA(nS,nS),XmY_RPA(nS,nS), & + rho_RPA(nBas,nBas,nS),error_diis(nBas,max_diis),e_diis(nBas,max_diis)) ! Initialization @@ -121,36 +141,30 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE do while(Conv > thresh .and. nSCF <= maxSCF) - ! Compute linear response + ! Compute screening if(.not. GW0 .or. nSCF == 0) then - call linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI, & - rho(:,:,:,ispin),EcRPA(ispin),Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + call linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI,OmRPA, & + rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA) endif +! Compute spectral weights + + call excitation_density(nBas,nC,nO,nR,nS,ERI,XpY_RPA,rho_RPA) + ! Compute correlation part of the self-energy - call excitation_density(nBas,nC,nO,nR,nS,ERI,XpY(:,:,ispin),rho(:,:,:,ispin)) - - if(SOSEX) call excitation_density_SOSEX(nBas,nC,nO,nR,nS,ERI,XpY(:,:,ispin),rhox(:,:,:,ispin)) - - ! Correlation self-energy - if(G0W) then - call self_energy_correlation_diag(COHSEX,SOSEX,eta,nBas,nC,nO,nV,nR,nS,eHF, & - Omega(:,ispin),rho(:,:,:,ispin),rhox(:,:,:,ispin),EcGM,SigC) - call renormalization_factor(COHSEX,SOSEX,eta,nBas,nC,nO,nV,nR,nS,eHF, & - Omega(:,ispin),rho(:,:,:,ispin),rhox(:,:,:,ispin),Z(:)) + call self_energy_correlation_diag(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,EcGM,SigC) + call renormalization_factor(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,Z) else - call self_energy_correlation_diag(COHSEX,SOSEX,eta,nBas,nC,nO,nV,nR,nS,eGW, & - Omega(:,ispin),rho(:,:,:,ispin),rhox(:,:,:,ispin),EcGM,SigC) - call renormalization_factor(COHSEX,SOSEX,eta,nBas,nC,nO,nV,nR,nS,eGW, & - Omega(:,ispin),rho(:,:,:,ispin),rhox(:,:,:,ispin),Z(:)) + call self_energy_correlation_diag(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA,EcGM,SigC) + call renormalization_factor(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA,Z) endif @@ -164,8 +178,7 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE ! Print results -! call print_excitation('RPA ',ispin,nS,Omega(:,ispin)) - call print_evGW(nBas,nO,nSCF,Conv,eHF,ENuc,ERHF,SigC,Z,eGW) + call print_evGW(nBas,nO,nSCF,Conv,eHF,ENuc,ERHF,SigC,Z,eGW,EcRPA,EcGM) ! Linear mixing or DIIS extrapolation @@ -215,23 +228,22 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE endif -! Dump the RPA correlation energy +! Deallocate memory - write(*,*) - write(*,*)'-------------------------------------------------------------------------------' - write(*,'(2X,A50,F20.10)') 'Tr@RPA@evGW correlation energy (singlet) =',EcRPA(1) - write(*,'(2X,A50,F20.10)') 'Tr@RPA@evGW correlation energy (triplet) =',EcRPA(2) - write(*,'(2X,A50,F20.10)') 'Tr@RPA@evGW correlation energy =',EcRPA(1) + EcRPA(2) - write(*,'(2X,A50,F20.10)') 'Tr@RPA@evGW total energy =',ENuc + ERHF + EcRPA(1) + EcRPA(2) - write(*,*)'-------------------------------------------------------------------------------' - write(*,*) + deallocate(eOld,Z,SigC,OmRPA,XpY_RPA,XmY_RPA,rho_RPA,error_diis,e_diis) ! Perform BSE calculation if(BSE) then - call Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold,eta, & - nBas,nC,nO,nV,nR,nS,ERI,eGW,eGW,Omega,XpY,XmY,rho,EcRPA,EcBSE) + call Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,eGW,eGW,EcBSE) + + if(exchange_kernel) then + + EcBSE(1) = 0.5d0*EcBSE(1) + EcBSE(2) = 1.5d0*EcBSE(2) + + end if write(*,*) write(*,*)'-------------------------------------------------------------------------------' @@ -258,8 +270,7 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE end if - call ACFDT(exchange_kernel,doXBS,.true.,TDA_W,TDA,BSE,singlet_manifold,triplet_manifold,eta, & - nBas,nC,nO,nV,nR,nS,ERI,eGW,eGW,Omega,XpY,XmY,rho,EcAC) + call ACFDT(exchange_kernel,doXBS,.true.,TDA_W,TDA,BSE,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,eGW,eGW,EcAC) write(*,*) write(*,*)'-------------------------------------------------------------------------------' diff --git a/src/QuAcK/linear_response.f90 b/src/QuAcK/linear_response.f90 index c3ea157..e443d52 100644 --- a/src/QuAcK/linear_response.f90 +++ b/src/QuAcK/linear_response.f90 @@ -1,4 +1,4 @@ -subroutine linear_response(ispin,dRPA,TDA,BSE,eta,nBas,nC,nO,nV,nR,nS,lambda,e,ERI,rho,EcRPA,Omega,XpY,XmY) +subroutine linear_response(ispin,dRPA,TDA,BSE,eta,nBas,nC,nO,nV,nR,nS,lambda,e,ERI,Omega_RPA,rho_RPA,EcRPA,Omega,XpY,XmY) ! Compute linear response @@ -12,8 +12,10 @@ subroutine linear_response(ispin,dRPA,TDA,BSE,eta,nBas,nC,nO,nV,nR,nS,lambda,e,E integer,intent(in) :: ispin,nBas,nC,nO,nV,nR,nS double precision,intent(in) :: lambda double precision,intent(in) :: e(nBas) - double precision,intent(in) :: rho(nBas,nBas,nS) double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + + double precision,intent(in) :: Omega_RPA(nS) + double precision,intent(in) :: rho_RPA(nBas,nBas,nS) ! Local variables @@ -42,7 +44,7 @@ subroutine linear_response(ispin,dRPA,TDA,BSE,eta,nBas,nC,nO,nV,nR,nS,lambda,e,E call linear_response_A_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nS,lambda,e,ERI,A) - if(BSE) call Bethe_Salpeter_A_matrix(eta,nBas,nC,nO,nV,nR,nS,lambda,ERI,Omega,rho,A) + if(BSE) call Bethe_Salpeter_A_matrix(eta,nBas,nC,nO,nV,nR,nS,lambda,ERI,Omega_RPA,rho_RPA,A) ! Tamm-Dancoff approximation @@ -51,7 +53,7 @@ subroutine linear_response(ispin,dRPA,TDA,BSE,eta,nBas,nC,nO,nV,nR,nS,lambda,e,E call linear_response_B_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nS,lambda,ERI,B) - if(BSE) call Bethe_Salpeter_B_matrix(eta,nBas,nC,nO,nV,nR,nS,lambda,ERI,Omega,rho,B) + if(BSE) call Bethe_Salpeter_B_matrix(eta,nBas,nC,nO,nV,nR,nS,lambda,ERI,Omega_RPA,rho_RPA,B) end if diff --git a/src/QuAcK/plot_GW.f90 b/src/QuAcK/plot_GW.f90 index 11c7f0c..fedc40c 100644 --- a/src/QuAcK/plot_GW.f90 +++ b/src/QuAcK/plot_GW.f90 @@ -1,4 +1,4 @@ -subroutine plot_GW(nBas,nC,nO,nV,nR,nS,eHF,eGW,Omega,rho,rhox) +subroutine plot_GW(nBas,nC,nO,nV,nR,nS,eHF,eGW,Omega,rho) ! Dump several GW quantities for external plotting @@ -8,7 +8,7 @@ subroutine plot_GW(nBas,nC,nO,nV,nR,nS,eHF,eGW,Omega,rho,rhox) ! Input variables integer,intent(in) :: nBas,nC,nO,nV,nR,nS - double precision,intent(in) :: eHF(nBas),eGW(nBas),Omega(nS),rho(nBas,nBas,nS),rhox(nBas,nBas,nS) + double precision,intent(in) :: eHF(nBas),eGW(nBas),Omega(nS),rho(nBas,nBas,nS) ! Local variables diff --git a/src/QuAcK/print_G0W0.f90 b/src/QuAcK/print_G0W0.f90 index d1ee3f4..782643b 100644 --- a/src/QuAcK/print_G0W0.f90 +++ b/src/QuAcK/print_G0W0.f90 @@ -40,8 +40,8 @@ subroutine print_G0W0(nBas,nO,e,ENuc,EHF,SigmaC,Z,eGW,EcRPA,EcGM) write(*,'(2X,A30,F15.6)') 'G0W0 LUMO energy (eV):',eGW(LUMO)*HaToeV write(*,'(2X,A30,F15.6)') 'G0W0 HOMO-LUMO gap (eV):',Gap*HaToeV write(*,*)'-------------------------------------------------------------------------------' - write(*,'(2X,A30,F15.6)') 'RPA@HF total energy =',ENuc + EHF + EcRPA - write(*,'(2X,A30,F15.6)') 'RPA@HF correlation energy =',EcRPA + write(*,'(2X,A30,F15.6)') 'RPA@G0W0 total energy =',ENuc + EHF + EcRPA + write(*,'(2X,A30,F15.6)') 'RPA@G0W0 correlation energy =',EcRPA write(*,'(2X,A30,F15.6)') 'GM@G0W0 total energy =',ENuc + EHF + EcGM write(*,'(2X,A30,F15.6)') 'GM@G0W0 correlation energy =',EcGM write(*,*)'-------------------------------------------------------------------------------' diff --git a/src/QuAcK/print_evGW.f90 b/src/QuAcK/print_evGW.f90 index 0bf95b5..8db2956 100644 --- a/src/QuAcK/print_evGW.f90 +++ b/src/QuAcK/print_evGW.f90 @@ -1,4 +1,4 @@ -subroutine print_evGW(nBas,nO,nSCF,Conv,e,ENuc,EHF,SigmaC,Z,eGW) +subroutine print_evGW(nBas,nO,nSCF,Conv,e,ENuc,EHF,SigC,Z,eGW,EcRPA,EcGM) ! Print one-electron energies and other stuff for evGW @@ -8,9 +8,15 @@ subroutine print_evGW(nBas,nO,nSCF,Conv,e,ENuc,EHF,SigmaC,Z,eGW) integer,intent(in) :: nBas,nO,nSCF double precision,intent(in) :: ENuc double precision,intent(in) :: EHF - double precision,intent(in) :: Conv,e(nBas),SigmaC(nBas),Z(nBas),eGW(nBas) + double precision,intent(in) :: Conv + double precision,intent(in) :: e(nBas) + double precision,intent(in) :: SigC(nBas) + double precision,intent(in) :: Z(nBas) + double precision,intent(in) :: eGW(nBas) + double precision,intent(in) :: EcRPA + double precision,intent(in) :: EcGM - integer :: x,HOMO,LUMO + integer :: p,HOMO,LUMO double precision :: Gap ! HOMO and LUMO @@ -32,9 +38,9 @@ subroutine print_evGW(nBas,nO,nSCF,Conv,e,ENuc,EHF,SigmaC,Z,eGW) '|','#','|','e_HF (eV)','|','Sigma_c (eV)','|','Z','|','e_QP (eV)','|' write(*,*)'-------------------------------------------------------------------------------' - do x=1,nBas + 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)') & - '|',x,'|',e(x)*HaToeV,'|',SigmaC(x)*HaToeV,'|',Z(x),'|',eGW(x)*HaToeV,'|' + '|',p,'|',e(p)*HaToeV,'|',SigC(p)*HaToeV,'|',Z(p),'|',eGW(p)*HaToeV,'|' enddo write(*,*)'-------------------------------------------------------------------------------' @@ -45,11 +51,11 @@ subroutine print_evGW(nBas,nO,nSCF,Conv,e,ENuc,EHF,SigmaC,Z,eGW) write(*,'(2X,A30,F15.6)') 'evGW LUMO energy (eV):',eGW(LUMO)*HaToeV write(*,'(2X,A30,F15.6)') 'evGW HOMO-LUMO gap (eV):',Gap*HaToeV write(*,*)'-------------------------------------------------------------------------------' -! write(*,'(2X,A30,F15.6)') 'RPA@evGW total energy =',ENuc + EHF + EcRPA -! write(*,'(2X,A30,F15.6)') 'RPA@evGW correlation energy =',EcRPA -! write(*,'(2X,A30,F15.6)') 'GM@evGW total energy =',ENuc + EHF + EcGM -! write(*,'(2X,A30,F15.6)') 'GM@evGW correlation energy =',EcGM -! write(*,*)'-------------------------------------------------------------------------------' + write(*,'(2X,A30,F15.6)') 'RPA@evGW total energy =',ENuc + EHF + EcRPA + write(*,'(2X,A30,F15.6)') 'RPA@evGW correlation energy =',EcRPA + write(*,'(2X,A30,F15.6)') 'GM@evGW total energy =',ENuc + EHF + EcGM + write(*,'(2X,A30,F15.6)') 'GM@evGW correlation energy =',EcGM + write(*,*)'-------------------------------------------------------------------------------' write(*,*) end subroutine print_evGW diff --git a/src/QuAcK/print_excitation.f90 b/src/QuAcK/print_excitation.f90 index e5ce17b..7aec451 100644 --- a/src/QuAcK/print_excitation.f90 +++ b/src/QuAcK/print_excitation.f90 @@ -26,7 +26,7 @@ subroutine print_excitation(method,ispin,nS,Omega) write(*,*) write(*,*)'-------------------------------------------------------------' - write(*,'(1X,A1,1X,A14,A14,A14,A9,A13)')'|',method,' calculation: ',spin_manifold,' manifold',' |' + write(*,'(1X,A14,A14,A14,A9)') method,' calculation: ',spin_manifold,' manifold' write(*,*)'-------------------------------------------------------------' write(*,'(1X,A1,1X,A5,1X,A1,1X,A23,1X,A1,1X,A23,1X,A1,1X)') & '|','State','|',' Excitation energy (au) ','|',' Excitation energy (eV) ','|' diff --git a/src/QuAcK/print_qsGW.f90 b/src/QuAcK/print_qsGW.f90 index b61bdd3..9f3cf62 100644 --- a/src/QuAcK/print_qsGW.f90 +++ b/src/QuAcK/print_qsGW.f90 @@ -70,8 +70,8 @@ subroutine print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,ENuc,P,T,V,Hc,J,K,F,Sig write(*,'(2X,A30,F15.6)') 'qsGW GM total energy =',EqsGW + ENuc + EcGM write(*,'(2X,A30,F15.6)') 'qsGW exchange energy =',Ex write(*,'(2X,A30,F15.6)') 'qsGW correlation energy =',Ec -! write(*,'(2X,A30,F15.6)') 'RPA@qsGW correlation energy =',EcRPA -! write(*,'(2X,A30,F15.6)') 'GM@qsGW correlation energy =',EcGM + write(*,'(2X,A30,F15.6)') 'RPA@qsGW correlation energy =',EcRPA + write(*,'(2X,A30,F15.6)') 'GM@qsGW correlation energy =',EcGM write(*,*)'-------------------------------------------' write(*,*) @@ -95,7 +95,6 @@ subroutine print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,ENuc,P,T,V,Hc,J,K,F,Sig write(*,'(A32,1X,F16.10)') ' Electronic energy ',EqsGW write(*,'(A32,1X,F16.10)') ' Nuclear repulsion ',ENuc write(*,'(A32,1X,F16.10)') ' qsGW energy ',ENuc + EqsGW -! write(*,'(A32,1X,F16.10)') ' RPA corr. energy ',EcRPA write(*,'(A50)') '---------------------------------------' write(*,*) diff --git a/src/QuAcK/qsGW.f90 b/src/QuAcK/qsGW.f90 index dad60a5..b1fbfe2 100644 --- a/src/QuAcK/qsGW.f90 +++ b/src/QuAcK/qsGW.f90 @@ -1,6 +1,6 @@ -subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, & - COHSEX,SOSEX,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,G0W,GW0,singlet_manifold,triplet_manifold,eta, & - nBas,nC,nO,nV,nR,nS,ENuc,ERHF,S,X,T,V,Hc,ERI_AO_basis,ERI_MO_basis,PHF,cHF,eHF) +subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & + G0W,GW0,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,S,X,T,V, & + Hc,ERI_AO_basis,ERI_MO_basis,PHF,cHF,eHF) ! Perform a quasiparticle self-consistent GW calculation @@ -25,8 +25,8 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, logical,intent(in) :: evDyn logical,intent(in) :: G0W logical,intent(in) :: GW0 - logical,intent(in) :: singlet_manifold - logical,intent(in) :: triplet_manifold + logical,intent(in) :: singlet + logical,intent(in) :: triplet double precision,intent(in) :: eta integer,intent(in) :: nBas,nC,nO,nV,nR,nS double precision,intent(in) :: ENuc @@ -49,7 +49,7 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, integer :: ispin integer :: n_diis double precision :: EqsGW - double precision :: EcRPA(nspin) + double precision :: EcRPA double precision :: EcBSE(nspin) double precision :: EcAC(nspin) double precision :: EcGM @@ -58,11 +58,10 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, double precision,external :: trace_matrix double precision,allocatable :: error_diis(:,:) double precision,allocatable :: F_diis(:,:) - double precision,allocatable :: Omega(:,:) - double precision,allocatable :: XpY(:,:,:) - double precision,allocatable :: XmY(:,:,:) - double precision,allocatable :: rho(:,:,:,:) - double precision,allocatable :: rhox(:,:,:,:) + double precision,allocatable :: OmRPA(:) + double precision,allocatable :: XpY_RPA(:,:) + double precision,allocatable :: XmY_RPA(:,:) + double precision,allocatable :: rho_RPA(:,:,:) double precision,allocatable :: c(:,:) double precision,allocatable :: cp(:,:) double precision,allocatable :: eGW(:) @@ -96,29 +95,37 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, ! SOSEX correction - if(SOSEX) write(*,*) 'SOSEX correction activated!' - write(*,*) + if(SOSEX) then + write(*,*) 'SOSEX correction activated but BUG!' + stop + end if ! COHSEX approximation - if(COHSEX) write(*,*) 'COHSEX approximation activated!' - write(*,*) + if(COHSEX) then + write(*,*) 'COHSEX approximation activated!' + write(*,*) + end if ! TDA for W - if(TDA_W) write(*,*) 'Tamm-Dancoff approximation for dynamic screening!' - write(*,*) + if(TDA_W) then + write(*,*) 'Tamm-Dancoff approximation for dynamic screening!' + write(*,*) + end if ! TDA - if(TDA) write(*,*) 'Tamm-Dancoff approximation activated!' - write(*,*) + if(TDA) then + write(*,*) 'Tamm-Dancoff approximation activated!' + write(*,*) + end if ! Memory allocation allocate(eGW(nBas),c(nBas,nBas),cp(nBas,nBas),P(nBas,nBas),F(nBas,nBas),Fp(nBas,nBas), & J(nBas,nBas),K(nBas,nBas),SigC(nBas,nBas),SigCp(nBas,nBas),SigCm(nBas,nBas),Z(nBas), & - Omega(nS,nspin),XpY(nS,nS,nspin),XmY(nS,nS,nspin),rho(nBas,nBas,nS,nspin),rhox(nBas,nBas,nS,nspin), & + OmRPA(nS),XpY_RPA(nS,nS),XmY_RPA(nS,nS),rho_RPA(nBas,nBas,nS), & error(nBas,nBas),error_diis(nBasSq,max_diis),F_diis(nBasSq,max_diis)) ! Initialization @@ -156,29 +163,23 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, if(.not. GW0 .or. nSCF == 0) then call linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI_MO_basis, & - rho(:,:,:,ispin),EcRPA(ispin),Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + OmRPA,rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA) endif ! Compute correlation part of the self-energy - call excitation_density(nBas,nC,nO,nR,nS,ERI_MO_basis,XpY(:,:,ispin),rho(:,:,:,ispin)) - - if(SOSEX) call excitation_density_SOSEX(nBas,nC,nO,nR,nS,ERI_MO_basis,XpY(:,:,ispin),rhox(:,:,:,ispin)) + call excitation_density(nBas,nC,nO,nR,nS,ERI_MO_basis,XpY_RPA,rho_RPA) if(G0W) then - call self_energy_correlation(COHSEX,SOSEX,eta,nBas,nC,nO,nV,nR,nS,eHF, & - Omega(:,ispin),rho(:,:,:,ispin),rhox(:,:,:,ispin),EcGM,SigC) - call renormalization_factor(COHSEX,SOSEX,eta,nBas,nC,nO,nV,nR,nS,eHF, & - Omega(:,ispin),rho(:,:,:,ispin),rhox(:,:,:,ispin),Z) + call self_energy_correlation(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,EcGM,SigC) + call renormalization_factor(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,Z) else - call self_energy_correlation(COHSEX,SOSEX,eta,nBas,nC,nO,nV,nR,nS,eGW, & - Omega(:,ispin),rho(:,:,:,ispin),rhox(:,:,:,ispin),EcGM,SigC) - call renormalization_factor(COHSEX,SOSEX,eta,nBas,nC,nO,nV,nR,nS,eGW, & - Omega(:,ispin),rho(:,:,:,ispin),rhox(:,:,:,ispin),Z) + call self_energy_correlation(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA,EcGM,SigC) + call renormalization_factor(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA,Z) endif @@ -221,7 +222,7 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, ! Print results ! call print_excitation('RPA ',ispin,nS,Omega(:,ispin)) - call print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,ENuc,P,T,V,Hc,J,K,F,SigCp,Z,EcRPA(ispin),EcGM,EqsGW) + call print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,ENuc,P,T,V,Hc,J,K,F,SigCp,Z,EcRPA,EcGM,EqsGW) ! Increment @@ -258,23 +259,22 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, endif -! Dump RPA correlation energy +! Deallocate memory - write(*,*) - write(*,*)'-------------------------------------------------------------------------------' - write(*,'(2X,A50,F20.10)') 'Tr@RPA@qsGW correlation energy (singlet) =',EcRPA(1) - write(*,'(2X,A50,F20.10)') 'Tr@RPA@qsGW correlation energy (triplet) =',EcRPA(2) - write(*,'(2X,A50,F20.10)') 'Tr@RPA@qsGW correlation energy =',EcRPA(1) + EcRPA(2) - write(*,'(2X,A50,F20.10)') 'Tr@RPA@qsGW total energy =',ENuc + EqsGW + EcRPA(1) + EcRPA(2) - write(*,*)'-------------------------------------------------------------------------------' - write(*,*) + deallocate(c,cp,P,F,Fp,J,K,SigC,SigCp,SigCm,Z,OmRPA,XpY_RPA,XmY_RPA,rho_RPA,error,error_diis,F_diis) ! Perform BSE calculation if(BSE) then - call Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold,eta, & - nBas,nC,nO,nV,nR,nS,ERI_MO_basis,eGW,eGW,Omega,XpY,XmY,rho,EcRPA,EcBSE) + call Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI_MO_basis,eGW,eGW,EcBSE) + + if(exchange_kernel) then + + EcBSE(1) = 0.5d0*EcBSE(1) + EcBSE(2) = 1.5d0*EcBSE(2) + + end if write(*,*) write(*,*)'-------------------------------------------------------------------------------' @@ -301,8 +301,7 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, end if - call ACFDT(exchange_kernel,doXBS,.true.,TDA_W,TDA,BSE,singlet_manifold,triplet_manifold,eta, & - nBas,nC,nO,nV,nR,nS,ERI_MO_basis,eGW,eGW,Omega,XpY,XmY,rho,EcAC) + call ACFDT(exchange_kernel,doXBS,.true.,TDA_W,TDA,BSE,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI_MO_basis,eGW,eGW,EcAC) write(*,*) write(*,*)'-------------------------------------------------------------------------------' diff --git a/src/QuAcK/renormalization_factor.f90 b/src/QuAcK/renormalization_factor.f90 index 15e3bf2..10f2849 100644 --- a/src/QuAcK/renormalization_factor.f90 +++ b/src/QuAcK/renormalization_factor.f90 @@ -1,4 +1,4 @@ -subroutine renormalization_factor(COHSEX,SOSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho,rhox,Z) +subroutine renormalization_factor(COHSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho,Z) ! Compute renormalization factor for GW @@ -8,13 +8,11 @@ subroutine renormalization_factor(COHSEX,SOSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega,r ! Input variables logical,intent(in) :: COHSEX - logical,intent(in) :: SOSEX double precision,intent(in) :: eta integer,intent(in) :: nBas,nC,nO,nV,nR,nS double precision,intent(in) :: e(nBas) double precision,intent(in) :: Omega(nS) double precision,intent(in) :: rho(nBas,nBas,nS) - double precision,intent(in) :: rhox(nBas,nBas,nS) ! Local variables @@ -36,40 +34,6 @@ subroutine renormalization_factor(COHSEX,SOSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega,r Z(:) = 1d0 return -! SOSEX correction - - elseif(SOSEX) then - - ! Occupied part of the correlation self-energy - - do x=nC+1,nBas-nR - do i=nC+1,nO - jb = 0 - do j=nC+1,nO - do b=nO+1,nBas-nR - jb = jb + 1 - eps = e(x) - e(i) + Omega(jb) - Z(x) = Z(x) - (rho(x,i,jb)/eps)*(rhox(x,i,jb)/eps) - end do - end do - end do - end do - - ! Virtual part of the correlation self-energy - - do x=nC+1,nBas-nR - do a=nO+1,nBas-nR - jb = 0 - do j=nC+1,nO - do b=nO+1,nBas-nR - jb = jb + 1 - eps = e(x) - e(a) - Omega(jb) - Z(x) = Z(x) - (rho(x,a,jb)/eps)*(rhox(x,a,jb)/eps) - end do - end do - end do - end do - else ! Occupied part of the correlation self-energy diff --git a/src/QuAcK/self_energy_correlation.f90 b/src/QuAcK/self_energy_correlation.f90 index 5baccea..e47a9b4 100644 --- a/src/QuAcK/self_energy_correlation.f90 +++ b/src/QuAcK/self_energy_correlation.f90 @@ -1,4 +1,4 @@ -subroutine self_energy_correlation(COHSEX,SOSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho,rhox,EcGM,SigC) +subroutine self_energy_correlation(COHSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho,EcGM,SigC) ! Compute correlation part of the self-energy @@ -8,13 +8,11 @@ subroutine self_energy_correlation(COHSEX,SOSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega, ! Input variables logical,intent(in) :: COHSEX - logical,intent(in) :: SOSEX double precision,intent(in) :: eta integer,intent(in) :: nBas,nC,nO,nV,nR,nS double precision,intent(in) :: e(nBas) double precision,intent(in) :: Omega(nS) double precision,intent(in) :: rho(nBas,nBas,nS) - double precision,intent(in) :: rhox(nBas,nBas,nS) ! Local variables @@ -30,7 +28,9 @@ subroutine self_energy_correlation(COHSEX,SOSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega, SigC = 0d0 -! COHSEX static approximation +!-----------------------------! +! COHSEX static approximation ! +!-----------------------------! if(COHSEX) then @@ -65,6 +65,10 @@ subroutine self_energy_correlation(COHSEX,SOSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega, else +!----------------! +! GW self-energy ! +!----------------! + ! Occupied part of the correlation self-energy do x=nC+1,nBas-nR @@ -91,36 +95,6 @@ subroutine self_energy_correlation(COHSEX,SOSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega, enddo enddo - if(SOSEX) then - - ! SOSEX: occupied part of the correlation self-energy - - do x=nC+1,nBas-nR - do y=nC+1,nBas-nR - do i=nC+1,nO - do jb=1,nS - eps = e(x) - e(i) + Omega(jb) - SigC(x,y) = SigC(x,y) - rho(x,i,jb)*rhox(y,i,jb)*eps/(eps**2 + eta**2) - enddo - enddo - enddo - enddo - - ! SOSEX: virtual part of the correlation self-energy - - do x=nC+1,nBas-nR - do y=nC+1,nBas-nR - do a=nO+1,nBas-nR - do jb=1,nS - eps = e(x) - e(a) - Omega(jb) - SigC(x,y) = SigC(x,y) - rho(x,a,jb)*rhox(y,a,jb)*eps/(eps**2 + eta**2) - enddo - enddo - enddo - enddo - - endif - endif end subroutine self_energy_correlation diff --git a/src/QuAcK/self_energy_correlation_diag.f90 b/src/QuAcK/self_energy_correlation_diag.f90 index 441806d..59aab3d 100644 --- a/src/QuAcK/self_energy_correlation_diag.f90 +++ b/src/QuAcK/self_energy_correlation_diag.f90 @@ -1,4 +1,4 @@ -subroutine self_energy_correlation_diag(COHSEX,SOSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho,rhox,EcGM,SigC) +subroutine self_energy_correlation_diag(COHSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho,EcGM,SigC) ! Compute diagonal of the correlation part of the self-energy @@ -8,7 +8,6 @@ subroutine self_energy_correlation_diag(COHSEX,SOSEX,eta,nBas,nC,nO,nV,nR,nS,e,O ! Input variables logical,intent(in) :: COHSEX - logical,intent(in) :: SOSEX double precision,intent(in) :: eta integer,intent(in) :: nBas integer,intent(in) :: nC @@ -19,7 +18,6 @@ subroutine self_energy_correlation_diag(COHSEX,SOSEX,eta,nBas,nC,nO,nV,nR,nS,e,O double precision,intent(in) :: e(nBas) double precision,intent(in) :: Omega(nS) double precision,intent(in) :: rho(nBas,nBas,nS) - double precision,intent(in) :: rhox(nBas,nBas,nS) ! Local variables @@ -69,45 +67,6 @@ subroutine self_energy_correlation_diag(COHSEX,SOSEX,eta,nBas,nC,nO,nV,nR,nS,e,O EcGM = EcGM - SigC(i) end do -!----------------------------- -! SOSEX self-energy *BUG* -!----------------------------- - - elseif(SOSEX) then - - ! SOSEX: occupied part of the correlation self-energy - - do p=nC+1,nBas-nR - do i=nC+1,nO - do jb=1,nS - eps = e(p) - e(i) + Omega(jb) - SigC(p) = SigC(p) - rho(p,i,jb)*rhox(p,i,jb)*eps/(eps**2 + eta**2) - end do - end do - end do - - ! SOSEX: virtual part of the correlation self-energy - - do p=nC+1,nBas-nR - do a=nO+1,nBas-nR - do jb=1,nS - eps = e(p) - e(a) - Omega(jb) - SigC(p) = SigC(p) - rho(p,a,jb)*rhox(p,a,jb)*eps/(eps**2 + eta**2) - end do - end do - end do - - ! GM correlation energy - - do i=nC+1,nO - do a=nO+1,nBas-nR - do jb=1,nS - eps = e(a) - e(i) + Omega(jb) - EcGM = EcGM + rho(a,i,jb)*rhox(a,i,jb)*eps/(eps**2 + eta**2) - end do - end do - end do - !----------------------------- ! GW self-energy !----------------------------- From ff58cd17c6436ee49bc4396fdb676d2217044e09 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Thu, 24 Sep 2020 14:39:37 +0200 Subject: [PATCH 10/17] UCIS --- input/basis | 55 ++++---- input/methods | 4 +- input/molecule | 4 +- input/molecule.xyz | 2 +- input/options | 8 +- src/QuAcK/UCIS.f90 | 127 ++++++++++++++++++ src/QuAcK/UG0W0.f90 | 46 +++---- src/QuAcK/UHF.f90 | 4 +- src/QuAcK/URPAx.f90 | 2 + src/QuAcK/USigmaC.f90 | 6 +- src/QuAcK/dUSigmaC.f90 | 6 +- src/QuAcK/print_UG0W0.f90 | 9 +- src/QuAcK/unrestricted_Bethe_Salpeter.f90 | 47 ++++--- .../unrestricted_Bethe_Salpeter_A_matrix.f90 | 24 ++-- .../unrestricted_Bethe_Salpeter_B_matrix.f90 | 24 ++-- src/QuAcK/unrestricted_linear_response.f90 | 18 +-- 16 files changed, 251 insertions(+), 135 deletions(-) create mode 100644 src/QuAcK/UCIS.f90 diff --git a/input/basis b/input/basis index 6f3d2a9..b2b2293 100644 --- a/input/basis +++ b/input/basis @@ -1,39 +1,30 @@ -1 10 +1 6 S 8 - 1 24350.0000000 0.0005020 - 2 3650.0000000 0.0038810 - 3 829.6000000 0.0199970 - 4 234.0000000 0.0784180 - 5 75.6100000 0.2296760 - 6 26.7300000 0.4327220 - 7 9.9270000 0.3506420 - 8 1.1020000 -0.0076450 + 1 1469.0000000 0.0007660 + 2 220.5000000 0.0058920 + 3 50.2600000 0.0296710 + 4 14.2400000 0.1091800 + 5 4.5810000 0.2827890 + 6 1.5800000 0.4531230 + 7 0.5640000 0.2747740 + 8 0.0734500 0.0097510 S 8 - 1 24350.0000000 -0.0001180 - 2 3650.0000000 -0.0009150 - 3 829.6000000 -0.0047370 - 4 234.0000000 -0.0192330 - 5 75.6100000 -0.0603690 - 6 26.7300000 -0.1425080 - 7 9.9270000 -0.1777100 - 8 1.1020000 0.6058360 + 1 1469.0000000 -0.0001200 + 2 220.5000000 -0.0009230 + 3 50.2600000 -0.0046890 + 4 14.2400000 -0.0176820 + 5 4.5810000 -0.0489020 + 6 1.5800000 -0.0960090 + 7 0.5640000 -0.1363800 + 8 0.0734500 0.5751020 S 1 - 1 2.8360000 1.0000000 -S 1 - 1 0.3782000 1.0000000 + 1 0.0280500 1.0000000 P 3 - 1 54.7000000 0.0171510 - 2 12.4300000 0.1076560 - 3 3.6790000 0.3216810 + 1 1.5340000 0.0227840 + 2 0.2749000 0.1391070 + 3 0.0736200 0.5003750 P 1 - 1 1.1430000 1.0000000 -P 1 - 1 0.3300000 1.0000000 + 1 0.0240300 1.0000000 D 1 - 1 4.0140000 1.0000000 -D 1 - 1 1.0960000 1.0000000 -F 1 - 1 2.5440000 1.0000000 - + 1 0.1239000 1.0000000 diff --git a/input/methods b/input/methods index 478a02f..ba17592 100644 --- a/input/methods +++ b/input/methods @@ -1,5 +1,5 @@ # RHF UHF MOM - T F F + F T F # MP2 MP3 MP2-F12 F F F # CCD CCSD CCSD(T) @@ -13,7 +13,7 @@ # G0F2 evGF2 G0F3 evGF3 F F F F # G0W0 evGW qsGW - F F T + T F F # G0T0 evGT qsGT F F F # MCMP2 diff --git a/input/molecule b/input/molecule index edeba31..058d6dd 100644 --- a/input/molecule +++ b/input/molecule @@ -1,4 +1,4 @@ # nAt nEla nElb nCore nRyd - 1 5 5 0 0 + 1 2 1 0 0 # Znuc x y z - Ne 0.0 0.0 0.0 + Li 0.0 0.0 0.0 diff --git a/input/molecule.xyz b/input/molecule.xyz index 1c70680..c9a5a65 100644 --- a/input/molecule.xyz +++ b/input/molecule.xyz @@ -1,3 +1,3 @@ 1 - Ne 0.0000000000 0.0000000000 0.0000000000 + Li 0.0000000000 0.0000000000 0.0000000000 diff --git a/input/options b/input/options index 6af6fdb..55538aa 100644 --- a/input/options +++ b/input/options @@ -5,14 +5,14 @@ # CC: maxSCF thresh DIIS n_diis 64 0.0000001 T 5 # spin: singlet triplet spin_conserved spin_flip TDA - T T T T F + T 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 - 256 0.00001 T 5 T 0.0 F F F F F + 256 0.00001 T 5 F 0.0 F F F F F # ACFDT: AC Kx XBS - F F T + T F T # BSE: BSE dBSE dTDA evDyn - T F T T + T T T T # MCMP2: nMC nEq nWalk dt nPrint iSeed doDrift 1000000 100000 10 0.3 10000 1234 T diff --git a/src/QuAcK/UCIS.f90 b/src/QuAcK/UCIS.f90 new file mode 100644 index 0000000..d27a61b --- /dev/null +++ b/src/QuAcK/UCIS.f90 @@ -0,0 +1,127 @@ +subroutine UCIS(spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,eHF) + +! Perform configuration interaction single calculation` + + implicit none + include 'parameters.h' + +! Input variables + + logical,intent(in) :: spin_conserved + logical,intent(in) :: spin_flip + integer,intent(in) :: nBas + integer,intent(in) :: nC(nspin) + integer,intent(in) :: nO(nspin) + integer,intent(in) :: nV(nspin) + integer,intent(in) :: nR(nspin) + integer,intent(in) :: nS(nspin) + double precision,intent(in) :: eHF(nBas,nspin) + double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_abab(nBas,nBas,nBas,nBas) + +! Local variables + + logical :: dump_matrix = .false. + logical :: dump_trans = .false. + integer :: ispin + double precision :: lambda + + integer :: nS_aa,nS_bb,nS_sc + double precision,allocatable :: A_sc(:,:) + double precision,allocatable :: Omega_sc(:) + + integer :: nS_ab,nS_ba,nS_sf + double precision,allocatable :: A_sf(:,:) + double precision,allocatable :: Omega_sf(:) + +! Hello world + + write(*,*) + write(*,*)'************************************************' + write(*,*)'| Configuration Interaction Singles |' + write(*,*)'************************************************' + write(*,*) + +! Adiabatic connection scaling + + lambda = 1d0 + +!----------------------------! +! Spin-conserved transitions ! +!----------------------------! + + if(spin_conserved) then + + ispin = 1 + + ! Memory allocation + + nS_aa = nS(1) + nS_bb = nS(2) + nS_sc = nS_aa + nS_bb + + allocate(A_sc(nS_sc,nS_sc),Omega_sc(nS_sc)) + + call unrestricted_linear_response_A_matrix(ispin,.false.,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,lambda,eHF, & + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,A_sc) + + if(dump_matrix) then + print*,'CIS matrix (spin-conserved transitions)' + call matout(nS_sc,nS_sc,A_sc) + write(*,*) + endif + + call diagonalize_matrix(nS_sc,A_sc,Omega_sc) + call print_excitation('UCIS ',5,nS_sc,Omega_sc) + + if(dump_trans) then + print*,'Spin-conserved CIS transition vectors' + call matout(nS_sc,nS_sc,A_sc) + write(*,*) + endif + + deallocate(A_sc,Omega_sc) + + endif + +!-----------------------! +! Spin-flip transitions ! +!-----------------------! + + if(spin_flip) then + + ispin = 2 + + ! Memory allocation + + nS_ab = (nO(1) - nC(1))*(nV(2) - nR(2)) + nS_ba = (nO(2) - nC(2))*(nV(1) - nR(1)) + nS_sf = nS_ab + nS_ba + + allocate(A_sf(nS_sf,nS_sf),Omega_sf(nS_sf)) + + call unrestricted_linear_response_A_matrix(ispin,.false.,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sf,nS_sf,lambda,eHF, & + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,A_sf) + + if(dump_matrix) then + print*,'CIS matrix (spin-conserved transitions)' + call matout(nS_sf,nS_sf,A_sf) + write(*,*) + endif + + call diagonalize_matrix(nS_sf,A_sf,Omega_sf) + call print_excitation('UCIS ',6,nS_sf,Omega_sf) + + if(dump_trans) then + print*,'Spin-flip CIS transition vectors' + call matout(nS_sf,nS_sf,A_sf) + write(*,*) + endif + + deallocate(A_sf,Omega_sf) + + endif + +end subroutine UCIS diff --git a/src/QuAcK/UG0W0.f90 b/src/QuAcK/UG0W0.f90 index 10b2b58..5df2b99 100644 --- a/src/QuAcK/UG0W0.f90 +++ b/src/QuAcK/UG0W0.f90 @@ -47,13 +47,16 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev logical :: print_W = .true. integer :: is integer :: ispin - double precision :: EcRPA(nspin) + double precision :: EcRPA double precision :: EcBSE(nspin) double precision :: EcAC(nspin) double precision,allocatable :: SigC(:,:) double precision,allocatable :: Z(:,:) integer :: nS_aa,nS_bb,nS_sc - double precision,allocatable :: Omega_sc(:),XpY_sc(:,:),XmY_sc(:,:),rho_sc(:,:,:,:) + double precision,allocatable :: OmRPA(:) + double precision,allocatable :: XpY_RPA(:,:) + double precision,allocatable :: XmY_RPA(:,:) + double precision,allocatable :: rho_RPA(:,:,:,:) double precision,allocatable :: eGWlin(:,:) @@ -101,8 +104,8 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev nS_bb = nS(2) nS_sc = nS_aa + nS_bb - allocate(SigC(nBas,nspin),Z(nBas,nspin),Omega_sc(nS_sc),XpY_sc(nS_sc,nS_sc),XmY_sc(nS_sc,nS_sc), & - rho_sc(nBas,nBas,nS_sc,nspin),eGWlin(nBas,nspin)) + allocate(SigC(nBas,nspin),Z(nBas,nspin),OmRPA(nS_sc),XpY_RPA(nS_sc,nS_sc),XmY_RPA(nS_sc,nS_sc), & + rho_RPA(nBas,nBas,nS_sc,nspin),eGWlin(nBas,nspin)) !-------------------! ! Compute screening ! @@ -113,27 +116,27 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev ispin = 1 call unrestricted_linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0, & - eHF,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega_sc,rho_sc,EcRPA(ispin),Omega_sc,XpY_sc,XmY_sc) + eHF,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,OmRPA,rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA) - if(print_W) call print_excitation('RPA@UHF',5,nS_sc,Omega_sc) + if(print_W) call print_excitation('RPA@UHF',5,nS_sc,OmRPA) !----------------------! ! Excitation densities ! !----------------------! - call unrestricted_excitation_density(nBas,nC,nO,nR,nS_aa,nS_bb,nS_sc,ERI_aaaa,ERI_aabb,ERI_bbbb,XpY_sc,rho_sc) + call unrestricted_excitation_density(nBas,nC,nO,nR,nS_aa,nS_bb,nS_sc,ERI_aaaa,ERI_aabb,ERI_bbbb,XpY_RPA,rho_RPA) !---------------------! ! Compute self-energy ! !---------------------! - call unrestricted_self_energy_correlation_diag(eta,nBas,nC,nO,nV,nR,nS_sc,eHF,Omega_sc,rho_sc,SigC) + call unrestricted_self_energy_correlation_diag(eta,nBas,nC,nO,nV,nR,nS_sc,eHF,OmRPA,rho_RPA,SigC) !--------------------------------! ! Compute renormalization factor ! !--------------------------------! - call unrestricted_renormalization_factor(eta,nBas,nC,nO,nV,nR,nS_sc,eHF,Omega_sc,rho_sc,Z) + call unrestricted_renormalization_factor(eta,nBas,nC,nO,nV,nR,nS_sc,eHF,OmRPA,rho_RPA,Z) !-----------------------------------! ! Solve the quasi-particle equation ! @@ -153,31 +156,24 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev ! Find graphical solution of the QP equation do is=1,nspin - call unrestricted_QP_graph(nBas,nC(is),nO(is),nV(is),nR(is),nS_sc,eta,eHF(:,is),Omega_sc, & - rho_sc,eGWlin(:,is),eGW(:,is)) + call unrestricted_QP_graph(nBas,nC(is),nO(is),nV(is),nR(is),nS_sc,eta,eHF(:,is),OmRPA, & + rho_RPA(:,:,:,is),eGWlin(:,is),eGW(:,is)) end do end if +! Compute RPA correlation energy + + call unrestricted_linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0, & + eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,OmRPA,rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA) + ! Dump results call print_UG0W0(nBas,nO,eHF,ENuc,EUHF,SigC,Z,eGW,EcRPA) -! Compute the RPA correlation energy - - call unrestricted_linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0, & - eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega_sc,rho_sc,EcRPA(ispin),Omega_sc,XpY_sc,XmY_sc) - - write(*,*) - write(*,*)'-------------------------------------------------------------------------------' - write(*,'(2X,A50,F20.10)') 'Tr@RPA@G0W0 correlation energy =',EcRPA(ispin) - write(*,'(2X,A50,F20.10)') 'Tr@RPA@G0W0 total energy =',ENuc + EUHF + EcRPA(ispin) - write(*,*)'-------------------------------------------------------------------------------' - write(*,*) - ! Free memory - deallocate(Omega_sc,XpY_sc,XmY_sc,rho_sc) + deallocate(OmRPA,XpY_RPA,XmY_RPA,rho_RPA) ! Perform BSE calculation @@ -185,7 +181,7 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev call unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta, & nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab, & - eHF,eGW,EcRPA,EcBSE) + eHF,eGW,EcBSE) ! if(exchange_kernel) then ! diff --git a/src/QuAcK/UHF.f90 b/src/QuAcK/UHF.f90 index 8559d03..34eb9ef 100644 --- a/src/QuAcK/UHF.f90 +++ b/src/QuAcK/UHF.f90 @@ -166,7 +166,8 @@ subroutine UHF(maxSCF,thresh,max_diis,guess_type,nBas,nO,S,T,V,Hc,ERI,X,ENuc,EUH n_diis = min(n_diis+1,max_diis) do ispin=1,nspin - call DIIS_extrapolation(rcond(ispin),nBasSq,nBasSq,n_diis,err_diis(:,:,ispin),F_diis(:,:,ispin),err(:,:,ispin),F(:,:,ispin)) + if(nO(ispin) > 1) call DIIS_extrapolation(rcond(ispin),nBasSq,nBasSq,n_diis,err_diis(:,:,ispin),F_diis(:,:,ispin), & + err(:,:,ispin),F(:,:,ispin)) end do ! Reset DIIS if required @@ -232,7 +233,6 @@ subroutine UHF(maxSCF,thresh,max_diis,guess_type,nBas,nO,S,T,V,Hc,ERI,X,ENuc,EUH ! Compute final UHF energy - call matout(nBas,2,e) call print_UHF(nBas,nO,e,c,ENuc,ET,EV,EJ,Ex,EUHF) end subroutine UHF diff --git a/src/QuAcK/URPAx.f90 b/src/QuAcK/URPAx.f90 index 149c62d..f351ca6 100644 --- a/src/QuAcK/URPAx.f90 +++ b/src/QuAcK/URPAx.f90 @@ -78,6 +78,7 @@ subroutine URPAx(doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,nC,nO call print_excitation('URPAx ',5,nS_sc,Omega_sc) ! call print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + deallocate(Omega_sc,XpY_sc,XmY_sc) endif @@ -100,6 +101,7 @@ subroutine URPAx(doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,nC,nO call print_excitation('URPAx ',6,nS_sf,Omega_sf) ! call print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + deallocate(Omega_sf,XpY_sf,XmY_sf) endif diff --git a/src/QuAcK/USigmaC.f90 b/src/QuAcK/USigmaC.f90 index d701cd7..c5e0817 100644 --- a/src/QuAcK/USigmaC.f90 +++ b/src/QuAcK/USigmaC.f90 @@ -18,7 +18,7 @@ double precision function USigmaC(p,w,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho) integer,intent(in) :: nS double precision,intent(in) :: e(nBas) double precision,intent(in) :: Omega(nS) - double precision,intent(in) :: rho(nBas,nBas,nS,nspin) + double precision,intent(in) :: rho(nBas,nBas,nS) ! Local variables @@ -34,14 +34,14 @@ double precision function USigmaC(p,w,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho) do i=nC+1,nO do jb=1,nS eps = w - e(i) + Omega(jb) - USigmaC = uSigmaC + rho(p,i,jb,1)**2*eps/(eps**2 + eta**2) + USigmaC = uSigmaC + rho(p,i,jb)**2*eps/(eps**2 + eta**2) end do end do do a=nO+1,nBas-nR do jb=1,nS eps = w - e(a) - Omega(jb) - USigmaC = USigmaC + rho(p,a,jb,1)**2*eps/(eps**2 + eta**2) + USigmaC = USigmaC + rho(p,a,jb)**2*eps/(eps**2 + eta**2) end do end do diff --git a/src/QuAcK/dUSigmaC.f90 b/src/QuAcK/dUSigmaC.f90 index cbd0cdb..418e131 100644 --- a/src/QuAcK/dUSigmaC.f90 +++ b/src/QuAcK/dUSigmaC.f90 @@ -18,7 +18,7 @@ double precision function dUSigmaC(p,w,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho) integer,intent(in) :: nS double precision,intent(in) :: e(nBas) double precision,intent(in) :: Omega(nS) - double precision,intent(in) :: rho(nBas,nBas,nS,nspin) + double precision,intent(in) :: rho(nBas,nBas,nS) ! Local variables @@ -34,7 +34,7 @@ double precision function dUSigmaC(p,w,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho) do i=nC+1,nO do jb=1,nS eps = w - e(i) + Omega(jb) - dUSigmaC = dUSigmaC + rho(p,i,jb,1)**2*(eps/(eps**2 + eta**2))**2 + dUSigmaC = dUSigmaC + rho(p,i,jb)**2*(eps/(eps**2 + eta**2))**2 end do end do @@ -43,7 +43,7 @@ double precision function dUSigmaC(p,w,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho) do a=nO+1,nBas-nR do jb=1,nS eps = w - e(a) - Omega(jb) - dUSigmaC = dUSigmaC + rho(p,a,jb,1)**2*(eps/(eps**2 + eta**2))**2 + dUSigmaC = dUSigmaC + rho(p,a,jb)**2*(eps/(eps**2 + eta**2))**2 end do end do diff --git a/src/QuAcK/print_UG0W0.f90 b/src/QuAcK/print_UG0W0.f90 index 3cd21cd..f678a1e 100644 --- a/src/QuAcK/print_UG0W0.f90 +++ b/src/QuAcK/print_UG0W0.f90 @@ -33,9 +33,10 @@ subroutine print_UG0W0(nBas,nO,e,ENuc,EHF,SigC,Z,eGW,EcRPA) write(*,*)' Unrestricted one-shot G0W0 calculation (eV)' write(*,*)'-------------------------------------------------------------------------------& -------------------------------------------------' + write(*,'(A1,A3,A1,A30,A1,A30,A1,A30,A1,A30,A1)') & + '|',' ','|','e_HF ','|','Sig_c ','|','Z ','|','e_QP ','|' write(*,'(A1,A3,A1,2A15,A1,2A15,A1,2A15,A1,2A15,A1)') & - '|','#','|','e_HF up','e_HF dw','|','Sig_c up','Sig_c dw','|', & - 'Z up','Z dw','|','e_QP up','e_QP dw','|' + '|','#','|','up ','dw ','|','up ','dw ','|','up ','dw ','|','up ','dw ','|' write(*,*)'-------------------------------------------------------------------------------& -------------------------------------------------' @@ -52,8 +53,8 @@ subroutine print_UG0W0(nBas,nO,e,ENuc,EHF,SigC,Z,eGW,EcRPA) write(*,'(2X,A30,F15.6)') 'G0W0 HOMO-LUMO gap (eV):',Gap*HaToeV write(*,*)'-------------------------------------------------------------------------------& -------------------------------------------------' - write(*,'(2X,A30,F15.6)') 'RPA@HF total energy =',ENuc + EHF + EcRPA - write(*,'(2X,A30,F15.6)') 'RPA@HF correlation energy =',EcRPA + write(*,'(2X,A30,F15.6)') 'RPA@G0W0 total energy =',ENuc + EHF + EcRPA + write(*,'(2X,A30,F15.6)') 'RPA@G0W0 correlation energy =',EcRPA write(*,*)'-------------------------------------------------------------------------------& -------------------------------------------------' write(*,*) diff --git a/src/QuAcK/unrestricted_Bethe_Salpeter.f90 b/src/QuAcK/unrestricted_Bethe_Salpeter.f90 index 992ee9b..5ac6e9c 100644 --- a/src/QuAcK/unrestricted_Bethe_Salpeter.f90 +++ b/src/QuAcK/unrestricted_Bethe_Salpeter.f90 @@ -1,6 +1,6 @@ subroutine unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta, & nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab, & - eW,eGW,EcRPA,EcBSE) + eW,eGW,EcBSE) ! Compute the Bethe-Salpeter excitation energies @@ -38,10 +38,12 @@ subroutine unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved, integer :: isp_W integer :: nS_aa,nS_bb,nS_sc - double precision,allocatable :: OmRPA_sc(:) - double precision,allocatable :: XpY_RPA_sc(:,:) - double precision,allocatable :: XmY_RPA_sc(:,:) - double precision,allocatable :: rho_RPA_sc(:,:,:,:) + double precision :: EcRPA + double precision,allocatable :: OmRPA(:) + double precision,allocatable :: XpY_RPA(:,:) + double precision,allocatable :: XmY_RPA(:,:) + double precision,allocatable :: rho_RPA(:,:,:,:) + double precision,allocatable :: OmBSE_sc(:) double precision,allocatable :: XpY_BSE_sc(:,:) double precision,allocatable :: XmY_BSE_sc(:,:) @@ -53,48 +55,46 @@ subroutine unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved, ! Output variables - double precision,intent(out) :: EcRPA(nspin) double precision,intent(out) :: EcBSE(nspin) -!----------------------------! -! Spin-conserved excitations ! -!----------------------------! - - isp_W = 1 - ! Memory allocation nS_aa = nS(1) nS_bb = nS(2) nS_sc = nS_aa + nS_bb - allocate(OmRPA_sc(nS_sc),XpY_RPA_sc(nS_sc,nS_sc),XmY_RPA_sc(nS_sc,nS_sc),rho_RPA_sc(nBas,nBas,nS_sc,nspin)) + allocate(OmRPA(nS_sc),XpY_RPA(nS_sc,nS_sc),XmY_RPA(nS_sc,nS_sc),rho_RPA(nBas,nBas,nS_sc,nspin)) + +!--------------------------! +! Spin-conserved screening ! +!--------------------------! + + isp_W = 1 + EcRPA = 0d0 ! Compute spin-conserved RPA screening call unrestricted_linear_response(isp_W,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0, & - eW,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,OmRPA_sc,rho_RPA_sc,EcRPA(isp_W), & - OmRPA_sc,XpY_RPA_sc,XmY_RPA_sc) + eW,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,OmRPA,rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA) -! call print_excitation('RPA@UG0W0',5,nS_sc,OmRPA_sc) + call unrestricted_excitation_density(nBas,nC,nO,nR,nS_aa,nS_bb,nS_sc,ERI_aaaa,ERI_aabb,ERI_bbbb,XpY_RPA,rho_RPA) - call unrestricted_excitation_density(nBas,nC,nO,nR,nS_aa,nS_bb,nS_sc,ERI_aaaa,ERI_aabb,ERI_bbbb, & - XpY_RPA_sc,rho_RPA_sc) + +!----------------------------! +! Spin-conserved excitations ! +!----------------------------! if(spin_conserved) then ispin = 1 - EcBSE(ispin) = 0d0 allocate(OmBSE_sc(nS_sc),XpY_BSE_sc(nS_sc,nS_sc),XmY_BSE_sc(nS_sc,nS_sc)) ! Compute spin-conserved BSE excitation energies - OmBSE_sc(:) = OmRPA_sc(:) - call unrestricted_linear_response(ispin,.true.,TDA,.true.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0, & - eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,OmRPA_sc,rho_RPA_sc,EcBSE(ispin), & + eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,OmRPA,rho_RPA,EcBSE(ispin), & OmBSE_sc,XpY_BSE_sc,XmY_BSE_sc) call print_excitation('BSE@UG0W0',5,nS_sc,OmBSE_sc) @@ -128,7 +128,6 @@ subroutine unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved, if(spin_flip) then ispin = 2 - EcBSE(ispin) = 0d0 ! Memory allocation @@ -140,7 +139,7 @@ subroutine unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved, allocate(OmBSE_sf(nS_sf),XpY_BSE_sf(nS_sf,nS_sf),XmY_BSE_sf(nS_sf,nS_sf)) call unrestricted_linear_response(ispin,.true.,TDA,.true.,eta,nBas,nC,nO,nV,nR,nS_ab,nS_ba,nS_sf,nS_sc,1d0, & - eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,OmRPA_sc,rho_RPA_sc,EcBSE(ispin), & + eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,OmRPA,rho_RPA,EcBSE(ispin), & OmBSE_sf,XpY_BSE_sf,XmY_BSE_sf) call print_excitation('BSE@UG0W0',6,nS_sf,OmBSE_sf) diff --git a/src/QuAcK/unrestricted_Bethe_Salpeter_A_matrix.f90 b/src/QuAcK/unrestricted_Bethe_Salpeter_A_matrix.f90 index 55d9a25..1b1e415 100644 --- a/src/QuAcK/unrestricted_Bethe_Salpeter_A_matrix.f90 +++ b/src/QuAcK/unrestricted_Bethe_Salpeter_A_matrix.f90 @@ -1,4 +1,4 @@ -subroutine unrestricted_Bethe_Salpeter_A_matrix(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nSsc,lambda, & +subroutine unrestricted_Bethe_Salpeter_A_matrix(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nS_sc,lambda, & ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega,rho,A_lr) ! Compute the extra term for Bethe-Salpeter equation for linear response in the unrestricted formalism @@ -17,15 +17,15 @@ subroutine unrestricted_Bethe_Salpeter_A_matrix(ispin,eta,nBas,nC,nO,nV,nR,nSa,n integer,intent(in) :: nSa integer,intent(in) :: nSb integer,intent(in) :: nSt - integer,intent(in) :: nSsc + integer,intent(in) :: nS_sc double precision,intent(in) :: eta double precision,intent(in) :: lambda double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_abab(nBas,nBas,nBas,nBas) - double precision,intent(in) :: Omega(nSsc) - double precision,intent(in) :: rho(nBas,nBas,nSsc,nspin) + double precision,intent(in) :: Omega(nS_sc) + double precision,intent(in) :: rho(nBas,nBas,nS_sc,nspin) ! Local variables @@ -55,12 +55,12 @@ subroutine unrestricted_Bethe_Salpeter_A_matrix(ispin,eta,nBas,nC,nO,nV,nR,nSa,n jb = jb + 1 chi = 0d0 - do kc=1,nSsc + do kc=1,nS_sc eps = Omega(kc)**2 + eta**2 chi = chi + rho(i,j,kc,1)*rho(a,b,kc,1)*Omega(kc)/eps enddo - A_lr(ia,jb) = A_lr(ia,jb) - lambda*ERI_aaaa(i,b,j,a) + 4d0*lambda*chi + A_lr(ia,jb) = A_lr(ia,jb) - lambda*ERI_aaaa(i,b,j,a) + 2d0*lambda*chi enddo enddo @@ -79,12 +79,12 @@ subroutine unrestricted_Bethe_Salpeter_A_matrix(ispin,eta,nBas,nC,nO,nV,nR,nSa,n jb = jb + 1 chi = 0d0 - do kc=1,nSsc + do kc=1,nS_sc eps = Omega(kc)**2 + eta**2 chi = chi + rho(i,j,kc,2)*rho(a,b,kc,2)*Omega(kc)/eps enddo - A_lr(nSa+ia,nSa+jb) = A_lr(nSa+ia,nSa+jb) - lambda*ERI_bbbb(i,b,j,a) + 4d0*lambda*chi + A_lr(nSa+ia,nSa+jb) = A_lr(nSa+ia,nSa+jb) - lambda*ERI_bbbb(i,b,j,a) + 2d0*lambda*chi enddo enddo @@ -111,12 +111,12 @@ subroutine unrestricted_Bethe_Salpeter_A_matrix(ispin,eta,nBas,nC,nO,nV,nR,nSa,n jb = jb + 1 chi = 0d0 - do kc=1,nSsc + do kc=1,nS_sc eps = Omega(kc)**2 + eta**2 chi = chi + rho(i,j,kc,1)*rho(a,b,kc,2)*Omega(kc)/eps enddo - A_lr(ia,jb) = A_lr(ia,jb) - lambda*ERI_abab(i,b,j,a) + 4d0*lambda*chi + A_lr(ia,jb) = A_lr(ia,jb) - lambda*ERI_abab(i,b,j,a) + 2d0*lambda*chi end do end do @@ -135,12 +135,12 @@ subroutine unrestricted_Bethe_Salpeter_A_matrix(ispin,eta,nBas,nC,nO,nV,nR,nSa,n jb = jb + 1 chi = 0d0 - do kc=1,nSsc + do kc=1,nS_sc eps = Omega(kc)**2 + eta**2 chi = chi + rho(i,j,kc,2)*rho(a,b,kc,1)*Omega(kc)/eps enddo - A_lr(nSa+ia,nSa+jb) = A_lr(nSa+ia,nSa+jb) - lambda*ERI_abab(b,i,a,j) + 4d0*lambda*chi + A_lr(nSa+ia,nSa+jb) = A_lr(nSa+ia,nSa+jb) - lambda*ERI_abab(b,i,a,j) + 2d0*lambda*chi end do end do diff --git a/src/QuAcK/unrestricted_Bethe_Salpeter_B_matrix.f90 b/src/QuAcK/unrestricted_Bethe_Salpeter_B_matrix.f90 index e954814..2f559ee 100644 --- a/src/QuAcK/unrestricted_Bethe_Salpeter_B_matrix.f90 +++ b/src/QuAcK/unrestricted_Bethe_Salpeter_B_matrix.f90 @@ -1,4 +1,4 @@ -subroutine unrestricted_Bethe_Salpeter_B_matrix(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nSsc,lambda, & +subroutine unrestricted_Bethe_Salpeter_B_matrix(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nS_sc,lambda, & ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega,rho,B_lr) ! Compute the extra term for Bethe-Salpeter equation for linear response @@ -17,15 +17,15 @@ subroutine unrestricted_Bethe_Salpeter_B_matrix(ispin,eta,nBas,nC,nO,nV,nR,nSa,n integer,intent(in) :: nSa integer,intent(in) :: nSb integer,intent(in) :: nSt - integer,intent(in) :: nSsc + integer,intent(in) :: nS_sc double precision,intent(in) :: eta double precision,intent(in) :: lambda double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_abab(nBas,nBas,nBas,nBas) - double precision,intent(in) :: Omega(nSsc) - double precision,intent(in) :: rho(nBas,nBas,nSsc,nspin) + double precision,intent(in) :: Omega(nS_sc) + double precision,intent(in) :: rho(nBas,nBas,nS_sc,nspin) ! Local variables @@ -55,12 +55,12 @@ subroutine unrestricted_Bethe_Salpeter_B_matrix(ispin,eta,nBas,nC,nO,nV,nR,nSa,n jb = jb + 1 chi = 0d0 - do kc=1,nSsc + do kc=1,nS_sc eps = Omega(kc)**2 + eta**2 chi = chi + rho(i,b,kc,1)*rho(a,j,kc,1)*Omega(kc)/eps enddo - B_lr(ia,jb) = B_lr(ia,jb) - lambda*ERI_aaaa(i,j,b,a) + 4d0*lambda*chi + B_lr(ia,jb) = B_lr(ia,jb) - lambda*ERI_aaaa(i,j,b,a) + 2d0*lambda*chi enddo enddo @@ -80,12 +80,12 @@ subroutine unrestricted_Bethe_Salpeter_B_matrix(ispin,eta,nBas,nC,nO,nV,nR,nSa,n jb = jb + 1 chi = 0d0 - do kc=1,nSsc + do kc=1,nS_sc eps = Omega(kc)**2 + eta**2 chi = chi + rho(i,b,kc,2)*rho(a,j,kc,2)*Omega(kc)/eps enddo - B_lr(nSa+ia,nSa+jb) = B_lr(nSa+ia,nSa+jb) - lambda*ERI_bbbb(i,j,b,a) + 4d0*lambda*chi + B_lr(nSa+ia,nSa+jb) = B_lr(nSa+ia,nSa+jb) - lambda*ERI_bbbb(i,j,b,a) + 2d0*lambda*chi enddo enddo @@ -113,12 +113,12 @@ subroutine unrestricted_Bethe_Salpeter_B_matrix(ispin,eta,nBas,nC,nO,nV,nR,nSa,n jb = jb + 1 chi = 0d0 - do kc=1,nSsc + do kc=1,nS_sc eps = Omega(kc)**2 + eta**2 chi = chi + rho(i,b,kc,1)*rho(a,j,kc,2)*Omega(kc)/eps enddo - B_lr(ia,nSa+jb) = B_lr(ia,nSa+jb) - lambda*ERI_abab(i,a,b,j) + 4d0*lambda*chi + B_lr(ia,nSa+jb) = B_lr(ia,nSa+jb) - lambda*ERI_abab(i,a,b,j) + 2d0*lambda*chi end do end do @@ -137,12 +137,12 @@ subroutine unrestricted_Bethe_Salpeter_B_matrix(ispin,eta,nBas,nC,nO,nV,nR,nSa,n jb = jb + 1 chi = 0d0 - do kc=1,nSsc + do kc=1,nS_sc eps = Omega(kc)**2 + eta**2 chi = chi + rho(i,b,kc,2)*rho(a,j,kc,1)*Omega(kc)/eps enddo - B_lr(nSa+ia,jb) = B_lr(nSa+ia,jb) - lambda*ERI_abab(b,j,i,a) + 4d0*lambda*chi + B_lr(nSa+ia,jb) = B_lr(nSa+ia,jb) - lambda*ERI_abab(b,j,i,a) + 2d0*lambda*chi end do end do diff --git a/src/QuAcK/unrestricted_linear_response.f90 b/src/QuAcK/unrestricted_linear_response.f90 index b61cb38..e816162 100644 --- a/src/QuAcK/unrestricted_linear_response.f90 +++ b/src/QuAcK/unrestricted_linear_response.f90 @@ -1,5 +1,5 @@ -subroutine unrestricted_linear_response(ispin,dRPA,TDA,BSE,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nSsc,lambda, & - e,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega_RPA,rho_RPA,EcRPA,Omega,XpY,XmY) +subroutine unrestricted_linear_response(ispin,dRPA,TDA,BSE,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nS_sc,lambda, & + e,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,OmRPA,rho_RPA,EcRPA,Omega,XpY,XmY) ! Compute linear response for unrestricted formalism @@ -21,7 +21,7 @@ subroutine unrestricted_linear_response(ispin,dRPA,TDA,BSE,eta,nBas,nC,nO,nV,nR, integer,intent(in) :: nSa integer,intent(in) :: nSb integer,intent(in) :: nSt - integer,intent(in) :: nSsc + integer,intent(in) :: nS_sc double precision,intent(in) :: lambda double precision,intent(in) :: e(nBas,nspin) double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas) @@ -29,8 +29,8 @@ subroutine unrestricted_linear_response(ispin,dRPA,TDA,BSE,eta,nBas,nC,nO,nV,nR, double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_abab(nBas,nBas,nBas,nBas) - double precision,intent(in) :: Omega_RPA(nSsc) - double precision,intent(in) :: rho_RPA(nBas,nBas,nSsc,nspin) + double precision,intent(in) :: OmRPA(nS_sc) + double precision,intent(in) :: rho_RPA(nBas,nBas,nS_sc,nspin) ! Local variables @@ -61,8 +61,8 @@ subroutine unrestricted_linear_response(ispin,dRPA,TDA,BSE,eta,nBas,nC,nO,nV,nR, ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,A) if(BSE) & - call unrestricted_Bethe_Salpeter_A_matrix(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nSsc,lambda, & - ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega_RPA,rho_RPA,A) + call unrestricted_Bethe_Salpeter_A_matrix(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nS_sc,lambda, & + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,OmRPA,rho_RPA,A) ! Tamm-Dancoff approximation @@ -73,8 +73,8 @@ subroutine unrestricted_linear_response(ispin,dRPA,TDA,BSE,eta,nBas,nC,nO,nV,nR, ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,B) if(BSE) & - call unrestricted_Bethe_Salpeter_B_matrix(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nSsc,lambda, & - ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega_RPA,rho_RPA,B) + call unrestricted_Bethe_Salpeter_B_matrix(ispin,eta,nBas,nC,nO,nV,nR,nSa,nSb,nSt,nS_sc,lambda, & + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,OmRPA,rho_RPA,B) end if From a611ee7442ed0b8edba66f40022ffa9d7ba32a95 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Thu, 24 Sep 2020 16:39:15 +0200 Subject: [PATCH 11/17] spin flip --- input/methods | 4 ++-- input/options | 2 +- src/QuAcK/QuAcK.f90 | 18 +++++++++++++----- src/QuAcK/RPAx.f90 | 9 +++++---- src/QuAcK/UCIS.f90 | 4 ++-- src/QuAcK/URPAx.f90 | 9 +++++---- src/QuAcK/UdRPA.f90 | 9 +++++---- src/QuAcK/dRPA.f90 | 10 +++++----- .../unrestricted_linear_response_A_matrix.f90 | 2 +- 9 files changed, 39 insertions(+), 28 deletions(-) diff --git a/input/methods b/input/methods index ba17592..70cc161 100644 --- a/input/methods +++ b/input/methods @@ -7,13 +7,13 @@ # drCCD rCCD lCCD pCCD F F F F # CIS CID CISD - F F F + T F F # RPA RPAx ppRPA F F F # G0F2 evGF2 G0F3 evGF3 F F F F # G0W0 evGW qsGW - T F F + F F F # G0T0 evGT qsGT F F F # MCMP2 diff --git a/input/options b/input/options index 55538aa..cb56d2c 100644 --- a/input/options +++ b/input/options @@ -5,7 +5,7 @@ # CC: maxSCF thresh DIIS n_diis 64 0.0000001 T 5 # spin: singlet triplet spin_conserved spin_flip TDA - T T T T T + T T T T F # 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/QuAcK/QuAcK.f90 b/src/QuAcK/QuAcK.f90 index 3bc4577..4a63fe3 100644 --- a/src/QuAcK/QuAcK.f90 +++ b/src/QuAcK/QuAcK.f90 @@ -586,7 +586,15 @@ program QuAcK if(doCIS) then call cpu_time(start_CIS) - call CIS(singlet,triplet,nBas,nC,nO,nV,nR,nS,ERI_MO,eHF) + if(unrestricted) then + + call UCIS(spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,ERI_MO_abab,eHF) + + else + + call CIS(singlet,triplet,nBas,nC,nO,nV,nR,nS,ERI_MO,eHF) + + end if call cpu_time(end_CIS) t_CIS = end_CIS - start_CIS @@ -636,12 +644,12 @@ program QuAcK call cpu_time(start_RPA) if(unrestricted) then - call UdRPA(doACFDT,exchange_kernel,spin_conserved,spin_flip,0d0,nBas,nC,nO,nV,nR,nS,ENuc,EUHF, & + call UdRPA(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,0d0,nBas,nC,nO,nV,nR,nS,ENuc,EUHF, & ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,ERI_MO_abab,eHF) else - call dRPA(doACFDT,exchange_kernel,singlet,triplet,0d0,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF) + call dRPA(TDA,doACFDT,exchange_kernel,singlet,triplet,0d0,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF) end if call cpu_time(end_RPA) @@ -661,12 +669,12 @@ program QuAcK call cpu_time(start_RPAx) if(unrestricted) then - call URPAx(doACFDT,exchange_kernel,spin_conserved,spin_flip,0d0,nBas,nC,nO,nV,nR,nS,ENuc,EUHF, & + call URPAx(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,0d0,nBas,nC,nO,nV,nR,nS,ENuc,EUHF, & ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,ERI_MO_abab,eHF) else - call RPAx(doACFDT,exchange_kernel,singlet,triplet,0d0,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF) + call RPAx(TDA,doACFDT,exchange_kernel,singlet,triplet,0d0,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF) end if call cpu_time(end_RPAx) diff --git a/src/QuAcK/RPAx.f90 b/src/QuAcK/RPAx.f90 index ca9f709..37f3f25 100644 --- a/src/QuAcK/RPAx.f90 +++ b/src/QuAcK/RPAx.f90 @@ -1,4 +1,4 @@ -subroutine RPAx(doACFDT,exchange_kernel,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF) +subroutine RPAx(TDA,doACFDT,exchange_kernel,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF) ! Perform random phase approximation calculation with exchange (aka TDHF) @@ -8,6 +8,7 @@ subroutine RPAx(doACFDT,exchange_kernel,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS, ! Input variables + logical,intent(in) :: TDA logical,intent(in) :: doACFDT logical,intent(in) :: exchange_kernel logical,intent(in) :: singlet @@ -58,7 +59,7 @@ subroutine RPAx(doACFDT,exchange_kernel,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS, ispin = 1 - call linear_response(ispin,.false.,.false.,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,Omega(:,ispin),rho, & + call linear_response(ispin,.false.,TDA,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,Omega(:,ispin),rho, & EcRPAx(ispin),Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) call print_excitation('RPAx@HF ',ispin,nS,Omega(:,ispin)) call print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) @@ -71,7 +72,7 @@ subroutine RPAx(doACFDT,exchange_kernel,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS, ispin = 2 - call linear_response(ispin,.false.,.false.,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,rho,Omega(:,ispin), & + call linear_response(ispin,.false.,TDA,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,rho,Omega(:,ispin), & EcRPAx(ispin),Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) call print_excitation('RPAx@HF ',ispin,nS,Omega(:,ispin)) call print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) @@ -103,7 +104,7 @@ subroutine RPAx(doACFDT,exchange_kernel,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS, write(*,*) '-------------------------------------------------------' write(*,*) - call ACFDT(exchange_kernel,.false.,.false.,.false.,.false.,.false.,singlet,triplet,eta, & + call ACFDT(exchange_kernel,.false.,.false.,.false.,TDA,.false.,singlet,triplet,eta, & nBas,nC,nO,nV,nR,nS,ERI,eHF,eHF,EcAC) write(*,*) diff --git a/src/QuAcK/UCIS.f90 b/src/QuAcK/UCIS.f90 index d27a61b..9db0626 100644 --- a/src/QuAcK/UCIS.f90 +++ b/src/QuAcK/UCIS.f90 @@ -64,7 +64,7 @@ subroutine UCIS(spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,E allocate(A_sc(nS_sc,nS_sc),Omega_sc(nS_sc)) - call unrestricted_linear_response_A_matrix(ispin,.false.,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,lambda,eHF, & + call unrestricted_linear_response_A_matrix(ispin,.false.,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,lambda,eHF, & ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,A_sc) if(dump_matrix) then @@ -102,7 +102,7 @@ subroutine UCIS(spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,E allocate(A_sf(nS_sf,nS_sf),Omega_sf(nS_sf)) - call unrestricted_linear_response_A_matrix(ispin,.false.,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sf,nS_sf,lambda,eHF, & + call unrestricted_linear_response_A_matrix(ispin,.false.,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sf,lambda,eHF, & ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,A_sf) if(dump_matrix) then diff --git a/src/QuAcK/URPAx.f90 b/src/QuAcK/URPAx.f90 index f351ca6..ff13fad 100644 --- a/src/QuAcK/URPAx.f90 +++ b/src/QuAcK/URPAx.f90 @@ -1,4 +1,4 @@ -subroutine URPAx(doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,nC,nO,nV,nR,nS,ENuc,EUHF, & +subroutine URPAx(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,nC,nO,nV,nR,nS,ENuc,EUHF, & ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,e) ! Perform random phase approximation calculation with exchange (aka TDHF) in the unrestricted formalism @@ -9,7 +9,7 @@ subroutine URPAx(doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,nC,nO ! Input variables - double precision,intent(in) :: eta + logical,intent(in) :: TDA logical,intent(in) :: doACFDT logical,intent(in) :: exchange_kernel logical,intent(in) :: spin_conserved @@ -20,6 +20,7 @@ subroutine URPAx(doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,nC,nO integer,intent(in) :: nV(nspin) integer,intent(in) :: nR(nspin) integer,intent(in) :: nS(nspin) + double precision,intent(in) :: eta double precision,intent(in) :: ENuc double precision,intent(in) :: EUHF double precision,intent(in) :: e(nBas,nspin) @@ -73,7 +74,7 @@ subroutine URPAx(doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,nC,nO allocate(Omega_sc(nS_sc),XpY_sc(nS_sc,nS_sc),XmY_sc(nS_sc,nS_sc)) - call unrestricted_linear_response(ispin,.false.,.false.,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0,e, & + call unrestricted_linear_response(ispin,.false.,TDA,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0,e, & ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega_sc,rho_sc,EcRPAx(ispin),Omega_sc,XpY_sc,XmY_sc) call print_excitation('URPAx ',5,nS_sc,Omega_sc) ! call print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) @@ -96,7 +97,7 @@ subroutine URPAx(doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,nC,nO allocate(Omega_sf(nS_sf),XpY_sf(nS_sf,nS_sf),XmY_sf(nS_sf,nS_sf)) - call unrestricted_linear_response(ispin,.false.,.false.,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sf,nS_sf,1d0,e, & + call unrestricted_linear_response(ispin,.false.,TDA,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sf,nS_sf,1d0,e, & ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega_sf,rho_sf,EcRPAx(ispin),Omega_sf,XpY_sf,XmY_sf) call print_excitation('URPAx ',6,nS_sf,Omega_sf) ! call print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) diff --git a/src/QuAcK/UdRPA.f90 b/src/QuAcK/UdRPA.f90 index 9fff2be..0169441 100644 --- a/src/QuAcK/UdRPA.f90 +++ b/src/QuAcK/UdRPA.f90 @@ -1,4 +1,4 @@ -subroutine UdRPA(doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,nC,nO,nV,nR,nS,ENuc,EUHF, & +subroutine UdRPA(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,nC,nO,nV,nR,nS,ENuc,EUHF, & ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,e) ! Perform random phase approximation calculation with exchange (aka TDHF) in the unrestricted formalism @@ -9,7 +9,7 @@ subroutine UdRPA(doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,nC,nO ! Input variables - double precision,intent(in) :: eta + logical,intent(in) :: TDA logical,intent(in) :: doACFDT logical,intent(in) :: exchange_kernel logical,intent(in) :: spin_conserved @@ -20,6 +20,7 @@ subroutine UdRPA(doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,nC,nO integer,intent(in) :: nV(nspin) integer,intent(in) :: nR(nspin) integer,intent(in) :: nS(nspin) + double precision,intent(in) :: eta double precision,intent(in) :: ENuc double precision,intent(in) :: EUHF double precision,intent(in) :: e(nBas,nspin) @@ -73,7 +74,7 @@ subroutine UdRPA(doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,nC,nO allocate(Omega_sc(nS_sc),XpY_sc(nS_sc,nS_sc),XmY_sc(nS_sc,nS_sc)) - call unrestricted_linear_response(ispin,.true.,.false.,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0,e, & + call unrestricted_linear_response(ispin,.true.,TDA,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0,e, & ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega_sc,rho_sc,EcRPA(ispin),Omega_sc,XpY_sc,XmY_sc) call print_excitation('URPA ',5,nS_sc,Omega_sc) ! call print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) @@ -95,7 +96,7 @@ subroutine UdRPA(doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,nC,nO allocate(Omega_sf(nS_sf),XpY_sf(nS_sf,nS_sf),XmY_sf(nS_sf,nS_sf)) - call unrestricted_linear_response(ispin,.true.,.false.,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sf,nS_sf,1d0,e, & + call unrestricted_linear_response(ispin,.true.,TDA,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sf,nS_sf,1d0,e, & ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega_sf,rho_sf,EcRPA(ispin),Omega_sf,XpY_sf,XmY_sf) call print_excitation('URPA ',6,nS_sf,Omega_sf) ! call print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) diff --git a/src/QuAcK/dRPA.f90 b/src/QuAcK/dRPA.f90 index d17ed51..3985af2 100644 --- a/src/QuAcK/dRPA.f90 +++ b/src/QuAcK/dRPA.f90 @@ -1,5 +1,4 @@ -subroutine dRPA(doACFDT,exchange_kernel,singlet,triplet,eta, & - nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF) +subroutine dRPA(TDA,doACFDT,exchange_kernel,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF) ! Perform a direct random phase approximation calculation @@ -9,6 +8,7 @@ subroutine dRPA(doACFDT,exchange_kernel,singlet,triplet,eta, & ! Input variables + logical,intent(in) :: TDA logical,intent(in) :: doACFDT logical,intent(in) :: exchange_kernel logical,intent(in) :: singlet @@ -59,7 +59,7 @@ subroutine dRPA(doACFDT,exchange_kernel,singlet,triplet,eta, & ispin = 1 - call linear_response(ispin,.true.,.false.,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,rho,Omega(:,ispin), & + call linear_response(ispin,.true.,TDA,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,rho,Omega(:,ispin), & EcRPA(ispin),Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) call print_excitation('RPA@HF ',ispin,nS,Omega(:,ispin)) call print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) @@ -72,7 +72,7 @@ subroutine dRPA(doACFDT,exchange_kernel,singlet,triplet,eta, & ispin = 2 - call linear_response(ispin,.true.,.false.,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,rho,Omega(:,ispin), & + call linear_response(ispin,.true.,TDA,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,rho,Omega(:,ispin), & EcRPA(ispin),Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) call print_excitation('RPA@HF ',ispin,nS,Omega(:,ispin)) call print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) @@ -105,7 +105,7 @@ subroutine dRPA(doACFDT,exchange_kernel,singlet,triplet,eta, & write(*,*) '------------------------------------------------------' write(*,*) - call ACFDT(exchange_kernel,.false.,.true.,.false.,.false.,.false.,singlet,triplet,eta, & + call ACFDT(exchange_kernel,.false.,.true.,.false.,TDA,.false.,singlet,triplet,eta, & nBas,nC,nO,nV,nR,nS,ERI,eHF,eHF,EcAC) if(exchange_kernel) then diff --git a/src/QuAcK/unrestricted_linear_response_A_matrix.f90 b/src/QuAcK/unrestricted_linear_response_A_matrix.f90 index 6c282e5..2f2d1b8 100644 --- a/src/QuAcK/unrestricted_linear_response_A_matrix.f90 +++ b/src/QuAcK/unrestricted_linear_response_A_matrix.f90 @@ -162,7 +162,7 @@ subroutine unrestricted_linear_response_A_matrix(ispin,dRPA,nBas,nC,nO,nV,nR,nSa jb = jb + 1 A_lr(nSa+ia,nSa+jb) = (e(a,1) - e(i,2))*Kronecker_delta(i,j)*Kronecker_delta(a,b) & - - (1d0 - delta_dRPA)*lambda*ERI_abab(b,i,a,j) + - (1d0 - delta_dRPA)*lambda*ERI_abab(b,j,i,a) end do end do From 875b53b7d04a4d670d8998558aa3a5e39063b7fa Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Thu, 24 Sep 2020 22:50:56 +0200 Subject: [PATCH 12/17] evUGW --- input/basis | 54 ++++--- input/methods | 13 +- input/molecule | 5 +- input/molecule.xyz | 5 +- input/options | 8 +- src/QuAcK/QuAcK.f90 | 15 +- src/QuAcK/UG0W0.f90 | 5 +- src/QuAcK/evGW.f90 | 7 +- src/QuAcK/evUGW.f90 | 307 ++++++++++++++++++++++++++++++++++++++ src/QuAcK/print_evUGW.f90 | 72 +++++++++ 10 files changed, 444 insertions(+), 47 deletions(-) create mode 100644 src/QuAcK/evUGW.f90 create mode 100644 src/QuAcK/print_evUGW.f90 diff --git a/input/basis b/input/basis index b2b2293..c7ec793 100644 --- a/input/basis +++ b/input/basis @@ -1,30 +1,38 @@ 1 6 S 8 - 1 1469.0000000 0.0007660 - 2 220.5000000 0.0058920 - 3 50.2600000 0.0296710 - 4 14.2400000 0.1091800 - 5 4.5810000 0.2827890 - 6 1.5800000 0.4531230 - 7 0.5640000 0.2747740 - 8 0.0734500 0.0097510 + 1 6665.0000000 0.0006920 + 2 1000.0000000 0.0053290 + 3 228.0000000 0.0270770 + 4 64.7100000 0.1017180 + 5 21.0600000 0.2747400 + 6 7.4950000 0.4485640 + 7 2.7970000 0.2850740 + 8 0.5215000 0.0152040 S 8 - 1 1469.0000000 -0.0001200 - 2 220.5000000 -0.0009230 - 3 50.2600000 -0.0046890 - 4 14.2400000 -0.0176820 - 5 4.5810000 -0.0489020 - 6 1.5800000 -0.0960090 - 7 0.5640000 -0.1363800 - 8 0.0734500 0.5751020 + 1 6665.0000000 -0.0001460 + 2 1000.0000000 -0.0011540 + 3 228.0000000 -0.0057250 + 4 64.7100000 -0.0233120 + 5 21.0600000 -0.0639550 + 6 7.4950000 -0.1499810 + 7 2.7970000 -0.1272620 + 8 0.5215000 0.5445290 S 1 - 1 0.0280500 1.0000000 + 1 0.1596000 1.0000000 P 3 - 1 1.5340000 0.0227840 - 2 0.2749000 0.1391070 - 3 0.0736200 0.5003750 + 1 9.4390000 0.0381090 + 2 2.0020000 0.2094800 + 3 0.5456000 0.5085570 P 1 - 1 0.0240300 1.0000000 + 1 0.1517000 1.0000000 D 1 - 1 0.1239000 1.0000000 - + 1 0.5500000 1.0000000 +2 3 +S 3 + 1 13.0100000 0.0196850 + 2 1.9620000 0.1379770 + 3 0.4446000 0.4781480 +S 1 + 1 0.1220000 1.0000000 +P 1 + 1 0.7270000 1.0000000 diff --git a/input/methods b/input/methods index 70cc161..81c1b6d 100644 --- a/input/methods +++ b/input/methods @@ -1,20 +1,21 @@ # RHF UHF MOM F T F -# MP2 MP3 MP2-F12 +# MP2* MP3 MP2-F12 F F F # CCD CCSD CCSD(T) F F F # drCCD rCCD lCCD pCCD F F F F -# CIS CID CISD - T F F -# RPA RPAx ppRPA +# CIS* CID CISD + F F F +# RPA* RPAx* ppRPA F F F # G0F2 evGF2 G0F3 evGF3 F F F F -# G0W0 evGW qsGW - F F F +# G0W0* evGW* qsGW + T T F # G0T0 evGT qsGT F F F # MCMP2 F +# * unrestricted version available diff --git a/input/molecule b/input/molecule index 058d6dd..e2a4fd3 100644 --- a/input/molecule +++ b/input/molecule @@ -1,4 +1,5 @@ # nAt nEla nElb nCore nRyd - 1 2 1 0 0 + 2 4 3 0 0 # Znuc x y z - Li 0.0 0.0 0.0 + C 0. 0. -0.16245872 + H 0. 0. 1.93436816 diff --git a/input/molecule.xyz b/input/molecule.xyz index c9a5a65..7a4f218 100644 --- a/input/molecule.xyz +++ b/input/molecule.xyz @@ -1,3 +1,4 @@ - 1 + 2 - Li 0.0000000000 0.0000000000 0.0000000000 + C 0.0000000000 0.0000000000 -0.0859694585 + H 0.0000000000 0.0000000000 1.0236236215 diff --git a/input/options b/input/options index cb56d2c..0d3bf88 100644 --- a/input/options +++ b/input/options @@ -1,5 +1,5 @@ # RHF: maxSCF thresh DIIS n_diis guess_type ortho_type - 64 0.0000001 T 5 1 1 + 64 0.00001 T 5 1 1 # MP: # CC: maxSCF thresh DIIS n_diis @@ -9,10 +9,10 @@ # 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 - 256 0.00001 T 5 F 0.0 F F F F F + 256 0.00001 T 5 T 0.0 F F F F F # ACFDT: AC Kx XBS - T F T + F F T # BSE: BSE dBSE dTDA evDyn - T T T T + F F T T # MCMP2: nMC nEq nWalk dt nPrint iSeed doDrift 1000000 100000 10 0.3 10000 1234 T diff --git a/src/QuAcK/QuAcK.f90 b/src/QuAcK/QuAcK.f90 index 4a63fe3..f7310a1 100644 --- a/src/QuAcK/QuAcK.f90 +++ b/src/QuAcK/QuAcK.f90 @@ -823,9 +823,18 @@ program QuAcK if(doevGW) then call cpu_time(start_evGW) - call evGW(maxSCF_GW,thresh_GW,n_diis_GW,doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX, & - BSE,TDA_W,TDA,G0W,GW0,dBSE,dTDA,evDyn,singlet,triplet,eta_GW, & - nBas,nC,nO,nV,nR,nS,ENuc,ERHF,Hc,H,ERI_MO,PHF,cHF,eHF,eG0W0) + if(unrestricted) then + + call evUGW(maxSCF_GW,thresh_GW,n_diis_GW,doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA, & + G0W,GW0,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta_GW,nBas,nC,nO,nV,nR,nS,ENuc, & + ERHF,Hc,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,ERI_MO_abab,PHF,cHF,eHF,eG0W0) + + else + + call evGW(maxSCF_GW,thresh_GW,n_diis_GW,doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX, & + BSE,TDA_W,TDA,G0W,GW0,dBSE,dTDA,evDyn,singlet,triplet,eta_GW, & + nBas,nC,nO,nV,nR,nS,ENuc,ERHF,Hc,ERI_MO,PHF,cHF,eHF,eG0W0) + end if call cpu_time(end_evGW) t_evGW = end_evGW - start_evGW diff --git a/src/QuAcK/UG0W0.f90 b/src/QuAcK/UG0W0.f90 index 5df2b99..c13a2a9 100644 --- a/src/QuAcK/UG0W0.f90 +++ b/src/QuAcK/UG0W0.f90 @@ -179,9 +179,8 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev if(BSE) then - call unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta, & - nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab, & - eHF,eGW,EcBSE) + call unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta,nBas,nC,nO,nV,nR,nS, & + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,eHF,eGW,EcBSE) ! if(exchange_kernel) then ! diff --git a/src/QuAcK/evGW.f90 b/src/QuAcK/evGW.f90 index 79f2dc2..d7d816e 100644 --- a/src/QuAcK/evGW.f90 +++ b/src/QuAcK/evGW.f90 @@ -1,6 +1,6 @@ -subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & - G0W,GW0,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,Hc,H, & - ERI,PHF,cHF,eHF,eG0W0) +subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & + G0W,GW0,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,Hc,ERI, & + PHF,cHF,eHF,eG0W0) ! Perform self-consistent eigenvalue-only GW calculation @@ -36,7 +36,6 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE double precision,intent(in) :: PHF(nBas,nBas) double precision,intent(in) :: eG0W0(nBas) double precision,intent(in) :: Hc(nBas,nBas) - double precision,intent(in) :: H(nBas,nBas) double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) ! Local variables diff --git a/src/QuAcK/evUGW.f90 b/src/QuAcK/evUGW.f90 new file mode 100644 index 0000000..3c8b2d8 --- /dev/null +++ b/src/QuAcK/evUGW.f90 @@ -0,0 +1,307 @@ +subroutine evUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA, & + G0W,GW0,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta,nBas,nC,nO,nV,nR,nS,ENuc, & + ERHF,Hc,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,PHF,cHF,eHF,eG0W0) + +! Perform self-consistent eigenvalue-only GW calculation + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: maxSCF + integer,intent(in) :: max_diis + double precision,intent(in) :: thresh + double precision,intent(in) :: ENuc + double precision,intent(in) :: ERHF + logical,intent(in) :: doACFDT + logical,intent(in) :: exchange_kernel + logical,intent(in) :: doXBS + logical,intent(in) :: COHSEX + logical,intent(in) :: BSE + logical,intent(in) :: TDA_W + logical,intent(in) :: TDA + logical,intent(in) :: dBSE + logical,intent(in) :: dTDA + logical,intent(in) :: evDyn + logical,intent(in) :: G0W + logical,intent(in) :: GW0 + logical,intent(in) :: spin_conserved + logical,intent(in) :: spin_flip + double precision,intent(in) :: eta + + integer,intent(in) :: nBas + integer,intent(in) :: nC(nspin) + integer,intent(in) :: nO(nspin) + integer,intent(in) :: nV(nspin) + integer,intent(in) :: nR(nspin) + integer,intent(in) :: nS(nspin) + + double precision,intent(in) :: eHF(nBas,nspin) + double precision,intent(in) :: cHF(nBas,nBas,nspin) + double precision,intent(in) :: PHF(nBas,nBas,nspin) + double precision,intent(in) :: eG0W0(nBas,nspin) + double precision,intent(in) :: Hc(nBas,nBas) + double precision,intent(in) :: ERI_aaaa(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_abab(nBas,nBas,nBas,nBas) + +! Local variables + + logical :: linear_mixing + integer :: is + integer :: ispin + integer :: nSCF + integer :: n_diis + double precision :: rcond(nspin) + double precision :: Conv + double precision :: EcRPA + double precision :: EcBSE(nspin) + double precision :: EcAC(nspin) + double precision :: EcGM + double precision :: alpha + double precision,allocatable :: error_diis(:,:,:) + double precision,allocatable :: e_diis(:,:,:) + double precision,allocatable :: eGW(:,:) + double precision,allocatable :: eOld(:,:) + double precision,allocatable :: Z(:,:) + integer :: nS_aa,nS_bb,nS_sc + double precision,allocatable :: SigC(:,:) + double precision,allocatable :: OmRPA(:) + double precision,allocatable :: XpY_RPA(:,:) + double precision,allocatable :: XmY_RPA(:,:) + double precision,allocatable :: rho_RPA(:,:,:,:) + +! Hello world + + write(*,*) + write(*,*)'************************************************' + write(*,*)'| Self-consistent evGW calculation |' + write(*,*)'************************************************' + write(*,*) + +! COHSEX approximation + + if(COHSEX) then + write(*,*) 'COHSEX approximation activated!' + write(*,*) + end if + +! TDA for W + + if(TDA_W) then + write(*,*) 'Tamm-Dancoff approximation for dynamic screening!' + write(*,*) + end if + +! TDA + + if(TDA) then + write(*,*) 'Tamm-Dancoff approximation activated!' + write(*,*) + end if + +! GW0 + + if(GW0) then + write(*,*) 'GW0 scheme activated!' + write(*,*) + end if + +! G0W + + if(G0W) then + write(*,*) 'G0W scheme activated!' + write(*,*) + end if + +! Linear mixing + + linear_mixing = .false. + alpha = 0.2d0 + +! Memory allocation + + nS_aa = nS(1) + nS_bb = nS(2) + nS_sc = nS_aa + nS_bb + + allocate(eGW(nBas,nspin),eOld(nBas,nspin),Z(nBas,nspin),SigC(nBas,nspin),OmRPA(nS_sc), & + XpY_RPA(nS_sc,nS_sc),XmY_RPA(nS_sc,nS_sc),rho_RPA(nBas,nBas,nS_sc,nspin), & + error_diis(nBas,max_diis,nspin),e_diis(nBas,max_diis,nspin)) + +! Initialization + + nSCF = 0 + ispin = 1 + n_diis = 0 + Conv = 1d0 + e_diis(:,:,:) = 0d0 + error_diis(:,:,:) = 0d0 + eGW(:,:) = eG0W0(:,:) + eOld(:,:) = eGW(:,:) + Z(:,:) = 1d0 + +!------------------------------------------------------------------------ +! Main loop +!------------------------------------------------------------------------ + + do while(Conv > thresh .and. nSCF <= maxSCF) + + ! Compute screening + + if(.not. GW0 .or. nSCF == 0) then + + call unrestricted_linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0, & + eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,OmRPA,rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA) + + + endif + + !----------------------! + ! Excitation densities ! + !----------------------! + + call unrestricted_excitation_density(nBas,nC,nO,nR,nS_aa,nS_bb,nS_sc,ERI_aaaa,ERI_aabb,ERI_bbbb,XpY_RPA,rho_RPA) + + !------------------------------------------------! + ! Compute self-energy and renormalization factor ! + !------------------------------------------------! + + if(G0W) then + + call unrestricted_self_energy_correlation_diag(eta,nBas,nC,nO,nV,nR,nS_sc,eHF,OmRPA,rho_RPA,SigC) + call unrestricted_renormalization_factor(eta,nBas,nC,nO,nV,nR,nS_sc,eHF,OmRPA,rho_RPA,Z) + + else + + call unrestricted_self_energy_correlation_diag(eta,nBas,nC,nO,nV,nR,nS_sc,eGW,OmRPA,rho_RPA,SigC) + call unrestricted_renormalization_factor(eta,nBas,nC,nO,nV,nR,nS_sc,eGW,OmRPA,rho_RPA,Z) + + endif + + !-----------------------------------! + ! Solve the quasi-particle equation ! + !-----------------------------------! + + eGW(:,:) = eHF(:,:) + SigC(:,:) + + ! Convergence criteria + + Conv = maxval(abs(eGW(:,:) - eOld(:,:))) + + ! Print results + + call print_evUGW(nBas,nO,nSCF,Conv,eHF,ENuc,ERHF,SigC,Z,eGW,EcRPA) + + ! Linear mixing or DIIS extrapolation + + if(linear_mixing) then + + eGW(:,:) = alpha*eGW(:,:) + (1d0 - alpha)*eOld(:,:) + + else + + n_diis = min(n_diis+1,max_diis) + do is=1,nspin + call DIIS_extrapolation(rcond(ispin),nBas,nBas,n_diis,error_diis(:,:,is), & + e_diis(:,:,is),eGW(:,is)-eOld(:,is),eGW(:,is)) + end do + +! Reset DIIS if required + + if(minval(rcond(:)) < 1d-15) n_diis = 0 + + endif + + ! Save quasiparticles energy for next cycle + + eOld(:,:) = eGW(:,:) + + ! Increment + + nSCF = nSCF + 1 + + enddo +!------------------------------------------------------------------------ +! End main loop +!------------------------------------------------------------------------ + +! Plot stuff + +! call plot_GW(nBas,nC,nO,nV,nR,nS,eHF,eGW,Omega(:,ispin),rho(:,:,:,ispin),rhox(:,:,:,ispin)) + +! Did it actually converge? + + if(nSCF == maxSCF+1) then + + write(*,*) + write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + write(*,*)' Convergence failed ' + write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + write(*,*) + + stop + + endif + +! Deallocate memory + + deallocate(eOld,Z,SigC,OmRPA,XpY_RPA,XmY_RPA,rho_RPA,error_diis,e_diis) + +! Perform BSE calculation + + if(BSE) then + + call unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta,nBas,nC,nO,nV,nR,nS, & + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,eGW,eGW,EcBSE) + +! if(exchange_kernel) then + +! EcBSE(1) = 0.5d0*EcBSE(1) +! EcBSE(2) = 1.5d0*EcBSE(2) + +! end if + +! write(*,*) +! write(*,*)'-------------------------------------------------------------------------------' +! write(*,'(2X,A50,F20.10)') 'Tr@BSE@evGW correlation energy (singlet) =',EcBSE(1) +! write(*,'(2X,A50,F20.10)') 'Tr@BSE@evGW correlation energy (triplet) =',EcBSE(2) +! write(*,'(2X,A50,F20.10)') 'Tr@BSE@evGW correlation energy =',EcBSE(1) + EcBSE(2) +! write(*,'(2X,A50,F20.10)') 'Tr@BSE@evGW total energy =',ENuc + ERHF + EcBSE(1) + EcBSE(2) +! write(*,*)'-------------------------------------------------------------------------------' +! write(*,*) + +! Compute the BSE correlation energy via the adiabatic connection + +! if(doACFDT) then + +! write(*,*) '------------------------------------------------------' +! write(*,*) 'Adiabatic connection version of BSE correlation energy' +! write(*,*) '------------------------------------------------------' +! write(*,*) + +! if(doXBS) then + +! write(*,*) '*** scaled screening version (XBS) ***' +! write(*,*) + +! end if + +! call ACFDT(exchange_kernel,doXBS,.true.,TDA_W,TDA,BSE,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,eGW,eGW,EcAC) + +! write(*,*) +! write(*,*)'-------------------------------------------------------------------------------' +! write(*,'(2X,A50,F20.10)') 'AC@BSE@evGW correlation energy (singlet) =',EcAC(1) +! write(*,'(2X,A50,F20.10)') 'AC@BSE@evGW correlation energy (triplet) =',EcAC(2) +! write(*,'(2X,A50,F20.10)') 'AC@BSE@evGW correlation energy =',EcAC(1) + EcAC(2) +! write(*,'(2X,A50,F20.10)') 'AC@BSE@evGW total energy =',ENuc + ERHF + EcAC(1) + EcAC(2) +! write(*,*)'-------------------------------------------------------------------------------' +! write(*,*) + +! end if + + endif + +end subroutine evUGW diff --git a/src/QuAcK/print_evUGW.f90 b/src/QuAcK/print_evUGW.f90 new file mode 100644 index 0000000..7c32002 --- /dev/null +++ b/src/QuAcK/print_evUGW.f90 @@ -0,0 +1,72 @@ +subroutine print_evUGW(nBas,nO,nSCF,Conv,e,ENuc,EHF,SigC,Z,eGW,EcRPA) + +! Print one-electron energies and other stuff for evGW + + implicit none + include 'parameters.h' + + integer,intent(in) :: nBas + integer,intent(in) :: nO(nspin) + integer,intent(in) :: nSCF + double precision,intent(in) :: ENuc + double precision,intent(in) :: EHF + double precision,intent(in) :: EcRPA + double precision,intent(in) :: Conv + double precision,intent(in) :: e(nBas,nspin) + double precision,intent(in) :: SigC(nBas,nspin) + double precision,intent(in) :: Z(nBas,nspin) + double precision,intent(in) :: eGW(nBas,nspin) + + integer :: p + double precision :: HOMO + double precision :: LUMO + double precision :: Gap + +! HOMO and LUMO + + HOMO = max(eGW(nO(1),1),eGW(nO(2),2)) + LUMO = min(eGW(nO(1)+1,1),eGW(nO(2)+1,2)) + Gap = LUMO - HOMO + +! Dump results + + write(*,*)'-------------------------------------------------------------------------------& + -------------------------------------------------' + if(nSCF < 10) then + write(*,'(1X,A21,I1,A1,I1,A12)')' Self-consistent evG',nSCF,'W',nSCF,' calculation' + else + write(*,'(1X,A21,I2,A1,I2,A12)')' Self-consistent evG',nSCF,'W',nSCF,' calculation' + endif + write(*,*)'-------------------------------------------------------------------------------& + -------------------------------------------------' + write(*,'(A1,A3,A1,A30,A1,A30,A1,A30,A1,A30,A1)') & + '|',' ','|','e_HF ','|','Sig_c ','|','Z ','|','e_QP ','|' + write(*,'(A1,A3,A1,2A15,A1,2A15,A1,2A15,A1,2A15,A1)') & + '|','#','|','up ','dw ','|','up ','dw ','|','up ','dw ','|','up ','dw ','|' + write(*,*)'-------------------------------------------------------------------------------& + -------------------------------------------------' + + do p=1,nBas + write(*,'(A1,I3,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1)') & + '|',p,'|',e(p,1)*HaToeV,e(p,2)*HaToeV,'|',SigC(p,1)*HaToeV,SigC(p,2)*HaToeV,'|', & + Z(p,1),Z(p,2),'|',eGW(p,1)*HaToeV,eGW(p,2)*HaToeV,'|' + enddo + + write(*,*)'-------------------------------------------------------------------------------& + -------------------------------------------------' + write(*,'(2X,A10,I3)') 'Iteration ',nSCF + write(*,'(2X,A14,F15.5)')'Convergence = ',Conv + write(*,*)'-------------------------------------------------------------------------------& + -------------------------------------------------' + write(*,'(2X,A30,F15.6)') 'evGW HOMO energy (eV):',HOMO*HaToeV + write(*,'(2X,A30,F15.6)') 'evGW LUMO energy (eV):',LUMO*HaToeV + write(*,'(2X,A30,F15.6)') 'evGW HOMO-LUMO gap (eV):',Gap*HaToeV + write(*,*)'-------------------------------------------------------------------------------& + -------------------------------------------------' + write(*,'(2X,A30,F15.6)') 'RPA@evGW total energy =',ENuc + EHF + EcRPA + write(*,'(2X,A30,F15.6)') 'RPA@evGW correlation energy =',EcRPA + write(*,*)'-------------------------------------------------------------------------------& + -------------------------------------------------' + write(*,*) + +end subroutine print_evUGW From 435d44391d398ec5ff62da0870ec32dcfc1cde2b Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Fri, 25 Sep 2020 15:05:06 +0200 Subject: [PATCH 13/17] clean up unrestricted code for one electron --- input/basis | 31 +------------------------------ input/methods | 4 ++-- input/molecule | 5 ++--- input/molecule.xyz | 5 ++--- src/QuAcK/QuAcK.f90 | 5 ++--- src/QuAcK/UG0W0.f90 | 2 +- src/QuAcK/evUGW.f90 | 5 ++--- src/QuAcK/print_UG0W0.f90 | 29 +++++++++++++++++++---------- src/QuAcK/print_UHF.f90 | 30 ++++++++++++++++++------------ src/QuAcK/print_evUGW.f90 | 29 +++++++++++++++++++---------- src/QuAcK/print_excitation.f90 | 2 +- 11 files changed, 69 insertions(+), 78 deletions(-) diff --git a/input/basis b/input/basis index c7ec793..79a747a 100644 --- a/input/basis +++ b/input/basis @@ -1,33 +1,4 @@ -1 6 -S 8 - 1 6665.0000000 0.0006920 - 2 1000.0000000 0.0053290 - 3 228.0000000 0.0270770 - 4 64.7100000 0.1017180 - 5 21.0600000 0.2747400 - 6 7.4950000 0.4485640 - 7 2.7970000 0.2850740 - 8 0.5215000 0.0152040 -S 8 - 1 6665.0000000 -0.0001460 - 2 1000.0000000 -0.0011540 - 3 228.0000000 -0.0057250 - 4 64.7100000 -0.0233120 - 5 21.0600000 -0.0639550 - 6 7.4950000 -0.1499810 - 7 2.7970000 -0.1272620 - 8 0.5215000 0.5445290 -S 1 - 1 0.1596000 1.0000000 -P 3 - 1 9.4390000 0.0381090 - 2 2.0020000 0.2094800 - 3 0.5456000 0.5085570 -P 1 - 1 0.1517000 1.0000000 -D 1 - 1 0.5500000 1.0000000 -2 3 +1 3 S 3 1 13.0100000 0.0196850 2 1.9620000 0.1379770 diff --git a/input/methods b/input/methods index 81c1b6d..58c5d33 100644 --- a/input/methods +++ b/input/methods @@ -1,7 +1,7 @@ # RHF UHF MOM F T F # MP2* MP3 MP2-F12 - F F F + T F F # CCD CCSD CCSD(T) F F F # drCCD rCCD lCCD pCCD @@ -13,7 +13,7 @@ # G0F2 evGF2 G0F3 evGF3 F F F F # G0W0* evGW* qsGW - T T F + F F F # G0T0 evGT qsGT F F F # MCMP2 diff --git a/input/molecule b/input/molecule index e2a4fd3..fd4bfbe 100644 --- a/input/molecule +++ b/input/molecule @@ -1,5 +1,4 @@ # nAt nEla nElb nCore nRyd - 2 4 3 0 0 + 1 1 0 0 0 # Znuc x y z - C 0. 0. -0.16245872 - H 0. 0. 1.93436816 + H 0. 0. 0. diff --git a/input/molecule.xyz b/input/molecule.xyz index 7a4f218..3dca9a4 100644 --- a/input/molecule.xyz +++ b/input/molecule.xyz @@ -1,4 +1,3 @@ - 2 + 1 - C 0.0000000000 0.0000000000 -0.0859694585 - H 0.0000000000 0.0000000000 1.0236236215 + H 0.0000000000 0.0000000000 0.0000000000 diff --git a/src/QuAcK/QuAcK.f90 b/src/QuAcK/QuAcK.f90 index f7310a1..2efdaa2 100644 --- a/src/QuAcK/QuAcK.f90 +++ b/src/QuAcK/QuAcK.f90 @@ -802,9 +802,8 @@ program QuAcK ENuc,EUHF,Hc,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,ERI_MO_abab,PHF,cHF,eHF,eG0W0) else - call G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & - dBSE,dTDA,evDyn,singlet,triplet,linGW,eta_GW, & - nBas,nC,nO,nV,nR,nS,ENuc,ERHF,Hc,ERI_MO,PHF,cHF,eHF,eG0W0) + call G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet, & + linGW,eta_GW,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,Hc,ERI_MO,PHF,cHF,eHF,eG0W0) end if diff --git a/src/QuAcK/UG0W0.f90 b/src/QuAcK/UG0W0.f90 index c13a2a9..5e1b6fc 100644 --- a/src/QuAcK/UG0W0.f90 +++ b/src/QuAcK/UG0W0.f90 @@ -118,7 +118,7 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev call unrestricted_linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0, & eHF,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,OmRPA,rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA) - if(print_W) call print_excitation('RPA@UHF',5,nS_sc,OmRPA) + if(print_W) call print_excitation('RPA@UHF ',5,nS_sc,OmRPA) !----------------------! ! Excitation densities ! diff --git a/src/QuAcK/evUGW.f90 b/src/QuAcK/evUGW.f90 index 3c8b2d8..1ba36ac 100644 --- a/src/QuAcK/evUGW.f90 +++ b/src/QuAcK/evUGW.f90 @@ -127,9 +127,8 @@ subroutine evUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE nS_bb = nS(2) nS_sc = nS_aa + nS_bb - allocate(eGW(nBas,nspin),eOld(nBas,nspin),Z(nBas,nspin),SigC(nBas,nspin),OmRPA(nS_sc), & - XpY_RPA(nS_sc,nS_sc),XmY_RPA(nS_sc,nS_sc),rho_RPA(nBas,nBas,nS_sc,nspin), & - error_diis(nBas,max_diis,nspin),e_diis(nBas,max_diis,nspin)) + allocate(eGW(nBas,nspin),eOld(nBas,nspin),Z(nBas,nspin),SigC(nBas,nspin),OmRPA(nS_sc),XpY_RPA(nS_sc,nS_sc), & + XmY_RPA(nS_sc,nS_sc),rho_RPA(nBas,nBas,nS_sc,nspin),error_diis(nBas,max_diis,nspin),e_diis(nBas,max_diis,nspin)) ! Initialization diff --git a/src/QuAcK/print_UG0W0.f90 b/src/QuAcK/print_UG0W0.f90 index f678a1e..0e8092e 100644 --- a/src/QuAcK/print_UG0W0.f90 +++ b/src/QuAcK/print_UG0W0.f90 @@ -16,15 +16,24 @@ subroutine print_UG0W0(nBas,nO,e,ENuc,EHF,SigC,Z,eGW,EcRPA) double precision,intent(in) :: eGW(nBas,nspin) integer :: p - double precision :: HOMO - double precision :: LUMO - double precision :: Gap + integer :: ispin + double precision :: HOMO(nspin) + double precision :: LUMO(nspin) + double precision :: Gap(nspin) ! HOMO and LUMO - HOMO = max(eGW(nO(1),1),eGW(nO(2),2)) - LUMO = min(eGW(nO(1)+1,1),eGW(nO(2)+1,2)) - Gap = LUMO - HOMO + do ispin=1,nspin + if(nO(ispin) > 0) then + HOMO(ispin) = eGW(nO(ispin),ispin) + LUMO(ispin) = eGW(nO(ispin)+1,ispin) + Gap(ispin) = LUMO(ispin) - HOMO(ispin) + else + HOMO(ispin) = 0d0 + LUMO(ispin) = e(1,ispin) + Gap(ispin) = 0d0 + end if + end do ! Dump results @@ -34,7 +43,7 @@ subroutine print_UG0W0(nBas,nO,e,ENuc,EHF,SigC,Z,eGW,EcRPA) write(*,*)'-------------------------------------------------------------------------------& -------------------------------------------------' write(*,'(A1,A3,A1,A30,A1,A30,A1,A30,A1,A30,A1)') & - '|',' ','|','e_HF ','|','Sig_c ','|','Z ','|','e_QP ','|' + '|',' ','|','e_HF ','|','Sig_c ','|','Z ','|','e_QP ','|' write(*,'(A1,A3,A1,2A15,A1,2A15,A1,2A15,A1,2A15,A1)') & '|','#','|','up ','dw ','|','up ','dw ','|','up ','dw ','|','up ','dw ','|' write(*,*)'-------------------------------------------------------------------------------& @@ -48,9 +57,9 @@ subroutine print_UG0W0(nBas,nO,e,ENuc,EHF,SigC,Z,eGW,EcRPA) write(*,*)'-------------------------------------------------------------------------------& -------------------------------------------------' - write(*,'(2X,A30,F15.6)') 'G0W0 HOMO energy (eV):',HOMO*HaToeV - write(*,'(2X,A30,F15.6)') 'G0W0 LUMO energy (eV):',LUMO*HaToeV - write(*,'(2X,A30,F15.6)') 'G0W0 HOMO-LUMO gap (eV):',Gap*HaToeV + write(*,'(2X,A30,F15.6)') 'G0W0 HOMO energy (eV):',maxval(HOMO(:))*HaToeV + write(*,'(2X,A30,F15.6)') 'G0W0 LUMO energy (eV):',minval(LUMO(:))*HaToeV + write(*,'(2X,A30,F15.6)') 'G0W0 HOMO-LUMO gap (eV):',(minval(LUMO(:))-maxval(HOMO(:)))*HaToeV write(*,*)'-------------------------------------------------------------------------------& -------------------------------------------------' write(*,'(2X,A30,F15.6)') 'RPA@G0W0 total energy =',ENuc + EHF + EcRPA diff --git a/src/QuAcK/print_UHF.f90 b/src/QuAcK/print_UHF.f90 index 6c52e4d..0ad8c89 100644 --- a/src/QuAcK/print_UHF.f90 +++ b/src/QuAcK/print_UHF.f90 @@ -16,18 +16,24 @@ subroutine print_UHF(nBas,nO,e,c,ENuc,ET,EV,EJ,Ex,EUHF) double precision,intent(in) :: Ex(nspin) double precision,intent(in) :: EUHF - integer :: HOMO(nspin) - integer :: LUMO(nspin) + integer :: ispin + double precision :: HOMO(nspin) + double precision :: LUMO(nspin) double precision :: Gap(nspin) ! HOMO and LUMO - HOMO(:) = nO(:) - - LUMO(:) = HOMO(:) + 1 - - Gap(1) = e(LUMO(1),1) - e(HOMO(1),1) - Gap(2) = e(LUMO(2),2) - e(HOMO(2),2) + do ispin=1,nspin + if(nO(ispin) > 0) then + HOMO(ispin) = e(nO(ispin),ispin) + LUMO(ispin) = e(nO(ispin)+1,ispin) + Gap(ispin) = LUMO(ispin) - HOMO(ispin) + else + HOMO(ispin) = 0d0 + LUMO(ispin) = e(1,ispin) + Gap(ispin) = 0d0 + end if + end do ! Dump results @@ -62,12 +68,12 @@ subroutine print_UHF(nBas,nO,e,c,ENuc,ET,EV,EJ,Ex,EUHF) write(*,'(A40,1X,F16.10,A3)') ' Nuclear repulsion: ',ENuc,' au' write(*,'(A40,1X,F16.10,A3)') ' UHF energy: ',EUHF + ENuc,' au' write(*,'(A60)') '-------------------------------------------------' - write(*,'(A40,F13.6,A3)') ' UHF HOMO a energy:',e(HOMO(1),1)*HatoeV,' eV' - write(*,'(A40,F13.6,A3)') ' UHF LUMO a energy:',e(LUMO(1),1)*HatoeV,' eV' + write(*,'(A40,F13.6,A3)') ' UHF HOMO a energy:',HOMO(1)*HatoeV,' eV' + write(*,'(A40,F13.6,A3)') ' UHF LUMO a energy:',LUMO(1)*HatoeV,' eV' write(*,'(A40,F13.6,A3)') ' UHF HOMOa-LUMOa gap:',Gap(1)*HatoeV,' eV' write(*,'(A60)') '-------------------------------------------------' - write(*,'(A40,F13.6,A3)') ' UHF HOMO b energy:',e(HOMO(2),2)*HatoeV,' eV' - write(*,'(A40,F13.6,A3)') ' UHF LUMO b energy:',e(LUMO(2),2)*HatoeV,' eV' + write(*,'(A40,F13.6,A3)') ' UHF HOMO b energy:',HOMO(2)*HatoeV,' eV' + write(*,'(A40,F13.6,A3)') ' UHF LUMO b energy:',LUMO(2)*HatoeV,' eV' write(*,'(A40,F13.6,A3)') ' UHF HOMOb-LUMOb gap :',Gap(2)*HatoeV,' eV' write(*,'(A60)') '-------------------------------------------------' write(*,*) diff --git a/src/QuAcK/print_evUGW.f90 b/src/QuAcK/print_evUGW.f90 index 7c32002..984d88c 100644 --- a/src/QuAcK/print_evUGW.f90 +++ b/src/QuAcK/print_evUGW.f90 @@ -18,15 +18,24 @@ subroutine print_evUGW(nBas,nO,nSCF,Conv,e,ENuc,EHF,SigC,Z,eGW,EcRPA) double precision,intent(in) :: eGW(nBas,nspin) integer :: p - double precision :: HOMO - double precision :: LUMO - double precision :: Gap + integer :: ispin + double precision :: HOMO(nspin) + double precision :: LUMO(nspin) + double precision :: Gap(nspin) ! HOMO and LUMO - HOMO = max(eGW(nO(1),1),eGW(nO(2),2)) - LUMO = min(eGW(nO(1)+1,1),eGW(nO(2)+1,2)) - Gap = LUMO - HOMO + do ispin=1,nspin + if(nO(ispin) > 0) then + HOMO(ispin) = eGW(nO(ispin),ispin) + LUMO(ispin) = eGW(nO(ispin)+1,ispin) + Gap(ispin) = LUMO(ispin) - HOMO(ispin) + else + HOMO(ispin) = 0d0 + LUMO(ispin) = e(1,ispin) + Gap(ispin) = 0d0 + end if + end do ! Dump results @@ -40,7 +49,7 @@ subroutine print_evUGW(nBas,nO,nSCF,Conv,e,ENuc,EHF,SigC,Z,eGW,EcRPA) write(*,*)'-------------------------------------------------------------------------------& -------------------------------------------------' write(*,'(A1,A3,A1,A30,A1,A30,A1,A30,A1,A30,A1)') & - '|',' ','|','e_HF ','|','Sig_c ','|','Z ','|','e_QP ','|' + '|',' ','|','e_HF ','|','Sig_c ','|','Z ','|','e_QP ','|' write(*,'(A1,A3,A1,2A15,A1,2A15,A1,2A15,A1,2A15,A1)') & '|','#','|','up ','dw ','|','up ','dw ','|','up ','dw ','|','up ','dw ','|' write(*,*)'-------------------------------------------------------------------------------& @@ -58,9 +67,9 @@ subroutine print_evUGW(nBas,nO,nSCF,Conv,e,ENuc,EHF,SigC,Z,eGW,EcRPA) write(*,'(2X,A14,F15.5)')'Convergence = ',Conv write(*,*)'-------------------------------------------------------------------------------& -------------------------------------------------' - write(*,'(2X,A30,F15.6)') 'evGW HOMO energy (eV):',HOMO*HaToeV - write(*,'(2X,A30,F15.6)') 'evGW LUMO energy (eV):',LUMO*HaToeV - write(*,'(2X,A30,F15.6)') 'evGW HOMO-LUMO gap (eV):',Gap*HaToeV + write(*,'(2X,A30,F15.6)') 'evGW HOMO energy (eV):',maxval(HOMO(:))*HaToeV + write(*,'(2X,A30,F15.6)') 'evGW LUMO energy (eV):',minval(LUMO(:))*HaToeV + write(*,'(2X,A30,F15.6)') 'evGW HOMO-LUMO gap (eV):',(minval(LUMO(:))-maxval(HOMO(:)))*HaToeV write(*,*)'-------------------------------------------------------------------------------& -------------------------------------------------' write(*,'(2X,A30,F15.6)') 'RPA@evGW total energy =',ENuc + EHF + EcRPA diff --git a/src/QuAcK/print_excitation.f90 b/src/QuAcK/print_excitation.f90 index 7aec451..c2bbdb4 100644 --- a/src/QuAcK/print_excitation.f90 +++ b/src/QuAcK/print_excitation.f90 @@ -7,7 +7,7 @@ subroutine print_excitation(method,ispin,nS,Omega) ! Input variables - character*12,intent(in) :: method + character*12,intent(in) :: method integer,intent(in) :: ispin,nS double precision,intent(in) :: Omega(nS) From 0e9edb30d28120c28c8462538f8d850bb6da229a Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Mon, 28 Sep 2020 21:25:25 +0200 Subject: [PATCH 14/17] oscillator strength and dipole integrals --- examples/basis.Ne.cc-pvdz | 43 +++++----- examples/molecule.H2 | 4 +- input/basis | 9 ++ input/methods | 6 +- input/molecule | 5 +- input/molecule.xyz | 5 +- input/options | 4 +- src/QuAcK/BSE2.f90 | 30 +++---- src/QuAcK/BSE2_dynamic_perturbation.f90 | 5 +- .../BSE2_dynamic_perturbation_iterative.f90 | 6 +- src/QuAcK/Bethe_Salpeter.f90 | 15 ++-- .../Bethe_Salpeter_dynamic_perturbation.f90 | 6 +- ...alpeter_dynamic_perturbation_iterative.f90 | 6 +- src/QuAcK/CIS.f90 | 3 +- src/QuAcK/G0F2.f90 | 5 +- src/QuAcK/G0T0.f90 | 21 ++--- src/QuAcK/G0W0.f90 | 5 +- src/QuAcK/QuAcK.f90 | 85 ++++++++++++------- src/QuAcK/RPAx.f90 | 8 +- src/QuAcK/UCIS.f90 | 3 +- src/QuAcK/UG0W0.f90 | 3 +- src/QuAcK/URPAx.f90 | 7 +- src/QuAcK/UdRPA.f90 | 3 +- src/QuAcK/dRPA.f90 | 7 +- src/QuAcK/evGF2.f90 | 5 +- src/QuAcK/evGT.f90 | 19 ++--- src/QuAcK/evGW.f90 | 5 +- src/QuAcK/evUGW.f90 | 3 +- src/QuAcK/print_transition_vectors.f90 | 72 +++++++++++----- src/QuAcK/qsGW.f90 | 6 +- src/QuAcK/spatial_to_spin_MO_energy.f90 | 2 +- ...unrestricted_spatial_to_spin_MO_energy.f90 | 30 +++++++ src/utils/read_integrals.f90 | 4 + 33 files changed, 283 insertions(+), 157 deletions(-) create mode 100644 src/QuAcK/unrestricted_spatial_to_spin_MO_energy.f90 diff --git a/examples/basis.Ne.cc-pvdz b/examples/basis.Ne.cc-pvdz index f19a2d0..ae7d362 100644 --- a/examples/basis.Ne.cc-pvdz +++ b/examples/basis.Ne.cc-pvdz @@ -1,30 +1,29 @@ 1 6 S 8 - 1 17880.0000000 0.0007380 - 2 2683.0000000 0.0056770 - 3 611.5000000 0.0288830 - 4 173.5000000 0.1085400 - 5 56.6400000 0.2909070 - 6 20.4200000 0.4483240 - 7 7.8100000 0.2580260 - 8 1.6530000 0.0150630 + 1 17880.0000000 0.0007380 + 2 2683.0000000 0.0056770 + 3 611.5000000 0.0288830 + 4 173.5000000 0.1085400 + 5 56.6400000 0.2909070 + 6 20.4200000 0.4483240 + 7 7.8100000 0.2580260 + 8 1.6530000 0.0150630 S 8 - 1 17880.0000000 -0.0001720 - 2 2683.0000000 -0.0013570 - 3 611.5000000 -0.0067370 - 4 173.5000000 -0.0276630 - 5 56.6400000 -0.0762080 - 6 20.4200000 -0.1752270 - 7 7.8100000 -0.1070380 - 8 1.6530000 0.5670500 + 1 17880.0000000 -0.0001720 + 2 2683.0000000 -0.0013570 + 3 611.5000000 -0.0067370 + 4 173.5000000 -0.0276630 + 5 56.6400000 -0.0762080 + 6 20.4200000 -0.1752270 + 7 7.8100000 -0.1070380 + 8 1.6530000 0.5670500 S 1 - 1 0.4869000 1.0000000 + 1 0.4869000 1.0000000 P 3 - 1 28.3900000 0.0460870 - 2 6.2700000 0.2401810 - 3 1.6950000 0.5087440 + 1 28.3900000 0.0460870 + 2 6.2700000 0.2401810 + 3 1.6950000 0.5087440 P 1 - 1 0.4317000 1.0000000 + 1 0.4317000 1.0000000 D 1 1 2.2020000 1.0000000 - diff --git a/examples/molecule.H2 b/examples/molecule.H2 index 779d849..7225285 100644 --- a/examples/molecule.H2 +++ b/examples/molecule.H2 @@ -1,5 +1,5 @@ # nAt nEla nElb nCore nRyd 2 1 1 0 0 # Znuc x y z - H 0. 0. 0. - H 0. 0. 1.399 + H 0. 0. -0.7 + H 0. 0. 0.7 diff --git a/input/basis b/input/basis index 79a747a..fb05e68 100644 --- a/input/basis +++ b/input/basis @@ -7,3 +7,12 @@ S 1 1 0.1220000 1.0000000 P 1 1 0.7270000 1.0000000 +2 3 +S 3 + 1 13.0100000 0.0196850 + 2 1.9620000 0.1379770 + 3 0.4446000 0.4781480 +S 1 + 1 0.1220000 1.0000000 +P 1 + 1 0.7270000 1.0000000 diff --git a/input/methods b/input/methods index 58c5d33..0d456f5 100644 --- a/input/methods +++ b/input/methods @@ -1,7 +1,7 @@ # RHF UHF MOM - F T F -# MP2* MP3 MP2-F12 T F F +# MP2* MP3 MP2-F12 + F F F # CCD CCSD CCSD(T) F F F # drCCD rCCD lCCD pCCD @@ -13,7 +13,7 @@ # G0F2 evGF2 G0F3 evGF3 F F F F # G0W0* evGW* qsGW - F F F + T F F # G0T0 evGT qsGT F F F # MCMP2 diff --git a/input/molecule b/input/molecule index fd4bfbe..7225285 100644 --- a/input/molecule +++ b/input/molecule @@ -1,4 +1,5 @@ # nAt nEla nElb nCore nRyd - 1 1 0 0 0 + 2 1 1 0 0 # Znuc x y z - H 0. 0. 0. + H 0. 0. -0.7 + H 0. 0. 0.7 diff --git a/input/molecule.xyz b/input/molecule.xyz index 3dca9a4..ac9420c 100644 --- a/input/molecule.xyz +++ b/input/molecule.xyz @@ -1,3 +1,4 @@ - 1 + 2 - H 0.0000000000 0.0000000000 0.0000000000 + H 0.0000000000 0.0000000000 -0.3704240743 + H 0.0000000000 0.0000000000 0.3704240743 diff --git a/input/options b/input/options index 0d3bf88..1d00d01 100644 --- a/input/options +++ b/input/options @@ -1,4 +1,4 @@ -# RHF: maxSCF thresh DIIS n_diis guess_type ortho_type +# HF: maxSCF thresh DIIS n_diis guess_type ortho_type 64 0.00001 T 5 1 1 # MP: @@ -13,6 +13,6 @@ # ACFDT: AC Kx XBS F F T # BSE: BSE dBSE dTDA evDyn - F F T T + F T T F # MCMP2: nMC nEq nWalk dt nPrint iSeed doDrift 1000000 100000 10 0.3 10000 1234 T diff --git a/src/QuAcK/BSE2.f90 b/src/QuAcK/BSE2.f90 index 64a9e8c..123cfea 100644 --- a/src/QuAcK/BSE2.f90 +++ b/src/QuAcK/BSE2.f90 @@ -1,5 +1,4 @@ -subroutine BSE2(TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold, & - eta,nBas,nC,nO,nV,nR,nS,ERI,eHF,eGF,EcBSE) +subroutine BSE2(TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,eGF,EcBSE) ! Compute the Bethe-Salpeter excitation energies @@ -12,8 +11,8 @@ subroutine BSE2(TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold, & logical,intent(in) :: dBSE logical,intent(in) :: dTDA logical,intent(in) :: evDyn - logical,intent(in) :: singlet_manifold - logical,intent(in) :: triplet_manifold + logical,intent(in) :: singlet + logical,intent(in) :: triplet double precision,intent(in) :: eta integer,intent(in) :: nBas @@ -25,6 +24,7 @@ subroutine BSE2(TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold, & double precision,intent(in) :: eHF(nBas) double precision,intent(in) :: eGF(nBas) double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + double precision,intent(in) :: dipole_int(nBas,nBas,ncart) ! Local variables @@ -46,14 +46,14 @@ subroutine BSE2(TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold, & ! Singlet manifold !------------------- - if(singlet_manifold) then + if(singlet) then ispin = 1 EcBSE(ispin) = 0d0 ! Compute BSE2 excitation energies - call linear_response(ispin,.false.,TDA,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGF(:),ERI(:,:,:,:), & + call linear_response(ispin,.false.,TDA,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGF,ERI, & OmBSE(:,ispin),rho,EcBSE(ispin),OmBSE(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) call print_excitation('BSE2 ',ispin,nS,OmBSE(:,ispin)) @@ -63,12 +63,12 @@ subroutine BSE2(TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold, & if(evDyn) then - call BSE2_dynamic_perturbation_iterative(dTDA,ispin,eta,nBas,nC,nO,nV,nR,nS, & - ERI(:,:,:,:),eHF(:),eGF(:),OmBSE(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + call BSE2_dynamic_perturbation_iterative(dTDA,ispin,eta,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,eGF, & + OmBSE(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) else - call BSE2_dynamic_perturbation(dTDA,ispin,eta,nBas,nC,nO,nV,nR,nS, & - ERI(:,:,:,:),eHF(:),eGF(:),OmBSE(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + call BSE2_dynamic_perturbation(dTDA,ispin,eta,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,eGF, & + OmBSE(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) end if @@ -80,7 +80,7 @@ subroutine BSE2(TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold, & ! Triplet manifold !------------------- - if(triplet_manifold) then + if(triplet) then ispin = 2 EcBSE(ispin) = 0d0 @@ -97,12 +97,12 @@ subroutine BSE2(TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold, & if(evDyn) then - call BSE2_dynamic_perturbation_iterative(dTDA,ispin,eta,nBas,nC,nO,nV,nR,nS, & - ERI(:,:,:,:),eHF(:),eGF(:),OmBSE(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + call BSE2_dynamic_perturbation_iterative(dTDA,ispin,eta,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,eGF, & + OmBSE(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) else - call BSE2_dynamic_perturbation(dTDA,ispin,eta,nBas,nC,nO,nV,nR,nS, & - ERI(:,:,:,:),eHF(:),eGF(:),OmBSE(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + call BSE2_dynamic_perturbation(dTDA,ispin,eta,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,eGF, & + OmBSE(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) end if diff --git a/src/QuAcK/BSE2_dynamic_perturbation.f90 b/src/QuAcK/BSE2_dynamic_perturbation.f90 index 30883d8..94c7c59 100644 --- a/src/QuAcK/BSE2_dynamic_perturbation.f90 +++ b/src/QuAcK/BSE2_dynamic_perturbation.f90 @@ -1,4 +1,4 @@ -subroutine BSE2_dynamic_perturbation(dTDA,ispin,eta,nBas,nC,nO,nV,nR,nS,ERI,eHF,eGF,OmBSE,XpY,XmY) +subroutine BSE2_dynamic_perturbation(dTDA,ispin,eta,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,eGF,OmBSE,XpY,XmY) ! Compute dynamical effects via perturbation theory for BSE @@ -18,6 +18,7 @@ subroutine BSE2_dynamic_perturbation(dTDA,ispin,eta,nBas,nC,nO,nV,nR,nS,ERI,eHF, integer,intent(in) :: nS double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + double precision,intent(in) :: dipole_int(nBas,nBas,ncart) double precision,intent(in) :: eHF(nBas) double precision,intent(in) :: eGF(nBas) double precision,intent(in) :: OmBSE(nS) @@ -56,7 +57,7 @@ subroutine BSE2_dynamic_perturbation(dTDA,ispin,eta,nBas,nC,nO,nV,nR,nS,ERI,eHF, ! Print main components of transition vectors - call print_transition_vectors(nBas,nC,nO,nV,nR,nS,OmBSE,XpY,XmY) + call print_transition_vectors(.false.,nBas,nC,nO,nV,nR,nS,dipole_int,OmBSE,XpY,XmY) gapGF = eGF(nO+1) - eGF(nO) diff --git a/src/QuAcK/BSE2_dynamic_perturbation_iterative.f90 b/src/QuAcK/BSE2_dynamic_perturbation_iterative.f90 index 26d5905..eedfad1 100644 --- a/src/QuAcK/BSE2_dynamic_perturbation_iterative.f90 +++ b/src/QuAcK/BSE2_dynamic_perturbation_iterative.f90 @@ -1,4 +1,5 @@ -subroutine BSE2_dynamic_perturbation_iterative(dTDA,ispin,eta,nBas,nC,nO,nV,nR,nS,ERI,eHF,eGF,OmBSE,XpY,XmY) +subroutine BSE2_dynamic_perturbation_iterative(dTDA,ispin,eta,nBas,nC,nO,nV,nR,nS,ERI,dipole_int, & + eHF,eGF,OmBSE,XpY,XmY) ! Compute self-consistently the dynamical effects via perturbation theory for BSE2 @@ -18,6 +19,7 @@ subroutine BSE2_dynamic_perturbation_iterative(dTDA,ispin,eta,nBas,nC,nO,nV,nR,n integer,intent(in) :: nS double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + double precision,intent(in) :: dipole_int(nBas,nBas,ncart) double precision,intent(in) :: eHF(nBas) double precision,intent(in) :: eGF(nBas) double precision,intent(in) :: OmBSE(nS) @@ -58,7 +60,7 @@ subroutine BSE2_dynamic_perturbation_iterative(dTDA,ispin,eta,nBas,nC,nO,nV,nR,n ! Print main components of transition vectors - call print_transition_vectors(nBas,nC,nO,nV,nR,nS,OmBSE,XpY,XmY) + call print_transition_vectors(.false.,nBas,nC,nO,nV,nR,nS,OmBSE,XpY,XmY) if(dTDA) then write(*,*) diff --git a/src/QuAcK/Bethe_Salpeter.f90 b/src/QuAcK/Bethe_Salpeter.f90 index d0763ee..8ca6757 100644 --- a/src/QuAcK/Bethe_Salpeter.f90 +++ b/src/QuAcK/Bethe_Salpeter.f90 @@ -1,4 +1,4 @@ -subroutine Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,eW,eGW,EcBSE) +subroutine Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eW,eGW,EcBSE) ! Compute the Bethe-Salpeter excitation energies @@ -20,6 +20,7 @@ subroutine Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC, double precision,intent(in) :: eW(nBas) double precision,intent(in) :: eGW(nBas) double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + double precision,intent(in) :: dipole_int(nBas,nBas,ncart) ! Local variables @@ -70,6 +71,8 @@ subroutine Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC, call linear_response(ispin,.true.,TDA,.true.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI,OmRPA, & rho_RPA,EcBSE(ispin),OmBSE(:,ispin),XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin)) call print_excitation('BSE@GW ',ispin,nS,OmBSE(:,ispin)) + call print_transition_vectors(.true.,nBas,nC,nO,nV,nR,nS,dipole_int, & + OmBSE(:,ispin),XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin)) !------------------------------------------------- ! Compute the dynamical screening at the BSE level @@ -81,11 +84,11 @@ subroutine Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC, if(evDyn) then - call Bethe_Salpeter_dynamic_perturbation_iterative(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA, & + call Bethe_Salpeter_dynamic_perturbation_iterative(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,dipole_int,OmRPA,rho_RPA, & OmBSE(:,ispin),XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin)) else - call Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA, & + call Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,dipole_int,OmRPA,rho_RPA, & OmBSE(:,ispin),XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin)) end if @@ -107,6 +110,8 @@ subroutine Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC, call linear_response(ispin,.true.,TDA,.true.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI,OmRPA, & rho_RPA,EcBSE(ispin),OmBSE(:,ispin),XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin)) call print_excitation('BSE@GW ',ispin,nS,OmBSE(:,ispin)) + call print_transition_vectors(.false.,nBas,nC,nO,nV,nR,nS,dipole_int, & + OmBSE(:,ispin),XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin)) !------------------------------------------------- ! Compute the dynamical screening at the BSE level @@ -118,11 +123,11 @@ subroutine Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC, if(evDyn) then - call Bethe_Salpeter_dynamic_perturbation_iterative(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA, & + call Bethe_Salpeter_dynamic_perturbation_iterative(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,dipole_int,OmRPA,rho_RPA, & OmBSE(:,ispin),XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin)) else - call Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA, & + call Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,dipole_int,OmRPA,rho_RPA, & OmBSE(:,ispin),XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin)) end if diff --git a/src/QuAcK/Bethe_Salpeter_dynamic_perturbation.f90 b/src/QuAcK/Bethe_Salpeter_dynamic_perturbation.f90 index ba0d2dd..197f2b2 100644 --- a/src/QuAcK/Bethe_Salpeter_dynamic_perturbation.f90 +++ b/src/QuAcK/Bethe_Salpeter_dynamic_perturbation.f90 @@ -1,4 +1,5 @@ -subroutine Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA,OmBSE,XpY,XmY) +subroutine Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,dipole_int, & + OmRPA,rho_RPA,OmBSE,XpY,XmY) ! Compute dynamical effects via perturbation theory for BSE @@ -17,6 +18,7 @@ subroutine Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW, integer,intent(in) :: nS double precision,intent(in) :: eGW(nBas) + double precision,intent(in) :: dipole_int(nBas,nBas,ncart) double precision,intent(in) :: OmRPA(nS) double precision,intent(in) :: rho_RPA(nBas,nBas,nS) double precision,intent(in) :: OmBSE(nS) @@ -55,7 +57,7 @@ subroutine Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW, ! Print main components of transition vectors - call print_transition_vectors(nBas,nC,nO,nV,nR,nS,OmBSE,XpY,XmY) + call print_transition_vectors(.false.,nBas,nC,nO,nV,nR,nS,dipole_int,OmBSE,XpY,XmY) if(dTDA) then write(*,*) diff --git a/src/QuAcK/Bethe_Salpeter_dynamic_perturbation_iterative.f90 b/src/QuAcK/Bethe_Salpeter_dynamic_perturbation_iterative.f90 index 72b5e88..c25da2a 100644 --- a/src/QuAcK/Bethe_Salpeter_dynamic_perturbation_iterative.f90 +++ b/src/QuAcK/Bethe_Salpeter_dynamic_perturbation_iterative.f90 @@ -1,4 +1,5 @@ -subroutine Bethe_Salpeter_dynamic_perturbation_iterative(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,OmRPA,rho_RPA,OmBSE,XpY,XmY) +subroutine Bethe_Salpeter_dynamic_perturbation_iterative(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,dipole_int, & + OmRPA,rho_RPA,OmBSE,XpY,XmY) ! Compute self-consistently the dynamical effects via perturbation theory for BSE @@ -17,6 +18,7 @@ subroutine Bethe_Salpeter_dynamic_perturbation_iterative(dTDA,eta,nBas,nC,nO,nV, integer,intent(in) :: nS double precision,intent(in) :: eGW(nBas) + double precision,intent(in) :: dipole_int(nBas,nBas,ncart) double precision,intent(in) :: OmRPA(nS) double precision,intent(in) :: rho_RPA(nBas,nBas,nS) double precision,intent(in) :: OmBSE(nS) @@ -54,7 +56,7 @@ subroutine Bethe_Salpeter_dynamic_perturbation_iterative(dTDA,eta,nBas,nC,nO,nV, ! Print main components of transition vectors - call print_transition_vectors(nBas,nC,nO,nV,nR,nS,OmBSE,XpY,XmY) + call print_transition_vectors(.false.,nBas,nC,nO,nV,nR,nS,dipole_int,OmBSE,XpY,XmY) if(dTDA) then write(*,*) diff --git a/src/QuAcK/CIS.f90 b/src/QuAcK/CIS.f90 index a18660f..ac4923c 100644 --- a/src/QuAcK/CIS.f90 +++ b/src/QuAcK/CIS.f90 @@ -1,5 +1,5 @@ subroutine CIS(singlet_manifold,triplet_manifold, & - nBas,nC,nO,nV,nR,nS,ERI,eHF) + nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF) ! Perform configuration interaction single calculation` @@ -13,6 +13,7 @@ subroutine CIS(singlet_manifold,triplet_manifold, & integer,intent(in) :: nBas,nC,nO,nV,nR,nS double precision,intent(in) :: eHF(nBas) double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + double precision,intent(in) :: dipole_int(nBas,nBas,ncart) ! Local variables diff --git a/src/QuAcK/G0F2.f90 b/src/QuAcK/G0F2.f90 index 88a41ce..8204ad1 100644 --- a/src/QuAcK/G0F2.f90 +++ b/src/QuAcK/G0F2.f90 @@ -1,5 +1,5 @@ subroutine G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold, & - linearize,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF) + linearize,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF) ! Perform a one-shot second-order Green function calculation @@ -27,6 +27,7 @@ subroutine G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold, & double precision,intent(in) :: ERHF double precision,intent(in) :: eHF(nBas) double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + double precision,intent(in) :: dipole_int(nBas,nBas,ncart) ! Local variables @@ -115,7 +116,7 @@ subroutine G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold, & if(BSE) then - call BSE2(TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold,eta,nBas,nC,nO,nV,nR,nS,ERI,eHF,eGF2,EcBSE) + call BSE2(TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold,eta,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,eGF2,EcBSE) end if diff --git a/src/QuAcK/G0T0.f90 b/src/QuAcK/G0T0.f90 index 231c842..c7ed983 100644 --- a/src/QuAcK/G0T0.f90 +++ b/src/QuAcK/G0T0.f90 @@ -1,5 +1,5 @@ -subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold, & - linearize,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF,eG0T0) +subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet, & + linearize,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF,eG0T0) ! Perform one-shot calculation with a T-matrix self-energy (G0T0) @@ -17,8 +17,8 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,sing logical,intent(in) :: dBSE logical,intent(in) :: dTDA logical,intent(in) :: evDyn - logical,intent(in) :: singlet_manifold - logical,intent(in) :: triplet_manifold + logical,intent(in) :: singlet + logical,intent(in) :: triplet logical,intent(in) :: linearize double precision,intent(in) :: eta @@ -32,6 +32,7 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,sing double precision,intent(in) :: ERHF double precision,intent(in) :: eHF(nBas) double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + double precision,intent(in) :: dipole_int(nBas,nBas,ncart) ! Local variables @@ -212,10 +213,8 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,sing if(BSE) then - allocate(Omega(nS,nspin),XpY(nS,nS,nspin),XmY(nS,nS,nspin),rho(nBas,nBas,nS,nspin)) - - call Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold,eta, & - nBas,nC,nO,nV,nR,nS,ERI,eHF,eG0T0,Omega,XpY,XmY,rho,EcRPA,EcBSE) + call Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta, & + nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,eG0T0,EcBSE) if(exchange_kernel) then @@ -249,8 +248,8 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,sing end if - call ACFDT(exchange_kernel,doXBS,.true.,TDA_W,TDA,BSE,singlet_manifold,triplet_manifold,eta, & - nBas,nC,nO,nV,nR,nS,ERI,eHF,eG0T0,Omega,XpY,XmY,rho,EcAC) + call ACFDT(exchange_kernel,doXBS,.true.,TDA_W,TDA,BSE,singlet,triplet,eta, & + nBas,nC,nO,nV,nR,nS,ERI,eHF,eG0T0,EcAC) if(exchange_kernel) then @@ -270,6 +269,8 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,sing 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/QuAcK/G0W0.f90 b/src/QuAcK/G0W0.f90 index a01c21b..058a0c8 100644 --- a/src/QuAcK/G0W0.f90 +++ b/src/QuAcK/G0W0.f90 @@ -1,6 +1,6 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & dBSE,dTDA,evDyn,singlet,triplet,linearize,eta, & - nBas,nC,nO,nV,nR,nS,ENuc,ERHF,Hc,ERI,PHF,cHF,eHF,eGW) + nBas,nC,nO,nV,nR,nS,ENuc,ERHF,Hc,ERI,dipole_int,PHF,cHF,eHF,eGW) ! Perform G0W0 calculation @@ -34,6 +34,7 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & double precision,intent(in) :: PHF(nBas,nBas) double precision,intent(in) :: Hc(nBas,nBas) double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + double precision,intent(in) :: dipole_int(nBas,nBas,ncart) ! Local variables @@ -182,7 +183,7 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & if(BSE) then - call Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,eHF,eGW,EcBSE) + call Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,eGW,EcBSE) if(exchange_kernel) then diff --git a/src/QuAcK/QuAcK.f90 b/src/QuAcK/QuAcK.f90 index 2efdaa2..9c5c095 100644 --- a/src/QuAcK/QuAcK.f90 +++ b/src/QuAcK/QuAcK.f90 @@ -52,9 +52,17 @@ program QuAcK integer :: TrialType double precision,allocatable :: cTrial(:),gradient(:),hessian(:,:) - double precision,allocatable :: S(:,:),T(:,:),V(:,:),Hc(:,:),H(:,:),X(:,:) + double precision,allocatable :: S(:,:) + double precision,allocatable :: T(:,:) + double precision,allocatable :: V(:,:) + double precision,allocatable :: Hc(:,:) + double precision,allocatable :: H(:,:) + double precision,allocatable :: X(:,:) + double precision,allocatable :: dipole_int(:,:,:,:) double precision,allocatable :: ERI_AO(:,:,:,:) double precision,allocatable :: ERI_MO(:,:,:,:) + integer :: ixyz + integer :: ispin integer :: bra1,bra2 integer :: ket1,ket2 double precision,allocatable :: ERI_MO_aaaa(:,:,:,:) @@ -225,7 +233,8 @@ program QuAcK ! Memory allocation for one- and two-electron integrals allocate(cHF(nBas,nBas,nspin),eHF(nBas,nspin),eG0W0(nBas,nspin),eG0T0(nBas,nspin),PHF(nBas,nBas,nspin), & - S(nBas,nBas),T(nBas,nBas),V(nBas,nBas),Hc(nBas,nBas),H(nBas,nBas),X(nBas,nBas),ERI_AO(nBas,nBas,nBas,nBas)) + S(nBas,nBas),T(nBas,nBas),V(nBas,nBas),Hc(nBas,nBas),H(nBas,nBas),X(nBas,nBas), & + dipole_int(nBas,nBas,ncart,nspin),ERI_AO(nBas,nBas,nBas,nBas)) ! Read integrals @@ -319,7 +328,6 @@ program QuAcK write(*,*) 'AO to MO transformation... Please be patient' write(*,*) - if(doSph) then allocate(ERI_MO(nBas,nBas,nBas,nBas)) @@ -331,6 +339,15 @@ program QuAcK if(unrestricted) then + ! Read and transform dipole-related integrals + + call read_dipole_integrals(nBas,dipole_int) + do ixyz=1,ncart + do ispin=1,nspin + call AOtoMO_transform(nBas,cHF(:,:,ispin),dipole_int(:,:,ixyz,ispin)) + end do + end do + ! Memory allocation allocate(ERI_MO_aaaa(nBas,nBas,nBas,nBas),ERI_MO_aabb(nBas,nBas,nBas,nBas),ERI_MO_bbbb(nBas,nBas,nBas,nBas)) @@ -379,7 +396,15 @@ program QuAcK ! Memory allocation allocate(ERI_MO(nBas,nBas,nBas,nBas)) - + + ! Read and transform dipole-related integrals + + ispin = 1 + call read_dipole_integrals(nBas,dipole_int) + do ixyz=1,ncart + call AOtoMO_transform(nBas,cHF,dipole_int(:,:,ixyz,ispin)) + end do + ! 4-index transform bra1 = 1 @@ -588,11 +613,12 @@ program QuAcK call cpu_time(start_CIS) if(unrestricted) then - call UCIS(spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,ERI_MO_abab,eHF) + call UCIS(spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_MO_aaaa,ERI_MO_aabb, & + ERI_MO_bbbb,ERI_MO_abab,dipole_int,eHF) else - call CIS(singlet,triplet,nBas,nC,nO,nV,nR,nS,ERI_MO,eHF) + call CIS(singlet,triplet,nBas,nC,nO,nV,nR,nS,ERI_MO,dipole_int,eHF) end if call cpu_time(end_CIS) @@ -626,7 +652,7 @@ program QuAcK if(doCISD) then call cpu_time(start_CISD) - call CISD(singlet,triplet,nBas,nC,nO,nV,nR,ERI_MO,eHF) +! call CISD(singlet,triplet,nBas,nC,nO,nV,nR,ERI_MO,eHF) call cpu_time(end_CISD) t_CISD = end_CISD - start_CISD @@ -645,11 +671,11 @@ program QuAcK if(unrestricted) then call UdRPA(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,0d0,nBas,nC,nO,nV,nR,nS,ENuc,EUHF, & - ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,ERI_MO_abab,eHF) + ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,ERI_MO_abab,dipole_int,eHF) else - call dRPA(TDA,doACFDT,exchange_kernel,singlet,triplet,0d0,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF) + call dRPA(TDA,doACFDT,exchange_kernel,singlet,triplet,0d0,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int,eHF) end if call cpu_time(end_RPA) @@ -670,11 +696,11 @@ program QuAcK if(unrestricted) then call URPAx(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,0d0,nBas,nC,nO,nV,nR,nS,ENuc,EUHF, & - ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,ERI_MO_abab,eHF) + ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,ERI_MO_abab,dipole_int,eHF) else - call RPAx(TDA,doACFDT,exchange_kernel,singlet,triplet,0d0,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF) + call RPAx(TDA,doACFDT,exchange_kernel,singlet,triplet,0d0,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int,eHF) end if call cpu_time(end_RPAx) @@ -692,8 +718,7 @@ program QuAcK if(doppRPA) then call cpu_time(start_ppRPA) - call ppRPA(singlet,triplet, & - nBas,nC,nO,nV,nR,ENuc,ERHF,ERI_MO,eHF) + call ppRPA(singlet,triplet,nBas,nC,nO,nV,nR,ENuc,ERHF,ERI_MO,eHF) call cpu_time(end_ppRPA) t_ppRPA = end_ppRPA - start_ppRPA @@ -727,7 +752,7 @@ program QuAcK call cpu_time(start_GF2) call G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet,linGF, & - eta_GF,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF) + eta_GF,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int,eHF) call cpu_time(end_GF2) t_GF2 = end_GF2 - start_GF2 @@ -744,8 +769,8 @@ program QuAcK call cpu_time(start_GF2) call evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF_GF,thresh_GF,n_diis_GF, & - singlet,triplet,linGF, & - eta_GF,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF) + singlet,triplet,linGF,eta_GF,nBas,nC,nO,nV,nR,nS,ENuc,ERHF, & + ERI_MO,dipole_int,eHF) call cpu_time(end_GF2) t_GF2 = end_GF2 - start_GF2 @@ -799,11 +824,11 @@ program QuAcK call UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,evDyn, & spin_conserved,spin_flip,linGW,eta_GW,nBas,nC,nO,nV,nR,nS, & - ENuc,EUHF,Hc,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,ERI_MO_abab,PHF,cHF,eHF,eG0W0) + ENuc,EUHF,Hc,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,ERI_MO_abab,dipole_int,PHF,cHF,eHF,eG0W0) else call G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet, & - linGW,eta_GW,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,Hc,ERI_MO,PHF,cHF,eHF,eG0W0) + linGW,eta_GW,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,Hc,ERI_MO,dipole_int,PHF,cHF,eHF,eG0W0) end if @@ -826,13 +851,13 @@ program QuAcK call evUGW(maxSCF_GW,thresh_GW,n_diis_GW,doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA, & G0W,GW0,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta_GW,nBas,nC,nO,nV,nR,nS,ENuc, & - ERHF,Hc,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,ERI_MO_abab,PHF,cHF,eHF,eG0W0) + ERHF,Hc,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,ERI_MO_abab,dipole_int,PHF,cHF,eHF,eG0W0) else call evGW(maxSCF_GW,thresh_GW,n_diis_GW,doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX, & BSE,TDA_W,TDA,G0W,GW0,dBSE,dTDA,evDyn,singlet,triplet,eta_GW, & - nBas,nC,nO,nV,nR,nS,ENuc,ERHF,Hc,ERI_MO,PHF,cHF,eHF,eG0W0) + nBas,nC,nO,nV,nR,nS,ENuc,ERHF,Hc,ERI_MO,dipole_int,PHF,cHF,eHF,eG0W0) end if call cpu_time(end_evGW) @@ -851,7 +876,7 @@ program QuAcK call cpu_time(start_qsGW) call qsGW(maxSCF_GW,thresh_GW,n_diis_GW,doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX, & BSE,TDA_W,TDA,G0W,GW0,dBSE,dTDA,evDyn,singlet,triplet,eta_GW, & - nBas,nC,nO,nV,nR,nS,ENuc,ERHF,S,X,T,V,Hc,ERI_AO,ERI_MO,PHF,cHF,eHF) + nBas,nC,nO,nV,nR,nS,ENuc,ERHF,S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int,PHF,cHF,eHF) call cpu_time(end_qsGW) t_qsGW = end_qsGW - start_qsGW @@ -869,9 +894,9 @@ program QuAcK if(doG0T0) then call cpu_time(start_G0T0) - call G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA, & + call G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA, & dBSE,dTDA,evDyn,singlet,triplet,linGW,eta_GW, & - nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF,eG0T0) + nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int,eHF,eG0T0) call cpu_time(end_G0T0) t_G0T0 = end_G0T0 - start_G0T0 @@ -887,9 +912,9 @@ program QuAcK if(doevGT) then call cpu_time(start_evGT) - call evGT(maxSCF_GW,thresh_GW,n_diis_GW,doACFDT,exchange_kernel,doXBS, & - BSE,TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta_GW, & - nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,eHF,eG0T0) + call evGT(maxSCF_GW,thresh_GW,n_diis_GW,doACFDT,exchange_kernel,doXBS, & + BSE,TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta_GW, & + nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int,eHF,eG0T0) call cpu_time(end_evGT) t_evGT = end_evGT - start_evGT @@ -898,10 +923,6 @@ program QuAcK end if -!------------------------------------------------------------------------ -! Perform evGT calculatiom -!------------------------------------------------------------------------ - !------------------------------------------------------------------------ ! Information for Monte Carlo calculations !------------------------------------------------------------------------ @@ -1006,7 +1027,7 @@ program QuAcK call cpu_time(start_G0W0) call G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & dBSE,dTDA,evDyn,singlet,triplet,linGW,eta_GW, & - nBas,nC,nO,nV,nR,nS,ENuc,ERHF,Hc,ERI_ERF_MO,PHF,cHF,eHF,eG0W0) + nBas,nC,nO,nV,nR,nS,ENuc,ERHF,Hc,ERI_ERF_MO,dipole_int,PHF,cHF,eHF,eG0W0) call cpu_time(end_G0W0) t_G0W0 = end_G0W0 - start_G0W0 @@ -1020,7 +1041,7 @@ program QuAcK call cpu_time(start_G0T0) call G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn, & singlet,triplet,linGW,eta_GW, & - nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_ERF_MO,eHF,eG0T0) + nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_ERF_MO,dipole_int,eHF,eG0T0) call cpu_time(end_G0T0) t_G0T0 = end_G0T0 - start_G0T0 diff --git a/src/QuAcK/RPAx.f90 b/src/QuAcK/RPAx.f90 index 37f3f25..3e523b4 100644 --- a/src/QuAcK/RPAx.f90 +++ b/src/QuAcK/RPAx.f90 @@ -1,4 +1,5 @@ -subroutine RPAx(TDA,doACFDT,exchange_kernel,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF) +subroutine RPAx(TDA,doACFDT,exchange_kernel,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF, & + ERI,dipole_int,eHF) ! Perform random phase approximation calculation with exchange (aka TDHF) @@ -24,6 +25,7 @@ subroutine RPAx(TDA,doACFDT,exchange_kernel,singlet,triplet,eta,nBas,nC,nO,nV,nR double precision,intent(in) :: ERHF double precision,intent(in) :: eHF(nBas) double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + double precision,intent(in) :: dipole_int(nBas,nBas,ncart) ! Local variables @@ -62,7 +64,7 @@ subroutine RPAx(TDA,doACFDT,exchange_kernel,singlet,triplet,eta,nBas,nC,nO,nV,nR call linear_response(ispin,.false.,TDA,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,Omega(:,ispin),rho, & EcRPAx(ispin),Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) call print_excitation('RPAx@HF ',ispin,nS,Omega(:,ispin)) - call print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + call print_transition_vectors(.true.,nBas,nC,nO,nV,nR,nS,dipole_int,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) endif @@ -75,7 +77,7 @@ subroutine RPAx(TDA,doACFDT,exchange_kernel,singlet,triplet,eta,nBas,nC,nO,nV,nR call linear_response(ispin,.false.,TDA,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,rho,Omega(:,ispin), & EcRPAx(ispin),Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) call print_excitation('RPAx@HF ',ispin,nS,Omega(:,ispin)) - call print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + call print_transition_vectors(.false.,nBas,nC,nO,nV,nR,nS,dipole_int,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) endif diff --git a/src/QuAcK/UCIS.f90 b/src/QuAcK/UCIS.f90 index 9db0626..e75fc5a 100644 --- a/src/QuAcK/UCIS.f90 +++ b/src/QuAcK/UCIS.f90 @@ -1,4 +1,4 @@ -subroutine UCIS(spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,eHF) +subroutine UCIS(spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,dipole_int,eHF) ! Perform configuration interaction single calculation` @@ -20,6 +20,7 @@ subroutine UCIS(spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,E double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_abab(nBas,nBas,nBas,nBas) + double precision,intent(in) :: dipole_int(nBas,nBas,ncart,nspin) ! Local variables diff --git a/src/QuAcK/UG0W0.f90 b/src/QuAcK/UG0W0.f90 index 5e1b6fc..dd5fa5b 100644 --- a/src/QuAcK/UG0W0.f90 +++ b/src/QuAcK/UG0W0.f90 @@ -1,6 +1,6 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,evDyn, & spin_conserved,spin_flip,linearize,eta,nBas,nC,nO,nV,nR,nS, & - ENuc,EUHF,Hc,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,PHF,cHF,eHF,eGW) + ENuc,EUHF,Hc,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,dipole_int,PHF,cHF,eHF,eGW) ! Perform unrestricted G0W0 calculation @@ -41,6 +41,7 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_abab(nBas,nBas,nBas,nBas) + double precision,intent(in) :: dipole_int(nBas,nBas,ncart,nspin) ! Local variables diff --git a/src/QuAcK/URPAx.f90 b/src/QuAcK/URPAx.f90 index ff13fad..9a3c510 100644 --- a/src/QuAcK/URPAx.f90 +++ b/src/QuAcK/URPAx.f90 @@ -1,5 +1,5 @@ subroutine URPAx(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,nC,nO,nV,nR,nS,ENuc,EUHF, & - ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,e) + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,dipole_int,e) ! Perform random phase approximation calculation with exchange (aka TDHF) in the unrestricted formalism @@ -28,6 +28,7 @@ subroutine URPAx(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,n double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_abab(nBas,nBas,nBas,nBas) + double precision,intent(in) :: dipole_int(nBas,nBas,ncart,nspin) ! Local variables @@ -77,7 +78,7 @@ subroutine URPAx(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,n call unrestricted_linear_response(ispin,.false.,TDA,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0,e, & ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega_sc,rho_sc,EcRPAx(ispin),Omega_sc,XpY_sc,XmY_sc) call print_excitation('URPAx ',5,nS_sc,Omega_sc) -! call print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) +! call print_transition_vectors(.true.,nBas,nC,nO,nV,nR,nS,dipole_int,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) deallocate(Omega_sc,XpY_sc,XmY_sc) @@ -100,7 +101,7 @@ subroutine URPAx(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,n call unrestricted_linear_response(ispin,.false.,TDA,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sf,nS_sf,1d0,e, & ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega_sf,rho_sf,EcRPAx(ispin),Omega_sf,XpY_sf,XmY_sf) call print_excitation('URPAx ',6,nS_sf,Omega_sf) -! call print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) +! call print_transition_vectors(.false.,nBas,nC,nO,nV,nR,nS,dipole_int,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) deallocate(Omega_sf,XpY_sf,XmY_sf) diff --git a/src/QuAcK/UdRPA.f90 b/src/QuAcK/UdRPA.f90 index 0169441..5d1e7f6 100644 --- a/src/QuAcK/UdRPA.f90 +++ b/src/QuAcK/UdRPA.f90 @@ -1,5 +1,5 @@ subroutine UdRPA(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,nC,nO,nV,nR,nS,ENuc,EUHF, & - ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,e) + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,dipole_int,e) ! Perform random phase approximation calculation with exchange (aka TDHF) in the unrestricted formalism @@ -28,6 +28,7 @@ subroutine UdRPA(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,n double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_abab(nBas,nBas,nBas,nBas) + double precision,intent(in) :: dipole_int(nBas,nBas,ncart,nspin) ! Local variables diff --git a/src/QuAcK/dRPA.f90 b/src/QuAcK/dRPA.f90 index 3985af2..fa45771 100644 --- a/src/QuAcK/dRPA.f90 +++ b/src/QuAcK/dRPA.f90 @@ -1,4 +1,4 @@ -subroutine dRPA(TDA,doACFDT,exchange_kernel,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF) +subroutine dRPA(TDA,doACFDT,exchange_kernel,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF) ! Perform a direct random phase approximation calculation @@ -24,6 +24,7 @@ subroutine dRPA(TDA,doACFDT,exchange_kernel,singlet,triplet,eta,nBas,nC,nO,nV,nR double precision,intent(in) :: ERHF double precision,intent(in) :: eHF(nBas) double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + double precision,intent(in) :: dipole_int(nBas,nBas,ncart) ! Local variables @@ -62,7 +63,7 @@ subroutine dRPA(TDA,doACFDT,exchange_kernel,singlet,triplet,eta,nBas,nC,nO,nV,nR call linear_response(ispin,.true.,TDA,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,rho,Omega(:,ispin), & EcRPA(ispin),Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) call print_excitation('RPA@HF ',ispin,nS,Omega(:,ispin)) - call print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + call print_transition_vectors(.true.,nBas,nC,nO,nV,nR,nS,dipole_int,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) endif @@ -75,7 +76,7 @@ subroutine dRPA(TDA,doACFDT,exchange_kernel,singlet,triplet,eta,nBas,nC,nO,nV,nR call linear_response(ispin,.true.,TDA,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,rho,Omega(:,ispin), & EcRPA(ispin),Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) call print_excitation('RPA@HF ',ispin,nS,Omega(:,ispin)) - call print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + call print_transition_vectors(.false.,nBas,nC,nO,nV,nR,nS,dipole_int,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) endif diff --git a/src/QuAcK/evGF2.f90 b/src/QuAcK/evGF2.f90 index d8b6411..168a762 100644 --- a/src/QuAcK/evGF2.f90 +++ b/src/QuAcK/evGF2.f90 @@ -1,5 +1,5 @@ subroutine evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF,thresh,max_diis,singlet_manifold,triplet_manifold, & - linearize,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF) + linearize,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF) ! Perform eigenvalue self-consistent second-order Green function calculation @@ -30,6 +30,7 @@ subroutine evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF,thresh,max_diis,singlet_manifold double precision,intent(in) :: ERHF double precision,intent(in) :: eHF(nBas) double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + double precision,intent(in) :: dipole_int(nBas,nBas,ncart) ! Local variables @@ -168,7 +169,7 @@ subroutine evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF,thresh,max_diis,singlet_manifold if(BSE) then - call BSE2(TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold,eta,nBas,nC,nO,nV,nR,nS,ERI,eHF,eGF2,EcBSE) + call BSE2(TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold,eta,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,eGF2,EcBSE) end if diff --git a/src/QuAcK/evGT.f90 b/src/QuAcK/evGT.f90 index 1e8c030..c923a20 100644 --- a/src/QuAcK/evGT.f90 +++ b/src/QuAcK/evGT.f90 @@ -1,6 +1,6 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, & - BSE,TDA_W,TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold, & - eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF,eG0T0) + BSE,TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet, & + eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF,eG0T0) ! Perform eigenvalue self-consistent calculation with a T-matrix self-energy (evGT) @@ -21,8 +21,8 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, & logical,intent(in) :: dBSE logical,intent(in) :: dTDA logical,intent(in) :: evDyn - logical,intent(in) :: singlet_manifold - logical,intent(in) :: triplet_manifold + logical,intent(in) :: singlet + logical,intent(in) :: triplet double precision,intent(in) :: eta integer,intent(in) :: nBas @@ -35,6 +35,7 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, & double precision,intent(in) :: ERHF double precision,intent(in) :: eHF(nBas) double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + double precision,intent(in) :: dipole_int(nBas,nBas,ncart) double precision,intent(in) :: eG0T0(nBas) @@ -260,10 +261,8 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, & if(BSE) then - allocate(Omega(nS,nspin),XpY(nS,nS,nspin),XmY(nS,nS,nspin),rho(nBas,nBas,nS,nspin)) - - call Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold,eta, & - nBas,nC,nO,nV,nR,nS,ERI,eGT,eGT,Omega,XpY,XmY,rho,EcRPA,EcBSE) + call Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta, & + nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eGT,eGT,EcRPA,EcBSE) if(exchange_kernel) then @@ -297,8 +296,8 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, & end if - call ACFDT(exchange_kernel,doXBS,.true.,TDA_W,TDA,BSE,singlet_manifold,triplet_manifold,eta, & - nBas,nC,nO,nV,nR,nS,ERI,eGT,eGT,Omega,XpY,XmY,rho,EcAC) + call ACFDT(exchange_kernel,doXBS,.true.,TDA_W,TDA,BSE,singlet,triplet,eta, & + nBas,nC,nO,nV,nR,nS,ERI,eGT,eGT,EcAC) if(exchange_kernel) then diff --git a/src/QuAcK/evGW.f90 b/src/QuAcK/evGW.f90 index d7d816e..26061f8 100644 --- a/src/QuAcK/evGW.f90 +++ b/src/QuAcK/evGW.f90 @@ -1,6 +1,6 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & G0W,GW0,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,Hc,ERI, & - PHF,cHF,eHF,eG0W0) + dipole_int,PHF,cHF,eHF,eG0W0) ! Perform self-consistent eigenvalue-only GW calculation @@ -37,6 +37,7 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE double precision,intent(in) :: eG0W0(nBas) double precision,intent(in) :: Hc(nBas,nBas) double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + double precision,intent(in) :: dipole_int(nBas,nBas,ncart) ! Local variables @@ -235,7 +236,7 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE if(BSE) then - call Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,eGW,eGW,EcBSE) + call Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eGW,eGW,EcBSE) if(exchange_kernel) then diff --git a/src/QuAcK/evUGW.f90 b/src/QuAcK/evUGW.f90 index 1ba36ac..24f8e0e 100644 --- a/src/QuAcK/evUGW.f90 +++ b/src/QuAcK/evUGW.f90 @@ -1,6 +1,6 @@ subroutine evUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA, & G0W,GW0,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta,nBas,nC,nO,nV,nR,nS,ENuc, & - ERHF,Hc,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,PHF,cHF,eHF,eG0W0) + ERHF,Hc,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,dipole_int,PHF,cHF,eHF,eG0W0) ! Perform self-consistent eigenvalue-only GW calculation @@ -46,6 +46,7 @@ subroutine evUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_abab(nBas,nBas,nBas,nBas) + double precision,intent(in) :: dipole_int(nBas,nBas,ncart,nspin) ! Local variables diff --git a/src/QuAcK/print_transition_vectors.f90 b/src/QuAcK/print_transition_vectors.f90 index ab3e093..6986eec 100644 --- a/src/QuAcK/print_transition_vectors.f90 +++ b/src/QuAcK/print_transition_vectors.f90 @@ -1,4 +1,4 @@ -subroutine print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega,XpY,XmY) +subroutine print_transition_vectors(spin_allowed,nBas,nC,nO,nV,nR,nS,dipole_int,Omega,XpY,XmY) ! Print transition vectors for linear response calculation @@ -7,12 +7,14 @@ subroutine print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega,XpY,XmY) ! Input variables + logical,intent(in) :: spin_allowed 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 :: dipole_int(nBas,nBas,ncart) double precision,intent(in) :: Omega(nS) double precision,intent(in) :: XpY(nS,nS) double precision,intent(in) :: XmY(nS,nS) @@ -20,31 +22,66 @@ subroutine print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega,XpY,XmY) ! Local variables integer :: ia,jb,i,j,a,b + integer :: ixyz integer,parameter :: maxS = 10 - double precision,parameter :: thres_vec = 0.1d0 double precision :: norm + double precision,parameter :: thres_vec = 0.1d0 double precision,allocatable :: X(:) double precision,allocatable :: Y(:) + double precision,allocatable :: f(:,:) + double precision,allocatable :: os(:) ! Memory allocation - allocate(X(nS),Y(nS)) + allocate(X(nS),Y(nS),f(nS,ncart),os(nS)) + +! Compute dipole moments and oscillator strengths + + + f(:,:) = 0d0 + if(spin_allowed) then + + do ia=1,nS + do ixyz=1,ncart + jb = 0 + do j=nC+1,nO + do b=nO+1,nBas-nR + jb = jb + 1 + f(ia,ixyz) = f(ia,ixyz) + dipole_int(j,b,ixyz)*XpY(ia,jb) + end do + end do + end do + end do + f(:,:) = sqrt(2d0)*f(:,:) + + write(*,*) '------------------------' + write(*,*) ' Dipole moments (X Y Z) ' + write(*,*) '------------------------' + call matout(nS,ncart,f) + write(*,*) + + do ia=1,nS + os(ia) = 2d0/3d0*Omega(ia)*sum(f(ia,:)**2) + end do + + write(*,*) '----------------------' + write(*,*) ' Oscillator strengths ' + write(*,*) '----------------------' + call matout(nS,1,os) + write(*,*) + + end if + +! Print details about excitations - write(*,*) do ia=1,min(nS,maxS) X(:) = 0.5d0*(XpY(ia,:) + XmY(ia,:)) Y(:) = 0.5d0*(XpY(ia,:) - XmY(ia,:)) - - norm = 0d0 - do jb=1,nS - norm = norm + X(jb)*X(jb) - end do - norm = sqrt(norm) - print*,'--------------------------------' - write(*,'(A15,I3,A2,F10.6,A3)') ' Excitation n. ',ia,': ',Omega(ia)*HaToeV,' eV' - print*,'--------------------------------' + print*,'---------------------------------------------' + write(*,'(A15,I3,A2,F10.6,A3,A6,F6.4,A1)') ' Excitation n. ',ia,': ',Omega(ia)*HaToeV,' eV',' (f = ',os(ia),')' + print*,'---------------------------------------------' jb = 0 do j=nC+1,nO @@ -54,12 +91,6 @@ subroutine print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega,XpY,XmY) end do end do - norm = 0d0 - do jb=1,nS - norm = norm + Y(jb)*Y(jb) - end do - norm = sqrt(norm) - jb = 0 do j=nC+1,nO do b=nO+1,nBas-nR @@ -71,4 +102,7 @@ subroutine print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega,XpY,XmY) end do + write(*,'(A30,F10.6)') 'Thomas-Reiche-Kuhn sum rule = ',sum(os(:)) + write(*,*) + end subroutine print_transition_vectors diff --git a/src/QuAcK/qsGW.f90 b/src/QuAcK/qsGW.f90 index b1fbfe2..2bdfaf3 100644 --- a/src/QuAcK/qsGW.f90 +++ b/src/QuAcK/qsGW.f90 @@ -1,6 +1,6 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & G0W,GW0,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,S,X,T,V, & - Hc,ERI_AO_basis,ERI_MO_basis,PHF,cHF,eHF) + Hc,ERI_AO_basis,ERI_MO_basis,dipole_int,PHF,cHF,eHF) ! Perform a quasiparticle self-consistent GW calculation @@ -41,6 +41,7 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE double precision,intent(in) :: X(nBas,nBas) double precision,intent(in) :: ERI_AO_basis(nBas,nBas,nBas,nBas) double precision,intent(inout):: ERI_MO_basis(nBas,nBas,nBas,nBas) + double precision,intent(in) :: dipole_int(nBas,nBas,ncart) ! Local variables @@ -267,7 +268,8 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE if(BSE) then - call Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI_MO_basis,eGW,eGW,EcBSE) + call Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI_MO_basis,dipole_int, & + eGW,eGW,EcBSE) if(exchange_kernel) then diff --git a/src/QuAcK/spatial_to_spin_MO_energy.f90 b/src/QuAcK/spatial_to_spin_MO_energy.f90 index 688dc1d..0a35a8c 100644 --- a/src/QuAcK/spatial_to_spin_MO_energy.f90 +++ b/src/QuAcK/spatial_to_spin_MO_energy.f90 @@ -1,6 +1,6 @@ subroutine spatial_to_spin_MO_energy(nBas,e,nBas2,se) -! Convert ERIs from spatial to spin orbitals +! Convert MO energies from spatial to spin orbitals implicit none diff --git a/src/QuAcK/unrestricted_spatial_to_spin_MO_energy.f90 b/src/QuAcK/unrestricted_spatial_to_spin_MO_energy.f90 new file mode 100644 index 0000000..b48fbe4 --- /dev/null +++ b/src/QuAcK/unrestricted_spatial_to_spin_MO_energy.f90 @@ -0,0 +1,30 @@ +subroutine unrestricted_spatial_to_spin_MO_energy(nBas,e,nBas2,se) + +! Convert MO energies from unrestricted spatial to spin orbitals + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nBas + integer,intent(in) :: nBas2 + double precision,intent(in) :: e(nBas,nspin) + +! Local variables + + integer :: p + +! Output variables + + double precision,intent(out) :: se(nBas2) + + do p=1,nBas2,2 + se(p) = e(p,1) + enddo + + do p=2,nBas2,2 + se(p) = e(p,2) + enddo + +end subroutine unrestricted_spatial_to_spin_MO_energy diff --git a/src/utils/read_integrals.f90 b/src/utils/read_integrals.f90 index 719df20..02c91a7 100644 --- a/src/utils/read_integrals.f90 +++ b/src/utils/read_integrals.f90 @@ -37,6 +37,10 @@ subroutine read_integrals(nBas,S,T,V,Hc,G) open(unit=10,file='int/Nuc.dat') open(unit=11,file='int/ERI.dat') + open(unit=21,file='int/x.dat') + open(unit=22,file='int/y.dat') + open(unit=23,file='int/z.dat') + ! Read overlap integrals S(:,:) = 0d0 From 28d85ed2043ae9ad09b14774901f96d2b5e7dd15 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Mon, 28 Sep 2020 22:24:02 +0200 Subject: [PATCH 15/17] unrestricted f --- input/basis | 44 +++--- input/methods | 6 +- input/molecule | 5 +- input/molecule.xyz | 5 +- input/options | 4 +- src/QuAcK/URPAx.f90 | 2 +- src/QuAcK/print_UHF.f90 | 1 + .../print_unrestricted_transition_vectors.f90 | 132 ++++++++++++++++++ 8 files changed, 171 insertions(+), 28 deletions(-) create mode 100644 src/QuAcK/print_unrestricted_transition_vectors.f90 diff --git a/input/basis b/input/basis index fb05e68..b2b2293 100644 --- a/input/basis +++ b/input/basis @@ -1,18 +1,30 @@ -1 3 -S 3 - 1 13.0100000 0.0196850 - 2 1.9620000 0.1379770 - 3 0.4446000 0.4781480 +1 6 +S 8 + 1 1469.0000000 0.0007660 + 2 220.5000000 0.0058920 + 3 50.2600000 0.0296710 + 4 14.2400000 0.1091800 + 5 4.5810000 0.2827890 + 6 1.5800000 0.4531230 + 7 0.5640000 0.2747740 + 8 0.0734500 0.0097510 +S 8 + 1 1469.0000000 -0.0001200 + 2 220.5000000 -0.0009230 + 3 50.2600000 -0.0046890 + 4 14.2400000 -0.0176820 + 5 4.5810000 -0.0489020 + 6 1.5800000 -0.0960090 + 7 0.5640000 -0.1363800 + 8 0.0734500 0.5751020 S 1 - 1 0.1220000 1.0000000 + 1 0.0280500 1.0000000 +P 3 + 1 1.5340000 0.0227840 + 2 0.2749000 0.1391070 + 3 0.0736200 0.5003750 P 1 - 1 0.7270000 1.0000000 -2 3 -S 3 - 1 13.0100000 0.0196850 - 2 1.9620000 0.1379770 - 3 0.4446000 0.4781480 -S 1 - 1 0.1220000 1.0000000 -P 1 - 1 0.7270000 1.0000000 + 1 0.0240300 1.0000000 +D 1 + 1 0.1239000 1.0000000 + diff --git a/input/methods b/input/methods index 0d456f5..adb472a 100644 --- a/input/methods +++ b/input/methods @@ -1,5 +1,5 @@ # RHF UHF MOM - T F F + F T F # MP2* MP3 MP2-F12 F F F # CCD CCSD CCSD(T) @@ -9,11 +9,11 @@ # CIS* CID CISD F F F # RPA* RPAx* ppRPA - F F F + F T F # G0F2 evGF2 G0F3 evGF3 F F F F # G0W0* evGW* qsGW - T F F + F F F # G0T0 evGT qsGT F F F # MCMP2 diff --git a/input/molecule b/input/molecule index 7225285..058d6dd 100644 --- a/input/molecule +++ b/input/molecule @@ -1,5 +1,4 @@ # nAt nEla nElb nCore nRyd - 2 1 1 0 0 + 1 2 1 0 0 # Znuc x y z - H 0. 0. -0.7 - H 0. 0. 0.7 + Li 0.0 0.0 0.0 diff --git a/input/molecule.xyz b/input/molecule.xyz index ac9420c..c9a5a65 100644 --- a/input/molecule.xyz +++ b/input/molecule.xyz @@ -1,4 +1,3 @@ - 2 + 1 - H 0.0000000000 0.0000000000 -0.3704240743 - H 0.0000000000 0.0000000000 0.3704240743 + Li 0.0000000000 0.0000000000 0.0000000000 diff --git a/input/options b/input/options index 1d00d01..1a82a15 100644 --- a/input/options +++ b/input/options @@ -1,11 +1,11 @@ # HF: maxSCF thresh DIIS n_diis guess_type ortho_type - 64 0.00001 T 5 1 1 + 64 0.0000001 T 5 1 1 # MP: # CC: maxSCF thresh DIIS n_diis 64 0.0000001 T 5 # spin: singlet triplet spin_conserved spin_flip TDA - T T T T F + T T T F F # 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/QuAcK/URPAx.f90 b/src/QuAcK/URPAx.f90 index 9a3c510..ad58315 100644 --- a/src/QuAcK/URPAx.f90 +++ b/src/QuAcK/URPAx.f90 @@ -78,7 +78,7 @@ subroutine URPAx(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,n call unrestricted_linear_response(ispin,.false.,TDA,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0,e, & ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega_sc,rho_sc,EcRPAx(ispin),Omega_sc,XpY_sc,XmY_sc) call print_excitation('URPAx ',5,nS_sc,Omega_sc) -! call print_transition_vectors(.true.,nBas,nC,nO,nV,nR,nS,dipole_int,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + call print_unrestricted_transition_vectors(.true.,nBas,nC,nO,nV,nR,nS,nS_sc,dipole_int,Omega_sc,XpY_sc,XmY_sc) deallocate(Omega_sc,XpY_sc,XmY_sc) diff --git a/src/QuAcK/print_UHF.f90 b/src/QuAcK/print_UHF.f90 index 0ad8c89..640d023 100644 --- a/src/QuAcK/print_UHF.f90 +++ b/src/QuAcK/print_UHF.f90 @@ -84,6 +84,7 @@ subroutine print_UHF(nBas,nO,e,c,ENuc,ET,EV,EJ,Ex,EUHF) write(*,'(A50)') 'UHF spin-up orbital coefficients ' write(*,'(A50)') '-----------------------------------------' call matout(nBas,nBas,c(:,:,1)) + write(*,*) write(*,'(A50)') '-----------------------------------------' write(*,'(A50)') 'UHF spin-down orbital coefficients ' write(*,'(A50)') '-----------------------------------------' diff --git a/src/QuAcK/print_unrestricted_transition_vectors.f90 b/src/QuAcK/print_unrestricted_transition_vectors.f90 new file mode 100644 index 0000000..2d6e8bf --- /dev/null +++ b/src/QuAcK/print_unrestricted_transition_vectors.f90 @@ -0,0 +1,132 @@ +subroutine print_unrestricted_transition_vectors(spin_allowed,nBas,nC,nO,nV,nR,nS,nSt,dipole_int,Omega,XpY,XmY) + +! Print transition vectors for linear response calculation + + implicit none + include 'parameters.h' + +! Input variables + + logical,intent(in) :: spin_allowed + integer,intent(in) :: nBas + integer,intent(in) :: nC(nspin) + integer,intent(in) :: nO(nspin) + integer,intent(in) :: nV(nspin) + integer,intent(in) :: nR(nspin) + integer,intent(in) :: nS(nspin) + integer,intent(in) :: nSt + double precision :: dipole_int(nBas,nBas,ncart,nspin) + double precision,intent(in) :: Omega(nSt) + double precision,intent(in) :: XpY(nSt,nSt) + double precision,intent(in) :: XmY(nSt,nSt) + +! Local variables + + integer :: ia,jb,i,j,a,b + integer :: ixyz + integer :: ispin + integer,parameter :: maxS = 10 + double precision :: norm + double precision,parameter :: thres_vec = 0.1d0 + double precision,allocatable :: X(:) + double precision,allocatable :: Y(:) + double precision,allocatable :: f(:,:) + double precision,allocatable :: os(:) + +! Memory allocation + + allocate(X(nSt),Y(nSt),f(nSt,ncart),os(nSt)) + +! Compute dipole moments and oscillator strengths + + + f(:,:) = 0d0 + if(spin_allowed) then + + do ispin=1,nspin + do ia=1,nSt + do ixyz=1,ncart + jb = 0 + do j=nC(ispin)+1,nO(ispin) + do b=nO(ispin)+1,nBas-nR(ispin) + jb = jb + 1 + f(ia,ixyz) = f(ia,ixyz) + dipole_int(j,b,ixyz,ispin)*XpY(ia,jb) + end do + end do + end do + end do + end do + + write(*,*) '----------------' + write(*,*) ' Dipole moments ' + write(*,*) '----------------' + call matout(nSt,ncart,f(:,:)) + write(*,*) + + do ia=1,nSt + os(ia) = 2d0/3d0*Omega(ia)*sum(f(ia,:)**2) + end do + + write(*,*) '----------------------' + write(*,*) ' Oscillator strengths ' + write(*,*) '----------------------' + call matout(nSt,1,os(:)) + write(*,*) + + end if + +! Print details about excitations + + do ia=1,min(nSt,maxS) + + X(:) = 0.5d0*(XpY(ia,:) + XmY(ia,:)) + Y(:) = 0.5d0*(XpY(ia,:) - XmY(ia,:)) + + print*,'---------------------------------------------' + write(*,'(A15,I3,A2,F10.6,A3,A6,F6.4,A1)') ' Excitation n. ',ia,': ',Omega(ia)*HaToeV,' eV',' (f = ',os(ia),')' + print*,'---------------------------------------------' + + ! Spin-up transitions + + jb = 0 + do j=nC(1)+1,nO(1) + do b=nO(1)+1,nBas-nR(1) + jb = jb + 1 + if(abs(X(jb)) > thres_vec) write(*,'(I3,A4,I3,A3,F10.6)') j,' -> ',b,' = ',X(jb)/sqrt(2d0) + end do + end do + + jb = 0 + do j=nC(1)+1,nO(1) + do b=nO(1)+1,nBas-nR(1) + jb = jb + 1 + if(abs(Y(jb)) > thres_vec) write(*,'(I3,A4,I3,A3,F10.6)') j,' <- ',b,' = ',Y(jb)/sqrt(2d0) + end do + end do + write(*,*) + + ! Spin-down transitions + + jb = 0 + do j=nC(2)+1,nO(2) + do b=nO(2)+1,nBas-nR(2) + jb = jb + 1 + if(abs(X(jb)) > thres_vec) write(*,'(I3,A4,I3,A3,F10.6)') j,' -> ',b,' = ',X(jb)/sqrt(2d0) + end do + end do + + jb = 0 + do j=nC(2)+1,nO(2) + do b=nO(2)+1,nBas-nR(2) + jb = jb + 1 + if(abs(Y(jb)) > thres_vec) write(*,'(I3,A4,I3,A3,F10.6)') j,' <- ',b,' = ',Y(jb)/sqrt(2d0) + end do + end do + write(*,*) + + end do + + write(*,'(A30,F10.6)') 'Thomas-Reiche-Kuhn sum rule = ',sum(os(:)) + write(*,*) + +end subroutine print_unrestricted_transition_vectors From c78f891d3cccc3ea289a16dc6318c1633bb94cb2 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Mon, 28 Sep 2020 22:58:58 +0200 Subject: [PATCH 16/17] dipole and f OK --- input/methods | 4 +- input/options | 2 +- src/QuAcK/QuAcK.f90 | 36 +++++---- src/QuAcK/UG0W0.f90 | 11 +-- src/QuAcK/URPAx.f90 | 8 +- src/QuAcK/UdRPA.f90 | 8 +- src/QuAcK/evUGW.f90 | 7 +- src/QuAcK/print_transition_vectors.f90 | 35 +++++---- .../print_unrestricted_transition_vectors.f90 | 78 +++++++++++-------- src/QuAcK/unrestricted_Bethe_Salpeter.f90 | 8 +- 10 files changed, 115 insertions(+), 82 deletions(-) diff --git a/input/methods b/input/methods index adb472a..b1f2358 100644 --- a/input/methods +++ b/input/methods @@ -9,11 +9,11 @@ # CIS* CID CISD F F F # RPA* RPAx* ppRPA - F T F + F F F # G0F2 evGF2 G0F3 evGF3 F F F F # G0W0* evGW* qsGW - F F F + T F F # G0T0 evGT qsGT F F F # MCMP2 diff --git a/input/options b/input/options index 1a82a15..1371bb5 100644 --- a/input/options +++ b/input/options @@ -13,6 +13,6 @@ # ACFDT: AC Kx XBS F F T # BSE: BSE dBSE dTDA evDyn - F T T F + T F T F # MCMP2: nMC nEq nWalk dt nPrint iSeed doDrift 1000000 100000 10 0.3 10000 1234 T diff --git a/src/QuAcK/QuAcK.f90 b/src/QuAcK/QuAcK.f90 index 9c5c095..4a906c9 100644 --- a/src/QuAcK/QuAcK.f90 +++ b/src/QuAcK/QuAcK.f90 @@ -58,7 +58,9 @@ program QuAcK double precision,allocatable :: Hc(:,:) double precision,allocatable :: H(:,:) double precision,allocatable :: X(:,:) - double precision,allocatable :: dipole_int(:,:,:,:) + double precision,allocatable :: dipole_int(:,:,:) + double precision,allocatable :: dipole_int_aa(:,:,:) + double precision,allocatable :: dipole_int_bb(:,:,:) double precision,allocatable :: ERI_AO(:,:,:,:) double precision,allocatable :: ERI_MO(:,:,:,:) integer :: ixyz @@ -233,8 +235,7 @@ program QuAcK ! Memory allocation for one- and two-electron integrals allocate(cHF(nBas,nBas,nspin),eHF(nBas,nspin),eG0W0(nBas,nspin),eG0T0(nBas,nspin),PHF(nBas,nBas,nspin), & - S(nBas,nBas),T(nBas,nBas),V(nBas,nBas),Hc(nBas,nBas),H(nBas,nBas),X(nBas,nBas), & - dipole_int(nBas,nBas,ncart,nspin),ERI_AO(nBas,nBas,nBas,nBas)) + S(nBas,nBas),T(nBas,nBas),V(nBas,nBas),Hc(nBas,nBas),H(nBas,nBas),X(nBas,nBas),ERI_AO(nBas,nBas,nBas,nBas)) ! Read integrals @@ -341,11 +342,13 @@ program QuAcK ! Read and transform dipole-related integrals - call read_dipole_integrals(nBas,dipole_int) + allocate(dipole_int_aa(nBas,nBas,ncart),dipole_int_bb(nBas,nBas,ncart)) + + call read_dipole_integrals(nBas,dipole_int_aa) + call read_dipole_integrals(nBas,dipole_int_bb) do ixyz=1,ncart - do ispin=1,nspin - call AOtoMO_transform(nBas,cHF(:,:,ispin),dipole_int(:,:,ixyz,ispin)) - end do + call AOtoMO_transform(nBas,cHF(:,:,1),dipole_int_aa(:,:,ixyz)) + call AOtoMO_transform(nBas,cHF(:,:,2),dipole_int_bb(:,:,ixyz)) end do ! Memory allocation @@ -399,10 +402,10 @@ program QuAcK ! Read and transform dipole-related integrals - ispin = 1 + allocate(dipole_int(nBas,nBas,ncart)) call read_dipole_integrals(nBas,dipole_int) do ixyz=1,ncart - call AOtoMO_transform(nBas,cHF,dipole_int(:,:,ixyz,ispin)) + call AOtoMO_transform(nBas,cHF,dipole_int(:,:,ixyz)) end do ! 4-index transform @@ -696,7 +699,7 @@ program QuAcK if(unrestricted) then call URPAx(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,0d0,nBas,nC,nO,nV,nR,nS,ENuc,EUHF, & - ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,ERI_MO_abab,dipole_int,eHF) + ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,ERI_MO_abab,dipole_int_aa,dipole_int_bb,eHF) else @@ -822,9 +825,9 @@ program QuAcK call cpu_time(start_G0W0) if(unrestricted) then - call UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,evDyn, & - spin_conserved,spin_flip,linGW,eta_GW,nBas,nC,nO,nV,nR,nS, & - ENuc,EUHF,Hc,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,ERI_MO_abab,dipole_int,PHF,cHF,eHF,eG0W0) + call UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip, & + linGW,eta_GW,nBas,nC,nO,nV,nR,nS,ENuc,EUHF,Hc,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,ERI_MO_abab, & + dipole_int_aa,dipole_int_bb,PHF,cHF,eHF,eG0W0) else call G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet, & @@ -849,9 +852,10 @@ program QuAcK call cpu_time(start_evGW) if(unrestricted) then - call evUGW(maxSCF_GW,thresh_GW,n_diis_GW,doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA, & - G0W,GW0,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta_GW,nBas,nC,nO,nV,nR,nS,ENuc, & - ERHF,Hc,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,ERI_MO_abab,dipole_int,PHF,cHF,eHF,eG0W0) + call evUGW(maxSCF_GW,thresh_GW,n_diis_GW,doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA, & + G0W,GW0,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta_GW,nBas,nC,nO,nV,nR,nS,ENuc, & + EUHF,Hc,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,ERI_MO_abab,dipole_int_aa,dipole_int_bb, & + PHF,cHF,eHF,eG0W0) else diff --git a/src/QuAcK/UG0W0.f90 b/src/QuAcK/UG0W0.f90 index dd5fa5b..53e3e41 100644 --- a/src/QuAcK/UG0W0.f90 +++ b/src/QuAcK/UG0W0.f90 @@ -1,6 +1,6 @@ -subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,evDyn, & - spin_conserved,spin_flip,linearize,eta,nBas,nC,nO,nV,nR,nS, & - ENuc,EUHF,Hc,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,dipole_int,PHF,cHF,eHF,eGW) +subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip, & + linearize,eta,nBas,nC,nO,nV,nR,nS,ENuc,EUHF,Hc,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab, & + dipole_int_aa,dipole_int_bb,PHF,cHF,eHF,eGW) ! Perform unrestricted G0W0 calculation @@ -41,7 +41,8 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_abab(nBas,nBas,nBas,nBas) - double precision,intent(in) :: dipole_int(nBas,nBas,ncart,nspin) + double precision,intent(in) :: dipole_int_aa(nBas,nBas,ncart) + double precision,intent(in) :: dipole_int_bb(nBas,nBas,ncart) ! Local variables @@ -181,7 +182,7 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev if(BSE) then call unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta,nBas,nC,nO,nV,nR,nS, & - ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,eHF,eGW,EcBSE) + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,dipole_int_aa,dipole_int_bb,eHF,eGW,EcBSE) ! if(exchange_kernel) then ! diff --git a/src/QuAcK/URPAx.f90 b/src/QuAcK/URPAx.f90 index ad58315..d7cf08c 100644 --- a/src/QuAcK/URPAx.f90 +++ b/src/QuAcK/URPAx.f90 @@ -1,5 +1,5 @@ subroutine URPAx(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,nC,nO,nV,nR,nS,ENuc,EUHF, & - ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,dipole_int,e) + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,dipole_int_aa,dipole_int_bb,e) ! Perform random phase approximation calculation with exchange (aka TDHF) in the unrestricted formalism @@ -28,7 +28,8 @@ subroutine URPAx(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,n double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_abab(nBas,nBas,nBas,nBas) - double precision,intent(in) :: dipole_int(nBas,nBas,ncart,nspin) + double precision,intent(in) :: dipole_int_aa(nBas,nBas,ncart) + double precision,intent(in) :: dipole_int_bb(nBas,nBas,ncart) ! Local variables @@ -78,7 +79,8 @@ subroutine URPAx(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,n call unrestricted_linear_response(ispin,.false.,TDA,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0,e, & ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega_sc,rho_sc,EcRPAx(ispin),Omega_sc,XpY_sc,XmY_sc) call print_excitation('URPAx ',5,nS_sc,Omega_sc) - call print_unrestricted_transition_vectors(.true.,nBas,nC,nO,nV,nR,nS,nS_sc,dipole_int,Omega_sc,XpY_sc,XmY_sc) + call print_unrestricted_transition_vectors(.true.,nBas,nC,nO,nV,nR,nS,nS_aa,nS_bb,nS_sc,dipole_int_aa,dipole_int_bb, & + Omega_sc,XpY_sc,XmY_sc) deallocate(Omega_sc,XpY_sc,XmY_sc) diff --git a/src/QuAcK/UdRPA.f90 b/src/QuAcK/UdRPA.f90 index 5d1e7f6..fd1aa0e 100644 --- a/src/QuAcK/UdRPA.f90 +++ b/src/QuAcK/UdRPA.f90 @@ -1,5 +1,5 @@ subroutine UdRPA(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,nC,nO,nV,nR,nS,ENuc,EUHF, & - ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,dipole_int,e) + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,dipole_int_aa,dipole_int_bb,e) ! Perform random phase approximation calculation with exchange (aka TDHF) in the unrestricted formalism @@ -28,7 +28,8 @@ subroutine UdRPA(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,n double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_abab(nBas,nBas,nBas,nBas) - double precision,intent(in) :: dipole_int(nBas,nBas,ncart,nspin) + double precision,intent(in) :: dipole_int_aa(nBas,nBas,ncart) + double precision,intent(in) :: dipole_int_bb(nBas,nBas,ncart) ! Local variables @@ -78,7 +79,8 @@ subroutine UdRPA(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,n call unrestricted_linear_response(ispin,.true.,TDA,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0,e, & ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,Omega_sc,rho_sc,EcRPA(ispin),Omega_sc,XpY_sc,XmY_sc) call print_excitation('URPA ',5,nS_sc,Omega_sc) -! call print_transition_vectors(nBas,nC,nO,nV,nR,nS,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + call print_unrestricted_transition_vectors(.true.,nBas,nC,nO,nV,nR,nS,nS_aa,nS_bb,nS_sc,dipole_int_aa,dipole_int_bb, & + Omega_sc,XpY_sc,XmY_sc) endif diff --git a/src/QuAcK/evUGW.f90 b/src/QuAcK/evUGW.f90 index 24f8e0e..322e13e 100644 --- a/src/QuAcK/evUGW.f90 +++ b/src/QuAcK/evUGW.f90 @@ -1,6 +1,6 @@ subroutine evUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA, & G0W,GW0,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta,nBas,nC,nO,nV,nR,nS,ENuc, & - ERHF,Hc,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,dipole_int,PHF,cHF,eHF,eG0W0) + ERHF,Hc,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,dipole_int_aa,dipole_int_bb,PHF,cHF,eHF,eG0W0) ! Perform self-consistent eigenvalue-only GW calculation @@ -46,7 +46,8 @@ subroutine evUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_abab(nBas,nBas,nBas,nBas) - double precision,intent(in) :: dipole_int(nBas,nBas,ncart,nspin) + double precision,intent(in) :: dipole_int_aa(nBas,nBas,ncart) + double precision,intent(in) :: dipole_int_bb(nBas,nBas,ncart) ! Local variables @@ -255,7 +256,7 @@ subroutine evUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE if(BSE) then call unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta,nBas,nC,nO,nV,nR,nS, & - ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,eGW,eGW,EcBSE) + ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,dipole_int_aa,dipole_int_bb,eGW,eGW,EcBSE) ! if(exchange_kernel) then diff --git a/src/QuAcK/print_transition_vectors.f90 b/src/QuAcK/print_transition_vectors.f90 index 6986eec..76ee45e 100644 --- a/src/QuAcK/print_transition_vectors.f90 +++ b/src/QuAcK/print_transition_vectors.f90 @@ -21,6 +21,7 @@ subroutine print_transition_vectors(spin_allowed,nBas,nC,nO,nV,nR,nS,dipole_int, ! Local variables + logical :: debug = .false. integer :: ia,jb,i,j,a,b integer :: ixyz integer,parameter :: maxS = 10 @@ -54,21 +55,25 @@ subroutine print_transition_vectors(spin_allowed,nBas,nC,nO,nV,nR,nS,dipole_int, end do f(:,:) = sqrt(2d0)*f(:,:) - write(*,*) '------------------------' - write(*,*) ' Dipole moments (X Y Z) ' - write(*,*) '------------------------' - call matout(nS,ncart,f) - write(*,*) - - do ia=1,nS - os(ia) = 2d0/3d0*Omega(ia)*sum(f(ia,:)**2) - end do - - write(*,*) '----------------------' - write(*,*) ' Oscillator strengths ' - write(*,*) '----------------------' - call matout(nS,1,os) - write(*,*) + if(debug) then + + write(*,*) '------------------------' + write(*,*) ' Dipole moments (X Y Z) ' + write(*,*) '------------------------' + call matout(nS,ncart,f) + write(*,*) + + do ia=1,nS + os(ia) = 2d0/3d0*Omega(ia)*sum(f(ia,:)**2) + end do + + write(*,*) '----------------------' + write(*,*) ' Oscillator strengths ' + write(*,*) '----------------------' + call matout(nS,1,os) + write(*,*) + + end if end if diff --git a/src/QuAcK/print_unrestricted_transition_vectors.f90 b/src/QuAcK/print_unrestricted_transition_vectors.f90 index 2d6e8bf..27c49ad 100644 --- a/src/QuAcK/print_unrestricted_transition_vectors.f90 +++ b/src/QuAcK/print_unrestricted_transition_vectors.f90 @@ -1,4 +1,5 @@ -subroutine print_unrestricted_transition_vectors(spin_allowed,nBas,nC,nO,nV,nR,nS,nSt,dipole_int,Omega,XpY,XmY) +subroutine print_unrestricted_transition_vectors(spin_allowed,nBas,nC,nO,nV,nR,nS,nSa,nSb,nSt,dipole_int_aa,dipole_int_bb, & + Omega,XpY,XmY) ! Print transition vectors for linear response calculation @@ -14,14 +15,18 @@ subroutine print_unrestricted_transition_vectors(spin_allowed,nBas,nC,nO,nV,nR,n integer,intent(in) :: nV(nspin) integer,intent(in) :: nR(nspin) integer,intent(in) :: nS(nspin) + integer,intent(in) :: nSa + integer,intent(in) :: nSb integer,intent(in) :: nSt - double precision :: dipole_int(nBas,nBas,ncart,nspin) + double precision :: dipole_int_aa(nBas,nBas,ncart) + double precision :: dipole_int_bb(nBas,nBas,ncart) double precision,intent(in) :: Omega(nSt) double precision,intent(in) :: XpY(nSt,nSt) double precision,intent(in) :: XmY(nSt,nSt) ! Local variables + logical :: debug = .false. integer :: ia,jb,i,j,a,b integer :: ixyz integer :: ispin @@ -43,35 +48,47 @@ subroutine print_unrestricted_transition_vectors(spin_allowed,nBas,nC,nO,nV,nR,n f(:,:) = 0d0 if(spin_allowed) then - do ispin=1,nspin - do ia=1,nSt - do ixyz=1,ncart - jb = 0 - do j=nC(ispin)+1,nO(ispin) - do b=nO(ispin)+1,nBas-nR(ispin) - jb = jb + 1 - f(ia,ixyz) = f(ia,ixyz) + dipole_int(j,b,ixyz,ispin)*XpY(ia,jb) - end do + do ia=1,nSt + do ixyz=1,ncart + + jb = 0 + do j=nC(1)+1,nO(1) + do b=nO(1)+1,nBas-nR(1) + jb = jb + 1 + f(ia,ixyz) = f(ia,ixyz) + dipole_int_aa(j,b,ixyz)*XpY(ia,jb) end do end do + + jb = 0 + do j=nC(2)+1,nO(2) + do b=nO(2)+1,nBas-nR(2) + jb = jb + 1 + f(ia,ixyz) = f(ia,ixyz) + dipole_int_bb(j,b,ixyz)*XpY(ia,nSa+jb) + end do + end do + end do end do - write(*,*) '----------------' - write(*,*) ' Dipole moments ' - write(*,*) '----------------' - call matout(nSt,ncart,f(:,:)) - write(*,*) - - do ia=1,nSt - os(ia) = 2d0/3d0*Omega(ia)*sum(f(ia,:)**2) - end do - - write(*,*) '----------------------' - write(*,*) ' Oscillator strengths ' - write(*,*) '----------------------' - call matout(nSt,1,os(:)) - write(*,*) + if(debug) then + + write(*,*) '----------------' + write(*,*) ' Dipole moments ' + write(*,*) '----------------' + call matout(nSt,ncart,f(:,:)) + write(*,*) + + do ia=1,nSt + os(ia) = 2d0/3d0*Omega(ia)*sum(f(ia,:)**2) + end do + + write(*,*) '----------------------' + write(*,*) ' Oscillator strengths ' + write(*,*) '----------------------' + call matout(nSt,1,os(:)) + write(*,*) + + end if end if @@ -92,7 +109,7 @@ subroutine print_unrestricted_transition_vectors(spin_allowed,nBas,nC,nO,nV,nR,n do j=nC(1)+1,nO(1) do b=nO(1)+1,nBas-nR(1) jb = jb + 1 - if(abs(X(jb)) > thres_vec) write(*,'(I3,A4,I3,A3,F10.6)') j,' -> ',b,' = ',X(jb)/sqrt(2d0) + if(abs(X(jb)) > thres_vec) write(*,'(I3,A5,I3,A4,F10.6)') j,'A -> ',b,'A = ',X(jb)/sqrt(2d0) end do end do @@ -100,10 +117,9 @@ subroutine print_unrestricted_transition_vectors(spin_allowed,nBas,nC,nO,nV,nR,n do j=nC(1)+1,nO(1) do b=nO(1)+1,nBas-nR(1) jb = jb + 1 - if(abs(Y(jb)) > thres_vec) write(*,'(I3,A4,I3,A3,F10.6)') j,' <- ',b,' = ',Y(jb)/sqrt(2d0) + if(abs(Y(jb)) > thres_vec) write(*,'(I3,A5,I3,A4,F10.6)') j,'A <- ',b,'A = ',Y(jb)/sqrt(2d0) end do end do - write(*,*) ! Spin-down transitions @@ -111,7 +127,7 @@ subroutine print_unrestricted_transition_vectors(spin_allowed,nBas,nC,nO,nV,nR,n do j=nC(2)+1,nO(2) do b=nO(2)+1,nBas-nR(2) jb = jb + 1 - if(abs(X(jb)) > thres_vec) write(*,'(I3,A4,I3,A3,F10.6)') j,' -> ',b,' = ',X(jb)/sqrt(2d0) + if(abs(X(jb)) > thres_vec) write(*,'(I3,A5,I3,A4,F10.6)') j,'B -> ',b,'B = ',X(jb)/sqrt(2d0) end do end do @@ -119,7 +135,7 @@ subroutine print_unrestricted_transition_vectors(spin_allowed,nBas,nC,nO,nV,nR,n do j=nC(2)+1,nO(2) do b=nO(2)+1,nBas-nR(2) jb = jb + 1 - if(abs(Y(jb)) > thres_vec) write(*,'(I3,A4,I3,A3,F10.6)') j,' <- ',b,' = ',Y(jb)/sqrt(2d0) + if(abs(Y(jb)) > thres_vec) write(*,'(I3,A5,I3,A4,F10.6)') j,'B <- ',b,'B = ',Y(jb)/sqrt(2d0) end do end do write(*,*) diff --git a/src/QuAcK/unrestricted_Bethe_Salpeter.f90 b/src/QuAcK/unrestricted_Bethe_Salpeter.f90 index 5ac6e9c..1b7566a 100644 --- a/src/QuAcK/unrestricted_Bethe_Salpeter.f90 +++ b/src/QuAcK/unrestricted_Bethe_Salpeter.f90 @@ -1,6 +1,6 @@ subroutine unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta, & nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab, & - eW,eGW,EcBSE) + dipole_int_aa,dipole_int_bb,eW,eGW,EcBSE) ! Compute the Bethe-Salpeter excitation energies @@ -30,7 +30,8 @@ subroutine unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved, double precision,intent(in) :: ERI_aabb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_bbbb(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_abab(nBas,nBas,nBas,nBas) - + double precision,intent(in) :: dipole_int_aa(nBas,nBas,ncart) + double precision,intent(in) :: dipole_int_bb(nBas,nBas,ncart) ! Local variables @@ -96,8 +97,9 @@ subroutine unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved, call unrestricted_linear_response(ispin,.true.,TDA,.true.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0, & eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,ERI_abab,OmRPA,rho_RPA,EcBSE(ispin), & OmBSE_sc,XpY_BSE_sc,XmY_BSE_sc) - call print_excitation('BSE@UG0W0',5,nS_sc,OmBSE_sc) + call print_unrestricted_transition_vectors(.true.,nBas,nC,nO,nV,nR,nS,nS_aa,nS_bb,nS_sc,dipole_int_aa,dipole_int_bb, & + OmBSE_sc,XpY_BSE_sc,XmY_BSE_sc) !------------------------------------------------- ! Compute the dynamical screening at the BSE level From c6769b0f1cdb954192f72d186c6201f95451128d Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Mon, 28 Sep 2020 23:19:26 +0200 Subject: [PATCH 17/17] dipole and f OK --- input/basis | 65 ++++++++++++------- input/molecule | 5 +- input/molecule.xyz | 5 +- input/options | 2 +- src/QuAcK/print_transition_vectors.f90 | 8 +-- .../print_unrestricted_transition_vectors.f90 | 8 +-- 6 files changed, 57 insertions(+), 36 deletions(-) diff --git a/input/basis b/input/basis index b2b2293..a93cea1 100644 --- a/input/basis +++ b/input/basis @@ -1,30 +1,49 @@ -1 6 +1 9 S 8 - 1 1469.0000000 0.0007660 - 2 220.5000000 0.0058920 - 3 50.2600000 0.0296710 - 4 14.2400000 0.1091800 - 5 4.5810000 0.2827890 - 6 1.5800000 0.4531230 - 7 0.5640000 0.2747740 - 8 0.0734500 0.0097510 + 1 6665.0000000 0.0006920 + 2 1000.0000000 0.0053290 + 3 228.0000000 0.0270770 + 4 64.7100000 0.1017180 + 5 21.0600000 0.2747400 + 6 7.4950000 0.4485640 + 7 2.7970000 0.2850740 + 8 0.5215000 0.0152040 S 8 - 1 1469.0000000 -0.0001200 - 2 220.5000000 -0.0009230 - 3 50.2600000 -0.0046890 - 4 14.2400000 -0.0176820 - 5 4.5810000 -0.0489020 - 6 1.5800000 -0.0960090 - 7 0.5640000 -0.1363800 - 8 0.0734500 0.5751020 + 1 6665.0000000 -0.0001460 + 2 1000.0000000 -0.0011540 + 3 228.0000000 -0.0057250 + 4 64.7100000 -0.0233120 + 5 21.0600000 -0.0639550 + 6 7.4950000 -0.1499810 + 7 2.7970000 -0.1272620 + 8 0.5215000 0.5445290 S 1 - 1 0.0280500 1.0000000 + 1 0.1596000 1.0000000 +S 1 + 1 0.0469000 1.0000000 P 3 - 1 1.5340000 0.0227840 - 2 0.2749000 0.1391070 - 3 0.0736200 0.5003750 + 1 9.4390000 0.0381090 + 2 2.0020000 0.2094800 + 3 0.5456000 0.5085570 P 1 - 1 0.0240300 1.0000000 + 1 0.1517000 1.0000000 +P 1 + 1 0.0404100 1.0000000 D 1 - 1 0.1239000 1.0000000 + 1 0.5500000 1.0000000 +D 1 + 1 0.1510000 1.0000000 +2 5 +S 3 + 1 13.0100000 0.0196850 + 2 1.9620000 0.1379770 + 3 0.4446000 0.4781480 +S 1 + 1 0.1220000 1.0000000 +S 1 + 1 0.0297400 1.0000000 +P 1 + 1 0.7270000 1.0000000 +P 1 + 1 0.1410000 1.0000000 diff --git a/input/molecule b/input/molecule index 058d6dd..e2a4fd3 100644 --- a/input/molecule +++ b/input/molecule @@ -1,4 +1,5 @@ # nAt nEla nElb nCore nRyd - 1 2 1 0 0 + 2 4 3 0 0 # Znuc x y z - Li 0.0 0.0 0.0 + C 0. 0. -0.16245872 + H 0. 0. 1.93436816 diff --git a/input/molecule.xyz b/input/molecule.xyz index c9a5a65..7a4f218 100644 --- a/input/molecule.xyz +++ b/input/molecule.xyz @@ -1,3 +1,4 @@ - 1 + 2 - Li 0.0000000000 0.0000000000 0.0000000000 + C 0.0000000000 0.0000000000 -0.0859694585 + H 0.0000000000 0.0000000000 1.0236236215 diff --git a/input/options b/input/options index 1371bb5..d9b23c7 100644 --- a/input/options +++ b/input/options @@ -1,5 +1,5 @@ # HF: maxSCF thresh DIIS n_diis guess_type ortho_type - 64 0.0000001 T 5 1 1 + 64 0.00001 T 5 1 1 # MP: # CC: maxSCF thresh DIIS n_diis diff --git a/src/QuAcK/print_transition_vectors.f90 b/src/QuAcK/print_transition_vectors.f90 index 76ee45e..3c30621 100644 --- a/src/QuAcK/print_transition_vectors.f90 +++ b/src/QuAcK/print_transition_vectors.f90 @@ -55,6 +55,10 @@ subroutine print_transition_vectors(spin_allowed,nBas,nC,nO,nV,nR,nS,dipole_int, end do f(:,:) = sqrt(2d0)*f(:,:) + do ia=1,nS + os(ia) = 2d0/3d0*Omega(ia)*sum(f(ia,:)**2) + end do + if(debug) then write(*,*) '------------------------' @@ -63,10 +67,6 @@ subroutine print_transition_vectors(spin_allowed,nBas,nC,nO,nV,nR,nS,dipole_int, call matout(nS,ncart,f) write(*,*) - do ia=1,nS - os(ia) = 2d0/3d0*Omega(ia)*sum(f(ia,:)**2) - end do - write(*,*) '----------------------' write(*,*) ' Oscillator strengths ' write(*,*) '----------------------' diff --git a/src/QuAcK/print_unrestricted_transition_vectors.f90 b/src/QuAcK/print_unrestricted_transition_vectors.f90 index 27c49ad..256f83c 100644 --- a/src/QuAcK/print_unrestricted_transition_vectors.f90 +++ b/src/QuAcK/print_unrestricted_transition_vectors.f90 @@ -70,6 +70,10 @@ subroutine print_unrestricted_transition_vectors(spin_allowed,nBas,nC,nO,nV,nR,n end do end do + do ia=1,nSt + os(ia) = 2d0/3d0*Omega(ia)*sum(f(ia,:)**2) + end do + if(debug) then write(*,*) '----------------' @@ -78,10 +82,6 @@ subroutine print_unrestricted_transition_vectors(spin_allowed,nBas,nC,nO,nV,nR,n call matout(nSt,ncart,f(:,:)) write(*,*) - do ia=1,nSt - os(ia) = 2d0/3d0*Omega(ia)*sum(f(ia,:)**2) - end do - write(*,*) '----------------------' write(*,*) ' Oscillator strengths ' write(*,*) '----------------------'