diff --git a/src/GT/GTpp_excitation_density.f90 b/src/GT/GTpp_excitation_density.f90 index a6ed548..ba32107 100644 --- a/src/GT/GTpp_excitation_density.f90 +++ b/src/GT/GTpp_excitation_density.f90 @@ -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 @@ -190,6 +193,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) & diff --git a/src/GT/RG0T0pp.f90 b/src/GT/RG0T0pp.f90 index e624bca..2975934 100644 --- a/src/GT/RG0T0pp.f90 +++ b/src/GT/RG0T0pp.f90 @@ -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,10 +221,14 @@ 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(:) @@ -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