mirror of
https://github.com/pfloos/quack
synced 2024-08-24 21:21:46 +02:00
rename LR routines
This commit is contained in:
parent
9c7725a0d9
commit
4576ee06c3
236
src/CC/BCCD.f90
236
src/CC/BCCD.f90
@ -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
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
||||
|
@ -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)
|
||||
|
||||
|
@ -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 !
|
||||
|
@ -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 !
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
||||
|
@ -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)
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
||||
|
@ -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 !
|
||||
|
@ -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
|
||||
|
@ -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 !
|
||||
|
@ -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
|
||||
|
||||
|
@ -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 !
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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 <S**2>
|
||||
|
@ -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
|
||||
|
@ -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 !
|
@ -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
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
||||
|
@ -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)
|
||||
|
||||
|
@ -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)
|
||||
|
||||
|
@ -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(*,*)'-------------------------------------------------------------------------------'
|
||||
|
Loading…
Reference in New Issue
Block a user