From e1bb48eac88f2c576d115d49ebf5639b9948e5d2 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Tue, 26 Jan 2021 21:28:05 +0100 Subject: [PATCH 01/63] fix eDFT for fractional spin --- input/dft | 18 +++++++++--------- input/methods | 4 ++-- input/options | 6 +++--- mol/h2.xyz | 2 +- src/eDFT/eDFT.f90 | 6 +++--- src/eDFT/eDFT_UKS.f90 | 12 +++++------- src/eDFT/read_options_dft.f90 | 7 +++---- src/eDFT/unrestricted_fock_exchange_energy.f90 | 2 +- src/eDFT/unrestricted_individual_energy.f90 | 8 +------- 9 files changed, 28 insertions(+), 37 deletions(-) diff --git a/input/dft b/input/dft index 709e75b..69e0fd2 100644 --- a/input/dft +++ b/input/dft @@ -6,7 +6,7 @@ # GGA = 2: RB88 # Hybrid = 4 # Hartree-Fock = 666 - 1 S51 + 666 HF # correlation rung: # Hartree = 0 # LDA = 1: RVWN5,RMFL20 @@ -19,20 +19,20 @@ # Number of states in ensemble (nEns) 3 # occupation numbers of orbitals nO and nO+1 - 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + + 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 # Ensemble weights: wEns(1),...,wEns(nEns-1) - 0.00 1.00 + 0.25 0.0 # N-centered? - T + F # Parameters for CC weight-dependent exchange functional -0.445525 0.0901503 -0.286898 -0.191734 -0.0364788 -0.017035 +0.0 0.0 0.0 +0.0 0.0 0.0 # choice of UCC exchange coefficient : 1 for Cx1, 2 for Cx2, 3 for Cx1*Cx2 2 diff --git a/input/methods b/input/methods index 7326f23..94ad703 100644 --- a/input/methods +++ b/input/methods @@ -1,11 +1,11 @@ # RHF UHF KS MOM - T F F F + F F T F # MP2* MP3 MP2-F12 F F F # CCD DCD CCSD CCSD(T) F F F F # drCCD rCCD lCCD pCCD - F F F T + F F F F # CIS* CIS(D) CID CISD F F F F # RPA* RPAx* ppRPA diff --git a/input/options b/input/options index 9678329..f61a0ff 100644 --- a/input/options +++ b/input/options @@ -1,11 +1,11 @@ # HF: maxSCF thresh DIIS n_diis guess_type ortho_type mix_guess - 128 0.0000001 T 5 1 1 T + 128 0.000001 T 5 1 1 F # MP: # CC: maxSCF thresh DIIS n_diis 64 0.00001 T 5 # spin: TDA singlet triplet spin_conserved spin_flip - F 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 @@ -13,6 +13,6 @@ # ACFDT: AC Kx XBS F F T # BSE: BSE dBSE dTDA evDyn - T F T F + T T T F # MCMP2: nMC nEq nWalk dt nPrint iSeed doDrift 1000000 100000 10 0.3 10000 1234 T diff --git a/mol/h2.xyz b/mol/h2.xyz index 4185b54..7ab70eb 100644 --- a/mol/h2.xyz +++ b/mol/h2.xyz @@ -1,4 +1,4 @@ 2 H 0.0 0.0 0.0 -H 0.0 0.0 0.740848 +H 0.0 0.0 0.741 diff --git a/src/eDFT/eDFT.f90 b/src/eDFT/eDFT.f90 index 2fa4513..93f7816 100644 --- a/src/eDFT/eDFT.f90 +++ b/src/eDFT/eDFT.f90 @@ -4,7 +4,7 @@ subroutine eDFT(maxSCF,thresh,max_diis,guess_type,nNuc,ZNuc,rNuc,ENuc,nBas,nEl,n ! exchange-correlation density-functional theory calculations - use xc_f90_lib_m +! use xc_f90_lib_m implicit none include 'parameters.h' @@ -92,8 +92,8 @@ subroutine eDFT(maxSCF,thresh,max_diis,guess_type,nNuc,ZNuc,rNuc,ENuc,nBas,nEl,n ! Libxc version - call xc_f90_version(vmajor, vminor, vmicro) - write(*,'("Libxc version: ",I1,".",I1,".",I1)') vmajor, vminor, vmicro +! call xc_f90_version(vmajor, vminor, vmicro) +! write(*,'("Libxc version: ",I1,".",I1,".",I1)') vmajor, vminor, vmicro ! call xcinfo() diff --git a/src/eDFT/eDFT_UKS.f90 b/src/eDFT/eDFT_UKS.f90 index 62588d4..fa8b158 100644 --- a/src/eDFT/eDFT_UKS.f90 +++ b/src/eDFT/eDFT_UKS.f90 @@ -337,7 +337,6 @@ subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weig nEl(ispin) = electron_number(nGrid,weight,rhow(:,ispin)) end do - ! Dump results write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F16.10,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') & @@ -364,12 +363,11 @@ subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weig end if !!!!! - do iEns=1,nEns - print*,'occnum=',occnum(1,1,iEns),occnum(2,1,iEns),occnum(1,2,iEns),occnum(2,2,iEns) - print*,'nel up and down and total=', electron_number(nGrid,weight,& - rho(:,1,iEns)),electron_number(nGrid,weight,rho(:,2,iEns)),sum(nEl(:)) - - end do +! do iEns=1,nEns +! print*,'occnum=',occnum(1,1,iEns),occnum(2,1,iEns),occnum(1,2,iEns),occnum(2,2,iEns) +! print*,'nel up and down and total=', electron_number(nGrid,weight,& +! rho(:,1,iEns)),electron_number(nGrid,weight,rho(:,2,iEns)),sum(nEl(:)) +! end do !!!!! ! Compute final KS energy diff --git a/src/eDFT/read_options_dft.f90 b/src/eDFT/read_options_dft.f90 index a9e14a1..77964a9 100644 --- a/src/eDFT/read_options_dft.f90 +++ b/src/eDFT/read_options_dft.f90 @@ -114,6 +114,7 @@ subroutine read_options_dft(nBas,method,x_rung,x_DFA,c_rung,c_DFA,SGn,nEns,wEns, write(*,*) (int(occnum(iBas,2,iEns)),iBas=1,nBas) write(*,*) end do + ! Read ensemble weights for real physical (fractional number of electrons) ensemble (w1,w2) allocate(nEl(nEns)) @@ -123,8 +124,6 @@ subroutine read_options_dft(nBas,method,x_rung,x_DFA,c_rung,c_DFA,SGn,nEns,wEns, nEl(iEns) = nEl(iEns) + occnum(iBas,1,iEns) + occnum(iBas,2,iEns) end do end do - print*,'nEl' - print*,nEl doNcentered = .false. @@ -164,13 +163,13 @@ subroutine read_options_dft(nBas,method,x_rung,x_DFA,c_rung,c_DFA,SGn,nEns,wEns, read(1,*) Cx_choice write(*,*)'----------------------------------------------------------' - write(*,*)' parameters for w1-dependant exchange functional coefficient ' + write(*,*)' parameters for w1-dependent exchange functional coefficient ' write(*,*)'----------------------------------------------------------' call matout(3,1,aCC_w1) write(*,*) write(*,*)'----------------------------------------------------------' - write(*,*)' parameters for w2-dependant exchange functional coefficient ' + write(*,*)' parameters for w2-dependent exchange functional coefficient ' write(*,*)'----------------------------------------------------------' call matout(3,1,aCC_w2) write(*,*) diff --git a/src/eDFT/unrestricted_fock_exchange_energy.f90 b/src/eDFT/unrestricted_fock_exchange_energy.f90 index d312fa6..fca45fa 100644 --- a/src/eDFT/unrestricted_fock_exchange_energy.f90 +++ b/src/eDFT/unrestricted_fock_exchange_energy.f90 @@ -20,6 +20,6 @@ subroutine unrestricted_fock_exchange_energy(nBas,P,Fx,Ex) ! Compute HF exchange energy - Ex = trace_matrix(nBas,matmul(P,Fx)) + Ex = 0.5d0*trace_matrix(nBas,matmul(P,Fx)) end subroutine unrestricted_fock_exchange_energy diff --git a/src/eDFT/unrestricted_individual_energy.f90 b/src/eDFT/unrestricted_individual_energy.f90 index d0fcd99..d5ea7f1 100644 --- a/src/eDFT/unrestricted_individual_energy.f90 +++ b/src/eDFT/unrestricted_individual_energy.f90 @@ -89,8 +89,6 @@ subroutine unrestricted_individual_energy(x_rung,x_DFA,c_rung,c_DFA,LDA_centered kappa(iEns) = nEl(iEns)/nEl(1) end do - print*,'test1' - !------------------------------------------------------------------------ ! Kinetic energy !------------------------------------------------------------------------ @@ -104,7 +102,6 @@ subroutine unrestricted_individual_energy(x_rung,x_DFA,c_rung,c_DFA,LDA_centered end if end do end do - print*,'test2' !------------------------------------------------------------------------ ! Potential energy @@ -120,7 +117,6 @@ subroutine unrestricted_individual_energy(x_rung,x_DFA,c_rung,c_DFA,LDA_centered end do end do - print*,'test3' !------------------------------------------------------------------------ ! Individual Hartree energy !------------------------------------------------------------------------ @@ -145,7 +141,7 @@ subroutine unrestricted_individual_energy(x_rung,x_DFA,c_rung,c_DFA,LDA_centered if(doNcentered) EJ(:,iEns) = kappa(iEns)*EJ(:,iEns) end do - print*,'test4' + !------------------------------------------------------------------------ ! Checking Hartree contributions for each individual states !------------------------------------------------------------------------ @@ -174,8 +170,6 @@ subroutine unrestricted_individual_energy(x_rung,x_DFA,c_rung,c_DFA,LDA_centered end do end do - print*,'test5' - !------------------------------------------------------------------------ ! Checking exchange contributions for each individual states !------------------------------------------------------------------------ From 96e3dfe5e035d6f1e4e020d09a60bd7bc48dba9c Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Sun, 31 Jan 2021 23:24:25 +0100 Subject: [PATCH 02/63] guess mix in eDFT --- input/options | 4 ++-- mol/h2.xyz | 2 +- src/LR/linear_response_B_pp.f90 | 3 +++ src/LR/linear_response_C_pp.f90 | 3 +++ src/LR/linear_response_D_pp.f90 | 3 +++ src/QuAcK/QuAcK.f90 | 2 +- src/eDFT/eDFT.f90 | 7 ++++--- src/eDFT/eDFT_UKS.f90 | 17 ++++++++++++++--- 8 files changed, 31 insertions(+), 10 deletions(-) diff --git a/input/options b/input/options index f61a0ff..c310e86 100644 --- a/input/options +++ b/input/options @@ -1,5 +1,5 @@ # HF: maxSCF thresh DIIS n_diis guess_type ortho_type mix_guess - 128 0.000001 T 5 1 1 F + 128 0.000001 T 5 1 1 T # MP: # CC: maxSCF thresh DIIS n_diis @@ -13,6 +13,6 @@ # ACFDT: AC Kx XBS F F T # BSE: BSE dBSE dTDA evDyn - T T T F + F T T F # MCMP2: nMC nEq nWalk dt nPrint iSeed doDrift 1000000 100000 10 0.3 10000 1234 T diff --git a/mol/h2.xyz b/mol/h2.xyz index 7ab70eb..dfa658c 100644 --- a/mol/h2.xyz +++ b/mol/h2.xyz @@ -1,4 +1,4 @@ 2 H 0.0 0.0 0.0 -H 0.0 0.0 0.741 +H 0.0 0.0 2.645875 diff --git a/src/LR/linear_response_B_pp.f90 b/src/LR/linear_response_B_pp.f90 index fe2515d..59e7a3d 100644 --- a/src/LR/linear_response_B_pp.f90 +++ b/src/LR/linear_response_B_pp.f90 @@ -86,4 +86,7 @@ subroutine linear_response_B_pp(ispin,nBas,nC,nO,nV,nR,nOO,nVV,e,ERI,B_pp) end if + print*,'B pp-matrix' + call matout(nVV,nOO,B_pp) + end subroutine linear_response_B_pp diff --git a/src/LR/linear_response_C_pp.f90 b/src/LR/linear_response_C_pp.f90 index 82f00f7..d22b11d 100644 --- a/src/LR/linear_response_C_pp.f90 +++ b/src/LR/linear_response_C_pp.f90 @@ -96,4 +96,7 @@ subroutine linear_response_C_pp(ispin,nBas,nC,nO,nV,nR,nOO,nVV,e,ERI,C_pp) end if + print*,'C pp-matrix' + call matout(nVV,nVV,C_pp) + end subroutine linear_response_C_pp diff --git a/src/LR/linear_response_D_pp.f90 b/src/LR/linear_response_D_pp.f90 index 4257795..d06a119 100644 --- a/src/LR/linear_response_D_pp.f90 +++ b/src/LR/linear_response_D_pp.f90 @@ -96,4 +96,7 @@ subroutine linear_response_D_pp(ispin,nBas,nC,nO,nV,nR,nOO,nVV,e,ERI,D_pp) end if + print*,'D pp-matrix' + call matout(nOO,nOO,D_pp) + end subroutine linear_response_D_pp diff --git a/src/QuAcK/QuAcK.f90 b/src/QuAcK/QuAcK.f90 index e0a75d6..710c9e4 100644 --- a/src/QuAcK/QuAcK.f90 +++ b/src/QuAcK/QuAcK.f90 @@ -316,7 +316,7 @@ program QuAcK if(doKS) then call cpu_time(start_KS) - call eDFT(maxSCF_HF,thresh_HF,n_diis_HF,guess_type,nNuc,ZNuc,rNuc,ENuc,nBas,nEl,nC, & + call eDFT(maxSCF_HF,thresh_HF,n_diis_HF,guess_type,mix,nNuc,ZNuc,rNuc,ENuc,nBas,nEl,nC, & nO,nV,nR,nShell,TotAngMomShell,CenterShell,KShell,DShell,ExpShell, & max_ang_mom,min_exponent,max_exponent,S,T,V,Hc,X,ERI_AO,dipole_int_AO) diff --git a/src/eDFT/eDFT.f90 b/src/eDFT/eDFT.f90 index 93f7816..ab6b5f0 100644 --- a/src/eDFT/eDFT.f90 +++ b/src/eDFT/eDFT.f90 @@ -1,4 +1,4 @@ -subroutine eDFT(maxSCF,thresh,max_diis,guess_type,nNuc,ZNuc,rNuc,ENuc,nBas,nEl,nC,nO,nV,nR, & +subroutine eDFT(maxSCF,thresh,max_diis,guess_type,mix,nNuc,ZNuc,rNuc,ENuc,nBas,nEl,nC,nO,nV,nR, & nShell,TotAngMomShell,CenterShell,KShell,DShell,ExpShell, & max_ang_mom,min_exponent,max_exponent,S,T,V,Hc,X,ERI,dipole_int) @@ -14,6 +14,7 @@ subroutine eDFT(maxSCF,thresh,max_diis,guess_type,nNuc,ZNuc,rNuc,ENuc,nBas,nEl,n integer,intent(in) :: maxSCF integer,intent(in) :: max_diis integer,intent(in) :: guess_type + logical,intent(in) :: mix double precision,intent(in) :: thresh integer,intent(in) :: nNuc @@ -201,13 +202,13 @@ subroutine eDFT(maxSCF,thresh,max_diis,guess_type,nNuc,ZNuc,rNuc,ENuc,nBas,nEl,n end if !------------------------------------------------------------------------ -! Compute N-centered UKS energy (UNBROKEN) +! Compute N-centered UKS energy !------------------------------------------------------------------------ if(method == 'eDFT-UKS') then call cpu_time(start_KS) - call eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight(:),maxSCF,thresh,max_diis,guess_type, & + call eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight(:),maxSCF,thresh,max_diis,guess_type,mix, & nBas,AO,dAO,S,T,V,Hc,ERI,X,ENuc,Ew,occnum,Cx_choice,doNcentered) call cpu_time(end_KS) diff --git a/src/eDFT/eDFT_UKS.f90 b/src/eDFT/eDFT_UKS.f90 index fa8b158..f045c3b 100644 --- a/src/eDFT/eDFT_UKS.f90 +++ b/src/eDFT/eDFT_UKS.f90 @@ -1,4 +1,4 @@ -subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,maxSCF,thresh,max_diis,guess_type, & +subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,maxSCF,thresh,max_diis,guess_type,mix, & nBas,AO,dAO,S,T,V,Hc,ERI,X,ENuc,Ew,occnum,Cx_choice,doNcentered) ! Perform unrestricted Kohn-Sham calculation for ensembles @@ -17,6 +17,7 @@ subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weig integer,intent(in) :: nGrid double precision,intent(in) :: weight(nGrid) integer,intent(in) :: maxSCF,max_diis,guess_type + logical,intent(in) :: mix double precision,intent(in) :: thresh integer,intent(in) :: nBas double precision,intent(in) :: AO(nBas,nGrid) @@ -39,6 +40,7 @@ subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weig logical :: LDA_centered = .false. integer :: nSCF,nBasSq integer :: n_diis + integer :: nO(nspin) double precision :: conv double precision :: rcond(nspin) double precision :: ET(nspin) @@ -75,7 +77,7 @@ subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weig double precision :: E(nEns) double precision :: Om(nEns) - integer :: ispin,iEns + integer :: ispin,iEns,iBas ! Hello world @@ -136,6 +138,15 @@ subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weig c(:,:,ispin) = matmul(X(:,:),cp(:,:,ispin)) end do + ! Mix guess to enforce symmetry breaking + + nO(:) = 0 + do ispin=1,nspin + nO(ispin) = int(sum(occnum(:,ispin,1))) + end do + + if(mix) call mix_guess(nBas,nO,c) + else if(guess_type == 2) then do ispin=1,nspin @@ -260,7 +271,7 @@ subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weig err(:,:,ispin) = matmul(F(:,:,ispin),matmul(Pw(:,:,ispin),S(:,:))) - matmul(matmul(S(:,:),Pw(:,:,ispin)),F(:,:,ispin)) end do - conv = maxval(abs(err(:,:,:))) + if(nSCF > 1) conv = maxval(abs(err(:,:,:))) ! DIIS extrapolation From 5dd286aa43700ef4f63d84a1450fa40bbcad2cc6 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Thu, 11 Feb 2021 22:32:48 +0100 Subject: [PATCH 03/63] PBE exchange --- input/dft | 12 ++--- input/methods | 2 +- input/options | 2 +- mol/h2.xyz | 2 +- src/eDFT/UPBE_gga_exchange_energy.f90 | 50 +++++++++++++++++ src/eDFT/UPBE_gga_exchange_potential.f90 | 68 ++++++++++++++++++++++++ 6 files changed, 127 insertions(+), 9 deletions(-) create mode 100644 src/eDFT/UPBE_gga_exchange_energy.f90 create mode 100644 src/eDFT/UPBE_gga_exchange_potential.f90 diff --git a/input/dft b/input/dft index 69e0fd2..73b5fde 100644 --- a/input/dft +++ b/input/dft @@ -2,23 +2,23 @@ eDFT-UKS # exchange rung: # Hartree = 0 -# LDA = 1: RS51,RMFL20 -# GGA = 2: RB88 +# LDA = 1: S51,MFL20 +# GGA = 2: B88 # Hybrid = 4 # Hartree-Fock = 666 666 HF # correlation rung: # Hartree = 0 -# LDA = 1: RVWN5,RMFL20 +# LDA = 1: VWN5,MFL20 # GGA = 2: # Hybrid = 4: # Hartree-Fock = 666 - 0 H + 0 H # quadrature grid SG-n 1 # Number of states in ensemble (nEns) 3 -# occupation numbers of orbitals nO and nO+1 +# occupation numbers 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 @@ -28,7 +28,7 @@ 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 # Ensemble weights: wEns(1),...,wEns(nEns-1) - 0.25 0.0 + 0.5 0.0 # N-centered? F # Parameters for CC weight-dependent exchange functional diff --git a/input/methods b/input/methods index 94ad703..9dac2ea 100644 --- a/input/methods +++ b/input/methods @@ -1,5 +1,5 @@ # RHF UHF KS MOM - F F T F + T F F F # MP2* MP3 MP2-F12 F F F # CCD DCD CCSD CCSD(T) diff --git a/input/options b/input/options index c310e86..9d7b8f9 100644 --- a/input/options +++ b/input/options @@ -1,5 +1,5 @@ # HF: maxSCF thresh DIIS n_diis guess_type ortho_type mix_guess - 128 0.000001 T 5 1 1 T + 128 0.0000001 T 5 1 1 T # MP: # CC: maxSCF thresh DIIS n_diis diff --git a/mol/h2.xyz b/mol/h2.xyz index dfa658c..fe38514 100644 --- a/mol/h2.xyz +++ b/mol/h2.xyz @@ -1,4 +1,4 @@ 2 H 0.0 0.0 0.0 -H 0.0 0.0 2.645875 +H 0.0 0.0 1.05835 diff --git a/src/eDFT/UPBE_gga_exchange_energy.f90 b/src/eDFT/UPBE_gga_exchange_energy.f90 new file mode 100644 index 0000000..0297501 --- /dev/null +++ b/src/eDFT/UPBE_gga_exchange_energy.f90 @@ -0,0 +1,50 @@ +subroutine UPBE_gga_exchange_energy(nGrid,weight,rho,drho,Ex) + +! Compute PBE GGA exchange energy + + implicit none + + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rho(nGrid) + double precision,intent(in) :: drho(3,nGrid) + +! Local variables + + integer :: iG + double precision :: alpha,mu,kappa + double precision :: r,g,x + +! Output variables + + double precision :: Ex + +! Coefficients for PBE exchange functional + + alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) + mu = ((1d0/2d0**(1d0/3d0))/(2d0*(3d0*pi**2)**(1d0/3d0)))**2*0.21951d0 + kappa = 0.804d0 + +! Compute GGA exchange energy + + Ex = 0d0 + + do iG=1,nGrid + + r = max(0d0,rho(iG)) + + if(r > threshold) then + g = drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2 + x = sqrt(g)/r**(4d0/3d0) + + Ex = Ex + weight(iG)*alpha*r**(4d0/3d0)*(1d0 + kappa - kappa/(1d0 + mu*x**2/kappa)) + + end if + + end do + +end subroutine UPBE_gga_exchange_energy diff --git a/src/eDFT/UPBE_gga_exchange_potential.f90 b/src/eDFT/UPBE_gga_exchange_potential.f90 new file mode 100644 index 0000000..2ab7921 --- /dev/null +++ b/src/eDFT/UPBE_gga_exchange_potential.f90 @@ -0,0 +1,68 @@ +subroutine UPBE_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx) + +! Compute PBE GGA exchange potential + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + integer,intent(in) :: nBas + double precision,intent(in) :: AO(nBas,nGrid) + double precision,intent(in) :: dAO(3,nBas,nGrid) + double precision,intent(in) :: rho(nGrid) + double precision,intent(in) :: drho(3,nGrid) + +! Local variables + + integer :: mu,nu,iG + double precision :: alpha,mupbe,kappa + double precision :: r,g,x,vAO,gAO + +! Output variables + + double precision,intent(out) :: Fx(nBas,nBas) + +! Coefficients for PBE exchange functional + + alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) + mupbe = ((1d0/2d0**(1d0/3d0))/(2d0*(3d0*pi**2)**(1d0/3d0)))**2*0.21951d0 + kappa = 0.804d0 + +! Compute GGA exchange matrix in the AO basis + + Fx(:,:) = 0d0 + + do mu=1,nBas + do nu=1,nBas + do iG=1,nGrid + + r = max(0d0,rho(iG)) + + if(r > threshold) then + + g = drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2 + x = sqrt(g)/r**(4d0/3d0) + + vAO = weight(iG)*AO(mu,iG)*AO(nu,iG) + + Fx(mu,nu) = Fx(mu,nu) & + + vAO*4d0/3d0*alpha*r**(1d0/3d0)*(1d0 + kappa - kappa/(1d0 + mupbe*x**2/kappa)) + + gAO = drho(1,iG)*(dAO(1,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(1,nu,iG)) & + + drho(2,iG)*(dAO(2,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(2,nu,iG)) & + + drho(3,iG)*(dAO(3,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(3,nu,iG)) + + gAO = weight(iG)*gAO + + Fx(mu,nu) = Fx(mu,nu) + 2d0*gAO*alpha*r**(4d0/3d0)*mupbe/(1d0 + mupbe*x**2/kappa)**2 + + end if + + end do + end do + end do + +end subroutine UPBE_gga_exchange_potential From a97b1881b7885871d41bfb1c66b759f28cf32dc8 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Fri, 12 Feb 2021 10:41:01 +0100 Subject: [PATCH 04/63] OK for PBE and G96 exchange --- input/dft | 12 +++---- input/methods | 2 +- src/eDFT/UG96_gga_exchange_energy.f90 | 2 +- src/eDFT/UG96_gga_exchange_potential.f90 | 1 - src/eDFT/UPBE_gga_exchange_energy.f90 | 10 +++--- src/eDFT/UPBE_gga_exchange_potential.f90 | 9 +++--- src/eDFT/US51_lda_exchange_energy.f90 | 11 ------- src/eDFT/unrestricted_exchange_energy.f90 | 10 +++++- ..._gga_exchange_derivative_discontinuity.f90 | 10 +++++- src/eDFT/unrestricted_gga_exchange_energy.f90 | 4 +++ .../unrestricted_gga_exchange_potential.f90 | 4 +++ .../unrestricted_mgga_exchange_energy.f90 | 32 +++++++++++++++++++ 12 files changed, 76 insertions(+), 31 deletions(-) create mode 100644 src/eDFT/unrestricted_mgga_exchange_energy.f90 diff --git a/input/dft b/input/dft index 73b5fde..42c6dab 100644 --- a/input/dft +++ b/input/dft @@ -2,14 +2,14 @@ eDFT-UKS # exchange rung: # Hartree = 0 -# LDA = 1: S51,MFL20 -# GGA = 2: B88 +# LDA = 1: S51,CC-S51 +# GGA = 2: B88,G96,PBE # Hybrid = 4 # Hartree-Fock = 666 - 666 HF + 2 PBE # correlation rung: # Hartree = 0 -# LDA = 1: VWN5,MFL20 +# LDA = 1: VWN5,eVWN5 # GGA = 2: # Hybrid = 4: # Hartree-Fock = 666 @@ -20,7 +20,7 @@ 3 # occupation numbers 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 @@ -28,7 +28,7 @@ 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 # Ensemble weights: wEns(1),...,wEns(nEns-1) - 0.5 0.0 + 0.0 0.0 # N-centered? F # Parameters for CC weight-dependent exchange functional diff --git a/input/methods b/input/methods index 9dac2ea..94ad703 100644 --- a/input/methods +++ b/input/methods @@ -1,5 +1,5 @@ # RHF UHF KS MOM - T F F F + F F T F # MP2* MP3 MP2-F12 F F F # CCD DCD CCSD CCSD(T) diff --git a/src/eDFT/UG96_gga_exchange_energy.f90 b/src/eDFT/UG96_gga_exchange_energy.f90 index 48f0a8c..1876cc5 100644 --- a/src/eDFT/UG96_gga_exchange_energy.f90 +++ b/src/eDFT/UG96_gga_exchange_energy.f90 @@ -11,7 +11,7 @@ subroutine UG96_gga_exchange_energy(nGrid,weight,rho,drho,Ex) integer,intent(in) :: nGrid double precision,intent(in) :: weight(nGrid) double precision,intent(in) :: rho(nGrid) - double precision,intent(in) :: drho(3,nGrid) + double precision,intent(in) :: drho(ncart,nGrid) ! Local variables diff --git a/src/eDFT/UG96_gga_exchange_potential.f90 b/src/eDFT/UG96_gga_exchange_potential.f90 index 2dd097b..c8d9b40 100644 --- a/src/eDFT/UG96_gga_exchange_potential.f90 +++ b/src/eDFT/UG96_gga_exchange_potential.f90 @@ -29,7 +29,6 @@ subroutine UG96_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx) alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) beta = +1d0/137d0 - beta = 0d0 ! Compute GGA exchange matrix in the AO basis diff --git a/src/eDFT/UPBE_gga_exchange_energy.f90 b/src/eDFT/UPBE_gga_exchange_energy.f90 index 0297501..d06f537 100644 --- a/src/eDFT/UPBE_gga_exchange_energy.f90 +++ b/src/eDFT/UPBE_gga_exchange_energy.f90 @@ -16,8 +16,8 @@ subroutine UPBE_gga_exchange_energy(nGrid,weight,rho,drho,Ex) ! Local variables integer :: iG - double precision :: alpha,mu,kappa - double precision :: r,g,x + double precision :: alpha,mupbe,kappa + double precision :: r,g,s2 ! Output variables @@ -26,7 +26,7 @@ subroutine UPBE_gga_exchange_energy(nGrid,weight,rho,drho,Ex) ! Coefficients for PBE exchange functional alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) - mu = ((1d0/2d0**(1d0/3d0))/(2d0*(3d0*pi**2)**(1d0/3d0)))**2*0.21951d0 + mupbe = ((1d0/2d0**(1d0/3d0))/(2d0*(3d0*pi**2)**(1d0/3d0)))**2*0.21951d0 kappa = 0.804d0 ! Compute GGA exchange energy @@ -39,9 +39,9 @@ subroutine UPBE_gga_exchange_energy(nGrid,weight,rho,drho,Ex) if(r > threshold) then g = drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2 - x = sqrt(g)/r**(4d0/3d0) + s2 = g/r**(8d0/3d0) - Ex = Ex + weight(iG)*alpha*r**(4d0/3d0)*(1d0 + kappa - kappa/(1d0 + mu*x**2/kappa)) + Ex = Ex + weight(iG)*alpha*r**(4d0/3d0)*(1d0 + kappa - kappa/(1d0 + mupbe*s2/kappa)) end if diff --git a/src/eDFT/UPBE_gga_exchange_potential.f90 b/src/eDFT/UPBE_gga_exchange_potential.f90 index 2ab7921..f05e0b6 100644 --- a/src/eDFT/UPBE_gga_exchange_potential.f90 +++ b/src/eDFT/UPBE_gga_exchange_potential.f90 @@ -19,7 +19,7 @@ subroutine UPBE_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx) integer :: mu,nu,iG double precision :: alpha,mupbe,kappa - double precision :: r,g,x,vAO,gAO + double precision :: r,g,s2,vAO,gAO ! Output variables @@ -44,12 +44,13 @@ subroutine UPBE_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx) if(r > threshold) then g = drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2 - x = sqrt(g)/r**(4d0/3d0) + s2 = g/r**(8d0/3d0) vAO = weight(iG)*AO(mu,iG)*AO(nu,iG) Fx(mu,nu) = Fx(mu,nu) & - + vAO*4d0/3d0*alpha*r**(1d0/3d0)*(1d0 + kappa - kappa/(1d0 + mupbe*x**2/kappa)) + + vAO*4d0/3d0*alpha*r**(1d0/3d0)*(1d0 + kappa - kappa/(1d0 + mupbe*s2/kappa)) & + - vAO*8d0/3d0*alpha*r**(1d0/3d0)*mupbe*s2/(1d0 + mupbe*s2/kappa)**2 gAO = drho(1,iG)*(dAO(1,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(1,nu,iG)) & + drho(2,iG)*(dAO(2,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(2,nu,iG)) & @@ -57,7 +58,7 @@ subroutine UPBE_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx) gAO = weight(iG)*gAO - Fx(mu,nu) = Fx(mu,nu) + 2d0*gAO*alpha*r**(4d0/3d0)*mupbe/(1d0 + mupbe*x**2/kappa)**2 + Fx(mu,nu) = Fx(mu,nu) + 2d0*gAO*alpha*r**(-4d0/3d0)*mupbe/(1d0 + mupbe*s2/kappa)**2 end if diff --git a/src/eDFT/US51_lda_exchange_energy.f90 b/src/eDFT/US51_lda_exchange_energy.f90 index b21d673..c0b8702 100644 --- a/src/eDFT/US51_lda_exchange_energy.f90 +++ b/src/eDFT/US51_lda_exchange_energy.f90 @@ -22,21 +22,10 @@ subroutine US51_lda_exchange_energy(nGrid,weight,rho,Ex) double precision :: Ex -! Cxw2 parameters for He N->N+1 -! a2 = 0.135068d0 -! b2 = -0.00774769d0 -! c2 = -0.0278205d0 - -! Cxw1 parameters for He N->N-1 -! a1 = 0.420243d0 -! b1 = 0.0700561d0 -! c1 = -0.288301d0 - ! Cx coefficient for Slater LDA exchange alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) -! alphaw = alpha*(1d0 - wEns(2)*(1d0 - wEns(2))*(a1 + b1*(wEns(2) - 0.5d0) + c1*(wEns(2) - 0.5d0)**2)) ! Compute LDA exchange energy Ex = 0d0 diff --git a/src/eDFT/unrestricted_exchange_energy.f90 b/src/eDFT/unrestricted_exchange_energy.f90 index 91c8e52..56cf438 100644 --- a/src/eDFT/unrestricted_exchange_energy.f90 +++ b/src/eDFT/unrestricted_exchange_energy.f90 @@ -26,7 +26,7 @@ subroutine unrestricted_exchange_energy(rung,DFA,LDA_centered,nEns,wEns,aCC_w1,a ! Local variables - double precision :: ExLDA,ExGGA,ExHF + double precision :: ExLDA,ExGGA,ExMGGA,ExHF double precision :: cX,aX,aC ! Output variables @@ -58,6 +58,14 @@ subroutine unrestricted_exchange_energy(rung,DFA,LDA_centered,nEns,wEns,aCC_w1,a Ex = ExGGA +! MGGA functionals + + case(3) + + call unrestricted_mgga_exchange_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,ExMGGA) + + Ex = ExMGGA + ! Hybrid functionals case(4) diff --git a/src/eDFT/unrestricted_gga_exchange_derivative_discontinuity.f90 b/src/eDFT/unrestricted_gga_exchange_derivative_discontinuity.f90 index bb0c4a7..7f451c5 100644 --- a/src/eDFT/unrestricted_gga_exchange_derivative_discontinuity.f90 +++ b/src/eDFT/unrestricted_gga_exchange_derivative_discontinuity.f90 @@ -22,14 +22,22 @@ subroutine unrestricted_gga_exchange_derivative_discontinuity(DFA,nEns,wEns,nGri double precision,intent(out) :: ExDD(nEns) -! Select correlation functional +! Select exchange functional select case (DFA) + case ('G96') + + ExDD(:) = 0d0 + case ('B88') ExDD(:) = 0d0 + case ('PBE') + + ExDD(:) = 0d0 + case default call print_warning('!!! GGA exchange derivative discontinuity not available !!!') diff --git a/src/eDFT/unrestricted_gga_exchange_energy.f90 b/src/eDFT/unrestricted_gga_exchange_energy.f90 index b7d2679..f184555 100644 --- a/src/eDFT/unrestricted_gga_exchange_energy.f90 +++ b/src/eDFT/unrestricted_gga_exchange_energy.f90 @@ -30,6 +30,10 @@ subroutine unrestricted_gga_exchange_energy(DFA,nEns,wEns,nGrid,weight,rho,drho, call UB88_gga_exchange_energy(nGrid,weight,rho,drho,Ex) + case ('PBE') + + call UPBE_gga_exchange_energy(nGrid,weight,rho,drho,Ex) + case default call print_warning('!!! GGA exchange energy not available !!!') diff --git a/src/eDFT/unrestricted_gga_exchange_potential.f90 b/src/eDFT/unrestricted_gga_exchange_potential.f90 index 368a0e4..4c72163 100644 --- a/src/eDFT/unrestricted_gga_exchange_potential.f90 +++ b/src/eDFT/unrestricted_gga_exchange_potential.f90 @@ -34,6 +34,10 @@ subroutine unrestricted_gga_exchange_potential(DFA,nEns,wEns,nGrid,weight,nBas,A call UB88_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx) + case ('PBE') + + call UPBE_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx) + case default call print_warning('!!! GGA exchange potential not available !!!') diff --git a/src/eDFT/unrestricted_mgga_exchange_energy.f90 b/src/eDFT/unrestricted_mgga_exchange_energy.f90 new file mode 100644 index 0000000..18a9cf7 --- /dev/null +++ b/src/eDFT/unrestricted_mgga_exchange_energy.f90 @@ -0,0 +1,32 @@ +subroutine unrestricted_mgga_exchange_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,Ex) + +! Select MGGA exchange functional for energy calculation + + implicit none + + include 'parameters.h' + +! Input variables + + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rho(nGrid) + double precision,intent(in) :: drho(3,nGrid) + +! Output variables + + double precision :: Ex + + select case (DFA) + + case default + + call print_warning('!!! MGGA exchange energy not available !!!') + stop + + end select + +end subroutine unrestricted_mgga_exchange_energy From 44dfbef76634cb3da027005d0e86b4aa2fe936e7 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Fri, 12 Feb 2021 16:47:40 +0100 Subject: [PATCH 05/63] OK with GGA exchange functionals --- input/dft | 8 +- input/methods | 2 +- input/options | 2 +- src/eDFT/UB88_gga_exchange_energy.f90 | 7 +- src/eDFT/UB88_gga_exchange_potential.f90 | 27 ++++-- src/eDFT/ULYP_gga_correlation_energy.f90 | 73 ++++++++++++++++ src/eDFT/ULYP_gga_correlation_potential.f90 | 85 +++++++++++++++++++ src/eDFT/UPBE_gga_exchange_potential.f90 | 1 - .../unrestricted_gga_correlation_energy.f90 | 18 ++-- 9 files changed, 193 insertions(+), 30 deletions(-) create mode 100644 src/eDFT/ULYP_gga_correlation_energy.f90 create mode 100644 src/eDFT/ULYP_gga_correlation_potential.f90 diff --git a/input/dft b/input/dft index 42c6dab..1b97ce1 100644 --- a/input/dft +++ b/input/dft @@ -4,13 +4,13 @@ # Hartree = 0 # LDA = 1: S51,CC-S51 # GGA = 2: B88,G96,PBE -# Hybrid = 4 +# Hybrid = 4: B3LYP,PBE0 # Hartree-Fock = 666 - 2 PBE + 2 B88 # correlation rung: -# Hartree = 0 +# Hartree = 0: H # LDA = 1: VWN5,eVWN5 -# GGA = 2: +# GGA = 2: LYP,PBE # Hybrid = 4: # Hartree-Fock = 666 0 H diff --git a/input/methods b/input/methods index 94ad703..1da5665 100644 --- a/input/methods +++ b/input/methods @@ -1,5 +1,5 @@ # RHF UHF KS MOM - F F T F + T F T F # MP2* MP3 MP2-F12 F F F # CCD DCD CCSD CCSD(T) diff --git a/input/options b/input/options index 9d7b8f9..a8c1b79 100644 --- a/input/options +++ b/input/options @@ -5,7 +5,7 @@ # CC: maxSCF thresh DIIS n_diis 64 0.00001 T 5 # spin: TDA singlet triplet spin_conserved spin_flip - T T T T T + F 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 diff --git a/src/eDFT/UB88_gga_exchange_energy.f90 b/src/eDFT/UB88_gga_exchange_energy.f90 index 2f6b14d..e049b78 100644 --- a/src/eDFT/UB88_gga_exchange_energy.f90 +++ b/src/eDFT/UB88_gga_exchange_energy.f90 @@ -16,7 +16,7 @@ subroutine UB88_gga_exchange_energy(nGrid,weight,rho,drho,Ex) ! Local variables integer :: iG - double precision :: alpha,beta + double precision :: alpha,b double precision :: r,g,x ! Output variables @@ -26,7 +26,7 @@ subroutine UB88_gga_exchange_energy(nGrid,weight,rho,drho,Ex) ! Coefficients for B88 GGA exchange functional alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) - beta = 0.0042d0 + b = 0.0042d0 ! Compute GGA exchange energy @@ -40,8 +40,7 @@ subroutine UB88_gga_exchange_energy(nGrid,weight,rho,drho,Ex) g = drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2 x = sqrt(g)/r**(4d0/3d0) - Ex = Ex + weight(iG)*alpha*r**(4d0/3d0) & - - weight(iG)*beta*x**2*r**(4d0/3d0)/(1d0 + 6d0*beta*x*asinh(x)) + Ex = Ex + weight(iG)*r**(4d0/3d0)*(alpha - b*x**2/(1d0 + 6d0*b*x*asinh(x))) end if diff --git a/src/eDFT/UB88_gga_exchange_potential.f90 b/src/eDFT/UB88_gga_exchange_potential.f90 index 14244ff..b8f38f6 100644 --- a/src/eDFT/UB88_gga_exchange_potential.f90 +++ b/src/eDFT/UB88_gga_exchange_potential.f90 @@ -18,8 +18,9 @@ subroutine UB88_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx) ! Local variables integer :: mu,nu,iG - double precision :: alpha,beta - double precision :: r,g,vAO,gAO + double precision :: alpha,b + double precision :: vAO,gAO + double precision :: r,g,x,dxdr,dxdg,f ! Output variables @@ -28,7 +29,7 @@ subroutine UB88_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx) ! Coefficients for B88 GGA exchange functional alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) - beta = 0.0042d0 + b = 0.0042d0 ! Compute GGA exchange matrix in the AO basis @@ -42,19 +43,27 @@ subroutine UB88_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx) if(r > threshold) then - g = drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2 vAO = weight(iG)*AO(mu,iG)*AO(nu,iG) - Fx(mu,nu) = Fx(mu,nu) & - + vAO*(4d0/3d0*r**(1d0/3d0)*(alpha - beta*g**(3d0/4d0)/r**2) & - + 2d0*beta*g**(3d0/4d0)/r**(5d0/3d0)) + + g = drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2 + x = sqrt(g)/r**(4d0/3d0) + dxdr = - 4d0*sqrt(g)/(3d0*r**(7d0/3d0))/x + dxdg = + 1d0/(2d0*sqrt(g)*r**(4d0/3d0))/x + + f = b*x**2/(1d0 + 6d0*b*x*asinh(x)) + + Fx(mu,nu) = Fx(mu,nu) + vAO*( & + 4d0/3d0*r**(1d0/3d0)*(alpha - f) & + - 2d0*r**(4d0/3d0)*dxdr*f & + + r**(4d0/3d0)*dxdr*(6d0*b*x*asinh(x) + 6d0*b*x**2/sqrt(1d0+x**2))*f/(1d0 + 6d0*b*x*asinh(x)) ) gAO = drho(1,iG)*(dAO(1,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(1,nu,iG)) & + drho(2,iG)*(dAO(2,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(2,nu,iG)) & + drho(3,iG)*(dAO(3,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(3,nu,iG)) - gAO = weight(iG)*gAO - Fx(mu,nu) = Fx(mu,nu) - 2d0*gAO*3d0/4d0*beta*g**(-1d0/4d0)/r**(2d0/3d0) + Fx(mu,nu) = Fx(mu,nu) + 2d0*gAO*r**(4d0/3d0)*dxdg*( & + - 2d0*f + (6d0*b*x*asinh(x) + 6d0*b*x**2/sqrt(1d0+x**2))*f/(1d0 + 6d0*b*x*asinh(x)) ) end if diff --git a/src/eDFT/ULYP_gga_correlation_energy.f90 b/src/eDFT/ULYP_gga_correlation_energy.f90 new file mode 100644 index 0000000..974d860 --- /dev/null +++ b/src/eDFT/ULYP_gga_correlation_energy.f90 @@ -0,0 +1,73 @@ +subroutine ULYP_gga_correlation_energy(nGrid,weight,rho,drho,Ec) + +! Compute unrestricted LYP GGA correlation energy + + implicit none + + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + double precision,intent(in) :: drho(ncart,nGrid,nspin) + +! Local variables + + integer :: iG + double precision :: ra,rb,r + double precision :: ga,gab,gb,g + + double precision :: a,b,c,d + double precision :: Cf,omega,delta + +! Output variables + + double precision :: Ec(nsp) + +! Parameters of the functional + + a = 0.04918d0 + b = 0.132d0 + c = 0.2533d0 + d = 0.349d0 + + Cf = 3d0/10d0*(3d0*pi**2)**(2d0/3d0) + +! Initialization + + Ec(:) = 0d0 + + do iG=1,nGrid + + ra = max(0d0,rho(iG,1)) + rb = max(0d0,rho(iG,2)) + r = ra + rb + + if(r > threshold) then + + ga = drho(1,iG,1)**2 + drho(2,iG,1)**2 + drho(3,iG,1)**2 + gb = drho(1,iG,2)**2 + drho(2,iG,2)**2 + drho(3,iG,2)**2 + gab = drho(1,iG,1)*drho(1,iG,2) + drho(2,iG,1)*drho(2,iG,2) + drho(3,iG,1)*drho(3,iG,2) + g = ga + gab + gb + + omega = exp(-c*r**(-1d0/3d0))/(1d0 + d*r**(-1d0/3d0))*r**(-11d0/3d0) + delta = c*r**(-1d0/3d0) + d*r**(-1d0/3d0)/(1d0 + d*r**(-1d0/3d0)) + + Ec(2) = Ec(2) - weight(iG)*4d0*a/(1d0 + d*r**(-1d0/3d0))*ra*rb/r & + - weight(iG)*a*b*omega*ra*rb*( & + 2d0**(11d0/3d0)*Cf*(ra**(8d0/3d0) + rb**(8d0/3d0)) & + + (47d0/18d0 - 7d0*delta/18d0)*g & + - (5d0/2d0 - delta/18d0)*(ga + gb) & + - (delta - 11d0)/9d0*(ra/r*ga + rb/r*gb) ) & + - weight(iG)*a*b*omega*( & + - 2d0*r**2/3d0*g & + + (2d0*r**2/3d0 - ra**2)*gb & + + (2d0*r**2/3d0 - rb**2)*ga ) + + end if + + end do + +end subroutine ULYP_gga_correlation_energy diff --git a/src/eDFT/ULYP_gga_correlation_potential.f90 b/src/eDFT/ULYP_gga_correlation_potential.f90 new file mode 100644 index 0000000..18022a8 --- /dev/null +++ b/src/eDFT/ULYP_gga_correlation_potential.f90 @@ -0,0 +1,85 @@ +subroutine ULYP_gga_correlation_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fc) + +! Compute LYP correlation potential + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + integer,intent(in) :: nBas + double precision,intent(in) :: AO(nBas,nGrid) + double precision,intent(in) :: dAO(ncart,nBas,nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + double precision,intent(in) :: drho(ncart,nGrid,nspin) + +! Local variables + + integer :: mu,nu,iG + double precision :: vAO,gaAO,gbAO + double precision :: ra,rb,r + double precision :: ga,gab,gb,g + + double precision :: a,b,c,d + double precision :: Cf,omega,delta + +! Output variables + + double precision,intent(out) :: Fc(nBas,nBas) + +! Prameter of the functional + + a = 0.04918d0 + b = 0.132d0 + c = 0.2533d0 + d = 0.349d0 + + Cf = 3d0/10d0*(3d0*pi**2)**(2d0/3d0) + +! Compute matrix elements in the AO basis + + Fc(:,:) = 0d0 + + do mu=1,nBas + do nu=1,nBas + do iG=1,nGrid + + ra = max(0d0,rho(iG,1)) + rb = max(0d0,rho(iG,2)) + r = ra + rb + + if(r > threshold) then + + ga = drho(1,iG,1)**2 + drho(2,iG,1)**2 + drho(3,iG,1)**2 + gb = drho(1,iG,2)**2 + drho(2,iG,2)**2 + drho(3,iG,2)**2 + gab = drho(1,iG,1)*drho(1,iG,2) + drho(2,iG,1)*drho(2,iG,2) + drho(3,iG,1)*drho(3,iG,2) + g = ga + gab + gb + + omega = exp(-c*r**(-1d0/3d0))/(1d0 + d*r**(-1d0/3d0))*r**(-11d0/3d0) + delta = c*r**(-1d0/3d0) + d*r**(-1d0/3d0)/(1d0 + d*r**(-1d0/3d0)) + + vAO = weight(iG)*AO(mu,iG)*AO(nu,iG) + + Fc(mu,nu) = Fc(mu,nu) + vAO + + gaAO = drho(1,iG,1)*(dAO(1,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(1,nu,iG)) & + + drho(2,iG,1)*(dAO(2,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(2,nu,iG)) & + + drho(3,iG,1)*(dAO(3,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(3,nu,iG)) + gaAO = weight(iG)*gaAO + + gbAO = drho(1,iG,2)*(dAO(1,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(1,nu,iG)) & + + drho(2,iG,2)*(dAO(2,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(2,nu,iG)) & + + drho(3,iG,2)*(dAO(3,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(3,nu,iG)) + gbAO = weight(iG)*gbAO + + Fc(mu,nu) = Fc(mu,nu) + 2d0*gaAO + gbAO + + end if + + end do + end do + end do + +end subroutine ULYP_gga_correlation_potential diff --git a/src/eDFT/UPBE_gga_exchange_potential.f90 b/src/eDFT/UPBE_gga_exchange_potential.f90 index f05e0b6..245eb66 100644 --- a/src/eDFT/UPBE_gga_exchange_potential.f90 +++ b/src/eDFT/UPBE_gga_exchange_potential.f90 @@ -55,7 +55,6 @@ subroutine UPBE_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx) gAO = drho(1,iG)*(dAO(1,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(1,nu,iG)) & + drho(2,iG)*(dAO(2,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(2,nu,iG)) & + drho(3,iG)*(dAO(3,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(3,nu,iG)) - gAO = weight(iG)*gAO Fx(mu,nu) = Fx(mu,nu) + 2d0*gAO*alpha*r**(-4d0/3d0)*mupbe/(1d0 + mupbe*s2/kappa)**2 diff --git a/src/eDFT/unrestricted_gga_correlation_energy.f90 b/src/eDFT/unrestricted_gga_correlation_energy.f90 index 1ba444a..34072e4 100644 --- a/src/eDFT/unrestricted_gga_correlation_energy.f90 +++ b/src/eDFT/unrestricted_gga_correlation_energy.f90 @@ -1,6 +1,6 @@ subroutine unrestricted_gga_correlation_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,Ec) -! Compute unrstricted GGA correlation energy +! Compute unrestricted GGA correlation energy implicit none include 'parameters.h' @@ -24,19 +24,17 @@ subroutine unrestricted_gga_correlation_energy(DFA,nEns,wEns,nGrid,weight,rho,dr double precision :: Ec(nsp) -! Coefficients for ??? GGA exchange functional + select case (DFA) -! Compute GGA exchange energy + case ('LYP') - Ec(:) = 0d0 + call ULYP_gga_correlation_energy(nGrid,weight,rho,drho,Ec) - do iG=1,nGrid + case default - ra = rho(iG,1) - rb = rho(iG,2) - ga = drho(1,iG,1)**2 + drho(2,iG,1)**2 + drho(3,iG,1)**2 - gb = drho(1,iG,2)**2 + drho(2,iG,2)**2 + drho(3,iG,2)**2 + call print_warning('!!! GGA correlation energy not available !!!') + stop - enddo + end select end subroutine unrestricted_gga_correlation_energy From d2b3d338a2bdd94d3e4b095c802de936c7c31aac Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Fri, 12 Feb 2021 22:34:20 +0100 Subject: [PATCH 06/63] working on LYP potential --- src/eDFT/ULYP_gga_correlation_potential.f90 | 25 ++++++++++++++++--- ...unrestricted_gga_correlation_potential.f90 | 19 ++++++++++++-- 2 files changed, 38 insertions(+), 6 deletions(-) diff --git a/src/eDFT/ULYP_gga_correlation_potential.f90 b/src/eDFT/ULYP_gga_correlation_potential.f90 index 18022a8..8c394bd 100644 --- a/src/eDFT/ULYP_gga_correlation_potential.f90 +++ b/src/eDFT/ULYP_gga_correlation_potential.f90 @@ -21,13 +21,16 @@ subroutine ULYP_gga_correlation_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fc) double precision :: vAO,gaAO,gbAO double precision :: ra,rb,r double precision :: ga,gab,gb,g + double precision :: dfdra,dfdrb + double precision :: fdga,dfdgb + double precision :: doda,dodb,ddda,dddb double precision :: a,b,c,d double precision :: Cf,omega,delta ! Output variables - double precision,intent(out) :: Fc(nBas,nBas) + double precision,intent(out) :: Fc(nBas,nBas,nspin) ! Prameter of the functional @@ -40,7 +43,7 @@ subroutine ULYP_gga_correlation_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fc) ! Compute matrix elements in the AO basis - Fc(:,:) = 0d0 + Fc(:,:,:) = 0d0 do mu=1,nBas do nu=1,nBas @@ -62,7 +65,16 @@ subroutine ULYP_gga_correlation_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fc) vAO = weight(iG)*AO(mu,iG)*AO(nu,iG) - Fc(mu,nu) = Fc(mu,nu) + vAO + doda = (d/(3d0*r**(4d0/3d0)*(1d0 + d*r**(-1d0/3d0)) + c/(3d0*r**(4d0/3d0)) - 11d0/(3d0*r))*omega + dodb = doda + + ddda = - c/3d0*r**(-4d0/3d0) + d**2/(3d0*(1d0 + d*r**(-1d0/3d0))**2)*r**(-5d0/3d0) * + - d/(3d0*(1d0 + d*r**(-1d0/3d0))*r**(-4d0/3d0) + dddb = ddda + + Fc(mu,nu,1) = Fc(mu,nu,1) + vAO*dfdra + + Fc(mu,nu,2) = Fc(mu,nu,2) + vAO*dfdrb gaAO = drho(1,iG,1)*(dAO(1,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(1,nu,iG)) & + drho(2,iG,1)*(dAO(2,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(2,nu,iG)) & @@ -73,8 +85,13 @@ subroutine ULYP_gga_correlation_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fc) + drho(2,iG,2)*(dAO(2,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(2,nu,iG)) & + drho(3,iG,2)*(dAO(3,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(3,nu,iG)) gbAO = weight(iG)*gbAO + + + dfdga = -a*b*omega*(-rb**2 + 2d0/3d0*r**2 + ra*rb*( - 5d0/2d0 - (delta-11d0)/9d0*ra/r + delta/18d0)) + dfdgb = -a*b*omega*(-ra**2 + 2d0/3d0*r**2 + ra*rb*( - 5d0/2d0 - (delta-11d0)/9d0*rb/r + delta/18d0)) - Fc(mu,nu) = Fc(mu,nu) + 2d0*gaAO + gbAO + Fc(mu,nu,1) = Fc(mu,nu,1) + 2d0*gaAO*dfdga + Fc(mu,nu,2) = Fc(mu,nu,2) + 2d0*gbAO*dfdgb end if diff --git a/src/eDFT/unrestricted_gga_correlation_potential.f90 b/src/eDFT/unrestricted_gga_correlation_potential.f90 index 0f49fb7..fce504f 100644 --- a/src/eDFT/unrestricted_gga_correlation_potential.f90 +++ b/src/eDFT/unrestricted_gga_correlation_potential.f90 @@ -24,8 +24,23 @@ subroutine unrestricted_gga_correlation_potential(DFA,nEns,wEns,nGrid,weight,nBa double precision,intent(out) :: Fc(nBas,nBas,nspin) -! Coefficients for GGA correlation functional +! Select GGA exchange functional -! Compute GGA correlation matrix in the AO basis + select case (DFA) + + case ('LYP') + + call ULYP_gga_correlation_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fc) + + case ('PBE') + +! call UPBE_gga_correlation_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fc) + + case default + + call print_warning('!!! GGA correlation potential not available !!!') + stop + + end select end subroutine unrestricted_gga_correlation_potential From e505d6d1a2f725992299bd55806a2ed8cce4864f Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Sat, 13 Feb 2021 16:06:38 +0100 Subject: [PATCH 07/63] potential for LYP done --- input/dft | 2 +- src/eDFT/ULYP_gga_correlation_potential.f90 | 79 +++++++++++++++++---- 2 files changed, 68 insertions(+), 13 deletions(-) diff --git a/input/dft b/input/dft index 1b97ce1..4743c0f 100644 --- a/input/dft +++ b/input/dft @@ -13,7 +13,7 @@ # GGA = 2: LYP,PBE # Hybrid = 4: # Hartree-Fock = 666 - 0 H + 2 LYP # quadrature grid SG-n 1 # Number of states in ensemble (nEns) diff --git a/src/eDFT/ULYP_gga_correlation_potential.f90 b/src/eDFT/ULYP_gga_correlation_potential.f90 index 8c394bd..4eac161 100644 --- a/src/eDFT/ULYP_gga_correlation_potential.f90 +++ b/src/eDFT/ULYP_gga_correlation_potential.f90 @@ -22,8 +22,8 @@ subroutine ULYP_gga_correlation_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fc) double precision :: ra,rb,r double precision :: ga,gab,gb,g double precision :: dfdra,dfdrb - double precision :: fdga,dfdgb - double precision :: doda,dodb,ddda,dddb + double precision :: dfdga,dfdgab,dfdgb + double precision :: dodra,dodrb,dddra,dddrb double precision :: a,b,c,d double precision :: Cf,omega,delta @@ -65,12 +65,67 @@ subroutine ULYP_gga_correlation_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fc) vAO = weight(iG)*AO(mu,iG)*AO(nu,iG) - doda = (d/(3d0*r**(4d0/3d0)*(1d0 + d*r**(-1d0/3d0)) + c/(3d0*r**(4d0/3d0)) - 11d0/(3d0*r))*omega - dodb = doda + dodra = (d/(3d0*r**(4d0/3d0)*(1d0 + d*r**(-1d0/3d0)) + c/(3d0*r**(4d0/3d0)) - 11d0/(3d0*r)))*omega + dodrb = dodra - ddda = - c/3d0*r**(-4d0/3d0) + d**2/(3d0*(1d0 + d*r**(-1d0/3d0))**2)*r**(-5d0/3d0) * - - d/(3d0*(1d0 + d*r**(-1d0/3d0))*r**(-4d0/3d0) - dddb = ddda + dddra = - c/3d0*r**(-4d0/3d0) & + + d**2/(3d0*(1d0 + d*r**(-1d0/3d0))**2)*r**(-5d0/3d0) & + - d/(3d0*(1d0 + d*r**(-1d0/3d0))*r**(-4d0/3d0)) + dddrb = dddra + + dfdra = - 4d0*a/(1d0 + d*r**(-1d0/3d0))*rb/r & + - 4d0/3d0*a*d/(1d0 + d*r**(-1d0/3d0))**2*ra*rb/r**(7d0/3d0) & + + 4d0*a/(1d0 + d*r**(-1d0/3d0))*ra*rb/r & + - a*b*omega*rb*( & + + 2d0**(11d0/3d0)*Cf*(ra**(8d0/3d0) + rb**(8d0/3d0)) & + + (47d0/18d0 - 7d0*delta/18d0)*g & + - (5d0/2d0 - delta/18d0)*(ga + gb) & + - (delta - 11d0)/9d0*(ra/r*ga + rb/r*gb) & + - 4d0/3d0*r/rb*g & + + (4d0/3d0*r/rb - 2d0*ra/rb)*gb & + + 4d0/3d0*r/rb*ga ) & + - a*b*omega*ra*rb*( & + + 8d0/3d0*2d0**(11d0/3d0)*Cf*ra**(5d0/3d0) & + - 7d0*dddra/18d0*g & + + dddra/18d0*(ga + gb) & + - dddra/9d0*(ra/r*ga + rb/r*gb) & + - (delta - 11d0)/(9d0*r)*(-ra/r*ga - rb/r*gb + ga) ) & + - a*b*dodra*ra*rb*( & + + 2d0**(11d0/3d0)*Cf*(ra**(8d0/3d0) + rb**(8d0/3d0)) & + + (47d0/18d0 - 7d0*delta/18d0)*g & + - (5d0/2d0 - delta/18d0)*(ga + gb) & + - (delta - 11d0)/9d0*(ra/r*ga + rb/r*gb) ) & + - a*b*dodra*( & + - 2d0*r**2/3d0*g & + + (2d0*r**2/3d0 - ra**2)*gb & + + (2d0*r**2/3d0 - rb**2)*ga ) + + dfdrb = - 4d0*a/(1d0 + d*r**(-1d0/3d0))*ra/r & + - 4d0/3d0*a*d/(1d0 + d*r**(-1d0/3d0))**2*ra*rb/r**(7d0/3d0) & + + 4d0*a/(1d0 + d*r**(-1d0/3d0))*ra*rb/r & + - a*b*omega*ra*( & + + 2d0**(11d0/3d0)*Cf*(ra**(8d0/3d0) + rb**(8d0/3d0)) & + + (47d0/18d0 - 7d0*delta/18d0)*g & + - (5d0/2d0 - delta/18d0)*(ga + gb) & + - (delta - 11d0)/9d0*(ra/r*ga + rb/r*gb) & + - 4d0/3d0*r/ra*g & + + (4d0/3d0*r/ra - 2d0*ra/rb)*ga & + + 4d0/3d0*r/ra*gb ) & + - a*b*omega*ra*rb*( & + + 8d0/3d0*2d0**(11d0/3d0)*Cf*rb**(5d0/3d0) & + - 7d0*dddrb/18d0*g & + + dddrb/18d0*(ga + gb) & + - dddrb/9d0*(ra/r*ga + rb/r*gb) & + - (delta - 11d0)/(9d0*r)*(-ra/r*ga - rb/r*gb + gb) ) & + - a*b*dodrb*ra*rb*( & + + 2d0**(11d0/3d0)*Cf*(ra**(8d0/3d0) + rb**(8d0/3d0)) & + + (47d0/18d0 - 7d0*delta/18d0)*g & + - (5d0/2d0 - delta/18d0)*(ga + gb) & + - (delta - 11d0)/9d0*(ra/r*ga + rb/r*gb) ) & + - a*b*dodrb*( & + - 2d0*r**2/3d0*g & + + (2d0*r**2/3d0 - ra**2)*gb & + + (2d0*r**2/3d0 - rb**2)*ga ) Fc(mu,nu,1) = Fc(mu,nu,1) + vAO*dfdra @@ -86,12 +141,12 @@ subroutine ULYP_gga_correlation_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fc) + drho(3,iG,2)*(dAO(3,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(3,nu,iG)) gbAO = weight(iG)*gbAO - - dfdga = -a*b*omega*(-rb**2 + 2d0/3d0*r**2 + ra*rb*( - 5d0/2d0 - (delta-11d0)/9d0*ra/r + delta/18d0)) - dfdgb = -a*b*omega*(-ra**2 + 2d0/3d0*r**2 + ra*rb*( - 5d0/2d0 - (delta-11d0)/9d0*rb/r + delta/18d0)) + dfdga = -a*b*omega*(-rb**2 + ra*rb*(1d0/9d0 - (delta-11d0)/9d0*ra/r - delta/3d0)) + dfdgab = -a*b*omega*(-2d0/3d0*r**2 + ra*rb*(47d0/18d0 - 7d0*delta/18d0)) + dfdgb = -a*b*omega*(-ra**2 + ra*rb*(1d0/9d0 - (delta-11d0)/9d0*rb/r - delta/3d0)) - Fc(mu,nu,1) = Fc(mu,nu,1) + 2d0*gaAO*dfdga - Fc(mu,nu,2) = Fc(mu,nu,2) + 2d0*gbAO*dfdgb + Fc(mu,nu,1) = Fc(mu,nu,1) + 2d0*gaAO*dfdga + gbAO*dfdgab + Fc(mu,nu,2) = Fc(mu,nu,2) + 2d0*gbAO*dfdgb + gaAO*dfdgab end if From 337e801ecd421432d24b3a4ffbae3dc8b731f1a8 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Sat, 13 Feb 2021 22:31:46 +0100 Subject: [PATCH 08/63] LYP done --- input/dft | 6 +++--- src/eDFT/ULYP_gga_correlation_energy.f90 | 6 +++--- src/eDFT/ULYP_gga_correlation_potential.f90 | 19 +++++++++---------- 3 files changed, 15 insertions(+), 16 deletions(-) diff --git a/input/dft b/input/dft index 4743c0f..19bf050 100644 --- a/input/dft +++ b/input/dft @@ -6,7 +6,7 @@ # GGA = 2: B88,G96,PBE # Hybrid = 4: B3LYP,PBE0 # Hartree-Fock = 666 - 2 B88 + 1 S51 # correlation rung: # Hartree = 0: H # LDA = 1: VWN5,eVWN5 @@ -19,8 +19,8 @@ # Number of states in ensemble (nEns) 3 # occupation numbers - 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 + 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 diff --git a/src/eDFT/ULYP_gga_correlation_energy.f90 b/src/eDFT/ULYP_gga_correlation_energy.f90 index 974d860..e0788b8 100644 --- a/src/eDFT/ULYP_gga_correlation_energy.f90 +++ b/src/eDFT/ULYP_gga_correlation_energy.f90 @@ -47,10 +47,10 @@ subroutine ULYP_gga_correlation_energy(nGrid,weight,rho,drho,Ec) if(r > threshold) then - ga = drho(1,iG,1)**2 + drho(2,iG,1)**2 + drho(3,iG,1)**2 - gb = drho(1,iG,2)**2 + drho(2,iG,2)**2 + drho(3,iG,2)**2 + ga = drho(1,iG,1)*drho(1,iG,1) + drho(2,iG,1)*drho(2,iG,1) + drho(3,iG,1)*drho(3,iG,1) + gb = drho(1,iG,2)*drho(1,iG,2) + drho(2,iG,2)*drho(2,iG,2) + drho(3,iG,2)*drho(3,iG,2) gab = drho(1,iG,1)*drho(1,iG,2) + drho(2,iG,1)*drho(2,iG,2) + drho(3,iG,1)*drho(3,iG,2) - g = ga + gab + gb + g = ga + 2d0*gab + gb omega = exp(-c*r**(-1d0/3d0))/(1d0 + d*r**(-1d0/3d0))*r**(-11d0/3d0) delta = c*r**(-1d0/3d0) + d*r**(-1d0/3d0)/(1d0 + d*r**(-1d0/3d0)) diff --git a/src/eDFT/ULYP_gga_correlation_potential.f90 b/src/eDFT/ULYP_gga_correlation_potential.f90 index 4eac161..702aba3 100644 --- a/src/eDFT/ULYP_gga_correlation_potential.f90 +++ b/src/eDFT/ULYP_gga_correlation_potential.f90 @@ -55,27 +55,27 @@ subroutine ULYP_gga_correlation_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fc) if(r > threshold) then - ga = drho(1,iG,1)**2 + drho(2,iG,1)**2 + drho(3,iG,1)**2 - gb = drho(1,iG,2)**2 + drho(2,iG,2)**2 + drho(3,iG,2)**2 + ga = drho(1,iG,1)*drho(1,iG,1) + drho(2,iG,1)*drho(2,iG,1) + drho(3,iG,1)*drho(3,iG,1) + gb = drho(1,iG,2)*drho(1,iG,2) + drho(2,iG,2)*drho(2,iG,2) + drho(3,iG,2)*drho(3,iG,2) gab = drho(1,iG,1)*drho(1,iG,2) + drho(2,iG,1)*drho(2,iG,2) + drho(3,iG,1)*drho(3,iG,2) - g = ga + gab + gb + g = ga + 2d0*gab + gb omega = exp(-c*r**(-1d0/3d0))/(1d0 + d*r**(-1d0/3d0))*r**(-11d0/3d0) delta = c*r**(-1d0/3d0) + d*r**(-1d0/3d0)/(1d0 + d*r**(-1d0/3d0)) vAO = weight(iG)*AO(mu,iG)*AO(nu,iG) - dodra = (d/(3d0*r**(4d0/3d0)*(1d0 + d*r**(-1d0/3d0)) + c/(3d0*r**(4d0/3d0)) - 11d0/(3d0*r)))*omega + dodra = (d/(3d0*r**(4d0/3d0)*(1d0 + d*r**(-1d0/3d0))) + c/(3d0*r**(4d0/3d0)) - 11d0/(3d0*r))*omega dodrb = dodra dddra = - c/3d0*r**(-4d0/3d0) & + d**2/(3d0*(1d0 + d*r**(-1d0/3d0))**2)*r**(-5d0/3d0) & - - d/(3d0*(1d0 + d*r**(-1d0/3d0))*r**(-4d0/3d0)) + - d/(3d0*(1d0 + d*r**(-1d0/3d0)))*r**(-4d0/3d0) dddrb = dddra dfdra = - 4d0*a/(1d0 + d*r**(-1d0/3d0))*rb/r & - 4d0/3d0*a*d/(1d0 + d*r**(-1d0/3d0))**2*ra*rb/r**(7d0/3d0) & - + 4d0*a/(1d0 + d*r**(-1d0/3d0))*ra*rb/r & + + 4d0*a/(1d0 + d*r**(-1d0/3d0))*ra*rb/r**2 & - a*b*omega*rb*( & + 2d0**(11d0/3d0)*Cf*(ra**(8d0/3d0) + rb**(8d0/3d0)) & + (47d0/18d0 - 7d0*delta/18d0)*g & @@ -102,14 +102,14 @@ subroutine ULYP_gga_correlation_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fc) dfdrb = - 4d0*a/(1d0 + d*r**(-1d0/3d0))*ra/r & - 4d0/3d0*a*d/(1d0 + d*r**(-1d0/3d0))**2*ra*rb/r**(7d0/3d0) & - + 4d0*a/(1d0 + d*r**(-1d0/3d0))*ra*rb/r & + + 4d0*a/(1d0 + d*r**(-1d0/3d0))*ra*rb/r**2 & - a*b*omega*ra*( & + 2d0**(11d0/3d0)*Cf*(ra**(8d0/3d0) + rb**(8d0/3d0)) & + (47d0/18d0 - 7d0*delta/18d0)*g & - (5d0/2d0 - delta/18d0)*(ga + gb) & - (delta - 11d0)/9d0*(ra/r*ga + rb/r*gb) & - 4d0/3d0*r/ra*g & - + (4d0/3d0*r/ra - 2d0*ra/rb)*ga & + + (4d0/3d0*r/ra - 2d0*rb/ra)*ga & + 4d0/3d0*r/ra*gb ) & - a*b*omega*ra*rb*( & + 8d0/3d0*2d0**(11d0/3d0)*Cf*rb**(5d0/3d0) & @@ -128,7 +128,6 @@ subroutine ULYP_gga_correlation_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fc) + (2d0*r**2/3d0 - rb**2)*ga ) Fc(mu,nu,1) = Fc(mu,nu,1) + vAO*dfdra - Fc(mu,nu,2) = Fc(mu,nu,2) + vAO*dfdrb gaAO = drho(1,iG,1)*(dAO(1,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(1,nu,iG)) & @@ -142,7 +141,7 @@ subroutine ULYP_gga_correlation_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fc) gbAO = weight(iG)*gbAO dfdga = -a*b*omega*(-rb**2 + ra*rb*(1d0/9d0 - (delta-11d0)/9d0*ra/r - delta/3d0)) - dfdgab = -a*b*omega*(-2d0/3d0*r**2 + ra*rb*(47d0/18d0 - 7d0*delta/18d0)) + dfdgab = -a*b*omega*(-4d0/3d0*r**2 + 2d0*ra*rb*(47d0/18d0 - 7d0*delta/18d0)) dfdgb = -a*b*omega*(-ra**2 + ra*rb*(1d0/9d0 - (delta-11d0)/9d0*rb/r - delta/3d0)) Fc(mu,nu,1) = Fc(mu,nu,1) + 2d0*gaAO*dfdga + gbAO*dfdgab From 692962fac2db4209a45aae44b4a26ab44b1978ac Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Sat, 13 Feb 2021 22:48:32 +0100 Subject: [PATCH 09/63] fix bug --- input/dft | 6 +++--- input/options | 2 +- src/eDFT/eDFT_UKS.f90 | 2 +- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/input/dft b/input/dft index 19bf050..03d7933 100644 --- a/input/dft +++ b/input/dft @@ -6,7 +6,7 @@ # GGA = 2: B88,G96,PBE # Hybrid = 4: B3LYP,PBE0 # Hartree-Fock = 666 - 1 S51 + 2 B88 # correlation rung: # Hartree = 0: H # LDA = 1: VWN5,eVWN5 @@ -19,8 +19,8 @@ # Number of states in ensemble (nEns) 3 # occupation numbers - 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 - 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 + 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 + 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 diff --git a/input/options b/input/options index a8c1b79..60308cb 100644 --- a/input/options +++ b/input/options @@ -1,5 +1,5 @@ # HF: maxSCF thresh DIIS n_diis guess_type ortho_type mix_guess - 128 0.0000001 T 5 1 1 T + 128 0.0000001 T 5 1 1 F # MP: # CC: maxSCF thresh DIIS n_diis diff --git a/src/eDFT/eDFT_UKS.f90 b/src/eDFT/eDFT_UKS.f90 index f045c3b..4f70433 100644 --- a/src/eDFT/eDFT_UKS.f90 +++ b/src/eDFT/eDFT_UKS.f90 @@ -223,7 +223,7 @@ subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weig rhow(:,:) = rhow(:,:) + wEns(iEns)*rho(:,:,iEns) end do - if(xc_rung > 1 .and. xc_rung /= 666) then + if(xc_rung > 1) then ! Ground state density From 0271024041efa4982f33a12ed16ff5c651d92214 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Sat, 13 Feb 2021 22:49:15 +0100 Subject: [PATCH 10/63] fix bug --- src/eDFT/GOK_UKS.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/eDFT/GOK_UKS.f90 b/src/eDFT/GOK_UKS.f90 index 1b01a96..9e2f82b 100644 --- a/src/eDFT/GOK_UKS.f90 +++ b/src/eDFT/GOK_UKS.f90 @@ -210,7 +210,7 @@ subroutine GOK_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,nGrid,weight,aCC_w1,aCC_w rhow(:,:) = rhow(:,:) + wEns(iEns)*rho(:,:,iEns) end do - if(xc_rung > 1 .and. xc_rung /= 666) then + if(xc_rung > 1) then ! Ground state density From 05acc903325107a8a732e282cacc8bcde19349fd Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Sat, 13 Feb 2021 23:09:52 +0100 Subject: [PATCH 11/63] working on structure eDFT code --- src/eDFT/select_rung.f90 | 4 -- ...d_correlation_derivative_discontinuity.f90 | 13 ++++--- src/eDFT/unrestricted_correlation_energy.f90 | 12 +++--- ...stricted_correlation_individual_energy.f90 | 13 ++++--- .../unrestricted_correlation_potential.f90 | 12 +++--- ...cted_exchange_derivative_discontinuity.f90 | 13 +++---- src/eDFT/unrestricted_exchange_energy.f90 | 8 ---- ...nrestricted_exchange_individual_energy.f90 | 17 +++++---- src/eDFT/unrestricted_exchange_potential.f90 | 14 +++---- ...nrestricted_mgga_correlation_potential.f90 | 38 +++++++++++++++++++ ...mgga_exchange_derivative_discontinuity.f90 | 36 ++++++++++++++++++ ...ricted_mgga_exchange_individual_energy.f90 | 35 +++++++++++++++++ .../unrestricted_mgga_exchange_potential.f90 | 36 ++++++++++++++++++ 13 files changed, 192 insertions(+), 59 deletions(-) create mode 100644 src/eDFT/unrestricted_mgga_correlation_potential.f90 create mode 100644 src/eDFT/unrestricted_mgga_exchange_derivative_discontinuity.f90 create mode 100644 src/eDFT/unrestricted_mgga_exchange_individual_energy.f90 create mode 100644 src/eDFT/unrestricted_mgga_exchange_potential.f90 diff --git a/src/eDFT/select_rung.f90 b/src/eDFT/select_rung.f90 index 2160590..9236764 100644 --- a/src/eDFT/select_rung.f90 +++ b/src/eDFT/select_rung.f90 @@ -32,10 +32,6 @@ subroutine select_rung(rung,DFA) case(4) write(*,*) "* 4th rung of Jacob's ladder: hybrid functional *" -! Hartree-Fock calculation - case(666) - write(*,*) "* rung 666: Hartree-Fock calculation *" - ! Default case default write(*,*) "!!! rung not available !!!" diff --git a/src/eDFT/unrestricted_correlation_derivative_discontinuity.f90 b/src/eDFT/unrestricted_correlation_derivative_discontinuity.f90 index e04ff0d..62fe916 100644 --- a/src/eDFT/unrestricted_correlation_derivative_discontinuity.f90 +++ b/src/eDFT/unrestricted_correlation_derivative_discontinuity.f90 @@ -45,6 +45,13 @@ subroutine unrestricted_correlation_derivative_discontinuity(rung,DFA,nEns,wEns, call print_warning('!!! derivative discontinuity NYI for GGAs !!!') stop +! MGGA functionals + + case(3) + + call print_warning('!!! derivative discontinuity NYI for MGGAs !!!') + stop + ! Hybrid functionals case(4) @@ -54,12 +61,6 @@ subroutine unrestricted_correlation_derivative_discontinuity(rung,DFA,nEns,wEns, aC = 0.81d0 -! Hartree-Fock calculation - - case(666) - - Ec(:,:) = 0d0 - end select end subroutine unrestricted_correlation_derivative_discontinuity diff --git a/src/eDFT/unrestricted_correlation_energy.f90 b/src/eDFT/unrestricted_correlation_energy.f90 index 578991f..54b702e 100644 --- a/src/eDFT/unrestricted_correlation_energy.f90 +++ b/src/eDFT/unrestricted_correlation_energy.f90 @@ -46,6 +46,12 @@ subroutine unrestricted_correlation_energy(rung,DFA,nEns,wEns,nGrid,weight,rho,d call unrestricted_gga_correlation_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,Ec) +! MGGA functionals + + case(3) + + call unrestricted_mgga_correlation_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,Ec) + ! Hybrid functionals case(4) @@ -57,12 +63,6 @@ subroutine unrestricted_correlation_energy(rung,DFA,nEns,wEns,nGrid,weight,rho,d Ec(:) = EcLDA(:) + aC*(EcGGA(:) - EcLDA(:)) -! Hartree-Fock calculation - - case(666) - - Ec(:) = 0d0 - end select end subroutine unrestricted_correlation_energy diff --git a/src/eDFT/unrestricted_correlation_individual_energy.f90 b/src/eDFT/unrestricted_correlation_individual_energy.f90 index a0431f4..8bff661 100644 --- a/src/eDFT/unrestricted_correlation_individual_energy.f90 +++ b/src/eDFT/unrestricted_correlation_individual_energy.f90 @@ -50,6 +50,13 @@ subroutine unrestricted_correlation_individual_energy(rung,DFA,LDA_centered,nEns call print_warning('!!! Individual energies NYI for GGAs !!!') stop +! MGGA functionals + + case(3) + + call print_warning('!!! Individual energies NYI for MGGAs !!!') + stop + ! Hybrid functionals case(4) @@ -59,12 +66,6 @@ subroutine unrestricted_correlation_individual_energy(rung,DFA,LDA_centered,nEns aC = 0.81d0 -! Hartree-Fock calculation - - case(666) - - Ec(:) = 0d0 - end select end subroutine unrestricted_correlation_individual_energy diff --git a/src/eDFT/unrestricted_correlation_potential.f90 b/src/eDFT/unrestricted_correlation_potential.f90 index e847b28..26d2fa5 100644 --- a/src/eDFT/unrestricted_correlation_potential.f90 +++ b/src/eDFT/unrestricted_correlation_potential.f90 @@ -51,6 +51,12 @@ subroutine unrestricted_correlation_potential(rung,DFA,nEns,wEns,nGrid,weight,nB call unrestricted_gga_correlation_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,Fc) +! MGGA functionals + + case(3) + + call unrestricted_mgga_correlation_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,Fc) + ! Hybrid functionals case(4) @@ -64,12 +70,6 @@ subroutine unrestricted_correlation_potential(rung,DFA,nEns,wEns,nGrid,weight,nB Fc(:,:,:) = FcLDA(:,:,:) + aC*(FcGGA(:,:,:) - FcLDA(:,:,:)) -! Hartree-Fock calculation - - case(666) - - Fc(:,:,:) = 0d0 - end select end subroutine unrestricted_correlation_potential diff --git a/src/eDFT/unrestricted_exchange_derivative_discontinuity.f90 b/src/eDFT/unrestricted_exchange_derivative_discontinuity.f90 index a52f093..0bc6660 100644 --- a/src/eDFT/unrestricted_exchange_derivative_discontinuity.f90 +++ b/src/eDFT/unrestricted_exchange_derivative_discontinuity.f90 @@ -43,13 +43,18 @@ subroutine unrestricted_exchange_derivative_discontinuity(rung,DFA,nEns,wEns,aCC call unrestricted_lda_exchange_derivative_discontinuity(DFA,nEns,wEns(:),aCC_w1,aCC_w2,nGrid,weight(:),& rhow(:),Cx_choice,doNcentered,kappa,ExDD(:)) - ! GGA functionals case(2) call unrestricted_gga_exchange_derivative_discontinuity(DFA,nEns,wEns(:),nGrid,weight(:),rhow(:),drhow(:,:),ExDD(:)) +! MGGA functionals + + case(3) + + call unrestricted_mgga_exchange_derivative_discontinuity(DFA,nEns,wEns(:),nGrid,weight(:),rhow(:),drhow(:,:),ExDD(:)) + ! Hybrid functionals case(4) @@ -57,12 +62,6 @@ subroutine unrestricted_exchange_derivative_discontinuity(rung,DFA,nEns,wEns,aCC call print_warning('!!! exchange part of derivative discontinuity NYI for hybrids !!!') stop -! Hartree-Fock calculation - - case(666) - - ExDD(:) = 0d0 - end select end subroutine unrestricted_exchange_derivative_discontinuity diff --git a/src/eDFT/unrestricted_exchange_energy.f90 b/src/eDFT/unrestricted_exchange_energy.f90 index 56cf438..deb011d 100644 --- a/src/eDFT/unrestricted_exchange_energy.f90 +++ b/src/eDFT/unrestricted_exchange_energy.f90 @@ -82,14 +82,6 @@ subroutine unrestricted_exchange_energy(rung,DFA,LDA_centered,nEns,wEns,aCC_w1,a + cX*(ExHF - ExLDA) & + aX*(ExGGA - ExLDA) -! Hartree-Fock calculation - - case(666) - - call unrestricted_fock_exchange_energy(nBas,P,FxHF,ExHF) - - Ex = ExHF - end select end subroutine unrestricted_exchange_energy diff --git a/src/eDFT/unrestricted_exchange_individual_energy.f90 b/src/eDFT/unrestricted_exchange_individual_energy.f90 index 65263be..5a2e5f4 100644 --- a/src/eDFT/unrestricted_exchange_individual_energy.f90 +++ b/src/eDFT/unrestricted_exchange_individual_energy.f90 @@ -33,6 +33,7 @@ subroutine unrestricted_exchange_individual_energy(rung,DFA,LDA_centered,nEns,wE double precision :: ExLDA double precision :: ExGGA + double precision :: ExMGGA double precision :: ExHF ! Output variables @@ -64,6 +65,14 @@ subroutine unrestricted_exchange_individual_energy(rung,DFA,LDA_centered,nEns,wE Ex = ExGGA +! MGGA functionals + + case(3) + + call unrestricted_mgga_exchange_individual_energy(DFA,nEns,wEns,nGrid,weight,rhow,drhow,rho,drho,ExMGGA) + + Ex = ExMGGA + ! Hybrid functionals case(4) @@ -71,14 +80,6 @@ subroutine unrestricted_exchange_individual_energy(rung,DFA,LDA_centered,nEns,wE call print_warning('!!! Individual energies NYI for Hybrids !!!') stop -! Hartree-Fock calculation - - case(666) - - call unrestricted_fock_exchange_individual_energy(nBas,Pw,P,ERI,ExHF) - - Ex = ExHF - end select end subroutine unrestricted_exchange_individual_energy diff --git a/src/eDFT/unrestricted_exchange_potential.f90 b/src/eDFT/unrestricted_exchange_potential.f90 index 487e5b4..70a0a54 100644 --- a/src/eDFT/unrestricted_exchange_potential.f90 +++ b/src/eDFT/unrestricted_exchange_potential.f90 @@ -57,6 +57,12 @@ subroutine unrestricted_exchange_potential(rung,DFA,LDA_centered,nEns,wEns,aCC_w call unrestricted_gga_exchange_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,Fx) +! MGGA functionals + + case(3) + + call unrestricted_mgga_exchange_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,Fx) + ! Hybrid functionals case(4) @@ -74,14 +80,6 @@ subroutine unrestricted_exchange_potential(rung,DFA,LDA_centered,nEns,wEns,aCC_w + cX*(FxHF(:,:) - FxLDA(:,:)) & + aX*(FxGGA(:,:) - FxLDA(:,:)) -! Hartree-Fock calculation - - case(666) - - call unrestricted_fock_exchange_potential(nBas,P,ERI,FxHF) - - Fx(:,:) = FxHF(:,:) - end select end subroutine unrestricted_exchange_potential diff --git a/src/eDFT/unrestricted_mgga_correlation_potential.f90 b/src/eDFT/unrestricted_mgga_correlation_potential.f90 new file mode 100644 index 0000000..cda1e10 --- /dev/null +++ b/src/eDFT/unrestricted_mgga_correlation_potential.f90 @@ -0,0 +1,38 @@ +subroutine unrestricted_mgga_correlation_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,Fc) + +! Compute unrestricted MGGA correlation potential + + implicit none + include 'parameters.h' + +! Input variables + + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + integer,intent(in) :: nBas + double precision,intent(in) :: AO(nBas,nGrid) + double precision,intent(in) :: dAO(3,nBas,nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + double precision,intent(in) :: drho(3,nGrid,nspin) + +! Local variables + +! Output variables + + double precision,intent(out) :: Fc(nBas,nBas,nspin) + +! Select MGGA exchange functional + + select case (DFA) + + case default + + call print_warning('!!! MGGA correlation potential not available !!!') + stop + + end select + +end subroutine unrestricted_mgga_correlation_potential diff --git a/src/eDFT/unrestricted_mgga_exchange_derivative_discontinuity.f90 b/src/eDFT/unrestricted_mgga_exchange_derivative_discontinuity.f90 new file mode 100644 index 0000000..1d75470 --- /dev/null +++ b/src/eDFT/unrestricted_mgga_exchange_derivative_discontinuity.f90 @@ -0,0 +1,36 @@ +subroutine unrestricted_mgga_exchange_derivative_discontinuity(DFA,nEns,wEns,nGrid,weight,rhow,drhow,ExDD) + +! Compute the exchange MGGA part of the derivative discontinuity + + implicit none + include 'parameters.h' + +! Input variables + + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rhow(nGrid) + double precision,intent(in) :: drhow(ncart,nGrid) + +! Local variables + + +! Output variables + + double precision,intent(out) :: ExDD(nEns) + +! Select exchange functional + + select case (DFA) + + case default + + call print_warning('!!! MGGA exchange derivative discontinuity not available !!!') + stop + + end select + +end subroutine unrestricted_mgga_exchange_derivative_discontinuity diff --git a/src/eDFT/unrestricted_mgga_exchange_individual_energy.f90 b/src/eDFT/unrestricted_mgga_exchange_individual_energy.f90 new file mode 100644 index 0000000..74267d5 --- /dev/null +++ b/src/eDFT/unrestricted_mgga_exchange_individual_energy.f90 @@ -0,0 +1,35 @@ +subroutine unrestricted_mgga_exchange_individual_energy(DFA,nEns,wEns,nGrid,weight,rhow,drhow,rho,drho,Ex) + +! Compute MGGA exchange energy for individual states + + implicit none + include 'parameters.h' + +! Input variables + + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rhow(nGrid) + double precision,intent(in) :: drhow(ncart,nGrid) + double precision,intent(in) :: rho(nGrid) + double precision,intent(in) :: drho(ncart,nGrid) + +! Output variables + + double precision :: Ex + +! Select correlation functional + + select case (DFA) + + case default + + call print_warning('!!! MGGA exchange individual energy not available !!!') + stop + + end select + +end subroutine unrestricted_mgga_exchange_individual_energy diff --git a/src/eDFT/unrestricted_mgga_exchange_potential.f90 b/src/eDFT/unrestricted_mgga_exchange_potential.f90 new file mode 100644 index 0000000..aef588f --- /dev/null +++ b/src/eDFT/unrestricted_mgga_exchange_potential.f90 @@ -0,0 +1,36 @@ +subroutine unrestricted_mgga_exchange_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,Fx) + +! Select MGGA exchange functional for potential calculation + + implicit none + include 'parameters.h' + +! Input variables + + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + integer,intent(in) :: nBas + double precision,intent(in) :: AO(nBas,nGrid) + double precision,intent(in) :: dAO(3,nBas,nGrid) + double precision,intent(in) :: rho(nGrid) + double precision,intent(in) :: drho(3,nGrid) + +! Output variables + + double precision,intent(out) :: Fx(nBas,nBas) + +! Select MGGA exchange functional + + select case (DFA) + + case default + + call print_warning('!!! MGGA exchange potential not available !!!') + stop + + end select + +end subroutine unrestricted_mgga_exchange_potential From da8c1c691ec80072aea01498760b6cbfa302948b Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Sun, 14 Feb 2021 21:54:10 +0100 Subject: [PATCH 12/63] B3LYP works --- input/dft | 18 +++--- input/methods | 4 +- src/eDFT/lda_exchange_potential.f90 | 58 ------------------- src/eDFT/unrestricted_correlation_energy.f90 | 11 +--- .../unrestricted_correlation_potential.f90 | 9 +-- src/eDFT/unrestricted_exchange_energy.f90 | 28 ++------- src/eDFT/unrestricted_exchange_potential.f90 | 14 +---- src/eDFT/unrestricted_lda_exchange_energy.f90 | 3 +- .../unrestricted_lda_exchange_potential.f90 | 2 +- 9 files changed, 23 insertions(+), 124 deletions(-) delete mode 100644 src/eDFT/lda_exchange_potential.f90 diff --git a/input/dft b/input/dft index 03d7933..bfcaa1b 100644 --- a/input/dft +++ b/input/dft @@ -1,26 +1,26 @@ # Restricted or unrestricted KS calculation eDFT-UKS # exchange rung: -# Hartree = 0 +# Hartree = 0: H # LDA = 1: S51,CC-S51 # GGA = 2: B88,G96,PBE -# Hybrid = 4: B3LYP,PBE0 -# Hartree-Fock = 666 - 2 B88 +# MGGA = 3: +# Hybrid = 4: HF,B3,PBE + 4 B3 # correlation rung: # Hartree = 0: H # LDA = 1: VWN5,eVWN5 # GGA = 2: LYP,PBE -# Hybrid = 4: -# Hartree-Fock = 666 - 2 LYP +# MGGA = 3: +# Hybrid = 4: HF,B88,PBE + 4 LYP # quadrature grid SG-n 1 # Number of states in ensemble (nEns) 3 # occupation numbers - 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 - 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 + 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 diff --git a/input/methods b/input/methods index 1da5665..ceea951 100644 --- a/input/methods +++ b/input/methods @@ -1,5 +1,5 @@ # RHF UHF KS MOM - T F T F + F F T F # MP2* MP3 MP2-F12 F F F # CCD DCD CCSD CCSD(T) @@ -9,7 +9,7 @@ # CIS* CIS(D) CID CISD F F F F # RPA* RPAx* ppRPA - F F F + F T F # G0F2 evGF2 G0F3 evGF3 F F F F # G0W0* evGW* qsGW* diff --git a/src/eDFT/lda_exchange_potential.f90 b/src/eDFT/lda_exchange_potential.f90 deleted file mode 100644 index c486267..0000000 --- a/src/eDFT/lda_exchange_potential.f90 +++ /dev/null @@ -1,58 +0,0 @@ -subroutine lda_exchange_potential(DFA,LDA_centered,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,nBas,AO,rho,Fx) - -! Select LDA correlation potential - - implicit none - - include 'parameters.h' - -! Input variables - - logical,intent(in) :: LDA_centered - character(len=12),intent(in) :: DFA - integer,intent(in) :: nEns - double precision,intent(in) :: wEns(nEns) - double precision,intent(in) :: aCC_w1(3) - double precision,intent(in) :: aCC_w2(3) - integer,intent(in) :: nGrid - double precision,intent(in) :: weight(nGrid) - integer,intent(in) :: nBas - double precision,intent(in) :: AO(nBas,nGrid) - double precision,intent(in) :: rho(nGrid) - -! Output variables - - double precision,intent(out) :: Fx(nBas,nBas) - -! Select exchange functional - - select case (DFA) - - case ('RS51') - - call RS51_lda_exchange_potential(nGrid,weight,nBas,AO,rho,Fx) - - case ('US51') - - call US51_lda_exchange_potential(nGrid,weight,nBas,AO,rho,Fx) - - case ('RMFL20') - - call RMFL20_lda_exchange_potential(LDA_centered,nEns,wEns,nGrid,weight,nBas,AO,rho,Fx) - - case ('RCC') - - call RCC_lda_exchange_potential(nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,nBas,AO,rho,Fx) - - case ('UCC') - - call UCC_lda_exchange_potential(nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,nBas,AO,rho,Fx) - - case default - - call print_warning('!!! LDA exchange functional not available !!!') - stop - - end select - -end subroutine lda_exchange_potential diff --git a/src/eDFT/unrestricted_correlation_energy.f90 b/src/eDFT/unrestricted_correlation_energy.f90 index 54b702e..fe53825 100644 --- a/src/eDFT/unrestricted_correlation_energy.f90 +++ b/src/eDFT/unrestricted_correlation_energy.f90 @@ -18,10 +18,6 @@ subroutine unrestricted_correlation_energy(rung,DFA,nEns,wEns,nGrid,weight,rho,d ! Local variables - double precision :: EcLDA(nsp) - double precision :: EcGGA(nsp) - double precision :: aC - ! Output variables double precision,intent(out) :: Ec(nsp) @@ -56,12 +52,7 @@ subroutine unrestricted_correlation_energy(rung,DFA,nEns,wEns,nGrid,weight,rho,d case(4) - aC = 0.81d0 - - call unrestricted_lda_correlation_energy(DFA,nEns,wEns,nGrid,weight,rho,EcLDA) - call unrestricted_gga_correlation_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,EcGGA) - - Ec(:) = EcLDA(:) + aC*(EcGGA(:) - EcLDA(:)) + call unrestricted_hybrid_correlation_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,Ec) end select diff --git a/src/eDFT/unrestricted_correlation_potential.f90 b/src/eDFT/unrestricted_correlation_potential.f90 index 26d2fa5..d8e168e 100644 --- a/src/eDFT/unrestricted_correlation_potential.f90 +++ b/src/eDFT/unrestricted_correlation_potential.f90 @@ -61,14 +61,7 @@ subroutine unrestricted_correlation_potential(rung,DFA,nEns,wEns,nGrid,weight,nB case(4) - allocate(FcLDA(nBas,nBas,nspin),FcGGA(nBas,nBas,nspin)) - - aC = 0.81d0 - - call unrestricted_lda_correlation_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,rho,FcLDA) - call unrestricted_gga_correlation_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,FcGGA) - - Fc(:,:,:) = FcLDA(:,:,:) + aC*(FcGGA(:,:,:) - FcLDA(:,:,:)) + call unrestricted_hybrid_correlation_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,Fc) end select diff --git a/src/eDFT/unrestricted_exchange_energy.f90 b/src/eDFT/unrestricted_exchange_energy.f90 index deb011d..f579248 100644 --- a/src/eDFT/unrestricted_exchange_energy.f90 +++ b/src/eDFT/unrestricted_exchange_energy.f90 @@ -26,9 +26,6 @@ subroutine unrestricted_exchange_energy(rung,DFA,LDA_centered,nEns,wEns,aCC_w1,a ! Local variables - double precision :: ExLDA,ExGGA,ExMGGA,ExHF - double precision :: cX,aX,aC - ! Output variables double precision,intent(out) :: Ex @@ -46,41 +43,26 @@ subroutine unrestricted_exchange_energy(rung,DFA,LDA_centered,nEns,wEns,aCC_w1,a case(1) call unrestricted_lda_exchange_energy(DFA,LDA_centered,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,& - rho,ExLDA,Cx_choice) - - Ex = ExLDA + rho,Ex,Cx_choice) ! GGA functionals case(2) - call unrestricted_gga_exchange_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,ExGGA) - - Ex = ExGGA + call unrestricted_gga_exchange_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,Ex) ! MGGA functionals case(3) - call unrestricted_mgga_exchange_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,ExMGGA) - - Ex = ExMGGA + call unrestricted_mgga_exchange_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,Ex) ! Hybrid functionals case(4) - cX = 0.20d0 - aX = 0.72d0 - aC = 0.81d0 - - call unrestricted_lda_exchange_energy(DFA,nEns,wEns,nGrid,weight,rho,ExLDA,Cx_choice) - call unrestricted_gga_exchange_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,ExGGA) - call unrestricted_fock_exchange_energy(nBas,P,FxHF,ExHF) - - Ex = ExLDA & - + cX*(ExHF - ExLDA) & - + aX*(ExGGA - ExLDA) + call unrestricted_hybrid_exchange_energy(DFA,LDA_centered,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,nBas,P,FxHF, & + rho,drho,Ex,Cx_choice) end select diff --git a/src/eDFT/unrestricted_exchange_potential.f90 b/src/eDFT/unrestricted_exchange_potential.f90 index 70a0a54..31cecc9 100644 --- a/src/eDFT/unrestricted_exchange_potential.f90 +++ b/src/eDFT/unrestricted_exchange_potential.f90 @@ -67,18 +67,8 @@ subroutine unrestricted_exchange_potential(rung,DFA,LDA_centered,nEns,wEns,aCC_w case(4) - allocate(FxLDA(nBas,nBas),FxGGA(nBas,nBas)) - - cX = 0.20d0 - aX = 0.72d0 - - call unrestricted_lda_exchange_potential(DFA,nGrid,weight,nBas,AO,rho,FxLDA,Cx_choice) - call unrestricted_gga_exchange_potential(DFA,nGrid,weight,nBas,AO,dAO,rho,drho,FxGGA) - call unrestricted_fock_exchange_potential(nBas,P,ERI,FxHF) - - Fx(:,:) = FxLDA(:,:) & - + cX*(FxHF(:,:) - FxLDA(:,:)) & - + aX*(FxGGA(:,:) - FxLDA(:,:)) + call unrestricted_hybrid_exchange_potential(DFA,LDA_centered,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,nBas,P, & + ERI,AO,dAO,rho,drho,Fx,FxHF,Cx_choice) end select diff --git a/src/eDFT/unrestricted_lda_exchange_energy.f90 b/src/eDFT/unrestricted_lda_exchange_energy.f90 index f4d6fba..71e7aa1 100644 --- a/src/eDFT/unrestricted_lda_exchange_energy.f90 +++ b/src/eDFT/unrestricted_lda_exchange_energy.f90 @@ -36,7 +36,8 @@ subroutine unrestricted_lda_exchange_energy(DFA,LDA_centered,nEns,wEns,aCC_w1,aC case default - call print_warning('!!! LDA exchange functional not available !!!') + call print_warning('!!! LDA exchange energy not available !!!') + stop end select diff --git a/src/eDFT/unrestricted_lda_exchange_potential.f90 b/src/eDFT/unrestricted_lda_exchange_potential.f90 index dd26ffb..718bce8 100644 --- a/src/eDFT/unrestricted_lda_exchange_potential.f90 +++ b/src/eDFT/unrestricted_lda_exchange_potential.f90 @@ -39,7 +39,7 @@ subroutine unrestricted_lda_exchange_potential(DFA,LDA_centered,nEns,wEns,aCC_w1 case default - call print_warning('!!! LDA exchange functional not available !!!') + call print_warning('!!! LDA exchange potential not available !!!') stop end select From 722d74ae170c48e51891953247b5ce62d9136fea Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Sun, 14 Feb 2021 22:24:52 +0100 Subject: [PATCH 13/63] fix KS --- src/QuAcK/QuAcK.f90 | 4 ++-- src/eDFT/eDFT.f90 | 13 +++++++++--- src/eDFT/eDFT_UKS.f90 | 21 ++++++++++--------- ...d_correlation_derivative_discontinuity.f90 | 5 ----- ...stricted_correlation_individual_energy.f90 | 5 ----- ...cted_exchange_derivative_discontinuity.f90 | 1 - ...nrestricted_exchange_individual_energy.f90 | 1 - 7 files changed, 23 insertions(+), 27 deletions(-) diff --git a/src/QuAcK/QuAcK.f90 b/src/QuAcK/QuAcK.f90 index 710c9e4..c1154f5 100644 --- a/src/QuAcK/QuAcK.f90 +++ b/src/QuAcK/QuAcK.f90 @@ -317,8 +317,8 @@ program QuAcK call cpu_time(start_KS) call eDFT(maxSCF_HF,thresh_HF,n_diis_HF,guess_type,mix,nNuc,ZNuc,rNuc,ENuc,nBas,nEl,nC, & - nO,nV,nR,nShell,TotAngMomShell,CenterShell,KShell,DShell,ExpShell, & - max_ang_mom,min_exponent,max_exponent,S,T,V,Hc,X,ERI_AO,dipole_int_AO) + nO,nV,nR,nShell,TotAngMomShell,CenterShell,KShell,DShell,ExpShell, & + max_ang_mom,min_exponent,max_exponent,S,T,V,Hc,X,ERI_AO,dipole_int_AO,EUHF,eHF,cHF,PHF) call cpu_time(end_KS) diff --git a/src/eDFT/eDFT.f90 b/src/eDFT/eDFT.f90 index ab6b5f0..2f9ec5a 100644 --- a/src/eDFT/eDFT.f90 +++ b/src/eDFT/eDFT.f90 @@ -1,6 +1,6 @@ subroutine eDFT(maxSCF,thresh,max_diis,guess_type,mix,nNuc,ZNuc,rNuc,ENuc,nBas,nEl,nC,nO,nV,nR, & nShell,TotAngMomShell,CenterShell,KShell,DShell,ExpShell, & - max_ang_mom,min_exponent,max_exponent,S,T,V,Hc,X,ERI,dipole_int) + max_ang_mom,min_exponent,max_exponent,S,T,V,Hc,X,ERI,dipole_int,Ew,eKS,cKS,PKS) ! exchange-correlation density-functional theory calculations @@ -50,7 +50,6 @@ subroutine eDFT(maxSCF,thresh,max_diis,guess_type,mix,nNuc,ZNuc,rNuc,ENuc,nBas,n ! Local variables - double precision :: Ew double precision,allocatable :: c(:,:) character(len=8) :: method @@ -83,6 +82,14 @@ subroutine eDFT(maxSCF,thresh,max_diis,guess_type,mix,nNuc,ZNuc,rNuc,ENuc,nBas,n integer :: i,vmajor,vminor,vmicro +! Output variables + + double precision,intent(out) :: Ew + double precision,intent(out) :: eKS(nBas,nspin) + double precision,intent(out) :: cKS(nBas,nBas,nspin) + double precision,intent(out) :: PKS(nBas,nBas,nspin) + + ! Hello World write(*,*) @@ -209,7 +216,7 @@ subroutine eDFT(maxSCF,thresh,max_diis,guess_type,mix,nNuc,ZNuc,rNuc,ENuc,nBas,n call cpu_time(start_KS) call eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight(:),maxSCF,thresh,max_diis,guess_type,mix, & - nBas,AO,dAO,S,T,V,Hc,ERI,X,ENuc,Ew,occnum,Cx_choice,doNcentered) + nBas,AO,dAO,S,T,V,Hc,ERI,X,ENuc,occnum,Cx_choice,doNcentered,Ew,eKS,cKS,PKS) call cpu_time(end_KS) t_KS = end_KS - start_KS diff --git a/src/eDFT/eDFT_UKS.f90 b/src/eDFT/eDFT_UKS.f90 index 4f70433..373e1ea 100644 --- a/src/eDFT/eDFT_UKS.f90 +++ b/src/eDFT/eDFT_UKS.f90 @@ -1,5 +1,5 @@ subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,maxSCF,thresh,max_diis,guess_type,mix, & - nBas,AO,dAO,S,T,V,Hc,ERI,X,ENuc,Ew,occnum,Cx_choice,doNcentered) + nBas,AO,dAO,S,T,V,Hc,ERI,X,ENuc,occnum,Cx_choice,doNcentered,Ew,eps,c,Pw) ! Perform unrestricted Kohn-Sham calculation for ensembles @@ -48,10 +48,7 @@ subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weig double precision :: EJ(nsp) double precision :: Ex(nspin) double precision :: Ec(nsp) - double precision :: Ew - double precision,allocatable :: eps(:,:) - double precision,allocatable :: c(:,:,:) double precision,allocatable :: cp(:,:,:) double precision,allocatable :: J(:,:,:) double precision,allocatable :: F(:,:,:) @@ -65,7 +62,6 @@ subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weig double precision,external :: trace_matrix double precision,external :: electron_number - double precision,allocatable :: Pw(:,:,:) double precision,allocatable :: rhow(:,:) double precision,allocatable :: drhow(:,:,:) double precision :: nEl(nspin) @@ -79,6 +75,13 @@ subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weig integer :: ispin,iEns,iBas +! Output variables + + double precision,intent(out) :: Ew + double precision,intent(out) :: eps(nBas,nspin) + double precision,intent(out) :: Pw(nBas,nBas,nspin) + double precision,intent(out) :: c(nBAs,nBas,nspin) + ! Hello world write(*,*) @@ -120,16 +123,14 @@ subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weig ! Memory allocation - allocate(eps(nBas,nspin),c(nBas,nBas,nspin),cp(nBas,nBas,nspin), & - J(nBas,nBas,nspin),F(nBas,nBas,nspin),Fp(nBas,nBas,nspin), & + allocate(cp(nBas,nBas,nspin),J(nBas,nBas,nspin),F(nBas,nBas,nspin),Fp(nBas,nBas,nspin), & Fx(nBas,nBas,nspin),FxHF(nBas,nBas,nspin),Fc(nBas,nBas,nspin),err(nBas,nBas,nspin), & - Pw(nBas,nBas,nspin),rhow(nGrid,nspin),drhow(ncart,nGrid,nspin), & - err_diis(nBasSq,max_diis,nspin),F_diis(nBasSq,max_diis,nspin), & + rhow(nGrid,nspin),drhow(ncart,nGrid,nspin), & + err_diis(nBasSq,max_diis,nspin),F_diis(nBasSq,max_diis,nspin), & P(nBas,nBas,nspin,nEns),rho(nGrid,nspin,nEns),drho(ncart,nGrid,nspin,nEns)) ! Guess coefficients and eigenvalues - if(guess_type == 1) then do ispin=1,nspin diff --git a/src/eDFT/unrestricted_correlation_derivative_discontinuity.f90 b/src/eDFT/unrestricted_correlation_derivative_discontinuity.f90 index 62fe916..7c7c33c 100644 --- a/src/eDFT/unrestricted_correlation_derivative_discontinuity.f90 +++ b/src/eDFT/unrestricted_correlation_derivative_discontinuity.f90 @@ -43,23 +43,18 @@ subroutine unrestricted_correlation_derivative_discontinuity(rung,DFA,nEns,wEns, case(2) call print_warning('!!! derivative discontinuity NYI for GGAs !!!') - stop ! MGGA functionals case(3) call print_warning('!!! derivative discontinuity NYI for MGGAs !!!') - stop ! Hybrid functionals case(4) call print_warning('!!! derivative discontinuity NYI for hybrids !!!') - stop - - aC = 0.81d0 end select diff --git a/src/eDFT/unrestricted_correlation_individual_energy.f90 b/src/eDFT/unrestricted_correlation_individual_energy.f90 index 8bff661..860c955 100644 --- a/src/eDFT/unrestricted_correlation_individual_energy.f90 +++ b/src/eDFT/unrestricted_correlation_individual_energy.f90 @@ -48,23 +48,18 @@ subroutine unrestricted_correlation_individual_energy(rung,DFA,LDA_centered,nEns case(2) call print_warning('!!! Individual energies NYI for GGAs !!!') - stop ! MGGA functionals case(3) call print_warning('!!! Individual energies NYI for MGGAs !!!') - stop ! Hybrid functionals case(4) call print_warning('!!! Individual energies NYI for hybrids !!!') - stop - - aC = 0.81d0 end select diff --git a/src/eDFT/unrestricted_exchange_derivative_discontinuity.f90 b/src/eDFT/unrestricted_exchange_derivative_discontinuity.f90 index 0bc6660..382e0aa 100644 --- a/src/eDFT/unrestricted_exchange_derivative_discontinuity.f90 +++ b/src/eDFT/unrestricted_exchange_derivative_discontinuity.f90 @@ -60,7 +60,6 @@ subroutine unrestricted_exchange_derivative_discontinuity(rung,DFA,nEns,wEns,aCC case(4) call print_warning('!!! exchange part of derivative discontinuity NYI for hybrids !!!') - stop end select diff --git a/src/eDFT/unrestricted_exchange_individual_energy.f90 b/src/eDFT/unrestricted_exchange_individual_energy.f90 index 5a2e5f4..6ddf3d2 100644 --- a/src/eDFT/unrestricted_exchange_individual_energy.f90 +++ b/src/eDFT/unrestricted_exchange_individual_energy.f90 @@ -78,7 +78,6 @@ subroutine unrestricted_exchange_individual_energy(rung,DFA,LDA_centered,nEns,wE case(4) call print_warning('!!! Individual energies NYI for Hybrids !!!') - stop end select From de4927aad4bab4162189874843157b210872b887 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Sun, 14 Feb 2021 22:52:17 +0100 Subject: [PATCH 14/63] hybrids --- input/dft | 6 +- ...d_correlation_derivative_discontinuity.f90 | 6 +- ...cted_exchange_derivative_discontinuity.f90 | 3 +- ...a_correlation_derivative_discontinuity.f90 | 44 +++++++++++ ...d_correlation_derivative_discontinuity.f90 | 48 ++++++++++++ ...unrestricted_hybrid_correlation_energy.f90 | 56 +++++++++++++ ...estricted_hybrid_correlation_potential.f90 | 65 ++++++++++++++++ ...brid_exchange_derivative_discontinuity.f90 | 54 +++++++++++++ .../unrestricted_hybrid_exchange_energy.f90 | 69 ++++++++++++++++ ...unrestricted_hybrid_exchange_potential.f90 | 78 +++++++++++++++++++ ...a_correlation_derivative_discontinuity.f90 | 34 ++++++++ .../unrestricted_mgga_correlation_energy.f90 | 36 +++++++++ 12 files changed, 492 insertions(+), 7 deletions(-) create mode 100644 src/eDFT/unrestricted_gga_correlation_derivative_discontinuity.f90 create mode 100644 src/eDFT/unrestricted_hybrid_correlation_derivative_discontinuity.f90 create mode 100644 src/eDFT/unrestricted_hybrid_correlation_energy.f90 create mode 100644 src/eDFT/unrestricted_hybrid_correlation_potential.f90 create mode 100644 src/eDFT/unrestricted_hybrid_exchange_derivative_discontinuity.f90 create mode 100644 src/eDFT/unrestricted_hybrid_exchange_energy.f90 create mode 100644 src/eDFT/unrestricted_hybrid_exchange_potential.f90 create mode 100644 src/eDFT/unrestricted_mgga_correlation_derivative_discontinuity.f90 create mode 100644 src/eDFT/unrestricted_mgga_correlation_energy.f90 diff --git a/input/dft b/input/dft index bfcaa1b..5c2cad4 100644 --- a/input/dft +++ b/input/dft @@ -6,14 +6,14 @@ # GGA = 2: B88,G96,PBE # MGGA = 3: # Hybrid = 4: HF,B3,PBE - 4 B3 + 4 HF # correlation rung: # Hartree = 0: H # LDA = 1: VWN5,eVWN5 # GGA = 2: LYP,PBE # MGGA = 3: -# Hybrid = 4: HF,B88,PBE - 4 LYP +# Hybrid = 4: HF,LYP,PBE + 4 HF # quadrature grid SG-n 1 # Number of states in ensemble (nEns) diff --git a/src/eDFT/unrestricted_correlation_derivative_discontinuity.f90 b/src/eDFT/unrestricted_correlation_derivative_discontinuity.f90 index 7c7c33c..98e8841 100644 --- a/src/eDFT/unrestricted_correlation_derivative_discontinuity.f90 +++ b/src/eDFT/unrestricted_correlation_derivative_discontinuity.f90 @@ -42,19 +42,19 @@ subroutine unrestricted_correlation_derivative_discontinuity(rung,DFA,nEns,wEns, case(2) - call print_warning('!!! derivative discontinuity NYI for GGAs !!!') + call unrestricted_gga_correlation_derivative_discontinuity(DFA,nEns,wEns,nGrid,weight,rhow,Ec) ! MGGA functionals case(3) - call print_warning('!!! derivative discontinuity NYI for MGGAs !!!') + call unrestricted_mgga_correlation_derivative_discontinuity(DFA,nEns,wEns,nGrid,weight,rhow,Ec) ! Hybrid functionals case(4) - call print_warning('!!! derivative discontinuity NYI for hybrids !!!') + call unrestricted_hybrid_correlation_derivative_discontinuity(DFA,nEns,wEns,nGrid,weight,rhow,Ec) end select diff --git a/src/eDFT/unrestricted_exchange_derivative_discontinuity.f90 b/src/eDFT/unrestricted_exchange_derivative_discontinuity.f90 index 382e0aa..0a5308a 100644 --- a/src/eDFT/unrestricted_exchange_derivative_discontinuity.f90 +++ b/src/eDFT/unrestricted_exchange_derivative_discontinuity.f90 @@ -59,7 +59,8 @@ subroutine unrestricted_exchange_derivative_discontinuity(rung,DFA,nEns,wEns,aCC case(4) - call print_warning('!!! exchange part of derivative discontinuity NYI for hybrids !!!') + call unrestricted_hybrid_exchange_derivative_discontinuity(DFA,nEns,wEns(:),aCC_w1,aCC_w2,nGrid,weight(:),& + rhow(:),Cx_choice,doNcentered,kappa,ExDD(:)) end select diff --git a/src/eDFT/unrestricted_gga_correlation_derivative_discontinuity.f90 b/src/eDFT/unrestricted_gga_correlation_derivative_discontinuity.f90 new file mode 100644 index 0000000..6c83d30 --- /dev/null +++ b/src/eDFT/unrestricted_gga_correlation_derivative_discontinuity.f90 @@ -0,0 +1,44 @@ +subroutine unrestricted_gga_correlation_derivative_discontinuity(DFA,nEns,wEns,nGrid,weight,rhow,Ec) + +! Compute the correlation GGA part of the derivative discontinuity + + implicit none + include 'parameters.h' + +! Input variables + + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rhow(nGrid,nspin) + +! Local variables + + double precision :: aC + +! Output variables + + double precision,intent(out) :: Ec(nsp,nEns) + +! Select correlation functional + + select case (DFA) + + case ('LYP') + + Ec(:,:) = 0d0 + + case ('PBE') + + Ec(:,:) = 0d0 + + case default + + call print_warning('!!! GGA correlation functional not available !!!') + stop + + end select + +end subroutine unrestricted_gga_correlation_derivative_discontinuity diff --git a/src/eDFT/unrestricted_hybrid_correlation_derivative_discontinuity.f90 b/src/eDFT/unrestricted_hybrid_correlation_derivative_discontinuity.f90 new file mode 100644 index 0000000..ed74ddd --- /dev/null +++ b/src/eDFT/unrestricted_hybrid_correlation_derivative_discontinuity.f90 @@ -0,0 +1,48 @@ +subroutine unrestricted_hybrid_correlation_derivative_discontinuity(DFA,nEns,wEns,nGrid,weight,rhow,Ec) + +! Compute the correlation hybrid part of the derivative discontinuity + + implicit none + include 'parameters.h' + +! Input variables + + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rhow(nGrid,nspin) + +! Local variables + + double precision :: aC + +! Output variables + + double precision,intent(out) :: Ec(nsp,nEns) + +! Select correlation functional + + select case (DFA) + + case ('HF') + + Ec(:,:) = 0d0 + + case ('LYP') + + Ec(:,:) = 0d0 + + case ('PBE') + + Ec(:,:) = 0d0 + + case default + + call print_warning('!!! Hybrid correlation functional not available !!!') + stop + + end select + +end subroutine unrestricted_hybrid_correlation_derivative_discontinuity diff --git a/src/eDFT/unrestricted_hybrid_correlation_energy.f90 b/src/eDFT/unrestricted_hybrid_correlation_energy.f90 new file mode 100644 index 0000000..0e030d0 --- /dev/null +++ b/src/eDFT/unrestricted_hybrid_correlation_energy.f90 @@ -0,0 +1,56 @@ +subroutine unrestricted_hybrid_correlation_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,Ec) + +! Compute the unrestricted version of the correlation energy for hybrid functionals + + implicit none + include 'parameters.h' + +! Input variables + + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + double precision,intent(in) :: drho(ncart,nGrid,nspin) + +! Local variables + + double precision :: EcLDA(nsp) + double precision :: EcGGA(nsp) + double precision :: aC + +! Output variables + + double precision,intent(out) :: Ec(nsp) + + select case (DFA) + + case('HF') + + Ec(:) = 0d0 + + case('LYP') + + aC = 0.81d0 + + call unrestricted_lda_correlation_energy('VWN5 ',nEns,wEns,nGrid,weight,rho,EcLDA) + call unrestricted_gga_correlation_energy('LYP ',nEns,wEns,nGrid,weight,rho,drho,EcGGA) + + Ec(:) = EcLDA(:) + aC*(EcGGA(:) - EcLDA(:)) + + case('PBE') + + call unrestricted_gga_correlation_energy('PBE ',nEns,wEns,nGrid,weight,rho,drho,EcGGA) + + Ec(:) = EcGGA(:) + + case default + + call print_warning('!!! Hybrid correlation energy not available !!!') + stop + + end select + +end subroutine unrestricted_hybrid_correlation_energy diff --git a/src/eDFT/unrestricted_hybrid_correlation_potential.f90 b/src/eDFT/unrestricted_hybrid_correlation_potential.f90 new file mode 100644 index 0000000..41afc8f --- /dev/null +++ b/src/eDFT/unrestricted_hybrid_correlation_potential.f90 @@ -0,0 +1,65 @@ +subroutine unrestricted_hybrid_correlation_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,Fc) + +! Compute the correlation potential for hybrid functionals + + implicit none + include 'parameters.h' + +! Input variables + + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + integer,intent(in) :: nBas + double precision,intent(in) :: AO(nBas,nGrid) + double precision,intent(in) :: dAO(ncart,nBas,nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + double precision,intent(in) :: drho(ncart,nGrid,nspin) + +! Local variables + + double precision,allocatable :: FcLDA(:,:,:) + double precision,allocatable :: FcGGA(:,:,:) + double precision :: aC + +! Output variables + + double precision,intent(out) :: Fc(nBas,nBas,nspin) + +! Memory allocation + + select case (DFA) + + case('HF') + + Fc(:,:,:) = 0d0 + + case('LYP') + + allocate(FcLDA(nBas,nBas,nspin),FcGGA(nBas,nBas,nspin)) + + aC = 0.81d0 + + call unrestricted_lda_correlation_potential('VWN5 ',nEns,wEns,nGrid,weight,nBas,AO,rho,FcLDA) + call unrestricted_gga_correlation_potential('LYP ',nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,FcGGA) + + Fc(:,:,:) = FcLDA(:,:,:) + aC*(FcGGA(:,:,:) - FcLDA(:,:,:)) + + case('PBE') + + allocate(FcGGA(nBas,nBas,nspin)) + + call unrestricted_gga_correlation_potential('PBE ',nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,FcGGA) + + Fc(:,:,:) = FcGGA(:,:,:) + + case default + + call print_warning('!!! Hybrid correlation potential not available !!!') + stop + + end select + +end subroutine unrestricted_hybrid_correlation_potential diff --git a/src/eDFT/unrestricted_hybrid_exchange_derivative_discontinuity.f90 b/src/eDFT/unrestricted_hybrid_exchange_derivative_discontinuity.f90 new file mode 100644 index 0000000..7e5bde8 --- /dev/null +++ b/src/eDFT/unrestricted_hybrid_exchange_derivative_discontinuity.f90 @@ -0,0 +1,54 @@ +subroutine unrestricted_hybrid_exchange_derivative_discontinuity(DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,rhow,& + Cx_choice,doNcentered,kappa,ExDD) + +! Compute the exchange part of the derivative discontinuity for hybrid functionals + + implicit none + include 'parameters.h' + +! Input variables + + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + double precision,intent(in) :: aCC_w1(3) + double precision,intent(in) :: aCC_w2(3) + + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rhow(nGrid) + integer,intent(in) :: Cx_choice + logical,intent(in) :: doNcentered + double precision,intent(in) :: kappa(nEns) + +! Local variables + + +! Output variables + + double precision,intent(out) :: ExDD(nEns) + +! Select exchange functional + + select case (DFA) + + case ('HF') + + ExDD(:) = 0d0 + + case ('B3') + + ExDD(:) = 0d0 + + case ('PBE') + + ExDD(:) = 0d0 + + case default + + call print_warning('!!! Hybrid exchange derivative discontinuity not available !!!') + stop + + end select + +end subroutine unrestricted_hybrid_exchange_derivative_discontinuity diff --git a/src/eDFT/unrestricted_hybrid_exchange_energy.f90 b/src/eDFT/unrestricted_hybrid_exchange_energy.f90 new file mode 100644 index 0000000..d0365b4 --- /dev/null +++ b/src/eDFT/unrestricted_hybrid_exchange_energy.f90 @@ -0,0 +1,69 @@ +subroutine unrestricted_hybrid_exchange_energy(DFA,LDA_centered,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,nBas,P,FxHF, & + rho,drho,Ex,Cx_choice) + +! Compute the exchange energy for hybrid functionals + + implicit none + include 'parameters.h' + +! Input variables + + character(len=12),intent(in) :: DFA + logical,intent(in) :: LDA_centered + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + double precision,intent(in) :: aCC_w1(3) + double precision,intent(in) :: aCC_w2(3) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + integer,intent(in) :: nBas + double precision,intent(in) :: P(nBas,nBas) + double precision,intent(in) :: FxHF(nBas,nBas) + double precision,intent(in) :: rho(nGrid) + double precision,intent(in) :: drho(ncart,nGrid) + integer,intent(in) :: Cx_choice + +! Local variables + + double precision :: ExLDA,ExGGA,ExHF + double precision :: a0,aX + +! Output variables + + double precision,intent(out) :: Ex + + select case (DFA) + + case ('HF') + + call unrestricted_fock_exchange_energy(nBas,P,FxHF,Ex) + + case ('B3') + + a0 = 0.20d0 + aX = 0.72d0 + + call unrestricted_lda_exchange_energy('S51 ',LDA_centered,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,& + rho,ExLDA,Cx_choice) + call unrestricted_gga_exchange_energy('B88 ',nEns,wEns,nGrid,weight,rho,drho,ExGGA) + call unrestricted_fock_exchange_energy(nBas,P,FxHF,ExHF) + + Ex = ExLDA & + + a0*(ExHF - ExLDA) & + + aX*(ExGGA - ExLDA) + + case ('PBE') + + call unrestricted_gga_exchange_energy('PBE ',nEns,wEns,nGrid,weight,rho,drho,ExGGA) + call unrestricted_fock_exchange_energy(nBas,P,FxHF,ExHF) + + Ex = 0.25d0*ExHF + 0.75d0*ExGGA + + case default + + call print_warning('!!! Hybrid exchange energy not available !!!') + stop + + end select + +end subroutine unrestricted_hybrid_exchange_energy diff --git a/src/eDFT/unrestricted_hybrid_exchange_potential.f90 b/src/eDFT/unrestricted_hybrid_exchange_potential.f90 new file mode 100644 index 0000000..f7c5d37 --- /dev/null +++ b/src/eDFT/unrestricted_hybrid_exchange_potential.f90 @@ -0,0 +1,78 @@ +subroutine unrestricted_hybrid_exchange_potential(DFA,LDA_centered,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,nBas,P, & + ERI,AO,dAO,rho,drho,Fx,FxHF,Cx_choice) + +! Compute the exchange potential for hybrid functionals + + implicit none + include 'parameters.h' + +! Input variables + + character(len=12),intent(in) :: DFA + logical,intent(in) :: LDA_centered + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + double precision,intent(in) :: aCC_w1(3) + double precision,intent(in) :: aCC_w2(3) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + integer,intent(in) :: nBas + double precision,intent(in) :: P(nBas,nBas) + double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + double precision,intent(in) :: AO(nBas,nGrid) + double precision,intent(in) :: dAO(ncart,nBas,nGrid) + double precision,intent(in) :: rho(nGrid) + double precision,intent(in) :: drho(ncart,nGrid) + integer,intent(in) :: Cx_choice + +! Local variables + + double precision,allocatable :: FxLDA(:,:),FxGGA(:,:) + double precision :: a0,aX + +! Output variables + + double precision,intent(out) :: Fx(nBas,nBas),FxHF(nBas,nBas) + +! Memory allocation + + select case (DFA) + + case('HF') + + call unrestricted_fock_exchange_potential(nBas,P,ERI,FxHF) + Fx(:,:) = FxHF(:,:) + + case('B3') + + allocate(FxLDA(nBas,nBas),FxGGA(nBas,nBas)) + + a0 = 0.20d0 + aX = 0.72d0 + + call unrestricted_lda_exchange_potential('S51 ',LDA_centered,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight, & + nBas,AO,rho,FxLDA,Cx_choice) + call unrestricted_gga_exchange_potential('B88 ',nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,FxGGA) + call unrestricted_fock_exchange_potential(nBas,P,ERI,FxHF) + + Fx(:,:) = FxLDA(:,:) & + + a0*(FxHF(:,:) - FxLDA(:,:)) & + + aX*(FxGGA(:,:) - FxLDA(:,:)) + + case('PBE') + + allocate(FxGGA(nBas,nBas)) + + call unrestricted_gga_exchange_potential('PBE ',nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,FxGGA) + call unrestricted_fock_exchange_potential(nBas,P,ERI,FxHF) + + Fx(:,:) = 0.25d0*FxHF(:,:) + 0.75d0*FxGGA(:,:) + + case default + + call print_warning('!!! Hybrid exchange potential not available !!!') + stop + + end select + +end subroutine unrestricted_hybrid_exchange_potential diff --git a/src/eDFT/unrestricted_mgga_correlation_derivative_discontinuity.f90 b/src/eDFT/unrestricted_mgga_correlation_derivative_discontinuity.f90 new file mode 100644 index 0000000..4a870fe --- /dev/null +++ b/src/eDFT/unrestricted_mgga_correlation_derivative_discontinuity.f90 @@ -0,0 +1,34 @@ +subroutine unrestricted_mgga_correlation_derivative_discontinuity(DFA,nEns,wEns,nGrid,weight,rhow,Ec) + +! Compute the correlation MGGA part of the derivative discontinuity + + implicit none + include 'parameters.h' + +! Input variables + + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rhow(nGrid,nspin) + +! Local variables + +! Output variables + + double precision,intent(out) :: Ec(nsp,nEns) + +! Select correlation functional + + select case (DFA) + + case default + + call print_warning('!!! MGGA correlation functional not available !!!') + stop + + end select + +end subroutine unrestricted_mgga_correlation_derivative_discontinuity diff --git a/src/eDFT/unrestricted_mgga_correlation_energy.f90 b/src/eDFT/unrestricted_mgga_correlation_energy.f90 new file mode 100644 index 0000000..ae797ac --- /dev/null +++ b/src/eDFT/unrestricted_mgga_correlation_energy.f90 @@ -0,0 +1,36 @@ +subroutine unrestricted_mgga_correlation_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,Ec) + +! Compute unrestricted MGGA correlation energy + + implicit none + include 'parameters.h' + +! Input variables + + character(len=12),intent(in) :: DFA + integer,intent(in) :: nEns + double precision,intent(in) :: wEns(nEns) + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + double precision,intent(in) :: drho(ncart,nGrid,nspin) + +! Local variables + + integer :: iG + double precision :: ra,rb,ga,gb + +! Output variables + + double precision :: Ec(nsp) + + select case (DFA) + + case default + + call print_warning('!!! MGGA correlation energy not available !!!') + stop + + end select + +end subroutine unrestricted_mgga_correlation_energy From 0f28af6d50e7917de54f677d12029f54534c69c1 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Mon, 15 Feb 2021 17:27:06 +0100 Subject: [PATCH 15/63] Vxc in GW --- include/parameters.h | 7 +- input/dft | 6 +- input/methods | 6 +- input/options | 2 +- src/AOtoMO/exchange_matrix_AO_basis.f90 | 6 +- src/HF/RHF.f90 | 9 +- src/HF/UHF.f90 | 9 +- src/HF/exchange_potential.f90 | 34 ++++++ src/MBPT/G0W0.f90 | 24 ++-- src/MBPT/UG0W0.f90 | 25 +++-- src/MBPT/evGW.f90 | 25 +++-- src/MBPT/evUGW.f90 | 19 +++- src/MBPT/self_energy_exchange.f90 | 10 +- src/MBPT/self_energy_exchange_diag.f90 | 42 +++++++ src/QuAcK/QuAcK.f90 | 104 +++++++++--------- src/eDFT/RB88_gga_exchange_energy.f90 | 4 +- .../RB88_gga_exchange_individual_energy.f90 | 6 +- src/eDFT/RB88_gga_exchange_potential.f90 | 4 +- ..._lda_exchange_derivative_discontinuity.f90 | 6 +- src/eDFT/RCC_lda_exchange_energy.f90 | 19 +++- .../RCC_lda_exchange_individual_energy.f90 | 19 +++- src/eDFT/RCC_lda_exchange_potential.f90 | 19 +++- ..._lda_exchange_derivative_discontinuity.f90 | 3 + src/eDFT/RMFL20_lda_exchange_energy.f90 | 3 + .../RMFL20_lda_exchange_individual_energy.f90 | 3 + src/eDFT/RMFL20_lda_exchange_potential.f90 | 3 + src/eDFT/UB88_gga_exchange_energy.f90 | 5 +- src/eDFT/UB88_gga_exchange_potential.f90 | 9 +- ..._lda_exchange_derivative_discontinuity.f90 | 22 ++-- src/eDFT/UCC_lda_exchange_energy.f90 | 33 +++--- .../UCC_lda_exchange_individual_energy.f90 | 34 ++---- src/eDFT/UCC_lda_exchange_potential.f90 | 34 +++--- src/eDFT/UG96_gga_exchange_energy.f90 | 5 +- src/eDFT/UG96_gga_exchange_potential.f90 | 5 +- src/eDFT/UPBE_gga_exchange_energy.f90 | 5 +- src/eDFT/UPBE_gga_exchange_potential.f90 | 9 +- src/eDFT/US51_lda_exchange_energy.f90 | 8 +- .../US51_lda_exchange_individual_energy.f90 | 8 +- src/eDFT/US51_lda_exchange_potential.f90 | 7 +- ...VWN5_lda_correlation_individual_energy.f90 | 4 +- src/eDFT/eDFT.f90 | 89 ++++++++------- src/eDFT/eDFT_UKS.f90 | 16 ++- src/eDFT/read_options_dft.f90 | 6 +- ...unrestricted_hybrid_correlation_energy.f90 | 10 +- ...estricted_hybrid_correlation_potential.f90 | 12 +- .../unrestricted_hybrid_exchange_energy.f90 | 9 +- ...unrestricted_hybrid_exchange_potential.f90 | 11 +- src/eDFT/xc_potential.f90 | 40 +++++++ 48 files changed, 487 insertions(+), 311 deletions(-) create mode 100644 src/HF/exchange_potential.f90 create mode 100644 src/MBPT/self_energy_exchange_diag.f90 create mode 100644 src/eDFT/xc_potential.f90 diff --git a/include/parameters.h b/include/parameters.h index d504995..d0e1202 100644 --- a/include/parameters.h +++ b/include/parameters.h @@ -1,7 +1,7 @@ integer,parameter :: ncart = 3 integer,parameter :: nspin = 2 integer,parameter :: nsp = 3 - integer,parameter :: maxEns = 10 + integer,parameter :: maxEns = 3 integer,parameter :: maxShell = 512 integer,parameter :: maxL = 7 integer,parameter :: n1eInt = 3 @@ -17,7 +17,6 @@ double precision,parameter :: BoToAn = 0.529177249d0 double precision,parameter :: auToD = 2.5415802529d0 - double precision,parameter :: CxLDA = - (3d0/4d0)*(3d0/pi)**(1d0/3d0) - double precision,parameter :: Cx0 = - (4d0/3d0)*(1d0/pi)**(1d0/3d0) - double precision,parameter :: Cx1 = - (176d0/105d0)*(1d0/pi)**(1d0/3d0) + double precision,parameter :: CxLDA = - (3d0/4d0)*(3d0/pi)**(1d0/3d0) + double precision,parameter :: CxLSDA = - (3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) diff --git a/input/dft b/input/dft index 5c2cad4..78b4137 100644 --- a/input/dft +++ b/input/dft @@ -6,18 +6,18 @@ # GGA = 2: B88,G96,PBE # MGGA = 3: # Hybrid = 4: HF,B3,PBE - 4 HF + 4 BHHLYP # correlation rung: # Hartree = 0: H # LDA = 1: VWN5,eVWN5 # GGA = 2: LYP,PBE # MGGA = 3: # Hybrid = 4: HF,LYP,PBE - 4 HF + 4 BHHLYP # quadrature grid SG-n 1 # Number of states in ensemble (nEns) - 3 + 1 # occupation numbers 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 diff --git a/input/methods b/input/methods index ceea951..dbe88da 100644 --- a/input/methods +++ b/input/methods @@ -1,5 +1,5 @@ # RHF UHF KS MOM - F F T F + T F F F # MP2* MP3 MP2-F12 F F F # CCD DCD CCSD CCSD(T) @@ -9,11 +9,11 @@ # CIS* CIS(D) CID CISD F 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 T F # G0T0 evGT qsGT F F F # MCMP2 diff --git a/input/options b/input/options index 60308cb..1d5bf49 100644 --- a/input/options +++ b/input/options @@ -9,7 +9,7 @@ # 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.0000001 T 5 T 0.00367493 F F F F F + 256 0.0000001 T 5 T 0.000 F F F F F # ACFDT: AC Kx XBS F F T # BSE: BSE dBSE dTDA evDyn diff --git a/src/AOtoMO/exchange_matrix_AO_basis.f90 b/src/AOtoMO/exchange_matrix_AO_basis.f90 index 2f0f1d2..8a38c0e 100644 --- a/src/AOtoMO/exchange_matrix_AO_basis.f90 +++ b/src/AOtoMO/exchange_matrix_AO_basis.f90 @@ -1,4 +1,4 @@ -subroutine exchange_matrix_AO_basis(nBas,P,G,K) +subroutine exchange_matrix_AO_basis(nBas,P,ERI,K) ! Compute exchange matrix in the AO basis @@ -9,7 +9,7 @@ subroutine exchange_matrix_AO_basis(nBas,P,G,K) integer,intent(in) :: nBas double precision,intent(in) :: P(nBas,nBas) - double precision,intent(in) :: G(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) ! Local variables @@ -24,7 +24,7 @@ subroutine exchange_matrix_AO_basis(nBas,P,G,K) do si=1,nBas do la=1,nBas do mu=1,nBas - K(mu,nu) = K(mu,nu) - P(la,si)*G(mu,la,si,nu) + K(mu,nu) = K(mu,nu) - P(la,si)*ERI(mu,la,si,nu) enddo enddo enddo diff --git a/src/HF/RHF.f90 b/src/HF/RHF.f90 index a907154..9fd3d22 100644 --- a/src/HF/RHF.f90 +++ b/src/HF/RHF.f90 @@ -1,4 +1,4 @@ -subroutine RHF(maxSCF,thresh,max_diis,guess_type,nNuc,ZNuc,rNuc,ENuc,nBas,nO,S,T,V,Hc,ERI,dipole_int,X,ERHF,e,c,P) +subroutine RHF(maxSCF,thresh,max_diis,guess_type,nNuc,ZNuc,rNuc,ENuc,nBas,nO,S,T,V,Hc,ERI,dipole_int,X,ERHF,e,c,P,Vx) ! Perform restricted Hartree-Fock calculation @@ -55,6 +55,7 @@ subroutine RHF(maxSCF,thresh,max_diis,guess_type,nNuc,ZNuc,rNuc,ENuc,nBas,nO,S,T double precision,intent(out) :: e(nBas) double precision,intent(out) :: c(nBas,nBas) double precision,intent(out) :: P(nBas,nBas) + double precision,intent(out) :: Vx(nBas) ! Hello world @@ -196,7 +197,13 @@ subroutine RHF(maxSCF,thresh,max_diis,guess_type,nNuc,ZNuc,rNuc,ENuc,nBas,nO,S,T EK = 0.25d0*trace_matrix(nBas,matmul(P,K)) ERHF = ET + EV + EJ + EK +! Compute dipole moments + call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int,dipole) call print_RHF(nBas,nO,e,C,ENuc,ET,EV,EJ,EK,ERHF,dipole) +! Compute Vx for post-HF calculations + + call exchange_potential(nBas,c,K,Vx) + end subroutine RHF diff --git a/src/HF/UHF.f90 b/src/HF/UHF.f90 index 4123dd5..a55e8bb 100644 --- a/src/HF/UHF.f90 +++ b/src/HF/UHF.f90 @@ -1,4 +1,4 @@ -subroutine UHF(maxSCF,thresh,max_diis,guess_type,mix,nNuc,ZNuc,rNuc,ENuc,nBas,nO,S,T,V,Hc,ERI,dipole_int,X,EUHF,e,c,P) +subroutine UHF(maxSCF,thresh,max_diis,guess_type,mix,nNuc,ZNuc,rNuc,ENuc,nBas,nO,S,T,V,Hc,ERI,dipole_int,X,EUHF,e,c,P,Vx) ! Perform unrestricted Hartree-Fock calculation @@ -59,6 +59,7 @@ subroutine UHF(maxSCF,thresh,max_diis,guess_type,mix,nNuc,ZNuc,rNuc,ENuc,nBas,nO double precision,intent(out) :: e(nBas,nspin) double precision,intent(out) :: c(nBas,nBas,nspin) double precision,intent(out) :: P(nBas,nBas,nspin) + double precision,intent(out) :: Vx(nBas,nspin) ! Hello world @@ -249,4 +250,10 @@ subroutine UHF(maxSCF,thresh,max_diis,guess_type,mix,nNuc,ZNuc,rNuc,ENuc,nBas,nO call dipole_moment(nBas,P(:,:,1)+P(:,:,2),nNuc,ZNuc,rNuc,dipole_int,dipole) call print_UHF(nBas,nO,S,e,c,ENuc,ET,EV,EJ,Ex,EUHF,dipole) +! Compute Vx for post-HF calculations + + do ispin=1,nspin + call exchange_potential(nBas,c(:,:,ispin),K(:,:,ispin),Vx(:,ispin)) + end do + end subroutine UHF diff --git a/src/HF/exchange_potential.f90 b/src/HF/exchange_potential.f90 new file mode 100644 index 0000000..9f72ce7 --- /dev/null +++ b/src/HF/exchange_potential.f90 @@ -0,0 +1,34 @@ +subroutine exchange_potential(nBas,c,Fx,Vx) + +! Compute the exchange potential in the MO basis + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nBas + double precision,intent(in) :: c(nBas,nBas) + double precision,intent(in) :: Fx(nBas,nBas) + +! Local variables + + integer :: mu,nu + integer :: p + +! Output variables + + double precision,intent(out) :: Vx(nBas) + +! Compute Vx + + Vx(:) = 0d0 + do p=1,nBas + do mu=1,nBas + do nu=1,nBas + Vx(p) = Vx(p) + c(mu,p)*Fx(mu,nu)*c(nu,p) + end do + end do + end do + +end subroutine exchange_potential diff --git a/src/MBPT/G0W0.f90 b/src/MBPT/G0W0.f90 index f629708..d679ce8 100644 --- a/src/MBPT/G0W0.f90 +++ b/src/MBPT/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,ERI,dipole_int,eHF,eGW) + nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int,PHF,cHF,eHF,Vxc,eGW) ! Perform G0W0 calculation @@ -29,9 +29,13 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & integer,intent(in) :: nBas,nC,nO,nV,nR,nS double precision,intent(in) :: ENuc double precision,intent(in) :: ERHF - double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_MO(nBas,nBas,nBas,nBas) double precision,intent(in) :: dipole_int(nBas,nBas,ncart) + double precision,intent(in) :: Vxc(nBas) double precision,intent(in) :: eHF(nBas) + double precision,intent(in) :: cHF(nBas,nBas) + double precision,intent(in) :: PHF(nBas,nBas) ! Local variables @@ -41,6 +45,7 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & double precision :: EcBSE(nspin) double precision :: EcAC(nspin) double precision :: EcGM + double precision,allocatable :: SigX(:) double precision,allocatable :: SigC(:) double precision,allocatable :: Z(:) double precision,allocatable :: OmRPA(:) @@ -100,14 +105,14 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & ! Memory allocation - allocate(SigC(nBas),Z(nBas),OmRPA(nS),XpY_RPA(nS,nS),XmY_RPA(nS,nS),rho_RPA(nBas,nBas,nS),eGWlin(nBas)) + allocate(SigC(nBas),SigX(nBas),Z(nBas),OmRPA(nS),XpY_RPA(nS,nS),XmY_RPA(nS,nS),rho_RPA(nBas,nBas,nS),eGWlin(nBas)) !-------------------! ! Compute screening ! !-------------------! 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) + eHF,ERI_MO,OmRPA,rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA) if(print_W) call print_excitation('RPA@HF ',ispin,nS,OmRPA) @@ -115,12 +120,13 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & ! Compute spectral weights ! !--------------------------! - call excitation_density(nBas,nC,nO,nR,nS,ERI,XpY_RPA,rho_RPA) + call excitation_density(nBas,nC,nO,nR,nS,ERI_MO,XpY_RPA,rho_RPA) !------------------------! ! Compute GW self-energy ! !------------------------! + call self_energy_exchange_diag(nBas,cHF,PHF,ERI_AO,SigX) call self_energy_correlation_diag(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,EcGM,SigC) !--------------------------------! @@ -133,7 +139,7 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & ! Solve the quasi-particle equation ! !-----------------------------------! - eGWlin(:) = eHF(:) + Z(:)*SigC(:) + eGWlin(:) = eHF(:) + Z(:)*(SigX(:) + SigC(:) - Vxc(:)) ! Linearized or graphical solution? @@ -159,7 +165,7 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & ! Compute the RPA correlation energy - call linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI,OmRPA, & + call linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI_MO,OmRPA, & rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA) !--------------! @@ -180,7 +186,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,dipole_int,eHF,eGW,EcBSE) + call Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI_MO,dipole_int,eHF,eGW,EcBSE) if(exchange_kernel) then @@ -214,7 +220,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,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,eHF,eGW,EcAC) + call ACFDT(exchange_kernel,doXBS,.true.,TDA_W,TDA,BSE,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI_MO,eHF,eGW,EcAC) write(*,*) write(*,*)'-------------------------------------------------------------------------------' diff --git a/src/MBPT/UG0W0.f90 b/src/MBPT/UG0W0.f90 index 5f8b8b9..5c876cc 100644 --- a/src/MBPT/UG0W0.f90 +++ b/src/MBPT/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,S,ERI_aaaa,ERI_aabb,ERI_bbbb, & - dipole_int_aa,dipole_int_bb,PHF,cHF,eHF,eGW) + linearize,eta,nBas,nC,nO,nV,nR,nS,ENuc,EUHF,S,ERI,ERI_aaaa,ERI_aabb,ERI_bbbb, & + dipole_int_aa,dipole_int_bb,PHF,cHF,eHF,Vxc,eGW) ! Perform unrestricted G0W0 calculation @@ -34,6 +34,7 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev double precision,intent(in) :: ENuc double precision,intent(in) :: EUHF double precision,intent(in) :: S(nBas,nBas) + double precision,intent(in) :: ERI(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) @@ -42,6 +43,7 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev 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) :: Vxc(nBas,nspin) ! Local variables @@ -52,6 +54,7 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev double precision :: EcGM(nspin) double precision :: EcBSE(nspin) double precision :: EcAC(nspin) + double precision,allocatable :: SigX(:,:) double precision,allocatable :: SigC(:,:) double precision,allocatable :: Z(:,:) integer :: nS_aa,nS_bb,nS_sc @@ -106,8 +109,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),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)) + allocate(SigX(nBas,nspin),SigC(nBas,nspin),Z(nBas,nspin),eGWlin(nBas,nspin), & + OmRPA(nS_sc),XpY_RPA(nS_sc,nS_sc),XmY_RPA(nS_sc,nS_sc),rho_RPA(nBas,nBas,nS_sc,nspin)) !-------------------! ! Compute screening ! @@ -132,6 +135,10 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev ! Compute self-energy ! !---------------------! + do is=1,nspin + call self_energy_exchange_diag(nBas,cHF(:,:,is),PHF(:,:,is),ERI,SigX(:,is)) + end do + call unrestricted_self_energy_correlation_diag(eta,nBas,nC,nO,nV,nR,nS_sc,eHF,OmRPA,rho_RPA,SigC,EcGM) !--------------------------------! @@ -144,7 +151,7 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev ! Solve the quasi-particle equation ! !-----------------------------------! - eGWlin(:,:) = eHF(:,:) + Z(:,:)*SigC(:,:) + eGWlin(:,:) = eHF(:,:) + Z(:,:)*(SigX(:,:) + SigC(:,:) - Vxc(:,:)) if(linearize) then @@ -157,10 +164,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 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 + do is=1,nspin + 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 diff --git a/src/MBPT/evGW.f90 b/src/MBPT/evGW.f90 index d471d70..882663d 100644 --- a/src/MBPT/evGW.f90 +++ b/src/MBPT/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,ERI, & - dipole_int,eHF,eG0W0) + G0W,GW0,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF, & + ERI_AO,ERI_MO,dipole_int,PHF,cHF,eHF,Vxc,eG0W0) ! Perform self-consistent eigenvalue-only GW calculation @@ -31,9 +31,13 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE logical,intent(in) :: triplet double precision,intent(in) :: eta integer,intent(in) :: nBas,nC,nO,nV,nR,nS + double precision,intent(in) :: PHF(nBas,nBas) double precision,intent(in) :: eHF(nBas) + double precision,intent(in) :: cHF(nBas,nBas) + double precision,intent(in) :: Vxc(nBas,nspin) double precision,intent(in) :: eG0W0(nBas) - double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_MO(nBas,nBas,nBas,nBas) double precision,intent(in) :: dipole_int(nBas,nBas,ncart) ! Local variables @@ -54,6 +58,7 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE double precision,allocatable :: eGW(:) double precision,allocatable :: eOld(:) double precision,allocatable :: Z(:) + double precision,allocatable :: SigX(:) double precision,allocatable :: SigC(:) double precision,allocatable :: OmRPA(:) double precision,allocatable :: XpY_RPA(:,:) @@ -117,9 +122,13 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE ! Memory allocation - allocate(eGW(nBas),eOld(nBas),Z(nBas),SigC(nBas),OmRPA(nS),XpY_RPA(nS,nS),XmY_RPA(nS,nS), & + allocate(eGW(nBas),eOld(nBas),Z(nBas),SigX(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)) +! Compute the exchange part of the self-energy + + call self_energy_exchange_diag(nBas,cHF,PHF,ERI_AO,SigX) + ! Initialization nSCF = 0 @@ -142,14 +151,14 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE 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,OmRPA, & + call linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI_MO,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) + call excitation_density(nBas,nC,nO,nR,nS,ERI_MO,XpY_RPA,rho_RPA) ! Compute correlation part of the self-energy @@ -233,7 +242,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,dipole_int,eGW,eGW,EcBSE) + call Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI_MO,dipole_int,eGW,eGW,EcBSE) if(exchange_kernel) then @@ -267,7 +276,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,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,eGW,eGW,EcAC) + call ACFDT(exchange_kernel,doXBS,.true.,TDA_W,TDA,BSE,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI_MO,eGW,eGW,EcAC) write(*,*) write(*,*)'-------------------------------------------------------------------------------' diff --git a/src/MBPT/evUGW.f90 b/src/MBPT/evUGW.f90 index 5379763..7af60b7 100644 --- a/src/MBPT/evUGW.f90 +++ b/src/MBPT/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, & - EUHF,S,ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb,cHF,eHF,eG0W0) + EUHF,S,ERI_AO,ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb,PHF,cHF,eHF,Vxc,eG0W0) ! Perform self-consistent eigenvalue-only GW calculation @@ -37,10 +37,13 @@ subroutine evUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE integer,intent(in) :: nR(nspin) integer,intent(in) :: nS(nspin) + double precision,intent(in) :: PHF(nBas,nBas,nspin) double precision,intent(in) :: eHF(nBas,nspin) double precision,intent(in) :: cHF(nBas,nBas,nspin) + double precision,intent(in) :: Vxc(nBas,nspin) double precision,intent(in) :: eG0W0(nBas,nspin) double precision,intent(in) :: S(nBas,nBas) + double precision,intent(in) :: ERI_AO(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) @@ -67,6 +70,7 @@ subroutine evUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE double precision,allocatable :: eOld(:,:) double precision,allocatable :: Z(:,:) integer :: nS_aa,nS_bb,nS_sc + double precision,allocatable :: SigX(:,:) double precision,allocatable :: SigC(:,:) double precision,allocatable :: OmRPA(:) double precision,allocatable :: XpY_RPA(:,:) @@ -127,8 +131,15 @@ 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),SigX(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)) + +! Compute the exchange part of the self-energy + + do is=1,nspin + call self_energy_exchange_diag(nBas,cHF(:,:,is),PHF(:,:,is),ERI_AO,SigX(:,is)) + end do ! Initialization @@ -182,7 +193,7 @@ subroutine evUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE ! Solve the quasi-particle equation ! !-----------------------------------! - eGW(:,:) = eHF(:,:) + SigC(:,:) + eGW(:,:) = eHF(:,:) + SigX(:,:) + SigC(:,:) - Vxc(:,:) ! Convergence criteria diff --git a/src/MBPT/self_energy_exchange.f90 b/src/MBPT/self_energy_exchange.f90 index 26db034..09653f6 100644 --- a/src/MBPT/self_energy_exchange.f90 +++ b/src/MBPT/self_energy_exchange.f90 @@ -1,4 +1,4 @@ -subroutine self_energy_exchange(nBas,c,P,G,SigmaX) +subroutine self_energy_exchange(nBas,c,P,ERI,SigX) ! Compute exchange part of the self-energy @@ -8,18 +8,18 @@ subroutine self_energy_exchange(nBas,c,P,G,SigmaX) ! Input variables integer,intent(in) :: nBas - double precision,intent(in) :: c(nBas,nBas),P(nBas,nBas),G(nBas,nBas,nBas,nBas) + double precision,intent(in) :: c(nBas,nBas),P(nBas,nBas),ERI(nBas,nBas,nBas,nBas) ! Output variables - double precision,intent(out) :: SigmaX(nBas,nBas) + double precision,intent(out) :: SigX(nBas,nBas) ! Compute exchange part of the self-energy in the AO basis - call exchange_matrix_AO_basis(nBas,P,G,SigmaX) + call exchange_matrix_AO_basis(nBas,P,ERI,SigX) ! Compute exchange part of the self-energy in the MO basis - SigmaX = matmul(transpose(c),matmul(SigmaX,c)) + SigX = matmul(transpose(c),matmul(SigX,c)) end subroutine self_energy_exchange diff --git a/src/MBPT/self_energy_exchange_diag.f90 b/src/MBPT/self_energy_exchange_diag.f90 new file mode 100644 index 0000000..0e305b7 --- /dev/null +++ b/src/MBPT/self_energy_exchange_diag.f90 @@ -0,0 +1,42 @@ +subroutine self_energy_exchange_diag(nBas,c,P,ERI,SigX) + +! Compute the diagonal elements of the exchange part of the self-energy + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nBas + double precision,intent(in) :: c(nBas,nBas) + double precision,intent(in) :: P(nBas,nBas) + double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + +! Local variables + + integer :: q,mu,nu + double precision,allocatable :: Fx(:,:) + +! Output variables + + double precision,intent(out) :: SigX(nBas) + +! Compute exchange part of the self-energy in the AO basis + + allocate(Fx(nBas,nBas)) + call exchange_matrix_AO_basis(nBas,P,ERI,Fx) + +! Compute exchange part of the self-energy in the MO basis + + SigX(:) = 0d0 + do q=1,nBas + do mu=1,nBas + do nu=1,nBas + SigX(q) = SigX(q) + c(mu,q)*Fx(mu,nu)*c(nu,q) + end do + end do + end do + + deallocate(Fx) + +end subroutine self_energy_exchange_diag diff --git a/src/QuAcK/QuAcK.f90 b/src/QuAcK/QuAcK.f90 index c1154f5..ec48069 100644 --- a/src/QuAcK/QuAcK.f90 +++ b/src/QuAcK/QuAcK.f90 @@ -32,6 +32,7 @@ program QuAcK double precision,allocatable :: ZNuc(:),rNuc(:,:) double precision,allocatable :: cHF(:,:,:),eHF(:,:),PHF(:,:,:) + double precision,allocatable :: Vxc(:,:,:) double precision,allocatable :: eG0W0(:,:) double precision,allocatable :: eG0T0(:,:) @@ -236,7 +237,7 @@ program QuAcK 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),X(nBas,nBas),ERI_AO(nBas,nBas,nBas,nBas), & - dipole_int_AO(nBas,nBas,ncart),dipole_int_MO(nBas,nBas,ncart)) + dipole_int_AO(nBas,nBas,ncart),dipole_int_MO(nBas,nBas,ncart),Vxc(nBas,nBas,nspin)) ! Read integrals @@ -280,7 +281,7 @@ program QuAcK call cpu_time(start_HF) call RHF(maxSCF_HF,thresh_HF,n_diis_HF,guess_type,nNuc,ZNuc,rNuc,ENuc, & - nBas,nO,S,T,V,Hc,ERI_AO,dipole_int_AO,X,ERHF,eHF,cHF,PHF) + nBas,nO,S,T,V,Hc,ERI_AO,dipole_int_AO,X,ERHF,eHF,cHF,PHF,Vxc) call cpu_time(end_HF) t_HF = end_HF - start_HF @@ -300,7 +301,7 @@ program QuAcK call cpu_time(start_HF) call UHF(maxSCF_HF,thresh_HF,n_diis_HF,guess_type,mix,nNuc,ZNuc,rNuc,ENuc, & - nBas,nO,S,T,V,Hc,ERI_AO,dipole_int_AO,X,EUHF,eHF,cHF,PHF) + nBas,nO,S,T,V,Hc,ERI_AO,dipole_int_AO,X,EUHF,eHF,cHF,PHF,Vxc) call cpu_time(end_HF) t_HF = end_HF - start_HF @@ -315,10 +316,13 @@ program QuAcK if(doKS) then + ! Switch on the unrestricted flag + unrestricted = .true. + call cpu_time(start_KS) call eDFT(maxSCF_HF,thresh_HF,n_diis_HF,guess_type,mix,nNuc,ZNuc,rNuc,ENuc,nBas,nEl,nC, & nO,nV,nR,nShell,TotAngMomShell,CenterShell,KShell,DShell,ExpShell, & - max_ang_mom,min_exponent,max_exponent,S,T,V,Hc,X,ERI_AO,dipole_int_AO,EUHF,eHF,cHF,PHF) + max_ang_mom,min_exponent,max_exponent,S,T,V,Hc,X,ERI_AO,dipole_int_AO,EUHF,eHF,cHF,PHF,Vxc) call cpu_time(end_KS) @@ -851,12 +855,12 @@ program QuAcK 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,S,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb, & - dipole_int_aa,dipole_int_bb,PHF,cHF,eHF,eG0W0) + linGW,eta_GW,nBas,nC,nO,nV,nR,nS,ENuc,EUHF,S,ERI_AO,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb, & + dipole_int_aa,dipole_int_bb,PHF,cHF,eHF,Vxc,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,ERI_MO,dipole_int_MO,eHF,eG0W0) + linGW,eta_GW,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int_MO,PHF,cHF,eHF,Vxc,eG0W0) end if @@ -879,14 +883,14 @@ 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, & - EUHF,S,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,dipole_int_aa,dipole_int_bb, & - cHF,eHF,eG0W0) + EUHF,S,ERI_AO,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,dipole_int_aa,dipole_int_bb, & + PHF,cHF,eHF,Vxc,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,ERI_MO,dipole_int_MO,eHF,eG0W0) + nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int_MO,PHF,cHF,eHF,Vxc,eG0W0) end if call cpu_time(end_evGW) @@ -1005,10 +1009,10 @@ program QuAcK if(doMCMP2) then call cpu_time(start_MCMP2) - call MCMP2(doDrift,nBas,nC,nO,nV,cHF,eHF,EcMP2, & - nMC,nEq,nWalk,dt,nPrint, & - nShell,CenterShell,TotAngMomShell,KShell,DShell,ExpShell, & - Norm,EcMCMP2,Err_EcMCMP2,Var_EcMCMP2) +! call MCMP2(doDrift,nBas,nC,nO,nV,cHF,eHF,EcMP2, & +! nMC,nEq,nWalk,dt,nPrint, & +! nShell,CenterShell,TotAngMomShell,KShell,DShell,ExpShell, & +! Norm,EcMCMP2,Err_EcMCMP2,Var_EcMCMP2) call cpu_time(end_MCMP2) t_MCMP2 = end_MCMP2 - start_MCMP2 @@ -1040,59 +1044,59 @@ program QuAcK ! Range-separeted GT/GW !------------------------------------------------------------------------ - if(doGTGW) then +! if(doGTGW) then - ! Read and transform long-range two-electron integrals +! ! Read and transform long-range two-electron integrals - allocate(ERI_ERF_AO(nBas,nBas,nBas,nBas),ERI_ERF_MO(nBas,nBas,nBas,nBas)) - call read_LR(nBas,ERI_ERF_AO) +! allocate(ERI_ERF_AO(nBas,nBas,nBas,nBas),ERI_ERF_MO(nBas,nBas,nBas,nBas)) +! call read_LR(nBas,ERI_ERF_AO) - call cpu_time(start_AOtoMO) +! call cpu_time(start_AOtoMO) - write(*,*) - write(*,*) 'AO to MO transformation for long-range ERIs... Please be patient' - write(*,*) +! write(*,*) +! write(*,*) 'AO to MO transformation for long-range ERIs... Please be patient' +! write(*,*) - call AOtoMO_integral_transform(nBas,cHF,ERI_ERF_AO,ERI_ERF_MO) +! call AOtoMO_integral_transform(nBas,cHF,ERI_ERF_AO,ERI_ERF_MO) - call cpu_time(end_AOtoMO) +! call cpu_time(end_AOtoMO) - deallocate(ERI_ERF_AO) +! deallocate(ERI_ERF_AO) - t_AOtoMO = end_AOtoMO - start_AOtoMO +! t_AOtoMO = end_AOtoMO - start_AOtoMO - write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for AO to MO transformation = ',t_AOtoMO,' seconds' - write(*,*) +! write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for AO to MO transformation = ',t_AOtoMO,' seconds' +! write(*,*) - ! Long-range G0W0 calculation +! ! Long-range G0W0 calculation - 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,ERI_ERF_MO,dipole_int_MO,eHF,eG0W0) - call cpu_time(end_G0W0) - - t_G0W0 = end_G0W0 - start_G0W0 - write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for G0W0 = ',t_G0W0,' seconds' - write(*,*) +! 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,ERI_ERF_MO,dipole_int_MO,eHF,eG0W0) +! call cpu_time(end_G0W0) +! +! t_G0W0 = end_G0W0 - start_G0W0 +! write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for G0W0 = ',t_G0W0,' seconds' +! write(*,*) - ! Short-range G0T0 calculation +! ! Short-range G0T0 calculation - ERI_ERF_MO(:,:,:,:) = ERI_MO(:,:,:,:) - ERI_ERF_MO(:,:,:,:) +! ERI_ERF_MO(:,:,:,:) = ERI_MO(:,:,:,:) - ERI_ERF_MO(:,:,:,:) - 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,dipole_int_MO,eHF,eG0T0) - call cpu_time(end_G0T0) - - t_G0T0 = end_G0T0 - start_G0T0 - write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for G0T0 = ',t_G0T0,' seconds' - write(*,*) +! 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,dipole_int_MO,eHF,eG0T0) +! call cpu_time(end_G0T0) +! +! t_G0T0 = end_G0T0 - start_G0T0 +! write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for G0T0 = ',t_G0T0,' seconds' +! write(*,*) ! call matout(nBas,1,(eG0W0+eG0T0-eHF(:,1))*HaToeV) - end if +! end if !------------------------------------------------------------------------ ! Basis set correction diff --git a/src/eDFT/RB88_gga_exchange_energy.f90 b/src/eDFT/RB88_gga_exchange_energy.f90 index 04c87f6..596710d 100644 --- a/src/eDFT/RB88_gga_exchange_energy.f90 +++ b/src/eDFT/RB88_gga_exchange_energy.f90 @@ -16,7 +16,6 @@ subroutine RB88_gga_exchange_energy(nGrid,weight,rho,drho,Ex) ! Local variables integer :: iG - double precision :: alpha double precision :: beta double precision :: r,g,x @@ -26,7 +25,6 @@ subroutine RB88_gga_exchange_energy(nGrid,weight,rho,drho,Ex) ! Coefficients for B88 GGA exchange functional - alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) beta = 0.0042d0 ! Compute GGA exchange energy @@ -41,7 +39,7 @@ subroutine RB88_gga_exchange_energy(nGrid,weight,rho,drho,Ex) g = 0.25d0*(drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2) x = sqrt(g)/r**(4d0/3d0) - Ex = Ex + weight(iG)*alpha*r**(4d0/3d0) & + Ex = Ex + weight(iG)*CxLDA*r**(4d0/3d0) & - weight(iG)*beta*x**2*r**(4d0/3d0)/(1d0 + 6d0*beta*x*asinh(x)) end if diff --git a/src/eDFT/RB88_gga_exchange_individual_energy.f90 b/src/eDFT/RB88_gga_exchange_individual_energy.f90 index 23c05bb..56c64bf 100644 --- a/src/eDFT/RB88_gga_exchange_individual_energy.f90 +++ b/src/eDFT/RB88_gga_exchange_individual_energy.f90 @@ -17,7 +17,6 @@ subroutine RB88_gga_exchange_individual_energy(nGrid,weight,rhow,drhow,rho,drho, ! Local variables integer :: iG - double precision :: alpha double precision :: beta double precision :: r,rI,g,x double precision :: ex_p,dexdr_p @@ -28,7 +27,6 @@ subroutine RB88_gga_exchange_individual_energy(nGrid,weight,rhow,drhow,rho,drho, ! Coefficients for B88 GGA exchange functional - alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) beta = 0.0042d0 ! Compute GGA exchange matrix in the AO basis @@ -45,11 +43,11 @@ subroutine RB88_gga_exchange_individual_energy(nGrid,weight,rhow,drhow,rho,drho, g = 0.25d0*(drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2) x = sqrt(g)/r**(4d0/3d0) - dexdr_p = 4d0/3d0*r**(1d0/3d0)*(alpha - beta*g**(3d0/4d0)/r**2) & + dexdr_p = 4d0/3d0*r**(1d0/3d0)*(CxLDA - beta*g**(3d0/4d0)/r**2) & + 2d0*beta*g**(3d0/4d0)/r**(5d0/3d0) & - 2d0*3d0/4d0*beta*g**(-1d0/4d0)/r**(2d0/3d0) - ex_p = alpha*r**(4d0/3d0) & + ex_p = CxLDA*r**(4d0/3d0) & - weight(iG)*beta*x**2*r**(4d0/3d0)/(1d0 + 6d0*beta*x*asinh(x)) Ex = Ex + weight(iG)*(ex_p*rI + dexdr_p*r*rI - dexdr_p*r*r) diff --git a/src/eDFT/RB88_gga_exchange_potential.f90 b/src/eDFT/RB88_gga_exchange_potential.f90 index 1dca23b..6829644 100644 --- a/src/eDFT/RB88_gga_exchange_potential.f90 +++ b/src/eDFT/RB88_gga_exchange_potential.f90 @@ -18,7 +18,6 @@ subroutine RB88_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx) ! Local variables integer :: mu,nu,iG - double precision :: alpha double precision :: beta double precision :: r,g,vAO,gAO @@ -28,7 +27,6 @@ subroutine RB88_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx) ! Coefficients for B88 GGA exchange functional - alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) beta = 0.0042d0 ! Compute GGA exchange matrix in the AO basis @@ -46,7 +44,7 @@ subroutine RB88_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx) g = 0.25d0*(drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2) vAO = weight(iG)*AO(mu,iG)*AO(nu,iG) Fx(mu,nu) = Fx(mu,nu) & - + vAO*(4d0/3d0*r**(1d0/3d0)*(alpha - beta*g**(3d0/4d0)/r**2) & + + vAO*(4d0/3d0*r**(1d0/3d0)*(CxLDA - beta*g**(3d0/4d0)/r**2) & + 2d0*beta*g**(3d0/4d0)/r**(5d0/3d0)) gAO = drho(1,iG)*(dAO(1,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(1,nu,iG)) & diff --git a/src/eDFT/RCC_lda_exchange_derivative_discontinuity.f90 b/src/eDFT/RCC_lda_exchange_derivative_discontinuity.f90 index 235407a..14d1083 100644 --- a/src/eDFT/RCC_lda_exchange_derivative_discontinuity.f90 +++ b/src/eDFT/RCC_lda_exchange_derivative_discontinuity.f90 @@ -84,12 +84,16 @@ subroutine RCC_lda_exchange_derivative_discontinuity(nEns,wEns,aCC_w1,aCC_w2,nGr dCxdw2 = (1d0 - w1*(1d0 - w1)*(a1 + b1*(w1 - 0.5d0) + c1*(w1 - 0.5d0)**2)) & * (0.5d0*b2 + (2d0*a2 + 0.5d0*c2)*(w2 - 0.5d0) - (1d0 - w2)*w2*(3d0*b2 + 4d0*c2*(w2 - 0.5d0))) + + case default + dCxdw1 = 0.d0 + dCxdw2 = 0.d0 + end select dCxdw1 = CxLDA*dCxdw1 dCxdw2 = CxLDA*dCxdw2 - dExdw(:) = 0d0 do iG=1,nGrid diff --git a/src/eDFT/RCC_lda_exchange_energy.f90 b/src/eDFT/RCC_lda_exchange_energy.f90 index 8fa5c6c..5f55d95 100644 --- a/src/eDFT/RCC_lda_exchange_energy.f90 +++ b/src/eDFT/RCC_lda_exchange_energy.f90 @@ -69,12 +69,19 @@ subroutine RCC_lda_exchange_energy(nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,rho,Ex,C Fx2 = 1d0 - w2*(1d0 - w2)*(a2 + b2*(w2 - 0.5d0) + c2*(w2 - 0.5d0)**2) select case (Cx_choice) - case(1) - Cx = CxLDA*Fx1 - case(2) - Cx = CxLDA*Fx2 - case(3) - Cx = CxLDA*Fx2*Fx1 + + case(1) + Cx = CxLDA*Fx1 + + case(2) + Cx = CxLDA*Fx2 + + case(3) + Cx = CxLDA*Fx2*Fx1 + + case default + Cx = CxLDA + end select ! Compute GIC-LDA exchange energy diff --git a/src/eDFT/RCC_lda_exchange_individual_energy.f90 b/src/eDFT/RCC_lda_exchange_individual_energy.f90 index 02f23f8..ade4f56 100644 --- a/src/eDFT/RCC_lda_exchange_individual_energy.f90 +++ b/src/eDFT/RCC_lda_exchange_individual_energy.f90 @@ -75,12 +75,19 @@ subroutine RCC_lda_exchange_individual_energy(nEns,wEns,aCC_w1,aCC_w2,nGrid,weig Fx2 = 1d0 - w2*(1d0 - w2)*(a2 + b2*(w2 - 0.5d0) + c2*(w2 - 0.5d0)**2) select case (Cx_choice) - case(1) - Cx = CxLDA*Fx1 - case(2) - Cx = CxLDA*Fx2 - case(3) - Cx = CxLDA*Fx2*Fx1 + + case(1) + Cx = CxLDA*Fx1 + + case(2) + Cx = CxLDA*Fx2 + + case(3) + Cx = CxLDA*Fx2*Fx1 + + case default + Cx = CxLDA + end select ! Compute LDA exchange matrix in the AO basis diff --git a/src/eDFT/RCC_lda_exchange_potential.f90 b/src/eDFT/RCC_lda_exchange_potential.f90 index d33017b..519dfa9 100644 --- a/src/eDFT/RCC_lda_exchange_potential.f90 +++ b/src/eDFT/RCC_lda_exchange_potential.f90 @@ -74,12 +74,19 @@ subroutine RCC_lda_exchange_potential(nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,nBas, Fx2 = 1d0 - w2*(1d0 - w2)*(a2 + b2*(w2 - 0.5d0) + c2*(w2 - 0.5d0)**2) select case (Cx_choice) - case(1) - Cx = CxLDA*Fx1 - case(2) - Cx = CxLDA*Fx2 - case(3) - Cx = CxLDA*Fx2*Fx1 + + case(1) + Cx = CxLDA*Fx1 + + case(2) + Cx = CxLDA*Fx2 + + case(3) + Cx = CxLDA*Fx2*Fx1 + + case default + Cx = CxLDA + end select diff --git a/src/eDFT/RMFL20_lda_exchange_derivative_discontinuity.f90 b/src/eDFT/RMFL20_lda_exchange_derivative_discontinuity.f90 index 15e1c3b..d3620c8 100644 --- a/src/eDFT/RMFL20_lda_exchange_derivative_discontinuity.f90 +++ b/src/eDFT/RMFL20_lda_exchange_derivative_discontinuity.f90 @@ -21,6 +21,9 @@ subroutine RMFL20_lda_exchange_derivative_discontinuity(nEns,wEns,nGrid,weight,r double precision :: dExdw(nEns) double precision,external :: Kronecker_delta + double precision,parameter :: Cx0 = - (4d0/3d0)*(1d0/pi)**(1d0/3d0) + double precision,parameter :: Cx1 = - (176d0/105d0)*(1d0/pi)**(1d0/3d0) + ! Output variables double precision,intent(out) :: ExDD(nEns) diff --git a/src/eDFT/RMFL20_lda_exchange_energy.f90 b/src/eDFT/RMFL20_lda_exchange_energy.f90 index c9ca09f..3d50004 100644 --- a/src/eDFT/RMFL20_lda_exchange_energy.f90 +++ b/src/eDFT/RMFL20_lda_exchange_energy.f90 @@ -15,6 +15,9 @@ subroutine RMFL20_lda_exchange_energy(LDA_centered,nEns,wEns,nGrid,weight,rho,Ex double precision,intent(in) :: weight(nGrid) double precision,intent(in) :: rho(nGrid) + double precision,parameter :: Cx0 = - (4d0/3d0)*(1d0/pi)**(1d0/3d0) + double precision,parameter :: Cx1 = - (176d0/105d0)*(1d0/pi)**(1d0/3d0) + ! Local variables integer :: iG diff --git a/src/eDFT/RMFL20_lda_exchange_individual_energy.f90 b/src/eDFT/RMFL20_lda_exchange_individual_energy.f90 index 75176b0..49a1299 100644 --- a/src/eDFT/RMFL20_lda_exchange_individual_energy.f90 +++ b/src/eDFT/RMFL20_lda_exchange_individual_energy.f90 @@ -22,6 +22,9 @@ subroutine RMFL20_lda_exchange_individual_energy(LDA_centered,nEns,wEns,nGrid,we double precision :: r,rI double precision :: e_p,dedr + double precision,parameter :: Cx0 = - (4d0/3d0)*(1d0/pi)**(1d0/3d0) + double precision,parameter :: Cx1 = - (176d0/105d0)*(1d0/pi)**(1d0/3d0) + ! Output variables double precision,intent(out) :: Ex diff --git a/src/eDFT/RMFL20_lda_exchange_potential.f90 b/src/eDFT/RMFL20_lda_exchange_potential.f90 index ce6cfca..4d0ca82 100644 --- a/src/eDFT/RMFL20_lda_exchange_potential.f90 +++ b/src/eDFT/RMFL20_lda_exchange_potential.f90 @@ -22,6 +22,9 @@ subroutine RMFL20_lda_exchange_potential(LDA_centered,nEns,wEns,nGrid,weight,nBa double precision :: Cxw double precision :: r,vAO + double precision,parameter :: Cx0 = - (4d0/3d0)*(1d0/pi)**(1d0/3d0) + double precision,parameter :: Cx1 = - (176d0/105d0)*(1d0/pi)**(1d0/3d0) + ! Output variables double precision,intent(out) :: Fx(nBas,nBas) diff --git a/src/eDFT/UB88_gga_exchange_energy.f90 b/src/eDFT/UB88_gga_exchange_energy.f90 index e049b78..2ecf64d 100644 --- a/src/eDFT/UB88_gga_exchange_energy.f90 +++ b/src/eDFT/UB88_gga_exchange_energy.f90 @@ -16,7 +16,7 @@ subroutine UB88_gga_exchange_energy(nGrid,weight,rho,drho,Ex) ! Local variables integer :: iG - double precision :: alpha,b + double precision :: b double precision :: r,g,x ! Output variables @@ -25,7 +25,6 @@ subroutine UB88_gga_exchange_energy(nGrid,weight,rho,drho,Ex) ! Coefficients for B88 GGA exchange functional - alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) b = 0.0042d0 ! Compute GGA exchange energy @@ -40,7 +39,7 @@ subroutine UB88_gga_exchange_energy(nGrid,weight,rho,drho,Ex) g = drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2 x = sqrt(g)/r**(4d0/3d0) - Ex = Ex + weight(iG)*r**(4d0/3d0)*(alpha - b*x**2/(1d0 + 6d0*b*x*asinh(x))) + Ex = Ex + weight(iG)*r**(4d0/3d0)*(CxLSDA - b*x**2/(1d0 + 6d0*b*x*asinh(x))) end if diff --git a/src/eDFT/UB88_gga_exchange_potential.f90 b/src/eDFT/UB88_gga_exchange_potential.f90 index b8f38f6..fcec63c 100644 --- a/src/eDFT/UB88_gga_exchange_potential.f90 +++ b/src/eDFT/UB88_gga_exchange_potential.f90 @@ -18,7 +18,7 @@ subroutine UB88_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx) ! Local variables integer :: mu,nu,iG - double precision :: alpha,b + double precision :: b double precision :: vAO,gAO double precision :: r,g,x,dxdr,dxdg,f @@ -28,7 +28,6 @@ subroutine UB88_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx) ! Coefficients for B88 GGA exchange functional - alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) b = 0.0042d0 ! Compute GGA exchange matrix in the AO basis @@ -52,9 +51,9 @@ subroutine UB88_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx) f = b*x**2/(1d0 + 6d0*b*x*asinh(x)) - Fx(mu,nu) = Fx(mu,nu) + vAO*( & - 4d0/3d0*r**(1d0/3d0)*(alpha - f) & - - 2d0*r**(4d0/3d0)*dxdr*f & + Fx(mu,nu) = Fx(mu,nu) + vAO*( & + 4d0/3d0*r**(1d0/3d0)*(CxLSDA - f) & + - 2d0*r**(4d0/3d0)*dxdr*f & + r**(4d0/3d0)*dxdr*(6d0*b*x*asinh(x) + 6d0*b*x**2/sqrt(1d0+x**2))*f/(1d0 + 6d0*b*x*asinh(x)) ) gAO = drho(1,iG)*(dAO(1,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(1,nu,iG)) & diff --git a/src/eDFT/UCC_lda_exchange_derivative_discontinuity.f90 b/src/eDFT/UCC_lda_exchange_derivative_discontinuity.f90 index 660e98b..dbe7cca 100644 --- a/src/eDFT/UCC_lda_exchange_derivative_discontinuity.f90 +++ b/src/eDFT/UCC_lda_exchange_derivative_discontinuity.f90 @@ -22,7 +22,7 @@ subroutine UCC_lda_exchange_derivative_discontinuity(nEns,wEns,aCC_w1,aCC_w2,nGr integer :: iEns,jEns integer :: iG - double precision :: r,alpha + double precision :: r double precision,allocatable :: dExdw(:) double precision,external :: Kronecker_delta @@ -30,9 +30,6 @@ subroutine UCC_lda_exchange_derivative_discontinuity(nEns,wEns,aCC_w1,aCC_w2,nGr double precision :: a2,b2,c2,w2 double precision :: dCxdw1,dCxdw2 - double precision :: nEli,nElw - - ! Output variables double precision,intent(out) :: ExDD(nEns) @@ -60,13 +57,6 @@ subroutine UCC_lda_exchange_derivative_discontinuity(nEns,wEns,aCC_w1,aCC_w2,nGr b2 = aCC_w2(2) c2 = aCC_w2(3) - nElw = electron_number(nGrid,weight,rhow) - - -! Cx coefficient for unrestricted Slater LDA exchange - - alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) - w1 = wEns(2) w2 = wEns(3) @@ -86,11 +76,15 @@ subroutine UCC_lda_exchange_derivative_discontinuity(nEns,wEns,aCC_w1,aCC_w2,nGr dCxdw2 = (1d0 - w1*(1d0 - w1)*(a1 + b1*(w1 - 0.5d0) + c1*(w1 - 0.5d0)**2)) & * (0.5d0*b2 + (2d0*a2 + 0.5d0*c2)*(w2 - 0.5d0) - (1d0 - w2)*w2*(3d0*b2 + 4d0*c2*(w2 - 0.5d0))) + + case default + dCxdw1 = 0d0 + dCxdw2 = 0d0 + end select - - dCxdw1 = alpha*dCxdw1 - dCxdw2 = alpha*dCxdw2 + dCxdw1 = CxLSDA*dCxdw1 + dCxdw2 = CxLSDA*dCxdw2 dExdw(:) = 0d0 diff --git a/src/eDFT/UCC_lda_exchange_energy.f90 b/src/eDFT/UCC_lda_exchange_energy.f90 index b3fcbaf..0964c15 100644 --- a/src/eDFT/UCC_lda_exchange_energy.f90 +++ b/src/eDFT/UCC_lda_exchange_energy.f90 @@ -19,7 +19,7 @@ subroutine UCC_lda_exchange_energy(nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,rho,Ex,C ! Local variables integer :: iG - double precision :: r,alpha + double precision :: r double precision :: a1,b1,c1,w1 double precision :: a2,b2,c2,w2 @@ -65,10 +65,6 @@ subroutine UCC_lda_exchange_energy(nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,rho,Ex,C b2 = aCC_w2(2) c2 = aCC_w2(3) -! Cx coefficient for unrestricted Slater LDA exchange - - alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) - ! Fx1 for states N and N-1 ! Fx2 for states N and N+1 @@ -79,21 +75,20 @@ subroutine UCC_lda_exchange_energy(nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,rho,Ex,C Fx2 = 1d0 - w2*(1d0 - w2)*(a2 + b2*(w2 - 0.5d0) + c2*(w2 - 0.5d0)**2) select case (Cx_choice) - case(1) - Cx = alpha*Fx1 - case(2) - Cx = alpha*Fx2 - case(3) - Cx = alpha*Fx2*Fx1 + + case(1) + Cx = CxLSDA*Fx1 + + case(2) + Cx = CxLSDA*Fx2 + + case(3) + Cx = CxLSDA*Fx2*Fx1 + + case default + Cx = CxLSDA + end select -! for two-weights ensemble -! Cx = alpha*Fx2*Fx1 - -! for left ensemble -! Cx = alpha*Fx1 - -! for right ensemble -! Cx = alpha*Fx2 ! Compute GIC-LDA exchange energy diff --git a/src/eDFT/UCC_lda_exchange_individual_energy.f90 b/src/eDFT/UCC_lda_exchange_individual_energy.f90 index 98072ca..a0a0df3 100644 --- a/src/eDFT/UCC_lda_exchange_individual_energy.f90 +++ b/src/eDFT/UCC_lda_exchange_individual_energy.f90 @@ -22,9 +22,8 @@ subroutine UCC_lda_exchange_individual_energy(nEns,wEns,aCC_w1,aCC_w2,nGrid,weig ! Local variables integer :: iG - double precision :: r,rI,alpha + double precision :: r,rI double precision :: e_p,dedr - double precision :: nEli,nElw double precision :: a1,b1,c1,w1 double precision :: a2,b2,c2,w2 @@ -51,10 +50,6 @@ subroutine UCC_lda_exchange_individual_energy(nEns,wEns,aCC_w1,aCC_w2,nGrid,weig b2 = aCC_w2(2) c2 = aCC_w2(3) -! Cx coefficient for unrestricted Slater LDA exchange - - alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) - w1 = wEns(2) Fx1 = 1d0 - w1*(1d0 - w1)*(a1 + b1*(w1 - 0.5d0) + c1*(w1 - 0.5d0)**2) @@ -64,21 +59,19 @@ subroutine UCC_lda_exchange_individual_energy(nEns,wEns,aCC_w1,aCC_w2,nGrid,weig select case (Cx_choice) case(1) - Cx = alpha*Fx1 + Cx = CxLSDA*Fx1 case(2) - Cx = alpha*Fx2 + Cx = CxLSDA*Fx2 case(3) - Cx = alpha*Fx2*Fx1 + Cx = CxLSDA*Fx2*Fx1 + + case default + Cx = CxLSDA end select - nEli = electron_number(nGrid,weight,rho) - - nElw = electron_number(nGrid,weight,rhow) - - ! Compute LDA exchange matrix in the AO basis Ex = 0d0 @@ -92,19 +85,12 @@ subroutine UCC_lda_exchange_individual_energy(nEns,wEns,aCC_w1,aCC_w2,nGrid,weig e_p = Cx*r**(1d0/3d0) dedr = 1d0/3d0*Cx*r**(-2d0/3d0) - if (doNcentered) then - Ex = Ex - weight(iG)*dedr*r*r*(nEli/nElw) - else - Ex = Ex - weight(iG)*dedr*r*r - end if + Ex = Ex - weight(iG)*dedr*r*r if(rI > threshold) then - if (doNcentered) then - Ex = Ex + weight(iG)*(e_p*rI + dedr*r*rI) - else - Ex = Ex + weight(iG)*((nEli/nElw)*e_p*rI + dedr*r*rI) - end if + Ex = Ex + weight(iG)*(e_p*rI + dedr*r*rI) + endif endif diff --git a/src/eDFT/UCC_lda_exchange_potential.f90 b/src/eDFT/UCC_lda_exchange_potential.f90 index dc14909..ecb027f 100644 --- a/src/eDFT/UCC_lda_exchange_potential.f90 +++ b/src/eDFT/UCC_lda_exchange_potential.f90 @@ -21,7 +21,7 @@ subroutine UCC_lda_exchange_potential(nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,nBas, ! Local variables integer :: mu,nu,iG - double precision :: r,vAO,alpha + double precision :: r,vAO double precision :: a1,b1,c1,w1 double precision :: a2,b2,c2,w2 @@ -67,10 +67,6 @@ subroutine UCC_lda_exchange_potential(nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,nBas, b2 = aCC_w2(2) c2 = aCC_w2(3) -! Cx coefficient for unrestricted Slater LDA exchange - - alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) - ! Fx1 for states N and N-1 ! Fx2 for states N and N+1 @@ -81,23 +77,21 @@ subroutine UCC_lda_exchange_potential(nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,nBas, Fx2 = 1d0 - w2*(1d0 - w2)*(a2 + b2*(w2 - 0.5d0) + c2*(w2 - 0.5d0)**2) select case (Cx_choice) - case(1) - Cx = alpha*Fx1 - case(2) - Cx = alpha*Fx2 - case(3) - Cx = alpha*Fx2*Fx1 + + case(1) + Cx = CxLSDA*Fx1 + + case(2) + Cx = CxLSDA*Fx2 + + case(3) + Cx = CxLSDA*Fx2*Fx1 + + case default + Cx = CxLSDA + end select -! for two-weight ensembles -! Cx = alpha*Fx2*Fx1 - -! for left ensemble -! Cx = alpha*Fx1 - -! for right ensemble -! Cx = alpha*Fx2 - ! Compute LDA exchange matrix in the AO basis Fx(:,:) = 0d0 diff --git a/src/eDFT/UG96_gga_exchange_energy.f90 b/src/eDFT/UG96_gga_exchange_energy.f90 index 1876cc5..f09d2a7 100644 --- a/src/eDFT/UG96_gga_exchange_energy.f90 +++ b/src/eDFT/UG96_gga_exchange_energy.f90 @@ -16,7 +16,7 @@ subroutine UG96_gga_exchange_energy(nGrid,weight,rho,drho,Ex) ! Local variables integer :: iG - double precision :: alpha,beta + double precision :: beta double precision :: r,g ! Output variables @@ -25,7 +25,6 @@ subroutine UG96_gga_exchange_energy(nGrid,weight,rho,drho,Ex) ! Coefficients for G96 GGA exchange functional - alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) beta = 1d0/137d0 ! Compute GGA exchange energy @@ -40,7 +39,7 @@ subroutine UG96_gga_exchange_energy(nGrid,weight,rho,drho,Ex) g = drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2 - Ex = Ex + weight(iG)*r**(4d0/3d0)*(alpha - beta*g**(3d0/4d0)/r**2) + Ex = Ex + weight(iG)*r**(4d0/3d0)*(CxLSDA - beta*g**(3d0/4d0)/r**2) end if diff --git a/src/eDFT/UG96_gga_exchange_potential.f90 b/src/eDFT/UG96_gga_exchange_potential.f90 index c8d9b40..4b28a3c 100644 --- a/src/eDFT/UG96_gga_exchange_potential.f90 +++ b/src/eDFT/UG96_gga_exchange_potential.f90 @@ -18,7 +18,7 @@ subroutine UG96_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx) ! Local variables integer :: mu,nu,iG - double precision :: alpha,beta + double precision :: beta double precision :: r,g,vAO,gAO ! Output variables @@ -27,7 +27,6 @@ subroutine UG96_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx) ! Coefficients for G96 GGA exchange functional - alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) beta = +1d0/137d0 ! Compute GGA exchange matrix in the AO basis @@ -45,7 +44,7 @@ subroutine UG96_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx) vAO = weight(iG)*AO(mu,iG)*AO(nu,iG) Fx(mu,nu) = Fx(mu,nu) & - + vAO*(4d0/3d0*r**(1d0/3d0)*(alpha - beta*g**(3d0/4d0)/r**2) & + + vAO*(4d0/3d0*r**(1d0/3d0)*(CxLSDA - beta*g**(3d0/4d0)/r**2) & + 2d0*beta*g**(3d0/4d0)/r**(5d0/3d0)) gAO = drho(1,iG)*(dAO(1,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(1,nu,iG)) & diff --git a/src/eDFT/UPBE_gga_exchange_energy.f90 b/src/eDFT/UPBE_gga_exchange_energy.f90 index d06f537..0cc35bd 100644 --- a/src/eDFT/UPBE_gga_exchange_energy.f90 +++ b/src/eDFT/UPBE_gga_exchange_energy.f90 @@ -16,7 +16,7 @@ subroutine UPBE_gga_exchange_energy(nGrid,weight,rho,drho,Ex) ! Local variables integer :: iG - double precision :: alpha,mupbe,kappa + double precision :: mupbe,kappa double precision :: r,g,s2 ! Output variables @@ -25,7 +25,6 @@ subroutine UPBE_gga_exchange_energy(nGrid,weight,rho,drho,Ex) ! Coefficients for PBE exchange functional - alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) mupbe = ((1d0/2d0**(1d0/3d0))/(2d0*(3d0*pi**2)**(1d0/3d0)))**2*0.21951d0 kappa = 0.804d0 @@ -41,7 +40,7 @@ subroutine UPBE_gga_exchange_energy(nGrid,weight,rho,drho,Ex) g = drho(1,iG)**2 + drho(2,iG)**2 + drho(3,iG)**2 s2 = g/r**(8d0/3d0) - Ex = Ex + weight(iG)*alpha*r**(4d0/3d0)*(1d0 + kappa - kappa/(1d0 + mupbe*s2/kappa)) + Ex = Ex + weight(iG)*CxLSDA*r**(4d0/3d0)*(1d0 + kappa - kappa/(1d0 + mupbe*s2/kappa)) end if diff --git a/src/eDFT/UPBE_gga_exchange_potential.f90 b/src/eDFT/UPBE_gga_exchange_potential.f90 index 245eb66..866b90a 100644 --- a/src/eDFT/UPBE_gga_exchange_potential.f90 +++ b/src/eDFT/UPBE_gga_exchange_potential.f90 @@ -18,7 +18,7 @@ subroutine UPBE_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx) ! Local variables integer :: mu,nu,iG - double precision :: alpha,mupbe,kappa + double precision :: mupbe,kappa double precision :: r,g,s2,vAO,gAO ! Output variables @@ -27,7 +27,6 @@ subroutine UPBE_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx) ! Coefficients for PBE exchange functional - alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) mupbe = ((1d0/2d0**(1d0/3d0))/(2d0*(3d0*pi**2)**(1d0/3d0)))**2*0.21951d0 kappa = 0.804d0 @@ -49,15 +48,15 @@ subroutine UPBE_gga_exchange_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fx) vAO = weight(iG)*AO(mu,iG)*AO(nu,iG) Fx(mu,nu) = Fx(mu,nu) & - + vAO*4d0/3d0*alpha*r**(1d0/3d0)*(1d0 + kappa - kappa/(1d0 + mupbe*s2/kappa)) & - - vAO*8d0/3d0*alpha*r**(1d0/3d0)*mupbe*s2/(1d0 + mupbe*s2/kappa)**2 + + vAO*4d0/3d0*CxLSDA*r**(1d0/3d0)*(1d0 + kappa - kappa/(1d0 + mupbe*s2/kappa)) & + - vAO*8d0/3d0*CxLSDA*r**(1d0/3d0)*mupbe*s2/(1d0 + mupbe*s2/kappa)**2 gAO = drho(1,iG)*(dAO(1,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(1,nu,iG)) & + drho(2,iG)*(dAO(2,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(2,nu,iG)) & + drho(3,iG)*(dAO(3,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(3,nu,iG)) gAO = weight(iG)*gAO - Fx(mu,nu) = Fx(mu,nu) + 2d0*gAO*alpha*r**(-4d0/3d0)*mupbe/(1d0 + mupbe*s2/kappa)**2 + Fx(mu,nu) = Fx(mu,nu) + 2d0*gAO*CxLSDA*r**(-4d0/3d0)*mupbe/(1d0 + mupbe*s2/kappa)**2 end if diff --git a/src/eDFT/US51_lda_exchange_energy.f90 b/src/eDFT/US51_lda_exchange_energy.f90 index c0b8702..fbaaad9 100644 --- a/src/eDFT/US51_lda_exchange_energy.f90 +++ b/src/eDFT/US51_lda_exchange_energy.f90 @@ -16,16 +16,12 @@ subroutine US51_lda_exchange_energy(nGrid,weight,rho,Ex) ! Local variables integer :: iG - double precision :: alpha,r,alphaw,a2,b2,c2,a1,b1,c1 + double precision :: r ! Output variables double precision :: Ex -! Cx coefficient for Slater LDA exchange - - alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) - ! Compute LDA exchange energy Ex = 0d0 @@ -35,7 +31,7 @@ subroutine US51_lda_exchange_energy(nGrid,weight,rho,Ex) if(r > threshold) then - Ex = Ex + weight(iG)*alpha*r**(4d0/3d0) + Ex = Ex + weight(iG)*CxLSDA*r**(4d0/3d0) endif diff --git a/src/eDFT/US51_lda_exchange_individual_energy.f90 b/src/eDFT/US51_lda_exchange_individual_energy.f90 index 36a8acf..f1541a5 100644 --- a/src/eDFT/US51_lda_exchange_individual_energy.f90 +++ b/src/eDFT/US51_lda_exchange_individual_energy.f90 @@ -17,7 +17,7 @@ subroutine US51_lda_exchange_individual_energy(nGrid,weight,rhow,rho,doNcentered ! Local variables integer :: iG - double precision :: r,rI,alpha + double precision :: r,rI double precision :: e,dedr double precision :: Exrr,ExrI,ExrrI @@ -27,8 +27,6 @@ subroutine US51_lda_exchange_individual_energy(nGrid,weight,rhow,rho,doNcentered ! Compute LDA exchange matrix in the AO basis - alpha = - (3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) - Exrr = 0d0 ExrI = 0d0 ExrrI = 0d0 @@ -40,8 +38,8 @@ subroutine US51_lda_exchange_individual_energy(nGrid,weight,rhow,rho,doNcentered if(r > threshold) then - e = alpha*r**(1d0/3d0) - dedr = 1d0/3d0*alpha*r**(-2d0/3d0) + e = CxLSDA*r**(1d0/3d0) + dedr = 1d0/3d0*CxLSDA*r**(-2d0/3d0) Exrr = Exrr - weight(iG)*dedr*r*r diff --git a/src/eDFT/US51_lda_exchange_potential.f90 b/src/eDFT/US51_lda_exchange_potential.f90 index 4066379..9c2bc0d 100644 --- a/src/eDFT/US51_lda_exchange_potential.f90 +++ b/src/eDFT/US51_lda_exchange_potential.f90 @@ -16,17 +16,12 @@ subroutine US51_lda_exchange_potential(nGrid,weight,nBas,AO,rho,Fx) ! Local variables integer :: mu,nu,iG - double precision :: alpha double precision :: r,vAO ! Output variables double precision,intent(out) :: Fx(nBas,nBas) -! Cx coefficient for Slater LDA exchange - - alpha = -(3d0/2d0)*(3d0/(4d0*pi))**(1d0/3d0) - ! Compute LDA exchange matrix in the AO basis Fx(:,:) = 0d0 @@ -39,7 +34,7 @@ subroutine US51_lda_exchange_potential(nGrid,weight,nBas,AO,rho,Fx) if(r > threshold) then vAO = weight(iG)*AO(mu,iG)*AO(nu,iG) - Fx(mu,nu) = Fx(mu,nu) + vAO*4d0/3d0*alpha*r**(1d0/3d0) + Fx(mu,nu) = Fx(mu,nu) + vAO*4d0/3d0*CxLSDA*r**(1d0/3d0) endif diff --git a/src/eDFT/UVWN5_lda_correlation_individual_energy.f90 b/src/eDFT/UVWN5_lda_correlation_individual_energy.f90 index beb8031..d856c41 100644 --- a/src/eDFT/UVWN5_lda_correlation_individual_energy.f90 +++ b/src/eDFT/UVWN5_lda_correlation_individual_energy.f90 @@ -88,7 +88,7 @@ subroutine UVWN5_lda_correlation_individual_energy(nGrid,weight,rhow,rho,Ec) decdra_f = drsdra*dxdrs*decdx_f - Ec(1) = Ec(1) + weight(iG)*(ec_z + decdra_f*r)*rI + Ec(1) = Ec(1) + weight(iG)*(ec_f + decdra_f*r)*rI end if @@ -191,7 +191,7 @@ subroutine UVWN5_lda_correlation_individual_energy(nGrid,weight,rhow,rho,Ec) decdra_f = drsdra*dxdrs*decdx_f - Ec(3) = Ec(3) + weight(iG)*(ec_z + decdra_f*r)*rI + Ec(3) = Ec(3) + weight(iG)*(ec_f + decdra_f*r)*rI end if diff --git a/src/eDFT/eDFT.f90 b/src/eDFT/eDFT.f90 index 2f9ec5a..bbfbed6 100644 --- a/src/eDFT/eDFT.f90 +++ b/src/eDFT/eDFT.f90 @@ -1,6 +1,6 @@ subroutine eDFT(maxSCF,thresh,max_diis,guess_type,mix,nNuc,ZNuc,rNuc,ENuc,nBas,nEl,nC,nO,nV,nR, & nShell,TotAngMomShell,CenterShell,KShell,DShell,ExpShell, & - max_ang_mom,min_exponent,max_exponent,S,T,V,Hc,X,ERI,dipole_int,Ew,eKS,cKS,PKS) + max_ang_mom,min_exponent,max_exponent,S,T,V,Hc,X,ERI,dipole_int,Ew,eKS,cKS,PKS,Vxc) ! exchange-correlation density-functional theory calculations @@ -50,8 +50,6 @@ subroutine eDFT(maxSCF,thresh,max_diis,guess_type,mix,nNuc,ZNuc,rNuc,ENuc,nBas,n ! Local variables - double precision,allocatable :: c(:,:) - character(len=8) :: method integer :: x_rung,c_rung character(len=12) :: x_DFA ,c_DFA @@ -88,6 +86,7 @@ subroutine eDFT(maxSCF,thresh,max_diis,guess_type,mix,nNuc,ZNuc,rNuc,ENuc,nBas,n double precision,intent(out) :: eKS(nBas,nspin) double precision,intent(out) :: cKS(nBas,nBas,nspin) double precision,intent(out) :: PKS(nBas,nBas,nspin) + double precision,intent(out) :: Vxc(nBas,nspin) ! Hello World @@ -111,7 +110,7 @@ subroutine eDFT(maxSCF,thresh,max_diis,guess_type,mix,nNuc,ZNuc,rNuc,ENuc,nBas,n ! Allocate ensemble weights and MO coefficients - allocate(c(nBas,nspin),wEns(maxEns),occnum(nBas,nspin,maxEns)) + allocate(wEns(maxEns),occnum(nBas,nspin,maxEns)) call read_options_dft(nBas,method,x_rung,x_DFA,c_rung,c_DFA,SGn,nEns,wEns,aCC_w1,aCC_w2, & doNcentered,occnum,Cx_choice) @@ -140,73 +139,73 @@ subroutine eDFT(maxSCF,thresh,max_diis,guess_type,mix,nNuc,ZNuc,rNuc,ENuc,nBas,n ! Compute GOK-RKS energy !------------------------------------------------------------------------ - if(method == 'GOK-RKS') then +! if(method == 'GOK-RKS') then - call cpu_time(start_KS) - call GOK_RKS(.false.,x_rung,x_DFA,c_rung,c_DFA,LDA_centered,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight, & - maxSCF,thresh,max_diis,guess_type,nBas,AO,dAO,nO(1),nV(1), & - S,T,V,Hc,ERI,X,ENuc,Ew,c,occnum,Cx_choice) - call cpu_time(end_KS) +! call cpu_time(start_KS) +! call GOK_RKS(.false.,x_rung,x_DFA,c_rung,c_DFA,LDA_centered,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight, & +! maxSCF,thresh,max_diis,guess_type,nBas,AO,dAO,nO(1),nV(1), & +! S,T,V,Hc,ERI,X,ENuc,Ew,c,occnum,Cx_choice) +! call cpu_time(end_KS) - t_KS = end_KS - start_KS - write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for GOK-RKS = ',t_KS,' seconds' - write(*,*) +! t_KS = end_KS - start_KS +! write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for GOK-RKS = ',t_KS,' seconds' +! write(*,*) - end if +!end if !------------------------------------------------------------------------ ! Compute LIM excitation energies !------------------------------------------------------------------------ - if(method == 'LIM-RKS') then +! if(method == 'LIM-RKS') then - call cpu_time(start_KS) - call LIM_RKS(x_rung,x_DFA,c_rung,c_DFA,LDA_centered,nEns,nGrid,weight(:), & - aCC_w1,aCC_w2,maxSCF,thresh,max_diis,guess_type,nBas,AO(:,:),dAO(:,:,:),nO(1),nV(1), & - S(:,:),T(:,:),V(:,:),Hc(:,:),ERI(:,:,:,:),X(:,:),ENuc,c(:,:),occnum,Cx_choice,doNcentered) - call cpu_time(end_KS) +! call cpu_time(start_KS) +! call LIM_RKS(x_rung,x_DFA,c_rung,c_DFA,LDA_centered,nEns,nGrid,weight(:), & +! aCC_w1,aCC_w2,maxSCF,thresh,max_diis,guess_type,nBas,AO(:,:),dAO(:,:,:),nO(1),nV(1), & +! S(:,:),T(:,:),V(:,:),Hc(:,:),ERI(:,:,:,:),X(:,:),ENuc,c(:,:),occnum,Cx_choice,doNcentered) +! call cpu_time(end_KS) - t_KS = end_KS - start_KS - write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for LIM-RKS = ',t_KS,' seconds' - write(*,*) +! t_KS = end_KS - start_KS +! write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for LIM-RKS = ',t_KS,' seconds' +! write(*,*) - end if +! end if !------------------------------------------------------------------------ ! Compute MOM excitation energies !------------------------------------------------------------------------ - if(method == 'MOM-RKS') then +! if(method == 'MOM-RKS') then - call cpu_time(start_KS) - call MOM_RKS(x_rung,x_DFA,c_rung,c_DFA,LDA_centered,nEns,nGrid,weight(:), & - aCC_w1,aCC_w2,maxSCF,thresh,max_diis,guess_type,nBas,AO(:,:),dAO(:,:,:),nO(1),nV(1), & - S(:,:),T(:,:),V(:,:),Hc(:,:),ERI(:,:,:,:),X(:,:),ENuc,c(:,:),occnum,Cx_choice,doNcentered) - call cpu_time(end_KS) +! call cpu_time(start_KS) +! call MOM_RKS(x_rung,x_DFA,c_rung,c_DFA,LDA_centered,nEns,nGrid,weight(:), & +! aCC_w1,aCC_w2,maxSCF,thresh,max_diis,guess_type,nBas,AO(:,:),dAO(:,:,:),nO(1),nV(1), & +! S(:,:),T(:,:),V(:,:),Hc(:,:),ERI(:,:,:,:),X(:,:),ENuc,c(:,:),occnum,Cx_choice,doNcentered) +! call cpu_time(end_KS) - t_KS = end_KS - start_KS - write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for MOM-RKS = ',t_KS,' seconds' - write(*,*) +! t_KS = end_KS - start_KS +! write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for MOM-RKS = ',t_KS,' seconds' +! write(*,*) - end if +! end if !------------------------------------------------------------------------ ! Compute GOK-UKS energy (BROKEN) !------------------------------------------------------------------------ - if(method == 'GOK-UKS') then +! if(method == 'GOK-UKS') then - call cpu_time(start_KS) - call GOK_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns(:),nGrid,weight(:),aCC_w1,aCC_w2,maxSCF,thresh,max_diis,guess_type, & - nBas,AO(:,:),dAO(:,:,:),nO(:),nV(:),S(:,:),T(:,:),V(:,:),Hc(:,:),ERI(:,:,:,:),X(:,:),ENuc,Ew,occnum, & - Cx_choice,doNcentered) - call cpu_time(end_KS) +! call cpu_time(start_KS) +! call GOK_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns(:),nGrid,weight(:),aCC_w1,aCC_w2,maxSCF,thresh,max_diis,guess_type, & +! nBas,AO(:,:),dAO(:,:,:),nO(:),nV(:),S(:,:),T(:,:),V(:,:),Hc(:,:),ERI(:,:,:,:),X(:,:),ENuc,Ew,occnum, & +! Cx_choice,doNcentered) +! call cpu_time(end_KS) - t_KS = end_KS - start_KS - write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for UKS = ',t_KS,' seconds' - write(*,*) +! t_KS = end_KS - start_KS +! write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for UKS = ',t_KS,' seconds' +! write(*,*) - end if +! end if !------------------------------------------------------------------------ ! Compute N-centered UKS energy @@ -216,7 +215,7 @@ subroutine eDFT(maxSCF,thresh,max_diis,guess_type,mix,nNuc,ZNuc,rNuc,ENuc,nBas,n call cpu_time(start_KS) call eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight(:),maxSCF,thresh,max_diis,guess_type,mix, & - nBas,AO,dAO,S,T,V,Hc,ERI,X,ENuc,occnum,Cx_choice,doNcentered,Ew,eKS,cKS,PKS) + nBas,AO,dAO,S,T,V,Hc,ERI,X,ENuc,occnum,Cx_choice,doNcentered,Ew,eKS,cKS,PKS,Vxc) call cpu_time(end_KS) t_KS = end_KS - start_KS diff --git a/src/eDFT/eDFT_UKS.f90 b/src/eDFT/eDFT_UKS.f90 index 373e1ea..d0bf4e0 100644 --- a/src/eDFT/eDFT_UKS.f90 +++ b/src/eDFT/eDFT_UKS.f90 @@ -1,5 +1,5 @@ subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,maxSCF,thresh,max_diis,guess_type,mix, & - nBas,AO,dAO,S,T,V,Hc,ERI,X,ENuc,occnum,Cx_choice,doNcentered,Ew,eps,c,Pw) + nBas,AO,dAO,S,T,V,Hc,ERI,X,ENuc,occnum,Cx_choice,doNcentered,Ew,eps,c,Pw,Vxc) ! Perform unrestricted Kohn-Sham calculation for ensembles @@ -80,7 +80,8 @@ subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weig double precision,intent(out) :: Ew double precision,intent(out) :: eps(nBas,nspin) double precision,intent(out) :: Pw(nBas,nBas,nspin) - double precision,intent(out) :: c(nBAs,nBas,nspin) + double precision,intent(out) :: c(nBas,nBas,nspin) + double precision,intent(out) :: Vxc(nBas,nspin) ! Hello world @@ -386,12 +387,17 @@ subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weig call print_UKS(nBas,nEns,occnum,wEns,eps,c,ENuc,ET,EV,EJ,Ex,Ec,Ew) +! Compute Vxc for post-HF calculations + + call xc_potential(nBas,c,Fx,Fc,Vxc) + !------------------------------------------------------------------------ ! Compute individual energies from ensemble energy !------------------------------------------------------------------------ - call unrestricted_individual_energy(x_rung,x_DFA,c_rung,c_DFA,LDA_centered,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,nBas, & - AO,dAO,T,V,ERI,ENuc,eps,Pw,rhow,drhow,J,Fx,FxHF,Fc,P,rho,drho,Ew,E,Om,occnum, & - Cx_choice,doNcentered) + if(nEns > 1) & + call unrestricted_individual_energy(x_rung,x_DFA,c_rung,c_DFA,LDA_centered,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,nBas, & + AO,dAO,T,V,ERI,ENuc,eps,Pw,rhow,drhow,J,Fx,FxHF,Fc,P,rho,drho,Ew,E,Om,occnum, & + Cx_choice,doNcentered) end subroutine eDFT_UKS diff --git a/src/eDFT/read_options_dft.f90 b/src/eDFT/read_options_dft.f90 index 77964a9..8c0fbc0 100644 --- a/src/eDFT/read_options_dft.f90 +++ b/src/eDFT/read_options_dft.f90 @@ -96,7 +96,7 @@ subroutine read_options_dft(nBas,method,x_rung,x_DFA,c_rung,c_DFA,SGn,nEns,wEns, occnum(:,:,:) = 0d0 - do iEns=1,nEns + do iEns=1,maxEns read(1,*) read(1,*) (occnum(iBas,1,iEns),iBas=1,nBas) read(1,*) (occnum(iBas,2,iEns),iBas=1,nBas) @@ -117,9 +117,9 @@ subroutine read_options_dft(nBas,method,x_rung,x_DFA,c_rung,c_DFA,SGn,nEns,wEns, ! Read ensemble weights for real physical (fractional number of electrons) ensemble (w1,w2) - allocate(nEl(nEns)) + allocate(nEl(maxEns)) nEl(:) = 0d0 - do iEns=1,nEns + do iEns=1,maxEns do iBas=1,nBas nEl(iEns) = nEl(iEns) + occnum(iBas,1,iEns) + occnum(iBas,2,iEns) end do diff --git a/src/eDFT/unrestricted_hybrid_correlation_energy.f90 b/src/eDFT/unrestricted_hybrid_correlation_energy.f90 index 0e030d0..4a3413e 100644 --- a/src/eDFT/unrestricted_hybrid_correlation_energy.f90 +++ b/src/eDFT/unrestricted_hybrid_correlation_energy.f90 @@ -31,7 +31,7 @@ subroutine unrestricted_hybrid_correlation_energy(DFA,nEns,wEns,nGrid,weight,rho Ec(:) = 0d0 - case('LYP') + case('B3LYP') aC = 0.81d0 @@ -40,11 +40,13 @@ subroutine unrestricted_hybrid_correlation_energy(DFA,nEns,wEns,nGrid,weight,rho Ec(:) = EcLDA(:) + aC*(EcGGA(:) - EcLDA(:)) + case('BHHLYP') + + call unrestricted_gga_correlation_energy('LYP ',nEns,wEns,nGrid,weight,rho,drho,Ec) + case('PBE') - call unrestricted_gga_correlation_energy('PBE ',nEns,wEns,nGrid,weight,rho,drho,EcGGA) - - Ec(:) = EcGGA(:) + call unrestricted_gga_correlation_energy('PBE ',nEns,wEns,nGrid,weight,rho,drho,Ec) case default diff --git a/src/eDFT/unrestricted_hybrid_correlation_potential.f90 b/src/eDFT/unrestricted_hybrid_correlation_potential.f90 index 41afc8f..96a9935 100644 --- a/src/eDFT/unrestricted_hybrid_correlation_potential.f90 +++ b/src/eDFT/unrestricted_hybrid_correlation_potential.f90 @@ -36,7 +36,7 @@ subroutine unrestricted_hybrid_correlation_potential(DFA,nEns,wEns,nGrid,weight, Fc(:,:,:) = 0d0 - case('LYP') + case('B3LYP') allocate(FcLDA(nBas,nBas,nspin),FcGGA(nBas,nBas,nspin)) @@ -47,13 +47,17 @@ subroutine unrestricted_hybrid_correlation_potential(DFA,nEns,wEns,nGrid,weight, Fc(:,:,:) = FcLDA(:,:,:) + aC*(FcGGA(:,:,:) - FcLDA(:,:,:)) + case('BHHLYP') + + allocate(FcGGA(nBas,nBas,nspin)) + + call unrestricted_gga_correlation_potential('LYP ',nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,Fc) + case('PBE') allocate(FcGGA(nBas,nBas,nspin)) - call unrestricted_gga_correlation_potential('PBE ',nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,FcGGA) - - Fc(:,:,:) = FcGGA(:,:,:) + call unrestricted_gga_correlation_potential('PBE ',nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,Fc) case default diff --git a/src/eDFT/unrestricted_hybrid_exchange_energy.f90 b/src/eDFT/unrestricted_hybrid_exchange_energy.f90 index d0365b4..8fee449 100644 --- a/src/eDFT/unrestricted_hybrid_exchange_energy.f90 +++ b/src/eDFT/unrestricted_hybrid_exchange_energy.f90 @@ -38,7 +38,7 @@ subroutine unrestricted_hybrid_exchange_energy(DFA,LDA_centered,nEns,wEns,aCC_w1 call unrestricted_fock_exchange_energy(nBas,P,FxHF,Ex) - case ('B3') + case ('B3LYP') a0 = 0.20d0 aX = 0.72d0 @@ -52,6 +52,13 @@ subroutine unrestricted_hybrid_exchange_energy(DFA,LDA_centered,nEns,wEns,aCC_w1 + a0*(ExHF - ExLDA) & + aX*(ExGGA - ExLDA) + case ('BHHLYP') + + call unrestricted_gga_exchange_energy('B88 ',nEns,wEns,nGrid,weight,rho,drho,ExGGA) + call unrestricted_fock_exchange_energy(nBas,P,FxHF,ExHF) + + Ex = 0.5d0*ExHF + 0.5d0*ExGGA + case ('PBE') call unrestricted_gga_exchange_energy('PBE ',nEns,wEns,nGrid,weight,rho,drho,ExGGA) diff --git a/src/eDFT/unrestricted_hybrid_exchange_potential.f90 b/src/eDFT/unrestricted_hybrid_exchange_potential.f90 index f7c5d37..9875832 100644 --- a/src/eDFT/unrestricted_hybrid_exchange_potential.f90 +++ b/src/eDFT/unrestricted_hybrid_exchange_potential.f90 @@ -43,7 +43,7 @@ subroutine unrestricted_hybrid_exchange_potential(DFA,LDA_centered,nEns,wEns,aCC call unrestricted_fock_exchange_potential(nBas,P,ERI,FxHF) Fx(:,:) = FxHF(:,:) - case('B3') + case('B3LYP') allocate(FxLDA(nBas,nBas),FxGGA(nBas,nBas)) @@ -59,6 +59,15 @@ subroutine unrestricted_hybrid_exchange_potential(DFA,LDA_centered,nEns,wEns,aCC + a0*(FxHF(:,:) - FxLDA(:,:)) & + aX*(FxGGA(:,:) - FxLDA(:,:)) + case('BHHLYP') + + allocate(FxGGA(nBas,nBas)) + + call unrestricted_gga_exchange_potential('B88 ',nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,FxGGA) + call unrestricted_fock_exchange_potential(nBas,P,ERI,FxHF) + + Fx(:,:) = 0.5d0*FxHF(:,:) + 0.5d0*FxGGA(:,:) + case('PBE') allocate(FxGGA(nBas,nBas)) diff --git a/src/eDFT/xc_potential.f90 b/src/eDFT/xc_potential.f90 new file mode 100644 index 0000000..2037ab2 --- /dev/null +++ b/src/eDFT/xc_potential.f90 @@ -0,0 +1,40 @@ +subroutine xc_potential(nBas,c,Fx,Fc,Vxc) + +! Compute the exchange-correlation potential in the MO basis + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nBas + double precision,intent(in) :: c(nBas,nBas,nspin) + double precision,intent(in) :: Fx(nBas,nBas,nspin) + double precision,intent(in) :: Fc(nBas,nBas,nspin) + +! Local variables + + integer :: mu,nu + integer :: p + integer :: ispin + +! Output variables + + double precision,intent(out) :: Vxc(nBas,nspin) + +! Compute Vxc + + Vxc(:,:) = 0d0 + do p=1,nBas + do ispin=1,nspin + do mu=1,nBas + do nu=1,nBas + Vxc(p,ispin) = Vxc(p,ispin) & + + c(mu,p,ispin)*(Fx(mu,nu,ispin) + Fc(mu,nu,ispin))*c(nu,p,ispin) + + end do + end do + end do + end do + +end subroutine xc_potential From 144b5904cb3fb82d913862c745ecd0984e531b94 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Mon, 15 Feb 2021 21:44:24 +0100 Subject: [PATCH 16/63] fix small bug --- input/dft | 2 +- input/methods | 4 ++-- input/options | 4 ++-- src/QuAcK/QuAcK.f90 | 4 ++-- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/input/dft b/input/dft index 78b4137..d296083 100644 --- a/input/dft +++ b/input/dft @@ -19,7 +19,7 @@ # Number of states in ensemble (nEns) 1 # occupation numbers - 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 diff --git a/input/methods b/input/methods index dbe88da..33cd61e 100644 --- a/input/methods +++ b/input/methods @@ -1,5 +1,5 @@ # RHF UHF KS MOM - T F F F + F T F F # MP2* MP3 MP2-F12 F F F # CCD DCD CCSD CCSD(T) @@ -13,7 +13,7 @@ # G0F2 evGF2 G0F3 evGF3 F F F F # G0W0* evGW* qsGW* - T T F + T F F # G0T0 evGT qsGT F F F # MCMP2 diff --git a/input/options b/input/options index 1d5bf49..24bc7ba 100644 --- a/input/options +++ b/input/options @@ -5,7 +5,7 @@ # CC: maxSCF thresh DIIS n_diis 64 0.00001 T 5 # spin: TDA singlet triplet spin_conserved spin_flip - F T T T T + 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 @@ -13,6 +13,6 @@ # ACFDT: AC Kx XBS F F T # BSE: BSE dBSE dTDA evDyn - F T T F + T T 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 ec48069..1bf48b3 100644 --- a/src/QuAcK/QuAcK.f90 +++ b/src/QuAcK/QuAcK.f90 @@ -32,7 +32,7 @@ program QuAcK double precision,allocatable :: ZNuc(:),rNuc(:,:) double precision,allocatable :: cHF(:,:,:),eHF(:,:),PHF(:,:,:) - double precision,allocatable :: Vxc(:,:,:) + double precision,allocatable :: Vxc(:,:) double precision,allocatable :: eG0W0(:,:) double precision,allocatable :: eG0T0(:,:) @@ -237,7 +237,7 @@ program QuAcK 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),X(nBas,nBas),ERI_AO(nBas,nBas,nBas,nBas), & - dipole_int_AO(nBas,nBas,ncart),dipole_int_MO(nBas,nBas,ncart),Vxc(nBas,nBas,nspin)) + dipole_int_AO(nBas,nBas,ncart),dipole_int_MO(nBas,nBas,ncart),Vxc(nBas,nspin)) ! Read integrals From a2155a4ae6bea8623d0187f648363392619a9019 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Mon, 15 Feb 2021 22:00:19 +0100 Subject: [PATCH 17/63] T-matrix with KS starting point --- src/MBPT/G0T0.f90 | 38 +++++++++++++++++++++++++------------- src/MBPT/G0W0.f90 | 24 ++++++++++++------------ src/MBPT/evGT.f90 | 47 ++++++++++++++++++++++++++++------------------- src/MBPT/evGW.f90 | 4 ++-- 4 files changed, 67 insertions(+), 46 deletions(-) diff --git a/src/MBPT/G0T0.f90 b/src/MBPT/G0T0.f90 index 7aa3dca..2e1b5a1 100644 --- a/src/MBPT/G0T0.f90 +++ b/src/MBPT/G0T0.f90 @@ -1,5 +1,5 @@ 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) + linearize,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int,PHF,cHF,eHF,Vxc,eG0T0) ! Perform one-shot calculation with a T-matrix self-energy (G0T0) @@ -30,8 +30,12 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,sing integer,intent(in) :: nS double precision,intent(in) :: ENuc double precision,intent(in) :: ERHF + double precision,intent(in) :: Vxc(nBas) double precision,intent(in) :: eHF(nBas) - double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + double precision,intent(in) :: cHF(nBas,nBas) + double precision,intent(in) :: PHF(nBas,nBas) + double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_MO(nBas,nBas,nBas,nBas) double precision,intent(in) :: dipole_int(nBas,nBas,ncart) ! Local variables @@ -54,6 +58,7 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,sing double precision,allocatable :: X2s(:,:),X2t(:,:) double precision,allocatable :: Y2s(:,:),Y2t(:,:) double precision,allocatable :: rho2s(:,:,:),rho2t(:,:,:) + double precision,allocatable :: SigX(:) double precision,allocatable :: SigT(:) double precision,allocatable :: Z(:) @@ -90,7 +95,7 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,sing Omega1t(nVVt),X1t(nVVt,nVVt),Y1t(nOOt,nVVt), & Omega2t(nOOt),X2t(nVVt,nOOt),Y2t(nOOt,nOOt), & rho1t(nBas,nO,nVVt),rho2t(nBas,nV,nOOt), & - SigT(nBas),Z(nBas)) + SigX(nBas),SigT(nBas),Z(nBas)) !---------------------------------------------- ! alpha-beta block @@ -101,7 +106,7 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,sing ! Compute linear response - call linear_response_pp(iblock,.true.,.false.,nBas,nC,nO,nV,nR,nOOs,nVVs,eHF(:),ERI(:,:,:,:), & + call linear_response_pp(iblock,.true.,.false.,nBas,nC,nO,nV,nR,nOOs,nVVs,eHF(:),ERI_MO(:,:,:,:), & Omega1s(:),X1s(:,:),Y1s(:,:),Omega2s(:),X2s(:,:),Y2s(:,:),EcRPA(ispin)) ! EcRPA(ispin) = 1d0*EcRPA(ispin) @@ -118,7 +123,7 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,sing ! Compute linear response - call linear_response_pp(iblock,.true.,.false.,nBas,nC,nO,nV,nR,nOOt,nVVt,eHF(:),ERI(:,:,:,:), & + call linear_response_pp(iblock,.true.,.false.,nBas,nC,nO,nV,nR,nOOt,nVVt,eHF(:),ERI_MO(:,:,:,:), & Omega1t(:),X1t(:,:),Y1t(:,:),Omega2t(:),X2t(:,:),Y2t(:,:),EcRPA(ispin)) ! EcRPA(ispin) = 2d0*EcRPA(ispin) @@ -139,7 +144,7 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,sing xERI = +0d0 alpha = +1d0 - call excitation_density_Tmatrix(iblock,dERI,xERI,nBas,nC,nO,nV,nR,nOOs,nVVs,ERI(:,:,:,:), & + call excitation_density_Tmatrix(iblock,dERI,xERI,nBas,nC,nO,nV,nR,nOOs,nVVs,ERI_MO(:,:,:,:), & X1s(:,:),Y1s(:,:),rho1s(:,:,:),X2s(:,:),Y2s(:,:),rho2s(:,:,:)) call self_energy_Tmatrix_diag(alpha,eta,nBas,nC,nO,nV,nR,nOOs,nVVs,eHF(:), & @@ -153,7 +158,7 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,sing xERI = -1d0 alpha = +1d0 - call excitation_density_Tmatrix(iblock,dERI,xERI,nBas,nC,nO,nV,nR,nOOt,nVVt,ERI(:,:,:,:), & + call excitation_density_Tmatrix(iblock,dERI,xERI,nBas,nC,nO,nV,nR,nOOt,nVVt,ERI_MO(:,:,:,:), & X1t(:,:),Y1t(:,:),rho1t(:,:,:),X2t(:,:),Y2t(:,:),rho2t(:,:,:)) call self_energy_Tmatrix_diag(alpha,eta,nBas,nC,nO,nV,nR,nOOt,nVVt,eHF(:), & @@ -164,17 +169,24 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,sing Z(:) = 1d0/(1d0 - Z(:)) + +!---------------------------------------------- +! Compute the exchange part of the self-energy +!---------------------------------------------- + + call self_energy_exchange_diag(nBas,cHF,PHF,ERI_AO,SigX) + !---------------------------------------------- ! Solve the quasi-particle equation !---------------------------------------------- if(linearize) then - eG0T0(:) = eHF(:) + Z(:)*SigT(:) + eG0T0(:) = eHF(:) + Z(:)*(SigX(:) + SigT(:) - Vxc(:)) else - eG0T0(:) = eHF(:) + SigT(:) + eG0T0(:) = eHF(:) + SigX(:) + SigT(:) - Vxc(:) end if @@ -188,11 +200,11 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,sing ispin = 1 iblock = 3 - call linear_response_pp(iblock,.false.,.false.,nBas,nC,nO,nV,nR,nOOs,nVVs,eG0T0(:),ERI(:,:,:,:), & + call linear_response_pp(iblock,.false.,.false.,nBas,nC,nO,nV,nR,nOOs,nVVs,eG0T0(:),ERI_MO(:,:,:,:), & Omega1s(:),X1s(:,:),Y1s(:,:),Omega2s(:),X2s(:,:),Y2s(:,:),EcRPA(ispin)) ispin = 2 iblock = 4 - call linear_response_pp(iblock,.false.,.false.,nBas,nC,nO,nV,nR,nOOt,nVVt,eG0T0(:),ERI(:,:,:,:), & + call linear_response_pp(iblock,.false.,.false.,nBas,nC,nO,nV,nR,nOOt,nVVt,eG0T0(:),ERI_MO(:,:,:,:), & Omega1t(:),X1t(:,:),Y1t(:,:),Omega2t(:),X2t(:,:),Y2t(:,:),EcRPA(ispin)) EcRPA(1) = EcRPA(1) - EcRPA(2) EcRPA(2) = 3d0*EcRPA(2) @@ -211,7 +223,7 @@ subroutine G0T0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,evDyn,sing if(BSE) then call Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta, & - nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,eG0T0,EcBSE) + nBas,nC,nO,nV,nR,nS,ERI_MO,dipole_int,eHF,eG0T0,EcBSE) if(exchange_kernel) then @@ -246,7 +258,7 @@ 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,triplet,eta, & - nBas,nC,nO,nV,nR,nS,ERI,eHF,eG0T0,EcAC) + nBas,nC,nO,nV,nR,nS,ERI_MO,eHF,eG0T0,EcAC) if(exchange_kernel) then diff --git a/src/MBPT/G0W0.f90 b/src/MBPT/G0W0.f90 index d679ce8..d2150b1 100644 --- a/src/MBPT/G0W0.f90 +++ b/src/MBPT/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,ERI_AO,ERI_MO,dipole_int,PHF,cHF,eHF,Vxc,eGW) + nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int,PHF,cHF,eHF,Vxc,eG0W0) ! Perform G0W0 calculation @@ -53,11 +53,11 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & double precision,allocatable :: XmY_RPA(:,:) double precision,allocatable :: rho_RPA(:,:,:) - double precision,allocatable :: eGWlin(:) + double precision,allocatable :: eG0W0lin(:) ! Output variables - double precision :: eGW(nBas) + double precision :: eG0W0(nBas) ! Hello world @@ -105,7 +105,7 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & ! Memory allocation - allocate(SigC(nBas),SigX(nBas),Z(nBas),OmRPA(nS),XpY_RPA(nS,nS),XmY_RPA(nS,nS),rho_RPA(nBas,nBas,nS),eGWlin(nBas)) + allocate(SigC(nBas),SigX(nBas),Z(nBas),OmRPA(nS),XpY_RPA(nS,nS),XmY_RPA(nS,nS),rho_RPA(nBas,nBas,nS),eG0W0lin(nBas)) !-------------------! ! Compute screening ! @@ -139,7 +139,7 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & ! Solve the quasi-particle equation ! !-----------------------------------! - eGWlin(:) = eHF(:) + Z(:)*(SigX(:) + SigC(:) - Vxc(:)) + eG0W0lin(:) = eHF(:) + Z(:)*(SigX(:) + SigC(:) - Vxc(:)) ! Linearized or graphical solution? @@ -148,14 +148,14 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & write(*,*) ' *** Quasiparticle energies obtained by linearization *** ' write(*,*) - eGW(:) = eGWlin(:) + eG0W0(:) = eG0W0lin(:) else 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) + call QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,OmRPA,rho_RPA,eG0W0lin,eG0W0) ! Find all the roots of the QP equation if necessary @@ -165,18 +165,18 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & ! Compute the RPA correlation energy - call linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI_MO,OmRPA, & + call linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eG0W0,ERI_MO,OmRPA, & rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA) !--------------! ! Dump results ! !--------------! - call print_G0W0(nBas,nO,eHF,ENuc,ERHF,SigC,Z,eGW,EcRPA,EcGM) + call print_G0W0(nBas,nO,eHF,ENuc,ERHF,SigC,Z,eG0W0,EcRPA,EcGM) ! Deallocate memory - deallocate(SigC,Z,OmRPA,XpY_RPA,XmY_RPA,rho_RPA,eGWlin) + deallocate(SigC,Z,OmRPA,XpY_RPA,XmY_RPA,rho_RPA,eG0W0lin) ! Plot stuff @@ -186,7 +186,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_MO,dipole_int,eHF,eGW,EcBSE) + call Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI_MO,dipole_int,eHF,eG0W0,EcBSE) if(exchange_kernel) then @@ -220,7 +220,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,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI_MO,eHF,eGW,EcAC) + call ACFDT(exchange_kernel,doXBS,.true.,TDA_W,TDA,BSE,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI_MO,eHF,eG0W0,EcAC) write(*,*) write(*,*)'-------------------------------------------------------------------------------' diff --git a/src/MBPT/evGT.f90 b/src/MBPT/evGT.f90 index c923a20..95a0e0d 100644 --- a/src/MBPT/evGT.f90 +++ b/src/MBPT/evGT.f90 @@ -1,6 +1,6 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, & - BSE,TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet, & - eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF,eG0T0) + BSE,TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas, & + nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int,PHF,cHF,eHF,Vxc,eG0T0) ! Perform eigenvalue self-consistent calculation with a T-matrix self-energy (evGT) @@ -33,8 +33,12 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, & integer,intent(in) :: nS double precision,intent(in) :: ENuc double precision,intent(in) :: ERHF + double precision,intent(in) :: PHF(nBas,nBas) double precision,intent(in) :: eHF(nBas) - double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + double precision,intent(in) :: cHF(nBas,nBas) + double precision,intent(in) :: Vxc(nBas) + double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_MO(nBas,nBas,nBas,nBas) double precision,intent(in) :: dipole_int(nBas,nBas,ncart) double precision,intent(in) :: eG0T0(nBas) @@ -68,6 +72,7 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, & double precision,allocatable :: X2s(:,:),X2t(:,:) double precision,allocatable :: Y2s(:,:),Y2t(:,:) double precision,allocatable :: rho2s(:,:,:),rho2t(:,:,:) + double precision,allocatable :: SigX(:) double precision,allocatable :: SigT(:) double precision,allocatable :: Z(:) @@ -96,15 +101,19 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, & ! Memory allocation - allocate(Omega1s(nVVs),X1s(nVVs,nVVs),Y1s(nOOs,nVVs), & - Omega2s(nOOs),X2s(nVVs,nOOs),Y2s(nOOs,nOOs), & - rho1s(nBas,nO,nVVs),rho2s(nBas,nV,nOOs), & - Omega1t(nVVt),X1t(nVVt,nVVt),Y1t(nOOt,nVVt), & - Omega2t(nOOt),X2t(nVVt,nOOt),Y2t(nOOt,nOOt), & - rho1t(nBas,nO,nVVt),rho2t(nBas,nV,nOOt), & - eGT(nBas),eOld(nBas),Z(nBas),SigT(nBas), & + allocate(Omega1s(nVVs),X1s(nVVs,nVVs),Y1s(nOOs,nVVs), & + Omega2s(nOOs),X2s(nVVs,nOOs),Y2s(nOOs,nOOs), & + rho1s(nBas,nO,nVVs),rho2s(nBas,nV,nOOs), & + Omega1t(nVVt),X1t(nVVt,nVVt),Y1t(nOOt,nVVt), & + Omega2t(nOOt),X2t(nVVt,nOOt),Y2t(nOOt,nOOt), & + rho1t(nBas,nO,nVVt),rho2t(nBas,nV,nOOt), & + eGT(nBas),eOld(nBas),Z(nBas),SigX(nBas),SigT(nBas), & error_diis(nBas,max_diis),e_diis(nBas,max_diis)) +! Compute the exchange part of the self-energy + + call self_energy_exchange_diag(nBas,cHF,PHF,ERI_AO,SigX) + ! Initialization nSCF = 0 @@ -131,7 +140,7 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, & ! Compute linear response - call linear_response_pp(iblock,.true.,.false.,nBas,nC,nO,nV,nR,nOOs,nVVs,eHF(:),ERI(:,:,:,:), & + call linear_response_pp(iblock,.true.,.false.,nBas,nC,nO,nV,nR,nOOs,nVVs,eHF(:),ERI_MO(:,:,:,:), & Omega1s(:),X1s(:,:),Y1s(:,:),Omega2s(:),X2s(:,:),Y2s(:,:),EcRPA(ispin)) ! EcRPA(ispin) = 1d0*EcRPA(ispin) @@ -148,7 +157,7 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, & ! Compute linear response - call linear_response_pp(iblock,.true.,.false.,nBas,nC,nO,nV,nR,nOOt,nVVt,eHF(:),ERI(:,:,:,:), & + call linear_response_pp(iblock,.true.,.false.,nBas,nC,nO,nV,nR,nOOt,nVVt,eHF(:),ERI_MO(:,:,:,:), & Omega1t(:),X1t(:,:),Y1t(:,:),Omega2t(:),X2t(:,:),Y2t(:,:),EcRPA(ispin)) ! EcRPA(ispin) = 2d0*EcRPA(ispin) @@ -169,7 +178,7 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, & xERI = +0d0 alpha = +1d0 - call excitation_density_Tmatrix(iblock,dERI,xERI,nBas,nC,nO,nV,nR,nOOs,nVVs,ERI(:,:,:,:), & + call excitation_density_Tmatrix(iblock,dERI,xERI,nBas,nC,nO,nV,nR,nOOs,nVVs,ERI_MO(:,:,:,:), & X1s(:,:),Y1s(:,:),rho1s(:,:,:),X2s(:,:),Y2s(:,:),rho2s(:,:,:)) call self_energy_Tmatrix_diag(alpha,eta,nBas,nC,nO,nV,nR,nOOs,nVVs,eGT(:), & @@ -183,7 +192,7 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, & xERI = -1d0 alpha = +1d0 - call excitation_density_Tmatrix(iblock,dERI,xERI,nBas,nC,nO,nV,nR,nOOt,nVVt,ERI(:,:,:,:), & + call excitation_density_Tmatrix(iblock,dERI,xERI,nBas,nC,nO,nV,nR,nOOt,nVVt,ERI_MO(:,:,:,:), & X1t(:,:),Y1t(:,:),rho1t(:,:,:),X2t(:,:),Y2t(:,:),rho2t(:,:,:)) call self_energy_Tmatrix_diag(alpha,eta,nBas,nC,nO,nV,nR,nOOt,nVVt,eGT(:), & @@ -200,7 +209,7 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, & ! Solve the quasi-particle equation !---------------------------------------------- - eGT(:) = eHF(:) + SigT(:) + eGT(:) = eHF(:) + SigX(:) + SigT(:) - Vxc(:) ! Convergence criteria @@ -238,11 +247,11 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, & ispin = 1 iblock = 3 - call linear_response_pp(iblock,.false.,.false.,nBas,nC,nO,nV,nR,nOOs,nVVs,eGT(:),ERI(:,:,:,:), & + call linear_response_pp(iblock,.false.,.false.,nBas,nC,nO,nV,nR,nOOs,nVVs,eGT(:),ERI_MO(:,:,:,:), & Omega1s(:),X1s(:,:),Y1s(:,:),Omega2s(:),X2s(:,:),Y2s(:,:),EcRPA(ispin)) ispin = 2 iblock = 4 - call linear_response_pp(iblock,.false.,.false.,nBas,nC,nO,nV,nR,nOOt,nVVt,eGT(:),ERI(:,:,:,:), & + call linear_response_pp(iblock,.false.,.false.,nBas,nC,nO,nV,nR,nOOt,nVVt,eGT(:),ERI_MO(:,:,:,:), & Omega1t(:),X1t(:,:),Y1t(:,:),Omega2t(:),X2t(:,:),Y2t(:,:),EcRPA(ispin)) EcRPA(1) = EcRPA(1) - EcRPA(2) EcRPA(2) = 3d0*EcRPA(2) @@ -262,7 +271,7 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, & if(BSE) then 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) + nBas,nC,nO,nV,nR,nS,ERI_MO,dipole_int,eGT,eGT,EcRPA,EcBSE) if(exchange_kernel) then @@ -297,7 +306,7 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, & end if call ACFDT(exchange_kernel,doXBS,.true.,TDA_W,TDA,BSE,singlet,triplet,eta, & - nBas,nC,nO,nV,nR,nS,ERI,eGT,eGT,EcAC) + nBas,nC,nO,nV,nR,nS,ERI_MO,eGT,eGT,EcAC) if(exchange_kernel) then diff --git a/src/MBPT/evGW.f90 b/src/MBPT/evGW.f90 index 882663d..7d15ef9 100644 --- a/src/MBPT/evGW.f90 +++ b/src/MBPT/evGW.f90 @@ -34,7 +34,7 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE double precision,intent(in) :: PHF(nBas,nBas) double precision,intent(in) :: eHF(nBas) double precision,intent(in) :: cHF(nBas,nBas) - double precision,intent(in) :: Vxc(nBas,nspin) + double precision,intent(in) :: Vxc(nBas) double precision,intent(in) :: eG0W0(nBas) double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas) double precision,intent(in) :: ERI_MO(nBas,nBas,nBas,nBas) @@ -176,7 +176,7 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE ! Solve the quasi-particle equation - eGW(:) = eHF(:) + SigC(:) + eGW(:) = eHF(:) + SigX(:) + SigC(:) - Vxc(:) ! Convergence criteria From ba7a2349afd37dbebca4961639f60b6f7300735c Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Mon, 15 Feb 2021 22:15:30 +0100 Subject: [PATCH 18/63] fix QP graph --- src/MBPT/G0W0.f90 | 2 +- src/MBPT/QP_graph.f90 | 16 +++++++++------- src/MBPT/UG0W0.f90 | 4 ++-- src/MBPT/unrestricted_QP_graph.f90 | 16 +++++++++------- 4 files changed, 21 insertions(+), 17 deletions(-) diff --git a/src/MBPT/G0W0.f90 b/src/MBPT/G0W0.f90 index d2150b1..d2c7fa7 100644 --- a/src/MBPT/G0W0.f90 +++ b/src/MBPT/G0W0.f90 @@ -155,7 +155,7 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & write(*,*) ' *** Quasiparticle energies obtained by root search (experimental) *** ' write(*,*) - call QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,OmRPA,rho_RPA,eG0W0lin,eG0W0) + call QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,SigX,Vxc,OmRPA,rho_RPA,eG0W0lin,eG0W0) ! Find all the roots of the QP equation if necessary diff --git a/src/MBPT/QP_graph.f90 b/src/MBPT/QP_graph.f90 index bc6ae48..69628e8 100644 --- a/src/MBPT/QP_graph.f90 +++ b/src/MBPT/QP_graph.f90 @@ -1,4 +1,4 @@ -subroutine QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,Omega,rho,eGWlin,eGW) +subroutine QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,SigX,Vxc,Omega,rho,eGWlin,eGW) ! Compute the graphical solution of the QP equation @@ -15,6 +15,8 @@ subroutine QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,Omega,rho,eGWlin,eGW) integer,intent(in) :: nS double precision,intent(in) :: eta double precision,intent(in) :: eHF(nBas) + double precision,intent(in) :: SigX(nBas) + double precision,intent(in) :: Vxc(nBas) double precision,intent(in) :: Omega(nS) double precision,intent(in) :: rho(nBas,nBas,nS) @@ -27,7 +29,7 @@ subroutine QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,Omega,rho,eGWlin,eGW) integer,parameter :: maxIt = 64 double precision,parameter :: thresh = 1d-6 double precision,external :: SigmaC,dSigmaC - double precision :: sig,dsig + double precision :: sigC,dsigC double precision :: f,df double precision :: w @@ -52,14 +54,14 @@ subroutine QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,Omega,rho,eGWlin,eGW) nIt = nIt + 1 - sig = SigmaC(p,w,eta,nBas,nC,nO,nV,nR,nS,eHF,Omega,rho) - dsig = dSigmaC(p,w,eta,nBas,nC,nO,nV,nR,nS,eHF,Omega,rho) - f = w - eHF(p) - sig - df = 1d0 - dsig + sigC = SigmaC(p,w,eta,nBas,nC,nO,nV,nR,nS,eHF,Omega,rho) + dsigC = dSigmaC(p,w,eta,nBas,nC,nO,nV,nR,nS,eHF,Omega,rho) + f = w - eHF(p) - SigX(p) - sigC + Vxc(p) + df = 1d0 - dsigC w = w - f/df - write(*,'(A3,I3,A1,1X,3F15.9)') 'It.',nIt,':',w*HaToeV,f,sig + write(*,'(A3,I3,A1,1X,3F15.9)') 'It.',nIt,':',w*HaToeV,f,sigC end do diff --git a/src/MBPT/UG0W0.f90 b/src/MBPT/UG0W0.f90 index 5c876cc..5fd0131 100644 --- a/src/MBPT/UG0W0.f90 +++ b/src/MBPT/UG0W0.f90 @@ -165,8 +165,8 @@ 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),OmRPA, & - rho_RPA(:,:,:,is),eGWlin(:,is),eGW(:,is)) + call unrestricted_QP_graph(nBas,nC(is),nO(is),nV(is),nR(is),nS_sc,eta,eHF(:,is),SigX(:,is),Vxc(:,is), & + OmRPA,rho_RPA(:,:,:,is),eGWlin(:,is),eGW(:,is)) end do end if diff --git a/src/MBPT/unrestricted_QP_graph.f90 b/src/MBPT/unrestricted_QP_graph.f90 index 96585a9..14b7653 100644 --- a/src/MBPT/unrestricted_QP_graph.f90 +++ b/src/MBPT/unrestricted_QP_graph.f90 @@ -1,4 +1,4 @@ -subroutine unrestricted_QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,Omega,rho,eGWlin,eGW) +subroutine unrestricted_QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,SigX,Vxc,Omega,rho,eGWlin,eGW) ! Compute the graphical solution of the QP equation @@ -15,6 +15,8 @@ subroutine unrestricted_QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,Omega,rho,eGWlin,eG integer,intent(in) :: nS double precision,intent(in) :: eta double precision,intent(in) :: eHF(nBas) + double precision,intent(in) :: SigX(nBas) + double precision,intent(in) :: Vxc(nBas) double precision,intent(in) :: Omega(nS) double precision,intent(in) :: rho(nBas,nBas,nS,nspin) @@ -27,7 +29,7 @@ subroutine unrestricted_QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,Omega,rho,eGWlin,eG integer,parameter :: maxIt = 10 double precision,parameter :: thresh = 1d-6 double precision,external :: USigmaC,dUSigmaC - double precision :: sig,dsig + double precision :: sigC,dsigC double precision :: f,df double precision :: w @@ -52,14 +54,14 @@ subroutine unrestricted_QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,Omega,rho,eGWlin,eG 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 + sigC = USigmaC(p,w,eta,nBas,nC,nO,nV,nR,nS,eHF,Omega,rho) + dsigC = dUSigmaC(p,w,eta,nBas,nC,nO,nV,nR,nS,eHF,Omega,rho) + f = w - eHF(p) - SigX(p) + Vxc(p) - sigC + df = 1d0 - dsigC w = w - f/df - write(*,'(A3,I3,A1,1X,3F15.9)') 'It.',nIt,':',w*HaToeV,f,sig + write(*,'(A3,I3,A1,1X,3F15.9)') 'It.',nIt,':',w*HaToeV,f,sigC end do From 6e826226701c0d8188a3fef9de850f114b52961e Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Mon, 15 Feb 2021 22:31:41 +0100 Subject: [PATCH 19/63] make UKS easier --- input/dft | 2 +- input/methods | 2 +- src/eDFT/eDFT.f90 | 31 ++++++++++++++++++++++++++++++- 3 files changed, 32 insertions(+), 3 deletions(-) diff --git a/input/dft b/input/dft index d296083..3d705c5 100644 --- a/input/dft +++ b/input/dft @@ -1,5 +1,5 @@ # Restricted or unrestricted KS calculation - eDFT-UKS + UKS # exchange rung: # Hartree = 0: H # LDA = 1: S51,CC-S51 diff --git a/input/methods b/input/methods index 33cd61e..796ea7b 100644 --- a/input/methods +++ b/input/methods @@ -1,5 +1,5 @@ # RHF UHF KS MOM - F T F F + F F T F # MP2* MP3 MP2-F12 F F F # CCD DCD CCSD CCSD(T) diff --git a/src/eDFT/eDFT.f90 b/src/eDFT/eDFT.f90 index bbfbed6..387e44a 100644 --- a/src/eDFT/eDFT.f90 +++ b/src/eDFT/eDFT.f90 @@ -79,6 +79,7 @@ subroutine eDFT(maxSCF,thresh,max_diis,guess_type,mix,nNuc,ZNuc,rNuc,ENuc,nBas,n integer :: Cx_choice integer :: i,vmajor,vminor,vmicro + integer :: iBas,iEns,ispin ! Output variables @@ -208,7 +209,35 @@ subroutine eDFT(maxSCF,thresh,max_diis,guess_type,mix,nNuc,ZNuc,rNuc,ENuc,nBas,n ! end if !------------------------------------------------------------------------ -! Compute N-centered UKS energy +! Compute UKS energy +!------------------------------------------------------------------------ + + if(method == 'UKS') then + + ! Reset occupation numbers for conventional UKS calculation + + occnum(:,:,:) = 0d0 + do ispin=1,nspin + do iBas=1,nO(ispin) + do iEns=1,nEns + occnum(iBas,ispin,iEns) = 1d0 + end do + end do + end do + + call cpu_time(start_KS) + call eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight(:),maxSCF,thresh,max_diis,guess_type,mix, & + nBas,AO,dAO,S,T,V,Hc,ERI,X,ENuc,occnum,Cx_choice,doNcentered,Ew,eKS,cKS,PKS,Vxc) + call cpu_time(end_KS) + + t_KS = end_KS - start_KS + write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for UKS = ',t_KS,' seconds' + write(*,*) + + end if + +!------------------------------------------------------------------------ +! Compute UKS energy for ensembles !------------------------------------------------------------------------ if(method == 'eDFT-UKS') then From ede8862d67b061ea3590df6cadda09e2dd68cb65 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Tue, 16 Feb 2021 10:00:01 +0100 Subject: [PATCH 20/63] fix bug in T matrix --- input/methods | 6 +- src/LR/linear_response_B_pp.f90 | 4 +- src/LR/linear_response_C_pp.f90 | 4 +- src/LR/linear_response_D_pp.f90 | 4 +- src/QuAcK/QuAcK.f90 | 9 +- src/eDFT/orthogonalization_matrix.f90 | 120 ------------------------- src/utils/orthogonalization_matrix.f90 | 12 +-- 7 files changed, 20 insertions(+), 139 deletions(-) delete mode 100644 src/eDFT/orthogonalization_matrix.f90 diff --git a/input/methods b/input/methods index 796ea7b..1fb9bee 100644 --- a/input/methods +++ b/input/methods @@ -1,5 +1,5 @@ # RHF UHF KS MOM - F F T F + T F F F # MP2* MP3 MP2-F12 F F F # CCD DCD CCSD CCSD(T) @@ -13,9 +13,9 @@ # G0F2 evGF2 G0F3 evGF3 F F F F # G0W0* evGW* qsGW* - T F F -# G0T0 evGT qsGT F F F +# G0T0 evGT qsGT + T F F # MCMP2 F # * unrestricted version available diff --git a/src/LR/linear_response_B_pp.f90 b/src/LR/linear_response_B_pp.f90 index 59e7a3d..7644897 100644 --- a/src/LR/linear_response_B_pp.f90 +++ b/src/LR/linear_response_B_pp.f90 @@ -86,7 +86,7 @@ subroutine linear_response_B_pp(ispin,nBas,nC,nO,nV,nR,nOO,nVV,e,ERI,B_pp) end if - print*,'B pp-matrix' - call matout(nVV,nOO,B_pp) +! print*,'B pp-matrix' +! call matout(nVV,nOO,B_pp) end subroutine linear_response_B_pp diff --git a/src/LR/linear_response_C_pp.f90 b/src/LR/linear_response_C_pp.f90 index d22b11d..a8b391d 100644 --- a/src/LR/linear_response_C_pp.f90 +++ b/src/LR/linear_response_C_pp.f90 @@ -96,7 +96,7 @@ subroutine linear_response_C_pp(ispin,nBas,nC,nO,nV,nR,nOO,nVV,e,ERI,C_pp) end if - print*,'C pp-matrix' - call matout(nVV,nVV,C_pp) +! print*,'C pp-matrix' +! call matout(nVV,nVV,C_pp) end subroutine linear_response_C_pp diff --git a/src/LR/linear_response_D_pp.f90 b/src/LR/linear_response_D_pp.f90 index d06a119..04a2960 100644 --- a/src/LR/linear_response_D_pp.f90 +++ b/src/LR/linear_response_D_pp.f90 @@ -96,7 +96,7 @@ subroutine linear_response_D_pp(ispin,nBas,nC,nO,nV,nR,nOO,nVV,e,ERI,D_pp) end if - print*,'D pp-matrix' - call matout(nOO,nOO,D_pp) +! print*,'D pp-matrix' +! call matout(nOO,nOO,D_pp) end subroutine linear_response_D_pp diff --git a/src/QuAcK/QuAcK.f90 b/src/QuAcK/QuAcK.f90 index 1bf48b3..ad67e96 100644 --- a/src/QuAcK/QuAcK.f90 +++ b/src/QuAcK/QuAcK.f90 @@ -940,9 +940,9 @@ program QuAcK if(doG0T0) then 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_MO,dipole_int_MO,eHF,eG0T0) + 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_AO,ERI_MO,dipole_int_MO, & + PHF,cHF,eHF,Vxc,eG0T0) call cpu_time(end_G0T0) t_G0T0 = end_G0T0 - start_G0T0 @@ -960,7 +960,8 @@ 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,triplet,eta_GW, & - nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int_MO,eHF,eG0T0) + nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_AO,ERI_MO,dipole_int_MO, & + PHF,cHF,eHF,Vxc,eG0T0) call cpu_time(end_evGT) t_evGT = end_evGT - start_evGT diff --git a/src/eDFT/orthogonalization_matrix.f90 b/src/eDFT/orthogonalization_matrix.f90 deleted file mode 100644 index 15ea4ac..0000000 --- a/src/eDFT/orthogonalization_matrix.f90 +++ /dev/null @@ -1,120 +0,0 @@ -subroutine orthogonalization_matrix(ortho_type,nBas,S,X) - -! Compute the orthogonalization matrix X - - implicit none - -! Input variables - - integer,intent(in) :: nBas,ortho_type - double precision,intent(in) :: S(nBas,nBas) - -! Local variables - - logical :: debug - double precision,allocatable :: UVec(:,:),Uval(:) - double precision,parameter :: thresh = 1d-6 - - integer :: i - -! Output variables - - double precision,intent(out) :: X(nBas,nBas) - - debug = .false. - -! Type of orthogonalization ortho_type -! -! 1 = Lowdin -! 2 = Canonical -! 3 = SVD -! - - allocate(Uvec(nBas,nBas),Uval(nBas)) - - if(ortho_type == 1) then - - write(*,*) - write(*,*) ' Lowdin orthogonalization' - write(*,*) - - Uvec = S - call diagonalize_matrix(nBas,Uvec,Uval) - - do i=1,nBas - - if(Uval(i) > thresh) then - - Uval(i) = 1d0/sqrt(Uval(i)) - - else - - write(*,*) 'Eigenvalue',i,'too small for Lowdin orthogonalization' - - endif - - enddo - - call ADAt(nBas,Uvec,Uval,X) - - elseif(ortho_type == 2) then - - write(*,*) - write(*,*) 'Canonical orthogonalization' - write(*,*) - - Uvec = S - call diagonalize_matrix(nBas,Uvec,Uval) - - do i=1,nBas - - if(Uval(i) > thresh) then - - Uval(i) = 1d0/sqrt(Uval(i)) - - else - - write(*,*) ' Eigenvalue',i,'too small for canonical orthogonalization' - - endif - - enddo - - call AD(nBas,Uvec,Uval) - X = Uvec - - elseif(ortho_type == 3) then - - write(*,*) - write(*,*) ' SVD-based orthogonalization NYI' - write(*,*) - -! Uvec = S -! call diagonalize_matrix(nBas,Uvec,Uval) - -! do i=1,nBas -! if(Uval(i) > thresh) then -! Uval(i) = 1d0/sqrt(Uval(i)) -! else -! write(*,*) 'Eigenvalue',i,'too small for canonical orthogonalization' -! endif -! enddo -! -! call AD(nBas,Uvec,Uval) -! X = Uvec - - endif - -! Print results - - if(debug) then - - write(*,'(A28)') '----------------------' - write(*,'(A28)') 'Orthogonalization matrix' - write(*,'(A28)') '----------------------' - call matout(nBas,nBas,X) - write(*,*) - - endif - -end subroutine orthogonalization_matrix diff --git a/src/utils/orthogonalization_matrix.f90 b/src/utils/orthogonalization_matrix.f90 index 348abdb..5c78601 100644 --- a/src/utils/orthogonalization_matrix.f90 +++ b/src/utils/orthogonalization_matrix.f90 @@ -57,9 +57,9 @@ subroutine orthogonalization_matrix(ortho_type,nBas,S,X) elseif(ortho_type == 2) then - write(*,*) - write(*,*) 'Canonical orthogonalization' - write(*,*) +! write(*,*) +! write(*,*) 'Canonical orthogonalization' +! write(*,*) Uvec = S call diagonalize_matrix(nBas,Uvec,Uval) @@ -83,9 +83,9 @@ subroutine orthogonalization_matrix(ortho_type,nBas,S,X) elseif(ortho_type == 3) then - write(*,*) - write(*,*) ' SVD-based orthogonalization NYI' - write(*,*) +! write(*,*) +! write(*,*) ' SVD-based orthogonalization NYI' +! write(*,*) ! Uvec = S ! call diagonalize_matrix(nBas,Uvec,Uval) From 272e47ed273c955e71405512d68b067a5992083e Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Thu, 25 Feb 2021 10:55:08 +0100 Subject: [PATCH 21/63] UVWN3 for Gaussian B3LYP --- input/dft | 2 +- input/methods | 4 +- input/options | 2 +- src/MBPT/Bethe_Salpeter.f90 | 4 +- .../Bethe_Salpeter_dynamic_perturbation.f90 | 3 +- src/MBPT/qsUGW.f90 | 4 +- src/MBPT/unrestricted_Bethe_Salpeter.f90 | 4 +- ...ed_Bethe_Salpeter_dynamic_perturbation.f90 | 5 +- src/eDFT/UVWN3_lda_correlation_energy.f90 | 137 ++++++++++++ ...VWN3_lda_correlation_individual_energy.f90 | 202 ++++++++++++++++++ src/eDFT/UVWN3_lda_correlation_potential.f90 | 202 ++++++++++++++++++ ...unrestricted_hybrid_correlation_energy.f90 | 2 +- ...estricted_hybrid_correlation_potential.f90 | 2 +- .../unrestricted_lda_correlation_energy.f90 | 4 + ...cted_lda_correlation_individual_energy.f90 | 4 + ...unrestricted_lda_correlation_potential.f90 | 4 + 16 files changed, 570 insertions(+), 15 deletions(-) create mode 100644 src/eDFT/UVWN3_lda_correlation_energy.f90 create mode 100644 src/eDFT/UVWN3_lda_correlation_individual_energy.f90 create mode 100644 src/eDFT/UVWN3_lda_correlation_potential.f90 diff --git a/input/dft b/input/dft index 3d705c5..c783a3f 100644 --- a/input/dft +++ b/input/dft @@ -9,7 +9,7 @@ 4 BHHLYP # correlation rung: # Hartree = 0: H -# LDA = 1: VWN5,eVWN5 +# LDA = 1: VWN3,VWN5,eVWN5 # GGA = 2: LYP,PBE # MGGA = 3: # Hybrid = 4: HF,LYP,PBE diff --git a/input/methods b/input/methods index 1fb9bee..94ad703 100644 --- a/input/methods +++ b/input/methods @@ -1,5 +1,5 @@ # RHF UHF KS MOM - T F F F + F F T F # MP2* MP3 MP2-F12 F F F # CCD DCD CCSD CCSD(T) @@ -15,7 +15,7 @@ # G0W0* evGW* qsGW* F F F # G0T0 evGT qsGT - T F F + F F F # MCMP2 F # * unrestricted version available diff --git a/input/options b/input/options index 24bc7ba..f2afee0 100644 --- a/input/options +++ b/input/options @@ -9,7 +9,7 @@ # 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.0000001 T 5 T 0.000 F F F F F + 256 0.0000001 T 5 T 0.00367493 F F F F F # ACFDT: AC Kx XBS F F T # BSE: BSE dBSE dTDA evDyn diff --git a/src/MBPT/Bethe_Salpeter.f90 b/src/MBPT/Bethe_Salpeter.f90 index 8ca6757..4d8621d 100644 --- a/src/MBPT/Bethe_Salpeter.f90 +++ b/src/MBPT/Bethe_Salpeter.f90 @@ -88,7 +88,7 @@ subroutine Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC, OmBSE(:,ispin),XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin)) else - call Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,dipole_int,OmRPA,rho_RPA, & + call Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eW,eGW,dipole_int,OmRPA,rho_RPA, & OmBSE(:,ispin),XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin)) end if @@ -127,7 +127,7 @@ subroutine Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC, OmBSE(:,ispin),XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin)) else - call Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,dipole_int,OmRPA,rho_RPA, & + call Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eW,eGW,dipole_int,OmRPA,rho_RPA, & OmBSE(:,ispin),XpY_BSE(:,:,ispin),XmY_BSE(:,:,ispin)) end if diff --git a/src/MBPT/Bethe_Salpeter_dynamic_perturbation.f90 b/src/MBPT/Bethe_Salpeter_dynamic_perturbation.f90 index c960a75..88dcc08 100644 --- a/src/MBPT/Bethe_Salpeter_dynamic_perturbation.f90 +++ b/src/MBPT/Bethe_Salpeter_dynamic_perturbation.f90 @@ -1,4 +1,4 @@ -subroutine Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW,dipole_int,OmRPA,rho_RPA,OmBSE,XpY,XmY) +subroutine Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eW,eGW,dipole_int,OmRPA,rho_RPA,OmBSE,XpY,XmY) ! Compute dynamical effects via perturbation theory for BSE @@ -16,6 +16,7 @@ subroutine Bethe_Salpeter_dynamic_perturbation(dTDA,eta,nBas,nC,nO,nV,nR,nS,eGW, integer,intent(in) :: nR integer,intent(in) :: nS + double precision,intent(in) :: eW(nBas) double precision,intent(in) :: eGW(nBas) double precision,intent(in) :: dipole_int(nBas,nBas,ncart) double precision,intent(in) :: OmRPA(nS) diff --git a/src/MBPT/qsUGW.f90 b/src/MBPT/qsUGW.f90 index 2128d0f..09d8cef 100644 --- a/src/MBPT/qsUGW.f90 +++ b/src/MBPT/qsUGW.f90 @@ -375,14 +375,14 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOS ! Deallocate memory - deallocate(c,cp,P,F,Fp,J,K,SigC,SigCp,SigCm,Z,OmRPA,XpY_RPA,XmY_RPA,rho_RPA,error,error_diis,F_diis) + deallocate(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 unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta,nBas,nC,nO,nV,nR,nS, & - S,ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb,cHF,eGW,eGW,EcBSE) + S,ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb,c,eGW,eGW,EcBSE) if(exchange_kernel) then diff --git a/src/MBPT/unrestricted_Bethe_Salpeter.f90 b/src/MBPT/unrestricted_Bethe_Salpeter.f90 index 5b0436b..a483c0e 100644 --- a/src/MBPT/unrestricted_Bethe_Salpeter.f90 +++ b/src/MBPT/unrestricted_Bethe_Salpeter.f90 @@ -112,7 +112,7 @@ subroutine unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved, if(dBSE) & call unrestricted_Bethe_Salpeter_dynamic_perturbation(ispin,dTDA,eta,nBas,nC,nO,nV,nR,nS,nS_aa,nS_bb,nS_sc,nS_sc, & - eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb, & + eW,eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb, & OmRPA,rho_RPA,OmBSE_sc,XpY_BSE_sc,XmY_BSE_sc) deallocate(OmBSE_sc,XpY_BSE_sc,XmY_BSE_sc) @@ -148,7 +148,7 @@ subroutine unrestricted_Bethe_Salpeter(TDA_W,TDA,dBSE,dTDA,evDyn,spin_conserved, if(dBSE) & call unrestricted_Bethe_Salpeter_dynamic_perturbation(ispin,dTDA,eta,nBas,nC,nO,nV,nR,nS,nS_ab,nS_ba,nS_sf,nS_sc, & - eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb, & + eW,eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb, & OmRPA,rho_RPA,OmBSE_sf,XpY_BSE_sf,XmY_BSE_sf) deallocate(OmBSE_sf,XpY_BSE_sf,XmY_BSE_sf) diff --git a/src/MBPT/unrestricted_Bethe_Salpeter_dynamic_perturbation.f90 b/src/MBPT/unrestricted_Bethe_Salpeter_dynamic_perturbation.f90 index 4bb3cd7..56a8ed9 100644 --- a/src/MBPT/unrestricted_Bethe_Salpeter_dynamic_perturbation.f90 +++ b/src/MBPT/unrestricted_Bethe_Salpeter_dynamic_perturbation.f90 @@ -1,5 +1,5 @@ -subroutine unrestricted_Bethe_Salpeter_dynamic_perturbation(ispin,dTDA,eta,nBas,nC,nO,nV,nR,nS,nSa,nSb,nSt,nS_sc,eGW, & - ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb, & +subroutine unrestricted_Bethe_Salpeter_dynamic_perturbation(ispin,dTDA,eta,nBas,nC,nO,nV,nR,nS,nSa,nSb,nSt,nS_sc,eW,eGW, & + ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb, & OmRPA,rho_RPA,OmBSE,XpY_BSE,XmY_BSE) ! Compute dynamical effects via perturbation theory for BSE @@ -23,6 +23,7 @@ subroutine unrestricted_Bethe_Salpeter_dynamic_perturbation(ispin,dTDA,eta,nBas, integer,intent(in) :: nSt integer,intent(in) :: nS_sc + 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) diff --git a/src/eDFT/UVWN3_lda_correlation_energy.f90 b/src/eDFT/UVWN3_lda_correlation_energy.f90 new file mode 100644 index 0000000..161f1ad --- /dev/null +++ b/src/eDFT/UVWN3_lda_correlation_energy.f90 @@ -0,0 +1,137 @@ +subroutine UVWN3_lda_correlation_energy(nGrid,weight,rho,Ec) + +! Compute unrestricted VWN3 LDA correlation energy + + implicit none + + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + +! Local variables + + integer :: iG + double precision :: ra,rb,r,rs,x,z + double precision :: a_p,x0_p,xx0_p,b_p,c_p,x_p,q_p + double precision :: a_f,x0_f,xx0_f,b_f,c_f,x_f,q_f + double precision :: a_a,x0_a,xx0_a,b_a,c_a,x_a,q_a + + double precision :: ec_z,ec_p,ec_f,ec_a + double precision :: fz,d2fz + +! Output variables + + double precision :: Ec(nsp) + +! Parameters of the functional + + a_p = +0.0621814d0/2d0 + x0_p = -0.409286d0 + b_p = +13.0720d0 + c_p = +42.7198d0 + + a_f = +0.0621814d0/4d0 + x0_f = -0.743294d0 + b_f = +20.1231d0 + c_f = +101.578d0 + + a_a = -1d0/(6d0*pi**2) + x0_a = -0.0047584D0 + b_a = 1.13107d0 + c_a = 13.0045d0 + +! Initialization + + Ec(:) = 0d0 + + do iG=1,nGrid + + ra = max(0d0,rho(iG,1)) + rb = max(0d0,rho(iG,2)) + +! alpha-alpha contribution + + if(ra > threshold) then + + rs = (4d0*pi*ra/3d0)**(-1d0/3d0) + x = sqrt(rs) + + x_f = x*x + b_f*x + c_f + xx0_f = x0_f*x0_f + b_f*x0_f + c_f + q_f = sqrt(4d0*c_f - b_f*b_f) + + ec_f = a_f*( log(x**2/x_f) + 2d0*b_f/q_f*atan(q_f/(2d0*x + b_f)) & + - b_f*x0_f/xx0_f*( log((x - x0_f)**2/x_f) + 2d0*(b_f + 2d0*x0_f)/q_f*atan(q_f/(2d0*x + b_f)) ) ) + + Ec(1) = Ec(1) + weight(iG)*ec_f*ra + + end if + +! alpha-beta contribution + + if(ra > threshold .or. rb > threshold) then + + r = ra + rb + rs = (4d0*pi*r/3d0)**(-1d0/3d0) + z = (ra - rb)/r + x = sqrt(rs) + + fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 + fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) + + d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) + + x_p = x*x + b_p*x + c_p + x_f = x*x + b_f*x + c_f + x_a = x*x + b_a*x + c_a + + xx0_p = x0_p*x0_p + b_p*x0_p + c_p + xx0_f = x0_f*x0_f + b_f*x0_f + c_f + xx0_a = x0_a*x0_a + b_a*x0_a + c_a + + q_p = sqrt(4d0*c_p - b_p*b_p) + q_f = sqrt(4d0*c_f - b_f*b_f) + q_a = sqrt(4d0*c_a - b_a*b_a) + + ec_p = a_p*( log(x**2/x_p) + 2d0*b_p/q_p*atan(q_p/(2d0*x + b_p)) & + - b_p*x0_p/xx0_p*( log((x - x0_p)**2/x_p) + 2d0*(b_p + 2d0*x0_p)/q_p*atan(q_p/(2d0*x + b_p)) ) ) + + ec_f = a_f*( log(x**2/x_f) + 2d0*b_f/q_f*atan(q_f/(2d0*x + b_f)) & + - b_f*x0_f/xx0_f*( log((x - x0_f)**2/x_f) + 2d0*(b_f + 2d0*x0_f)/q_f*atan(q_f/(2d0*x + b_f)) ) ) + + ec_a = a_a*( log(x**2/x_a) + 2d0*b_a/q_a*atan(q_a/(2d0*x + b_a)) & + - b_a*x0_a/xx0_a*( log((x - x0_a)**2/x_a) + 2d0*(b_a + 2d0*x0_a)/q_a*atan(q_a/(2d0*x + b_a)) ) ) + + ec_z = ec_p + ec_a*fz/d2fz*(1d0-z**4) + (ec_f - ec_p)*fz*z**4 + + Ec(2) = Ec(2) + weight(iG)*ec_z*r + + end if + +! beta-beta contribution + + if(rb > threshold) then + + rs = (4d0*pi*rb/3d0)**(-1d0/3d0) + x = sqrt(rs) + + x_f = x*x + b_f*x + c_f + xx0_f = x0_f*x0_f + b_f*x0_f + c_f + q_f = sqrt(4d0*c_f - b_f*b_f) + + ec_f = a_f*( log(x**2/x_f) + 2d0*b_f/q_f*atan(q_f/(2d0*x + b_f)) & + - b_f*x0_f/xx0_f*( log((x - x0_f)**2/x_f) + 2d0*(b_f + 2d0*x0_f)/q_f*atan(q_f/(2d0*x + b_f)) ) ) + + Ec(3) = Ec(3) + weight(iG)*ec_f*rb + + end if + + end do + + Ec(2) = Ec(2) - Ec(1) - Ec(3) + +end subroutine UVWN3_lda_correlation_energy diff --git a/src/eDFT/UVWN3_lda_correlation_individual_energy.f90 b/src/eDFT/UVWN3_lda_correlation_individual_energy.f90 new file mode 100644 index 0000000..2448381 --- /dev/null +++ b/src/eDFT/UVWN3_lda_correlation_individual_energy.f90 @@ -0,0 +1,202 @@ +subroutine UVWN3_lda_correlation_individual_energy(nGrid,weight,rhow,rho,Ec) + +! Compute VWN3 LDA correlation potential + + implicit none + + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rhow(nGrid,nspin) + double precision,intent(in) :: rho(nGrid,nspin) + +! Local variables + + integer :: iG + double precision :: ra,rb,r,raI,rbI,rI,rs,x,z + double precision :: a_p,x0_p,xx0_p,b_p,c_p,x_p,q_p + double precision :: a_f,x0_f,xx0_f,b_f,c_f,x_f,q_f + double precision :: a_a,x0_a,xx0_a,b_a,c_a,x_a,q_a + double precision :: dfzdz,dxdrs,dxdx_p,dxdx_f,dxdx_a,decdx_p,decdx_f,decdx_a + double precision :: dzdra,dfzdra,drsdra,decdra_p,decdra_f,decdra_a,decdra + double precision :: dzdrb,dfzdrb,drsdrb,decdrb_p,decdrb_f,decdrb_a,decdrb + double precision :: ec_z,ec_p,ec_f,ec_a + double precision :: fz,d2fz + +! Output variables + + double precision :: Ec(nsp) + +! Parameters of the functional + + a_p = +0.0621814d0/2d0 + x0_p = -0.409286d0 + b_p = +13.0720d0 + c_p = +42.7198d0 + + a_f = +0.0621814d0/4d0 + x0_f = -0.743294d0 + b_f = +20.1231d0 + c_f = +101.578d0 + + a_a = -1d0/(6d0*pi**2) + x0_a = -0.0047584D0 + b_a = +1.13107d0 + c_a = +13.0045d0 + +! Initialization + + Ec(:) = 0d0 + + do iG=1,nGrid + + ra = max(0d0,rhow(iG,1)) + rb = max(0d0,rhow(iG,2)) + + raI = max(0d0,rho(iG,1)) + rbI = max(0d0,rho(iG,2)) + +! spin-up contribution + + if(ra > threshold .or. raI > threshold) then + + r = ra + rI = raI + + rs = (4d0*pi*r/3d0)**(-1d0/3d0) + x = sqrt(rs) + + x_f = x*x + b_f*x + c_f + + xx0_f = x0_f*x0_f + b_f*x0_f + c_f + + q_f = sqrt(4d0*c_f - b_f*b_f) + + ec_f = a_f*( log(x**2/x_f) + 2d0*b_f/q_f*atan(q_f/(2d0*x + b_f)) & + - b_f*x0_f/xx0_f*( log((x - x0_f)**2/x_f) + 2d0*(b_f + 2d0*x0_f)/q_f*atan(q_f/(2d0*x + b_f)) ) ) + + drsdra = - (36d0*pi)**(-1d0/3d0)*r**(-4d0/3d0) + dxdrs = 0.5d0/sqrt(rs) + + dxdx_f = 2d0*x + b_f + + decdx_f = a_f*( 2d0/x - 4d0*b_f/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f & + - b_f*x0_f/xx0_f*( 2/(x-x0_f) - 4d0*(b_f+2d0*x0_f)/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f ) ) + + decdra_f = drsdra*dxdrs*decdx_f + + Ec(1) = Ec(1) + weight(iG)*(ec_f + decdra_f*r)*rI + + end if + +! up-down contribution + + if(ra > threshold .or. raI > threshold) then + + r = ra + rb + rI = raI + rbI + + rs = (4d0*pi*r/3d0)**(-1d0/3d0) + z = (ra - rb)/r + x = sqrt(rs) + + fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 + fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) + + d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) + + x_p = x*x + b_p*x + c_p + x_f = x*x + b_f*x + c_f + x_a = x*x + b_a*x + c_a + + xx0_p = x0_p*x0_p + b_p*x0_p + c_p + xx0_f = x0_f*x0_f + b_f*x0_f + c_f + xx0_a = x0_a*x0_a + b_a*x0_a + c_a + + q_p = sqrt(4d0*c_p - b_p*b_p) + q_f = sqrt(4d0*c_f - b_f*b_f) + q_a = sqrt(4d0*c_a - b_a*b_a) + + ec_p = a_p*( log(x**2/x_p) + 2d0*b_p/q_p*atan(q_p/(2d0*x + b_p)) & + - b_p*x0_p/xx0_p*( log((x - x0_p)**2/x_p) + 2d0*(b_p + 2d0*x0_p)/q_p*atan(q_p/(2d0*x + b_p)) ) ) + + ec_f = a_f*( log(x**2/x_f) + 2d0*b_f/q_f*atan(q_f/(2d0*x + b_f)) & + - b_f*x0_f/xx0_f*( log((x - x0_f)**2/x_f) + 2d0*(b_f + 2d0*x0_f)/q_f*atan(q_f/(2d0*x + b_f)) ) ) + + ec_a = a_a*( log(x**2/x_a) + 2d0*b_a/q_a*atan(q_a/(2d0*x + b_a)) & + - b_a*x0_a/xx0_a*( log((x - x0_a)**2/x_a) + 2d0*(b_a + 2d0*x0_a)/q_a*atan(q_a/(2d0*x + b_a)) ) ) + + ec_z = ec_p + ec_a*fz/d2fz*(1d0-z**4) + (ec_f - ec_p)*fz*z**4 + + dzdra = (1d0 - z)/r + dfzdz = (4d0/3d0)*((1d0 + z)**(1d0/3d0) - (1d0 - z)**(1d0/3d0))/(2d0*(2d0**(1d0/3d0) - 1d0)) + dfzdra = dzdra*dfzdz + + drsdra = - (36d0*pi)**(-1d0/3d0)*r**(-4d0/3d0) + dxdrs = 0.5d0/sqrt(rs) + + dxdx_p = 2d0*x + b_p + dxdx_f = 2d0*x + b_f + dxdx_a = 2d0*x + b_a + + decdx_p = a_p*( 2d0/x - 4d0*b_p/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p & + - b_p*x0_p/xx0_p*( 2/(x-x0_p) - 4d0*(b_p+2d0*x0_p)/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p ) ) + + decdx_f = a_f*( 2d0/x - 4d0*b_f/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f & + - b_f*x0_f/xx0_f*( 2/(x-x0_f) - 4d0*(b_f+2d0*x0_f)/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f ) ) + + decdx_a = a_a*( 2d0/x - 4d0*b_a/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a & + - b_a*x0_a/xx0_a*( 2/(x-x0_a) - 4d0*(b_a+2d0*x0_a)/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a ) ) + + decdra_p = drsdra*dxdrs*decdx_p + decdra_f = drsdra*dxdrs*decdx_f + decdra_a = drsdra*dxdrs*decdx_a + + decdra = decdra_p + decdra_a*fz/d2fz*(1d0-z**4) + ec_a*dfzdra/d2fz*(1d0-z**4) - 4d0*ec_a*fz/d2fz*dzdra*z**3 & + + (decdra_f - decdra_p)*fz*z**4 + (ec_f - ec_p)*dfzdra*z**4 + 4d0*(ec_f - ec_p)*fz*dzdra*z**3 + + Ec(2) = Ec(2) + weight(iG)*(ec_z + decdra*r)*rI + + end if + +! spin-down contribution + + if(rb > threshold .or. rbI > threshold) then + + r = rb + rI = rbI + + rs = (4d0*pi*r/3d0)**(-1d0/3d0) + x = sqrt(rs) + + x_f = x*x + b_f*x + c_f + + xx0_f = x0_f*x0_f + b_f*x0_f + c_f + + q_f = sqrt(4d0*c_f - b_f*b_f) + + ec_f = a_f*( log(x**2/x_f) + 2d0*b_f/q_f*atan(q_f/(2d0*x + b_f)) & + - b_f*x0_f/xx0_f*( log((x - x0_f)**2/x_f) + 2d0*(b_f + 2d0*x0_f)/q_f*atan(q_f/(2d0*x + b_f)) ) ) + + drsdra = - (36d0*pi)**(-1d0/3d0)*r**(-4d0/3d0) + dxdrs = 0.5d0/sqrt(rs) + + dxdx_f = 2d0*x + b_f + + decdx_f = a_f*( 2d0/x - 4d0*b_f/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f & + - b_f*x0_f/xx0_f*( 2/(x-x0_f) - 4d0*(b_f+2d0*x0_f)/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f ) ) + + decdra_f = drsdra*dxdrs*decdx_f + + Ec(3) = Ec(3) + weight(iG)*(ec_f + decdra_f*r)*rI + + end if + + end do + + Ec(2) = Ec(2) - Ec(1) - Ec(3) + +end subroutine UVWN3_lda_correlation_individual_energy diff --git a/src/eDFT/UVWN3_lda_correlation_potential.f90 b/src/eDFT/UVWN3_lda_correlation_potential.f90 new file mode 100644 index 0000000..47f8cd9 --- /dev/null +++ b/src/eDFT/UVWN3_lda_correlation_potential.f90 @@ -0,0 +1,202 @@ +subroutine UVWN3_lda_correlation_potential(nGrid,weight,nBas,AO,rho,Fc) + +! Compute unrestricted VWN3 LDA correlation potential + + implicit none + + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + integer,intent(in) :: nBas + double precision,intent(in) :: AO(nBas,nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + +! Local variables + + integer :: mu,nu,iG + double precision :: ra,rb,r,rs,x,z + double precision :: a_p,x0_p,xx0_p,b_p,c_p,x_p,q_p + double precision :: a_f,x0_f,xx0_f,b_f,c_f,x_f,q_f + double precision :: a_a,x0_a,xx0_a,b_a,c_a,x_a,q_a + double precision :: dfzdz,dxdrs,dxdx_p,dxdx_f,dxdx_a,decdx_p,decdx_f,decdx_a + double precision :: dzdra,dfzdra,drsdra,decdra_p,decdra_f,decdra_a,decdra + double precision :: dzdrb,dfzdrb,drsdrb,decdrb_p,decdrb_f,decdrb_a,decdrb + + double precision :: ec_z,ec_p,ec_f,ec_a + double precision :: fz,d2fz + +! Output variables + + double precision :: Fc(nBas,nBas,nspin) + +! Parameters of the functional + + a_p = +0.0621814d0/2d0 + x0_p = -0.409286d0 + b_p = +13.0720d0 + c_p = +42.7198d0 + + a_f = +0.0621814d0/4d0 + x0_f = -0.743294d0 + b_f = +20.1231d0 + c_f = +101.578d0 + + a_a = -1d0/(6d0*pi**2) + x0_a = -0.0047584D0 + b_a = +1.13107d0 + c_a = +13.0045d0 + +! Initialization + + Fc(:,:,:) = 0d0 + + do mu=1,nBas + do nu=1,nBas + do iG=1,nGrid + + ra = max(0d0,rho(iG,1)) + rb = max(0d0,rho(iG,2)) + +! spin-up contribution + + if(ra > threshold) then + + r = ra + rb + rs = (4d0*pi*r/3d0)**(-1d0/3d0) + z = (ra - rb)/r + x = sqrt(rs) + + fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 + fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) + + d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) + + x_p = x*x + b_p*x + c_p + x_f = x*x + b_f*x + c_f + x_a = x*x + b_a*x + c_a + + xx0_p = x0_p*x0_p + b_p*x0_p + c_p + xx0_f = x0_f*x0_f + b_f*x0_f + c_f + xx0_a = x0_a*x0_a + b_a*x0_a + c_a + + q_p = sqrt(4d0*c_p - b_p*b_p) + q_f = sqrt(4d0*c_f - b_f*b_f) + q_a = sqrt(4d0*c_a - b_a*b_a) + + ec_p = a_p*( log(x**2/x_p) + 2d0*b_p/q_p*atan(q_p/(2d0*x + b_p)) & + - b_p*x0_p/xx0_p*( log((x - x0_p)**2/x_p) + 2d0*(b_p + 2d0*x0_p)/q_p*atan(q_p/(2d0*x + b_p)) ) ) + + ec_f = a_f*( log(x**2/x_f) + 2d0*b_f/q_f*atan(q_f/(2d0*x + b_f)) & + - b_f*x0_f/xx0_f*( log((x - x0_f)**2/x_f) + 2d0*(b_f + 2d0*x0_f)/q_f*atan(q_f/(2d0*x + b_f)) ) ) + + ec_a = a_a*( log(x**2/x_a) + 2d0*b_a/q_a*atan(q_a/(2d0*x + b_a)) & + - b_a*x0_a/xx0_a*( log((x - x0_a)**2/x_a) + 2d0*(b_a + 2d0*x0_a)/q_a*atan(q_a/(2d0*x + b_a)) ) ) + + ec_z = ec_p + ec_a*fz/d2fz*(1d0-z**4) + (ec_f - ec_p)*fz*z**4 + + dzdra = (1d0 - z)/r + dfzdz = (4d0/3d0)*((1d0 + z)**(1d0/3d0) - (1d0 - z)**(1d0/3d0))/(2d0*(2d0**(1d0/3d0) - 1d0)) + dfzdra = dzdra*dfzdz + + drsdra = - (36d0*pi)**(-1d0/3d0)*r**(-4d0/3d0) + dxdrs = 0.5d0/sqrt(rs) + + dxdx_p = 2d0*x + b_p + dxdx_f = 2d0*x + b_f + dxdx_a = 2d0*x + b_a + + decdx_p = a_p*( 2d0/x - 4d0*b_p/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p & + - b_p*x0_p/xx0_p*( 2/(x-x0_p) - 4d0*(b_p+2d0*x0_p)/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p ) ) + + decdx_f = a_f*( 2d0/x - 4d0*b_f/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f & + - b_f*x0_f/xx0_f*( 2/(x-x0_f) - 4d0*(b_f+2d0*x0_f)/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f ) ) + + decdx_a = a_a*( 2d0/x - 4d0*b_a/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a & + - b_a*x0_a/xx0_a*( 2/(x-x0_a) - 4d0*(b_a+2d0*x0_a)/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a ) ) + + decdra_p = drsdra*dxdrs*decdx_p + decdra_f = drsdra*dxdrs*decdx_f + decdra_a = drsdra*dxdrs*decdx_a + + decdra = decdra_p + decdra_a*fz/d2fz*(1d0-z**4) + ec_a*dfzdra/d2fz*(1d0-z**4) - 4d0*ec_a*fz/d2fz*dzdra*z**3 & + + (decdra_f - decdra_p)*fz*z**4 + (ec_f - ec_p)*dfzdra*z**4 + 4d0*(ec_f - ec_p)*fz*dzdra*z**3 + + Fc(mu,nu,1) = Fc(mu,nu,1) + weight(iG)*AO(mu,iG)*AO(nu,iG)*(ec_z + decdra*r) + + end if + +! spin-down contribution + + if(rb > threshold) then + + r = ra + rb + rs = (4d0*pi*r/3d0)**(-1d0/3d0) + z = (ra - rb)/r + x = sqrt(rs) + + fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 + fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) + + d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) + + x_p = x*x + b_p*x + c_p + x_f = x*x + b_f*x + c_f + x_a = x*x + b_a*x + c_a + + xx0_p = x0_p*x0_p + b_p*x0_p + c_p + xx0_f = x0_f*x0_f + b_f*x0_f + c_f + xx0_a = x0_a*x0_a + b_a*x0_a + c_a + + q_p = sqrt(4d0*c_p - b_p*b_p) + q_f = sqrt(4d0*c_f - b_f*b_f) + q_a = sqrt(4d0*c_a - b_a*b_a) + + ec_p = a_p*( log(x**2/x_p) + 2d0*b_p/q_p*atan(q_p/(2d0*x + b_p)) & + - b_p*x0_p/xx0_p*( log((x - x0_p)**2/x_p) + 2d0*(b_p + 2d0*x0_p)/q_p*atan(q_p/(2d0*x + b_p)) ) ) + + ec_f = a_f*( log(x**2/x_f) + 2d0*b_f/q_f*atan(q_f/(2d0*x + b_f)) & + - b_f*x0_f/xx0_f*( log((x - x0_f)**2/x_f) + 2d0*(b_f + 2d0*x0_f)/q_f*atan(q_f/(2d0*x + b_f)) ) ) + + ec_a = a_a*( log(x**2/x_a) + 2d0*b_a/q_a*atan(q_a/(2d0*x + b_a)) & + - b_a*x0_a/xx0_a*( log((x - x0_a)**2/x_a) + 2d0*(b_a + 2d0*x0_a)/q_a*atan(q_a/(2d0*x + b_a)) ) ) + + ec_z = ec_p + ec_a*fz/d2fz*(1d0-z**4) + (ec_f - ec_p)*fz*z**4 + + dzdrb = - (1d0 + z)/r + dfzdz = (4d0/3d0)*((1d0 + z)**(1d0/3d0) - (1d0 - z)**(1d0/3d0))/(2d0*(2d0**(1d0/3d0) - 1d0)) + dfzdrb = dzdrb*dfzdz + + drsdrb = - (36d0*pi)**(-1d0/3d0)*r**(-4d0/3d0) + dxdrs = 0.5d0/sqrt(rs) + + dxdx_p = 2d0*x + b_p + dxdx_f = 2d0*x + b_f + dxdx_a = 2d0*x + b_a + + decdx_p = a_p*( 2d0/x - 4d0*b_p/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p & + - b_p*x0_p/xx0_p*( 2/(x-x0_p) - 4d0*(b_p+2d0*x0_p)/( (b_p+2d0*x)**2 + q_p**2) - dxdx_p/x_p ) ) + + decdx_f = a_f*( 2d0/x - 4d0*b_f/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f & + - b_f*x0_f/xx0_f*( 2/(x-x0_f) - 4d0*(b_f+2d0*x0_f)/( (b_f+2d0*x)**2 + q_f**2) - dxdx_f/x_f ) ) + + decdx_a = a_a*( 2d0/x - 4d0*b_a/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a & + - b_a*x0_a/xx0_a*( 2/(x-x0_a) - 4d0*(b_a+2d0*x0_a)/( (b_a+2d0*x)**2 + q_a**2) - dxdx_a/x_a ) ) + + decdrb_p = drsdrb*dxdrs*decdx_p + decdrb_f = drsdrb*dxdrs*decdx_f + decdrb_a = drsdrb*dxdrs*decdx_a + + decdrb = decdrb_p + decdrb_a*fz/d2fz*(1d0-z**4) + ec_a*dfzdrb/d2fz*(1d0-z**4) - 4d0*ec_a*fz/d2fz*dzdrb*z**3 & + + (decdrb_f - decdrb_p)*fz*z**4 + (ec_f - ec_p)*dfzdrb*z**4 + 4d0*(ec_f - ec_p)*fz*dzdrb*z**3 + Fc(mu,nu,2) = Fc(mu,nu,2) + weight(iG)*AO(mu,iG)*AO(nu,iG)*(ec_z + decdrb*r) + + end if + + end do + end do + end do + +end subroutine UVWN3_lda_correlation_potential diff --git a/src/eDFT/unrestricted_hybrid_correlation_energy.f90 b/src/eDFT/unrestricted_hybrid_correlation_energy.f90 index 4a3413e..e8a286b 100644 --- a/src/eDFT/unrestricted_hybrid_correlation_energy.f90 +++ b/src/eDFT/unrestricted_hybrid_correlation_energy.f90 @@ -35,7 +35,7 @@ subroutine unrestricted_hybrid_correlation_energy(DFA,nEns,wEns,nGrid,weight,rho aC = 0.81d0 - call unrestricted_lda_correlation_energy('VWN5 ',nEns,wEns,nGrid,weight,rho,EcLDA) + call unrestricted_lda_correlation_energy('VWN3 ',nEns,wEns,nGrid,weight,rho,EcLDA) call unrestricted_gga_correlation_energy('LYP ',nEns,wEns,nGrid,weight,rho,drho,EcGGA) Ec(:) = EcLDA(:) + aC*(EcGGA(:) - EcLDA(:)) diff --git a/src/eDFT/unrestricted_hybrid_correlation_potential.f90 b/src/eDFT/unrestricted_hybrid_correlation_potential.f90 index 96a9935..4b37441 100644 --- a/src/eDFT/unrestricted_hybrid_correlation_potential.f90 +++ b/src/eDFT/unrestricted_hybrid_correlation_potential.f90 @@ -42,7 +42,7 @@ subroutine unrestricted_hybrid_correlation_potential(DFA,nEns,wEns,nGrid,weight, aC = 0.81d0 - call unrestricted_lda_correlation_potential('VWN5 ',nEns,wEns,nGrid,weight,nBas,AO,rho,FcLDA) + call unrestricted_lda_correlation_potential('VWN3 ',nEns,wEns,nGrid,weight,nBas,AO,rho,FcLDA) call unrestricted_gga_correlation_potential('LYP ',nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,FcGGA) Fc(:,:,:) = FcLDA(:,:,:) + aC*(FcGGA(:,:,:) - FcLDA(:,:,:)) diff --git a/src/eDFT/unrestricted_lda_correlation_energy.f90 b/src/eDFT/unrestricted_lda_correlation_energy.f90 index 938ec59..4837f1e 100644 --- a/src/eDFT/unrestricted_lda_correlation_energy.f90 +++ b/src/eDFT/unrestricted_lda_correlation_energy.f90 @@ -34,6 +34,10 @@ subroutine unrestricted_lda_correlation_energy(DFA,nEns,wEns,nGrid,weight,rho,Ec ! Vosko, Wilk and Nusair's functional V: Can. J. Phys. 58 (1980) 1200 + case ('VWN3') + + call UVWN3_lda_correlation_energy(nGrid,weight,rho,Ec) + case ('VWN5') call UVWN5_lda_correlation_energy(nGrid,weight,rho,Ec) diff --git a/src/eDFT/unrestricted_lda_correlation_individual_energy.f90 b/src/eDFT/unrestricted_lda_correlation_individual_energy.f90 index 1db2a25..6cdb3b9 100644 --- a/src/eDFT/unrestricted_lda_correlation_individual_energy.f90 +++ b/src/eDFT/unrestricted_lda_correlation_individual_energy.f90 @@ -26,6 +26,10 @@ subroutine unrestricted_lda_correlation_individual_energy(DFA,LDA_centered,nEns, ! Vosko, Wilk and Nusair's functional V: Can. J. Phys. 58 (1980) 1200 + case ('VWN3') + + call UVWN3_lda_correlation_individual_energy(nGrid,weight,rhow,rho,Ec) + case ('VWN5') call UVWN5_lda_correlation_individual_energy(nGrid,weight,rhow,rho,Ec) diff --git a/src/eDFT/unrestricted_lda_correlation_potential.f90 b/src/eDFT/unrestricted_lda_correlation_potential.f90 index 549bc55..e66b357 100644 --- a/src/eDFT/unrestricted_lda_correlation_potential.f90 +++ b/src/eDFT/unrestricted_lda_correlation_potential.f90 @@ -38,6 +38,10 @@ include 'parameters.h' ! Vosko, Wilk and Nusair's functional V: Can. J. Phys. 58 (1980) 1200 + case ('VWN3') + + call UVWN3_lda_correlation_potential(nGrid,weight(:),nBas,AO(:,:),rho(:,:),Fc(:,:,:)) + case ('VWN5') call UVWN5_lda_correlation_potential(nGrid,weight(:),nBas,AO(:,:),rho(:,:),Fc(:,:,:)) From 622cf193318d832b288e3e211b9531a9257580b0 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Thu, 25 Feb 2021 15:02:16 +0100 Subject: [PATCH 22/63] potental PW92 --- input/dft | 6 +++--- input/methods | 2 +- src/eDFT/unrestricted_lda_correlation_energy.f90 | 6 +++--- src/eDFT/unrestricted_lda_correlation_potential.f90 | 8 +++----- 4 files changed, 10 insertions(+), 12 deletions(-) diff --git a/input/dft b/input/dft index c783a3f..f2a0704 100644 --- a/input/dft +++ b/input/dft @@ -6,14 +6,14 @@ # GGA = 2: B88,G96,PBE # MGGA = 3: # Hybrid = 4: HF,B3,PBE - 4 BHHLYP + 2 B88 # correlation rung: # Hartree = 0: H -# LDA = 1: VWN3,VWN5,eVWN5 +# LDA = 1: PW92,VWN3,VWN5,eVWN5 # GGA = 2: LYP,PBE # MGGA = 3: # Hybrid = 4: HF,LYP,PBE - 4 BHHLYP + 1 PW92 # quadrature grid SG-n 1 # Number of states in ensemble (nEns) diff --git a/input/methods b/input/methods index 94ad703..9dac2ea 100644 --- a/input/methods +++ b/input/methods @@ -1,5 +1,5 @@ # RHF UHF KS MOM - F F T F + T F F F # MP2* MP3 MP2-F12 F F F # CCD DCD CCSD CCSD(T) diff --git a/src/eDFT/unrestricted_lda_correlation_energy.f90 b/src/eDFT/unrestricted_lda_correlation_energy.f90 index 4837f1e..49a72df 100644 --- a/src/eDFT/unrestricted_lda_correlation_energy.f90 +++ b/src/eDFT/unrestricted_lda_correlation_energy.f90 @@ -32,7 +32,9 @@ subroutine unrestricted_lda_correlation_energy(DFA,nEns,wEns,nGrid,weight,rho,Ec call UW38_lda_correlation_energy(nGrid,weight,rho,Ec) -! Vosko, Wilk and Nusair's functional V: Can. J. Phys. 58 (1980) 1200 + case ('PW92') + + call UPW92_lda_correlation_energy(nGrid,weight,rho,Ec) case ('VWN3') @@ -42,8 +44,6 @@ subroutine unrestricted_lda_correlation_energy(DFA,nEns,wEns,nGrid,weight,rho,Ec call UVWN5_lda_correlation_energy(nGrid,weight,rho,Ec) -! Chachiyo's LDA correlation functional: Chachiyo, JCP 145 (2016) 021101 - case ('C16') call UC16_lda_correlation_energy(nGrid,weight,rho,Ec) diff --git a/src/eDFT/unrestricted_lda_correlation_potential.f90 b/src/eDFT/unrestricted_lda_correlation_potential.f90 index e66b357..9d44349 100644 --- a/src/eDFT/unrestricted_lda_correlation_potential.f90 +++ b/src/eDFT/unrestricted_lda_correlation_potential.f90 @@ -30,13 +30,13 @@ include 'parameters.h' Fc(:,:,:) = 0d0 -! Wigner's LDA correlation functional: Wigner, Trans. Faraday Soc. 34 (1938) 678 - case ('W38') call UW38_lda_correlation_potential(nGrid,weight(:),nBas,AO(:,:),rho(:,:),Fc(:,:,:)) -! Vosko, Wilk and Nusair's functional V: Can. J. Phys. 58 (1980) 1200 + case ('PW92') + + call UPW92_lda_correlation_potential(nGrid,weight(:),nBas,AO(:,:),rho(:,:),Fc(:,:,:)) case ('VWN3') @@ -46,8 +46,6 @@ include 'parameters.h' call UVWN5_lda_correlation_potential(nGrid,weight(:),nBas,AO(:,:),rho(:,:),Fc(:,:,:)) -! Chachiyo's LDA correlation functional: Chachiyo, JCP 145 (2016) 021101 - case ('C16') call UC16_lda_correlation_potential(nGrid,weight(:),nBas,AO(:,:),rho(:,:),Fc(:,:,:)) From a594e0fa7c07a261f171efa4086cd8ca16fa1d3f Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Thu, 25 Feb 2021 15:02:35 +0100 Subject: [PATCH 23/63] PW92 --- src/eDFT/UPW92_lda_correlation_energy.f90 | 122 ++++++++++++ src/eDFT/UPW92_lda_correlation_potential.f90 | 184 +++++++++++++++++++ 2 files changed, 306 insertions(+) create mode 100644 src/eDFT/UPW92_lda_correlation_energy.f90 create mode 100644 src/eDFT/UPW92_lda_correlation_potential.f90 diff --git a/src/eDFT/UPW92_lda_correlation_energy.f90 b/src/eDFT/UPW92_lda_correlation_energy.f90 new file mode 100644 index 0000000..e4dcb28 --- /dev/null +++ b/src/eDFT/UPW92_lda_correlation_energy.f90 @@ -0,0 +1,122 @@ +subroutine UPW92_lda_correlation_energy(nGrid,weight,rho,Ec) + +! Compute unrestricted PW92 LDA correlation energy + + implicit none + + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + +! Local variables + + integer :: iG + double precision :: ra,rb,r,rs,x,z + double precision :: A_p,a1_p,b1_p,b2_p,b3_p,b4_p + double precision :: A_f,a1_f,b1_f,b2_f,b3_f,b4_f + double precision :: A_a,a1_a,b1_a,b2_a,b3_a,b4_a + + double precision :: ec_z,ec_p,ec_f,ec_a + double precision :: fz,d2fz + +! Output variables + + double precision :: Ec(nsp) + +! Parameters of the functional + + A_p = 0.031091d0 + a1_p = 0.21370d0 + b1_p = 7.5957d0 + b2_p = 3.5876d0 + b3_p = 1.6382d0 + b4_p = 0.49294d0 + + A_f = 0.015545d0 + a1_f = 0.20548d0 + b1_f = 14.1189d0 + b2_f = 6.1977d0 + b3_f = 3.3662d0 + b4_f = 0.62517d0 + + A_a = 0.016887d0 + a1_a = 0.11125d0 + b1_a = 10.357d0 + b2_a = 3.6231d0 + b3_a = 0.88026d0 + b4_a = 0.49671d0 + +! Initialization + + Ec(:) = 0d0 + + do iG=1,nGrid + + ra = max(0d0,rho(iG,1)) + rb = max(0d0,rho(iG,2)) + +! alpha-alpha contribution + + if(ra > threshold) then + + rs = (4d0*pi*ra/3d0)**(-1d0/3d0) + + ec_f = b1_f*sqrt(rs) + b2_f*rs + b3_f*rs**(3d0/2d0) + b4_f*rs**2 + ec_f = -2d0*A_f*(1d0 + a1_f*rs)*log(1d0 + 1d0/(2d0*A_f*ec_f)) + + Ec(1) = Ec(1) + weight(iG)*ec_f*ra + + end if + +! alpha-beta contribution + + if(ra > threshold .or. rb > threshold) then + + r = ra + rb + rs = (4d0*pi*r/3d0)**(-1d0/3d0) + z = (ra - rb)/r + x = sqrt(rs) + + fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 + fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) + + d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) + + ec_p = b1_p*sqrt(rs) + b2_p*rs + b3_p*rs**(3d0/2d0) + b4_p*rs**2 + ec_p = -2d0*A_p*(1d0 + a1_p*rs)*log(1d0 + 1d0/(2d0*A_p*ec_p)) + + ec_f = b1_f*sqrt(rs) + b2_f*rs + b3_f*rs**(3d0/2d0) + b4_f*rs**2 + ec_f = -2d0*A_f*(1d0 + a1_f*rs)*log(1d0 + 1d0/(2d0*A_f*ec_f)) + + ec_a = b1_a*sqrt(rs) + b2_a*rs + b3_a*rs**(3d0/2d0) + b4_a*rs**2 + ec_a = +2d0*A_a*(1d0 + a1_a*rs)*log(1d0 + 1d0/(2d0*A_a*ec_a)) + + ec_z = ec_p + ec_a*fz/d2fz*(1d0-z**4) + (ec_f - ec_p)*fz*z**4 + + Ec(2) = Ec(2) + weight(iG)*ec_z*r + + end if + +! beta-beta contribution + + if(rb > threshold) then + + rs = (4d0*pi*rb/3d0)**(-1d0/3d0) + x = sqrt(rs) + + ec_f = b1_f*sqrt(rs) + b2_f*rs + b3_f*rs**(3d0/2d0) + b4_f*rs**2 + ec_f = -2d0*A_f*(1d0 + a1_f*rs)*log(1d0 + 1d0/(2d0*A_f*ec_f)) + + Ec(3) = Ec(3) + weight(iG)*ec_f*rb + + end if + + end do + + Ec(2) = Ec(2) - Ec(1) - Ec(3) + +end subroutine UPW92_lda_correlation_energy diff --git a/src/eDFT/UPW92_lda_correlation_potential.f90 b/src/eDFT/UPW92_lda_correlation_potential.f90 new file mode 100644 index 0000000..9579b62 --- /dev/null +++ b/src/eDFT/UPW92_lda_correlation_potential.f90 @@ -0,0 +1,184 @@ +subroutine UPW92_lda_correlation_potential(nGrid,weight,nBas,AO,rho,Fc) + +! Compute unrestricted PW92 LDA correlation potential + + implicit none + + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + integer,intent(in) :: nBas + double precision,intent(in) :: AO(nBas,nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + +! Local variables + + integer :: mu,nu,iG + double precision :: ra,rb,r,rs,z,t,dt + double precision :: A_p,a1_p,b1_p,b2_p,b3_p,b4_p + double precision :: A_f,a1_f,b1_f,b2_f,b3_f,b4_f + double precision :: A_a,a1_a,b1_a,b2_a,b3_a,b4_a + double precision :: dfzdz,decdrs_p,decdrs_f,decdrs_a + double precision :: dzdra,dfzdra,drsdra,decdra_p,decdra_f,decdra_a,decdra + double precision :: dzdrb,dfzdrb,drsdrb,decdrb_p,decdrb_f,decdrb_a,decdrb + + double precision :: ec_z,ec_p,ec_f,ec_a + double precision :: fz,d2fz + +! Output variables + + double precision :: Fc(nBas,nBas,nspin) + +! Parameters of the functional + + A_p = 0.031091d0 + a1_p = 0.21370d0 + b1_p = 7.5957d0 + b2_p = 3.5876d0 + b3_p = 1.6382d0 + b4_p = 0.49294d0 + + A_f = 0.015545d0 + a1_f = 0.20548d0 + b1_f = 14.1189d0 + b2_f = 6.1977d0 + b3_f = 3.3662d0 + b4_f = 0.62517d0 + + A_a = 0.016887d0 + a1_a = 0.11125d0 + b1_a = 10.357d0 + b2_a = 3.6231d0 + b3_a = 0.88026d0 + b4_a = 0.49671d0 + +! Initialization + + Fc(:,:,:) = 0d0 + + do mu=1,nBas + do nu=1,nBas + do iG=1,nGrid + + ra = max(0d0,rho(iG,1)) + rb = max(0d0,rho(iG,2)) + +! spin-up contribution + + if(ra > threshold) then + + r = ra + rb + rs = (4d0*pi*r/3d0)**(-1d0/3d0) + z = (ra - rb)/r + + fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 + fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) + + d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) + + ec_p = b1_p*sqrt(rs) + b2_p*rs + b3_p*rs**(3d0/2d0) + b4_p*rs**2 + ec_p = -2d0*A_p*(1d0 + a1_p*rs)*log(1d0 + 1d0/(2d0*A_p*ec_p)) + + ec_f = b1_f*sqrt(rs) + b2_f*rs + b3_f*rs**(3d0/2d0) + b4_f*rs**2 + ec_f = -2d0*A_f*(1d0 + a1_f*rs)*log(1d0 + 1d0/(2d0*A_f*ec_f)) + + ec_a = b1_a*sqrt(rs) + b2_a*rs + b3_a*rs**(3d0/2d0) + b4_a*rs**2 + ec_a = +2d0*A_a*(1d0 + a1_a*rs)*log(1d0 + 1d0/(2d0*A_a*ec_a)) + + ec_z = ec_p + ec_a*fz/d2fz*(1d0-z**4) + (ec_f - ec_p)*fz*z**4 + + dzdra = (1d0 - z)/r + dfzdz = (4d0/3d0)*((1d0 + z)**(1d0/3d0) - (1d0 - z)**(1d0/3d0))/(2d0*(2d0**(1d0/3d0) - 1d0)) + dfzdra = dzdra*dfzdz + drsdra = - (36d0*pi)**(-1d0/3d0)*r**(-4d0/3d0) + + t = b1_p*sqrt(rs) + b2_p*rs + b3_p*rs**(3d0/2d0) + b4_p*rs**2 + dt = 0.5d0*b1_p*sqrt(rs) + b2_p*rs + 1.5d0*b3_p*rs**(3d0/2d0) + 2d0*b4_p*rs**2 + decdrs_p = (1d0 + a1_p*rs)/rs*dt/(t**2*(1d0 + 1d0/(2d0*A_p*t))) & + - 2d0*A_p*a1_p*log(1d0 + 1d0/(2d0*A_p*t)) + + t = b1_f*sqrt(rs) + b2_f*rs + b3_f*rs**(3d0/2d0) + b4_f*rs**2 + dt = 0.5d0*b1_f*sqrt(rs) + b2_f*rs + 1.5d0*b3_f*rs**(3d0/2d0) + 2d0*b4_f*rs**2 + decdrs_f = (1d0 + a1_f*rs)/rs*dt/(t**2*(1d0 + 1d0/(2d0*A_f*t))) & + - 2d0*A_f*a1_f*log(1d0 + 1d0/(2d0*A_f*t)) + + t = b1_a*sqrt(rs) + b2_a*rs + b3_a*rs**(3d0/2d0) + b4_a*rs**2 + dt = 0.5d0*b1_a*sqrt(rs) + b2_a*rs + 1.5d0*b3_a*rs**(3d0/2d0) + 2d0*b4_a*rs**2 + decdrs_a = (1d0 + a1_a*rs)/rs*dt/(t**2*(1d0 + 1d0/(2d0*A_a*t))) & + - 2d0*A_a*a1_a*log(1d0 + 1d0/(2d0*A_a*t)) + + decdra_p = drsdra*decdrs_p + decdra_f = drsdra*decdrs_f + decdra_a = drsdra*decdrs_a + + decdra = decdra_p + decdra_a*fz/d2fz*(1d0-z**4) + ec_a*dfzdra/d2fz*(1d0-z**4) - 4d0*ec_a*fz/d2fz*dzdra*z**3 & + + (decdra_f - decdra_p)*fz*z**4 + (ec_f - ec_p)*dfzdra*z**4 + 4d0*(ec_f - ec_p)*fz*dzdra*z**3 + + Fc(mu,nu,1) = Fc(mu,nu,1) + weight(iG)*AO(mu,iG)*AO(nu,iG)*(ec_z + decdra*r) + + end if + +! spin-down contribution + + if(rb > threshold) then + + r = ra + rb + rs = (4d0*pi*r/3d0)**(-1d0/3d0) + z = (ra - rb)/r + + fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 + fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) + + d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) + + ec_p = b1_p*sqrt(rs) + b2_p*rs + b3_p*rs**(3d0/2d0) + b4_p*rs**2 + ec_p = -2d0*A_p*(1d0 + a1_p*rs)*log(1d0 + 1d0/(2d0*A_p*ec_p)) + + ec_f = b1_f*sqrt(rs) + b2_f*rs + b3_f*rs**(3d0/2d0) + b4_f*rs**2 + ec_f = -2d0*A_f*(1d0 + a1_f*rs)*log(1d0 + 1d0/(2d0*A_f*ec_f)) + + ec_a = b1_a*sqrt(rs) + b2_a*rs + b3_a*rs**(3d0/2d0) + b4_a*rs**2 + ec_a = +2d0*A_a*(1d0 + a1_a*rs)*log(1d0 + 1d0/(2d0*A_a*ec_a)) + + ec_z = ec_p + ec_a*fz/d2fz*(1d0-z**4) + (ec_f - ec_p)*fz*z**4 + + dzdrb = - (1d0 + z)/r + dfzdz = (4d0/3d0)*((1d0 + z)**(1d0/3d0) - (1d0 - z)**(1d0/3d0))/(2d0*(2d0**(1d0/3d0) - 1d0)) + dfzdrb = dzdrb*dfzdz + + drsdrb = - (36d0*pi)**(-1d0/3d0)*r**(-4d0/3d0) + + + t = b1_p*sqrt(rs) + b2_p*rs + b3_p*rs**(3d0/2d0) + b4_p*rs**2 + dt = 0.5d0*b1_p*sqrt(rs) + b2_p*rs + 1.5d0*b3_p*rs**(3d0/2d0) + 2d0*b4_p*rs**2 + decdrs_p = (1d0 + a1_p*rs)/rs*dt/(t**2*(1d0 + 1d0/(2d0*A_p*t))) & + - 2d0*A_p*a1_p*log(1d0 + 1d0/(2d0*A_p*t)) + + t = b1_f*sqrt(rs) + b2_f*rs + b3_f*rs**(3d0/2d0) + b4_f*rs**2 + dt = 0.5d0*b1_f*sqrt(rs) + b2_f*rs + 1.5d0*b3_f*rs**(3d0/2d0) + 2d0*b4_f*rs**2 + decdrs_f = (1d0 + a1_f*rs)/rs*dt/(t**2*(1d0 + 1d0/(2d0*A_f*t))) & + - 2d0*A_f*a1_f*log(1d0 + 1d0/(2d0*A_f*t)) + + t = b1_a*sqrt(rs) + b2_a*rs + b3_a*rs**(3d0/2d0) + b4_a*rs**2 + dt = 0.5d0*b1_a*sqrt(rs) + b2_a*rs + 1.5d0*b3_a*rs**(3d0/2d0) + 2d0*b4_a*rs**2 + decdrs_a = (1d0 + a1_a*rs)/rs*dt/(t**2*(1d0 + 1d0/(2d0*A_a*t))) & + - 2d0*A_a*a1_a*log(1d0 + 1d0/(2d0*A_a*t)) + + decdrb_p = drsdrb*decdrs_p + decdrb_f = drsdrb*decdrs_f + decdrb_a = drsdrb*decdrs_a + + decdrb = decdrb_p + decdrb_a*fz/d2fz*(1d0-z**4) + ec_a*dfzdrb/d2fz*(1d0-z**4) - 4d0*ec_a*fz/d2fz*dzdrb*z**3 & + + (decdrb_f - decdrb_p)*fz*z**4 + (ec_f - ec_p)*dfzdrb*z**4 + 4d0*(ec_f - ec_p)*fz*dzdrb*z**3 + Fc(mu,nu,2) = Fc(mu,nu,2) + weight(iG)*AO(mu,iG)*AO(nu,iG)*(ec_z + decdrb*r) + + end if + + end do + end do + end do + +end subroutine UPW92_lda_correlation_potential From a7594c270a8ffc4a2d3f6a96efe52dfa0ca1078e Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Fri, 26 Feb 2021 09:55:10 +0100 Subject: [PATCH 24/63] UPBE --- GoDuck | Bin 3345144 -> 3345144 bytes input/methods | 2 +- input/options | 4 ++-- mol/h2.xyz | 2 +- src/eDFT/UPW92_lda_correlation_energy.f90 | 4 +--- 5 files changed, 5 insertions(+), 7 deletions(-) diff --git a/GoDuck b/GoDuck index ac64321013705ac028251f03d4bbe0725480af99..4b7a79c44f4cca826093630f5b91e051f2308854 100755 GIT binary patch delta 630 zcmXw!&1(};6vdgmd^Aa?#_!e`t>4}or+%!2Fz%%U+z*9r>_$ZdcjJKK0V`#SiZWm- zh#(3PL{MiD<}avO=t87JaN$aVE~O9yzPYb14*WRho_FuteDcZK)Vd7|IVj{&KoKQO zpo|Ktn1qcfY(ov(u>(7?3%jugdohg}>_Z*<(ZB&5#4HZsFpl6Tj^Q{?;N*K+UQ(gI z7_ThRwJD*|P3li)6s?DpsK;5jO5+*zAfwmRE~!VF(zoPVlGfjmJ1gXU)?WVV$McKv z+84T|R8e;AXd6Tc0p+Poqm}@`hy0>>;0s@CF#nL8Yb=jCTGHQ z|Bz$ms(-1S&%6&FCnl_yIS?!E*qr3lq`t(f@t`5pn&Yr0w0?ozics|;kBf#b@xT@u zE^t^9@-K5z7HVDp|K8{ZJK{x6pZgMyd=3hxaED#9ws)5s;zj8)ClYq<^H^mRb;7OY zl~uOIiv5RM&&J)S{LGTV{2JSNA@4c2bIR7=>Av8=Q1fMWQsxa`=?y0BvSSIQZ+M|1 h)QUMMW^}KYuvSy+l$N74r*&HEjMmw>mz;Ck{{R~T<7)r_ delta 630 zcmXxeOK1~O6b4`>H;*Q9YJ9iGXnlK5och>?aW5s{ekd-g-H3?bZX8hj(Mm}{unw3C zB8Wl+5v;QagBxAdAi5Cg5L~#Dpi3#lfOpQ-#Sb6zbZ)>x1`1i^kVgSy zD58WiHo?X?HluV9u7s(v9SBbxb2wkY)0DUd2zCp#w^e50RcA^A>y({+DP&ywllfNEyi z`9;o{+5Jt9`L6tjn%T5l^*A=eYLNq}qPER(MlI_<@haS}i5k<~s)*Lkuv-$9&+;g5 zbdLMBXfVsIg2=zfaZ%K`^8eoODm&7Jb)S3cfqr7>bC47HH`&dIy0^F{U6?FzELHn1 zk5sC#-TJqAX^CyABL7}`Hoew)$d4@1%nI9Ck@uLJ=5FT+2S)X$=`W=lgJ=2$v)f_E oQlajW7d%@MH6jl3sqS=R)~V|p*Ku^Fbx!D<)HxM( threshold) then rs = (4d0*pi*rb/3d0)**(-1d0/3d0) - x = sqrt(rs) ec_f = b1_f*sqrt(rs) + b2_f*rs + b3_f*rs**(3d0/2d0) + b4_f*rs**2 ec_f = -2d0*A_f*(1d0 + a1_f*rs)*log(1d0 + 1d0/(2d0*A_f*ec_f)) From 5f55c1af4d0e3f5816a0f9a12907d1c754772d74 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Mon, 1 Mar 2021 14:55:29 +0100 Subject: [PATCH 25/63] fixing up qsGW Ec --- input/dft | 4 +- input/methods | 4 +- src/MBPT/print_qsGW.f90 | 24 ++++-- src/MBPT/print_qsUGW.f90 | 6 +- src/MBPT/qsGW.f90 | 2 +- src/MBPT/qsUGW.f90 | 10 ++- src/MBPT/self_energy_correlation.f90 | 84 +++++++++++-------- .../unrestricted_self_energy_correlation.f90 | 26 +++++- src/eDFT/UPW92_lda_correlation_energy.f90 | 6 +- src/eDFT/UPW92_lda_correlation_potential.f90 | 1 + src/eDFT/UVWN3_lda_correlation_energy.f90 | 6 +- src/eDFT/UVWN3_lda_correlation_potential.f90 | 26 +++--- src/eDFT/UVWN5_lda_correlation_energy.f90 | 6 +- src/eDFT/UVWN5_lda_correlation_potential.f90 | 30 +++---- .../unrestricted_gga_correlation_energy.f90 | 4 + ...unrestricted_gga_correlation_potential.f90 | 2 +- 16 files changed, 140 insertions(+), 101 deletions(-) diff --git a/input/dft b/input/dft index f2a0704..3220f9d 100644 --- a/input/dft +++ b/input/dft @@ -6,14 +6,14 @@ # GGA = 2: B88,G96,PBE # MGGA = 3: # Hybrid = 4: HF,B3,PBE - 2 B88 + 1 S51 # correlation rung: # Hartree = 0: H # LDA = 1: PW92,VWN3,VWN5,eVWN5 # GGA = 2: LYP,PBE # MGGA = 3: # Hybrid = 4: HF,LYP,PBE - 1 PW92 + 0 H # quadrature grid SG-n 1 # Number of states in ensemble (nEns) diff --git a/input/methods b/input/methods index 504e70c..2452cdc 100644 --- a/input/methods +++ b/input/methods @@ -1,5 +1,5 @@ # RHF UHF KS MOM - T F F F + F T F F # MP2* MP3 MP2-F12 F F F # CCD DCD CCSD CCSD(T) @@ -13,7 +13,7 @@ # G0F2 evGF2 G0F3 evGF3 F F F F # G0W0* evGW* qsGW* - F F T + T F T # G0T0 evGT qsGT F F F # MCMP2 diff --git a/src/MBPT/print_qsGW.f90 b/src/MBPT/print_qsGW.f90 index df854d6..d6be17b 100644 --- a/src/MBPT/print_qsGW.f90 +++ b/src/MBPT/print_qsGW.f90 @@ -1,4 +1,4 @@ -subroutine print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,ENuc,P,T,V,J,K,F,SigC,Z,EcRPA,EqsGW,dipole) +subroutine print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,ENuc,P,T,V,J,K,F,SigC,Z,EcGM,EcRPA,EqsGW,dipole) ! Print one-electron energies and other stuff for qsGW @@ -7,9 +7,18 @@ subroutine print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,ENuc,P,T,V,J,K,F,SigC,Z ! Input variables - integer,intent(in) :: nBas,nO,nSCF - double precision,intent(in) :: ENuc,EcRPA,Conv,thresh - double precision,intent(in) :: eHF(nBas),eGW(nBas),c(nBas),P(nBas,nBas) + integer,intent(in) :: nBas + integer,intent(in) :: nO + integer,intent(in) :: nSCF + double precision,intent(in) :: ENuc + double precision,intent(in) :: EcGM + double precision,intent(in) :: EcRPA + double precision,intent(in) :: Conv + double precision,intent(in) :: thresh + double precision,intent(in) :: eHF(nBas) + double precision,intent(in) :: eGW(nBas) + double precision,intent(in) :: c(nBas) + double precision,intent(in) :: P(nBas,nBas) double precision,intent(in) :: T(nBas,nBas),V(nBas,nBas) double precision,intent(in) :: J(nBas,nBas),K(nBas,nBas),F(nBas,nBas) double precision,intent(in) :: Z(nBas),SigC(nBas,nBas) @@ -37,9 +46,8 @@ subroutine print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,ENuc,P,T,V,J,K,F,SigC,Z EV = trace_matrix(nBas,matmul(P,V)) EJ = 0.5d0*trace_matrix(nBas,matmul(P,J)) Ex = 0.25d0*trace_matrix(nBas,matmul(P,K)) - Ec = 0d0 ! Ec = -0.50d0*trace_matrix(nBas,matmul(P,SigC)) - EqsGW = ET + EV + EJ + Ex + Ec + EqsGW = ET + EV + EJ + Ex + EcGM ! Dump results @@ -69,7 +77,7 @@ subroutine print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,ENuc,P,T,V,J,K,F,SigC,Z write(*,*)'-------------------------------------------' write(*,'(2X,A30,F15.6,A3)') ' qsGW total energy:',EqsGW + ENuc,' au' write(*,'(2X,A30,F15.6,A3)') ' qsGW exchange energy:',Ex,' au' -! write(*,'(2X,A30,F15.6,A3)') ' qsGW correlation energy:',Ec,' au' + write(*,'(2X,A30,F15.6,A3)') ' qsGW correlation energy:',EcGM,' au' write(*,'(2X,A30,F15.6,A3)') 'RPA@qsGW correlation energy:',EcRPA,' au' write(*,*)'-------------------------------------------' write(*,*) @@ -89,7 +97,7 @@ subroutine print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,ENuc,P,T,V,J,K,F,SigC,Z write(*,'(A32,1X,F16.10,A3)') ' Two-electron energy: ',EJ + Ex,' au' write(*,'(A32,1X,F16.10,A3)') ' Hartree energy: ',EJ,' au' write(*,'(A32,1X,F16.10,A3)') ' Exchange energy: ',Ex,' au' -! write(*,'(A32,1X,F16.10,A3)') ' Correlation energy: ',Ec,' au' + write(*,'(A32,1X,F16.10,A3)') ' Correlation energy: ',EcGM,' au' write(*,'(A50)') '---------------------------------------' write(*,'(A32,1X,F16.10,A3)') ' Electronic energy: ',EqsGW,' au' write(*,'(A32,1X,F16.10,A3)') ' Nuclear repulsion: ',ENuc,' au' diff --git a/src/MBPT/print_qsUGW.f90 b/src/MBPT/print_qsUGW.f90 index d753e0e..144b2d9 100644 --- a/src/MBPT/print_qsUGW.f90 +++ b/src/MBPT/print_qsUGW.f90 @@ -1,5 +1,5 @@ subroutine print_qsUGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,cGW,PGW,Ov,T,V,J,K, & - ENuc,ET,EV,EJ,Ex,Ec,EcRPA,EqsGW,SigC,Z,dipole) + ENuc,ET,EV,EJ,Ex,Ec,EcGM,EcRPA,EqsGW,SigC,Z,dipole) ! Print one-electron energies and other stuff for qsUGW @@ -17,6 +17,7 @@ subroutine print_qsUGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,cGW,PGW,Ov,T,V,J,K, & double precision,intent(in) :: EJ(nsp) double precision,intent(in) :: Ex(nspin) double precision,intent(in) :: Ec(nsp) + double precision,intent(in) :: EcGM(nspin) double precision,intent(in) :: EcRPA double precision,intent(in) :: EqsGW double precision,intent(in) :: Conv @@ -103,6 +104,7 @@ subroutine print_qsUGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,cGW,PGW,Ov,T,V,J,K, & write(*,'(2X,A30,F15.6,A3)') ' qsUGW total energy:',EqsGW + ENuc,' au' write(*,'(2X,A30,F15.6,A3)') ' qsUGW exchange energy:',sum(Ex(:)),' au' ! write(*,'(2X,A30,F15.6,A3)') ' qsUGW correlation energy:',sum(Ec(:)),' au' + write(*,'(2X,A30,F15.6,A3)') ' GM@qsUGW correlation energy:',sum(EcGM(:)),' au' write(*,'(2X,A30,F15.6,A3)') 'RPA@qsUGW correlation energy:',EcRPA,' au' write(*,*)'-------------------------------------------------------------------------------& -------------------------------------------------' @@ -141,7 +143,7 @@ subroutine print_qsUGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,cGW,PGW,Ov,T,V,J,K, & write(*,'(A40,1X,F16.10,A3)') ' Exchange energy: ',sum(Ex(:)),' au' write(*,'(A40,1X,F16.10,A3)') ' Exchange a energy: ',Ex(1),' au' write(*,'(A40,1X,F16.10,A3)') ' Exchange b energy: ',Ex(2),' au' -! write(*,*) + write(*,*) ! write(*,'(A40,1X,F16.10,A3)') ' Correlation energy: ',sum(Ec(:)),' au' ! write(*,'(A40,1X,F16.10,A3)') ' Correlation aa energy: ',Ec(1),' au' ! write(*,'(A40,1X,F16.10,A3)') ' Correlation ab energy: ',Ec(2),' au' diff --git a/src/MBPT/qsGW.f90 b/src/MBPT/qsGW.f90 index e906391..db7f56d 100644 --- a/src/MBPT/qsGW.f90 +++ b/src/MBPT/qsGW.f90 @@ -235,7 +235,7 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE ! Print results call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int_AO,dipole) - call print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,ENuc,P,T,V,J,K,F,SigCp,Z,EcRPA,EqsGW,dipole) + call print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,ENuc,P,T,V,J,K,F,SigCp,Z,EcGM,EcRPA,EqsGW,dipole) enddo !------------------------------------------------------------------------ diff --git a/src/MBPT/qsUGW.f90 b/src/MBPT/qsUGW.f90 index 09d8cef..d5b84d2 100644 --- a/src/MBPT/qsUGW.f90 +++ b/src/MBPT/qsUGW.f90 @@ -77,6 +77,7 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOS double precision :: Ex(nspin) double precision :: Ec(nsp) double precision :: EcRPA + double precision :: EcGM(nspin) double precision :: EqsGW double precision :: EcBSE(nspin) double precision :: EcAC(nspin) @@ -230,12 +231,12 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOS if(G0W) then - call unrestricted_self_energy_correlation(eta,nBas,nC,nO,nV,nR,nS_sc,eHF,OmRPA,rho_RPA,SigC) + call unrestricted_self_energy_correlation(eta,nBas,nC,nO,nV,nR,nS_sc,eHF,OmRPA,rho_RPA,SigC,EcGM) call unrestricted_renormalization_factor(eta,nBas,nC,nO,nV,nR,nS_sc,eHF,OmRPA,rho_RPA,Z) else - call unrestricted_self_energy_correlation(eta,nBas,nC,nO,nV,nR,nS_sc,eGW,OmRPA,rho_RPA,SigC) + call unrestricted_self_energy_correlation(eta,nBas,nC,nO,nV,nR,nS_sc,eGW,OmRPA,rho_RPA,SigC,EcGM) call unrestricted_renormalization_factor(eta,nBas,nC,nO,nV,nR,nS_sc,eGW,OmRPA,rho_RPA,Z) endif @@ -321,7 +322,8 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOS ! Coulomb energy EJ(1) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,1),J(:,:,1))) - EJ(2) = 1.0d0*trace_matrix(nBas,matmul(P(:,:,1),J(:,:,2))) + EJ(2) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,1),J(:,:,2))) & + + 0.5d0*trace_matrix(nBas,matmul(P(:,:,2),J(:,:,1))) EJ(3) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,2),J(:,:,2))) ! Exchange energy @@ -348,7 +350,7 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOS !------------------------------------------------------------------------ call dipole_moment(nBas,P(:,:,1)+P(:,:,2),nNuc,ZNuc,rNuc,dipole_int_AO,dipole) - call print_qsUGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,P,S,T,V,J,K,ENuc,ET,EV,EJ,Ex,Ec,EcRPA,EqsGW,SigCp,Z,dipole) + call print_qsUGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,P,S,T,V,J,K,ENuc,ET,EV,EJ,Ex,Ec,EcGM,EcRPA,EqsGW,SigCp,Z,dipole) enddo !------------------------------------------------------------------------ diff --git a/src/MBPT/self_energy_correlation.f90 b/src/MBPT/self_energy_correlation.f90 index e47a9b4..369ee32 100644 --- a/src/MBPT/self_energy_correlation.f90 +++ b/src/MBPT/self_energy_correlation.f90 @@ -16,7 +16,9 @@ subroutine self_energy_correlation(COHSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho,Ec ! Local variables - integer :: i,j,a,b,p,x,y,jb + integer :: i,j,a,b + integer :: p,q,r + integer :: jb double precision :: eps ! Output variables @@ -26,7 +28,7 @@ subroutine self_energy_correlation(COHSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho,Ec ! Initialize - SigC = 0d0 + SigC(:,:) = 0d0 !-----------------------------! ! COHSEX static approximation ! @@ -36,32 +38,32 @@ subroutine self_energy_correlation(COHSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho,Ec ! COHSEX: SEX of the COHSEX correlation self-energy - do x=nC+1,nBas-nR - do y=nC+1,nBas-nR + do p=nC+1,nBas-nR + do q=nC+1,nBas-nR do i=nC+1,nO do jb=1,nS - SigC(x,y) = SigC(x,y) + 4d0*rho(x,i,jb)*rho(y,i,jb)/Omega(jb) - enddo - enddo - enddo - enddo + SigC(p,q) = SigC(p,q) + 4d0*rho(p,i,jb)*rho(q,i,jb)/Omega(jb) + end do + end do + end do + end do ! COHSEX: COH part of the COHSEX correlation self-energy - do x=nC+1,nBas-nR - do y=nC+1,nBas-nR - do p=nC+1,nBas-nR + do p=nC+1,nBas-nR + do q=nC+1,nBas-nR + do r=nC+1,nBas-nR do jb=1,nS - SigC(x,y) = SigC(x,y) - 2d0*rho(x,p,jb)*rho(y,p,jb)/Omega(jb) - enddo - enddo - enddo - enddo + SigC(p,q) = SigC(p,q) - 2d0*rho(p,r,jb)*rho(q,r,jb)/Omega(jb) + end do + end do + end do + end do EcGM = 0d0 do i=nC+1,nO EcGM = EcGM + 0.5d0*SigC(i,i) - enddo + end do else @@ -71,30 +73,42 @@ subroutine self_energy_correlation(COHSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho,Ec ! Occupied part of the correlation self-energy - do x=nC+1,nBas-nR - do y=nC+1,nBas-nR + do p=nC+1,nBas-nR + do q=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) + 2d0*rho(x,i,jb)*rho(y,i,jb)*eps/(eps**2 + eta**2) - enddo - enddo - enddo - enddo + eps = e(p) - e(i) + Omega(jb) + SigC(p,q) = SigC(p,q) + 2d0*rho(p,i,jb)*rho(q,i,jb)*eps/(eps**2 + eta**2) + end do + end do + end do + end do ! Virtual part of the correlation self-energy - do x=nC+1,nBas-nR - do y=nC+1,nBas-nR + do p=nC+1,nBas-nR + do q=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) + 2d0*rho(x,a,jb)*rho(y,a,jb)*eps/(eps**2 + eta**2) - enddo - enddo - enddo - enddo + eps = e(p) - e(a) - Omega(jb) + SigC(p,q) = SigC(p,q) + 2d0*rho(p,a,jb)*rho(q,a,jb)*eps/(eps**2 + eta**2) + end do + end do + end do + end do - endif + ! GM correlation energy + + EcGM = 0d0 + do i=nC+1,nO + do a=nO+1,nBas-nR + do jb=1,nS + eps = e(a) - e(i) + Omega(jb) + EcGM = EcGM - 4d0*rho(a,i,jb)*rho(a,i,jb)*eps/(eps**2 + eta**2) + end do + end do + end do + + end if end subroutine self_energy_correlation diff --git a/src/MBPT/unrestricted_self_energy_correlation.f90 b/src/MBPT/unrestricted_self_energy_correlation.f90 index 1fa2f5b..d6c5f98 100644 --- a/src/MBPT/unrestricted_self_energy_correlation.f90 +++ b/src/MBPT/unrestricted_self_energy_correlation.f90 @@ -1,4 +1,4 @@ -subroutine unrestricted_self_energy_correlation(eta,nBas,nC,nO,nV,nR,nSt,e,Omega,rho,SigC) +subroutine unrestricted_self_energy_correlation(eta,nBas,nC,nO,nV,nR,nSt,e,Omega,rho,SigC,EcGM) ! Compute diagonal of the correlation part of the self-energy @@ -26,10 +26,12 @@ subroutine unrestricted_self_energy_correlation(eta,nBas,nC,nO,nV,nR,nSt,e,Omega ! Output variables double precision,intent(out) :: SigC(nBas,nBas,nspin) + double precision :: EcGM(nspin) ! Initialize SigC(:,:,:) = 0d0 + EcGM(:) = 0d0 !--------------! ! Spin-up part ! @@ -61,6 +63,17 @@ subroutine unrestricted_self_energy_correlation(eta,nBas,nC,nO,nV,nR,nSt,e,Omega end do end do + ! GM correlation energy + + do i=nC(1)+1,nO(1) + do a=nO(1)+1,nBas-nR(1) + do jb=1,nSt + eps = e(a,1) - e(i,1) + Omega(jb) + EcGM(1) = EcGM(1) - rho(a,i,jb,1)**2*eps/(eps**2 + eta**2) + end do + end do + end do + !----------------! ! Spin-down part ! !----------------! @@ -91,4 +104,15 @@ subroutine unrestricted_self_energy_correlation(eta,nBas,nC,nO,nV,nR,nSt,e,Omega end do end do + ! GM correlation energy + + do i=nC(2)+1,nO(2) + do a=nO(2)+1,nBas-nR(2) + do jb=1,nSt + eps = e(a,2) - e(i,2) + Omega(jb) + EcGM(2) = EcGM(2) - rho(a,i,jb,2)**2*eps/(eps**2 + eta**2) + end do + end do + end do + end subroutine unrestricted_self_energy_correlation diff --git a/src/eDFT/UPW92_lda_correlation_energy.f90 b/src/eDFT/UPW92_lda_correlation_energy.f90 index f661846..9a70abc 100644 --- a/src/eDFT/UPW92_lda_correlation_energy.f90 +++ b/src/eDFT/UPW92_lda_correlation_energy.f90 @@ -58,6 +58,8 @@ subroutine UPW92_lda_correlation_energy(nGrid,weight,rho,Ec) ra = max(0d0,rho(iG,1)) rb = max(0d0,rho(iG,2)) + r = ra + rb + z = (ra - rb)/r ! alpha-alpha contribution @@ -74,11 +76,9 @@ subroutine UPW92_lda_correlation_energy(nGrid,weight,rho,Ec) ! alpha-beta contribution - if(ra > threshold .or. rb > threshold) then + if(r > threshold) then - r = ra + rb rs = (4d0*pi*r/3d0)**(-1d0/3d0) - z = (ra - rb)/r fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) diff --git a/src/eDFT/UPW92_lda_correlation_potential.f90 b/src/eDFT/UPW92_lda_correlation_potential.f90 index 9579b62..d63d9e4 100644 --- a/src/eDFT/UPW92_lda_correlation_potential.f90 +++ b/src/eDFT/UPW92_lda_correlation_potential.f90 @@ -173,6 +173,7 @@ subroutine UPW92_lda_correlation_potential(nGrid,weight,nBas,AO,rho,Fc) decdrb = decdrb_p + decdrb_a*fz/d2fz*(1d0-z**4) + ec_a*dfzdrb/d2fz*(1d0-z**4) - 4d0*ec_a*fz/d2fz*dzdrb*z**3 & + (decdrb_f - decdrb_p)*fz*z**4 + (ec_f - ec_p)*dfzdrb*z**4 + 4d0*(ec_f - ec_p)*fz*dzdrb*z**3 + Fc(mu,nu,2) = Fc(mu,nu,2) + weight(iG)*AO(mu,iG)*AO(nu,iG)*(ec_z + decdrb*r) end if diff --git a/src/eDFT/UVWN3_lda_correlation_energy.f90 b/src/eDFT/UVWN3_lda_correlation_energy.f90 index 161f1ad..ff9d18e 100644 --- a/src/eDFT/UVWN3_lda_correlation_energy.f90 +++ b/src/eDFT/UVWN3_lda_correlation_energy.f90 @@ -52,6 +52,8 @@ subroutine UVWN3_lda_correlation_energy(nGrid,weight,rho,Ec) ra = max(0d0,rho(iG,1)) rb = max(0d0,rho(iG,2)) + r = ra + rb + z = (ra - rb)/r ! alpha-alpha contribution @@ -73,11 +75,9 @@ subroutine UVWN3_lda_correlation_energy(nGrid,weight,rho,Ec) ! alpha-beta contribution - if(ra > threshold .or. rb > threshold) then + if(r > threshold) then - r = ra + rb rs = (4d0*pi*r/3d0)**(-1d0/3d0) - z = (ra - rb)/r x = sqrt(rs) fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 diff --git a/src/eDFT/UVWN3_lda_correlation_potential.f90 b/src/eDFT/UVWN3_lda_correlation_potential.f90 index 47f8cd9..ce1c93a 100644 --- a/src/eDFT/UVWN3_lda_correlation_potential.f90 +++ b/src/eDFT/UVWN3_lda_correlation_potential.f90 @@ -59,21 +59,22 @@ subroutine UVWN3_lda_correlation_potential(nGrid,weight,nBas,AO,rho,Fc) ra = max(0d0,rho(iG,1)) rb = max(0d0,rho(iG,2)) + r = ra + rb + z = (ra - rb)/r + + fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 + fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) + + d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) + ! spin-up contribution if(ra > threshold) then - - r = ra + rb + rs = (4d0*pi*r/3d0)**(-1d0/3d0) - z = (ra - rb)/r x = sqrt(rs) - fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 - fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) - - d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) - x_p = x*x + b_p*x + c_p x_f = x*x + b_f*x + c_f x_a = x*x + b_a*x + c_a @@ -132,16 +133,9 @@ subroutine UVWN3_lda_correlation_potential(nGrid,weight,nBas,AO,rho,Fc) if(rb > threshold) then - r = ra + rb rs = (4d0*pi*r/3d0)**(-1d0/3d0) - z = (ra - rb)/r x = sqrt(rs) - - fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 - fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) - - d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) - + x_p = x*x + b_p*x + c_p x_f = x*x + b_f*x + c_f x_a = x*x + b_a*x + c_a diff --git a/src/eDFT/UVWN5_lda_correlation_energy.f90 b/src/eDFT/UVWN5_lda_correlation_energy.f90 index 8dadbc4..6ec7eaf 100644 --- a/src/eDFT/UVWN5_lda_correlation_energy.f90 +++ b/src/eDFT/UVWN5_lda_correlation_energy.f90 @@ -52,6 +52,8 @@ subroutine UVWN5_lda_correlation_energy(nGrid,weight,rho,Ec) ra = max(0d0,rho(iG,1)) rb = max(0d0,rho(iG,2)) + r = ra + rb + z = (ra - rb)/r ! alpha-alpha contribution @@ -73,11 +75,9 @@ subroutine UVWN5_lda_correlation_energy(nGrid,weight,rho,Ec) ! alpha-beta contribution - if(ra > threshold .or. rb > threshold) then + if(r > threshold) then - r = ra + rb rs = (4d0*pi*r/3d0)**(-1d0/3d0) - z = (ra - rb)/r x = sqrt(rs) fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 diff --git a/src/eDFT/UVWN5_lda_correlation_potential.f90 b/src/eDFT/UVWN5_lda_correlation_potential.f90 index d36e8a1..c40ea59 100644 --- a/src/eDFT/UVWN5_lda_correlation_potential.f90 +++ b/src/eDFT/UVWN5_lda_correlation_potential.f90 @@ -59,21 +59,21 @@ subroutine UVWN5_lda_correlation_potential(nGrid,weight,nBas,AO,rho,Fc) ra = max(0d0,rho(iG,1)) rb = max(0d0,rho(iG,2)) + r = ra + rb + z = (ra - rb)/r + + rs = (4d0*pi*r/3d0)**(-1d0/3d0) + x = sqrt(rs) + + fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 + fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) + + d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) ! spin-up contribution if(ra > threshold) then - r = ra + rb - rs = (4d0*pi*r/3d0)**(-1d0/3d0) - z = (ra - rb)/r - x = sqrt(rs) - - fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 - fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) - - d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) - x_p = x*x + b_p*x + c_p x_f = x*x + b_f*x + c_f x_a = x*x + b_a*x + c_a @@ -132,16 +132,6 @@ subroutine UVWN5_lda_correlation_potential(nGrid,weight,nBas,AO,rho,Fc) if(rb > threshold) then - r = ra + rb - rs = (4d0*pi*r/3d0)**(-1d0/3d0) - z = (ra - rb)/r - x = sqrt(rs) - - fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 - fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) - - d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) - x_p = x*x + b_p*x + c_p x_f = x*x + b_f*x + c_f x_a = x*x + b_a*x + c_a diff --git a/src/eDFT/unrestricted_gga_correlation_energy.f90 b/src/eDFT/unrestricted_gga_correlation_energy.f90 index 34072e4..bcd3edd 100644 --- a/src/eDFT/unrestricted_gga_correlation_energy.f90 +++ b/src/eDFT/unrestricted_gga_correlation_energy.f90 @@ -30,6 +30,10 @@ subroutine unrestricted_gga_correlation_energy(DFA,nEns,wEns,nGrid,weight,rho,dr call ULYP_gga_correlation_energy(nGrid,weight,rho,drho,Ec) + case ('PBE') + + call UPBE_gga_correlation_energy(nGrid,weight,rho,drho,Ec) + case default call print_warning('!!! GGA correlation energy not available !!!') diff --git a/src/eDFT/unrestricted_gga_correlation_potential.f90 b/src/eDFT/unrestricted_gga_correlation_potential.f90 index fce504f..f52ebe9 100644 --- a/src/eDFT/unrestricted_gga_correlation_potential.f90 +++ b/src/eDFT/unrestricted_gga_correlation_potential.f90 @@ -34,7 +34,7 @@ subroutine unrestricted_gga_correlation_potential(DFA,nEns,wEns,nGrid,weight,nBa case ('PBE') -! call UPBE_gga_correlation_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fc) + call UPBE_gga_correlation_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fc) case default From 7c1304af91d46d5c81374ad79fb8e03738d79366 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Mon, 1 Mar 2021 15:01:47 +0100 Subject: [PATCH 26/63] UPBE --- src/eDFT/UPBE_gga_correlation_energy.f90 | 172 ++++++++++++++++++++ src/eDFT/UPBE_gga_correlation_potential.f90 | 88 ++++++++++ 2 files changed, 260 insertions(+) create mode 100644 src/eDFT/UPBE_gga_correlation_energy.f90 create mode 100644 src/eDFT/UPBE_gga_correlation_potential.f90 diff --git a/src/eDFT/UPBE_gga_correlation_energy.f90 b/src/eDFT/UPBE_gga_correlation_energy.f90 new file mode 100644 index 0000000..461e2bb --- /dev/null +++ b/src/eDFT/UPBE_gga_correlation_energy.f90 @@ -0,0 +1,172 @@ +subroutine UPBE_gga_correlation_energy(nGrid,weight,rho,drho,Ec) + +! Compute unrestricted PBE GGA correlation energy + + implicit none + + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + double precision,intent(in) :: drho(ncart,nGrid,nspin) + +! Local variables + + integer :: iG + double precision :: ra,rb,r,rs,z + double precision :: ga,gab,gb,g + + double precision :: a,b,c,d + double precision :: gam,beta + + double precision :: A_p,a1_p,b1_p,b2_p,b3_p,b4_p + double precision :: A_f,a1_f,b1_f,b2_f,b3_f,b4_f + double precision :: A_a,a1_a,b1_a,b2_a,b3_a,b4_a + + double precision :: ec_z,ec_p,ec_f,ec_a + double precision :: fz,d2fz + + double precision :: H,kf,ks,t,phi + +! Output variables + + double precision :: Ec(nsp) + +! Parameters for PW92 + + A_p = 0.031091d0 + a1_p = 0.21370d0 + b1_p = 7.5957d0 + b2_p = 3.5876d0 + b3_p = 1.6382d0 + b4_p = 0.49294d0 + + A_f = 0.015545d0 + a1_f = 0.20548d0 + b1_f = 14.1189d0 + b2_f = 6.1977d0 + b3_f = 3.3662d0 + b4_f = 0.62517d0 + + A_a = 0.016887d0 + a1_a = 0.11125d0 + b1_a = 10.357d0 + b2_a = 3.6231d0 + b3_a = 0.88026d0 + b4_a = 0.49671d0 + +! Parameters PBE + + gam = (1d0 - log(2d0))/pi**2 + beta = 0.066725d0 + +! Initialization + + Ec(:) = 0d0 + + do iG=1,nGrid + + ra = max(0d0,rho(iG,1)) + rb = max(0d0,rho(iG,2)) + r = ra + rb + z = (ra - rb)/r + +! alpha-alpha contribution + + if(ra > threshold) then + + rs = (4d0*pi*ra/3d0)**(-1d0/3d0) + + ec_f = b1_f*sqrt(rs) + b2_f*rs + b3_f*rs**(3d0/2d0) + b4_f*rs**2 + ec_f = -2d0*A_f*(1d0 + a1_f*rs)*log(1d0 + 1d0/(2d0*A_f*ec_f)) + + ga = drho(1,iG,1)*drho(1,iG,1) + drho(2,iG,1)*drho(2,iG,1) + drho(3,iG,1)*drho(3,iG,1) + + kf = (3d0*pi**2*ra)**(1d0/3d0) + ks = sqrt(4d0*kf/pi) + phi = 1d0 + t = sqrt(ga)/(2d0*phi*ks*ra) + + A = beta/gam/(exp(-ec_f/(gam*phi**3)) - 1d0) + + H = gam*phi**3*log(1d0 + beta/gam*t**2*((1d0 + A*t**2)/(1d0 + A*t**2 + A**2*t**4))) + + Ec(1) = Ec(1) + weight(iG)*(ec_f + H)*ra + + end if + + r = ra + rb + +! alpha-beta contribution + + if(r > threshold) then + + rs = (4d0*pi*r/3d0)**(-1d0/3d0) + + fz = (1d0 + z)**(4d0/3d0) + (1d0 - z)**(4d0/3d0) - 2d0 + fz = fz/(2d0*(2d0**(1d0/3d0) - 1d0)) + d2fz = 4d0/(9d0*(2**(1d0/3d0) - 1d0)) + + ec_p = b1_p*sqrt(rs) + b2_p*rs + b3_p*rs**(3d0/2d0) + b4_p*rs**2 + ec_p = -2d0*A_p*(1d0 + a1_p*rs)*log(1d0 + 1d0/(2d0*A_p*ec_p)) + + ec_f = b1_f*sqrt(rs) + b2_f*rs + b3_f*rs**(3d0/2d0) + b4_f*rs**2 + ec_f = -2d0*A_f*(1d0 + a1_f*rs)*log(1d0 + 1d0/(2d0*A_f*ec_f)) + + ec_a = b1_a*sqrt(rs) + b2_a*rs + b3_a*rs**(3d0/2d0) + b4_a*rs**2 + ec_a = +2d0*A_a*(1d0 + a1_a*rs)*log(1d0 + 1d0/(2d0*A_a*ec_a)) + + ec_z = ec_p + ec_a*fz/d2fz*(1d0-z**4) + (ec_f - ec_p)*fz*z**4 + + ga = drho(1,iG,1)*drho(1,iG,1) + drho(2,iG,1)*drho(2,iG,1) + drho(3,iG,1)*drho(3,iG,1) + gb = drho(1,iG,2)*drho(1,iG,2) + drho(2,iG,2)*drho(2,iG,2) + drho(3,iG,2)*drho(3,iG,2) + gab = drho(1,iG,1)*drho(1,iG,2) + drho(2,iG,1)*drho(2,iG,2) + drho(3,iG,1)*drho(3,iG,2) + g = ga + 2d0*gab + gb + + rs = (4d0*pi*r/3d0)**(-1d0/3d0) + kf = (3d0*pi**2*r)**(1d0/3d0) + ks = sqrt(4d0*kf/pi) + phi = ((1d0 + z)**(2d0/3d0) + (1d0 - z)**(2d0/3d0))/2d0 + t = sqrt(g)/(2d0*phi*ks*r) + + A = beta/gam/(exp(-ec_p/(gam*phi**3)) - 1d0) + + H = gam*phi**3*log(1d0 + beta/gam*t**2*((1d0 + A*t**2)/(1d0 + A*t**2 + A**2*t**4))) + + Ec(2) = Ec(2) - weight(iG)*(ec_p + H)*r + + end if + +! beta-beta contribution + + if(rb > threshold) then + + rs = (4d0*pi*rb/3d0)**(-1d0/3d0) + + ec_f = b1_f*sqrt(rs) + b2_f*rs + b3_f*rs**(3d0/2d0) + b4_f*rs**2 + ec_f = -2d0*A_f*(1d0 + a1_f*rs)*log(1d0 + 1d0/(2d0*A_f*ec_f)) + + gb = drho(1,iG,2)*drho(1,iG,2) + drho(2,iG,2)*drho(2,iG,2) + drho(3,iG,2)*drho(3,iG,2) + + kf = (3d0*pi**2*rb)**(1d0/3d0) + ks = sqrt(4d0*kf/pi) + phi = 1d0 + t = sqrt(gb)/(2d0*phi*ks*rb) + + A = beta/gam/(exp(-ec_f/(gam*phi**3)) - 1d0) + + H = gam*phi**3*log(1d0 + beta/gam*t**2*((1d0 + A*t**2)/(1d0 + A*t**2 + A**2*t**4))) + + Ec(3) = Ec(3) + weight(iG)*(ec_f + H)*rb + + end if + + end do + + Ec(2) = Ec(2) - Ec(1) - Ec(3) + + +end subroutine UPBE_gga_correlation_energy diff --git a/src/eDFT/UPBE_gga_correlation_potential.f90 b/src/eDFT/UPBE_gga_correlation_potential.f90 new file mode 100644 index 0000000..af8794a --- /dev/null +++ b/src/eDFT/UPBE_gga_correlation_potential.f90 @@ -0,0 +1,88 @@ +subroutine UPBE_gga_correlation_potential(nGrid,weight,nBas,AO,dAO,rho,drho,Fc) + +! Compute LYP correlation potential + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nGrid + double precision,intent(in) :: weight(nGrid) + integer,intent(in) :: nBas + double precision,intent(in) :: AO(nBas,nGrid) + double precision,intent(in) :: dAO(ncart,nBas,nGrid) + double precision,intent(in) :: rho(nGrid,nspin) + double precision,intent(in) :: drho(ncart,nGrid,nspin) + +! Local variables + + integer :: mu,nu,iG + double precision :: vAO,gaAO,gbAO + double precision :: ra,rb,r + double precision :: ga,gab,gb,g + double precision :: dfdra,dfdrb + double precision :: dfdga,dfdgab,dfdgb + double precision :: dodra,dodrb,dddra,dddrb + + double precision :: a,b,c,d + double precision :: Cf,omega,delta + +! Output variables + + double precision,intent(out) :: Fc(nBas,nBas,nspin) + +! Prameter of the functional + +! Compute matrix elements in the AO basis + + call UPW92_lda_correlation_potential(nGrid,weight,nBas,AO,rho,Fc) + + do mu=1,nBas + do nu=1,nBas + do iG=1,nGrid + + ra = max(0d0,rho(iG,1)) + rb = max(0d0,rho(iG,2)) + r = ra + rb + + if(r > threshold) then + + ga = drho(1,iG,1)*drho(1,iG,1) + drho(2,iG,1)*drho(2,iG,1) + drho(3,iG,1)*drho(3,iG,1) + gb = drho(1,iG,2)*drho(1,iG,2) + drho(2,iG,2)*drho(2,iG,2) + drho(3,iG,2)*drho(3,iG,2) + gab = drho(1,iG,1)*drho(1,iG,2) + drho(2,iG,1)*drho(2,iG,2) + drho(3,iG,1)*drho(3,iG,2) + g = ga + 2d0*gab + gb + + vAO = weight(iG)*AO(mu,iG)*AO(nu,iG) + + dfdra = 0d0 + dfdrb = 0d0 + + Fc(mu,nu,1) = Fc(mu,nu,1) + vAO*dfdra + Fc(mu,nu,2) = Fc(mu,nu,2) + vAO*dfdrb + + gaAO = drho(1,iG,1)*(dAO(1,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(1,nu,iG)) & + + drho(2,iG,1)*(dAO(2,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(2,nu,iG)) & + + drho(3,iG,1)*(dAO(3,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(3,nu,iG)) + gaAO = weight(iG)*gaAO + + gbAO = drho(1,iG,2)*(dAO(1,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(1,nu,iG)) & + + drho(2,iG,2)*(dAO(2,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(2,nu,iG)) & + + drho(3,iG,2)*(dAO(3,mu,iG)*AO(nu,iG) + AO(mu,iG)*dAO(3,nu,iG)) + gbAO = weight(iG)*gbAO + + dfdga = 0d0 + dfdgab = 0d0 + dfdgb = 0d0 + + + Fc(mu,nu,1) = Fc(mu,nu,1) + 2d0*gaAO*dfdga + gbAO*dfdgab + Fc(mu,nu,2) = Fc(mu,nu,2) + 2d0*gbAO*dfdgb + gaAO*dfdgab + + end if + + end do + end do + end do + +end subroutine UPBE_gga_correlation_potential From 1a33dde2ab0c46a39250a60043876dfbfd6eb8c8 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Mon, 1 Mar 2021 15:03:44 +0100 Subject: [PATCH 27/63] remove libxc --- src/eDFT/US51_lda_exchange_energy.f90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/eDFT/US51_lda_exchange_energy.f90 b/src/eDFT/US51_lda_exchange_energy.f90 index fbaaad9..5fe5d28 100644 --- a/src/eDFT/US51_lda_exchange_energy.f90 +++ b/src/eDFT/US51_lda_exchange_energy.f90 @@ -1,7 +1,5 @@ subroutine US51_lda_exchange_energy(nGrid,weight,rho,Ex) - use xc_f90_lib_m - ! Compute Slater's LDA exchange energy implicit none From 75ec2443c15b608ed5e876ba38747540cf7c71a0 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Wed, 3 Mar 2021 11:37:46 +0100 Subject: [PATCH 28/63] stability analysis --- input/methods | 2 +- input/options | 6 +- mol/h2.xyz | 2 +- src/HF/RHF_stability.f90 | 147 +++++++++++++++++++++++++++++++ src/HF/UHF_stability.f90 | 174 +++++++++++++++++++++++++++++++++++++ src/MBPT/print_qsUGW.f90 | 1 + src/MP/MP2.f90 | 12 ++- src/QuAcK/QuAcK.f90 | 44 ++++++++-- src/QuAcK/read_options.f90 | 21 +++-- 9 files changed, 384 insertions(+), 25 deletions(-) create mode 100644 src/HF/RHF_stability.f90 create mode 100644 src/HF/UHF_stability.f90 diff --git a/input/methods b/input/methods index 2452cdc..738a281 100644 --- a/input/methods +++ b/input/methods @@ -13,7 +13,7 @@ # G0F2 evGF2 G0F3 evGF3 F F F F # G0W0* evGW* qsGW* - T F T + F F F # G0T0 evGT qsGT F F F # MCMP2 diff --git a/input/options b/input/options index eef2cae..5f8d15d 100644 --- a/input/options +++ b/input/options @@ -1,5 +1,5 @@ -# HF: maxSCF thresh DIIS n_diis guess_type ortho_type mix_guess - 128 0.0000001 T 5 1 1 F +# HF: maxSCF thresh DIIS n_diis guess_type ortho_type mix_guess stability + 128 0.0000001 T 5 1 1 T T # MP: # CC: maxSCF thresh DIIS n_diis @@ -9,7 +9,7 @@ # 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.0000001 T 5 T 0.00367493 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/mol/h2.xyz b/mol/h2.xyz index ce5f117..a302682 100644 --- a/mol/h2.xyz +++ b/mol/h2.xyz @@ -1,4 +1,4 @@ 2 H 0.0 0.0 0.0 -H 0.0 0.0 0.7408481486 +H 0.0 0.0 1.4 diff --git a/src/HF/RHF_stability.f90 b/src/HF/RHF_stability.f90 new file mode 100644 index 0000000..bade757 --- /dev/null +++ b/src/HF/RHF_stability.f90 @@ -0,0 +1,147 @@ +subroutine RHF_stability(nBas,nC,nO,nV,nR,nS,eHF,ERI) + +! Perform a stability analysis of the RHF solution + + 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) :: eHF(nBas) + double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + +! Local variables + + integer,parameter :: maxS = 20 + integer :: ia + integer :: ispin + + double precision,allocatable :: A(:,:) + double precision,allocatable :: B(:,:) + double precision,allocatable :: AB(:,:) + double precision,allocatable :: Om(:) + +! Memory allocation + + allocate(A(nS,nS),B(nS,nS),AB(nS,nS),Om(nS)) + +!-------------------------------------------------------------! +! Stability analysis: Real RHF -> Real RHF +!-------------------------------------------------------------! + + ispin = 1 + + call linear_response_A_matrix(ispin,.false.,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,A) + call linear_response_B_matrix(ispin,.false.,nBas,nC,nO,nV,nR,nS,1d0,ERI,B) + + AB(:,:) = A(:,:) + B(:,:) + + call diagonalize_matrix(nS,AB,Om) + + write(*,*)'-------------------------------------------------------------' + write(*,*)'| Stability analysis: Real RHF -> Real RHF |' + write(*,*)'-------------------------------------------------------------' + write(*,'(1X,A1,1X,A5,1X,A1,1X,A23,1X,A1,1X,A23,1X,A1,1X)') & + '|','State','|',' Excitation energy (au) ','|',' Excitation energy (eV) ','|' + write(*,*)'-------------------------------------------------------------' + do ia=1,min(nS,maxS) + write(*,'(1X,A1,1X,I5,1X,A1,1X,F23.6,1X,A1,1X,F23.6,1X,A1,1X)') & + '|',ia,'|',Om(ia),'|',Om(ia)*HaToeV,'|' + enddo + write(*,*)'-------------------------------------------------------------' + + if(minval(Om(:)) < 0d0) then + + write(*,'(1X,A40,1X)') 'Too bad, RHF solution is unstable!' + write(*,'(1X,A40,1X,F15.10,A3)') 'Largest negative eigenvalue: ',Om(1),' au' + + else + + write(*,'(1X,A40,1X)') 'Well done, RHF solution is stable!' + write(*,'(1X,A40,1X,F15.10,A3)') 'Smallest eigenvalue: ',Om(1),' au' + + end if + write(*,*)'-------------------------------------------------------------' + write(*,*) + +!-------------------------------------------------------------! +! Stability analysis: Real RHF -> Complex RHF +!-------------------------------------------------------------! + + AB(:,:) = A(:,:) - B(:,:) + + call diagonalize_matrix(nS,AB,Om) + + write(*,*)'-------------------------------------------------------------' + write(*,*)'| Stability analysis: Real RHF -> Complex RHF |' + write(*,*)'-------------------------------------------------------------' + write(*,'(1X,A1,1X,A5,1X,A1,1X,A23,1X,A1,1X,A23,1X,A1,1X)') & + '|','State','|',' Excitation energy (au) ','|',' Excitation energy (eV) ','|' + write(*,*)'-------------------------------------------------------------' + do ia=1,min(nS,maxS) + write(*,'(1X,A1,1X,I5,1X,A1,1X,F23.6,1X,A1,1X,F23.6,1X,A1,1X)') & + '|',ia,'|',Om(ia),'|',Om(ia)*HaToeV,'|' + enddo + write(*,*)'-------------------------------------------------------------' + + if(minval(Om(:)) < 0d0) then + + write(*,'(1X,A40,1X)') 'Too bad, RHF solution is unstable!' + write(*,'(1X,A40,1X,F15.10,A3)') 'Largest negative eigenvalue: ',Om(1),' au' + + else + + write(*,'(1X,A40,1X)') 'Well done, RHF solution is stable!' + write(*,'(1X,A40,1X,F15.10,A3)') 'Smallest eigenvalue: ',Om(1),' au' + + end if + write(*,*)'-------------------------------------------------------------' + write(*,*) + +!-------------------------------------------------------------! +! Stability analysis: Real RHF -> Real UHF +!-------------------------------------------------------------! + + ispin = 2 + + call linear_response_A_matrix(ispin,.false.,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,A) + call linear_response_B_matrix(ispin,.false.,nBas,nC,nO,nV,nR,nS,1d0,ERI,B) + + AB(:,:) = A(:,:) + B(:,:) + + call diagonalize_matrix(nS,AB,Om) + + write(*,*)'-------------------------------------------------------------' + write(*,*)'| Stability analysis: Real RHF -> Real UHF |' + write(*,*)'-------------------------------------------------------------' + write(*,'(1X,A1,1X,A5,1X,A1,1X,A23,1X,A1,1X,A23,1X,A1,1X)') & + '|','State','|',' Excitation energy (au) ','|',' Excitation energy (eV) ','|' + write(*,*)'-------------------------------------------------------------' + do ia=1,min(nS,maxS) + write(*,'(1X,A1,1X,I5,1X,A1,1X,F23.6,1X,A1,1X,F23.6,1X,A1,1X)') & + '|',ia,'|',Om(ia),'|',Om(ia)*HaToeV,'|' + enddo + write(*,*)'-------------------------------------------------------------' + + if(minval(Om(:)) < 0d0) then + + write(*,'(1X,A40,1X)') 'Too bad, RHF solution is unstable!' + write(*,'(1X,A40,1X,F15.10,A3)') 'Largest negative eigenvalue: ',Om(1),' au' + + else + + write(*,'(1X,A40,1X)') 'Well done, RHF solution is stable!' + write(*,'(1X,A40,1X,F15.10,A3)') 'Smallest eigenvalue: ',Om(1),' au' + + end if + write(*,*)'-------------------------------------------------------------' + write(*,*) + +end subroutine RHF_stability diff --git a/src/HF/UHF_stability.f90 b/src/HF/UHF_stability.f90 new file mode 100644 index 0000000..db77387 --- /dev/null +++ b/src/HF/UHF_stability.f90 @@ -0,0 +1,174 @@ +subroutine UHF_stability(nBas,nC,nO,nV,nR,nS,eHF,ERI_aaaa,ERI_aabb,ERI_bbbb) + +! Perform a stability analysis of the UHF solution + + 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) :: 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) + +! Local variables + + integer,parameter :: maxS = 20 + integer :: ia + integer :: ispin + + integer :: nS_aa,nS_bb,nS_sc + double precision,allocatable :: Om_sc(:) + double precision,allocatable :: A_sc(:,:) + double precision,allocatable :: B_sc(:,:) + double precision,allocatable :: AB_sc(:,:) + + integer :: nS_ab,nS_ba,nS_sf + double precision,allocatable :: Om_sf(:) + double precision,allocatable :: A_sf(:,:) + double precision,allocatable :: B_sf(:,:) + double precision,allocatable :: AB_sf(:,:) + +! Menory allocation + + nS_aa = nS(1) + nS_bb = nS(2) + nS_sc = nS_aa + nS_bb + + allocate(Om_sc(nS_sc),A_sc(nS_sc,nS_sc),B_sc(nS_sc,nS_sc),AB_sc(nS_sc,nS_sc)) + +!-------------------------------------------------------------! +! Stability analysis: Real UHF -> Real UHF +!-------------------------------------------------------------! + + ispin = 1 + + call unrestricted_linear_response_A_matrix(ispin,.false.,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,1d0,eHF, & + ERI_aaaa,ERI_aabb,ERI_bbbb,A_sc) + call unrestricted_linear_response_B_matrix(ispin,.false.,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,1d0, & + ERI_aaaa,ERI_aabb,ERI_bbbb,B_sc) + + AB_sc(:,:) = A_sc(:,:) + B_sc(:,:) + + call diagonalize_matrix(nS_sc,AB_sc,Om_sc) + + write(*,*)'-------------------------------------------------------------' + write(*,*)'| Stability analysis: Real UHF -> Real UHF |' + write(*,*)'-------------------------------------------------------------' + write(*,'(1X,A1,1X,A5,1X,A1,1X,A23,1X,A1,1X,A23,1X,A1,1X)') & + '|','State','|',' Excitation energy (au) ','|',' Excitation energy (eV) ','|' + write(*,*)'-------------------------------------------------------------' + do ia=1,min(nS_sc,maxS) + write(*,'(1X,A1,1X,I5,1X,A1,1X,F23.6,1X,A1,1X,F23.6,1X,A1,1X)') & + '|',ia,'|',Om_sc(ia),'|',Om_sc(ia)*HaToeV,'|' + enddo + write(*,*)'-------------------------------------------------------------' + + if(minval(Om_sc(:)) < 0d0) then + + write(*,'(1X,A40,1X)') 'Too bad, UHF solution is unstable!' + write(*,'(1X,A40,1X,F15.10,A3)') 'Largest negative eigenvalue: ',Om_sc(1),' au' + + else + + write(*,'(1X,A40,1X)') 'Well done, UHF solution is stable!' + write(*,'(1X,A40,1X,F15.10,A3)') 'Smallest eigenvalue: ',Om_sc(1),' au' + + end if + write(*,*)'-------------------------------------------------------------' + write(*,*) + +!-------------------------------------------------------------! +! Stability analysis: Real UHF -> Complex UHF +!-------------------------------------------------------------! + + AB_sc(:,:) = A_sc(:,:) - B_sc(:,:) + + call diagonalize_matrix(nS_sc,AB_sc,Om_sc) + + write(*,*)'-------------------------------------------------------------' + write(*,*)'| Stability analysis: Real UHF -> Complex UHF |' + write(*,*)'-------------------------------------------------------------' + write(*,'(1X,A1,1X,A5,1X,A1,1X,A23,1X,A1,1X,A23,1X,A1,1X)') & + '|','State','|',' Excitation energy (au) ','|',' Excitation energy (eV) ','|' + write(*,*)'-------------------------------------------------------------' + do ia=1,min(nS_sc,maxS) + write(*,'(1X,A1,1X,I5,1X,A1,1X,F23.6,1X,A1,1X,F23.6,1X,A1,1X)') & + '|',ia,'|',Om_sc(ia),'|',Om_sc(ia)*HaToeV,'|' + enddo + write(*,*)'-------------------------------------------------------------' + + if(minval(Om_sc(:)) < 0d0) then + + write(*,'(1X,A40,1X)') 'Too bad, UHF solution is unstable!' + write(*,'(1X,A40,1X,F15.10,A3)') 'Largest negative eigenvalue: ',Om_sc(1),' au' + + else + + write(*,'(1X,A40,1X)') 'Well done, UHF solution is stable!' + write(*,'(1X,A40,1X,F15.10,A3)') 'Smallest eigenvalue: ',Om_sc(1),' au' + + end if + write(*,*)'-------------------------------------------------------------' + write(*,*) + +! Menory (de)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 + + deallocate(Om_sc,A_sc,B_sc,AB_sc) + allocate(Om_sf(nS_sf),A_sf(nS_sf,nS_sf),B_sf(nS_sf,nS_sf),AB_sf(nS_sf,nS_sf)) + +!-------------------------------------------------------------! +! Stability analysis: Real UHF -> Real GHF +!-------------------------------------------------------------! + + ispin = 2 + + call unrestricted_linear_response_A_matrix(ispin,.false.,nBas,nC,nO,nV,nR,nS_ab,nS_ba,nS_sf,1d0,eHF, & + ERI_aaaa,ERI_aabb,ERI_bbbb,A_sf) + call unrestricted_linear_response_B_matrix(ispin,.false.,nBas,nC,nO,nV,nR,nS_ab,nS_ba,nS_sf,1d0, & + ERI_aaaa,ERI_aabb,ERI_bbbb,B_sf) + + AB_sf(:,:) = A_sf(:,:) + B_sf(:,:) + + call diagonalize_matrix(nS_sf,AB_sf,Om_sf) + + write(*,*)'-------------------------------------------------------------' + write(*,*)'| Stability analysis: Real UHF -> Real GHF |' + write(*,*)'-------------------------------------------------------------' + write(*,'(1X,A1,1X,A5,1X,A1,1X,A23,1X,A1,1X,A23,1X,A1,1X)') & + '|','State','|',' Excitation energy (au) ','|',' Excitation energy (eV) ','|' + write(*,*)'-------------------------------------------------------------' + do ia=1,min(nS_sf,maxS) + write(*,'(1X,A1,1X,I5,1X,A1,1X,F23.6,1X,A1,1X,F23.6,1X,A1,1X)') & + '|',ia,'|',Om_sf(ia),'|',Om_sf(ia)*HaToeV,'|' + enddo + write(*,*)'-------------------------------------------------------------' + + if(minval(Om_sf(:)) < 0d0) then + + write(*,'(1X,A40,1X)') 'Too bad, UHF solution is unstable!' + write(*,'(1X,A40,1X,F15.10,A3)') 'Largest negative eigenvalue: ',Om_sf(1),' au' + + else + + write(*,'(1X,A40,1X)') 'Well done, UHF solution is stable!' + write(*,'(1X,A40,1X,F15.10,A3)') 'Smallest eigenvalue: ',Om_sf(1),' au' + + end if + write(*,*)'-------------------------------------------------------------' + write(*,*) + +end subroutine UHF_stability diff --git a/src/MBPT/print_qsUGW.f90 b/src/MBPT/print_qsUGW.f90 index 144b2d9..32dc633 100644 --- a/src/MBPT/print_qsUGW.f90 +++ b/src/MBPT/print_qsUGW.f90 @@ -113,6 +113,7 @@ subroutine print_qsUGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,cGW,PGW,Ov,T,V,J,K, & ! Dump results for final iteration if(Conv < thresh) then +! if(.true.) then write(*,*) write(*,'(A60)') '-------------------------------------------------' diff --git a/src/MP/MP2.f90 b/src/MP/MP2.f90 index 2c6d75c..8b028df 100644 --- a/src/MP/MP2.f90 +++ b/src/MP/MP2.f90 @@ -6,9 +6,15 @@ subroutine MP2(nBas,nC,nO,nV,nR,ERI,ENuc,EHF,e,EcMP2) ! Input variables - integer,intent(in) :: nBas,nC,nO,nV,nR - double precision,intent(in) :: ENuc,EHF - double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas),e(nBas) + integer,intent(in) :: nBas + integer,intent(in) :: nC + integer,intent(in) :: nO + integer,intent(in) :: nV + integer,intent(in) :: nR + double precision,intent(in) :: ENuc + double precision,intent(in) :: EHF + double precision,intent(in) :: e(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 ad67e96..177f7e4 100644 --- a/src/QuAcK/QuAcK.f90 +++ b/src/QuAcK/QuAcK.f90 @@ -6,6 +6,7 @@ program QuAcK logical :: doSph logical :: unrestricted = .false. logical :: doRHF,doUHF,doMOM + logical :: dostab logical :: doKS logical :: doMP2,doMP3,doMP2F12 logical :: doCCD,doDCD,doCCSD,doCCSDT @@ -78,6 +79,7 @@ program QuAcK double precision :: start_QuAcK ,end_QuAcK ,t_QuAcK double precision :: start_int ,end_int ,t_int double precision :: start_HF ,end_HF ,t_HF + double precision :: start_stab ,end_stab ,t_stab double precision :: start_KS ,end_KS ,t_KS double precision :: start_MOM ,end_MOM ,t_MOM double precision :: start_AOtoMO ,end_AOtoMO ,t_AOtoMO @@ -169,14 +171,14 @@ program QuAcK ! Read options for methods - call read_options(maxSCF_HF,thresh_HF,DIIS_HF,n_diis_HF,guess_type,ortho_type,mix, & - maxSCF_CC,thresh_CC,DIIS_CC,n_diis_CC, & - TDA,singlet,triplet,spin_conserved,spin_flip, & - 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, & - doACFDT,exchange_kernel,doXBS, & - BSE,dBSE,dTDA,evDyn, & + call read_options(maxSCF_HF,thresh_HF,DIIS_HF,n_diis_HF,guess_type,ortho_type,mix,dostab, & + maxSCF_CC,thresh_CC,DIIS_CC,n_diis_CC, & + TDA,singlet,triplet,spin_conserved,spin_flip, & + 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, & + doACFDT,exchange_kernel,doXBS, & + BSE,dBSE,dTDA,evDyn, & nMC,nEq,nWalk,dt,nPrint,iSeed,doDrift) ! Weird stuff @@ -439,6 +441,32 @@ program QuAcK write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for AO to MO transformation = ',t_AOtoMO,' seconds' write(*,*) +!------------------------------------------------------------------------ +! Stability analysis of HF solution +!------------------------------------------------------------------------ + + if(dostab) then + + call cpu_time(start_stab) + + if(unrestricted) then + + call UHF_stability(nBas,nC,nO,nV,nR,nS,eHF,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb) + + else + + call RHF_stability(nBas,nC,nO,nV,nR,nS,eHF,ERI_MO) + + end if + + call cpu_time(end_stab) + + t_stab = end_stab - start_stab + write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for stability analysis = ',t_stab,' seconds' + write(*,*) + + end if + !------------------------------------------------------------------------ ! Compute MP2 energy !------------------------------------------------------------------------ diff --git a/src/QuAcK/read_options.f90 b/src/QuAcK/read_options.f90 index 1492197..2d7aa4f 100644 --- a/src/QuAcK/read_options.f90 +++ b/src/QuAcK/read_options.f90 @@ -1,11 +1,11 @@ -subroutine read_options(maxSCF_HF,thresh_HF,DIIS_HF,n_diis_HF,guess_type,ortho_type,mix, & - maxSCF_CC,thresh_CC,DIIS_CC,n_diis_CC, & - TDA,singlet,triplet,spin_conserved,spin_flip, & - 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, & - doACFDT,exchange_kernel,doXBS, & - BSE,dBSE,dTDA,evDyn, & +subroutine read_options(maxSCF_HF,thresh_HF,DIIS_HF,n_diis_HF,guess_type,ortho_type,mix,dostab, & + maxSCF_CC,thresh_CC,DIIS_CC,n_diis_CC, & + TDA,singlet,triplet,spin_conserved,spin_flip, & + 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, & + doACFDT,exchange_kernel,doXBS, & + BSE,dBSE,dTDA,evDyn, & nMC,nEq,nWalk,dt,nPrint,iSeed,doDrift) ! Read desired methods @@ -21,6 +21,7 @@ subroutine read_options(maxSCF_HF,thresh_HF,DIIS_HF,n_diis_HF,guess_type,ortho_t integer,intent(out) :: guess_type integer,intent(out) :: ortho_type logical,intent(out) :: mix + logical,intent(out) :: dostab integer,intent(out) :: maxSCF_CC double precision,intent(out) :: thresh_CC @@ -87,12 +88,14 @@ subroutine read_options(maxSCF_HF,thresh_HF,DIIS_HF,n_diis_HF,guess_type,ortho_t guess_type = 1 ortho_type = 1 mix = .false. + dostab = .false. read(1,*) - read(1,*) maxSCF_HF,thresh_HF,answer1,n_diis_HF,guess_type,ortho_type,answer2 + read(1,*) maxSCF_HF,thresh_HF,answer1,n_diis_HF,guess_type,ortho_type,answer2,answer3 if(answer1 == 'T') DIIS_HF = .true. if(answer2 == 'T') mix = .true. + if(answer3 == 'T') dostab = .true. if(.not.DIIS_HF) n_diis_HF = 1 From eeadbf5c55c69803dfab4afc3166aee3864504c5 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Thu, 4 Mar 2021 15:06:16 +0100 Subject: [PATCH 29/63] fix bug --- src/eDFT/restricted_exchange_energy.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/eDFT/restricted_exchange_energy.f90 b/src/eDFT/restricted_exchange_energy.f90 index fc43d4e..d86421b 100644 --- a/src/eDFT/restricted_exchange_energy.f90 +++ b/src/eDFT/restricted_exchange_energy.f90 @@ -64,7 +64,7 @@ subroutine restricted_exchange_energy(rung,DFA,LDA_centered,nEns,wEns,aCC_w1,aCC aX = 0.72d0 aC = 0.81d0 - call restricted_lda_exchange_energy(DFA,nEns,wEns,nGrid,weight,rho,ExLDA,Cx_choice) + call restricted_lda_exchange_energy(DFA,LDA_centered,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,rho,ExLDA,Cx_choice) call restricted_gga_exchange_energy(DFA,nEns,wEns,nGrid,weight,rho,drho,ExGGA) call restricted_fock_exchange_energy(nBas,P,FxHF,ExHF) From 6daf1dd5ab6ddc473667df4a9163428550460db3 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Thu, 4 Mar 2021 15:07:01 +0100 Subject: [PATCH 30/63] fix bug --- src/eDFT/restricted_exchange_potential.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/eDFT/restricted_exchange_potential.f90 b/src/eDFT/restricted_exchange_potential.f90 index ddcbb2b..774edd8 100644 --- a/src/eDFT/restricted_exchange_potential.f90 +++ b/src/eDFT/restricted_exchange_potential.f90 @@ -66,7 +66,7 @@ subroutine restricted_exchange_potential(rung,DFA,LDA_centered,nEns,wEns,aCC_w1, cX = 0.20d0 aX = 0.72d0 - call restricted_lda_exchange_potential(DFA,nGrid,weight,nBas,AO,rho,FxLDA,Cx_choice) + call restricted_lda_exchange_potential(DFA,LDA_centered,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,nBas,AO,rho,Fx,Cx_choice) call restricted_gga_exchange_potential(DFA,nGrid,weight,nBas,AO,dAO,rho,drho,FxGGA) call restricted_fock_exchange_potential(nBas,P,ERI,FxHF) From 3d1da67d3380ce2b13b472d92d04435360188b77 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Thu, 4 Mar 2021 15:07:39 +0100 Subject: [PATCH 31/63] fix bug --- src/eDFT/restricted_exchange_potential.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/eDFT/restricted_exchange_potential.f90 b/src/eDFT/restricted_exchange_potential.f90 index 774edd8..fad526d 100644 --- a/src/eDFT/restricted_exchange_potential.f90 +++ b/src/eDFT/restricted_exchange_potential.f90 @@ -66,8 +66,8 @@ subroutine restricted_exchange_potential(rung,DFA,LDA_centered,nEns,wEns,aCC_w1, cX = 0.20d0 aX = 0.72d0 - call restricted_lda_exchange_potential(DFA,LDA_centered,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,nBas,AO,rho,Fx,Cx_choice) - call restricted_gga_exchange_potential(DFA,nGrid,weight,nBas,AO,dAO,rho,drho,FxGGA) + call restricted_lda_exchange_potential(DFA,LDA_centered,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,nBas,AO,rho,FxLDA,Cx_choice) + call restricted_gga_exchange_potential(DFA,nEns,wEns,nGrid,weight,nBas,AO,dAO,rho,drho,FxGGA) call restricted_fock_exchange_potential(nBas,P,ERI,FxHF) Fx(:,:) = FxLDA(:,:) & From 013fff95b6d2c0a996a4210f2a40759982682eea Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Thu, 4 Mar 2021 15:09:56 +0100 Subject: [PATCH 32/63] fix bug RPAx --- src/RPA/RPAx.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/RPA/RPAx.f90 b/src/RPA/RPAx.f90 index 34f1655..6b096e4 100644 --- a/src/RPA/RPAx.f90 +++ b/src/RPA/RPAx.f90 @@ -82,7 +82,7 @@ subroutine RPAx(TDA,doACFDT,exchange_kernel,singlet,triplet,eta,nBas,nC,nO,nV,nR ispin = 2 - call linear_response(ispin,.false.,TDA,.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,Omega(:,ispin),rho, & EcRPAx(ispin),Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) call print_excitation('RPAx@HF ',ispin,nS,Omega(:,ispin)) call print_transition_vectors(.false.,nBas,nC,nO,nV,nR,nS,dipole_int,Omega(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) From cecaf03c576ae0a6fd53e1fef651c6846a6b01c7 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Fri, 5 Mar 2021 17:29:52 +0100 Subject: [PATCH 33/63] static screening --- input/methods | 6 ++-- input/options | 2 +- mol/h2.xyz | 2 +- src/MBPT/static_screening_WA.f90 | 53 ++++++++++++++++++++++++++++++++ src/MBPT/static_screening_WB.f90 | 53 ++++++++++++++++++++++++++++++++ 5 files changed, 111 insertions(+), 5 deletions(-) create mode 100644 src/MBPT/static_screening_WA.f90 create mode 100644 src/MBPT/static_screening_WB.f90 diff --git a/input/methods b/input/methods index 738a281..26ff8ab 100644 --- a/input/methods +++ b/input/methods @@ -1,5 +1,5 @@ # RHF UHF KS MOM - F T F F + T F F F # MP2* MP3 MP2-F12 F F F # CCD DCD CCSD CCSD(T) @@ -9,11 +9,11 @@ # CIS* CIS(D) CID CISD F F F F # RPA* RPAx* ppRPA - F F F + T F F # G0F2 evGF2 G0F3 evGF3 F F F F # G0W0* evGW* qsGW* - F F F + F F T # G0T0 evGT qsGT F F F # MCMP2 diff --git a/input/options b/input/options index 5f8d15d..347efea 100644 --- a/input/options +++ b/input/options @@ -1,5 +1,5 @@ # HF: maxSCF thresh DIIS n_diis guess_type ortho_type mix_guess stability - 128 0.0000001 T 5 1 1 T T + 128 0.0000001 T 5 1 1 F F # MP: # CC: maxSCF thresh DIIS n_diis diff --git a/mol/h2.xyz b/mol/h2.xyz index a302682..7ab70eb 100644 --- a/mol/h2.xyz +++ b/mol/h2.xyz @@ -1,4 +1,4 @@ 2 H 0.0 0.0 0.0 -H 0.0 0.0 1.4 +H 0.0 0.0 0.741 diff --git a/src/MBPT/static_screening_WA.f90 b/src/MBPT/static_screening_WA.f90 new file mode 100644 index 0000000..dff07d7 --- /dev/null +++ b/src/MBPT/static_screening_WA.f90 @@ -0,0 +1,53 @@ +subroutine static_screening_WA(eta,nBas,nC,nO,nV,nR,nS,lambda,ERI,Omega,rho,WA) + +! Compute the OOVV block of the static screening W for the resonant block + + 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) :: ERI(nBas,nBas,nBas,nBas) + double precision,intent(in) :: Omega(nS) + double precision,intent(in) :: rho(nBas,nBas,nS) + +! Local variables + + double precision :: chi + double precision :: eps + integer :: i,j,a,b,ia,jb,kc + +! Output variables + + double precision,intent(out) :: WA(nS,nS) + +! Initialize + + WA(:,:) = 0d0 + + 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,nS + eps = Omega(kc)**2 + eta**2 + chi = chi + rho(i,j,kc)*rho(a,b,kc)*Omega(kc)/eps + enddo + + WA(ia,jb) = WA(ia,jb) + lambda*ERI(i,b,j,a) - 4d0*lambda*chi + + enddo + enddo + enddo + enddo + +end subroutine static_screening_WA diff --git a/src/MBPT/static_screening_WB.f90 b/src/MBPT/static_screening_WB.f90 new file mode 100644 index 0000000..4419660 --- /dev/null +++ b/src/MBPT/static_screening_WB.f90 @@ -0,0 +1,53 @@ +subroutine static_screening_WB(eta,nBas,nC,nO,nV,nR,nS,lambda,ERI,Omega,rho,WB) + +! Compute the static screening W for the coupling block + + 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) :: ERI(nBas,nBas,nBas,nBas) + double precision,intent(in) :: Omega(nS) + double precision,intent(in) :: rho(nBas,nBas,nS) + +! Local variables + + double precision :: chi + double precision :: eps + integer :: i,j,a,b,ia,jb,kc + +! Output variables + + double precision,intent(out) :: WB(nS,nS) + +! Initialize + + WB(:,:) = 0d0 + + 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,nS + eps = Omega(kc)**2 + eta**2 + chi = chi + rho(i,b,kc)*rho(a,j,kc)*Omega(kc)/eps + enddo + + WB(ia,jb) = WB(ia,jb) + lambda*ERI(i,j,b,a) - 4d0*lambda*chi + + enddo + enddo + enddo + enddo + +end subroutine static_screening_WB From ab7cf0401e4e01850b5045dbaad7b7ce783edeb1 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Fri, 5 Mar 2021 22:34:48 +0100 Subject: [PATCH 34/63] qsGF2 --- input/methods | 8 +- mol/benzene.xyz | 4 +- src/MBPT/G0F2.f90 | 9 +- src/MBPT/evGF2.f90 | 8 +- src/MBPT/print_qsGF2.f90 | 122 +++++++++++++++++++ src/MBPT/qsGF2.f90 | 222 +++++++++++++++++++++++++++++++++++ src/MBPT/self_energy_GF2.f90 | 73 ++++++++++++ src/QuAcK/QuAcK.f90 | 24 +++- src/QuAcK/read_methods.f90 | 13 +- 9 files changed, 461 insertions(+), 22 deletions(-) create mode 100644 src/MBPT/print_qsGF2.f90 create mode 100644 src/MBPT/qsGF2.f90 create mode 100644 src/MBPT/self_energy_GF2.f90 diff --git a/input/methods b/input/methods index 26ff8ab..89fb8f0 100644 --- a/input/methods +++ b/input/methods @@ -9,11 +9,11 @@ # CIS* CIS(D) CID CISD F F F F # RPA* RPAx* ppRPA - T F F -# G0F2 evGF2 G0F3 evGF3 - F F F F + F F F +# G0F2 evGF2 qsGF2 G0F3 evGF3 + F F T F F # G0W0* evGW* qsGW* - F F T + F F F # G0T0 evGT qsGT F F F # MCMP2 diff --git a/mol/benzene.xyz b/mol/benzene.xyz index 4b49a6a..08d5f47 100644 --- a/mol/benzene.xyz +++ b/mol/benzene.xyz @@ -1,5 +1,5 @@ 12 -Benzene,^1A_{1g},CC3,aug-cc-pVTZ + C 0.00000000 1.39250319 0.00000000 C -1.20594314 0.69625160 0.00000000 C -1.20594314 -0.69625160 0.00000000 @@ -11,4 +11,4 @@ H -2.14171677 -1.23652075 0.00000000 H 0.00000000 -2.47304151 0.00000000 H 2.14171677 -1.23652075 0.00000000 H 2.14171677 1.23652075 0.00000000 -H 0.00000000 2.47304151 0.00000000 \ No newline at end of file +H 0.00000000 2.47304151 0.00000000 diff --git a/src/MBPT/G0F2.f90 b/src/MBPT/G0F2.f90 index 8204ad1..db22b4b 100644 --- a/src/MBPT/G0F2.f90 +++ b/src/MBPT/G0F2.f90 @@ -1,5 +1,4 @@ -subroutine G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet_manifold,triplet_manifold, & - linearize,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF) +subroutine G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet,linearize,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF) ! Perform a one-shot second-order Green function calculation @@ -13,8 +12,8 @@ subroutine G0F2(BSE,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 logical,intent(in) :: linearize double precision,intent(in) :: eta integer,intent(in) :: nBas @@ -116,7 +115,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,dipole_int,eHF,eGF2,EcBSE) + call BSE2(TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,eGF2,EcBSE) end if diff --git a/src/MBPT/evGF2.f90 b/src/MBPT/evGF2.f90 index 168a762..14bd86f 100644 --- a/src/MBPT/evGF2.f90 +++ b/src/MBPT/evGF2.f90 @@ -1,4 +1,4 @@ -subroutine evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF,thresh,max_diis,singlet_manifold,triplet_manifold, & +subroutine evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF,thresh,max_diis,singlet,triplet, & linearize,eta,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF) ! Perform eigenvalue self-consistent second-order Green function calculation @@ -16,8 +16,8 @@ subroutine evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF,thresh,max_diis,singlet_manifold integer,intent(in) :: maxSCF double precision,intent(in) :: thresh integer,intent(in) :: max_diis - 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 integer,intent(in) :: nBas @@ -169,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,dipole_int,eHF,eGF2,EcBSE) + call BSE2(TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF,eGF2,EcBSE) end if diff --git a/src/MBPT/print_qsGF2.f90 b/src/MBPT/print_qsGF2.f90 new file mode 100644 index 0000000..c78100b --- /dev/null +++ b/src/MBPT/print_qsGF2.f90 @@ -0,0 +1,122 @@ +subroutine print_qsGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,c,ENuc,P,T,V,J,K,F,SigC,Z,EqsGF2,dipole) + +! Print one-electron energies and other stuff for qsGF2 + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nBas + integer,intent(in) :: nO + integer,intent(in) :: nSCF + double precision,intent(in) :: ENuc + double precision,intent(in) :: Conv + double precision,intent(in) :: thresh + double precision,intent(in) :: eHF(nBas) + double precision,intent(in) :: eGF2(nBas) + double precision,intent(in) :: c(nBas) + double precision,intent(in) :: P(nBas,nBas) + double precision,intent(in) :: T(nBas,nBas),V(nBas,nBas) + double precision,intent(in) :: J(nBas,nBas),K(nBas,nBas),F(nBas,nBas) + double precision,intent(in) :: Z(nBas),SigC(nBas,nBas) + double precision,intent(in) :: dipole(ncart) + +! Local variables + + integer :: q,ixyz,HOMO,LUMO + double precision :: Gap,ET,EV,EJ,Ex,Ec + double precision,external :: trace_matrix + +! Output variables + + double precision,intent(out) :: EqsGF2 + +! HOMO and LUMO + + HOMO = nO + LUMO = HOMO + 1 + Gap = eGF2(LUMO)-eGF2(HOMO) + +! Compute energies + + ET = trace_matrix(nBas,matmul(P,T)) + EV = trace_matrix(nBas,matmul(P,V)) + EJ = 0.5d0*trace_matrix(nBas,matmul(P,J)) + Ex = 0.25d0*trace_matrix(nBas,matmul(P,K)) + Ec = 0.50d0*trace_matrix(nBas,matmul(P,SigC)) + EqsGF2 = ET + EV + EJ + Ex + Ec + +! Dump results + + write(*,*)'-------------------------------------------------------------------------------' + if(nSCF < 10) then + write(*,'(1X,A21,I1,A1,I1,A12)')' Self-consistent qsG',nSCF,'W',nSCF,' calculation' + else + write(*,'(1X,A21,I2,A1,I2,A12)')' Self-consistent qsG',nSCF,'W',nSCF,' calculation' + endif + 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)','|','Sig_c (eV)','|','Z','|','e_QP (eV)','|' + write(*,*)'-------------------------------------------------------------------------------' + + do q=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)') & + '|',q,'|',eHF(q)*HaToeV,'|',SigC(q,q)*HaToeV,'|',Z(q),'|',eGF2(q)*HaToeV,'|' + enddo + + write(*,*)'-------------------------------------------------------------------------------' + write(*,'(2X,A10,I3)') 'Iteration ',nSCF + write(*,'(2X,A19,F15.5)')'max(|FPS - SPF|) = ',Conv + write(*,*)'-------------------------------------------' + write(*,'(2X,A30,F15.6,A3)') 'qsGF2 HOMO energy:',eGF2(HOMO)*HaToeV,' eV' + write(*,'(2X,A30,F15.6,A3)') 'qsGF2 LUMO energy:',eGF2(LUMO)*HaToeV,' eV' + write(*,'(2X,A30,F15.6,A3)') 'qsGF2 HOMO-LUMO gap :',Gap*HaToeV,' eV' + write(*,*)'-------------------------------------------' + write(*,'(2X,A30,F15.6,A3)') ' qsGF2 total energy:',EqsGF2 + ENuc,' au' + write(*,'(2X,A30,F15.6,A3)') ' qsGF2 exchange energy:',Ex,' au' + write(*,*)'-------------------------------------------' + write(*,*) + +! Dump results for final iteration + + if(Conv < thresh) then + + write(*,*) + write(*,'(A50)') '---------------------------------------' + write(*,'(A32)') ' Summary ' + write(*,'(A50)') '---------------------------------------' + write(*,'(A32,1X,F16.10,A3)') ' One-electron energy: ',ET + EV,' au' + write(*,'(A32,1X,F16.10,A3)') ' Kinetic energy: ',ET,' au' + write(*,'(A32,1X,F16.10,A3)') ' Potential energy: ',EV,' au' + write(*,'(A50)') '---------------------------------------' + write(*,'(A32,1X,F16.10,A3)') ' Two-electron energy: ',EJ + Ex,' au' + write(*,'(A32,1X,F16.10,A3)') ' Hartree energy: ',EJ,' au' + write(*,'(A32,1X,F16.10,A3)') ' Exchange energy: ',Ex,' au' + write(*,'(A32,1X,F16.10,A3)') ' Correlation energy: ',Ec,' au' + write(*,'(A50)') '---------------------------------------' + write(*,'(A32,1X,F16.10,A3)') ' Electronic energy: ',EqsGF2,' au' + write(*,'(A32,1X,F16.10,A3)') ' Nuclear repulsion: ',ENuc,' au' + write(*,'(A32,1X,F16.10,A3)') ' qsGF2 energy: ',ENuc + EqsGF2,' au' + write(*,'(A50)') '---------------------------------------' + write(*,'(A35)') ' Dipole moment (Debye) ' + write(*,'(10X,4A10)') 'X','Y','Z','Tot.' + write(*,'(10X,4F10.6)') (dipole(ixyz)*auToD,ixyz=1,ncart),norm2(dipole)*auToD + write(*,'(A50)') '-----------------------------------------' + write(*,*) + + write(*,'(A50)') '---------------------------------------' + write(*,'(A32)') ' qsGF2 MO coefficients' + write(*,'(A50)') '---------------------------------------' + call matout(nBas,nBas,c) + write(*,*) + write(*,'(A50)') '---------------------------------------' + write(*,'(A32)') ' qsGF2 MO energies' + write(*,'(A50)') '---------------------------------------' + call matout(nBas,1,eGF2) + write(*,*) + + endif + + +end subroutine print_qsGF2 diff --git a/src/MBPT/qsGF2.f90 b/src/MBPT/qsGF2.f90 new file mode 100644 index 0000000..0248685 --- /dev/null +++ b/src/MBPT/qsGF2.f90 @@ -0,0 +1,222 @@ +subroutine qsGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet, & + eta,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,ERHF, & + S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF) + +! Perform a quasiparticle self-consistent GF2 calculation + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: maxSCF + integer,intent(in) :: max_diis + double precision,intent(in) :: thresh + logical,intent(in) :: BSE + logical,intent(in) :: TDA + logical,intent(in) :: dBSE + logical,intent(in) :: dTDA + logical,intent(in) :: evDyn + logical,intent(in) :: singlet + logical,intent(in) :: triplet + double precision,intent(in) :: eta + + integer,intent(in) :: nNuc + double precision,intent(in) :: ZNuc(nNuc) + double precision,intent(in) :: rNuc(nNuc,ncart) + double precision,intent(in) :: ENuc + + integer,intent(in) :: nBas,nC,nO,nV,nR,nS + double precision,intent(in) :: ERHF + double precision,intent(in) :: eHF(nBas) + double precision,intent(in) :: cHF(nBas,nBas) + double precision,intent(in) :: PHF(nBas,nBas) + double precision,intent(in) :: S(nBas,nBas) + double precision,intent(in) :: T(nBas,nBas) + double precision,intent(in) :: V(nBas,nBas) + double precision,intent(in) :: Hc(nBas,nBas) + double precision,intent(in) :: X(nBas,nBas) + double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas) + double precision,intent(inout):: ERI_MO(nBas,nBas,nBas,nBas) + double precision,intent(in) :: dipole_int_AO(nBas,nBas,ncart) + double precision,intent(in) :: dipole_int_MO(nBas,nBas,ncart) + +! Local variables + + integer :: nSCF + integer :: nBasSq + integer :: ispin + integer :: n_diis + double precision :: EqsGF2 + double precision :: Conv + double precision :: rcond + double precision,external :: trace_matrix + double precision :: dipole(ncart) + double precision :: EcBSE(nspin) + + double precision,allocatable :: error_diis(:,:) + double precision,allocatable :: F_diis(:,:) + double precision,allocatable :: c(:,:) + double precision,allocatable :: cp(:,:) + double precision,allocatable :: eGF2(:) + double precision,allocatable :: P(:,:) + double precision,allocatable :: F(:,:) + double precision,allocatable :: Fp(:,:) + double precision,allocatable :: J(:,:) + double precision,allocatable :: K(:,:) + double precision,allocatable :: SigC(:,:) + double precision,allocatable :: SigCp(:,:) + double precision,allocatable :: SigCm(:,:) + double precision,allocatable :: Z(:) + double precision,allocatable :: error(:,:) + +! Hello world + + write(*,*) + write(*,*)'************************************************' + write(*,*)'| Self-consistent qsGF2 calculation |' + write(*,*)'************************************************' + write(*,*) + +! Warning + + write(*,*) '!! ERIs in MO basis will be overwritten in qsGF2 !!' + write(*,*) + +! Stuff + + nBasSq = nBas*nBas + +! TDA + + if(TDA) then + write(*,*) 'Tamm-Dancoff approximation activated!' + write(*,*) + end if + +! Memory allocation + + allocate(eGF2(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), & + error(nBas,nBas),error_diis(nBasSq,max_diis),F_diis(nBasSq,max_diis)) + +! Initialization + + nSCF = -1 + n_diis = 0 + ispin = 1 + Conv = 1d0 + P(:,:) = PHF(:,:) + eGF2(:) = eHF(:) + c(:,:) = cHF(:,:) + F_diis(:,:) = 0d0 + error_diis(:,:) = 0d0 + +!------------------------------------------------------------------------ +! Main loop +!------------------------------------------------------------------------ + + do while(Conv > thresh .and. nSCF <= maxSCF) + + ! Increment + + nSCF = nSCF + 1 + + ! Buid Coulomb matrix + + call Coulomb_matrix_AO_basis(nBas,P,ERI_AO,J) + + ! Compute exchange part of the self-energy + + call exchange_matrix_AO_basis(nBas,P,ERI_AO,K) + + ! AO to MO transformation of two-electron integrals + + call AOtoMO_integral_transform(1,1,1,1,nBas,c,ERI_AO,ERI_MO) + + ! Compute self-energy and renormalization factor + + call self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI_MO,SigC,Z) + + ! Make correlation self-energy Hermitian and transform it back to AO basis + + SigCp = 0.5d0*(SigC + transpose(SigC)) + SigCm = 0.5d0*(SigC - transpose(SigC)) + + call MOtoAO_transform(nBas,S,c,SigCp) + + ! Solve the quasi-particle equation + + F(:,:) = Hc(:,:) + J(:,:) + 0.5d0*K(:,:) + SigCp(:,:) + + ! Compute commutator and convergence criteria + + error = matmul(F,matmul(P,S)) - matmul(matmul(S,P),F) + Conv = maxval(abs(error)) + + ! DIIS extrapolation + + n_diis = min(n_diis+1,max_diis) + call DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,error_diis,F_diis,error,F) + +! Reset DIIS if required + + if(abs(rcond) < 1d-15) n_diis = 0 + + ! Diagonalize Hamiltonian in AO basis + + Fp = matmul(transpose(X),matmul(F,X)) + cp(:,:) = Fp(:,:) + call diagonalize_matrix(nBas,cp,eGF2) + c = matmul(X,cp) + + ! Compute new density matrix in the AO basis + + P(:,:) = 2d0*matmul(c(:,1:nO),transpose(c(:,1:nO))) + + ! Print results + + call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int_AO,dipole) + call print_qsGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,c,ENuc,P,T,V,J,K,F,SigCp,Z,EqsGF2,dipole) + + enddo +!------------------------------------------------------------------------ +! End main loop +!------------------------------------------------------------------------ + +! Did it actually converge? + + if(nSCF == maxSCF+1) then + + write(*,*) + write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + write(*,*)' Convergence failed ' + write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + write(*,*) + + stop + + endif + +! Deallocate memory + + deallocate(c,cp,P,F,Fp,J,K,SigC,SigCp,SigCm,Z,error,error_diis,F_diis) + +! Perform BSE calculation + + if(BSE) then + + call BSE2(TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI_MO,dipole_int_MO,eHF,eGF2,EcBSE) + + write(*,*) + write(*,*)'-------------------------------------------------------------------------------' + write(*,'(2X,A50,F20.10)') 'Tr@BSE@qsGF2 correlation energy (singlet) =',EcBSE(1) + write(*,'(2X,A50,F20.10)') 'Tr@BSE@qsGF2 correlation energy (triplet) =',EcBSE(2) + write(*,'(2X,A50,F20.10)') 'Tr@BSE@qsGF2 correlation energy =',EcBSE(1) + EcBSE(2) + write(*,'(2X,A50,F20.10)') 'Tr@BSE@qsGF2 total energy =',ENuc + EqsGF2 + EcBSE(1) + EcBSE(2) + write(*,*)'-------------------------------------------------------------------------------' + write(*,*) + + end if + +end subroutine qsGF2 diff --git a/src/MBPT/self_energy_GF2.f90 b/src/MBPT/self_energy_GF2.f90 new file mode 100644 index 0000000..e4dcdd1 --- /dev/null +++ b/src/MBPT/self_energy_GF2.f90 @@ -0,0 +1,73 @@ +subroutine self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z) + +! Compute GF2 self-energy and its renormalization factor + + implicit none + include 'parameters.h' + +! Input variables + + double precision,intent(in) :: eta + integer,intent(in) :: nBas,nC,nO,nV,nR,nS + double precision,intent(in) :: eHF(nBas) + double precision,intent(in) :: eGF2(nBas) + double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + +! Local variables + + integer :: i,j,a,b + integer :: p,q + double precision :: eps + double precision :: num + +! Output variables + + double precision,intent(out) :: SigC(nBas,nBas) + double precision,intent(out) :: Z(nBas) + +! Initialize + + SigC(:,:) = 0d0 + Z(:) = 0d0 + +! Compute GF2 self-energy + + do p=nC+1,nBas-nR + do q=nC+1,nBas-nR + do i=nC+1,nO + do j=nC+1,nO + do a=nO+1,nBas-nR + + eps = eGF2(p) + eHF(a) - eHF(i) - eHF(j) + num = (2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(q,a,i,j) + + SigC(p,q) = SigC(p,q) + num*eps/(eps**2 + eta**2) + if(p == q) Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + + end do + end do + end do + end do + end do + + do p=nC+1,nBas-nR + do q=nC+1,nBas-nR + do i=nC+1,nO + do a=nO+1,nBas-nR + do b=nO+1,nBas-nR + + eps = eGF2(p) + eHF(i) - eHF(a) - eHF(b) + num = (2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(q,i,a,b) + + SigC(p,q) = SigC(p,q) + num*eps/(eps**2 + eta**2) + if(p == q) Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + + end do + end do + end do + end do + end do + + Z(:) = 1d0/(1d0 - Z(:)) + +end subroutine self_energy_GF2 diff --git a/src/QuAcK/QuAcK.f90 b/src/QuAcK/QuAcK.f90 index 177f7e4..9647ef1 100644 --- a/src/QuAcK/QuAcK.f90 +++ b/src/QuAcK/QuAcK.f90 @@ -14,7 +14,7 @@ program QuAcK logical :: doCIS,doCIS_D,doCID,doCISD logical :: doRPA,doRPAx,doppRPA logical :: doADC - logical :: doG0F2,doevGF2,doG0F3,doevGF3 + logical :: doG0F2,doevGF2,doqsGF2,doG0F3,doevGF3 logical :: doG0W0,doevGW,doqsGW logical :: doG0T0,doevGT,doqsGT logical :: doMCMP2,doMinMCMP2 @@ -164,7 +164,8 @@ program QuAcK do_drCCD,do_rCCD,do_lCCD,do_pCCD, & doCIS,doCIS_D,doCID,doCISD, & doRPA,doRPAx,doppRPA, & - doG0F2,doevGF2,doG0F3,doevGF3, & + doG0F2,doevGF2,doqsGF2, & + doG0F3,doevGF3, & doG0W0,doevGW,doqsGW, & doG0T0,doevGT,doqsGT, & doMCMP2) @@ -839,6 +840,25 @@ program QuAcK end if +!------------------------------------------------------------------------ +! Perform qsGF2 calculation +!------------------------------------------------------------------------ + + if(doqsGF2) then + + call cpu_time(start_GF2) + + call qsGF2(maxSCF_GF,thresh_GF,n_diis_GF,BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta_GF,nNuc,ZNuc,rNuc,ENuc, & + nBas,nC,nO,nV,nR,nS,ERHF,S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF) + + call cpu_time(end_GF2) + + t_GF2 = end_GF2 - start_GF2 + write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for qsGF2 = ',t_GF2,' seconds' + write(*,*) + + end if + !------------------------------------------------------------------------ ! Compute G0F3 electronic binding energies !------------------------------------------------------------------------ diff --git a/src/QuAcK/read_methods.f90 b/src/QuAcK/read_methods.f90 index ab0d2d6..1401cc9 100644 --- a/src/QuAcK/read_methods.f90 +++ b/src/QuAcK/read_methods.f90 @@ -4,7 +4,8 @@ subroutine read_methods(doRHF,doUHF,doKS,doMOM, & do_drCCD,do_rCCD,do_lCCD,do_pCCD, & doCIS,doCIS_D,doCID,doCISD, & doRPA,doRPAx,doppRPA, & - doG0F2,doevGF2,doG0F3,doevGF3, & + doG0F2,doevGF2,doqsGF2, & + doG0F3,doevGF3, & doG0W0,doevGW,doqsGW, & doG0T0,doevGT,doqsGT, & doMCMP2) @@ -21,7 +22,7 @@ subroutine read_methods(doRHF,doUHF,doKS,doMOM, & logical,intent(out) :: do_drCCD,do_rCCD,do_lCCD,do_pCCD logical,intent(out) :: doCIS,doCIS_D,doCID,doCISD logical,intent(out) :: doRPA,doRPAx,doppRPA - logical,intent(out) :: doG0F2,doevGF2,doG0F3,doevGF3 + logical,intent(out) :: doG0F2,doevGF2,doqsGF2,doG0F3,doevGF3 logical,intent(out) :: doG0W0,doevGW,doqsGW logical,intent(out) :: doG0T0,doevGT,doqsGT logical,intent(out) :: doMCMP2 @@ -66,6 +67,7 @@ subroutine read_methods(doRHF,doUHF,doKS,doMOM, & doG0F2 = .false. doevGF2 = .false. + doqsGF2 = .false. doG0F3 = .false. doevGF3 = .false. @@ -132,11 +134,12 @@ subroutine read_methods(doRHF,doUHF,doKS,doMOM, & ! Read Green function methods read(1,*) - read(1,*) answer1,answer2,answer3,answer4 + read(1,*) answer1,answer2,answer3,answer4,answer5 if(answer1 == 'T') doG0F2 = .true. if(answer2 == 'T') doevGF2 = .true. - if(answer3 == 'T') doG0F3 = .true. - if(answer4 == 'T') doevGF3 = .true. + if(answer3 == 'T') doqsGF2 = .true. + if(answer4 == 'T') doG0F3 = .true. + if(answer5 == 'T') doevGF3 = .true. ! Read GW methods From 96fa82931d7b4fbb0a2dbfc4301c46983362721e Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Sat, 6 Mar 2021 15:27:35 +0100 Subject: [PATCH 35/63] GF2 clean up --- src/MBPT/G0F2.f90 | 51 +++------------------ src/MBPT/evGF2.f90 | 51 +++------------------ src/MBPT/self_energy_GF2.f90 | 46 +++++++++---------- src/MBPT/self_energy_GF2_diag.f90 | 73 +++++++++++++++++++++++++++++++ 4 files changed, 106 insertions(+), 115 deletions(-) create mode 100644 src/MBPT/self_energy_GF2_diag.f90 diff --git a/src/MBPT/G0F2.f90 b/src/MBPT/G0F2.f90 index db22b4b..303e5ea 100644 --- a/src/MBPT/G0F2.f90 +++ b/src/MBPT/G0F2.f90 @@ -30,15 +30,11 @@ subroutine G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet,linearize,eta,nBas,nC,nO ! Local variables - double precision :: eps - double precision :: V double precision :: EcBSE(nspin) double precision,allocatable :: eGF2(:) - double precision,allocatable :: Sig(:) + double precision,allocatable :: SigC(:) double precision,allocatable :: Z(:) - integer :: i,j,a,b,p - ! Hello world write(*,*) @@ -49,7 +45,7 @@ subroutine G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet,linearize,eta,nBas,nC,nO ! Memory allocation - allocate(Sig(nBas),Z(nBas),eGF2(nBas)) + allocate(SigC(nBas),Z(nBas),eGF2(nBas)) if(linearize) then @@ -60,56 +56,21 @@ subroutine G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet,linearize,eta,nBas,nC,nO ! Frequency-dependent second-order contribution - Sig(:) = 0d0 - Z(:) = 0d0 - - do p=nC+1,nBas-nR - do i=nC+1,nO - do j=nC+1,nO - do a=nO+1,nBas-nR - - eps = eHF(p) + eHF(a) - eHF(i) - eHF(j) - V = (2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(p,a,i,j) - - Sig(p) = Sig(p) + V*eps/(eps**2 + eta**2) - Z(p) = Z(p) - V*(eps**2 - eta**2)/(eps**2 + eta**2)**2 - - end do - end do - end do - end do - - do p=nC+1,nBas-nR - do i=nC+1,nO - do a=nO+1,nBas-nR - do b=nO+1,nBas-nR - - eps = eHF(p) + eHF(i) - eHF(a) - eHF(b) - V = (2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(p,i,a,b) - - Sig(p) = Sig(p) + V*eps/(eps**2 + eta**2) - Z(p) = Z(p) - V*(eps**2 - eta**2)/(eps**2 + eta**2)**2 - - end do - end do - end do - end do - - Z(:) = 1d0/(1d0 - Z(:)) + call self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eHF,ERI,SigC,Z) if(linearize) then - eGF2(:) = eHF(:) + Z(:)*Sig(:) + eGF2(:) = eHF(:) + Z(:)*SigC(:) else - eGF2(:) = eHF(:) + Sig(:) + eGF2(:) = eHF(:) + SigC(:) end if ! Print results - call print_G0F2(nBas,nO,eHF,Sig,eGF2,Z) + call print_G0F2(nBas,nO,eHF,SigC,eGF2,Z) ! Perform BSE2 calculation diff --git a/src/MBPT/evGF2.f90 b/src/MBPT/evGF2.f90 index 14bd86f..ff39619 100644 --- a/src/MBPT/evGF2.f90 +++ b/src/MBPT/evGF2.f90 @@ -37,19 +37,15 @@ subroutine evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF,thresh,max_diis,singlet,triplet, integer :: nSCF integer :: n_diis double precision :: EcBSE(nspin) - double precision :: num - double precision :: eps double precision :: Conv double precision :: rcond double precision,allocatable :: eGF2(:) double precision,allocatable :: eOld(:) - double precision,allocatable :: Sig(:) + double precision,allocatable :: SigC(:) double precision,allocatable :: Z(:) double precision,allocatable :: error_diis(:,:) double precision,allocatable :: e_diis(:,:) - integer :: i,j,a,b,p - ! Hello world write(*,*) @@ -60,7 +56,7 @@ subroutine evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF,thresh,max_diis,singlet,triplet, ! Memory allocation - allocate(Sig(nBas),Z(nBas),eGF2(nBas),eOld(nBas),error_diis(nBas,max_diis),e_diis(nBas,max_diis)) + allocate(SigC(nBas),Z(nBas),eGF2(nBas),eOld(nBas),error_diis(nBas,max_diis),e_diis(nBas,max_diis)) ! Initialization @@ -80,50 +76,15 @@ subroutine evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF,thresh,max_diis,singlet,triplet, ! Frequency-dependent second-order contribution - Sig(:) = 0d0 - Z(:) = 0d0 - - do p=nC+1,nBas-nR - do i=nC+1,nO - do j=nC+1,nO - do a=nO+1,nBas-nR - - eps = eGF2(p) + eHF(a) - eHF(i) - eHF(j) - num = (2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(p,a,i,j) - - Sig(p) = Sig(p) + num*eps/(eps**2 + eta**2) - Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 - - end do - end do - end do - end do - - do p=nC+1,nBas-nR - do i=nC+1,nO - do a=nO+1,nBas-nR - do b=nO+1,nBas-nR - - eps = eGF2(p) + eHF(i) - eHF(a) - eHF(b) - num = (2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(p,i,a,b) - - Sig(p) = Sig(p) + num*eps/(eps**2 + eta**2) - Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 - - end do - end do - end do - end do - - Z(:) = 1d0/(1d0 - Z(:)) + call self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z) if(linearize) then - eGF2(:) = eHF(:) + Z(:)*Sig(:) + eGF2(:) = eHF(:) + Z(:)*SigC(:) else - eGF2(:) = eHF(:) + Sig(:) + eGF2(:) = eHF(:) + SigC(:) end if @@ -131,7 +92,7 @@ subroutine evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF,thresh,max_diis,singlet,triplet, ! Print results - call print_evGF2(nBas,nO,nSCF,Conv,eHF,Sig,Z,eGF2) + call print_evGF2(nBas,nO,nSCF,Conv,eHF,SigC,Z,eGF2) ! DIIS extrapolation diff --git a/src/MBPT/self_energy_GF2.f90 b/src/MBPT/self_energy_GF2.f90 index e4dcdd1..c64d507 100644 --- a/src/MBPT/self_energy_GF2.f90 +++ b/src/MBPT/self_energy_GF2.f90 @@ -1,6 +1,6 @@ -subroutine self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z) +subroutine self_energy_GF2_diag(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z) -! Compute GF2 self-energy and its renormalization factor +! Compute diagonal part of the GF2 self-energy and its renormalization factor implicit none include 'parameters.h' @@ -16,53 +16,49 @@ subroutine self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z) ! Local variables integer :: i,j,a,b - integer :: p,q + integer :: p double precision :: eps double precision :: num ! Output variables - double precision,intent(out) :: SigC(nBas,nBas) + double precision,intent(out) :: SigC(nBas) double precision,intent(out) :: Z(nBas) ! Initialize - SigC(:,:) = 0d0 - Z(:) = 0d0 + SigC(:) = 0d0 + Z(:) = 0d0 ! Compute GF2 self-energy do p=nC+1,nBas-nR - do q=nC+1,nBas-nR - do i=nC+1,nO - do j=nC+1,nO - do a=nO+1,nBas-nR + do i=nC+1,nO + do j=nC+1,nO + do a=nO+1,nBas-nR - eps = eGF2(p) + eHF(a) - eHF(i) - eHF(j) - num = (2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(q,a,i,j) + eps = eGF2(p) + eHF(a) - eHF(i) - eHF(j) + num = (2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(p,a,i,j) - SigC(p,q) = SigC(p,q) + num*eps/(eps**2 + eta**2) - if(p == q) Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + SigC(p) = SigC(p) + num*eps/(eps**2 + eta**2) + Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 - end do end do end do end do end do do p=nC+1,nBas-nR - do q=nC+1,nBas-nR - do i=nC+1,nO - do a=nO+1,nBas-nR - do b=nO+1,nBas-nR + do i=nC+1,nO + do a=nO+1,nBas-nR + do b=nO+1,nBas-nR - eps = eGF2(p) + eHF(i) - eHF(a) - eHF(b) - num = (2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(q,i,a,b) + eps = eGF2(p) + eHF(i) - eHF(a) - eHF(b) + num = (2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(p,i,a,b) - SigC(p,q) = SigC(p,q) + num*eps/(eps**2 + eta**2) - if(p == q) Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + SigC(p) = SigC(p) + num*eps/(eps**2 + eta**2) + Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 - end do end do end do end do @@ -70,4 +66,4 @@ subroutine self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z) Z(:) = 1d0/(1d0 - Z(:)) -end subroutine self_energy_GF2 +end subroutine self_energy_GF2_diag diff --git a/src/MBPT/self_energy_GF2_diag.f90 b/src/MBPT/self_energy_GF2_diag.f90 new file mode 100644 index 0000000..e4dcdd1 --- /dev/null +++ b/src/MBPT/self_energy_GF2_diag.f90 @@ -0,0 +1,73 @@ +subroutine self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z) + +! Compute GF2 self-energy and its renormalization factor + + implicit none + include 'parameters.h' + +! Input variables + + double precision,intent(in) :: eta + integer,intent(in) :: nBas,nC,nO,nV,nR,nS + double precision,intent(in) :: eHF(nBas) + double precision,intent(in) :: eGF2(nBas) + double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + +! Local variables + + integer :: i,j,a,b + integer :: p,q + double precision :: eps + double precision :: num + +! Output variables + + double precision,intent(out) :: SigC(nBas,nBas) + double precision,intent(out) :: Z(nBas) + +! Initialize + + SigC(:,:) = 0d0 + Z(:) = 0d0 + +! Compute GF2 self-energy + + do p=nC+1,nBas-nR + do q=nC+1,nBas-nR + do i=nC+1,nO + do j=nC+1,nO + do a=nO+1,nBas-nR + + eps = eGF2(p) + eHF(a) - eHF(i) - eHF(j) + num = (2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(q,a,i,j) + + SigC(p,q) = SigC(p,q) + num*eps/(eps**2 + eta**2) + if(p == q) Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + + end do + end do + end do + end do + end do + + do p=nC+1,nBas-nR + do q=nC+1,nBas-nR + do i=nC+1,nO + do a=nO+1,nBas-nR + do b=nO+1,nBas-nR + + eps = eGF2(p) + eHF(i) - eHF(a) - eHF(b) + num = (2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(q,i,a,b) + + SigC(p,q) = SigC(p,q) + num*eps/(eps**2 + eta**2) + if(p == q) Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + + end do + end do + end do + end do + end do + + Z(:) = 1d0/(1d0 - Z(:)) + +end subroutine self_energy_GF2 From 7fd5abe76f4e1d2f549c74d6e04ce5f74f6399f7 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Sat, 6 Mar 2021 23:08:43 +0100 Subject: [PATCH 36/63] clean up GM again --- input/methods | 6 +-- input/options | 4 +- src/MBPT/BSE2.f90 | 5 +++ src/MBPT/G0F2.f90 | 5 ++- src/MBPT/evGF2.f90 | 5 ++- src/MBPT/print_G0F2.f90 | 14 +++++-- src/MBPT/print_evGF2.f90 | 14 +++++-- src/MBPT/print_qsGF2.f90 | 12 +++--- src/MBPT/print_qsGW.f90 | 11 +++-- src/MBPT/print_qsUGW.f90 | 18 ++++---- src/MBPT/qsGF2.f90 | 5 ++- src/MBPT/qsUGW.f90 | 18 ++------ src/MBPT/self_energy_GF2.f90 | 68 +++++++++++++++++++++---------- src/MBPT/self_energy_GF2_diag.f90 | 66 ++++++++++++++++++------------ 14 files changed, 148 insertions(+), 103 deletions(-) diff --git a/input/methods b/input/methods index 89fb8f0..d790e69 100644 --- a/input/methods +++ b/input/methods @@ -1,7 +1,7 @@ # RHF UHF KS MOM T F F F # MP2* MP3 MP2-F12 - F F F + T F F # CCD DCD CCSD CCSD(T) F F F F # drCCD rCCD lCCD pCCD @@ -11,9 +11,9 @@ # RPA* RPAx* ppRPA F F F # G0F2 evGF2 qsGF2 G0F3 evGF3 - F F T F F + F F F F F # G0W0* evGW* qsGW* - F F F + F F T # G0T0 evGT qsGT F F F # MCMP2 diff --git a/input/options b/input/options index 347efea..f64a274 100644 --- a/input/options +++ b/input/options @@ -7,12 +7,12 @@ # spin: TDA singlet triplet spin_conserved spin_flip F T T T T # GF: maxSCF thresh DIIS n_diis lin eta renorm - 256 0.00001 T 5 T 0.0 3 + 256 0.00001 T 5 T 0.001 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 # ACFDT: AC Kx XBS F F T # BSE: BSE dBSE dTDA evDyn - F T T F + F F T F # MCMP2: nMC nEq nWalk dt nPrint iSeed doDrift 1000000 100000 10 0.3 10000 1234 T diff --git a/src/MBPT/BSE2.f90 b/src/MBPT/BSE2.f90 index 123cfea..25bc56c 100644 --- a/src/MBPT/BSE2.f90 +++ b/src/MBPT/BSE2.f90 @@ -56,6 +56,9 @@ subroutine BSE2(TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,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)) + call print_transition_vectors(.true.,nBas,nC,nO,nV,nR,nS,dipole_int, & + OmBSE(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) + ! Compute dynamic correction for BSE via perturbation theory @@ -90,6 +93,8 @@ subroutine BSE2(TDA,dBSE,dTDA,evDyn,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,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)) + call print_transition_vectors(.false.,nBas,nC,nO,nV,nR,nS,dipole_int, & + OmBSE(:,ispin),XpY(:,:,ispin),XmY(:,:,ispin)) ! Compute dynamic correction for BSE via perturbation theory diff --git a/src/MBPT/G0F2.f90 b/src/MBPT/G0F2.f90 index 303e5ea..bc1c7ab 100644 --- a/src/MBPT/G0F2.f90 +++ b/src/MBPT/G0F2.f90 @@ -30,6 +30,7 @@ subroutine G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet,linearize,eta,nBas,nC,nO ! Local variables + double precision :: Ec double precision :: EcBSE(nspin) double precision,allocatable :: eGF2(:) double precision,allocatable :: SigC(:) @@ -56,7 +57,7 @@ subroutine G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet,linearize,eta,nBas,nC,nO ! Frequency-dependent second-order contribution - call self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eHF,ERI,SigC,Z) + call self_energy_GF2_diag(eta,nBas,nC,nO,nV,nR,nS,eHF,eHF,ERI,SigC,Z,Ec) if(linearize) then @@ -70,7 +71,7 @@ subroutine G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet,linearize,eta,nBas,nC,nO ! Print results - call print_G0F2(nBas,nO,eHF,SigC,eGF2,Z) + call print_G0F2(nBas,nO,eHF,SigC,eGF2,Z,ENuc,ERHF,Ec) ! Perform BSE2 calculation diff --git a/src/MBPT/evGF2.f90 b/src/MBPT/evGF2.f90 index ff39619..eb5d775 100644 --- a/src/MBPT/evGF2.f90 +++ b/src/MBPT/evGF2.f90 @@ -36,6 +36,7 @@ subroutine evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF,thresh,max_diis,singlet,triplet, integer :: nSCF integer :: n_diis + double precision :: Ec double precision :: EcBSE(nspin) double precision :: Conv double precision :: rcond @@ -76,7 +77,7 @@ subroutine evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF,thresh,max_diis,singlet,triplet, ! Frequency-dependent second-order contribution - call self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z) + call self_energy_GF2_diag(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z,Ec) if(linearize) then @@ -92,7 +93,7 @@ subroutine evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF,thresh,max_diis,singlet,triplet, ! Print results - call print_evGF2(nBas,nO,nSCF,Conv,eHF,SigC,Z,eGF2) + call print_evGF2(nBas,nO,nSCF,Conv,eHF,SigC,Z,eGF2,ENuc,ERHF,Ec) ! DIIS extrapolation diff --git a/src/MBPT/print_G0F2.f90 b/src/MBPT/print_G0F2.f90 index e560db8..87b545b 100644 --- a/src/MBPT/print_G0F2.f90 +++ b/src/MBPT/print_G0F2.f90 @@ -1,4 +1,4 @@ -subroutine print_G0F2(nBas,nO,eHF,Sig,eGF2,Z) +subroutine print_G0F2(nBas,nO,eHF,Sig,eGF2,Z,ENuc,ERHF,Ec) ! Print one-electron energies and other stuff for G0F2 @@ -11,6 +11,9 @@ subroutine print_G0F2(nBas,nO,eHF,Sig,eGF2,Z) double precision,intent(in) :: Sig(nBas) double precision,intent(in) :: eGF2(nBas) double precision,intent(in) :: Z(nBas) + double precision,intent(in) :: ENuc + double precision,intent(in) :: ERHF + double precision,intent(in) :: Ec integer :: p integer :: HOMO @@ -38,10 +41,13 @@ subroutine print_G0F2(nBas,nO,eHF,Sig,eGF2,Z) enddo write(*,*)'--------------------------------------------------------------------------' - write(*,'(2X,A27,F15.6)') 'G0F2 HOMO energy (eV):',eGF2(HOMO)*HaToeV - write(*,'(2X,A27,F15.6)') 'G0F2 LUMO energy (eV):',eGF2(LUMO)*HaToeV - write(*,'(2X,A27,F15.6)') 'G0F2 HOMO-LUMO gap (eV):',Gap*HaToeV + write(*,'(2X,A30,F15.6)') 'G0F2 HOMO energy (eV):',eGF2(HOMO)*HaToeV + write(*,'(2X,A30,F15.6)') 'G0F2 LUMO energy (eV):',eGF2(LUMO)*HaToeV + write(*,'(2X,A30,F15.6)') 'G0F2 HOMO-LUMO gap (eV):',Gap*HaToeV write(*,*)'--------------------------------------------------------------------------' + write(*,'(2X,A30,F15.6,A3)') 'G0F2 total energy :',ENuc + ERHF + Ec,' au' + write(*,'(2X,A30,F15.6,A3)') 'G0F2 correlation energy:',Ec,' au' + write(*,*)'-------------------------------------------------------------------------------' write(*,*) end subroutine print_G0F2 diff --git a/src/MBPT/print_evGF2.f90 b/src/MBPT/print_evGF2.f90 index fdab254..07c8b42 100644 --- a/src/MBPT/print_evGF2.f90 +++ b/src/MBPT/print_evGF2.f90 @@ -1,4 +1,4 @@ -subroutine print_evGF2(nBas,nO,nSCF,Conv,eHF,Sig,Z,eGF2) +subroutine print_evGF2(nBas,nO,nSCF,Conv,eHF,Sig,Z,eGF2,ENuc,ERHF,Ec) ! Print one-electron energies and other stuff for G0F2 @@ -13,6 +13,9 @@ subroutine print_evGF2(nBas,nO,nSCF,Conv,eHF,Sig,Z,eGF2) double precision,intent(in) :: Sig(nBas) double precision,intent(in) :: eGF2(nBas) double precision,intent(in) :: Z(nBas) + double precision,intent(in) :: ENuc + double precision,intent(in) :: ERHF + double precision,intent(in) :: Ec integer :: p integer :: HOMO @@ -44,10 +47,13 @@ subroutine print_evGF2(nBas,nO,nSCF,Conv,eHF,Sig,Z,eGF2) write(*,'(2X,A14,F15.5)')'Convergence = ',Conv write(*,*)'--------------------------------------------------------------------------' - write(*,'(2X,A27,F15.6)') 'evGF2 HOMO energy (eV):',eGF2(HOMO)*HaToeV - write(*,'(2X,A27,F15.6)') 'evGF2 LUMO energy (eV):',eGF2(LUMO)*HaToeV - write(*,'(2X,A27,F15.6)') 'evGF2 HOMO-LUMO gap (eV):',Gap*HaToeV + write(*,'(2X,A30,F15.6)') 'evGF2 HOMO energy (eV):',eGF2(HOMO)*HaToeV + write(*,'(2X,A30,F15.6)') 'evGF2 LUMO energy (eV):',eGF2(LUMO)*HaToeV + write(*,'(2X,A30,F15.6)') 'evGF2 HOMO-LUMO gap (eV):',Gap*HaToeV write(*,*)'--------------------------------------------------------------------------' + write(*,'(2X,A30,F15.6,A3)') 'evGF2 total energy :',ENuc + ERHF + Ec,' au' + write(*,'(2X,A30,F15.6,A3)') 'evGF2 correlation energy:',Ec,' au' + write(*,*)'-------------------------------------------------------------------------------' write(*,*) end subroutine print_evGF2 diff --git a/src/MBPT/print_qsGF2.f90 b/src/MBPT/print_qsGF2.f90 index c78100b..558e8b8 100644 --- a/src/MBPT/print_qsGF2.f90 +++ b/src/MBPT/print_qsGF2.f90 @@ -1,4 +1,4 @@ -subroutine print_qsGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,c,ENuc,P,T,V,J,K,F,SigC,Z,EqsGF2,dipole) +subroutine print_qsGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,c,ENuc,P,T,V,J,K,F,SigC,Z,EqsGF2,Ec,dipole) ! Print one-electron energies and other stuff for qsGF2 @@ -44,8 +44,7 @@ subroutine print_qsGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,c,ENuc,P,T,V,J,K,F,SigC EV = trace_matrix(nBas,matmul(P,V)) EJ = 0.5d0*trace_matrix(nBas,matmul(P,J)) Ex = 0.25d0*trace_matrix(nBas,matmul(P,K)) - Ec = 0.50d0*trace_matrix(nBas,matmul(P,SigC)) - EqsGF2 = ET + EV + EJ + Ex + Ec + EqsGF2 = ET + EV + EJ + Ex ! Dump results @@ -73,8 +72,9 @@ subroutine print_qsGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,c,ENuc,P,T,V,J,K,F,SigC write(*,'(2X,A30,F15.6,A3)') 'qsGF2 LUMO energy:',eGF2(LUMO)*HaToeV,' eV' write(*,'(2X,A30,F15.6,A3)') 'qsGF2 HOMO-LUMO gap :',Gap*HaToeV,' eV' write(*,*)'-------------------------------------------' - write(*,'(2X,A30,F15.6,A3)') ' qsGF2 total energy:',EqsGF2 + ENuc,' au' + write(*,'(2X,A30,F15.6,A3)') ' qsGF2 total energy:',ENuc + EqsGF2 + Ec,' au' write(*,'(2X,A30,F15.6,A3)') ' qsGF2 exchange energy:',Ex,' au' + write(*,'(2X,A30,F15.6,A3)') ' qsGF2 correlation energy:',Ec,' au' write(*,*)'-------------------------------------------' write(*,*) @@ -95,9 +95,9 @@ subroutine print_qsGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,c,ENuc,P,T,V,J,K,F,SigC write(*,'(A32,1X,F16.10,A3)') ' Exchange energy: ',Ex,' au' write(*,'(A32,1X,F16.10,A3)') ' Correlation energy: ',Ec,' au' write(*,'(A50)') '---------------------------------------' - write(*,'(A32,1X,F16.10,A3)') ' Electronic energy: ',EqsGF2,' au' + write(*,'(A32,1X,F16.10,A3)') ' Electronic energy: ',EqsGF2 + Ec,' au' write(*,'(A32,1X,F16.10,A3)') ' Nuclear repulsion: ',ENuc,' au' - write(*,'(A32,1X,F16.10,A3)') ' qsGF2 energy: ',ENuc + EqsGF2,' au' + write(*,'(A32,1X,F16.10,A3)') ' qsGF2 energy: ',ENuc + EqsGF2 + Ec,' au' write(*,'(A50)') '---------------------------------------' write(*,'(A35)') ' Dipole moment (Debye) ' write(*,'(10X,4A10)') 'X','Y','Z','Tot.' diff --git a/src/MBPT/print_qsGW.f90 b/src/MBPT/print_qsGW.f90 index d6be17b..97b65be 100644 --- a/src/MBPT/print_qsGW.f90 +++ b/src/MBPT/print_qsGW.f90 @@ -27,7 +27,7 @@ subroutine print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,ENuc,P,T,V,J,K,F,SigC,Z ! Local variables integer :: x,ixyz,HOMO,LUMO - double precision :: Gap,ET,EV,EJ,Ex,Ec + double precision :: Gap,ET,EV,EJ,Ex double precision,external :: trace_matrix ! Output variables @@ -46,8 +46,7 @@ subroutine print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,ENuc,P,T,V,J,K,F,SigC,Z EV = trace_matrix(nBas,matmul(P,V)) EJ = 0.5d0*trace_matrix(nBas,matmul(P,J)) Ex = 0.25d0*trace_matrix(nBas,matmul(P,K)) -! Ec = -0.50d0*trace_matrix(nBas,matmul(P,SigC)) - EqsGW = ET + EV + EJ + Ex + EcGM + EqsGW = ET + EV + EJ + Ex ! Dump results @@ -75,9 +74,9 @@ subroutine print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,ENuc,P,T,V,J,K,F,SigC,Z write(*,'(2X,A30,F15.6,A3)') 'qsGW LUMO energy:',eGW(LUMO)*HaToeV,' eV' write(*,'(2X,A30,F15.6,A3)') 'qsGW HOMO-LUMO gap :',Gap*HaToeV,' eV' write(*,*)'-------------------------------------------' - write(*,'(2X,A30,F15.6,A3)') ' qsGW total energy:',EqsGW + ENuc,' au' + write(*,'(2X,A30,F15.6,A3)') ' qsGW total energy:',ENuc + EqsGW + EcGM,' au' write(*,'(2X,A30,F15.6,A3)') ' qsGW exchange energy:',Ex,' au' - write(*,'(2X,A30,F15.6,A3)') ' qsGW correlation energy:',EcGM,' au' + write(*,'(2X,A30,F15.6,A3)') ' GM@qsGW correlation energy:',EcGM,' au' write(*,'(2X,A30,F15.6,A3)') 'RPA@qsGW correlation energy:',EcRPA,' au' write(*,*)'-------------------------------------------' write(*,*) @@ -101,7 +100,7 @@ subroutine print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,ENuc,P,T,V,J,K,F,SigC,Z write(*,'(A50)') '---------------------------------------' write(*,'(A32,1X,F16.10,A3)') ' Electronic energy: ',EqsGW,' au' write(*,'(A32,1X,F16.10,A3)') ' Nuclear repulsion: ',ENuc,' au' - write(*,'(A32,1X,F16.10,A3)') ' qsGW energy: ',ENuc + EqsGW,' au' + write(*,'(A32,1X,F16.10,A3)') ' qsGW energy: ',ENuc + EqsGW + EcGM,' au' write(*,'(A50)') '---------------------------------------' write(*,'(A35)') ' Dipole moment (Debye) ' write(*,'(10X,4A10)') 'X','Y','Z','Tot.' diff --git a/src/MBPT/print_qsUGW.f90 b/src/MBPT/print_qsUGW.f90 index 32dc633..d776764 100644 --- a/src/MBPT/print_qsUGW.f90 +++ b/src/MBPT/print_qsUGW.f90 @@ -1,5 +1,5 @@ subroutine print_qsUGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,cGW,PGW,Ov,T,V,J,K, & - ENuc,ET,EV,EJ,Ex,Ec,EcGM,EcRPA,EqsGW,SigC,Z,dipole) + ENuc,ET,EV,EJ,Ex,EcGM,EcRPA,EqsGW,SigC,Z,dipole) ! Print one-electron energies and other stuff for qsUGW @@ -16,7 +16,6 @@ subroutine print_qsUGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,cGW,PGW,Ov,T,V,J,K, & double precision,intent(in) :: EV(nspin) double precision,intent(in) :: EJ(nsp) double precision,intent(in) :: Ex(nspin) - double precision,intent(in) :: Ec(nsp) double precision,intent(in) :: EcGM(nspin) double precision,intent(in) :: EcRPA double precision,intent(in) :: EqsGW @@ -101,9 +100,8 @@ subroutine print_qsUGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,cGW,PGW,Ov,T,V,J,K, & write(*,'(2X,A30,F15.6,A3)') 'qsUGW HOMO-LUMO gap :',(minval(LUMO(:))-maxval(HOMO(:)))*HaToeV,' eV' write(*,*)'-------------------------------------------------------------------------------& -------------------------------------------------' - write(*,'(2X,A30,F15.6,A3)') ' qsUGW total energy:',EqsGW + ENuc,' au' + write(*,'(2X,A30,F15.6,A3)') ' qsUGW total energy:',ENuc + EqsGW + sum(EcGM(:)),' au' write(*,'(2X,A30,F15.6,A3)') ' qsUGW exchange energy:',sum(Ex(:)),' au' -! write(*,'(2X,A30,F15.6,A3)') ' qsUGW correlation energy:',sum(Ec(:)),' au' write(*,'(2X,A30,F15.6,A3)') ' GM@qsUGW correlation energy:',sum(EcGM(:)),' au' write(*,'(2X,A30,F15.6,A3)') 'RPA@qsUGW correlation energy:',EcRPA,' au' write(*,*)'-------------------------------------------------------------------------------& @@ -113,7 +111,6 @@ subroutine print_qsUGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,cGW,PGW,Ov,T,V,J,K, & ! Dump results for final iteration if(Conv < thresh) then -! if(.true.) then write(*,*) write(*,'(A60)') '-------------------------------------------------' @@ -145,14 +142,13 @@ subroutine print_qsUGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,cGW,PGW,Ov,T,V,J,K, & write(*,'(A40,1X,F16.10,A3)') ' Exchange a energy: ',Ex(1),' au' write(*,'(A40,1X,F16.10,A3)') ' Exchange b energy: ',Ex(2),' au' write(*,*) -! write(*,'(A40,1X,F16.10,A3)') ' Correlation energy: ',sum(Ec(:)),' au' -! write(*,'(A40,1X,F16.10,A3)') ' Correlation aa energy: ',Ec(1),' au' -! write(*,'(A40,1X,F16.10,A3)') ' Correlation ab energy: ',Ec(2),' au' -! write(*,'(A40,1X,F16.10,A3)') ' Correlation bb energy: ',Ec(3),' au' + write(*,'(A40,1X,F16.10,A3)') ' Correlation energy: ',sum(EcGM(:)),' au' + write(*,'(A40,1X,F16.10,A3)') ' Correlation aa energy: ',EcGM(1),' au' + write(*,'(A40,1X,F16.10,A3)') ' Correlation bb energy: ',EcGM(2),' au' write(*,'(A60)') '-------------------------------------------------' - write(*,'(A40,1X,F16.10,A3)') ' Electronic energy: ',EqsGW,' au' + write(*,'(A40,1X,F16.10,A3)') ' Electronic energy: ',EqsGW + sum(EcGM(:)),' au' write(*,'(A40,1X,F16.10,A3)') ' Nuclear repulsion: ',ENuc,' au' - write(*,'(A40,1X,F16.10,A3)') ' qsUGW energy: ',EqsGW + ENuc,' au' + write(*,'(A40,1X,F16.10,A3)') ' qsUGW energy: ',ENuc + EqsGW + sum(EcGM(:)),' au' write(*,'(A60)') '-------------------------------------------------' write(*,'(A40,F13.6)') ' S (exact) :',2d0*S_exact + 1d0 write(*,'(A40,F13.6)') ' S :',2d0*S + 1d0 diff --git a/src/MBPT/qsGF2.f90 b/src/MBPT/qsGF2.f90 index 0248685..7ae192b 100644 --- a/src/MBPT/qsGF2.f90 +++ b/src/MBPT/qsGF2.f90 @@ -52,6 +52,7 @@ subroutine qsGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet, double precision :: rcond double precision,external :: trace_matrix double precision :: dipole(ncart) + double precision :: Ec double precision :: EcBSE(nspin) double precision,allocatable :: error_diis(:,:) @@ -136,7 +137,7 @@ subroutine qsGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet, ! Compute self-energy and renormalization factor - call self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI_MO,SigC,Z) + call self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI_MO,SigC,Z,Ec) ! Make correlation self-energy Hermitian and transform it back to AO basis @@ -177,7 +178,7 @@ subroutine qsGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet, ! Print results call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int_AO,dipole) - call print_qsGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,c,ENuc,P,T,V,J,K,F,SigCp,Z,EqsGF2,dipole) + call print_qsGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,c,ENuc,P,T,V,J,K,F,SigCp,Z,EqsGF2,Ec,dipole) enddo !------------------------------------------------------------------------ diff --git a/src/MBPT/qsUGW.f90 b/src/MBPT/qsUGW.f90 index d5b84d2..de27201 100644 --- a/src/MBPT/qsUGW.f90 +++ b/src/MBPT/qsUGW.f90 @@ -75,7 +75,6 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOS double precision :: EV(nspin) double precision :: EJ(nsp) double precision :: Ex(nspin) - double precision :: Ec(nsp) double precision :: EcRPA double precision :: EcGM(nspin) double precision :: EqsGW @@ -332,25 +331,16 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOS Ex(is) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,is),K(:,:,is))) end do - ! Correlation energy - - Ec(:) = 0d0 - -! Ec(1) = - 0.25d0*trace_matrix(nBas,matmul(P(:,:,1),SigCp(:,:,1))) -! Ec(2) = - 0.25d0*trace_matrix(nBas,matmul(P(:,:,1),SigCp(:,:,2))) & -! - 0.25d0*trace_matrix(nBas,matmul(P(:,:,2),SigCp(:,:,1))) -! Ec(3) = - 0.25d0*trace_matrix(nBas,matmul(P(:,:,2),SigCp(:,:,2))) - ! Total energy - EqsGW = sum(ET(:)) + sum(EV(:)) + sum(EJ(:)) + sum(Ex(:)) + sum(Ec(:)) + EqsGW = sum(ET(:)) + sum(EV(:)) + sum(EJ(:)) + sum(Ex(:)) !------------------------------------------------------------------------ ! Print results !------------------------------------------------------------------------ call dipole_moment(nBas,P(:,:,1)+P(:,:,2),nNuc,ZNuc,rNuc,dipole_int_AO,dipole) - call print_qsUGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,P,S,T,V,J,K,ENuc,ET,EV,EJ,Ex,Ec,EcGM,EcRPA,EqsGW,SigCp,Z,dipole) + call print_qsUGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,P,S,T,V,J,K,ENuc,ET,EV,EJ,Ex,EcGM,EcRPA,EqsGW,SigCp,Z,dipole) enddo !------------------------------------------------------------------------ @@ -398,7 +388,7 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOS write(*,'(2X,A50,F20.10)') 'Tr@BSE@qsUGW correlation energy (spin-conserved) =',EcBSE(1) write(*,'(2X,A50,F20.10)') 'Tr@BSE@qsUGW correlation energy (spin-flip) =',EcBSE(2) write(*,'(2X,A50,F20.10)') 'Tr@BSE@qsUGW correlation energy =',EcBSE(1) + EcBSE(2) - write(*,'(2X,A50,F20.10)') 'Tr@BSE@qsUGW total energy =',ENuc + EUHF + EcBSE(1) + EcBSE(2) + write(*,'(2X,A50,F20.10)') 'Tr@BSE@qsUGW total energy =',ENuc + EqsGW + EcBSE(1) + EcBSE(2) write(*,*)'-------------------------------------------------------------------------------' write(*,*) @@ -426,7 +416,7 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOS write(*,'(2X,A50,F20.10)') 'AC@BSE@qsUGW correlation energy (spin-conserved) =',EcAC(1) write(*,'(2X,A50,F20.10)') 'AC@BSE@qsUGW correlation energy (spin-flip) =',EcAC(2) write(*,'(2X,A50,F20.10)') 'AC@BSE@qsUGW correlation energy =',EcAC(1) + EcAC(2) - write(*,'(2X,A50,F20.10)') 'AC@BSE@qsUGW total energy =',ENuc + EUHF + EcAC(1) + EcAC(2) + write(*,'(2X,A50,F20.10)') 'AC@BSE@qsUGW total energy =',ENuc + EqsGW + EcAC(1) + EcAC(2) write(*,*)'-------------------------------------------------------------------------------' write(*,*) diff --git a/src/MBPT/self_energy_GF2.f90 b/src/MBPT/self_energy_GF2.f90 index c64d507..21c1520 100644 --- a/src/MBPT/self_energy_GF2.f90 +++ b/src/MBPT/self_energy_GF2.f90 @@ -1,6 +1,6 @@ -subroutine self_energy_GF2_diag(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z) +subroutine self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z,Ec) -! Compute diagonal part of the GF2 self-energy and its renormalization factor +! Compute GF2 self-energy and its renormalization factor implicit none include 'parameters.h' @@ -16,49 +16,54 @@ subroutine self_energy_GF2_diag(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z) ! Local variables integer :: i,j,a,b - integer :: p + integer :: p,q double precision :: eps double precision :: num ! Output variables - double precision,intent(out) :: SigC(nBas) + double precision,intent(out) :: SigC(nBas,nBas) double precision,intent(out) :: Z(nBas) + double precision,intent(out) :: Ec ! Initialize - SigC(:) = 0d0 - Z(:) = 0d0 + SigC(:,:) = 0d0 + Z(:) = 0d0 -! Compute GF2 self-energy +! Compute GF2 self-energy and renormalization factor do p=nC+1,nBas-nR - do i=nC+1,nO - do j=nC+1,nO - do a=nO+1,nBas-nR + do q=nC+1,nBas-nR + do i=nC+1,nO + do j=nC+1,nO + do a=nO+1,nBas-nR - eps = eGF2(p) + eHF(a) - eHF(i) - eHF(j) - num = (2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(p,a,i,j) + eps = eGF2(p) + eHF(a) - eHF(i) - eHF(j) + num = (2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(q,a,i,j) - SigC(p) = SigC(p) + num*eps/(eps**2 + eta**2) - Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + SigC(p,q) = SigC(p,q) + num*eps/(eps**2 + eta**2) + if(p == q) Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + end do end do end do end do end do do p=nC+1,nBas-nR - do i=nC+1,nO - do a=nO+1,nBas-nR - do b=nO+1,nBas-nR + do q=nC+1,nBas-nR + do i=nC+1,nO + do a=nO+1,nBas-nR + do b=nO+1,nBas-nR - eps = eGF2(p) + eHF(i) - eHF(a) - eHF(b) - num = (2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(p,i,a,b) + eps = eGF2(p) + eHF(i) - eHF(a) - eHF(b) + num = (2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(q,i,a,b) - SigC(p) = SigC(p) + num*eps/(eps**2 + eta**2) - Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + SigC(p,q) = SigC(p,q) + num*eps/(eps**2 + eta**2) + if(p == q) Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + end do end do end do end do @@ -66,4 +71,23 @@ subroutine self_energy_GF2_diag(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z) Z(:) = 1d0/(1d0 - Z(:)) -end subroutine self_energy_GF2_diag +! Compute correlaiton energy + + Ec = 0d0 + + do j=nC+1,nO + do i=nC+1,nO + do a=nO+1,nBas-nR + do b=nO+1,nBas-nR + + eps = eGF2(j) + eHF(i) - eHF(a) - eHF(b) + num = (2d0*ERI(j,i,a,b) - ERI(j,i,b,a))*ERI(j,i,a,b) + + Ec = Ec + num*eps/(eps**2 + eta**2) + + end do + end do + end do + end do + +end subroutine self_energy_GF2 diff --git a/src/MBPT/self_energy_GF2_diag.f90 b/src/MBPT/self_energy_GF2_diag.f90 index e4dcdd1..e0611a0 100644 --- a/src/MBPT/self_energy_GF2_diag.f90 +++ b/src/MBPT/self_energy_GF2_diag.f90 @@ -1,6 +1,6 @@ -subroutine self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z) +subroutine self_energy_GF2_diag(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z,Ec) -! Compute GF2 self-energy and its renormalization factor +! Compute diagonal part of the GF2 self-energy and its renormalization factor implicit none include 'parameters.h' @@ -16,53 +16,50 @@ subroutine self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z) ! Local variables integer :: i,j,a,b - integer :: p,q + integer :: p double precision :: eps double precision :: num ! Output variables - double precision,intent(out) :: SigC(nBas,nBas) + double precision,intent(out) :: SigC(nBas) double precision,intent(out) :: Z(nBas) + double precision,intent(out) :: Ec ! Initialize - SigC(:,:) = 0d0 - Z(:) = 0d0 + SigC(:) = 0d0 + Z(:) = 0d0 ! Compute GF2 self-energy do p=nC+1,nBas-nR - do q=nC+1,nBas-nR - do i=nC+1,nO - do j=nC+1,nO - do a=nO+1,nBas-nR + do i=nC+1,nO + do j=nC+1,nO + do a=nO+1,nBas-nR - eps = eGF2(p) + eHF(a) - eHF(i) - eHF(j) - num = (2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(q,a,i,j) + eps = eGF2(p) + eHF(a) - eHF(i) - eHF(j) + num = (2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(p,a,i,j) - SigC(p,q) = SigC(p,q) + num*eps/(eps**2 + eta**2) - if(p == q) Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + SigC(p) = SigC(p) + num*eps/(eps**2 + eta**2) + Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 - end do end do end do end do end do do p=nC+1,nBas-nR - do q=nC+1,nBas-nR - do i=nC+1,nO - do a=nO+1,nBas-nR - do b=nO+1,nBas-nR + do i=nC+1,nO + do a=nO+1,nBas-nR + do b=nO+1,nBas-nR - eps = eGF2(p) + eHF(i) - eHF(a) - eHF(b) - num = (2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(q,i,a,b) + eps = eGF2(p) + eHF(i) - eHF(a) - eHF(b) + num = (2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(p,i,a,b) - SigC(p,q) = SigC(p,q) + num*eps/(eps**2 + eta**2) - if(p == q) Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + SigC(p) = SigC(p) + num*eps/(eps**2 + eta**2) + Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 - end do end do end do end do @@ -70,4 +67,23 @@ subroutine self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z) Z(:) = 1d0/(1d0 - Z(:)) -end subroutine self_energy_GF2 +! Compute correlaiton energy + + Ec = 0d0 + + do j=nC+1,nO + do i=nC+1,nO + do a=nO+1,nBas-nR + do b=nO+1,nBas-nR + + eps = eGF2(j) + eHF(i) - eHF(a) - eHF(b) + num = (2d0*ERI(j,i,a,b) - ERI(j,i,b,a))*ERI(j,i,a,b) + + Ec = Ec + num*eps/(eps**2 + eta**2) + + end do + end do + end do + end do + +end subroutine self_energy_GF2_diag From 3ced7a88467fb7bfd40b689fddf9fda33e0ade75 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Sun, 7 Mar 2021 17:17:18 +0100 Subject: [PATCH 37/63] GF move --- src/{MBPT => GF}/BSE2.f90 | 0 src/{MBPT => GF}/BSE2_A_matrix_dynamic.f90 | 0 src/{MBPT => GF}/BSE2_B_matrix_dynamic.f90 | 0 .../BSE2_dynamic_perturbation.f90 | 0 .../BSE2_dynamic_perturbation_iterative.f90 | 0 src/{MBPT => GF}/G0F2.f90 | 0 src/{MBPT => GF}/G0F3.f90 | 0 src/{MBPT => GF}/G0T0.f90 | 0 src/{MBPT => GF}/G0W0.f90 | 0 src/{MBPT => GF}/evGF2.f90 | 0 src/{MBPT => GF}/evGF3.f90 | 0 src/{MBPT => GF}/print_G0F2.f90 | 0 src/{MBPT => GF}/print_G0F3.f90 | 0 src/{MBPT => GF}/print_evGF2.f90 | 0 src/{MBPT => GF}/print_evGF3.f90 | 0 src/{MBPT => GF}/print_qsGF2.f90 | 0 src/{MBPT => GF}/qsGF2.f90 | 0 src/{MBPT => GF}/self_energy_GF2.f90 | 0 src/{MBPT => GF}/self_energy_GF2_diag.f90 | 0 src/GF/unrestricted_self_energy_GF2.f90 | 158 ++++++++++++++++++ 20 files changed, 158 insertions(+) rename src/{MBPT => GF}/BSE2.f90 (100%) rename src/{MBPT => GF}/BSE2_A_matrix_dynamic.f90 (100%) rename src/{MBPT => GF}/BSE2_B_matrix_dynamic.f90 (100%) rename src/{MBPT => GF}/BSE2_dynamic_perturbation.f90 (100%) rename src/{MBPT => GF}/BSE2_dynamic_perturbation_iterative.f90 (100%) rename src/{MBPT => GF}/G0F2.f90 (100%) rename src/{MBPT => GF}/G0F3.f90 (100%) rename src/{MBPT => GF}/G0T0.f90 (100%) rename src/{MBPT => GF}/G0W0.f90 (100%) rename src/{MBPT => GF}/evGF2.f90 (100%) rename src/{MBPT => GF}/evGF3.f90 (100%) rename src/{MBPT => GF}/print_G0F2.f90 (100%) rename src/{MBPT => GF}/print_G0F3.f90 (100%) rename src/{MBPT => GF}/print_evGF2.f90 (100%) rename src/{MBPT => GF}/print_evGF3.f90 (100%) rename src/{MBPT => GF}/print_qsGF2.f90 (100%) rename src/{MBPT => GF}/qsGF2.f90 (100%) rename src/{MBPT => GF}/self_energy_GF2.f90 (100%) rename src/{MBPT => GF}/self_energy_GF2_diag.f90 (100%) create mode 100644 src/GF/unrestricted_self_energy_GF2.f90 diff --git a/src/MBPT/BSE2.f90 b/src/GF/BSE2.f90 similarity index 100% rename from src/MBPT/BSE2.f90 rename to src/GF/BSE2.f90 diff --git a/src/MBPT/BSE2_A_matrix_dynamic.f90 b/src/GF/BSE2_A_matrix_dynamic.f90 similarity index 100% rename from src/MBPT/BSE2_A_matrix_dynamic.f90 rename to src/GF/BSE2_A_matrix_dynamic.f90 diff --git a/src/MBPT/BSE2_B_matrix_dynamic.f90 b/src/GF/BSE2_B_matrix_dynamic.f90 similarity index 100% rename from src/MBPT/BSE2_B_matrix_dynamic.f90 rename to src/GF/BSE2_B_matrix_dynamic.f90 diff --git a/src/MBPT/BSE2_dynamic_perturbation.f90 b/src/GF/BSE2_dynamic_perturbation.f90 similarity index 100% rename from src/MBPT/BSE2_dynamic_perturbation.f90 rename to src/GF/BSE2_dynamic_perturbation.f90 diff --git a/src/MBPT/BSE2_dynamic_perturbation_iterative.f90 b/src/GF/BSE2_dynamic_perturbation_iterative.f90 similarity index 100% rename from src/MBPT/BSE2_dynamic_perturbation_iterative.f90 rename to src/GF/BSE2_dynamic_perturbation_iterative.f90 diff --git a/src/MBPT/G0F2.f90 b/src/GF/G0F2.f90 similarity index 100% rename from src/MBPT/G0F2.f90 rename to src/GF/G0F2.f90 diff --git a/src/MBPT/G0F3.f90 b/src/GF/G0F3.f90 similarity index 100% rename from src/MBPT/G0F3.f90 rename to src/GF/G0F3.f90 diff --git a/src/MBPT/G0T0.f90 b/src/GF/G0T0.f90 similarity index 100% rename from src/MBPT/G0T0.f90 rename to src/GF/G0T0.f90 diff --git a/src/MBPT/G0W0.f90 b/src/GF/G0W0.f90 similarity index 100% rename from src/MBPT/G0W0.f90 rename to src/GF/G0W0.f90 diff --git a/src/MBPT/evGF2.f90 b/src/GF/evGF2.f90 similarity index 100% rename from src/MBPT/evGF2.f90 rename to src/GF/evGF2.f90 diff --git a/src/MBPT/evGF3.f90 b/src/GF/evGF3.f90 similarity index 100% rename from src/MBPT/evGF3.f90 rename to src/GF/evGF3.f90 diff --git a/src/MBPT/print_G0F2.f90 b/src/GF/print_G0F2.f90 similarity index 100% rename from src/MBPT/print_G0F2.f90 rename to src/GF/print_G0F2.f90 diff --git a/src/MBPT/print_G0F3.f90 b/src/GF/print_G0F3.f90 similarity index 100% rename from src/MBPT/print_G0F3.f90 rename to src/GF/print_G0F3.f90 diff --git a/src/MBPT/print_evGF2.f90 b/src/GF/print_evGF2.f90 similarity index 100% rename from src/MBPT/print_evGF2.f90 rename to src/GF/print_evGF2.f90 diff --git a/src/MBPT/print_evGF3.f90 b/src/GF/print_evGF3.f90 similarity index 100% rename from src/MBPT/print_evGF3.f90 rename to src/GF/print_evGF3.f90 diff --git a/src/MBPT/print_qsGF2.f90 b/src/GF/print_qsGF2.f90 similarity index 100% rename from src/MBPT/print_qsGF2.f90 rename to src/GF/print_qsGF2.f90 diff --git a/src/MBPT/qsGF2.f90 b/src/GF/qsGF2.f90 similarity index 100% rename from src/MBPT/qsGF2.f90 rename to src/GF/qsGF2.f90 diff --git a/src/MBPT/self_energy_GF2.f90 b/src/GF/self_energy_GF2.f90 similarity index 100% rename from src/MBPT/self_energy_GF2.f90 rename to src/GF/self_energy_GF2.f90 diff --git a/src/MBPT/self_energy_GF2_diag.f90 b/src/GF/self_energy_GF2_diag.f90 similarity index 100% rename from src/MBPT/self_energy_GF2_diag.f90 rename to src/GF/self_energy_GF2_diag.f90 diff --git a/src/GF/unrestricted_self_energy_GF2.f90 b/src/GF/unrestricted_self_energy_GF2.f90 new file mode 100644 index 0000000..674eae9 --- /dev/null +++ b/src/GF/unrestricted_self_energy_GF2.f90 @@ -0,0 +1,158 @@ +subroutine UMP2(nBas,nC,nO,nV,nR,ERI_aa,ERI_ab,ERI_bb,ENuc,EHF,e,Ec) + +! Perform unrestricted second-order Moller-Plesset calculation + + 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) + double precision,intent(in) :: ENuc + double precision,intent(in) :: EHF + 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) :: e(nBas,nspin) + +! Local variables + + integer :: bra,ket + integer :: i,j,a,b + double precision :: eps + double precision :: Edaa,Exaa,Ecaa + double precision :: Edab,Exab,Ecab + double precision :: Edbb,Exbb,Ecbb + double precision :: Ed,Ex + +! Output variables + + double precision,intent(out) :: Ec + +! Hello world + + write(*,*) + write(*,*)'********************************************************' + write(*,*)'| Unrestricted second-order Moller-Plesset calculation |' + write(*,*)'********************************************************' + write(*,*) + +!---------------------! +! Compute UMP2 energy | +!---------------------! + +! aaaa block + + bra = 1 + ket = 1 + + Edaa = 0d0 + Exaa = 0d0 + + do i=nC(bra)+1,nO(bra) + do a=nO(bra)+1,nBas-nR(bra) + + do j=nC(ket)+1,nO(ket) + do b=nO(ket)+1,nBas-nR(ket) + + eps = e(i,bra) + e(j,ket) - e(a,bra) - e(b,ket) + + Edaa = Edaa + 0.5d0*ERI_aa(i,j,a,b)*ERI_aa(i,j,a,b)/eps + Exaa = Exaa - 0.5d0*ERI_aa(i,j,a,b)*ERI_aa(i,j,b,a)/eps + + + enddo + enddo + enddo + enddo + + Ecaa = Edaa + Exaa + +! aabb block + + bra = 1 + ket = 2 + + Edab = 0d0 + Exab = 0d0 + + do i=nC(bra)+1,nO(bra) + do a=nO(bra)+1,nBas-nR(bra) + + do j=nC(ket)+1,nO(ket) + do b=nO(ket)+1,nBas-nR(ket) + + eps = e(i,bra) + e(j,ket) - e(a,bra) - e(b,ket) + + Edab = Edab + ERI_ab(i,j,a,b)*ERI_ab(i,j,a,b)/eps + + enddo + enddo + enddo + enddo + + Ecab = Edab + Exab + +! bbbb block + + bra = 2 + ket = 2 + + Edbb = 0d0 + Exbb = 0d0 + + do i=nC(bra)+1,nO(bra) + do a=nO(bra)+1,nBas-nR(bra) + + do j=nC(ket)+1,nO(ket) + do b=nO(ket)+1,nBas-nR(ket) + + eps = e(i,bra) + e(j,ket) - e(a,bra) - e(b,ket) + + Edbb = Edbb + 0.5d0*ERI_bb(i,j,a,b)*ERI_bb(i,j,a,b)/eps + Exbb = Exbb - 0.5d0*ERI_bb(i,j,a,b)*ERI_bb(i,j,b,a)/eps + + + enddo + enddo + enddo + enddo + + Ecbb = Edbb + Exbb + +! Final flush + + Ed = Edaa + Edab + Edbb + Ex = Exaa + Exab + Exbb + Ec = Ed + Ex + + write(*,*) + write(*,'(A32)') '--------------------------' + write(*,'(A32)') ' MP2 calculation ' + write(*,'(A32)') '--------------------------' + write(*,'(A32,1X,F16.10)') ' MP2 correlation energy = ',Ec + write(*,'(A32,1X,F16.10)') ' alpha-alpha = ',Ecaa + write(*,'(A32,1X,F16.10)') ' alpha-beta = ',Ecab + write(*,'(A32,1X,F16.10)') ' beta-beta = ',Ecbb + write(*,*) + write(*,'(A32,1X,F16.10)') ' Direct part = ',Ed + write(*,'(A32,1X,F16.10)') ' alpha-alpha = ',Edaa + write(*,'(A32,1X,F16.10)') ' alpha-beta = ',Edab + write(*,'(A32,1X,F16.10)') ' beta-beta = ',Edbb + write(*,*) + write(*,'(A32,1X,F16.10)') ' Exchange part = ',Ex + write(*,'(A32,1X,F16.10)') ' alpha-alpha = ',Exaa + write(*,'(A32,1X,F16.10)') ' alpha-beta = ',Exab + write(*,'(A32,1X,F16.10)') ' beta-beta = ',Exbb + write(*,'(A32)') '--------------------------' + write(*,'(A32,1X,F16.10)') ' MP2 electronic energy = ', EHF + Ec + write(*,'(A32,1X,F16.10)') ' MP2 total energy = ',ENuc + EHF + Ec + write(*,'(A32)') '--------------------------' + write(*,*) + +end subroutine UMP2 From 533e88e8faf02ed6c4845067466c25e50a6e9ef9 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Sun, 7 Mar 2021 22:19:42 +0100 Subject: [PATCH 38/63] qsUGF2 --- src/GF/self_energy_GF2.f90 | 4 +- src/GF/unrestricted_self_energy_GF2.f90 | 250 +++++++++++-------- src/GF/unrestricted_self_energy_GF2_diag.f90 | 188 ++++++++++++++ 3 files changed, 332 insertions(+), 110 deletions(-) create mode 100644 src/GF/unrestricted_self_energy_GF2_diag.f90 diff --git a/src/GF/self_energy_GF2.f90 b/src/GF/self_energy_GF2.f90 index 21c1520..8ab7bad 100644 --- a/src/GF/self_energy_GF2.f90 +++ b/src/GF/self_energy_GF2.f90 @@ -43,7 +43,7 @@ subroutine self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z,Ec) num = (2d0*ERI(p,a,i,j) - ERI(p,a,j,i))*ERI(q,a,i,j) SigC(p,q) = SigC(p,q) + num*eps/(eps**2 + eta**2) - if(p == q) Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + if(p == q) Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 end do end do @@ -61,7 +61,7 @@ subroutine self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z,Ec) num = (2d0*ERI(p,i,a,b) - ERI(p,i,b,a))*ERI(q,i,a,b) SigC(p,q) = SigC(p,q) + num*eps/(eps**2 + eta**2) - if(p == q) Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + if(p == q) Z(p) = Z(p) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 end do end do diff --git a/src/GF/unrestricted_self_energy_GF2.f90 b/src/GF/unrestricted_self_energy_GF2.f90 index 674eae9..bbd9e72 100644 --- a/src/GF/unrestricted_self_energy_GF2.f90 +++ b/src/GF/unrestricted_self_energy_GF2.f90 @@ -1,6 +1,6 @@ -subroutine UMP2(nBas,nC,nO,nV,nR,ERI_aa,ERI_ab,ERI_bb,ENuc,EHF,e,Ec) +subroutine unrestricted_self_energy_GF2(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,eGF2,SigC,Z) -! Perform unrestricted second-order Moller-Plesset calculation +! Perform unrestricted GF2 self-energy and its renormalization factor implicit none include 'parameters.h' @@ -13,146 +13,180 @@ subroutine UMP2(nBas,nC,nO,nV,nR,ERI_aa,ERI_ab,ERI_bb,ENuc,EHF,e,Ec) integer,intent(in) :: nO(nspin) integer,intent(in) :: nV(nspin) integer,intent(in) :: nR(nspin) - double precision,intent(in) :: ENuc - double precision,intent(in) :: EHF + double precision,intent(in) :: eta 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) :: e(nBas,nspin) + double precision,intent(in) :: eHF(nBas,nspin) + double precision,intent(in) :: eGF2(nBas,nspin) ! Local variables - integer :: bra,ket + integer :: p,q integer :: i,j,a,b - double precision :: eps - double precision :: Edaa,Exaa,Ecaa - double precision :: Edab,Exab,Ecab - double precision :: Edbb,Exbb,Ecbb - double precision :: Ed,Ex + double precision :: eps,num ! Output variables - double precision,intent(out) :: Ec - -! Hello world - - write(*,*) - write(*,*)'********************************************************' - write(*,*)'| Unrestricted second-order Moller-Plesset calculation |' - write(*,*)'********************************************************' - write(*,*) + double precision,intent(out) :: SigC(nBas,nBas,nspin) + double precision,intent(out) :: Z(nBas,nspin) !---------------------! -! Compute UMP2 energy | +! Compute self-energy | !---------------------! -! aaaa block + !----------------! + ! Spin-up sector + !----------------! - bra = 1 - ket = 1 + do p=nC(1)+1,nBas-nR(1) + do q=nC(1)+1,nBas-nR(1) - Edaa = 0d0 - Exaa = 0d0 + ! Addition part: aa - do i=nC(bra)+1,nO(bra) - do a=nO(bra)+1,nBas-nR(bra) + do i=nC(1)+1,nO(1) + do a=nO(1)+1,nBas-nR(1) + do b=nO(1)+1,nBas-nR(1) - do j=nC(ket)+1,nO(ket) - do b=nO(ket)+1,nBas-nR(ket) - - eps = e(i,bra) + e(j,ket) - e(a,bra) - e(b,ket) + eps = eGF2(p,1) + eHF(i,1) - eHF(a,1) - eHF(b,1) + num = ERI_aa(i,q,a,b)*ERI_aa(a,b,i,p) & + - ERI_aa(i,q,a,b)*ERI_aa(a,b,p,i) - Edaa = Edaa + 0.5d0*ERI_aa(i,j,a,b)*ERI_aa(i,j,a,b)/eps - Exaa = Exaa - 0.5d0*ERI_aa(i,j,a,b)*ERI_aa(i,j,b,a)/eps - + SigC(p,q,1) = SigC(p,q,1) + num*eps/(eps**2 + eta**2) + if(p == q) Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + enddo enddo enddo + + ! Addition part: ab + + do i=nC(2)+1,nO(2) + do a=nO(2)+1,nBas-nR(2) + do b=nO(1)+1,nBas-nR(1) + + eps = eGF2(p,1) + eHF(i,2) - eHF(a,2) - eHF(b,1) + num = ERI_ab(q,i,b,a)*ERI_ab(b,a,p,i) + + SigC(p,q,1) = SigC(p,q,1) + num*eps/(eps**2 + eta**2) + if(p == q) Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + + enddo + enddo + enddo + + ! Removal part: aa + + do i=nC(1)+1,nO(1) + do a=nO(1)+1,nBas-nR(1) + do j=nC(1)+1,nO(1) + + eps = eGF2(p,1) + eHF(a,1) - eHF(i,1) - eHF(j,1) + num = ERI_aa(a,q,i,j)*ERI_aa(i,j,a,p) & + - ERI_aa(a,q,i,j)*ERI_aa(i,j,p,a) + + SigC(p,q,1) = SigC(p,q,1) + num*eps/(eps**2 + eta**2) + if(p == q) Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + + enddo + enddo + enddo + + ! Removal part: ab + + do i=nC(2)+1,nO(2) + do a=nO(2)+1,nBas-nR(2) + do j=nC(1)+1,nO(1) + + eps = eGF2(p,1) + eHF(a,2) - eHF(i,2) - eHF(j,1) + num = ERI_ab(q,a,j,i)*ERI_ab(j,i,p,a) + + SigC(p,q,1) = SigC(p,q,1) + num*eps/(eps**2 + eta**2) + if(p == q) Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + + enddo + enddo + enddo + enddo enddo - Ecaa = Edaa + Exaa + !------------------! + ! Spin-down sector ! + !------------------! -! aabb block + do p=nC(2)+1,nBas-nR(2) + do q=nC(2)+1,nBas-nR(2) - bra = 1 - ket = 2 + ! Addition part: bb - Edab = 0d0 - Exab = 0d0 + do i=nC(2)+1,nO(2) + do a=nO(2)+1,nBas-nR(2) + do b=nO(2)+1,nBas-nR(2) - do i=nC(bra)+1,nO(bra) - do a=nO(bra)+1,nBas-nR(bra) - - do j=nC(ket)+1,nO(ket) - do b=nO(ket)+1,nBas-nR(ket) - - eps = e(i,bra) + e(j,ket) - e(a,bra) - e(b,ket) + eps = eGF2(p,2) + eHF(i,2) - eHF(a,2) - eHF(b,2) + num = ERI_bb(i,q,a,b)*ERI_bb(a,b,i,p) & + - ERI_bb(i,q,a,b)*ERI_bb(a,b,p,i) - Edab = Edab + ERI_ab(i,j,a,b)*ERI_ab(i,j,a,b)/eps + SigC(p,q,2) = SigC(p,q,2) + num*eps/(eps**2 + eta**2) + if(p == q) Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + enddo enddo enddo + + ! Addition part: ab + + do i=nC(1)+1,nO(1) + do a=nO(1)+1,nBas-nR(1) + do b=nO(2)+1,nBas-nR(2) + + eps = eGF2(p,2) + eHF(i,1) - eHF(a,1) - eHF(b,2) + num = ERI_ab(i,q,a,b)*ERI_ab(a,b,i,p) + + SigC(p,q,2) = SigC(p,q,2) + num*eps/(eps**2 + eta**2) + if(p == q) Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + + enddo + enddo + enddo + + ! Removal part: bb + + do i=nC(2)+1,nO(2) + do a=nO(2)+1,nBas-nR(2) + do j=nC(2)+1,nO(2) + + eps = eGF2(p,2) + eHF(a,2) - eHF(i,2) - eHF(j,2) + num = ERI_bb(a,q,i,j)*ERI_bb(i,j,a,p) & + - ERI_bb(a,q,i,j)*ERI_bb(i,j,p,a) + + SigC(p,q,2) = SigC(p,q,2) + num*eps/(eps**2 + eta**2) + if(p == q) Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + + enddo + enddo + enddo + + ! Removal part: ab + + do i=nC(1)+1,nO(1) + do a=nO(1)+1,nBas-nR(1) + do j=nC(2)+1,nO(2) + + eps = eGF2(p,2) + eHF(a,1) - eHF(i,1) - eHF(j,2) + num = ERI_ab(a,q,i,j)*ERI_ab(i,j,a,p) + + SigC(p,q,2) = SigC(p,q,2) + num*eps/(eps**2 + eta**2) + if(p == q) Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + + enddo + enddo + enddo + enddo enddo - Ecab = Edab + Exab + Z(:,:) = 1d0/(1d0 - Z(:,:)) -! bbbb block - - bra = 2 - ket = 2 - - Edbb = 0d0 - Exbb = 0d0 - - do i=nC(bra)+1,nO(bra) - do a=nO(bra)+1,nBas-nR(bra) - - do j=nC(ket)+1,nO(ket) - do b=nO(ket)+1,nBas-nR(ket) - - eps = e(i,bra) + e(j,ket) - e(a,bra) - e(b,ket) - - Edbb = Edbb + 0.5d0*ERI_bb(i,j,a,b)*ERI_bb(i,j,a,b)/eps - Exbb = Exbb - 0.5d0*ERI_bb(i,j,a,b)*ERI_bb(i,j,b,a)/eps - - - enddo - enddo - enddo - enddo - - Ecbb = Edbb + Exbb - -! Final flush - - Ed = Edaa + Edab + Edbb - Ex = Exaa + Exab + Exbb - Ec = Ed + Ex - - write(*,*) - write(*,'(A32)') '--------------------------' - write(*,'(A32)') ' MP2 calculation ' - write(*,'(A32)') '--------------------------' - write(*,'(A32,1X,F16.10)') ' MP2 correlation energy = ',Ec - write(*,'(A32,1X,F16.10)') ' alpha-alpha = ',Ecaa - write(*,'(A32,1X,F16.10)') ' alpha-beta = ',Ecab - write(*,'(A32,1X,F16.10)') ' beta-beta = ',Ecbb - write(*,*) - write(*,'(A32,1X,F16.10)') ' Direct part = ',Ed - write(*,'(A32,1X,F16.10)') ' alpha-alpha = ',Edaa - write(*,'(A32,1X,F16.10)') ' alpha-beta = ',Edab - write(*,'(A32,1X,F16.10)') ' beta-beta = ',Edbb - write(*,*) - write(*,'(A32,1X,F16.10)') ' Exchange part = ',Ex - write(*,'(A32,1X,F16.10)') ' alpha-alpha = ',Exaa - write(*,'(A32,1X,F16.10)') ' alpha-beta = ',Exab - write(*,'(A32,1X,F16.10)') ' beta-beta = ',Exbb - write(*,'(A32)') '--------------------------' - write(*,'(A32,1X,F16.10)') ' MP2 electronic energy = ', EHF + Ec - write(*,'(A32,1X,F16.10)') ' MP2 total energy = ',ENuc + EHF + Ec - write(*,'(A32)') '--------------------------' - write(*,*) - -end subroutine UMP2 +end subroutine unrestricted_self_energy_GF2 diff --git a/src/GF/unrestricted_self_energy_GF2_diag.f90 b/src/GF/unrestricted_self_energy_GF2_diag.f90 new file mode 100644 index 0000000..d88c1eb --- /dev/null +++ b/src/GF/unrestricted_self_energy_GF2_diag.f90 @@ -0,0 +1,188 @@ +subroutine unrestricted_self_energy_GF2_diag(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_bb,eHF,eGF2,SigC,Z) + +! Perform unrestricted GF2 self-energy and its renormalization factor + + 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) + double precision,intent(in) :: eta + 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) :: eHF(nBas,nspin) + double precision,intent(in) :: eGF2(nBas,nspin) + +! Local variables + + integer :: p + integer :: i,j,a,b + double precision :: eps,num + +! Output variables + + double precision,intent(out) :: SigC(nBas,nspin) + double precision,intent(out) :: Z(nBas,nspin) + +!---------------------! +! Compute self-energy | +!---------------------! + + !----------------! + ! Spin-up sector + !----------------! + + do p=nC(1)+1,nBas-nR(1) + + ! Addition part: aa + + do i=nC(1)+1,nO(1) + do a=nO(1)+1,nBas-nR(1) + do b=nO(1)+1,nBas-nR(1) + + eps = eGF2(p,1) + eHF(i,1) - eHF(a,1) - eHF(b,1) + num = ERI_aa(i,p,a,b)*ERI_aa(a,b,i,p) & + - ERI_aa(i,p,a,b)*ERI_aa(a,b,p,i) + + SigC(p,1) = SigC(p,1) + num*eps/(eps**2 + eta**2) + Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + + enddo + enddo + enddo + + ! Addition part: ab + + do i=nC(2)+1,nO(2) + do a=nO(2)+1,nBas-nR(2) + do b=nO(1)+1,nBas-nR(1) + + eps = eGF2(p,1) + eHF(i,2) - eHF(a,2) - eHF(b,1) + num = ERI_ab(p,i,b,a)*ERI_ab(b,a,p,i) + + SigC(p,1) = SigC(p,1) + num*eps/(eps**2 + eta**2) + Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + + enddo + enddo + enddo + + ! Removal part: aa + + do i=nC(1)+1,nO(1) + do a=nO(1)+1,nBas-nR(1) + do j=nC(1)+1,nO(1) + + eps = eGF2(p,1) + eHF(a,1) - eHF(i,1) - eHF(j,1) + num = ERI_aa(a,p,i,j)*ERI_aa(i,j,a,p) & + - ERI_aa(a,p,i,j)*ERI_aa(i,j,p,a) + + SigC(p,1) = SigC(p,1) + num*eps/(eps**2 + eta**2) + Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + + enddo + enddo + enddo + + ! Removal part: ab + + do i=nC(2)+1,nO(2) + do a=nO(2)+1,nBas-nR(2) + do j=nC(1)+1,nO(1) + + eps = eGF2(p,1) + eHF(a,2) - eHF(i,2) - eHF(j,1) + num = ERI_ab(p,a,j,i)*ERI_ab(j,i,p,a) + + SigC(p,1) = SigC(p,1) + num*eps/(eps**2 + eta**2) + Z(p,1) = Z(p,1) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + + enddo + enddo + enddo + + enddo + + !------------------! + ! Spin-down sector ! + !------------------! + + do p=nC(2)+1,nBas-nR(2) + + ! Addition part: bb + + do i=nC(2)+1,nO(2) + do a=nO(2)+1,nBas-nR(2) + do b=nO(2)+1,nBas-nR(2) + + eps = eGF2(p,2) + eHF(i,2) - eHF(a,2) - eHF(b,2) + num = ERI_bb(i,p,a,b)*ERI_bb(a,b,i,p) & + - ERI_bb(i,p,a,b)*ERI_bb(a,b,p,i) + + SigC(p,2) = SigC(p,2) + num*eps/(eps**2 + eta**2) + Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + + enddo + enddo + enddo + + ! Addition part: ab + + do i=nC(1)+1,nO(1) + do a=nO(1)+1,nBas-nR(1) + do b=nO(2)+1,nBas-nR(2) + + eps = eGF2(p,2) + eHF(i,1) - eHF(a,1) - eHF(b,2) + num = ERI_ab(i,p,a,b)*ERI_ab(a,b,i,p) + + SigC(p,2) = SigC(p,2) + num*eps/(eps**2 + eta**2) + Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + + enddo + enddo + enddo + + ! Removal part: bb + + do i=nC(2)+1,nO(2) + do a=nO(2)+1,nBas-nR(2) + do j=nC(2)+1,nO(2) + + eps = eGF2(p,2) + eHF(a,2) - eHF(i,2) - eHF(j,2) + num = ERI_bb(a,p,i,j)*ERI_bb(i,j,a,p) & + - ERI_bb(a,p,i,j)*ERI_bb(i,j,p,a) + + SigC(p,2) = SigC(p,2) + num*eps/(eps**2 + eta**2) + Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + + enddo + enddo + enddo + + ! Removal part: ab + + do i=nC(1)+1,nO(1) + do a=nO(1)+1,nBas-nR(1) + do j=nC(2)+1,nO(2) + + eps = eGF2(p,2) + eHF(a,1) - eHF(i,1) - eHF(j,2) + num = ERI_ab(a,p,i,j)*ERI_ab(i,j,a,p) + + SigC(p,2) = SigC(p,2) + num*eps/(eps**2 + eta**2) + Z(p,2) = Z(p,2) - num*(eps**2 - eta**2)/(eps**2 + eta**2)**2 + + enddo + enddo + enddo + + enddo + + Z(:,:) = 1d0/(1d0 - Z(:,:)) + +end subroutine unrestricted_self_energy_GF2_diag From 29ed74cba0a75a393ea64f985b840f5706599389 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Sun, 7 Mar 2021 22:44:37 +0100 Subject: [PATCH 39/63] qsUGF2 --- src/GF/G0F2.f90 | 3 +- src/GF/evGF2.f90 | 3 +- src/GF/print_qsGF2.f90 | 3 +- src/GF/print_qsUGF2.f90 | 178 ++++++++++++++++++ src/GF/qsGF2.f90 | 3 +- src/GF/qsUGF2.f90 | 309 ++++++++++++++++++++++++++++++++ src/GF/self_energy_GF2.f90 | 22 +-- src/GF/self_energy_GF2_diag.f90 | 22 +-- src/MP/UMP2.f90 | 12 +- 9 files changed, 504 insertions(+), 51 deletions(-) create mode 100644 src/GF/print_qsUGF2.f90 create mode 100644 src/GF/qsUGF2.f90 diff --git a/src/GF/G0F2.f90 b/src/GF/G0F2.f90 index bc1c7ab..cfc7750 100644 --- a/src/GF/G0F2.f90 +++ b/src/GF/G0F2.f90 @@ -57,7 +57,7 @@ subroutine G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet,linearize,eta,nBas,nC,nO ! Frequency-dependent second-order contribution - call self_energy_GF2_diag(eta,nBas,nC,nO,nV,nR,nS,eHF,eHF,ERI,SigC,Z,Ec) + call self_energy_GF2_diag(eta,nBas,nC,nO,nV,nR,nS,eHF,eHF,ERI,SigC,Z) if(linearize) then @@ -71,6 +71,7 @@ subroutine G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet,linearize,eta,nBas,nC,nO ! Print results + call MP2(nBas,nC,nO,nV,nR,ERI,ENuc,EHF,eGF2,Ec) call print_G0F2(nBas,nO,eHF,SigC,eGF2,Z,ENuc,ERHF,Ec) ! Perform BSE2 calculation diff --git a/src/GF/evGF2.f90 b/src/GF/evGF2.f90 index eb5d775..2203533 100644 --- a/src/GF/evGF2.f90 +++ b/src/GF/evGF2.f90 @@ -77,7 +77,7 @@ subroutine evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF,thresh,max_diis,singlet,triplet, ! Frequency-dependent second-order contribution - call self_energy_GF2_diag(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z,Ec) + call self_energy_GF2_diag(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z) if(linearize) then @@ -93,6 +93,7 @@ subroutine evGF2(BSE,TDA,dBSE,dTDA,evDyn,maxSCF,thresh,max_diis,singlet,triplet, ! Print results + call MP2(nBas,nC,nO,nV,nR,ERI,ENuc,EHF,eGF2,Ec) call print_evGF2(nBas,nO,nSCF,Conv,eHF,SigC,Z,eGF2,ENuc,ERHF,Ec) ! DIIS extrapolation diff --git a/src/GF/print_qsGF2.f90 b/src/GF/print_qsGF2.f90 index 558e8b8..02c694d 100644 --- a/src/GF/print_qsGF2.f90 +++ b/src/GF/print_qsGF2.f90 @@ -20,12 +20,13 @@ subroutine print_qsGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,c,ENuc,P,T,V,J,K,F,SigC double precision,intent(in) :: T(nBas,nBas),V(nBas,nBas) double precision,intent(in) :: J(nBas,nBas),K(nBas,nBas),F(nBas,nBas) double precision,intent(in) :: Z(nBas),SigC(nBas,nBas) + double precision,intent(in) :: Ec double precision,intent(in) :: dipole(ncart) ! Local variables integer :: q,ixyz,HOMO,LUMO - double precision :: Gap,ET,EV,EJ,Ex,Ec + double precision :: Gap,ET,EV,EJ,Ex double precision,external :: trace_matrix ! Output variables diff --git a/src/GF/print_qsUGF2.f90 b/src/GF/print_qsUGF2.f90 new file mode 100644 index 0000000..5b825e9 --- /dev/null +++ b/src/GF/print_qsUGF2.f90 @@ -0,0 +1,178 @@ +subroutine print_qsUGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,cGF2,PGF2,Ov,T,V,J,K, & + ENuc,ET,EV,EJ,Ex,Ec,EqsGF2,SigC,Z,dipole) + +! Print one-electron energies and other stuff for qsUGF2 + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nBas + integer,intent(in) :: nO(nspin) + integer,intent(in) :: nSCF + double precision,intent(in) :: ENuc + double precision,intent(in) :: ET(nspin) + double precision,intent(in) :: EV(nspin) + double precision,intent(in) :: EJ(nsp) + double precision,intent(in) :: Ex(nspin) + double precision,intent(in) :: Ec(nsp) + double precision,intent(in) :: EqsGF2 + double precision,intent(in) :: Conv + double precision,intent(in) :: thresh + double precision,intent(in) :: eHF(nBas,nspin) + double precision,intent(in) :: eGF2(nBas,nspin) + double precision,intent(in) :: cGF2(nBas,nBas,nspin) + double precision,intent(in) :: PGF2(nBas,nBas,nspin) + double precision,intent(in) :: Ov(nBas,nBas) + double precision,intent(in) :: T(nBas,nBas) + double precision,intent(in) :: V(nBas,nBas) + double precision,intent(in) :: J(nBas,nBas,nspin) + double precision,intent(in) :: K(nBas,nBas,nspin) + double precision,intent(in) :: SigC(nBas,nBas,nspin) + double precision,intent(in) :: Z(nBas,nspin) + double precision,intent(in) :: dipole(ncart) + +! Local variables + + integer :: p + integer :: ispin,ixyz + double precision :: HOMO(nspin) + double precision :: LUMO(nspin) + double precision :: Gap(nspin) + double precision :: S_exact,S2_exact + double precision :: S,S2 + double precision,external :: trace_matrix + +! HOMO and LUMO + + do ispin=1,nspin + if(nO(ispin) > 0) then + HOMO(ispin) = eGF2(nO(ispin),ispin) + LUMO(ispin) = eGF2(nO(ispin)+1,ispin) + Gap(ispin) = LUMO(ispin) - HOMO(ispin) + else + HOMO(ispin) = 0d0 + LUMO(ispin) = eGF2(1,ispin) + Gap(ispin) = 0d0 + end if + end do + + S2_exact = dble(nO(1) - nO(2))/2d0*(dble(nO(1) - nO(2))/2d0 + 1d0) + S2 = S2_exact + nO(2) - sum(matmul(transpose(cGF2(:,1:nO(1),1)),matmul(Ov,cGF2(:,1:nO(2),2)))**2) + + S_exact = 0.5d0*dble(nO(1) - nO(2)) + S = -0.5d0 + 0.5d0*sqrt(1d0 + 4d0*S2) + +! Dump results + + write(*,*)'-------------------------------------------------------------------------------& + -------------------------------------------------' + if(nSCF < 10) then + write(*,'(1X,A21,I1,A1,I1,A12)')' Self-consistent qsG',nSCF,'W',nSCF,' calculation' + else + write(*,'(1X,A21,I2,A1,I2,A12)')' Self-consistent qsG',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,'|',eHF(p,1)*HaToeV,eHF(p,2)*HaToeV,'|',SigC(p,p,1)*HaToeV,SigC(p,p,2)*HaToeV,'|', & + Z(p,1),Z(p,2),'|',eGF2(p,1)*HaToeV,eGF2(p,2)*HaToeV,'|' + enddo + + write(*,*)'-------------------------------------------------------------------------------& + -------------------------------------------------' + write(*,'(2X,A10,I3)') 'Iteration ',nSCF + write(*,'(2X,A19,F15.5)')'max(|FPS - SPF|) = ',Conv + write(*,*)'-------------------------------------------------------------------------------& + -------------------------------------------------' + write(*,'(2X,A30,F15.6,A3)') 'qsUGF2 HOMO energy:',maxval(HOMO(:))*HaToeV,' eV' + write(*,'(2X,A30,F15.6,A3)') 'qsUGF2 LUMO energy:',minval(LUMO(:))*HaToeV,' eV' + write(*,'(2X,A30,F15.6,A3)') 'qsUGF2 HOMO-LUMO gap :',(minval(LUMO(:))-maxval(HOMO(:)))*HaToeV,' eV' + write(*,*)'-------------------------------------------------------------------------------& + -------------------------------------------------' + write(*,'(2X,A30,F15.6,A3)') ' qsUGF2 total energy:',ENuc + EqsGF2 + sum(Ec(:)),' au' + write(*,'(2X,A30,F15.6,A3)') ' qsUGF2 exchange energy:',sum(Ex(:)),' au' + write(*,'(2X,A30,F15.6,A3)') ' qsUGF2 correlation energy:',sum(Ec(:)),' au' + write(*,*)'-------------------------------------------------------------------------------& + -------------------------------------------------' + write(*,*) + +! Dump results for final iteration + + if(Conv < thresh) then + + write(*,*) + write(*,'(A60)') '-------------------------------------------------' + write(*,'(A40)') ' Summary ' + write(*,'(A60)') '-------------------------------------------------' + write(*,'(A40,1X,F16.10,A3)') ' One-electron energy: ',sum(ET(:)) + sum(EV(:)),' au' + write(*,'(A40,1X,F16.10,A3)') ' One-electron a energy: ',ET(1) + EV(1),' au' + write(*,'(A40,1X,F16.10,A3)') ' One-electron b energy: ',ET(2) + EV(2),' au' + write(*,*) + write(*,'(A40,1X,F16.10,A3)') ' Kinetic energy: ',sum(ET(:)),' au' + write(*,'(A40,1X,F16.10,A3)') ' Kinetic a energy: ',ET(1),' au' + write(*,'(A40,1X,F16.10,A3)') ' Kinetic b energy: ',ET(2),' au' + write(*,*) + write(*,'(A40,1X,F16.10,A3)') ' Potential energy: ',sum(EV(:)),' au' + write(*,'(A40,1X,F16.10,A3)') ' Potential a energy: ',EV(1),' au' + write(*,'(A40,1X,F16.10,A3)') ' Potential b energy: ',EV(2),' au' + write(*,'(A60)') '-------------------------------------------------' + write(*,'(A40,1X,F16.10,A3)') ' Two-electron energy: ',sum(EJ(:)) + sum(Ex(:)),' au' + write(*,'(A40,1X,F16.10,A3)') ' Two-electron aa energy: ',EJ(1) + Ex(1),' au' + write(*,'(A40,1X,F16.10,A3)') ' Two-electron ab energy: ',EJ(2),' au' + write(*,'(A40,1X,F16.10,A3)') ' Two-electron bb energy: ',EJ(3) + Ex(2),' au' + write(*,*) + write(*,'(A40,1X,F16.10,A3)') ' Hartree energy: ',sum(EJ(:)),' au' + write(*,'(A40,1X,F16.10,A3)') ' Hartree aa energy: ',EJ(1),' au' + write(*,'(A40,1X,F16.10,A3)') ' Hartree ab energy: ',EJ(2),' au' + write(*,'(A40,1X,F16.10,A3)') ' Hartree bb energy: ',EJ(3),' au' + write(*,*) + write(*,'(A40,1X,F16.10,A3)') ' Exchange energy: ',sum(Ex(:)),' au' + write(*,'(A40,1X,F16.10,A3)') ' Exchange a energy: ',Ex(1),' au' + write(*,'(A40,1X,F16.10,A3)') ' Exchange b energy: ',Ex(2),' au' + write(*,*) + write(*,'(A40,1X,F16.10,A3)') ' Correlation energy: ',sum(Ec(:)),' au' + write(*,'(A40,1X,F16.10,A3)') ' Correlation aa energy: ',Ec(1),' au' + write(*,'(A40,1X,F16.10,A3)') ' Correlation ab energy: ',Ec(2),' au' + write(*,'(A40,1X,F16.10,A3)') ' Correlation bb energy: ',Ec(3),' au' + write(*,'(A60)') '-------------------------------------------------' + write(*,'(A40,1X,F16.10,A3)') ' Electronic energy: ',EqsGF2 + sum(Ec(:)),' au' + write(*,'(A40,1X,F16.10,A3)') ' Nuclear repulsion: ',ENuc,' au' + write(*,'(A40,1X,F16.10,A3)') ' qsUGF2 energy: ',ENuc + EqsGF2 + sum(Ec(:)),' au' + write(*,'(A60)') '-------------------------------------------------' + write(*,'(A40,F13.6)') ' S (exact) :',2d0*S_exact + 1d0 + write(*,'(A40,F13.6)') ' S :',2d0*S + 1d0 + write(*,'(A40,F13.6)') ' (exact) :',S2_exact + write(*,'(A40,F13.6)') ' :',S2 + write(*,'(A60)') '-------------------------------------------------' + write(*,'(A45)') ' Dipole moment (Debye) ' + write(*,'(19X,4A10)') 'X','Y','Z','Tot.' + write(*,'(19X,4F10.6)') (dipole(ixyz)*auToD,ixyz=1,ncart),norm2(dipole)*auToD + write(*,'(A60)') '-------------------------------------------------' + write(*,*) + + ! Print orbitals + + write(*,'(A50)') '-----------------------------------------' + write(*,'(A50)') 'qsUGF2 spin-up orbital coefficients ' + write(*,'(A50)') '-----------------------------------------' + call matout(nBas,nBas,cGF2(:,:,1)) + write(*,*) + write(*,'(A50)') '-----------------------------------------' + write(*,'(A50)') 'qsUGF2 spin-down orbital coefficients ' + write(*,'(A50)') '-----------------------------------------' + call matout(nBas,nBas,cGF2(:,:,2)) + write(*,*) + + endif + +end subroutine print_qsUGF2 diff --git a/src/GF/qsGF2.f90 b/src/GF/qsGF2.f90 index 7ae192b..5f810cf 100644 --- a/src/GF/qsGF2.f90 +++ b/src/GF/qsGF2.f90 @@ -137,7 +137,7 @@ subroutine qsGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet, ! Compute self-energy and renormalization factor - call self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI_MO,SigC,Z,Ec) + call self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI_MO,SigC,Z) ! Make correlation self-energy Hermitian and transform it back to AO basis @@ -177,6 +177,7 @@ subroutine qsGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet, ! Print results + call MP2(nBas,nC,nO,nV,nR,ERI_MO,ENuc,EHF,eGF2,Ec) call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int_AO,dipole) call print_qsGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,c,ENuc,P,T,V,J,K,F,SigCp,Z,EqsGF2,Ec,dipole) diff --git a/src/GF/qsUGF2.f90 b/src/GF/qsUGF2.f90 new file mode 100644 index 0000000..93d2833 --- /dev/null +++ b/src/GF/qsUGF2.f90 @@ -0,0 +1,309 @@ +subroutine qsUGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta, & + nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,EUHF,S,X,T,V,Hc,ERI_AO, & + ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_AO,dipole_int_aa,dipole_int_bb,PHF,cHF,eHF) + +! Perform an unrestricted quasiparticle self-consistent GF2 calculation + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: maxSCF + integer,intent(in) :: max_diis + double precision,intent(in) :: thresh + logical,intent(in) :: BSE + 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) :: nNuc + double precision,intent(in) :: ZNuc(nNuc) + double precision,intent(in) :: rNuc(nNuc,ncart) + double precision,intent(in) :: ENuc + + 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) :: EUHF + 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) :: S(nBas,nBas) + double precision,intent(in) :: T(nBas,nBas) + double precision,intent(in) :: V(nBas,nBas) + double precision,intent(in) :: Hc(nBas,nBas) + double precision,intent(in) :: X(nBas,nBas) + double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas) + double precision,intent(inout):: ERI_aaaa(nBas,nBas,nBas,nBas) + double precision,intent(inout):: ERI_aabb(nBas,nBas,nBas,nBas) + double precision,intent(inout):: ERI_bbbb(nBas,nBas,nBas,nBas) + double precision,intent(in) :: dipole_int_AO(nBas,nBas,ncart) + double precision,intent(in) :: dipole_int_aa(nBas,nBas,ncart) + double precision,intent(in) :: dipole_int_bb(nBas,nBas,ncart) + +! Local variables + + integer :: nSCF + integer :: nBasSq + integer :: ispin + integer :: is + integer :: n_diis + integer :: nS_aa,nS_bb,nS_sc + double precision :: dipole(ncart) + + double precision :: ET(nspin) + double precision :: EV(nspin) + double precision :: EJ(nsp) + double precision :: Ex(nspin) + double precision :: Ec(nspin) + double precision :: EqsGF2 + double precision :: EcBSE(nspin) + double precision :: EcAC(nspin) + double precision :: Conv + double precision :: rcond(nspin) + double precision,external :: trace_matrix + double precision,allocatable :: error_diis(:,:,:) + double precision,allocatable :: F_diis(:,:,:) + double precision,allocatable :: c(:,:,:) + double precision,allocatable :: cp(:,:,:) + double precision,allocatable :: eGF2(:,:) + double precision,allocatable :: P(:,:,:) + double precision,allocatable :: F(:,:,:) + double precision,allocatable :: Fp(:,:,:) + double precision,allocatable :: J(:,:,:) + double precision,allocatable :: K(:,:,:) + double precision,allocatable :: SigC(:,:,:) + double precision,allocatable :: SigCp(:,:,:) + double precision,allocatable :: SigCm(:,:,:) + double precision,allocatable :: Z(:,:) + double precision,allocatable :: error(:,:,:) + +! Hello world + + write(*,*) + write(*,*)'**************************************************' + write(*,*)'| Self-consistent unrestricted qsGF2 calculation |' + write(*,*)'**************************************************' + write(*,*) + +! Warning + + write(*,*) '!! ERIs in MO basis will be overwritten in qsUGF2 !!' + write(*,*) + +! Stuff + + nBasSq = nBas*nBas + +! TDA + + if(TDA) then + write(*,*) 'Tamm-Dancoff approximation activated!' + write(*,*) + end if + +! Memory allocation + + nS_aa = nS(1) + nS_bb = nS(2) + nS_sc = nS_aa + nS_bb + + allocate(eGF2(nBas,nspin),c(nBas,nBas,nspin),cp(nBas,nBas,nspin),P(nBas,nBas,nspin),F(nBas,nBas,nspin),Fp(nBas,nBas,nspin), & + J(nBas,nBas,nspin),K(nBas,nBas,nspin),SigC(nBas,nBas,nspin),SigCp(nBas,nBas,nspin),SigCm(nBas,nBas,nspin), & + Z(nBas,nspin),error(nBas,nBas,nspin),error_diis(nBasSq,max_diis,nspin),F_diis(nBasSq,max_diis,nspin)) + +! Initialization + + nSCF = -1 + n_diis = 0 + ispin = 1 + Conv = 1d0 + P(:,:,:) = PHF(:,:,:) + eGF2(:,:) = eHF(:,:) + c(:,:,:) = cHF(:,:,:) + F_diis(:,:,:) = 0d0 + error_diis(:,:,:) = 0d0 + +!------------------------------------------------------------------------ +! Main loop +!------------------------------------------------------------------------ + + do while(Conv > thresh .and. nSCF < maxSCF) + + ! Increment + + nSCF = nSCF + 1 + + ! Buid Coulomb matrix + + do is=1,nspin + call Coulomb_matrix_AO_basis(nBas,P(:,:,is),ERI_AO(:,:,:,:),J(:,:,is)) + end do + + ! Compute exchange part of the self-energy + + do is=1,nspin + call exchange_matrix_AO_basis(nBas,P(:,:,is),ERI_AO(:,:,:,:),K(:,:,is)) + end do + + !-------------------------------------------------- + ! AO to MO transformation of two-electron integrals + !-------------------------------------------------- + + ! 4-index transform for (aa|aa) block + + call AOtoMO_integral_transform(1,1,1,1,nBas,c,ERI_AO,ERI_aaaa) + + ! 4-index transform for (aa|bb) block + + call AOtoMO_integral_transform(1,1,2,2,nBas,c,ERI_AO,ERI_aabb) + + ! 4-index transform for (bb|bb) block + + call AOtoMO_integral_transform(2,2,2,2,nBas,c,ERI_AO,ERI_bbbb) + + !------------------------------------------------! + ! Compute self-energy and renormalization factor ! + !------------------------------------------------! + + call unrestricted_self_energy_GF2(nBas,nC,nO,nV,nR,eta,ERI_aaaa,ERI_aabb,ERI_bbbb,eHF,eGF2,SigC,Z) + + ! Make correlation self-energy Hermitian and transform it back to AO basis + + do is=1,nspin + SigCp(:,:,is) = 0.5d0*(SigC(:,:,is) + transpose(SigC(:,:,is))) + SigCm(:,:,is) = 0.5d0*(SigC(:,:,is) - transpose(SigC(:,:,is))) + end do + + do is=1,nspin + call MOtoAO_transform(nBas,S,c(:,:,is),SigCp(:,:,is)) + end do + + ! Solve the quasi-particle equation + + do is=1,nspin + F(:,:,is) = Hc(:,:) + J(:,:,is) + J(:,:,mod(is,2)+1) + K(:,:,is) + SigCp(:,:,is) + end do + + ! Check convergence + + do is=1,nspin + error(:,:,is) = matmul(F(:,:,is),matmul(P(:,:,is),S(:,:))) - matmul(matmul(S(:,:),P(:,:,is)),F(:,:,is)) + end do + + if(nSCF > 1) conv = maxval(abs(error(:,:,:))) + + ! DIIS extrapolation + + n_diis = min(n_diis+1,max_diis) + do is=1,nspin + if(nO(is) > 1) call DIIS_extrapolation(rcond(is),nBasSq,nBasSq,n_diis,error_diis(:,1:n_diis,is), & + F_diis(:,1:n_diis,is),error(:,:,is),F(:,:,is)) + end do + + ! Reset DIIS if required + + if(minval(rcond(:)) < 1d-15) n_diis = 0 + + ! Transform Fock matrix in orthogonal basis + + do is=1,nspin + Fp(:,:,is) = matmul(transpose(X(:,:)),matmul(F(:,:,is),X(:,:))) + end do + + ! Diagonalize Fock matrix to get eigenvectors and eigenvalues + + cp(:,:,:) = Fp(:,:,:) + do is=1,nspin + call diagonalize_matrix(nBas,cp(:,:,is),eGF2(:,is)) + end do + + ! Back-transform eigenvectors in non-orthogonal basis + + do is=1,nspin + c(:,:,is) = matmul(X(:,:),cp(:,:,is)) + end do + + ! Compute density matrix + + do is=1,nspin + P(:,:,is) = matmul(c(:,1:nO(is),is),transpose(c(:,1:nO(is),is))) + end do + + !------------------------------------------------------------------------ + ! Compute total energy + !------------------------------------------------------------------------ + + ! Kinetic energy + + do is=1,nspin + ET(is) = trace_matrix(nBas,matmul(P(:,:,is),T(:,:))) + end do + + ! Potential energy + + do is=1,nspin + EV(is) = trace_matrix(nBas,matmul(P(:,:,is),V(:,:))) + end do + + ! Coulomb energy + + EJ(1) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,1),J(:,:,1))) + EJ(2) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,1),J(:,:,2))) & + + 0.5d0*trace_matrix(nBas,matmul(P(:,:,2),J(:,:,1))) + EJ(3) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,2),J(:,:,2))) + + ! Exchange energy + + do is=1,nspin + Ex(is) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,is),K(:,:,is))) + end do + + ! Correlation energy + + call UMP2(nBas,nC,nO,nV,nR,ERI_aaaa,ERI_aabb,ERI_bbbb,ENuc,EHF,eGF2,Ec) + + ! Total energy + + EqsGF2 = sum(ET(:)) + sum(EV(:)) + sum(EJ(:)) + sum(Ex(:)) + + !------------------------------------------------------------------------ + ! Print results + !------------------------------------------------------------------------ + + call dipole_moment(nBas,P(:,:,1)+P(:,:,2),nNuc,ZNuc,rNuc,dipole_int_AO,dipole) + call print_qsUGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,c,P,S,T,V,J,K,ENuc,ET,EV,EJ,Ex,Ec,EqsGF2,SigCp,Z,dipole) + + enddo +!------------------------------------------------------------------------ +! End main loop +!------------------------------------------------------------------------ + +! Did it actually converge? + + if(nSCF == maxSCF) then + + write(*,*) + write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + write(*,*)' Convergence failed ' + write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + write(*,*) + + stop + + endif + +! Deallocate memory + + deallocate(cp,P,F,Fp,J,K,SigC,SigCp,SigCm,Z,error,error_diis,F_diis) + +end subroutine qsUGF2 diff --git a/src/GF/self_energy_GF2.f90 b/src/GF/self_energy_GF2.f90 index 8ab7bad..173ecaf 100644 --- a/src/GF/self_energy_GF2.f90 +++ b/src/GF/self_energy_GF2.f90 @@ -1,4 +1,4 @@ -subroutine self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z,Ec) +subroutine self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z) ! Compute GF2 self-energy and its renormalization factor @@ -24,7 +24,6 @@ subroutine self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z,Ec) double precision,intent(out) :: SigC(nBas,nBas) double precision,intent(out) :: Z(nBas) - double precision,intent(out) :: Ec ! Initialize @@ -71,23 +70,4 @@ subroutine self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z,Ec) Z(:) = 1d0/(1d0 - Z(:)) -! Compute correlaiton energy - - Ec = 0d0 - - do j=nC+1,nO - do i=nC+1,nO - do a=nO+1,nBas-nR - do b=nO+1,nBas-nR - - eps = eGF2(j) + eHF(i) - eHF(a) - eHF(b) - num = (2d0*ERI(j,i,a,b) - ERI(j,i,b,a))*ERI(j,i,a,b) - - Ec = Ec + num*eps/(eps**2 + eta**2) - - end do - end do - end do - end do - end subroutine self_energy_GF2 diff --git a/src/GF/self_energy_GF2_diag.f90 b/src/GF/self_energy_GF2_diag.f90 index e0611a0..c64d507 100644 --- a/src/GF/self_energy_GF2_diag.f90 +++ b/src/GF/self_energy_GF2_diag.f90 @@ -1,4 +1,4 @@ -subroutine self_energy_GF2_diag(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z,Ec) +subroutine self_energy_GF2_diag(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z) ! Compute diagonal part of the GF2 self-energy and its renormalization factor @@ -24,7 +24,6 @@ subroutine self_energy_GF2_diag(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z,Ec) double precision,intent(out) :: SigC(nBas) double precision,intent(out) :: Z(nBas) - double precision,intent(out) :: Ec ! Initialize @@ -67,23 +66,4 @@ subroutine self_energy_GF2_diag(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z,Ec) Z(:) = 1d0/(1d0 - Z(:)) -! Compute correlaiton energy - - Ec = 0d0 - - do j=nC+1,nO - do i=nC+1,nO - do a=nO+1,nBas-nR - do b=nO+1,nBas-nR - - eps = eGF2(j) + eHF(i) - eHF(a) - eHF(b) - num = (2d0*ERI(j,i,a,b) - ERI(j,i,b,a))*ERI(j,i,a,b) - - Ec = Ec + num*eps/(eps**2 + eta**2) - - end do - end do - end do - end do - end subroutine self_energy_GF2_diag diff --git a/src/MP/UMP2.f90 b/src/MP/UMP2.f90 index 674eae9..acdfbd2 100644 --- a/src/MP/UMP2.f90 +++ b/src/MP/UMP2.f90 @@ -32,7 +32,7 @@ subroutine UMP2(nBas,nC,nO,nV,nR,ERI_aa,ERI_ab,ERI_bb,ENuc,EHF,e,Ec) ! Output variables - double precision,intent(out) :: Ec + double precision,intent(out) :: Ec(nsp) ! Hello world @@ -72,6 +72,7 @@ subroutine UMP2(nBas,nC,nO,nV,nR,ERI_aa,ERI_ab,ERI_bb,ENuc,EHF,e,Ec) enddo Ecaa = Edaa + Exaa + Ec(1) = Ecaa ! aabb block @@ -97,6 +98,7 @@ subroutine UMP2(nBas,nC,nO,nV,nR,ERI_aa,ERI_ab,ERI_bb,ENuc,EHF,e,Ec) enddo Ecab = Edab + Exab + Ec(2) = Ecab ! bbbb block @@ -124,18 +126,18 @@ subroutine UMP2(nBas,nC,nO,nV,nR,ERI_aa,ERI_ab,ERI_bb,ENuc,EHF,e,Ec) enddo Ecbb = Edbb + Exbb + Ec(3) = Ecbb ! Final flush Ed = Edaa + Edab + Edbb Ex = Exaa + Exab + Exbb - Ec = Ed + Ex write(*,*) write(*,'(A32)') '--------------------------' write(*,'(A32)') ' MP2 calculation ' write(*,'(A32)') '--------------------------' - write(*,'(A32,1X,F16.10)') ' MP2 correlation energy = ',Ec + write(*,'(A32,1X,F16.10)') ' MP2 correlation energy = ',sum(Ec(:)) write(*,'(A32,1X,F16.10)') ' alpha-alpha = ',Ecaa write(*,'(A32,1X,F16.10)') ' alpha-beta = ',Ecab write(*,'(A32,1X,F16.10)') ' beta-beta = ',Ecbb @@ -150,8 +152,8 @@ subroutine UMP2(nBas,nC,nO,nV,nR,ERI_aa,ERI_ab,ERI_bb,ENuc,EHF,e,Ec) write(*,'(A32,1X,F16.10)') ' alpha-beta = ',Exab write(*,'(A32,1X,F16.10)') ' beta-beta = ',Exbb write(*,'(A32)') '--------------------------' - write(*,'(A32,1X,F16.10)') ' MP2 electronic energy = ', EHF + Ec - write(*,'(A32,1X,F16.10)') ' MP2 total energy = ',ENuc + EHF + Ec + write(*,'(A32,1X,F16.10)') ' MP2 electronic energy = ', EHF + sum(Ec(:)) + write(*,'(A32,1X,F16.10)') ' MP2 total energy = ',ENuc + EHF + sum(Ec(:)) write(*,'(A32)') '--------------------------' write(*,*) From 2d826d0f1e3f8f65b6ff38035c733e4d7f5137b4 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Sun, 7 Mar 2021 23:04:47 +0100 Subject: [PATCH 40/63] working on qsUGF2 --- input/methods | 10 +++++----- src/GF/print_qsGF2.f90 | 24 ++++++++++-------------- src/GF/print_qsUGF2.f90 | 4 ++-- src/GF/qsGF2.f90 | 40 +++++++++++++++++++++++++++++++++++++--- src/GF/qsUGF2.f90 | 8 ++++---- src/QuAcK/QuAcK.f90 | 14 ++++++++++++-- 6 files changed, 70 insertions(+), 30 deletions(-) diff --git a/input/methods b/input/methods index d790e69..f719fe3 100644 --- a/input/methods +++ b/input/methods @@ -1,7 +1,7 @@ # RHF UHF KS MOM - T F F F + F T F F # MP2* MP3 MP2-F12 - T F F + F F F # CCD DCD CCSD CCSD(T) F F F F # drCCD rCCD lCCD pCCD @@ -10,10 +10,10 @@ F F F F # RPA* RPAx* ppRPA F F F -# G0F2 evGF2 qsGF2 G0F3 evGF3 - F F F F F +# G0F2 evGF2 qsGF2* G0F3 evGF3 + F F T F F # G0W0* evGW* qsGW* - F F T + F F F # G0T0 evGT qsGT F F F # MCMP2 diff --git a/src/GF/print_qsGF2.f90 b/src/GF/print_qsGF2.f90 index 02c694d..5e3faf9 100644 --- a/src/GF/print_qsGF2.f90 +++ b/src/GF/print_qsGF2.f90 @@ -1,4 +1,5 @@ -subroutine print_qsGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,c,ENuc,P,T,V,J,K,F,SigC,Z,EqsGF2,Ec,dipole) +subroutine print_qsGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,c,P,T,V,J,K,F,SigC,Z, & + ENuc,ET,EV,EJ,Ex,Ec,EqsGF2,dipole) ! Print one-electron energies and other stuff for qsGF2 @@ -20,40 +21,35 @@ subroutine print_qsGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,c,ENuc,P,T,V,J,K,F,SigC double precision,intent(in) :: T(nBas,nBas),V(nBas,nBas) double precision,intent(in) :: J(nBas,nBas),K(nBas,nBas),F(nBas,nBas) double precision,intent(in) :: Z(nBas),SigC(nBas,nBas) + double precision,intent(in) :: ET + double precision,intent(in) :: EV + double precision,intent(in) :: EJ + double precision,intent(in) :: Ex double precision,intent(in) :: Ec + double precision,intent(in) :: EqsGF2 double precision,intent(in) :: dipole(ncart) ! Local variables integer :: q,ixyz,HOMO,LUMO - double precision :: Gap,ET,EV,EJ,Ex + double precision :: Gap double precision,external :: trace_matrix ! Output variables - double precision,intent(out) :: EqsGF2 - ! HOMO and LUMO HOMO = nO LUMO = HOMO + 1 Gap = eGF2(LUMO)-eGF2(HOMO) -! Compute energies - - ET = trace_matrix(nBas,matmul(P,T)) - EV = trace_matrix(nBas,matmul(P,V)) - EJ = 0.5d0*trace_matrix(nBas,matmul(P,J)) - Ex = 0.25d0*trace_matrix(nBas,matmul(P,K)) - EqsGF2 = ET + EV + EJ + Ex - ! Dump results write(*,*)'-------------------------------------------------------------------------------' if(nSCF < 10) then - write(*,'(1X,A21,I1,A1,I1,A12)')' Self-consistent qsG',nSCF,'W',nSCF,' calculation' + write(*,'(1X,A21,I1,A2,A12)')' Self-consistent qsG',nSCF,'F2',' calculation' else - write(*,'(1X,A21,I2,A1,I2,A12)')' Self-consistent qsG',nSCF,'W',nSCF,' calculation' + write(*,'(1X,A21,I2,A2,A12)')' Self-consistent qsG',nSCF,'F2',' calculation' endif 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)') & diff --git a/src/GF/print_qsUGF2.f90 b/src/GF/print_qsUGF2.f90 index 5b825e9..4db8f23 100644 --- a/src/GF/print_qsUGF2.f90 +++ b/src/GF/print_qsUGF2.f90 @@ -69,9 +69,9 @@ subroutine print_qsUGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,cGF2,PGF2,Ov,T,V,J,K, write(*,*)'-------------------------------------------------------------------------------& -------------------------------------------------' if(nSCF < 10) then - write(*,'(1X,A21,I1,A1,I1,A12)')' Self-consistent qsG',nSCF,'W',nSCF,' calculation' + write(*,'(1X,A21,I1,A2,A12)')' Self-consistent qsG',nSCF,'F2',' calculation' else - write(*,'(1X,A21,I2,A1,I2,A12)')' Self-consistent qsG',nSCF,'W',nSCF,' calculation' + write(*,'(1X,A21,I2,A2,A12)')' Self-consistent qsG',nSCF,'F2',' calculation' endif write(*,*)'-------------------------------------------------------------------------------& -------------------------------------------------' diff --git a/src/GF/qsGF2.f90 b/src/GF/qsGF2.f90 index 5f810cf..2f39f70 100644 --- a/src/GF/qsGF2.f90 +++ b/src/GF/qsGF2.f90 @@ -52,6 +52,10 @@ subroutine qsGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet, double precision :: rcond double precision,external :: trace_matrix double precision :: dipole(ncart) + double precision :: ET + double precision :: EV + double precision :: EJ + double precision :: Ex double precision :: Ec double precision :: EcBSE(nspin) @@ -175,11 +179,41 @@ subroutine qsGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet, P(:,:) = 2d0*matmul(c(:,1:nO),transpose(c(:,1:nO))) - ! Print results + !------------------------------------------------------------------------ + ! Compute total energy + !------------------------------------------------------------------------ + + ! Kinetic energy + + ET = trace_matrix(nBas,matmul(P,T)) + + ! Potential energy + + EV = trace_matrix(nBas,matmul(P,V)) + + ! Coulomb energy + + EJ = 0.5d0*trace_matrix(nBas,matmul(P,J)) + + ! Exchange energy + + Ex = -0.25d0*trace_matrix(nBas,matmul(P,K)) + + ! Total energy + + EqsGF2 = ET + EV + EJ + Ex + + ! Correlation energy + + call MP2(nBas,nC,nO,nV,nR,ERI_MO,ENuc,EqsGF2,eGF2,Ec) + + !------------------------------------------------------------------------ + ! Print results + !------------------------------------------------------------------------ - call MP2(nBas,nC,nO,nV,nR,ERI_MO,ENuc,EHF,eGF2,Ec) call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int_AO,dipole) - call print_qsGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,c,ENuc,P,T,V,J,K,F,SigCp,Z,EqsGF2,Ec,dipole) + call print_qsGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,c,P,T,V,J,K,F,SigCp,Z, & + ENuc,ET,EV,EJ,Ex,Ec,EqsGF2,dipole) enddo !------------------------------------------------------------------------ diff --git a/src/GF/qsUGF2.f90 b/src/GF/qsUGF2.f90 index 93d2833..eaa0dbb 100644 --- a/src/GF/qsUGF2.f90 +++ b/src/GF/qsUGF2.f90 @@ -268,14 +268,14 @@ subroutine qsUGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,spin_conserved, Ex(is) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,is),K(:,:,is))) end do - ! Correlation energy - - call UMP2(nBas,nC,nO,nV,nR,ERI_aaaa,ERI_aabb,ERI_bbbb,ENuc,EHF,eGF2,Ec) - ! Total energy EqsGF2 = sum(ET(:)) + sum(EV(:)) + sum(EJ(:)) + sum(Ex(:)) + ! Correlation energy + + call UMP2(nBas,nC,nO,nV,nR,ERI_aaaa,ERI_aabb,ERI_bbbb,ENuc,EqsGF2,eGF2,Ec) + !------------------------------------------------------------------------ ! Print results !------------------------------------------------------------------------ diff --git a/src/QuAcK/QuAcK.f90 b/src/QuAcK/QuAcK.f90 index 9647ef1..64e4819 100644 --- a/src/QuAcK/QuAcK.f90 +++ b/src/QuAcK/QuAcK.f90 @@ -848,8 +848,18 @@ program QuAcK call cpu_time(start_GF2) - call qsGF2(maxSCF_GF,thresh_GF,n_diis_GF,BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta_GF,nNuc,ZNuc,rNuc,ENuc, & - nBas,nC,nO,nV,nR,nS,ERHF,S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF) + if(unrestricted) then + + call qsUGF2(maxSCF_GF,thresh_GF,n_diis_GF,BSE,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,eta_GF, & + nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,EUHF,S,X,T,V,Hc,ERI_AO, & + ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,dipole_int_AO,dipole_int_aa,dipole_int_bb,PHF,cHF,eHF) + + else + + call qsGF2(maxSCF_GF,thresh_GF,n_diis_GF,BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet,eta_GF,nNuc,ZNuc,rNuc,ENuc, & + nBas,nC,nO,nV,nR,nS,ERHF,S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF) + + end if call cpu_time(end_GF2) From 72470287f71eacb37c0af16224dbc2e0c6039b72 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Mon, 8 Mar 2021 17:00:05 +0100 Subject: [PATCH 41/63] UG0F2 --- input/methods | 8 +- input/options | 2 +- mol/butadiene.xyz | 4 +- src/CI/FCI.f90 | 31 +++++ src/GF/UG0F2.f90 | 122 +++++++++++++++++++ src/GF/print_UG0F2.f90 | 73 +++++++++++ src/GF/qsUGF2.f90 | 8 ++ src/GF/unrestricted_self_energy_GF2.f90 | 2 + src/GF/unrestricted_self_energy_GF2_diag.f90 | 2 + src/MBPT/qsGW.f90 | 2 + src/QuAcK/QuAcK.f90 | 36 +++++- src/QuAcK/read_methods.f90 | 8 +- 12 files changed, 284 insertions(+), 14 deletions(-) create mode 100644 src/CI/FCI.f90 create mode 100644 src/GF/UG0F2.f90 create mode 100644 src/GF/print_UG0F2.f90 diff --git a/input/methods b/input/methods index f719fe3..4673c55 100644 --- a/input/methods +++ b/input/methods @@ -6,12 +6,12 @@ F F F F # drCCD rCCD lCCD pCCD F F F F -# CIS* CIS(D) CID CISD - F F F F +# CIS* CIS(D) CID CISD FCI + F F F F F # RPA* RPAx* ppRPA F F F -# G0F2 evGF2 qsGF2* G0F3 evGF3 - F F T F F +# G0F2* evGF2 qsGF2* G0F3 evGF3 + T F F F F # G0W0* evGW* qsGW* F F F # G0T0 evGT qsGT diff --git a/input/options b/input/options index f64a274..d2044fb 100644 --- a/input/options +++ b/input/options @@ -7,7 +7,7 @@ # spin: TDA singlet triplet spin_conserved spin_flip F T T T T # GF: maxSCF thresh DIIS n_diis lin eta renorm - 256 0.00001 T 5 T 0.001 3 + 256 0.00001 T 5 T 0.001 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 # ACFDT: AC Kx XBS diff --git a/mol/butadiene.xyz b/mol/butadiene.xyz index f2069d8..8bbbc73 100644 --- a/mol/butadiene.xyz +++ b/mol/butadiene.xyz @@ -1,5 +1,5 @@ 10 -Butadiene,^1A_g,CC3,aug-cc-pVTZ + C 0.60673471 0.00000000 0.39936380 C -0.60673471 0.00000000 -0.39936380 C 1.84223863 0.00000000 -0.11897388 @@ -9,4 +9,4 @@ H -0.48033933 0.00000000 -1.47579018 H 1.99778057 0.00000000 -1.19009558 H -1.99778057 0.00000000 1.19009558 H 2.71819794 0.00000000 0.51257105 -H -2.71819794 0.00000000 -0.51257105 \ No newline at end of file +H -2.71819794 0.00000000 -0.51257105 diff --git a/src/CI/FCI.f90 b/src/CI/FCI.f90 new file mode 100644 index 0000000..1fcabbd --- /dev/null +++ b/src/CI/FCI.f90 @@ -0,0 +1,31 @@ +subroutine FCI(nBas,nC,nO,nV,nR,ERI,e) + +! Perform a full configuration interaction calculation + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: nBas,nC,nO,nV,nR + double precision,intent(in) :: e(nBas) + double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + +! Local variables + +! Hello world + + write(*,*) + write(*,*)'**********************************' + write(*,*)'| Full Configuration Interaction |' + write(*,*)'**********************************' + write(*,*) + +! Form FCI vector + +! Form FCI matrix + +! Diagonalize FCI matrix + + +end subroutine FCI diff --git a/src/GF/UG0F2.f90 b/src/GF/UG0F2.f90 new file mode 100644 index 0000000..8f64d4e --- /dev/null +++ b/src/GF/UG0F2.f90 @@ -0,0 +1,122 @@ +subroutine UG0F2(BSE,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,linearize,eta,nBas,nC,nO,nV,nR,nS,ENuc,EUHF, & + S,ERI,ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb,eHF) + +! Perform unrestricted G0W0 calculation + + implicit none + include 'parameters.h' + include 'quadrature.h' + +! Input variables + + logical,intent(in) :: BSE + 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 + logical,intent(in) :: linearize + 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) :: ENuc + double precision,intent(in) :: EUHF + double precision,intent(in) :: S(nBas,nBas) + double precision,intent(in) :: ERI(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) :: dipole_int_aa(nBas,nBas,ncart) + double precision,intent(in) :: dipole_int_bb(nBas,nBas,ncart) + double precision,intent(in) :: eHF(nBas,nspin) + +! Local variables + + integer :: is + integer :: ispin + double precision :: Ec(nsp) + double precision :: EcBSE(nspin) + double precision,allocatable :: SigC(:,:) + double precision,allocatable :: Z(:,:) + integer :: nS_aa,nS_bb,nS_sc + + double precision,allocatable :: eGF2lin(:,:) + double precision,allocatable :: eGF2(:,:) + +! Output variables + +! Hello world + + write(*,*) + write(*,*)'************************************************' + write(*,*)'| One-shot G0F2 calculation |' + write(*,*)'| *** Unrestricted version *** |' + write(*,*)'************************************************' + write(*,*) + +! TDA + + if(TDA) then + write(*,*) 'Tamm-Dancoff approximation activated!' + write(*,*) + end if + +! Memory allocation + + nS_aa = nS(1) + nS_bb = nS(2) + nS_sc = nS_aa + nS_bb + + allocate(SigC(nBas,nspin),Z(nBas,nspin),eGF2(nBas,nspin),eGF2lin(nBas,nspin)) + +!---------------------! +! Compute self-energy ! +!---------------------! + + call unrestricted_self_energy_GF2_diag(nBas,nC,nO,nV,nR,eta,ERI_aaaa,ERI_aabb,ERI_bbbb,eHF,eGF2,SigC,Z) + +!-----------------------------------! +! Solve the quasi-particle equation ! +!-----------------------------------! + + eGF2lin(:,:) = eHF(:,:) + Z(:,:)*SigC(:,:) + + if(linearize) then + + write(*,*) ' *** Quasiparticle energies obtained by linearization *** ' + write(*,*) + + eGF2(:,:) = eGF2lin(:,:) + + else + + ! Find graphical solution of the QP equation + + print*,'!!! Graphical solution NYI for UG0F2 !!!' + stop + + end if + +! Compute MP2 correlation energy + + call UMP2(nBas,nC,nO,nV,nR,ERI_aaaa,ERI_aabb,ERI_bbbb,ENuc,EUHF,eHF,Ec) + +! Dump results + + call print_UG0F2(nBas,nO,eHF,ENuc,EUHF,SigC,Z,eGF2,Ec) + +! Perform BSE calculation + + if(BSE) then + + print*,'!!! BSE2 NYI for UG0F2 !!!' + + end if + +end subroutine UG0F2 diff --git a/src/GF/print_UG0F2.f90 b/src/GF/print_UG0F2.f90 new file mode 100644 index 0000000..1495401 --- /dev/null +++ b/src/GF/print_UG0F2.f90 @@ -0,0 +1,73 @@ +subroutine print_UG0F2(nBas,nO,eHF,ENuc,EUHF,SigC,Z,eGF2,Ec) + +! Print one-electron energies and other stuff for G0W0 + + implicit none + include 'parameters.h' + + integer,intent(in) :: nBas + integer,intent(in) :: nO(nspin) + double precision,intent(in) :: ENuc + double precision,intent(in) :: EUHF + double precision,intent(in) :: Ec(nsp) + double precision,intent(in) :: eHF(nBas,nspin) + double precision,intent(in) :: SigC(nBas,nspin) + double precision,intent(in) :: Z(nBas,nspin) + double precision,intent(in) :: eGF2(nBas,nspin) + + integer :: p + integer :: ispin + double precision :: HOMO(nspin) + double precision :: LUMO(nspin) + double precision :: Gap(nspin) + +! HOMO and LUMO + + do ispin=1,nspin + if(nO(ispin) > 0) then + HOMO(ispin) = eGF2(nO(ispin),ispin) + LUMO(ispin) = eGF2(nO(ispin)+1,ispin) + Gap(ispin) = LUMO(ispin) - HOMO(ispin) + else + HOMO(ispin) = 0d0 + LUMO(ispin) = eGF2(1,ispin) + Gap(ispin) = 0d0 + end if + end do + +! Dump results + + write(*,*)'-------------------------------------------------------------------------------& + -------------------------------------------------' + write(*,*)' Unrestricted one-shot G0F2 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)') & + '|','#','|','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,'|',eHF(p,1)*HaToeV,eHF(p,2)*HaToeV,'|',SigC(p,1)*HaToeV,SigC(p,2)*HaToeV,'|', & + Z(p,1),Z(p,2),'|',eGF2(p,1)*HaToeV,eGF2(p,2)*HaToeV,'|' + enddo + + write(*,*)'-------------------------------------------------------------------------------& + -------------------------------------------------' + write(*,'(2X,A30,F15.6,A3)') 'UG0F2 HOMO energy:',maxval(HOMO(:))*HaToeV,' eV' + write(*,'(2X,A30,F15.6,A3)') 'UG0F2 LUMO energy:',minval(LUMO(:))*HaToeV,' eV' + write(*,'(2X,A30,F15.6,A3)') 'UG0F2 HOMO-LUMO gap :',(minval(LUMO(:))-maxval(HOMO(:)))*HaToeV,' eV' + write(*,*)'-------------------------------------------------------------------------------& + -------------------------------------------------' + write(*,'(2X,A30,F15.6,A3)') ' UG0F2 total energy :',ENuc + EUHF + sum(Ec(:)),' au' + write(*,'(2X,A30,F15.6,A3)') ' UG0F2 correlation energy:',sum(Ec(:)),' au' + write(*,*)'-------------------------------------------------------------------------------& + -------------------------------------------------' + write(*,*) + +end subroutine print_UG0F2 + + diff --git a/src/GF/qsUGF2.f90 b/src/GF/qsUGF2.f90 index eaa0dbb..70a8e68 100644 --- a/src/GF/qsUGF2.f90 +++ b/src/GF/qsUGF2.f90 @@ -306,4 +306,12 @@ subroutine qsUGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,spin_conserved, deallocate(cp,P,F,Fp,J,K,SigC,SigCp,SigCm,Z,error,error_diis,F_diis) +! Perform BSE calculation + + if(BSE) then + + print*,'!!! BSE2 NYI for qsUGF2 !!!' + + end if + end subroutine qsUGF2 diff --git a/src/GF/unrestricted_self_energy_GF2.f90 b/src/GF/unrestricted_self_energy_GF2.f90 index bbd9e72..7bc83dd 100644 --- a/src/GF/unrestricted_self_energy_GF2.f90 +++ b/src/GF/unrestricted_self_energy_GF2.f90 @@ -35,6 +35,8 @@ subroutine unrestricted_self_energy_GF2(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_b ! Compute self-energy | !---------------------! + SigC(:,:,:) = 0d0 + !----------------! ! Spin-up sector !----------------! diff --git a/src/GF/unrestricted_self_energy_GF2_diag.f90 b/src/GF/unrestricted_self_energy_GF2_diag.f90 index d88c1eb..6f06010 100644 --- a/src/GF/unrestricted_self_energy_GF2_diag.f90 +++ b/src/GF/unrestricted_self_energy_GF2_diag.f90 @@ -35,6 +35,8 @@ subroutine unrestricted_self_energy_GF2_diag(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab, ! Compute self-energy | !---------------------! + SigC(:,:) = 0d0 + !----------------! ! Spin-up sector !----------------! diff --git a/src/MBPT/qsGW.f90 b/src/MBPT/qsGW.f90 index db7f56d..7802f04 100644 --- a/src/MBPT/qsGW.f90 +++ b/src/MBPT/qsGW.f90 @@ -207,6 +207,8 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE F(:,:) = Hc(:,:) + J(:,:) + 0.5d0*K(:,:) + SigCp(:,:) + call matout(nBas,nBAs,SigCp) + ! Compute commutator and convergence criteria error = matmul(F,matmul(P,S)) - matmul(matmul(S,P),F) diff --git a/src/QuAcK/QuAcK.f90 b/src/QuAcK/QuAcK.f90 index 64e4819..1b191d4 100644 --- a/src/QuAcK/QuAcK.f90 +++ b/src/QuAcK/QuAcK.f90 @@ -11,7 +11,7 @@ program QuAcK logical :: doMP2,doMP3,doMP2F12 logical :: doCCD,doDCD,doCCSD,doCCSDT logical :: do_drCCD,do_rCCD,do_lCCD,do_pCCD - logical :: doCIS,doCIS_D,doCID,doCISD + logical :: doCIS,doCIS_D,doCID,doCISD,doFCI logical :: doRPA,doRPAx,doppRPA logical :: doADC logical :: doG0F2,doevGF2,doqsGF2,doG0F3,doevGF3 @@ -89,6 +89,7 @@ program QuAcK double precision :: start_CIS ,end_CIS ,t_CIS double precision :: start_CID ,end_CID ,t_CID double precision :: start_CISD ,end_CISD ,t_CISD + double precision :: start_FCI ,end_FCI ,t_FCI double precision :: start_RPA ,end_RPA ,t_RPA double precision :: start_RPAx ,end_RPAx ,t_RPAx double precision :: start_ppRPA ,end_ppRPA ,t_ppRPA @@ -162,7 +163,7 @@ program QuAcK doMP2,doMP3,doMP2F12, & doCCD,doDCD,doCCSD,doCCSDT, & do_drCCD,do_rCCD,do_lCCD,do_pCCD, & - doCIS,doCIS_D,doCID,doCISD, & + doCIS,doCIS_D,doCID,doCISD,doFCI, & doRPA,doRPAx,doppRPA, & doG0F2,doevGF2,doqsGF2, & doG0F3,doevGF3, & @@ -812,8 +813,19 @@ program QuAcK if(doG0F2) then 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,dipole_int_MO,eHF) + + if(unrestricted) then + + call UG0F2(BSE,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,linGF,eta_GF,nBas,nC,nO,nV,nR,nS,ENuc,EUHF, & + S,ERI_AO,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb,dipole_int_aa,dipole_int_bb,eHF) + + else + + call G0F2(BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet,linGF, & + eta_GF,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int_MO,eHF) + + end if + call cpu_time(end_GF2) t_GF2 = end_GF2 - start_GF2 @@ -1176,6 +1188,22 @@ program QuAcK end if +!------------------------------------------------------------------------ +! Compute FCI +!------------------------------------------------------------------------ + + if(doFCI) then + + call cpu_time(start_FCI) + call FCI(nBas,nC,nO,nV,nR,ERI_MO,eHF) + call cpu_time(end_FCI) + + t_FCI = end_FCI - start_FCI + write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for FCI = ',t_FCI,' seconds' + write(*,*) + + end if + !------------------------------------------------------------------------ ! End of QuAcK !------------------------------------------------------------------------ diff --git a/src/QuAcK/read_methods.f90 b/src/QuAcK/read_methods.f90 index 1401cc9..5228e17 100644 --- a/src/QuAcK/read_methods.f90 +++ b/src/QuAcK/read_methods.f90 @@ -2,7 +2,7 @@ subroutine read_methods(doRHF,doUHF,doKS,doMOM, & doMP2,doMP3,doMP2F12, & doCCD,doDCD,doCCSD,doCCSDT, & do_drCCD,do_rCCD,do_lCCD,do_pCCD, & - doCIS,doCIS_D,doCID,doCISD, & + doCIS,doCIS_D,doCID,doCISD,doFCI, & doRPA,doRPAx,doppRPA, & doG0F2,doevGF2,doqsGF2, & doG0F3,doevGF3, & @@ -20,7 +20,7 @@ subroutine read_methods(doRHF,doUHF,doKS,doMOM, & logical,intent(out) :: doMP2,doMP3,doMP2F12 logical,intent(out) :: doCCD,doDCD,doCCSD,doCCSDT logical,intent(out) :: do_drCCD,do_rCCD,do_lCCD,do_pCCD - logical,intent(out) :: doCIS,doCIS_D,doCID,doCISD + logical,intent(out) :: doCIS,doCIS_D,doCID,doCISD,doFCI logical,intent(out) :: doRPA,doRPAx,doppRPA logical,intent(out) :: doG0F2,doevGF2,doqsGF2,doG0F3,doevGF3 logical,intent(out) :: doG0W0,doevGW,doqsGW @@ -60,6 +60,7 @@ subroutine read_methods(doRHF,doUHF,doKS,doMOM, & doCIS_D = .false. doCID = .false. doCISD = .false. + doFCI = .false. doRPA = .false. doRPAx = .false. @@ -118,11 +119,12 @@ subroutine read_methods(doRHF,doUHF,doKS,doMOM, & ! Read excited state methods read(1,*) - read(1,*) answer1,answer2,answer3,answer4 + read(1,*) answer1,answer2,answer3,answer4,answer5 if(answer1 == 'T') doCIS = .true. if(answer2 == 'T') doCIS_D = .true. if(answer3 == 'T') doCID = .true. if(answer4 == 'T') doCISD = .true. + if(answer5 == 'T') doFCI = .true. if(doCIS_D) doCIS = .true. read(1,*) From dd568d88068f61e130fc91cecd9a16ca510714ed Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Mon, 8 Mar 2021 20:09:54 +0100 Subject: [PATCH 42/63] evUGF2 --- input/methods | 4 +- src/GF/evUGF2.f90 | 194 ++++++++++++++++++++++++++++++++++++++++ src/GF/print_evUGF2.f90 | 81 +++++++++++++++++ src/QuAcK/QuAcK.f90 | 18 +++- 4 files changed, 292 insertions(+), 5 deletions(-) create mode 100644 src/GF/evUGF2.f90 create mode 100644 src/GF/print_evUGF2.f90 diff --git a/input/methods b/input/methods index 4673c55..7fa0bc0 100644 --- a/input/methods +++ b/input/methods @@ -10,8 +10,8 @@ F F F F F # RPA* RPAx* ppRPA F F F -# G0F2* evGF2 qsGF2* G0F3 evGF3 - T F F F F +# G0F2* evGF2* qsGF2* G0F3 evGF3 + F T F F F # G0W0* evGW* qsGW* F F F # G0T0 evGT qsGT diff --git a/src/GF/evUGF2.f90 b/src/GF/evUGF2.f90 new file mode 100644 index 0000000..5072adb --- /dev/null +++ b/src/GF/evUGF2.f90 @@ -0,0 +1,194 @@ +subroutine evUGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip, & + eta,nBas,nC,nO,nV,nR,nS,ENuc,EUHF,S,ERI_AO,ERI_aaaa,ERI_aabb,ERI_bbbb, & + dipole_int_aa,dipole_int_bb,cHF,eHF) + +! 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) :: EUHF + logical,intent(in) :: BSE + 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) :: nS(nspin) + + double precision,intent(in) :: eHF(nBas,nspin) + double precision,intent(in) :: cHF(nBas,nBas,nspin) + double precision,intent(in) :: S(nBas,nBas) + double precision,intent(in) :: ERI_AO(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) :: dipole_int_aa(nBas,nBas,ncart) + double precision,intent(in) :: dipole_int_bb(nBas,nBas,ncart) + +! Local variables + + logical :: linear_mixing + integer :: is + integer :: ispin + integer :: nSCF + integer :: n_diis + double precision :: rcond(nspin) + double precision :: Conv + double precision :: Ec(nsp) + double precision :: EcBSE(nspin) + double precision :: EcAC(nspin) + double precision :: alpha + double precision,allocatable :: error_diis(:,:,:) + double precision,allocatable :: e_diis(:,:,:) + double precision,allocatable :: eGF2(:,:) + double precision,allocatable :: eOld(:,:) + double precision,allocatable :: Z(:,:) + integer :: nS_aa,nS_bb,nS_sc + double precision,allocatable :: SigC(:,:) + +! Hello world + + write(*,*) + write(*,*)'**************************************************' + write(*,*)'| Self-consistent unrestricted evGF2 calculation |' + write(*,*)'**************************************************' + write(*,*) + +! TDA + + if(TDA) then + write(*,*) 'Tamm-Dancoff approximation 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(eGF2(nBas,nspin),eOld(nBas,nspin),Z(nBas,nspin),SigC(nBas,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 + eGF2(:,:) = eHF(:,:) + eOld(:,:) = eHF(:,:) + Z(:,:) = 1d0 + +!------------------------------------------------------------------------ +! Main loop +!------------------------------------------------------------------------ + + do while(Conv > thresh .and. nSCF <= maxSCF) + + !------------------------------------------------! + ! Compute self-energy and renormalization factor ! + !------------------------------------------------! + + call unrestricted_self_energy_GF2_diag(nBas,nC,nO,nV,nR,eta,ERI_aaaa,ERI_aabb,ERI_bbbb,eHF,eGF2,SigC,Z) + + !-----------------------------------! + ! Solve the quasi-particle equation ! + !-----------------------------------! + + eGF2(:,:) = eHF(:,:) + SigC(:,:) + + ! Convergence criteria + + Conv = maxval(abs(eGF2(:,:) - eOld(:,:))) + + ! Compute MP2 correlation energy + + call UMP2(nBas,nC,nO,nV,nR,ERI_aaaa,ERI_aabb,ERI_bbbb,ENuc,EUHF,eHF,Ec) + + ! Print results + + call print_evUGF2(nBas,nO,nSCF,Conv,eHF,ENuc,EUHF,SigC,Z,eGF2,Ec) + + ! Linear mixing or DIIS extrapolation + + if(linear_mixing) then + + eGF2(:,:) = alpha*eGF2(:,:) + (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(:,1:n_diis,is), & + e_diis(:,1:n_diis,is),eGF2(:,is)-eOld(:,is),eGF2(:,is)) + end do + +! Reset DIIS if required + + if(minval(rcond(:)) < 1d-15) n_diis = 0 + + endif + + ! Save quasiparticles energy for next cycle + + eOld(:,:) = eGF2(:,:) + + ! Increment + + nSCF = nSCF + 1 + + enddo +!------------------------------------------------------------------------ +! End main loop +!------------------------------------------------------------------------ + +! Did it actually converge? + + if(nSCF == maxSCF+1) then + + write(*,*) + write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + write(*,*)' Convergence failed ' + write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + write(*,*) + + stop + + endif + +! Deallocate memory + + deallocate(eOld,Z,SigC,error_diis,e_diis) + +! Perform BSE calculation + + if(BSE) then + + print*,'!!! BSE2 NYI for evUGF2 !!!' + + endif + +end subroutine evUGF2 diff --git a/src/GF/print_evUGF2.f90 b/src/GF/print_evUGF2.f90 new file mode 100644 index 0000000..f04f6f3 --- /dev/null +++ b/src/GF/print_evUGF2.f90 @@ -0,0 +1,81 @@ +subroutine print_evUGF2(nBas,nO,nSCF,Conv,eHF,ENuc,EUHF,SigC,Z,eGF2,Ec) + +! Print one-electron energies and other stuff for evGF2 + + 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) :: EUHF + double precision,intent(in) :: Ec(nsp) + double precision,intent(in) :: Conv + double precision,intent(in) :: eHF(nBas,nspin) + double precision,intent(in) :: SigC(nBas,nspin) + double precision,intent(in) :: Z(nBas,nspin) + double precision,intent(in) :: eGF2(nBas,nspin) + + integer :: p + integer :: ispin + double precision :: HOMO(nspin) + double precision :: LUMO(nspin) + double precision :: Gap(nspin) + +! HOMO and LUMO + + do ispin=1,nspin + if(nO(ispin) > 0) then + HOMO(ispin) = eGF2(nO(ispin),ispin) + LUMO(ispin) = eGF2(nO(ispin)+1,ispin) + Gap(ispin) = LUMO(ispin) - HOMO(ispin) + else + HOMO(ispin) = 0d0 + LUMO(ispin) = eGF2(1,ispin) + Gap(ispin) = 0d0 + end if + end do + +! Dump results + + write(*,*)'-------------------------------------------------------------------------------& + -------------------------------------------------' + if(nSCF < 10) then + write(*,'(1X,A21,I1,A2,A12)')' Self-consistent evG',nSCF,'F2',' calculation' + else + write(*,'(1X,A21,I2,A2,A12)')' Self-consistent evG',nSCF,'F2',' 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,'|',eHF(p,1)*HaToeV,eHF(p,2)*HaToeV,'|',SigC(p,1)*HaToeV,SigC(p,2)*HaToeV,'|', & + Z(p,1),Z(p,2),'|',eGF2(p,1)*HaToeV,eGF2(p,2)*HaToeV,'|' + enddo + + write(*,*)'-------------------------------------------------------------------------------& + -------------------------------------------------' + write(*,'(2X,A10,I3)') 'Iteration ',nSCF + write(*,'(2X,A14,F15.5)')'Convergence = ',Conv + write(*,*)'-------------------------------------------------------------------------------& + -------------------------------------------------' + write(*,'(2X,A30,F15.6,A3)') 'evGF2 HOMO energy:',maxval(HOMO(:))*HaToeV,' eV' + write(*,'(2X,A30,F15.6,A3)') 'evGF2 LUMO energy:',minval(LUMO(:))*HaToeV,' eV' + write(*,'(2X,A30,F15.6,A3)') 'evGF2 HOMO-LUMO gap :',(minval(LUMO(:))-maxval(HOMO(:)))*HaToeV,' eV' + write(*,*)'-------------------------------------------------------------------------------& + -------------------------------------------------' + write(*,'(2X,A30,F15.6,A3)') ' evGF2 total energy :',ENuc + EUHF + sum(Ec(:)),' au' + write(*,'(2X,A30,F15.6,A3)') ' evGF2 correlation energy:',sum(Ec(:)),' au' + write(*,*)'-------------------------------------------------------------------------------& + -------------------------------------------------' + write(*,*) + +end subroutine print_evUGF2 diff --git a/src/QuAcK/QuAcK.f90 b/src/QuAcK/QuAcK.f90 index 1b191d4..8bbff6e 100644 --- a/src/QuAcK/QuAcK.f90 +++ b/src/QuAcK/QuAcK.f90 @@ -841,9 +841,21 @@ program QuAcK if(doevGF2) then 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,dipole_int_MO,eHF) + + if(unrestricted) then + + call evUGF2(maxSCF_GF,thresh_GF,n_diis_GF,BSE,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip, & + eta_GF,nBas,nC,nO,nV,nR,nS,ENuc,EUHF,S,ERI_AO,ERI_MO_aaaa,ERI_MO_aabb,ERI_MO_bbbb, & + dipole_int_aa,dipole_int_bb,cHF,eHF) + + else + + 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,dipole_int_MO,eHF) + + end if + call cpu_time(end_GF2) t_GF2 = end_GF2 - start_GF2 From b5a28cca0dbd15dcc92bf103ee7a4357dde2d73a Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Mon, 15 Mar 2021 15:43:51 +0100 Subject: [PATCH 43/63] EcGM --- src/MBPT/print_qsGW.f90 | 4 ++-- src/MBPT/print_qsUGW.f90 | 6 +++--- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/MBPT/print_qsGW.f90 b/src/MBPT/print_qsGW.f90 index 97b65be..ffcd712 100644 --- a/src/MBPT/print_qsGW.f90 +++ b/src/MBPT/print_qsGW.f90 @@ -74,7 +74,7 @@ subroutine print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,ENuc,P,T,V,J,K,F,SigC,Z write(*,'(2X,A30,F15.6,A3)') 'qsGW LUMO energy:',eGW(LUMO)*HaToeV,' eV' write(*,'(2X,A30,F15.6,A3)') 'qsGW HOMO-LUMO gap :',Gap*HaToeV,' eV' write(*,*)'-------------------------------------------' - write(*,'(2X,A30,F15.6,A3)') ' qsGW total energy:',ENuc + EqsGW + EcGM,' au' + write(*,'(2X,A30,F15.6,A3)') ' qsGW total energy:',ENuc + EqsGW,' au' write(*,'(2X,A30,F15.6,A3)') ' qsGW exchange energy:',Ex,' au' write(*,'(2X,A30,F15.6,A3)') ' GM@qsGW correlation energy:',EcGM,' au' write(*,'(2X,A30,F15.6,A3)') 'RPA@qsGW correlation energy:',EcRPA,' au' @@ -100,7 +100,7 @@ subroutine print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,ENuc,P,T,V,J,K,F,SigC,Z write(*,'(A50)') '---------------------------------------' write(*,'(A32,1X,F16.10,A3)') ' Electronic energy: ',EqsGW,' au' write(*,'(A32,1X,F16.10,A3)') ' Nuclear repulsion: ',ENuc,' au' - write(*,'(A32,1X,F16.10,A3)') ' qsGW energy: ',ENuc + EqsGW + EcGM,' au' + write(*,'(A32,1X,F16.10,A3)') ' qsGW energy: ',ENuc + EqsGW,' au' write(*,'(A50)') '---------------------------------------' write(*,'(A35)') ' Dipole moment (Debye) ' write(*,'(10X,4A10)') 'X','Y','Z','Tot.' diff --git a/src/MBPT/print_qsUGW.f90 b/src/MBPT/print_qsUGW.f90 index d776764..18594dc 100644 --- a/src/MBPT/print_qsUGW.f90 +++ b/src/MBPT/print_qsUGW.f90 @@ -100,7 +100,7 @@ subroutine print_qsUGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,cGW,PGW,Ov,T,V,J,K, & write(*,'(2X,A30,F15.6,A3)') 'qsUGW HOMO-LUMO gap :',(minval(LUMO(:))-maxval(HOMO(:)))*HaToeV,' eV' write(*,*)'-------------------------------------------------------------------------------& -------------------------------------------------' - write(*,'(2X,A30,F15.6,A3)') ' qsUGW total energy:',ENuc + EqsGW + sum(EcGM(:)),' au' + write(*,'(2X,A30,F15.6,A3)') ' qsUGW total energy:',ENuc + EqsGW,' au' write(*,'(2X,A30,F15.6,A3)') ' qsUGW exchange energy:',sum(Ex(:)),' au' write(*,'(2X,A30,F15.6,A3)') ' GM@qsUGW correlation energy:',sum(EcGM(:)),' au' write(*,'(2X,A30,F15.6,A3)') 'RPA@qsUGW correlation energy:',EcRPA,' au' @@ -146,9 +146,9 @@ subroutine print_qsUGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,cGW,PGW,Ov,T,V,J,K, & write(*,'(A40,1X,F16.10,A3)') ' Correlation aa energy: ',EcGM(1),' au' write(*,'(A40,1X,F16.10,A3)') ' Correlation bb energy: ',EcGM(2),' au' write(*,'(A60)') '-------------------------------------------------' - write(*,'(A40,1X,F16.10,A3)') ' Electronic energy: ',EqsGW + sum(EcGM(:)),' au' + write(*,'(A40,1X,F16.10,A3)') ' Electronic energy: ',EqsGW,' au' write(*,'(A40,1X,F16.10,A3)') ' Nuclear repulsion: ',ENuc,' au' - write(*,'(A40,1X,F16.10,A3)') ' qsUGW energy: ',ENuc + EqsGW + sum(EcGM(:)),' au' + write(*,'(A40,1X,F16.10,A3)') ' qsUGW energy: ',ENuc + EqsGW,' au' write(*,'(A60)') '-------------------------------------------------' write(*,'(A40,F13.6)') ' S (exact) :',2d0*S_exact + 1d0 write(*,'(A40,F13.6)') ' S :',2d0*S + 1d0 From d01e7c248c6906eb802e0b8f611fea536e8c43ab Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Tue, 23 Mar 2021 19:50:46 +0100 Subject: [PATCH 44/63] debug qsGF2/qsUGF2 --- input/dft | 20 ++++++++++---------- input/methods | 2 +- src/GF/print_qsGF2.f90 | 8 ++++---- src/GF/print_qsUGF2.f90 | 10 +++++----- src/GF/qsGF2.f90 | 15 ++++++++------- src/GF/qsUGF2.f90 | 10 +++++----- src/GF/self_energy_GF2.f90 | 2 +- src/GF/unrestricted_self_energy_GF2.f90 | 1 + src/MP/MP2.f90 | 16 +++++++--------- 9 files changed, 42 insertions(+), 42 deletions(-) diff --git a/input/dft b/input/dft index 3220f9d..8059451 100644 --- a/input/dft +++ b/input/dft @@ -1,12 +1,12 @@ # Restricted or unrestricted KS calculation - UKS + eDFT-UKS # exchange rung: # Hartree = 0: H # LDA = 1: S51,CC-S51 # GGA = 2: B88,G96,PBE # MGGA = 3: # Hybrid = 4: HF,B3,PBE - 1 S51 + 4 HF # correlation rung: # Hartree = 0: H # LDA = 1: PW92,VWN3,VWN5,eVWN5 @@ -17,18 +17,18 @@ # quadrature grid SG-n 1 # Number of states in ensemble (nEns) - 1 + 2 # occupation numbers - 1 1 1 0 0 0 0 0 0 0 0 0 0 0 0 - 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 # Ensemble weights: wEns(1),...,wEns(nEns-1) - 0.0 0.0 + 0.5 0.0 # N-centered? F # Parameters for CC weight-dependent exchange functional diff --git a/input/methods b/input/methods index 7fa0bc0..098169e 100644 --- a/input/methods +++ b/input/methods @@ -11,7 +11,7 @@ # RPA* RPAx* ppRPA F F F # G0F2* evGF2* qsGF2* G0F3 evGF3 - F T F F F + F F T F F # G0W0* evGW* qsGW* F F F # G0T0 evGT qsGT diff --git a/src/GF/print_qsGF2.f90 b/src/GF/print_qsGF2.f90 index 5e3faf9..33a6e9b 100644 --- a/src/GF/print_qsGF2.f90 +++ b/src/GF/print_qsGF2.f90 @@ -69,7 +69,7 @@ subroutine print_qsGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,c,P,T,V,J,K,F,SigC,Z, & write(*,'(2X,A30,F15.6,A3)') 'qsGF2 LUMO energy:',eGF2(LUMO)*HaToeV,' eV' write(*,'(2X,A30,F15.6,A3)') 'qsGF2 HOMO-LUMO gap :',Gap*HaToeV,' eV' write(*,*)'-------------------------------------------' - write(*,'(2X,A30,F15.6,A3)') ' qsGF2 total energy:',ENuc + EqsGF2 + Ec,' au' + write(*,'(2X,A30,F15.6,A3)') ' qsGF2 total energy:',ENuc + EqsGF2,' au' write(*,'(2X,A30,F15.6,A3)') ' qsGF2 exchange energy:',Ex,' au' write(*,'(2X,A30,F15.6,A3)') ' qsGF2 correlation energy:',Ec,' au' write(*,*)'-------------------------------------------' @@ -87,14 +87,14 @@ subroutine print_qsGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,c,P,T,V,J,K,F,SigC,Z, & write(*,'(A32,1X,F16.10,A3)') ' Kinetic energy: ',ET,' au' write(*,'(A32,1X,F16.10,A3)') ' Potential energy: ',EV,' au' write(*,'(A50)') '---------------------------------------' - write(*,'(A32,1X,F16.10,A3)') ' Two-electron energy: ',EJ + Ex,' au' + write(*,'(A32,1X,F16.10,A3)') ' Two-electron energy: ',EJ + Ex + Ec,' au' write(*,'(A32,1X,F16.10,A3)') ' Hartree energy: ',EJ,' au' write(*,'(A32,1X,F16.10,A3)') ' Exchange energy: ',Ex,' au' write(*,'(A32,1X,F16.10,A3)') ' Correlation energy: ',Ec,' au' write(*,'(A50)') '---------------------------------------' - write(*,'(A32,1X,F16.10,A3)') ' Electronic energy: ',EqsGF2 + Ec,' au' + write(*,'(A32,1X,F16.10,A3)') ' Electronic energy: ',EqsGF2,' au' write(*,'(A32,1X,F16.10,A3)') ' Nuclear repulsion: ',ENuc,' au' - write(*,'(A32,1X,F16.10,A3)') ' qsGF2 energy: ',ENuc + EqsGF2 + Ec,' au' + write(*,'(A32,1X,F16.10,A3)') ' qsGF2 energy: ',ENuc + EqsGF2,' au' write(*,'(A50)') '---------------------------------------' write(*,'(A35)') ' Dipole moment (Debye) ' write(*,'(10X,4A10)') 'X','Y','Z','Tot.' diff --git a/src/GF/print_qsUGF2.f90 b/src/GF/print_qsUGF2.f90 index 4db8f23..8c83812 100644 --- a/src/GF/print_qsUGF2.f90 +++ b/src/GF/print_qsUGF2.f90 @@ -99,7 +99,7 @@ subroutine print_qsUGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,cGF2,PGF2,Ov,T,V,J,K, write(*,'(2X,A30,F15.6,A3)') 'qsUGF2 HOMO-LUMO gap :',(minval(LUMO(:))-maxval(HOMO(:)))*HaToeV,' eV' write(*,*)'-------------------------------------------------------------------------------& -------------------------------------------------' - write(*,'(2X,A30,F15.6,A3)') ' qsUGF2 total energy:',ENuc + EqsGF2 + sum(Ec(:)),' au' + write(*,'(2X,A30,F15.6,A3)') ' qsUGF2 total energy:',ENuc + EqsGF2,' au' write(*,'(2X,A30,F15.6,A3)') ' qsUGF2 exchange energy:',sum(Ex(:)),' au' write(*,'(2X,A30,F15.6,A3)') ' qsUGF2 correlation energy:',sum(Ec(:)),' au' write(*,*)'-------------------------------------------------------------------------------& @@ -126,10 +126,10 @@ subroutine print_qsUGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,cGF2,PGF2,Ov,T,V,J,K, write(*,'(A40,1X,F16.10,A3)') ' Potential a energy: ',EV(1),' au' write(*,'(A40,1X,F16.10,A3)') ' Potential b energy: ',EV(2),' au' write(*,'(A60)') '-------------------------------------------------' - write(*,'(A40,1X,F16.10,A3)') ' Two-electron energy: ',sum(EJ(:)) + sum(Ex(:)),' au' - write(*,'(A40,1X,F16.10,A3)') ' Two-electron aa energy: ',EJ(1) + Ex(1),' au' - write(*,'(A40,1X,F16.10,A3)') ' Two-electron ab energy: ',EJ(2),' au' - write(*,'(A40,1X,F16.10,A3)') ' Two-electron bb energy: ',EJ(3) + Ex(2),' au' + write(*,'(A40,1X,F16.10,A3)') ' Two-electron energy: ',sum(EJ(:)) + sum(Ex(:)) + sum(Ec(:)),' au' + write(*,'(A40,1X,F16.10,A3)') ' Two-electron aa energy: ',EJ(1) + Ex(1) + Ec(1),' au' + write(*,'(A40,1X,F16.10,A3)') ' Two-electron ab energy: ',EJ(2) + Ec(2),' au' + write(*,'(A40,1X,F16.10,A3)') ' Two-electron bb energy: ',EJ(3) + Ex(2) + Ec(3),' au' write(*,*) write(*,'(A40,1X,F16.10,A3)') ' Hartree energy: ',sum(EJ(:)),' au' write(*,'(A40,1X,F16.10,A3)') ' Hartree aa energy: ',EJ(1),' au' diff --git a/src/GF/qsGF2.f90 b/src/GF/qsGF2.f90 index 2f39f70..6e8988b 100644 --- a/src/GF/qsGF2.f90 +++ b/src/GF/qsGF2.f90 @@ -197,16 +197,17 @@ subroutine qsGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet, ! Exchange energy - Ex = -0.25d0*trace_matrix(nBas,matmul(P,K)) - - ! Total energy - - EqsGF2 = ET + EV + EJ + Ex + Ex = 0.25d0*trace_matrix(nBas,matmul(P,K)) ! Correlation energy call MP2(nBas,nC,nO,nV,nR,ERI_MO,ENuc,EqsGF2,eGF2,Ec) + ! Total energy + + EqsGF2 = ET + EV + EJ + Ex + Ec + + !------------------------------------------------------------------------ ! Print results !------------------------------------------------------------------------ @@ -248,8 +249,8 @@ subroutine qsGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet, write(*,*)'-------------------------------------------------------------------------------' write(*,'(2X,A50,F20.10)') 'Tr@BSE@qsGF2 correlation energy (singlet) =',EcBSE(1) write(*,'(2X,A50,F20.10)') 'Tr@BSE@qsGF2 correlation energy (triplet) =',EcBSE(2) - write(*,'(2X,A50,F20.10)') 'Tr@BSE@qsGF2 correlation energy =',EcBSE(1) + EcBSE(2) - write(*,'(2X,A50,F20.10)') 'Tr@BSE@qsGF2 total energy =',ENuc + EqsGF2 + EcBSE(1) + EcBSE(2) + write(*,'(2X,A50,F20.10)') 'Tr@BSE@qsGF2 correlation energy =',sum(EcBSE(:)) + write(*,'(2X,A50,F20.10)') 'Tr@BSE@qsGF2 total energy =',ENuc + EqsGF2 + sum(EcBSE(:)) write(*,*)'-------------------------------------------------------------------------------' write(*,*) diff --git a/src/GF/qsUGF2.f90 b/src/GF/qsUGF2.f90 index 70a8e68..5c93e01 100644 --- a/src/GF/qsUGF2.f90 +++ b/src/GF/qsUGF2.f90 @@ -64,7 +64,7 @@ subroutine qsUGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,spin_conserved, double precision :: EV(nspin) double precision :: EJ(nsp) double precision :: Ex(nspin) - double precision :: Ec(nspin) + double precision :: Ec(nsp) double precision :: EqsGF2 double precision :: EcBSE(nspin) double precision :: EcAC(nspin) @@ -268,14 +268,14 @@ subroutine qsUGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,spin_conserved, Ex(is) = 0.5d0*trace_matrix(nBas,matmul(P(:,:,is),K(:,:,is))) end do - ! Total energy - - EqsGF2 = sum(ET(:)) + sum(EV(:)) + sum(EJ(:)) + sum(Ex(:)) - ! Correlation energy call UMP2(nBas,nC,nO,nV,nR,ERI_aaaa,ERI_aabb,ERI_bbbb,ENuc,EqsGF2,eGF2,Ec) + ! Total energy + + EqsGF2 = sum(ET(:)) + sum(EV(:)) + sum(EJ(:)) + sum(Ex(:)) + sum(Ec(:)) + !------------------------------------------------------------------------ ! Print results !------------------------------------------------------------------------ diff --git a/src/GF/self_energy_GF2.f90 b/src/GF/self_energy_GF2.f90 index 173ecaf..f4b8e90 100644 --- a/src/GF/self_energy_GF2.f90 +++ b/src/GF/self_energy_GF2.f90 @@ -28,7 +28,7 @@ subroutine self_energy_GF2(eta,nBas,nC,nO,nV,nR,nS,eHF,eGF2,ERI,SigC,Z) ! Initialize SigC(:,:) = 0d0 - Z(:) = 0d0 + Z(:) = 0d0 ! Compute GF2 self-energy and renormalization factor diff --git a/src/GF/unrestricted_self_energy_GF2.f90 b/src/GF/unrestricted_self_energy_GF2.f90 index 7bc83dd..cce6adf 100644 --- a/src/GF/unrestricted_self_energy_GF2.f90 +++ b/src/GF/unrestricted_self_energy_GF2.f90 @@ -36,6 +36,7 @@ subroutine unrestricted_self_energy_GF2(nBas,nC,nO,nV,nR,eta,ERI_aa,ERI_ab,ERI_b !---------------------! SigC(:,:,:) = 0d0 + Z(:,:) = 0d0 !----------------! ! Spin-up sector diff --git a/src/MP/MP2.f90 b/src/MP/MP2.f90 index 8b028df..7dd921f 100644 --- a/src/MP/MP2.f90 +++ b/src/MP/MP2.f90 @@ -23,7 +23,7 @@ subroutine MP2(nBas,nC,nO,nV,nR,ERI,ENuc,EHF,e,EcMP2) ! Output variables - double precision,intent(out) :: EcMP2(3) + double precision,intent(out) :: EcMP2 ! Hello world @@ -57,20 +57,18 @@ subroutine MP2(nBas,nC,nO,nV,nR,ERI,ENuc,EHF,e,EcMP2) enddo enddo - EcMP2(2) = 2d0*E2a - EcMP2(3) = -E2b - EcMP2(1) = EcMP2(2) + EcMP2(3) + EcMP2 = 2d0*E2a - E2b write(*,*) write(*,'(A32)') '--------------------------' write(*,'(A32)') ' MP2 calculation ' write(*,'(A32)') '--------------------------' - write(*,'(A32,1X,F16.10)') ' MP2 correlation energy = ',EcMP2(1) - write(*,'(A32,1X,F16.10)') ' Direct part = ',EcMP2(2) - write(*,'(A32,1X,F16.10)') ' Exchange part = ',EcMP2(3) + write(*,'(A32,1X,F16.10)') ' MP2 correlation energy = ',EcMP2 + write(*,'(A32,1X,F16.10)') ' Direct part = ',2d0*E2a + write(*,'(A32,1X,F16.10)') ' Exchange part = ',-E2b write(*,'(A32)') '--------------------------' - write(*,'(A32,1X,F16.10)') ' MP2 electronic energy = ',EHF + EcMP2(1) - write(*,'(A32,1X,F16.10)') ' MP2 total energy = ',ENuc + EHF + EcMP2(1) + write(*,'(A32,1X,F16.10)') ' MP2 electronic energy = ',EHF + EcMP2 + write(*,'(A32,1X,F16.10)') ' MP2 total energy = ',ENuc + EHF + EcMP2 write(*,'(A32)') '--------------------------' write(*,*) From ed2992bc8515bdb4b2281f6b1da2b6c16e26fd8a Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Tue, 23 Mar 2021 22:35:46 +0100 Subject: [PATCH 45/63] clean up qsGW print --- input/methods | 4 ++-- input/options | 2 +- mol/h2.xyz | 2 +- src/MBPT/print_qsGW.f90 | 15 +++++++-------- src/MBPT/qsGW.f90 | 30 +++++++++++++++++++++++++++++- 5 files changed, 40 insertions(+), 13 deletions(-) diff --git a/input/methods b/input/methods index 098169e..24288c1 100644 --- a/input/methods +++ b/input/methods @@ -11,9 +11,9 @@ # RPA* RPAx* ppRPA F F F # G0F2* evGF2* qsGF2* G0F3 evGF3 - F F T F F + F F F F F # G0W0* evGW* qsGW* - F F F + F F T # G0T0 evGT qsGT F F F # MCMP2 diff --git a/input/options b/input/options index d2044fb..9ce0271 100644 --- a/input/options +++ b/input/options @@ -1,5 +1,5 @@ # HF: maxSCF thresh DIIS n_diis guess_type ortho_type mix_guess stability - 128 0.0000001 T 5 1 1 F F + 128 0.0000001 T 5 1 1 T F # MP: # CC: maxSCF thresh DIIS n_diis diff --git a/mol/h2.xyz b/mol/h2.xyz index 7ab70eb..85810e4 100644 --- a/mol/h2.xyz +++ b/mol/h2.xyz @@ -1,4 +1,4 @@ 2 H 0.0 0.0 0.0 -H 0.0 0.0 0.741 +H 0.0 0.0 2.0 diff --git a/src/MBPT/print_qsGW.f90 b/src/MBPT/print_qsGW.f90 index ffcd712..c3995b0 100644 --- a/src/MBPT/print_qsGW.f90 +++ b/src/MBPT/print_qsGW.f90 @@ -1,4 +1,5 @@ -subroutine print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,ENuc,P,T,V,J,K,F,SigC,Z,EcGM,EcRPA,EqsGW,dipole) +subroutine print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,P,T,V,J,K,F,SigC,Z, & + ENuc,ET,EV,EJ,Ex,EcGM,EcRPA,EqsGW,dipole) ! Print one-electron energies and other stuff for qsGW @@ -11,6 +12,10 @@ subroutine print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,ENuc,P,T,V,J,K,F,SigC,Z integer,intent(in) :: nO integer,intent(in) :: nSCF double precision,intent(in) :: ENuc + double precision,intent(in) :: ET + double precision,intent(in) :: EV + double precision,intent(in) :: EJ + double precision,intent(in) :: Ex double precision,intent(in) :: EcGM double precision,intent(in) :: EcRPA double precision,intent(in) :: Conv @@ -27,7 +32,7 @@ subroutine print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,ENuc,P,T,V,J,K,F,SigC,Z ! Local variables integer :: x,ixyz,HOMO,LUMO - double precision :: Gap,ET,EV,EJ,Ex + double precision :: Gap double precision,external :: trace_matrix ! Output variables @@ -42,12 +47,6 @@ subroutine print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,ENuc,P,T,V,J,K,F,SigC,Z ! Compute energies - ET = trace_matrix(nBas,matmul(P,T)) - EV = trace_matrix(nBas,matmul(P,V)) - EJ = 0.5d0*trace_matrix(nBas,matmul(P,J)) - Ex = 0.25d0*trace_matrix(nBas,matmul(P,K)) - EqsGW = ET + EV + EJ + Ex - ! Dump results write(*,*)'-------------------------------------------------------------------------------' diff --git a/src/MBPT/qsGW.f90 b/src/MBPT/qsGW.f90 index 7802f04..e143ebe 100644 --- a/src/MBPT/qsGW.f90 +++ b/src/MBPT/qsGW.f90 @@ -55,6 +55,10 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE integer :: nBasSq integer :: ispin integer :: n_diis + double precision :: ET + double precision :: EV + double precision :: EJ + double precision :: Ex double precision :: EqsGW double precision :: EcRPA double precision :: EcBSE(nspin) @@ -234,10 +238,34 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE P(:,:) = 2d0*matmul(c(:,1:nO),transpose(c(:,1:nO))) + !------------------------------------------------------------------------ + ! Compute total energy + !------------------------------------------------------------------------ + + ! Kinetic energy + + ET = trace_matrix(nBas,matmul(P,T)) + + ! Potential energy + + EV = trace_matrix(nBas,matmul(P,V)) + + ! Coulomb energy + + EJ = 0.5d0*trace_matrix(nBas,matmul(P,J)) + + ! Exchange energy + + Ex = 0.25d0*trace_matrix(nBas,matmul(P,K)) + + ! Total energy + + EqsGW = ET + EV + EJ + Ex + ! Print results call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int_AO,dipole) - call print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,ENuc,P,T,V,J,K,F,SigCp,Z,EcGM,EcRPA,EqsGW,dipole) + call print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,P,T,V,J,K,F,SigCp,Z,ENuc,ET,EV,EJ,Ex,EcGM,EcRPA,EqsGW,dipole) enddo !------------------------------------------------------------------------ From 372a1a3b0e2381e8ac8f3265368cb8cc8fa692b1 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Thu, 25 Mar 2021 11:05:56 +0100 Subject: [PATCH 46/63] dipole in UKS --- input/dft | 4 ++-- input/methods | 4 ++-- mol/h2.xyz | 2 +- src/eDFT/eDFT.f90 | 8 ++++---- src/eDFT/eDFT_UKS.f90 | 23 +++++++++++++++-------- src/eDFT/print_UKS.f90 | 41 +++++++++++++++++++++++++---------------- 6 files changed, 49 insertions(+), 33 deletions(-) diff --git a/input/dft b/input/dft index 8059451..b528057 100644 --- a/input/dft +++ b/input/dft @@ -1,5 +1,5 @@ # Restricted or unrestricted KS calculation - eDFT-UKS + UKS # exchange rung: # Hartree = 0: H # LDA = 1: S51,CC-S51 @@ -28,7 +28,7 @@ 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 # Ensemble weights: wEns(1),...,wEns(nEns-1) - 0.5 0.0 + 0.25 0.0 # N-centered? F # Parameters for CC weight-dependent exchange functional diff --git a/input/methods b/input/methods index 24288c1..768c20d 100644 --- a/input/methods +++ b/input/methods @@ -1,5 +1,5 @@ # RHF UHF KS MOM - F T F F + F F T F # MP2* MP3 MP2-F12 F F F # CCD DCD CCSD CCSD(T) @@ -13,7 +13,7 @@ # G0F2* evGF2* qsGF2* G0F3 evGF3 F F F F F # G0W0* evGW* qsGW* - F F T + F F F # G0T0 evGT qsGT F F F # MCMP2 diff --git a/mol/h2.xyz b/mol/h2.xyz index 85810e4..f8e2dab 100644 --- a/mol/h2.xyz +++ b/mol/h2.xyz @@ -1,4 +1,4 @@ 2 H 0.0 0.0 0.0 -H 0.0 0.0 2.0 +H 0.0 0.0 0.71 diff --git a/src/eDFT/eDFT.f90 b/src/eDFT/eDFT.f90 index 387e44a..f4a5b40 100644 --- a/src/eDFT/eDFT.f90 +++ b/src/eDFT/eDFT.f90 @@ -226,8 +226,8 @@ subroutine eDFT(maxSCF,thresh,max_diis,guess_type,mix,nNuc,ZNuc,rNuc,ENuc,nBas,n end do call cpu_time(start_KS) - call eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight(:),maxSCF,thresh,max_diis,guess_type,mix, & - nBas,AO,dAO,S,T,V,Hc,ERI,X,ENuc,occnum,Cx_choice,doNcentered,Ew,eKS,cKS,PKS,Vxc) + call eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,maxSCF,thresh,max_diis,guess_type,mix, & + nNuc,ZNuc,rNuc,ENuc,nBas,AO,dAO,S,T,V,Hc,ERI,dipole_int,X,occnum,Cx_choice,doNcentered,Ew,eKS,cKS,PKS,Vxc) call cpu_time(end_KS) t_KS = end_KS - start_KS @@ -243,8 +243,8 @@ subroutine eDFT(maxSCF,thresh,max_diis,guess_type,mix,nNuc,ZNuc,rNuc,ENuc,nBas,n if(method == 'eDFT-UKS') then call cpu_time(start_KS) - call eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight(:),maxSCF,thresh,max_diis,guess_type,mix, & - nBas,AO,dAO,S,T,V,Hc,ERI,X,ENuc,occnum,Cx_choice,doNcentered,Ew,eKS,cKS,PKS,Vxc) + call eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,maxSCF,thresh,max_diis,guess_type,mix, & + nNuc,ZNuc,rNuc,ENuc,nBas,AO,dAO,S,T,V,Hc,ERI,dipole_int,X,occnum,Cx_choice,doNcentered,Ew,eKS,cKS,PKS,Vxc) call cpu_time(end_KS) t_KS = end_KS - start_KS diff --git a/src/eDFT/eDFT_UKS.f90 b/src/eDFT/eDFT_UKS.f90 index d0bf4e0..03a9212 100644 --- a/src/eDFT/eDFT_UKS.f90 +++ b/src/eDFT/eDFT_UKS.f90 @@ -1,5 +1,5 @@ subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weight,maxSCF,thresh,max_diis,guess_type,mix, & - nBas,AO,dAO,S,T,V,Hc,ERI,X,ENuc,occnum,Cx_choice,doNcentered,Ew,eps,c,Pw,Vxc) + nNuc,ZNuc,rNuc,ENuc,nBas,AO,dAO,S,T,V,Hc,ERI,dipole_int,X,occnum,Cx_choice,doNcentered,Ew,eps,c,Pw,Vxc) ! Perform unrestricted Kohn-Sham calculation for ensembles @@ -23,13 +23,18 @@ subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weig double precision,intent(in) :: AO(nBas,nGrid) double precision,intent(in) :: dAO(ncart,nBas,nGrid) + integer,intent(in) :: nNuc + double precision,intent(in) :: ZNuc(nNuc) + double precision,intent(in) :: rNuc(nNuc,ncart) + double precision,intent(in) :: ENuc + double precision,intent(in) :: S(nBas,nBas) double precision,intent(in) :: T(nBas,nBas) double precision,intent(in) :: V(nBas,nBas) double precision,intent(in) :: Hc(nBas,nBas) double precision,intent(in) :: X(nBas,nBas) double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) - double precision,intent(in) :: ENuc + double precision,intent(in) :: dipole_int(nBas,nBas,ncart) double precision,intent(in) :: occnum(nBas,nspin,nEns) integer,intent(in) :: Cx_choice logical,intent(in) :: doNcentered @@ -48,6 +53,7 @@ subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weig double precision :: EJ(nsp) double precision :: Ex(nspin) double precision :: Ec(nsp) + double precision :: dipole(ncart) double precision,allocatable :: cp(:,:,:) double precision,allocatable :: J(:,:,:) @@ -132,6 +138,11 @@ subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weig ! Guess coefficients and eigenvalues + nO(:) = 0 + do ispin=1,nspin + nO(ispin) = int(sum(occnum(:,ispin,1))) + end do + if(guess_type == 1) then do ispin=1,nspin @@ -142,11 +153,6 @@ subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weig ! Mix guess to enforce symmetry breaking - nO(:) = 0 - do ispin=1,nspin - nO(ispin) = int(sum(occnum(:,ispin,1))) - end do - if(mix) call mix_guess(nBas,nO,c) else if(guess_type == 2) then @@ -385,7 +391,8 @@ subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weig ! Compute final KS energy - call print_UKS(nBas,nEns,occnum,wEns,eps,c,ENuc,ET,EV,EJ,Ex,Ec,Ew) + call dipole_moment(nBas,Pw(:,:,1)+Pw(:,:,2),nNuc,ZNuc,rNuc,dipole_int,dipole) + call print_UKS(nBas,nEns,nO,S,wEns,eps,c,ENuc,ET,EV,EJ,Ex,Ec,Ew,dipole) ! Compute Vxc for post-HF calculations diff --git a/src/eDFT/print_UKS.f90 b/src/eDFT/print_UKS.f90 index f063849..be30958 100644 --- a/src/eDFT/print_UKS.f90 +++ b/src/eDFT/print_UKS.f90 @@ -1,4 +1,4 @@ -subroutine print_UKS(nBas,nEns,occnum,wEns,eps,c,ENuc,ET,EV,EJ,Ex,Ec,Ew) +subroutine print_UKS(nBas,nEns,nO,Ov,wEns,eps,c,ENuc,ET,EV,EJ,Ex,Ec,Ew,dipole) ! Print one- and two-electron energies and other stuff for KS calculation @@ -9,7 +9,8 @@ subroutine print_UKS(nBas,nEns,occnum,wEns,eps,c,ENuc,ET,EV,EJ,Ex,Ec,Ew) integer,intent(in) :: nBas integer,intent(in) :: nEns - double precision,intent(in) :: occnum(nBas,nspin,nEns) + integer,intent(in) :: nO(nspin) + double precision,intent(in) :: Ov(nBas,nBas) double precision,intent(in) :: wEns(nEns) double precision,intent(in) :: eps(nBas,nspin) double precision,intent(in) :: c(nBas,nBas,nspin) @@ -20,40 +21,39 @@ subroutine print_UKS(nBas,nEns,occnum,wEns,eps,c,ENuc,ET,EV,EJ,Ex,Ec,Ew) double precision,intent(in) :: Ex(nspin) double precision,intent(in) :: Ec(nsp) double precision,intent(in) :: Ew + double precision,intent(in) :: dipole(ncart) ! Local variables + integer :: ixyz integer :: ispin integer :: iEns integer :: iBas integer :: HOMO(nspin) integer :: LUMO(nspin) double precision :: Gap(nspin) - double precision :: nEl(nspin) - -! Number of electrons in the ensemble - - nEl(:) = 0d0 - do ispin=1,nspin - do iEns=1,nEns - do iBas=1,nBas - nEl(ispin) = nEl(ispin) + wEns(iEns)*occnum(iBas,ispin,iEns) - end do - end do - end do + double precision :: S_exact,S2_exact + double precision :: S,S2 ! HOMO and LUMO do ispin=1,nspin - HOMO(ispin) = ceiling(nEl(ispin)) + HOMO(ispin) = nO(ispin) LUMO(ispin) = HOMO(ispin) + 1 Gap(ispin) = eps(LUMO(ispin),ispin) - eps(HOMO(ispin),ispin) end do -! Dump results +! Spin comtamination + S2_exact = dble(nO(1) - nO(2))/2d0*(dble(nO(1) - nO(2))/2d0 + 1d0) + S2 = S2_exact + nO(2) - sum(matmul(transpose(c(:,1:nO(1),1)),matmul(Ov,c(:,1:nO(2),2)))**2) + + S_exact = 0.5d0*dble(nO(1) - nO(2)) + S = -0.5d0 + 0.5d0*sqrt(1d0 + 4d0*S2) + +! Dump results write(*,*) write(*,'(A60)') '-------------------------------------------------' @@ -97,6 +97,15 @@ subroutine print_UKS(nBas,nEns,occnum,wEns,eps,c,ENuc,ET,EV,EJ,Ex,Ec,Ew) write(*,'(A40,F13.6,A3)') ' KS LUMO b energy:',eps(LUMO(2),2)*HatoeV,' eV' write(*,'(A40,F13.6,A3)') ' KS HOMOb-LUMOb gap :',Gap(2)*HatoeV,' eV' write(*,'(A60)') '-------------------------------------------------' + write(*,'(A40,1X,F16.6)') ' S (exact) :',2d0*S_exact + 1d0 + write(*,'(A40,1X,F16.6)') ' S :',2d0*S + 1d0 + write(*,'(A40,1X,F16.6)') ' (exact) :',S2_exact + write(*,'(A40,1X,F16.6)') ' :',S2 + write(*,'(A60)') '-------------------------------------------------' + write(*,'(A45)') ' Dipole moment (Debye) ' + write(*,'(19X,4A10)') 'X','Y','Z','Tot.' + write(*,'(19X,4F10.6)') (dipole(ixyz)*auToD,ixyz=1,ncart),norm2(dipole)*auToD + write(*,'(A60)') '-------------------------------------------------' write(*,*) ! Print results From 210314bcd0ad72f37edb59078e26466bc3fa501a Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Thu, 25 Mar 2021 16:01:06 +0100 Subject: [PATCH 47/63] fix bug in print qsUGF2 --- input/methods | 4 ++-- input/options | 2 +- src/GF/print_qsUGF2.f90 | 4 ++-- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/input/methods b/input/methods index 768c20d..c965dd2 100644 --- a/input/methods +++ b/input/methods @@ -1,5 +1,5 @@ # RHF UHF KS MOM - F F T F + T F F F # MP2* MP3 MP2-F12 F F F # CCD DCD CCSD CCSD(T) @@ -13,7 +13,7 @@ # G0F2* evGF2* qsGF2* G0F3 evGF3 F 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 9ce0271..367898e 100644 --- a/input/options +++ b/input/options @@ -13,6 +13,6 @@ # ACFDT: AC Kx XBS F F T # BSE: BSE dBSE dTDA evDyn - F F T F + T T T F # MCMP2: nMC nEq nWalk dt nPrint iSeed doDrift 1000000 100000 10 0.3 10000 1234 T diff --git a/src/GF/print_qsUGF2.f90 b/src/GF/print_qsUGF2.f90 index 8c83812..ffec3c1 100644 --- a/src/GF/print_qsUGF2.f90 +++ b/src/GF/print_qsUGF2.f90 @@ -145,9 +145,9 @@ subroutine print_qsUGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,cGF2,PGF2,Ov,T,V,J,K, write(*,'(A40,1X,F16.10,A3)') ' Correlation ab energy: ',Ec(2),' au' write(*,'(A40,1X,F16.10,A3)') ' Correlation bb energy: ',Ec(3),' au' write(*,'(A60)') '-------------------------------------------------' - write(*,'(A40,1X,F16.10,A3)') ' Electronic energy: ',EqsGF2 + sum(Ec(:)),' au' + write(*,'(A40,1X,F16.10,A3)') ' Electronic energy: ',EqsGF2,' au' write(*,'(A40,1X,F16.10,A3)') ' Nuclear repulsion: ',ENuc,' au' - write(*,'(A40,1X,F16.10,A3)') ' qsUGF2 energy: ',ENuc + EqsGF2 + sum(Ec(:)),' au' + write(*,'(A40,1X,F16.10,A3)') ' qsUGF2 energy: ',ENuc + EqsGF2,' au' write(*,'(A60)') '-------------------------------------------------' write(*,'(A40,F13.6)') ' S (exact) :',2d0*S_exact + 1d0 write(*,'(A40,F13.6)') ' S :',2d0*S + 1d0 From 114ac2d1d1594a7e193e0079a9c45c8bec3c452c Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Sat, 27 Mar 2021 15:03:54 +0100 Subject: [PATCH 48/63] debug qsGW and qsGF --- input/methods | 6 +- input/options | 8 +- mol/h2.xyz | 2 +- src/GF/G0W0.f90 | 238 --------------------------------------- src/GF/qsGF2.f90 | 23 ++-- src/GF/qsUGF2.f90 | 35 ++++-- src/HF/RHF.f90 | 10 +- src/HF/UHF.f90 | 14 +-- src/MBPT/evGW.f90 | 10 +- src/MBPT/print_qsGW.f90 | 11 +- src/MBPT/print_qsUGW.f90 | 2 +- src/MBPT/qsGW.f90 | 31 +++-- src/MBPT/qsUGW.f90 | 38 +++++-- 13 files changed, 114 insertions(+), 314 deletions(-) delete mode 100644 src/GF/G0W0.f90 diff --git a/input/methods b/input/methods index c965dd2..098169e 100644 --- a/input/methods +++ b/input/methods @@ -1,5 +1,5 @@ # RHF UHF KS MOM - T F F F + F T F F # MP2* MP3 MP2-F12 F F F # CCD DCD CCSD CCSD(T) @@ -11,9 +11,9 @@ # RPA* RPAx* ppRPA F F F # G0F2* evGF2* qsGF2* G0F3 evGF3 - F F F F F + F F T 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 367898e..6c25527 100644 --- a/input/options +++ b/input/options @@ -1,5 +1,5 @@ # HF: maxSCF thresh DIIS n_diis guess_type ortho_type mix_guess stability - 128 0.0000001 T 5 1 1 T F + 1024 0.0000001 T 5 2 1 T F # MP: # CC: maxSCF thresh DIIS n_diis @@ -7,12 +7,12 @@ # spin: TDA singlet triplet spin_conserved spin_flip F T T T T # GF: maxSCF thresh DIIS n_diis lin eta renorm - 256 0.00001 T 5 T 0.001 3 + 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.0000001 T 5 T 0.0 F F F F F # ACFDT: AC Kx XBS F F T # BSE: BSE dBSE dTDA evDyn - T T T F + F T T F # MCMP2: nMC nEq nWalk dt nPrint iSeed doDrift 1000000 100000 10 0.3 10000 1234 T diff --git a/mol/h2.xyz b/mol/h2.xyz index f8e2dab..fe42126 100644 --- a/mol/h2.xyz +++ b/mol/h2.xyz @@ -1,4 +1,4 @@ 2 H 0.0 0.0 0.0 -H 0.0 0.0 0.71 +H 0.0 0.0 1.0 diff --git a/src/GF/G0W0.f90 b/src/GF/G0W0.f90 deleted file mode 100644 index d2c7fa7..0000000 --- a/src/GF/G0W0.f90 +++ /dev/null @@ -1,238 +0,0 @@ -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,ERI_AO,ERI_MO,dipole_int,PHF,cHF,eHF,Vxc,eG0W0) - -! Perform G0W0 calculation - - implicit none - include 'parameters.h' - include 'quadrature.h' - -! Input variables - - logical,intent(in) :: doACFDT - logical,intent(in) :: exchange_kernel - logical,intent(in) :: doXBS - logical,intent(in) :: COHSEX - logical,intent(in) :: SOSEX - 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) :: singlet - logical,intent(in) :: triplet - logical,intent(in) :: linearize - double precision,intent(in) :: eta - - integer,intent(in) :: nBas,nC,nO,nV,nR,nS - double precision,intent(in) :: ENuc - double precision,intent(in) :: ERHF - double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas) - double precision,intent(in) :: ERI_MO(nBas,nBas,nBas,nBas) - double precision,intent(in) :: dipole_int(nBas,nBas,ncart) - double precision,intent(in) :: Vxc(nBas) - double precision,intent(in) :: eHF(nBas) - double precision,intent(in) :: cHF(nBas,nBas) - double precision,intent(in) :: PHF(nBas,nBas) - -! Local variables - - logical :: print_W = .true. - integer :: ispin - double precision :: EcRPA - double precision :: EcBSE(nspin) - double precision :: EcAC(nspin) - double precision :: EcGM - double precision,allocatable :: SigX(:) - double precision,allocatable :: SigC(:) - double precision,allocatable :: Z(:) - double precision,allocatable :: OmRPA(:) - double precision,allocatable :: XpY_RPA(:,:) - double precision,allocatable :: XmY_RPA(:,:) - double precision,allocatable :: rho_RPA(:,:,:) - - double precision,allocatable :: eG0W0lin(:) - -! Output variables - - double precision :: eG0W0(nBas) - -! Hello world - - write(*,*) - write(*,*)'************************************************' - write(*,*)'| One-shot G0W0 calculation |' - write(*,*)'************************************************' - write(*,*) - -! Initialization - - EcRPA = 0d0 - -! SOSEX correction - - if(SOSEX) then - write(*,*) 'SOSEX correction activated but BUG!' - stop - end if - -! 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 - -! Spin manifold - - ispin = 1 - -! Memory allocation - - allocate(SigC(nBas),SigX(nBas),Z(nBas),OmRPA(nS),XpY_RPA(nS,nS),XmY_RPA(nS,nS),rho_RPA(nBas,nBas,nS),eG0W0lin(nBas)) - -!-------------------! -! Compute screening ! -!-------------------! - - call linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0, & - eHF,ERI_MO,OmRPA,rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA) - - if(print_W) call print_excitation('RPA@HF ',ispin,nS,OmRPA) - -!--------------------------! -! Compute spectral weights ! -!--------------------------! - - call excitation_density(nBas,nC,nO,nR,nS,ERI_MO,XpY_RPA,rho_RPA) - -!------------------------! -! Compute GW self-energy ! -!------------------------! - - call self_energy_exchange_diag(nBas,cHF,PHF,ERI_AO,SigX) - call self_energy_correlation_diag(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,EcGM,SigC) - -!--------------------------------! -! Compute renormalization factor ! -!--------------------------------! - - call renormalization_factor(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,Z) - -!-----------------------------------! -! Solve the quasi-particle equation ! -!-----------------------------------! - - eG0W0lin(:) = eHF(:) + Z(:)*(SigX(:) + SigC(:) - Vxc(:)) - - ! Linearized or graphical solution? - - if(linearize) then - - write(*,*) ' *** Quasiparticle energies obtained by linearization *** ' - write(*,*) - - eG0W0(:) = eG0W0lin(:) - - else - - write(*,*) ' *** Quasiparticle energies obtained by root search (experimental) *** ' - write(*,*) - - call QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,SigX,Vxc,OmRPA,rho_RPA,eG0W0lin,eG0W0) - - ! 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 - -! Compute the RPA correlation energy - - call linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eG0W0,ERI_MO,OmRPA, & - rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA) - -!--------------! -! Dump results ! -!--------------! - - call print_G0W0(nBas,nO,eHF,ENuc,ERHF,SigC,Z,eG0W0,EcRPA,EcGM) - -! Deallocate memory - - deallocate(SigC,Z,OmRPA,XpY_RPA,XmY_RPA,rho_RPA,eG0W0lin) - -! Plot stuff - -! 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,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI_MO,dipole_int,eHF,eG0W0,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@G0W0 correlation energy (singlet) =',EcBSE(1) - write(*,'(2X,A50,F20.10)') 'Tr@BSE@G0W0 correlation energy (triplet) =',EcBSE(2) - write(*,'(2X,A50,F20.10)') 'Tr@BSE@G0W0 correlation energy =',EcBSE(1) + EcBSE(2) - write(*,'(2X,A50,F20.10)') 'Tr@BSE@G0W0 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@UG0W0 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_MO,eHF,eG0W0,EcAC) - - write(*,*) - write(*,*)'-------------------------------------------------------------------------------' - write(*,'(2X,A50,F20.10)') 'AC@BSE@UG0W0 correlation energy (singlet) =',EcAC(1) - write(*,'(2X,A50,F20.10)') 'AC@BSE@UG0W0 correlation energy (triplet) =',EcAC(2) - write(*,'(2X,A50,F20.10)') 'AC@BSE@UG0W0 correlation energy =',EcAC(1) + EcAC(2) - write(*,'(2X,A50,F20.10)') 'AC@BSE@UG0W0 total energy =',ENuc + ERHF + EcAC(1) + EcAC(2) - write(*,*)'-------------------------------------------------------------------------------' - write(*,*) - - end if - - end if - -end subroutine G0W0 diff --git a/src/GF/qsGF2.f90 b/src/GF/qsGF2.f90 index 6e8988b..b4b385b 100644 --- a/src/GF/qsGF2.f90 +++ b/src/GF/qsGF2.f90 @@ -64,6 +64,7 @@ subroutine qsGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet, double precision,allocatable :: c(:,:) double precision,allocatable :: cp(:,:) double precision,allocatable :: eGF2(:) + double precision,allocatable :: eOld(:) double precision,allocatable :: P(:,:) double precision,allocatable :: F(:,:) double precision,allocatable :: Fp(:,:) @@ -101,8 +102,8 @@ subroutine qsGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet, ! Memory allocation - allocate(eGF2(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), & + allocate(eGF2(nBas),eOld(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), & error(nBas,nBas),error_diis(nBasSq,max_diis),F_diis(nBasSq,max_diis)) ! Initialization @@ -112,6 +113,7 @@ subroutine qsGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet, ispin = 1 Conv = 1d0 P(:,:) = PHF(:,:) + eOld(:) = eHF(:) eGF2(:) = eHF(:) c(:,:) = cHF(:,:) F_diis(:,:) = 0d0 @@ -157,16 +159,15 @@ subroutine qsGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet, ! Compute commutator and convergence criteria error = matmul(F,matmul(P,S)) - matmul(matmul(S,P),F) - Conv = maxval(abs(error)) ! DIIS extrapolation n_diis = min(n_diis+1,max_diis) - call DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,error_diis,F_diis,error,F) - -! Reset DIIS if required - - if(abs(rcond) < 1d-15) n_diis = 0 + if(abs(rcond) > 1d-7) then + call DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,error_diis,F_diis,error,F) + else + n_diis = 0 + end if ! Diagonalize Hamiltonian in AO basis @@ -174,6 +175,12 @@ subroutine qsGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet, cp(:,:) = Fp(:,:) call diagonalize_matrix(nBas,cp,eGF2) c = matmul(X,cp) + SigCp = matmul(transpose(c),matmul(SigCp,c)) + + ! Save quasiparticles energy for next cycle + + Conv = maxval(abs(eGF2 - eOld)) + eOld(:) = eGF2(:) ! Compute new density matrix in the AO basis diff --git a/src/GF/qsUGF2.f90 b/src/GF/qsUGF2.f90 index 5c93e01..9c05f6a 100644 --- a/src/GF/qsUGF2.f90 +++ b/src/GF/qsUGF2.f90 @@ -75,6 +75,7 @@ subroutine qsUGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,spin_conserved, double precision,allocatable :: F_diis(:,:,:) double precision,allocatable :: c(:,:,:) double precision,allocatable :: cp(:,:,:) + double precision,allocatable :: eOld(:,:) double precision,allocatable :: eGF2(:,:) double precision,allocatable :: P(:,:,:) double precision,allocatable :: F(:,:,:) @@ -117,9 +118,10 @@ subroutine qsUGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,spin_conserved, nS_bb = nS(2) nS_sc = nS_aa + nS_bb - allocate(eGF2(nBas,nspin),c(nBas,nBas,nspin),cp(nBas,nBas,nspin),P(nBas,nBas,nspin),F(nBas,nBas,nspin),Fp(nBas,nBas,nspin), & - J(nBas,nBas,nspin),K(nBas,nBas,nspin),SigC(nBas,nBas,nspin),SigCp(nBas,nBas,nspin),SigCm(nBas,nBas,nspin), & - Z(nBas,nspin),error(nBas,nBas,nspin),error_diis(nBasSq,max_diis,nspin),F_diis(nBasSq,max_diis,nspin)) + allocate(eGF2(nBas,nspin),eOld(nBas,nspin),c(nBas,nBas,nspin),cp(nBas,nBas,nspin),P(nBas,nBas,nspin),F(nBas,nBas,nspin), & + Fp(nBas,nBas,nspin),J(nBas,nBas,nspin),K(nBas,nBas,nspin),SigC(nBas,nBas,nspin),SigCp(nBas,nBas,nspin), & + SigCm(nBas,nBas,nspin),Z(nBas,nspin),error(nBas,nBas,nspin),error_diis(nBasSq,max_diis,nspin), & + F_diis(nBasSq,max_diis,nspin)) ! Initialization @@ -205,14 +207,14 @@ subroutine qsUGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,spin_conserved, ! DIIS extrapolation n_diis = min(n_diis+1,max_diis) - do is=1,nspin - if(nO(is) > 1) call DIIS_extrapolation(rcond(is),nBasSq,nBasSq,n_diis,error_diis(:,1:n_diis,is), & - F_diis(:,1:n_diis,is),error(:,:,is),F(:,:,is)) - end do - - ! Reset DIIS if required - - if(minval(rcond(:)) < 1d-15) n_diis = 0 + if(minval(rcond(:)) > 1d-7) then + do is=1,nspin + if(nO(is) > 1) call DIIS_extrapolation(rcond(is),nBasSq,nBasSq,n_diis,error_diis(:,1:n_diis,is), & + F_diis(:,1:n_diis,is),error(:,:,is),F(:,:,is)) + end do + else + n_diis = 0 + end if ! Transform Fock matrix in orthogonal basis @@ -233,12 +235,23 @@ subroutine qsUGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,spin_conserved, c(:,:,is) = matmul(X(:,:),cp(:,:,is)) end do + ! Back-transform self-energy + + do is=1,nspin + SigCp(:,:,is) = matmul(transpose(c(:,:,is)),matmul(SigCp(:,:,is),c(:,:,is))) + end do + ! Compute density matrix do is=1,nspin P(:,:,is) = matmul(c(:,1:nO(is),is),transpose(c(:,1:nO(is),is))) end do + ! Save quasiparticles energy for next cycle + + Conv = maxval(abs(eGF2(:,:) - eOld(:,:))) + eOld(:,:) = eGF2(:,:) + !------------------------------------------------------------------------ ! Compute total energy !------------------------------------------------------------------------ diff --git a/src/HF/RHF.f90 b/src/HF/RHF.f90 index 9fd3d22..05499a5 100644 --- a/src/HF/RHF.f90 +++ b/src/HF/RHF.f90 @@ -127,11 +127,11 @@ subroutine RHF(maxSCF,thresh,max_diis,guess_type,nNuc,ZNuc,rNuc,ENuc,nBas,nO,S,T ! DIIS extrapolation n_diis = min(n_diis+1,max_diis) - call DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,error_diis,F_diis,error,F) - -! Reset DIIS if required - - if(abs(rcond) < 1d-15) n_diis = 0 + if(abs(rcond) > 1d-7) then + call DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,error_diis,F_diis,error,F) + else + n_diis = 0 + end if ! Diagonalize Fock matrix diff --git a/src/HF/UHF.f90 b/src/HF/UHF.f90 index a55e8bb..9443924 100644 --- a/src/HF/UHF.f90 +++ b/src/HF/UHF.f90 @@ -179,14 +179,14 @@ subroutine UHF(maxSCF,thresh,max_diis,guess_type,mix,nNuc,ZNuc,rNuc,ENuc,nBas,nO ! DIIS extrapolation n_diis = min(n_diis+1,max_diis) - do ispin=1,nspin - if(nO(ispin) > 1) call DIIS_extrapolation(rcond(ispin),nBasSq,nBasSq,n_diis,err_diis(:,1:n_diis,ispin), & + if(minval(rcond(:)) > 1d-7) then + do ispin=1,nspin + if(nO(ispin) > 1) call DIIS_extrapolation(rcond(ispin),nBasSq,nBasSq,n_diis,err_diis(:,1:n_diis,ispin), & F_diis(:,1:n_diis,ispin),err(:,:,ispin),F(:,:,ispin)) - end do - -! Reset DIIS if required - - if(minval(rcond(:)) < 1d-15) n_diis = 0 + end do + else + n_diis = 0 + end if !------------------------------------------------------------------------ ! Compute UHF energy diff --git a/src/MBPT/evGW.f90 b/src/MBPT/evGW.f90 index 7d15ef9..85998eb 100644 --- a/src/MBPT/evGW.f90 +++ b/src/MBPT/evGW.f90 @@ -195,11 +195,11 @@ subroutine evGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE else n_diis = min(n_diis+1,max_diis) - call DIIS_extrapolation(rcond,nBas,nBas,n_diis,error_diis,e_diis,eGW-eOld,eGW) - -! Reset DIIS if required - - if(abs(rcond) < 1d-15) n_diis = 0 + if(abs(rcond) > 1d-7) then + call DIIS_extrapolation(rcond,nBas,nBas,n_diis,error_diis,e_diis,eGW-eOld,eGW) + else + n_diis = 0 + endif endif diff --git a/src/MBPT/print_qsGW.f90 b/src/MBPT/print_qsGW.f90 index c3995b0..52702be 100644 --- a/src/MBPT/print_qsGW.f90 +++ b/src/MBPT/print_qsGW.f90 @@ -1,5 +1,4 @@ -subroutine print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,P,T,V,J,K,F,SigC,Z, & - ENuc,ET,EV,EJ,Ex,EcGM,EcRPA,EqsGW,dipole) +subroutine print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,SigC,Z,ENuc,ET,EV,EJ,Ex,EcGM,EcRPA,EqsGW,dipole) ! Print one-electron energies and other stuff for qsGW @@ -23,10 +22,8 @@ subroutine print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,P,T,V,J,K,F,SigC,Z, & double precision,intent(in) :: eHF(nBas) double precision,intent(in) :: eGW(nBas) double precision,intent(in) :: c(nBas) - double precision,intent(in) :: P(nBas,nBas) - double precision,intent(in) :: T(nBas,nBas),V(nBas,nBas) - double precision,intent(in) :: J(nBas,nBas),K(nBas,nBas),F(nBas,nBas) - double precision,intent(in) :: Z(nBas),SigC(nBas,nBas) + double precision,intent(in) :: SigC(nBas,nBas) + double precision,intent(in) :: Z(nBas) double precision,intent(in) :: dipole(ncart) ! Local variables @@ -67,7 +64,7 @@ subroutine print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,P,T,V,J,K,F,SigC,Z, & write(*,*)'-------------------------------------------------------------------------------' write(*,'(2X,A10,I3)') 'Iteration ',nSCF - write(*,'(2X,A19,F15.5)')'max(|FPS - SPF|) = ',Conv + write(*,'(2X,A14,F15.5)')'Convergence = ',Conv write(*,*)'-------------------------------------------' write(*,'(2X,A30,F15.6,A3)') 'qsGW HOMO energy:',eGW(HOMO)*HaToeV,' eV' write(*,'(2X,A30,F15.6,A3)') 'qsGW LUMO energy:',eGW(LUMO)*HaToeV,' eV' diff --git a/src/MBPT/print_qsUGW.f90 b/src/MBPT/print_qsUGW.f90 index 18594dc..983e148 100644 --- a/src/MBPT/print_qsUGW.f90 +++ b/src/MBPT/print_qsUGW.f90 @@ -92,7 +92,7 @@ subroutine print_qsUGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,cGW,PGW,Ov,T,V,J,K, & write(*,*)'-------------------------------------------------------------------------------& -------------------------------------------------' write(*,'(2X,A10,I3)') 'Iteration ',nSCF - write(*,'(2X,A19,F15.5)')'max(|FPS - SPF|) = ',Conv + write(*,'(2X,A14,F15.5)')'Convergence = ',Conv write(*,*)'-------------------------------------------------------------------------------& -------------------------------------------------' write(*,'(2X,A30,F15.6,A3)') 'qsUGW HOMO energy:',maxval(HOMO(:))*HaToeV,' eV' diff --git a/src/MBPT/qsGW.f90 b/src/MBPT/qsGW.f90 index e143ebe..5d54f93 100644 --- a/src/MBPT/qsGW.f90 +++ b/src/MBPT/qsGW.f90 @@ -69,6 +69,7 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE double precision,external :: trace_matrix double precision :: dipole(ncart) + logical :: print_W = .true. double precision,allocatable :: error_diis(:,:) double precision,allocatable :: F_diis(:,:) double precision,allocatable :: OmRPA(:) @@ -78,6 +79,7 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE double precision,allocatable :: c(:,:) double precision,allocatable :: cp(:,:) double precision,allocatable :: eGW(:) + double precision,allocatable :: eOld(:) double precision,allocatable :: P(:,:) double precision,allocatable :: F(:,:) double precision,allocatable :: Fp(:,:) @@ -136,9 +138,9 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE ! 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), & - OmRPA(nS),XpY_RPA(nS,nS),XmY_RPA(nS,nS),rho_RPA(nBas,nBas,nS), & + allocate(eGW(nBas),eOld(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), & + 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 @@ -149,6 +151,7 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE Conv = 1d0 P(:,:) = PHF(:,:) eGW(:) = eHF(:) + eOld(:) = eHF(:) c(:,:) = cHF(:,:) F_diis(:,:) = 0d0 error_diis(:,:) = 0d0 @@ -181,6 +184,7 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE call linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI_MO, & OmRPA,rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA) + if(print_W) call print_excitation('RPA@qsGW ',ispin,nS,OmRPA) endif @@ -211,21 +215,18 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE F(:,:) = Hc(:,:) + J(:,:) + 0.5d0*K(:,:) + SigCp(:,:) - call matout(nBas,nBAs,SigCp) - ! Compute commutator and convergence criteria error = matmul(F,matmul(P,S)) - matmul(matmul(S,P),F) - Conv = maxval(abs(error)) ! DIIS extrapolation n_diis = min(n_diis+1,max_diis) - call DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,error_diis,F_diis,error,F) - -! Reset DIIS if required - - if(abs(rcond) < 1d-15) n_diis = 0 + if(abs(rcond) > 1d-7) then + call DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,error_diis,F_diis,error,F) + else + n_diis = 0 + end if ! Diagonalize Hamiltonian in AO basis @@ -233,6 +234,12 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE cp(:,:) = Fp(:,:) call diagonalize_matrix(nBas,cp,eGW) c = matmul(X,cp) + SigCp = matmul(transpose(c),matmul(SigCp,c)) + + ! Save quasiparticles energy for next cycle + + Conv = maxval(abs(eGW - eOld)) + eOld(:) = eGW(:) ! Compute new density matrix in the AO basis @@ -265,7 +272,7 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE ! Print results call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int_AO,dipole) - call print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,P,T,V,J,K,F,SigCp,Z,ENuc,ET,EV,EJ,Ex,EcGM,EcRPA,EqsGW,dipole) + call print_qsGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,c,SigCp,Z,ENuc,ET,EV,EJ,Ex,EcGM,EcRPA,EqsGW,dipole) enddo !------------------------------------------------------------------------ diff --git a/src/MBPT/qsUGW.f90 b/src/MBPT/qsUGW.f90 index de27201..7e7b051 100644 --- a/src/MBPT/qsUGW.f90 +++ b/src/MBPT/qsUGW.f90 @@ -92,6 +92,7 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOS double precision,allocatable :: c(:,:,:) double precision,allocatable :: cp(:,:,:) double precision,allocatable :: eGW(:,:) + double precision,allocatable :: eOld(:,:) double precision,allocatable :: P(:,:,:) double precision,allocatable :: F(:,:,:) double precision,allocatable :: Fp(:,:,:) @@ -154,10 +155,11 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOS nS_bb = nS(2) nS_sc = nS_aa + nS_bb - allocate(eGW(nBas,nspin),c(nBas,nBas,nspin),cp(nBas,nBas,nspin),P(nBas,nBas,nspin),F(nBas,nBas,nspin),Fp(nBas,nBas,nspin), & - J(nBas,nBas,nspin),K(nBas,nBas,nspin),SigC(nBas,nBas,nspin),SigCp(nBas,nBas,nspin),SigCm(nBas,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), & - error(nBas,nBas,nspin),error_diis(nBasSq,max_diis,nspin),F_diis(nBasSq,max_diis,nspin)) + allocate(eGW(nBas,nspin),eOld(nBas,nspin),c(nBas,nBas,nspin),cp(nBas,nBas,nspin),P(nBas,nBas,nspin),F(nBas,nBas,nspin), & + Fp(nBas,nBas,nspin),J(nBas,nBas,nspin),K(nBas,nBas,nspin),SigC(nBas,nBas,nspin),SigCp(nBas,nBas,nspin), & + SigCm(nBas,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),error(nBas,nBas,nspin),error_diis(nBasSq,max_diis,nspin), & + F_diis(nBasSq,max_diis,nspin)) ! Initialization @@ -167,6 +169,7 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOS Conv = 1d0 P(:,:,:) = PHF(:,:,:) eGW(:,:) = eHF(:,:) + eOld(:,:) = eHF(:,:) c(:,:,:) = cHF(:,:,:) F_diis(:,:,:) = 0d0 error_diis(:,:,:) = 0d0 @@ -268,14 +271,14 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOS ! DIIS extrapolation n_diis = min(n_diis+1,max_diis) - do is=1,nspin - if(nO(is) > 1) call DIIS_extrapolation(rcond(is),nBasSq,nBasSq,n_diis,error_diis(:,1:n_diis,is), & - F_diis(:,1:n_diis,is),error(:,:,is),F(:,:,is)) - end do - - ! Reset DIIS if required - - if(minval(rcond(:)) < 1d-15) n_diis = 0 + if(minval(rcond(:)) > 1d-7) then + do is=1,nspin + if(nO(is) > 1) call DIIS_extrapolation(rcond(is),nBasSq,nBasSq,n_diis,error_diis(:,1:n_diis,is), & + F_diis(:,1:n_diis,is),error(:,:,is),F(:,:,is)) + end do + else + n_diis = 0 + end if ! Transform Fock matrix in orthogonal basis @@ -296,12 +299,23 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOS c(:,:,is) = matmul(X(:,:),cp(:,:,is)) end do + ! Back-transform self-energy + + do is=1,nspin + SigCp(:,:,is) = matmul(transpose(c(:,:,is)),matmul(SigCp(:,:,is),c(:,:,is))) + end do + ! Compute density matrix do is=1,nspin P(:,:,is) = matmul(c(:,1:nO(is),is),transpose(c(:,1:nO(is),is))) end do + ! Save quasiparticles energy for next cycle + + Conv = maxval(abs(eGW(:,:) - eOld(:,:))) + eOld(:,:) = eGW(:,:) + !------------------------------------------------------------------------ ! Compute total energy !------------------------------------------------------------------------ From 246f4dea488db00106831bdd5945c27be05e2ea1 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Sat, 27 Mar 2021 15:04:18 +0100 Subject: [PATCH 49/63] add G0W0 --- src/MBPT/G0W0.f90 | 238 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 238 insertions(+) create mode 100644 src/MBPT/G0W0.f90 diff --git a/src/MBPT/G0W0.f90 b/src/MBPT/G0W0.f90 new file mode 100644 index 0000000..d2c7fa7 --- /dev/null +++ b/src/MBPT/G0W0.f90 @@ -0,0 +1,238 @@ +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,ERI_AO,ERI_MO,dipole_int,PHF,cHF,eHF,Vxc,eG0W0) + +! Perform G0W0 calculation + + implicit none + include 'parameters.h' + include 'quadrature.h' + +! Input variables + + logical,intent(in) :: doACFDT + logical,intent(in) :: exchange_kernel + logical,intent(in) :: doXBS + logical,intent(in) :: COHSEX + logical,intent(in) :: SOSEX + 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) :: singlet + logical,intent(in) :: triplet + logical,intent(in) :: linearize + double precision,intent(in) :: eta + + integer,intent(in) :: nBas,nC,nO,nV,nR,nS + double precision,intent(in) :: ENuc + double precision,intent(in) :: ERHF + double precision,intent(in) :: ERI_AO(nBas,nBas,nBas,nBas) + double precision,intent(in) :: ERI_MO(nBas,nBas,nBas,nBas) + double precision,intent(in) :: dipole_int(nBas,nBas,ncart) + double precision,intent(in) :: Vxc(nBas) + double precision,intent(in) :: eHF(nBas) + double precision,intent(in) :: cHF(nBas,nBas) + double precision,intent(in) :: PHF(nBas,nBas) + +! Local variables + + logical :: print_W = .true. + integer :: ispin + double precision :: EcRPA + double precision :: EcBSE(nspin) + double precision :: EcAC(nspin) + double precision :: EcGM + double precision,allocatable :: SigX(:) + double precision,allocatable :: SigC(:) + double precision,allocatable :: Z(:) + double precision,allocatable :: OmRPA(:) + double precision,allocatable :: XpY_RPA(:,:) + double precision,allocatable :: XmY_RPA(:,:) + double precision,allocatable :: rho_RPA(:,:,:) + + double precision,allocatable :: eG0W0lin(:) + +! Output variables + + double precision :: eG0W0(nBas) + +! Hello world + + write(*,*) + write(*,*)'************************************************' + write(*,*)'| One-shot G0W0 calculation |' + write(*,*)'************************************************' + write(*,*) + +! Initialization + + EcRPA = 0d0 + +! SOSEX correction + + if(SOSEX) then + write(*,*) 'SOSEX correction activated but BUG!' + stop + end if + +! 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 + +! Spin manifold + + ispin = 1 + +! Memory allocation + + allocate(SigC(nBas),SigX(nBas),Z(nBas),OmRPA(nS),XpY_RPA(nS,nS),XmY_RPA(nS,nS),rho_RPA(nBas,nBas,nS),eG0W0lin(nBas)) + +!-------------------! +! Compute screening ! +!-------------------! + + call linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0, & + eHF,ERI_MO,OmRPA,rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA) + + if(print_W) call print_excitation('RPA@HF ',ispin,nS,OmRPA) + +!--------------------------! +! Compute spectral weights ! +!--------------------------! + + call excitation_density(nBas,nC,nO,nR,nS,ERI_MO,XpY_RPA,rho_RPA) + +!------------------------! +! Compute GW self-energy ! +!------------------------! + + call self_energy_exchange_diag(nBas,cHF,PHF,ERI_AO,SigX) + call self_energy_correlation_diag(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,EcGM,SigC) + +!--------------------------------! +! Compute renormalization factor ! +!--------------------------------! + + call renormalization_factor(COHSEX,eta,nBas,nC,nO,nV,nR,nS,eHF,OmRPA,rho_RPA,Z) + +!-----------------------------------! +! Solve the quasi-particle equation ! +!-----------------------------------! + + eG0W0lin(:) = eHF(:) + Z(:)*(SigX(:) + SigC(:) - Vxc(:)) + + ! Linearized or graphical solution? + + if(linearize) then + + write(*,*) ' *** Quasiparticle energies obtained by linearization *** ' + write(*,*) + + eG0W0(:) = eG0W0lin(:) + + else + + write(*,*) ' *** Quasiparticle energies obtained by root search (experimental) *** ' + write(*,*) + + call QP_graph(nBas,nC,nO,nV,nR,nS,eta,eHF,SigX,Vxc,OmRPA,rho_RPA,eG0W0lin,eG0W0) + + ! 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 + +! Compute the RPA correlation energy + + call linear_response(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS,1d0,eG0W0,ERI_MO,OmRPA, & + rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA) + +!--------------! +! Dump results ! +!--------------! + + call print_G0W0(nBas,nO,eHF,ENuc,ERHF,SigC,Z,eG0W0,EcRPA,EcGM) + +! Deallocate memory + + deallocate(SigC,Z,OmRPA,XpY_RPA,XmY_RPA,rho_RPA,eG0W0lin) + +! Plot stuff + +! 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,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI_MO,dipole_int,eHF,eG0W0,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@G0W0 correlation energy (singlet) =',EcBSE(1) + write(*,'(2X,A50,F20.10)') 'Tr@BSE@G0W0 correlation energy (triplet) =',EcBSE(2) + write(*,'(2X,A50,F20.10)') 'Tr@BSE@G0W0 correlation energy =',EcBSE(1) + EcBSE(2) + write(*,'(2X,A50,F20.10)') 'Tr@BSE@G0W0 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@UG0W0 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_MO,eHF,eG0W0,EcAC) + + write(*,*) + write(*,*)'-------------------------------------------------------------------------------' + write(*,'(2X,A50,F20.10)') 'AC@BSE@UG0W0 correlation energy (singlet) =',EcAC(1) + write(*,'(2X,A50,F20.10)') 'AC@BSE@UG0W0 correlation energy (triplet) =',EcAC(2) + write(*,'(2X,A50,F20.10)') 'AC@BSE@UG0W0 correlation energy =',EcAC(1) + EcAC(2) + write(*,'(2X,A50,F20.10)') 'AC@BSE@UG0W0 total energy =',ENuc + ERHF + EcAC(1) + EcAC(2) + write(*,*)'-------------------------------------------------------------------------------' + write(*,*) + + end if + + end if + +end subroutine G0W0 From 80c77efe479d9b9a9bc61488d0b34905f015b5af Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Sat, 27 Mar 2021 15:06:51 +0100 Subject: [PATCH 50/63] qsGF print --- src/GF/print_qsGF2.f90 | 2 +- src/GF/print_qsUGF2.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/GF/print_qsGF2.f90 b/src/GF/print_qsGF2.f90 index 33a6e9b..1462e70 100644 --- a/src/GF/print_qsGF2.f90 +++ b/src/GF/print_qsGF2.f90 @@ -63,7 +63,7 @@ subroutine print_qsGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,c,P,T,V,J,K,F,SigC,Z, & write(*,*)'-------------------------------------------------------------------------------' write(*,'(2X,A10,I3)') 'Iteration ',nSCF - write(*,'(2X,A19,F15.5)')'max(|FPS - SPF|) = ',Conv + write(*,'(2X,A14,F15.5)')'Convergence = ',Conv write(*,*)'-------------------------------------------' write(*,'(2X,A30,F15.6,A3)') 'qsGF2 HOMO energy:',eGF2(HOMO)*HaToeV,' eV' write(*,'(2X,A30,F15.6,A3)') 'qsGF2 LUMO energy:',eGF2(LUMO)*HaToeV,' eV' diff --git a/src/GF/print_qsUGF2.f90 b/src/GF/print_qsUGF2.f90 index ffec3c1..f87a9d5 100644 --- a/src/GF/print_qsUGF2.f90 +++ b/src/GF/print_qsUGF2.f90 @@ -91,7 +91,7 @@ subroutine print_qsUGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,cGF2,PGF2,Ov,T,V,J,K, write(*,*)'-------------------------------------------------------------------------------& -------------------------------------------------' write(*,'(2X,A10,I3)') 'Iteration ',nSCF - write(*,'(2X,A19,F15.5)')'max(|FPS - SPF|) = ',Conv + write(*,'(2X,A14,F15.5)')'Convergence = ',Conv write(*,*)'-------------------------------------------------------------------------------& -------------------------------------------------' write(*,'(2X,A30,F15.6,A3)') 'qsUGF2 HOMO energy:',maxval(HOMO(:))*HaToeV,' eV' From 6d590f237fb8f35e5e436b1c0fc769e94d6bb514 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Thu, 1 Apr 2021 22:04:23 +0200 Subject: [PATCH 51/63] fix bug in URPA --- input/dft | 4 ++-- input/methods | 4 ++-- input/options | 4 ++-- mol/h2.xyz | 2 +- src/RPA/URPA.f90 | 7 +++++++ src/eDFT/eDFT_UKS.f90 | 16 ++++++++-------- 6 files changed, 22 insertions(+), 15 deletions(-) diff --git a/input/dft b/input/dft index b528057..9523149 100644 --- a/input/dft +++ b/input/dft @@ -1,5 +1,5 @@ # Restricted or unrestricted KS calculation - UKS + eDFT-UKS # exchange rung: # Hartree = 0: H # LDA = 1: S51,CC-S51 @@ -28,7 +28,7 @@ 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 # Ensemble weights: wEns(1),...,wEns(nEns-1) - 0.25 0.0 + 0.1 0.0 # N-centered? F # Parameters for CC weight-dependent exchange functional diff --git a/input/methods b/input/methods index 098169e..e7c0516 100644 --- a/input/methods +++ b/input/methods @@ -9,9 +9,9 @@ # CIS* CIS(D) CID CISD FCI F F F F F # RPA* RPAx* ppRPA - F F F + F T F # G0F2* evGF2* qsGF2* G0F3 evGF3 - F F T F F + F F F F F # G0W0* evGW* qsGW* F F F # G0T0 evGT qsGT diff --git a/input/options b/input/options index 6c25527..651045a 100644 --- a/input/options +++ b/input/options @@ -1,5 +1,5 @@ # HF: maxSCF thresh DIIS n_diis guess_type ortho_type mix_guess stability - 1024 0.0000001 T 5 2 1 T F + 1024 0.00001 F 5 1 1 F F # MP: # CC: maxSCF thresh DIIS n_diis @@ -11,7 +11,7 @@ # GW/GT: maxSCF thresh DIIS n_diis lin eta COHSEX SOSEX TDA_W G0W GW0 256 0.0000001 T 5 T 0.0 F F F F F # ACFDT: AC Kx XBS - F F T + F T T # BSE: BSE dBSE dTDA evDyn F T T F # MCMP2: nMC nEq nWalk dt nPrint iSeed doDrift diff --git a/mol/h2.xyz b/mol/h2.xyz index fe42126..6a4e902 100644 --- a/mol/h2.xyz +++ b/mol/h2.xyz @@ -1,4 +1,4 @@ 2 H 0.0 0.0 0.0 -H 0.0 0.0 1.0 +H 0.0 0.0 0.7 diff --git a/src/RPA/URPA.f90 b/src/RPA/URPA.f90 index 1a9f222..e08fb11 100644 --- a/src/RPA/URPA.f90 +++ b/src/RPA/URPA.f90 @@ -146,6 +146,13 @@ subroutine URPA(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,nC call unrestricted_ACFDT(exchange_kernel,.false.,.true.,.false.,TDA,.false.,spin_conserved,spin_flip,eta, & nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,ERI_bbbb,e,e,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@URPA correlation energy (spin-conserved) =',EcAC(1) diff --git a/src/eDFT/eDFT_UKS.f90 b/src/eDFT/eDFT_UKS.f90 index 03a9212..2653787 100644 --- a/src/eDFT/eDFT_UKS.f90 +++ b/src/eDFT/eDFT_UKS.f90 @@ -284,14 +284,14 @@ subroutine eDFT_UKS(x_rung,x_DFA,c_rung,c_DFA,nEns,wEns,aCC_w1,aCC_w2,nGrid,weig ! DIIS extrapolation 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)) - end do - -! Reset DIIS if required - - if(minval(rcond(:)) < 1d-15) n_diis = 0 + if(minval(rcond(:)) > 1d-7) then + do ispin=1,nspin + call DIIS_extrapolation(rcond(ispin),nBasSq,nBasSq,n_diis, & + err_diis(:,:,ispin),F_diis(:,:,ispin),err(:,:,ispin),F(:,:,ispin)) + end do + else + n_diis = 0 + end if ! Transform Fock matrix in orthogonal basis From 78b0f7abb92a5ce0119164365f7a37f7f08732c1 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Thu, 1 Apr 2021 22:54:23 +0200 Subject: [PATCH 52/63] fix bug in URPAx --- input/options | 2 +- src/RPA/URPAx.f90 | 2 +- src/RPA/unrestricted_ACFDT.f90 | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/input/options b/input/options index 651045a..ae16f8a 100644 --- a/input/options +++ b/input/options @@ -11,7 +11,7 @@ # GW/GT: maxSCF thresh DIIS n_diis lin eta COHSEX SOSEX TDA_W G0W GW0 256 0.0000001 T 5 T 0.0 F F F F F # ACFDT: AC Kx XBS - F T T + T T T # BSE: BSE dBSE dTDA evDyn F T T F # MCMP2: nMC nEq nWalk dt nPrint iSeed doDrift diff --git a/src/RPA/URPAx.f90 b/src/RPA/URPAx.f90 index 90f329c..ec52d87 100644 --- a/src/RPA/URPAx.f90 +++ b/src/RPA/URPAx.f90 @@ -122,7 +122,7 @@ subroutine URPAx(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,n if(exchange_kernel) then EcRPAx(1) = 0.5d0*EcRPAx(1) - EcRPAx(2) = 1.5d0*EcRPAx(2) + EcRPAx(2) = 0.5d0*EcRPAx(2) end if diff --git a/src/RPA/unrestricted_ACFDT.f90 b/src/RPA/unrestricted_ACFDT.f90 index ded29de..bdd9435 100644 --- a/src/RPA/unrestricted_ACFDT.f90 +++ b/src/RPA/unrestricted_ACFDT.f90 @@ -192,7 +192,7 @@ subroutine unrestricted_ACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,spin_cons EcAC(ispin) = 0.5d0*dot_product(wAC,Ec(:,ispin)) - if(exchange_kernel) EcAC(ispin) = 1.5d0*EcAC(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) From 4cd96d2aa47e36a442bf2a32c82cce1861291c02 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Fri, 2 Apr 2021 09:53:23 +0200 Subject: [PATCH 53/63] OK for RPA/RPAx/GW --- input/methods | 4 ++-- input/options | 4 ++-- src/MBPT/UG0W0.f90 | 6 +++++- src/MBPT/evUGW.f90 | 6 +++++- src/MBPT/qsUGW.f90 | 6 +++++- src/RPA/URPAx.f90 | 4 ++++ 6 files changed, 23 insertions(+), 7 deletions(-) diff --git a/input/methods b/input/methods index e7c0516..549430d 100644 --- a/input/methods +++ b/input/methods @@ -9,11 +9,11 @@ # CIS* CIS(D) CID CISD FCI F F F F F # RPA* RPAx* ppRPA - F T F + F F F # G0F2* evGF2* qsGF2* G0F3 evGF3 F 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 ae16f8a..2d89e1e 100644 --- a/input/options +++ b/input/options @@ -1,5 +1,5 @@ # HF: maxSCF thresh DIIS n_diis guess_type ortho_type mix_guess stability - 1024 0.00001 F 5 1 1 F F + 1024 0.00001 F 5 1 1 T F # MP: # CC: maxSCF thresh DIIS n_diis @@ -13,6 +13,6 @@ # ACFDT: AC Kx XBS T T T # BSE: BSE dBSE dTDA evDyn - F T T F + T T T F # MCMP2: nMC nEq nWalk dt nPrint iSeed doDrift 1000000 100000 10 0.3 10000 1234 T diff --git a/src/MBPT/UG0W0.f90 b/src/MBPT/UG0W0.f90 index 5fd0131..36e891b 100644 --- a/src/MBPT/UG0W0.f90 +++ b/src/MBPT/UG0W0.f90 @@ -194,8 +194,12 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev if(exchange_kernel) then EcBSE(1) = 0.5d0*EcBSE(1) - EcBSE(2) = 1.5d0*EcBSE(1) + EcBSE(2) = 0.5d0*EcBSE(2) + else + + EcBSE(2) = 0.0d0 + end if write(*,*) diff --git a/src/MBPT/evUGW.f90 b/src/MBPT/evUGW.f90 index 7af60b7..ece48d8 100644 --- a/src/MBPT/evUGW.f90 +++ b/src/MBPT/evUGW.f90 @@ -268,7 +268,11 @@ subroutine evUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,BSE if(exchange_kernel) then EcBSE(1) = 0.5d0*EcBSE(1) - EcBSE(2) = 1.5d0*EcBSE(2) + EcBSE(2) = 0.5d0*EcBSE(2) + + else + + EcBSE(2) = 0.0d0 end if diff --git a/src/MBPT/qsUGW.f90 b/src/MBPT/qsUGW.f90 index 7e7b051..ec24b26 100644 --- a/src/MBPT/qsUGW.f90 +++ b/src/MBPT/qsUGW.f90 @@ -393,7 +393,11 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOS if(exchange_kernel) then EcBSE(1) = 0.5d0*EcBSE(1) - EcBSE(2) = 1.5d0*EcBSE(2) + EcBSE(2) = 0.5d0*EcBSE(2) + + else + + EcBSE(2) = 0.0d0 end if diff --git a/src/RPA/URPAx.f90 b/src/RPA/URPAx.f90 index ec52d87..450e913 100644 --- a/src/RPA/URPAx.f90 +++ b/src/RPA/URPAx.f90 @@ -124,6 +124,10 @@ subroutine URPAx(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,eta,nBas,n EcRPAx(1) = 0.5d0*EcRPAx(1) EcRPAx(2) = 0.5d0*EcRPAx(2) + else + + EcRPAx(2) = 0d0 + end if write(*,*) From 5e6e95b8871d18a2e0d959487f0d6bb5a9459e23 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Wed, 19 May 2021 14:50:25 +0200 Subject: [PATCH 54/63] update before antoine mess --- input/dft | 2 +- input/methods | 8 ++++---- input/options | 6 +++--- mol/h2.xyz | 2 +- mol/water.xyz | 4 ++-- 5 files changed, 11 insertions(+), 11 deletions(-) diff --git a/input/dft b/input/dft index 9523149..8059451 100644 --- a/input/dft +++ b/input/dft @@ -28,7 +28,7 @@ 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 # Ensemble weights: wEns(1),...,wEns(nEns-1) - 0.1 0.0 + 0.5 0.0 # N-centered? F # Parameters for CC weight-dependent exchange functional diff --git a/input/methods b/input/methods index 549430d..71f9f1c 100644 --- a/input/methods +++ b/input/methods @@ -1,11 +1,11 @@ # RHF UHF KS MOM - F T F F + T F F F # MP2* MP3 MP2-F12 F F F # CCD DCD CCSD CCSD(T) - F F F F + T T T T # drCCD rCCD lCCD pCCD - F F F F + F F F T # CIS* CIS(D) CID CISD FCI F F F F F # RPA* RPAx* ppRPA @@ -13,7 +13,7 @@ # G0F2* evGF2* qsGF2* G0F3 evGF3 F 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 2d89e1e..7bf0757 100644 --- a/input/options +++ b/input/options @@ -5,14 +5,14 @@ # CC: maxSCF thresh DIIS n_diis 64 0.00001 T 5 # spin: TDA singlet triplet spin_conserved spin_flip - F T T T T + 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.0000001 T 5 T 0.0 F F F F F # ACFDT: AC Kx XBS - T T T + F T T # BSE: BSE dBSE dTDA evDyn - T T T F + F F T F # MCMP2: nMC nEq nWalk dt nPrint iSeed doDrift 1000000 100000 10 0.3 10000 1234 T diff --git a/mol/h2.xyz b/mol/h2.xyz index 6a4e902..82998e1 100644 --- a/mol/h2.xyz +++ b/mol/h2.xyz @@ -1,4 +1,4 @@ 2 H 0.0 0.0 0.0 -H 0.0 0.0 0.7 +H 0.0 0.0 100. diff --git a/mol/water.xyz b/mol/water.xyz index c768808..aca599c 100644 --- a/mol/water.xyz +++ b/mol/water.xyz @@ -1,5 +1,5 @@ 3 -Water,^1A_1,CC3,aug-cc-pVTZ + O 0.00000000 0.00000000 -0.06990256 H 0.00000000 0.75753241 0.51843495 -H 0.00000000 -0.75753241 0.51843495 \ No newline at end of file +H 0.00000000 -0.75753241 0.51843495 From 378bfd9356bf630d31a369e1ddedbada2c778624 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Wed, 19 May 2021 15:11:44 +0200 Subject: [PATCH 55/63] RMOM --- input/methods | 8 +- src/HF/MOM.f90 | 195 ----------------------------------------- src/HF/RMOM.f90 | 209 ++++++++++++++++++++++++++++++++++++++++++++ src/QuAcK/QuAcK.f90 | 14 ++- 4 files changed, 225 insertions(+), 201 deletions(-) delete mode 100644 src/HF/MOM.f90 create mode 100644 src/HF/RMOM.f90 diff --git a/input/methods b/input/methods index 71f9f1c..13ed09a 100644 --- a/input/methods +++ b/input/methods @@ -1,11 +1,11 @@ -# RHF UHF KS MOM - T F F F +# RHF UHF KS MOM + T F F T # MP2* MP3 MP2-F12 F F F # CCD DCD CCSD CCSD(T) - T T T T + F F F F # drCCD rCCD lCCD pCCD - F F F T + F F F F # CIS* CIS(D) CID CISD FCI F F F F F # RPA* RPAx* ppRPA diff --git a/src/HF/MOM.f90 b/src/HF/MOM.f90 deleted file mode 100644 index 3b720e4..0000000 --- a/src/HF/MOM.f90 +++ /dev/null @@ -1,195 +0,0 @@ -subroutine MOM(maxSCF,thresh,max_diis,nBas,nO,S,T,V,Hc,ERI,X,ENuc,ERHF,c,e,P) - -! Maximum overlap method - - implicit none - -! Input variables - - integer,intent(in) :: maxSCF,max_diis - double precision,intent(in) :: thresh - - integer,intent(in) :: nBas,nO - double precision,intent(in) :: ENuc - double precision,intent(in) :: S(nBas,nBas),T(nBas,nBas),V(nBas,nBas),Hc(nBas,nBas) - double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas),X(nBas,nBas) - -! Local variables - - integer :: iBas,jBas - integer :: nSCF,nBasSq,n_diis - double precision :: ET,EV,EJ,EK,Conv,Gap - double precision :: rcond - double precision,external :: trace_matrix - double precision,allocatable :: error(:,:),error_diis(:,:),F_diis(:,:) - double precision,allocatable :: J(:,:),K(:,:),cp(:,:),F(:,:),Fp(:,:) - double precision,allocatable :: cG(:,:),ON(:) - -! Output variables - - double precision,intent(inout):: ERHF,c(nBas,nBas),e(nBas),P(nBas,nBas) - -! Hello world - - write(*,*) - write(*,*)'************************************************' - write(*,*)'| Maximum overlap method |' - write(*,*)'************************************************' - write(*,*) - -! Useful quantities - - nBasSq = nBas*nBas - -! Memory allocation - - allocate(J(nBas,nBas),K(nBas,nBas),error(nBas,nBas), & - cp(nBas,nBas),Fp(nBas,nBas),F(nBas,nBas), & - cG(nBas,nBas),ON(nBas), & - error_diis(nBasSq,max_diis),F_diis(nBasSq,max_diis)) - -! Set up guess orbitals - - cG(:,:) = c(:,:) - -! Set up occupation numbers - - ON(1:nO) = 1d0 - ON(nO+1:nBas) = 0d0 - -! HOMO-LUMO transition - - ON(nO) = 0d0 - ON(nO+1) = 1d0 - - write(*,*) - write(*,*) ' --- Initial MO occupations --- ' - write(*,*) - call matout(nBas,1,ON) - write(*,*) - -! Compute density matrix - - call density_matrix(nBas,ON,c,P) - -! Initialization - - n_diis = 0 - F_diis(:,:) = 0d0 - error_diis(:,:) = 0d0 - Conv = 1d0 - nSCF = 0 - -!------------------------------------------------------------------------ -! Main SCF loop -!------------------------------------------------------------------------ - write(*,*) - write(*,*)'----------------------------------------------------' - write(*,*)'| MOM calculation |' - write(*,*)'----------------------------------------------------' - write(*,'(1X,A1,1X,A3,1X,A1,1X,A16,1X,A1,1X,A10,1X,A1,1X,A10,1X,A1,1X)') & - '|','#','|','HF energy','|','Conv','|','HL Gap','|' - write(*,*)'----------------------------------------------------' - - do while(Conv > thresh .and. nSCF < maxSCF) - -! Increment - - nSCF = nSCF + 1 - -! Build Fock matrix - - call Coulomb_matrix_AO_basis(nBas,P,ERI,J) - call exchange_matrix_AO_basis(nBas,P,ERI,K) - - F(:,:) = Hc(:,:) + J(:,:) + K(:,:) - -! Check convergence - - error = matmul(F,matmul(P,S)) - matmul(matmul(S,P),F) - Conv = maxval(abs(error)) - -! DIIS extrapolation - - n_diis = min(n_diis+1,max_diis) - call DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,error_diis,F_diis,error,F) - -! Reset DIIS if required - - if(abs(rcond) < 1d-15) n_diis = 0 - -! Diagonalize Fock matrix - - Fp = matmul(transpose(X),matmul(F,X)) - cp(:,:) = Fp(:,:) - call diagonalize_matrix(nBas,cp,e) - c = matmul(X,cp) - -! MOM overlap - - call MOM_overlap(nBas,nO,S,cG,c,ON) - -! Density matrix - - call density_matrix(nBas,ON,c,P) - -! Compute HF energy - - ERHF = trace_matrix(nBas,matmul(P,Hc)) & - + 0.5d0*trace_matrix(nBas,matmul(P,J)) & - + 0.5d0*trace_matrix(nBas,matmul(P,K)) - -! Compute HOMO-LUMO gap - - if(nBas > nO) then - - Gap = e(nO+1) - e(nO) - - else - - Gap = 0d0 - - endif - -! Dump results - - write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') & - '|',nSCF,'|',ERHF+ENuc,'|',Conv,'|',Gap,'|' - - enddo - write(*,*)'----------------------------------------------------' -!------------------------------------------------------------------------ -! End of SCF loop -!------------------------------------------------------------------------ - -! Did it actually converge? - - if(nSCF == maxSCF) then - - write(*,*) - write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' - write(*,*)' Convergence failed ' - write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' - write(*,*) - - stop - - endif - - write(*,*) - write(*,*) ' --- Final MO occupations --- ' - write(*,*) - call matout(nBas,1,ON) - write(*,*) - -! Compute HF energy - - ET = trace_matrix(nBas,matmul(P,T)) - EV = trace_matrix(nBas,matmul(P,V)) - EJ = 0.5d0*trace_matrix(nBas,matmul(P,J)) - EK = 0.5d0*trace_matrix(nBas,matmul(P,K)) - ERHF = ET + EV + EJ + EK - - call print_RHF(nBas,nO,e,c,ENuc,ET,EV,EJ,EK,ERHF) - -end subroutine MOM diff --git a/src/HF/RMOM.f90 b/src/HF/RMOM.f90 new file mode 100644 index 0000000..c086b36 --- /dev/null +++ b/src/HF/RMOM.f90 @@ -0,0 +1,209 @@ +subroutine RMOM(maxSCF,thresh,max_diis,guess_type,nNuc,ZNuc,rNuc,ENuc,nBas,nO,S,T,V,Hc,ERI,dipole_int,X,ERHF,e,c,P,Vx) + +! Perform restricted Hartree-Fock calculation with MOM algorithm + + implicit none + include 'parameters.h' + +! Input variables + + integer,intent(in) :: maxSCF,max_diis,guess_type + double precision,intent(in) :: thresh + + integer,intent(in) :: nBas + integer,intent(in) :: nO + integer,intent(in) :: nNuc + double precision,intent(in) :: ZNuc(nNuc) + double precision,intent(in) :: rNuc(nNuc,ncart) + double precision,intent(in) :: ENuc + double precision,intent(in) :: S(nBas,nBas) + double precision,intent(in) :: T(nBas,nBas) + double precision,intent(in) :: V(nBas,nBas) + double precision,intent(in) :: Hc(nBas,nBas) + double precision,intent(in) :: X(nBas,nBas) + double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas) + double precision,intent(in) :: dipole_int(nBas,nBas,ncart) + +! Local variables + + integer :: nSCF + integer :: nBasSq + integer :: n_diis + double precision :: ET + double precision :: EV + double precision :: EJ + double precision :: EK + double precision :: dipole(ncart) + + double precision :: Conv + double precision :: Gap + double precision :: rcond + double precision,external :: trace_matrix + double precision,allocatable :: error(:,:) + double precision,allocatable :: error_diis(:,:) + double precision,allocatable :: F_diis(:,:) + double precision,allocatable :: J(:,:) + double precision,allocatable :: K(:,:) + double precision,allocatable :: cp(:,:) + double precision,allocatable :: F(:,:) + double precision,allocatable :: Fp(:,:) + double precision,allocatable :: ON(:) + +! Output variables + + double precision,intent(out) :: ERHF + double precision,intent(out) :: e(nBas) + double precision,intent(out) :: c(nBas,nBas) + double precision,intent(out) :: P(nBas,nBas) + double precision,intent(out) :: Vx(nBas) + +! Hello world + + write(*,*) + write(*,*)'*********************************************' + write(*,*)'| Restricted Maximum Overlap Method |' + write(*,*)'*********************************************' + write(*,*) + +! Useful quantities + + nBasSq = nBas*nBas + +! Memory allocation + + allocate(J(nBas,nBas),K(nBas,nBas),error(nBas,nBas), & + cp(nBas,nBas),Fp(nBas,nBas),F(nBas,nBas),ON(nBas), & + error_diis(nBasSq,max_diis),F_diis(nBasSq,max_diis)) + +! Guess coefficients and eigenvalues + + call mo_guess(nBas,nO,guess_type,S,Hc,ERI,J,K,X,cp,F,Fp,e,c,P) + +! ON(:) = 0d0 +! do i=1,nO +! ON(i) = 1d0 +! ON(i) = dble(2*i-1) +! end do + +! call density_matrix(nBas,ON,c,P) + +! Initialization + + n_diis = 0 + F_diis(:,:) = 0d0 + error_diis(:,:) = 0d0 + Conv = 1d0 + nSCF = 0 + +!------------------------------------------------------------------------ +! Main SCF loop +!------------------------------------------------------------------------ + write(*,*) + write(*,*)'----------------------------------------------------' + write(*,*)'| RHF calculation |' + write(*,*)'----------------------------------------------------' + write(*,'(1X,A1,1X,A3,1X,A1,1X,A16,1X,A1,1X,A10,1X,A1,1X,A10,1X,A1,1X)') & + '|','#','|','HF energy','|','Conv','|','HL Gap','|' + write(*,*)'----------------------------------------------------' + + do while(Conv > thresh .and. nSCF < maxSCF) + +! Increment + + nSCF = nSCF + 1 + +! Build Fock matrix + + call Coulomb_matrix_AO_basis(nBas,P,ERI,J) + call exchange_matrix_AO_basis(nBas,P,ERI,K) + + F(:,:) = Hc(:,:) + J(:,:) + 0.5d0*K(:,:) + +! Check convergence + + error = matmul(F,matmul(P,S)) - matmul(matmul(S,P),F) + Conv = maxval(abs(error)) + +! DIIS extrapolation + + n_diis = min(n_diis+1,max_diis) + if(abs(rcond) > 1d-7) then + call DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,error_diis,F_diis,error,F) + else + n_diis = 0 + end if + +! Diagonalize Fock matrix + + Fp = matmul(transpose(X),matmul(F,X)) + cp(:,:) = Fp(:,:) + call diagonalize_matrix(nBas,cp,e) + c = matmul(X,cp) + +! Density matrix + + P(:,:) = 2d0*matmul(c(:,1:nO),transpose(c(:,1:nO))) + +! call density_matrix(nBas,ON,c,P) + +! Compute HF energy + + ERHF = trace_matrix(nBas,matmul(P,Hc)) & + + 0.5d0*trace_matrix(nBas,matmul(P,J)) & + + 0.25d0*trace_matrix(nBas,matmul(P,K)) + +! Compute HOMO-LUMO gap + + if(nBas > nO) then + + Gap = e(nO+1) - e(nO) + + else + + Gap = 0d0 + + endif + +! Dump results + + write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') & + '|',nSCF,'|',ERHF+ENuc,'|',Conv,'|',Gap,'|' + + enddo + write(*,*)'----------------------------------------------------' +!------------------------------------------------------------------------ +! End of SCF loop +!------------------------------------------------------------------------ + +! Did it actually converge? + + if(nSCF == maxSCF) then + + write(*,*) + write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + write(*,*)' Convergence failed ' + write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + write(*,*) + + stop + + endif + +! Compute HF energy + + ET = trace_matrix(nBas,matmul(P,T)) + EV = trace_matrix(nBas,matmul(P,V)) + EJ = 0.5d0*trace_matrix(nBas,matmul(P,J)) + EK = 0.25d0*trace_matrix(nBas,matmul(P,K)) + ERHF = ET + EV + EJ + EK + +! Compute dipole moments + + call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int,dipole) + call print_RHF(nBas,nO,e,C,ENuc,ET,EV,EJ,EK,ERHF,dipole) + +! Compute Vx for post-HF calculations + + call exchange_potential(nBas,c,K,Vx) + +end subroutine RMOM diff --git a/src/QuAcK/QuAcK.f90 b/src/QuAcK/QuAcK.f90 index 8bbff6e..5ed4a55 100644 --- a/src/QuAcK/QuAcK.f90 +++ b/src/QuAcK/QuAcK.f90 @@ -343,8 +343,18 @@ program QuAcK if(doMOM) then call cpu_time(start_MOM) - call MOM(maxSCF_HF,thresh_HF,n_diis_HF, & - nBas,nO,S,T,V,Hc,ERI_AO,X,ENuc,ERHF,cHF,eHF,PHF) + + if(unrestricted) then + +! call UMOM() + + else + + call RMOM(maxSCF_HF,thresh_HF,n_diis_HF,guess_type,nNuc,ZNuc,rNuc,ENuc, & + nBas,nO,S,T,V,Hc,ERI_AO,dipole_int_AO,X,ERHF,eHF,cHF,PHF,Vxc) + + end if + call cpu_time(end_MOM) t_MOM = end_MOM - start_MOM From e77365c593298d8e734bbf842c99850a357cb8bf Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Wed, 19 May 2021 15:15:31 +0200 Subject: [PATCH 56/63] MOM --- src/HF/MOM.f90 | 195 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 195 insertions(+) create mode 100644 src/HF/MOM.f90 diff --git a/src/HF/MOM.f90 b/src/HF/MOM.f90 new file mode 100644 index 0000000..3b720e4 --- /dev/null +++ b/src/HF/MOM.f90 @@ -0,0 +1,195 @@ +subroutine MOM(maxSCF,thresh,max_diis,nBas,nO,S,T,V,Hc,ERI,X,ENuc,ERHF,c,e,P) + +! Maximum overlap method + + implicit none + +! Input variables + + integer,intent(in) :: maxSCF,max_diis + double precision,intent(in) :: thresh + + integer,intent(in) :: nBas,nO + double precision,intent(in) :: ENuc + double precision,intent(in) :: S(nBas,nBas),T(nBas,nBas),V(nBas,nBas),Hc(nBas,nBas) + double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas),X(nBas,nBas) + +! Local variables + + integer :: iBas,jBas + integer :: nSCF,nBasSq,n_diis + double precision :: ET,EV,EJ,EK,Conv,Gap + double precision :: rcond + double precision,external :: trace_matrix + double precision,allocatable :: error(:,:),error_diis(:,:),F_diis(:,:) + double precision,allocatable :: J(:,:),K(:,:),cp(:,:),F(:,:),Fp(:,:) + double precision,allocatable :: cG(:,:),ON(:) + +! Output variables + + double precision,intent(inout):: ERHF,c(nBas,nBas),e(nBas),P(nBas,nBas) + +! Hello world + + write(*,*) + write(*,*)'************************************************' + write(*,*)'| Maximum overlap method |' + write(*,*)'************************************************' + write(*,*) + +! Useful quantities + + nBasSq = nBas*nBas + +! Memory allocation + + allocate(J(nBas,nBas),K(nBas,nBas),error(nBas,nBas), & + cp(nBas,nBas),Fp(nBas,nBas),F(nBas,nBas), & + cG(nBas,nBas),ON(nBas), & + error_diis(nBasSq,max_diis),F_diis(nBasSq,max_diis)) + +! Set up guess orbitals + + cG(:,:) = c(:,:) + +! Set up occupation numbers + + ON(1:nO) = 1d0 + ON(nO+1:nBas) = 0d0 + +! HOMO-LUMO transition + + ON(nO) = 0d0 + ON(nO+1) = 1d0 + + write(*,*) + write(*,*) ' --- Initial MO occupations --- ' + write(*,*) + call matout(nBas,1,ON) + write(*,*) + +! Compute density matrix + + call density_matrix(nBas,ON,c,P) + +! Initialization + + n_diis = 0 + F_diis(:,:) = 0d0 + error_diis(:,:) = 0d0 + Conv = 1d0 + nSCF = 0 + +!------------------------------------------------------------------------ +! Main SCF loop +!------------------------------------------------------------------------ + write(*,*) + write(*,*)'----------------------------------------------------' + write(*,*)'| MOM calculation |' + write(*,*)'----------------------------------------------------' + write(*,'(1X,A1,1X,A3,1X,A1,1X,A16,1X,A1,1X,A10,1X,A1,1X,A10,1X,A1,1X)') & + '|','#','|','HF energy','|','Conv','|','HL Gap','|' + write(*,*)'----------------------------------------------------' + + do while(Conv > thresh .and. nSCF < maxSCF) + +! Increment + + nSCF = nSCF + 1 + +! Build Fock matrix + + call Coulomb_matrix_AO_basis(nBas,P,ERI,J) + call exchange_matrix_AO_basis(nBas,P,ERI,K) + + F(:,:) = Hc(:,:) + J(:,:) + K(:,:) + +! Check convergence + + error = matmul(F,matmul(P,S)) - matmul(matmul(S,P),F) + Conv = maxval(abs(error)) + +! DIIS extrapolation + + n_diis = min(n_diis+1,max_diis) + call DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,error_diis,F_diis,error,F) + +! Reset DIIS if required + + if(abs(rcond) < 1d-15) n_diis = 0 + +! Diagonalize Fock matrix + + Fp = matmul(transpose(X),matmul(F,X)) + cp(:,:) = Fp(:,:) + call diagonalize_matrix(nBas,cp,e) + c = matmul(X,cp) + +! MOM overlap + + call MOM_overlap(nBas,nO,S,cG,c,ON) + +! Density matrix + + call density_matrix(nBas,ON,c,P) + +! Compute HF energy + + ERHF = trace_matrix(nBas,matmul(P,Hc)) & + + 0.5d0*trace_matrix(nBas,matmul(P,J)) & + + 0.5d0*trace_matrix(nBas,matmul(P,K)) + +! Compute HOMO-LUMO gap + + if(nBas > nO) then + + Gap = e(nO+1) - e(nO) + + else + + Gap = 0d0 + + endif + +! Dump results + + write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') & + '|',nSCF,'|',ERHF+ENuc,'|',Conv,'|',Gap,'|' + + enddo + write(*,*)'----------------------------------------------------' +!------------------------------------------------------------------------ +! End of SCF loop +!------------------------------------------------------------------------ + +! Did it actually converge? + + if(nSCF == maxSCF) then + + write(*,*) + write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + write(*,*)' Convergence failed ' + write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + write(*,*) + + stop + + endif + + write(*,*) + write(*,*) ' --- Final MO occupations --- ' + write(*,*) + call matout(nBas,1,ON) + write(*,*) + +! Compute HF energy + + ET = trace_matrix(nBas,matmul(P,T)) + EV = trace_matrix(nBas,matmul(P,V)) + EJ = 0.5d0*trace_matrix(nBas,matmul(P,J)) + EK = 0.5d0*trace_matrix(nBas,matmul(P,K)) + ERHF = ET + EV + EJ + EK + + call print_RHF(nBas,nO,e,c,ENuc,ET,EV,EJ,EK,ERHF) + +end subroutine MOM From 9eca749bce4e05b5b7b85b8b3a2607522cf9ab38 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Fri, 25 Jun 2021 10:19:42 +0200 Subject: [PATCH 57/63] qsGW --- input/methods | 4 ++-- input/options | 6 +++--- mol/ethylene.xyz | 4 ++-- mol/h2.xyz | 2 +- src/GF/qsGF2.f90 | 9 +++++---- src/GF/qsUGF2.f90 | 1 + src/MBPT/qsGW.f90 | 9 +++++---- src/MBPT/qsUGW.f90 | 1 + src/utils/wrap_lapack.f90 | 2 +- 9 files changed, 21 insertions(+), 17 deletions(-) diff --git a/input/methods b/input/methods index 13ed09a..6bac133 100644 --- a/input/methods +++ b/input/methods @@ -1,5 +1,5 @@ # RHF UHF KS MOM - T F F T + T F F F # MP2* MP3 MP2-F12 F F F # CCD DCD CCSD CCSD(T) @@ -13,7 +13,7 @@ # G0F2* evGF2* qsGF2* G0F3 evGF3 F 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 7bf0757..b6d75f6 100644 --- a/input/options +++ b/input/options @@ -5,14 +5,14 @@ # CC: maxSCF thresh DIIS n_diis 64 0.00001 T 5 # spin: TDA singlet triplet spin_conserved spin_flip - T T T T T + F 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.0000001 T 5 T 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 T T # BSE: BSE dBSE dTDA evDyn - F F 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/mol/ethylene.xyz b/mol/ethylene.xyz index aab62c8..aeb24b4 100644 --- a/mol/ethylene.xyz +++ b/mol/ethylene.xyz @@ -1,8 +1,8 @@ 6 -Ethylene,^1A_g,CC3,aug-cc-pVTZ + C 0.00000000 0.66690396 0.00000000 C 0.00000000 -0.66690396 0.00000000 H 0.00000000 1.22952195 0.92229064 H 0.00000000 -1.22952195 0.92229064 H 0.00000000 1.22952195 -0.92229064 -H 0.00000000 -1.22952195 -0.92229064 \ No newline at end of file +H 0.00000000 -1.22952195 -0.92229064 diff --git a/mol/h2.xyz b/mol/h2.xyz index 82998e1..4185b54 100644 --- a/mol/h2.xyz +++ b/mol/h2.xyz @@ -1,4 +1,4 @@ 2 H 0.0 0.0 0.0 -H 0.0 0.0 100. +H 0.0 0.0 0.740848 diff --git a/src/GF/qsGF2.f90 b/src/GF/qsGF2.f90 index b4b385b..db8e50d 100644 --- a/src/GF/qsGF2.f90 +++ b/src/GF/qsGF2.f90 @@ -118,6 +118,7 @@ subroutine qsGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet, c(:,:) = cHF(:,:) F_diis(:,:) = 0d0 error_diis(:,:) = 0d0 + rcond = 1d0 !------------------------------------------------------------------------ ! Main loop @@ -177,15 +178,15 @@ subroutine qsGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,singlet,triplet, c = matmul(X,cp) SigCp = matmul(transpose(c),matmul(SigCp,c)) + ! Compute new density matrix in the AO basis + + P(:,:) = 2d0*matmul(c(:,1:nO),transpose(c(:,1:nO))) + ! Save quasiparticles energy for next cycle Conv = maxval(abs(eGF2 - eOld)) eOld(:) = eGF2(:) - ! Compute new density matrix in the AO basis - - P(:,:) = 2d0*matmul(c(:,1:nO),transpose(c(:,1:nO))) - !------------------------------------------------------------------------ ! Compute total energy !------------------------------------------------------------------------ diff --git a/src/GF/qsUGF2.f90 b/src/GF/qsUGF2.f90 index 9c05f6a..3295f6f 100644 --- a/src/GF/qsUGF2.f90 +++ b/src/GF/qsUGF2.f90 @@ -134,6 +134,7 @@ subroutine qsUGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,spin_conserved, c(:,:,:) = cHF(:,:,:) F_diis(:,:,:) = 0d0 error_diis(:,:,:) = 0d0 + rcond = 1d0 !------------------------------------------------------------------------ ! Main loop diff --git a/src/MBPT/qsGW.f90 b/src/MBPT/qsGW.f90 index 5d54f93..60f2d09 100644 --- a/src/MBPT/qsGW.f90 +++ b/src/MBPT/qsGW.f90 @@ -155,6 +155,7 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE c(:,:) = cHF(:,:) F_diis(:,:) = 0d0 error_diis(:,:) = 0d0 + rcond = 1d0 !------------------------------------------------------------------------ ! Main loop @@ -236,15 +237,15 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOSE c = matmul(X,cp) SigCp = matmul(transpose(c),matmul(SigCp,c)) + ! Compute new density matrix in the AO basis + + P(:,:) = 2d0*matmul(c(:,1:nO),transpose(c(:,1:nO))) + ! Save quasiparticles energy for next cycle Conv = maxval(abs(eGW - eOld)) eOld(:) = eGW(:) - ! Compute new density matrix in the AO basis - - P(:,:) = 2d0*matmul(c(:,1:nO),transpose(c(:,1:nO))) - !------------------------------------------------------------------------ ! Compute total energy !------------------------------------------------------------------------ diff --git a/src/MBPT/qsUGW.f90 b/src/MBPT/qsUGW.f90 index ec24b26..0718811 100644 --- a/src/MBPT/qsUGW.f90 +++ b/src/MBPT/qsUGW.f90 @@ -173,6 +173,7 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,COHSEX,SOS c(:,:,:) = cHF(:,:,:) F_diis(:,:,:) = 0d0 error_diis(:,:,:) = 0d0 + rcond = 1d0 !------------------------------------------------------------------------ ! Main loop diff --git a/src/utils/wrap_lapack.f90 b/src/utils/wrap_lapack.f90 index 2a38dfa..54d6cd0 100644 --- a/src/utils/wrap_lapack.f90 +++ b/src/utils/wrap_lapack.f90 @@ -153,7 +153,7 @@ subroutine linear_solve(N,A,b,x,rcond) implicit none integer,intent(in) :: N - double precision,intent(in) :: A(N,N),b(N),rcond + double precision,intent(out) :: A(N,N),b(N),rcond double precision,intent(out) :: x(N) integer :: info,lwork From 3349b92e551b72338ffd3baab18cc0653e7901a2 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Tue, 6 Jul 2021 11:57:13 +0200 Subject: [PATCH 58/63] add G0T0 --- src/{GF => MBPT}/G0T0.f90 | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename src/{GF => MBPT}/G0T0.f90 (100%) diff --git a/src/GF/G0T0.f90 b/src/MBPT/G0T0.f90 similarity index 100% rename from src/GF/G0T0.f90 rename to src/MBPT/G0T0.f90 From ab45790280035116a3e7f614d90872087250623e Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Thu, 9 Sep 2021 15:10:19 +0200 Subject: [PATCH 59/63] correcting printing error in G0W0 --- input/options | 4 ++-- mol/h2.xyz | 2 +- src/MBPT/G0W0.f90 | 14 +++++++------- src/MBPT/UG0W0.f90 | 6 +++--- 4 files changed, 13 insertions(+), 13 deletions(-) diff --git a/input/options b/input/options index b6d75f6..6502323 100644 --- a/input/options +++ b/input/options @@ -1,5 +1,5 @@ # HF: maxSCF thresh DIIS n_diis guess_type ortho_type mix_guess stability - 1024 0.00001 F 5 1 1 T F + 1024 0.0000001 F 5 1 1 T F # MP: # CC: maxSCF thresh DIIS n_diis @@ -11,7 +11,7 @@ # 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 # ACFDT: AC Kx XBS - F T T + T F T # BSE: BSE dBSE dTDA evDyn T F T F # MCMP2: nMC nEq nWalk dt nPrint iSeed doDrift diff --git a/mol/h2.xyz b/mol/h2.xyz index 4185b54..f3733c8 100644 --- a/mol/h2.xyz +++ b/mol/h2.xyz @@ -1,4 +1,4 @@ 2 H 0.0 0.0 0.0 -H 0.0 0.0 0.740848 +H 0.0 0.0 10.0 diff --git a/src/MBPT/G0W0.f90 b/src/MBPT/G0W0.f90 index d2c7fa7..8b0c01a 100644 --- a/src/MBPT/G0W0.f90 +++ b/src/MBPT/G0W0.f90 @@ -208,9 +208,9 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & if(doACFDT) then - write(*,*) '--------------------------------------------------------------' - write(*,*) ' Adiabatic connection version of BSE@UG0W0 correlation energy ' - write(*,*) '--------------------------------------------------------------' + write(*,*) '-------------------------------------------------------------' + write(*,*) ' Adiabatic connection version of BSE@G0W0 correlation energy ' + write(*,*) '-------------------------------------------------------------' write(*,*) if(doXBS) then @@ -224,10 +224,10 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,COHSEX,SOSEX,BSE,TDA_W,TDA, & write(*,*) write(*,*)'-------------------------------------------------------------------------------' - write(*,'(2X,A50,F20.10)') 'AC@BSE@UG0W0 correlation energy (singlet) =',EcAC(1) - write(*,'(2X,A50,F20.10)') 'AC@BSE@UG0W0 correlation energy (triplet) =',EcAC(2) - write(*,'(2X,A50,F20.10)') 'AC@BSE@UG0W0 correlation energy =',EcAC(1) + EcAC(2) - write(*,'(2X,A50,F20.10)') 'AC@BSE@UG0W0 total energy =',ENuc + ERHF + EcAC(1) + EcAC(2) + write(*,'(2X,A50,F20.10)') 'AC@BSE@G0W0 correlation energy (singlet) =',EcAC(1) + write(*,'(2X,A50,F20.10)') 'AC@BSE@G0W0 correlation energy (triplet) =',EcAC(2) + write(*,'(2X,A50,F20.10)') 'AC@BSE@G0W0 correlation energy =',EcAC(1) + EcAC(2) + write(*,'(2X,A50,F20.10)') 'AC@BSE@G0W0 total energy =',ENuc + ERHF + EcAC(1) + EcAC(2) write(*,*)'-------------------------------------------------------------------------------' write(*,*) diff --git a/src/MBPT/UG0W0.f90 b/src/MBPT/UG0W0.f90 index 36e891b..90d4ab1 100644 --- a/src/MBPT/UG0W0.f90 +++ b/src/MBPT/UG0W0.f90 @@ -215,9 +215,9 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,COHSEX,BSE,TDA_W,TDA,dBSE,dTDA,ev if(doACFDT) then - write(*,*) '------------------------------------------------------' - write(*,*) 'Adiabatic connection version of BSE correlation energy' - write(*,*) '------------------------------------------------------' + write(*,*) '------------------------------------------------------------' + write(*,*) 'Adiabatic connection version of BSE@UG0W0 correlation energy' + write(*,*) '------------------------------------------------------------' write(*,*) if(doXBS) then From 35f1ba916b82a6211b41eba6e92c49ad40a4d116 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Mon, 27 Sep 2021 15:57:26 +0200 Subject: [PATCH 60/63] fix bug in evGT --- input/options | 4 ++-- mol/h2.xyz | 2 +- src/LR/linear_response.f90 | 4 ++-- src/MBPT/Bethe_Salpeter_A_matrix.f90 | 1 + src/MBPT/Bethe_Salpeter_B_matrix.f90 | 1 + src/MBPT/evGT.f90 | 4 ++-- src/RPA/ACFDT.f90 | 1 + 7 files changed, 10 insertions(+), 7 deletions(-) diff --git a/input/options b/input/options index 6502323..a4e9cf1 100644 --- a/input/options +++ b/input/options @@ -5,11 +5,11 @@ # CC: maxSCF thresh DIIS n_diis 64 0.00001 T 5 # spin: TDA singlet triplet spin_conserved spin_flip - F T T T T + 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 T 0.0 F F T F F # ACFDT: AC Kx XBS T F T # BSE: BSE dBSE dTDA evDyn diff --git a/mol/h2.xyz b/mol/h2.xyz index f3733c8..6a4e902 100644 --- a/mol/h2.xyz +++ b/mol/h2.xyz @@ -1,4 +1,4 @@ 2 H 0.0 0.0 0.0 -H 0.0 0.0 10.0 +H 0.0 0.0 0.7 diff --git a/src/LR/linear_response.f90 b/src/LR/linear_response.f90 index e2a65fc..831be12 100644 --- a/src/LR/linear_response.f90 +++ b/src/LR/linear_response.f90 @@ -95,10 +95,10 @@ subroutine linear_response(ispin,dRPA,TDA,BSE,eta,nBas,nC,nO,nV,nR,nS,lambda,e,E XpY = matmul(transpose(Z),AmBSq) call DA(nS,1d0/sqrt(Omega),XpY) - + XmY = matmul(transpose(Z),AmBIv) call DA(nS,1d0*sqrt(Omega),XmY) - + end if ! Compute the RPA correlation energy diff --git a/src/MBPT/Bethe_Salpeter_A_matrix.f90 b/src/MBPT/Bethe_Salpeter_A_matrix.f90 index 82f968d..28dc945 100644 --- a/src/MBPT/Bethe_Salpeter_A_matrix.f90 +++ b/src/MBPT/Bethe_Salpeter_A_matrix.f90 @@ -36,6 +36,7 @@ subroutine Bethe_Salpeter_A_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 + lambda*rho(i,j,kc)*rho(a,b,kc)*Omega(kc)/eps chi = chi + rho(i,j,kc)*rho(a,b,kc)*Omega(kc)/eps enddo diff --git a/src/MBPT/Bethe_Salpeter_B_matrix.f90 b/src/MBPT/Bethe_Salpeter_B_matrix.f90 index 7e000ee..97f60d5 100644 --- a/src/MBPT/Bethe_Salpeter_B_matrix.f90 +++ b/src/MBPT/Bethe_Salpeter_B_matrix.f90 @@ -36,6 +36,7 @@ subroutine Bethe_Salpeter_B_matrix(eta,nBas,nC,nO,nV,nR,nS,lambda,ERI,OmRPA,rho_ chi = 0d0 do kc=1,nS eps = OmRPA(kc)**2 + eta**2 +! chi = chi + lambda*rho_RPA(i,b,kc)*rho_RPA(a,j,kc)*OmRPA(kc)/eps chi = chi + rho_RPA(i,b,kc)*rho_RPA(a,j,kc)*OmRPA(kc)/eps enddo diff --git a/src/MBPT/evGT.f90 b/src/MBPT/evGT.f90 index 95a0e0d..814db63 100644 --- a/src/MBPT/evGT.f90 +++ b/src/MBPT/evGT.f90 @@ -140,7 +140,7 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, & ! Compute linear response - call linear_response_pp(iblock,.true.,.false.,nBas,nC,nO,nV,nR,nOOs,nVVs,eHF(:),ERI_MO(:,:,:,:), & + call linear_response_pp(iblock,.true.,.false.,nBas,nC,nO,nV,nR,nOOs,nVVs,eGT(:),ERI_MO(:,:,:,:), & Omega1s(:),X1s(:,:),Y1s(:,:),Omega2s(:),X2s(:,:),Y2s(:,:),EcRPA(ispin)) ! EcRPA(ispin) = 1d0*EcRPA(ispin) @@ -157,7 +157,7 @@ subroutine evGT(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS, & ! Compute linear response - call linear_response_pp(iblock,.true.,.false.,nBas,nC,nO,nV,nR,nOOt,nVVt,eHF(:),ERI_MO(:,:,:,:), & + call linear_response_pp(iblock,.true.,.false.,nBas,nC,nO,nV,nR,nOOt,nVVt,eGT(:),ERI_MO(:,:,:,:), & Omega1t(:),X1t(:,:),Y1t(:,:),Omega2t(:),X2t(:,:),Y2t(:,:),EcRPA(ispin)) ! EcRPA(ispin) = 2d0*EcRPA(ispin) diff --git a/src/RPA/ACFDT.f90 b/src/RPA/ACFDT.f90 index b3f52bc..24d9de0 100644 --- a/src/RPA/ACFDT.f90 +++ b/src/RPA/ACFDT.f90 @@ -97,6 +97,7 @@ subroutine ACFDT(exchange_kernel,doXBS,dRPA,TDA_W,TDA,BSE,singlet,triplet,eta,nB call linear_response(isp_W,.true.,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) +! call print_excitation('W^lambda: ',isp_W,nS,OmRPA) end if From 19c8e44739e3b35901d35475ea898fdde2d749fd Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Mon, 4 Oct 2021 16:41:09 +0200 Subject: [PATCH 61/63] fix bug in UG0F2 and evUGF2 --- input/methods | 4 ++-- input/options | 4 ++-- src/GF/UG0F2.f90 | 2 +- src/GF/evUGF2.f90 | 2 +- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/input/methods b/input/methods index 6bac133..817f4f1 100644 --- a/input/methods +++ b/input/methods @@ -3,7 +3,7 @@ # MP2* MP3 MP2-F12 F F F # CCD DCD CCSD CCSD(T) - F F F F + F F T F # drCCD rCCD lCCD pCCD F F F F # CIS* CIS(D) CID CISD FCI @@ -13,7 +13,7 @@ # G0F2* evGF2* qsGF2* G0F3 evGF3 F 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 a4e9cf1..4282258 100644 --- a/input/options +++ b/input/options @@ -1,9 +1,9 @@ # HF: maxSCF thresh DIIS n_diis guess_type ortho_type mix_guess stability - 1024 0.0000001 F 5 1 1 T F + 1024 0.000000001 F 5 1 1 T F # MP: # CC: maxSCF thresh DIIS n_diis - 64 0.00001 T 5 + 64 0.0000000001 T 5 # spin: TDA singlet triplet spin_conserved spin_flip T T T T T # GF: maxSCF thresh DIIS n_diis lin eta renorm diff --git a/src/GF/UG0F2.f90 b/src/GF/UG0F2.f90 index 8f64d4e..e39ab8c 100644 --- a/src/GF/UG0F2.f90 +++ b/src/GF/UG0F2.f90 @@ -105,7 +105,7 @@ subroutine UG0F2(BSE,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,linearize,eta, ! Compute MP2 correlation energy - call UMP2(nBas,nC,nO,nV,nR,ERI_aaaa,ERI_aabb,ERI_bbbb,ENuc,EUHF,eHF,Ec) + call UMP2(nBas,nC,nO,nV,nR,ERI_aaaa,ERI_aabb,ERI_bbbb,ENuc,EUHF,eGF2,Ec) ! Dump results diff --git a/src/GF/evUGF2.f90 b/src/GF/evUGF2.f90 index 5072adb..5f4d0f3 100644 --- a/src/GF/evUGF2.f90 +++ b/src/GF/evUGF2.f90 @@ -126,7 +126,7 @@ subroutine evUGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,evDyn,spin_conserved, ! Compute MP2 correlation energy - call UMP2(nBas,nC,nO,nV,nR,ERI_aaaa,ERI_aabb,ERI_bbbb,ENuc,EUHF,eHF,Ec) + call UMP2(nBas,nC,nO,nV,nR,ERI_aaaa,ERI_aabb,ERI_bbbb,ENuc,EUHF,eGF2,Ec) ! Print results From b24950b706e621d2b8352202f670f82f3c0878b9 Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Fri, 8 Oct 2021 15:18:21 +0200 Subject: [PATCH 62/63] bug in UG0F2 --- input/dft | 12 ++++++------ input/methods | 4 ++-- input/options | 2 +- src/GF/UG0F2.f90 | 2 +- 4 files changed, 10 insertions(+), 10 deletions(-) diff --git a/input/dft b/input/dft index 8059451..0b96007 100644 --- a/input/dft +++ b/input/dft @@ -5,30 +5,30 @@ # LDA = 1: S51,CC-S51 # GGA = 2: B88,G96,PBE # MGGA = 3: -# Hybrid = 4: HF,B3,PBE - 4 HF +# Hybrid = 4: HF,B3LYP,PBE + 1 S51 # correlation rung: # Hartree = 0: H # LDA = 1: PW92,VWN3,VWN5,eVWN5 # GGA = 2: LYP,PBE # MGGA = 3: -# Hybrid = 4: HF,LYP,PBE +# Hybrid = 4: HF,B3LYP,PBE 0 H # quadrature grid SG-n 1 # Number of states in ensemble (nEns) 2 # occupation numbers + 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 - 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 # Ensemble weights: wEns(1),...,wEns(nEns-1) - 0.5 0.0 + 0.0 0.0 # N-centered? F # Parameters for CC weight-dependent exchange functional diff --git a/input/methods b/input/methods index 817f4f1..444f417 100644 --- a/input/methods +++ b/input/methods @@ -1,9 +1,9 @@ # RHF UHF KS MOM - T F F F + F F T F # MP2* MP3 MP2-F12 F F F # CCD DCD CCSD CCSD(T) - F F T F + F F F F # drCCD rCCD lCCD pCCD F F F F # CIS* CIS(D) CID CISD FCI diff --git a/input/options b/input/options index 4282258..11c2122 100644 --- a/input/options +++ b/input/options @@ -1,5 +1,5 @@ # HF: maxSCF thresh DIIS n_diis guess_type ortho_type mix_guess stability - 1024 0.000000001 F 5 1 1 T F + 1024 0.000000001 T 5 1 1 F F # MP: # CC: maxSCF thresh DIIS n_diis diff --git a/src/GF/UG0F2.f90 b/src/GF/UG0F2.f90 index e39ab8c..0389f93 100644 --- a/src/GF/UG0F2.f90 +++ b/src/GF/UG0F2.f90 @@ -79,7 +79,7 @@ subroutine UG0F2(BSE,TDA,dBSE,dTDA,evDyn,spin_conserved,spin_flip,linearize,eta, ! Compute self-energy ! !---------------------! - call unrestricted_self_energy_GF2_diag(nBas,nC,nO,nV,nR,eta,ERI_aaaa,ERI_aabb,ERI_bbbb,eHF,eGF2,SigC,Z) + call unrestricted_self_energy_GF2_diag(nBas,nC,nO,nV,nR,eta,ERI_aaaa,ERI_aabb,ERI_bbbb,eHF,eHF,SigC,Z) !-----------------------------------! ! Solve the quasi-particle equation ! From ba0e0c173193210f78d1d1622fc2eacca2f264dc Mon Sep 17 00:00:00 2001 From: Pierre-Francois Loos Date: Tue, 12 Oct 2021 14:40:40 +0200 Subject: [PATCH 63/63] ispinloop --- input/dft | 4 ++-- input/options | 2 +- src/eDFT/unrestricted_individual_energy.f90 | 4 +++- 3 files changed, 6 insertions(+), 4 deletions(-) diff --git a/input/dft b/input/dft index 0b96007..f123932 100644 --- a/input/dft +++ b/input/dft @@ -17,10 +17,10 @@ # quadrature grid SG-n 1 # Number of states in ensemble (nEns) - 2 + 1 # occupation numbers - 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 diff --git a/input/options b/input/options index 11c2122..6b70026 100644 --- a/input/options +++ b/input/options @@ -1,5 +1,5 @@ # HF: maxSCF thresh DIIS n_diis guess_type ortho_type mix_guess stability - 1024 0.000000001 T 5 1 1 F F + 1024 0.00001 F 5 1 1 F F # MP: # CC: maxSCF thresh DIIS n_diis diff --git a/src/eDFT/unrestricted_individual_energy.f90 b/src/eDFT/unrestricted_individual_energy.f90 index d5ea7f1..f397140 100644 --- a/src/eDFT/unrestricted_individual_energy.f90 +++ b/src/eDFT/unrestricted_individual_energy.f90 @@ -84,7 +84,9 @@ subroutine unrestricted_individual_energy(x_rung,x_DFA,c_rung,c_DFA,LDA_centered nEl(:) = 0d0 do iEns=1,nEns do iBas=1,nBas - nEl(iEns) = nEl(iEns) + occnum(iBas,1,iEns) + occnum(iBas,2,iEns) + do ispin=1,nspin + nEl(iEns) = nEl(iEns) + occnum(iBas,ispin,iEns) + end do end do kappa(iEns) = nEl(iEns)/nEl(1) end do