Commit fe7831ec authored by dalcorso's avatar dalcorso

Task groups are now used in some parts of the phonon code.


git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@9806 c92efa57-630b-4861-b058-cf58834340f0
parent 32e9e8e3
......@@ -5,7 +5,7 @@
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
SUBROUTINE apply_dpot(nrxxs, aux1, dvscfins, current_spin)
SUBROUTINE apply_dpot(nrxxs, aux1, dv, current_spin)
!
! This routine applies the change of the self consistent potential to
! one wavefunction
......@@ -13,34 +13,72 @@ SUBROUTINE apply_dpot(nrxxs, aux1, dvscfins, current_spin)
USE kinds, ONLY : DP
USE noncollin_module, ONLY : noncolin, npol, nspin_mag
USE spin_orb, ONLY : domag
USE mp_global, ONLY : me_bgrp
USE fft_base, ONLY : dffts
IMPLICIT NONE
INTEGER, INTENT(IN) :: current_spin, nrxxs
COMPLEX(DP), INTENT(IN) :: dvscfins(nrxxs,nspin_mag)
COMPLEX(DP), INTENT(IN) :: dv(nrxxs,nspin_mag)
COMPLEX(DP), INTENT(INOUT) :: aux1(nrxxs,npol)
COMPLEX(DP) :: sup, sdwn
INTEGER :: ir
IF (noncolin) THEN
IF (domag) then
DO ir = 1, nrxxs
sup=aux1(ir,1)*(dvscfins(ir,1)+dvscfins(ir,4))+ &
aux1(ir,2)*(dvscfins(ir,2)-(0.d0,1.d0)*dvscfins(ir,3))
sdwn=aux1(ir,2)*(dvscfins(ir,1)-dvscfins(ir,4)) + &
aux1(ir,1)*(dvscfins(ir,2)+(0.d0,1.d0)*dvscfins(ir,3))
aux1(ir,1)=sup
aux1(ir,2)=sdwn
!
! Noncollinear part with task groups
!
IF( dffts%have_task_groups ) THEN
IF (domag) THEN
DO ir=1, dffts%nr1x*dffts%nr2x*dffts%tg_npp( me_bgrp + 1 )
sup = aux1(ir,1) * (dv(ir,1)+dv(ir,4)) + &
aux1(ir,2) * (dv(ir,2)-(0.d0,1.d0)*dv(ir,3))
sdwn = aux1(ir,2) * (dv(ir,1)-dv(ir,4)) + &
aux1(ir,1) * (dv(ir,2)+(0.d0,1.d0)*dv(ir,3))
aux1(ir,1)=sup
aux1(ir,2)=sdwn
ENDDO
ELSE
DO ir=1, dffts%nr1x*dffts%nr2x*dffts%tg_npp( me_bgrp + 1 )
aux1(ir,:) = aux1(ir,:) * dv(ir,1)
ENDDO
ENDIF
ELSE
!
! Noncollinear part without TG
!
IF (domag) then
DO ir = 1, nrxxs
sup=aux1(ir,1)*(dv(ir,1)+dv(ir,4))+ &
aux1(ir,2)*(dv(ir,2)-(0.d0,1.d0)*dv(ir,3))
sdwn=aux1(ir,2)*(dv(ir,1)-dv(ir,4)) + &
aux1(ir,1)*(dv(ir,2)+(0.d0,1.d0)*dv(ir,3))
aux1(ir,1)=sup
aux1(ir,2)=sdwn
ENDDO
ELSE
DO ir = 1, nrxxs
aux1(ir,:)=aux1(ir,:)*dv(ir,1)
ENDDO
ENDIF
ENDIF
ELSE
!
! collinear part with Task Groups
!
IF( dffts%have_task_groups ) THEN
!
DO ir = 1, dffts%nr1x*dffts%nr2x*dffts%tg_npp( me_bgrp + 1 )
aux1 (ir,1) = aux1 (ir,1) * dv(ir,1)
ENDDO
ELSE
!
! collinear part with Task Groups
!
DO ir = 1, nrxxs
aux1(ir,:)=aux1(ir,:)*dvscfins(ir,1)
aux1(ir,1)=aux1(ir,1)*dv(ir,current_spin)
ENDDO
ENDIF
ELSE
DO ir = 1, nrxxs
aux1(ir,1)=aux1(ir,1)*dvscfins(ir,current_spin)
ENDDO
ENDIF
RETURN
......
......@@ -4,7 +4,6 @@
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
!-----------------------------------------------------------------------
subroutine cft_wave (evc_g, evc_r, isw)
!-----------------------------------------------------------------------
......@@ -64,3 +63,97 @@ subroutine cft_wave (evc_g, evc_r, isw)
return
end subroutine cft_wave
!
!-----------------------------------------------------------------------
subroutine cft_wave_tg (evc_g, evc_r, isw, v_size, ibnd, nbnd_occ)
!-----------------------------------------------------------------------
!
! Fourier-transformation of a wavefunction using the task group
! features
! evc_g(npwx): the wavefunction in G space
! evc_r(nrxxs): the wavefunction in R space ("smooth" grid)
! isw =+1: input: evc_g
! output: evc_f = Fourier(evc_g)
! evc_g is transformed according to igk-indexes
! evc_r is set to zero at the beginning
! isw =-1: input: evc_r
! output: evc_g = evc_g + Fourier-1(evc_r)
! evc_r is transformed according to igkq indexes
!
USE kinds, ONLY : DP
USE wvfct, ONLY : npwx, npw, igk
USE fft_base, ONLY: dffts
USE fft_interfaces, ONLY: fwfft, invfft
USE gvecs, ONLY : nls
USE mp_global, ONLY : me_bgrp
use noncollin_module, ONLY : noncolin, npol
use qpoint, ONLY : npwq, igkq
implicit none
integer, intent(in) :: v_size
integer, intent(in) :: isw, ibnd, nbnd_occ
complex(DP), intent(inout) :: evc_g(npwx*npol,nbnd_occ), evc_r(v_size,npol)
integer :: ig, ioff, idx
if (isw.eq.1) then
evc_r = (0.d0, 0.d0)
!
ioff = 0
!
DO idx = 1, dffts%nogrp
!
IF( idx + ibnd - 1 <= nbnd_occ ) THEN
DO ig = 1, npw
evc_r(nls (igk(ig))+ioff,1) = evc_g(ig,idx+ibnd-1)
ENDDO
IF (noncolin) THEN
DO ig = 1, npw
evc_r(nls (igk(ig))+ioff,2) = evc_g(npwx+ig,idx+ibnd-1)
ENDDO
ENDIF
ENDIF
!
ioff = ioff + dffts%tg_nnr
!
ENDDO
CALL invfft ('Wave', evc_r(:,1), dffts)
IF (noncolin) CALL invfft ('Wave', evc_r(:,2), dffts)
else if(isw.eq.-1) then
CALL fwfft ('Wave', evc_r(:,1), dffts)
IF (noncolin) CALL fwfft ('Wave', evc_r(:,2), dffts)
!
ioff = 0
!
DO idx = 1, dffts%nogrp
!
IF( idx + ibnd - 1 <= nbnd_occ ) THEN
!
DO ig = 1, npwq
evc_g(ig, ibnd+idx-1) = evc_g(ig, ibnd+idx-1) + &
evc_r( nls(igkq(ig)) + ioff, 1 )
ENDDO
!
IF (noncolin) THEN
DO ig = 1, npwq
evc_g (ig+npwx, ibnd+idx-1) = evc_g (ig+npwx, ibnd+idx-1) &
+ evc_r (nls(igkq(ig))+ ioff,2)
ENDDO
ENDIF
!
ENDIF
!
ioff = ioff + dffts%nr3x * dffts%nsw( me_bgrp + 1 )
!
ENDDO
else
call errore (' cft_wave_tg',' Wrong switch',1)
endif
return
end subroutine cft_wave_tg
......@@ -21,13 +21,16 @@ SUBROUTINE ch_psi_all (n, h, ah, e, ik, m)
USE wvfct, ONLY : npwx, nbnd
USE becmod, ONLY : bec_type, becp, calbec
USE uspp, ONLY : nkb, vkb
USE fft_base, ONLY : dffts
USE wvfct, ONLY : npwx, igk
USE qpoint, ONLY : igkq
USE noncollin_module, ONLY : noncolin, npol
USE control_ph, ONLY : alpha_pv, nbnd_occ
USE control_ph, ONLY : alpha_pv, nbnd_occ, lgamma
USE eqv, ONLY : evq
USE qpoint, ONLY : ikqs
USE mp_global, ONLY : intra_bgrp_comm
USE mp_global, ONLY : intra_bgrp_comm, get_ntask_groups
USE mp, ONLY : mp_sum
!Needed only for TDDFPT
......@@ -60,8 +63,14 @@ SUBROUTINE ch_psi_all (n, h, ah, e, ik, m)
! scalar products
! the product of the Hamiltonian and h
! the product of the S matrix and h
INTEGER, ALLOCATABLE :: ibuf(:)
CALL start_clock ('ch_psi')
!
! This routine is task groups aware
!
IF (get_ntask_groups() > 1) dffts%have_task_groups=.TRUE.
ALLOCATE (ps ( nbnd , m))
ALLOCATE (hpsi( npwx*npol , m))
ALLOCATE (spsi( npwx*npol , m))
......@@ -70,7 +79,25 @@ SUBROUTINE ch_psi_all (n, h, ah, e, ik, m)
!
! compute the product of the hamiltonian with the h vector
!
CALL h_psiq (npwx, n, m, h, hpsi, spsi)
IF (dffts%have_task_groups) THEN
!
! With task groups we use the Hpsi routine of PW parallelized
! on task groups
!
IF (.NOT.lgamma) THEN
ALLOCATE(ibuf(npwx))
ibuf=igk
igk=igkq
ENDIF
CALL h_psi (npwx, n, m, h, hpsi)
CALL s_psi (npwx, n, m, h, spsi)
IF (.NOT.lgamma) THEN
igk=ibuf
DEALLOCATE(ibuf)
ENDIF
ELSE
CALL h_psiq (npwx, n, m, h, hpsi, spsi)
ENDIF
CALL start_clock ('last')
!
......@@ -113,6 +140,7 @@ SUBROUTINE ch_psi_all (n, h, ah, e, ik, m)
DEALLOCATE (ps)
IF (tddfpt) NULLIFY(evq)
dffts%have_task_groups=.FALSE.
CALL stop_clock ('last')
CALL stop_clock ('ch_psi')
......
......@@ -64,8 +64,11 @@ subroutine dvqpsi_us (ik, uact, addnlcc)
complex(DP) , allocatable :: aux1 (:), aux2 (:)
complex(DP) , pointer :: auxs (:)
! work space
logical :: htg
call start_clock ('dvqpsi_us')
htg = dffts%have_task_groups
dffts%have_task_groups=.FALSE.
if (nlcc_any.and.addnlcc) then
allocate (aux( dfftp%nnr))
if (doublegrid) then
......@@ -203,6 +206,7 @@ subroutine dvqpsi_us (ik, uact, addnlcc)
!
call dvqpsi_us_only (ik, uact)
dffts%have_task_groups=htg
call stop_clock ('dvqpsi_us')
return
end subroutine dvqpsi_us
......@@ -25,6 +25,9 @@ subroutine incdrhoscf (drhoscf, weight, ik, dbecsum, dpsi)
USE wavefunctions_module, ONLY: evc
USE qpoint, ONLY : npwq, igkq, ikks
USE control_ph, ONLY : nbnd_occ
USE mp_global, ONLY : me_bgrp, inter_bgrp_comm, get_ntask_groups
USE mp, ONLY : mp_sum
implicit none
! I/O variables
......@@ -46,42 +49,119 @@ subroutine incdrhoscf (drhoscf, weight, ik, dbecsum, dpsi)
complex(DP), allocatable :: psi (:), dpsic (:)
! the wavefunctions in real space
! the change of wavefunctions in real space
complex(DP), allocatable :: tg_psi(:), tg_dpsi(:), tg_drho(:)
integer :: ibnd, ikk, ir, ig
integer :: ibnd, ikk, ir, ig, incr, v_siz, idx, ioff
! counters
call start_clock ('incdrhoscf')
IF (get_ntask_groups() > 1) dffts%have_task_groups=.TRUE.
allocate (dpsic( dffts%nnr))
allocate (psi ( dffts%nnr))
wgt = 2.d0 * weight / omega
ikk = ikks(ik)
incr=1
!
IF (dffts%have_task_groups) THEN
!
v_siz = dffts%tg_nnr * dffts%nogrp
!
ALLOCATE( tg_psi( v_siz ) )
ALLOCATE( tg_dpsi( v_siz ) )
ALLOCATE( tg_drho( v_siz ) )
!
incr = dffts%nogrp
!
ENDIF
!
! dpsi contains the perturbed wavefunctions of this k point
! evc contains the unperturbed wavefunctions of this k point
!
do ibnd = 1, nbnd_occ (ikk)
psi (:) = (0.d0, 0.d0)
do ig = 1, npw
psi (nls (igk (ig) ) ) = evc (ig, ibnd)
enddo
do ibnd = 1, nbnd_occ(ikk), incr
!
IF (dffts%have_task_groups) THEN
!
tg_drho=(0.0_DP, 0.0_DP)
tg_psi=(0.0_DP, 0.0_DP)
tg_dpsi=(0.0_DP, 0.0_DP)
!
ioff = 0
!
DO idx = 1, dffts%nogrp
!
! ... dffts%nogrp ffts at the same time. We prepare both
! evc (at k) and dpsi (at k+q)
!
IF( idx + ibnd - 1 <= nbnd_occ(ikk) ) THEN
!
DO ig = 1, npw
tg_psi( nls( igk( ig ) ) + ioff ) = evc( ig, idx+ibnd-1 )
END DO
DO ig = 1, npwq
tg_dpsi( nls( igkq( ig ) ) + ioff ) = dpsi( ig, idx+ibnd-1 )
END DO
!
END IF
!
ioff = ioff + dffts%tg_nnr
!
END DO
CALL invfft ('Wave', tg_psi, dffts)
CALL invfft ('Wave', tg_dpsi, dffts)
CALL invfft ('Wave', psi, dffts)
do ir = 1, dffts%tg_npp( me_bgrp + 1 ) * dffts%nr1x * dffts%nr2x
tg_drho (ir) = tg_drho (ir) + wgt * CONJG(tg_psi (ir) ) * &
tg_dpsi (ir)
enddo
!
! reduce the group charge (equivalent to sum over bands of
! orbital group)
!
CALL mp_sum( tg_drho, gid = dffts%ogrp_comm )
!
ioff = 0
DO idx = 1, dffts%nogrp
IF( me_bgrp == dffts%nolist( idx ) ) EXIT
ioff = ioff + dffts%nr1x * dffts%nr2x * &
dffts%npp( dffts%nolist( idx ) + 1 )
END DO
!
! copy the charge back to the proper processor location
!
DO ir = 1, dffts%nnr
drhoscf(ir) = drhoscf(ir) + tg_drho(ir+ioff)
END DO
ELSE
psi (:) = (0.d0, 0.d0)
do ig = 1, npw
psi (nls (igk (ig) ) ) = evc (ig, ibnd)
enddo
dpsic(:) = (0.d0, 0.d0)
do ig = 1, npwq
dpsic (nls (igkq (ig) ) ) = dpsi (ig, ibnd)
enddo
CALL invfft ('Wave', psi, dffts)
CALL invfft ('Wave', dpsic, dffts)
do ir = 1, dffts%nnr
drhoscf (ir) = drhoscf (ir) + wgt * CONJG(psi (ir) ) * dpsic (ir)
enddo
enddo
dpsic(:) = (0.d0, 0.d0)
do ig = 1, npwq
dpsic (nls (igkq (ig) ) ) = dpsi (ig, ibnd)
enddo
CALL invfft ('Wave', dpsic, dffts)
do ir = 1, dffts%nnr
drhoscf (ir) = drhoscf (ir) + wgt * CONJG(psi (ir) ) * dpsic (ir)
enddo
ENDIF
enddo
call addusdbec (ik, weight, dpsi, dbecsum)
deallocate (psi)
deallocate (dpsic)
IF (dffts%have_task_groups) THEN
DEALLOCATE(tg_psi)
DEALLOCATE(tg_dpsi)
DEALLOCATE(tg_drho)
ENDIF
dffts%have_task_groups=.FALSE.
call stop_clock ('incdrhoscf')
return
......
......@@ -28,6 +28,8 @@ subroutine incdrhoscf_nc (drhoscf, weight, ik, dbecsum, dpsi)
USE wavefunctions_module, ONLY: evc
USE qpoint, ONLY : npwq, igkq, ikks
USE control_ph, ONLY : nbnd_occ
USE mp_global, ONLY : me_bgrp, inter_bgrp_comm, get_ntask_groups
USE mp, ONLY : mp_sum
implicit none
......@@ -38,7 +40,7 @@ subroutine incdrhoscf_nc (drhoscf, weight, ik, dbecsum, dpsi)
! input: the weight of the k point
COMPLEX(DP), INTENT(IN) :: dpsi(npwx*npol,nbnd)
! input: the perturbed wfcs at the given k point
COMPLEX(DP), INTENT(INOUT) :: drhoscf (dfftp%nnr,nspin_mag), dbecsum (nhm,nhm,nat,nspin)
COMPLEX(DP), INTENT(INOUT) :: drhoscf (dffts%nnr,nspin_mag), dbecsum (nhm,nhm,nat,nspin)
! input/output: the accumulated change of the charge density and dbecsum
!
!
......@@ -52,57 +54,155 @@ subroutine incdrhoscf_nc (drhoscf, weight, ik, dbecsum, dpsi)
! the wavefunctions in real space
! the change of wavefunctions in real space
integer :: ibnd, jbnd, ikk, ir, ig
complex(DP), allocatable :: tg_psi (:,:), tg_dpsi (:,:), tg_drho(:,:), &
aux(:,:)
integer :: ibnd, jbnd, ikk, ir, ig, incr, v_siz, idx, ioff, ipol
! counters
call start_clock ('incdrhoscf')
IF (get_ntask_groups() > 1 ) dffts%have_task_groups=.TRUE.
allocate (dpsic(dffts%nnr, npol))
allocate (psi (dffts%nnr, npol))
allocate (aux(dfftp%nnr,nspin_mag))
wgt = 2.d0 * weight / omega
ikk = ikks(ik)
incr = 1
!
IF (dffts%have_task_groups) THEN
!
v_siz = dffts%tg_nnr * dffts%nogrp
!
ALLOCATE( tg_psi( v_siz, npol ) )
ALLOCATE( tg_dpsi( v_siz, npol ) )
ALLOCATE( tg_drho( v_siz, nspin_mag ) )
!
incr = dffts%nogrp
!
ENDIF
!
! dpsi contains the perturbed wavefunctions of this k point
! evc contains the unperturbed wavefunctions of this k point
!
do ibnd = 1, nbnd_occ (ikk)
psi = (0.d0, 0.d0)
do ig = 1, npw
psi (nls (igk (ig) ), 1) = evc (ig, ibnd)
psi (nls (igk (ig) ), 2) = evc (ig+npwx, ibnd)
enddo
CALL invfft ('Wave', psi(:,1), dffts)
CALL invfft ('Wave', psi(:,2), dffts)
do ibnd = 1, nbnd_occ(ikk), incr
IF (dffts%have_task_groups) THEN
!
tg_drho=(0.0_DP, 0.0_DP)
tg_psi=(0.0_DP, 0.0_DP)
tg_dpsi=(0.0_DP, 0.0_DP)
!
ioff = 0
!
DO idx = 1, dffts%nogrp
!
! ... dffts%nogrp ffts at the same time. We prepare both
! evc (at k) and dpsi (at k+q)
!
IF( idx + ibnd - 1 <= nbnd_occ(ikk) ) THEN
!
DO ig = 1, npw
tg_psi( nls( igk( ig ) ) + ioff, 1 ) = evc( ig, idx+ibnd-1 )
tg_psi( nls( igk( ig ) ) + ioff, 2 ) = evc( npwx+ig, idx+ibnd-1 )
END DO
DO ig = 1, npwq
tg_dpsi( nls( igkq( ig ) ) + ioff, 1 ) = dpsi( ig, idx+ibnd-1 )
tg_dpsi( nls( igkq( ig ) ) + ioff, 2 ) = dpsi( npwx+ig, idx+ibnd-1 )
END DO
!
END IF
!
ioff = ioff + dffts%tg_nnr
!
END DO
CALL invfft ('Wave', tg_psi(:,1), dffts)
CALL invfft ('Wave', tg_psi(:,2), dffts)
CALL invfft ('Wave', tg_dpsi(:,1), dffts)
CALL invfft ('Wave', tg_dpsi(:,2), dffts)
dpsic = (0.d0, 0.d0)
do ig = 1, npwq
dpsic (nls (igkq (ig)), 1 ) = dpsi (ig, ibnd)
dpsic (nls (igkq (ig)), 2 ) = dpsi (ig+npwx, ibnd)
enddo
do ir = 1, dffts%tg_npp( me_bgrp + 1 ) * dffts%nr1x * dffts%nr2x
tg_drho (ir,1) = tg_drho (ir,1) + wgt * (CONJG(tg_psi (ir,1) )* &
tg_dpsi (ir,1) + CONJG(tg_psi (ir,2) ) * &
tg_dpsi (ir,2) )
enddo
IF (domag) THEN
do ir = 1, dffts%tg_npp( me_bgrp + 1 ) * dffts%nr1x * dffts%nr2x
tg_drho(ir,2)= tg_drho(ir,2) + wgt *(CONJG(tg_psi(ir,1))* &
tg_dpsi(ir,2)+ CONJG(tg_psi(ir,2))*tg_dpsi(ir,1) )
tg_drho(ir,3)= tg_drho(ir,3) + wgt *(CONJG(tg_psi(ir,1))* &
tg_dpsi(ir,2)- CONJG(tg_psi(ir,2))*tg_dpsi(ir,1) )&
* (0.d0,-1.d0)
tg_drho(ir,4)= tg_drho(ir,4) + wgt *(CONJG(tg_psi(ir,1))* &
tg_dpsi(ir,1)-CONJG(tg_psi(ir,2))*tg_dpsi(ir,2) )
enddo
ENDIF
!
! reduce the group charge (equivalent to sum over the bands of the
! orbital group)
!
CALL mp_sum( tg_drho, gid = dffts%ogrp_comm )
!
ioff = 0
DO idx = 1, dffts%nogrp
IF( me_bgrp == dffts%nolist( idx ) ) EXIT
ioff = ioff + dffts%nr1x * dffts%nr2x * &
dffts%npp( dffts%nolist( idx ) + 1 )
END DO
!
! copy the charge back to the proper processor location
!
DO ipol=1,nspin_mag
DO ir = 1, dffts%nnr
aux(ir,ipol) = aux(ir,ipol) + tg_drho(ir+ioff,ipol)
END DO
END DO
ELSE
psi = (0.d0, 0.d0)
do ig = 1, npw
psi (nls (igk (ig) ), 1) = evc (ig, ibnd)
psi (nls (igk (ig) ), 2) = evc (ig+npwx, ibnd)
enddo
CALL invfft ('Wave', psi(:,1), dffts)
CALL invfft ('Wave', psi(:,2), dffts)
CALL invfft ('Wave', dpsic(:,1), dffts)
CALL invfft ('Wave', dpsic(:,2), dffts)
do ir = 1, dffts%nnr
drhoscf(ir,1)=drhoscf(ir,1)+wgt*(CONJG(psi(ir,1))*dpsic(ir,1) + &
CONJG(psi(ir,2))*dpsic(ir,2) )
dpsic = (0.d0, 0.d0)
do ig = 1, npwq
dpsic (nls (igkq (ig)), 1 ) = dpsi (ig, ibnd)
dpsic (nls (igkq (ig)), 2 ) = dpsi (ig+npwx, ibnd)
enddo
enddo
IF (domag) THEN
CALL invfft ('Wave', dpsic(:,1), dffts)
CALL invfft ('Wave', dpsic(:,2), dffts)
do ir = 1, dffts%nnr
drhoscf(ir,2)=drhoscf (ir,2) + wgt *(CONJG(psi(ir,1))*dpsic(ir,2)+ &
drhoscf(ir,1)=drhoscf(ir,1)+wgt*(CONJG(psi(ir,1))*dpsic(ir,1) + &
CONJG(psi(ir,2))*dpsic(ir,2) )
enddo
IF (domag) THEN
do ir = 1, dffts%nnr
drhoscf(ir,2)=drhoscf (ir,2) + wgt *(CONJG(psi(ir,1))*dpsic(ir,2)+ &
CONJG(psi(ir,2))*dpsic(ir,1) )
drhoscf(ir,3)=drhoscf (ir,3) + wgt *(CONJG(psi(ir,1))*dpsic(ir,2)- &
drhoscf(ir,3)=drhoscf (ir,3) + wgt *(CONJG(psi(ir,1))*dpsic(ir,2)- &
CONJG(psi(ir,2))*dpsic(ir,1) ) * (0.d0,-1.d0)
drhoscf(ir,4)=drhoscf (ir,4) + wgt *(CONJG(psi(ir,1))*dpsic(ir,1)- &
drhoscf(ir,4)=drhoscf (ir,4) + wgt *(CONJG(psi(ir,1))*dpsic(ir,1)- &
CONJG(psi(ir,2))*dpsic(ir,2) )
enddo
enddo
END IF
END IF
enddo
call addusdbec_nc (ik, weight, dpsi, dbecsum)
deallocate (aux)
deallocate (psi)
deallocate (dpsic)
IF (dffts%have_task_groups) THEN
DEALLOCATE( tg_psi )
DEALLOCATE( tg_dpsi )
DEALLOCATE( tg_drho )
END IF
dffts%have_task_groups=.FALSE.
call stop_clock ('incdrhoscf')
return
end subroutine incdrhoscf_nc
......@@ -32,6 +32,7 @@ SUBROUTINE phq_readin()
USE lsda_mod, ONLY : lsda, nspin
USE spin_orb, ONLY : domag
USE cellmd, ONLY : lmovecell
USE fft_base, ONLY : dffts
USE run_info, ONLY : title
USE control_ph, ONLY : maxter, alpha_mix, lgamma, lgamma_gamma, epsil, &
zue, zeu, xmldyn, newgrid, &
......@@ -54,7 +55,7 @@ SUBROUTINE phq_readin()
USE mp_global, ONLY : nproc_pool, nproc_pool_file, &
nimage, my_image_id, &
nproc_image_file, nproc_image, npool, &
get_ntask_groups, ntask_groups_file, &
get_ntask_groups, &
nbgrp
USE paw_variables, ONLY : okpaw
USE ramanm, ONLY : eth_rps, eth_ns, lraman, elop, dek
......@@ -478,9 +479,11 @@ SUBROUTINE phq_readin()
IF (nproc_pool /= nproc_pool_file .and. .not. twfcollect) &
CALL errore('phq_readin',&
'pw.x run with a different number of pools. Use wf_collect=.true.',1)
!
! Task groups not used in phonon. Activated only in some places
!
IF (get_ntask_groups() > 1) dffts%have_task_groups=.FALSE.
IF (get_ntask_groups() > 1) &
CALL errore('phq_readin','task_groups not available in phonon',1)
IF (nbgrp /= 1) &
CALL errore('phq_readin','band parallelization not available in phonon',1)
......
......@@ -25,6 +25,8 @@ SUBROUTINE run_pwscf(do_band)
!