subroutine GF2_phBSE2_dynamic_perturbation_iterative(dTDA,ispin,eta,nBas,nC,nO,nV,nR,nS,ERI,dipole_int, & eHF,eGF,A_sta,B_sta,OmBSE,XpY,XmY) ! Compute self-consistently the dynamical effects via perturbation theory for BSE2 implicit none include 'parameters.h' ! Input variables logical,intent(in) :: dTDA integer,intent(in) :: ispin 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) :: 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) :: A_sta(nS,nS) double precision,intent(in) :: B_sta(nS,nS) double precision,intent(in) :: OmBSE(nS) double precision,intent(in) :: XpY(nS,nS) double precision,intent(in) :: XmY(nS,nS) ! Local variables integer :: ia integer,parameter :: maxS = 10 double precision :: gapGF integer :: nSCF integer :: maxSCF = 10 double precision :: Conv double precision :: thresh = 1d-3 double precision,allocatable :: OmDyn(:) double precision,allocatable :: ZDyn(:) double precision,allocatable :: OmOld(:) 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 :: B_dyn(:,:) ! Memory allocation allocate(OmDyn(nS),OmOld(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),B_dyn(nS,nS)) ! Print main components of transition vectors call print_transition_vectors(.false.,nBas,nC,nO,nV,nR,nS,OmBSE,XpY,XmY) if(dTDA) then write(*,*) write(*,*) '*** dynamical TDA activated ***' write(*,*) end if gapGF = eGF(nO+1) - eGF(nO) Conv = 1d0 nSCF = 0 OmOld(:) = OmBSE(:) write(*,*) '---------------------------------------------------------------------------------------------------' write(*,*) ' First-order dynamical correction to static Bethe-Salpeter excitation energies ' write(*,*) '---------------------------------------------------------------------------------------------------' write(*,'(A57,F10.6,A3)') ' BSE2 neutral excitation must be lower than the GF gap = ',gapGF*HaToeV,' eV' write(*,*) '---------------------------------------------------------------------------------------------------' write(*,*) do while(Conv > thresh .and. nSCF < maxSCF) nSCF = nSCF + 1 write(*,*) '---------------------------------------------------------------------------------------------------' write(*,'(2X,A15,I3)') 'Iteration n.',nSCF write(*,*) '---------------------------------------------------------------------------------------------------' write(*,'(2X,A5,1X,A20,1X,A20,1X,A20,A20)') '#','Static (eV)','Dynamic (eV)','Correction (eV)','Convergence (eV)' write(*,*) '---------------------------------------------------------------------------------------------------' do ia=1,min(nS,maxS) X(:) = 0.5d0*(XpY(ia,:) + XmY(ia,:)) Y(:) = 0.5d0*(XpY(ia,:) - XmY(ia,:)) ! Resonant part of the BSE correction call GF2_phBSE2_dynamic_kernel_A(ispin,eta,nBas,nC,nO,nV,nR,nS,1d0,ERI,eGF,+OmOld(ia),Ap_dyn,ZAp_dyn) if(dTDA) then OmDyn(ia) = dot_product(X,matmul(Ap_dyn - A_sta,X)) ZDyn(ia) = dot_product(X,matmul(ZAp_dyn,X)) else ! Anti-resonant part of the BSE correction call GF2_phBSE2_dynamic_kernel_A(ispin,eta,nBas,nC,nO,nV,nR,nS,1d0,ERI,eGF,-OmOld(ia),Am_dyn,ZAm_dyn) call GF2_phBSE2_dynamic_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nS,1d0,ERI,eGF,B_dyn) ZDyn(ia) = dot_product(X,matmul(ZAp_dyn,X)) & + dot_product(Y,matmul(ZAm_dyn,Y)) OmDyn(ia) = dot_product(X,matmul(Ap_dyn - A_sta,X)) & - dot_product(Y,matmul(Am_dyn - A_sta,Y)) & + dot_product(X,matmul(B_dyn - B_sta,Y)) & - dot_product(Y,matmul(B_dyn - B_sta,X)) end if 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,(OmBSE(ia) + OmDyn(ia) - OmOld(ia))*HaToeV end do Conv = maxval(abs(OmBSE(:) + OmDyn(:) - OmOld(:)))*HaToeV OmOld(:) = OmBSE(:) + OmDyn(:) write(*,*) '---------------------------------------------------------------------------------------------------' write(*,'(2X,A20,1X,F10.6)') ' Convergence = ',Conv write(*,*) '---------------------------------------------------------------------------------------------------' write(*,*) end do ! Did it actually converge? if(nSCF == maxSCF) then write(*,*) write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' write(*,*)' Convergence failed ' write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' write(*,*) endif end subroutine