scnc
/
quantum-espresso
mirror of https://gitlab.com/QEF/q-e.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

nl indexes now in fft type

This commit is contained in:
Carlo Cavazzoni 2017-12-24 15:43:44 +01:00
parent 4cab1886ee
commit c23a49e7f9
22 changed files with 62 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
PHonon/PH/addcore.f90
View File

@ -18,7 +18,7 @@ subroutine addcore (mode, drhoc)
use cell_base, only : tpiba
use fft_base, only : dfftp
use fft_interfaces, only: invfft
use gvect, only : ngm, nl, mill, eigts1, eigts2, eigts3, g
use gvect, only : ngm, mill, eigts1, eigts2, eigts3, g
use modes, only : u
use qpoint, only : eigqts, xq
use nlcc_ph, only : drc
@ -61,7 +61,7 @@ subroutine addcore (mode, drhoc)
* eigts3 (mill (3,ig), na)
gu = gu0 + g (1, ig) * u1 + g (2, ig) * u2 + g (3, ig) &
* u3
drhoc (nl (ig) ) = drhoc (nl (ig) ) + drc (ig, nt) * gu * &
drhoc (dfftp%nl (ig) ) = drhoc (dfftp%nl (ig) ) + drc (ig, nt) * gu * &
fact * gtau
enddo
endif

4
PHonon/PH/addnlcc.f90
View File

@ -16,7 +16,7 @@ subroutine addnlcc (imode0, drhoscf, npe)
use funct, only : dft_is_gradient, dft_is_nonlocc
USE cell_base, ONLY : omega, alat
use scf, only : rho, rho_core
USE gvect, ONLY : g, ngm, nl
USE gvect, ONLY : g, ngm
USE fft_base, ONLY : dfftp
USE noncollin_module, ONLY : nspin_lsda, nspin_gga, nspin_mag
USE dynmat, ONLY : dyn, dyn_rec
@ -100,7 +100,7 @@ subroutine addnlcc (imode0, drhoscf, npe)
!
if ( dft_is_gradient() ) &
call dgradcorr (rho%of_r, grho, dvxc_rr, dvxc_sr, dvxc_ss, dvxc_s, xq, &
drhoscf (1, 1, ipert), dfftp%nnr, nspin_mag, nspin_gga, nl, ngm, g, alat,&
drhoscf (1, 1, ipert), dfftp%nnr, nspin_mag, nspin_gga, dfftp%nl, ngm, g, alat,&
dvaux)
if (dft_is_nonlocc()) &
call dnonloccorr(rho%of_r, drhoscf (1, 1, ipert), xq, dvaux)

4
PHonon/PH/addnlcc_zstar_eu_us.f90
View File

@ -14,7 +14,7 @@ SUBROUTINE addnlcc_zstar_eu_us( drhoscf )
USE funct, only : dft_is_gradient, dft_is_nonlocc
USE scf, only : rho, rho_core
USE cell_base, ONLY : omega, alat
USE gvect, ONLY : ngm, nl, g
USE gvect, ONLY : ngm, g
USE fft_base, ONLY : dfftp
USE noncollin_module, ONLY : nspin_lsda, nspin_gga, nspin_mag
USE efield_mod, ONLY : zstareu0
@ -80,7 +80,7 @@ SUBROUTINE addnlcc_zstar_eu_us( drhoscf )
IF ( dft_is_gradient() ) &
CALL dgradcorr (rho%of_r, grho, &
dvxc_rr, dvxc_sr, dvxc_ss, dvxc_s, xq, drhoscf (1,1,ipol),&
dfftp%nnr, nspin_mag, nspin_gga, nl, ngm, g, alat, dvaux)
dfftp%nnr, nspin_mag, nspin_gga, dfftp%nl, ngm, g, alat, dvaux)
if (dft_is_nonlocc()) &
call dnonloccorr(rho%of_r, drhoscf (1, 1, ipol), xq, dvaux)

4
PHonon/PH/addusddens.f90
View File

@ -29,7 +29,7 @@ subroutine addusddens (drhoscf, dbecsum, mode0, npe, iflag)
USE kinds, only : DP
use fft_base, only: dfftp
use fft_interfaces, only: invfft
USE gvect, ONLY : gg, ngm, nl, g, eigts1, eigts2, eigts3, mill
USE gvect, ONLY : gg, ngm, g, eigts1, eigts2, eigts3, mill
USE uspp, ONLY : okvan, becsum
USE cell_base, ONLY : tpiba
USE ions_base, ONLY : nat, ityp, ntyp => nsp
@ -188,7 +188,7 @@ subroutine addusddens (drhoscf, dbecsum, mode0, npe, iflag)
do is = 1, nspin_mag
psic(:) = (0.d0, 0.d0)
do ig = 1, ngm
psic (nl (ig) ) = aux (ig, is, ipert)
psic (dfftp%nl (ig) ) = aux (ig, is, ipert)
enddo
CALL invfft ('Dense', psic, dfftp)
call daxpy (2*dfftp%nnr, 1.0_DP, psic, 1, drhoscf(1,is,ipert), 1)

4
PHonon/PH/addusddense.f90
View File

@ -23,7 +23,7 @@ subroutine addusddense (drhoscf, dbecsum)
USE ions_base, ONLY : nat, ityp, ntyp => nsp
use fft_base, only: dfftp
use fft_interfaces, only: invfft
USE gvect, ONLY : nl, g, gg, ngm, eigts1, eigts2, eigts3, mill
USE gvect, ONLY : g, gg, ngm, eigts1, eigts2, eigts3, mill
USE uspp, ONLY: okvan
USE uspp_param, ONLY: upf, lmaxq, nh, nhm
USE noncollin_module, ONLY : nspin_mag
@ -114,7 +114,7 @@ subroutine addusddense (drhoscf, dbecsum)
do is=1,nspin_mag
do ipert = 1, 3
qg (:) = (0.d0, 0.d0)
qg (nl (:) ) = aux (:, is, ipert)
qg (dfftp%nl (:) ) = aux (:, is, ipert)
CALL invfft ('Dense', qg, dfftp)
drhoscf(:,is,ipert) = drhoscf(:,is,ipert) + 2.d0*qg(:)
enddo

4
PHonon/PH/addusldos.f90
View File

@ -18,7 +18,7 @@ subroutine addusldos (ldos, becsum1)
USE ions_base, ONLY : nat, ityp, ntyp => nsp
use fft_base, only: dfftp
use fft_interfaces, only: invfft
USE gvect, ONLY : nl, eigts1, eigts2, eigts3, mill, gg, g, ngm
USE gvect, ONLY : eigts1, eigts2, eigts3, mill, gg, g, ngm
USE wavefunctions_module, ONLY: psic
USE uspp, ONLY: okvan
USE uspp_param, ONLY: upf, lmaxq, nh, nhm
@ -87,7 +87,7 @@ subroutine addusldos (ldos, becsum1)
do is = 1, nspin_mag
psic (:) = (0.d0,0.d0)
do ig = 1, ngm
psic (nl (ig) ) = aux (ig, is)
psic (dfftp%nl (ig) ) = aux (ig, is)
enddo
CALL invfft ('Dense', psic, dfftp)
call daxpy (dfftp%nnr, 1.d0, psic, 2, ldos(1,is), 2 )

3
PHonon/PH/compute_drhous.f90
View File

@ -24,7 +24,6 @@ subroutine compute_drhous (drhous, dbecsum, wgg, becq, alpq)
USE klist, ONLY : xk, wk, ngk, igk_k
USE fft_base, ONLY: dffts, dfftp
USE fft_interfaces, ONLY: invfft
USE gvecs, ONLY : nls
USE wvfct, ONLY : nbnd
USE qpoint, ONLY : nksq, ikks, ikqs
@ -93,7 +92,7 @@ subroutine compute_drhous (drhous, dbecsum, wgg, becq, alpq)
evcr(:,:) = (0.d0, 0.d0)
do ibnd = 1, nbnd
do ig = 1, npw
evcr (nls (igk_k(ig,ikk) ), ibnd) = evc (ig, ibnd)
evcr (dffts%nl (igk_k(ig,ikk) ), ibnd) = evc (ig, ibnd)
enddo
CALL invfft ('Wave', evcr (:, ibnd), dffts)
enddo

5
PHonon/PH/compute_drhous_nc.f90
View File

@ -22,7 +22,6 @@ subroutine compute_drhous_nc (drhous, dbecsum, wgg, becq, alpq)
USE buffers, ONLY : get_buffer
USE fft_base, ONLY : dffts, dfftp
USE fft_interfaces, ONLY : invfft
USE gvecs, ONLY : nls
USE wvfct, ONLY : npwx, nbnd
USE noncollin_module, ONLY : npol, nspin_mag
USE wavefunctions_module, ONLY: evc
@ -97,8 +96,8 @@ subroutine compute_drhous_nc (drhous, dbecsum, wgg, becq, alpq)
evcr = (0.d0, 0.d0)
do ibnd = 1, nbnd
do ig = 1, npw
evcr (nls (igk_k(ig,ikk) ), 1, ibnd) = evc (ig, ibnd)
evcr (nls (igk_k(ig,ikk) ), 2, ibnd) = evc (ig+npwx, ibnd)
evcr (dffts%nl (igk_k(ig,ikk) ), 1, ibnd) = evc (ig, ibnd)
evcr (dffts%nl (igk_k(ig,ikk) ), 2, ibnd) = evc (ig+npwx, ibnd)
enddo
CALL invfft ('Wave', evcr (:, 1, ibnd), dffts)
CALL invfft ('Wave', evcr (:, 2, ibnd), dffts)

4
PHonon/PH/compute_dvloc.f90
View File

@ -20,7 +20,7 @@ subroutine compute_dvloc (mode, dvlocin)
USE fft_base, ONLY : dffts
USE fft_interfaces, ONLY: invfft
USE gvect, ONLY : eigts1, eigts2, eigts3, mill, g
USE gvecs, ONLY : ngms, nls
USE gvecs, ONLY : ngms
USE cell_base, ONLY : tpiba
USE ions_base, ONLY : nat, ityp
USE modes, ONLY : u
@ -62,7 +62,7 @@ subroutine compute_dvloc (mode, dvlocin)
gtau = eigts1 (mill(1,ig), na) * eigts2 (mill(2,ig), na) * &
eigts3 (mill(3,ig), na)
gu = gu0 + g (1, ig) * u1 + g (2, ig) * u2 + g (3, ig) * u3
dvlocin (nls (ig) ) = dvlocin (nls (ig) ) + vlocq (ig, nt) &
dvlocin (dffts%nl (ig) ) = dvlocin (dffts%nl (ig) ) + vlocq (ig, nt) &
* gu * fact * gtau
enddo
IF (do_cutoff_2D) then

4
PHonon/PH/dvanqq.f90
View File

@ -27,7 +27,7 @@ subroutine dvanqq
USE ions_base, ONLY : nat, ityp, ntyp => nsp
USE fft_base, ONLY: dfftp
USE fft_interfaces, ONLY: fwfft
use gvect, only : ngm, gg, nl, g, mill, eigts1, eigts2, eigts3
use gvect, only : ngm, gg, g, mill, eigts1, eigts2, eigts3
use spin_orb, only : lspinorb
use scf, only : v, vltot
use noncollin_module, ONLY : noncolin, nspin_mag
@ -207,7 +207,7 @@ subroutine dvanqq
do is = 1, nspin_mag
do ipol = 1, 3
do ig = 1, ngm
aux2 (ig) = veff (nl (ig), is) * g (ipol, ig)
aux2 (ig) = veff (dfftp%nl (ig), is) * g (ipol, ig)
enddo
int1 (ih, jh, ipol, nb, is) = - fact1 * &
zdotc (ngm, aux1, 1, aux2, 1)

20
PHonon/PH/dvqpsi_us.f90
View File

@ -25,9 +25,9 @@ subroutine dvqpsi_us (ik, uact, addnlcc)
USE cell_base, ONLY : tpiba, alat
USE fft_base, ONLY : dfftp, dffts
USE fft_interfaces, ONLY: fwfft, invfft
USE gvect, ONLY : eigts1, eigts2, eigts3, mill, g, nl, &
USE gvect, ONLY : eigts1, eigts2, eigts3, mill, g, &
ngm
USE gvecs, ONLY : ngms, doublegrid, nls
USE gvecs, ONLY : ngms, doublegrid
USE lsda_mod, ONLY : lsda, isk
USE scf, ONLY : rho, rho_core
USE noncollin_module, ONLY : nspin_lsda, nspin_gga, nspin_mag, npol
@ -102,7 +102,7 @@ subroutine dvqpsi_us (ik, uact, addnlcc)
gtau = eigts1 (mill(1,ig), na) * eigts2 (mill(2,ig), na) * &
eigts3 (mill(3,ig), na)
gu = gu0 + g (1, ig) * u1 + g (2, ig) * u2 + g (3, ig) * u3
aux1 (nls (ig) ) = aux1 (nls (ig) ) + vlocq (ig, nt) * gu * &
aux1 (dffts%nl (ig) ) = aux1 (dffts%nl (ig) ) + vlocq (ig, nt) * gu * &
fact * gtau
enddo
IF (do_cutoff_2D) then
@ -132,7 +132,7 @@ subroutine dvqpsi_us (ik, uact, addnlcc)
eigts2(mill(2,ig),na)* &
eigts3(mill(3,ig),na)
gu = gu0+g(1,ig)*u1+g(2,ig)*u2+g(3,ig)*u3
drhoc(nl(ig))=drhoc(nl(ig))+drc(ig,nt)*gu*fact*gtau
drhoc(dfftp%nl(ig))=drhoc(dfftp%nl(ig))+drc(ig,nt)*gu*fact*gtau
enddo
endif
endif
@ -158,7 +158,7 @@ subroutine dvqpsi_us (ik, uact, addnlcc)
IF ( dft_is_gradient() ) &
CALL dgradcorr (rho%of_r, grho, &
dvxc_rr, dvxc_sr, dvxc_ss, dvxc_s, xq, drhoc,&
dfftp%nnr, 1, nspin_gga, nl, ngm, g, alat, aux)
dfftp%nnr, 1, nspin_gga, dfftp%nl, ngm, g, alat, aux)
IF (dft_is_nonlocc()) &
CALL dnonloccorr(rho%of_r, drhoc, xq, aux)
@ -174,7 +174,7 @@ subroutine dvqpsi_us (ik, uact, addnlcc)
!
auxs(:) = (0.d0, 0.d0)
do ig=1,ngms
auxs(nls(ig)) = aux(nl(ig))
auxs(dffts%nl(ig)) = aux(dfftp%nl(ig))
enddo
aux1(:) = aux1(:) + auxs(:)
endif
@ -191,11 +191,11 @@ subroutine dvqpsi_us (ik, uact, addnlcc)
aux2(:) = (0.d0, 0.d0)
if (ip==1) then
do ig = 1, npw
aux2 (nls (igk_k (ig,ikk) ) ) = evc (ig, ibnd)
aux2 (dffts%nl (igk_k (ig,ikk) ) ) = evc (ig, ibnd)
enddo
else
do ig = 1, npw
aux2 (nls (igk_k (ig,ikk) ) ) = evc (ig+npwx, ibnd)
aux2 (dffts%nl (igk_k (ig,ikk) ) ) = evc (ig+npwx, ibnd)
enddo
end if
!
@ -211,11 +211,11 @@ subroutine dvqpsi_us (ik, uact, addnlcc)
CALL fwfft ('Wave', aux2, dffts)
if (ip==1) then
do ig = 1, npwq
dvpsi (ig, ibnd) = aux2 (nls (igk_k (ig,ikq) ) )
dvpsi (ig, ibnd) = aux2 (dffts%nl (igk_k (ig,ikq) ) )
enddo
else
do ig = 1, npwq
dvpsi (ig+npwx, ibnd) = aux2 (nls (igk_k (ig,ikq) ) )
dvpsi (ig+npwx, ibnd) = aux2 (dffts%nl (igk_k (ig,ikq) ) )
enddo
end if
enddo

6
PHonon/PH/dynmat_us.f90
View File

@ -22,7 +22,7 @@ SUBROUTINE dynmat_us()
USE fft_base, ONLY : dfftp
USE fft_interfaces, ONLY : fwfft
USE buffers, ONLY : get_buffer
USE gvect, ONLY : g, ngm, nl, igtongl
USE gvect, ONLY : g, ngm, igtongl
USE wvfct, ONLY : npwx, nbnd, wg, et
USE lsda_mod, ONLY : lsda, current_spin, isk, nspin
USE vlocal, ONLY : vloc
@ -115,8 +115,8 @@ SUBROUTINE dynmat_us()
g (2, ng) * tau (2, na) + &
g (3, ng) * tau (3, na) )
fac = omega * vloc (igtongl (ng), ityp (na) ) * tpiba2 * &
( DBLE (rhog (nl (ng) ) ) * COS (gtau) - &
AIMAG (rhog (nl (ng) ) ) * SIN (gtau) )
( DBLE (rhog (dfftp%nl (ng) ) ) * COS (gtau) - &
AIMAG (rhog (dfftp%nl (ng) ) ) * SIN (gtau) )
dynwrk (na_icart, na_jcart) = dynwrk (na_icart, na_jcart) - &
fac * g (icart, ng) * g (jcart, ng)
ENDDO

4
PHonon/PH/dynmatcc.f90
View File

@ -18,7 +18,7 @@ subroutine dynmatcc
USE ions_base, ONLY : nat, ityp, tau
USE fft_base, ONLY : dfftp
USE fft_interfaces, ONLY : fwfft
USE gvect, ONLY : nl, ngm, g
USE gvect, ONLY : ngm, g
USE lsda_mod, ONLY : nspin
use scf, ONLY : rho, rho_core, rhog_core
USE modes, ONLY : u
@ -84,7 +84,7 @@ subroutine dynmatcc
arg = tpi * (g (1, ig) * tau (1, na) + g (2, ig) * tau (2, na) &
+ g (3, ig) * tau (3, na) )
exc = CMPLX(cos (arg), - sin (arg) ,kind=DP) * tpiba2
work (ig) = drc (ig, nta) * exc * CONJG(vxc (nl (ig) ) )
work (ig) = drc (ig, nta) * exc * CONJG(vxc (dfftp%nl (ig) ) )
enddo
do i = 1, 3
na_i = 3 * (na - 1) + i

8
PHonon/PH/ef_shift.f90
View File

@ -26,7 +26,7 @@ subroutine ef_shift (drhoscf, ldos, ldoss, dos_ef, irr, npe, flag)
USE cell_base, ONLY : omega
USE fft_base, ONLY : dfftp, dffts
USE fft_interfaces, ONLY : fwfft, invfft
USE gvect, ONLY : gg, nl
USE gvect, ONLY : gg
USE buffers, ONLY : get_buffer, save_buffer
USE lsda_mod, ONLY : nspin
USE wvfct, ONLY : npwx, et
@ -92,7 +92,7 @@ subroutine ef_shift (drhoscf, ldos, ldoss, dos_ef, irr, npe, flag)
delta_n = (0.d0, 0.d0)
do is = 1, nspin_lsda
CALL fwfft ('Dense', drhoscf(:,is,ipert), dfftp)
if (gg(1).lt.1.0d-8) delta_n = delta_n + omega*drhoscf(nl(1),is,ipert)
if (gg(1).lt.1.0d-8) delta_n = delta_n + omega*drhoscf(dfftp%nl(1),is,ipert)
CALL invfft ('Dense', drhoscf(:,is,ipert), dfftp)
enddo
call mp_sum ( delta_n, intra_bgrp_comm )
@ -176,7 +176,7 @@ subroutine ef_shift_paw (drhoscf, dbecsum, ldos, ldoss, becsum1, &
USE buffers, ONLY : get_buffer, save_buffer
USE fft_base, ONLY : dfftp, dffts
USE fft_interfaces, ONLY : fwfft, invfft
USE gvect, ONLY : gg, nl
USE gvect, ONLY : gg
USE lsda_mod, ONLY : nspin
USE uspp_param, ONLY : nhm
USE wvfct, ONLY : npwx, et
@ -244,7 +244,7 @@ subroutine ef_shift_paw (drhoscf, dbecsum, ldos, ldoss, becsum1, &
delta_n = (0.d0, 0.d0)
do is = 1, nspin_lsda
CALL fwfft ('Dense', drhoscf(:,is,ipert), dfftp)
if (gg(1).lt.1.0d-8) delta_n = delta_n + omega*drhoscf(nl(1),is,ipert)
if (gg(1).lt.1.0d-8) delta_n = delta_n + omega*drhoscf(dfftp%nl(1),is,ipert)
CALL invfft ('Dense', drhoscf(:,is,ipert), dfftp)
enddo
call mp_sum ( delta_n, intra_bgrp_comm )

5
PHonon/PH/elph_scdft_mod.f90
View File

@ -430,7 +430,6 @@ SUBROUTINE elph_scdft_fft(evc_g, evc_r, npw, igk, isw)
USE wvfct, ONLY : npwx
USE fft_base, ONLY: dffts
USE fft_interfaces, ONLY: fwfft, invfft
USE gvecs, ONLY : nls
!
INTEGER,INTENT(IN) :: isw
INTEGER,INTENT(IN) :: npw, igk(npw)
@ -443,7 +442,7 @@ SUBROUTINE elph_scdft_fft(evc_g, evc_r, npw, igk, isw)
evc_r = (0_dp, 0_dp)
!
DO ig = 1, npw
evc_r(nls(igk(ig))) = evc_g(ig)
evc_r(dffts%nl(igk(ig))) = evc_g(ig)
END DO
!
CALL invfft ('Wave', evc_r(1:dffts%nnr), dffts)
@ -453,7 +452,7 @@ SUBROUTINE elph_scdft_fft(evc_g, evc_r, npw, igk, isw)
CALL fwfft ('Wave', evc_r(1:dffts%nnr), dffts)
!
DO ig = 1, npw
evc_g(ig) = evc_r(nls(igk(ig)))
evc_g(ig) = evc_r(dffts%nl(igk(ig)))
END DO
!
END IF

18
PHonon/PH/ep_matrix_element_wannier.f90
View File

@ -346,7 +346,6 @@ SUBROUTINE elphel_refolded (npe, imode0, dvscfins)
USE mp, ONLY: mp_sum
USE ions_base, ONLY : nat
USE io_global, ONLY : stdout
USE gvecs, ONLY : nls
USE eqv, ONLY : dvpsi!, evq
USE qpoint, ONLY : nksq, ikks, ikqs
@ -620,7 +619,6 @@ subroutine calculate_and_apply_phase(ik, ikqg, igqg, npwq_refolded, g_kpq, xk_ga
USE fft_interfaces, ONLY : fwfft, invfft
USE wvfct, ONLY: nbnd, npwx
USE gvect, ONLY : ngm, g
USE gvecs, ONLY : nls
USE gvecw, ONLY : gcutw
USE cell_base, ONLY : bg
USE qpoint, ONLY : nksq
@ -672,7 +670,7 @@ subroutine calculate_and_apply_phase(ik, ikqg, igqg, npwq_refolded, g_kpq, xk_ga
phase(:) = (0.d0,0.d0)
if ( igqg(ik)>0) then
phase( nls(igqg(ik)) ) = (1.d0,0.d0)
phase( dffts%nl(igqg(ik)) ) = (1.d0,0.d0)
endif
@ -685,28 +683,28 @@ subroutine calculate_and_apply_phase(ik, ikqg, igqg, npwq_refolded, g_kpq, xk_ga
do m=1,nbnd
psi_scratch = (0.d0, 0.d0)
psi_scratch(nls (igk_ (1:npw_) ) ) = evq (1:npw_, m)
! psi_scratch(nls (igk_ (1:npw) ) ) = evq (1:npw, m)
psi_scratch(dffts%nl (igk_ (1:npw_) ) ) = evq (1:npw_, m)
! psi_scratch(dffts%nl (igk_ (1:npw) ) ) = evq (1:npw, m)
CALL invfft ('Wave', psi_scratch, dffts)
! call cft3s (psic, nr1s, nr2s, nr3s, nrx1s, nrx2s, nrx3s, +2)
psi_scratch(1:dffts%nnr) = psi_scratch(1:dffts%nnr) * phase(1:dffts%nnr)
! call cft3s (psic, nr1s, nr2s, nr3s, nrx1s, nrx2s, nrx3s, -2)
CALL fwfft ('Wave', psi_scratch, dffts)
evq(1:npwq_refolded,m) = psi_scratch(nls (igkq_(1:npwq_refolded) ) )
evq(1:npwq_refolded,m) = psi_scratch(dffts%nl (igkq_(1:npwq_refolded) ) )
enddo
if(noncolin) then
do m=1,nbnd
psi_scratch = (0.d0, 0.d0)
psi_scratch(nls (igk_ (1:npw_) ) ) = evq (npwx+1:npwx+npw_, m)
! psi_scratch(nls (igk_ (1:npw) ) ) = evq (1:npw, m)
psi_scratch(dffts%nl (igk_ (1:npw_) ) ) = evq (npwx+1:npwx+npw_, m)
! psi_scratch(dffts%nl (igk_ (1:npw) ) ) = evq (1:npw, m)
CALL invfft ('Wave', psi_scratch, dffts)
! call cft3s (psic, nr1s, nr2s, nr3s, nrx1s, nrx2s, nrx3s, +2)
psi_scratch(1:dffts%nnr) = psi_scratch(1:dffts%nnr) * phase(1:dffts%nnr)
! call cft3s (psic, nr1s, nr2s, nr3s, nrx1s, nrx2s, nrx3s, -2)
CALL fwfft ('Wave', psi_scratch, dffts)
! evq(npwx+1:npwx+npwq_refolded,m) = psi_scratch(nls (igkq_(1:npwq_refolded) ) )
evq((npwx+1):(npwx+npwq_refolded),m) = psi_scratch(nls (igkq_(1:npwq_refolded) ) )
! evq(npwx+1:npwx+npwq_refolded,m) = psi_scratch(dffts%nl (igkq_(1:npwq_refolded) ) )
evq((npwx+1):(npwx+npwq_refolded),m) = psi_scratch(dffts%nl (igkq_(1:npwq_refolded) ) )
enddo
endif

3
PHonon/PH/incdrhous.f90
View File

@ -19,7 +19,6 @@ subroutine incdrhous (drhoscf, weight, ik, dbecsum, evcr, wgg, becq, &
USE cell_base, ONLY : omega
USE fft_base, ONLY : dffts
USE fft_interfaces, ONLY: invfft
USE gvecs, ONLY : nls
USE noncollin_module, ONLY : npol
USE uspp, ONLY : nkb, qq_nt
USE uspp_param,ONLY : nhm, nh
@ -120,7 +119,7 @@ subroutine incdrhous (drhoscf, weight, ik, dbecsum, evcr, wgg, becq, &
enddo
dpsir(:) = (0.d0, 0.d0)
do ig = 1, npwq
dpsir(nls(igk_k(ig,ikq))) = dpsi (ig, ibnd)
dpsir(dffts%nl(igk_k(ig,ikq))) = dpsi (ig, ibnd)
enddo
CALL invfft ('Wave', dpsir, dffts)
do ir = 1, dffts%nnr

5
PHonon/PH/incdrhous_nc.f90
View File

@ -20,7 +20,6 @@ subroutine incdrhous_nc (drhoscf, weight, ik, dbecsum, evcr, wgg, becq, &
USE ions_base, ONLY : ntyp => nsp, nat, ityp
USE fft_base, ONLY : dffts, dfftp
USE fft_interfaces, ONLY: invfft
USE gvecs, ONLY : nls
USE lsda_mod, ONLY : nspin
USE spin_orb, ONLY : lspinorb, domag
USE noncollin_module, ONLY : npol, nspin_mag
@ -146,8 +145,8 @@ subroutine incdrhous_nc (drhoscf, weight, ik, dbecsum, evcr, wgg, becq, &
enddo
dpsir = (0.d0, 0.d0)
do ig = 1, npwq
dpsir(nls(igk_k(ig,ikq)),1) = dpsi (ig, ibnd)
dpsir(nls(igk_k(ig,ikq)),2) = dpsi (ig+npwx, ibnd)
dpsir(dffts%nl(igk_k(ig,ikq)),1) = dpsi (ig, ibnd)
dpsir(dffts%nl(igk_k(ig,ikq)),2) = dpsi (ig+npwx, ibnd)
enddo
CALL invfft ('Wave', dpsir(:,1), dffts)
CALL invfft ('Wave', dpsir(:,2), dffts)

8
PHonon/PH/localdos.f90
View File

@ -24,7 +24,7 @@ subroutine localdos_paw (ldos, ldoss, becsum1, dos_ef)
USE fft_base, ONLY : dffts, dfftp
USE fft_interfaces, ONLY: invfft
USE buffers, ONLY : get_buffer
USE gvecs, ONLY : doublegrid, nls
USE gvecs, ONLY : doublegrid
USE klist, ONLY : xk, wk, ngk, igk_k, degauss, ngauss, ltetra
USE lsda_mod, ONLY : nspin, lsda, current_spin, isk
USE noncollin_module, ONLY : noncolin, npol, nspin_mag
@ -111,8 +111,8 @@ subroutine localdos_paw (ldos, ldoss, becsum1, dos_ef)
IF (noncolin) THEN
psic_nc = (0.d0, 0.d0)
do ig = 1, npw
psic_nc (nls (igk_k(ig,ik)), 1 ) = evc (ig, ibnd)
psic_nc (nls (igk_k(ig,ik)), 2 ) = evc (ig+npwx, ibnd)
psic_nc (dffts%nl (igk_k(ig,ik)), 1 ) = evc (ig, ibnd)
psic_nc (dffts%nl (igk_k(ig,ik)), 2 ) = evc (ig+npwx, ibnd)
enddo
CALL invfft ('Smooth', psic_nc(:,1), dffts)
CALL invfft ('Smooth', psic_nc(:,2), dffts)
@ -141,7 +141,7 @@ subroutine localdos_paw (ldos, ldoss, becsum1, dos_ef)
ELSE
psic (:) = (0.d0, 0.d0)
do ig = 1, npw
psic (nls (igk_k(ig,ik) ) ) = evc (ig, ibnd)
psic (dffts%nl (igk_k(ig,ik) ) ) = evc (ig, ibnd)
enddo
CALL invfft ('Smooth', psic, dffts)
do j = 1, dffts%nnr

5
PHonon/PH/read_wfc_rspace_and_fwfft.f90
View File

@ -12,7 +12,6 @@ subroutine read_wfc_rspace_and_fwfft( evc , ik , lrec , iunit , npw , igmap )
USE fft_base, ONLY : dffts
USE scatter_mod, ONLY : scatter_grid
USE fft_interfaces, ONLY : fwfft
USE gvecs, ONLY : nls
USE io_global, ONLY : ionode_id, ionode
USE mp_pools, ONLY : inter_pool_comm
USE mp, ONLY : mp_bcast
@ -64,13 +63,13 @@ subroutine read_wfc_rspace_and_fwfft( evc , ik , lrec , iunit , npw , igmap )
call fwfft('Wave',evc_r(:,1),dffts)
do ig = 1, npw
evc (ig,ibnd) = evc_r (nls (igmap (ig) ), 1 )
evc (ig,ibnd) = evc_r (dffts%nl (igmap (ig) ), 1 )
enddo
IF (noncolin) THEN
CALL fwfft ('Wave', evc_r(:,2), dffts)
DO ig = 1, npw
evc (ig+npwx,ibnd) = evc_r (nls(igmap(ig)),2)
evc (ig+npwx,ibnd) = evc_r (dffts%nl(igmap(ig)),2)
ENDDO
ENDIF

6
PHonon/PH/solve_e_fpol.f90
View File

@ -32,7 +32,7 @@ subroutine solve_e_fpol ( iw )
USE fft_base, ONLY : dffts, dfftp
USE fft_interfaces, ONLY : fwfft, invfft
USE gvect, ONLY : g
USE gvecs, ONLY : doublegrid, nls
USE gvecs, ONLY : doublegrid
USE becmod, ONLY : becp, calbec
USE wvfct, ONLY : npwx, nbnd, g2kin, et
USE uspp, ONLY : okvan, vkb
@ -185,7 +185,7 @@ subroutine solve_e_fpol ( iw )
do ibnd = 1, nbnd_occ (ik)
aux1(:) = (0.d0, 0.d0)
do ig = 1, npw
aux1 (nls(igk_k(ig,ik)))=evc(ig,ibnd)
aux1 (dffts%nl(igk_k(ig,ik)))=evc(ig,ibnd)
enddo
CALL invfft ('Wave', aux1, dffts)
do ir = 1, dffts%nnr
@ -193,7 +193,7 @@ subroutine solve_e_fpol ( iw )
enddo
CALL fwfft ('Wave', aux1, dffts)
do ig = 1, npwq
dvpsi(ig,ibnd)=dvpsi(ig,ibnd)+aux1(nls(igk_k(ig,ik)))
dvpsi(ig,ibnd)=dvpsi(ig,ibnd)+aux1(dffts%nl(igk_k(ig,ik)))
enddo
enddo
!

5
PHonon/PH/solve_e_nscf.f90
View File

@ -22,7 +22,6 @@ subroutine solve_e_nscf( avg_iter, thresh, ik, ipol, dvscfs, auxr )
USE fft_interfaces, ONLY : fwfft, invfft
USE buffers, ONLY : get_buffer
USE gvect, ONLY : g
USE gvecs, ONLY : nls
USE wvfct, ONLY : et
USE wavefunctions_module, ONLY : evc
USE eqv, ONLY : dpsi, dvpsi
@ -71,7 +70,7 @@ subroutine solve_e_nscf( avg_iter, thresh, ik, ipol, dvscfs, auxr )
do ibnd = 1, nbnd_occ (ik)
auxr (:) = (0.d0, 0.d0)
do ig = 1, npw
auxr (nls (igk_k (ig,ik))) = evc (ig, ibnd)
auxr (dffts%nl (igk_k (ig,ik))) = evc (ig, ibnd)
end do
CALL invfft ('Wave', auxr, dffts)
do ir = 1, dffts%nnr
@ -80,7 +79,7 @@ subroutine solve_e_nscf( avg_iter, thresh, ik, ipol, dvscfs, auxr )
CALL fwfft ('Wave', auxr, dffts)
do ig = 1, npwq
! note: q=0
dvpsi (ig, ibnd) = dvpsi(ig, ibnd) + auxr(nls (igk_k (ig,ik)))
dvpsi (ig, ibnd) = dvpsi(ig, ibnd) + auxr(dffts%nl (igk_k (ig,ik)))
enddo
enddo
!