diff --git a/input/methods b/input/methods index cf57016..3704d04 100644 --- a/input/methods +++ b/input/methods @@ -11,9 +11,9 @@ # RPA RPAx ppRPA F T F # G0F2 evGF2 G0F3 evGF3 - T F F F + F F F F # G0W0 evGW qsGW - F F F + T F F # G0T0 evGT qsGT F F F # MCMP2 diff --git a/src/QuAcK/BSE2.f90 b/src/QuAcK/BSE2.f90 new file mode 100644 index 0000000..9ea3bd9 --- /dev/null +++ b/src/QuAcK/BSE2.f90 @@ -0,0 +1,96 @@ +subroutine BSE2(TDA,singlet_manifold,triplet_manifold,eta,nBas,nC,nO,nV,nR,nS,ERI,eHF,eGF,EcBSE) + +! Compute the Bethe-Salpeter excitation energies + + implicit none + include 'parameters.h' + +! Input variables + + logical,intent(in) :: TDA + logical,intent(in) :: singlet_manifold + logical,intent(in) :: triplet_manifold + + 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) :: eHF(nBas) + double precision,intent(in) :: eGF(nBas) + double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + +! Local variables + + logical :: evDyn = .false. + integer :: ispin + double precision,allocatable :: OmBSE(:,:) + double precision,allocatable :: XpY(:,:,:) + double precision,allocatable :: XmY(:,:,:) + double precision :: rho + +! Output variables + + double precision,intent(out) :: EcBSE(nspin) + +! Memory allocation + + allocate(OmBSE(nS,nspin),XpY(nS,nS,nspin),XmY(nS,nS,nspin)) + +!------------------- +! Singlet manifold +!------------------- + + if(singlet_manifold) 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, & + 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 + + if(evDyn) then + +! call Bethe_Salpeter_2_dynamic_perturbation_iterative(TDA,eta,nBas,nC,nO,nV,nR,nS,eHF(:),eGF(:), & +! OmBSE(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + else + call BSE2_dynamic_perturbation(TDA,eta,nBas,nC,nO,nV,nR,nS,eHF(:),eGF(:),OmBSE(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + end if + + end if + +!------------------- +! Triplet manifold +!------------------- + + if(triplet_manifold) then + + ispin = 2 + EcBSE(ispin) = 0d0 + + ! 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)) + call print_excitation('BSE2 ',ispin,nS,OmBSE(:,ispin)) + + ! Compute dynamic correction for BSE via perturbation theory + + if(evDyn) then + +! call Bethe_Salpeter_2_dynamic_perturbation_iterative(TDA,eta,nBas,nC,nO,nV,nR,nS,eHF(:),eGF(:), & +! OmBSE(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + else + call BSE2_dynamic_perturbation(TDA,eta,nBas,nC,nO,nV,nR,nS,eHF(:),eGF(:),OmBSE(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + end if + + end if + +end subroutine BSE2 diff --git a/src/QuAcK/BSE2_A_matrix_dynamic.f90 b/src/QuAcK/BSE2_A_matrix_dynamic.f90 new file mode 100644 index 0000000..13bbcfe --- /dev/null +++ b/src/QuAcK/BSE2_A_matrix_dynamic.f90 @@ -0,0 +1,76 @@ +subroutine BSE2_A_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,lambda,eGW,OmRPA,OmBSE,rho,A_dyn) + +! Compute the dynamic part of the Bethe-Salpeter equation matrices + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nBas,nC,nO,nV,nR,nS + double precision,intent(in) :: eta + double precision,intent(in) :: lambda + double precision,intent(in) :: eGW(nBas) + double precision,intent(in) :: OmRPA(nS) + double precision,intent(in) :: OmBSE + double precision,intent(in) :: rho(nBas,nBas,nS) + +! Local variables + + integer :: maxS + double precision :: chi + double precision :: eps + integer :: i,j,a,b,ia,jb,kc + +! Output variables + + double precision,intent(out) :: A_dyn(nS,nS) + +! Initialization + + A_dyn(:,:) = 0d0 + +! Number of poles taken into account + + maxS = nS + +! Build dynamic A matrix + + ia = 0 + do i=nC+1,nO + do a=nO+1,nBas-nR + ia = ia + 1 + jb = 0 + do j=nC+1,nO + do b=nO+1,nBas-nR + jb = jb + 1 + + chi = 0d0 + do kc=1,maxS + + eps = OmRPA(kc)**2 + eta**2 + chi = chi + rho(i,j,kc)*rho(a,b,kc)*OmRPA(kc)/eps + + enddo + + A_dyn(ia,jb) = A_dyn(ia,jb) - 4d0*lambda*chi + + chi = 0d0 + do kc=1,maxS + + eps = (OmBSE - OmRPA(kc) - (eGW(a) - eGW(j)))**2 + eta**2 + chi = chi + rho(i,j,kc)*rho(a,b,kc)*(OmBSE - OmRPA(kc) - (eGW(a) - eGW(j)))/eps + + eps = (OmBSE - OmRPA(kc) - (eGW(b) - eGW(i)))**2 + eta**2 + chi = chi + rho(i,j,kc)*rho(a,b,kc)*(OmBSE - OmRPA(kc) - (eGW(b) - eGW(i)))/eps + + enddo + + A_dyn(ia,jb) = A_dyn(ia,jb) - 2d0*lambda*chi + + enddo + enddo + enddo + enddo + +end subroutine BSE2_A_matrix_dynamic diff --git a/src/QuAcK/BSE2_ZA_matrix_dynamic.f90 b/src/QuAcK/BSE2_ZA_matrix_dynamic.f90 new file mode 100644 index 0000000..a7be783 --- /dev/null +++ b/src/QuAcK/BSE2_ZA_matrix_dynamic.f90 @@ -0,0 +1,66 @@ +subroutine BSE2_ZA_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,lambda,eGW,OmRPA,OmBSE,rho,ZA_dyn) + +! Compute the dynamic part of the Bethe-Salpeter equation matrices + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nBas,nC,nO,nV,nR,nS + double precision,intent(in) :: eta + double precision,intent(in) :: lambda + double precision,intent(in) :: eGW(nBas) + double precision,intent(in) :: OmRPA(nS) + double precision,intent(in) :: OmBSE + double precision,intent(in) :: rho(nBas,nBas,nS) + +! Local variables + + integer :: maxS + double precision :: chi + double precision :: eps + integer :: i,j,a,b,ia,jb,kc + +! Output variables + + double precision,intent(out) :: ZA_dyn(nS,nS) + +! Initialization + + ZA_dyn(:,:) = 0d0 + +! Number of poles taken into account + + maxS = nS + +! Build dynamic A matrix + + ia = 0 + do i=nC+1,nO + do a=nO+1,nBas-nR + ia = ia + 1 + jb = 0 + do j=nC+1,nO + do b=nO+1,nBas-nR + jb = jb + 1 + + chi = 0d0 + do kc=1,maxS + + eps = (OmBSE - OmRPA(kc) - (eGW(a) - eGW(j)))**2 + eta**2 + chi = chi + rho(i,j,kc)*rho(a,b,kc)*((OmBSE - OmRPA(kc) - (eGW(a) - eGW(j)))/eps)**2 + + eps = (OmBSE - OmRPA(kc) - (eGW(b) - eGW(i)))**2 + eta**2 + chi = chi + rho(i,j,kc)*rho(a,b,kc)*((OmBSE - OmRPA(kc) - (eGW(b) - eGW(i)))/eps)**2 + + enddo + + ZA_dyn(ia,jb) = ZA_dyn(ia,jb) + 2d0*lambda*chi + + enddo + enddo + enddo + enddo + +end subroutine BSE2_ZA_matrix_dynamic diff --git a/src/QuAcK/BSE2_dynamic_perturbation.f90 b/src/QuAcK/BSE2_dynamic_perturbation.f90 new file mode 100644 index 0000000..c332a47 --- /dev/null +++ b/src/QuAcK/BSE2_dynamic_perturbation.f90 @@ -0,0 +1,117 @@ +subroutine BSE2_dynamic_perturbation(TDA,eta,nBas,nC,nO,nV,nR,nS,eHF,eGF,OmBSE,XpY,XmY) + +! Compute dynamical effects via perturbation theory for BSE + + implicit none + include 'parameters.h' + +! Input variables + + logical,intent(in) :: TDA + 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) :: eHF(nBas) + double precision,intent(in) :: eGF(nBas) + double precision,intent(in) :: OmBSE(nS) + double precision,intent(in) :: XpY(nS,nS) + double precision,intent(in) :: XmY(nS,nS) + +! Local variables + + logical :: dTDA = .false. + integer :: ia + integer,parameter :: maxS = 10 + double precision :: gapGF + + double precision,allocatable :: OmDyn(:) + double precision,allocatable :: ZDyn(:) + double precision,allocatable :: X(:) + double precision,allocatable :: Y(:) + + double precision,allocatable :: Ap_dyn(:,:) + double precision,allocatable :: Am_dyn(:,:) + double precision,allocatable :: ZAp_dyn(:,:) + double precision,allocatable :: ZAm_dyn(:,:) + + double precision,allocatable :: Bp_dyn(:,:) + double precision,allocatable :: Bm_dyn(:,:) + double precision,allocatable :: ZBp_dyn(:,:) + double precision,allocatable :: ZBm_dyn(:,:) + +! Memory allocation + + allocate(OmDyn(nS),ZDyn(nS),X(nS),Y(nS),Ap_dyn(nS,nS),ZAp_dyn(nS,nS)) + + if(.not.dTDA) allocate(Am_dyn(nS,nS),ZAm_dyn(nS,nS),Bp_dyn(nS,nS),Bm_dyn(nS,nS),ZBp_dyn(nS,nS),ZBm_dyn(nS,nS)) + + gapGF = eGF(nO+1) - eGF(nO) + + write(*,*) '---------------------------------------------------------------------------------------------------' + write(*,*) ' First-order dynamical correction to static 2nd-order Bethe-Salpeter excitation energies ' + write(*,*) '---------------------------------------------------------------------------------------------------' + write(*,'(2X,A5,1X,A20,1X,A20,1X,A20,1X,A20)') '#','Static (eV)','Dynamic (eV)','Correction (eV)','Renorm. (eV)' + write(*,*) '---------------------------------------------------------------------------------------------------' + + do ia=1,min(nS,maxS) + + X(:) = 0.5d0*(XpY(ia,:) + XmY(ia,:)) + Y(:) = 0.5d0*(XpY(ia,:) - XmY(ia,:)) + + ! First-order correction + + if(dTDA) then + + ! Resonant part of the BSE correction for dynamical TDA + + call BSE2_A_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,1d0,eHF(:),eGF(:),OmBSE(ia),Ap_dyn(:,:)) + + ! Renormalization factor of the resonant parts for dynamical TDA + + call BSE2_ZA_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,1d0,eHF(:),eGF(:),OmBSE(ia),ZAp_dyn(:,:)) + + ZDyn(ia) = dot_product(X(:),matmul(ZAp_dyn(:,:),X(:))) + OmDyn(ia) = dot_product(X(:),matmul(Ap_dyn(:,:),X(:))) + + else + + ! Resonant and anti-resonant part of the BSE correction + +! call Bethe_Salpeter_AB_matrix_dynamic(eta,nBas,nC,nO,nV,nR,nS,1d0,eHF(:),eGF(:),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,eHF(:),eGF(:),OmBSE(ia), & +! ZAp_dyn(:,:),ZAm_dyn(:,:),ZBp_dyn(:,:),ZBm_dyn(:,:)) + + ZDyn(ia) = dot_product(X(:),matmul(ZAp_dyn(:,:),X(:))) & + - dot_product(Y(:),matmul(ZAm_dyn(:,:),Y(:))) & + + dot_product(X(:),matmul(ZBp_dyn(:,:),Y(:))) & + - dot_product(Y(:),matmul(ZBm_dyn(:,:),X(:))) + + OmDyn(ia) = dot_product(X(:),matmul(Ap_dyn(:,:),X(:))) & + - dot_product(Y(:),matmul(Am_dyn(:,:),Y(:))) & + + dot_product(X(:),matmul(Bp_dyn(:,:),Y(:))) & + - dot_product(Y(:),matmul(Bm_dyn(:,:),X(:))) + + end if + + ZDyn(ia) = 1d0/(1d0 - ZDyn(ia)) + OmDyn(ia) = ZDyn(ia)*OmDyn(ia) + + write(*,'(2X,I5,5X,F15.6,5X,F15.6,5X,F15.6,5X,F15.6)') & + ia,OmBSE(ia)*HaToeV,(OmBSE(ia)+OmDyn(ia))*HaToeV,OmDyn(ia)*HaToeV,ZDyn(ia) + + if(OmBSE(ia) > gapGF) write(*,*) ' !!! BSE2 neutral excitation larger than the GF2 gap !!! ' + + end do + write(*,*) '---------------------------------------------------------------------------------------------------' + write(*,*) + +end subroutine BSE2_dynamic_perturbation