LCPQ
/
quack
mirror of https://github.com/pfloos/quack
4
1
Fork 0
Code Releases Activity

Merge pull request #4 from pfloos/master 

PR
This commit is contained in:
AbdAmmar 2023-11-16 12:50:42 +01:00 committed by GitHub
parent 4300a2481c 1c422cdb19
commit 8f6243e34e
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
106 changed files with 2985 additions and 798 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
input/methods → input/methods.default
View File

@ -1,7 +1,7 @@
# RHF UHF GHF ROHF
T T T T
F F F F
# MP2 MP3
T T
F F
# CCD pCCD DCD CCSD CCSD(T)
F F F F F
# drCCD rCCD crCCD lCCD
@ -9,7 +9,7 @@
# CIS CIS(D) CID CISD FCI
F F F F F
# phRPA phRPAx crRPA ppRPA
T T F T
F F F F
# G0F2 evGF2 qsGF2 G0F3 evGF3
F F F F F
# G0W0 evGW qsGW SRG-qsGW ufG0W0 ufGW
@ -17,4 +17,4 @@
# G0T0pp evGTpp qsGTpp G0T0eh evGTeh qsGTeh
F F F F F F
# Rtest Utest Gtest
T T T
F F F

18
input/options
View File

@ -1,18 +0,0 @@
# HF: maxSCF thresh DIIS guess mix shift stab search
10000 0.0000001 5 1 0.0 0.0 F F
# MP: reg
F
# CC: maxSCF thresh DIIS
64 0.0000001 5
# spin: TDA spin_conserved spin_flip
F T T
# GF: maxSCF thresh DIIS lin eta renorm reg
256 0.00001 5 F 0.0 0 F
# GW: maxSCF thresh DIIS lin eta TDA_W reg
10 0.00001 5 F 0.0 F F
# GT: maxSCF thresh DIIS lin eta TDA_T reg
256 0.00001 5 F 0.0 F F
# ACFDT: AC Kx XBS
F F T
# BSE: phBSE phBSE2 ppBSE dBSE dTDA
F F F F T

18
input/options.default Normal file
View File

@ -0,0 +1,18 @@
# HF: maxSCF thresh DIIS guess mix shift stab search
256 0.00001 5 1 0.0 0.0 F F
# MP: reg
F
# CC: maxSCF thresh DIIS
64 0.00001 5
# spin: TDA singlet triplet
F T T
# GF: maxSCF thresh DIIS lin eta renorm reg
256 0.00001 5 F 0.0 0 F
# GW: maxSCF thresh DIIS lin eta TDA_W reg
256 0.00001 5 F 0.0 F F
# GT: maxSCF thresh DIIS lin eta TDA_T reg
256 0.00001 5 F 0.0 F F
# ACFDT: AC Kx XBS
F F T
# BSE: phBSE phBSE2 ppBSE dBSE dTDA
F F F F T

24
src/CC/CCD.f90
View File

@ -1,4 +1,4 @@
subroutine CCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,eHF)
subroutine CCD(dotest,maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,eHF)
! CCD module
@ -6,6 +6,8 @@ subroutine CCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,e
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
@ -29,7 +31,7 @@ subroutine CCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,e
integer :: nSCF
double precision :: Conv
double precision :: EcMP2,EcMP3,EcMP4
double precision :: ECCD,EcCCD
double precision :: ECC,EcCC
double precision,allocatable :: seHF(:)
double precision,allocatable :: sERI(:,:,:,:)
double precision,allocatable :: dbERI(:,:,:,:)
@ -191,13 +193,13 @@ subroutine CCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,e
! Compute correlation energy
call CCD_correlation_energy(nC,nO,nV,nR,OOVV,t,EcCCD)
call CCD_correlation_energy(nC,nO,nV,nR,OOVV,t,EcCC)
if(nSCF == 1) call MP3_correlation_energy(nC,nO,nV,nR,OOVV,t,v,delta_OOVV,EcMP3)
! Dump results
ECCD = ERHF + EcCCD
ECC = ERHF + EcCC
! DIIS extrapolation
@ -209,7 +211,7 @@ subroutine CCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,e
if(abs(rcond) < 1d-15) n_diis = 0
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
'|',nSCF,'|',ECCD+ENuc,'|',EcCCD,'|',Conv,'|'
'|',nSCF,'|',ECC+ENuc,'|',EcCC,'|',Conv,'|'
enddo
write(*,*)'----------------------------------------------------'
@ -235,8 +237,8 @@ subroutine CCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,e
write(*,*)'----------------------------------------------------'
write(*,*)' CCD energy '
write(*,*)'----------------------------------------------------'
write(*,'(1X,A30,1X,F15.10)')' E(CCD) = ',ECCD
write(*,'(1X,A30,1X,F15.10)')' Ec(CCD) = ',EcCCD
write(*,'(1X,A30,1X,F15.10)')' E(CCD) = ',ECC
write(*,'(1X,A30,1X,F15.10)')' Ec(CCD) = ',EcCC
write(*,*)'----------------------------------------------------'
write(*,*)
@ -272,4 +274,12 @@ subroutine CCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,e
if(do_DIP_EOM_CC_2h) call DIP_EOM_CCD_2h(nC,nO,nV,nR,eO,OOVV,OOOO,t)
! Testing zone
if(dotest) then
call dump_test_value('R','CCD correlation energy',EcCC)
end if
end subroutine

12
src/CC/CCSD.f90
View File

@ -1,4 +1,4 @@
subroutine CCSD(maxSCF,thresh,max_diis,doCCSDT,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,eHF)
subroutine CCSD(dotest,maxSCF,thresh,max_diis,doCCSDT,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,eHF)
! CCSD module
@ -6,6 +6,8 @@ subroutine CCSD(maxSCF,thresh,max_diis,doCCSDT,nBasin,nCin,nOin,nVin,nRin,ERI,EN
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
@ -302,4 +304,12 @@ subroutine CCSD(maxSCF,thresh,max_diis,doCCSDT,nBasin,nCin,nOin,nVin,nRin,ERI,EN
end if
! Testing zone
if(dotest) then
call dump_test_value('R','CCSD correlation energy',EcCCSD)
end if
end subroutine

22
src/CC/DCD.f90
View File

@ -1,4 +1,4 @@
subroutine DCD(maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
subroutine DCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
! DCD module
@ -6,6 +6,8 @@ subroutine DCD(maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
@ -24,7 +26,7 @@ subroutine DCD(maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
integer :: nSCF
double precision :: Conv
double precision :: EcMP2,EcMP3,EcMP4
double precision :: EDCD,EcDCD
double precision :: ECC,EcCC
double precision,allocatable :: eO(:)
double precision,allocatable :: eV(:)
@ -123,13 +125,13 @@ subroutine DCD(maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
! Compute correlation energy
EcDCD = 0d0
EcCC = 0d0
do i=1,nO-nC
do j=1,nO-nC
do a=1,nV-nR
do b=1,nV-nR
EcDCD = EcDCD + (2d0*OOVV(i,j,a,b) - OOVV(i,j,b,a))*t(i,j,a,b)
EcCC = EcCC + (2d0*OOVV(i,j,a,b) - OOVV(i,j,b,a))*t(i,j,a,b)
enddo
enddo
@ -138,10 +140,10 @@ subroutine DCD(maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
! Dump results
EDCD = ERHF + EcDCD
ECC = ERHF + EcCC
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
'|',nSCF,'|',EDCD+ENuc,'|',EcDCD,'|',Conv,'|'
'|',nSCF,'|',ECC+ENuc,'|',EcCC,'|',Conv,'|'
! Increment
@ -280,4 +282,12 @@ subroutine DCD(maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
endif
! Testing zone
if(dotest) then
call dump_test_value('R','DCD correlation energy',EcCC)
end if
end subroutine

172
src/CC/GCC.f90 Normal file
View File

@ -0,0 +1,172 @@
subroutine GCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,dolCCD, &
maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,EGHF,eHF)
! Generalized Coupled-cluster module
implicit none
include 'parameters.h'
! Input variables
logical :: dotest
logical :: doCCD
logical :: dopCCD
logical :: doDCD
logical :: doCCSD
logical :: doCCSDT
logical :: dodrCCD
logical :: dorCCD
logical :: docrCCD
logical :: dolCCD
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
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) :: EGHF
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
! Local variables
double precision :: start_CC ,end_CC ,t_CC
!------------------------------------------------------------------------
! Perform CCD calculation
!------------------------------------------------------------------------
if(doCCD) then
call wall_time(start_CC)
call GCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,EGHF,eHF)
call wall_time(end_CC)
t_CC = end_CC - start_CC
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for CCD = ',t_CC,' seconds'
write(*,*)
end if
!------------------------------------------------------------------------
! Perform DCD calculation
!------------------------------------------------------------------------
if(doDCD) then
call wall_time(start_CC)
! call DCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR, &
! ERI,ENuc,EGHF,eHF)
call wall_time(end_CC)
t_CC = end_CC - start_CC
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for DCD = ',t_CC,' seconds'
write(*,*)
end if
!------------------------------------------------------------------------
! Perform CCSD or CCSD(T) calculation
!------------------------------------------------------------------------
if(doCCSDT) doCCSD = .true.
if(doCCSD) then
call wall_time(start_CC)
call GCCSD(dotest,maxSCF,thresh,max_diis,doCCSDT,nBas,nC,nO,nV,nR,ERI,ENuc,EGHF,eHF)
call wall_time(end_CC)
t_CC = end_CC - start_CC
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for CCSD or CCSD(T)= ',t_CC,' seconds'
write(*,*)
end if
!------------------------------------------------------------------------
! Perform direct ring CCD calculation
!------------------------------------------------------------------------
if(dodrCCD) then
call wall_time(start_CC)
call drGCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,EGHF,eHF)
call wall_time(end_CC)
t_CC = end_CC - start_CC
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for direct ring CCD = ',t_CC,' seconds'
write(*,*)
end if
!------------------------------------------------------------------------
! Perform ring CCD calculation
!------------------------------------------------------------------------
if(dorCCD) then
call wall_time(start_CC)
call rGCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,EGHF,eHF)
call wall_time(end_CC)
t_CC = end_CC - start_CC
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for rCCD = ',t_CC,' seconds'
write(*,*)
end if
!------------------------------------------------------------------------
! Perform crossed-ring CCD calculation
!------------------------------------------------------------------------
if(docrCCD) then
call wall_time(start_CC)
call crGCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,EGHF,eHF)
call wall_time(end_CC)
t_CC = end_CC - start_CC
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for crossed-ring CCD = ',t_CC,' seconds'
write(*,*)
end if
!------------------------------------------------------------------------
! Perform ladder CCD calculation
!------------------------------------------------------------------------
if(dolCCD) then
call wall_time(start_CC)
call lGCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,EGHF,eHF)
call wall_time(end_CC)
t_CC = end_CC - start_CC
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for ladder CCD = ',t_CC,' seconds'
write(*,*)
end if
!------------------------------------------------------------------------
! Perform pair CCD calculation
!------------------------------------------------------------------------
if(dopCCD) then
call wall_time(start_CC)
! call pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,EGHF,eHF)
call wall_time(end_CC)
t_CC = end_CC - start_CC
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for pair CCD = ',t_CC,' seconds'
write(*,*)
end if
end subroutine

262
src/CC/GCCD.f90 Normal file
View File

@ -0,0 +1,262 @@
subroutine GCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,EGHF,eHF)
! Generalized CCD module
implicit none
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
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) :: EGHF
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
! Local variables
integer :: nSCF
double precision :: Conv
double precision :: EcMP2,EcMP3,EcMP4
double precision :: ECC,EcCC
double precision,allocatable :: dbERI(:,:,:,:)
double precision,allocatable :: eO(:)
double precision,allocatable :: eV(:)
double precision,allocatable :: delta_OOVV(:,:,:,:)
double precision,allocatable :: OOOO(:,:,:,:)
double precision,allocatable :: OOVV(:,:,:,:)
double precision,allocatable :: OVOV(:,:,:,:)
double precision,allocatable :: VVVV(:,:,:,:)
double precision,allocatable :: OVVO(:,:,:,:)
double precision,allocatable :: X1(:,:,:,:)
double precision,allocatable :: X2(:,:)
double precision,allocatable :: X3(:,:)
double precision,allocatable :: X4(:,:,:,:)
double precision,allocatable :: u(:,:,:,:)
double precision,allocatable :: v(:,:,:,:)
double precision,allocatable :: r(:,:,:,:)
double precision,allocatable :: t(:,:,:,:)
integer :: n_diis
double precision :: rcond
double precision,allocatable :: error_diis(:,:)
double precision,allocatable :: t_diis(:,:)
logical :: do_EE_EOM_CC_1h1p = .false.
logical :: do_EA_EOM_CC_1p = .false.
logical :: do_IP_EOM_CC_1h = .false.
logical :: do_DEA_EOM_CC_2p = .false.
logical :: do_DIP_EOM_CC_2h = .false.
! Hello world
write(*,*)
write(*,*)'*******************************'
write(*,*)'* Generalized CCD Calculation *'
write(*,*)'*******************************'
write(*,*)
! Antysymmetrize ERIs
allocate(dbERI(nBas,nBas,nBas,nBas))
call antisymmetrize_ERI(2,nBas,ERI,dbERI)
! Form energy denominator
allocate(eO(nO-nC),eV(nV-nR))
allocate(delta_OOVV(nO-nC,nO-nC,nV-nR,nV-nR))
eO(:) = eHF(nC+1:nO)
eV(:) = eHF(nO+1:nBas-nR)
call form_delta_OOVV(nC,nO,nV,nR,eO,eV,delta_OOVV)
! Create integral batches
allocate(OOOO(nO-nC,nO-nC,nO-nC,nO-nC),OOVV(nO-nC,nO-nC,nV-nR,nV-nR), &
OVOV(nO-nC,nV-nR,nO-nC,nV-nR),VVVV(nV-nR,nV-nR,nV-nR,nV-nR))
OOOO(:,:,:,:) = dbERI(nC+1:nO ,nC+1:nO ,nC+1:nO ,nC+1:nO )
OOVV(:,:,:,:) = dbERI(nC+1:nO ,nC+1:nO ,nO+1:nBas-nR,nO+1:nBas-nR)
OVOV(:,:,:,:) = dbERI(nC+1:nO ,nO+1:nBas-nR,nC+1:nO ,nO+1:nBas-nR)
VVVV(:,:,:,:) = dbERI(nO+1:nBas-nR,nO+1:nBas-nR,nO+1:nBas-nR,nO+1:nBas-nR)
allocate(OVVO(nO-nC,nV-nR,nV-nR,nO-nC))
OVVO(:,:,:,:) = dbERI(nC+1:nO,nO+1:nBas-nR,nO+1:nBas-nR,nC+1:nO)
deallocate(dbERI)
! MP2 guess amplitudes
allocate(t(nO-nC,nO-nC,nV-nR,nV-nR))
t(:,:,:,:) = -OOVV(:,:,:,:)/delta_OOVV(:,:,:,:)
call CCD_correlation_energy(nC,nO,nV,nR,OOVV,t,EcMP2)
EcMP4 = 0d0
! Memory allocation for DIIS
allocate(error_diis((nO-nR)**2*(nV-nR)**2,max_diis),t_diis((nO-nR)**2*(nV-nR)**2,max_diis))
! Initialization
allocate(r(nO-nC,nO-nC,nV-nR,nV-nR),u(nO-nC,nO-nC,nV-nR,nV-nR),v(nO-nC,nO-nC,nV-nR,nV-nR))
allocate(X1(nO-nC,nO-nC,nO-nC,nO-nC),X2(nV-nR,nV-nR),X3(nO-nC,nO-nC),X4(nO-nC,nO-nC,nV-nR,nV-nR))
Conv = 1d0
nSCF = 0
n_diis = 0
t_diis(:,:) = 0d0
error_diis(:,:) = 0d0
!------------------------------------------------------------------------
! Main SCF loop
!------------------------------------------------------------------------
write(*,*)
write(*,*)'----------------------------------------------------'
write(*,*)'| GCCD calculation |'
write(*,*)'----------------------------------------------------'
write(*,'(1X,A1,1X,A3,1X,A1,1X,A16,1X,A1,1X,A10,1X,A1,1X,A10,1X,A1,1X)') &
'|','#','|','E(GCCD)','|','Ec(GCCD)','|','Conv','|'
write(*,*)'----------------------------------------------------'
do while(Conv > thresh .and. nSCF < maxSCF)
! Increment
nSCF = nSCF + 1
! Form linear array
call form_u(nC,nO,nV,nR,OOOO,VVVV,OVOV,t,u)
! Form interemediate arrays
call form_X(nC,nO,nV,nR,OOVV,t,X1,X2,X3,X4)
! Form quadratic array
call form_v(nC,nO,nV,nR,X1,X2,X3,X4,t,v)
! Compute residual
r(:,:,:,:) = OOVV(:,:,:,:) + delta_OOVV(:,:,:,:)*t(:,:,:,:) + u(:,:,:,:) + v(:,:,:,:)
! Check convergence
Conv = maxval(abs(r(:,:,:,:)))
! Update amplitudes
t(:,:,:,:) = t(:,:,:,:) - r(:,:,:,:)/delta_OOVV(:,:,:,:)
! Compute correlation energy
call CCD_correlation_energy(nC,nO,nV,nR,OOVV,t,EcCC)
if(nSCF == 1) call MP3_correlation_energy(nC,nO,nV,nR,OOVV,t,v,delta_OOVV,EcMP3)
! Dump results
ECC = EGHF + EcCC
! DIIS extrapolation
n_diis = min(n_diis+1,max_diis)
call DIIS_extrapolation(rcond,(nO-nC)**2*(nV-nR)**2,(nO-nC)**2*(nV-nR)**2,n_diis,error_diis,t_diis,-r/delta_OOVV,t)
! Reset DIIS if required
if(abs(rcond) < 1d-15) n_diis = 0
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
'|',nSCF,'|',ECC+ENuc,'|',EcCC,'|',Conv,'|'
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(*,*)'----------------------------------------------------'
write(*,*)' GCCD energy '
write(*,*)'----------------------------------------------------'
write(*,'(1X,A30,1X,F15.10)')' E(GCCD) = ',ECC
write(*,'(1X,A30,1X,F15.10)')' Ec(GCCD) = ',EcCC
write(*,*)'----------------------------------------------------'
write(*,*)
! Moller-Plesset energies
write(*,*)
write(*,'(1X,A15,1X,F10.6)') 'Ec(GMP2) = ',EcMP2
write(*,'(1X,A15,1X,F10.6)') 'Ec(GMP3) = ',EcMP3
write(*,'(1X,A15,1X,F10.6)') 'Ec(GMP4-SDQ) = ',EcMP4
write(*,*)
!------------------------------------------------------------------------
! EOM section
!------------------------------------------------------------------------
! EE-EOM-CCD (1h1p)
if(do_EE_EOM_CC_1h1p) call EE_EOM_CCD_1h1p(nC,nO,nV,nR,eO,eV,OOVV,OVVO,t)
! EA-EOM (1p)
! if(do_EA-EOM-CC_1p) call EA-EOM-CCD_1p()
! IP-EOM-CCD(1h)
! if(do_IP-EOM-CC_1h) call IP-EOM-CCD_1h()
! DEA-EOM (2p)
if(do_DEA_EOM_CC_2p) call DEA_EOM_CCD_2p(nC,nO,nV,nR,eV,OOVV,VVVV,t)
! DIP-EOM-CCD(2h)
if(do_DIP_EOM_CC_2h) call DIP_EOM_CCD_2h(nC,nO,nV,nR,eO,OOVV,OOOO,t)
! Testing zone
if(dotest) then
call dump_test_value('G','GCCD correlation energy',EcCC)
end if
end subroutine

291
src/CC/GCCSD.f90 Normal file
View File

@ -0,0 +1,291 @@
subroutine GCCSD(dotest,maxSCF,thresh,max_diis,doCCSDT,nBas,nC,nO,nV,nR,ERI,ENuc,EGHF,eHF)
! Generalized CCSD module
implicit none
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
logical,intent(in) :: doCCSDT
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) :: EGHF
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
! Local variables
double precision :: start_CCSDT,end_CCSDT,t_CCSDT
integer :: nSCF
double precision :: Conv
double precision :: EcMP2
double precision :: ECC
double precision :: EcCC
double precision :: EcCCT
double precision,allocatable :: dbERI(:,:,:,:)
double precision,allocatable :: delta_OV(:,:)
double precision,allocatable :: delta_OOVV(:,:,:,:)
double precision,allocatable :: OOOO(:,:,:,:)
double precision,allocatable :: OOOV(:,:,:,:)
double precision,allocatable :: OVOO(:,:,:,:)
double precision,allocatable :: VOOO(:,:,:,:)
double precision,allocatable :: OOVV(:,:,:,:)
double precision,allocatable :: OVVO(:,:,:,:)
double precision,allocatable :: OVVV(:,:,:,:)
double precision,allocatable :: VOVV(:,:,:,:)
double precision,allocatable :: VVVO(:,:,:,:)
double precision,allocatable :: VVVV(:,:,:,:)
double precision,allocatable :: eO(:)
double precision,allocatable :: eV(:)
double precision,allocatable :: hvv(:,:)
double precision,allocatable :: hoo(:,:)
double precision,allocatable :: hvo(:,:)
double precision,allocatable :: gvv(:,:)
double precision,allocatable :: goo(:,:)
double precision,allocatable :: aoooo(:,:,:,:)
double precision,allocatable :: bvvvv(:,:,:,:)
double precision,allocatable :: hovvo(:,:,:,:)
double precision,allocatable :: r1(:,:)
double precision,allocatable :: r2(:,:,:,:)
double precision,allocatable :: t1(:,:)
double precision,allocatable :: t2(:,:,:,:)
double precision,allocatable :: tau(:,:,:,:)
integer :: n_diis
double precision :: rcond1
double precision :: rcond2
double precision,allocatable :: err1_diis(:,:)
double precision,allocatable :: err2_diis(:,:)
double precision,allocatable :: t1_diis(:,:)
double precision,allocatable :: t2_diis(:,:)
! Hello world
write(*,*)
write(*,*)'********************************'
write(*,*)'* Generalized CCSD Calculation *'
write(*,*)'********************************'
write(*,*)
! Antysymmetrize ERIs
allocate(dbERI(nBas,nBas,nBas,nBas))
call antisymmetrize_ERI(2,nBas,ERI,dbERI)
! Form energy denominator
allocate(eO(nO),eV(nV))
allocate(delta_OV(nO,nV),delta_OOVV(nO,nO,nV,nV))
eO(:) = eHF(1:nO)
eV(:) = eHF(nO+1:nBas)
call form_delta_OV(nC,nO,nV,nR,eO,eV,delta_OV)
call form_delta_OOVV(nC,nO,nV,nR,eO,eV,delta_OOVV)
! Create integral batches
allocate(OOOO(nO,nO,nO,nO), &
OOOV(nO,nO,nO,nV),OVOO(nO,nV,nO,nO),VOOO(nV,nO,nO,nO), &
OOVV(nO,nO,nV,nV),OVVO(nO,nV,nV,nO), &
OVVV(nO,nV,nV,nV),VOVV(nV,nO,nV,nV),VVVO(nV,nV,nV,nO), &
VVVV(nV,nV,nV,nV))
OOOO(:,:,:,:) = dbERI( 1:nO , 1:nO , 1:nO , 1:nO )
OOOV(:,:,:,:) = dbERI( 1:nO , 1:nO , 1:nO ,nO+1:nBas)
OVOO(:,:,:,:) = dbERI( 1:nO ,nO+1:nBas, 1:nO , 1:nO )
VOOO(:,:,:,:) = dbERI(nO+1:nBas, 1:nO , 1:nO , 1:nO )
OOVV(:,:,:,:) = dbERI( 1:nO , 1:nO ,nO+1:nBas,nO+1:nBas)
OVVO(:,:,:,:) = dbERI( 1:nO ,nO+1:nBas,nO+1:nBas, 1:nO )
OVVV(:,:,:,:) = dbERI( 1:nO ,nO+1:nBas,nO+1:nBas,nO+1:nBas)
VOVV(:,:,:,:) = dbERI(nO+1:nBas, 1:nO ,nO+1:nBas,nO+1:nBas)
VVVO(:,:,:,:) = dbERI(nO+1:nBas,nO+1:nBas,nO+1:nBas, 1:nO )
VVVV(:,:,:,:) = dbERI(nO+1:nBas,nO+1:nBas,nO+1:nBas,nO+1:nBas)
deallocate(dbERI)
! MP2 guess amplitudes
allocate(t1(nO,nV),t2(nO,nO,nV,nV),tau(nO,nO,nV,nV))
t1(:,:) = 0d0
t2(:,:,:,:) = -OOVV(:,:,:,:)/delta_OOVV(:,:,:,:)
call form_tau(nC,nO,nV,nR,t1,t2,tau)
EcMP2 = 0.5d0*dot_product(pack(OOVV,.true.),pack(tau,.true.))
write(*,'(1X,A20,1X,F10.6)') 'Ec(MP2) = ',EcMP2
! Initialization
allocate(hvv(nV,nV),hoo(nO,nO),hvo(nV,nO), &
gvv(nV,nV),goo(nO,nO), &
aoooo(nO,nO,nO,nO),bvvvv(nV,nV,nV,nV),hovvo(nO,nV,nV,nO), &
r1(nO,nV),r2(nO,nO,nV,nV))
! Memory allocation for DIIS
allocate(err1_diis(nO*nV ,max_diis),t1_diis(nO*nV ,max_diis), &
err2_diis(nO*nO*nV*nV,max_diis),t2_diis(nO*nO*nV*nV,max_diis))
Conv = 1d0
nSCF = 0
ECC = EGHF
n_diis = 0
t1_diis(:,:) = 0d0
t2_diis(:,:) = 0d0
err1_diis(:,:) = 0d0
err2_diis(:,:) = 0d0
!------------------------------------------------------------------------
! Main SCF loop
!------------------------------------------------------------------------
write(*,*)
write(*,*)'----------------------------------------------------'
write(*,*)'| GCCSD calculation |'
write(*,*)'----------------------------------------------------'
write(*,'(1X,A1,1X,A3,1X,A1,1X,A16,1X,A1,1X,A10,1X,A1,1X,A10,1X,A1,1X)') &
'|','#','|','E(GCCSD)','|','Ec(GCCSD)','|','Conv','|'
write(*,*)'----------------------------------------------------'
do while(Conv > thresh .and. nSCF < maxSCF)
! Increment
nSCF = nSCF + 1
! Scuseria Eqs. (5), (6) and (7)
call form_h(nC,nO,nV,nR,eO,eV,OOVV,t1,tau,hvv,hoo,hvo)
! Scuseria Eqs. (9), (10), (11), (12) and (13)
call form_g(nC,nO,nV,nR,hvv,hoo,VOVV,OOOV,t1,gvv,goo)
call form_abh(nC,nO,nV,nR,OOOO,OVOO,OOVV,VVVV,VOVV,OVVO,OVVV,t1,tau,aoooo,bvvvv,hovvo)
! Compute residuals
call form_r1(nC,nO,nV,nR,OVVO,OVVV,OOOV,hvv,hoo,hvo,t1,t2,tau,r1)
call form_r2(nC,nO,nV,nR,OOVV,OVOO,OVVV,OVVO,gvv,goo,aoooo,bvvvv,hovvo,t1,t2,tau,r2)
! Check convergence
Conv = max(maxval(abs(r1(nC+1:nO,1:nV-nR))),maxval(abs(r2(nC+1:nO,nC+1:nO,1:nV-nR,1:nV-nR))))
! Update
t1(:,:) = t1(:,:) - r1(:,:) /delta_OV (:,:)
t2(:,:,:,:) = t2(:,:,:,:) - r2(:,:,:,:)/delta_OOVV(:,:,:,:)
call form_tau(nC,nO,nV,nR,t1,t2,tau)
! Compute correlation energy
call CCSD_correlation_energy(nC,nO,nV,nR,OOVV,tau,EcCC)
! Dump results
ECC = EGHF + EcCC
! DIIS extrapolation
n_diis = min(n_diis+1,max_diis)
! call DIIS_extrapolation(rcond1,nO*nV ,nO*nV ,n_diis,err1_diis,t1_diis,-r1/delta_OV ,t1)
! call DIIS_extrapolation(rcond2,nO*nO*nV*nV,nO*nO*nV*nV,n_diis,err2_diis,t2_diis,-r2/delta_OOVV,t2)
! Reset DIIS if required
! if(min(abs(rcond1),abs(rcond2)) < 1d-15) n_diis = 0
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
'|',nSCF,'|',ECC+ENuc,'|',EcCC,'|',Conv,'|'
end do
write(*,*)'----------------------------------------------------'
!------------------------------------------------------------------------
! End of SCF loop
!------------------------------------------------------------------------
! Did it actually converge?
if(nSCF == maxSCF) then
write(*,*)
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
write(*,*)' Convergence failed '
write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
write(*,*)
stop
end if
write(*,*)
write(*,*)'----------------------------------------------------'
write(*,*)' CCSD energy '
write(*,*)'----------------------------------------------------'
write(*,'(1X,A20,1X,F15.10)')' E(CCSD) = ',ENuc+ECC
write(*,'(1X,A20,1X,F10.6)')' Ec(CCSD) = ',EcCC
write(*,*)'----------------------------------------------------'
write(*,*)
! Deallocate memory
deallocate(hvv,hoo,hvo, &
delta_OV,delta_OOVV, &
gvv,goo, &
aoooo,bvvvv,hovvo, &
tau, &
r1,r2)
!------------------------------------------------------------------------
! (T) correction
!------------------------------------------------------------------------
if(doCCSDT) then
call wall_time(start_CCSDT)
call CCSDT(nC,nO,nV,nR,eO,eV,OOVV,VVVO,VOOO,t1,t2,EcCCT)
call wall_time(end_CCSDT)
t_CCSDT = end_CCSDT - start_CCSDT
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for (T) = ',t_CCSDT,' seconds'
write(*,*)
write(*,*)
write(*,*)'----------------------------------------------------'
write(*,*)' GCCSD(T) energy '
write(*,*)'----------------------------------------------------'
write(*,'(1X,A20,1X,F15.10)')' E(GCCSD(T)) = ',ENuc + ECC + EcCCT
write(*,'(1X,A20,1X,F10.6)')' Ec(GCCSD(T)) = ',EcCC + EcCCT
write(*,*)'----------------------------------------------------'
write(*,*)
end if
! Testing zone
if(dotest) then
call dump_test_value('R','GCCSD correlation energy',EcCC)
end if
end subroutine

29
src/CC/RCC.f90
View File

@ -1,5 +1,5 @@
subroutine RCC(doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,dolCCD, &
maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,EHF,epsHF)
subroutine RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,dolCCD, &
maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
! Coupled-cluster module
@ -8,6 +8,8 @@ subroutine RCC(doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,dolCCD,
! Input variables
logical :: dotest
logical :: doCCD
logical :: dopCCD
logical :: doDCD
@ -28,8 +30,8 @@ subroutine RCC(doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,dolCCD,
integer,intent(in) :: nV(nspin)
integer,intent(in) :: nR(nspin)
double precision,intent(in) :: ENuc
double precision,intent(in) :: EHF
double precision,intent(in) :: epsHF(nBas)
double precision,intent(in) :: ERHF
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
! Local variables
@ -43,7 +45,7 @@ subroutine RCC(doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,dolCCD,
if(doCCD) then
call wall_time(start_CC)
call CCD(maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,EHF,epsHF)
call CCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
call wall_time(end_CC)
t_CC = end_CC - start_CC
@ -59,8 +61,8 @@ subroutine RCC(doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,dolCCD,
if(doDCD) then
call wall_time(start_CC)
call DCD(maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR, &
ERI,ENuc,EHF,epsHF)
call DCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR, &
ERI,ENuc,ERHF,eHF)
call wall_time(end_CC)
t_CC = end_CC - start_CC
@ -78,7 +80,7 @@ subroutine RCC(doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,dolCCD,
if(doCCSD) then
call wall_time(start_CC)
call CCSD(maxSCF,thresh,max_diis,doCCSDT,nBas,nC,nO,nV,nR,ERI,ENuc,EHF,epsHF)
call CCSD(dotest,maxSCF,thresh,max_diis,doCCSDT,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
call wall_time(end_CC)
t_CC = end_CC - start_CC
@ -94,7 +96,7 @@ subroutine RCC(doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,dolCCD,
if(dodrCCD) then
call wall_time(start_CC)
call drCCD(maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,EHF,epsHF)
call drCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
call wall_time(end_CC)
t_CC = end_CC - start_CC
@ -110,7 +112,7 @@ subroutine RCC(doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,dolCCD,
if(dorCCD) then
call wall_time(start_CC)
call rCCD(maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,EHF,epsHF,epsHF)
call rCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
call wall_time(end_CC)
t_CC = end_CC - start_CC
@ -126,7 +128,7 @@ subroutine RCC(doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,dolCCD,
if(docrCCD) then
call wall_time(start_CC)
call crCCD(maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,EHF,epsHF)
call crCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
call wall_time(end_CC)
t_CC = end_CC - start_CC
@ -142,7 +144,7 @@ subroutine RCC(doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,dolCCD,
if(dolCCD) then
call wall_time(start_CC)
call lCCD(maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,EHF,epsHF)
call lCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
call wall_time(end_CC)
t_CC = end_CC - start_CC
@ -158,8 +160,7 @@ subroutine RCC(doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,dolCCD,
if(dopCCD) then
call wall_time(start_CC)
call pCCD(maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,EHF,epsHF)
call pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
call wall_time(end_CC)
t_CC = end_CC - start_CC

22
src/CC/crCCD.f90
View File

@ -1,4 +1,4 @@
subroutine crCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,eHF)
subroutine crCCD(dotest,maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,eHF)
! Crossed-ring CCD module
@ -6,6 +6,8 @@ subroutine crCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
@ -29,7 +31,7 @@ subroutine crCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF
integer :: nSCF
double precision :: Conv
double precision :: EcMP2
double precision :: ECCD,EcCCD
double precision :: ECC,EcCC
double precision,allocatable :: seHF(:)
double precision,allocatable :: sERI(:,:,:,:)
double precision,allocatable :: dbERI(:,:,:,:)
@ -155,11 +157,11 @@ subroutine crCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF
! Compute correlation energy
call CCD_correlation_energy(nC,nO,nV,nR,OOVV,t2,EcCCD)
call CCD_correlation_energy(nC,nO,nV,nR,OOVV,t2,EcCC)
! Dump results
ECCD = ERHF + EcCCD
ECC = ERHF + EcCC
! DIIS extrapolation
@ -171,7 +173,7 @@ subroutine crCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF
if(abs(rcond) < 1d-15) n_diis = 0
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
'|',nSCF,'|',ECCD+ENuc,'|',EcCCD,'|',Conv,'|'
'|',nSCF,'|',ECC+ENuc,'|',EcCC,'|',Conv,'|'
enddo
write(*,*)'----------------------------------------------------'
@ -197,9 +199,15 @@ subroutine crCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF
write(*,*)'----------------------------------------------------'
write(*,*)' crossed-ring CCD energy '
write(*,*)'----------------------------------------------------'
write(*,'(1X,A30,1X,F15.10)')' E(crCCD) = ',ECCD
write(*,'(1X,A30,1X,F15.10)')' Ec(crCCD) = ',EcCCD
write(*,'(1X,A30,1X,F15.10)')' E(crCCD) = ',ECC
write(*,'(1X,A30,1X,F15.10)')' Ec(crCCD) = ',EcCC
write(*,*)'----------------------------------------------------'
write(*,*)
if(dotest) then
call dump_test_value('R','crCCD correlation energy',EcCC)
end if
end subroutine

189
src/CC/crGCCD.f90 Normal file
View File

@ -0,0 +1,189 @@
subroutine crGCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
! Generalized crossed-ring CCD module
implicit none
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
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,ERHF
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
! Local variables
integer :: nSCF
double precision :: Conv
double precision :: EcMP2
double precision :: ECC,EcCC
double precision,allocatable :: dbERI(:,:,:,:)
double precision,allocatable :: eO(:)
double precision,allocatable :: eV(:)
double precision,allocatable :: delta_OOVV(:,:,:,:)
double precision,allocatable :: OOVV(:,:,:,:)
double precision,allocatable :: OVOV(:,:,:,:)
double precision,allocatable :: r2(:,:,:,:)
double precision,allocatable :: t2(:,:,:,:)
integer :: n_diis
double precision :: rcond
double precision,allocatable :: error_diis(:,:)
double precision,allocatable :: t_diis(:,:)
! Hello world
write(*,*)
write(*,*)'*********************************'
write(*,*)'* Generalized crCCD Calculation *'
write(*,*)'*********************************'
write(*,*)
! Antysymmetrize ERIs
allocate(dbERI(nBas,nBas,nBas,nBas))
call antisymmetrize_ERI(2,nBas,ERI,dbERI)
! Form energy denominator
allocate(eO(nO),eV(nV))
allocate(delta_OOVV(nO,nO,nV,nV))
eO(:) = eHF(1:nO)
eV(:) = eHF(nO+1:nBas)
call form_delta_OOVV(nC,nO,nV,nR,eO,eV,delta_OOVV)
! Create integral batches
allocate(OOVV(nO,nO,nV,nV),OVOV(nO,nV,nO,nV))
OOVV(:,:,:,:) = dbERI( 1:nO , 1:nO ,nO+1:nBas,nO+1:nBas)
OVOV(:,:,:,:) = dbERI( 1:nO ,nO+1:nBas, 1:nO ,nO+1:nBas)
deallocate(dbERI)
! MP2 guess amplitudes
allocate(t2(nO,nO,nV,nV))
t2(:,:,:,:) = -OOVV(:,:,:,:)/delta_OOVV(:,:,:,:)
call CCD_correlation_energy(nC,nO,nV,nR,OOVV,t2,EcMP2)
! Memory allocation for DIIS
allocate(error_diis(nO*nO*nV*nV,max_diis),t_diis(nO*nO*nV*nV,max_diis))
! Initialization
allocate(r2(nO,nO,nV,nV))
Conv = 1d0
nSCF = 0
n_diis = 0
t_diis(:,:) = 0d0
error_diis(:,:) = 0d0
!------------------------------------------------------------------------
! Main SCF loop
!------------------------------------------------------------------------
write(*,*)
write(*,*)'----------------------------------------------------'
write(*,*)'| crossed-ring CCD calculation |'
write(*,*)'----------------------------------------------------'
write(*,'(1X,A1,1X,A3,1X,A1,1X,A16,1X,A1,1X,A10,1X,A1,1X,A10,1X,A1,1X)') &
'|','#','|','E(CCD)','|','Ec(CCD)','|','Conv','|'
write(*,*)'----------------------------------------------------'
do while(Conv > thresh .and. nSCF < maxSCF)
! Increment
nSCF = nSCF + 1
! Compute residual
call form_crossed_ring_r(nC,nO,nV,nR,OVOV,OOVV,t2,r2)
r2(:,:,:,:) = OOVV(:,:,:,:) - delta_OOVV(:,:,:,:)*t2(:,:,:,:) + r2(:,:,:,:)
! Check convergence
Conv = maxval(abs(r2(nC+1:nO,nC+1:nO,1:nV-nR,1:nV-nR)))
! Update amplitudes
t2(:,:,:,:) = t2(:,:,:,:) + r2(:,:,:,:)/delta_OOVV(:,:,:,:)
! Compute correlation energy
call CCD_correlation_energy(nC,nO,nV,nR,OOVV,t2,EcCC)
! Dump results
ECC = ERHF + EcCC
! DIIS extrapolation
n_diis = min(n_diis+1,max_diis)
call DIIS_extrapolation(rcond,nO*nO*nV*nV,nO*nO*nV*nV,n_diis,error_diis,t_diis,-r2/delta_OOVV,t2)
! Reset DIIS if required
if(abs(rcond) < 1d-15) n_diis = 0
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
'|',nSCF,'|',ECC+ENuc,'|',EcCC,'|',Conv,'|'
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(*,*)'----------------------------------------------------'
write(*,*)' crossed-ring CCD energy '
write(*,*)'----------------------------------------------------'
write(*,'(1X,A30,1X,F15.10)')' E(crCCD) = ',ECC
write(*,'(1X,A30,1X,F15.10)')' Ec(crCCD) = ',EcCC
write(*,*)'----------------------------------------------------'
write(*,*)
if(dotest) then
call dump_test_value('R','crCCD correlation energy',EcCC)
end if
end subroutine

24
src/CC/drCCD.f90
View File

@ -1,4 +1,4 @@
subroutine drCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,eHF)
subroutine drCCD(dotest,maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,eHF)
! Direct ring CCD module
@ -6,6 +6,8 @@ subroutine drCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
@ -29,7 +31,7 @@ subroutine drCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF
integer :: nSCF
double precision :: Conv
double precision :: EcMP2
double precision :: ECCD,EcCCD
double precision :: ECC,EcCC
double precision,allocatable :: seHF(:)
double precision,allocatable :: sERI(:,:,:,:)
@ -147,12 +149,12 @@ subroutine drCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF
! Compute correlation energy
call CCD_correlation_energy(nC,nO,nV,nR,OOVV,t2,EcCCD)
EcCCD = 2d0*EcCCD
call CCD_correlation_energy(nC,nO,nV,nR,OOVV,t2,EcCC)
EcCC = 2d0*EcCC
! Dump results
ECCD = ERHF + EcCCD
ECC = ERHF + EcCC
! DIIS extrapolation
@ -164,7 +166,7 @@ subroutine drCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF
if(abs(rcond) < 1d-15) n_diis = 0
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
'|',nSCF,'|',ECCD+ENuc,'|',EcCCD,'|',Conv,'|'
'|',nSCF,'|',ECC+ENuc,'|',EcCC,'|',Conv,'|'
enddo
write(*,*)'----------------------------------------------------'
@ -190,9 +192,15 @@ subroutine drCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF
write(*,*)'----------------------------------------------------'
write(*,*)' direct ring CCD energy '
write(*,*)'----------------------------------------------------'
write(*,'(1X,A30,1X,F15.10)')' E(drCCD) = ',ECCD
write(*,'(1X,A30,1X,F15.10)')' Ec(drCCD) = ',EcCCD
write(*,'(1X,A30,1X,F15.10)')' E(drCCD) = ',ECC
write(*,'(1X,A30,1X,F15.10)')' Ec(drCCD) = ',EcCC
write(*,*)'----------------------------------------------------'
write(*,*)
if(dotest) then
call dump_test_value('R','drCCD correlation energy',EcCC)
end if
end subroutine

181
src/CC/drGCCD.f90 Normal file
View File

@ -0,0 +1,181 @@
subroutine drGCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
! Generalized Direct ring CCD module
implicit none
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
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,ERHF
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
! Local variables
integer :: nSCF
double precision :: Conv
double precision :: EcMP2
double precision :: ECC,EcCC
double precision,allocatable :: eO(:)
double precision,allocatable :: eV(:)
double precision,allocatable :: delta_OOVV(:,:,:,:)
double precision,allocatable :: OOVV(:,:,:,:)
double precision,allocatable :: OVVO(:,:,:,:)
double precision,allocatable :: r2(:,:,:,:)
double precision,allocatable :: t2(:,:,:,:)
integer :: n_diis
double precision :: rcond
double precision,allocatable :: error_diis(:,:)
double precision,allocatable :: t_diis(:,:)
! Hello world
write(*,*)
write(*,*)'*********************************'
write(*,*)'* Generalized drCCD Calculation *'
write(*,*)'*********************************'
write(*,*)
! Form energy denominator
allocate(eO(nO),eV(nV))
allocate(delta_OOVV(nO,nO,nV,nV))
eO(:) = eHF(1:nO)
eV(:) = eHF(nO+1:nBas)
call form_delta_OOVV(nC,nO,nV,nR,eO,eV,delta_OOVV)
! Create integral batches
allocate(OOVV(nO,nO,nV,nV),OVVO(nO,nV,nV,nO))
OOVV(:,:,:,:) = ERI( 1:nO , 1:nO ,nO+1:nBas,nO+1:nBas)
OVVO(:,:,:,:) = ERI( 1:nO ,nO+1:nBas,nO+1:nBas, 1:nO )
! MP2 guess amplitudes
allocate(t2(nO,nO,nV,nV))
t2(:,:,:,:) = -OOVV(:,:,:,:)/delta_OOVV(:,:,:,:)
call CCD_correlation_energy(nC,nO,nV,nR,OOVV,t2,EcMP2)
! Memory allocation for DIIS
allocate(error_diis(nO*nO*nV*nV,max_diis),t_diis(nO*nO*nV*nV,max_diis))
! Initialization
allocate(r2(nO,nO,nV,nV))
Conv = 1d0
nSCF = 0
n_diis = 0
t_diis(:,:) = 0d0
error_diis(:,:) = 0d0
!------------------------------------------------------------------------
! Main SCF loop
!------------------------------------------------------------------------
write(*,*)
write(*,*)'----------------------------------------------------'
write(*,*)'| direct ring GCCD calculation |'
write(*,*)'----------------------------------------------------'
write(*,'(1X,A1,1X,A3,1X,A1,1X,A16,1X,A1,1X,A10,1X,A1,1X,A10,1X,A1,1X)') &
'|','#','|','E(GCCD)','|','Ec(GCCD)','|','Conv','|'
write(*,*)'----------------------------------------------------'
do while(Conv > thresh .and. nSCF < maxSCF)
! Increment
nSCF = nSCF + 1
! Compute residual
call form_ring_r(nC,nO,nV,nR,OVVO,OOVV,t2,r2)
r2(:,:,:,:) = OOVV(:,:,:,:) + delta_OOVV(:,:,:,:)*t2(:,:,:,:) + r2(:,:,:,:)
! Check convergence
Conv = maxval(abs(r2(nC+1:nO,nC+1:nO,1:nV-nR,1:nV-nR)))
! Update amplitudes
t2(:,:,:,:) = t2(:,:,:,:) - r2(:,:,:,:)/delta_OOVV(:,:,:,:)
! Compute correlation energy
call CCD_correlation_energy(nC,nO,nV,nR,OOVV,t2,EcCC)
EcCC = 2d0*EcCC
! Dump results
ECC = ERHF + EcCC
! DIIS extrapolation
n_diis = min(n_diis+1,max_diis)
call DIIS_extrapolation(rcond,nO*nO*nV*nV,nO*nO*nV*nV,n_diis,error_diis,t_diis,-r2/delta_OOVV,t2)
! Reset DIIS if required
if(abs(rcond) < 1d-15) n_diis = 0
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
'|',nSCF,'|',ECC+ENuc,'|',EcCC,'|',Conv,'|'
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(*,*)'----------------------------------------------------'
write(*,*)' direct ring GCCD energy '
write(*,*)'----------------------------------------------------'
write(*,'(1X,A30,1X,F15.10)')' E(drGCCD) = ',ECC
write(*,'(1X,A30,1X,F15.10)')' Ec(drGCCD) = ',EcCC
write(*,*)'----------------------------------------------------'
write(*,*)
if(dotest) then
call dump_test_value('G','drCCD correlation energy',EcCC)
end if
end subroutine

22
src/CC/lCCD.f90
View File

@ -1,4 +1,4 @@
subroutine lCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,eHF)
subroutine lCCD(dotest,maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,eHF)
! Ladder CCD module
@ -6,6 +6,8 @@ subroutine lCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
@ -29,7 +31,7 @@ subroutine lCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,
integer :: nSCF
double precision :: Conv
double precision :: EcMP2
double precision :: ECCD,EcCCD
double precision :: ECC,EcCC
double precision,allocatable :: seHF(:)
double precision,allocatable :: sERI(:,:,:,:)
double precision,allocatable :: dbERI(:,:,:,:)
@ -168,11 +170,11 @@ subroutine lCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,
! Compute correlation energy
call CCD_correlation_energy(nC,nO,nV,nR,OOVV,t2,EcCCD)
call CCD_correlation_energy(nC,nO,nV,nR,OOVV,t2,EcCC)
! Dump results
ECCD = ERHF + EcCCD
ECC = ERHF + EcCC
! DIIS extrapolation
@ -184,7 +186,7 @@ subroutine lCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,
if(abs(rcond) < 1d-15) n_diis = 0
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
'|',nSCF,'|',ECCD+ENuc,'|',EcCCD,'|',Conv,'|'
'|',nSCF,'|',ECC+ENuc,'|',EcCC,'|',Conv,'|'
enddo
write(*,*)'----------------------------------------------------'
@ -210,9 +212,15 @@ subroutine lCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,
write(*,*)'----------------------------------------------------'
write(*,*)' ladder CCD energy '
write(*,*)'----------------------------------------------------'
write(*,'(1X,A30,1X,F15.10)')' E(lCCD) = ',ECCD
write(*,'(1X,A30,1X,F15.10)')' Ec(lCCD) = ',EcCCD
write(*,'(1X,A30,1X,F15.10)')' E(lCCD) = ',ECC
write(*,'(1X,A30,1X,F15.10)')' Ec(lCCD) = ',EcCC
write(*,*)'----------------------------------------------------'
write(*,*)
if(dotest) then
call dump_test_value('R','lCCD correlation energy',EcCC)
end if
end subroutine

202
src/CC/lGCCD.f90 Normal file
View File

@ -0,0 +1,202 @@
subroutine lGCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
! Generalized Ladder CCD module
implicit none
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
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,ERHF
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
! Local variables
integer :: nSCF
double precision :: Conv
double precision :: EcMP2
double precision :: ECC,EcCC
double precision,allocatable :: dbERI(:,:,:,:)
double precision,allocatable :: eO(:)
double precision,allocatable :: eV(:)
double precision,allocatable :: delta_OOVV(:,:,:,:)
double precision,allocatable :: OOOO(:,:,:,:)
double precision,allocatable :: OOVV(:,:,:,:)
double precision,allocatable :: OVOV(:,:,:,:)
double precision,allocatable :: VVVV(:,:,:,:)
double precision,allocatable :: X1(:,:,:,:)
double precision,allocatable :: X2(:,:)
double precision,allocatable :: X3(:,:)
double precision,allocatable :: X4(:,:,:,:)
double precision,allocatable :: u(:,:,:,:)
double precision,allocatable :: v(:,:,:,:)
double precision,allocatable :: r2(:,:,:,:)
double precision,allocatable :: t2(:,:,:,:)
integer :: n_diis
double precision :: rcond
double precision,allocatable :: error_diis(:,:)
double precision,allocatable :: t_diis(:,:)
! Hello world
write(*,*)
write(*,*)'********************************'
write(*,*)'* Generalized lCCD Calculation *'
write(*,*)'********************************'
write(*,*)
! Antysymmetrize ERIs
allocate(dbERI(nBas,nBas,nBas,nBas))
call antisymmetrize_ERI(2,nBas,ERI,dbERI)
! Form energy denominator
allocate(eO(nO),eV(nV))
allocate(delta_OOVV(nO,nO,nV,nV))
eO(:) = eHF(1:nO)
eV(:) = eHF(nO+1:nBas)
call form_delta_OOVV(nC,nO,nV,nR,eO,eV,delta_OOVV)
! Create integral batches
allocate(OOOO(nO,nO,nO,nO),OOVV(nO,nO,nV,nV),OVOV(nO,nV,nO,nV),VVVV(nV,nV,nV,nV))
OOOO(:,:,:,:) = dbERI( 1:nO , 1:nO , 1:nO , 1:nO )
OOVV(:,:,:,:) = dbERI( 1:nO , 1:nO ,nO+1:nBas,nO+1:nBas)
OVOV(:,:,:,:) = dbERI( 1:nO ,nO+1:nBas, 1:nO ,nO+1:nBas)
VVVV(:,:,:,:) = dbERI(nO+1:nBas,nO+1:nBas,nO+1:nBas,nO+1:nBas)
deallocate(dbERI)
! MP2 guess amplitudes
allocate(t2(nO,nO,nV,nV))
t2(:,:,:,:) = -OOVV(:,:,:,:)/delta_OOVV(:,:,:,:)
call CCD_correlation_energy(nC,nO,nV,nR,OOVV,t2,EcMP2)
! Memory allocation for DIIS
allocate(error_diis(nO*nO*nV*nV,max_diis),t_diis(nO*nO*nV*nV,max_diis))
! Initialization
allocate(r2(nO,nO,nV,nV),u(nO,nO,nV,nV),v(nO,nO,nV,nV))
allocate(X1(nO,nO,nO,nO),X2(nV,nV),X3(nO,nO),X4(nO,nO,nV,nV))
Conv = 1d0
nSCF = 0
n_diis = 0
t_diis(:,:) = 0d0
error_diis(:,:) = 0d0
!------------------------------------------------------------------------
! Main SCF loop
!------------------------------------------------------------------------
write(*,*)
write(*,*)'----------------------------------------------------'
write(*,*)'| ladder CCD calculation |'
write(*,*)'----------------------------------------------------'
write(*,'(1X,A1,1X,A3,1X,A1,1X,A16,1X,A1,1X,A10,1X,A1,1X,A10,1X,A1,1X)') &
'|','#','|','E(CCD)','|','Ec(CCD)','|','Conv','|'
write(*,*)'----------------------------------------------------'
do while(Conv > thresh .and. nSCF < maxSCF)
! Increment
nSCF = nSCF + 1
! Compute residual
call form_ladder_r(nC,nO,nV,nR,OOOO,OOVV,VVVV,t2,r2)
r2(:,:,:,:) = OOVV(:,:,:,:) + delta_OOVV(:,:,:,:)*t2(:,:,:,:) + r2(:,:,:,:)
! Check convergence
Conv = maxval(abs(r2(nC+1:nO,nC+1:nO,1:nV-nR,1:nV-nR)))
! Update amplitudes
t2(:,:,:,:) = t2(:,:,:,:) - r2(:,:,:,:)/delta_OOVV(:,:,:,:)
! Compute correlation energy
call CCD_correlation_energy(nC,nO,nV,nR,OOVV,t2,EcCC)
! Dump results
ECC = ERHF + EcCC
! DIIS extrapolation
n_diis = min(n_diis+1,max_diis)
call DIIS_extrapolation(rcond,nO*nO*nV*nV,nO*nO*nV*nV,n_diis,error_diis,t_diis,-r2/delta_OOVV,t2)
! Reset DIIS if required
if(abs(rcond) < 1d-15) n_diis = 0
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
'|',nSCF,'|',ECC+ENuc,'|',EcCC,'|',Conv,'|'
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(*,*)'----------------------------------------------------'
write(*,*)' ladder CCD energy '
write(*,*)'----------------------------------------------------'
write(*,'(1X,A30,1X,F15.10)')' E(lCCD) = ',ECC
write(*,'(1X,A30,1X,F15.10)')' Ec(lCCD) = ',EcCC
write(*,*)'----------------------------------------------------'
write(*,*)
if(dotest) then
call dump_test_value('R','lCCD correlation energy',EcCC)
end if
end subroutine

24
src/CC/pCCD.f90
View File

@ -1,4 +1,4 @@
subroutine pCCD(maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
subroutine pCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
! pair CCD module
@ -6,6 +6,8 @@ subroutine pCCD(maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
@ -21,7 +23,7 @@ subroutine pCCD(maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
integer :: nSCF
double precision :: Conv
double precision :: ECCD,EcCCD
double precision :: ECC,EcCC
double precision,allocatable :: eO(:)
double precision,allocatable :: eV(:)
@ -91,10 +93,10 @@ subroutine pCCD(maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
t(:,:) = -0.5d0*OOVV(:,:)/delta_OV(:,:)
EcCCD = 0d0
EcCC = 0d0
do i=1,nO-nC
do a=1,nV-nR
EcCCD = EcCCD + OOVV(i,a)*t(i,a)
EcCC = EcCC + OOVV(i,a)*t(i,a)
end do
end do
@ -170,16 +172,16 @@ subroutine pCCD(maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
! Compute correlation energy
EcCCD = 0d0
EcCC = 0d0
do i=1,nO-nC
do a=1,nV-nR
EcCCD = EcCCD + OOVV(i,a)*t(i,a)
EcCC = EcCC + OOVV(i,a)*t(i,a)
end do
end do
! Dump results
ECCD = ERHF + EcCCD
ECC = ERHF + EcCC
! DIIS extrapolation
@ -191,7 +193,7 @@ subroutine pCCD(maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
! if(abs(rcond) < 1d-15) n_diis = 0
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
'|',nSCF,'|',ECCD+ENuc,'|',EcCCD,'|',Conv,'|'
'|',nSCF,'|',ECC+ENuc,'|',EcCC,'|',Conv,'|'
enddo
write(*,*)'----------------------------------------------------'
@ -212,4 +214,10 @@ subroutine pCCD(maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
endif
if(dotest) then
call dump_test_value('R','pCCD correlation energy',EcCC)
end if
end subroutine

34
src/CC/rCCD.f90
View File

@ -1,4 +1,4 @@
subroutine rCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,eHF,eGW)
subroutine rCCD(dotest,maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,eHF)
! Ring CCD module
@ -6,6 +6,8 @@ subroutine rCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
@ -18,7 +20,6 @@ subroutine rCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,
double precision,intent(in) :: ENuc
double precision,intent(in) :: ERHF
double precision,intent(in) :: eHF(nBasin)
double precision,intent(in) :: eGW(nBasin)
double precision,intent(in) :: ERI(nBasin,nBasin,nBasin,nBasin)
! Local variables
@ -31,9 +32,8 @@ subroutine rCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,
integer :: nSCF
double precision :: Conv
double precision :: EcMP2
double precision :: ECCD,EcCCD
double precision :: ECC,EcCC
double precision,allocatable :: seHF(:)
double precision,allocatable :: seGW(:)
double precision,allocatable :: sERI(:,:,:,:)
double precision,allocatable :: dbERI(:,:,:,:)
@ -70,10 +70,9 @@ subroutine rCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,
nV = 2*nVin
nR = 2*nRin
allocate(seHF(nBas),seGW(nBas),sERI(nBas,nBas,nBas,nBas))
allocate(seHF(nBas),sERI(nBas,nBas,nBas,nBas))
call spatial_to_spin_MO_energy(nBasin,eHF,nBas,seHF)
call spatial_to_spin_MO_energy(nBasin,eGW,nBas,seGW)
call spatial_to_spin_ERI(nBasin,ERI,nBas,sERI)
! Antysymmetrize ERIs
@ -89,12 +88,12 @@ subroutine rCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,
allocate(eO(nO),eV(nV))
allocate(delta_OOVV(nO,nO,nV,nV))
eO(:) = seGW(1:nO)
eV(:) = seGW(nO+1:nBas)
eO(:) = seHF(1:nO)
eV(:) = seHF(nO+1:nBas)
call form_delta_OOVV(nC,nO,nV,nR,eO,eV,delta_OOVV)
! deallocate(seHF,seGW)
deallocate(seHF)
! Create integral batches
@ -161,11 +160,11 @@ subroutine rCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,
! Compute correlation energy
call CCD_correlation_energy(nC,nO,nV,nR,OOVV,t,EcCCD)
call CCD_correlation_energy(nC,nO,nV,nR,OOVV,t,EcCC)
! Dump results
ECCD = ERHF + EcCCD
ECC = ERHF + EcCC
! DIIS extrapolation
@ -177,7 +176,7 @@ subroutine rCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,
if(abs(rcond) < 1d-15) n_diis = 0
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
'|',nSCF,'|',ECCD+ENuc,'|',EcCCD,'|',Conv,'|'
'|',nSCF,'|',ECC+ENuc,'|',EcCC,'|',Conv,'|'
enddo
write(*,*)'----------------------------------------------------'
@ -203,8 +202,8 @@ subroutine rCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,
write(*,*)'----------------------------------------------------'
write(*,*)' ring CCD energy '
write(*,*)'----------------------------------------------------'
write(*,'(1X,A30,1X,F15.10)')' E(rCCD) = ',ECCD
write(*,'(1X,A30,1X,F15.10)')' Ec(rCCD) = ',EcCCD
write(*,'(1X,A30,1X,F15.10)')' E(rCCD) = ',ECC
write(*,'(1X,A30,1X,F15.10)')' Ec(rCCD) = ',EcCC
write(*,*)'----------------------------------------------------'
write(*,*)
@ -223,4 +222,11 @@ subroutine rCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,
if(do_EE_EOM_CC_1h1p) call EE_EOM_CCD_1h1p(nC,nO,nV,nR,eO,eV,OOVV,OVVO,t)
if(dotest) then
call dump_test_value('R','rCCD correlation energy',EcCC)
end if
end subroutine

208
src/CC/rGCCD.f90 Normal file
View File

@ -0,0 +1,208 @@
subroutine rGCCD(dotest,maxSCF,thresh,max_diis,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF)
! Generalized ring CCD module
implicit none
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
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) :: ERHF
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
! Local variables
integer :: nSCF
double precision :: Conv
double precision :: EcMP2
double precision :: ECC,EcCC
double precision,allocatable :: dbERI(:,:,:,:)
double precision,allocatable :: eO(:)
double precision,allocatable :: eV(:)
double precision,allocatable :: delta_OOVV(:,:,:,:)
double precision,allocatable :: OOVV(:,:,:,:)
double precision,allocatable :: OVVO(:,:,:,:)
double precision,allocatable :: r(:,:,:,:)
double precision,allocatable :: t(:,:,:,:)
integer :: n_diis
double precision :: rcond
double precision,allocatable :: error_diis(:,:)
double precision,allocatable :: t_diis(:,:)
logical :: do_EE_EOM_CC_1h1p = .true.
! Hello world
write(*,*)
write(*,*)'********************************'
write(*,*)'* Generalized rCCD Calculation *'
write(*,*)'********************************'
write(*,*)
! Antysymmetrize ERIs
allocate(dbERI(nBas,nBas,nBas,nBas))
call antisymmetrize_ERI(2,nBas,ERI,dbERI)
! Form energy denominator
allocate(eO(nO),eV(nV))
allocate(delta_OOVV(nO,nO,nV,nV))
eO(:) = eHF(1:nO)
eV(:) = eHF(nO+1:nBas)
call form_delta_OOVV(nC,nO,nV,nR,eO,eV,delta_OOVV)
! Create integral batches
allocate(OOVV(nO,nO,nV,nV),OVVO(nO,nV,nV,nO))
OOVV(:,:,:,:) = dbERI( 1:nO , 1:nO ,nO+1:nBas,nO+1:nBas)
OVVO(:,:,:,:) = dbERI( 1:nO ,nO+1:nBas,nO+1:nBas, 1:nO )
deallocate(dbERI)
! MP2 guess amplitudes
allocate(t(nO,nO,nV,nV))
t(:,:,:,:) = -OOVV(:,:,:,:)/delta_OOVV(:,:,:,:)
call CCD_correlation_energy(nC,nO,nV,nR,OOVV,t,EcMP2)
! Memory allocation for DIIS
allocate(error_diis(nO*nO*nV*nV,max_diis),t_diis(nO*nO*nV*nV,max_diis))
! Initialization
allocate(r(nO,nO,nV,nV))
Conv = 1d0
nSCF = 0
n_diis = 0
t_diis(:,:) = 0d0
error_diis(:,:) = 0d0
!------------------------------------------------------------------------
! Main SCF loop
!------------------------------------------------------------------------
write(*,*)
write(*,*)'----------------------------------------------------'
write(*,*)'| ring CCD calculation |'
write(*,*)'----------------------------------------------------'
write(*,'(1X,A1,1X,A3,1X,A1,1X,A16,1X,A1,1X,A10,1X,A1,1X,A10,1X,A1,1X)') &
'|','#','|','E(CCD)','|','Ec(CCD)','|','Conv','|'
write(*,*)'----------------------------------------------------'
do while(Conv > thresh .and. nSCF < maxSCF)
! Increment
nSCF = nSCF + 1
! Compute residual
call form_ring_r(nC,nO,nV,nR,OVVO,OOVV,t,r)
r(:,:,:,:) = OOVV(:,:,:,:) + delta_OOVV(:,:,:,:)*t(:,:,:,:) + r(:,:,:,:)
! Check convergence
Conv = maxval(abs(r(nC+1:nO,nC+1:nO,1:nV-nR,1:nV-nR)))
! Update amplitudes
t(:,:,:,:) = t(:,:,:,:) - r(:,:,:,:)/delta_OOVV(:,:,:,:)
! Compute correlation energy
call CCD_correlation_energy(nC,nO,nV,nR,OOVV,t,EcCC)
! Dump results
ECC = ERHF + EcCC
! DIIS extrapolation
n_diis = min(n_diis+1,max_diis)
call DIIS_extrapolation(rcond,nO*nO*nV*nV,nO*nO*nV*nV,n_diis,error_diis,t_diis,-r/delta_OOVV,t)
! Reset DIIS if required
if(abs(rcond) < 1d-15) n_diis = 0
write(*,'(1X,A1,1X,I3,1X,A1,1X,F16.10,1X,A1,1X,F10.6,1X,A1,1X,F10.6,1X,A1,1X)') &
'|',nSCF,'|',ECC+ENuc,'|',EcCC,'|',Conv,'|'
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(*,*)'----------------------------------------------------'
write(*,*)' ring CCD energy '
write(*,*)'----------------------------------------------------'
write(*,'(1X,A30,1X,F15.10)')' E(rCCD) = ',ECC
write(*,'(1X,A30,1X,F15.10)')' Ec(rCCD) = ',EcCC
write(*,*)'----------------------------------------------------'
write(*,*)
! write(*,*)
! write(*,*)'----------------------------------------------------'
! write(*,*)' ring CCD amplitudes '
! write(*,*)'----------------------------------------------------'
! call matout(nO*nO,nV*nV,t)
! write(*,*)
!------------------------------------------------------------------------
! EOM section
!------------------------------------------------------------------------
! EE-EOM-CCD (1h1p)
if(do_EE_EOM_CC_1h1p) call EE_EOM_CCD_1h1p(nC,nO,nV,nR,eO,eV,OOVV,OVVO,t)
if(dotest) then
call dump_test_value('R','rCCD correlation energy',EcCC)
end if
end subroutine

8
src/CI/CID.f90
View File

@ -1,4 +1,4 @@
subroutine CID(singlet_manifold,triplet_manifold,nBasin,nCin,nOin,nVin,nRin,ERIin,eHFin,E0)
subroutine CID(dotest,singlet,triplet,nBasin,nCin,nOin,nVin,nRin,ERIin,eHFin,E0)
! Perform configuration interaction with doubles
@ -7,8 +7,10 @@ subroutine CID(singlet_manifold,triplet_manifold,nBasin,nCin,nOin,nVin,nRin,ERIi
! Input variables
logical,intent(in) :: singlet_manifold
logical,intent(in) :: triplet_manifold
logical,intent(in) :: dotest
logical,intent(in) :: singlet
logical,intent(in) :: triplet
integer,intent(in) :: nBasin
integer,intent(in) :: nCin
integer,intent(in) :: nOin

8
src/CI/CISD.f90
View File

@ -1,4 +1,4 @@
subroutine CISD(singlet_manifold,triplet_manifold,nBasin,nCin,nOin,nVin,nRin,ERIin,eHFin,E0)
subroutine CISD(dotest,singlet,triplet,nBasin,nCin,nOin,nVin,nRin,ERIin,eHFin,E0)
! Perform configuration interaction with singles and doubles
@ -7,8 +7,10 @@ subroutine CISD(singlet_manifold,triplet_manifold,nBasin,nCin,nOin,nVin,nRin,ERI
! Input variables
logical,intent(in) :: singlet_manifold
logical,intent(in) :: triplet_manifold
logical,intent(in) :: dotest
logical,intent(in) :: singlet
logical,intent(in) :: triplet
integer,intent(in) :: nBasin
integer,intent(in) :: nCin
integer,intent(in) :: nOin

20
src/CI/RCI.f90
View File

@ -1,4 +1,4 @@
subroutine RCI(doCIS,doCIS_D,doCID,doCISD,doFCI,singlet,triplet,nBas,nC,nO,nV,nR,nS,ERI,dipole_int, &
subroutine RCI(dotest,doCIS,doCIS_D,doCID,doCISD,doFCI,singlet,triplet,nBas,nC,nO,nV,nR,nS,ERI,dipole_int, &
epsHF,EHF,cHF,S)
! Configuration interaction module
@ -8,11 +8,13 @@ subroutine RCI(doCIS,doCIS_D,doCID,doCISD,doFCI,singlet,triplet,nBas,nC,nO,nV,nR
! Input variables
logical :: doCIS
logical :: doCIS_D
logical :: doCID
logical :: doCISD
logical :: doFCI
logical,intent(in) :: dotest
logical,intent(in) :: doCIS
logical,intent(in) :: doCIS_D
logical,intent(in) :: doCID
logical,intent(in) :: doCISD
logical,intent(in) :: doFCI
logical,intent(in) :: singlet
logical,intent(in) :: triplet
@ -40,7 +42,7 @@ subroutine RCI(doCIS,doCIS_D,doCID,doCISD,doFCI,singlet,triplet,nBas,nC,nO,nV,nR
if(doCIS) then
call wall_time(start_CI)
call CIS(singlet,triplet,doCIS_D,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,epsHF)
call RCIS(dotest,singlet,triplet,doCIS_D,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,epsHF)
call wall_time(end_CI)
t_CI = end_CI - start_CI
@ -56,7 +58,7 @@ subroutine RCI(doCIS,doCIS_D,doCID,doCISD,doFCI,singlet,triplet,nBas,nC,nO,nV,nR
if(doCID) then
call wall_time(start_CI)
call CID(singlet,triplet,nBas,nC,nO,nV,nR,ERI,epsHF,EHF)
call CID(dotest,singlet,triplet,nBas,nC,nO,nV,nR,ERI,epsHF,EHF)
call wall_time(end_CI)
t_CI = end_CI - start_CI
@ -72,7 +74,7 @@ subroutine RCI(doCIS,doCIS_D,doCID,doCISD,doFCI,singlet,triplet,nBas,nC,nO,nV,nR
if(doCISD) then
call wall_time(start_CI)
call CISD(singlet,triplet,nBas,nC,nO,nV,nR,ERI,epsHF,EHF)
call CISD(dotest,singlet,triplet,nBas,nC,nO,nV,nR,ERI,epsHF,EHF)
call wall_time(end_CI)
t_CI = end_CI - start_CI

24
src/CI/CIS.f90 → src/CI/RCIS.f90
View File

@ -1,4 +1,4 @@
subroutine CIS(singlet,triplet,doCIS_D,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF)
subroutine RCIS(dotest,singlet,triplet,doCIS_D,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF)
! Perform configuration interaction single calculation`
@ -7,6 +7,8 @@ subroutine CIS(singlet,triplet,doCIS_D,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF)
! Input variables
logical,intent(in) :: dotest
logical,intent(in) :: singlet
logical,intent(in) :: triplet
logical,intent(in) :: doCIS_D
@ -55,7 +57,7 @@ subroutine CIS(singlet,triplet,doCIS_D,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF)
endif
call diagonalize_matrix(nS,A,Om)
call print_excitation_energies('CIS',ispin,nS,Om)
call print_excitation_energies('CIS@RHF',ispin,nS,Om)
call phLR_transition_vectors(.true.,nBas,nC,nO,nV,nR,nS,dipole_int,Om,transpose(A),transpose(A))
if(dump_trans) then
@ -69,6 +71,14 @@ subroutine CIS(singlet,triplet,doCIS_D,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF)
maxS = min(maxS,nS)
if(doCIS_D) call CIS_D(ispin,nBas,nC,nO,nV,nR,nS,maxS,eHF,ERI,Om(1:maxS),A(:,1:maxS))
! Testing zone
if(dotest) then
call dump_test_value('R','CIS singlet excitation energy',Om(1))
end if
endif
if(triplet) then
@ -83,7 +93,7 @@ subroutine CIS(singlet,triplet,doCIS_D,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF)
endif
call diagonalize_matrix(nS,A,Om)
call print_excitation_energies('CIS',ispin,nS,Om)
call print_excitation_energies('CIS@RHF',ispin,nS,Om)
call phLR_transition_vectors(.false.,nBas,nC,nO,nV,nR,nS,dipole_int,Om,transpose(A),transpose(A))
if(dump_trans) then
@ -97,6 +107,14 @@ subroutine CIS(singlet,triplet,doCIS_D,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF)
maxS = min(maxS,nS)
if(doCIS_D) call CIS_D(ispin,nBas,nC,nO,nV,nR,nS,maxS,eHF,ERI,Om(1:maxS),A(:,1:maxS))
! Testing zone
if(dotest) then
call dump_test_value('R','CIS triplet excitation energy',Om(1))
end if
endif
end subroutine

16
src/CI/UCI.f90
View File

@ -1,4 +1,4 @@
subroutine UCI(doCIS,doCIS_D,doCID,doCISD,doFCI,spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS, &
subroutine UCI(dotest,doCIS,doCIS_D,doCID,doCISD,doFCI,spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS, &
ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb,epsHF,EHF,cHF,S,F)
! Configuration interaction module
@ -8,11 +8,13 @@ subroutine UCI(doCIS,doCIS_D,doCID,doCISD,doFCI,spin_conserved,spin_flip,nBas,nC
! Input variables
logical :: doCIS
logical :: doCIS_D
logical :: doCID
logical :: doCISD
logical :: doFCI
logical,intent(in) :: dotest
logical,intent(in) :: doCIS
logical,intent(in) :: doCIS_D
logical,intent(in) :: doCID
logical,intent(in) :: doCISD
logical,intent(in) :: doFCI
logical,intent(in) :: spin_conserved
logical,intent(in) :: spin_flip
@ -44,7 +46,7 @@ subroutine UCI(doCIS,doCIS_D,doCID,doCISD,doFCI,spin_conserved,spin_flip,nBas,nC
if(doCIS) then
call wall_time(start_CI)
call UCIS(spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb, &
call UCIS(dotest,spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb, &
ERI_bbbb,dipole_int_aa,dipole_int_bb,epsHF,cHF,S)
call wall_time(end_CI)

24
src/CI/UCIS.f90
View File

@ -1,4 +1,4 @@
subroutine UCIS(spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,ERI_bbbb, &
subroutine UCIS(dotest,spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,ERI_bbbb, &
dipole_int_aa,dipole_int_bb,eHF,cHF,S)
! Perform configuration interaction single calculation`
@ -8,6 +8,8 @@ subroutine UCIS(spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,E
! Input variables
logical,intent(in) :: dotest
logical,intent(in) :: spin_conserved
logical,intent(in) :: spin_flip
integer,intent(in) :: nBas
@ -78,7 +80,7 @@ subroutine UCIS(spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,E
call diagonalize_matrix(nS_sc,A_sc,Om_sc)
A_sc(:,:) = transpose(A_sc)
call print_excitation_energies('UCIS',5,nS_sc,Om_sc)
call print_excitation_energies('CIS@UHF',5,nS_sc,Om_sc)
call phULR_transition_vectors(ispin,nBas,nC,nO,nV,nR,nS,nS_aa,nS_bb,nS_sc,dipole_int_aa,dipole_int_bb, &
cHF,S,Om_sc,A_sc,A_sc)
@ -88,6 +90,14 @@ subroutine UCIS(spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,E
write(*,*)
endif
! Testing zone
if(dotest) then
call dump_test_value('U','CIS singlet excitation energy',Om_sc(1))
end if
deallocate(A_sc,Om_sc)
endif
@ -118,7 +128,7 @@ subroutine UCIS(spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,E
call diagonalize_matrix(nS_sf,A_sf,Om_sf)
A_sf(:,:) = transpose(A_sf)
call print_excitation_energies('UCIS',6,nS_sf,Om_sf)
call print_excitation_energies('CIS@UHF',6,nS_sf,Om_sf)
call phULR_transition_vectors(ispin,nBas,nC,nO,nV,nR,nS,nS_ab,nS_ba,nS_sf,dipole_int_aa,dipole_int_bb, &
cHF,S,Om_sf,A_sf,A_sf)
@ -128,6 +138,14 @@ subroutine UCIS(spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,E
write(*,*)
endif
! Testing zone
if(dotest) then
call dump_test_value('U','CIS triplet excitation energy',Om_sf(1))
end if
deallocate(A_sf,Om_sf)
endif

25
src/GF/GG0F2.f90
View File

@ -1,4 +1,4 @@
subroutine GG0F2(dophBSE,doppBSE,TDA,dBSE,dTDA,linearize,eta,regularize, &
subroutine GG0F2(dotest,dophBSE,doppBSE,TDA,dBSE,dTDA,linearize,eta,regularize, &
nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF)
! Perform a one-shot second-order Green function calculation
@ -8,6 +8,8 @@ subroutine GG0F2(dophBSE,doppBSE,TDA,dBSE,dTDA,linearize,eta,regularize, &
! Input variables
logical,intent(in) :: dotest
logical,intent(in) :: dophBSE
logical,intent(in) :: doppBSE
logical,intent(in) :: TDA
@ -39,10 +41,11 @@ subroutine GG0F2(dophBSE,doppBSE,TDA,dBSE,dTDA,linearize,eta,regularize, &
! Hello world
write(*,*)
write(*,*)'************************************************'
write(*,*)'| One-shot second-order Green function |'
write(*,*)'************************************************'
write(*,*)'********************************'
write(*,*)'* Generalized G0F2 Calculation *'
write(*,*)'********************************'
write(*,*)
! Memory allocation
@ -80,8 +83,8 @@ subroutine GG0F2(dophBSE,doppBSE,TDA,dBSE,dTDA,linearize,eta,regularize, &
! Print results
call GMP2(regularize,nBas,nC,nO,nV,nR,ERI,ENuc,EHF,eGF,Ec)
call print_G0F2(nBas,nO,eHF,SigC,eGF,Z,ENuc,ERHF,Ec)
call GMP2(.false.,regularize,nBas,nC,nO,nV,nR,ERI,ENuc,EHF,eGF,Ec)
call print_RG0F2(nBas,nO,eHF,SigC,eGF,Z,ENuc,ERHF,Ec)
! Perform BSE2 calculation
@ -113,4 +116,14 @@ subroutine GG0F2(dophBSE,doppBSE,TDA,dBSE,dTDA,linearize,eta,regularize, &
! end if
! Testing zone
if(dotest) then
call dump_test_value('G','G0F2 correlation energy',Ec)
call dump_test_value('G','G0F2 HOMO energy',eGF(nO))
call dump_test_value('G','G0F2 LUMO energy',eGF(nO+1))
end if
end subroutine

16
src/GF/GGF.f90
View File

@ -1,4 +1,4 @@
subroutine GGF(doG0F2,doevGF2,doqsGF2,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,linearize,eta,regularize, &
subroutine GGF(dotest,doG0F2,doevGF2,doqsGF2,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,linearize,eta,regularize, &
nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc,ERI_AO,ERI,dipole_int_AO,dipole_int,PHF,cHF,epsHF)
! Green's function module
@ -8,9 +8,11 @@ subroutine GGF(doG0F2,doevGF2,doqsGF2,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA
! Input variables
logical :: doG0F2
logical :: doevGF2
logical :: doqsGF2
logical,intent(in) :: dotest
logical,intent(in) :: doG0F2
logical,intent(in) :: doevGF2
logical,intent(in) :: doqsGF2
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
@ -61,7 +63,7 @@ subroutine GGF(doG0F2,doevGF2,doqsGF2,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA
if(doG0F2) then
call wall_time(start_GF)
call GG0F2(dophBSE,doppBSE,TDA,dBSE,dTDA,linearize,eta,regularize, &
call GG0F2(dotest,dophBSE,doppBSE,TDA,dBSE,dTDA,linearize,eta,regularize, &
nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,epsHF)
call wall_time(end_GF)
@ -78,7 +80,7 @@ subroutine GGF(doG0F2,doevGF2,doqsGF2,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA
if(doevGF2) then
call wall_time(start_GF)
call evGGF2(dophBSE,doppBSE,TDA,dBSE,dTDA,maxSCF,thresh,max_diis,linearize,eta,regularize, &
call evGGF2(dotest,dophBSE,doppBSE,TDA,dBSE,dTDA,maxSCF,thresh,max_diis,linearize,eta,regularize, &
nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,epsHF)
call wall_time(end_GF)
@ -95,7 +97,7 @@ subroutine GGF(doG0F2,doevGF2,doqsGF2,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA
if(doqsGF2) then
call wall_time(start_GF)
! call qsGGF2(maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,eta,regularize,nNuc,ZNuc,rNuc,ENuc, &
! call qsGGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,eta,regularize,nNuc,ZNuc,rNuc,ENuc, &
! nBas,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc,ERI_AO,ERI,dipole_int_AO,dipole_int,PHF,cHF,epsHF)
call wall_time(end_GF)

38
src/GF/G0F2.f90 → src/GF/RG0F2.f90
View File

@ -1,5 +1,5 @@
subroutine G0F2(dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet,linearize,eta,regularize, &
nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF)
subroutine RG0F2(dotest,dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet,linearize,eta,regularize, &
nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF)
! Perform a one-shot second-order Green function calculation
@ -8,6 +8,8 @@ subroutine G0F2(dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet,linearize,eta,regu
! Input variables
logical,intent(in) :: dotest
logical,intent(in) :: dophBSE
logical,intent(in) :: doppBSE
logical,intent(in) :: TDA
@ -42,9 +44,9 @@ subroutine G0F2(dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet,linearize,eta,regu
! Hello world
write(*,*)
write(*,*)'************************************************'
write(*,*)'| One-shot second-order Green function |'
write(*,*)'************************************************'
write(*,*)'*******************************'
write(*,*)'* Restricted G0F2 Calculation *'
write(*,*)'*******************************'
write(*,*)
! Memory allocation
@ -82,8 +84,8 @@ subroutine G0F2(dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet,linearize,eta,regu
! Print results
call RMP2(regularize,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eGF,Ec)
call print_G0F2(nBas,nO,eHF,SigC,eGF,Z,ENuc,ERHF,Ec)
call RMP2(.false.,regularize,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eGF,Ec)
call print_RG0F2(nBas,nO,eHF,SigC,eGF,Z,ENuc,ERHF,Ec)
! Perform BSE2 calculation
@ -95,8 +97,8 @@ subroutine G0F2(dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet,linearize,eta,regu
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A50,F20.10)') 'Tr@phBSE@G0F2 correlation energy (singlet) =',EcBSE(1)
write(*,'(2X,A50,F20.10)') 'Tr@phBSE@G0F2 correlation energy (triplet) =',EcBSE(2)
write(*,'(2X,A50,F20.10)') 'Tr@phBSE@G0F2 correlation energy =',sum(EcBSE(:))
write(*,'(2X,A50,F20.10)') 'Tr@phBSE@G0F2 total energy =',ENuc + ERHF + sum(EcBSE(:))
write(*,'(2X,A50,F20.10)') 'Tr@phBSE@G0F2 correlation energy =',sum(EcBSE)
write(*,'(2X,A50,F20.10)') 'Tr@phBSE@G0F2 total energy =',ENuc + ERHF + sum(EcBSE)
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)
@ -108,15 +110,27 @@ subroutine G0F2(dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet,linearize,eta,regu
call GF2_ppBSE2(TDA,dBSE,dTDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,ERI,dipole_int,eGF,EcBSE)
EcBSE(2) = 3d0*EcBSE(2)
write(*,*)
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@G0F2 correlation energy (singlet) =',EcBSE(1),' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@G0F2 correlation energy (triplet) =',3d0*EcBSE(2),' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@G0F2 correlation energy =',EcBSE(1) + 3d0*EcBSE(2),' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@G0F2 total energy =',ENuc + ERHF + EcBSE(1) + 3d0*EcBSE(2),' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@G0F2 correlation energy (triplet) =',EcBSE(2),' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@G0F2 correlation energy =',sum(EcBSE),' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@G0F2 total energy =',ENuc + ERHF + sum(EcBSE),' au'
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)
end if
! Testing zone
if(dotest) then
call dump_test_value('R','G0F2 correlation energy',Ec)
call dump_test_value('R','G0F2 HOMO energy',eGF(nO))
call dump_test_value('R','G0F2 LUMO energy',eGF(nO+1))
end if
end subroutine

3
src/GF/G0F3.f90 → src/GF/RG0F3.f90
View File

@ -1,4 +1,4 @@
subroutine G0F3(renormalization,nBas,nC,nO,nV,nR,V,e0)
subroutine RG0F3(dotest,renormalization,nBas,nC,nO,nV,nR,V,e0)
! Perform third-order Green function calculation in diagonal approximation
@ -7,6 +7,7 @@
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: renormalization
integer,intent(in) :: nBas,nC,nO,nV,nR
double precision,intent(in) :: e0(nBas),V(nBas,nBas,nBas,nBas)

32
src/GF/RGF.f90
View File

@ -1,4 +1,4 @@
subroutine RGF(doG0F2,doevGF2,doqsGF2,doG0F3,doevGF3,renorm,maxSCF,thresh,max_diis, &
subroutine RGF(dotest,doG0F2,doevGF2,doqsGF2,doG0F3,doevGF3,renorm,maxSCF,thresh,max_diis, &
dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet,linearize,eta,regularize, &
nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc,ERI_AO,ERI, &
dipole_int_AO,dipole_int,PHF,cHF,epsHF)
@ -10,11 +10,13 @@ subroutine RGF(doG0F2,doevGF2,doqsGF2,doG0F3,doevGF3,renorm,maxSCF,thresh,max_di
! Input variables
logical :: doG0F2
logical :: doevGF2
logical :: doqsGF2
logical :: doG0F3
logical :: doevGF3
logical,intent(in) :: dotest
logical,intent(in) :: doG0F2
logical,intent(in) :: doevGF2
logical,intent(in) :: doqsGF2
logical,intent(in) :: doG0F3
logical,intent(in) :: doevGF3
integer :: renorm
integer,intent(in) :: maxSCF
@ -68,8 +70,8 @@ subroutine RGF(doG0F2,doevGF2,doqsGF2,doG0F3,doevGF3,renorm,maxSCF,thresh,max_di
if(doG0F2) then
call wall_time(start_GF)
call G0F2(dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet,linearize,eta,regularize, &
nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,epsHF)
call RG0F2(dotest,dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet,linearize,eta,regularize, &
nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,epsHF)
call wall_time(end_GF)
t_GF = end_GF - start_GF
@ -85,9 +87,9 @@ subroutine RGF(doG0F2,doevGF2,doqsGF2,doG0F3,doevGF3,renorm,maxSCF,thresh,max_di
if(doevGF2) then
call wall_time(start_GF)
call evGF2(dophBSE,doppBSE,TDA,dBSE,dTDA,maxSCF,thresh,max_diis, &
singlet,triplet,linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,EHF, &
ERI,dipole_int,epsHF)
call evRGF2(dotest,dophBSE,doppBSE,TDA,dBSE,dTDA,maxSCF,thresh,max_diis, &
singlet,triplet,linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,EHF, &
ERI,dipole_int,epsHF)
call wall_time(end_GF)
t_GF = end_GF - start_GF
@ -103,8 +105,8 @@ subroutine RGF(doG0F2,doevGF2,doqsGF2,doG0F3,doevGF3,renorm,maxSCF,thresh,max_di
if(doqsGF2) then
call wall_time(start_GF)
call qsGF2(maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet,eta,regularize,nNuc,ZNuc,rNuc,ENuc, &
nBas,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc,ERI_AO,ERI,dipole_int_AO,dipole_int,PHF,cHF,epsHF)
call qsRGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet,eta,regularize,nNuc,ZNuc,rNuc,ENuc, &
nBas,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc,ERI_AO,ERI,dipole_int_AO,dipole_int,PHF,cHF,epsHF)
call wall_time(end_GF)
t_GF = end_GF - start_GF
@ -120,7 +122,7 @@ subroutine RGF(doG0F2,doevGF2,doqsGF2,doG0F3,doevGF3,renorm,maxSCF,thresh,max_di
if(doG0F3) then
call wall_time(start_GF)
call G0F3(renorm,nBas,nC,nO,nV,nR,ERI,epsHF)
call RG0F3(dotest,renorm,nBas,nC,nO,nV,nR,ERI,epsHF)
call wall_time(end_GF)
t_GF = end_GF - start_GF
@ -136,7 +138,7 @@ subroutine RGF(doG0F2,doevGF2,doqsGF2,doG0F3,doevGF3,renorm,maxSCF,thresh,max_di
if(doevGF3) then
call wall_time(start_GF)
call evGF3(maxSCF,thresh,max_diis,renorm,nBas,nC,nO,nV,nR,ERI,epsHF)
call evRGF3(dotest,maxSCF,thresh,max_diis,renorm,nBas,nC,nO,nV,nR,ERI,epsHF)
call wall_time(end_GF)
t_GF = end_GF - start_GF

43
src/GF/UG0F2.f90
View File

@ -1,4 +1,4 @@
subroutine UG0F2(BSE,TDA,dBSE,dTDA,spin_conserved,spin_flip,linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,EUHF, &
subroutine UG0F2(dotest,BSE,TDA,dBSE,dTDA,spin_conserved,spin_flip,linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,EUHF, &
ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb,eHF)
! Perform unrestricted G0W0 calculation
@ -9,6 +9,8 @@ subroutine UG0F2(BSE,TDA,dBSE,dTDA,spin_conserved,spin_flip,linearize,eta,regula
! Input variables
logical,intent(in) :: dotest
logical,intent(in) :: BSE
logical,intent(in) :: TDA
logical,intent(in) :: dBSE
@ -44,18 +46,17 @@ subroutine UG0F2(BSE,TDA,dBSE,dTDA,spin_conserved,spin_flip,linearize,eta,regula
double precision,allocatable :: Z(:,:)
integer :: nS_aa,nS_bb,nS_sc
double precision,allocatable :: eGF2lin(:,:)
double precision,allocatable :: eGF2(:,:)
double precision,allocatable :: eGFlin(:,:)
double precision,allocatable :: eGF(:,:)
! Output variables
! Hello world
write(*,*)
write(*,*)'************************************************'
write(*,*)'| One-shot G0F2 calculation |'
write(*,*)'| *** Unrestricted version *** |'
write(*,*)'************************************************'
write(*,*)'*********************************'
write(*,*)'* Unrestricted G0F2 Calculation *'
write(*,*)'*********************************'
write(*,*)
! TDA
@ -71,7 +72,7 @@ subroutine UG0F2(BSE,TDA,dBSE,dTDA,spin_conserved,spin_flip,linearize,eta,regula
nS_bb = nS(2)
nS_sc = nS_aa + nS_bb
allocate(SigC(nBas,nspin),Z(nBas,nspin),eGF2(nBas,nspin),eGF2lin(nBas,nspin))
allocate(SigC(nBas,nspin),Z(nBas,nspin),eGF(nBas,nspin),eGFlin(nBas,nspin))
!---------------------!
! Compute self-energy !
@ -91,31 +92,33 @@ subroutine UG0F2(BSE,TDA,dBSE,dTDA,spin_conserved,spin_flip,linearize,eta,regula
! Solve the quasi-particle equation !
!-----------------------------------!
eGF2lin(:,:) = eHF(:,:) + Z(:,:)*SigC(:,:)
eGFlin(:,:) = eHF(:,:) + Z(:,:)*SigC(:,:)
if(linearize) then
write(*,*) ' *** Quasiparticle energies obtained by linearization *** '
write(*,*)
eGF2(:,:) = eGF2lin(:,:)
eGF(:,:) = eGFlin(:,:)
else
! Find graphical solution of the QP equation
print*,'!!! Graphical solution NYI for UG0F2 !!!'
stop
write(*,*) '!!! Graphical solution NYI for UG0F2 !!!'
write(*,*) ' *** Quasiparticle energies obtained by linearization *** '
eGF(:,:) = eGFlin(:,:)
end if
! Compute MP2 correlation energy
call UMP2(nBas,nC,nO,nV,nR,ERI_aaaa,ERI_aabb,ERI_bbbb,ENuc,EUHF,eGF2,Ec)
call UMP2(.false.,nBas,nC,nO,nV,nR,ERI_aaaa,ERI_aabb,ERI_bbbb,ENuc,EUHF,eGF,Ec)
! Dump results
call print_UG0F2(nBas,nO,eHF,ENuc,EUHF,SigC,Z,eGF2,Ec)
call print_UG0F2(nBas,nO,eHF,ENuc,EUHF,SigC,Z,eGF,Ec)
! Perform BSE calculation
@ -125,4 +128,16 @@ subroutine UG0F2(BSE,TDA,dBSE,dTDA,spin_conserved,spin_flip,linearize,eta,regula
end if
! Testing zone
if(dotest) then
call dump_test_value('U','G0F2 correlation energy',Ec)
call dump_test_value('U','G0F2 HOMOa energy',eGF(nO(1),1))
call dump_test_value('U','G0F2 LUMOa energy',eGF(nO(1)+1,1))
call dump_test_value('U','G0F2 HOMOa energy',eGF(nO(2),2))
call dump_test_value('U','G0F2 LUMOa energy',eGF(nO(2)+1,2))
end if
end subroutine

20
src/GF/UGF.f90
View File

@ -1,4 +1,4 @@
subroutine UGF(doG0F2,doevGF2,doqsGF2,doG0F3,doevGF3,renorm,maxSCF,thresh,max_diis, &
subroutine UGF(dotest,doG0F2,doevGF2,doqsGF2,doG0F3,doevGF3,renorm,maxSCF,thresh,max_diis, &
dophBSE,doppBSE,TDA,dBSE,dTDA,spin_conserved,spin_flip,linearize,eta,regularize, &
nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc,ERI_AO,ERI_aaaa,ERI_aabb,ERI_bbbb, &
dipole_int_AO,dipole_int_aa,dipole_int_bb,PHF,cHF,epsHF)
@ -10,11 +10,13 @@ subroutine UGF(doG0F2,doevGF2,doqsGF2,doG0F3,doevGF3,renorm,maxSCF,thresh,max_di
! Input variables
logical :: doG0F2
logical :: doevGF2
logical :: doqsGF2
logical :: doG0F3
logical :: doevGF3
logical,intent(in) :: dotest
logical,intent(in) :: doG0F2
logical,intent(in) :: doevGF2
logical,intent(in) :: doqsGF2
logical,intent(in) :: doG0F3
logical,intent(in) :: doevGF3
integer :: renorm
integer,intent(in) :: maxSCF
@ -71,7 +73,7 @@ subroutine UGF(doG0F2,doevGF2,doqsGF2,doG0F3,doevGF3,renorm,maxSCF,thresh,max_di
if(doG0F2) then
call wall_time(start_GF)
call UG0F2(dophBSE,TDA,dBSE,dTDA,spin_conserved,spin_flip,linearize,eta,regularize, &
call UG0F2(dotest,dophBSE,TDA,dBSE,dTDA,spin_conserved,spin_flip,linearize,eta,regularize, &
nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI_aaaa,ERI_aabb,ERI_bbbb, &
dipole_int_aa,dipole_int_bb,epsHF)
call wall_time(end_GF)
@ -89,7 +91,7 @@ subroutine UGF(doG0F2,doevGF2,doqsGF2,doG0F3,doevGF3,renorm,maxSCF,thresh,max_di
if(doevGF2) then
call wall_time(start_GF)
call evUGF2(maxSCF,thresh,max_diis,dophBSE,TDA,dBSE,dTDA,spin_conserved,spin_flip, &
call evUGF2(dotest,maxSCF,thresh,max_diis,dophBSE,TDA,dBSE,dTDA,spin_conserved,spin_flip, &
eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI_aaaa,ERI_aabb,ERI_bbbb, &
dipole_int_aa,dipole_int_bb,cHF,epsHF)
call wall_time(end_GF)
@ -107,7 +109,7 @@ subroutine UGF(doG0F2,doevGF2,doqsGF2,doG0F3,doevGF3,renorm,maxSCF,thresh,max_di
if(doqsGF2) then
call wall_time(start_GF)
call qsUGF2(maxSCF,thresh,max_diis,dophBSE,TDA,dBSE,dTDA,spin_conserved,spin_flip,eta,regularize, &
call qsUGF2(dotest,maxSCF,thresh,max_diis,dophBSE,TDA,dBSE,dTDA,spin_conserved,spin_flip,eta,regularize, &
nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc,ERI_AO, &
ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_AO,dipole_int_aa,dipole_int_bb,PHF,cHF,epsHF)
call wall_time(end_GF)

24
src/GF/evGGF2.f90
View File

@ -1,4 +1,4 @@
subroutine evGGF2(dophBSE,doppBSE,TDA,dBSE,dTDA,maxSCF,thresh,max_diis, &
subroutine evGGF2(dotest,dophBSE,doppBSE,TDA,dBSE,dTDA,maxSCF,thresh,max_diis, &
linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF)
! Perform eigenvalue self-consistent second-order Green function calculation
@ -8,6 +8,8 @@ subroutine evGGF2(dophBSE,doppBSE,TDA,dBSE,dTDA,maxSCF,thresh,max_diis, &
! Input variables
logical,intent(in) :: dotest
logical,intent(in) :: dophBSE
logical,intent(in) :: doppBSE
logical,intent(in) :: TDA
@ -50,9 +52,9 @@ subroutine evGGF2(dophBSE,doppBSE,TDA,dBSE,dTDA,maxSCF,thresh,max_diis, &
! Hello world
write(*,*)
write(*,*)'************************************************'
write(*,*)'| Second-order Green function calculation |'
write(*,*)'************************************************'
write(*,*)'*********************************'
write(*,*)'* Generalized evGF2 Calculation *'
write(*,*)'*********************************'
write(*,*)
! Memory allocation
@ -105,8 +107,8 @@ subroutine evGGF2(dophBSE,doppBSE,TDA,dBSE,dTDA,maxSCF,thresh,max_diis, &
! Print results
call GMP2(regularize,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eGF,Ec)
call print_evGF2(nBas,nO,nSCF,Conv,eHF,SigC,Z,eGF,ENuc,ERHF,Ec)
call GMP2(.false.,regularize,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eGF,Ec)
call print_evRGF2(nBas,nO,nSCF,Conv,eHF,SigC,Z,eGF,ENuc,ERHF,Ec)
! DIIS extrapolation
@ -170,4 +172,14 @@ subroutine evGGF2(dophBSE,doppBSE,TDA,dBSE,dTDA,maxSCF,thresh,max_diis, &
! end if
! Testing zone
if(dotest) then
call dump_test_value('G','evGF2 correlation energy',Ec)
call dump_test_value('G','evGF2 HOMO energy',eGF(nO))
call dump_test_value('G','evGF2 LUMO energy',eGF(nO+1))
end if
end subroutine

25
src/GF/evGF2.f90 → src/GF/evRGF2.f90
View File

@ -1,4 +1,4 @@
subroutine evGF2(dophBSE,doppBSE,TDA,dBSE,dTDA,maxSCF,thresh,max_diis,singlet,triplet, &
subroutine evRGF2(dotest,dophBSE,doppBSE,TDA,dBSE,dTDA,maxSCF,thresh,max_diis,singlet,triplet, &
linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF)
! Perform eigenvalue self-consistent second-order Green function calculation
@ -8,6 +8,8 @@ subroutine evGF2(dophBSE,doppBSE,TDA,dBSE,dTDA,maxSCF,thresh,max_diis,singlet,tr
! Input variables
logical,intent(in) :: dotest
logical,intent(in) :: dophBSE
logical,intent(in) :: doppBSE
logical,intent(in) :: TDA
@ -51,10 +53,11 @@ subroutine evGF2(dophBSE,doppBSE,TDA,dBSE,dTDA,maxSCF,thresh,max_diis,singlet,tr
! Hello world
write(*,*)
write(*,*)'************************************************'
write(*,*)'| Second-order Green function calculation |'
write(*,*)'************************************************'
write(*,*)'********************************'
write(*,*)'* Restricted evGF2 Calculation *'
write(*,*)'********************************'
write(*,*)
! Memory allocation
@ -107,8 +110,8 @@ subroutine evGF2(dophBSE,doppBSE,TDA,dBSE,dTDA,maxSCF,thresh,max_diis,singlet,tr
! Print results
call RMP2(regularize,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eGF,Ec)
call print_evGF2(nBas,nO,nSCF,Conv,eHF,SigC,Z,eGF,ENuc,ERHF,Ec)
call RMP2(.false.,regularize,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eGF,Ec)
call print_evRGF2(nBas,nO,nSCF,Conv,eHF,SigC,Z,eGF,ENuc,ERHF,Ec)
! DIIS extrapolation
@ -176,4 +179,14 @@ subroutine evGF2(dophBSE,doppBSE,TDA,dBSE,dTDA,maxSCF,thresh,max_diis,singlet,tr
end if
! Testing zone
if(dotest) then
call dump_test_value('R','evGF2 correlation energy',Ec)
call dump_test_value('R','evGF2 HOMO energy',eGF(nO))
call dump_test_value('R','evGF2 LUMO energy',eGF(nO+1))
end if
end subroutine

4
src/GF/evGF3.f90 → src/GF/evRGF3.f90
View File

@ -1,4 +1,4 @@
subroutine evGF3(maxSCF,thresh,max_diis,renormalization,nBas,nC,nO,nV,nR,V,e0)
subroutine evRGF3(dotest,maxSCF,thresh,max_diis,renormalization,nBas,nC,nO,nV,nR,V,e0)
! Perform third-order Green function calculation in diagonal approximation
@ -7,6 +7,8 @@
! Input variables
logical,intent(in) :: dotest
double precision,intent(in) :: thresh
integer,intent(in) :: maxSCF,max_diis,renormalization
integer,intent(in) :: nBas,nC,nO,nV,nR

13
src/GF/evUGF2.f90
View File

@ -1,4 +1,4 @@
subroutine evUGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,spin_conserved,spin_flip, &
subroutine evUGF2(dotest,maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,spin_conserved,spin_flip, &
eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,EUHF,ERI_aaaa,ERI_aabb,ERI_bbbb, &
dipole_int_aa,dipole_int_bb,cHF,eHF)
@ -9,6 +9,8 @@ subroutine evUGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,spin_conserved,spin_f
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
@ -61,10 +63,11 @@ subroutine evUGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,spin_conserved,spin_f
! Hello world
write(*,*)
write(*,*)'**************************************************'
write(*,*)'| Self-consistent unrestricted evGF2 calculation |'
write(*,*)'**************************************************'
write(*,*)'*********************************'
write(*,*)'* Unrestricted G0F2 Calculation *'
write(*,*)'*********************************'
write(*,*)
! TDA
@ -133,7 +136,7 @@ subroutine evUGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,spin_conserved,spin_f
! Compute MP2 correlation energy
call UMP2(nBas,nC,nO,nV,nR,ERI_aaaa,ERI_aabb,ERI_bbbb,ENuc,EUHF,eGF2,Ec)
call UMP2(.false.,nBas,nC,nO,nV,nR,ERI_aaaa,ERI_aabb,ERI_bbbb,ENuc,EUHF,eGF2,Ec)
! Print results

2
src/GF/print_G0F2.f90 → src/GF/print_RG0F2.f90
View File

@ -1,4 +1,4 @@
subroutine print_G0F2(nBas,nO,eHF,Sig,eGF,Z,ENuc,ERHF,Ec)
subroutine print_RG0F2(nBas,nO,eHF,Sig,eGF,Z,ENuc,ERHF,Ec)
! Print one-electron energies and other stuff for G0F2

24
src/GF/print_UG0F2.f90
View File

@ -37,17 +37,17 @@ subroutine print_UG0F2(nBas,nO,eHF,ENuc,EUHF,SigC,Z,eGF2,Ec)
! Dump results
write(*,*)'-------------------------------------------------------------------------------&
------------------------------------------------'
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
write(*,*)' Unrestricted one-shot G0F2 calculation (eV)'
write(*,*)'-------------------------------------------------------------------------------&
------------------------------------------------'
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(*,*)'-------------------------------------------------------------------------------&
------------------------------------------------'
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
do p=1,nBas
write(*,'(A1,I3,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1)') &
@ -55,17 +55,17 @@ subroutine print_UG0F2(nBas,nO,eHF,ENuc,EUHF,SigC,Z,eGF2,Ec)
Z(p,1),Z(p,2),'|',eGF2(p,1)*HaToeV,eGF2(p,2)*HaToeV,'|'
enddo
write(*,*)'-------------------------------------------------------------------------------&
------------------------------------------------'
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(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
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(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
write(*,*)
end subroutine

2
src/GF/print_evGF2.f90 → src/GF/print_evRGF2.f90
View File

@ -1,4 +1,4 @@
subroutine print_evGF2(nBas,nO,nSCF,Conv,eHF,Sig,Z,eGF,ENuc,ERHF,Ec)
subroutine print_evRGF2(nBas,nO,nSCF,Conv,eHF,Sig,Z,eGF,ENuc,ERHF,Ec)
! Print one-electron energies and other stuff for G0F2

28
src/GF/print_evUGF2.f90
View File

@ -39,21 +39,21 @@ subroutine print_evUGF2(nBas,nO,nSCF,Conv,eHF,ENuc,EUHF,SigC,Z,eGF2,Ec)
! Dump results
write(*,*)'-------------------------------------------------------------------------------&
-------------------------------------------------'
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(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
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(*,*)'-------------------------------------------------------------------------------&
-------------------------------------------------'
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
do p=1,nBas
write(*,'(A1,I3,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1)') &
@ -61,21 +61,21 @@ subroutine print_evUGF2(nBas,nO,nSCF,Conv,eHF,ENuc,EUHF,SigC,Z,eGF2,Ec)
Z(p,1),Z(p,2),'|',eGF2(p,1)*HaToeV,eGF2(p,2)*HaToeV,'|'
enddo
write(*,*)'-------------------------------------------------------------------------------&
-------------------------------------------------'
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
write(*,'(2X,A10,I3)') 'Iteration ',nSCF
write(*,'(2X,A14,F15.5)')'Convergence = ',Conv
write(*,*)'-------------------------------------------------------------------------------&
-------------------------------------------------'
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(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
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(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
write(*,*)
end subroutine

2
src/GF/print_qsGF2.f90 → src/GF/print_qsRGF2.f90
View File

@ -1,4 +1,4 @@
subroutine print_qsGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF,c,SigC,Z,ENuc,ET,EV,EJ,Ex,Ec,EqsGF,dipole)
subroutine print_qsRGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF,c,SigC,Z,ENuc,ET,EV,EJ,Ex,Ec,EqsGF,dipole)
! Print one-electron energies and other stuff for qsGF2

28
src/GF/print_qsUGF2.f90
View File

@ -66,21 +66,21 @@ subroutine print_qsUGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,cGF2,PGF2,Ov,T,V,J,K,
! Dump results
write(*,*)'-------------------------------------------------------------------------------&
-------------------------------------------------'
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
if(nSCF < 10) then
write(*,'(1X,A21,I1,A2,A12)')' Self-consistent qsG',nSCF,'F2',' calculation'
else
write(*,'(1X,A21,I2,A2,A12)')' Self-consistent qsG',nSCF,'F2',' calculation'
endif
write(*,*)'-------------------------------------------------------------------------------&
-------------------------------------------------'
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(*,*)'-------------------------------------------------------------------------------&
-------------------------------------------------'
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
do p=1,nBas
write(*,'(A1,I3,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1)') &
@ -88,22 +88,22 @@ subroutine print_qsUGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF2,cGF2,PGF2,Ov,T,V,J,K,
Z(p,1),Z(p,2),'|',eGF2(p,1)*HaToeV,eGF2(p,2)*HaToeV,'|'
enddo
write(*,*)'-------------------------------------------------------------------------------&
-------------------------------------------------'
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
write(*,'(2X,A10,I3)') 'Iteration ',nSCF
write(*,'(2X,A14,F15.5)')'Convergence = ',Conv
write(*,*)'-------------------------------------------------------------------------------&
-------------------------------------------------'
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(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
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(*,*)'-------------------------------------------------------------------------------&
-------------------------------------------------'
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
write(*,*)
! Dump results for final iteration

25
src/GF/qsGF2.f90 → src/GF/qsRGF2.f90
View File

@ -1,4 +1,4 @@
subroutine qsGF2(maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet, &
subroutine qsRGF2(dotest,maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet, &
eta,regularize,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)
@ -9,6 +9,8 @@ subroutine qsGF2(maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,tr
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
@ -78,10 +80,11 @@ subroutine qsGF2(maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,tr
! Hello world
write(*,*)
write(*,*)'************************************************'
write(*,*)'| Self-consistent qsGF2 calculation |'
write(*,*)'************************************************'
write(*,*)'********************************'
write(*,*)'* Restricted qsGF2 Calculation *'
write(*,*)'********************************'
write(*,*)
! Warning
@ -216,7 +219,7 @@ subroutine qsGF2(maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,tr
! Correlation energy
call RMP2(regularize,nBas,nC,nO,nV,nR,ERI_MO,ENuc,EqsGF2,eGF,Ec)
call RMP2(.false.,regularize,nBas,nC,nO,nV,nR,ERI_MO,ENuc,EqsGF2,eGF,Ec)
! Total energy
@ -228,7 +231,7 @@ subroutine qsGF2(maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,tr
!------------------------------------------------------------------------
call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int_AO,dipole)
call print_qsGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF,c,SigCp,Z,ENuc,ET,EV,EJ,Ex,Ec,EqsGF2,dipole)
call print_qsRGF2(nBas,nO,nSCF,Conv,thresh,eHF,eGF,c,SigCp,Z,ENuc,ET,EV,EJ,Ex,Ec,EqsGF2,dipole)
enddo
!------------------------------------------------------------------------
@ -288,4 +291,14 @@ subroutine qsGF2(maxSCF,thresh,max_diis,dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,tr
end if
! Testing zone
if(dotest) then
call dump_test_value('R','qsGF2 correlation energy',Ec)
call dump_test_value('R','qsGF2 HOMO energy',eGF(nO))
call dump_test_value('R','qsGF2 LUMO energy',eGF(nO+1))
end if
end subroutine

13
src/GF/qsUGF2.f90
View File

@ -1,4 +1,4 @@
subroutine qsUGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,spin_conserved,spin_flip,eta,regularize, &
subroutine qsUGF2(dotest,maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,spin_conserved,spin_flip,eta,regularize, &
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)
@ -9,6 +9,8 @@ subroutine qsUGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,spin_conserved,spin_f
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
@ -89,10 +91,11 @@ subroutine qsUGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,spin_conserved,spin_f
! Hello world
write(*,*)
write(*,*)'**************************************************'
write(*,*)'| Self-consistent unrestricted qsGF2 calculation |'
write(*,*)'**************************************************'
write(*,*)'**********************************'
write(*,*)'* Unrestricted qsGF2 Calculation *'
write(*,*)'**********************************'
write(*,*)
! Warning
@ -290,7 +293,7 @@ subroutine qsUGF2(maxSCF,thresh,max_diis,BSE,TDA,dBSE,dTDA,spin_conserved,spin_f
! Correlation energy
call UMP2(nBas,nC,nO,nV,nR,ERI_aaaa,ERI_aabb,ERI_bbbb,ENuc,EqsGF2,eGF2,Ec)
call UMP2(.false.,nBas,nC,nO,nV,nR,ERI_aaaa,ERI_aabb,ERI_bbbb,ENuc,EqsGF2,eGF2,Ec)
! Total energy

23
src/GT/G0T0eh.f90 → src/GT/RG0T0eh.f90
View File

@ -1,6 +1,5 @@
subroutine G0T0eh(doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_T,TDA,dBSE,dTDA,doppBSE, &
singlet,triplet,linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,ERHF, &
ERI,dipole_int,eHF)
subroutine RG0T0eh(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_T,TDA,dBSE,dTDA,doppBSE, &
singlet,triplet,linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF)
! Perform ehG0T0 calculation
@ -10,6 +9,8 @@ subroutine G0T0eh(doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_T,TDA,dBSE,
! Input variables
logical,intent(in) :: dotest
logical,intent(in) :: doACFDT
logical,intent(in) :: exchange_kernel
logical,intent(in) :: doXBS
@ -73,9 +74,9 @@ subroutine G0T0eh(doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_T,TDA,dBSE,
! Hello world
write(*,*)
write(*,*)'************************************************'
write(*,*)'| One-shot G0T0eh calculation |'
write(*,*)'************************************************'
write(*,*)'*********************************'
write(*,*)'* Restricted G0T0eh Calculation *'
write(*,*)'*********************************'
write(*,*)
! Initialization
@ -167,4 +168,14 @@ subroutine G0T0eh(doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_T,TDA,dBSE,
call print_G0T0eh(nBas,nO,eHF,ENuc,ERHF,Sig,Z,eGT,EcRPA,EcGM)
! Testing zone
if(dotest) then
call dump_test_value('R','G0T0eh correlation energy',EcRPA)
call dump_test_value('R','G0T0eh HOMO energy',eGT(nO))
call dump_test_value('R','G0T0eh LUMO energy',eGT(nO+1))
end if
end subroutine

34
src/GT/G0T0pp.f90 → src/GT/RG0T0pp.f90
View File

@ -1,5 +1,5 @@
subroutine G0T0pp(doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,dTDA,doppBSE,singlet,triplet, &
linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF)
subroutine RG0T0pp(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,dTDA,doppBSE,singlet,triplet, &
linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF)
! Perform one-shot calculation with a T-matrix self-energy (G0T0)
@ -8,6 +8,8 @@ subroutine G0T0pp(doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,dTDA,dopp
! Input variables
logical,intent(in) :: dotest
logical,intent(in) :: doACFDT
logical,intent(in) :: exchange_kernel
logical,intent(in) :: doXBS
@ -65,9 +67,9 @@ subroutine G0T0pp(doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,dTDA,dopp
! Hello world
write(*,*)
write(*,*)'************************************************'
write(*,*)'| One-shot G0T0pp calculation |'
write(*,*)'************************************************'
write(*,*)'*********************************'
write(*,*)'* Restricted G0T0pp Calculation *'
write(*,*)'*********************************'
write(*,*)
@ -260,8 +262,8 @@ subroutine G0T0pp(doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,dTDA,dopp
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A50,F20.10,A3)') 'Tr@phBSE@G0T0pp correlation energy (singlet) =',EcBSE(1),' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@phBSE@G0T0pp correlation energy (triplet) =',EcBSE(2),' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@phBSE@G0T0pp correlation energy =',EcBSE(1) + EcBSE(2),' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@phBSE@G0T0pp total energy =',ENuc + ERHF + EcBSE(1) + EcBSE(2),' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@phBSE@G0T0pp correlation energy =',sum(EcBSE),' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@phBSE@G0T0pp total energy =',ENuc + ERHF + sum(EcBSE),' au'
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)
@ -296,8 +298,8 @@ subroutine G0T0pp(doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,dTDA,dopp
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A50,F20.10,A3)') 'AC@phBSE@G0T0pp correlation energy (singlet) =',EcBSE(1),' au'
write(*,'(2X,A50,F20.10,A3)') 'AC@phBSE@G0T0pp correlation energy (triplet) =',EcBSE(2),' au'
write(*,'(2X,A50,F20.10,A3)') 'AC@phBSE@G0T0pp correlation energy =',EcBSE(1) + EcBSE(2),' au'
write(*,'(2X,A50,F20.10,A3)') 'AC@phBSE@G0T0pp total energy =',ENuc + ERHF + EcBSE(1) + EcBSE(2),' au'
write(*,'(2X,A50,F20.10,A3)') 'AC@phBSE@G0T0pp correlation energy =',sum(EcBSE),' au'
write(*,'(2X,A50,F20.10,A3)') 'AC@phBSE@G0T0pp total energy =',ENuc + ERHF + sum(EcBSE),' au'
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)
@ -315,11 +317,21 @@ subroutine G0T0pp(doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,dTDA,dopp
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@G0T0pp correlation energy (singlet) =',EcBSE(1),' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@G0T0pp correlation energy (triplet) =',EcBSE(2),' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@G0T0pp correlation energy =',EcBSE(1) + EcBSE(2),' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@G0T0pp total energy =',ENuc + ERHF + EcBSE(1) + EcBSE(2),' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@G0T0pp correlation energy =',sum(EcBSE),' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@ppBSE@G0T0pp total energy =',ENuc + ERHF + sum(EcBSE),' au'
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)
end if
! Testing zone
if(dotest) then
call dump_test_value('R','G0T0pp correlation energy',sum(EcRPA))
call dump_test_value('R','G0T0pp HOMO energy',eGT(nO))
call dump_test_value('R','G0T0pp LUMO energy',eGT(nO+1))
end if
end subroutine

42
src/GT/RGT.f90
View File

@ -1,4 +1,4 @@
subroutine RGT(doG0T0pp,doevGTpp,doqsGTpp,doG0T0eh,doevGTeh,doqsGTeh,maxSCF,thresh,max_diis,doACFDT, &
subroutine RGT(dotest,doG0T0pp,doevGTpp,doqsGTpp,doG0T0eh,doevGTeh,doqsGTeh,maxSCF,thresh,max_diis,doACFDT, &
exchange_kernel,doXBS,dophBSE,dophBSE2,doppBSE,TDA_T,TDA,dBSE,dTDA,singlet,triplet, &
linearize,eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc, &
ERI_AO,ERI,dipole_int_AO,dipole_int,PHF,cHF,epsHF)
@ -10,12 +10,14 @@ subroutine RGT(doG0T0pp,doevGTpp,doqsGTpp,doG0T0eh,doevGTeh,doqsGTeh,maxSCF,thre
! Input variables
logical :: doG0T0pp
logical :: doevGTpp
logical :: doqsGTpp
logical :: doG0T0eh
logical :: doevGTeh
logical :: doqsGTeh
logical,intent(in) :: dotest
logical,intent(in) :: doG0T0pp
logical,intent(in) :: doevGTpp
logical,intent(in) :: doqsGTpp
logical,intent(in) :: doG0T0eh
logical,intent(in) :: doevGTeh
logical,intent(in) :: doqsGTeh
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
@ -74,7 +76,7 @@ subroutine RGT(doG0T0pp,doevGTpp,doqsGTpp,doG0T0eh,doevGTeh,doqsGTeh,maxSCF,thre
if(doG0T0pp) then
call wall_time(start_GT)
call G0T0pp(doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,dTDA,doppBSE,singlet,triplet, &
call RG0T0pp(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,dTDA,doppBSE,singlet,triplet, &
linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,epsHF)
call wall_time(end_GT)
@ -91,8 +93,8 @@ subroutine RGT(doG0T0pp,doevGTpp,doqsGTpp,doG0T0eh,doevGTeh,doqsGTeh,maxSCF,thre
if(doevGTpp) then
call wall_time(start_GT)
call evGTpp(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,dTDA,singlet,triplet, &
linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,epsHF)
call evRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,dTDA,singlet,triplet, &
linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,epsHF)
call wall_time(end_GT)
t_GT = end_GT - start_GT
@ -108,9 +110,9 @@ subroutine RGT(doG0T0pp,doevGTpp,doqsGTpp,doG0T0eh,doevGTeh,doqsGTeh,maxSCF,thre
if(doqsGTpp) then
call wall_time(start_GT)
call qsGTpp(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,dTDA,singlet,triplet, &
eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc,ERI_AO,ERI,dipole_int_AO,dipole_int, &
PHF,cHF,epsHF)
call qsRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,dTDA,singlet,triplet, &
eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc,ERI_AO,ERI,dipole_int_AO,dipole_int, &
PHF,cHF,epsHF)
call wall_time(end_GT)
t_GT = end_GT - start_GT
@ -126,8 +128,8 @@ subroutine RGT(doG0T0pp,doevGTpp,doqsGTpp,doG0T0eh,doevGTeh,doqsGTeh,maxSCF,thre
if(doG0T0eh) then
call wall_time(start_GT)
call G0T0eh(doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_T,TDA,dBSE,dTDA,doppBSE,singlet,triplet, &
linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,epsHF)
call RG0T0eh(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_T,TDA,dBSE,dTDA,doppBSE,singlet,triplet, &
linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,epsHF)
call wall_time(end_GT)
t_GT = end_GT - start_GT
@ -143,8 +145,8 @@ subroutine RGT(doG0T0pp,doevGTpp,doqsGTpp,doG0T0eh,doevGTeh,doqsGTeh,maxSCF,thre
if(doevGTeh) then
call wall_time(start_GT)
call evGTeh(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_T,TDA,dBSE,dTDA,doppBSE, &
singlet,triplet,linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,epsHF)
call evRGTeh(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_T,TDA,dBSE,dTDA,doppBSE, &
singlet,triplet,linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,epsHF)
call wall_time(end_GT)
t_GT = end_GT - start_GT
@ -160,9 +162,9 @@ subroutine RGT(doG0T0pp,doevGTpp,doqsGTpp,doG0T0eh,doevGTeh,doqsGTeh,maxSCF,thre
if(doqsGTeh) then
call wall_time(start_GT)
call qsGTeh(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_T,TDA,dBSE,dTDA,singlet,triplet, &
eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc,ERI_AO,ERI,dipole_int_AO,dipole_int, &
PHF,cHF,epsHF)
call qsRGTeh(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_T,TDA,dBSE,dTDA,singlet,triplet, &
eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc,ERI_AO,ERI,dipole_int_AO,dipole_int, &
PHF,cHF,epsHF)
call wall_time(end_GT)
t_GT = end_GT - start_GT

37
src/GT/UG0T0pp.f90
View File

@ -1,4 +1,4 @@
subroutine UG0T0pp(doACFDT,exchange_kernel,doXBS,BSE,TDA_T,TDA,dBSE,dTDA, &
subroutine UG0T0pp(dotest,doACFDT,exchange_kernel,doXBS,BSE,TDA_T,TDA,dBSE,dTDA, &
spin_conserved,spin_flip,linearize,eta,regularize,nBas,nC,nO,nV, &
nR,nS,ENuc,EUHF,ERI_aaaa,ERI_aabb,ERI_bbbb, &
dipole_int_aa,dipole_int_bb,cHF,eHF)
@ -10,6 +10,8 @@ subroutine UG0T0pp(doACFDT,exchange_kernel,doXBS,BSE,TDA_T,TDA,dBSE,dTDA, &
! Input variables
logical,intent(in) :: dotest
logical,intent(in) :: doACFDT
logical,intent(in) :: exchange_kernel
logical,intent(in) :: doXBS
@ -60,17 +62,16 @@ subroutine UG0T0pp(doACFDT,exchange_kernel,doXBS,BSE,TDA_T,TDA,dBSE,dTDA, &
double precision,allocatable :: rho2ab(:,:,:),rho2aa(:,:,:),rho2bb(:,:,:)
double precision,allocatable :: SigT(:,:)
double precision,allocatable :: Z(:,:)
double precision,allocatable :: eG0T0(:,:)
double precision,allocatable :: eGT(:,:)
! Output variables
! Hello world
write(*,*)
write(*,*)'************************************************'
write(*,*)'| One-shot G0T0 calculation |'
write(*,*)'| *** Unrestricted version *** |'
write(*,*)'************************************************'
write(*,*)'***********************************'
write(*,*)'* Unrestricted G0T0pp Calculation *'
write(*,*)'***********************************'
write(*,*)
! Dimensions of the pp-URPA linear reponse matrices
@ -101,7 +102,7 @@ subroutine UG0T0pp(doACFDT,exchange_kernel,doXBS,BSE,TDA_T,TDA,dBSE,dTDA, &
Om1bb(nPbb),X1bb(nPbb,nPbb),Y1bb(nHbb,nPbb), &
Om2bb(nPbb),X2bb(nPbb,nPbb),Y2bb(nHbb,nPbb), &
rho1bb(nBas,nBas,nPbb),rho2bb(nBas,nBas,nHbb), &
SigT(nBas,nspin),Z(nBas,nspin),eG0T0(nBas,nspin))
SigT(nBas,nspin),Z(nBas,nspin),eGT(nBas,nspin))
!----------------------------------------------
! alpha-beta block
@ -183,7 +184,7 @@ subroutine UG0T0pp(doACFDT,exchange_kernel,doXBS,BSE,TDA_T,TDA,dBSE,dTDA, &
if(linearize) then
eG0T0(:,:) = eHF(:,:) + Z(:,:)*SigT(:,:)
eGT(:,:) = eHF(:,:) + Z(:,:)*SigT(:,:)
else
@ -203,7 +204,7 @@ subroutine UG0T0pp(doACFDT,exchange_kernel,doXBS,BSE,TDA_T,TDA,dBSE,dTDA, &
ispin = 1
iblock = 3
call ppULR(iblock,TDA,nBas,nC,nO,nV,nR,nPaa,nPab,nPbb,nPab,nHaa,nHab,nHbb,nHab,1d0,eG0T0,ERI_aaaa, &
call ppULR(iblock,TDA,nBas,nC,nO,nV,nR,nPaa,nPab,nPbb,nPab,nHaa,nHab,nHbb,nHab,1d0,eGT,ERI_aaaa, &
ERI_aabb,ERI_bbbb,Om1ab,X1ab,Y1ab,Om2ab,X2ab,Y2ab,EcRPA(ispin))
!alpha-alpha block
@ -211,7 +212,7 @@ subroutine UG0T0pp(doACFDT,exchange_kernel,doXBS,BSE,TDA_T,TDA,dBSE,dTDA, &
ispin = 2
iblock = 4
call ppULR(iblock,TDA,nBas,nC,nO,nV,nR,nPaa,nPab,nPbb,nPaa,nHaa,nHab,nHbb,nHaa,1d0,eG0T0,ERI_aaaa, &
call ppULR(iblock,TDA,nBas,nC,nO,nV,nR,nPaa,nPab,nPbb,nPaa,nHaa,nHab,nHbb,nHaa,1d0,eGT,ERI_aaaa, &
ERI_aabb,ERI_bbbb,Om1aa,X1aa,Y1aa,Om2aa,X2aa,Y2aa,EcRPA(ispin))
Ecaa = EcRPA(2)
@ -220,7 +221,7 @@ subroutine UG0T0pp(doACFDT,exchange_kernel,doXBS,BSE,TDA_T,TDA,dBSE,dTDA, &
iblock = 7
call ppULR(iblock,TDA,nBas,nC,nO,nV,nR,nPaa,nPab,nPbb,nPbb,nHaa,nHab,nHbb,nHbb,1d0,eG0T0,ERI_aaaa, &
call ppULR(iblock,TDA,nBas,nC,nO,nV,nR,nPaa,nPab,nPbb,nPbb,nHaa,nHab,nHbb,nHbb,1d0,eGT,ERI_aaaa, &
ERI_aabb,ERI_bbbb,Om1bb,X1bb,Y1bb,Om2bb,X2bb,Y2bb,EcRPA(ispin))
Ecbb = EcRPA(2)
@ -228,7 +229,7 @@ subroutine UG0T0pp(doACFDT,exchange_kernel,doXBS,BSE,TDA_T,TDA,dBSE,dTDA, &
EcRPA(1) = EcRPA(1) - EcRPA(2)
EcRPA(2) = 3d0*EcRPA(2)
call print_UG0T0(nBas,nO,eHF,ENuc,EUHF,SigT,Z,eG0T0,EcGM,EcRPA)
call print_UG0T0(nBas,nO,eHF,ENuc,EUHF,SigT,Z,eGT,EcGM,EcRPA)
! Free memory
@ -236,4 +237,16 @@ subroutine UG0T0pp(doACFDT,exchange_kernel,doXBS,BSE,TDA_T,TDA,dBSE,dTDA, &
Om1aa,X1aa,Y1aa,Om2aa,X2aa,Y2aa,rho1aa,rho2aa, &
Om1bb,X1bb,Y1bb,Om2bb,X2bb,Y2bb,rho1bb,rho2bb)
! Testing zone
if(dotest) then
call dump_test_value('U','G0T0pp correlation energy',sum(EcRPA))
call dump_test_value('U','G0T0pp HOMOa energy',eGT(nO(1),1))
call dump_test_value('U','G0T0pp LUMOa energy',eGT(nO(1)+1,1))
call dump_test_value('U','G0T0pp HOMOa energy',eGT(nO(2),2))
call dump_test_value('U','G0T0pp LUMOa energy',eGT(nO(2)+1,2))
end if
end subroutine

22
src/GT/UGT.f90
View File

@ -1,4 +1,4 @@
subroutine UGT(doG0T0pp,doevGTpp,doqsGTpp,doG0T0eh,doevGTeh,doqsGTeh,maxSCF,thresh,max_diis,doACFDT, &
subroutine UGT(dotest,doG0T0pp,doevGTpp,doqsGTpp,doG0T0eh,doevGTeh,doqsGTeh,maxSCF,thresh,max_diis,doACFDT, &
exchange_kernel,doXBS,dophBSE,dophBSE2,doppBSE,TDA_T,TDA,dBSE,dTDA,spin_conserved,spin_flip, &
linearize,eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc, &
ERI_AO,ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_AO,dipole_int_aa,dipole_int_bb,PHF,cHF,epsHF)
@ -10,12 +10,14 @@ subroutine UGT(doG0T0pp,doevGTpp,doqsGTpp,doG0T0eh,doevGTeh,doqsGTeh,maxSCF,thre
! Input variables
logical :: doG0T0pp
logical :: doevGTpp
logical :: doqsGTpp
logical :: doG0T0eh
logical :: doevGTeh
logical :: doqsGTeh
logical,intent(in) :: dotest
logical,intent(in) :: doG0T0pp
logical,intent(in) :: doevGTpp
logical,intent(in) :: doqsGTpp
logical,intent(in) :: doG0T0eh
logical,intent(in) :: doevGTeh
logical,intent(in) :: doqsGTeh
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
@ -77,7 +79,7 @@ subroutine UGT(doG0T0pp,doevGTpp,doqsGTpp,doG0T0eh,doevGTeh,doqsGTeh,maxSCF,thre
if(doG0T0pp) then
call wall_time(start_GT)
call UG0T0pp(doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,dTDA,spin_conserved,spin_flip, &
call UG0T0pp(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,dTDA,spin_conserved,spin_flip, &
linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI_aaaa,ERI_aabb,ERI_bbbb, &
dipole_int_aa,dipole_int_bb,cHF,epsHF)
call wall_time(end_GT)
@ -95,7 +97,7 @@ subroutine UGT(doG0T0pp,doevGTpp,doqsGTpp,doG0T0eh,doevGTeh,doqsGTeh,maxSCF,thre
if(doevGTpp) then
call wall_time(start_GT)
call evUGTpp(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,dTDA,spin_conserved,spin_flip, &
call evUGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,dTDA,spin_conserved,spin_flip, &
linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb, &
cHF,epsHF)
call wall_time(end_GT)
@ -113,7 +115,7 @@ subroutine UGT(doG0T0pp,doevGTpp,doqsGTpp,doG0T0eh,doevGTeh,doqsGTeh,maxSCF,thre
if(doqsGTpp) then
call wall_time(start_GT)
call qsUGTpp(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,dTDA,spin_conserved,spin_flip, &
call qsUGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,dTDA,spin_conserved,spin_flip, &
eta,regularize,nBas,nC,nO,nV,nR,nS,nNuc,ZNuc,rNuc,ENuc,EHF,S,X,T,V,Hc,ERI_AO,ERI_aaaa,ERI_aabb,ERI_bbbb, &
dipole_int_AO,dipole_int_aa,dipole_int_bb,PHF,cHF,epsHF)
call wall_time(end_GT)

22
src/GT/evGTeh.f90 → src/GT/evRGTeh.f90
View File

@ -1,5 +1,5 @@
subroutine evGTeh(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_T,TDA,dBSE,dTDA,doppBSE, &
singlet,triplet,linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF)
subroutine evRGTeh(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_T,TDA,dBSE,dTDA,doppBSE, &
singlet,triplet,linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF)
! Perform self-consistent eigenvalue-only ehGT calculation
@ -8,6 +8,8 @@ subroutine evGTeh(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,d
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
@ -70,9 +72,9 @@ subroutine evGTeh(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,d
! Hello world
write(*,*)
write(*,*)'************************************************'
write(*,*)'| Self-consistent evGTeh calculation |'
write(*,*)'************************************************'
write(*,*)'**********************************'
write(*,*)'* Restricted evRGTeh Calculation *'
write(*,*)'**********************************'
write(*,*)
! TDA for T
@ -296,4 +298,14 @@ subroutine evGTeh(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,d
! end if
! Testing zone
if(dotest) then
call dump_test_value('R','evGTeh correlation energy',EcRPA)
call dump_test_value('R','evGTeh HOMO energy',eGT(nO))
call dump_test_value('R','evGTeh LUMO energy',eGT(nO+1))
end if
end subroutine

31
src/GT/evGTpp.f90 → src/GT/evRGTpp.f90
View File

@ -1,5 +1,5 @@
subroutine evGTpp(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE,TDA_T,TDA,dBSE,dTDA,singlet,triplet, &
linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF)
subroutine evRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE,TDA_T,TDA,dBSE,dTDA,singlet,triplet, &
linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF)
! Perform eigenvalue self-consistent calculation with a T-matrix self-energy (evGT)
@ -8,6 +8,8 @@ subroutine evGTpp(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE,TDA_T
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
@ -74,9 +76,9 @@ subroutine evGTpp(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE,TDA_T
! Hello world
write(*,*)
write(*,*)'************************************************'
write(*,*)'| Self-consistent evGTpp calculation |'
write(*,*)'************************************************'
write(*,*)'*********************************'
write(*,*)'* Restricted evGTpp Calculation *'
write(*,*)'*********************************'
write(*,*)
! TDA for T
@ -265,8 +267,8 @@ subroutine evGTpp(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE,TDA_T
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A50,F20.10)') 'Tr@phBSE@evGTpp correlation energy (singlet) =',EcBSE(1)
write(*,'(2X,A50,F20.10)') 'Tr@phBSE@evGTpp correlation energy (triplet) =',EcBSE(2)
write(*,'(2X,A50,F20.10)') 'Tr@phBSE@evGTpp correlation energy =',EcBSE(1) + EcBSE(2)
write(*,'(2X,A50,F20.10)') 'Tr@phBSE@evGTpp total energy =',ENuc + ERHF + EcBSE(1) + EcBSE(2)
write(*,'(2X,A50,F20.10)') 'Tr@phBSE@evGTpp correlation energy =',sum(EcBSE)
write(*,'(2X,A50,F20.10)') 'Tr@phBSE@evGTpp total energy =',ENuc + ERHF + sum(EcBSE)
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)
@ -301,8 +303,8 @@ subroutine evGTpp(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE,TDA_T
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A50,F20.10)') 'AC@phBSE@evGTpp correlation energy (singlet) =',EcBSE(1)
write(*,'(2X,A50,F20.10)') 'AC@phBSE@evGTpp correlation energy (triplet) =',EcBSE(2)
write(*,'(2X,A50,F20.10)') 'AC@phBSE@evGTpp correlation energy =',EcBSE(1) + EcBSE(2)
write(*,'(2X,A50,F20.10)') 'AC@phBSE@evGTpp total energy =',ENuc + ERHF + EcBSE(1) + EcBSE(2)
write(*,'(2X,A50,F20.10)') 'AC@phBSE@evGTpp correlation energy =',sum(EcBSE)
write(*,'(2X,A50,F20.10)') 'AC@phBSE@evGTpp total energy =',ENuc + ERHF + sum(EcBSE)
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)
@ -310,4 +312,15 @@ subroutine evGTpp(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE,TDA_T
end if
! Testing zone
if(dotest) then
call dump_test_value('R','evGTpp correlation energy',sum(EcRPA))
call dump_test_value('R','evGTpp HOMO energy',eGT(nO))
call dump_test_value('R','evGTpp LUMO energy',eGT(nO+1))
end if
end subroutine

23
src/GT/evUGTpp.f90
View File

@ -1,4 +1,4 @@
subroutine evUGTpp(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE, &
subroutine evUGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE, &
TDA_T,TDA,dBSE,dTDA,spin_conserved,spin_flip,&
eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,EUHF,ERI_aaaa, &
ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb,cHF,eHF)
@ -9,6 +9,9 @@ subroutine evUGTpp(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE, &
include 'parameters.h'
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
@ -73,9 +76,9 @@ subroutine evUGTpp(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE, &
! Hello world
write(*,*)
write(*,*)'************************************************'
write(*,*)'| Self-consistent evUGT calculation |'
write(*,*)'************************************************'
write(*,*)'***********************************'
write(*,*)'* Unrestricted evGTpp Calculation *'
write(*,*)'***********************************'
write(*,*)
! Dimensions of the pp-URPA linear reponse matrices
@ -284,4 +287,16 @@ subroutine evUGTpp(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE, &
Om1aa,X1aa,Y1aa,Om2aa,X2aa,Y2aa,rho1aa,rho2aa, &
Om1bb,X1bb,Y1bb,Om2bb,X2bb,Y2bb,rho1bb,rho2bb)
! Testing zone
if(dotest) then
call dump_test_value('U','evGTpp correlation energy',sum(EcRPA))
call dump_test_value('U','evGTpp HOMOa energy',eGT(nO(1),1))
call dump_test_value('U','evGTpp LUMOa energy',eGT(nO(1)+1,1))
call dump_test_value('U','evGTpp HOMOa energy',eGT(nO(2),2))
call dump_test_value('U','evGTpp LUMOa energy',eGT(nO(2)+1,2))
end if
end subroutine

60
src/GT/qsGTeh.f90 → src/GT/qsRGTeh.f90
View File

@ -1,6 +1,6 @@
subroutine qsGTeh(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_T,TDA, &
dBSE,dTDA,singlet,triplet,eta,regularize,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)
subroutine qsRGTeh(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_T,TDA, &
dBSE,dTDA,singlet,triplet,eta,regularize,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 GTeh calculation
@ -9,6 +9,8 @@ subroutine qsGTeh(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,d
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
@ -73,7 +75,7 @@ subroutine qsGTeh(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,d
double precision :: dipole(ncart)
logical :: print_T = .true.
double precision,allocatable :: error_diis(:,:)
double precision,allocatable :: err_diis(:,:)
double precision,allocatable :: F_diis(:,:)
double precision,allocatable :: Aph(:,:)
double precision,allocatable :: Bph(:,:)
@ -94,14 +96,14 @@ subroutine qsGTeh(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,d
double precision,allocatable :: Sig(:,:)
double precision,allocatable :: Sigp(:,:)
double precision,allocatable :: Z(:)
double precision,allocatable :: error(:,:)
double precision,allocatable :: err(:,:)
! Hello world
write(*,*)
write(*,*)'************************************************'
write(*,*)'| Self-consistent qsGTeh calculation |'
write(*,*)'************************************************'
write(*,*)'*********************************'
write(*,*)'* Restricted qsGTeh Calculation *'
write(*,*)'*********************************'
write(*,*)
! Warning
@ -131,21 +133,21 @@ subroutine qsGTeh(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,d
allocate(Aph(nS,nS),Bph(nS,nS),eGT(nBas),eOld(nBas),c(nBas,nBas),cp(nBas,nBas),P(nBas,nBas),F(nBas,nBas),Fp(nBas,nBas), &
J(nBas,nBas),K(nBas,nBas),Sig(nBas,nBas),Sigp(nBas,nBas),Z(nBas),Om(nS),XpY(nS,nS),XmY(nS,nS), &
rhoL(nBas,nBas,nS),rhoR(nBas,nBas,nS),error(nBas,nBas),error_diis(nBasSq,max_diis),F_diis(nBasSq,max_diis))
rhoL(nBas,nBas,nS),rhoR(nBas,nBas,nS),err(nBas,nBas),err_diis(nBasSq,max_diis),F_diis(nBasSq,max_diis))
! Initialization
nSCF = -1
n_diis = 0
ispin = 2
Conv = 1d0
P(:,:) = PHF(:,:)
eGT(:) = eHF(:)
eOld(:) = eHF(:)
c(:,:) = cHF(:,:)
F_diis(:,:) = 0d0
error_diis(:,:) = 0d0
rcond = 0d0
nSCF = -1
n_diis = 0
ispin = 2
Conv = 1d0
P(:,:) = PHF(:,:)
eGT(:) = eHF(:)
eOld(:) = eHF(:)
c(:,:) = cHF(:,:)
F_diis(:,:) = 0d0
err_diis(:,:) = 0d0
rcond = 0d0
!------------------------------------------------------------------------
! Main loop
@ -198,14 +200,14 @@ subroutine qsGTeh(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,d
! Compute commutator and convergence criteria
error = matmul(F,matmul(P,S)) - matmul(matmul(S,P),F)
err = matmul(F,matmul(P,S)) - matmul(matmul(S,P),F)
! DIIS extrapolation
if(max_diis > 1) then
n_diis = min(n_diis+1,max_diis)
call DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,error_diis,F_diis,error,F)
call DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,err_diis,F_diis,err,F)
end if
@ -223,7 +225,7 @@ subroutine qsGTeh(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,d
! Save quasiparticles energy for next cycle
Conv = maxval(abs(error))
Conv = maxval(abs(err))
eOld(:) = eGT(:)
!------------------------------------------------------------------------
@ -276,7 +278,7 @@ subroutine qsGTeh(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,d
! Deallocate memory
deallocate(c,cp,P,F,Fp,J,K,Sig,Sigp,Z,Om,XpY,XmY,rhoL,rhoR,error,error_diis,F_diis)
deallocate(c,cp,P,F,Fp,J,K,Sig,Sigp,Z,Om,XpY,XmY,rhoL,rhoR,err,err_diis,F_diis)
! Perform BSE calculation
@ -332,4 +334,14 @@ subroutine qsGTeh(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,d
! end if
! Testing zone
if(dotest) then
call dump_test_value('R','qsGTeh correlation energy',EcRPA)
call dump_test_value('R','qsGTeh HOMO energy',eGT(nO))
call dump_test_value('R','qsGTeh LUMO energy',eGT(nO+1))
end if
end subroutine

32
src/GT/qsGTpp.f90 → src/GT/qsRGTpp.f90
View File

@ -1,6 +1,6 @@
subroutine qsGTpp(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA, &
dBSE,dTDA,singlet,triplet,eta,regularize,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)
subroutine qsRGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA, &
dBSE,dTDA,singlet,triplet,eta,regularize,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 GT calculation
@ -9,6 +9,7 @@ subroutine qsGTpp(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,T
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
@ -98,9 +99,9 @@ subroutine qsGTpp(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,T
! Hello world
write(*,*)
write(*,*)'************************************************'
write(*,*)'| Self-consistent qsGTpp calculation |'
write(*,*)'************************************************'
write(*,*)'*********************************'
write(*,*)'* Restricted qsGTpp Calculation *'
write(*,*)'*********************************'
write(*,*)
! Dimensions of the pp-RPA linear reponse matrices
@ -341,8 +342,8 @@ subroutine qsGTpp(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,T
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A50,F20.10)') 'Tr@phBSE@qsGTpp correlation energy (singlet) =',EcBSE(1)
write(*,'(2X,A50,F20.10)') 'Tr@BphSE@qsGTpp correlation energy (triplet) =',EcBSE(2)
write(*,'(2X,A50,F20.10)') 'Tr@phBSE@qsGTpp correlation energy =',EcBSE(1) + EcBSE(2)
write(*,'(2X,A50,F20.10)') 'Tr@phBSE@qsGTpp total energy =',ENuc + EqsGT + EcBSE(1) + EcBSE(2)
write(*,'(2X,A50,F20.10)') 'Tr@phBSE@qsGTpp correlation energy =',sum(EcBSE)
write(*,'(2X,A50,F20.10)') 'Tr@phBSE@qsGTpp total energy =',ENuc + EqsGT + sum(EcBSE)
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)
@ -370,8 +371,8 @@ subroutine qsGTpp(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,T
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A50,F20.10)') 'AC@phBSE@qsGTpp correlation energy (singlet) =',EcBSE(1)
write(*,'(2X,A50,F20.10)') 'AC@phBSE@qsGTpp correlation energy (triplet) =',EcBSE(2)
write(*,'(2X,A50,F20.10)') 'AC@phBSE@qsGTpp correlation energy =',EcBSE(1) + EcBSE(2)
write(*,'(2X,A50,F20.10)') 'AC@phBSE@qsGTpp total energy =',ENuc + EqsGT + EcBSE(1) + EcBSE(2)
write(*,'(2X,A50,F20.10)') 'AC@phBSE@qsGTpp correlation energy =',sum(EcBSE)
write(*,'(2X,A50,F20.10)') 'AC@phBSE@qsGTpp total energy =',ENuc + EqsGT + sum(EcBSE)
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)
@ -379,4 +380,15 @@ subroutine qsGTpp(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,T
end if
! Testing zone
if(dotest) then
call dump_test_value('R','qsGTpp correlation energy',sum(EcRPA))
call dump_test_value('R','qsGTpp HOMO energy',eGT(nO))
call dump_test_value('R','qsGTpp LUMO energy',eGT(nO+1))
end if
end subroutine

23
src/GT/qsUGTpp.f90
View File

@ -1,4 +1,4 @@
subroutine qsUGTpp(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE, &
subroutine qsUGTpp(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE, &
TDA_T,TDA,dBSE,dTDA,spin_conserved,spin_flip,&
eta,regularize,nBas,nC,nO,nV,nR,nS,nNuc,ZNuc,rNuc,ENuc,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)
@ -9,6 +9,9 @@ subroutine qsUGTpp(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE, &
include 'parameters.h'
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
@ -103,9 +106,9 @@ subroutine qsUGTpp(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE, &
! Hello world
write(*,*)
write(*,*)'************************************************'
write(*,*)'| Self-consistent qsUGT calculation |'
write(*,*)'************************************************'
write(*,*)'***********************************'
write(*,*)'* Unrestricted evGTpp Calculation *'
write(*,*)'***********************************'
write(*,*)
! Dimensions of the pp-URPA linear reponse matrices
@ -409,4 +412,16 @@ write(*,*) 'EcGM', EcGM(1)
deallocate(c,cp,P,F,Fp,J,K,SigT,SigTp,Z,error,error_diis,F_diis)
! Testing zone
if(dotest) then
call dump_test_value('U','qsGTpp correlation energy',sum(EcRPA))
call dump_test_value('U','qsGTpp HOMOa energy',eGT(nO(1),1))
call dump_test_value('U','qsGTpp LUMOa energy',eGT(nO(1)+1,1))
call dump_test_value('U','qsGTpp HOMOa energy',eGT(nO(2),2))
call dump_test_value('U','qsGTpp LUMOa energy',eGT(nO(2)+1,2))
end if
end subroutine

14
src/GW/GG0W0.f90
View File

@ -1,4 +1,4 @@
subroutine GG0W0(doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, &
subroutine GG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, &
linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF)
! Perform G0W0 calculation
@ -8,6 +8,8 @@ subroutine GG0W0(doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,d
! Input variables
logical,intent(in) :: dotest
logical,intent(in) :: doACFDT
logical,intent(in) :: exchange_kernel
logical,intent(in) :: doXBS
@ -219,4 +221,14 @@ subroutine GG0W0(doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,d
! end if
! Testing zone
if(dotest) then
call dump_test_value('G','G0W0 correlation energy',EcRPA)
call dump_test_value('G','G0W0 HOMO energy',eGW(nO))
call dump_test_value('G','G0W0 LUMO energy',eGW(nO+1))
end if
end subroutine

22
src/GW/GGW.f90
View File

@ -1,6 +1,5 @@
subroutine GGW(doG0W0,doevGW,doqsGW,maxSCF,thresh,max_diis,doACFDT, &
exchange_kernel,doXBS,dophBSE,dophBSE2,doppBSE,TDA_W,TDA,dBSE,dTDA, &
linearize,eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nBas2,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc, &
subroutine GGW(dotest,doG0W0,doevGW,doqsGW,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,doppBSE, &
TDA_W,TDA,dBSE,dTDA,linearize,eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nBas2,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc, &
ERI_AO,ERI,dipole_int_AO,dipole_int,PHF,cHF,epsHF)
! GW module
@ -10,12 +9,11 @@ subroutine GGW(doG0W0,doevGW,doqsGW,maxSCF,thresh,max_diis,doACFDT, &
! Input variables
logical :: doG0W0
logical :: doevGW
logical :: doqsGW
logical :: doufG0W0
logical :: doufGW
logical :: doSRGqsGW
logical,intent(in) :: dotest
logical,intent(in) :: doG0W0
logical,intent(in) :: doevGW
logical,intent(in) :: doqsGW
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
@ -72,7 +70,7 @@ subroutine GGW(doG0W0,doevGW,doqsGW,maxSCF,thresh,max_diis,doACFDT, &
if(doG0W0) then
call wall_time(start_GW)
call GG0W0(doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, &
call GG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, &
linearize,eta,regularize,nBas2,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,epsHF)
call wall_time(end_GW)
@ -89,7 +87,7 @@ subroutine GGW(doG0W0,doevGW,doqsGW,maxSCF,thresh,max_diis,doACFDT, &
if(doevGW) then
call wall_time(start_GW)
call evGGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, &
call evGGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, &
linearize,eta,regularize,nBas2,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,epsHF)
call wall_time(end_GW)
@ -106,7 +104,7 @@ subroutine GGW(doG0W0,doevGW,doqsGW,maxSCF,thresh,max_diis,doACFDT, &
if(doqsGW) then
call wall_time(start_GW)
call qsGGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, &
call qsGGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, &
eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nBas2,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc,ERI_AO,ERI, &
dipole_int_AO,dipole_int,PHF,cHF,epsHF)
call wall_time(end_GW)

14
src/GW/RG0W0.f90
View File

@ -1,4 +1,4 @@
subroutine RG0W0(doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE,singlet,triplet, &
subroutine RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE,singlet,triplet, &
linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF)
! Perform G0W0 calculation
@ -9,6 +9,8 @@ subroutine RG0W0(doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,d
! Input variables
logical,intent(in) :: dotest
logical,intent(in) :: doACFDT
logical,intent(in) :: exchange_kernel
logical,intent(in) :: doXBS
@ -231,4 +233,14 @@ subroutine RG0W0(doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,d
end if
! Testing zone
if(dotest) then
call dump_test_value('R','G0W0 correlation energy',EcRPA)
call dump_test_value('R','G0W0 HOMO energy',eGW(nO))
call dump_test_value('R','G0W0 LUMO energy',eGW(nO+1))
end if
end subroutine

28
src/GW/RGW.f90
View File

@ -1,4 +1,4 @@
subroutine RGW(doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thresh,max_diis,doACFDT, &
subroutine RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thresh,max_diis,doACFDT, &
exchange_kernel,doXBS,dophBSE,dophBSE2,doppBSE,TDA_W,TDA,dBSE,dTDA,singlet,triplet, &
linearize,eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc, &
ERI_AO,ERI,dipole_int_AO,dipole_int,PHF,cHF,epsHF)
@ -10,12 +10,14 @@ subroutine RGW(doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thresh,max_
! Input variables
logical :: doG0W0
logical :: doevGW
logical :: doqsGW
logical :: doufG0W0
logical :: doufGW
logical :: doSRGqsGW
logical,intent(in) :: dotest
logical,intent(in) :: doG0W0
logical,intent(in) :: doevGW
logical,intent(in) :: doqsGW
logical,intent(in) :: doufG0W0
logical,intent(in) :: doufGW
logical,intent(in) :: doSRGqsGW
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
@ -73,7 +75,7 @@ subroutine RGW(doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thresh,max_
if(doG0W0) then
call wall_time(start_GW)
call RG0W0(doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE,singlet,triplet, &
call RG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE,singlet,triplet, &
linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,epsHF)
call wall_time(end_GW)
@ -90,7 +92,7 @@ subroutine RGW(doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thresh,max_
if(doevGW) then
call wall_time(start_GW)
call evRGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, &
call evRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, &
singlet,triplet,linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,epsHF)
call wall_time(end_GW)
@ -107,7 +109,7 @@ subroutine RGW(doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thresh,max_
if(doqsGW) then
call wall_time(start_GW)
call qsRGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, &
call qsRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, &
singlet,triplet,eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc,ERI_AO,ERI, &
dipole_int_AO,dipole_int,PHF,cHF,epsHF)
call wall_time(end_GW)
@ -125,7 +127,7 @@ subroutine RGW(doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thresh,max_
if(doSRGqsGW) then
call wall_time(start_GW)
call SRG_qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA, &
call SRG_qsGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA, &
singlet,triplet,eta,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc,ERI_AO,ERI, &
dipole_int_AO,dipole_int,PHF,cHF,epsHF)
call wall_time(end_GW)
@ -143,7 +145,7 @@ subroutine RGW(doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thresh,max_
if(doufG0W0) then
call wall_time(start_GW)
call ufG0W0(nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,epsHF,TDA_W)
call ufG0W0(dotest,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,epsHF,TDA_W)
call wall_time(end_GW)
t_GW = end_GW - start_GW
@ -159,7 +161,7 @@ subroutine RGW(doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thresh,max_
if(doufGW) then
call wall_time(start_GW)
call ufGW(nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,epsHF)
call ufGW(dotest,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,epsHF)
call wall_time(end_GW)
t_GW = end_GW - start_GW

4
src/GW/SRG_qsGW.f90
View File

@ -1,4 +1,4 @@
subroutine SRG_qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE,BSE2,TDA_W,TDA, &
subroutine SRG_qsGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE,BSE2,TDA_W,TDA, &
dBSE,dTDA,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)
@ -9,6 +9,8 @@ subroutine SRG_qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE,BSE
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh

16
src/GW/UG0W0.f90
View File

@ -1,4 +1,4 @@
subroutine UG0W0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,spin_conserved,spin_flip, &
subroutine UG0W0(dotest,doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,spin_conserved,spin_flip, &
linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,EUHF,S,ERI_aaaa,ERI_aabb,ERI_bbbb, &
dipole_int_aa,dipole_int_bb,cHF,eHF)
@ -10,6 +10,8 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,spin_cons
! Input variables
logical,intent(in) :: dotest
logical,intent(in) :: doACFDT
logical,intent(in) :: exchange_kernel
logical,intent(in) :: doXBS
@ -240,4 +242,16 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,spin_cons
end if
! Testing zone
if(dotest) then
call dump_test_value('U','G0W0 correlation energy',EcRPA)
call dump_test_value('U','G0W0 HOMOa energy',eGW(nO(1),1))
call dump_test_value('U','G0W0 LUMOa energy',eGW(nO(1)+1,1))
call dump_test_value('U','G0W0 HOMOa energy',eGW(nO(2),2))
call dump_test_value('U','G0W0 LUMOa energy',eGW(nO(2)+1,2))
end if
end subroutine

22
src/GW/UGW.f90
View File

@ -1,4 +1,4 @@
subroutine UGW(doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thresh,max_diis,doACFDT, &
subroutine UGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thresh,max_diis,doACFDT, &
exchange_kernel,doXBS,dophBSE,dophBSE2,doppBSE,TDA_W,TDA,dBSE,dTDA,spin_conserved,spin_flip, &
linearize,eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc, &
ERI_AO,ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_AO,dipole_int_aa,dipole_int_bb,PHF,cHF,epsHF)
@ -10,12 +10,14 @@ subroutine UGW(doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thresh,max_
! Input variables
logical :: doG0W0
logical :: doevGW
logical :: doqsGW
logical :: doufG0W0
logical :: doufGW
logical :: doSRGqsGW
logical,intent(in) :: dotest
logical,intent(in) :: doG0W0
logical,intent(in) :: doevGW
logical,intent(in) :: doqsGW
logical,intent(in) :: doufG0W0
logical,intent(in) :: doufGW
logical,intent(in) :: doSRGqsGW
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
@ -76,7 +78,7 @@ subroutine UGW(doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thresh,max_
if(doG0W0) then
call wall_time(start_GW)
call UG0W0(doACFDT,exchange_kernel,doXBS,dophBSE,TDA_W,TDA,dBSE,dTDA,spin_conserved,spin_flip, &
call UG0W0(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_W,TDA,dBSE,dTDA,spin_conserved,spin_flip, &
linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,EHF,S,ERI_aaaa,ERI_aabb,ERI_bbbb, &
dipole_int_aa,dipole_int_bb,cHF,epsHF)
call wall_time(end_GW)
@ -94,7 +96,7 @@ subroutine UGW(doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thresh,max_
if(doevGW) then
call wall_time(start_GW)
call evUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_W,TDA,dBSE,dTDA, &
call evUGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_W,TDA,dBSE,dTDA, &
spin_conserved,spin_flip,linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,EHF,S, &
ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb,cHF,epsHF)
call wall_time(end_GW)
@ -112,7 +114,7 @@ subroutine UGW(doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF,thresh,max_
if(doqsGW) then
call wall_time(start_GW)
call qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_W,TDA,dBSE,dTDA,spin_conserved,spin_flip, &
call qsUGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_W,TDA,dBSE,dTDA,spin_conserved,spin_flip, &
eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc,ERI_AO,ERI_aaaa,ERI_aabb,ERI_bbbb, &
dipole_int_AO,dipole_int_aa,dipole_int_bb,PHF,cHF,epsHF)
call wall_time(end_GW)

14
src/GW/evGGW.f90
View File

@ -1,4 +1,4 @@
subroutine evGGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, &
subroutine evGGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, &
linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF)
! Perform self-consistent eigenvalue-only GW calculation
@ -8,6 +8,8 @@ subroutine evGGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,do
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
@ -264,4 +266,14 @@ subroutine evGGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,do
! end if
! Testing zone
if(dotest) then
call dump_test_value('G','evGW correlation energy',EcRPA)
call dump_test_value('G','evGW HOMO energy',eGW(nO))
call dump_test_value('G','evGW LUMO energy',eGW(nO+1))
end if
end subroutine

14
src/GW/evRGW.f90
View File

@ -1,4 +1,4 @@
subroutine evRGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, &
subroutine evRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, &
singlet,triplet,linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF)
! Perform self-consistent eigenvalue-only GW calculation
@ -8,6 +8,8 @@ subroutine evRGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,do
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
@ -275,4 +277,14 @@ subroutine evRGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,do
end if
! Testing zone
if(dotest) then
call dump_test_value('R','evGW correlation energy',EcRPA)
call dump_test_value('R','evGW HOMO energy',eGW(nO))
call dump_test_value('R','evGW LUMO energy',eGW(nO+1))
end if
end subroutine

16
src/GW/evUGW.f90
View File

@ -1,4 +1,4 @@
subroutine evUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA, &
subroutine evUGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA, &
spin_conserved,spin_flip,linearize,eta,regularize,nBas,nC,nO,nV,nR,nS,ENuc, &
EUHF,S,ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb,cHF,eHF)
@ -9,6 +9,8 @@ subroutine evUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE,TDA_W,
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
@ -306,4 +308,16 @@ subroutine evUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE,TDA_W,
end if
! Testing zone
if(dotest) then
call dump_test_value('U','evGW correlation energy',EcRPA)
call dump_test_value('U','evGW HOMOa energy',eGW(nO(1),1))
call dump_test_value('U','evGW LUMOa energy',eGW(nO(1)+1,1))
call dump_test_value('U','evGW HOMOa energy',eGW(nO(2),2))
call dump_test_value('U','evGW LUMOa energy',eGW(nO(2)+1,2))
end if
end subroutine

24
src/GW/print_UG0W0.f90
View File

@ -38,17 +38,17 @@ subroutine print_UG0W0(nBas,nO,eHF,ENuc,EUHF,SigC,Z,eGW,EcRPA,EcGM)
! Dump results
write(*,*)'-------------------------------------------------------------------------------&
------------------------------------------------'
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
write(*,*)' One-shot UG0W0 calculation (eV)'
write(*,*)'-------------------------------------------------------------------------------&
------------------------------------------------'
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
write(*,'(A1,A3,A1,A30,A1,A30,A1,A30,A1,A30,A1)') &
'|',' ','|','e_HF ','|','Sig_GW ','|','Z ','|','e_GW ','|'
write(*,'(A1,A3,A1,2A15,A1,2A15,A1,2A15,A1,2A15,A1)') &
'|','#','|','up ','dw ','|','up ','dw ','|','up ','dw ','|','up ','dw ','|'
write(*,*)'-------------------------------------------------------------------------------&
------------------------------------------------'
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
do p=1,nBas
write(*,'(A1,I3,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1)') &
@ -56,19 +56,19 @@ subroutine print_UG0W0(nBas,nO,eHF,ENuc,EUHF,SigC,Z,eGW,EcRPA,EcGM)
Z(p,1),Z(p,2),'|',eGW(p,1)*HaToeV,eGW(p,2)*HaToeV,'|'
enddo
write(*,*)'-------------------------------------------------------------------------------&
------------------------------------------------'
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
write(*,'(2X,A50,F15.6,A3)') 'UG0W0 HOMO energy = ',maxval(HOMO(:))*HaToeV,' eV'
write(*,'(2X,A50,F15.6,A3)') 'UG0W0 LUMO energy = ',minval(LUMO(:))*HaToeV,' eV'
write(*,'(2X,A50,F15.6,A3)') 'UG0W0 HOMO-LUMO gap = ',(minval(LUMO(:))-maxval(HOMO(:)))*HaToeV,' eV'
write(*,*)'-------------------------------------------------------------------------------&
------------------------------------------------'
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
write(*,'(2X,A50,F15.6,A3)') 'phRPA@UG0W0 total energy = ',ENuc + EUHF + EcRPA,' au'
write(*,'(2X,A50,F15.6,A3)') 'phRPA@UG0W0 correlation energy = ',EcRPA,' au'
write(*,'(2X,A50,F15.6,A3)') ' GM@UG0W0 total energy = ',ENuc + EUHF + sum(EcGM(:)),' au'
write(*,'(2X,A50,F15.6,A3)') ' GM@UG0W0 correlation energy = ',sum(EcGM(:)),' au'
write(*,*)'-------------------------------------------------------------------------------&
------------------------------------------------'
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
write(*,*)
end subroutine

28
src/GW/print_evUGW.f90
View File

@ -40,8 +40,8 @@ subroutine print_evUGW(nBas,nO,nSCF,Conv,eHF,ENuc,EUHF,SigC,Z,eGW,EcRPA,EcGM)
! Dump results
write(*,*)'-------------------------------------------------------------------------------&
------------------------------------------------'
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
if(nSCF < 10) then
write(*,'(1X,A22,I1,A1,I1,A12)')' Self-consistent evUG',nSCF,'W',nSCF,' calculation'
elseif(nSCF < 100) then
@ -49,14 +49,14 @@ subroutine print_evUGW(nBas,nO,nSCF,Conv,eHF,ENuc,EUHF,SigC,Z,eGW,EcRPA,EcGM)
else
write(*,'(1X,A22,I3,A1,I3,A12)')' Self-consistent evUG',nSCF,'W',nSCF,' calculation'
end if
write(*,*)'-------------------------------------------------------------------------------&
------------------------------------------------'
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
write(*,'(A1,A3,A1,A30,A1,A30,A1,A30,A1,A30,A1)') &
'|',' ','|','e_HF ','|','Sig_GW ','|','Z ','|','e_GW ','|'
write(*,'(A1,A3,A1,2A15,A1,2A15,A1,2A15,A1,2A15,A1)') &
'|','#','|','up ','dw ','|','up ','dw ','|','up ','dw ','|','up ','dw ','|'
write(*,*)'-------------------------------------------------------------------------------&
------------------------------------------------'
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
do p=1,nBas
write(*,'(A1,I3,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1)') &
@ -64,23 +64,23 @@ subroutine print_evUGW(nBas,nO,nSCF,Conv,eHF,ENuc,EUHF,SigC,Z,eGW,EcRPA,EcGM)
Z(p,1),Z(p,2),'|',eGW(p,1)*HaToeV,eGW(p,2)*HaToeV,'|'
enddo
write(*,*)'-------------------------------------------------------------------------------&
------------------------------------------------'
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
write(*,'(2X,A10,I3)') 'Iteration ',nSCF
write(*,'(2X,A14,F15.5)')'Convergence = ',Conv
write(*,*)'-------------------------------------------------------------------------------&
-------------------------------------------------'
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
write(*,'(2X,A30,F15.6,A3)') 'evUGW HOMO energy = ',maxval(HOMO(:))*HaToeV,' eV'
write(*,'(2X,A30,F15.6,A3)') 'evUGW LUMO energy = ',minval(LUMO(:))*HaToeV,' eV'
write(*,'(2X,A30,F15.6,A3)') 'evUGW HOMO-LUMO gap = ',(minval(LUMO(:))-maxval(HOMO(:)))*HaToeV,' eV'
write(*,*)'-------------------------------------------------------------------------------&
------------------------------------------------'
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
write(*,'(2X,A30,F15.6,A3)') 'RPA@evUGW total energy = ',ENuc + EUHF + EcRPA,' au'
write(*,'(2X,A30,F15.6,A3)') 'RPA@evUGW correlation energy = ',EcRPA,' au'
write(*,'(2X,A30,F15.6,A3)') ' GM@evUGW total energy = ',ENuc + EUHF + sum(EcGM(:)),' au'
write(*,'(2X,A30,F15.6,A3)') ' GM@evUGW correlation energy = ',sum(EcGM(:)),' au'
write(*,*)'-------------------------------------------------------------------------------&
-------------------------------------------------'
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
write(*,*)
end subroutine

28
src/GW/print_qsUGW.f90
View File

@ -62,8 +62,8 @@ subroutine print_qsUGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,cGW,Ov,ENuc,ET,EV,EJ,Ex,
! Dump results
write(*,*)'-------------------------------------------------------------------------------&
------------------------------------------------'
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
if(nSCF < 10) then
write(*,'(1X,A22,I1,A1,I1,A12)')' Self-consistent qsUG',nSCF,'W',nSCF,' calculation'
elseif(nSCF < 100) then
@ -71,14 +71,14 @@ subroutine print_qsUGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,cGW,Ov,ENuc,ET,EV,EJ,Ex,
else
write(*,'(1X,A22,I3,A1,I3,A12)')' Self-consistent qsUG',nSCF,'W',nSCF,' calculation'
end if
write(*,*)'-------------------------------------------------------------------------------&
------------------------------------------------'
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
write(*,'(A1,A3,A1,A30,A1,A30,A1,A30,A1,A30,A1)') &
'|',' ','|','e_HF ','|','Sig_GW ','|','Z ','|','e_GW ','|'
write(*,'(A1,A3,A1,2A15,A1,2A15,A1,2A15,A1,2A15,A1)') &
'|','#','|','up ','dw ','|','up ','dw ','|','up ','dw ','|','up ','dw ','|'
write(*,*)'-------------------------------------------------------------------------------&
------------------------------------------------'
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
do p=1,nBas
write(*,'(A1,I3,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1,2F15.6,A1)') &
@ -86,23 +86,23 @@ subroutine print_qsUGW(nBas,nO,nSCF,Conv,thresh,eHF,eGW,cGW,Ov,ENuc,ET,EV,EJ,Ex,
Z(p,1),Z(p,2),'|',eGW(p,1)*HaToeV,eGW(p,2)*HaToeV,'|'
enddo
write(*,*)'-------------------------------------------------------------------------------&
------------------------------------------------'
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
write(*,'(2X,A10,I3)') 'Iteration ',nSCF
write(*,'(2X,A14,F15.5)')'Convergence = ',Conv
write(*,*)'-------------------------------------------------------------------------------&
------------------------------------------------'
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
write(*,'(2X,A30,F15.6,A3)') 'qsUGW HOMO energy = ',maxval(HOMO(:))*HaToeV,' eV'
write(*,'(2X,A30,F15.6,A3)') 'qsUGW LUMO energy = ',minval(LUMO(:))*HaToeV,' eV'
write(*,'(2X,A30,F15.6,A3)') 'qsUGW HOMO-LUMO gap = ',(minval(LUMO(:))-maxval(HOMO(:)))*HaToeV,' eV'
write(*,*)'-------------------------------------------------------------------------------&
------------------------------------------------'
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
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'
write(*,*)'-------------------------------------------------------------------------------&
------------------------------------------------'
write(*,*)'----------------------------------------------------------------'// &
'----------------------------------------------------------------'
write(*,*)
! Dump results for final iteration

14
src/GW/qsGGW.f90
View File

@ -1,4 +1,4 @@
subroutine qsGGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, &
subroutine qsGGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, &
eta,regularize,nNuc,ZNuc,rNuc,ENuc,nBas,nBas2,nC,nO,nV,nR,nS,EGHF,Ov,Or,T,V,Hc,ERI_AO, &
ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF)
@ -9,6 +9,8 @@ subroutine qsGGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,do
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
@ -437,4 +439,14 @@ subroutine qsGGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,do
! end if
! Testing zone
if(dotest) then
call dump_test_value('G','qsGW correlation energy',EcRPA)
call dump_test_value('G','qsGW HOMO energy',eGW(nO))
call dump_test_value('G','qsGW LUMO energy',eGW(nO+1))
end if
end subroutine

14
src/GW/qsRGW.f90
View File

@ -1,4 +1,4 @@
subroutine qsRGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, &
subroutine qsRGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dTDA,doppBSE, &
singlet,triplet,eta,regularize,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)
@ -9,6 +9,8 @@ subroutine qsRGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,do
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
@ -343,4 +345,14 @@ subroutine qsRGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,do
end if
! Testing zone
if(dotest) then
call dump_test_value('R','qsGW correlation energy',EcRPA)
call dump_test_value('R','qsGW HOMO energy',eGW(nO))
call dump_test_value('R','qsGW LUMO energy',eGW(nO+1))
end if
end subroutine

16
src/GW/qsUGW.f90
View File

@ -1,4 +1,4 @@
subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,spin_conserved,spin_flip, &
subroutine qsUGW(dotest,maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,spin_conserved,spin_flip, &
eta,regularize,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)
@ -9,6 +9,8 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE,TDA_W,
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: maxSCF
integer,intent(in) :: max_diis
double precision,intent(in) :: thresh
@ -413,4 +415,16 @@ subroutine qsUGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE,TDA_W,
end if
! Testing zone
if(dotest) then
call dump_test_value('U','qsGW correlation energy',EcRPA)
call dump_test_value('U','qsGW HOMOa energy',eGW(nO(1),1))
call dump_test_value('U','qsGW LUMOa energy',eGW(nO(1)+1,1))
call dump_test_value('U','qsGW HOMOa energy',eGW(nO(2),2))
call dump_test_value('U','qsGW LUMOa energy',eGW(nO(2)+1,2))
end if
end subroutine

4
src/GW/ufG0W0.f90
View File

@ -1,4 +1,4 @@
subroutine ufG0W0(nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF,TDA_W)
subroutine ufG0W0(dotest,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF,TDA_W)
! Unfold G0W0 equations
@ -7,6 +7,8 @@ subroutine ufG0W0(nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF,TDA_W)
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: nBas
integer,intent(in) :: nC
integer,intent(in) :: nO

4
src/GW/ufGW.f90
View File

@ -1,4 +1,4 @@
subroutine ufGW(nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
subroutine ufGW(dotest,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
! Unfold GW equations
@ -7,6 +7,8 @@ subroutine ufGW(nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,eHF)
! Input variables
logical,intent(in) :: dotest
integer,intent(in) :: nBas
integer,intent(in) :: nC
integer,intent(in) :: nO

16
src/HF/GHF.f90
View File

@ -234,14 +234,14 @@ subroutine GHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
ET = ETaa + ETbb
! Potential energy
! Potential energy
EVaa = trace_matrix(nBas,matmul(Paa,V))
EVbb = trace_matrix(nBas,matmul(Pbb,V))
EVaa = trace_matrix(nBas,matmul(Paa,V))
EVbb = trace_matrix(nBas,matmul(Pbb,V))
EV = EVaa + EVbb
EV = EVaa + EVbb
! Hartree energy
! Hartree energy
EJaaaa = 0.5d0*trace_matrix(nBas,matmul(Paa,Jaa))
EJaabb = 0.5d0*trace_matrix(nBas,matmul(Paa,Jbb))
@ -294,7 +294,7 @@ subroutine GHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
! Compute final GHF energy
call print_GHF(nBas,nBas2,nO,eHF,C,P,ENuc,ET,EV,EJ,EK,EGHF,dipole)
call print_GHF(nBas,nBas2,nO,eHF,C,P,Ov,ENuc,ET,EV,EJ,EK,EGHF,dipole)
! Print test values
@ -304,7 +304,7 @@ subroutine GHF(dotest,maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
call dump_test_value('G','GHF HOMO energy',eHF(nO))
call dump_test_value('G','GHF LUMO energy',eHF(nO+1))
call dump_test_value('G','GHF dipole moment',norm2(dipole))
end if
end if
end subroutine

2
src/HF/GHF_search.f90
View File

@ -98,7 +98,7 @@ subroutine GHF_search(maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
!---------------------!
call wall_time(start_HF)
call GHF(maxSCF,thresh,max_diis,guess,mix,level_shift,nNuc,ZNuc,rNuc,ENuc, &
call GHF(.false.,maxSCF,thresh,max_diis,guess,mix,level_shift,nNuc,ZNuc,rNuc,ENuc, &
nBas,nBas2,nO,S,T,V,Hc,ERI_AO,dipole_int_AO,X,EHF,e,c,P)
call wall_time(end_HF)

2
src/HF/RHF.f90
View File

@ -201,7 +201,7 @@ subroutine RHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
call dipole_moment(nBas,P,nNuc,ZNuc,rNuc,dipole_int,dipole)
call print_RHF(nBas,nO,eHF,C,ENuc,ET,EV,EJ,EK,ERHF,dipole)
! Print test values
! Testing zone
if(dotest) then

2
src/HF/RHF_search.f90
View File

@ -91,7 +91,7 @@ subroutine RHF_search(maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,rN
!---------------------!
call wall_time(start_HF)
call RHF(maxSCF,thresh,max_diis,guess,level_shift,nNuc,ZNuc,rNuc,ENuc, &
call RHF(.false.,maxSCF,thresh,max_diis,guess,level_shift,nNuc,ZNuc,rNuc,ENuc, &
nBas,nO,S,T,V,Hc,ERI_AO,dipole_int_AO,X,EHF,e,c,P)
call wall_time(end_HF)

2
src/HF/UHF_search.f90
View File

@ -102,7 +102,7 @@ subroutine UHF_search(maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu
!---------------------!
call wall_time(start_HF)
call UHF(maxSCF,thresh,max_diis,guess,mix,level_shift,nNuc,ZNuc,rNuc,ENuc, &
call UHF(.false.,maxSCF,thresh,max_diis,guess,mix,level_shift,nNuc,ZNuc,rNuc,ENuc, &
nBas,nO,S,T,V,Hc,ERI_AO,dipole_int_AO,X,EHF,e,c,P)
call wall_time(end_HF)

164
src/HF/print_GHF.f90
View File

@ -1,4 +1,5 @@
subroutine print_GHF(nBas,nBas2,nO,e,Sao,C,P,ENuc,ET,EV,EJ,EK,EHF,dipole)
subroutine print_GHF(nBas,nBas2,nO,eHF,C,P,S,ENuc,ET,EV,EJ,EK,EGHF,dipole)
! Print one-electron energies and other stuff for GHF
@ -10,28 +11,31 @@ subroutine print_GHF(nBas,nBas2,nO,e,Sao,C,P,ENuc,ET,EV,EJ,EK,EHF,dipole)
integer,intent(in) :: nBas
integer,intent(in) :: nBas2
integer,intent(in) :: nO
double precision,intent(in) :: e(nBas2)
! TODO
! add AO overlap as input
double precision,intent(in) :: Sao(nBas,nBas)
double precision,intent(in) :: eHF(nBas2)
double precision,intent(in) :: C(nBas2,nBas2)
double precision,intent(in) :: P(nBas2,nBas2)
double precision,intent(in) :: S(nBas,nBas)
double precision,intent(in) :: ENuc
double precision,intent(in) :: ET
double precision,intent(in) :: EV
double precision,intent(in) :: EJ
double precision,intent(in) :: EK
double precision,intent(in) :: EHF
double precision,intent(in) :: EGHF
double precision,intent(in) :: dipole(ncart)
! Local variables
integer :: i, j, ixyz
integer :: i,j
integer :: ixyz
integer :: mu,nu
integer :: HOMO
integer :: LUMO
double precision :: Gap
double precision :: Sz,Sx2,Sy2,Sz2,S2
double precision :: Sx ,Sy ,Sz
double precision :: Sx2,Sy2,Sz2
double precision :: S2
double precision :: na, nb
double precision :: nonco_z, contam_uhf, xy_perp, contam_ghf
@ -43,6 +47,15 @@ subroutine print_GHF(nBas,nBas2,nO,e,Sao,C,P,ENuc,ET,EV,EJ,EK,EHF,dipole)
double precision,allocatable :: Pbb(:,:), Sbb(:,:)
double precision,allocatable :: tmp(:,:)
double precision,allocatable :: Mx(:,:)
double precision,allocatable :: My(:,:)
double precision,allocatable :: Mz(:,:)
double precision,allocatable :: PP(:,:)
double precision :: T(3,3)
double precision :: vec(3,3)
double precision :: val(3)
double precision :: lambda
double precision,external :: trace_matrix
logical :: dump_orb = .false.
@ -51,16 +64,52 @@ subroutine print_GHF(nBas,nBas2,nO,e,Sao,C,P,ENuc,ET,EV,EJ,EK,EHF,dipole)
HOMO = nO
LUMO = HOMO + 1
Gap = e(LUMO)-e(HOMO)
Gap = eHF(LUMO)-eHF(HOMO)
! Density matrices
allocate(Paa(nBas2,nBas2),Pab(nBas2,nBas2),Pba(nBas2,nBas2),Pbb(nBas2,nBas2))
allocate(Paa(nO,nO),Pab(nO,nO),Pba(nO,nO),Pbb(nO,nO))
Paa(:,:) = P( 1:nBas , 1:nBas )
Pab(:,:) = P( 1:nBas ,nBas+1:nBas2)
Pba(:,:) = P(nBas+1:nBas2, 1:nBas )
Pbb(:,:) = P(nBas+1:nBas2,nBas+1:nBas2)
allocate(Ca(nBas,nO),Cb(nBas,nO))
Ca(:,:) = C( 1:nBas ,1:nO)
Cb(:,:) = C(nBas+1:nBas2,1:nO)
Paa = matmul(transpose(Ca),matmul(S,Ca))
Pab = matmul(transpose(Ca),matmul(S,Cb))
Pba = matmul(transpose(Cb),matmul(S,Ca))
Pbb = matmul(transpose(Cb),matmul(S,Cb))
! Compute components of S = (Sx,Sy,Sz)
Sx = 0.5d0*(trace_matrix(nO,Pab) + trace_matrix(nO,Pba))
Sy = 0.5d0*(trace_matrix(nO,Pab) - trace_matrix(nO,Pba))
Sz = 0.5d0*(trace_matrix(nO,Paa) - trace_matrix(nO,Pbb))
! Compute <S^2> = <Sx^2> + <Sy^2> + <Sz^2>
! Sx2 = 0.25d0*trace_matrix(nO,Paa+Pbb) + 0.25d0*trace_matrix(nO,Pab+Pba)**2 &
! - 0.5d0*trace_matrix(nO,matmul(Paa,Pbb) + matmul(Pab,Pab))
! Sx2 = trace_matrix(
! Sy2 = 0.25d0*trace_matrix(nO,Paa+Pbb) - 0.25d0*trace_matrix(nO,Pab-Pba)**2 &
! - 0.5d0*trace_matrix(nO,matmul(Paa,Pbb) - matmul(Pab,Pab))
! Sz2 = 0.25d0*trace_matrix(nO,Paa+Pbb) + 0.25d0*trace_matrix(nO,Paa-Pbb)**2 &
! - 0.25d0*trace_matrix(nO,matmul(Paa,Paa) + matmul(Pbb,Pbb)) &
! + 0.25d0*trace_matrix(nO,matmul(Pab,Pba) + matmul(Pba,Pab))
! S2 = Sz*(Sz+1d0) + trace_matrix(nO,Pbb) + 0.25d0*trace_matrix(nO,Paa+Pbb)
! do i=1,nO
! do j=1,nO
! S2 = S2 - 0.25d0*(Paa(i,j) - Pbb(i,j))**2 &
! + (Pba(i,i)*Pab(j,j) - Pba(i,j)*Pab(j,i))
! end do
! end do
! print*,'<S^2> = ',S2
! TODO
! check C size
@ -135,31 +184,46 @@ subroutine print_GHF(nBas,nBas2,nO,e,Sao,C,P,ENuc,ET,EV,EJ,EK,EHF,dipole)
S2 = Sz * (Sz + 1.d0) + nonco_z + contam_ghf
! Compute expectation values of S^2 (WRONG!)
! Sx2 = 0.25d0*trace_matrix(nBas,Paa+Pbb) + 0.25d0*trace_matrix(nBas,Pab+Pba)**2
! do mu=1,nBas
! do nu=1,nBas
! Sx2 = Sx2 - 0.5d0*(Paa(mu,nu)*Pbb(nu,mu) + Pab(mu,nu)*Pab(nu,mu))
! end do
! end do
!
! Sy2 = 0.25d0*trace_matrix(nBas,Paa+Pbb) - 0.25d0*trace_matrix(nBas,Pab+Pba)**2
! do mu=1,nBas
! do nu=1,nBas
! Sy2 = Sy2 - 0.5d0*(Paa(mu,nu)*Pbb(nu,mu) - Pab(mu,nu)*Pab(nu,mu))
! end do
! end do
!
! Sz2 = 0.25d0*trace_matrix(nBas,Paa+Pbb) + 0.25d0*trace_matrix(nBas,Pab-Pba)**2
! do mu=1,nBas
! do nu=1,nBas
! Sz2 = Sz2 - 0.25d0*(Paa(mu,nu)*Pbb(nu,mu) - Pab(mu,nu)*Pab(nu,mu))
! Sz2 = Sz2 + 0.25d0*(Pab(mu,nu)*Pba(nu,mu) - Pba(mu,nu)*Pab(nu,mu))
! end do
! end do
!
! S2 = Sx2 + Sy2 + Sz2
! deallocate(Paa,Pab,Pba,Pbb)
! Check collinearity and coplanarity
! allocate(PP(nO,nO),Mx(nO,nO),My(nO,nO),Mz(nO,nO))
! PP(:,:) = 0.5d0*(Paa(:,:) + Pbb(:,:))
! Mx(:,:) = 0.5d0*(Pba(:,:) + Pab(:,:))
! My(:,:) = 0.5d0*(Pba(:,:) - Pab(:,:))
! Mz(:,:) = 0.5d0*(Paa(:,:) - Pbb(:,:))
! T(1,1) = trace_matrix(nO,matmul(Mx,Mx))
! T(1,2) = trace_matrix(nO,matmul(Mx,My))
! T(1,3) = trace_matrix(nO,matmul(Mx,Mz))
! T(2,1) = trace_matrix(nO,matmul(My,Mx))
! T(2,2) = trace_matrix(nO,matmul(My,My))
! T(2,3) = trace_matrix(nO,matmul(My,Mz))
! T(3,1) = trace_matrix(nO,matmul(Mz,Mx))
! T(3,2) = trace_matrix(nO,matmul(Mz,My))
! T(3,3) = trace_matrix(nO,matmul(Mz,Mz))
! lambda = trace_matrix(nO,PP - matmul(PP,PP))
! write(*,'(A,F10.6)') 'Tr(P - P^2) = ',lambda
! vec(:,:) = T(:,:)
! call diagonalize_matrix(3,vec,val)
! write(*,'(A,3F10.6)') 'Eigenvalues of T = ',val
! T(1,1) = - T(1,1) + lambda
! T(2,2) = - T(2,2) + lambda
! T(3,3) = - T(3,3) + lambda
! vec(:,:) = T(:,:)
! call diagonalize_matrix(3,vec,val)
! write(*,'(A,3F10.6)') 'Eigenvalues of A = ',val
! deallocate(PP,Mx,My,Mz)
! Dump results
@ -175,16 +239,24 @@ subroutine print_GHF(nBas,nBas2,nO,e,Sao,C,P,ENuc,ET,EV,EJ,EK,EHF,dipole)
write(*,'(A33,1X,F16.10,A3)') ' Hartree energy = ',EJ,' au'
write(*,'(A33,1X,F16.10,A3)') ' Exchange energy = ',EK,' au'
write(*,'(A50)') '---------------------------------------'
write(*,'(A33,1X,F16.10,A3)') ' Electronic energy = ',EHF,' au'
write(*,'(A33,1X,F16.10,A3)') ' Electronic energy = ',EGHF,' au'
write(*,'(A33,1X,F16.10,A3)') ' Nuclear repulsion = ',ENuc,' au'
write(*,'(A33,1X,F16.10,A3)') ' GHF energy = ',EHF + ENuc,' au'
write(*,'(A33,1X,F16.10,A3)') ' GHF energy = ',EGHF + ENuc,' au'
write(*,'(A50)') '---------------------------------------'
write(*,'(A33,1X,F16.6,A3)') ' GHF HOMO energy = ',e(HOMO)*HaToeV,' eV'
write(*,'(A33,1X,F16.6,A3)') ' GHF LUMO energy = ',e(LUMO)*HaToeV,' eV'
write(*,'(A33,1X,F16.6,A3)') ' GHF HOMO energy = ',eHF(HOMO)*HaToeV,' eV'
write(*,'(A33,1X,F16.6,A3)') ' GHF LUMO energy = ',eHF(LUMO)*HaToeV,' eV'
write(*,'(A33,1X,F16.6,A3)') ' GHF HOMO-LUMO gap = ',Gap*HaToeV,' eV'
write(*,'(A50)') '---------------------------------------'
! write(*,'(A32,1X,F16.6)') ' <S**2> :',S2
! write(*,'(A50)') '---------------------------------------'
write(*,'(A33,1X,F16.6)') ' <Sx> = ',Sx
write(*,'(A33,1X,F16.6)') ' <Sy> = ',Sy
write(*,'(A33,1X,F16.6)') ' <Sz> = ',Sz
write(*,'(A50)') '---------------------------------------'
write(*,'(A33,1X,F16.6)') ' <Sx**2> = ',Sx2
write(*,'(A33,1X,F16.6)') ' <Sy**2> = ',Sy2
write(*,'(A33,1X,F16.6)') ' <Sz**2> = ',Sz2
write(*,'(A33,1X,F16.6)') ' <S**2> = ',Sx2+Sy2+Sz2
write(*,'(A33,1X,F16.6)') ' <S**2> = ',S2
write(*,'(A50)') '---------------------------------------'
write(*,'(A36)') ' Dipole moment (Debye) '
write(*,'(10X,4A10)') 'X','Y','Z','Tot.'
write(*,'(10X,4F10.4)') (dipole(ixyz)*auToD,ixyz=1,ncart),norm2(dipole)*auToD
@ -197,13 +269,13 @@ subroutine print_GHF(nBas,nBas2,nO,e,Sao,C,P,ENuc,ET,EV,EJ,EK,EHF,dipole)
write(*,'(A50)') '---------------------------------------'
write(*,'(A50)') ' GHF orbital coefficients '
write(*,'(A50)') '---------------------------------------'
call matout(nBas2,nBas2,c)
call matout(nBas2,nBas2,C)
write(*,*)
end if
write(*,'(A50)') '---------------------------------------'
write(*,'(A50)') ' GHF orbital energies (au) '
write(*,'(A50)') '---------------------------------------'
call matout(nBas2,1,e)
call vecout(nBas2,eHF)
write(*,*)
end subroutine

18
src/HF/print_ROHF.f90
View File

@ -1,4 +1,4 @@
subroutine print_ROHF(nBas,nO,e,c,ENuc,ET,EV,EJ,Ex,EHF,dipole)
subroutine print_ROHF(nBas,nO,eHF,c,ENuc,ET,EV,EJ,Ex,EROHF,dipole)
! Print one- and two-electron energies and other stuff for RoHF calculation
@ -7,14 +7,14 @@ subroutine print_ROHF(nBas,nO,e,c,ENuc,ET,EV,EJ,Ex,EHF,dipole)
integer,intent(in) :: nBas
integer,intent(in) :: nO(nspin)
double precision,intent(in) :: e(nBas)
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: c(nBas,nBas)
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) :: EHF
double precision,intent(in) :: EROHF
double precision,intent(in) :: dipole(ncart)
integer :: ixyz
@ -28,16 +28,16 @@ subroutine print_ROHF(nBas,nO,e,c,ENuc,ET,EV,EJ,Ex,EHF,dipole)
do ispin=1,nspin
if(nO(ispin) > 0) then
HOMO(ispin) = e(nO(ispin))
HOMO(ispin) = eHF(nO(ispin))
if(nO(ispin) < nBas) then
LUMO(ispin) = e(nO(ispin)+1)
LUMO(ispin) = eHF(nO(ispin)+1)
else
LUMO(ispin) = 0d0
end if
Gap(ispin) = LUMO(ispin) - HOMO(ispin)
else
HOMO(ispin) = 0d0
LUMO(ispin) = e(1)
LUMO(ispin) = eHF(1)
Gap(ispin) = 0d0
end if
end do
@ -73,9 +73,9 @@ subroutine print_ROHF(nBas,nO,e,c,ENuc,ET,EV,EJ,Ex,EHF,dipole)
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(*,'(A60)') '-------------------------------------------------'
write(*,'(A40,1X,F16.10,A3)') ' Electronic energy: ',EHF,' au'
write(*,'(A40,1X,F16.10,A3)') ' Electronic energy: ',EROHF,' au'
write(*,'(A40,1X,F16.10,A3)') ' Nuclear repulsion: ',ENuc,' au'
write(*,'(A40,1X,F16.10,A3)') ' ROHF energy: ',EHF + ENuc,' au'
write(*,'(A40,1X,F16.10,A3)') ' ROHF energy: ',EROHF + ENuc,' au'
write(*,'(A60)') '-------------------------------------------------'
write(*,'(A40,1X,F16.6,A3)') ' ROHF HOMO a energy:',HOMO(1)*HatoeV,' eV'
write(*,'(A40,1X,F16.6,A3)') ' ROHF LUMO a energy:',LUMO(1)*HatoeV,' eV'
@ -104,7 +104,7 @@ subroutine print_ROHF(nBas,nO,e,c,ENuc,ET,EV,EJ,Ex,EHF,dipole)
write(*,'(A50)') '---------------------------------------'
write(*,'(A50)') ' ROHF orbital energies (au) '
write(*,'(A50)') '---------------------------------------'
call matout(nBas,1,e)
call vecout(nBas,eHF)
write(*,*)
end subroutine

141
src/HF/print_UHF.f90
View File

@ -1,4 +1,4 @@
subroutine print_UHF(nBas,nO,Ov,e,c,ENuc,ET,EV,EJ,Ex,EUHF,dipole)
subroutine print_UHF(nBas,nO,Ov,eHF,c,ENuc,ET,EV,EJ,Ex,EUHF,dipole)
! Print one- and two-electron energies and other stuff for UHF calculation
@ -10,7 +10,7 @@ subroutine print_UHF(nBas,nO,Ov,e,c,ENuc,ET,EV,EJ,Ex,EUHF,dipole)
integer,intent(in) :: nBas
integer,intent(in) :: nO(nspin)
double precision,intent(in) :: Ov(nBas,nBas)
double precision,intent(in) :: e(nBas,nspin)
double precision,intent(in) :: eHF(nBas,nspin)
double precision,intent(in) :: c(nBas,nBas,nspin)
double precision,intent(in) :: ENuc
double precision,intent(in) :: ET(nspin)
@ -27,8 +27,8 @@ subroutine print_UHF(nBas,nO,Ov,e,c,ENuc,ET,EV,EJ,Ex,EUHF,dipole)
double precision :: HOMO(nspin)
double precision :: LUMO(nspin)
double precision :: Gap(nspin)
double precision :: S_exact,S2_exact
double precision :: S,S2
double precision :: Sx,Sy,Sz
double precision :: Sx2,Sy2,Sz2
logical :: dump_orb = .false.
@ -36,100 +36,103 @@ subroutine print_UHF(nBas,nO,Ov,e,c,ENuc,ET,EV,EJ,Ex,EUHF,dipole)
do ispin=1,nspin
if(nO(ispin) > 0) then
HOMO(ispin) = e(nO(ispin),ispin)
HOMO(ispin) = eHF(nO(ispin),ispin)
if(nO(ispin) < nBas) then
LUMO(ispin) = e(nO(ispin)+1,ispin)
LUMO(ispin) = eHF(nO(ispin)+1,ispin)
else
LUMO(ispin) = 0d0
end if
Gap(ispin) = LUMO(ispin) - HOMO(ispin)
else
HOMO(ispin) = 0d0
LUMO(ispin) = e(1,ispin)
LUMO(ispin) = eHF(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(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)
Sz = 0.5d0*dble(nO(1) - nO(2))
! print*,Sz*(Sz+1d0) + nO(2) - sum(matmul(transpose(c(:,1:nO(1),1)),matmul(Ov,c(:,1:nO(2),2)))**2)
Sx2 = 0.25d0*dble(nO(1) - nO(2)) + 0.5d0*nO(2) - 0.5d0*sum(matmul(transpose(c(:,1:nO(1),1)),matmul(Ov,c(:,1:nO(2),2)))**2)
Sy2 = 0.25d0*dble(nO(1) - nO(2)) + 0.5d0*nO(2) - 0.5d0*sum(matmul(transpose(c(:,1:nO(1),1)),matmul(Ov,c(:,1:nO(2),2)))**2)
Sz2 = 0.25d0*dble(nO(1) - nO(2))**2
! Dump results
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(*,'(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(*,'(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(*,'(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(*,'(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(*,'(A60)') '-------------------------------------------------'
write(*,'(A40,1X,F16.10,A3)') ' Electronic energy: ',EUHF,' au'
write(*,'(A40,1X,F16.10,A3)') ' Nuclear repulsion: ',ENuc,' au'
write(*,'(A40,1X,F16.10,A3)') ' UHF energy: ',EUHF + ENuc,' au'
write(*,'(A60)') '-------------------------------------------------'
write(*,'(A40,1X,F16.6,A3)') ' UHF HOMO a energy:',HOMO(1)*HatoeV,' eV'
write(*,'(A40,1X,F16.6,A3)') ' UHF LUMO a energy:',LUMO(1)*HatoeV,' eV'
write(*,'(A40,1X,F16.6,A3)') ' UHF HOMOa-LUMOa gap:',Gap(1)*HatoeV,' eV'
write(*,'(A60)') '-------------------------------------------------'
write(*,'(A40,1X,F16.6,A3)') ' UHF HOMO b energy:',HOMO(2)*HatoeV,' eV'
write(*,'(A40,1X,F16.6,A3)') ' UHF LUMO b energy:',LUMO(2)*HatoeV,' eV'
write(*,'(A40,1X,F16.6,A3)') ' UHF 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)') ' <S**2> (exact) :',S2_exact
write(*,'(A40,1X,F16.6)') ' <S**2> :',S2
write(*,'(A60)') '-------------------------------------------------'
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(*,'(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(*,'(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(*,'(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(*,'(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(*,'(A60)') '---------------------------------------------'
write(*,'(A40,1X,F16.10,A3)') ' Electronic energy = ',EUHF,' au'
write(*,'(A40,1X,F16.10,A3)') ' Nuclear repulsion = ',ENuc,' au'
write(*,'(A40,1X,F16.10,A3)') ' UHF energy = ',EUHF + ENuc,' au'
write(*,'(A60)') '---------------------------------------------'
write(*,'(A40,1X,F16.6,A3)') ' UHF HOMO a energy = ' ,HOMO(1)*HatoeV,' eV'
write(*,'(A40,1X,F16.6,A3)') ' UHF LUMO a energy = ' ,LUMO(1)*HatoeV,' eV'
write(*,'(A40,1X,F16.6,A3)') ' UHF HOMOa-LUMOa gap = ' ,Gap(1)*HatoeV,' eV'
write(*,'(A60)') '---------------------------------------------'
write(*,'(A40,1X,F16.6,A3)') ' UHF HOMO b energy = ',HOMO(2)*HatoeV,' eV'
write(*,'(A40,1X,F16.6,A3)') ' UHF LUMO b energy = ',LUMO(2)*HatoeV,' eV'
write(*,'(A40,1X,F16.6,A3)') ' UHF HOMOb-LUMOb gap = ',Gap(2)*HatoeV,' eV'
write(*,'(A60)') '---------------------------------------------'
write(*,'(A40,1X,F10.6)') ' <Sx> = ',Sx
write(*,'(A40,1X,F10.6)') ' <Sy> = ',Sy
write(*,'(A40,1X,F10.6)') ' <Sz> = ',Sz
write(*,'(A40,1X,F10.6)') ' <Sx^2> = ',Sx2
write(*,'(A40,1X,F10.6)') ' <Sy^2> = ',Sy2
write(*,'(A40,1X,F10.6)') ' <Sz^2> = ',Sz2
write(*,'(A40,1X,F10.6)') ' <S^2> = ',Sx2+Sy2+Sz2
write(*,'(A60)') '---------------------------------------------'
write(*,'(A45)') ' Dipole moment (Debye) '
write(*,'(19X,4A10)') 'X','Y','Z','Tot.'
write(*,'(19X,4F10.4)') (dipole(ixyz)*auToD,ixyz=1,ncart),norm2(dipole)*auToD
write(*,'(A60)') '-------------------------------------------------'
write(*,'(A60)') '---------------------------------------------'
write(*,*)
! Print results
if(dump_orb) then
write(*,'(A50)') '-----------------------------------------'
write(*,'(A50)') 'UHF spin-up orbital coefficients '
write(*,'(A50)') '-----------------------------------------'
write(*,'(A40)') '-----------------------------------------'
write(*,'(A40)') 'UHF spin-up orbital coefficients '
write(*,'(A40)') '-----------------------------------------'
call matout(nBas,nBas,c(:,:,1))
write(*,*)
write(*,'(A50)') '-----------------------------------------'
write(*,'(A50)') 'UHF spin-down orbital coefficients '
write(*,'(A50)') '-----------------------------------------'
write(*,'(A40)') '-----------------------------------------'
write(*,'(A40)') 'UHF spin-down orbital coefficients '
write(*,'(A40)') '-----------------------------------------'
call matout(nBas,nBas,c(:,:,2))
write(*,*)
end if
write(*,'(A50)') '---------------------------------------'
write(*,'(A50)') ' UHF spin-up orbital energies '
write(*,'(A50)') '---------------------------------------'
call matout(nBas,1,e(:,1))
write(*,'(A40)') '---------------------------------------'
write(*,'(A40)') ' UHF spin-up orbital energies '
write(*,'(A40)') '---------------------------------------'
call vecout(nBas,eHF(:,1))
write(*,*)
write(*,'(A50)') '---------------------------------------'
write(*,'(A50)') ' UHF spin-down orbital energies '
write(*,'(A50)') '---------------------------------------'
call matout(nBas,1,e(:,2))
write(*,'(A40)') '---------------------------------------'
write(*,'(A40)') ' UHF spin-down orbital energies '
write(*,'(A40)') '---------------------------------------'
call vecout(nBas,eHF(:,2))
write(*,*)
end subroutine

2
src/MP/GMP2.f90
View File

@ -178,7 +178,7 @@ subroutine GMP2(dotest,regularize,nBas,nC,nO,nV,nR,ERI,ENuc,EGHF,eHF,EcMP2)
if(dotest) then
call dump_test_value('G','GMP2 correlation energy',EcMP2)
call dump_test_value('G','MP2 correlation energy',EcMP2)
end if

2
src/MP/RMP2.f90
View File

@ -175,7 +175,7 @@ subroutine RMP2(dotest,regularize,nBas,nC,nO,nV,nR,ERI,ENuc,ERHF,eHF,EcMP2)
if(dotest) then
call dump_test_value('R','RMP2 correlation energy',EcMP2)
call dump_test_value('R','MP2 correlation energy',EcMP2)
end if

2
src/MP/UMP2.f90
View File

@ -160,7 +160,7 @@ subroutine UMP2(dotest,nBas,nC,nO,nV,nR,ERI_aa,ERI_ab,ERI_bb,ENuc,EUHF,eHF,Ec)
if(dotest) then
call dump_test_value('U','UMP2 correlation energy',sum(Ec))
call dump_test_value('U','MP2 correlation energy',sum(Ec))
end if

70
src/QuAcK/GQuAcK.f90
View File

@ -1,9 +1,11 @@
subroutine GQuAcK(dotest,doGHF,dostab,dosearch,doMP2,doMP3,dophRPA,dophRPAx,doppRPA, &
doG0W0,doevGW,doqsGW,doG0F2,doevGF2,doqsGF2, &
nNuc,nBas,nC,nO,nV,nR,ENuc,ZNuc,rNuc,S,T,V,Hc,X,dipole_int_AO,ERI_AO, &
maxSCF_HF,max_diis_HF,thresh_HF,level_shift,guess_type,mix,reg_MP, &
TDA,maxSCF_GF,max_diis_GF,thresh_GF,lin_GF,reg_GF,eta_GF, &
maxSCF_GW,max_diis_GW,thresh_GW,TDA_W,lin_GW,reg_GW,eta_GW, &
subroutine GQuAcK(dotest,doGHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,doDCD,doCCSD,doCCSDT, &
dodrCCD,dorCCD,docrCCD,dolCCD,dophRPA,dophRPAx,docrRPA,doppRPA, &
doG0W0,doevGW,doqsGW,doG0F2,doevGF2,doqsGF2, &
nNuc,nBas,nC,nO,nV,nR,ENuc,ZNuc,rNuc,S,T,V,Hc,X,dipole_int_AO,ERI_AO, &
maxSCF_HF,max_diis_HF,thresh_HF,level_shift,guess_type,mix,reg_MP, &
maxSCF_CC,max_diis_CC,thresh_CC, &
TDA,maxSCF_GF,max_diis_GF,thresh_GF,lin_GF,reg_GF,eta_GF, &
maxSCF_GW,max_diis_GW,thresh_GW,TDA_W,lin_GW,reg_GW,eta_GW, &
dophBSE,dophBSE2,doppBSE,dBSE,dTDA,doACFDT,exchange_kernel,doXBS)
implicit none
@ -16,7 +18,9 @@ subroutine GQuAcK(dotest,doGHF,dostab,dosearch,doMP2,doMP3,dophRPA,dophRPAx,dopp
logical,intent(in) :: dosearch
logical,intent(in) :: doMP2
logical,intent(in) :: doMP3
logical,intent(in) :: dophRPA,dophRPAx,doppRPA
logical,intent(in) :: doCCD,dopCCD,doDCD,doCCSD,doCCSDT
logical,intent(in) :: dodrCCD,dorCCD,docrCCD,dolCCD
logical,intent(in) :: dophRPA,dophRPAx,docrRPA,doppRPA
logical,intent(in) :: doG0F2,doevGF2,doqsGF2
logical,intent(in) :: doG0W0,doevGW,doqsGW
@ -43,6 +47,9 @@ subroutine GQuAcK(dotest,doGHF,dostab,dosearch,doMP2,doMP3,dophRPA,dophRPAx,dopp
logical,intent(in) :: reg_MP
integer,intent(in) :: maxSCF_CC,max_diis_CC
double precision,intent(in) :: thresh_CC
logical,intent(in) :: TDA
integer,intent(in) :: maxSCF_GF,max_diis_GF
@ -60,18 +67,19 @@ subroutine GQuAcK(dotest,doGHF,dostab,dosearch,doMP2,doMP3,dophRPA,dophRPAx,dopp
! Local variables
logical :: doMP,doRPA,doGF,doGW
logical :: doMP,doCC,doRPA,doGF,doGW
double precision :: start_HF ,end_HF ,t_HF
double precision :: start_stab ,end_stab ,t_stab
double precision :: start_AOtoMO ,end_AOtoMO ,t_AOtoMO
double precision :: start_MP ,end_MP ,t_MP
double precision :: start_CC ,end_CC ,t_CC
double precision :: start_RPA ,end_RPA ,t_RPA
double precision :: start_GF ,end_GF ,t_GF
double precision :: start_GW ,end_GW ,t_GW
double precision,allocatable :: cHF(:,:),epsHF(:),PHF(:,:)
double precision :: EHF
double precision,allocatable :: cHF(:,:),eHF(:),PHF(:,:)
double precision :: EGHF
double precision,allocatable :: dipole_int_MO(:,:,:)
double precision,allocatable :: ERI_MO(:,:,:,:)
double precision,allocatable :: ERI_tmp(:,:,:,:)
@ -93,7 +101,7 @@ subroutine GQuAcK(dotest,doGHF,dostab,dosearch,doMP2,doMP3,dophRPA,dophRPAx,dopp
nBas2 = 2*nBas
allocate(cHF(nBas2,nBas2),epsHF(nBas2),PHF(nBas2,nBas2), &
allocate(cHF(nBas2,nBas2),eHF(nBas2),PHF(nBas2,nBas2), &
dipole_int_MO(nBas2,nBas2,ncart),ERI_MO(nBas2,nBas2,nBas2,nBas2))
!---------------------!
@ -104,7 +112,7 @@ subroutine GQuAcK(dotest,doGHF,dostab,dosearch,doMP2,doMP3,dophRPA,dophRPAx,dopp
call wall_time(start_HF)
call GHF(dotest,maxSCF_HF,thresh_HF,max_diis_HF,guess_type,mix,level_shift,nNuc,ZNuc,rNuc,ENuc, &
nBas,nBas2,nO,S,T,V,Hc,ERI_AO,dipole_int_AO,X,EHF,epsHF,cHF,PHF)
nBas,nBas2,nO,S,T,V,Hc,ERI_AO,dipole_int_AO,X,EGHF,eHF,cHF,PHF)
call wall_time(end_HF)
t_HF = end_HF - start_HF
@ -165,7 +173,7 @@ subroutine GQuAcK(dotest,doGHF,dostab,dosearch,doMP2,doMP3,dophRPA,dophRPAx,dopp
if(dostab) then
call wall_time(start_stab)
call GHF_stability(nBas2,nC,nO,nV,nR,nS,epsHF,ERI_MO)
call GHF_stability(nBas2,nC,nO,nV,nR,nS,eHF,ERI_MO)
call wall_time(end_stab)
t_stab = end_stab - start_stab
@ -178,7 +186,7 @@ subroutine GQuAcK(dotest,doGHF,dostab,dosearch,doMP2,doMP3,dophRPA,dophRPAx,dopp
call wall_time(start_stab)
call GHF_search(maxSCF_HF,thresh_HF,max_diis_HF,guess_type,mix,level_shift,nNuc,ZNuc,rNuc,ENuc, &
nBas,nBas2,nC,nO,nV,nR,S,T,V,Hc,ERI_AO,dipole_int_AO,X,EHF,epsHF,cHF,PHF)
nBas,nBas2,nC,nO,nV,nR,S,T,V,Hc,ERI_AO,dipole_int_AO,X,EGHF,eHF,cHF,PHF)
call wall_time(end_stab)
t_stab = end_stab - start_stab
@ -196,7 +204,7 @@ subroutine GQuAcK(dotest,doGHF,dostab,dosearch,doMP2,doMP3,dophRPA,dophRPAx,dopp
if(doMP) then
call wall_time(start_MP)
call GMP(dotest,doMP2,doMP3,reg_MP,nBas2,nC,nO,nV,nR,ERI_MO,ENuc,EHF,epsHF)
call GMP(dotest,doMP2,doMP3,reg_MP,nBas2,nC,nO,nV,nR,ERI_MO,ENuc,EGHF,eHF)
call wall_time(end_MP)
t_MP = end_MP - start_MP
@ -205,17 +213,35 @@ subroutine GQuAcK(dotest,doGHF,dostab,dosearch,doMP2,doMP3,dophRPA,dophRPAx,dopp
end if
!------------------------!
! Coupled-cluster module !
!------------------------!
doCC = doCCD .or. doCCSD .or. doCCSDT .or. dodrCCD .or. dorCCD .or. docrCCD .or. dolCCD
if(doCC) then
call wall_time(start_CC)
call GCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,dolCCD, &
maxSCF_CC,thresh_CC,max_diis_CC,nBas2,nC,nO,nV,nR,ERI_MO,ENuc,EGHF,eHF)
call wall_time(end_CC)
t_CC = end_CC - start_CC
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for CC = ',t_CC,' seconds'
write(*,*)
end if
!-----------------------------------!
! Random-phase approximation module !
!-----------------------------------!
doRPA = dophRPA .or. dophRPAx .or. doppRPA
doRPA = dophRPA .or. dophRPAx .or. docrRPA .or. doppRPA
if(doRPA) then
call wall_time(start_RPA)
call GRPA(dotest,dophRPA,dophRPAx,doppRPA,TDA,doACFDT,exchange_kernel,nBas2,nC,nO,nV,nR,nS,ENuc,EHF, &
ERI_MO,dipole_int_MO,epsHF,cHF,S)
call GRPA(dotest,dophRPA,dophRPAx,docrRPA,doppRPA,TDA,nBas2,nC,nO,nV,nR,nS,ENuc,EGHF,ERI_MO,dipole_int_MO,eHF)
call wall_time(end_RPA)
t_RPA = end_RPA - start_RPA
@ -233,8 +259,8 @@ subroutine GQuAcK(dotest,doGHF,dostab,dosearch,doMP2,doMP3,dophRPA,dophRPAx,dopp
if(doGF) then
call wall_time(start_GF)
call GGF(doG0F2,doevGF2,doqsGF2,maxSCF_GF,thresh_GF,max_diis_GF,dophBSE,doppBSE,TDA,dBSE,dTDA,lin_GF,eta_GF,reg_GF, &
nNuc,ZNuc,rNuc,ENuc,nBas2,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,epsHF)
call GGF(dotest,doG0F2,doevGF2,doqsGF2,maxSCF_GF,thresh_GF,max_diis_GF,dophBSE,doppBSE,TDA,dBSE,dTDA,lin_GF,eta_GF,reg_GF, &
nNuc,ZNuc,rNuc,ENuc,nBas2,nC,nO,nV,nR,nS,EGHF,S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF)
call wall_time(end_GF)
t_GF = end_GF - start_GF
@ -252,9 +278,9 @@ subroutine GQuAcK(dotest,doGHF,dostab,dosearch,doMP2,doMP3,dophRPA,dophRPAx,dopp
if(doGW) then
call wall_time(start_GW)
call GGW(doG0W0,doevGW,doqsGW,maxSCF_GW,thresh_GW,max_diis_GW,doACFDT,exchange_kernel,doXBS, &
call GGW(dotest,doG0W0,doevGW,doqsGW,maxSCF_GW,thresh_GW,max_diis_GW,doACFDT,exchange_kernel,doXBS, &
dophBSE,dophBSE2,doppBSE,TDA_W,TDA,dBSE,dTDA,lin_GW,eta_GW,reg_GW,nNuc,ZNuc,rNuc,ENuc, &
nBas,nBas2,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,epsHF)
nBas,nBas2,nC,nO,nV,nR,nS,EGHF,S,X,T,V,Hc,ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,eHF)
call wall_time(end_GW)
t_GW = end_GW - start_GW

5
src/QuAcK/QuAcK.f90
View File

@ -226,11 +226,12 @@ program QuAcK
!--------------------------!
if(doGQuAcK) &
call GQuAcK(doGtest,doGHF,dostab,dosearch,doMP2,doMP3,dophRPA,dophRPAx,doppRPA, &
call GQuAcK(doGtest,doGHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,doDCD,doCCSD,doCCSDT, &
dodrCCD,dorCCD,docrCCD,dolCCD,dophRPA,dophRPAx,docrRPA,doppRPA, &
doG0W0,doevGW,doqsGW,doG0F2,doevGF2,doqsGF2, &
nNuc,nBas,sum(nC),sum(nO),sum(nV),sum(nR),ENuc,ZNuc,rNuc,S,T,V,Hc,X,dipole_int_AO,ERI_AO, &
maxSCF_HF,max_diis_HF,thresh_HF,level_shift,guess_type,mix,reg_MP, &
TDA,maxSCF_GF,max_diis_GF,thresh_GF,lin_GF,reg_GF,eta_GF, &
maxSCF_CC,max_diis_CC,thresh_CC,TDA,maxSCF_GF,max_diis_GF,thresh_GF,lin_GF,reg_GF,eta_GF, &
maxSCF_GW,max_diis_GW,thresh_GW,TDA_W,lin_GW,reg_GW,eta_GW, &
dophBSE,dophBSE2,doppBSE,dBSE,dTDA,doACFDT,exchange_kernel,doXBS)

44
src/QuAcK/RQuAcK.f90
View File

@ -90,8 +90,8 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
double precision :: start_GW ,end_GW ,t_GW
double precision :: start_GT ,end_GT ,t_GT
double precision,allocatable :: cHF(:,:),epsHF(:),PHF(:,:)
double precision :: EHF
double precision,allocatable :: cHF(:,:),eHF(:),PHF(:,:)
double precision :: ERHF
double precision,allocatable :: dipole_int_MO(:,:,:)
double precision,allocatable :: ERI_MO(:,:,:,:)
integer :: ixyz
@ -107,7 +107,7 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
! Memory allocation !
!-------------------!
allocate(cHF(nBas,nBas),epsHF(nBas),PHF(nBas,nBas), &
allocate(cHF(nBas,nBas),eHF(nBas),PHF(nBas,nBas), &
dipole_int_MO(nBas,nBas,ncart),ERI_MO(nBas,nBas,nBas,nBas))
!---------------------!
@ -118,7 +118,7 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
call wall_time(start_HF)
call RHF(dotest,maxSCF_HF,thresh_HF,max_diis_HF,guess_type,level_shift,nNuc,ZNuc,rNuc,ENuc, &
nBas,nO,S,T,V,Hc,ERI_AO,dipole_int_AO,X,EHF,epsHF,cHF,PHF)
nBas,nO,S,T,V,Hc,ERI_AO,dipole_int_AO,X,ERHF,eHF,cHF,PHF)
call wall_time(end_HF)
t_HF = end_HF - start_HF
@ -131,7 +131,7 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
call wall_time(start_HF)
call ROHF(dotest,maxSCF_HF,thresh_HF,max_diis_HF,guess_type,mix,level_shift,nNuc,ZNuc,rNuc,ENuc, &
nBas,nO,S,T,V,Hc,ERI_AO,dipole_int_AO,X,EHF,epsHF,cHF,PHF)
nBas,nO,S,T,V,Hc,ERI_AO,dipole_int_AO,X,ERHF,eHF,cHF,PHF)
call wall_time(end_HF)
t_HF = end_HF - start_HF
@ -175,7 +175,7 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
if(dostab) then
call wall_time(start_stab)
call RHF_stability(nBas,nC,nO,nV,nR,nS,epsHF,ERI_MO)
call RHF_stability(nBas,nC,nO,nV,nR,nS,eHF,ERI_MO)
call wall_time(end_stab)
t_stab = end_stab - start_stab
@ -188,7 +188,7 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
call wall_time(start_stab)
call RHF_search(maxSCF_HF,thresh_HF,max_diis_HF,guess_type,level_shift,nNuc,ZNuc,rNuc,ENuc, &
nBas,nC,nO,nV,nR,S,T,V,Hc,ERI_AO,dipole_int_AO,X,EHF,epsHF,cHF,PHF)
nBas,nC,nO,nV,nR,S,T,V,Hc,ERI_AO,dipole_int_AO,X,ERHF,eHF,cHF,PHF)
call wall_time(end_stab)
t_stab = end_stab - start_stab
@ -206,7 +206,7 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
if(doMP) then
call wall_time(start_MP)
call RMP(dotest,doMP2,doMP3,reg_MP,nBas,nC,nO,nV,nR,ERI_MO,ENuc,EHF,epsHF)
call RMP(dotest,doMP2,doMP3,reg_MP,nBas,nC,nO,nV,nR,ERI_MO,ENuc,ERHF,eHF)
call wall_time(end_MP)
t_MP = end_MP - start_MP
@ -225,8 +225,8 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
if(doCC) then
call wall_time(start_CC)
call RCC(doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,dolCCD, &
maxSCF_CC,thresh_CC,max_diis_CC,nBas,nC,nO,nV,nR,ERI_MO,ENuc,EHF,epsHF)
call RCC(dotest,doCCD,dopCCD,doDCD,doCCSD,doCCSDT,dodrCCD,dorCCD,docrCCD,dolCCD, &
maxSCF_CC,thresh_CC,max_diis_CC,nBas,nC,nO,nV,nR,ERI_MO,ENuc,ERHF,eHF)
call wall_time(end_CC)
t_CC = end_CC - start_CC
@ -244,8 +244,8 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
if(doCI) then
call wall_time(start_CI)
call RCI(doCIS,doCIS_D,doCID,doCISD,doFCI,singlet,triplet,nBas,nC,nO,nV,nR,nS,ERI_MO,dipole_int_MO, &
epsHF,EHF,cHF,S)
call RCI(dotest,doCIS,doCIS_D,doCID,doCISD,doFCI,singlet,triplet,nBas,nC,nO,nV,nR,nS,ERI_MO,dipole_int_MO, &
eHF,ERHF,cHF,S)
call wall_time(end_CI)
t_CI = end_CI - start_CI
@ -264,7 +264,7 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
call wall_time(start_RPA)
call RRPA(dotest,dophRPA,dophRPAx,docrRPA,doppRPA,TDA,doACFDT,exchange_kernel,singlet,triplet, &
nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI_MO,dipole_int_MO,epsHF,cHF,S)
nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI_MO,dipole_int_MO,eHF,cHF,S)
call wall_time(end_RPA)
t_RPA = end_RPA - start_RPA
@ -282,10 +282,10 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
if(doGF) then
call wall_time(start_GF)
call RGF(doG0F2,doevGF2,doqsGF2,doG0F3,doevGF3,renorm_GF,maxSCF_GF,thresh_GF,max_diis_GF, &
call RGF(dotest,doG0F2,doevGF2,doqsGF2,doG0F3,doevGF3,renorm_GF,maxSCF_GF,thresh_GF,max_diis_GF, &
dophBSE,doppBSE,TDA,dBSE,dTDA,singlet,triplet,lin_GF,eta_GF,reg_GF, &
nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc,ERI_AO,ERI_MO, &
dipole_int_AO,dipole_int_MO,PHF,cHF,epsHF)
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 wall_time(end_GF)
t_GF = end_GF - start_GF
@ -303,10 +303,10 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
if(doGW) then
call wall_time(start_GW)
call RGW(doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF_GW,thresh_GW,max_diis_GW,doACFDT, &
call RGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF_GW,thresh_GW,max_diis_GW,doACFDT, &
exchange_kernel,doXBS,dophBSE,dophBSE2,doppBSE,TDA_W,TDA,dBSE,dTDA,singlet,triplet, &
lin_GW,eta_GW,reg_GW,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc, &
ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,epsHF)
lin_GW,eta_GW,reg_GW,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 wall_time(end_GW)
t_GW = end_GW - start_GW
@ -324,10 +324,10 @@ subroutine RQuAcK(dotest,doRHF,doROHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,d
if(doGT) then
call wall_time(start_GT)
call RGT(doG0T0pp,doevGTpp,doqsGTpp,doG0T0eh,doevGTeh,doqsGTeh,maxSCF_GT,thresh_GT,max_diis_GT,doACFDT, &
call RGT(dotest,doG0T0pp,doevGTpp,doqsGTpp,doG0T0eh,doevGTeh,doqsGTeh,maxSCF_GT,thresh_GT,max_diis_GT,doACFDT, &
exchange_kernel,doXBS,dophBSE,dophBSE2,doppBSE,TDA_T,TDA,dBSE,dTDA,singlet,triplet, &
lin_GT,eta_GT,reg_GT,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc, &
ERI_AO,ERI_MO,dipole_int_AO,dipole_int_MO,PHF,cHF,epsHF)
lin_GT,eta_GT,reg_GT,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 wall_time(end_GT)
t_GT = end_GT - start_GT

40
src/QuAcK/UQuAcK.f90
View File

@ -88,8 +88,8 @@ subroutine UQuAcK(dotest,doUHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,doDCD,do
double precision :: start_GW ,end_GW ,t_GW
double precision :: start_GT ,end_GT ,t_GT
double precision,allocatable :: cHF(:,:,:),epsHF(:,:),PHF(:,:,:)
double precision :: EHF
double precision,allocatable :: cHF(:,:,:),eHF(:,:),PHF(:,:,:)
double precision :: EUHF
double precision,allocatable :: dipole_int_aa(:,:,:),dipole_int_bb(:,:,:)
double precision,allocatable :: ERI_aaaa(:,:,:,:),ERI_aabb(:,:,:,:),ERI_bbbb(:,:,:,:)
integer :: ixyz
@ -105,7 +105,7 @@ subroutine UQuAcK(dotest,doUHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,doDCD,do
! Memory allocation !
!-------------------!
allocate(cHF(nBas,nBas,nspin),epsHF(nBas,nspin),PHF(nBas,nBas,nspin), &
allocate(cHF(nBas,nBas,nspin),eHF(nBas,nspin),PHF(nBas,nBas,nspin), &
dipole_int_aa(nBas,nBas,ncart),dipole_int_bb(nBas,nBas,ncart), &
ERI_aaaa(nBas,nBas,nBas,nBas),ERI_aabb(nBas,nBas,nBas,nBas),ERI_bbbb(nBas,nBas,nBas,nBas))
@ -117,7 +117,7 @@ subroutine UQuAcK(dotest,doUHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,doDCD,do
call wall_time(start_HF)
call UHF(dotest,maxSCF_HF,thresh_HF,max_diis_HF,guess_type,mix,level_shift,nNuc,ZNuc,rNuc,ENuc, &
nBas,nO,S,T,V,Hc,ERI_AO,dipole_int_AO,X,EHF,epsHF,cHF,PHF)
nBas,nO,S,T,V,Hc,ERI_AO,dipole_int_AO,X,EUHF,eHF,cHF,PHF)
call wall_time(end_HF)
t_HF = end_HF - start_HF
@ -138,7 +138,7 @@ subroutine UQuAcK(dotest,doUHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,doDCD,do
! write(*,*)
! call eDFT(maxSCF_HF,thresh_HF,max_diis_HF,guess_type,mix,level_shift,nNuc,ZNuc,rNuc,ENuc,nBas,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,EHF,epsHF,cHF,PHF,Vxc)
! max_ang_mom,min_exponent,max_exponent,S,T,V,Hc,X,ERI_AO,dipole_int_AO,EUHF,eHF,cHF,PHF,Vxc)
! call wall_time(end_KS)
! t_KS = end_KS - start_KS
@ -191,7 +191,7 @@ subroutine UQuAcK(dotest,doUHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,doDCD,do
if(dostab) then
call wall_time(start_stab)
call UHF_stability(nBas,nC,nO,nV,nR,nS,epsHF,ERI_aaaa,ERI_aabb,ERI_bbbb)
call UHF_stability(nBas,nC,nO,nV,nR,nS,eHF,ERI_aaaa,ERI_aabb,ERI_bbbb)
call wall_time(end_stab)
t_stab = end_stab - start_stab
@ -204,7 +204,7 @@ subroutine UQuAcK(dotest,doUHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,doDCD,do
call wall_time(start_stab)
call UHF_search(maxSCF_HF,thresh_HF,max_diis_HF,guess_type,mix,level_shift,nNuc,ZNuc,rNuc,ENuc, &
nBas,nC,nO,nV,nR,S,T,V,Hc,ERI_AO,dipole_int_AO,X,EHF,epsHF,cHF,PHF)
nBas,nC,nO,nV,nR,S,T,V,Hc,ERI_AO,dipole_int_AO,X,EUHF,eHF,cHF,PHF)
call wall_time(end_stab)
@ -223,7 +223,7 @@ subroutine UQuAcK(dotest,doUHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,doDCD,do
if(doMP) then
call wall_time(start_MP)
call UMP(dotest,doMP2,doMP3,reg_MP,nBas,nC,nO,nV,nR,ERI_aaaa,ERI_aabb,ERI_bbbb,ENuc,EHF,epsHF)
call UMP(dotest,doMP2,doMP3,reg_MP,nBas,nC,nO,nV,nR,ERI_aaaa,ERI_aabb,ERI_bbbb,ENuc,EUHF,eHF)
call wall_time(end_MP)
t_MP = end_MP - start_MP
@ -259,8 +259,8 @@ subroutine UQuAcK(dotest,doUHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,doDCD,do
if(doCI) then
call wall_time(start_CI)
call UCI(doCIS,doCIS_D,doCID,doCISD,doFCI,spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS, &
ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb,epsHF,EHF,cHF,S)
call UCI(dotest,doCIS,doCIS_D,doCID,doCISD,doFCI,spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS, &
ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb,eHF,EUHF,cHF,S)
call wall_time(end_CI)
t_CI = end_CI - start_CI
@ -279,7 +279,7 @@ subroutine UQuAcK(dotest,doUHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,doDCD,do
call wall_time(start_RPA)
call URPA(dotest,dophRPA,dophRPAx,docrRPA,doppRPA,TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip, &
nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb,epsHF,cHF,S)
nBas,nC,nO,nV,nR,nS,ENuc,EUHF,ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_aa,dipole_int_bb,eHF,cHF,S)
call wall_time(end_RPA)
t_RPA = end_RPA - start_RPA
@ -297,10 +297,10 @@ subroutine UQuAcK(dotest,doUHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,doDCD,do
if(doGF) then
call wall_time(start_GF)
call UGF(doG0F2,doevGF2,doqsGF2,doG0F3,doevGF3,renorm_GF,maxSCF_GF,thresh_GF,max_diis_GF, &
call UGF(dotest,doG0F2,doevGF2,doqsGF2,doG0F3,doevGF3,renorm_GF,maxSCF_GF,thresh_GF,max_diis_GF, &
dophBSE,doppBSE,TDA,dBSE,dTDA,spin_conserved,spin_flip,lin_GF,eta_GF,reg_GF, &
nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc,ERI_AO,ERI_aaaa,ERI_aabb,ERI_bbbb, &
dipole_int_AO,dipole_int_aa,dipole_int_bb,PHF,cHF,epsHF)
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)
call wall_time(end_GF)
t_GF = end_GF - start_GF
@ -318,10 +318,10 @@ subroutine UQuAcK(dotest,doUHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,doDCD,do
if(doGW) then
call wall_time(start_GW)
call UGW(doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF_GW,thresh_GW,max_diis_GW,doACFDT, &
call UGW(dotest,doG0W0,doevGW,doqsGW,doufG0W0,doufGW,doSRGqsGW,maxSCF_GW,thresh_GW,max_diis_GW,doACFDT, &
exchange_kernel,doXBS,dophBSE,dophBSE2,doppBSE,TDA_W,TDA,dBSE,dTDA,spin_conserved,spin_flip, &
lin_GW,eta_GW,reg_GW,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc, &
ERI_AO,ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_AO,dipole_int_aa,dipole_int_bb,PHF,cHF,epsHF)
lin_GW,eta_GW,reg_GW,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)
call wall_time(end_GW)
t_GW = end_GW - start_GW
@ -339,10 +339,10 @@ subroutine UQuAcK(dotest,doUHF,dostab,dosearch,doMP2,doMP3,doCCD,dopCCD,doDCD,do
if(doGT) then
call wall_time(start_GT)
call UGT(doG0T0pp,doevGTpp,doqsGTpp,doG0T0eh,doevGTeh,doqsGTeh,maxSCF_GT,thresh_GT,max_diis_GT,doACFDT, &
call UGT(dotest,doG0T0pp,doevGTpp,doqsGTpp,doG0T0eh,doevGTeh,doqsGTeh,maxSCF_GT,thresh_GT,max_diis_GT,doACFDT, &
exchange_kernel,doXBS,dophBSE,dophBSE2,doppBSE,TDA_T,TDA,dBSE,dTDA,spin_conserved,spin_flip, &
lin_GT,eta_GT,reg_GT,nNuc,ZNuc,rNuc,ENuc,nBas,nC,nO,nV,nR,nS,EHF,S,X,T,V,Hc, &
ERI_AO,ERI_aaaa,ERI_aabb,ERI_bbbb,dipole_int_AO,dipole_int_aa,dipole_int_bb,PHF,cHF,epsHF)
lin_GT,eta_GT,reg_GT,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)
call wall_time(end_GT)
t_GT = end_GT - start_GT

31
src/RPA/GRPA.f90
View File

@ -1,4 +1,4 @@
subroutine GRPA(dotest,dophRPA,dophRPAx,doppRPA,TDA,doACFDT,exchange_kernel,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,epsHF)
subroutine GRPA(dotest,dophRPA,dophRPAx,docrRPA,doppRPA,TDA,nBas,nC,nO,nV,nR,nS,ENuc,EGHF,ERI,dipole_int,eHF)
! Random-phase approximation module
@ -11,11 +11,10 @@ subroutine GRPA(dotest,dophRPA,dophRPAx,doppRPA,TDA,doACFDT,exchange_kernel,nBas
logical,intent(in) :: dophRPA
logical,intent(in) :: dophRPAx
logical,intent(in) :: docrRPA
logical,intent(in) :: doppRPA
logical,intent(in) :: TDA
logical,intent(in) :: doACFDT
logical,intent(in) :: exchange_kernel
integer,intent(in) :: nBas
integer,intent(in) :: nC
integer,intent(in) :: nO
@ -23,8 +22,8 @@ subroutine GRPA(dotest,dophRPA,dophRPAx,doppRPA,TDA,doACFDT,exchange_kernel,nBas
integer,intent(in) :: nR
integer,intent(in) :: nS
double precision,intent(in) :: ENuc
double precision,intent(in) :: EHF
double precision,intent(in) :: epsHF(nBas)
double precision,intent(in) :: EGHF
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
double precision,intent(in) :: dipole_int(nBas,nBas,ncart)
@ -39,7 +38,7 @@ subroutine GRPA(dotest,dophRPA,dophRPAx,doppRPA,TDA,doACFDT,exchange_kernel,nBas
if(dophRPA) then
call wall_time(start_RPA)
call phGRPA(dotest,TDA,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,epsHF)
call phGRPA(dotest,TDA,nBas,nC,nO,nV,nR,nS,ENuc,EGHF,ERI,dipole_int,eHF)
call wall_time(end_RPA)
t_RPA = end_RPA - start_RPA
@ -55,7 +54,7 @@ subroutine GRPA(dotest,dophRPA,dophRPAx,doppRPA,TDA,doACFDT,exchange_kernel,nBas
if(dophRPAx) then
call wall_time(start_RPA)
call phGRPAx(dotest,TDA,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,epsHF)
call phGRPAx(dotest,TDA,nBas,nC,nO,nV,nR,nS,ENuc,EGHF,ERI,dipole_int,eHF)
call wall_time(end_RPA)
@ -65,6 +64,22 @@ subroutine GRPA(dotest,dophRPA,dophRPAx,doppRPA,TDA,doACFDT,exchange_kernel,nBas
end if
!------------------------------------------------------------------------
! Compute crRPA excitations
!------------------------------------------------------------------------
if(docrRPA) then
call wall_time(start_RPA)
call crGRPA(dotest,TDA,nBas,nC,nO,nV,nR,nS,ENuc,EGHF,ERI,dipole_int,eHF)
call wall_time(end_RPA)
t_RPA = end_RPA - start_RPA
write(*,'(A65,1X,F9.3,A8)') 'Total CPU time for cr-RPA = ',t_RPA,' seconds'
write(*,*)
end if
!------------------------------------------------------------------------
! Compute ppRPA excitations
!------------------------------------------------------------------------
@ -72,7 +87,7 @@ subroutine GRPA(dotest,dophRPA,dophRPAx,doppRPA,TDA,doACFDT,exchange_kernel,nBas
if(doppRPA) then
call wall_time(start_RPA)
call ppGRPA(dotest,TDA,doACFDT,nBas,nC,nO,nV,nR,ENuc,EHF,ERI,dipole_int,epsHF)
call ppGRPA(dotest,TDA,nBas,nC,nO,nV,nR,nS,ENuc,EGHF,ERI,dipole_int,eHF)
call wall_time(end_RPA)
t_RPA = end_RPA - start_RPA

85
src/RPA/crGRPA.f90 Normal file
View File

@ -0,0 +1,85 @@
subroutine crGRPA(dotest,TDA,nBas,nC,nO,nV,nR,nS,ENuc,EGHF,ERI,dipole_int,eHF)
! Crossed-ring channel of the random phase approximation
implicit none
include 'parameters.h'
include 'quadrature.h'
! Input variables
logical,intent(in) :: dotest
logical,intent(in) :: TDA
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) :: ENuc
double precision,intent(in) :: EGHF
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
double precision,intent(in) :: dipole_int(nBas,nBas,ncart)
! Local variables
integer :: ispin
logical :: dRPA
double precision,allocatable :: Aph(:,:)
double precision,allocatable :: Bph(:,:)
double precision,allocatable :: Om(:)
double precision,allocatable :: XpY(:,:)
double precision,allocatable :: XmY(:,:)
double precision :: EcRPA
! Hello world
write(*,*)
write(*,*)'**********************************'
write(*,*)'* Generalized cr-RPA Calculation *'
write(*,*)'**********************************'
write(*,*)
! TDA
if(TDA) then
write(*,*) 'Tamm-Dancoff approximation activated!'
write(*,*)
end if
! Initialization
dRPA = .false.
EcRPA = 0d0
! Memory allocation
allocate(Om(nS),XpY(nS,nS),XmY(nS,nS),Aph(nS,nS))
if(.not.TDA) allocate(Bph(nS,nS))
ispin = 3
call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,-1d0,eHF,ERI,Aph)
if(.not.TDA) call phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,-1d0,ERI,Bph)
call phLR(TDA,nS,Aph,Bph,EcRPA,Om,XpY,XmY)
call print_excitation_energies('crRPA@GHF',ispin,nS,Om)
call phLR_transition_vectors(.true.,nBas,nC,nO,nV,nR,nS,dipole_int,Om,XpY,XmY)
write(*,*)
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A50,F20.10,A3)') 'Tr@crRPA correlation energy = ',EcRPA,' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@crRPA total energy = ',ENuc + EGHF + EcRPA,' au'
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)
if(dotest) then
call dump_test_value('G','crRPA correlation energy',EcRPA)
end if
end subroutine

46
src/RPA/crRRPA.f90
View File

@ -1,4 +1,4 @@
subroutine crRRPA(dotest,TDA,doACFDT,exchange_kernel,singlet,triplet,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,e)
subroutine crRRPA(dotest,TDA,doACFDT,exchange_kernel,singlet,triplet,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF)
! Crossed-ring channel of the random phase approximation
@ -22,8 +22,8 @@ subroutine crRRPA(dotest,TDA,doACFDT,exchange_kernel,singlet,triplet,nBas,nC,nO,
integer,intent(in) :: nR
integer,intent(in) :: nS
double precision,intent(in) :: ENuc
double precision,intent(in) :: EHF
double precision,intent(in) :: e(nBas)
double precision,intent(in) :: ERHF
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
double precision,intent(in) :: dipole_int(nBas,nBas,ncart)
@ -42,9 +42,9 @@ subroutine crRRPA(dotest,TDA,doACFDT,exchange_kernel,singlet,triplet,nBas,nC,nO,
! Hello world
write(*,*)
write(*,*)'***********************************************************'
write(*,*)'| Random phase approximation calculation: cr channel |'
write(*,*)'***********************************************************'
write(*,*)'*********************************'
write(*,*)'* Restricted cr-RPA Calculation *'
write(*,*)'*********************************'
write(*,*)
! TDA
@ -56,10 +56,8 @@ subroutine crRRPA(dotest,TDA,doACFDT,exchange_kernel,singlet,triplet,nBas,nC,nO,
! Initialization
dRPA = .false.
dRPA = .false.
EcRPA(:) = 0d0
EcRPA(:) = 0d0
! Memory allocation
@ -72,11 +70,11 @@ subroutine crRRPA(dotest,TDA,doACFDT,exchange_kernel,singlet,triplet,nBas,nC,nO,
ispin = 1
call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,-1d0,e,ERI,Aph)
call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,-1d0,eHF,ERI,Aph)
if(.not.TDA) call phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,-1d0,ERI,Bph)
call phLR(TDA,nS,Aph,Bph,EcRPA(ispin),Om,XpY,XmY)
call print_excitation_energies('crRPA@HF',ispin,nS,Om)
call print_excitation_energies('crRPA@RHF',ispin,nS,Om)
call phLR_transition_vectors(.true.,nBas,nC,nO,nV,nR,nS,dipole_int,Om,XpY,XmY)
endif
@ -87,7 +85,7 @@ subroutine crRRPA(dotest,TDA,doACFDT,exchange_kernel,singlet,triplet,nBas,nC,nO,
ispin = 2
call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,-1d0,e,ERI,Aph)
call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,-1d0,eHF,ERI,Aph)
if(.not.TDA) call phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,-1d0,ERI,Bph)
call phLR(TDA,nS,Aph,Bph,EcRPA(ispin),Om,XpY,XmY)
@ -105,10 +103,10 @@ subroutine crRRPA(dotest,TDA,doACFDT,exchange_kernel,singlet,triplet,nBas,nC,nO,
write(*,*)
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A50,F20.10)') 'Tr@crRPA correlation energy (singlet) =',EcRPA(1)
write(*,'(2X,A50,F20.10)') 'Tr@crRPA correlation energy (triplet) =',EcRPA(2)
write(*,'(2X,A50,F20.10)') 'Tr@crRPA correlation energy =',EcRPA(1) + EcRPA(2)
write(*,'(2X,A50,F20.10)') 'Tr@crRPA total energy =',ENuc + EHF + EcRPA(1) + EcRPA(2)
write(*,'(2X,A50,F20.10,A3)') 'Tr@crRRPA correlation energy (singlet) =',EcRPA(1),' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@crRRPA correlation energy (triplet) =',EcRPA(2),' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@crRRPA correlation energy =',sum(EcRPA),' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@crRRPA total energy =',ENuc + ERHF + sum(EcRPA),' au'
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)
@ -121,17 +119,23 @@ subroutine crRRPA(dotest,TDA,doACFDT,exchange_kernel,singlet,triplet,nBas,nC,nO,
write(*,*) '-------------------------------------------------------'
write(*,*)
call crACFDT(exchange_kernel,dRPA,TDA,singlet,triplet,nBas,nC,nO,nV,nR,nS,ERI,e,EcRPA)
call crACFDT(exchange_kernel,dRPA,TDA,singlet,triplet,nBas,nC,nO,nV,nR,nS,ERI,eHF,EcRPA)
write(*,*)
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A50,F20.10)') 'AC@crRPA correlation energy (singlet) =',EcRPA(1)
write(*,'(2X,A50,F20.10)') 'AC@crRPA correlation energy (triplet) =',EcRPA(2)
write(*,'(2X,A50,F20.10)') 'AC@crRPA correlation energy =',EcRPA(1) + EcRPA(2)
write(*,'(2X,A50,F20.10)') 'AC@crRPA total energy =',ENuc + EHF + EcRPA(1) + EcRPA(2)
write(*,'(2X,A50,F20.10,A3)') 'AC@crRRPA correlation energy (singlet) =',EcRPA(1),' au'
write(*,'(2X,A50,F20.10,A3)') 'AC@crRRPA correlation energy (triplet) =',EcRPA(2),' au'
write(*,'(2X,A50,F20.10,A3)') 'AC@crRRPA correlation energy =',sum(EcRPA),' au'
write(*,'(2X,A50,F20.10,A3)') 'AC@crRRPA total energy =',ENuc + ERHF + sum(EcRPA),' au'
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)
end if
if(dotest) then
call dump_test_value('R','crRPA correlation energy',sum(EcRPA))
end if
end subroutine

17
src/RPA/phGRPA.f90
View File

@ -1,4 +1,4 @@
subroutine phGRPA(dotest,TDA,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,e)
subroutine phGRPA(dotest,TDA,nBas,nC,nO,nV,nR,nS,ENuc,EGHF,ERI,dipole_int,eHF)
! Perform a direct random phase approximation calculation
@ -18,8 +18,8 @@ subroutine phGRPA(dotest,TDA,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,e)
integer,intent(in) :: nR
integer,intent(in) :: nS
double precision,intent(in) :: ENuc
double precision,intent(in) :: EHF
double precision,intent(in) :: e(nBas)
double precision,intent(in) :: EGHF
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
double precision,intent(in) :: dipole_int(nBas,nBas,ncart)
@ -52,8 +52,7 @@ subroutine phGRPA(dotest,TDA,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,e)
! Initialization
dRPA = .true.
dRPA = .true.
EcRPA = 0d0
! Memory allocation
@ -63,7 +62,7 @@ subroutine phGRPA(dotest,TDA,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,e)
ispin = 3
call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,e,ERI,Aph)
call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,Aph)
if(.not.TDA) call phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,ERI,Bph)
call phLR(TDA,nS,Aph,Bph,EcRPA,Om,XpY,XmY)
@ -72,14 +71,14 @@ subroutine phGRPA(dotest,TDA,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,e)
write(*,*)
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A50,F20.10)') 'Tr@phGRPA correlation energy = ',EcRPA
write(*,'(2X,A50,F20.10)') 'Tr@phGRPA total energy = ',ENuc + EHF + EcRPA
write(*,'(2X,A50,F20.10,A3)') 'Tr@phGRPA correlation energy = ',EcRPA,' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@phGRPA total energy = ',ENuc + EGHF + EcRPA,' au'
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)
if(dotest) then
call dump_test_value('G','phGRPA corrlation energy',EcRPA)
call dump_test_value('G','phRPA corrlation energy',EcRPA)
end if

16
src/RPA/phGRPAx.f90
View File

@ -1,4 +1,4 @@
subroutine phGRPAx(dotest,TDA,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,e)
subroutine phGRPAx(dotest,TDA,nBas,nC,nO,nV,nR,nS,ENuc,EGHF,ERI,dipole_int,eHF)
! Perform random phase approximation calculation with exchange (aka TDHF)
@ -18,8 +18,8 @@ subroutine phGRPAx(dotest,TDA,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,e)
integer,intent(in) :: nR
integer,intent(in) :: nS
double precision,intent(in) :: ENuc
double precision,intent(in) :: EHF
double precision,intent(in) :: e(nBas)
double precision,intent(in) :: EGHF
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
double precision,intent(in) :: dipole_int(nBas,nBas,ncart)
@ -47,14 +47,12 @@ subroutine phGRPAx(dotest,TDA,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,e)
if(TDA) then
write(*,*) 'Tamm-Dancoff approximation activated!'
write(*,*) ' => RPAx + TDA = CIS '
write(*,*)
end if
! Initialization
dRPA = .false.
dRPA = .false.
EcRPA = 0d0
! Memory allocation
@ -64,7 +62,7 @@ subroutine phGRPAx(dotest,TDA,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,e)
ispin = 3
call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,e,ERI,Aph)
call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,Aph)
if(.not.TDA) call phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,ERI,Bph)
call phLR(TDA,nS,Aph,Bph,EcRPA,Om,XpY,XmY)
@ -74,13 +72,13 @@ subroutine phGRPAx(dotest,TDA,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,e)
write(*,*)
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A50,F20.10,A3)') 'Tr@phRPAx correlation energy = ',EcRPA,' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@phRPAx total energy = ',ENuc + EHF + EcRPA,' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@phRPAx total energy = ',ENuc + EGHF + EcRPA,' au'
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)
if(dotest) then
call dump_test_value('G','phGRPAx correlation energy',EcRPA)
call dump_test_value('G','phRPAx correlation energy',EcRPA)
end if

19
src/RPA/phRRPA.f90
View File

@ -1,4 +1,4 @@
subroutine phRRPA(dotest,TDA,doACFDT,exchange_kernel,singlet,triplet,nBas,nC,nO,nV,nR,nS,ENuc,EHF,ERI,dipole_int,e)
subroutine phRRPA(dotest,TDA,doACFDT,exchange_kernel,singlet,triplet,nBas,nC,nO,nV,nR,nS,ENuc,ERHF,ERI,dipole_int,eHF)
! Perform a direct random phase approximation calculation
@ -22,8 +22,8 @@ subroutine phRRPA(dotest,TDA,doACFDT,exchange_kernel,singlet,triplet,nBas,nC,nO,
integer,intent(in) :: nR
integer,intent(in) :: nS
double precision,intent(in) :: ENuc
double precision,intent(in) :: EHF
double precision,intent(in) :: e(nBas)
double precision,intent(in) :: ERHF
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
double precision,intent(in) :: dipole_int(nBas,nBas,ncart)
@ -57,7 +57,6 @@ subroutine phRRPA(dotest,TDA,doACFDT,exchange_kernel,singlet,triplet,nBas,nC,nO,
! Initialization
dRPA = .true.
EcRPA(:) = 0d0
! Memory allocation
@ -71,7 +70,7 @@ subroutine phRRPA(dotest,TDA,doACFDT,exchange_kernel,singlet,triplet,nBas,nC,nO,
ispin = 1
call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,e,ERI,Aph)
call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,Aph)
if(.not.TDA) call phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,ERI,Bph)
call phLR(TDA,nS,Aph,Bph,EcRPA(ispin),Om,XpY,XmY)
@ -86,7 +85,7 @@ subroutine phRRPA(dotest,TDA,doACFDT,exchange_kernel,singlet,triplet,nBas,nC,nO,
ispin = 2
call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,e,ERI,Aph)
call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,Aph)
if(.not.TDA) call phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,ERI,Bph)
call phLR(TDA,nS,Aph,Bph,EcRPA(ispin),Om,XpY,XmY)
@ -107,7 +106,7 @@ subroutine phRRPA(dotest,TDA,doACFDT,exchange_kernel,singlet,triplet,nBas,nC,nO,
write(*,'(2X,A50,F20.10,A3)') 'Tr@phRRPA correlation energy (singlet) = ',EcRPA(1),' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@phRRPA correlation energy (triplet) = ',EcRPA(2),' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@phRRPA correlation energy = ',sum(EcRPA),' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@phRRPA total energy = ',ENuc + EHF + sum(EcRPA),' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@phRRPA total energy = ',ENuc + ERHF + sum(EcRPA),' au'
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)
@ -122,14 +121,14 @@ subroutine phRRPA(dotest,TDA,doACFDT,exchange_kernel,singlet,triplet,nBas,nC,nO,
write(*,*) '--------------------------------------------------------'
write(*,*)
call phACFDT(exchange_kernel,dRPA,TDA,singlet,triplet,nBas,nC,nO,nV,nR,nS,ERI,e,EcRPA)
call phACFDT(exchange_kernel,dRPA,TDA,singlet,triplet,nBas,nC,nO,nV,nR,nS,ERI,eHF,EcRPA)
write(*,*)
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A50,F20.10,A3)') 'AC@phRRPA correlation energy (singlet) = ',EcRPA(1),' au'
write(*,'(2X,A50,F20.10,A3)') 'AC@phRRPA correlation energy (triplet) = ',EcRPA(2),' au'
write(*,'(2X,A50,F20.10,A3)') 'AC@phRRPA correlation energy = ',sum(EcRPA),' au'
write(*,'(2X,A50,F20.10,A3)') 'AC@phRRPA total energy = ',ENuc + EHF + sum(EcRPA),' au'
write(*,'(2X,A50,F20.10,A3)') 'AC@phRRPA total energy = ',ENuc + ERHF + sum(EcRPA),' au'
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)
@ -137,7 +136,7 @@ subroutine phRRPA(dotest,TDA,doACFDT,exchange_kernel,singlet,triplet,nBas,nC,nO,
if(dotest) then
call dump_test_value('R','phRRPA correlation energy',sum(EcRPA))
call dump_test_value('R','phRPA correlation energy',sum(EcRPA))
end if

11
src/RPA/phRRPAx.f90
View File

@ -42,16 +42,15 @@ subroutine phRRPAx(dotest,TDA,doACFDT,exchange_kernel,singlet,triplet,nBas,nC,nO
! Hello world
write(*,*)
write(*,*)'***********************************************************'
write(*,*)'| Random phase approximation calculation with exchange |'
write(*,*)'***********************************************************'
write(*,*)'**********************************'
write(*,*)'* Restricted ph-RPAx Calculation *'
write(*,*)'**********************************'
write(*,*)
! TDA
if(TDA) then
write(*,*) 'Tamm-Dancoff approximation activated!'
write(*,*) ' => RPAx + TDA = CIS '
write(*,*)
end if
@ -138,9 +137,11 @@ subroutine phRRPAx(dotest,TDA,doACFDT,exchange_kernel,singlet,triplet,nBas,nC,nO
end if
! Testing zone
if(dotest) then
call dump_test_value('R','phRRPAx correlation energy',sum(EcRPA))
call dump_test_value('R','phRPAx correlation energy',sum(EcRPA))
end if

2
src/RPA/phURPA.f90
View File

@ -167,7 +167,7 @@ subroutine phURPA(dotest,TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,nB
if(dotest) then
call dump_test_value('U','phURPA correlation energy',sum(EcRPA))
call dump_test_value('U','phRPA correlation energy',sum(EcRPA))
end if

4
src/RPA/phURPAx.f90
View File

@ -169,9 +169,11 @@ subroutine phURPAx(dotest,TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,n
end if
! Testing zone
if(dotest) then
call dump_test_value('U','phURPAx correlation energy',sum(EcRPA))
call dump_test_value('U','phRPAx correlation energy',sum(EcRPA))
end if

35
src/RPA/ppGRPA.f90
View File

@ -1,4 +1,4 @@
subroutine ppGRPA(dotest,TDA,doACFDT,nBas,nC,nO,nV,nR,ENuc,EHF,ERI,dipole_int,e)
subroutine ppGRPA(dotest,TDA,nBas,nC,nO,nV,nR,ENuc,EGHF,ERI,dipole_int,eHF)
! Perform ppGRPA calculation
@ -10,15 +10,14 @@ subroutine ppGRPA(dotest,TDA,doACFDT,nBas,nC,nO,nV,nR,ENuc,EHF,ERI,dipole_int,e)
logical,intent(in) :: dotest
logical,intent(in) :: TDA
logical,intent(in) :: doACFDT
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) :: EGHF
double precision,intent(in) :: eHF(nBas)
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
double precision,intent(in) :: dipole_int(nBas,nBas,ncart)
@ -60,8 +59,8 @@ subroutine ppGRPA(dotest,TDA,doACFDT,nBas,nC,nO,nV,nR,ENuc,EHF,ERI,dipole_int,e)
Bpp(nVV,nOO),Cpp(nVV,nVV),Dpp(nOO,nOO))
if(.not.TDA) call ppLR_B(ispin,nBas,nC,nO,nV,nR,nOO,nVV,1d0,ERI,Bpp)
call ppLR_C(ispin,nBas,nC,nO,nV,nR,nVV,1d0,e,ERI,Cpp)
call ppLR_D(ispin,nBas,nC,nO,nV,nR,nOO,1d0,e,ERI,Dpp)
call ppLR_C(ispin,nBas,nC,nO,nV,nR,nVV,1d0,eHF,ERI,Cpp)
call ppLR_D(ispin,nBas,nC,nO,nV,nR,nOO,1d0,eHF,ERI,Dpp)
call ppLR(TDA,nOO,nVV,Bpp,Cpp,Dpp,Om1,X1,Y1,Om2,X2,Y2,EcRPA)
@ -73,33 +72,13 @@ subroutine ppGRPA(dotest,TDA,doACFDT,nBas,nC,nO,nV,nR,ENuc,EHF,ERI,dipole_int,e)
write(*,*)
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A50,F20.10,A3)') 'Tr@ppGRPA correlation energy = ',EcRPA,' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@ppGRPA total energy = ',ENuc + EHF + EcRPA,' au'
write(*,'(2X,A50,F20.10,A3)') 'Tr@ppGRPA total energy = ',ENuc + EGHF + EcRPA,' au'
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)
! Compute the correlation energy via the adiabatic connection
! if(doACFDT) then
! write(*,*) '--------------------------------------------------------'
! write(*,*) 'Adiabatic connection version of ppRPA correlation energy'
! write(*,*) '--------------------------------------------------------'
! write(*,*)
! call ppACFDT(TDA,singlet,triplet,nBas,nC,nO,nV,nR,ERI,e,EcRPA)
! write(*,*)
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,'(2X,A50,F20.10,A3)') 'AC@ppRPA correlation energy =',EcRPA,' au'
! write(*,'(2X,A50,F20.10,A3)') 'AC@ppRPA total energy =',ENuc + EHF + EcRPA(1) + EcRPA(2),' au'
! write(*,*)'-------------------------------------------------------------------------------'
! write(*,*)
! end if
if(dotest) then
call dump_test_value('G','ppGRPA correlation energy',EcRPA)
call dump_test_value('G','ppRPA correlation energy',EcRPA)
end if

2
src/RPA/ppRRPA.f90
View File

@ -152,7 +152,7 @@ subroutine ppRRPA(dotest,TDA,doACFDT,singlet,triplet,nBas,nC,nO,nV,nR,ENuc,EHF,E
if(dotest) then
call dump_test_value('R','ppRRPA correlation energy',sum(EcRPA))
call dump_test_value('R','ppRPA correlation energy',sum(EcRPA))
end if

4
src/RPA/ppURPA.f90
View File

@ -156,9 +156,11 @@ subroutine ppURPA(dotest,TDA,doACFDT,spin_conserved,spin_flip,nBas,nC,nO,nV,nR,E
! end if
! Testing zone
if(dotest) then
call dump_test_value('U','ppURPA correlation energy',sum(EcRPA))
call dump_test_value('U','ppRPA correlation energy',sum(EcRPA))
end if

Some files were not shown because too many files have changed in this diff Show More