Commit 26622c51 authored by Matteo Gerosa's avatar Matteo Gerosa
Browse files

Extended use of k_grid object to gamma_only routines.

parent 3693bc1c
...@@ -41,6 +41,7 @@ MODULE wfreq_db ...@@ -41,6 +41,7 @@ MODULE wfreq_db
USE io_push, ONLY : io_push_bar USE io_push, ONLY : io_push_bar
USE json_module, ONLY : json_file USE json_module, ONLY : json_file
USE constants, ONLY : rytoev USE constants, ONLY : rytoev
USE types_bz_grid, ONLY : k_grid
! !
IMPLICIT NONE IMPLICIT NONE
! !
...@@ -87,7 +88,7 @@ MODULE wfreq_db ...@@ -87,7 +88,7 @@ MODULE wfreq_db
DEALLOCATE(ilist) DEALLOCATE(ilist)
IF( l_generate_plot ) CALL json%add('output.P.freqlist',sigma_freq(1:n_spectralf)*rytoev) IF( l_generate_plot ) CALL json%add('output.P.freqlist',sigma_freq(1:n_spectralf)*rytoev)
! !
DO iks = 1, nks DO iks = 1, k_grid%nps
! !
WRITE(my_label_k,'(i6.6)') iks_l2g(iks) WRITE(my_label_k,'(i6.6)') iks_l2g(iks)
! !
......
...@@ -55,18 +55,17 @@ SUBROUTINE do_setup ...@@ -55,18 +55,17 @@ SUBROUTINE do_setup
! INIT PW ! INIT PW
! !
CALL init_pw_arrays(nbnd) CALL init_pw_arrays(nbnd)
CALL set_iks_l2g()
! !
CALL set_dirs() CALL set_dirs()
! !
! INIT K, Q GRIDS ! INIT K, Q GRIDS
! !
!k_grid = bz_grid()
CALL k_grid%init('K') CALL k_grid%init('K')
! !
!q_grid = bz_grid()
CALL q_grid%init('Q') CALL q_grid%init('Q')
! !
CALL set_iks_l2g()
!
IF ( ANY ( (q_grid%ngrid(:) - k_grid%ngrid(:)) /= 0 ) ) THEN IF ( ANY ( (q_grid%ngrid(:) - k_grid%ngrid(:)) /= 0 ) ) THEN
CALL errore( 'do_setup','q-point grid must be the same as k-point grid ',1) CALL errore( 'do_setup','q-point grid must be the same as k-point grid ',1)
ENDIF ENDIF
...@@ -79,7 +78,7 @@ SUBROUTINE do_setup ...@@ -79,7 +78,7 @@ SUBROUTINE do_setup
IF ( lsda ) THEN IF ( lsda ) THEN
IF ( INT( nelup ) == 0 .AND. INT( neldw ) == 0 ) THEN IF ( INT( nelup ) == 0 .AND. INT( neldw ) == 0 ) THEN
!IF ( .NOT. two_fermi_energies ) THEN !IF ( .NOT. two_fermi_energies ) THEN
DO iks = 1, nks DO iks = 1, k_grid%nps
spin = isk(iks) spin = isk(iks)
! !
SELECT CASE(spin) SELECT CASE(spin)
......
...@@ -20,6 +20,7 @@ FUNCTION get_alpha_pv() ...@@ -20,6 +20,7 @@ FUNCTION get_alpha_pv()
USE mp_global, ONLY : inter_pool_comm USE mp_global, ONLY : inter_pool_comm
USE klist, ONLY : nks USE klist, ONLY : nks
USE westcom, ONLY : nbnd_occ USE westcom, ONLY : nbnd_occ
USE types_bz_grid, ONLY : k_grid
! !
IMPLICIT NONE IMPLICIT NONE
! !
...@@ -34,7 +35,7 @@ FUNCTION get_alpha_pv() ...@@ -34,7 +35,7 @@ FUNCTION get_alpha_pv()
! Calculate ALPHA_PV ! Calculate ALPHA_PV
! !
emin = et (1, 1) emin = et (1, 1)
DO iks = 1, nks DO iks = 1, k_grid%nps
DO ibnd = 1, nbnd DO ibnd = 1, nbnd
emin = MIN (emin, et (ibnd, iks) ) emin = MIN (emin, et (ibnd, iks) )
ENDDO ENDDO
...@@ -43,7 +44,7 @@ FUNCTION get_alpha_pv() ...@@ -43,7 +44,7 @@ FUNCTION get_alpha_pv()
CALL mp_min( emin, inter_pool_comm) CALL mp_min( emin, inter_pool_comm)
! !
emax = et (1, 1) emax = et (1, 1)
DO iks = 1, nks DO iks = 1, k_grid%nps
DO ibnd = 1, nbnd_occ(iks) DO ibnd = 1, nbnd_occ(iks)
emax = MAX (emax, et (ibnd, iks) ) emax = MAX (emax, et (ibnd, iks) )
ENDDO ENDDO
......
...@@ -19,6 +19,7 @@ SUBROUTINE set_iks_l2g ...@@ -19,6 +19,7 @@ SUBROUTINE set_iks_l2g
USE westcom, ONLY : iks_l2g USE westcom, ONLY : iks_l2g
USE mp, ONLY : mp_sum USE mp, ONLY : mp_sum
USE mp_global, ONLY : inter_pool_comm,npool,my_pool_id USE mp_global, ONLY : inter_pool_comm,npool,my_pool_id
USE types_bz_grid, ONLY : k_grid
! !
IMPLICIT NONE IMPLICIT NONE
! !
...@@ -28,7 +29,7 @@ SUBROUTINE set_iks_l2g ...@@ -28,7 +29,7 @@ SUBROUTINE set_iks_l2g
ALLOCATE( iks_l2g(nkstot) ) ALLOCATE( iks_l2g(nkstot) )
! !
my_nks=0 my_nks=0
my_nks(my_pool_id) = nks my_nks(my_pool_id) = k_grid%nps
CALL mp_sum( my_nks, inter_pool_comm ) CALL mp_sum( my_nks, inter_pool_comm )
! !
my_offset = 0 my_offset = 0
...@@ -36,7 +37,7 @@ SUBROUTINE set_iks_l2g ...@@ -36,7 +37,7 @@ SUBROUTINE set_iks_l2g
my_offset = my_offset + my_nks(ip) my_offset = my_offset + my_nks(ip)
ENDDO ENDDO
! !
DO iks = 1, nks DO iks = 1, k_grid%nps
iks_l2g(iks) = my_offset + iks iks_l2g(iks) = my_offset + iks
ENDDO ENDDO
! !
......
...@@ -22,6 +22,7 @@ SUBROUTINE set_nbndocc( ) ...@@ -22,6 +22,7 @@ SUBROUTINE set_nbndocc( )
USE noncollin_module, ONLY : noncolin,npol USE noncollin_module, ONLY : noncolin,npol
USE io_global, ONLY : stdout USE io_global, ONLY : stdout
USE westcom, ONLY : nbnd_occ USE westcom, ONLY : nbnd_occ
USE types_bz_grid, ONLY : k_grid
! !
IMPLICIT NONE IMPLICIT NONE
! !
...@@ -30,11 +31,11 @@ SUBROUTINE set_nbndocc( ) ...@@ -30,11 +31,11 @@ SUBROUTINE set_nbndocc( )
! Calculate NBNDVAL ! Calculate NBNDVAL
! !
IF(ALLOCATED(nbnd_occ)) DEALLOCATE(nbnd_occ) IF(ALLOCATED(nbnd_occ)) DEALLOCATE(nbnd_occ)
ALLOCATE( nbnd_occ(nks) ) ALLOCATE( nbnd_occ(k_grid%nps) )
! !
IF(lsda) THEN IF(lsda) THEN
! !
DO iks = 1, nks DO iks = 1, k_grid%nps
spin = isk(iks) spin = isk(iks)
! !
SELECT CASE(spin) SELECT CASE(spin)
......
...@@ -90,12 +90,12 @@ SUBROUTINE do_rho ( ) ...@@ -90,12 +90,12 @@ SUBROUTINE do_rho ( )
IF( gamma_only ) THEN IF( gamma_only ) THEN
CALL single_invfft_gamma(dffts,npw,npwx,evc(1,global_ib),psic,'Wave') CALL single_invfft_gamma(dffts,npw,npwx,evc(1,global_ib),psic,'Wave')
DO ir = 1, dffts%nnr DO ir = 1, dffts%nnr
auxr(ir) = auxr(ir) + REAL( psic(ir), KIND=DP) * REAL( psic(ir), KIND=DP) * wk(iks) auxr(ir) = auxr(ir) + REAL( psic(ir), KIND=DP) * REAL( psic(ir), KIND=DP) * k_grid%weight(iks)
ENDDO ENDDO
ELSE ELSE
CALL single_invfft_k(dffts,npw,npwx,evc(1,global_ib),psic,'Wave',igk_k(1,current_k)) CALL single_invfft_k(dffts,npw,npwx,evc(1,global_ib),psic,'Wave',igk_k(1,current_k))
DO ir = 1, dffts%nnr DO ir = 1, dffts%nnr
auxr(ir) = auxr(ir) + REAL( CONJG( psic(ir) ) * psic(ir), KIND=DP) * wk(iks) auxr(ir) = auxr(ir) + REAL( CONJG( psic(ir) ) * psic(ir), KIND=DP) * k_grid%weight(iks)
ENDDO ENDDO
ENDIF ENDIF
! !
......
...@@ -66,8 +66,8 @@ SUBROUTINE do_sxx ( ) ...@@ -66,8 +66,8 @@ SUBROUTINE do_sxx ( )
! !
CALL io_push_title("(S)creened eXact eXchange") CALL io_push_title("(S)creened eXact eXchange")
! !
ALLOCATE( sigma_exx( westpp_range(1):westpp_range(2), nks) ) ALLOCATE( sigma_exx( westpp_range(1):westpp_range(2), k_grid%nps) )
ALLOCATE( sigma_sxx( westpp_range(1):westpp_range(2), nks) ) ALLOCATE( sigma_sxx( westpp_range(1):westpp_range(2), k_grid%nps) )
! !
sigma_exx = 0._DP sigma_exx = 0._DP
sigma_sxx = 0._DP sigma_sxx = 0._DP
......
...@@ -30,13 +30,14 @@ SUBROUTINE calc_corr_gamma( sigma_corr, energy, l_verbose) ...@@ -30,13 +30,14 @@ SUBROUTINE calc_corr_gamma( sigma_corr, energy, l_verbose)
USE io_push, ONLY : io_push_bar,io_push_value,io_push_title USE io_push, ONLY : io_push_bar,io_push_value,io_push_title
USE distribution_center, ONLY : pert,ifr,rfr,aband USE distribution_center, ONLY : pert,ifr,rfr,aband
USE types_coulomb, ONLY : pot3D USE types_coulomb, ONLY : pot3D
USE types_bz_grid, ONLY : k_grid
! !
IMPLICIT NONE IMPLICIT NONE
! !
! I/O ! I/O
! !
COMPLEX(DP),INTENT(OUT) :: sigma_corr( qp_bandrange(1):qp_bandrange(2), nks ) ! The correlation self-energy, imaginary part is lifetime. COMPLEX(DP),INTENT(OUT) :: sigma_corr( qp_bandrange(1):qp_bandrange(2), k_grid%nps ) ! The correlation self-energy, imaginary part is lifetime.
REAL(DP),INTENT(IN) :: energy( qp_bandrange(1):qp_bandrange(2), nks ) ! The energy variable REAL(DP),INTENT(IN) :: energy( qp_bandrange(1):qp_bandrange(2), k_grid%nps ) ! The energy variable
LOGICAL,INTENT(IN) :: l_verbose LOGICAL,INTENT(IN) :: l_verbose
! !
! Workspace ! Workspace
...@@ -73,12 +74,12 @@ SUBROUTINE calc_corr_gamma( sigma_corr, energy, l_verbose) ...@@ -73,12 +74,12 @@ SUBROUTINE calc_corr_gamma( sigma_corr, energy, l_verbose)
IF(l_verbose) WRITE(stdout,'(5x,"Integrating along the IM axis...")') IF(l_verbose) WRITE(stdout,'(5x,"Integrating along the IM axis...")')
IF(l_verbose) CALL io_push_bar IF(l_verbose) CALL io_push_bar
! !
IF(l_verbose) barra_load = nks * ( qp_bandrange(2) - qp_bandrange(1) + 1 ) IF(l_verbose) barra_load = k_grid%nps * ( qp_bandrange(2) - qp_bandrange(1) + 1 )
IF(l_verbose) CALL start_bar_type( barra, 'sigmac_i', barra_load ) IF(l_verbose) CALL start_bar_type( barra, 'sigmac_i', barra_load )
! !
! LOOP ! LOOP
! !
DO iks = 1, nks ! KPOINT-SPIN DO iks = 1, k_grid%nps ! KPOINT-SPIN
! !
nbndval = nbnd_occ(iks) nbndval = nbnd_occ(iks)
! !
...@@ -145,12 +146,12 @@ SUBROUTINE calc_corr_gamma( sigma_corr, energy, l_verbose) ...@@ -145,12 +146,12 @@ SUBROUTINE calc_corr_gamma( sigma_corr, energy, l_verbose)
IF(l_verbose) WRITE(stdout,'(5x,"Residues along the RE axis...")') IF(l_verbose) WRITE(stdout,'(5x,"Residues along the RE axis...")')
IF(l_verbose) CALL io_push_bar IF(l_verbose) CALL io_push_bar
! !
IF(l_verbose) barra_load = nks * ( qp_bandrange(2) - qp_bandrange(1) + 1 ) IF(l_verbose) barra_load = k_grid%nps * ( qp_bandrange(2) - qp_bandrange(1) + 1 )
IF(l_verbose) CALL start_bar_type( barra, 'sigmac_r', barra_load ) IF(l_verbose) CALL start_bar_type( barra, 'sigmac_r', barra_load )
! !
! LOOP ! LOOP
! !
DO iks = 1, nks DO iks = 1, k_grid%nps
! !
nbndval = nbnd_occ(iks) nbndval = nbnd_occ(iks)
! !
...@@ -298,9 +299,6 @@ SUBROUTINE calc_corr_k( sigma_corr, energy, l_verbose) ...@@ -298,9 +299,6 @@ SUBROUTINE calc_corr_k( sigma_corr, energy, l_verbose)
ikk = k_grid%ip(ikks) 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%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) l_gammaq = q_grid%l_pIsGamma(iq)
nbndval = nbnd_occ(ikks) nbndval = nbnd_occ(ikks)
! !
...@@ -387,9 +385,6 @@ SUBROUTINE calc_corr_k( sigma_corr, energy, l_verbose) ...@@ -387,9 +385,6 @@ SUBROUTINE calc_corr_k( sigma_corr, energy, l_verbose)
ikk = k_grid%ip(ikks) 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%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) l_gammaq = q_grid%l_pIsGamma(iq)
nbndval = nbnd_occ(ikks) nbndval = nbnd_occ(ikks)
! !
......
...@@ -53,7 +53,7 @@ SUBROUTINE calc_exx2( sigma_exx, nb1, nb2 ) ...@@ -53,7 +53,7 @@ SUBROUTINE calc_exx2( sigma_exx, nb1, nb2 )
! I/O ! I/O
! !
INTEGER, INTENT(IN) :: nb1, nb2 INTEGER, INTENT(IN) :: nb1, nb2
REAL(DP),INTENT(OUT) :: sigma_exx( nb1:nb2, nks) REAL(DP),INTENT(OUT) :: sigma_exx( nb1:nb2, k_grid%nps)
! !
! Workspace ! Workspace
! !
......
...@@ -42,13 +42,14 @@ SUBROUTINE calc_vxc( sigma_vxcl, sigma_vxcnl ) ...@@ -42,13 +42,14 @@ SUBROUTINE calc_vxc( sigma_vxcl, sigma_vxcnl )
USE funct, ONLY : dft_is_hybrid,get_exx_fraction USE funct, ONLY : dft_is_hybrid,get_exx_fraction
USE class_idistribute, ONLY : idistribute USE class_idistribute, ONLY : idistribute
USE exx, ONLY : vexx,exxalfa USE exx, ONLY : vexx,exxalfa
USE types_bz_grid, ONLY : k_grid
! !
IMPLICIT NONE IMPLICIT NONE
! !
! I/O ! I/O
! !
REAL(DP),INTENT(OUT) :: sigma_vxcl( qp_bandrange(1):qp_bandrange(2), nks ) REAL(DP),INTENT(OUT) :: sigma_vxcl( qp_bandrange(1):qp_bandrange(2), k_grid%nps )
REAL(DP),INTENT(OUT) :: sigma_vxcnl( qp_bandrange(1):qp_bandrange(2), nks ) REAL(DP),INTENT(OUT) :: sigma_vxcnl( qp_bandrange(1):qp_bandrange(2), k_grid%nps )
! !
! Workspace ! Workspace
! !
...@@ -84,12 +85,12 @@ SUBROUTINE calc_vxc( sigma_vxcl, sigma_vxcnl ) ...@@ -84,12 +85,12 @@ SUBROUTINE calc_vxc( sigma_vxcl, sigma_vxcnl )
! !
nnr = REAL( dfftp%nr1*dfftp%nr2*dfftp%nr3, KIND=DP ) nnr = REAL( dfftp%nr1*dfftp%nr2*dfftp%nr3, KIND=DP )
! !
barra_load = nks barra_load = k_grid%nps
CALL start_bar_type( barra, 'sigmavxc', barra_load ) CALL start_bar_type( barra, 'sigmavxc', barra_load )
! !
! LOOP ! LOOP
! !
DO iks = 1, nks ! KPOINT-SPIN DO iks = 1, k_grid%nps ! KPOINT-SPIN
! !
! ... Set k-point, spin, kinetic energy, needed by Hpsi ! ... Set k-point, spin, kinetic energy, needed by Hpsi
! !
...@@ -104,7 +105,7 @@ SUBROUTINE calc_vxc( sigma_vxcl, sigma_vxcnl ) ...@@ -104,7 +105,7 @@ SUBROUTINE calc_vxc( sigma_vxcl, sigma_vxcnl )
! !
! ... read in wavefunctions from the previous iteration ! ... read in wavefunctions from the previous iteration
! !
IF(nks>1) THEN IF(k_grid%nps>1) THEN
!iuwfc = 20 !iuwfc = 20
!lrwfc = nbnd * npwx * npol !lrwfc = nbnd * npwx * npol
!!CALL get_buffer( evc, nwordwfc, iunwfc, iks ) !!CALL get_buffer( evc, nwordwfc, iunwfc, iks )
......
...@@ -63,6 +63,7 @@ SUBROUTINE solve_gfreq_gamma(l_read_restart) ...@@ -63,6 +63,7 @@ SUBROUTINE solve_gfreq_gamma(l_read_restart)
USE wfreq_restart, ONLY : solvegfreq_restart_write,solvegfreq_restart_read,bks_type USE wfreq_restart, ONLY : solvegfreq_restart_write,solvegfreq_restart_read,bks_type
USE wfreq_io, ONLY : writeout_overlap,writeout_solvegfreq,preallocate_solvegfreq USE wfreq_io, ONLY : writeout_overlap,writeout_solvegfreq,preallocate_solvegfreq
USE types_coulomb, ONLY : pot3D USE types_coulomb, ONLY : pot3D
USE types_bz_grid, ONLY : k_grid
! !
IMPLICIT NONE IMPLICIT NONE
! !
...@@ -106,12 +107,12 @@ SUBROUTINE solve_gfreq_gamma(l_read_restart) ...@@ -106,12 +107,12 @@ SUBROUTINE solve_gfreq_gamma(l_read_restart)
bks%lastdone_band = 0 bks%lastdone_band = 0
bks%old_ks = 0 bks%old_ks = 0
bks%old_band = 0 bks%old_band = 0
bks%max_ks = nks bks%max_ks = k_grid%nps
bks%min_ks = 1 bks%min_ks = 1
ENDIF ENDIF
! !
barra_load = 0 barra_load = 0
DO iks = 1, nks DO iks = 1, k_grid%nps
IF(iks<bks%lastdone_ks) CYCLE IF(iks<bks%lastdone_ks) CYCLE
DO ib = qp_bandrange(1), qp_bandrange(2) DO ib = qp_bandrange(1), qp_bandrange(2)
IF(iks==bks%lastdone_ks .AND. ib <= bks%lastdone_band ) CYCLE IF(iks==bks%lastdone_ks .AND. ib <= bks%lastdone_band ) CYCLE
...@@ -128,7 +129,7 @@ SUBROUTINE solve_gfreq_gamma(l_read_restart) ...@@ -128,7 +129,7 @@ SUBROUTINE solve_gfreq_gamma(l_read_restart)
! !
! LOOP ! LOOP
! !
DO iks = 1, nks ! KPOINT-SPIN DO iks = 1, k_grid%nps ! KPOINT-SPIN
IF(iks<bks%lastdone_ks) CYCLE IF(iks<bks%lastdone_ks) CYCLE
! !
! ... Set k-point, spin, kinetic energy, needed by Hpsi ! ... Set k-point, spin, kinetic energy, needed by Hpsi
...@@ -144,7 +145,7 @@ SUBROUTINE solve_gfreq_gamma(l_read_restart) ...@@ -144,7 +145,7 @@ SUBROUTINE solve_gfreq_gamma(l_read_restart)
! !
! ... read in wavefunctions from the previous iteration ! ... read in wavefunctions from the previous iteration
! !
IF(nks>1) THEN IF(k_grid%nps>1) THEN
!iuwfc = 20 !iuwfc = 20
!lrwfc = nbnd * npwx * npol !lrwfc = nbnd * npwx * npol
!!CALL get_buffer( evc, nwordwfc, iunwfc, iks ) !!CALL get_buffer( evc, nwordwfc, iunwfc, iks )
...@@ -187,14 +188,7 @@ SUBROUTINE solve_gfreq_gamma(l_read_restart) ...@@ -187,14 +188,7 @@ SUBROUTINE solve_gfreq_gamma(l_read_restart)
! !
! PSIC ! PSIC
! !
! IF(gamma_only) THEN CALL single_invfft_gamma(dffts,npw,npwx,evc(1,ib),psic,'Wave')
CALL single_invfft_gamma(dffts,npw,npwx,evc(1,ib),psic,'Wave')
! ELSEIF(noncolin) THEN
! CALL SINGLEBAND_invfft_k(npw,evc(1 ,ib),npwx,psic_nc(1,1),dffts%nnr,.TRUE.)
! CALL SINGLEBAND_invfft_k(npw,evc(1+npwx,ib),npwx,psic_nc(1,2),dffts%nnr,.TRUE.)
! ELSE
! CALL SINGLEBAND_invfft_k(npw,evc(1,ib),npwx,psic,dffts%nnr,.TRUE.)
! ENDIF
! !
! ZEROS ! ZEROS
! !
...@@ -221,30 +215,11 @@ SUBROUTINE solve_gfreq_gamma(l_read_restart) ...@@ -221,30 +215,11 @@ SUBROUTINE solve_gfreq_gamma(l_read_restart)
ENDDO ENDDO
! !
! Bring it to R-space ! Bring it to R-space
! IF(gamma_only) THEN CALL single_invfft_gamma(dffts,npwq,npwqx,pertg(1),pertr,TRIM(fftdriver))
CALL single_invfft_gamma(dffts,npwq,npwqx,pertg(1),pertr,TRIM(fftdriver)) DO ir=1,dffts%nnr
DO ir=1,dffts%nnr pertr(ir)=psic(ir)*pertr(ir)
pertr(ir)=psic(ir)*pertr(ir) ENDDO
ENDDO CALL single_fwfft_gamma(dffts,npw,npwx,pertr,dvpsi(1,ip),'Wave')
CALL single_fwfft_gamma(dffts,npw,npwx,pertr,dvpsi(1,ip),'Wave')
! ELSEIF(noncolin) THEN
! CALL SINGLEBAND_invfft_k(npwq,pertg(1),npwx,pertr,dffts%nnr,.FALSE.)
! DO ir=1,dffts%nnr
! pertr(ir)=psic_nc(ir,1)*DCONJG(pertr(ir))
! ENDDO
! CALL SINGLEBAND_fwfft_k(npw,pertr,dffts%nnr,dvpsi(1,ip),npwx,.TRUE.)
! CALL SINGLEBAND_invfft_k(npwq,pertg(1),npwx,pertr,dffts%nnr,.FALSE.)
! DO ir=1,dffts%nnr
! pertr(ir)=psic_nc(ir,2)*DCONJG(pertr(ir))
! ENDDO
! CALL SINGLEBAND_fwfft_k(npw,pertr,dffts%nnr,dvpsi(1+npwx,ip),npwx,.TRUE.)
! ELSE
! CALL SINGLEBAND_invfft_k(npwq,pertg(1),npwx,pertr,dffts%nnr,.FALSE.)
! DO ir=1,dffts%nnr
! pertr(ir)=psic(ir)*DCONJG(pertr(ir))
! ENDDO
! CALL SINGLEBAND_fwfft_k(npw,pertr,dffts%nnr,dvpsi(1,ip),npwx,.TRUE.)
! ENDIF
! !
! !
ENDDO ! pert ENDDO ! pert
...@@ -451,8 +426,8 @@ SUBROUTINE solve_gfreq_k(l_read_restart) ...@@ -451,8 +426,8 @@ SUBROUTINE solve_gfreq_k(l_read_restart)
! !
! LOOP ! LOOP
! !
! outer k-point loop (matrix element): ikks, npwk, evck, psick ! ... Outer k-point loop (wfc matrix element): ikks, npwk, evck, psick
! inner k-point loop (sum over k'): iks, npw, evc (passed to h_psi) ! ... Inner k-point loop (wfc summed over k'): iks, npw, evc (passed to h_psi: current_k = iks)
! !
DO ikks = 1, k_grid%nps ! KPOINT-SPIN (MATRIX ELEMENT) DO ikks = 1, k_grid%nps ! KPOINT-SPIN (MATRIX ELEMENT)
IF(ikks<bksks%lastdone_ks) CYCLE IF(ikks<bksks%lastdone_ks) CYCLE
......
...@@ -51,8 +51,8 @@ SUBROUTINE solve_hf_gamma( ) ...@@ -51,8 +51,8 @@ SUBROUTINE solve_hf_gamma( )
USE west_io, ONLY : serial_table_output USE west_io, ONLY : serial_table_output
USE distribution_center, ONLY : pert USE distribution_center, ONLY : pert
USE funct, ONLY : get_exx_fraction,dft_is_hybrid USE funct, ONLY : get_exx_fraction,dft_is_hybrid
USE klist, ONLY : wk
USE wfreq_io, ONLY : writeout_solvehf USE wfreq_io, ONLY : writeout_solvehf
USE types_bz_grid, ONLY : k_grid
! !
IMPLICIT NONE IMPLICIT NONE
! !
...@@ -80,12 +80,12 @@ SUBROUTINE solve_hf_gamma( ) ...@@ -80,12 +80,12 @@ SUBROUTINE solve_hf_gamma( )
! !
sigma_hf(:,:) = sigma_exx(:,:) - sigma_vxcl(:,:) - sigma_vxcnl(:,:) sigma_hf(:,:) = sigma_exx(:,:) - sigma_vxcl(:,:) - sigma_vxcnl(:,:)
! !
CALL writeout_solvehf( sigma_hf(qp_bandrange(1),1), qp_bandrange(2)-qp_bandrange(1)+1, nks ) CALL writeout_solvehf( sigma_hf(qp_bandrange(1),1), qp_bandrange(2)-qp_bandrange(1)+1, k_grid%nps )
! !
! Output it per k-point ! Output it per k-point
! !
ALLOCATE(out_tab(qp_bandrange(2)-qp_bandrange(1)+1,6)) ALLOCATE(out_tab(qp_bandrange(2)-qp_bandrange(1)+1,6))
DO iks=1,nks DO iks=1,k_grid%nps
DO ib = qp_bandrange(1), qp_bandrange(2) DO ib = qp_bandrange(1), qp_bandrange(2)
out_tab( ib - qp_bandrange(1) + 1, 1) = REAL( ib, KIND=DP) out_tab( ib - qp_bandrange(1) + 1, 1) = REAL( ib, KIND=DP)
out_tab( ib - qp_bandrange(1) + 1, 2) = et(ib,iks) * rytoev out_tab( ib - qp_bandrange(1) + 1, 2) = et(ib,iks) * rytoev
...@@ -107,14 +107,14 @@ SUBROUTINE solve_hf_gamma( ) ...@@ -107,14 +107,14 @@ SUBROUTINE solve_hf_gamma( )
IF( l_enable_gwetot) THEN IF( l_enable_gwetot) THEN
! !
nbndval = MIN( MAXVAL( nbnd_occ(:) ), nbnd ) nbndval = MIN( MAXVAL( nbnd_occ(:) ), nbnd )