LCPQ/quack
4
1
Fork 0
mirror of https://github.com/pfloos/quack synced 2024-08-29 07:42:02 +02:00
Code Releases Activity

saving tmp

Browse Source
This commit is contained in:
Abdallah Ammar 2024-08-19 18:11:39 +02:00
parent 7643ef3c2f
commit 989bd99f17
2 changed files with 84 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/GT/GTpp_excitation_density.f90
View File

@ -2,6 +2,7 @@ subroutine GTpp_excitation_density(ispin,nBas,nC,nO,nV,nR,nOO,nVV,ERI,X1,Y1,rho1
! Compute excitation densities for T-matrix self-energy
implicit none
! Input variables
@ -44,6 +45,8 @@ subroutine GTpp_excitation_density(ispin,nBas,nC,nO,nV,nR,nOO,nVV,ERI,X1,Y1,rho1
if(ispin == 1) then
print*, "ispin = ", ispin
!$OMP PARALLEL &
!$OMP SHARED(nC,nBas,nR,nO,nVV,nOO,rho1,rho2,ERI,X1,Y1,X2,Y2) &
!$OMP PRIVATE(q,p,ab,cd,kl,ij) &
@ -123,10 +126,11 @@ subroutine GTpp_excitation_density(ispin,nBas,nC,nO,nV,nR,nOO,nVV,ERI,X1,Y1,rho1
if(ispin == 2 .or. ispin == 4) then
print*, "ispin = ", ispin
do q=nC+1,nBas-nR
do p=nC+1,nBas-nR
! do ab=1,nVV
ab = 0
do a=nO+1,nBas-nR
do b=a+1,nBas-nR
@ -153,7 +157,6 @@ subroutine GTpp_excitation_density(ispin,nBas,nC,nO,nV,nR,nOO,nVV,ERI,X1,Y1,rho1
end do
end do
! do ij=1,nOO
ij = 0
do i=nC+1,nO
do j=i+1,nO
@ -191,6 +194,8 @@ subroutine GTpp_excitation_density(ispin,nBas,nC,nO,nV,nR,nOO,nVV,ERI,X1,Y1,rho1
if(ispin == 3) then
print*, "ispin = ", ispin
!$OMP PARALLEL &
!$OMP SHARED(nC,nBas,nR,nO,nVV,nOO,rho1,rho2,ERI,X1,Y1,X2,Y2) &
!$OMP PRIVATE(q,p,ab,cd,kl,ij,c,d,k,l) &

88
src/GT/RG0T0pp.f90
View File

@ -64,6 +64,11 @@ subroutine RG0T0pp(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,d
double precision,allocatable :: eGT(:)
double precision,allocatable :: eGTlin(:)
double precision :: t0, t1
double precision :: tt0, tt1
call wall_time(t0)
! Output variables
! Hello world
@ -122,11 +127,25 @@ subroutine RG0T0pp(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,d
allocate(Bpp(nVVs,nOOs),Cpp(nVVs,nVVs),Dpp(nOOs,nOOs))
if(.not.TDA_T) call ppLR_B(iblock,nBas,nC,nO,nV,nR,nOOs,nVVs,1d0,ERI,Bpp)
call ppLR_C(iblock,nBas,nC,nO,nV,nR,nVVs,1d0,eHF,ERI,Cpp)
call ppLR_D(iblock,nBas,nC,nO,nV,nR,nOOs,1d0,eHF,ERI,Dpp)
call wall_time(tt0)
call ppLR_C(iblock,nBas,nC,nO,nV,nR,nVVs,1d0,eHF,ERI,Cpp)
call wall_time(tt1)
write(*,'(A65,1X,F9.3,A8)') 'Wall time for ppLR_C = ',tt1-tt0,' seconds'
call wall_time(tt0)
call ppLR_D(iblock,nBas,nC,nO,nV,nR,nOOs,1d0,eHF,ERI,Dpp)
call wall_time(tt1)
write(*,'(A65,1X,F9.3,A8)') 'Wall time for ppLR_D = ',tt1-tt0,' seconds'
call wall_time(tt0)
if(.not.TDA_T) call ppLR_B(iblock,nBas,nC,nO,nV,nR,nOOs,nVVs,1d0,ERI,Bpp)
call wall_time(tt1)
write(*,'(A65,1X,F9.3,A8)') 'Wall time for ppLR_B = ',tt1-tt0,' seconds'
call wall_time(tt0)
call ppLR(TDA_T,nOOs,nVVs,Bpp,Cpp,Dpp,Om1s,X1s,Y1s,Om2s,X2s,Y2s,EcRPA(ispin))
call wall_time(tt1)
write(*,'(A65,1X,F9.3,A8)') 'Wall time for ppLR = ',tt1-tt0,' seconds'
deallocate(Bpp,Cpp,Dpp)
@ -145,11 +164,25 @@ subroutine RG0T0pp(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,d
allocate(Bpp(nVVt,nOOt),Cpp(nVVt,nVVt),Dpp(nOOt,nOOt))
if(.not.TDA_T) call ppLR_B(iblock,nBas,nC,nO,nV,nR,nOOt,nVVt,1d0,ERI,Bpp)
call ppLR_C(iblock,nBas,nC,nO,nV,nR,nVVt,1d0,eHF,ERI,Cpp)
call ppLR_D(iblock,nBas,nC,nO,nV,nR,nOOt,1d0,eHF,ERI,Dpp)
call wall_time(tt0)
call ppLR_C(iblock,nBas,nC,nO,nV,nR,nVVt,1d0,eHF,ERI,Cpp)
call wall_time(tt1)
write(*,'(A65,1X,F9.3,A8)') 'Wall time for ppLR_C = ',tt1-tt0,' seconds'
call wall_time(tt0)
call ppLR_D(iblock,nBas,nC,nO,nV,nR,nOOt,1d0,eHF,ERI,Dpp)
call wall_time(tt1)
write(*,'(A65,1X,F9.3,A8)') 'Wall time for ppLR_D = ',tt1-tt0,' seconds'
call wall_time(tt0)
if(.not.TDA_T) call ppLR_B(iblock,nBas,nC,nO,nV,nR,nOOt,nVVt,1d0,ERI,Bpp)
call wall_time(tt1)
write(*,'(A65,1X,F9.3,A8)') 'Wall time for ppLR_B = ',tt1-tt0,' seconds'
call wall_time(tt0)
call ppLR(TDA_T,nOOt,nVVt,Bpp,Cpp,Dpp,Om1t,X1t,Y1t,Om2t,X2t,Y2t,EcRPA(ispin))
call wall_time(tt1)
write(*,'(A65,1X,F9.3,A8)') 'Wall time for ppLR = ',tt1-tt0,' seconds'
deallocate(Bpp,Cpp,Dpp)
@ -162,16 +195,25 @@ subroutine RG0T0pp(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,d
! iblock = 1
iblock = 3
call wall_time(tt0)
call GTpp_excitation_density(iblock,nBas,nC,nO,nV,nR,nOOs,nVVs,ERI,X1s,Y1s,rho1s,X2s,Y2s,rho2s)
call wall_time(tt1)
write(*,'(A65,1X,F9.3,A8)') 'Wall time for GTpp_excitation_density = ',tt1-tt0,' seconds'
! iblock = 2
iblock = 4
call wall_time(tt0)
call GTpp_excitation_density(iblock,nBas,nC,nO,nV,nR,nOOt,nVVt,ERI,X1t,Y1t,rho1t,X2t,Y2t,rho2t)
call wall_time(tt1)
write(*,'(A65,1X,F9.3,A8)') 'Wall time for GTpp_excitation_density = ',tt1-tt0,' seconds'
!----------------------------------------------
! Compute T-matrix version of the self-energy
!----------------------------------------------
call wall_time(tt0)
if(regularize) then
call GTpp_regularization(nBas,nC,nO,nV,nR,nOOs,nVVs,eHF,Om1s,rho1s,Om2s,rho2s)
call GTpp_regularization(nBas,nC,nO,nV,nR,nOOt,nVVt,eHF,Om1t,rho1t,Om2t,rho2t)
@ -179,11 +221,15 @@ subroutine RG0T0pp(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,d
call GTpp_self_energy_diag(eta,nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,eHF,Om1s,rho1s,Om2s,rho2s, &
Om1t,rho1t,Om2t,rho2t,EcGM,Sig,Z)
call wall_time(tt1)
write(*,'(A65,1X,F9.3,A8)') 'Wall time for self-energy = ',tt1-tt0,' seconds'
!----------------------------------------------
! Solve the quasi-particle equation
!----------------------------------------------
call wall_time(tt0)
eGTlin(:) = eHF(:) + Z(:)*Sig(:)
if(linearize) then
@ -203,6 +249,9 @@ subroutine RG0T0pp(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,d
end if
call wall_time(tt1)
write(*,'(A65,1X,F9.3,A8)') 'Wall time to solve QP = ',tt1-tt0,' seconds'
! call GTpp_plot_self_energy(nBas,nC,nO,nV,nR,nOOs,nVVs,nOOt,nVVt,eHF,eGT,Om1s,rho1s,Om2s,rho2s, &
! Om1t,rho1t,Om2t,rho2t)
@ -218,9 +267,9 @@ subroutine RG0T0pp(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,d
allocate(Bpp(nVVs,nOOs),Cpp(nVVs,nVVs),Dpp(nOOs,nOOs))
call ppLR_C(iblock,nBas,nC,nO,nV,nR,nVVs,1d0,eGT,ERI,Cpp)
call ppLR_D(iblock,nBas,nC,nO,nV,nR,nOOs,1d0,eGT,ERI,Dpp)
if(.not.TDA_T) call ppLR_B(iblock,nBas,nC,nO,nV,nR,nOOs,nVVs,1d0,ERI,Bpp)
call ppLR_C(iblock,nBas,nC,nO,nV,nR,nVVs,1d0,eGT,ERI,Cpp)
call ppLR_D(iblock,nBas,nC,nO,nV,nR,nOOs,1d0,eGT,ERI,Dpp)
call ppLR(TDA_T,nOOs,nVVs,Bpp,Cpp,Dpp,Om1s,X1s,Y1s,Om2s,X2s,Y2s,EcRPA(ispin))
@ -232,11 +281,25 @@ subroutine RG0T0pp(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,d
allocate(Bpp(nVVt,nOOt),Cpp(nVVt,nVVt),Dpp(nOOt,nOOt))
if(.not.TDA_T) call ppLR_B(iblock,nBas,nC,nO,nV,nR,nOOt,nVVt,1d0,ERI,Bpp)
call ppLR_C(iblock,nBas,nC,nO,nV,nR,nVVt,1d0,eGT,ERI,Cpp)
call ppLR_D(iblock,nBas,nC,nO,nV,nR,nOOt,1d0,eGT,ERI,Dpp)
call wall_time(tt0)
call ppLR_C(iblock,nBas,nC,nO,nV,nR,nVVt,1d0,eGT,ERI,Cpp)
call wall_time(tt1)
write(*,'(A65,1X,F9.3,A8)') 'Wall time for ppLR_C = ',tt1-tt0,' seconds'
call wall_time(tt0)
call ppLR_D(iblock,nBas,nC,nO,nV,nR,nOOt,1d0,eGT,ERI,Dpp)
call wall_time(tt1)
write(*,'(A65,1X,F9.3,A8)') 'Wall time for ppLR_D = ',tt1-tt0,' seconds'
call wall_time(tt0)
if(.not.TDA_T) call ppLR_B(iblock,nBas,nC,nO,nV,nR,nOOt,nVVt,1d0,ERI,Bpp)
call wall_time(tt1)
write(*,'(A65,1X,F9.3,A8)') 'Wall time for ppLR_B = ',tt1-tt0,' seconds'
call wall_time(tt0)
call ppLR(TDA_T,nOOt,nVVt,Bpp,Cpp,Dpp,Om1t,X1t,Y1t,Om2t,X2t,Y2t,EcRPA(ispin))
call wall_time(tt1)
write(*,'(A65,1X,F9.3,A8)') 'Wall time for ppLR = ',tt1-tt0,' seconds'
deallocate(Bpp,Cpp,Dpp)
@ -336,4 +399,7 @@ subroutine RG0T0pp(dotest,doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,d
end if
call wall_time(t1)
write(*,'(A65,1X,F9.3,A8)') 'Total Wall time for RG0T0pp = ',t1-t0,' seconds'
end subroutine