diff --git a/src/CC/BCCD.f90 b/src/CC/BCCD.f90 deleted file mode 100644 index 3d9c677..0000000 --- a/src/CC/BCCD.f90 +++ /dev/null @@ -1,236 +0,0 @@ -subroutine BCCD(maxSCF,thresh,max_diis,nBasin,nCin,nOin,nVin,nRin,ERI,ENuc,ERHF,eHF) - -! Brueckner CCD module - - implicit none - -! Input variables - - integer,intent(in) :: maxSCF - integer,intent(in) :: max_diis - double precision,intent(in) :: thresh - - integer,intent(in) :: nBasin - integer,intent(in) :: nCin - integer,intent(in) :: nOin - integer,intent(in) :: nVin - integer,intent(in) :: nRin - double precision,intent(in) :: ENuc,ERHF - double precision,intent(in) :: eHF(nBasin) - double precision,intent(in) :: ERI(nBasin,nBasin,nBasin,nBasin) - -! Local variables - - integer :: nBas - integer :: nC - integer :: nO - integer :: nV - integer :: nR - integer :: nSCF - double precision :: Conv - double precision :: EcMP2,EcMP3,EcMP4 - double precision :: ECCD,EcCCD - double precision,allocatable :: seHF(:) - double precision,allocatable :: sERI(:,:,:,:) - double precision,allocatable :: dbERI(:,:,:,:) - - double precision,allocatable :: eO(:) - double precision,allocatable :: eV(:) - double precision,allocatable :: delta_OOVV(:,:,:,:) - - double precision,allocatable :: OOOO(:,:,:,:) - double precision,allocatable :: OOOV(:,:,:,:) - double precision,allocatable :: OOVV(:,:,:,:) - double precision,allocatable :: OVOV(:,:,:,:) - double precision,allocatable :: OVVV(:,:,:,:) - 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,i,j,a,b - double precision :: rcond - double precision,allocatable :: error_diis(:,:) - double precision,allocatable :: t_diis(:,:) - -! Hello world - - write(*,*) - write(*,*)'**************************************' - write(*,*)'| BCCD calculation |' - write(*,*)'**************************************' - write(*,*) - -! Spatial to spin orbitals - - nBas = 2*nBasin - nC = 2*nCin - nO = 2*nOin - nV = 2*nVin - nR = 2*nRin - - allocate(seHF(nBas),sERI(nBas,nBas,nBas,nBas)) - - call spatial_to_spin_MO_energy(nBasin,eHF,nBas,seHF) - call spatial_to_spin_ERI(nBasin,ERI,nBas,sERI) - -! Antysymmetrize ERIs - - allocate(dbERI(nBas,nBas,nBas,nBas)) - - call antisymmetrize_ERI(2,nBas,sERI,dbERI) - - deallocate(sERI) - -! Form energy denominator - - allocate(eO(nO-nC),eV(nV-nR)) - allocate(delta_OOVV(nO-nC,nO-nC,nV-nR,nV-nR)) - - eO(:) = seHF(nC+1:nO) - eV(:) = seHF(nO+1:nBas-nR) - - call form_delta_OOVV(nC,nO,nV,nR,eO,eV,delta_OOVV) - - deallocate(seHF) - -! Create integral batches - - allocate(OOOO(nO-nC,nO-nC,nO-nC,nO-nC),OOOV(nO-nC,nO-nC,nO-nC,nV-nR), & - OOVV(nO-nC,nO-nC,nV-nR,nV-nR),OVOV(nO-nC,nV-nR,nO-nC,nV-nR), & - OVVV(nO-nC,nV-nR,nV-nR,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 ) - OOOV(:,:,:,:) = dbERI(nC+1:nO ,nC+1:nO ,nC+1:nO ,nO+1:nBas-nR) - 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) - OVVV(:,:,:,:) = dbERI(nC+1:nO ,nO+1:nBas-nR,nO+1:nBas-nR,nO+1:nBas-nR) - VVVV(:,:,:,:) = dbERI(nO+1:nBas-nR,nO+1:nBas-nR,nO+1:nBas-nR,nO+1:nBas-nR) - - deallocate(dbERI) - -! MP2 guess amplitudes - - allocate(t2(nO-nC,nO-nC,nV-nR,nV-nR)) - - t2(:,:,:,:) = -OOVV(:,:,:,:)/delta_OOVV(:,:,:,:) - - call CCD_correlation_energy(nC,nO,nV,nR,OOVV,t2,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(r2(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(*,*)'| BCCD calculation |' - write(*,*)'----------------------------------------------------' - write(*,'(1X,A1,1X,A3,1X,A1,1X,A16,1X,A1,1X,A10,1X,A1,1X,A10,1X,A1,1X)') & - '|','#','|','E(BCCD)','|','Ec(BCCD)','|','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,t2,u) - -! Form interemediate arrays - - call form_X(nC,nO,nV,nR,OOVV,t2,X1,X2,X3,X4) - -! Form quadratic array - - call form_v(nC,nO,nV,nR,X1,X2,X3,X4,t2,v) - -! Compute residual - - r2(:,:,:,:) = OOVV(:,:,:,:) + delta_OOVV(:,:,:,:)*t2(:,:,:,:) + u(:,:,:,:) + v(:,:,:,:) - -! Check convergence - - Conv = maxval(abs(r2(:,:,:,:))) - -! Update amplitudes - - t2(:,:,:,:) = t2(:,:,:,:) - r2(:,:,:,:)/delta_OOVV(:,:,:,:) - -! Compute correlation energy - - call CCD_correlation_energy(nC,nO,nV,nR,OOVV,t2,EcCCD) - - if(nSCF == 1) call MP3_correlation_energy(nC,nO,nV,nR,OOVV,t2,v,delta_OOVV,EcMP3) - -! Dump results - - ECCD = ERHF + EcCCD - - ! 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,-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,'|',ECCD+ENuc,'|',EcCCD,'|',Conv,'|' - - enddo - write(*,*)'----------------------------------------------------' -!------------------------------------------------------------------------ -! End of SCF loop -!------------------------------------------------------------------------ - -! Did it actually converge? - - if(nSCF == maxSCF) then - - write(*,*) - write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' - write(*,*)' Convergence failed ' - write(*,*)'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' - write(*,*) - - stop - - endif - -! Moller-Plesset energies - - write(*,*) - write(*,'(1X,A15,1X,F10.6)') 'Ec(MP2) = ',EcMP2 - write(*,'(1X,A15,1X,F10.6)') 'Ec(MP3) = ',EcMP3 - write(*,'(1X,A15,1X,F10.6)') 'Ec(MP4-SDQ) = ',EcMP4 - write(*,*) - -end subroutine diff --git a/src/CC/EE_EOM_CCD_1h1p.f90 b/src/CC/EE_EOM_CCD_1h1p.f90 index e6aeeff..55ce7ec 100644 --- a/src/CC/EE_EOM_CCD_1h1p.f90 +++ b/src/CC/EE_EOM_CCD_1h1p.f90 @@ -143,7 +143,7 @@ subroutine EE_EOM_CCD_1h1p(nC,nO,nV,nR,eO,eV,OOVV,OVVO,t) call quick_sort(Om,order,nS) call set_order(Z,order,nS,nS) - call print_excitation('EE-EOM-CCD ',3,nS,Om) + call print_excitation_energies('EE-EOM-CCD',3,nS,Om) end if diff --git a/src/CI/CIS.f90 b/src/CI/CIS.f90 index bdaff1d..aff6b97 100644 --- a/src/CI/CIS.f90 +++ b/src/CI/CIS.f90 @@ -55,8 +55,8 @@ 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('CIS ',ispin,nS,Om) - call print_transition_vectors_ph(.true.,nBas,nC,nO,nV,nR,nS,dipole_int,Om,transpose(A),transpose(A)) + call print_excitation_energies('CIS',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 print*,'Singlet CIS transition vectors' @@ -67,7 +67,7 @@ subroutine CIS(singlet,triplet,doCIS_D,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF) ! Compute CIS(D) correction maxS = min(maxS,nS) - if(doCIS_D) call D_correction(ispin,nBas,nC,nO,nV,nR,nS,maxS,eHF,ERI,Om(1:maxS),A(:,1:maxS)) + if(doCIS_D) call CIS_D(ispin,nBas,nC,nO,nV,nR,nS,maxS,eHF,ERI,Om(1:maxS),A(:,1:maxS)) endif @@ -83,8 +83,8 @@ 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('CIS ',ispin,nS,Om) - call print_transition_vectors_ph(.false.,nBas,nC,nO,nV,nR,nS,dipole_int,Om,transpose(A),transpose(A)) + call print_excitation_energies('CIS',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 print*,'Triplet CIS transition vectors' @@ -95,7 +95,7 @@ subroutine CIS(singlet,triplet,doCIS_D,nBas,nC,nO,nV,nR,nS,ERI,dipole_int,eHF) ! Compute CIS(D) correction maxS = min(maxS,nS) - if(doCIS_D) call D_correction(ispin,nBas,nC,nO,nV,nR,nS,maxS,eHF,ERI,Om(1:maxS),A(:,1:maxS)) + if(doCIS_D) call CIS_D(ispin,nBas,nC,nO,nV,nR,nS,maxS,eHF,ERI,Om(1:maxS),A(:,1:maxS)) endif diff --git a/src/CI/D_correction.f90 b/src/CI/CIS_D.f90 similarity index 98% rename from src/CI/D_correction.f90 rename to src/CI/CIS_D.f90 index 63551d8..629d0e1 100644 --- a/src/CI/D_correction.f90 +++ b/src/CI/CIS_D.f90 @@ -1,4 +1,4 @@ -subroutine D_correction(ispin,nBasin,nCin,nOin,nVin,nRin,nSin,maxS,eHF,ERI,w,X) +subroutine CIS_D(ispin,nBasin,nCin,nOin,nVin,nRin,nSin,maxS,eHF,ERI,w,X) ! Compute the D correction of CIS(D) @@ -274,4 +274,5 @@ subroutine D_correction(ispin,nBasin,nCin,nOin,nVin,nRin,nSin,maxS,eHF,ERI,w,X) !------------------------------------------------------------------------ ! End of loop over single excitations !------------------------------------------------------------------------ + end subroutine diff --git a/src/CI/UCIS.f90 b/src/CI/UCIS.f90 index 386147a..110e2e0 100644 --- a/src/CI/UCIS.f90 +++ b/src/CI/UCIS.f90 @@ -34,11 +34,11 @@ subroutine UCIS(spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,E integer :: nS_aa,nS_bb,nS_sc double precision,allocatable :: A_sc(:,:) - double precision,allocatable :: Omega_sc(:) + double precision,allocatable :: Om_sc(:) integer :: nS_ab,nS_ba,nS_sf double precision,allocatable :: A_sf(:,:) - double precision,allocatable :: Omega_sf(:) + double precision,allocatable :: Om_sf(:) ! Hello world @@ -66,7 +66,7 @@ subroutine UCIS(spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,E nS_bb = nS(2) nS_sc = nS_aa + nS_bb - allocate(A_sc(nS_sc,nS_sc),Omega_sc(nS_sc)) + allocate(A_sc(nS_sc,nS_sc),Om_sc(nS_sc)) call phULR_A(ispin,.false.,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,lambda,eHF,ERI_aaaa,ERI_aabb,ERI_bbbb,A_sc) @@ -76,11 +76,11 @@ subroutine UCIS(spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,E write(*,*) endif - call diagonalize_matrix(nS_sc,A_sc,Omega_sc) + call diagonalize_matrix(nS_sc,A_sc,Om_sc) A_sc(:,:) = transpose(A_sc) - call print_excitation('UCIS ',5,nS_sc,Omega_sc) - call print_unrestricted_transition_vectors(ispin,nBas,nC,nO,nV,nR,nS,nS_aa,nS_bb,nS_sc,dipole_int_aa,dipole_int_bb, & - cHF,S,Omega_sc,A_sc,A_sc) + call print_excitation_energies('UCIS',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) if(dump_trans) then print*,'Spin-conserved CIS transition vectors' @@ -88,7 +88,7 @@ subroutine UCIS(spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,E write(*,*) endif - deallocate(A_sc,Omega_sc) + deallocate(A_sc,Om_sc) endif @@ -106,7 +106,7 @@ subroutine UCIS(spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,E nS_ba = (nO(2) - nC(2))*(nV(1) - nR(1)) nS_sf = nS_ab + nS_ba - allocate(A_sf(nS_sf,nS_sf),Omega_sf(nS_sf)) + allocate(A_sf(nS_sf,nS_sf),Om_sf(nS_sf)) call phULR_A(ispin,.false.,nBas,nC,nO,nV,nR,nS_ab,nS_ba,nS_sf,lambda,eHF,ERI_aaaa,ERI_aabb,ERI_bbbb,A_sf) @@ -116,11 +116,11 @@ subroutine UCIS(spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,E write(*,*) endif - call diagonalize_matrix(nS_sf,A_sf,Omega_sf) + call diagonalize_matrix(nS_sf,A_sf,Om_sf) A_sf(:,:) = transpose(A_sf) - call print_excitation('UCIS ',6,nS_sf,Omega_sf) - call print_unrestricted_transition_vectors(ispin,nBas,nC,nO,nV,nR,nS,nS_ab,nS_ba,nS_sf,dipole_int_aa,dipole_int_bb, & - cHF,S,Omega_sf,A_sf,A_sf) + call print_excitation_energies('UCIS ',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) if(dump_trans) then print*,'Spin-flip CIS transition vectors' @@ -128,7 +128,7 @@ subroutine UCIS(spin_conserved,spin_flip,nBas,nC,nO,nV,nR,nS,ERI_aaaa,ERI_aabb,E write(*,*) endif - deallocate(A_sf,Omega_sf) + deallocate(A_sf,Om_sf) endif diff --git a/src/GF/GF2_phBSE2.f90 b/src/GF/GF2_phBSE2.f90 index dcce3cb..97ec667 100644 --- a/src/GF/GF2_phBSE2.f90 +++ b/src/GF/GF2_phBSE2.f90 @@ -68,8 +68,8 @@ subroutine GF2_phBSE2(TDA,dBSE,dTDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI, ! Compute phBSE2@GF2 excitation energies call phLR(TDA,nS,A_sta,B_sta,EcBSE(ispin),OmBSE,XpY,XmY) - call print_excitation('phBSE2@GF2 ',ispin,nS,OmBSE) - call print_transition_vectors_ph(.true.,nBas,nC,nO,nV,nR,nS,dipole_int,OmBSE,XpY,XmY) + call print_excitation_energies('phBSE2@GF2',ispin,nS,OmBSE) + call phLR_transition_vectors(.true.,nBas,nC,nO,nV,nR,nS,dipole_int,OmBSE,XpY,XmY) ! Compute dynamic correction for BSE via perturbation theory @@ -101,8 +101,8 @@ subroutine GF2_phBSE2(TDA,dBSE,dTDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS,ERI, ! Compute phBSE2@GF2 excitation energies call phLR(TDA,nS,A_sta,B_sta,EcBSE(ispin),OmBSE,XpY,XmY) - call print_excitation('phBSE2@GF2 ',ispin,nS,OmBSE) - call print_transition_vectors_ph(.false.,nBas,nC,nO,nV,nR,nS,dipole_int,OmBSE,XpY,XmY) + call print_excitation_energies('phBSE2@GF2',ispin,nS,OmBSE) + call phLR_transition_vectors(.false.,nBas,nC,nO,nV,nR,nS,dipole_int,OmBSE,XpY,XmY) ! Compute dynamic correction for BSE via perturbation theory diff --git a/src/GF/GF2_phBSE2_dynamic_perturbation.f90 b/src/GF/GF2_phBSE2_dynamic_perturbation.f90 index 5bc5f66..a60c4f7 100644 --- a/src/GF/GF2_phBSE2_dynamic_perturbation.f90 +++ b/src/GF/GF2_phBSE2_dynamic_perturbation.f90 @@ -57,7 +57,7 @@ subroutine GF2_phBSE2_dynamic_perturbation(dTDA,ispin,eta,nBas,nC,nO,nV,nR,nS,ER ! Print main components of transition vectors - call print_transition_vectors_ph(.false.,nBas,nC,nO,nV,nR,nS,dipole_int,OmBSE,XpY,XmY) + call phLR_transition_vectors(.false.,nBas,nC,nO,nV,nR,nS,dipole_int,OmBSE,XpY,XmY) gapGF = eGF(nO+1) - eGF(nO) diff --git a/src/GF/GF2_ppBSE2.f90 b/src/GF/GF2_ppBSE2.f90 index a2ea9eb..d3c3349 100644 --- a/src/GF/GF2_ppBSE2.f90 +++ b/src/GF/GF2_ppBSE2.f90 @@ -93,7 +93,7 @@ subroutine GF2_ppBSE2(TDA,dBSE,dTDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,ERI,dip call ppLR(TDA,nOO,nVV,Bpp,Cpp,Dpp,Om1,X1,Y1,Om2,X2,Y2,EcBSE(ispin)) - call print_transition_vectors_pp(.true.,nBas,nC,nO,nV,nR,nOO,nVV,dipole_int,Om1,X1,Y1,Om2,X2,Y2) + call ppLR_transition_vectors(.true.,nBas,nC,nO,nV,nR,nOO,nVV,dipole_int,Om1,X1,Y1,Om2,X2,Y2) !----------------------------------------------------! ! Compute the dynamical screening at the ppBSE level ! @@ -146,7 +146,7 @@ subroutine GF2_ppBSE2(TDA,dBSE,dTDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,ERI,dip call ppLR(TDA,nOO,nVV,Bpp,Cpp,Dpp,Om1,X1,Y1,Om2,X2,Y2,EcBSE(ispin)) - call print_transition_vectors_pp(.false.,nBas,nC,nO,nV,nR,nOO,nVV,dipole_int,Om1,X1,Y1,Om2,X2,Y2) + call ppLR_transition_vectors(.false.,nBas,nC,nO,nV,nR,nOO,nVV,dipole_int,Om1,X1,Y1,Om2,X2,Y2) !----------------------------------------------------! ! Compute the dynamical screening at the ppBSE level ! diff --git a/src/GT/G0T0eh.f90 b/src/GT/G0T0eh.f90 index 0c9d2b5..bdd8c29 100644 --- a/src/GT/G0T0eh.f90 +++ b/src/GT/G0T0eh.f90 @@ -114,7 +114,7 @@ subroutine G0T0eh(doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_T,TDA,dBSE, call phLR(TDA_T,nS,Aph,Bph,EcRPA,Om,XpY,XmY) - if(print_T) call print_excitation('RPA@HF ',ispin,nS,Om) + if(print_T) call print_excitation_energies('RPA@HF ',ispin,nS,Om) !--------------------------! ! Compute spectral weights ! diff --git a/src/GT/G0T0pp.f90 b/src/GT/G0T0pp.f90 index b5da52e..76cf225 100644 --- a/src/GT/G0T0pp.f90 +++ b/src/GT/G0T0pp.f90 @@ -109,8 +109,8 @@ subroutine G0T0pp(doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,dTDA,dopp deallocate(Bpp,Cpp,Dpp) - call print_excitation('pp-RPA (N+2)',iblock,nVVs,Om1s(:)) - call print_excitation('pp-RPA (N-2)',iblock,nOOs,Om2s(:)) + call print_excitation_energies('pp-RPA (N+2)',iblock,nVVs,Om1s(:)) + call print_excitation_energies('pp-RPA (N-2)',iblock,nOOs,Om2s(:)) !---------------------------------------------- ! alpha-alpha block @@ -131,8 +131,8 @@ subroutine G0T0pp(doACFDT,exchange_kernel,doXBS,dophBSE,TDA_T,TDA,dBSE,dTDA,dopp deallocate(Bpp,Cpp,Dpp) - call print_excitation('ppRPA (N+2) ',iblock,nVVt,Om1t) - call print_excitation('ppRPA (N-2) ',iblock,nOOt,Om2t) + call print_excitation_energies('ppRPA (N+2)',iblock,nVVt,Om1t) + call print_excitation_energies('ppRPA (N-2)',iblock,nOOt,Om2t) !---------------------------------------------- ! Compute T-matrix version of the self-energy diff --git a/src/GT/GTpp_phBSE.f90 b/src/GT/GTpp_phBSE.f90 index e315d56..bf72191 100644 --- a/src/GT/GTpp_phBSE.f90 +++ b/src/GT/GTpp_phBSE.f90 @@ -139,8 +139,8 @@ subroutine GTpp_phBSE(TDA_T,TDA,dBSE,dTDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,n call phLR(TDA,nS,Aph,Bph,EcBSE(ispin),OmBSE,XpY_BSE,XmY_BSE) - call print_excitation('phBSE@GTpp ',ispin,nS,OmBSE) - call print_transition_vectors_ph(.true.,nBas,nC,nO,nV,nR,nS,dipole_int,OmBSE,XpY_BSE,XmY_BSE) + call print_excitation_energies('phBSE@GTpp',ispin,nS,OmBSE) + call phLR_transition_vectors(.true.,nBas,nC,nO,nV,nR,nS,dipole_int,OmBSE,XpY_BSE,XmY_BSE) ! Compute dynamic correction for BSE via renormalized perturbation theory @@ -169,8 +169,8 @@ subroutine GTpp_phBSE(TDA_T,TDA,dBSE,dTDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,n call phLR(TDA,nS,Aph,Bph,EcBSE(ispin),OmBSE,XpY_BSE,XmY_BSE) - call print_excitation('phBSE@GTpp ',ispin,nS,OmBSE) - call print_transition_vectors_ph(.false.,nBas,nC,nO,nV,nR,nS,dipole_int,OmBSE,XpY_BSE,XmY_BSE) + call print_excitation_energies('phBSE@GTpp',ispin,nS,OmBSE) + call phLR_transition_vectors(.false.,nBas,nC,nO,nV,nR,nS,dipole_int,OmBSE,XpY_BSE,XmY_BSE) ! Compute dynamic correction for BSE via renormalized perturbation theory diff --git a/src/GT/GTpp_ppBSE.f90 b/src/GT/GTpp_ppBSE.f90 index 758770c..cedaa1d 100644 --- a/src/GT/GTpp_ppBSE.f90 +++ b/src/GT/GTpp_ppBSE.f90 @@ -155,7 +155,7 @@ subroutine GTpp_ppBSE(TDA_T,TDA,dBSE,dTDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,n call ppLR(TDA,nOOs,nVVs,Bpp,Cpp,Dpp,Om1s,X1s,Y1s,Om2s,X2s,Y2s,EcBSE(ispin)) - call print_transition_vectors_pp(.true.,nBas,nC,nO,nV,nR,nOOs,nVVs,dipole_int,Om1s,X1s,Y1s,Om2s,X2s,Y2s) + call ppLR_transition_vectors(.true.,nBas,nC,nO,nV,nR,nOOs,nVVs,dipole_int,Om1s,X1s,Y1s,Om2s,X2s,Y2s) deallocate(Om1s,X1s,Y1s,Om2s,X2s,Y2s,TBab,TCab,TDab,TBaa,TCaa,TDaa,Bpp,Cpp,Dpp) @@ -240,7 +240,7 @@ subroutine GTpp_ppBSE(TDA_T,TDA,dBSE,dTDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,n call ppLR(TDA,nOOs,nVVs,Bpp,Cpp,Dpp,Om1s,X1s,Y1s,Om2s,X2s,Y2s,EcBSE(ispin)) - call print_transition_vectors_pp(.false.,nBas,nC,nO,nV,nR,nOOt,nVVt,dipole_int,Om1t,X1t,Y1t,Om2t,X2t,Y2t) + call ppLR_transition_vectors(.false.,nBas,nC,nO,nV,nR,nOOt,nVVt,dipole_int,Om1t,X1t,Y1t,Om2t,X2t,Y2t) deallocate(Om1t,X1t,Y1t,Om2t,X2t,Y2t,TBab,TCab,TDab,TBaa,TCaa,TDaa,Bpp,Cpp,Dpp) diff --git a/src/GT/UG0T0pp.f90 b/src/GT/UG0T0pp.f90 index a55b099..f5408fa 100644 --- a/src/GT/UG0T0pp.f90 +++ b/src/GT/UG0T0pp.f90 @@ -120,8 +120,8 @@ subroutine UG0T0pp(doACFDT,exchange_kernel,doXBS,BSE,TDA_T,TDA,dBSE,dTDA, & ! EcRPA(ispin) = 1d0*EcRPA(ispin) - call print_excitation('pp-RPA (N+2)',iblock,nPab,Om1ab(:)) - call print_excitation('pp-RPA (N-2)',iblock,nHab,Om2ab(:)) + call print_excitation_energies('ppRPA@HF (N+2)',iblock,nPab,Om1ab(:)) + call print_excitation_energies('ppRPA@HF (N-2)',iblock,nHab,Om2ab(:)) !---------------------------------------------- ! alpha-alpha block @@ -138,8 +138,8 @@ subroutine UG0T0pp(doACFDT,exchange_kernel,doXBS,BSE,TDA_T,TDA,dBSE,dTDA, & ! EcRPA(ispin) = 2d0*EcRPA(ispin) ! EcRPA(ispin) = 3d0*EcRPA(ispin) - call print_excitation('pp-RPA (N+2)',iblock,nPaa,Om1aa(:)) - call print_excitation('pp-RPA (N-2)',iblock,nHaa,Om2aa(:)) + call print_excitation_energies('ppRPA@HF (N+2)',iblock,nPaa,Om1aa(:)) + call print_excitation_energies('ppRPA@HF (N-2)',iblock,nHaa,Om2aa(:)) !---------------------------------------------- ! beta-beta block @@ -156,8 +156,8 @@ subroutine UG0T0pp(doACFDT,exchange_kernel,doXBS,BSE,TDA_T,TDA,dBSE,dTDA, & ! EcRPA(ispin) = 2d0*EcRPA(ispin) ! EcRPA(ispin) = 3d0*EcRPA(ispin) - call print_excitation('pp-RPA (N+2)',iblock,nPbb,Om1bb(:)) - call print_excitation('pp-RPA (N-2)',iblock,nHbb,Om2bb(:)) + call print_excitation_energies('ppRPA@HF (N+2)',iblock,nPbb,Om1bb(:)) + call print_excitation_energies('ppRPA@HF (N-2)',iblock,nHbb,Om2bb(:)) !---------------------------------------------- ! Compute T-matrix version of the self-energy diff --git a/src/GT/qsGTeh.f90 b/src/GT/qsGTeh.f90 index dc6ebd4..3c6ae93 100644 --- a/src/GT/qsGTeh.f90 +++ b/src/GT/qsGTeh.f90 @@ -177,7 +177,7 @@ subroutine qsGTeh(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE,BSE2, call phLR(TDA_T,nS,Aph,Bph,EcRPA,Om,XpY,XmY) - if(print_T) call print_excitation('RPA@qsGTeh ',ispin,nS,Om) + if(print_T) call print_excitation_energies('phRPA@qsGTeh',ispin,nS,Om) ! Compute correlation part of the self-energy diff --git a/src/GW/G0W0.f90 b/src/GW/G0W0.f90 index f78febe..69edac1 100644 --- a/src/GW/G0W0.f90 +++ b/src/GW/G0W0.f90 @@ -104,7 +104,7 @@ subroutine G0W0(doACFDT,exchange_kernel,doXBS,dophBSE,dophBSE2,TDA_W,TDA,dBSE,dT call phLR(TDA_W,nS,Aph,Bph,EcRPA,Om,XpY,XmY) - if(print_W) call print_excitation('RPA@HF ',ispin,nS,Om) + if(print_W) call print_excitation_energies('RPA@HF ',ispin,nS,Om) !--------------------------! ! Compute spectral weights ! diff --git a/src/GW/GW_phBSE.f90 b/src/GW/GW_phBSE.f90 index b74828e..0f0606f 100644 --- a/src/GW/GW_phBSE.f90 +++ b/src/GW/GW_phBSE.f90 @@ -117,8 +117,8 @@ subroutine GW_phBSE(dophBSE2,TDA_W,TDA,dBSE,dTDA,singlet,triplet,eta,nBas,nC,nO, call phLR(TDA,nS,Aph,Bph,EcBSE(ispin),OmBSE,XpY_BSE,XmY_BSE) - call print_excitation('phBSE@GW ',ispin,nS,OmBSE) - call print_transition_vectors_ph(.true.,nBas,nC,nO,nV,nR,nS,dipole_int,OmBSE,XpY_BSE,XmY_BSE) + call print_excitation_energies('phBSE@GW',ispin,nS,OmBSE) + call phLR_transition_vectors(.true.,nBas,nC,nO,nV,nR,nS,dipole_int,OmBSE,XpY_BSE,XmY_BSE) !----------------------------------------------------! ! Compute the dynamical screening at the phBSE level ! @@ -149,8 +149,8 @@ subroutine GW_phBSE(dophBSE2,TDA_W,TDA,dBSE,dTDA,singlet,triplet,eta,nBas,nC,nO, call phLR(TDA,nS,Aph,Bph,EcBSE(ispin),OmBSE,XpY_BSE,XmY_BSE) - call print_excitation('phBSE@GW ',ispin,nS,OmBSE) - call print_transition_vectors_ph(.false.,nBas,nC,nO,nV,nR,nS,dipole_int,OmBSE,XpY_BSE,XmY_BSE) + call print_excitation_energies('phBSE@GW',ispin,nS,OmBSE) + call phLR_transition_vectors(.false.,nBas,nC,nO,nV,nR,nS,dipole_int,OmBSE,XpY_BSE,XmY_BSE) !------------------------------------------------- ! Compute the dynamical screening at the BSE level diff --git a/src/GW/GW_ppBSE.f90 b/src/GW/GW_ppBSE.f90 index 169dc4f..4fb3713 100644 --- a/src/GW/GW_ppBSE.f90 +++ b/src/GW/GW_ppBSE.f90 @@ -122,7 +122,7 @@ subroutine GW_ppBSE(TDA_W,TDA,dBSE,dTDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS, call ppLR(TDA,nOO,nVV,Bpp,Cpp,Dpp,Om1,X1,Y1,Om2,X2,Y2,EcBSE(ispin)) - call print_transition_vectors_pp(.true.,nBas,nC,nO,nV,nR,nOO,nVV,dipole_int,Om1,X1,Y1,Om2,X2,Y2) + call ppLR_transition_vectors(.true.,nBas,nC,nO,nV,nR,nOO,nVV,dipole_int,Om1,X1,Y1,Om2,X2,Y2) !----------------------------------------------------! ! Compute the dynamical screening at the ppBSE level ! @@ -175,7 +175,7 @@ subroutine GW_ppBSE(TDA_W,TDA,dBSE,dTDA,singlet,triplet,eta,nBas,nC,nO,nV,nR,nS, call ppLR(TDA,nOO,nVV,Bpp,Cpp,Dpp,Om1,X1,Y1,Om2,X2,Y2,EcBSE(ispin)) - call print_transition_vectors_pp(.false.,nBas,nC,nO,nV,nR,nOO,nVV,dipole_int,Om1,X1,Y1,Om2,X2,Y2) + call ppLR_transition_vectors(.false.,nBas,nC,nO,nV,nR,nOO,nVV,dipole_int,Om1,X1,Y1,Om2,X2,Y2) !----------------------------------------------------! ! Compute the dynamical screening at the ppBSE level ! diff --git a/src/GW/SRG_qsGW.f90 b/src/GW/SRG_qsGW.f90 index 338b0c9..16417be 100644 --- a/src/GW/SRG_qsGW.f90 +++ b/src/GW/SRG_qsGW.f90 @@ -141,8 +141,6 @@ subroutine SRG_qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE,BSE error_diis(:,:) = 0d0 rcond = 0d0 - print*,max_diis - !------------------------------------------------------------------------ ! Main loop !------------------------------------------------------------------------ @@ -183,7 +181,7 @@ subroutine SRG_qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,BSE,BSE tlr = tlr + tlr2 -tlr1 - if(print_W) call print_excitation('RPA@qsGW ',ispin,nS,OmRPA) + if(print_W) call print_excitation_energies('phRPA@SRG-qsGW',ispin,nS,OmRPA) ! Compute correlation part of the self-energy diff --git a/src/GW/UG0W0.f90 b/src/GW/UG0W0.f90 index 953f1bf..3b2e6a5 100644 --- a/src/GW/UG0W0.f90 +++ b/src/GW/UG0W0.f90 @@ -112,7 +112,7 @@ subroutine UG0W0(doACFDT,exchange_kernel,doXBS,BSE,TDA_W,TDA,dBSE,dTDA,spin_cons call phULR(ispin,.true.,TDA_W,.false.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0, & eHF,ERI_aaaa,ERI_aabb,ERI_bbbb,OmRPA,rho_RPA,EcRPA,OmRPA,XpY_RPA,XmY_RPA) - if(print_W) call print_excitation('RPA@UHF ',5,nS_sc,OmRPA) + if(print_W) call print_excitation_energies('phRPA@UHF',5,nS_sc,OmRPA) !----------------------! ! Excitation densities ! diff --git a/src/GW/UGW_phBSE.f90 b/src/GW/UGW_phBSE.f90 index 82ddc30..0770beb 100644 --- a/src/GW/UGW_phBSE.f90 +++ b/src/GW/UGW_phBSE.f90 @@ -100,9 +100,9 @@ subroutine UGW_phBSE(TDA_W,TDA,dBSE,dTDA,spin_conserved,spin_flip,eta, & call phULR(ispin,.true.,TDA,.true.,eta,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0, & eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,OmRPA,rho_RPA,EcBSE(ispin),OmBSE_sc,XpY_BSE_sc,XmY_BSE_sc) - call print_excitation('BSE@UGW ',5,nS_sc,OmBSE_sc) - call print_unrestricted_transition_vectors(ispin,nBas,nC,nO,nV,nR,nS,nS_aa,nS_bb,nS_sc,dipole_int_aa,dipole_int_bb, & - cW,S,OmBSE_sc,XpY_BSE_sc,XmY_BSE_sc) + call print_excitation_energies('phBSE@UGW',5,nS_sc,OmBSE_sc) + call phULR_transition_vectors(ispin,nBas,nC,nO,nV,nR,nS,nS_aa,nS_bb,nS_sc,dipole_int_aa,dipole_int_bb, & + cW,S,OmBSE_sc,XpY_BSE_sc,XmY_BSE_sc) !------------------------------------------------- ! Compute the dynamical screening at the BSE level @@ -136,9 +136,9 @@ subroutine UGW_phBSE(TDA_W,TDA,dBSE,dTDA,spin_conserved,spin_flip,eta, & eGW,ERI_aaaa,ERI_aabb,ERI_bbbb,OmRPA,rho_RPA,EcBSE(ispin), & OmBSE_sf,XpY_BSE_sf,XmY_BSE_sf) - call print_excitation('BSE@UGW ',6,nS_sf,OmBSE_sf) - call print_unrestricted_transition_vectors(ispin,nBas,nC,nO,nV,nR,nS,nS_ab,nS_ba,nS_sf,dipole_int_aa,dipole_int_bb, & - cW,S,OmBSE_sf,XpY_BSE_sf,XmY_BSE_sf) + call print_excitation_energies('phBSE@UGW',6,nS_sf,OmBSE_sf) + call phULR_transition_vectors(ispin,nBas,nC,nO,nV,nR,nS,nS_ab,nS_ba,nS_sf,dipole_int_aa,dipole_int_bb, & + cW,S,OmBSE_sf,XpY_BSE_sf,XmY_BSE_sf) !------------------------------------------------- ! Compute the dynamical screening at the BSE level diff --git a/src/GW/qsGW.f90 b/src/GW/qsGW.f90 index e031da6..13c6057 100644 --- a/src/GW/qsGW.f90 +++ b/src/GW/qsGW.f90 @@ -176,7 +176,7 @@ subroutine qsGW(maxSCF,thresh,max_diis,doACFDT,exchange_kernel,doXBS,dophBSE,dop if(.not.TDA_W) call phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,ERI_MO,Bph) call phLR(TDA_W,nS,Aph,Bph,EcRPA,Om,XpY,XmY) - if(print_W) call print_excitation('phRPA@qsGW ',ispin,nS,Om) + if(print_W) call print_excitation_energies('phRPA@qsGW',ispin,nS,Om) ! Compute correlation part of the self-energy diff --git a/src/LR/oscillator_strength_ph.f90 b/src/LR/phLR_oscillator_strength.f90 similarity index 95% rename from src/LR/oscillator_strength_ph.f90 rename to src/LR/phLR_oscillator_strength.f90 index 5591cc4..5085ce1 100644 --- a/src/LR/oscillator_strength_ph.f90 +++ b/src/LR/phLR_oscillator_strength.f90 @@ -1,4 +1,4 @@ -subroutine oscillator_strength_ph(nBas,nC,nO,nV,nR,nS,maxS,dipole_int,Om,XpY,XmY,os) +subroutine phLR_oscillator_strength(nBas,nC,nO,nV,nR,nS,maxS,dipole_int,Om,XpY,XmY,os) ! Compute linear response diff --git a/src/LR/print_transition_vectors_ph.f90 b/src/LR/phLR_transition_vectors.f90 similarity index 91% rename from src/LR/print_transition_vectors_ph.f90 rename to src/LR/phLR_transition_vectors.f90 index efb6a1e..ac65d39 100644 --- a/src/LR/print_transition_vectors_ph.f90 +++ b/src/LR/phLR_transition_vectors.f90 @@ -1,4 +1,4 @@ -subroutine print_transition_vectors_ph(spin_allowed,nBas,nC,nO,nV,nR,nS,dipole_int,Om,XpY,XmY) +subroutine phLR_transition_vectors(spin_allowed,nBas,nC,nO,nV,nR,nS,dipole_int,Om,XpY,XmY) ! Print transition vectors for linear response calculation @@ -37,7 +37,7 @@ subroutine print_transition_vectors_ph(spin_allowed,nBas,nC,nO,nV,nR,nS,dipole_i ! Compute oscillator strengths os(:) = 0d0 - if(spin_allowed) call oscillator_strength_ph(nBas,nC,nO,nV,nR,nS,maxS,dipole_int,Om,XpY,XmY,os) + if(spin_allowed) call phLR_oscillator_strength(nBas,nC,nO,nV,nR,nS,maxS,dipole_int,Om,XpY,XmY,os) ! Print details about excitations diff --git a/src/LR/unrestricted_oscillator_strength.f90 b/src/LR/phULR_oscillator_strength.f90 similarity index 94% rename from src/LR/unrestricted_oscillator_strength.f90 rename to src/LR/phULR_oscillator_strength.f90 index 27a0eab..2fdc22b 100644 --- a/src/LR/unrestricted_oscillator_strength.f90 +++ b/src/LR/phULR_oscillator_strength.f90 @@ -1,4 +1,4 @@ -subroutine unrestricted_oscillator_strength(nBas,nC,nO,nV,nR,nS,nSa,nSb,nSt,maxS,dipole_int_aa,dipole_int_bb,Omega,XpY,XmY,os) +subroutine phULR_oscillator_strength(nBas,nC,nO,nV,nR,nS,nSa,nSb,nSt,maxS,dipole_int_aa,dipole_int_bb,Omega,XpY,XmY,os) ! Compute linear response diff --git a/src/LR/print_unrestricted_transition_vectors.f90 b/src/LR/phULR_transition_vectors.f90 similarity index 92% rename from src/LR/print_unrestricted_transition_vectors.f90 rename to src/LR/phULR_transition_vectors.f90 index 653e14c..2e0f128 100644 --- a/src/LR/print_unrestricted_transition_vectors.f90 +++ b/src/LR/phULR_transition_vectors.f90 @@ -1,5 +1,4 @@ -subroutine print_unrestricted_transition_vectors(ispin,nBas,nC,nO,nV,nR,nS,nSa,nSb,nSt,dipole_int_aa,dipole_int_bb, & - c,S,Omega,XpY,XmY) +subroutine phULR_transition_vectors(ispin,nBas,nC,nO,nV,nR,nS,nSa,nSb,nSt,dipole_int_aa,dipole_int_bb,c,S,Omega,XpY,XmY) ! Print transition vectors for linear response calculation @@ -44,8 +43,8 @@ subroutine print_unrestricted_transition_vectors(ispin,nBas,nC,nO,nV,nR,nS,nSa,n ! Compute oscillator strengths os(:) = 0d0 - if(ispin == 1) call unrestricted_oscillator_strength(nBas,nC,nO,nV,nR,nS,nSa,nSb,nSt,maxS, & - dipole_int_aa,dipole_int_bb,Omega,XpY,XmY,os) + if(ispin == 1) call phULR_oscillator_strength(nBas,nC,nO,nV,nR,nS,nSa,nSb,nSt,maxS, & + dipole_int_aa,dipole_int_bb,Omega,XpY,XmY,os) ! Compute diff --git a/src/LR/oscillator_strength_pp.f90 b/src/LR/ppLR_oscillator_strength.f90 similarity index 96% rename from src/LR/oscillator_strength_pp.f90 rename to src/LR/ppLR_oscillator_strength.f90 index 4906bb7..3e3cc44 100644 --- a/src/LR/oscillator_strength_pp.f90 +++ b/src/LR/ppLR_oscillator_strength.f90 @@ -1,4 +1,4 @@ -subroutine oscillator_strength_pp(nBas,nC,nO,nV,nR,nOO,nVV,maxOO,maxVV,dipole_int,Om1,X1,Y1,Om2,X2,Y2,os1,os2) +subroutine ppLR_oscillator_strength(nBas,nC,nO,nV,nR,nOO,nVV,maxOO,maxVV,dipole_int,Om1,X1,Y1,Om2,X2,Y2,os1,os2) ! Compute linear response diff --git a/src/LR/print_transition_vectors_pp.f90 b/src/LR/ppLR_transition_vectors.f90 similarity index 95% rename from src/LR/print_transition_vectors_pp.f90 rename to src/LR/ppLR_transition_vectors.f90 index dae8d0c..8d48d6d 100644 --- a/src/LR/print_transition_vectors_pp.f90 +++ b/src/LR/ppLR_transition_vectors.f90 @@ -1,4 +1,4 @@ -subroutine print_transition_vectors_pp(spin_allowed,nBas,nC,nO,nV,nR,nOO,nVV,dipole_int,Om1,X1,Y1,Om2,X2,Y2) +subroutine ppLR_transition_vectors(spin_allowed,nBas,nC,nO,nV,nR,nOO,nVV,dipole_int,Om1,X1,Y1,Om2,X2,Y2) ! Print transition vectors for p-p linear response calculation @@ -47,7 +47,7 @@ subroutine print_transition_vectors_pp(spin_allowed,nBas,nC,nO,nV,nR,nOO,nVV,dip os2(:) = 0d0 if(spin_allowed) & - call oscillator_strength_pp(nBas,nC,nO,nV,nR,nOO,nVV,maxOO,maxVV,dipole_int,Om1,X1,Y1,Om2,X2,Y2,os1,os2) + call ppLR_oscillator_strength(nBas,nC,nO,nV,nR,nOO,nVV,maxOO,maxVV,dipole_int,Om1,X1,Y1,Om2,X2,Y2,os1,os2) !-----------------------------------------------! ! Print details about excitations for pp sector ! diff --git a/src/LR/print_excitation.f90 b/src/LR/print_excitation_energies.f90 similarity index 63% rename from src/LR/print_excitation.f90 rename to src/LR/print_excitation_energies.f90 index c28cb4b..8ba261a 100644 --- a/src/LR/print_excitation.f90 +++ b/src/LR/print_excitation_energies.f90 @@ -1,4 +1,4 @@ -subroutine print_excitation(method,ispin,nS,Omega) +subroutine print_excitation_energies(method,ispin,nS,Om) ! Print excitation energies for a given spin manifold @@ -7,14 +7,15 @@ subroutine print_excitation(method,ispin,nS,Omega) ! Input variables - character*12,intent(in) :: method - integer,intent(in) :: ispin,nS - double precision,intent(in) :: Omega(nS) + character(len=20),intent(in) :: method + integer,intent(in) :: ispin + integer,intent(in) :: nS + double precision,intent(in) :: Om(nS) ! Local variables - character*14 :: spin_manifold - integer,parameter :: maxS = 50 + character(len=20) :: spin_manifold + integer,parameter :: maxS = 20 integer :: ia if(ispin == 1) spin_manifold = 'singlet' @@ -26,19 +27,19 @@ subroutine print_excitation(method,ispin,nS,Omega) if(ispin == 7) spin_manifold = 'beta-beta' write(*,*) - write(*,*)'-------------------------------------------------------------' - write(*,'(1X,A14,A14,A14,A9)') method,' calculation: ',spin_manifold,' manifold' - write(*,*)'-------------------------------------------------------------' + write(*,*)'-------------------------------------------------------------------------------' + write(*,'(1X,A20,A20,A20,A9)') trim(method),' calculation: ',trim(spin_manifold),' manifold' + write(*,*)'-------------------------------------------------------------------------------' write(*,'(1X,A1,1X,A5,1X,A1,1X,A23,1X,A1,1X,A23,1X,A1,1X)') & '|','State','|',' Excitation energy (au) ','|',' Excitation energy (eV) ','|' - write(*,*)'-------------------------------------------------------------' + write(*,*)'-------------------------------------------------------------------------------' do ia=1,min(maxS,nS) write(*,'(1X,A1,1X,I5,1X,A1,1X,F23.6,1X,A1,1X,F23.6,1X,A1,1X)') & - '|',ia,'|',Omega(ia),'|',Omega(ia)*HaToeV,'|' + '|',ia,'|',Om(ia),'|',Om(ia)*HaToeV,'|' enddo - write(*,*)'-------------------------------------------------------------' + write(*,*)'-------------------------------------------------------------------------------' write(*,*) end subroutine diff --git a/src/RPA/crRPA.f90 b/src/RPA/crRPA.f90 index 97d72b2..277a2dc 100644 --- a/src/RPA/crRPA.f90 +++ b/src/RPA/crRPA.f90 @@ -75,8 +75,8 @@ subroutine crRPA(TDA,doACFDT,exchange_kernel,singlet,triplet,nBas,nC,nO,nV,nR,nS if(.not.TDA) call phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,-1d0,ERI,Bph) call phLR(TDA,nS,Aph,Bph,EcTr(ispin),Om,XpY,XmY) - call print_excitation('crRPA@HF ',ispin,nS,Om) - call print_transition_vectors_ph(.true.,nBas,nC,nO,nV,nR,nS,dipole_int,Om,XpY,XmY) + call print_excitation_energies('crRPA@HF',ispin,nS,Om) + call phLR_transition_vectors(.true.,nBas,nC,nO,nV,nR,nS,dipole_int,Om,XpY,XmY) endif @@ -90,8 +90,8 @@ subroutine crRPA(TDA,doACFDT,exchange_kernel,singlet,triplet,nBas,nC,nO,nV,nR,nS if(.not.TDA) call phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,-1d0,ERI,Bph) call phLR(TDA,nS,Aph,Bph,EcTr(ispin),Om,XpY,XmY) - call print_excitation('crRPA@HF ',ispin,nS,Om) - call print_transition_vectors_ph(.false.,nBas,nC,nO,nV,nR,nS,dipole_int,Om,XpY,XmY) + call print_excitation_energies('crRPA@HF',ispin,nS,Om) + call phLR_transition_vectors(.false.,nBas,nC,nO,nV,nR,nS,dipole_int,Om,XpY,XmY) endif diff --git a/src/RPA/phRPA.f90 b/src/RPA/phRPA.f90 index cd78d14..3cc2480 100644 --- a/src/RPA/phRPA.f90 +++ b/src/RPA/phRPA.f90 @@ -75,8 +75,8 @@ subroutine phRPA(TDA,doACFDT,exchange_kernel,singlet,triplet,nBas,nC,nO,nV,nR,nS if(.not.TDA) call phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,ERI,Bph) call phLR(TDA,nS,Aph,Bph,EcTr(ispin),Om,XpY,XmY) - call print_excitation('phRPA@HF ',ispin,nS,Om) - call print_transition_vectors_ph(.true.,nBas,nC,nO,nV,nR,nS,dipole_int,Om,XpY,XmY) + call print_excitation_energies('phRPA@HF',ispin,nS,Om) + call phLR_transition_vectors(.true.,nBas,nC,nO,nV,nR,nS,dipole_int,Om,XpY,XmY) endif @@ -90,8 +90,8 @@ subroutine phRPA(TDA,doACFDT,exchange_kernel,singlet,triplet,nBas,nC,nO,nV,nR,nS if(.not.TDA) call phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,ERI,Bph) call phLR(TDA,nS,Aph,Bph,EcTr(ispin),Om,XpY,XmY) - call print_excitation('phRPA@HF ',ispin,nS,Om) - call print_transition_vectors_ph(.false.,nBas,nC,nO,nV,nR,nS,dipole_int,Om,XpY,XmY) + call print_excitation_energies('phRPA@HF ',ispin,nS,Om) + call phLR_transition_vectors(.false.,nBas,nC,nO,nV,nR,nS,dipole_int,Om,XpY,XmY) endif diff --git a/src/RPA/phRPAx.f90 b/src/RPA/phRPAx.f90 index 24b694b..bb110c8 100644 --- a/src/RPA/phRPAx.f90 +++ b/src/RPA/phRPAx.f90 @@ -76,8 +76,8 @@ subroutine phRPAx(TDA,doACFDT,exchange_kernel,singlet,triplet,nBas,nC,nO,nV,nR,n if(.not.TDA) call phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,ERI,Bph) call phLR(TDA,nS,Aph,Bph,EcTr(ispin),Om,XpY,XmY) - call print_excitation('phRPAx@HF ',ispin,nS,Om) - call print_transition_vectors_ph(.true.,nBas,nC,nO,nV,nR,nS,dipole_int,Om,XpY,XmY) + call print_excitation_energies('phRPAx@HF ',ispin,nS,Om) + call phLR_transition_vectors(.true.,nBas,nC,nO,nV,nR,nS,dipole_int,Om,XpY,XmY) endif @@ -91,8 +91,8 @@ subroutine phRPAx(TDA,doACFDT,exchange_kernel,singlet,triplet,nBas,nC,nO,nV,nR,n if(.not.TDA) call phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,ERI,Bph) call phLR(TDA,nS,Aph,Bph,EcTr(ispin),Om,XpY,XmY) - call print_excitation('phRPAx@HF ',ispin,nS,Om) - call print_transition_vectors_ph(.false.,nBas,nC,nO,nV,nR,nS,dipole_int,Om,XpY,XmY) + call print_excitation_energies('phRPAx@HF ',ispin,nS,Om) + call phLR_transition_vectors(.false.,nBas,nC,nO,nV,nR,nS,dipole_int,Om,XpY,XmY) endif diff --git a/src/RPA/phURPA.f90 b/src/RPA/phURPA.f90 index b457f32..bbcd067 100644 --- a/src/RPA/phURPA.f90 +++ b/src/RPA/phURPA.f90 @@ -36,12 +36,12 @@ subroutine phURPA(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,nBas,nC,n integer :: ispin integer :: nS_aa,nS_bb,nS_sc - double precision,allocatable :: Omega_sc(:) + double precision,allocatable :: Om_sc(:) double precision,allocatable :: XpY_sc(:,:) double precision,allocatable :: XmY_sc(:,:) integer :: nS_ab,nS_ba,nS_sf - double precision,allocatable :: Omega_sf(:) + double precision,allocatable :: Om_sf(:) double precision,allocatable :: XpY_sf(:,:) double precision,allocatable :: XmY_sf(:,:) @@ -80,15 +80,15 @@ subroutine phURPA(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,nBas,nC,n nS_bb = nS(2) nS_sc = nS_aa + nS_bb - allocate(Omega_sc(nS_sc),XpY_sc(nS_sc,nS_sc),XmY_sc(nS_sc,nS_sc)) + allocate(Om_sc(nS_sc),XpY_sc(nS_sc,nS_sc),XmY_sc(nS_sc,nS_sc)) call phULR(ispin,.true.,TDA,.false.,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0,e, & - ERI_aaaa,ERI_aabb,ERI_bbbb,Omega_sc,rho_sc,EcRPA(ispin),Omega_sc,XpY_sc,XmY_sc) - call print_excitation('URPA ',5,nS_sc,Omega_sc) - call print_unrestricted_transition_vectors(ispin,nBas,nC,nO,nV,nR,nS,nS_aa,nS_bb,nS_sc,dipole_int_aa,dipole_int_bb, & - c,S,Omega_sc,XpY_sc,XmY_sc) + ERI_aaaa,ERI_aabb,ERI_bbbb,Om_sc,rho_sc,EcRPA(ispin),Om_sc,XpY_sc,XmY_sc) + call print_excitation_energies('phURPA@HF',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, & + c,S,Om_sc,XpY_sc,XmY_sc) - deallocate(Omega_sc,XpY_sc,XmY_sc) + deallocate(Om_sc,XpY_sc,XmY_sc) endif @@ -104,15 +104,15 @@ subroutine phURPA(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,nBas,nC,n nS_ba = (nO(2) - nC(2))*(nV(1) - nR(1)) nS_sf = nS_ab + nS_ba - allocate(Omega_sf(nS_sf),XpY_sf(nS_sf,nS_sf),XmY_sf(nS_sf,nS_sf)) + allocate(Om_sf(nS_sf),XpY_sf(nS_sf,nS_sf),XmY_sf(nS_sf,nS_sf)) call phULR(ispin,.true.,TDA,.false.,nBas,nC,nO,nV,nR,nS_ab,nS_ba,nS_sf,nS_sf,1d0,e, & - ERI_aaaa,ERI_aabb,ERI_bbbb,Omega_sf,rho_sf,EcRPA(ispin),Omega_sf,XpY_sf,XmY_sf) - call print_excitation('URPA ',6,nS_sf,Omega_sf) - call print_unrestricted_transition_vectors(ispin,nBas,nC,nO,nV,nR,nS,nS_ab,nS_ba,nS_sf,dipole_int_aa,dipole_int_bb, & - c,S,Omega_sf,XpY_sf,XmY_sf) + ERI_aaaa,ERI_aabb,ERI_bbbb,Om_sf,rho_sf,EcRPA(ispin),Om_sf,XpY_sf,XmY_sf) + call print_excitation_energies('phURPA@HF',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, & + c,S,Om_sf,XpY_sf,XmY_sf) - deallocate(Omega_sf,XpY_sf,XmY_sf) + deallocate(Om_sf,XpY_sf,XmY_sf) endif diff --git a/src/RPA/phURPAx.f90 b/src/RPA/phURPAx.f90 index 3ed0867..626761a 100644 --- a/src/RPA/phURPAx.f90 +++ b/src/RPA/phURPAx.f90 @@ -85,9 +85,9 @@ subroutine phURPAx(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,nBas,nC, call phULR(ispin,.false.,TDA,.false.,nBas,nC,nO,nV,nR,nS_aa,nS_bb,nS_sc,nS_sc,1d0,e, & ERI_aaaa,ERI_aabb,ERI_bbbb,Omega_sc,rho_sc,EcRPA(ispin),Omega_sc,XpY_sc,XmY_sc) - call print_excitation('URPAx ',5,nS_sc,Omega_sc) - call print_unrestricted_transition_vectors(ispin,nBas,nC,nO,nV,nR,nS,nS_aa,nS_bb,nS_sc,dipole_int_aa,dipole_int_bb, & - c,S,Omega_sc,XpY_sc,XmY_sc) + call print_excitation_energies('phURPAx@HF',5,nS_sc,Omega_sc) + call phULR_transition_vectors(ispin,nBas,nC,nO,nV,nR,nS,nS_aa,nS_bb,nS_sc,dipole_int_aa,dipole_int_bb, & + c,S,Omega_sc,XpY_sc,XmY_sc) deallocate(Omega_sc,XpY_sc,XmY_sc) @@ -109,9 +109,9 @@ subroutine phURPAx(TDA,doACFDT,exchange_kernel,spin_conserved,spin_flip,nBas,nC, call phULR(ispin,.false.,TDA,.false.,nBas,nC,nO,nV,nR,nS_ab,nS_ba,nS_sf,nS_sf,1d0,e, & ERI_aaaa,ERI_aabb,ERI_bbbb,Omega_sf,rho_sf,EcRPA(ispin),Omega_sf,XpY_sf,XmY_sf) - call print_excitation('URPAx ',6,nS_sf,Omega_sf) - call print_unrestricted_transition_vectors(ispin,nBas,nC,nO,nV,nR,nS,nS_ab,nS_ba,nS_sf,dipole_int_aa,dipole_int_bb, & - c,S,Omega_sf,XpY_sf,XmY_sf) + call print_excitation_energies('phURPAx@HF',6,nS_sf,Omega_sf) + call phULR_transition_vectors(ispin,nBas,nC,nO,nV,nR,nS,nS_ab,nS_ba,nS_sf,dipole_int_aa,dipole_int_bb, & + c,S,Omega_sf,XpY_sf,XmY_sf) deallocate(Omega_sf,XpY_sf,XmY_sf) diff --git a/src/RPA/ppRPA.f90 b/src/RPA/ppRPA.f90 index 555d964..8c6d98b 100644 --- a/src/RPA/ppRPA.f90 +++ b/src/RPA/ppRPA.f90 @@ -78,8 +78,8 @@ subroutine ppRPA(TDA,doACFDT,singlet,triplet,nBas,nC,nO,nV,nR,ENuc,EHF,ERI,dipol ! call print_transition_vectors_pp(.true.,nBas,nC,nO,nV,nR,nOO,nVV,dipole_int,Om1,X1,Y1,Om2,X2,Y2) - call print_excitation('ppRPA (N+2) ',ispin,nVV,Om1) - call print_excitation('ppRPA (N-2) ',ispin,nOO,Om2) + call print_excitation_energies('ppRPA (N+2) ',ispin,nVV,Om1) + call print_excitation_energies('ppRPA (N-2) ',ispin,nOO,Om2) deallocate(Om1,X1,Y1,Om2,X2,Y2,Bpp,Cpp,Dpp) @@ -110,8 +110,8 @@ subroutine ppRPA(TDA,doACFDT,singlet,triplet,nBas,nC,nO,nV,nR,ENuc,EHF,ERI,dipol ! call print_transition_vectors_pp(.false.,nBas,nC,nO,nV,nR,nOO,nVV,dipole_int,Om1,X1,Y1,Om2,X2,Y2) - call print_excitation('ppRPA (N+2) ',ispin,nVV,Om1) - call print_excitation('ppRPA (N-2) ',ispin,nOO,Om2) + call print_excitation_energies('ppRPA (N+2) ',ispin,nVV,Om1) + call print_excitation_energies('ppRPA (N-2) ',ispin,nOO,Om2) deallocate(Om1,X1,Y1,Om2,X2,Y2,Bpp,Cpp,Dpp) diff --git a/src/RPA/ppURPA.f90 b/src/RPA/ppURPA.f90 index a8db313..83605f2 100644 --- a/src/RPA/ppURPA.f90 +++ b/src/RPA/ppURPA.f90 @@ -72,8 +72,8 @@ subroutine ppURPA(TDA,doACFDT,spin_conserved,spin_flip,nBas,nC,nO,nV,nR,ENuc,EUH ERI_aabb,ERI_bbbb,Om1sc,X1sc,Y1sc, & Om2sc,X2sc,Y2sc,Ec_ppURPA(ispin)) - call print_excitation('pp-RPA (N+2)',iblock,nP_sc,Om1sc) - call print_excitation('pp-RPA (N-2)',iblock,nH_sc,Om2sc) + call print_excitation_energies('ppRPA@HF (N+2)',iblock,nP_sc,Om1sc) + call print_excitation_energies('ppRPA@HF (N-2)',iblock,nH_sc,Om2sc) !alpha-alpha block @@ -98,8 +98,8 @@ subroutine ppURPA(TDA,doACFDT,spin_conserved,spin_flip,nBas,nC,nO,nV,nR,ENuc,EUH ERI_aabb,ERI_bbbb,Om1sf,X1sf,Y1sf, & Om2sf,X2sf,Y2sf,Ec_ppURPA(ispin)) - call print_excitation('pp-RPA (N+2)',iblock,nP_sf,Om1sf) - call print_excitation('pp-RPA (N-2)',iblock,nH_sf,Om2sf) + call print_excitation_energies('ppRPA@HF (N+2)',iblock,nP_sf,Om1sf) + call print_excitation_energies('ppRPA@HF (N-2)',iblock,nH_sf,Om2sf) deallocate(Om1sf,X1sf,Y1sf,Om2sf,X2sf,Y2sf) @@ -118,8 +118,8 @@ subroutine ppURPA(TDA,doACFDT,spin_conserved,spin_flip,nBas,nC,nO,nV,nR,ENuc,EUH ERI_aabb,ERI_bbbb,Om1sf,X1sf,Y1sf,& Om2sf,X2sf,Y2sf,Ec_ppURPA(ispin)) - call print_excitation('pp-RPA (N+2)',iblock,nP_sf,Om1sf) - call print_excitation('pp-RPA (N-2)',iblock,nH_sf,Om2sf) + call print_excitation_energies('ppRPA@HF (N+2)',iblock,nP_sf,Om1sf) + call print_excitation_energies('ppRPA@HF (N-2)',iblock,nH_sf,Om2sf) write(*,*) write(*,*)'-------------------------------------------------------------------------------'