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

indexes nl now taken from fft type

This commit is contained in:
Carlo Cavazzoni 2017-12-24 15:24:26 +01:00
parent 9fde4f00fa
commit 4cab1886ee
11 changed files with 72 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
LR_Modules/Coul_cut_2D_ph.f90
View File

@ -125,7 +125,7 @@ subroutine cutoff_localq (dvlocin, fact, u1, u2, u3, gu0, nt, na)
USE kinds
USE fft_base, ONLY : dffts
USE gvect, ONLY : eigts1, eigts2, eigts3, mill, g
USE gvecs, ONLY : ngms, nls
USE gvecs, ONLY : ngms
implicit none
!
complex(DP), INTENT(INOUT) :: dvlocin (dffts%nnr)
@ -142,7 +142,7 @@ subroutine cutoff_localq (dvlocin, fact, u1, u2, u3, gu0, nt, na)
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) ) + lr_Vlocq (ig, nt) &
dvlocin (dffts%nl (ig) ) = dvlocin (dffts%nl (ig) ) + lr_Vlocq (ig, nt) &
* gu * fact * gtau
enddo
return
@ -161,7 +161,7 @@ subroutine cutoff_dv_of_drho (dvaux, is, dvscf)
USE cell_base, ONLY : tpiba2
USE fft_base, ONLY: dfftp
USE noncollin_module, ONLY : nspin_mag
USE gvect, ONLY : g, ngm, nl
USE gvect, ONLY : g, ngm
USE qpoint, ONLY : xq
implicit none
!
@ -179,8 +179,8 @@ subroutine cutoff_dv_of_drho (dvaux, is, dvscf)
do ig = 1, ngm
qg2 = (g(1,ig)+xq(1))**2 + (g(2,ig)+xq(2))**2 + (g(3,ig)+xq(3))**2
if (qg2 > 1.d-8) then
dvaux(nl(ig),is) = dvaux(nl(ig),is) + cutoff_2D_qg(ig)*&
e2 * fpi * dvscf(nl(ig),1) / (tpiba2 * qg2)
dvaux(dfftp%nl(ig),is) = dvaux(dfftp%nl(ig),is) + cutoff_2D_qg(ig)*&
e2 * fpi * dvscf(dfftp%nl(ig),1) / (tpiba2 * qg2)
endif
enddo
return
@ -197,7 +197,7 @@ subroutine cutoff_dynmat0 (dynwrk, rhog)
USE constants, ONLY : tpi, eps8
USE cell_base, ONLY : omega, tpiba2
USE fft_base, ONLY: dfftp
USE gvect, ONLY : g, ngm, nl, gg
USE gvect, ONLY : g, ngm, gg
USE Coul_cut_2D, ONLY : lr_Vloc
USE ions_base, ONLY : nat, ityp, ntyp => nsp, tau
implicit none
@ -218,8 +218,8 @@ subroutine cutoff_dynmat0 (dynwrk, rhog)
g (2, ng) * tau (2, na) + &
g (3, ng) * tau (3, na) )
fac = omega * lr_Vloc ( 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

19
LR_Modules/cft_wave.f90
View File

@ -61,7 +61,6 @@ END SUBROUTINE cft_wave
SUBROUTINE fwfft_wave (npwq, igkq, evc_g, evc_r )
USE kinds, ONLY : DP
USE wvfct, ONLY : npwx
USE gvecs, ONLY : nls
USE fft_base, ONLY : dffts
USE fft_interfaces, ONLY: fwfft
USE noncollin_module, ONLY : noncolin, npol
@ -74,12 +73,12 @@ SUBROUTINE fwfft_wave (npwq, igkq, evc_g, evc_r )
CALL fwfft ('Wave', evc_r(:,1), dffts)
DO ig = 1, npwq
evc_g (ig) = evc_g (ig) + evc_r (nls (igkq(ig) ), 1 )
evc_g (ig) = evc_g (ig) + evc_r (dffts%nl (igkq(ig) ), 1 )
ENDDO
IF (noncolin) THEN
CALL fwfft ('Wave', evc_r(:,2), dffts)
DO ig = 1, npwq
evc_g (ig+npwx) = evc_g (ig+npwx) + evc_r (nls(igkq(ig)),2)
evc_g (ig+npwx) = evc_g (ig+npwx) + evc_r (dffts%nl(igkq(ig)),2)
ENDDO
ENDIF
END SUBROUTINE fwfft_wave
@ -87,7 +86,6 @@ END SUBROUTINE fwfft_wave
SUBROUTINE invfft_wave (npw, igk, evc_g, evc_r )
USE kinds, ONLY : DP
USE wvfct, ONLY : npwx
USE gvecs, ONLY : nls
USE fft_base, ONLY : dffts
USE fft_interfaces, ONLY: invfft
USE noncollin_module, ONLY : noncolin, npol
@ -101,12 +99,12 @@ SUBROUTINE invfft_wave (npw, igk, evc_g, evc_r )
evc_r = (0.0_dp, 0.0_dp)
DO ig = 1, npw
evc_r (nls (igk(ig) ),1 ) = evc_g (ig)
evc_r (dffts%nl (igk(ig) ),1 ) = evc_g (ig)
ENDDO
CALL invfft ('Wave', evc_r(:,1), dffts)
IF (noncolin) THEN
DO ig = 1, npw
evc_r (nls(igk(ig)),2) = evc_g (ig+npwx)
evc_r (dffts%nl(igk(ig)),2) = evc_g (ig+npwx)
ENDDO
CALL invfft ('Wave', evc_r(:,2), dffts)
ENDIF
@ -139,7 +137,6 @@ SUBROUTINE cft_wave_tg (ik, evc_g, evc_r, isw, v_size, ibnd, nbnd_occ)
USE kinds, ONLY : DP
USE wvfct, ONLY : npwx
USE fft_base, ONLY : dffts
USE gvecs, ONLY : nls
USE qpoint, ONLY : ikks, ikqs
USE klist, ONLY : ngk, igk_k
USE mp_bands, ONLY : me_bgrp
@ -167,11 +164,11 @@ SUBROUTINE cft_wave_tg (ik, evc_g, evc_r, isw, v_size, ibnd, nbnd_occ)
!
IF( idx + ibnd - 1 <= nbnd_occ ) THEN
DO ig = 1, npw
evc_r(nls (igk_k(ig,ikk))+ioff,1) = evc_g(ig,idx+ibnd-1)
evc_r(dffts%nl (igk_k(ig,ikk))+ioff,1) = evc_g(ig,idx+ibnd-1)
ENDDO
IF (noncolin) THEN
DO ig = 1, npw
evc_r(nls (igk_k(ig,ikk))+ioff,2) = evc_g(npwx+ig,idx+ibnd-1)
evc_r(dffts%nl (igk_k(ig,ikk))+ioff,2) = evc_g(npwx+ig,idx+ibnd-1)
ENDDO
ENDIF
ENDIF
@ -196,13 +193,13 @@ SUBROUTINE cft_wave_tg (ik, evc_g, evc_r, isw, v_size, ibnd, nbnd_occ)
!
DO ig = 1, npwq
evc_g(ig, ibnd+idx-1) = evc_g(ig, ibnd+idx-1) + &
evc_r( nls(igk_k(ig,ikq)) + ioff, 1 )
evc_r( dffts%nl(igk_k(ig,ikq)) + 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(igk_k(ig,ikq))+ ioff,2)
+ evc_r (dffts%nl(igk_k(ig,ikq))+ ioff,2)
ENDDO
ENDIF
!

4
LR_Modules/compute_vsgga.f90
View File

@ -12,7 +12,7 @@ SUBROUTINE compute_vsgga( rhoout, grho, vsgga )
!
USE constants, ONLY : e2
USE kinds, ONLY : DP
USE gvect, ONLY : nl, ngm, g
USE gvect, ONLY : ngm, g
USE cell_base, ONLY : alat
USE noncollin_module, ONLY : noncolin, nspin_gga
USE funct, ONLY : gcxc, gcx_spin, gcc_spin, &
@ -154,7 +154,7 @@ SUBROUTINE compute_vsgga( rhoout, grho, vsgga )
!
DO is = 1, nspin_gga
!
CALL grad_dot( dfftp%nnr, h(1,1,is), ngm, g, nl, alat, dh )
CALL grad_dot( dfftp%nnr, h(1,1,is), ngm, g, dfftp%nl, alat, dh )
!
vaux(:,is) = vaux(:,is) - dh(:)
!

6
LR_Modules/dgradcorr.f90
View File

@ -249,7 +249,6 @@ subroutine qgradient (xq, nrxx, a, ngm, g, nl, alat, ga)
USE control_flags, ONLY : gamma_only
USE fft_base, ONLY : dfftp
USE fft_interfaces, ONLY : fwfft, invfft
USE gvect, ONLY : nlm
implicit none
integer :: nrxx, ngm, nl (ngm)
@ -272,7 +271,7 @@ subroutine qgradient (xq, nrxx, a, ngm, g, nl, alat, ga)
gaux (:) = (0.d0, 0.d0)
do n = 1, ngm
gaux(nl(n)) = CMPLX(0.d0, xq (ipol) + g (ipol, n),kind=DP) * aux (nl(n))
if (gamma_only) gaux( nlm(n) ) = conjg( gaux( nl(n) ) )
if (gamma_only) gaux( dfftp%nlm(n) ) = conjg( gaux( nl(n) ) )
enddo
! bring back to R-space, (\grad_ipol a)(r) ...
@ -300,7 +299,6 @@ subroutine qgrad_dot (xq, nrxx, a, ngm, g, nl, alat, da)
USE control_flags, ONLY : gamma_only
USE fft_base, ONLY : dfftp
USE fft_interfaces, ONLY: fwfft, invfft
USE gvect, ONLY : nlm
implicit none
integer :: nrxx, ngm, nl (ngm)
@ -331,7 +329,7 @@ subroutine qgrad_dot (xq, nrxx, a, ngm, g, nl, alat, da)
!
do n = 1, ngm
!
da( nlm(n) ) = conjg( da( nl(n) ) )
da( dfftp%nlm(n) ) = conjg( da( nl(n) ) )
!
end do
!

20
LR_Modules/dv_of_drho.f90
View File

@ -22,7 +22,7 @@ subroutine dv_of_drho (dvscf, add_nlcc, drhoc)
USE constants, ONLY : e2, fpi
USE fft_base, ONLY : dfftp
USE fft_interfaces, ONLY : fwfft, invfft
USE gvect, ONLY : nl, ngm, g,nlm, gstart
USE gvect, ONLY : ngm, g, gstart
USE cell_base, ONLY : alat, tpiba2, omega
USE noncollin_module, ONLY : nspin_lsda, nspin_mag, nspin_gga
USE funct, ONLY : dft_is_gradient, dft_is_nonlocc
@ -98,7 +98,7 @@ subroutine dv_of_drho (dvscf, add_nlcc, drhoc)
!
if ( dft_is_gradient() ) call dgradcorr &
(rho%of_r, grho, dvxc_rr, dvxc_sr, dvxc_ss, dvxc_s, xq, &
dvscf, dfftp%nnr, nspin_mag, nspin_gga, nl, ngm, g, alat, dvaux)
dvscf, dfftp%nnr, nspin_mag, nspin_gga, dfftp%nl, ngm, g, alat, dvaux)
!
if (dft_is_nonlocc()) then
call dnonloccorr(rho%of_r, dvscf, xq, dvaux)
@ -133,7 +133,7 @@ subroutine dv_of_drho (dvscf, add_nlcc, drhoc)
do is = 1, nspin_lsda
do ig = gstart, ngm
qg2 = (g(1,ig)+xq(1))**2 + (g(2,ig)+xq(2))**2 + (g(3,ig)+xq(3))**2
dvhart(nl(ig),is) = e2 * fpi * dvscf(nl(ig),1) / (tpiba2 * qg2)
dvhart(dfftp%nl(ig),is) = e2 * fpi * dvscf(dfftp%nl(ig),1) / (tpiba2 * qg2)
enddo
enddo
!
@ -144,7 +144,7 @@ subroutine dv_of_drho (dvscf, add_nlcc, drhoc)
! Total response density
!
do ig = 1, ngm
rgtot(ig) = dvscf(nl(ig),1)
rgtot(ig) = dvscf(dfftp%nl(ig),1)
enddo
!
CALL wg_corr_h (omega, ngm, rgtot, dvaux_mt, eh_corr)
@ -152,11 +152,11 @@ subroutine dv_of_drho (dvscf, add_nlcc, drhoc)
do is = 1, nspin_lsda
!
do ig = 1, ngm
dvhart(nl(ig),is) = dvhart(nl(ig),is) + dvaux_mt(ig)
dvhart(dfftp%nl(ig),is) = dvhart(dfftp%nl(ig),is) + dvaux_mt(ig)
enddo
if (gamma_only) then
do ig = 1, ngm
dvhart(nlm(ig),is) = conjg(dvhart(nl(ig),is))
dvhart(dfftp%nlm(ig),is) = conjg(dvhart(dfftp%nl(ig),is))
enddo
endif
!
@ -188,8 +188,8 @@ subroutine dv_of_drho (dvscf, add_nlcc, drhoc)
do ig = 1, ngm
qg2 = (g(1,ig)+xq(1))**2 + (g(2,ig)+xq(2))**2 + (g(3,ig)+xq(3))**2
if (qg2 > 1.d-8) then
dvhart(nl(ig),is) = e2 * fpi * dvscf(nl(ig),1) / (tpiba2 * qg2)
dvhart(nlm(ig),is)=conjg(dvhart(nl(ig),is))
dvhart(dfftp%nl(ig),is) = e2 * fpi * dvscf(dfftp%nl(ig),1) / (tpiba2 * qg2)
dvhart(dfftp%nlm(ig),is)=conjg(dvhart(dfftp%nl(ig),is))
endif
enddo
!
@ -217,8 +217,8 @@ subroutine dv_of_drho (dvscf, add_nlcc, drhoc)
do ig = 1, ngm
qg2 = (g(1,ig)+xq(1))**2 + (g(2,ig)+xq(2))**2 + (g(3,ig)+xq(3))**2
if (qg2 > 1.d-8) then
dvaux(nl(ig),is) = dvaux(nl(ig),is) + &
& e2 * fpi * dvscf(nl(ig),1) / (tpiba2 * qg2)
dvaux(dfftp%nl(ig),is) = dvaux(dfftp%nl(ig),is) + &
& e2 * fpi * dvscf(dfftp%nl(ig),1) / (tpiba2 * qg2)
endif
enddo
ENDIF

25
LR_Modules/dv_rVV10.f90
View File

@ -56,7 +56,7 @@ CONTAINS
subroutine dv_drho_rvv10(rho, drho, nspin, q_point, dv_drho)
USE gvect, ONLY : nl, g, nlm, ngm
USE gvect, ONLY : g, ngm
USE cell_base, ONLY : alat, tpiba, omega
integer, intent(IN) :: nspin
@ -87,7 +87,7 @@ end subroutine dv_drho_rvv10
subroutine get_delta_v(rho, drho, nspin, q_point, delta_v)
USE gvect, ONLY : nl, g, nlm, ngm
USE gvect, ONLY : g, ngm
USE cell_base, ONLY : alat, tpiba, omega
integer, intent(IN) :: nspin
@ -182,7 +182,7 @@ subroutine get_delta_v(rho, drho, nspin, q_point, delta_v)
total_rho(:) = rho(:,1)
call numerical_gradient(total_rho,gradient_rho)
CALL qgradient (q_point, dfftp%nnr, drho(:,1), ngm, g, nl, alat, gradient_drho)
CALL qgradient (q_point, dfftp%nnr, drho(:,1), ngm, g, dfftp%nl, alat, gradient_drho)
call fill_q0_extended_on_grid ()
@ -304,9 +304,9 @@ subroutine get_delta_v(rho, drho, nspin, q_point, delta_v)
CALL fwfft ('Dense', delta_h, dfftp)
delta_h_aux(:) = (0.0_DP, 0.0_DP)
delta_h_aux(nl(:)) = CMPLX(0.0_DP,(g(icar,:)+q_point(icar)),kind=DP ) * delta_h(nl(:))
delta_h_aux(dfftp%nl(:)) = CMPLX(0.0_DP,(g(icar,:)+q_point(icar)),kind=DP ) * delta_h(dfftp%nl(:))
if (gamma_only) delta_h_aux(nlm(:)) = CONJG(delta_h_aux(nl(:)))
if (gamma_only) delta_h_aux(dfftp%nlm(:)) = CONJG(delta_h_aux(dfftp%nl(:)))
CALL invfft ('Dense', delta_h_aux, dfftp)
@ -610,7 +610,7 @@ end SUBROUTINE fill_q0_extended_on_grid
subroutine get_u_delta_u(u, delta_u, q_point)
USE gvect, ONLY : nl, nlm, g, gg, ngm, igtongl, gl, ngl, gstart
USE gvect, ONLY : g, gg, ngm, igtongl, gl, ngl, gstart
USE cell_base, ONLY : tpiba, omega
complex(dp), intent(inout) :: u(dfftp%nnr,Nqs), delta_u(dfftp%nnr,Nqs)
@ -664,18 +664,18 @@ subroutine get_u_delta_u(u, delta_u, q_point)
!! Sum over beta
do q1_i = 1, Nqs
temp_u(nl(g_i), q2_i) = temp_u(nl(g_i), q2_i) + kernel_of_g(q2_i,q1_i)*u(nl(g_i), q1_i)
temp_u(dfftp%nl(g_i), q2_i) = temp_u(dfftp%nl(g_i), q2_i) + kernel_of_g(q2_i,q1_i)*u(dfftp%nl(g_i), q1_i)
temp_delta_u(nl(g_i), q2_i) = temp_delta_u(nl(g_i), q2_i) + &
kernel_of_gq(q2_i,q1_i)*delta_u(nl(g_i), q1_i)
temp_delta_u(dfftp%nl(g_i), q2_i) = temp_delta_u(dfftp%nl(g_i), q2_i) + &
kernel_of_gq(q2_i,q1_i)*delta_u(dfftp%nl(g_i), q1_i)
end do
end do
end do
if (gamma_only) then
temp_u(nlm(:),:) = CONJG(temp_u(nl(:),:))
temp_delta_u(nlm(:),:) = CONJG(temp_delta_u(nl(:),:))
temp_u(dfftp%nlm(:),:) = CONJG(temp_u(dfftp%nl(:),:))
temp_delta_u(dfftp%nlm(:),:) = CONJG(temp_delta_u(dfftp%nl(:),:))
endif
!!
@ -710,7 +710,6 @@ subroutine qgradient (xq, nrxx, a, ngm, g, nl, alat, ga)
use control_flags, ONLY : gamma_only
USE fft_base, ONLY: dfftp
USE fft_interfaces, ONLY: fwfft, invfft
USE gvect, ONLY : nlm
!gamma_only is disregarded for phonon calculations
USE kinds, only : DP
USE constants, ONLY: tpi
@ -735,7 +734,7 @@ subroutine qgradient (xq, nrxx, a, ngm, g, nl, alat, ga)
gaux (:) = (0.d0, 0.d0)
do n = 1, ngm
gaux(nl(n)) = CMPLX(0.d0, xq (ipol) + g (ipol, n),kind=DP) * aux (nl(n))
if (gamma_only) gaux( nlm(n) ) = conjg( gaux( nl(n) ) )
if (gamma_only) gaux( dfftp%nlm(n) ) = conjg( gaux( nl(n) ) )
enddo
! bring back to R-space, (\grad_ipol a)(r) ...

25
LR_Modules/dv_vdW_DF.f90
View File

@ -56,7 +56,7 @@ CONTAINS
subroutine dv_drho_vdwdf(rho, drho, nspin, q_point, dv_drho)
USE gvect, ONLY : nl, g, nlm, ngm
USE gvect, ONLY : g, ngm
USE cell_base, ONLY : alat, tpiba, omega
integer, intent(IN) :: nspin
@ -87,7 +87,7 @@ end subroutine dv_drho_vdwdf
subroutine get_delta_v(rho, drho, nspin, q_point, delta_v)
USE gvect, ONLY : nl, g, nlm, ngm
USE gvect, ONLY : g, ngm
USE cell_base, ONLY : alat, tpiba, omega
integer, intent(IN) :: nspin
@ -180,7 +180,7 @@ subroutine get_delta_v(rho, drho, nspin, q_point, delta_v)
total_rho(:) = rho(:,1)
call numerical_gradient(total_rho,gradient_rho)
CALL qgradient (q_point, dfftp%nnr, drho(:,1), ngm, g, nl, alat, gradient_drho)
CALL qgradient (q_point, dfftp%nnr, drho(:,1), ngm, g, dfftp%nl, alat, gradient_drho)
!! -------------------------------------------------------------------------
!! q and derivatives [REMOVE q0 AND q BEFORE FINAL VERSION]
@ -302,9 +302,9 @@ subroutine get_delta_v(rho, drho, nspin, q_point, delta_v)
CALL fwfft ('Dense', delta_h, dfftp)
delta_h_aux(:) = (0.0_DP, 0.0_DP)
delta_h_aux(nl(:)) = CMPLX(0.0_DP,(g(icar,:)+q_point(icar)),kind=DP ) * delta_h(nl(:))
delta_h_aux(dfftp%nl(:)) = CMPLX(0.0_DP,(g(icar,:)+q_point(icar)),kind=DP ) * delta_h(dfftp%nl(:))
if (gamma_only) delta_h_aux(nlm(:)) = CONJG(delta_h_aux(nl(:)))
if (gamma_only) delta_h_aux(dfftp%nlm(:)) = CONJG(delta_h_aux(dfftp%nl(:)))
CALL invfft ('Dense', delta_h_aux, dfftp)
@ -584,7 +584,7 @@ end SUBROUTINE fill_q0_extended_on_grid
subroutine get_u_delta_u(u, delta_u, q_point)
USE gvect, ONLY : nl, nlm, g, gg, ngm, igtongl, gl, ngl, gstart
USE gvect, ONLY : g, gg, ngm, igtongl, gl, ngl, gstart
USE cell_base, ONLY : tpiba, omega
complex(dp), intent(inout) :: u(dfftp%nnr,Nqs), delta_u(dfftp%nnr,Nqs)
@ -639,18 +639,18 @@ subroutine get_u_delta_u(u, delta_u, q_point)
!! Sum over beta
do q1_i = 1, Nqs
temp_u(nl(g_i), q2_i) = temp_u(nl(g_i), q2_i) + kernel_of_g(q2_i,q1_i)*u(nl(g_i), q1_i)
temp_u(dfftp%nl(g_i), q2_i) = temp_u(dfftp%nl(g_i), q2_i) + kernel_of_g(q2_i,q1_i)*u(dfftp%nl(g_i), q1_i)
temp_delta_u(nl(g_i), q2_i) = temp_delta_u(nl(g_i), q2_i) + &
kernel_of_gq(q2_i,q1_i)*delta_u(nl(g_i), q1_i)
temp_delta_u(dfftp%nl(g_i), q2_i) = temp_delta_u(dfftp%nl(g_i), q2_i) + &
kernel_of_gq(q2_i,q1_i)*delta_u(dfftp%nl(g_i), q1_i)
end do
end do
end do
if (gamma_only) then
temp_u(nlm(:),:) = CONJG(temp_u(nl(:),:))
temp_delta_u(nlm(:),:) = CONJG(temp_delta_u(nl(:),:))
temp_u(dfftp%nlm(:),:) = CONJG(temp_u(dfftp%nl(:),:))
temp_delta_u(dfftp%nlm(:),:) = CONJG(temp_delta_u(dfftp%nl(:),:))
endif
!!
@ -685,7 +685,6 @@ subroutine qgradient (xq, nrxx, a, ngm, g, nl, alat, ga)
use control_flags, ONLY : gamma_only
USE fft_base, ONLY: dfftp
USE fft_interfaces, ONLY: fwfft, invfft
USE gvect, ONLY : nlm
!gamma_only is disregarded for phonon calculations
USE kinds, only : DP
USE constants, ONLY: tpi
@ -710,7 +709,7 @@ subroutine qgradient (xq, nrxx, a, ngm, g, nl, alat, ga)
gaux (:) = (0.d0, 0.d0)
do n = 1, ngm
gaux(nl(n)) = CMPLX(0.d0, xq (ipol) + g (ipol, n),kind=DP) * aux (nl(n))
if (gamma_only) gaux( nlm(n) ) = conjg( gaux( nl(n) ) )
if (gamma_only) gaux( dfftp%nlm(n) ) = conjg( gaux( nl(n) ) )
enddo
! bring back to R-space, (\grad_ipol a)(r) ...

9
LR_Modules/incdrhoscf.f90
View File

@ -18,7 +18,6 @@ subroutine incdrhoscf (drhoscf, weight, ik, dbecsum, dpsi)
USE ions_base, ONLY : nat
USE fft_base, ONLY : dffts
USE fft_interfaces, ONLY : invfft
USE gvecs, ONLY : nls
USE wvfct, ONLY : npwx, nbnd
USE uspp_param, ONLY : nhm
USE wavefunctions_module, ONLY : evc
@ -103,10 +102,10 @@ subroutine incdrhoscf (drhoscf, weight, ik, dbecsum, dpsi)
IF( idx + ibnd - 1 <= nbnd_occ(ikk) ) THEN
!
DO ig = 1, npw
tg_psi( nls( igk_k( ig,ikk ) ) + ioff ) = evc( ig, idx+ibnd-1 )
tg_psi( dffts%nl( igk_k( ig,ikk ) ) + ioff ) = evc( ig, idx+ibnd-1 )
END DO
DO ig = 1, npwq
tg_dpsi( nls( igk_k( ig,ikq ) ) + ioff ) = dpsi( ig, idx+ibnd-1 )
tg_dpsi( dffts%nl( igk_k( ig,ikq ) ) + ioff ) = dpsi( ig, idx+ibnd-1 )
END DO
!
END IF
@ -134,7 +133,7 @@ subroutine incdrhoscf (drhoscf, weight, ik, dbecsum, dpsi)
!
psi (:) = (0.d0, 0.d0)
do ig = 1, npw
psi (nls (igk_k(ig,ikk) ) ) = evc (ig, ibnd)
psi (dffts%nl (igk_k(ig,ikk) ) ) = evc (ig, ibnd)
enddo
CALL invfft ('Wave', psi, dffts)
!
@ -142,7 +141,7 @@ subroutine incdrhoscf (drhoscf, weight, ik, dbecsum, dpsi)
!
dpsic(:) = (0.d0, 0.d0)
do ig = 1, npwq
dpsic (nls (igk_k(ig,ikq) ) ) = dpsi (ig, ibnd)
dpsic (dffts%nl (igk_k(ig,ikq) ) ) = dpsi (ig, ibnd)
enddo
CALL invfft ('Wave', dpsic, dffts)
!

17
LR_Modules/incdrhoscf_nc.f90
View File

@ -18,7 +18,6 @@ subroutine incdrhoscf_nc (drhoscf, weight, ik, dbecsum, dpsi)
USE cell_base, ONLY : omega
USE fft_base, ONLY : dffts, dfftp
USE fft_interfaces, ONLY : invfft
USE gvecs, ONLY : nls
USE lsda_mod, ONLY : nspin
USE spin_orb, ONLY : domag
USE noncollin_module, ONLY : npol, nspin_mag
@ -107,12 +106,12 @@ subroutine incdrhoscf_nc (drhoscf, weight, ik, dbecsum, dpsi)
IF( idx + ibnd - 1 <= nbnd_occ(ikk) ) THEN
!
DO ig = 1, npw
tg_psi( nls( igk_k( ig,ikk ) ) + ioff, 1 ) = evc( ig, idx+ibnd-1 )
tg_psi( nls( igk_k( ig,ikk ) ) + ioff, 2 ) = evc( npwx+ig, idx+ibnd-1 )
tg_psi( dffts%nl( igk_k( ig,ikk ) ) + ioff, 1 ) = evc( ig, idx+ibnd-1 )
tg_psi( dffts%nl( igk_k( ig,ikk ) ) + ioff, 2 ) = evc( npwx+ig, idx+ibnd-1 )
END DO
DO ig = 1, npwq
tg_dpsi( nls( igk_k( ig,ikq ) ) + ioff, 1 ) = dpsi( ig, idx+ibnd-1 )
tg_dpsi( nls( igk_k( ig,ikq ) ) + ioff, 2 ) = dpsi( npwx+ig, idx+ibnd-1 )
tg_dpsi( dffts%nl( igk_k( ig,ikq ) ) + ioff, 1 ) = dpsi( ig, idx+ibnd-1 )
tg_dpsi( dffts%nl( igk_k( ig,ikq ) ) + ioff, 2 ) = dpsi( npwx+ig, idx+ibnd-1 )
END DO
!
END IF
@ -153,8 +152,8 @@ subroutine incdrhoscf_nc (drhoscf, weight, ik, dbecsum, dpsi)
!
psi = (0.d0, 0.d0)
do ig = 1, npw
psi (nls (igk_k(ig,ikk) ), 1) = evc (ig, ibnd)
psi (nls (igk_k(ig,ikk) ), 2) = evc (ig+npwx, ibnd)
psi (dffts%nl (igk_k(ig,ikk) ), 1) = evc (ig, ibnd)
psi (dffts%nl (igk_k(ig,ikk) ), 2) = evc (ig+npwx, ibnd)
enddo
CALL invfft ('Wave', psi(:,1), dffts)
CALL invfft ('Wave', psi(:,2), dffts)
@ -163,8 +162,8 @@ subroutine incdrhoscf_nc (drhoscf, weight, ik, dbecsum, dpsi)
!
dpsic = (0.d0, 0.d0)
do ig = 1, npwq
dpsic (nls (igk_k(ig,ikq)), 1 ) = dpsi (ig, ibnd)
dpsic (nls (igk_k(ig,ikq)), 2 ) = dpsi (ig+npwx, ibnd)
dpsic (dffts%nl (igk_k(ig,ikq)), 1 ) = dpsi (ig, ibnd)
dpsic (dffts%nl (igk_k(ig,ikq)), 2 ) = dpsi (ig+npwx, ibnd)
enddo
CALL invfft ('Wave', dpsic(:,1), dffts)
CALL invfft ('Wave', dpsic(:,2), dffts)

4
LR_Modules/newdq.f90
View File

@ -21,7 +21,7 @@ subroutine newdq (dvscf, npe)
USE cell_base, ONLY : omega
USE fft_base, ONLY : dfftp
USE fft_interfaces, ONLY : fwfft
USE gvect, ONLY : g, gg, ngm, mill, eigts1, eigts2, eigts3, nl
USE gvect, ONLY : g, gg, ngm, mill, eigts1, eigts2, eigts3
USE uspp, ONLY : okvan
USE uspp_param, ONLY : upf, lmaxq, nh, nhm
USE paw_variables, ONLY : okpaw
@ -99,7 +99,7 @@ subroutine newdq (dvscf, npe)
enddo
CALL fwfft ('Dense', veff, dfftp)
do ig = 1, ngm
aux2 (ig, is) = veff (nl (ig) )
aux2 (ig, is) = veff (dfftp%nl (ig) )
enddo
enddo

8
LR_Modules/setup_dgc.f90
View File

@ -18,7 +18,7 @@ subroutine setup_dgc
USE constants, ONLY : e2
USE fft_base, ONLY : dfftp
USE fft_interfaces, ONLY : fwfft
USE gvect, ONLY : ngm, g, nl
USE gvect, ONLY : ngm, g
USE spin_orb, ONLY : domag
USE scf, ONLY : rho, rho_core, rhog_core
USE noncollin_module, ONLY : noncolin, ux, nspin_gga, nspin_mag
@ -77,10 +77,10 @@ subroutine setup_dgc
!
CALL fwfft ('Dense', psic, dfftp)
!
rhogout(:,is) = psic(nl(:))
rhogout(:,is) = psic(dfftp%nl(:))
!
!
CALL gradrho(dfftp%nnr, rhogout(1,is), ngm, g, nl, grho(1,1,is) )
CALL gradrho(dfftp%nnr, rhogout(1,is), ngm, g, dfftp%nl, grho(1,1,is) )
!
END DO
DEALLOCATE(rhogout)
@ -95,7 +95,7 @@ subroutine setup_dgc
enddo
endif
do is = 1, nspin_gga
call gradrho (dfftp%nnr, rho%of_g (1, is), ngm, g, nl, grho (1, 1, is) )
call gradrho (dfftp%nnr, rho%of_g (1, is), ngm, g, dfftp%nl, grho (1, 1, is) )
enddo
END IF