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

More removal of I/O of indices 

git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@12464 c92efa57-630b-4861-b058-cf58834340f0
This commit is contained in:
giannozz 2016-06-04 20:18:02 +00:00
parent 0299c8ed2a
commit 86a67ebed8
3 changed files with 46 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
LR_Modules/commutator_Hx_psi.f90
View File

@ -12,7 +12,7 @@ subroutine commutator_Hx_psi (ik, nbnd_occ, becp1, becp2, ipol, dpsi)
! On output: dpsi contains [H,x_ipol] | psi_ik > in crystal axis
! (projected on at(*,ipol) )
!
! vkb,evc,igk must be properly set for the appropriate k-point
! vkb and evc must be properly set for the appropriate k-point
! in addition becp1 must be set equal to becp1 = <vkb|evc>
! as it is done in PH/phq_init.f90 for the k-point ik
! NB: here the last index of becp1 is missing, hence it refers
@ -24,9 +24,9 @@ subroutine commutator_Hx_psi (ik, nbnd_occ, becp1, becp2, ipol, dpsi)
USE cell_base, ONLY : tpiba, at
USE ions_base, ONLY : nat, ityp, ntyp => nsp
USE io_global, ONLY : stdout
USE klist, ONLY : xk
USE klist, ONLY : xk, igk_k, ngk
USE gvect, ONLY : g
USE wvfct, ONLY : npw, npwx, nbnd, igk, g2kin, et
USE wvfct, ONLY : npwx, nbnd, et
USE wavefunctions_module, ONLY: evc
USE lsda_mod, ONLY : nspin
USE noncollin_module,ONLY : noncolin, npol
@ -44,11 +44,11 @@ subroutine commutator_Hx_psi (ik, nbnd_occ, becp1, becp2, ipol, dpsi)
!
! Local variables
!
integer :: ig, na, ibnd, jbnd, ikb, jkb, nt, lter, ih, jh, ijkb0, &
integer :: npw, ig, na, ibnd, jbnd, ikb, jkb, nt, lter, ih, jh, ijkb0, &
nrec, is, js, ijs
! counters
real(DP), allocatable :: gk (:,:)
real(DP), allocatable :: gk (:,:), g2k(:)
! the derivative of |k+G|
complex(DP), allocatable :: ps2(:,:,:), dvkb (:,:), dvkb1 (:,:), &
work (:,:), psc(:,:,:,:), deff_nc(:,:,:,:)
@ -58,10 +58,11 @@ subroutine commutator_Hx_psi (ik, nbnd_occ, becp1, becp2, ipol, dpsi)
CALL start_clock ('commutator_Hx_psi')
dpsi=(0.d0, 0.d0)
!
allocate (gk ( 3, npwx))
npw = ngk(ik)
allocate (gk(3, npw), g2k(npw) )
do ig = 1, npw
gk (1:3, ig) = (xk (1:3, ik) + g (1:3, igk (ig) ) ) * tpiba
g2kin (ig) = SUM(gk (1:3, ig) **2 )
gk (1:3, ig) = (xk (1:3, ik) + g (1:3, igk_k(ig,ik) ) ) * tpiba
g2k (ig) = SUM(gk (1:3, ig) **2 )
enddo
!
! this is the kinetic contribution to [H,x]: -2i (k+G)_ipol * psi
@ -103,14 +104,14 @@ subroutine commutator_Hx_psi (ik, nbnd_occ, becp1, becp2, ipol, dpsi)
call gen_us_dj (ik, dvkb)
call gen_us_dy (ik, at (1, ipol), dvkb1)
do ig = 1, npw
if (g2kin (ig) < 1.0d-10) then
if (g2k (ig) < 1.0d-10) then
gk (1, ig) = 0.d0
gk (2, ig) = 0.d0
gk (3, ig) = 0.d0
else
gk (1, ig) = gk (1, ig) / sqrt (g2kin (ig) )
gk (2, ig) = gk (2, ig) / sqrt (g2kin (ig) )
gk (3, ig) = gk (3, ig) / sqrt (g2kin (ig) )
gk (1, ig) = gk (1, ig) / sqrt (g2k (ig) )
gk (2, ig) = gk (2, ig) / sqrt (g2k (ig) )
gk (3, ig) = gk (3, ig) / sqrt (g2k (ig) )
endif
enddo
@ -131,7 +132,7 @@ subroutine commutator_Hx_psi (ik, nbnd_occ, becp1, becp2, ipol, dpsi)
endif
enddo
enddo
deallocate (gk)
deallocate (g2k, gk)
! In the case of gamma point systems becp2 is real
! so we have to include a factor of i before calling

27
LR_Modules/incdrhoscf.f90
View File

@ -16,13 +16,14 @@ subroutine incdrhoscf (drhoscf, weight, ik, dbecsum, dpsi)
USE kinds, ONLY : DP
USE cell_base, ONLY : omega
USE ions_base, ONLY : nat
USE fft_base, ONLY: dffts
USE fft_interfaces, ONLY: invfft
USE fft_base, ONLY : dffts
USE fft_interfaces, ONLY : invfft
USE gvecs, ONLY : nls
USE wvfct, ONLY : npw, igk, npwx, nbnd
USE uspp_param, ONLY: nhm
USE wavefunctions_module, ONLY: evc
USE qpoint, ONLY : npwq, igkq, ikks
USE wvfct, ONLY : npwx, nbnd
USE uspp_param, ONLY : nhm
USE wavefunctions_module, ONLY : evc
USE klist, ONLY : ngk,igk_k
USE qpoint, ONLY : ikks, ikqs
USE control_lr, ONLY : nbnd_occ
USE mp_bands, ONLY : me_bgrp, inter_bgrp_comm, ntask_groups
USE mp, ONLY : mp_sum
@ -49,7 +50,8 @@ subroutine incdrhoscf (drhoscf, weight, ik, dbecsum, dpsi)
! the change of wavefunctions in real space
COMPLEX(DP), ALLOCATABLE :: tg_psi(:), tg_dpsi(:), tg_drho(:)
INTEGER :: ibnd, ikk, ir, ig, incr, v_siz, idx, ioff
INTEGER :: npw, npwq, ikk, ikq
INTEGER :: ibnd, ir, ig, incr, v_siz, idx, ioff
! counters
CALL start_clock ('incdrhoscf')
@ -61,6 +63,9 @@ subroutine incdrhoscf (drhoscf, weight, ik, dbecsum, dpsi)
!
wgt = 2.d0 * weight / omega
ikk = ikks(ik)
ikq = ikqs(ik)
npw = ngk(ikk)
npwq= ngk(ikq)
incr = 1
!
IF (dffts%have_task_groups) THEN
@ -96,10 +101,10 @@ subroutine incdrhoscf (drhoscf, weight, ik, dbecsum, dpsi)
IF( idx + ibnd - 1 <= nbnd_occ(ikk) ) THEN
!
DO ig = 1, npw
tg_psi( nls( igk( ig ) ) + ioff ) = evc( ig, idx+ibnd-1 )
tg_psi( nls( igk_k( ig,ikk ) ) + ioff ) = evc( ig, idx+ibnd-1 )
END DO
DO ig = 1, npwq
tg_dpsi( nls( igkq( ig ) ) + ioff ) = dpsi( ig, idx+ibnd-1 )
tg_dpsi( nls( igk_k( ig,ikq ) ) + ioff ) = dpsi( ig, idx+ibnd-1 )
END DO
!
END IF
@ -141,7 +146,7 @@ subroutine incdrhoscf (drhoscf, weight, ik, dbecsum, dpsi)
!
psi (:) = (0.d0, 0.d0)
do ig = 1, npw
psi (nls (igk (ig) ) ) = evc (ig, ibnd)
psi (nls (igk_k(ig,ikk) ) ) = evc (ig, ibnd)
enddo
CALL invfft ('Wave', psi, dffts)
!
@ -149,7 +154,7 @@ subroutine incdrhoscf (drhoscf, weight, ik, dbecsum, dpsi)
!
dpsic(:) = (0.d0, 0.d0)
do ig = 1, npwq
dpsic (nls (igkq (ig) ) ) = dpsi (ig, ibnd)
dpsic (nls (igk_k(ig,ikq) ) ) = dpsi (ig, ibnd)
enddo
CALL invfft ('Wave', dpsic, dffts)
!

27
LR_Modules/incdrhoscf_nc.f90
View File

@ -23,9 +23,10 @@ subroutine incdrhoscf_nc (drhoscf, weight, ik, dbecsum, dpsi)
USE spin_orb, ONLY : domag
USE noncollin_module, ONLY : npol, nspin_mag
USE uspp_param, ONLY : nhm
USE wvfct, ONLY : npw, npwx, igk, nbnd
USE wvfct, ONLY : npwx, nbnd
USE wavefunctions_module, ONLY : evc
USE qpoint, ONLY : npwq, igkq, ikks
USE klist, ONLY : ngk,igk_k
USE qpoint, ONLY : ikks, ikqs
USE control_lr, ONLY : nbnd_occ
USE mp_bands, ONLY : me_bgrp, inter_bgrp_comm, ntask_groups
USE mp, ONLY : mp_sum
@ -53,7 +54,8 @@ subroutine incdrhoscf_nc (drhoscf, weight, ik, dbecsum, dpsi)
!
COMPLEX(DP), ALLOCATABLE :: tg_psi (:,:), tg_dpsi (:,:), tg_drho(:,:)
!
INTEGER :: ibnd, jbnd, ikk, ir, ig, incr, v_siz, idx, ioff, ipol
INTEGER :: npw, npwq, ikk, ikq
INTEGER :: ibnd, jbnd, ir, ig, incr, v_siz, idx, ioff, ipol
! counters
!
CALL start_clock ('incdrhoscf')
@ -65,6 +67,9 @@ subroutine incdrhoscf_nc (drhoscf, weight, ik, dbecsum, dpsi)
!
wgt = 2.d0 * weight / omega
ikk = ikks(ik)
ikq = ikqs(ik)
npw = ngk(ikk)
npwq= ngk(ikq)
incr = 1
!
IF (dffts%have_task_groups) THEN
@ -100,12 +105,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( ig ) ) + ioff, 1 ) = evc( ig, idx+ibnd-1 )
tg_psi( nls( igk( ig ) ) + ioff, 2 ) = evc( npwx+ig, idx+ibnd-1 )
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 )
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 )
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 )
END DO
!
END IF
@ -163,8 +168,8 @@ subroutine incdrhoscf_nc (drhoscf, weight, ik, dbecsum, dpsi)
!
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)
psi (nls (igk_k(ig,ikk) ), 1) = evc (ig, ibnd)
psi (nls (igk_k(ig,ikk) ), 2) = evc (ig+npwx, ibnd)
enddo
CALL invfft ('Wave', psi(:,1), dffts)
CALL invfft ('Wave', psi(:,2), dffts)
@ -173,8 +178,8 @@ subroutine incdrhoscf_nc (drhoscf, weight, ik, dbecsum, dpsi)
!
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)
dpsic (nls (igk_k(ig,ikq)), 1 ) = dpsi (ig, ibnd)
dpsic (nls (igk_k(ig,ikq)), 2 ) = dpsi (ig+npwx, ibnd)
enddo
CALL invfft ('Wave', dpsic(:,1), dffts)
CALL invfft ('Wave', dpsic(:,2), dffts)