Commit f41f571e authored by Matteo Gerosa's avatar Matteo Gerosa
Browse files

In calc_corr, replaced loop over q with loop over k' (consistent with...

In calc_corr, replaced loop over q with loop over k' (consistent with solve_freq). Removed unused variables in calc_exx2.
parent 1cb90d06
......@@ -246,7 +246,7 @@ SUBROUTINE calc_corr_k( sigma_corr, energy, l_verbose)
!
! Workspace
!
INTEGER :: ik,is,iks,iq,ikqs,ib,ifreq,glob_ifreq,il,im,glob_im,ip
INTEGER :: ik,ikk,iks,ikks,iq,ib,ifreq,glob_ifreq,il,im,glob_im,ip
INTEGER :: nbndval
!
REAL(DP),EXTERNAL :: integrate_imfreq
......@@ -288,21 +288,24 @@ SUBROUTINE calc_corr_k( sigma_corr, energy, l_verbose)
DO iks = 1, k_grid%nps ! KPOINT-SPIN (MATRIX ELEMENT)
!
ik = k_grid%ip(iks)
is = k_grid%is(iks)
! is = k_grid%is(iks)
!
DO ib = qp_bandrange(1), qp_bandrange(2)
!
partial_h = 0._DP
partial_b = 0._DP
!
DO iq = 1, q_grid%np ! Q-POINT
! DO iq = 1, q_grid%np ! Q-POINT
DO ikks = 1, k_grid%nps ! KPOINT-SPIN (INTEGRAL OVER K')
!
CALL k_grid%find( k_grid%p_cart(:,ik) - q_grid%p_cart(:,iq), is, 'cart', ikqs, g0 )
ikk = k_grid%ip(ikks)
!
CALL k_grid%find( k_grid%p_cart(:,ik) - k_grid%p_cart(:,ikk), 1, 'cart', iq, g0 )
!CALL k_grid%add( k_grid%p_cart(:,ik), -q_grid%p_cart(:,iq), kmq, g0, 'cart' )
!ikqs = k_grid%find( kmq, 'cart' )
!ikqs = kmq_grid%index_kq(iks,iq)
l_gammaq = q_grid%l_pIsGamma(iq)
nbndval = nbnd_occ(ikqs)
nbndval = nbnd_occ(ikks)
!
! HEAD PART
!
......@@ -320,7 +323,7 @@ SUBROUTINE calc_corr_k( sigma_corr, energy, l_verbose)
DO ifreq = 1,ifr%nloc
DO im = 1, aband%nloc
glob_im = aband%l2g(im)
enrg = et(glob_im,ikqs) - energy(ib,iks)
enrg = et(glob_im,ikks) - energy(ib,iks)
partial_b = partial_b + z_body1_ifr_q(im,ifreq,ib,iks,iq)*integrate_imfreq(ifreq,enrg)*q_grid%weight(iq)
ENDDO
ENDDO
......@@ -341,7 +344,7 @@ SUBROUTINE calc_corr_k( sigma_corr, energy, l_verbose)
!
ENDIF
!
ENDDO ! iq
ENDDO ! ikks
!
CALL mp_sum( partial_h, intra_bgrp_comm)
CALL mp_sum( partial_b, intra_bgrp_comm)
......@@ -369,10 +372,10 @@ SUBROUTINE calc_corr_k( sigma_corr, energy, l_verbose)
!
! LOOP
!
DO iks = 1, k_grid%nps
DO iks = 1, k_grid%nps ! KPOINT-SPIN (MATRIX ELEMENT)
!
ik = k_grid%ip(iks)
is = k_grid%is(iks)
! is = k_grid%is(iks)
!
DO ib = qp_bandrange(1), qp_bandrange(2)
!
......@@ -381,14 +384,17 @@ SUBROUTINE calc_corr_k( sigma_corr, energy, l_verbose)
residues_b = 0._DP
residues_h = 0._DP
!
DO iq = 1, q_grid%np ! Q-POINT
! DO iq = 1, q_grid%np ! Q-POINT
DO ikks = 1, k_grid%nps ! KPOINT-SPIN (INTEGRAL OVER K')
!
ikk = k_grid%ip(ikks)
!
CALL k_grid%find( k_grid%p_cart(:,ik) - q_grid%p_cart(:,iq), is, 'cart', ikqs, g0 )
CALL k_grid%find( k_grid%p_cart(:,ik) - k_grid%p_cart(:,ikk), 1, 'cart', iq, g0 )
!CALL k_grid%add( k_grid%p_cart(:,ik), -q_grid%p_cart(:,iq), kmq, g0, 'cart' )
!ikqs = k_grid%find( kmq, 'cart' )
!!ikqs = kmq_grid%index_kq(iks,iq)
l_gammaq = q_grid%l_pIsGamma(iq)
nbndval = nbnd_occ(ikqs)
nbndval = nbnd_occ(ikks)
!
DO im = 1,aband%nloc
!
......@@ -397,15 +403,15 @@ SUBROUTINE calc_corr_k( sigma_corr, energy, l_verbose)
this_is_a_pole=.false.
IF( glob_im <= nbndval ) THEN ! poles inside G+
segno = -1._DP
IF( et(glob_im,ikqs) - enrg > 0.00001_DP ) this_is_a_pole=.TRUE.
IF( et(glob_im,ikks) - enrg > 0.00001_DP ) this_is_a_pole=.TRUE.
ELSE ! poles inside G-
segno = 1._DP
IF( et(glob_im,ikqs) - enrg < -0.00001_DP ) this_is_a_pole=.TRUE.
IF( et(glob_im,ikks) - enrg < -0.00001_DP ) this_is_a_pole=.TRUE.
ENDIF
!
IF( this_is_a_pole ) THEN
!
CALL retrieve_glob_freq( et(glob_im,ikqs) - enrg, glob_ifreq )
CALL retrieve_glob_freq( et(glob_im,ikks) - enrg, glob_ifreq )
!
DO ifreq = 1, rfr%nloc
!
......@@ -421,7 +427,7 @@ SUBROUTINE calc_corr_k( sigma_corr, energy, l_verbose)
!
ENDDO ! im
!
ENDDO ! iq
ENDDO ! ikks
!
CALL mp_sum( residues_h, intra_bgrp_comm )
CALL mp_sum( residues_h, inter_image_comm )
......
......@@ -62,11 +62,9 @@ SUBROUTINE calc_exx2_gamma( sigma_exx, nb1, nb2 )
INTEGER :: ib,iv,i1,ir,iks,ig,iv_glob
INTEGER :: nbndval
TYPE(idistribute) :: vband
REAL(DP) :: peso
TYPE(bar_type) :: barra
INTEGER :: barra_load
REAL(DP),ALLOCATABLE :: mysqvc(:)
REAL(DP) :: q(3)
REAL(DP) :: ecutvcut
TYPE(vcut_type) :: vcut
REAL(DP) :: mydiv
......@@ -139,12 +137,6 @@ SUBROUTINE calc_exx2_gamma( sigma_exx, nb1, nb2 )
!
nbndval = nbnd_occ(iks)
!
! IF( gamma_only ) THEN
peso = 2._DP
! ELSE
! peso = 1._DP
! ENDIF
!
vband = idistribute()
CALL vband%init(nbndval,'i','nbndval',.FALSE.)
!
......@@ -188,7 +180,7 @@ SUBROUTINE calc_exx2_gamma( sigma_exx, nb1, nb2 )
DO ig = 1,ngms
pertg(ig) = pertg(ig) * mysqvc(ig)
ENDDO
sigma_exx( ib, iks ) = sigma_exx( ib, iks ) - peso * DDOT( 2*ngms, pertg(1), 1, pertg(1), 1) / omega
sigma_exx( ib, iks ) = sigma_exx( ib, iks ) - 2._DP * DDOT( 2*ngms, pertg(1), 1, pertg(1), 1) / omega
!IF(gstart==2) sigma_exx( ib, iks ) = sigma_exx( ib, iks ) + REAL( pertg(1), KIND = DP )**2 / omega
IF( ib == iv_glob .AND. gstart == 2 ) sigma_exx( ib, iks ) = sigma_exx( ib, iks ) - mydiv
!
......@@ -272,11 +264,9 @@ SUBROUTINE calc_exx2_k( sigma_exx, nb1, nb2 )
INTEGER :: nbndval
INTEGER :: npwkq
TYPE(idistribute) :: vband
REAL(DP) :: peso
TYPE(bar_type) :: barra
INTEGER :: barra_load
REAL(DP),ALLOCATABLE :: mysqvc(:)
REAL(DP) :: q(3)
LOGICAL :: l_gammaq
REAL(DP) :: ecutvcut
TYPE(vcut_type) :: vcut
......@@ -354,8 +344,6 @@ SUBROUTINE calc_exx2_k( sigma_exx, nb1, nb2 )
!
nbndval = nbnd_occ(iks)
!
peso = 1._DP
!
vband = idistribute()
CALL vband%init(nbndval,'i','nbndval',.FALSE.)
!
......@@ -420,7 +408,7 @@ SUBROUTINE calc_exx2_k( sigma_exx, nb1, nb2 )
DO ig = 1,ngms
pertg(ig) = pertg(ig) * mysqvc(ig)
ENDDO
sigma_exx( ib, iks ) = sigma_exx( ib, iks ) - peso * DDOT( 2*ngms, pertg(1), 1, pertg(1), 1)/omega*q_grid%weight(iq)
sigma_exx( ib, iks ) = sigma_exx( ib, iks ) - DDOT( 2*ngms, pertg(1), 1, pertg(1), 1)/omega*q_grid%weight(iq)
!IF(gstart==2) sigma_exx( ib, iks ) = sigma_exx( ib, iks ) + REAL( pertg(1), KIND = DP )**2 / omega
IF( ib == iv_glob .AND. gstart == 2 .AND. l_gammaq ) sigma_exx( ib, iks ) = sigma_exx( ib, iks ) - mydiv
!
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment