PTEROSOR/QuAcK
10
1
Fork 0
mirror of https://github.com/pfloos/quack synced 2025-04-02 06:51:37 +02:00
Code Releases Activity

more changes in print

Browse Source
This commit is contained in:
Pierre-Francois Loos 2025-03-31 22:03:00 +02:00
parent 337a672461
commit a96e46bbc5
3 changed files with 24 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/Parquet/GParquet.f90
View File

@ -1,4 +1,4 @@
subroutine GParquet(max_it_1b,conv_1b,max_it_2b,conv_2b,nOrb,nC,nO,nV,nR,nS,eHF,ERI)
subroutine GParquet(ENuc,max_it_1b,conv_1b,max_it_2b,conv_2b,nOrb,nC,nO,nV,nR,nS,eGHF,eHF,ERI)
! Parquet approximation based on restricted orbitals
@ -15,6 +15,8 @@ subroutine GParquet(max_it_1b,conv_1b,max_it_2b,conv_2b,nOrb,nC,nO,nV,nR,nS,eHF,
! Input variables
double precision,intent(in) :: ENuc
double precision,intent(in) :: EGHF
integer,intent(in) :: max_it_1b,max_it_2b
double precision,intent(in) :: conv_1b,conv_2b
integer,intent(in) :: nOrb,nC,nO,nV,nR,nS
@ -34,12 +36,13 @@ subroutine GParquet(max_it_1b,conv_1b,max_it_2b,conv_2b,nOrb,nC,nO,nV,nR,nS,eHF,
integer :: nOO,nVV
! eh BSE
double precision :: EcRPA
double precision :: Ec_eh
double precision,allocatable :: Aph(:,:), Bph(:,:)
double precision,allocatable :: XpY(:,:), XmY(:,:)
double precision,allocatable :: eh_Om(:), old_eh_Om(:)
double precision,allocatable :: eh_Gam_A(:,:),eh_Gam_B(:,:)
! pp BSE
double precision :: Ec_pp
double precision,allocatable :: Bpp(:,:), Cpp(:,:), Dpp(:,:)
double precision,allocatable :: X1(:,:),Y1(:,:)
double precision,allocatable :: ee_Om(:), old_ee_Om(:)
@ -207,7 +210,7 @@ subroutine GParquet(max_it_1b,conv_1b,max_it_2b,conv_2b,nOrb,nC,nO,nV,nR,nS,eHF,
Aph(:,:) = Aph(:,:) + eh_Gam_A(:,:)
Bph(:,:) = Bph(:,:) + eh_Gam_B(:,:)
call phGLR(TDA,nS,Aph,Bph,EcRPA,eh_Om,XpY,XmY)
call phGLR(TDA,nS,Aph,Bph,Ec_eh,eh_Om,XpY,XmY)
call wall_time(end_t)
@ -260,7 +263,7 @@ subroutine GParquet(max_it_1b,conv_1b,max_it_2b,conv_2b,nOrb,nC,nO,nV,nR,nS,eHF,
Cpp(:,:) = Cpp(:,:) + pp_Gam_C(:,:)
Dpp(:,:) = Dpp(:,:) + pp_Gam_D(:,:)
call ppGLR(TDA,nOO,nVV,Bpp,Cpp,Dpp,ee_Om,X1,Y1,hh_Om,X2,Y2,EcRPA)
call ppGLR(TDA,nOO,nVV,Bpp,Cpp,Dpp,ee_Om,X1,Y1,hh_Om,X2,Y2,Ec_pp)
call wall_time(end_t)
t = end_t - start_t
@ -495,7 +498,7 @@ subroutine GParquet(max_it_1b,conv_1b,max_it_2b,conv_2b,nOrb,nC,nO,nV,nR,nS,eHF,
! Print for one-body part
call print_parquet_1b(nOrb,nO,eHF,SigC,eQP,Z,n_it_1b,err_1b,0d0,0d0,0d0)
call print_parquet_1b(nOrb,nO,eHF,SigC,eQP,Z,n_it_1b,err_1b,ENuc,EGHF,EcGM,Ec_eh,Ec_pp)
deallocate(eQPlin,Z,SigC)

16
src/Parquet/print_parquet_1b.f90
View File

@ -1,4 +1,4 @@
subroutine print_parquet_1b(nOrb,nO,eHF,SigC,eQP,Z,n_it_1b,err_1b,ENuc,ERHF,Ec)
subroutine print_parquet_1b(nOrb,nO,eHF,SigC,eQP,Z,n_it_1b,err_1b,ENuc,EGHF,EcGM,Ec_eh,Ec_pp)
! Print one-electron energies and other stuff for G0F2
@ -14,8 +14,10 @@ subroutine print_parquet_1b(nOrb,nO,eHF,SigC,eQP,Z,n_it_1b,err_1b,ENuc,ERHF,Ec)
integer,intent(in) :: n_it_1b
double precision,intent(in) :: err_1b
double precision,intent(in) :: ENuc
double precision,intent(in) :: ERHF
double precision,intent(in) :: Ec
double precision,intent(in) :: EGHF
double precision,intent(in) :: EcGM
double precision,intent(in) :: Ec_eh
double precision,intent(in) :: Ec_pp
integer :: p
integer :: HOMO
@ -50,8 +52,12 @@ subroutine print_parquet_1b(nOrb,nO,eHF,SigC,eQP,Z,n_it_1b,err_1b,ENuc,ERHF,Ec)
write(*,'(2X,A60,F15.6,A3)') 'Parquet LUMO energy = ',eQP(LUMO)*HaToeV,' eV'
write(*,'(2X,A60,F15.6,A3)') 'Parquet HOMO-LUMO gap = ',Gap*HaToeV,' eV'
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A60,F15.6,A3)') 'Parquet total energy = ',ENuc + ERHF + Ec,' au'
write(*,'(2X,A60,F15.6,A3)') 'Parquet correlation energy = ',Ec,' au'
write(*,'(2X,A60,F15.6,A3)') ' Parquet total energy = ',ENuc + EGHF + EcGM,' au'
write(*,'(2X,A60,F15.6,A3)') ' Parquet correlation energy = ',EcGM,' au'
write(*,*)'-------------------------------------------------------------------------------'
write(*,'(2X,A60,F15.6,A3)') ' eh-RPA correlation energy = ',Ec_eh,' au'
write(*,'(2X,A60,F15.6,A3)') ' pp-RPA correlation energy = ',Ec_pp,' au'
write(*,'(2X,A60,F15.6,A3)') '(eh+pp)-RPA correlation energy = ',Ec_pp,' au'
write(*,*)'-------------------------------------------------------------------------------'
write(*,*)

11
src/QuAcK/GQuAcK.f90
View File

@ -8,7 +8,7 @@ subroutine GQuAcK(working_dir,dotest,doGHF,dostab,dosearch,doMP2,doMP3,doCCD,dop
maxSCF_GW,max_diis_GW,thresh_GW,TDA_W,lin_GW,reg_GW,eta_GW, &
maxSCF_GT,max_diis_GT,thresh_GT,TDA_T,lin_GT,reg_GT,eta_GT, &
dophBSE,dophBSE2,doppBSE,dBSE,dTDA,doACFDT,exchange_kernel,doXBS, &
max_it_macro,conv_one_body,max_it_micro,conv_two_body)
max_it_1b,conv_1b,max_it_2b,conv_2b)
implicit none
include 'parameters.h'
@ -75,8 +75,8 @@ subroutine GQuAcK(working_dir,dotest,doGHF,dostab,dosearch,doMP2,doMP3,doCCD,dop
logical,intent(in) :: dophBSE,dophBSE2,doppBSE,dBSE,dTDA
logical,intent(in) :: doACFDT,exchange_kernel,doXBS
integer,intent(in) :: max_it_macro,max_it_micro
double precision,intent(in) :: conv_one_body,conv_two_body
integer,intent(in) :: max_it_1b,max_it_2b
double precision,intent(in) :: conv_1b,conv_2b
! Local variables
@ -349,9 +349,8 @@ subroutine GQuAcK(working_dir,dotest,doGHF,dostab,dosearch,doMP2,doMP3,doCCD,dop
if(doParquet) then
call wall_time(start_Parquet)
call GParquet(max_it_macro,conv_one_body,max_it_micro,conv_two_body, &
nBas2,nC,nO,nV,nR,nS, &
eHF,ERI_MO)
call GParquet(ENuc,max_it_1b,conv_1b,max_it_2b,conv_2b, &
nBas2,nC,nO,nV,nR,nS,EGHF,eHF,ERI_MO)
call wall_time(end_Parquet)
t_Parquet = end_Parquet - start_Parquet