diff --git a/input/methods b/input/methods.default similarity index 86% rename from input/methods rename to input/methods.default index 682b927..4f2a83b 100644 --- a/input/methods +++ b/input/methods.default @@ -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 diff --git a/input/options b/input/options deleted file mode 100644 index 979a4b1..0000000 --- a/input/options +++ /dev/null @@ -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 diff --git a/input/options.default b/input/options.default new file mode 100644 index 0000000..8a86013 --- /dev/null +++ b/input/options.default @@ -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 diff --git a/src/CC/CCD.f90 b/src/CC/CCD.f90 index e7844ab..c44e00e 100644 --- a/src/CC/CCD.f90 +++ b/src/CC/CCD.f90 @@ -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 diff --git a/src/CC/CCSD.f90 b/src/CC/CCSD.f90 index 42d0a90..0c895b4 100644 --- a/src/CC/CCSD.f90 +++ b/src/CC/CCSD.f90 @@ -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 diff --git a/src/CC/DCD.f90 b/src/CC/DCD.f90 index e7d856a..91344e8 100644 --- a/src/CC/DCD.f90 +++ b/src/CC/DCD.f90 @@ -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 diff --git a/src/CC/GCC.f90 b/src/CC/GCC.f90 new file mode 100644 index 0000000..4ce7985 --- /dev/null +++ b/src/CC/GCC.f90 @@ -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 diff --git a/src/CC/GCCD.f90 b/src/CC/GCCD.f90 new file mode 100644 index 0000000..2f5869a --- /dev/null +++ b/src/CC/GCCD.f90 @@ -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 diff --git a/src/CC/GCCSD.f90 b/src/CC/GCCSD.f90 new file mode 100644 index 0000000..31bc9ae --- /dev/null +++ b/src/CC/GCCSD.f90 @@ -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 diff --git a/src/CC/RCC.f90 b/src/CC/RCC.f90 index 2e5722d..142d8fc 100644 --- a/src/CC/RCC.f90 +++ b/src/CC/RCC.f90 @@ -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 diff --git a/src/CC/crCCD.f90 b/src/CC/crCCD.f90 index d427ba7..ffc1881 100644 --- a/src/CC/crCCD.f90 +++ b/src/CC/crCCD.f90 @@ -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 diff --git a/src/CC/crGCCD.f90 b/src/CC/crGCCD.f90 new file mode 100644 index 0000000..b1058aa --- /dev/null +++ b/src/CC/crGCCD.f90 @@ -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 diff --git a/src/CC/drCCD.f90 b/src/CC/drCCD.f90 index 33764d6..0a46948 100644 --- a/src/CC/drCCD.f90 +++ b/src/CC/drCCD.f90 @@ -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 diff --git a/src/CC/drGCCD.f90 b/src/CC/drGCCD.f90 new file mode 100644 index 0000000..0692d63 --- /dev/null +++ b/src/CC/drGCCD.f90 @@ -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 diff --git a/src/CC/lCCD.f90 b/src/CC/lCCD.f90 index b7c77ae..440933f 100644 --- a/src/CC/lCCD.f90 +++ b/src/CC/lCCD.f90 @@ -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 diff --git a/src/CC/lGCCD.f90 b/src/CC/lGCCD.f90 new file mode 100644 index 0000000..3c4a3d3 --- /dev/null +++ b/src/CC/lGCCD.f90 @@ -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 diff --git a/src/CC/pCCD.f90 b/src/CC/pCCD.f90 index 203db1a..916d9af 100644 --- a/src/CC/pCCD.f90 +++ b/src/CC/pCCD.f90 @@ -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 diff --git a/src/CC/rCCD.f90 b/src/CC/rCCD.f90 index bba1607..bbd6444 100644 --- a/src/CC/rCCD.f90 +++ b/src/CC/rCCD.f90 @@ -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 diff --git a/src/CC/rGCCD.f90 b/src/CC/rGCCD.f90 new file mode 100644 index 0000000..6aea413 --- /dev/null +++ b/src/CC/rGCCD.f90 @@ -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 diff --git a/src/CI/CID.f90 b/src/CI/CID.f90 index df14e0b..ef8d65e 100644 --- a/src/CI/CID.f90 +++ b/src/CI/CID.f90 @@ -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 diff --git a/src/CI/CISD.f90 b/src/CI/CISD.f90 index fdd928e..38bce1d 100644 --- a/src/CI/CISD.f90 +++ b/src/CI/CISD.f90 @@ -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 diff --git a/src/CI/RCI.f90 b/src/CI/RCI.f90 index e6e21f7..84a7fe8 100644 --- a/src/CI/RCI.f90 +++ b/src/CI/RCI.f90 @@ -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 diff --git a/src/CI/CIS.f90 b/src/CI/RCIS.f90 similarity index 83% rename from src/CI/CIS.f90 rename to src/CI/RCIS.f90 index aff6b97..54f0add 100644 --- a/src/CI/CIS.f90 +++ b/src/CI/RCIS.f90 @@ -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 diff --git a/src/CI/UCI.f90 b/src/CI/UCI.f90 index 8ddae0e..ba2f3fb 100644 --- a/src/CI/UCI.f90 +++ b/src/CI/UCI.f90 @@ -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) diff --git a/src/CI/UCIS.f90 b/src/CI/UCIS.f90 index bd049ff..148f9e0 100644 --- a/src/CI/UCIS.f90 +++ b/src/CI/UCIS.f90 @@ -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 diff --git a/src/GF/GG0F2.f90 b/src/GF/GG0F2.f90 index 4b82ef5..562ee85 100644 --- a/src/GF/GG0F2.f90 +++ b/src/GF/GG0F2.f90 @@ -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 diff --git a/src/GF/GGF.f90 b/src/GF/GGF.f90 index 8570bfa..c8064ae 100644 --- a/src/GF/GGF.f90 +++ b/src/GF/GGF.f90 @@ -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) diff --git a/src/GF/G0F2.f90 b/src/GF/RG0F2.f90 similarity index 79% rename from src/GF/G0F2.f90 rename to src/GF/RG0F2.f90 index daa307a..dbce318 100644 --- a/src/GF/G0F2.f90 +++ b/src/GF/RG0F2.f90 @@ -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 diff --git a/src/GF/G0F3.f90 b/src/GF/RG0F3.f90 similarity index 99% rename from src/GF/G0F3.f90 rename to src/GF/RG0F3.f90 index 90e67a6..4995415 100644 --- a/src/GF/G0F3.f90 +++ b/src/GF/RG0F3.f90 @@ -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) diff --git a/src/GF/RGF.f90 b/src/GF/RGF.f90 index 6ff348e..490dd49 100644 --- a/src/GF/RGF.f90 +++ b/src/GF/RGF.f90 @@ -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 diff --git a/src/GF/UG0F2.f90 b/src/GF/UG0F2.f90 index 8383c96..3874808 100644 --- a/src/GF/UG0F2.f90 +++ b/src/GF/UG0F2.f90 @@ -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 diff --git a/src/GF/UGF.f90 b/src/GF/UGF.f90 index 1aa8357..55bafb9 100644 --- a/src/GF/UGF.f90 +++ b/src/GF/UGF.f90 @@ -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) diff --git a/src/GF/evGGF2.f90 b/src/GF/evGGF2.f90 index 086c7ff..bdcdd0c 100644 --- a/src/GF/evGGF2.f90 +++ b/src/GF/evGGF2.f90 @@ -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 diff --git a/src/GF/evGF2.f90 b/src/GF/evRGF2.f90 similarity index 89% rename from src/GF/evGF2.f90 rename to src/GF/evRGF2.f90 index ebc85da..b10c514 100644 --- a/src/GF/evGF2.f90 +++ b/src/GF/evRGF2.f90 @@ -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 diff --git a/src/GF/evGF3.f90 b/src/GF/evRGF3.f90 similarity index 98% rename from src/GF/evGF3.f90 rename to src/GF/evRGF3.f90 index 8451ee5..852cbc1 100644 --- a/src/GF/evGF3.f90 +++ b/src/GF/evRGF3.f90 @@ -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 diff --git a/src/GF/evUGF2.f90 b/src/GF/evUGF2.f90 index e01066d..d19c5d0 100644 --- a/src/GF/evUGF2.f90 +++ b/src/GF/evUGF2.f90 @@ -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 diff --git a/src/GF/print_G0F2.f90 b/src/GF/print_RG0F2.f90 similarity index 97% rename from src/GF/print_G0F2.f90 rename to src/GF/print_RG0F2.f90 index c521761..428220c 100644 --- a/src/GF/print_G0F2.f90 +++ b/src/GF/print_RG0F2.f90 @@ -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 diff --git a/src/GF/print_UG0F2.f90 b/src/GF/print_UG0F2.f90 index 7a3b2aa..c727f03 100644 --- a/src/GF/print_UG0F2.f90 +++ b/src/GF/print_UG0F2.f90 @@ -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 diff --git a/src/GF/print_evGF2.f90 b/src/GF/print_evRGF2.f90 similarity index 97% rename from src/GF/print_evGF2.f90 rename to src/GF/print_evRGF2.f90 index 1e4bdf7..17e6e80 100644 --- a/src/GF/print_evGF2.f90 +++ b/src/GF/print_evRGF2.f90 @@ -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 diff --git a/src/GF/print_evUGF2.f90 b/src/GF/print_evUGF2.f90 index 59a054a..eefe183 100644 --- a/src/GF/print_evUGF2.f90 +++ b/src/GF/print_evUGF2.f90 @@ -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 diff --git a/src/GF/print_qsGF2.f90 b/src/GF/print_qsRGF2.f90 similarity index 98% rename from src/GF/print_qsGF2.f90 rename to src/GF/print_qsRGF2.f90 index 38f41bd..3d98502 100644 --- a/src/GF/print_qsGF2.f90 +++ b/src/GF/print_qsRGF2.f90 @@ -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 diff --git a/src/GF/print_qsUGF2.f90 b/src/GF/print_qsUGF2.f90 index caf3065..165e7da 100644 --- a/src/GF/print_qsUGF2.f90 +++ b/src/GF/print_qsUGF2.f90 @@ -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 diff --git a/src/GF/qsGF2.f90 b/src/GF/qsRGF2.f90 similarity index 92% rename from src/GF/qsGF2.f90 rename to src/GF/qsRGF2.f90 index 25eb2f1..a5d2ee8 100644 --- a/src/GF/qsGF2.f90 +++ b/src/GF/qsRGF2.f90 @@ -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 diff --git a/src/GF/qsUGF2.f90 b/src/GF/qsUGF2.f90 index 5ba102c..a2c56cb 100644 --- a/src/GF/qsUGF2.f90 +++ b/src/GF/qsUGF2.f90 @@ -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 diff --git a/src/GT/G0T0eh.f90 b/src/GT/RG0T0eh.f90 similarity index 88% rename from src/GT/G0T0eh.f90 rename to src/GT/RG0T0eh.f90 index 055144e..80c232e 100644 --- a/src/GT/G0T0eh.f90 +++ b/src/GT/RG0T0eh.f90 @@ -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 diff --git a/src/GT/G0T0pp.f90 b/src/GT/RG0T0pp.f90 similarity index 92% rename from src/GT/G0T0pp.f90 rename to src/GT/RG0T0pp.f90 index 7a1e94c..27a7919 100644 --- a/src/GT/G0T0pp.f90 +++ b/src/GT/RG0T0pp.f90 @@ -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 diff --git a/src/GT/RGT.f90 b/src/GT/RGT.f90 index 22eddf0..e35890c 100644 --- a/src/GT/RGT.f90 +++ b/src/GT/RGT.f90 @@ -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 diff --git a/src/GT/UG0T0pp.f90 b/src/GT/UG0T0pp.f90 index a34d926..a66e4de 100644 --- a/src/GT/UG0T0pp.f90 +++ b/src/GT/UG0T0pp.f90 @@ -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 diff --git a/src/GT/UGT.f90 b/src/GT/UGT.f90 index 15c43ea..2458346 100644 --- a/src/GT/UGT.f90 +++ b/src/GT/UGT.f90 @@ -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) diff --git a/src/GT/evGTeh.f90 b/src/GT/evRGTeh.f90 similarity index 93% rename from src/GT/evGTeh.f90 rename to src/GT/evRGTeh.f90 index b316755..5733cd0 100644 --- a/src/GT/evGTeh.f90 +++ b/src/GT/evRGTeh.f90 @@ -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 diff --git a/src/GT/evGTpp.f90 b/src/GT/evRGTpp.f90 similarity index 92% rename from src/GT/evGTpp.f90 rename to src/GT/evRGTpp.f90 index c33bf4b..dfbda1f 100644 --- a/src/GT/evGTpp.f90 +++ b/src/GT/evRGTpp.f90 @@ -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 diff --git a/src/GT/evUGTpp.f90 b/src/GT/evUGTpp.f90 index 5217ace..0a0061d 100644 --- a/src/GT/evUGTpp.f90 +++ b/src/GT/evUGTpp.f90 @@ -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 diff --git a/src/GT/qsGTeh.f90 b/src/GT/qsRGTeh.f90 similarity index 87% rename from src/GT/qsGTeh.f90 rename to src/GT/qsRGTeh.f90 index 7b7ff6c..4f4a58c 100644 --- a/src/GT/qsGTeh.f90 +++ b/src/GT/qsRGTeh.f90 @@ -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 diff --git a/src/GT/qsGTpp.f90 b/src/GT/qsRGTpp.f90 similarity index 93% rename from src/GT/qsGTpp.f90 rename to src/GT/qsRGTpp.f90 index 118ae13..45967ba 100644 --- a/src/GT/qsGTpp.f90 +++ b/src/GT/qsRGTpp.f90 @@ -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 diff --git a/src/GT/qsUGTpp.f90 b/src/GT/qsUGTpp.f90 index 390f1dc..01ed8cb 100644 --- a/src/GT/qsUGTpp.f90 +++ b/src/GT/qsUGTpp.f90 @@ -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 diff --git a/src/GW/GG0W0.f90 b/src/GW/GG0W0.f90 index baf499b..ccadf34 100644 --- a/src/GW/GG0W0.f90 +++ b/src/GW/GG0W0.f90 @@ -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 diff --git a/src/GW/GGW.f90 b/src/GW/GGW.f90 index a45ef3b..d6c6498 100644 --- a/src/GW/GGW.f90 +++ b/src/GW/GGW.f90 @@ -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) diff --git a/src/GW/RG0W0.f90 b/src/GW/RG0W0.f90 index 4d18979..73c9dd2 100644 --- a/src/GW/RG0W0.f90 +++ b/src/GW/RG0W0.f90 @@ -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 diff --git a/src/GW/RGW.f90 b/src/GW/RGW.f90 index 74bbf83..cee59e7 100644 --- a/src/GW/RGW.f90 +++ b/src/GW/RGW.f90 @@ -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 diff --git a/src/GW/SRG_qsGW.f90 b/src/GW/SRG_qsGW.f90 index 7f525bf..64e4454 100644 --- a/src/GW/SRG_qsGW.f90 +++ b/src/GW/SRG_qsGW.f90 @@ -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 diff --git a/src/GW/UG0W0.f90 b/src/GW/UG0W0.f90 index 108cd8d..871c809 100644 --- a/src/GW/UG0W0.f90 +++ b/src/GW/UG0W0.f90 @@ -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 diff --git a/src/GW/UGW.f90 b/src/GW/UGW.f90 index 70c810a..0cd3d1a 100644 --- a/src/GW/UGW.f90 +++ b/src/GW/UGW.f90 @@ -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) diff --git a/src/GW/evGGW.f90 b/src/GW/evGGW.f90 index f1d3312..5780298 100644 --- a/src/GW/evGGW.f90 +++ b/src/GW/evGGW.f90 @@ -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 diff --git a/src/GW/evRGW.f90 b/src/GW/evRGW.f90 index b8a2eed..7d15040 100644 --- a/src/GW/evRGW.f90 +++ b/src/GW/evRGW.f90 @@ -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 diff --git a/src/GW/evUGW.f90 b/src/GW/evUGW.f90 index 7f0d408..2110f75 100644 --- a/src/GW/evUGW.f90 +++ b/src/GW/evUGW.f90 @@ -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 diff --git a/src/GW/print_UG0W0.f90 b/src/GW/print_UG0W0.f90 index 53ccc63..29731e3 100644 --- a/src/GW/print_UG0W0.f90 +++ b/src/GW/print_UG0W0.f90 @@ -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 diff --git a/src/GW/print_evUGW.f90 b/src/GW/print_evUGW.f90 index 4070408..ab2498b 100644 --- a/src/GW/print_evUGW.f90 +++ b/src/GW/print_evUGW.f90 @@ -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 diff --git a/src/GW/print_qsUGW.f90 b/src/GW/print_qsUGW.f90 index 36f9edc..8975144 100644 --- a/src/GW/print_qsUGW.f90 +++ b/src/GW/print_qsUGW.f90 @@ -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 diff --git a/src/GW/qsGGW.f90 b/src/GW/qsGGW.f90 index 709739e..544dffb 100644 --- a/src/GW/qsGGW.f90 +++ b/src/GW/qsGGW.f90 @@ -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 diff --git a/src/GW/qsRGW.f90 b/src/GW/qsRGW.f90 index 06b1a0f..3ca58b6 100644 --- a/src/GW/qsRGW.f90 +++ b/src/GW/qsRGW.f90 @@ -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 diff --git a/src/GW/qsUGW.f90 b/src/GW/qsUGW.f90 index 35ed010..8105ba8 100644 --- a/src/GW/qsUGW.f90 +++ b/src/GW/qsUGW.f90 @@ -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 diff --git a/src/GW/ufG0W0.f90 b/src/GW/ufG0W0.f90 index ad4f370..4bc1ea9 100644 --- a/src/GW/ufG0W0.f90 +++ b/src/GW/ufG0W0.f90 @@ -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 diff --git a/src/GW/ufGW.f90 b/src/GW/ufGW.f90 index 99497d3..66543ca 100644 --- a/src/GW/ufGW.f90 +++ b/src/GW/ufGW.f90 @@ -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 diff --git a/src/HF/GHF.f90 b/src/HF/GHF.f90 index d8e24d7..c3ffd00 100644 --- a/src/HF/GHF.f90 +++ b/src/HF/GHF.f90 @@ -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 diff --git a/src/HF/GHF_search.f90 b/src/HF/GHF_search.f90 index e8082f7..5d43822 100644 --- a/src/HF/GHF_search.f90 +++ b/src/HF/GHF_search.f90 @@ -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) diff --git a/src/HF/RHF.f90 b/src/HF/RHF.f90 index f07e4bd..796f6c0 100644 --- a/src/HF/RHF.f90 +++ b/src/HF/RHF.f90 @@ -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 diff --git a/src/HF/RHF_search.f90 b/src/HF/RHF_search.f90 index 337b244..eb12b94 100644 --- a/src/HF/RHF_search.f90 +++ b/src/HF/RHF_search.f90 @@ -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) diff --git a/src/HF/UHF_search.f90 b/src/HF/UHF_search.f90 index 0ea95c2..ae4de45 100644 --- a/src/HF/UHF_search.f90 +++ b/src/HF/UHF_search.f90 @@ -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) diff --git a/src/HF/print_GHF.f90 b/src/HF/print_GHF.f90 index 6b92af0..dfed554 100644 --- a/src/HF/print_GHF.f90 +++ b/src/HF/print_GHF.f90 @@ -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 = + + + +! 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*,' = ',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)') ' :',S2 -! write(*,'(A50)') '---------------------------------------' + write(*,'(A33,1X,F16.6)') ' = ',Sx + write(*,'(A33,1X,F16.6)') ' = ',Sy + write(*,'(A33,1X,F16.6)') ' = ',Sz + write(*,'(A50)') '---------------------------------------' + write(*,'(A33,1X,F16.6)') ' = ',Sx2 + write(*,'(A33,1X,F16.6)') ' = ',Sy2 + write(*,'(A33,1X,F16.6)') ' = ',Sz2 + write(*,'(A33,1X,F16.6)') ' = ',Sx2+Sy2+Sz2 + write(*,'(A33,1X,F16.6)') ' = ',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 diff --git a/src/HF/print_ROHF.f90 b/src/HF/print_ROHF.f90 index e818c3d..db970ad 100644 --- a/src/HF/print_ROHF.f90 +++ b/src/HF/print_ROHF.f90 @@ -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 diff --git a/src/HF/print_UHF.f90 b/src/HF/print_UHF.f90 index 38339e2..27fe49a 100644 --- a/src/HF/print_UHF.f90 +++ b/src/HF/print_UHF.f90 @@ -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)') ' (exact) :',S2_exact - write(*,'(A40,1X,F16.6)') ' :',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 + write(*,'(A40,1X,F10.6)') ' = ',Sy + write(*,'(A40,1X,F10.6)') ' = ',Sz + write(*,'(A40,1X,F10.6)') ' = ',Sx2 + write(*,'(A40,1X,F10.6)') ' = ',Sy2 + write(*,'(A40,1X,F10.6)') ' = ',Sz2 + write(*,'(A40,1X,F10.6)') ' = ',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 diff --git a/src/MP/GMP2.f90 b/src/MP/GMP2.f90 index 9558629..7c95a02 100644 --- a/src/MP/GMP2.f90 +++ b/src/MP/GMP2.f90 @@ -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 diff --git a/src/MP/RMP2.f90 b/src/MP/RMP2.f90 index f944599..e16fb10 100644 --- a/src/MP/RMP2.f90 +++ b/src/MP/RMP2.f90 @@ -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 diff --git a/src/MP/UMP2.f90 b/src/MP/UMP2.f90 index 3c19874..fee5982 100644 --- a/src/MP/UMP2.f90 +++ b/src/MP/UMP2.f90 @@ -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 diff --git a/src/QuAcK/GQuAcK.f90 b/src/QuAcK/GQuAcK.f90 index 7070099..1f8ea5a 100644 --- a/src/QuAcK/GQuAcK.f90 +++ b/src/QuAcK/GQuAcK.f90 @@ -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 diff --git a/src/QuAcK/QuAcK.f90 b/src/QuAcK/QuAcK.f90 index 8fb8048..df2c856 100644 --- a/src/QuAcK/QuAcK.f90 +++ b/src/QuAcK/QuAcK.f90 @@ -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) diff --git a/src/QuAcK/RQuAcK.f90 b/src/QuAcK/RQuAcK.f90 index ecdfc5d..f82e48c 100644 --- a/src/QuAcK/RQuAcK.f90 +++ b/src/QuAcK/RQuAcK.f90 @@ -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 diff --git a/src/QuAcK/UQuAcK.f90 b/src/QuAcK/UQuAcK.f90 index a2c7af4..7675dc1 100644 --- a/src/QuAcK/UQuAcK.f90 +++ b/src/QuAcK/UQuAcK.f90 @@ -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 diff --git a/src/RPA/GRPA.f90 b/src/RPA/GRPA.f90 index 745fa05..6f1f716 100644 --- a/src/RPA/GRPA.f90 +++ b/src/RPA/GRPA.f90 @@ -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 diff --git a/src/RPA/crGRPA.f90 b/src/RPA/crGRPA.f90 new file mode 100644 index 0000000..462fdd9 --- /dev/null +++ b/src/RPA/crGRPA.f90 @@ -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 diff --git a/src/RPA/crRRPA.f90 b/src/RPA/crRRPA.f90 index 6176fad..7e3a76d 100644 --- a/src/RPA/crRRPA.f90 +++ b/src/RPA/crRRPA.f90 @@ -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 diff --git a/src/RPA/phGRPA.f90 b/src/RPA/phGRPA.f90 index 486abea..85bcb0b 100644 --- a/src/RPA/phGRPA.f90 +++ b/src/RPA/phGRPA.f90 @@ -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 diff --git a/src/RPA/phGRPAx.f90 b/src/RPA/phGRPAx.f90 index d1c38a3..d3baa4d 100644 --- a/src/RPA/phGRPAx.f90 +++ b/src/RPA/phGRPAx.f90 @@ -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 diff --git a/src/RPA/phRRPA.f90 b/src/RPA/phRRPA.f90 index 8d15258..62a7f99 100644 --- a/src/RPA/phRRPA.f90 +++ b/src/RPA/phRRPA.f90 @@ -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 diff --git a/src/RPA/phRRPAx.f90 b/src/RPA/phRRPAx.f90 index 3423ddf..d618b10 100644 --- a/src/RPA/phRRPAx.f90 +++ b/src/RPA/phRRPAx.f90 @@ -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 diff --git a/src/RPA/phURPA.f90 b/src/RPA/phURPA.f90 index c373929..d4af923 100644 --- a/src/RPA/phURPA.f90 +++ b/src/RPA/phURPA.f90 @@ -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 diff --git a/src/RPA/phURPAx.f90 b/src/RPA/phURPAx.f90 index 1814a35..3b5017f 100644 --- a/src/RPA/phURPAx.f90 +++ b/src/RPA/phURPAx.f90 @@ -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 diff --git a/src/RPA/ppGRPA.f90 b/src/RPA/ppGRPA.f90 index 1136f99..132a10b 100644 --- a/src/RPA/ppGRPA.f90 +++ b/src/RPA/ppGRPA.f90 @@ -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 diff --git a/src/RPA/ppRRPA.f90 b/src/RPA/ppRRPA.f90 index 660076c..db5ee38 100644 --- a/src/RPA/ppRRPA.f90 +++ b/src/RPA/ppRRPA.f90 @@ -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 diff --git a/src/RPA/ppURPA.f90 b/src/RPA/ppURPA.f90 index 6380a65..e652bf4 100644 --- a/src/RPA/ppURPA.f90 +++ b/src/RPA/ppURPA.f90 @@ -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 diff --git a/test/Gtest_ref.dat b/test/Gtest_ref.dat index 4c0052e..3745f27 100644 --- a/test/Gtest_ref.dat +++ b/test/Gtest_ref.dat @@ -1,16 +1 @@ GHF energy - -85.160473883160876 - GHF HOMO energy - -0.501365804897696 - GHF LUMO energy - 0.203278954950924 - GHF dipole moment - 0.714967673390535 - GMP2 correlation energy - -0.128988144318866 - phGRPA corrlation energy - -0.138552809810392 - phGRPAx correlation energy - -0.368057033788489 - ppGRPA correlation energy - -0.092561239023951 diff --git a/test/Rtest_ref.dat b/test/Rtest_ref.dat index 7c20f60..75cf09e 100644 --- a/test/Rtest_ref.dat +++ b/test/Rtest_ref.dat @@ -1,18 +1,74 @@ RHF energy - -85.160473883160876 + -2.855160426884076 RHF HOMO energy - -0.501365804897693 + -0.914126628614305 RHF LUMO energy - 0.203278954950938 + 1.399859335225087 RHF dipole moment - 0.611349538338893 - ROHF energy - -85.160473714509976 + 0.000000000000000 RMP2 correlation energy - -0.128988144386404 + -0.011200122910187 + CCD correlation energy + -0.014985063408247 + DCD correlation energy + -0.014985062907429 + CCSD correlation energy + -0.015001711549550 + drCCD correlation energy + -0.018845374502248 + rCCD correlation energy + -0.016836324636164 + crCCD correlation energy + 0.008524677369855 + lCCD correlation energy + -0.008082420815100 + pCCD correlation energy + -0.014985062519068 + RCIS singlet excitation energy + 1.911193619935257 + RCIS triplet excitation energy + 1.455852629402236 phRRPA correlation energy - -0.138552809856833 + -0.018845374129105 phRRPAx correlation energy - -0.197284981952336 + -0.015760565121283 + crRRPA correlation energy + -0.008868581132405 ppRRPA correlation energy - -0.092561239071529 + -0.008082420815100 + RG0F2 correlation energy + -0.011438430540374 + RG0F2 HOMO energy + -0.882696116247871 + RG0F2 LUMO energy + 1.383080391811630 + evRGF2 correlation energy + -0.011448483158486 + evRGF2 HOMO energy + -0.881327878713477 + evRGF2 LUMO energy + 1.382458968133448 + RG0W0 correlation energy + -0.019314094399756 + RG0W0 HOMO energy + -0.870533880190454 + RG0W0 LUMO energy + 1.377171287010956 + evRGW correlation energy + -0.019335511771724 + evRGW HOMO energy + -0.868460640957913 + evRGW LUMO energy + 1.376287581471769 + RG0T0pp correlation energy + -0.008082420815100 + RG0T0pp HOMO energy + -0.914126628614305 + RG0T0pp LUMO energy + 1.399859335225087 + evRGTpp correlation energy + -0.008082420815100 + evRGTpp HOMO energy + -0.914126628614305 + evRGTpp LUMO energy + 1.399859335225087 diff --git a/test/Utest_ref.dat b/test/Utest_ref.dat index 45d2df7..d69b0a9 100644 --- a/test/Utest_ref.dat +++ b/test/Utest_ref.dat @@ -12,6 +12,10 @@ 0.611349538338891 UMP2 correlation energy -0.128988144318865 + UCIS singlet excitation energy + 0.310356023571988 + UCIS triplet excitation energy + 0.310356023571958 phURPA correlation energy -0.138552809810790 phURPAx correlation energy diff --git a/test/methods.test b/test/methods.test index 682b927..956bcdf 100644 --- a/test/methods.test +++ b/test/methods.test @@ -1,20 +1,20 @@ # RHF UHF GHF ROHF - T T T T + T F F F # MP2 MP3 T T # CCD pCCD DCD CCSD CCSD(T) - F F F F F + T T T T F # drCCD rCCD crCCD lCCD - F F F F + T T T T # CIS CIS(D) CID CISD FCI - F F F F F + T F F F F # phRPA phRPAx crRPA ppRPA - T T F T + T T T T # G0F2 evGF2 qsGF2 G0F3 evGF3 - F F F F F + T T F F F # G0W0 evGW qsGW SRG-qsGW ufG0W0 ufGW - F F F F F F + T T F F F F # G0T0pp evGTpp qsGTpp G0T0eh evGTeh qsGTeh - F F F F F F + T T F F F F # Rtest Utest Gtest - T T T + T F F diff --git a/test/options.test b/test/options.test index 979a4b1..92084cd 100644 --- a/test/options.test +++ b/test/options.test @@ -4,14 +4,14 @@ F # CC: maxSCF thresh DIIS 64 0.0000001 5 -# spin: TDA spin_conserved spin_flip - F T T +# 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 - 10 0.00001 5 F 0.0 F F + 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 + 256 0.00001 5 F 0.0 F F # ACFDT: AC Kx XBS F F T # BSE: phBSE phBSE2 ppBSE dBSE dTDA diff --git a/test/run_test.sh b/test/run_test.sh index c9af29d..a93d550 100755 --- a/test/run_test.sh +++ b/test/run_test.sh @@ -3,4 +3,6 @@ cp ./methods.test ../input/methods cp ./options.test ../input/options cd .. -python3 PyDuck.py -x water -b 6-31g -m 1 +python3 PyDuck.py -x He -b 6-31g -m 1 +cp input/methods.default input/methods +cp input/options.default input/options