From d5a396200e3bb0bf10f72dc0b761e6d31ac343bc Mon Sep 17 00:00:00 2001 From: pfloos Date: Sun, 8 Sep 2024 16:19:03 +0200 Subject: [PATCH] remove redundant code --- src/GF/RGF2_ppBSE_static_kernel_B.f90 | 35 ----------------------- src/GF/RGF2_ppBSE_static_kernel_C.f90 | 40 --------------------------- src/GF/RGF2_ppBSE_static_kernel_D.f90 | 35 ----------------------- src/GW/GGW_phBSE.f90 | 17 ++++-------- src/GW/GGW_ppBSE.f90 | 8 ++---- src/GW/RGW_ppBSE_static_kernel_B.f90 | 31 --------------------- src/GW/RGW_ppBSE_static_kernel_C.f90 | 31 --------------------- src/GW/RGW_ppBSE_static_kernel_D.f90 | 31 --------------------- src/HF/GHF_search.f90 | 7 ++--- src/HF/GHF_stability.f90 | 7 ++--- src/LR/phLR_A.f90 | 23 --------------- src/LR/phLR_B.f90 | 22 --------------- src/LR/ppLR_B.f90 | 4 +-- src/LR/ppLR_C.f90 | 4 +-- src/LR/ppLR_C_od.f90 | 4 +-- src/LR/ppLR_D.f90 | 4 +-- src/LR/ppLR_D_od.f90 | 4 +-- 17 files changed, 22 insertions(+), 285 deletions(-) diff --git a/src/GF/RGF2_ppBSE_static_kernel_B.f90 b/src/GF/RGF2_ppBSE_static_kernel_B.f90 index 47a998e..93f2e3b 100644 --- a/src/GF/RGF2_ppBSE_static_kernel_B.f90 +++ b/src/GF/RGF2_ppBSE_static_kernel_B.f90 @@ -135,39 +135,4 @@ subroutine RGF2_ppBSE_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nOO,nVV,lambda, end if -! Second-order correlation kernel for the block B of the spinorbital manifold - - if(ispin == 4) then - - ab = 0 - do a=nO+1,nBas-nR - do b=a+1,nBas-nR - ab = ab + 1 - - ij = 0 - do i=nC+1,nO - do j=i+1,nO - ij = ij + 1 - - do m=nC+1,nO - do e=nO+1,nBas-nR - - dem = eGF(m) - eGF(e) - num = (ERI(a,m,i,e) - ERI(a,m,e,i)) * (ERI(e,b,m,j) - ERI(e,b,j,m)) - num = num + (ERI(a,e,i,m) - ERI(a,e,m,i)) * (ERI(m,b,e,j) - ERI(m,b,j,e)) - num = num - (ERI(b,m,i,e) - ERI(b,m,e,i)) * (ERI(e,a,m,j) - ERI(e,a,j,m)) - num = num - (ERI(b,e,i,m) - ERI(b,e,m,i)) * (ERI(m,a,e,j) - ERI(m,a,j,e)) - KB_sta(ab,ij) = KB_sta(ab,ij) + num*dem/(dem**2 + eta**2) - - end do - end do - - end do - end do - - end do - end do - - end if - end subroutine diff --git a/src/GF/RGF2_ppBSE_static_kernel_C.f90 b/src/GF/RGF2_ppBSE_static_kernel_C.f90 index cf133ae..2fff804 100644 --- a/src/GF/RGF2_ppBSE_static_kernel_C.f90 +++ b/src/GF/RGF2_ppBSE_static_kernel_C.f90 @@ -260,45 +260,5 @@ end if ! end do ! end if - - if(ispin == 4) then - - ab = 0 - do a=nO+1,nBas-nR - do b=a+1,nBas-nR - ab = ab + 1 - - cd = 0 - do c=nO+1,nBas-nR - do d=c+1,nBas-nR - cd = cd + 1 - - do m=nC+1,nO - do e=nO+1,nBas-nR - - dem = eGF(m) - eGF(e) - num = (ERI(a,m,c,e) - ERI(a,m,e,c)) * (ERI(e,b,m,d) - ERI(e,b,d,m)) - num = num + (ERI(a,e,c,m) - ERI(a,e,m,c)) * (ERI(m,b,e,d) - ERI(m,b,d,e)) - num = num - (ERI(b,m,c,e) - ERI(b,m,e,c)) * (ERI(e,a,m,d) - ERI(e,a,d,m)) - num = num - (ERI(b,e,c,m) - ERI(b,e,m,c)) * (ERI(m,a,e,d) - ERI(m,a,d,e)) - - KC_sta(ab,cd) = KC_sta(ab,cd) + num*dem/(dem**2 + eta**2) - - end do - end do - - end do - end do - - end do - end do - - end if - -! Second-order correlation kernel for the block C of the spinorbital manifold - - - -! deallocate(Om_tmp) end subroutine diff --git a/src/GF/RGF2_ppBSE_static_kernel_D.f90 b/src/GF/RGF2_ppBSE_static_kernel_D.f90 index 0474370..bcde139 100644 --- a/src/GF/RGF2_ppBSE_static_kernel_D.f90 +++ b/src/GF/RGF2_ppBSE_static_kernel_D.f90 @@ -135,39 +135,4 @@ subroutine RGF2_ppBSE_static_kernel_D(ispin,eta,nBas,nC,nO,nV,nR,nOO,lambda,ERI, end if -! Second-order correlation kernel for the block D of the spinorbital manifold - - if(ispin == 4) then - - ij = 0 - do i=nC+1,nO - do j=i+1,nO - ij = ij + 1 - - kl = 0 - do k=nC+1,nO - do l=k+1,nO - kl = kl + 1 - - do m=nC+1,nO - do e=nO+1,nBas-nR - - dem = eGF(m) - eGF(e) - num = (ERI(i,m,k,e) - ERI(i,m,e,k)) * (ERI(e,j,m,l) - ERI(e,j,l,m)) - num = num + (ERI(i,e,k,m) - ERI(i,e,m,k)) * (ERI(m,j,e,l) - ERI(m,j,l,e)) - num = num - (ERI(j,m,k,e) - ERI(j,m,e,k)) * (ERI(e,i,m,l) - ERI(e,i,l,m)) - num = num - (ERI(j,e,k,m) - ERI(j,e,m,k)) * (ERI(m,i,e,l) - ERI(m,i,l,e)) - - KD_sta(ij,kl) = KD_sta(ij,kl) + num*dem/(dem**2 + eta**2) - end do - end do - - end do - end do - - end do - end do - - end if - end subroutine diff --git a/src/GW/GGW_phBSE.f90 b/src/GW/GGW_phBSE.f90 index bb0677f..5e15087 100644 --- a/src/GW/GGW_phBSE.f90 +++ b/src/GW/GGW_phBSE.f90 @@ -30,9 +30,6 @@ subroutine GGW_phBSE(dophBSE2,TDA_W,TDA,dBSE,dTDA,eta,nBas,nC,nO,nV,nR,nS,ERI,di logical :: dRPA = .false. logical :: dRPA_W = .true. - integer :: ispin - integer :: isp_W - double precision :: EcRPA double precision,allocatable :: OmRPA(:) double precision,allocatable :: XpY_RPA(:,:) @@ -65,25 +62,23 @@ subroutine GGW_phBSE(dophBSE2,TDA_W,TDA,dBSE,dTDA,eta,nBas,nC,nO,nV,nR,nS,ERI,di ! Compute (singlet) RPA screening !--------------------------------- - isp_W = 3 EcRPA = 0d0 - call phLR_A(isp_W,dRPA_W,nBas,nC,nO,nV,nR,nS,1d0,eW,ERI,Aph) - if(.not.TDA_W) call phLR_B(isp_W,dRPA_W,nBas,nC,nO,nV,nR,nS,1d0,ERI,Bph) + call phGLR_A(dRPA_W,nBas,nC,nO,nV,nR,nS,1d0,eW,ERI,Aph) + if(.not.TDA_W) call phGLR_B(dRPA_W,nBas,nC,nO,nV,nR,nS,1d0,ERI,Bph) - call phLR(TDA_W,nS,Aph,Bph,EcRPA,OmRPA,XpY_RPA,XmY_RPA) + call phGLR(TDA_W,nS,Aph,Bph,EcRPA,OmRPA,XpY_RPA,XmY_RPA) call GGW_excitation_density(nBas,nC,nO,nR,nS,ERI,XpY_RPA,rho_RPA) call GGW_phBSE_static_kernel_A(eta,nBas,nC,nO,nV,nR,nS,1d0,ERI,OmRPA,rho_RPA,KA_sta) call GGW_phBSE_static_kernel_B(eta,nBas,nC,nO,nV,nR,nS,1d0,ERI,OmRPA,rho_RPA,KB_sta) - ispin = 3 EcBSE = 0d0 ! Compute BSE excitation energies - call phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI,Aph) - if(.not.TDA) call phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,1d0,ERI,Bph) + call phGLR_A(dRPA,nBas,nC,nO,nV,nR,nS,1d0,eGW,ERI,Aph) + if(.not.TDA) call phGLR_B(dRPA,nBas,nC,nO,nV,nR,nS,1d0,ERI,Bph) ! Second-order BSE static kernel @@ -107,7 +102,7 @@ subroutine GGW_phBSE(dophBSE2,TDA_W,TDA,dBSE,dTDA,eta,nBas,nC,nO,nV,nR,nS,ERI,di Aph(:,:) = Aph(:,:) + KA_sta(:,:) if(.not.TDA) Bph(:,:) = Bph(:,:) + KB_sta(:,:) - call phLR(TDA,nS,Aph,Bph,EcBSE,OmBSE,XpY_BSE,XmY_BSE) + call phGLR(TDA,nS,Aph,Bph,EcBSE,OmBSE,XpY_BSE,XmY_BSE) call print_excitation_energies('phBSE@GW@GHF','spinorbital',nS,OmBSE) call phLR_transition_vectors(.true.,nBas,nC,nO,nV,nR,nS,dipole_int,OmBSE,XpY_BSE,XmY_BSE) diff --git a/src/GW/GGW_ppBSE.f90 b/src/GW/GGW_ppBSE.f90 index e88cd78..5adeba5 100644 --- a/src/GW/GGW_ppBSE.f90 +++ b/src/GW/GGW_ppBSE.f90 @@ -26,8 +26,6 @@ subroutine GGW_ppBSE(TDA_W,TDA,dBSE,dTDA,eta,nOrb,nC,nO,nV,nR,nS,ERI,dipole_int, ! Local variables - integer :: isp_W - logical :: dRPA = .false. logical :: dRPA_W = .true. @@ -67,15 +65,13 @@ subroutine GGW_ppBSE(TDA_W,TDA,dBSE,dTDA,eta,nOrb,nC,nO,nV,nR,nS,ERI,dipole_int, ! Compute RPA screening ! !-----------------------! - isp_W = 3 EcRPA = 0d0 allocate(OmRPA(nS),XpY_RPA(nS,nS),XmY_RPA(nS,nS),rho_RPA(nOrb,nOrb,nS), & Aph(nS,nS),Bph(nS,nS)) - call phLR_A(isp_W,dRPA_W,nOrb,nC,nO,nV,nR,nS,1d0,eW,ERI,Aph) - - if(.not.TDA_W) call phLR_B(isp_W,dRPA_W,nOrb,nC,nO,nV,nR,nS,1d0,ERI,Bph) + call phGLR_A(dRPA_W,nOrb,nC,nO,nV,nR,nS,1d0,eW,ERI,Aph) + if(.not.TDA_W) call phGLR_B(dRPA_W,nOrb,nC,nO,nV,nR,nS,1d0,ERI,Bph) call phLR(TDA_W,nS,Aph,Bph,EcRPA,OmRPA,XpY_RPA,XmY_RPA) diff --git a/src/GW/RGW_ppBSE_static_kernel_B.f90 b/src/GW/RGW_ppBSE_static_kernel_B.f90 index 0c54e4d..cb6cd6c 100644 --- a/src/GW/RGW_ppBSE_static_kernel_B.f90 +++ b/src/GW/RGW_ppBSE_static_kernel_B.f90 @@ -99,35 +99,4 @@ subroutine RGW_ppBSE_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nS,nOO,nVV,lambd end if -!---------------! -! SpinOrb block ! -!---------------! - - if(ispin == 4) then - - ab = 0 - do a=nO+1,nBas-nR - do b=a+1,nBas-nR - ab = ab + 1 - ij = 0 - do i=nC+1,nO - do j=i+1,nO - ij = ij + 1 - - chi = 0d0 - do m=1,nS - eps = Om(m)**2 + eta**2 - chi = chi - rho(i,a,m)*rho(j,b,m)*Om(m)/eps & - + rho(i,b,m)*rho(a,j,m)*Om(m)/eps - end do - - KB(ab,ij) = 2d0*lambda*chi - - end do - end do - end do - end do - - end if - end subroutine diff --git a/src/GW/RGW_ppBSE_static_kernel_C.f90 b/src/GW/RGW_ppBSE_static_kernel_C.f90 index a516b57..b7636b4 100644 --- a/src/GW/RGW_ppBSE_static_kernel_C.f90 +++ b/src/GW/RGW_ppBSE_static_kernel_C.f90 @@ -348,35 +348,4 @@ subroutine RGW_ppBSE_static_kernel_C(ispin,eta,nBas,nC,nO,nV,nR,nS,nVV,lambda,ER end if -!---------------! -! SpinOrb block ! -!---------------! - - if(ispin == 4) then - - ab = 0 - do a=nO+1,nBas-nR - do b=a+1,nBas-nR - ab = ab + 1 - cd = 0 - do c=nO+1,nBas-nR - do d=c+1,nBas-nR - cd = cd + 1 - - chi = 0d0 - do m=1,nS - eps = Om(m)**2 + eta**2 - chi = chi - rho(a,c,m)*rho(b,d,m)*Om(m)/eps & - + rho(a,d,m)*rho(b,c,m)*Om(m)/eps - end do - - KC(ab,cd) = 2d0*lambda*chi - - end do - end do - end do - end do - - end if - end subroutine diff --git a/src/GW/RGW_ppBSE_static_kernel_D.f90 b/src/GW/RGW_ppBSE_static_kernel_D.f90 index c0407a5..16c73a5 100644 --- a/src/GW/RGW_ppBSE_static_kernel_D.f90 +++ b/src/GW/RGW_ppBSE_static_kernel_D.f90 @@ -98,35 +98,4 @@ subroutine RGW_ppBSE_static_kernel_D(ispin,eta,nBas,nC,nO,nV,nR,nS,nOO,lambda,ER end if -!---------------! -! SpinOrb block ! -!---------------! - - if(ispin == 4) then - - ij = 0 - do i=nC+1,nO - do j=i+1,nO - ij = ij + 1 - kl = 0 - do k=nC+1,nO - do l=k+1,nO - kl = kl + 1 - - chi = 0d0 - do m=1,nS - eps = Om(m)**2 + eta**2 - chi = chi - rho(i,k,m)*rho(j,l,m)*Om(m)/eps & - + rho(i,l,m)*rho(j,k,m)*Om(m)/eps - end do - - KD(ij,kl) = 2d0*lambda*chi - - end do - end do - end do - end do - - end if - end subroutine diff --git a/src/HF/GHF_search.f90 b/src/HF/GHF_search.f90 index 29bf58b..5d45b7f 100644 --- a/src/HF/GHF_search.f90 +++ b/src/HF/GHF_search.f90 @@ -48,7 +48,6 @@ subroutine GHF_search(maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu integer,parameter :: maxS = 20 integer :: ia,i,a,mu - integer :: ispin double precision,allocatable :: Aph(:,:) double precision,allocatable :: Bph(:,:) @@ -152,10 +151,8 @@ subroutine GHF_search(maxSCF,thresh,max_diis,guess_type,mix,level_shift,nNuc,ZNu ! Stability analysis: Real GHF -> Real GHF !-------------------------------------------------------------! - ispin = 3 - - call phLR_A(ispin,.false.,nBas2,nC,nO,nV,nR,nS,1d0,e,ERI_MO,Aph) - call phLR_B(ispin,.false.,nBas2,nC,nO,nV,nR,nS,1d0,ERI_MO,Bph) + call phGLR_A(.false.,nBas2,nC,nO,nV,nR,nS,1d0,e,ERI_MO,Aph) + call phGLR_B(.false.,nBas2,nC,nO,nV,nR,nS,1d0,ERI_MO,Bph) AB(:,:) = Aph(:,:) + Bph(:,:) diff --git a/src/HF/GHF_stability.f90 b/src/HF/GHF_stability.f90 index a69cf2f..62a6dec 100644 --- a/src/HF/GHF_stability.f90 +++ b/src/HF/GHF_stability.f90 @@ -21,7 +21,6 @@ subroutine GHF_stability(nBas,nC,nO,nV,nR,nS,eHF,ERI) integer,parameter :: maxS = 20 integer :: ia - integer :: ispin double precision,allocatable :: A(:,:) double precision,allocatable :: B(:,:) @@ -36,10 +35,8 @@ subroutine GHF_stability(nBas,nC,nO,nV,nR,nS,eHF,ERI) ! Stability analysis: Real GHF -> Real GHF !-------------------------------------------------------------! - ispin = 3 - - call phLR_A(ispin,.false.,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,A) - call phLR_B(ispin,.false.,nBas,nC,nO,nV,nR,nS,1d0,ERI,B) + call phGLR_A(.false.,nBas,nC,nO,nV,nR,nS,1d0,eHF,ERI,A) + call phGLR_B(.false.,nBas,nC,nO,nV,nR,nS,1d0,ERI,B) AB(:,:) = A(:,:) + B(:,:) diff --git a/src/LR/phLR_A.f90 b/src/LR/phLR_A.f90 index 8f9e8ee..2826fdd 100644 --- a/src/LR/phLR_A.f90 +++ b/src/LR/phLR_A.f90 @@ -81,27 +81,4 @@ subroutine phLR_A(ispin,dRPA,nBas,nC,nO,nV,nR,nS,lambda,e,ERI,Aph) end if -! Build A matrix for spin orbitals - - if(ispin == 3) then - - ia = 0 - do i=nC+1,nO - do a=nO+1,nBas-nR - ia = ia + 1 - jb = 0 - do j=nC+1,nO - do b=nO+1,nBas-nR - jb = jb + 1 - - Aph(ia,jb) = (e(a) - e(i))*Kronecker_delta(i,j)*Kronecker_delta(a,b) & - + lambda*ERI(i,b,a,j) - (1d0 - delta_dRPA)*lambda*ERI(i,b,j,a) - - end do - end do - end do - end do - - end if - end subroutine diff --git a/src/LR/phLR_B.f90 b/src/LR/phLR_B.f90 index 6e5258d..51a4a01 100644 --- a/src/LR/phLR_B.f90 +++ b/src/LR/phLR_B.f90 @@ -71,26 +71,4 @@ subroutine phLR_B(ispin,dRPA,nBas,nC,nO,nV,nR,nS,lambda,ERI,Bph) end if -! Build B matrix for spin orbitals - - if(ispin == 3) then - - ia = 0 - do i=nC+1,nO - do a=nO+1,nBas-nR - ia = ia + 1 - jb = 0 - do j=nC+1,nO - do b=nO+1,nBas-nR - jb = jb + 1 - - Bph(ia,jb) = lambda*ERI(i,j,a,b) - (1d0 - delta_dRPA)*lambda*ERI(i,j,b,a) - - end do - end do - end do - end do - - end if - end subroutine diff --git a/src/LR/ppLR_B.f90 b/src/LR/ppLR_B.f90 index a4f1fab..bfb3734 100644 --- a/src/LR/ppLR_B.f90 +++ b/src/LR/ppLR_B.f90 @@ -49,9 +49,9 @@ subroutine ppLR_B(ispin,nOrb,nC,nO,nV,nR,nOO,nVV,lambda,ERI,Bpp) end if -! Build the B matrix for the triplet manifold, or alpha-alpha, or in the spin-orbital basis +! Build the B matrix for the triplet or alpha-alpha manifold - if(ispin == 2 .or. ispin == 4) then + if(ispin == 2) then ab = 0 do a=nO+1,nOrb-nR diff --git a/src/LR/ppLR_C.f90 b/src/LR/ppLR_C.f90 index 6170797..764a0ed 100644 --- a/src/LR/ppLR_C.f90 +++ b/src/LR/ppLR_C.f90 @@ -106,9 +106,9 @@ subroutine ppLR_C(ispin,nOrb,nC,nO,nV,nR,nVV,lambda,e,ERI,Cpp) end if -! Build C matrix for the triplet manifold, or alpha-alpha block, or in the spin-orbital basis +! Build C matrix for the triplet or alpha-alpha manifold - if(ispin == 2 .or. ispin == 4) then + if(ispin == 2) then !$OMP PARALLEL & !$OMP SHARED(Cpp,lambda,ERI,e,eF,nC,nO,nOrb,nR) & !$OMP PRIVATE(c,d,a,b,ab,cd) & diff --git a/src/LR/ppLR_C_od.f90 b/src/LR/ppLR_C_od.f90 index 48606d0..8aae7cf 100644 --- a/src/LR/ppLR_C_od.f90 +++ b/src/LR/ppLR_C_od.f90 @@ -44,9 +44,9 @@ subroutine ppLR_C_od(ispin,nBas,nC,nO,nV,nR,nOO,nVV,lambda,ERI,Cpp) end if -! Build C matrix for the triplet manifold, or alpha-alpha block, or in the spin-orbital basis +! Build C matrix for the triplet or alpha-alpha manifold - if(ispin == 2 .or. ispin == 4) then + if(ispin == 2) then ab = 0 do a=nO+1,nBas-nR diff --git a/src/LR/ppLR_D.f90 b/src/LR/ppLR_D.f90 index f55b66c..ee759a3 100644 --- a/src/LR/ppLR_D.f90 +++ b/src/LR/ppLR_D.f90 @@ -56,9 +56,9 @@ subroutine ppLR_D(ispin,nOrb,nC,nO,nV,nR,nOO,lambda,e,ERI,Dpp) end if -! Build the D matrix for the triplet manifold, the alpha-alpha block, or in the spin-orbital basis +! Build the D matrix for the triplet or alpha-alpha manifold - if(ispin == 2 .or. ispin == 4) then + if(ispin == 2) then ij = 0 do i=nC+1,nO diff --git a/src/LR/ppLR_D_od.f90 b/src/LR/ppLR_D_od.f90 index 1d1b904..9aa3504 100644 --- a/src/LR/ppLR_D_od.f90 +++ b/src/LR/ppLR_D_od.f90 @@ -44,9 +44,9 @@ subroutine ppLR_D_od(ispin,nBas,nC,nO,nV,nR,nOO,nVV,lambda,ERI,Dpp) end if -! Build the D matrix for the triplet manifold, the alpha-alpha block, or in the spin-orbital basis +! Build the D matrix for the triplet or alpha-alpha manifold - if(ispin == 2 .or. ispin == 4) then + if(ispin == 2) then ij = 0 do i=nC+1,nO