Skip to content

GitLab

Commit 8c9bdcef authored by Marco Govoni's avatar Marco Govoni
Browse files

Merge branch 'dfpt_band_parallel' into 'develop' 

Add distributed band parallelization to Wstat

See merge request west-devel/West!35
parents 6e13d0ca 9d17440e
Hide whitespace changes
Inline Side-by-side
.gitlab-ci.yml
View file @ 8c9bdcef
......@@ -54,7 +54,7 @@ stages:
- make conf PYT=python3 PYT_LDFLAGS="`python3-config --ldflags --embed`"
- make -j4 all
- cd test-suite
- make NP=$CI_NP NI=$CI_NI NT=$CI_NT
- make NP=$CI_NP NI=$CI_NI NB=$CI_NB NT=$CI_NT
artifacts:
when: on_failure
paths:
......@@ -83,6 +83,7 @@ gcc840_t:
variables:
CI_NP: 8
CI_NI: 1
CI_NB: 1
CI_NT: 1
extends:
- .template_bot_start
......@@ -92,7 +93,8 @@ gcc840_t:
gcc930_t:
variables:
CI_NP: 8
CI_NI: 1
CI_NI: 2
CI_NB: 2
CI_NT: 1
extends:
- .template_bot_start
......@@ -103,9 +105,10 @@ gcc930_t:
gcc840_t2:
variables:
CI_NP: 4
CI_NP: 8
CI_NI: 2
CI_NT: 1
CI_NB: 1
CI_NT: 2
only:
- schedules
extends:
......@@ -115,8 +118,9 @@ gcc840_t2:
gcc930_t2:
variables:
CI_NP: 2
CI_NI: 2
CI_NP: 8
CI_NI: 1
CI_NB: 2
CI_NT: 2
only:
- schedules
......
DFPT_kernel/Makefile
View file @ 8c9bdcef
......@@ -9,6 +9,7 @@ MODFLAGS= $(MOD_FLAG)../../iotk/src $(MOD_FLAG)../../Modules $(MOD_FLAG)../../LA
$(MOD_FLAG)../Tools \
$(MOD_FLAG)../FFT_kernel \
$(MOD_FLAG)../Coulomb_kernel \
$(MOD_FLAG)../Para_kernel \
$(MOD_FLAG).
IFLAGS=
......
DFPT_kernel/apply_sternheimerop_to_m_wfcs.f90
View file @ 8c9bdcef
!
! Copyright (C) 2015-2017 M. Govoni
! Copyright (C) 2015-2017 M. Govoni
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
......@@ -7,7 +7,7 @@
!
! This file is part of WEST.
!
! Contributors to this file:
! Contributors to this file:
! Marco Govoni
!
!-----------------------------------------------------------------------
......@@ -40,7 +40,7 @@ SUBROUTINE apply_sternheimerop_to_m_wfcs(nbndval, psi, hpsi, e, alpha, m)
! input: the vector
! output: the operator applied to the vector
!
! Workspace
! Workspace
!
INTEGER :: ibnd, ig
COMPLEX(DP) :: za
......@@ -50,11 +50,15 @@ SUBROUTINE apply_sternheimerop_to_m_wfcs(nbndval, psi, hpsi, e, alpha, m)
! compute the product of the hamiltonian with the h vector
!
hpsi=(0.0_DP,0.0_DP)
!
!
IF(l_kinetic_only) THEN
CALL k_psi( npwx, npw, m, psi, hpsi )
ELSE
CALL h_psi( npwx, npw, m, psi, hpsi )
!
! use h_psi_, i.e. h_psi without band parallelization, as wstat
! handles band parallelization separately in dfpt_module
!
CALL h_psi_( npwx, npw, m, psi, hpsi )
ENDIF
!
! then we compute the operator H-epsilon S
......@@ -74,4 +78,4 @@ SUBROUTINE apply_sternheimerop_to_m_wfcs(nbndval, psi, hpsi, e, alpha, m)
!
CALL stop_clock ('stern')
!
END SUBROUTINE
END SUBROUTINE
DFPT_kernel/dfpt_module.f90
View file @ 8c9bdcef
!
! Copyright (C) 2015-2017 M. Govoni
! Copyright (C) 2015-2017 M. Govoni
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
......@@ -7,7 +7,7 @@
!
! This file is part of WEST.
!
! Contributors to this file:
! Contributors to this file:
! Marco Govoni
!
!-----------------------------------------------------------------------
......@@ -23,31 +23,29 @@ MODULE dfpt_module
!-----------------------------------------------------------------------
!
USE kinds, ONLY : DP
USE constants, ONLY : tpi
USE io_global, ONLY : stdout
USE wvfct, ONLY : nbnd,g2kin,et
USE fft_base, ONLY : dfftp,dffts
USE gvect, ONLY : nl,nl,gstart,g,ngm
USE wvfct, ONLY : nbnd,et
USE fft_base, ONLY : dffts
USE gvect, ONLY : gstart
USE wavefunctions_module, ONLY : evc,psic
USE gvecw, ONLY : gcutw
USE mp, ONLY : mp_sum,mp_barrier,mp_bcast
USE mp_global, ONLY : inter_image_comm,inter_pool_comm,my_image_id
USE mp_global, ONLY : inter_image_comm,inter_pool_comm,my_image_id,inter_bgrp_comm
USE fft_at_k, ONLY : single_fwfft_k,single_invfft_k
USE fft_at_gamma, ONLY : single_fwfft_gamma,single_invfft_gamma,double_fwfft_gamma,double_invfft_gamma
USE fft_interfaces, ONLY : fwfft, invfft
USE buffers, ONLY : get_buffer
USE noncollin_module, ONLY : noncolin,npol
USE bar, ONLY : bar_type,start_bar_type,update_bar_type,stop_bar_type
USE pwcom, ONLY : current_spin,wk,nks,nelup,neldw,isk,xk,npw,npwx,lsda,nkstot,&
USE pwcom, ONLY : current_spin,nelup,neldw,isk,xk,npw,npwx,lsda,&
& current_k,ngk,igk_k
USE cell_base, ONLY : tpiba2,omega,at
USE control_flags, ONLY : gamma_only, io_level
USE io_files, ONLY : tmp_dir, nwordwfc, iunwfc, diropn
USE uspp, ONLY : nkb, vkb, okvan
USE cell_base, ONLY : omega
USE control_flags, ONLY : gamma_only
USE uspp, ONLY : nkb, vkb
USE westcom, ONLY : nbnd_occ,iuwfc,lrwfc,npwqx,npwq,igq_q,fftdriver
USE io_push, ONLY : io_push_title
USE mp_world, ONLY : mpime,world_comm
USE mp_world, ONLY : world_comm
USE types_bz_grid, ONLY : k_grid, q_grid, compute_phase
USE class_idistribute, ONLY : idistribute
USE distribution_center, ONLY : occband
!
IMPLICIT NONE
!
......@@ -61,14 +59,15 @@ MODULE dfpt_module
!
! Workspace
!
INTEGER :: ipert, ig, ir, ibnd, iks, ikqs, ikq, ik, is
INTEGER :: i, j, k
INTEGER :: ipert, ig, ir, ibnd, ibnd2, lbnd, iks, ikqs, ikq, ik, is
INTEGER :: nbndval, ierr
INTEGER :: npwkq
!
REAL(DP) :: g0(3)
REAL(DP) :: anorm
REAL(DP), ALLOCATABLE :: eprec(:)
REAL(DP), ALLOCATABLE :: eprec_loc(:)
REAL(DP), ALLOCATABLE :: et_loc(:)
!
COMPLEX(DP), ALLOCATABLE :: dvpsi(:,:),dpsi(:,:)
COMPLEX(DP), ALLOCATABLE :: aux_r(:),aux_g(:)
......@@ -79,8 +78,6 @@ MODULE dfpt_module
!
TYPE(bar_type) :: barra
!
LOGICAL :: conv_dfpt
LOGICAL :: exst,exst_mem
LOGICAL :: l_dost
!
CHARACTER(LEN=512) :: title
......@@ -98,6 +95,8 @@ MODULE dfpt_module
ENDIF
CALL io_push_title(TRIM(ADJUSTL(title)))
!
occband = idistribute()
!
dng=0.0_DP
!
CALL start_bar_type( barra, 'dfpt', MAX(m,1) * k_grid%nps )
......@@ -116,7 +115,7 @@ MODULE dfpt_module
!
current_k = iks
IF ( lsda ) current_spin = isk(iks)
CALL g2_kin(iks)
CALL g2_kin(iks)
!
! ... More stuff needed by the hamiltonian: nonlocal projectors
!
......@@ -124,6 +123,8 @@ MODULE dfpt_module
!
nbndval = nbnd_occ(iks)
!
CALL occband%init( nbndval, 'b', 'occband', .FALSE. )
!
! ... Number of G vectors for PW expansion of wfs at k
!
npw = ngk(iks)
......@@ -145,8 +146,8 @@ MODULE dfpt_module
! ... Find G0 and compute phase
!
!CALL k_grid%find( k_grid%p_cart(:,ik) - q_grid%p_cart(:,iq), is, 'cart', ikqs, g0 ) !M
CALL k_grid%find( k_grid%p_cart(:,ik) - q_grid%p_cart(:,iq), 'cart', ikq, g0 )
ikqs = k_grid%ipis2ips(ikq,is)
CALL k_grid%find( k_grid%p_cart(:,ik) - q_grid%p_cart(:,iq), 'cart', ikq, g0 )
ikqs = k_grid%ipis2ips(ikq,is)
!
CALL compute_phase( g0, 'cart', phase )
!
......@@ -163,24 +164,32 @@ MODULE dfpt_module
!
!
ALLOCATE(eprec(nbndval))
ALLOCATE(eprec_loc(occband%nloc))
ALLOCATE(et_loc(occband%nloc))
CALL set_eprec(nbndval,evc(1,1),eprec)
!
ALLOCATE(dvpsi(npwx*npol,nbndval))
ALLOCATE(dpsi(npwx*npol,nbndval))
DO lbnd = 1,occband%nloc
ibnd = occband%l2g(lbnd)
eprec_loc(lbnd) = eprec(ibnd)
et_loc(lbnd) = et(ibnd,ikqs)
ENDDO
!
ALLOCATE(dvpsi(npwx*npol,occband%nloc))
ALLOCATE(dpsi(npwx*npol,occband%nloc))
!
DO ipert = 1, m
!
ALLOCATE( aux_g(npwqx) ); aux_g = 0._DP
ALLOCATE( aux_r(dffts%nnr) ); aux_r = 0._DP
!
DO CONCURRENT (ig = 1:npwq)
aux_g(ig) = dvg(ig,ipert)
DO CONCURRENT (ig = 1:npwq)
aux_g(ig) = dvg(ig,ipert)
ENDDO
!
! ... inverse Fourier transform of the perturbation: (q+)G ---> R
!
IF (gamma_only) THEN
CALL single_invfft_gamma(dffts,npwq,npwqx,aux_g,aux_r,TRIM(fftdriver))
CALL single_invfft_gamma(dffts,npwq,npwqx,aux_g,aux_r,TRIM(fftdriver))
ELSE
CALL single_invfft_k(dffts,npwq,npwqx,aux_g,aux_r,'Wave',igq_q(1,iq))
ENDIF
......@@ -193,31 +202,38 @@ MODULE dfpt_module
IF(gamma_only) THEN
!
! double bands @ gamma
DO ibnd=1,nbndval-MOD(nbndval,2),2
DO lbnd = 1,occband%nloc-MOD(occband%nloc,2),2
!
ibnd = occband%l2g(lbnd)
ibnd2 = occband%l2g(lbnd+1)
!
CALL double_invfft_gamma(dffts,npw,npwx,evc(1,ibnd),evc(1,ibnd+1),psic,'Wave')
CALL double_invfft_gamma(dffts,npw,npwx,evc(1,ibnd),evc(1,ibnd2),psic,'Wave')
DO CONCURRENT (ir=1:dffts%nnr)
psic(ir) = psic(ir) * REAL(aux_r(ir),KIND=DP)
ENDDO
CALL double_fwfft_gamma(dffts,npw,npwx,psic,dvpsi(1,ibnd),dvpsi(1,ibnd+1),'Wave')
CALL double_fwfft_gamma(dffts,npw,npwx,psic,dvpsi(1,lbnd),dvpsi(1,lbnd+1),'Wave')
!
ENDDO
!
!
! single band @ gamma
IF( MOD(nbndval,2) == 1 ) THEN
ibnd=nbndval
IF( MOD(occband%nloc,2) == 1 ) THEN
!
lbnd = occband%nloc
ibnd = occband%l2g(lbnd)
!
CALL single_invfft_gamma(dffts,npw,npwx,evc(1,ibnd),psic,'Wave')
DO CONCURRENT (ir=1:dffts%nnr)
psic(ir) = CMPLX( REAL(psic(ir),KIND=DP) * REAL(aux_r(ir),KIND=DP), 0._DP, KIND=DP)
ENDDO
CALL single_fwfft_gamma(dffts,npw,npwx,psic,dvpsi(1,ibnd),'Wave')
CALL single_fwfft_gamma(dffts,npw,npwx,psic,dvpsi(1,lbnd),'Wave')
!
ENDIF
!
ELSE
!
DO ibnd = 1, nbndval
DO lbnd = 1,occband%nloc
!
ibnd = occband%l2g(lbnd)
!
! ... inverse Fourier transform of wfs at [k-q]: (k-q+)G ---> R
!
......@@ -233,14 +249,16 @@ MODULE dfpt_module
! Fourier transform product of wf at [k-q], phase and
! perturbation of wavevector q: R ---> (k+)G
!
CALL single_fwfft_k(dffts,npw,npwx,psic,dvpsi(1,ibnd),'Wave',igk_k(1,iks))
CALL single_fwfft_k(dffts,npw,npwx,psic,dvpsi(1,lbnd),'Wave',igk_k(1,iks))
!
! dv|psi> is in dvpsi
!
ENDDO
!
IF (noncolin) THEN
DO ibnd = 1, nbndval
DO lbnd = 1,occband%nloc
!
ibnd = occband%l2g(lbnd)
!
CALL single_invfft_k(dffts,npwkq,npwx,evckmq(npwx+1,ibnd),psic,'Wave',igk_k(1,ikqs))
!
......@@ -248,7 +266,7 @@ MODULE dfpt_module
psic(ir) = psic(ir) * phase(ir) * aux_r(ir)
ENDDO
!
CALL single_fwfft_k(dffts,npw,npwx,psic,dvpsi(npwx+1,ibnd),'Wave',igk_k(1,iks))
CALL single_fwfft_k(dffts,npw,npwx,psic,dvpsi(npwx+1,lbnd),'Wave',igk_k(1,iks))
!
ENDDO
ENDIF
......@@ -260,17 +278,17 @@ MODULE dfpt_module
!
! - P_c | dvpsi >
!
CALL apply_alpha_pc_to_m_wfcs( nbndval, nbndval, dvpsi, (-1._DP,0._DP) )
CALL apply_alpha_pc_to_m_wfcs( nbndval, occband%nloc, dvpsi, (-1._DP,0._DP) )
!
CALL precondition_m_wfcts( nbndval, dvpsi, dpsi, eprec )
CALL precondition_m_wfcts( occband%nloc, dvpsi, dpsi, eprec_loc )
!
IF( l_dost) THEN
!
!
! The Sternheimer operator is (H_k - E_(k-q) + alpha * P_v)
! The Hamiltonian is evaluated at the k-point current_k in h_psi
! (see also PHonon/PH/cch_psi_all.f90, where H_(k+q) is evaluated)
!
CALL linsolve_sternheimer_m_wfcts (nbndval, nbndval, dvpsi, dpsi, et(1,ikqs), eprec, tr2, ierr )
CALL linsolve_sternheimer_m_wfcts (nbndval, occband%nloc, dvpsi, dpsi, et_loc, eprec_loc, tr2, ierr )
!
IF(ierr/=0) THEN
WRITE(stdout, '(7X,"** WARNING : PERT ",i8," iks ",I8," not converged, ierr = ",i8)') ipert,iks,ierr
......@@ -285,9 +303,11 @@ MODULE dfpt_module
IF(gamma_only) THEN
!
! double band @ gamma
DO ibnd=1,nbndval
DO lbnd = 1,occband%nloc
!
ibnd = occband%l2g(lbnd)
!
CALL double_invfft_gamma(dffts,npw,npwx,evc(1,ibnd),dpsi(1,ibnd),psic,'Wave')
CALL double_invfft_gamma(dffts,npw,npwx,evc(1,ibnd),dpsi(1,lbnd),psic,'Wave')
DO CONCURRENT (ir=1:dffts%nnr)
aux_r(ir) = aux_r(ir) + CMPLX( REAL( psic(ir),KIND=DP) * DIMAG( psic(ir)) , 0.0_DP, KIND=DP)
ENDDO
......@@ -298,7 +318,9 @@ MODULE dfpt_module
!
ALLOCATE( dpsic(dffts%nnr) )
!
DO ibnd = 1, nbndval
DO lbnd = 1,occband%nloc
!
ibnd = occband%l2g(lbnd)
!
! inverse Fourier transform of wavefunction at [k-q]: (k-q+)G ---> R
!
......@@ -306,20 +328,22 @@ MODULE dfpt_module
!
! inverse Fourier transform of perturbed wavefunction: (k+)G ---> R
!
CALL single_invfft_k(dffts,npw,npwx,dpsi(1,ibnd),dpsic,'Wave',igk_k(1,iks))
CALL single_invfft_k(dffts,npw,npwx,dpsi(1,lbnd),dpsic,'Wave',igk_k(1,iks))
!
DO CONCURRENT (ir = 1: dffts%nnr)
DO CONCURRENT (ir = 1: dffts%nnr)
aux_r(ir) = aux_r(ir) + CONJG( psic(ir) * phase(ir) ) * dpsic(ir)
ENDDO
!
ENDDO
!
IF (noncolin) THEN
DO ibnd = 1, nbndval
DO lbnd = 1,occband%nloc
!
ibnd = occband%l2g(lbnd)
!
CALL single_invfft_k(dffts,npwkq,npwx,evckmq(npwx+1,ibnd),psic,'Wave',igk_k(1,ikqs))
!
CALL single_invfft_k(dffts,npw,npwx,dpsi(npwx+1,ibnd),dpsic,'Wave',igk_k(1,iks))
CALL single_invfft_k(dffts,npw,npwx,dpsi(npwx+1,lbnd),dpsic,'Wave',igk_k(1,iks))
!
DO CONCURRENT (ir = 1: dffts%nnr)
aux_r(ir) = aux_r(ir) + CONJG( psic(ir) * phase(ir) ) * dpsic(ir)
......@@ -332,10 +356,14 @@ MODULE dfpt_module
!
ENDIF
!
! Sum up aux_r from band groups
!
CALL mp_sum(aux_r,inter_bgrp_comm)
!
! The perturbation is in aux_r
!
ALLOCATE( aux_g(npwqx) )
!
!
IF(gamma_only) THEN
CALL single_fwfft_gamma(dffts,npwq,npwqx,aux_r,aux_g,TRIM(fftdriver))
ELSE
......@@ -349,13 +377,15 @@ MODULE dfpt_module
DEALLOCATE( aux_g )
DEALLOCATE( aux_r )
!
CALL update_bar_type( barra, 'dfpt', 1 )
CALL update_bar_type( barra, 'dfpt', 1 )
!
ENDDO ! ipert
!
IF( m == 0 ) CALL update_bar_type( barra, 'dfpt', 1 )
!
DEALLOCATE( eprec )
DEALLOCATE( eprec_loc )
DEALLOCATE( et_loc )
DEALLOCATE( dpsi )
DEALLOCATE( dvpsi )
!
......@@ -363,7 +393,7 @@ MODULE dfpt_module
!
IF ( gamma_only ) THEN
IF ( gstart == 2 ) dng(1,1:m) = CMPLX( 0._DP, 0._DP, KIND=DP )
ELSE
ELSE
IF ( gstart == 2 .AND. q_grid%l_pIsGamma(iq) ) dng(1,1:m) = CMPLX( 0._DP, 0._DP, KIND=DP )
DEALLOCATE( evckmq )
DEALLOCATE( phase )
......@@ -376,7 +406,7 @@ MODULE dfpt_module
CALL stop_bar_type( barra, 'dfpt' )
!
END SUBROUTINE
!
!
END MODULE
!!-----------------------------------------------------------------------
!SUBROUTINE dfpt (m,dvg,dng,tr2)
......@@ -422,7 +452,7 @@ END MODULE
! INTEGER :: ipert, ig, ir, ibnd, iks
! INTEGER :: nbndval, ierr
! !
! REAL(DP) :: anorm, prod
! REAL(DP) :: anorm, prod
! REAL(DP),ALLOCATABLE :: eprec(:)
! !
! COMPLEX(DP),ALLOCATABLE :: dvpsi(:,:),dpsi(:,:)
......@@ -441,10 +471,10 @@ END MODULE
! !
! CALL report_dynamical_memory()
! !
! l_dost = ( tr2 >= 0._DP )
! l_dost = ( tr2 >= 0._DP )
! !
! IF( l_dost ) THEN
! WRITE(title,'(a,es14.6)') "Sternheimer eq. solver... with threshold = ", tr2
! IF( l_dost ) THEN
! WRITE(title,'(a,es14.6)') "Sternheimer eq. solver... with threshold = ", tr2
! ELSE
! WRITE(title,'(a,es14.6)') "Sternheimer eq. solver... with lite-solver"
! ENDIF
......@@ -452,8 +482,8 @@ END MODULE
! !
! dng=0.0_DP
! !
! CALL start_bar_type( barra, 'dfpt', MAX(m,1) * nks )
! !IF(nks>1) CALL diropn(iuwfc,'wfc',lrwfc,exst)
! CALL start_bar_type( barra, 'dfpt', MAX(m,1) * nks )
! !IF(nks>1) CALL diropn(iuwfc,'wfc',lrwfc,exst)
! !
! DO iks = 1, nks ! KPOINT-SPIN LOOP
! !
......@@ -472,7 +502,7 @@ END MODULE
! !
! IF(nks>1) THEN
! !iuwfc = 20
! !lrwfc = nbnd * npwx * npol
! !lrwfc = nbnd * npwx * npol
! !!CALL get_buffer( evc, nwordwfc, iunwfc, iks )
! IF(my_image_id==0) CALL get_buffer( evc, lrwfc, iuwfc, iks )
! !CALL mp_bcast(evc,0,inter_image_comm)
......@@ -505,7 +535,7 @@ END MODULE
! ALLOCATE(eprec(nbndval))
! CALL set_eprec(nbndval,evc(1,1),eprec)
! !
! ALLOCATE(dvpsi(npwx*npol,nbndval))
! ALLOCATE(dvpsi(npwx*npol,nbndval))
! ALLOCATE(dpsi(npwx*npol,nbndval))
! !
! DO ipert = 1, m
......@@ -517,7 +547,7 @@ END MODULE
! aux_r = 0._DP
! !
! DO ig = 1, npwq ! perturbation acts only on body
! aux_g(ig) = dvg(ig,ipert) * pot3D%sqvc(ig)
! aux_g(ig) = dvg(ig,ipert) * pot3D%sqvc(ig)
! ENDDO
! !
! IF(gamma_only) THEN
......@@ -543,7 +573,7 @@ END MODULE
! CALL double_fwfft_gamma(dffts,npw,npwx,psic,dvpsi(1,ibnd),dvpsi(1,ibnd+1),'Wave')
! !
! ENDDO
! !
! !
! ! single band @ gamma
! IF( MOD(nbndval,2) == 1 ) THEN
! ibnd=nbndval
......@@ -552,7 +582,7 @@ END MODULE
! DO ir=1,dffts%nnr
! psic(ir) = CMPLX( REAL(psic(ir),KIND=DP) * REAL(aux_r(ir),KIND=DP), 0._DP, KIND=DP)
! ENDDO
! CALL single_fwfft_gamma(dffts,npw,npwx,psic,dvpsi(1,ibnd),'Wave')
! CALL single_fwfft_gamma(dffts,npw,npwx,psic,dvpsi(1,ibnd),'Wave')
! !
! ENDIF
! !
......@@ -565,7 +595,7 @@ END MODULE
! DO ir=1,dffts%nnr
! psic(ir) = psic(ir) * aux_r(ir)
! ENDDO
! CALL single_fwfft_k(dffts,npw,npwx,psic,dvpsi(1,ibnd),'Wave',igk_k(1,current_k))
! CALL single_fwfft_k(dffts,npw,npwx,psic,dvpsi(1,ibnd),'Wave',igk_k(1,current_k))
! !
! ENDDO
! !
......@@ -576,25 +606,25 @@ END MODULE
! DO ir=1,dffts%nnr
! psic(ir) = psic(ir) * aux_r(ir)
! ENDDO
! CALL single_fwfft_k(dffts,npw,npwx,psic,dvpsi(npwx+1,ibnd),'Wave',igk_k(1,current_k))
! CALL single_fwfft_k(dffts,npw,npwx,psic,dvpsi(npwx+1,ibnd),'Wave',igk_k(1,current_k))
! !
! ENDDO
! ENDIF
! !
! ENDIF
! ENDIF
! !
! DEALLOCATE(aux_g)
! DEALLOCATE(aux_r)
! !
! CALL apply_alpha_pc_to_m_wfcs(nbndval,nbndval,dvpsi,(-1._DP,0._DP))
! !
! CALL precondition_m_wfcts( nbndval, dvpsi, dpsi, eprec )
! CALL precondition_m_wfcts( nbndval, dvpsi, dpsi, eprec )
! !
! IF( l_dost) THEN
! !
! CALL linsolve_sternheimer_m_wfcts (nbndval, nbndval, dvpsi, dpsi, et(1,iks), eprec, tr2, ierr )
! !
! IF(ierr/=0) THEN
! CALL linsolve_sternheimer_m_wfcts (nbndval, nbndval, dvpsi, dpsi, et(1,iks), eprec, tr2, ierr )
! !
! IF(ierr/=0) THEN
! WRITE(stdout, '(7X,"** WARNING : PERT ",i8," not converged, ierr = ",i8)') ipert,ierr
! ENDIF
! !
......@@ -603,7 +633,7 @@ END MODULE
! ALLOCATE(aux_r(dffts%nnr))
! !
! aux_r=0._DP
! !
! !
! IF(gamma_only) THEN
! !
! ! double band @ gamma
......@@ -611,7 +641,7 @@ END MODULE
! !
! CALL double_invfft_gamma(dffts,npw,npwx,evc(1,ibnd),dpsi(1,ibnd),psic,'Wave')
! DO ir=1,dffts%nnr
! prod = REAL( psic(ir),KIND=DP) * DIMAG( psic(ir))
! prod = REAL( psic(ir),KIND=DP) * DIMAG( psic(ir))
! aux_r(ir) = aux_r(ir) + CMPLX( prod, 0.0_DP, KIND=DP)
! ENDDO
! !
......@@ -622,22 +652,22 @@ END MODULE
! ALLOCATE(dpsic(dffts%nnr))
! !
! ! only single bands
! DO ibnd=1,nbndval
! DO ibnd=1,nbndval
! !
! CALL single_invfft_k(dffts,npw,npwx,evc(1,ibnd),psic,'Wave',igk_k(1,current_k))
! CALL single_invfft_k(dffts,npw,npwx,dpsi(1,ibnd),dpsic,'Wave',igk_k(1,current_k))
! DO ir=1,dffts%nnr
! DO ir=1,dffts%nnr
! aux_r(ir) = aux_r(ir) + DCONJG(psic(ir))*dpsic(ir)
! ENDDO
! !
! ENDDO
! !
! IF(npol==2) THEN
! DO ibnd=1,nbndval
! DO ibnd=1,nbndval