Commit 6963f3e5 authored by sponce's avatar sponce

The index igk and igkq are no longer written on files.

The global array igk_k is used.
cft_wave had to be duplicated from LR_Module/cft_wave because of possible shifts in igkq. 



git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@12447 c92efa57-630b-4861-b058-cf58834340f0
parent ecc0bb76
...@@ -24,6 +24,7 @@ allocate_epwq.o \ ...@@ -24,6 +24,7 @@ allocate_epwq.o \
printout_base.o \ printout_base.o \
bcast_epw_input.o \ bcast_epw_input.o \
broyden.o \ broyden.o \
cft_wave_epw.o \
close_epw.o \ close_epw.o \
constants_epw.o \ constants_epw.o \
create_mesh.o \ create_mesh.o \
......
...@@ -20,7 +20,7 @@ ...@@ -20,7 +20,7 @@
! Imported the noncolinear case implemented by xlzhang ! Imported the noncolinear case implemented by xlzhang
! !
USE ions_base, ONLY : nat, ntyp => nsp USE ions_base, ONLY : nat, ntyp => nsp
USE pwcom, ONLY : igk, npwx, nbnd, ngm, nspin, nks USE pwcom, ONLY : npwx, nbnd, ngm, nspin, nks
USE noncollin_module, ONLY : noncolin, npol USE noncollin_module, ONLY : noncolin, npol
USE wavefunctions_module, ONLY: evc USE wavefunctions_module, ONLY: evc
USE spin_orb, ONLY : lspinorb USE spin_orb, ONLY : lspinorb
...@@ -32,7 +32,7 @@ ...@@ -32,7 +32,7 @@
int4, int4_nc, int5, int5_so, becsum_nc, & int4, int4_nc, int5, int5_so, becsum_nc, &
alphasum, alphasum_nc, alphap alphasum, alphasum_nc, alphap
USE lr_symm_base, ONLY : rtau USE lr_symm_base, ONLY : rtau
USE qpoint, ONLY : igkq, eigqts USE qpoint, ONLY : eigqts
USE lrus, ONLY : becp1, int3, int3_nc, dpqq, dpqq_so USE lrus, ONLY : becp1, int3, int3_nc, dpqq, dpqq_so
USE elph2, ONLY : elph, el_ph_mat USE elph2, ONLY : elph, el_ph_mat
USE becmod, ONLY : becp, allocate_bec_type USE becmod, ONLY : becp, allocate_bec_type
...@@ -56,16 +56,14 @@ ...@@ -56,16 +56,14 @@
! !
IF (lgamma) THEN IF (lgamma) THEN
! !
! q=0 : evq and igkq are pointers to evc and igk ! q=0 : evq is a pointers to evc
! !
evq => evc evq => evc
igkq => igk
ELSE ELSE
! !
! q!=0 : evq, igkq are ALLOCATEd and calculated at point k+q ! q!=0 : evq is ALLOCATEd and calculated at point k+q
! !
ALLOCATE (evq ( npwx*npol, nbnd)) ALLOCATE (evq ( npwx*npol, nbnd))
ALLOCATE (igkq ( npwx ))
ENDIF ENDIF
! !
ALLOCATE (dvpsi ( npwx*npol, nbnd)) ALLOCATE (dvpsi ( npwx*npol, nbnd))
......
!
! Copyright (C) 2010-2016 Samuel Ponce', Roxana Margine, Carla Verdi, Feliciano Giustino
! Copyright (C) 2001-2016 Quantum ESPRESSO group
! 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,
! or http://www.gnu.org/copyleft/gpl.txt .
! Adapted from LR_Modules/cft_wave.f90
!
!-----------------------------------------------------------------------
SUBROUTINE cft_wave_epw (igk, npw, igkq, npwq, evc_g, evc_r, isw)
!-----------------------------------------------------------------------
!
! Inverse Fourier (isw=+1) or Fourier (isw=-1) transform of a wavefunction
!
! ik: index of k-point under consideration
! evc_g(npwx*npol): wavefunction in G space, ordering: see below
! evc_r(dffts%nnr,npol): wavefunction in R space, ordering: same as
! real-space points on the "smooth" FFT grid
!
! isw =+1 input: evc_g (ordered as \psi(k+G), using k+G indices)
! output: evc_r = Fourier(evc_g), evc_g = unchanged
! isw =-1 input: evc_r (overwritten on output)
! output: evc_g = evc_g + InvFourier(evc_r)
! ordered as \psi(k+q+G), using k+q+G indices
!
! Further required variables from modules (must be properly initialized,
! unchanged on output):
!
USE kinds, ONLY : DP
USE wvfct, ONLY : npwx
USE fft_base, ONLY : dffts
USE gvecs, ONLY : nls
USE fft_interfaces, ONLY: fwfft, invfft
USE noncollin_module, ONLY : noncolin, npol
IMPLICIT NONE
INTEGER, INTENT(IN) :: isw, npw, npwq
INTEGER, INTENT(IN) :: igk(npw), igkq(npwq)
COMPLEX(DP) :: evc_g (npwx*npol), evc_r (dffts%nnr,npol)
! intent depends upon the value of isw
!
INTEGER :: ig
IF (isw == 1) THEN
evc_r = (0.0_dp, 0.0_dp)
DO ig = 1, npw
evc_r (nls (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)
ENDDO
CALL invfft ('Wave', evc_r(:,2), dffts)
ENDIF
ELSE IF (isw == -1) then
CALL fwfft ('Wave', evc_r(:,1), dffts)
DO ig = 1, npwq
evc_g (ig) = evc_g (ig) + evc_r (nls (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)
ENDDO
ENDIF
ELSE
CALL errore (' cft_wave',' Wrong value for isw',1)
ENDIF
RETURN
END SUBROUTINE cft_wave_epw
!
...@@ -14,7 +14,6 @@ ...@@ -14,7 +14,6 @@
SUBROUTINE close_epw SUBROUTINE close_epw
!------------------------------------------------------------------ !------------------------------------------------------------------
! !
USE io_files, ONLY: iunigk
USE io_epw, ONLY: iunepmatf, iuetf USE io_epw, ONLY: iunepmatf, iuetf
USE phcom, ONLY: iuwfc, iudwf, iudrhous, iudvkb3, fildrho, iudrho USE phcom, ONLY: iuwfc, iudwf, iudrhous, iudvkb3, fildrho, iudrho
USE epwcom, ONLY: elinterp, iuncuf USE epwcom, ONLY: elinterp, iuncuf
...@@ -48,7 +47,5 @@ ...@@ -48,7 +47,5 @@
! CLOSE (unit = iunepmatwp, status = 'delete') ! CLOSE (unit = iunepmatwp, status = 'delete')
! !
ENDIF ENDIF
!
CLOSE (unit = iunigk, status = 'delete')
! !
END SUBROUTINE close_epw END SUBROUTINE close_epw
...@@ -32,20 +32,22 @@ ...@@ -32,20 +32,22 @@
USE lsda_mod, ONLY : lsda, isk USE lsda_mod, ONLY : lsda, isk
USE noncollin_module, ONLY : npol USE noncollin_module, ONLY : npol
use uspp_param, ONLY : upf use uspp_param, ONLY : upf
USE wvfct, ONLY : nbnd, npw, npwx, igk USE wvfct, ONLY : nbnd, npwx
USE wavefunctions_module, ONLY : evc USE wavefunctions_module, ONLY : evc
USE nlcc_ph, ONLY : drc USE nlcc_ph, ONLY : drc
USE uspp, ONLY : nlcc_any USE uspp, ONLY : nlcc_any
USE eqv, ONLY : dvpsi, dmuxc, vlocq USE eqv, ONLY : dvpsi, dmuxc, vlocq
USE qpoint, ONLY : npwq, igkq, eigqts!, ikks USE qpoint, ONLY : eigqts, npwq !, ikks
USE klist, ONLY : ngk
USE elph2, ONLY : igkq, igk
implicit none implicit none
! !
! The dummy variables ! The dummy variables
! !
integer :: ik integer :: ik, npw
! input: the k point ! input: the k point
real(kind=DP) :: xq0(3),xxk(3) real(kind=DP) :: xq0(3), xxk(3)
complex(DP) :: uact (3 * nat) complex(DP) :: uact (3 * nat)
! input: the pattern of displacements ! input: the pattern of displacements
logical :: addnlcc logical :: addnlcc
...@@ -75,6 +77,9 @@ ...@@ -75,6 +77,9 @@
!IF (nlcc_any) THEN !IF (nlcc_any) THEN
! SP - changed according to QE5/PH/dvqpsi_us ! SP - changed according to QE5/PH/dvqpsi_us
!htg = dffts%have_task_groups !htg = dffts%have_task_groups
npw = ngk(ik)
dffts%have_task_groups=.FALSE. dffts%have_task_groups=.FALSE.
IF (nlcc_any.AND.addnlcc) THEN IF (nlcc_any.AND.addnlcc) THEN
ALLOCATE (aux( dfftp%nnr)) ALLOCATE (aux( dfftp%nnr))
......
...@@ -31,10 +31,11 @@ ...@@ -31,10 +31,11 @@
USE noncollin_module, ONLY : noncolin, npol USE noncollin_module, ONLY : noncolin, npol
USE uspp, ONLY : okvan, nkb, vkb USE uspp, ONLY : okvan, nkb, vkb
USE uspp_param, ONLY : nh, nhm USE uspp_param, ONLY : nh, nhm
USE qpoint, ONLY : igkq, npwq USE qpoint, ONLY : npwq
USE phus, ONLY : int1, int1_nc, int2, int2_so, alphap USE phus, ONLY : int1, int1_nc, int2, int2_so, alphap
USE lrus, ONLY : becp1 USE lrus, ONLY : becp1
USE eqv, ONLY : dvpsi USE eqv, ONLY : dvpsi
USE elph2, ONLY : igkq
implicit none implicit none
! !
......
...@@ -84,7 +84,11 @@ ...@@ -84,7 +84,11 @@
irvec(:,:), &! crys coordinates of wigner-seitz vectors (both elec and phon) irvec(:,:), &! crys coordinates of wigner-seitz vectors (both elec and phon)
ndegen(:), &! corresponding degeneragy, electrons (old version) ndegen(:), &! corresponding degeneragy, electrons (old version)
ndegen_k(:), &! corresponding degeneragy, electrons ndegen_k(:), &! corresponding degeneragy, electrons
ndegen_q(:) ! corresponding degeneragy, phonons ndegen_q(:), &! corresponding degeneragy, phonons
igk(:), &! Index for k+G vector
igkq(:), &! Index for k+q+G vector
igk_k_all(:,:), &! Global index (in case of parallel)
ngk_all(:) ! Global number of plane wave for each global k-point
INTEGER, allocatable :: & INTEGER, allocatable :: &
shift (:), &! for every k+q, index of the G0 which folds k+q into k+q+G0 of the first BZ shift (:), &! for every k+q, index of the G0 which folds k+q into k+q+G0 of the first BZ
gmap(:) ! the map G -> G-G_0 in the large (density) G vectors set, for every G_0 gmap(:) ! the map G -> G-G_0 in the large (density) G vectors set, for every G_0
......
...@@ -63,28 +63,29 @@ ...@@ -63,28 +63,29 @@
USE kinds, ONLY : DP USE kinds, ONLY : DP
USE io_global, ONLY : stdout USE io_global, ONLY : stdout
USE wavefunctions_module, ONLY: evc USE wavefunctions_module, ONLY: evc
USE io_files, ONLY : iunigk, diropn, seqopn USE io_files, ONLY : diropn, seqopn
USE wvfct, ONLY : npwx USE wvfct, ONLY : npwx
USE pwcom, ONLY : current_spin, isk, tpiba, g, & USE pwcom, ONLY : current_spin, isk, tpiba, g, &
lsda, nbnd, npw, xk, ngm, & lsda, nbnd, xk, ngm, &
igk, nks nks
USE uspp, ONLY : vkb USE uspp, ONLY : vkb
USE symm_base, ONLY : s USE symm_base, ONLY : s
USE modes, ONLY : u USE modes, ONLY : u
USE phcom, ONLY : iuwfc USE phcom, ONLY : iuwfc
USE qpoint, ONLY : igkq, xq, npwq USE qpoint, ONLY : xq, npwq, ikqs, ikks
USE eqv, ONLY : dvpsi, evq USE eqv, ONLY : dvpsi, evq
USE units_ph, ONLY : lrwfc USE units_ph, ONLY : lrwfc
USE phus, ONLY : alphap USE phus, ONLY : alphap
USE lrus, ONLY : becp1 USE lrus, ONLY : becp1
USE becmod, ONLY : calbec USE becmod, ONLY : calbec
USE elph2, ONLY : shift, gmap, el_ph_mat, umat, umatq, & USE elph2, ONLY : shift, gmap, el_ph_mat, umat, umatq, igk_k_all, &
umat_all, xk_all, et_all, xkq, etq umat_all, xk_all, et_all, xkq, etq, igkq, igk, &
ngk_all
USE fft_base, ONLY : dffts USE fft_base, ONLY : dffts
USE constants_epw, ONLY : czero, cone, ci USE constants_epw, ONLY : czero, cone, ci
USE control_flags, ONLY : iverbosity USE control_flags, ONLY : iverbosity
USE control_lr, ONLY : lgamma USE control_lr, ONLY : lgamma
USE klist, ONLY : nkstot USE klist, ONLY : nkstot, ngk, igk_k
USE noncollin_module, ONLY : noncolin, npol, nspin_mag USE noncollin_module, ONLY : noncolin, npol, nspin_mag
! !
implicit none implicit none
...@@ -102,7 +103,7 @@ ...@@ -102,7 +103,7 @@
! !
integer :: ik, ipert, mode, ibnd, jbnd, ig, nkq, ipool, & integer :: ik, ipert, mode, ibnd, jbnd, ig, nkq, ipool, &
ik0, igkq_tmp (npwx), imap, & ik0, igkq_tmp (npwx), imap, &
ipooltmp, nkq_abs, ipol ipooltmp, nkq_abs, ipol, npw
complex(kind=DP), ALLOCATABLE :: aux1 (:,:), elphmat (:,:,:), eptmp (:,:), aux2(:,:) complex(kind=DP), ALLOCATABLE :: aux1 (:,:), elphmat (:,:,:), eptmp (:,:), aux2(:,:)
!DBSP - NAG complains ... !DBSP - NAG complains ...
COMPLEX(DP),EXTERNAL :: ZDOTC COMPLEX(DP),EXTERNAL :: ZDOTC
...@@ -117,7 +118,7 @@ ...@@ -117,7 +118,7 @@
REAL(kind=DP) :: g0vec_all_r(3,125) REAL(kind=DP) :: g0vec_all_r(3,125)
! G-vectors needed to fold the k+q grid into the k grid, cartesian coord. ! G-vectors needed to fold the k+q grid into the k grid, cartesian coord.
INTEGER :: ng0vec, ngxx INTEGER :: ng0vec, ngxx, lower_bnd, upper_bnd
! number of inequivalent such translations ! number of inequivalent such translations
! bound for the allocation of the array gmap ! bound for the allocation of the array gmap
! !
...@@ -154,12 +155,16 @@ ...@@ -154,12 +155,16 @@
IF (nproc_pool>1) call errore & IF (nproc_pool>1) call errore &
('elphel2_shuffle', 'ONLY one proc per pool in shuffle mode', 1) ('elphel2_shuffle', 'ONLY one proc per pool in shuffle mode', 1)
#endif #endif
!
! find the bounds of k-dependent arrays in the parallel case in each pool
CALL fkbounds( nkstot, lower_bnd, upper_bnd )
!
IF (.not.lgamma) THEN IF (.not.lgamma) THEN
! !
! setup for k+q folding ! setup for k+q folding
! !
CALL kpointdivision ( ik0 ) CALL kpointdivision ( ik0 )
CALL readgmap ( nkstot, ngxx, ng0vec, g0vec_all_r ) CALL readgmap ( nkstot, ngxx, ng0vec, g0vec_all_r, lower_bnd)
! !
IF (imode0.eq.0 .and. iverbosity.eq.1) WRITE(stdout, 5) ngxx IF (imode0.eq.0 .and. iverbosity.eq.1) WRITE(stdout, 5) ngxx
5 FORMAT (5x,'Estimated size of gmap: ngxx =',i5) 5 FORMAT (5x,'Estimated size of gmap: ngxx =',i5)
...@@ -169,7 +174,6 @@ ...@@ -169,7 +174,6 @@
! close all sequential files in order to re-open them as direct access ! close all sequential files in order to re-open them as direct access
! close all .wfc files in order to prepare shuffled read ! close all .wfc files in order to prepare shuffled read
! !
CLOSE (unit = iunigk, status = 'keep')
CLOSE (unit = iuwfc, status = 'keep') CLOSE (unit = iuwfc, status = 'keep')
#ifdef __PARA #ifdef __PARA
! never remove this barrier ! never remove this barrier
...@@ -191,10 +195,7 @@ ...@@ -191,10 +195,7 @@
! below and also that the eigenvalues are taken correctly in ephwann) ! below and also that the eigenvalues are taken correctly in ephwann)
! !
#ifdef __PARA #ifdef __PARA
!write(*,*)'ik ',ik
ipooltmp= my_pool_id+1 ipooltmp= my_pool_id+1
!write(*,*)'ipooltmp',ipooltmp
!write(*,*)'ipool',ipool
#endif #endif
! !
! !
...@@ -213,10 +214,20 @@ ...@@ -213,10 +214,20 @@
! in parallel mypool is for k and ipool is for k+q ! in parallel mypool is for k and ipool is for k+q
! !
CALL readwfc (ipooltmp, ik, evc) CALL readwfc (ipooltmp, ik, evc)
CALL readigk (ipooltmp, ik, npw, igk)
!
CALL readwfc (ipool, nkq, evq) CALL readwfc (ipool, nkq, evq)
CALL readigk (ipool, nkq, npwq, igkq) !
! Now we define the igk and igkq from the global igk_k_all
!
npw = ngk_all(ik+lower_bnd-1)
npwq = ngk_all(nkq_abs)
!
IF (ALLOCATED(igk)) DEALLOCATE(igk)
IF (ALLOCATED(igkq)) DEALLOCATE(igkq)
ALLOCATE( igk(npw) )
ALLOCATE( igkq(npwq) )
!
igk = igk_k_all(1:npw,ik+lower_bnd-1)
igkq = igk_k_all(1:npwq,nkq_abs)
! !
#ifdef __PARA #ifdef __PARA
IF (.not.lgamma .and. nks.gt.1 .and. maxval(igkq(1:npwq)).gt.ngxx) & IF (.not.lgamma .and. nks.gt.1 .and. maxval(igkq(1:npwq)).gt.ngxx) &
...@@ -364,13 +375,13 @@ ...@@ -364,13 +375,13 @@
! !
aux2=(0.0_DP,0.0_DP) aux2=(0.0_DP,0.0_DP)
DO ibnd = 1, nbnd !, incr DO ibnd = 1, nbnd !, incr
CALL cft_wave (evc(:, ibnd), aux1, +1) CALL cft_wave_epw (igk, npw, igkq, npwq, evc(:, ibnd), aux1, +1)
IF (timerev) THEN IF (timerev) THEN
CALL apply_dpot(dffts%nnr, aux1, CONJG(dvscfins(:,:,ipert)),current_spin) CALL apply_dpot(dffts%nnr, aux1, CONJG(dvscfins(:,:,ipert)),current_spin)
ELSE ELSE
CALL apply_dpot(dffts%nnr, aux1, dvscfins(:,:,ipert),current_spin) CALL apply_dpot(dffts%nnr, aux1, dvscfins(:,:,ipert),current_spin)
ENDIF ENDIF
CALL cft_wave (aux2(:, ibnd), aux1, -1) CALL cft_wave_epw (igk, npw, igkq, npwq, aux2(:, ibnd), aux1, -1)
ENDDO ENDDO
dvpsi=dvpsi+aux2 dvpsi=dvpsi+aux2
!DBSP !DBSP
...@@ -432,7 +443,6 @@ ...@@ -432,7 +443,6 @@
! !
! restore original configuration of files ! restore original configuration of files
! !
CALL seqopn (iunigk, 'igk', 'unformatted', exst)
CALL diropn (iuwfc, 'wfc', lrwfc, exst) CALL diropn (iuwfc, 'wfc', lrwfc, exst)
#ifdef __PARA #ifdef __PARA
! never remove this barrier - > insures that wfcs are restored to each pool before moving on ! never remove this barrier - > insures that wfcs are restored to each pool before moving on
......
...@@ -53,7 +53,8 @@ ...@@ -53,7 +53,8 @@
iswitch, kmaps, nest_fn, eig_read, & iswitch, kmaps, nest_fn, eig_read, &
band_plot, specfun, dvscf_dir, lpolar band_plot, specfun, dvscf_dir, lpolar
USE elph2, ONLY : epmatq, dynq, sumr, et_all, xk_all, et_mb, et_ks, & USE elph2, ONLY : epmatq, dynq, sumr, et_all, xk_all, et_mb, et_ks, &
zstar, epsi, cu, cuq, lwin, lwinq, bmat zstar, epsi, cu, cuq, lwin, lwinq, bmat, igk_k_all, &
ngk_all
USE constants_epw, ONLY : ryd2ev USE constants_epw, ONLY : ryd2ev
USE fft_base, ONLY : dfftp USE fft_base, ONLY : dfftp
USE control_ph, ONLY : u_from_file USE control_ph, ONLY : u_from_file
...@@ -655,18 +656,20 @@ ...@@ -655,18 +656,20 @@
! !
! free up some memory ! free up some memory
! !
IF ( ASSOCIATED (evq) ) NULLIFY (evq) IF ( ASSOCIATED (evq) ) NULLIFY (evq)
IF ( ALLOCATED (evc) ) DEALLOCATE (evc) IF ( ALLOCATED (evc) ) DEALLOCATE (evc)
IF ( ASSOCIATED (igkq) ) NULLIFY (igkq) IF ( ASSOCIATED (igkq) ) NULLIFY (igkq)
IF ( ALLOCATED (igk) ) DEALLOCATE (igk) IF ( ALLOCATED (igk) ) DEALLOCATE (igk)
IF ( ALLOCATED (dvpsi)) DEALLOCATE (dvpsi) IF ( ALLOCATED (dvpsi)) DEALLOCATE (dvpsi)
IF ( ALLOCATED (dpsi) ) DEALLOCATE (dpsi) IF ( ALLOCATED (dpsi) ) DEALLOCATE (dpsi)
IF ( ALLOCATED (sumr) ) DEALLOCATE (sumr) IF ( ALLOCATED (sumr) ) DEALLOCATE (sumr)
IF ( ALLOCATED (cu) ) DEALLOCATE (cu) IF ( ALLOCATED (cu) ) DEALLOCATE (cu)
IF ( ALLOCATED (cuq) ) DEALLOCATE (cuq) IF ( ALLOCATED (cuq) ) DEALLOCATE (cuq)
IF ( ALLOCATED (lwin) ) DEALLOCATE (lwin) IF ( ALLOCATED (lwin) ) DEALLOCATE (lwin)
IF ( ALLOCATED (lwinq) ) DEALLOCATE (lwinq) IF ( ALLOCATED (lwinq) ) DEALLOCATE (lwinq)
IF ( ALLOCATED (bmat) ) DEALLOCATE (bmat) IF ( ALLOCATED (bmat) ) DEALLOCATE (bmat)
IF ( ALLOCATED (igk_k_all) ) DEALLOCATE(igk_k_all)
IF ( ALLOCATED (ngk_all) ) DEALLOCATE(ngk_all)
! !
CALL stop_clock ( 'elphon_wrap' ) CALL stop_clock ( 'elphon_wrap' )
!DBSP !DBSP
......
...@@ -20,11 +20,12 @@ ...@@ -20,11 +20,12 @@
USE phus, ONLY : alphap USE phus, ONLY : alphap
USE lrus, ONLY : becp1 USE lrus, ONLY : becp1
USE uspp, ONLY : vkb USE uspp, ONLY : vkb
USE io_files, ONLY : iunigk
USE pwcom, ONLY : npwx, nbnd, tpi, nks, lsda, current_spin,& USE pwcom, ONLY : npwx, nbnd, tpi, nks, lsda, current_spin,&
tpiba2, npw, igk, tpiba, bg, & tpiba2, tpiba, bg, &
eigts1, eigts2, eigts3, g, g2kin, isk, & eigts1, eigts2, eigts3, g, g2kin, isk, &
ngm, xk, strf, omega ngm, xk, strf, omega
USE klist, ONLY : ngk, igk_k, nkstot
USE constants_epw, ONLY : zero
USE gvecw, ONLY : ecutwfc USE gvecw, ONLY : ecutwfc
USE atom, ONLY : msh, rgrid USE atom, ONLY : msh, rgrid
USE wavefunctions_module, ONLY : evc USE wavefunctions_module, ONLY : evc
...@@ -36,6 +37,11 @@ ...@@ -36,6 +37,11 @@
USE nlcc_ph, ONLY : drc USE nlcc_ph, ONLY : drc
USE uspp, ONLY : nlcc_any USE uspp, ONLY : nlcc_any
USE fft_base, ONLY : dfftp USE fft_base, ONLY : dfftp
USE elph2, ONLY : igk_k_all, ngk_all
#ifdef __PARA
USE mp, ONLY : mp_barrier
USE mp_global, ONLY : inter_pool_comm
#endif
! !
IMPLICIT NONE IMPLICIT NONE
! !
...@@ -104,12 +110,8 @@ ...@@ -104,12 +110,8 @@
! parameters which define the non-local pseudopotential and ! parameters which define the non-local pseudopotential and
! which are independent of the k point for the US case ! which are independent of the k point for the US case
! !
!
! this was in the phq_init routine. uspp?
CALL init_us_1() CALL init_us_1()
! !
REWIND( iunigk )
!
DO ik = 1, nks DO ik = 1, nks
! !
! !
...@@ -117,16 +119,15 @@ ...@@ -117,16 +119,15 @@
! !
! g2kin is used here as work space ! g2kin is used here as work space
! !
CALL gk_sort( xk(1,ik), ngm, g, ( ecutwfc / tpiba2 ), npw, igk, g2kin ) CALL gk_sort( xk(1,ik), ngm, g, ( ecutwfc / tpiba2 ), ngk(ik), igk_k(1,ik), g2kin )
! !
! if there is only one k-point evc, evq, npw, igk stay in memory ! if there is only one k-point evc, evq, npw, igk stay in memory
! !
WRITE( iunigk ) npw, igk npwq = ngk(ik)
! !
npwq = npw
! The functions vkb(k+G) ! The functions vkb(k+G)
! !
CALL init_us_2( npw, igk, xk(1,ik), vkb ) CALL init_us_2( ngk(ik), igk_k(1,ik), xk(1,ik), vkb )
! !
! ... read the wavefunctions at k ! ... read the wavefunctions at k
! !
...@@ -136,9 +137,9 @@ ...@@ -136,9 +137,9 @@
! the code ! the code
! !
IF (noncolin) THEN IF (noncolin) THEN
CALL calbec (npw, vkb, evc, becp1(ik)%nc(:,:,:) ) CALL calbec (ngk(ik), vkb, evc, becp1(ik)%nc(:,:,:) )
ELSE ELSE
CALL calbec (npw, vkb, evc, becp1(ik)%k(:,:)) CALL calbec (ngk(ik), vkb, evc, becp1(ik)%k(:,:))
ENDIF ENDIF
! !
! we compute the derivative of the becp term with respect to an ! we compute the derivative of the becp term with respect to an
...@@ -147,26 +148,42 @@ ...@@ -147,26 +148,42 @@
DO ipol = 1, 3 DO ipol = 1, 3
aux1=(0.d0,0.d0) aux1=(0.d0,0.d0)
DO ibnd = 1, nbnd DO ibnd = 1, nbnd
DO ig = 1, npw DO ig = 1, ngk(ik)
aux1(ig,ibnd) = evc(ig,ibnd) * tpiba * ( 0.D0, 1.D0 ) * & aux1(ig,ibnd) = evc(ig,ibnd) * tpiba * ( 0.D0, 1.D0 ) * &
( xk(ipol,ik) + g(ipol,igk(ig)) ) ( xk(ipol,ik) + g(ipol,igk_k(ig,ik)) )
ENDDO ENDDO
IF (noncolin) THEN IF (noncolin) THEN
DO ig = 1, npw DO ig = 1, ngk(ik)
aux1(ig+npwx,ibnd) = evc(ig+npwx,ibnd)*tpiba*(0.D0,1.D0)*& aux1(ig+npwx,ibnd) = evc(ig+npwx,ibnd)*tpiba*(0.D0,1.D0)*&
( xk(ipol,ik) + g(ipol,igk(ig)) ) ( xk(ipol,ik) + g(ipol,igk_k(ig,ik)) )
ENDDO ENDDO
ENDIF ENDIF
ENDDO ENDDO
IF (noncolin) THEN IF (noncolin) THEN
CALL calbec (npw, vkb, aux1, alphap(ipol,ik)%nc(:,:,:) ) CALL calbec (ngk(ik), vkb, aux1, alphap(ipol,ik)%nc(:,:,:) )
ELSE ELSE
CALL calbec (npw, vkb, aux1, alphap(ipol,ik)%k(:,:) ) CALL calbec (ngk(ik), vkb, aux1, alphap(ipol,ik)%k(:,:) )
ENDIF ENDIF
ENDDO ENDDO
! !
! !
ENDDO ENDDO
!
IF(.not. ALLOCATED(igk_k_all) ) ALLOCATE(igk_k_all( npwx, nkstot))
IF(.not. ALLOCATED(ngk_all) ) ALLOCATE(ngk_all(nkstot))
!
#ifdef __PARA
!
CALL poolgather_int (npwx, nkstot, nks, igk_k(:,1:nks), igk_k_all )
CALL poolgather_int1 (nkstot, nks, ngk(1:nks), ngk_all )
CALL mp_barrier(inter_pool_comm)
!
#else
!
igk_k_all = igk_k
ngk_all = ngk
!
#endif
! !
DEALLOCATE( aux1 ) DEALLOCATE( aux1 )