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 \
printout_base.o \
bcast_epw_input.o \
broyden.o \
cft_wave_epw.o \
close_epw.o \
constants_epw.o \
create_mesh.o \
......
......@@ -20,7 +20,7 @@
! Imported the noncolinear case implemented by xlzhang
!
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 wavefunctions_module, ONLY: evc
USE spin_orb, ONLY : lspinorb
......@@ -32,7 +32,7 @@
int4, int4_nc, int5, int5_so, becsum_nc, &
alphasum, alphasum_nc, alphap
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 elph2, ONLY : elph, el_ph_mat
USE becmod, ONLY : becp, allocate_bec_type
......@@ -56,16 +56,14 @@
!
IF (lgamma) THEN
!
! q=0 : evq and igkq are pointers to evc and igk
! q=0 : evq is a pointers to evc
!
evq => evc
igkq => igk
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 (igkq ( npwx ))
ENDIF
!
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 @@
SUBROUTINE close_epw
!------------------------------------------------------------------
!
USE io_files, ONLY: iunigk
USE io_epw, ONLY: iunepmatf, iuetf
USE phcom, ONLY: iuwfc, iudwf, iudrhous, iudvkb3, fildrho, iudrho
USE epwcom, ONLY: elinterp, iuncuf
......@@ -48,7 +47,5 @@
! CLOSE (unit = iunepmatwp, status = 'delete')
!
ENDIF
!
CLOSE (unit = iunigk, status = 'delete')
!
END SUBROUTINE close_epw
......@@ -32,20 +32,22 @@
USE lsda_mod, ONLY : lsda, isk
USE noncollin_module, ONLY : npol
use uspp_param, ONLY : upf
USE wvfct, ONLY : nbnd, npw, npwx, igk
USE wvfct, ONLY : nbnd, npwx
USE wavefunctions_module, ONLY : evc
USE nlcc_ph, ONLY : drc
USE uspp, ONLY : nlcc_any
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
!
! The dummy variables
!
integer :: ik
integer :: ik, npw
! input: the k point
real(kind=DP) :: xq0(3),xxk(3)
real(kind=DP) :: xq0(3), xxk(3)
complex(DP) :: uact (3 * nat)
! input: the pattern of displacements
logical :: addnlcc
......@@ -75,6 +77,9 @@
!IF (nlcc_any) THEN
! SP - changed according to QE5/PH/dvqpsi_us
!htg = dffts%have_task_groups
npw = ngk(ik)
dffts%have_task_groups=.FALSE.
IF (nlcc_any.AND.addnlcc) THEN
ALLOCATE (aux( dfftp%nnr))
......
......@@ -31,10 +31,11 @@
USE noncollin_module, ONLY : noncolin, npol
USE uspp, ONLY : okvan, nkb, vkb
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 lrus, ONLY : becp1
USE eqv, ONLY : dvpsi
USE elph2, ONLY : igkq
implicit none
!
......
......@@ -84,7 +84,11 @@
irvec(:,:), &! crys coordinates of wigner-seitz vectors (both elec and phon)
ndegen(:), &! corresponding degeneragy, electrons (old version)
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 :: &
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
......
......@@ -63,28 +63,29 @@
USE kinds, ONLY : DP
USE io_global, ONLY : stdout
USE wavefunctions_module, ONLY: evc
USE io_files, ONLY : iunigk, diropn, seqopn
USE io_files, ONLY : diropn, seqopn
USE wvfct, ONLY : npwx
USE pwcom, ONLY : current_spin, isk, tpiba, g, &
lsda, nbnd, npw, xk, ngm, &
igk, nks
lsda, nbnd, xk, ngm, &
nks
USE uspp, ONLY : vkb
USE symm_base, ONLY : s
USE modes, ONLY : u
USE phcom, ONLY : iuwfc
USE qpoint, ONLY : igkq, xq, npwq
USE qpoint, ONLY : xq, npwq, ikqs, ikks
USE eqv, ONLY : dvpsi, evq
USE units_ph, ONLY : lrwfc
USE phus, ONLY : alphap
USE lrus, ONLY : becp1
USE becmod, ONLY : calbec
USE elph2, ONLY : shift, gmap, el_ph_mat, umat, umatq, &
umat_all, xk_all, et_all, xkq, etq
USE elph2, ONLY : shift, gmap, el_ph_mat, umat, umatq, igk_k_all, &
umat_all, xk_all, et_all, xkq, etq, igkq, igk, &
ngk_all
USE fft_base, ONLY : dffts
USE constants_epw, ONLY : czero, cone, ci
USE control_flags, ONLY : iverbosity
USE control_lr, ONLY : lgamma
USE klist, ONLY : nkstot
USE klist, ONLY : nkstot, ngk, igk_k
USE noncollin_module, ONLY : noncolin, npol, nspin_mag
!
implicit none
......@@ -102,7 +103,7 @@
!
integer :: ik, ipert, mode, ibnd, jbnd, ig, nkq, ipool, &
ik0, igkq_tmp (npwx), imap, &
ipooltmp, nkq_abs, ipol
ipooltmp, nkq_abs, ipol, npw
complex(kind=DP), ALLOCATABLE :: aux1 (:,:), elphmat (:,:,:), eptmp (:,:), aux2(:,:)
!DBSP - NAG complains ...
COMPLEX(DP),EXTERNAL :: ZDOTC
......@@ -117,7 +118,7 @@
REAL(kind=DP) :: g0vec_all_r(3,125)
! 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
! bound for the allocation of the array gmap
!
......@@ -154,12 +155,16 @@
IF (nproc_pool>1) call errore &
('elphel2_shuffle', 'ONLY one proc per pool in shuffle mode', 1)
#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
!
! setup for k+q folding
!
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
5 FORMAT (5x,'Estimated size of gmap: ngxx =',i5)
......@@ -169,7 +174,6 @@
! close all sequential files in order to re-open them as direct access
! close all .wfc files in order to prepare shuffled read
!
CLOSE (unit = iunigk, status = 'keep')
CLOSE (unit = iuwfc, status = 'keep')
#ifdef __PARA
! never remove this barrier
......@@ -191,10 +195,7 @@
! below and also that the eigenvalues are taken correctly in ephwann)
!
#ifdef __PARA
!write(*,*)'ik ',ik
ipooltmp= my_pool_id+1
!write(*,*)'ipooltmp',ipooltmp
!write(*,*)'ipool',ipool
#endif
!
!
......@@ -213,10 +214,20 @@
! in parallel mypool is for k and ipool is for k+q
!
CALL readwfc (ipooltmp, ik, evc)
CALL readigk (ipooltmp, ik, npw, igk)
!
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
IF (.not.lgamma .and. nks.gt.1 .and. maxval(igkq(1:npwq)).gt.ngxx) &
......@@ -364,13 +375,13 @@
!
aux2=(0.0_DP,0.0_DP)
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
CALL apply_dpot(dffts%nnr, aux1, CONJG(dvscfins(:,:,ipert)),current_spin)
ELSE
CALL apply_dpot(dffts%nnr, aux1, dvscfins(:,:,ipert),current_spin)
ENDIF
CALL cft_wave (aux2(:, ibnd), aux1, -1)
CALL cft_wave_epw (igk, npw, igkq, npwq, aux2(:, ibnd), aux1, -1)
ENDDO
dvpsi=dvpsi+aux2
!DBSP
......@@ -432,7 +443,6 @@
!
! restore original configuration of files
!
CALL seqopn (iunigk, 'igk', 'unformatted', exst)
CALL diropn (iuwfc, 'wfc', lrwfc, exst)
#ifdef __PARA
! never remove this barrier - > insures that wfcs are restored to each pool before moving on
......
......@@ -53,7 +53,8 @@
iswitch, kmaps, nest_fn, eig_read, &
band_plot, specfun, dvscf_dir, lpolar
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 fft_base, ONLY : dfftp
USE control_ph, ONLY : u_from_file
......@@ -655,18 +656,20 @@
!
! free up some memory
!
IF ( ASSOCIATED (evq) ) NULLIFY (evq)
IF ( ALLOCATED (evc) ) DEALLOCATE (evc)
IF ( ASSOCIATED (igkq) ) NULLIFY (igkq)
IF ( ALLOCATED (igk) ) DEALLOCATE (igk)
IF ( ALLOCATED (dvpsi)) DEALLOCATE (dvpsi)
IF ( ALLOCATED (dpsi) ) DEALLOCATE (dpsi)
IF ( ALLOCATED (sumr) ) DEALLOCATE (sumr)
IF ( ALLOCATED (cu) ) DEALLOCATE (cu)
IF ( ALLOCATED (cuq) ) DEALLOCATE (cuq)
IF ( ALLOCATED (lwin) ) DEALLOCATE (lwin)
IF ( ALLOCATED (lwinq) ) DEALLOCATE (lwinq)
IF ( ALLOCATED (bmat) ) DEALLOCATE (bmat)
IF ( ASSOCIATED (evq) ) NULLIFY (evq)
IF ( ALLOCATED (evc) ) DEALLOCATE (evc)
IF ( ASSOCIATED (igkq) ) NULLIFY (igkq)
IF ( ALLOCATED (igk) ) DEALLOCATE (igk)
IF ( ALLOCATED (dvpsi)) DEALLOCATE (dvpsi)
IF ( ALLOCATED (dpsi) ) DEALLOCATE (dpsi)
IF ( ALLOCATED (sumr) ) DEALLOCATE (sumr)
IF ( ALLOCATED (cu) ) DEALLOCATE (cu)
IF ( ALLOCATED (cuq) ) DEALLOCATE (cuq)
IF ( ALLOCATED (lwin) ) DEALLOCATE (lwin)
IF ( ALLOCATED (lwinq) ) DEALLOCATE (lwinq)
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' )
!DBSP
......
......@@ -20,11 +20,12 @@
USE phus, ONLY : alphap
USE lrus, ONLY : becp1
USE uspp, ONLY : vkb
USE io_files, ONLY : iunigk
USE pwcom, ONLY : npwx, nbnd, tpi, nks, lsda, current_spin,&
tpiba2, npw, igk, tpiba, bg, &
tpiba2, tpiba, bg, &
eigts1, eigts2, eigts3, g, g2kin, isk, &
ngm, xk, strf, omega
USE klist, ONLY : ngk, igk_k, nkstot
USE constants_epw, ONLY : zero
USE gvecw, ONLY : ecutwfc
USE atom, ONLY : msh, rgrid
USE wavefunctions_module, ONLY : evc
......@@ -36,6 +37,11 @@
USE nlcc_ph, ONLY : drc
USE uspp, ONLY : nlcc_any
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
!
......@@ -104,12 +110,8 @@
! parameters which define the non-local pseudopotential and
! which are independent of the k point for the US case
!
!
! this was in the phq_init routine. uspp?
CALL init_us_1()
!
REWIND( iunigk )
!
DO ik = 1, nks
!
!
......@@ -117,16 +119,15 @@
!
! 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
!
WRITE( iunigk ) npw, igk
npwq = ngk(ik)
!
npwq = npw
! 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
!
......@@ -136,9 +137,9 @@
! the code
!
IF (noncolin) THEN
CALL calbec (npw, vkb, evc, becp1(ik)%nc(:,:,:) )
CALL calbec (ngk(ik), vkb, evc, becp1(ik)%nc(:,:,:) )
ELSE
CALL calbec (npw, vkb, evc, becp1(ik)%k(:,:))
CALL calbec (ngk(ik), vkb, evc, becp1(ik)%k(:,:))
ENDIF
!
! we compute the derivative of the becp term with respect to an
......@@ -147,26 +148,42 @@
DO ipol = 1, 3
aux1=(0.d0,0.d0)
DO ibnd = 1, nbnd
DO ig = 1, npw
DO ig = 1, ngk(ik)
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
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)*&
( xk(ipol,ik) + g(ipol,igk(ig)) )
( xk(ipol,ik) + g(ipol,igk_k(ig,ik)) )
ENDDO
ENDIF
ENDDO
IF (noncolin) THEN
CALL calbec (npw, vkb, aux1, alphap(ipol,ik)%nc(:,:,:) )
CALL calbec (ngk(ik), vkb, aux1, alphap(ipol,ik)%nc(:,:,:) )
ELSE
CALL calbec (npw, vkb, aux1, alphap(ipol,ik)%k(:,:) )
CALL calbec (ngk(ik), vkb, aux1, alphap(ipol,ik)%k(:,:) )
ENDIF
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 )
!
......
......@@ -19,7 +19,7 @@
!
!-----------------------------------------------------------------------
use mp_global, ONLY : me_pool
use io_files, ONLY : prefix, iunigk, tmp_dir, &
use io_files, ONLY : prefix, tmp_dir, &
diropn, seqopn
use units_ph, ONLY : iudrhous, lrdrhous, iudvkb3, iuwfc
USE uspp, ONLY : nkb, okvan
......@@ -61,15 +61,6 @@
#ifdef __PARA
300 continue
#endif
!
! Here the sequential files
!
! The igk at a given k (and k+q if q!=0)
!
iunigk = 24
filint = trim(prefix) //'.igk'
CALL seqopn (iunigk, 'igk', 'unformatted', exst)
!
!
! file for setting unitary gauges of eigenstates
!
......
......@@ -27,12 +27,12 @@
implicit none
!
INTEGER :: nsize, nks, nkstot
! first dimension of vectors f_in and f_out
! number of k-points per pool
! total number of k-points
! first dimension of vectors f_in and f_out
! number of k-points per pool
! total number of k-points
REAL (KIND=DP) :: f_in(nsize,nks), f_out(nsize,nkstot)
! input ( only for k-points of mypool )
! output ( contains values for all k-point )
! input ( only for k-points of mypool )
! output ( contains values for all k-point )
!
#ifdef __PARA
INTEGER :: rest, nbase
......@@ -78,17 +78,17 @@
implicit none
!
INTEGER :: nsize, nks, nkstot
! first dimension of vectors f_in and f_out
! number of k-points per pool
! total number of k-points
! first dimension of vectors f_in and f_out
! number of k-points per pool
! total number of k-points
REAL (KIND=DP) :: f_in(nsize,nks), f_out(nsize,nkstot)
! input ( only for k-points of mypool )
! output ( contains values for all k-point )
! input ( only for k-points of mypool )
! output ( contains values for all k-point )
!
#ifdef __PARA
INTEGER :: rest, nbase, nkst
! the rest of the integer division nkstot / npo
! the position in the original list
! the rest of the integer division nkstot / npo
! the position in the original list
!
nkst = 2 * ( nkstot / 2 / npool )
rest = ( nkstot - nkst * npool ) / 2
......@@ -112,5 +112,106 @@
!
end subroutine poolgather2
!
!----------------
subroutine poolgather_int1 ( nkstot, nks, f_in, f_out)
!--------------------------------------------------------------------
!
! gather the kpoints and the electronic eigenvalues
! across the pools
! works with the double grid (k and k+q)
! define rest and nbase as in loadkmesh_para subroutine
!
!--------------------------------------------------------------------
USE kinds, ONLY : DP
#ifdef __PARA
USE mp_global, ONLY : my_pool_id, nproc_pool, &
inter_pool_comm, me_pool, root_pool, kunit,npool, my_pool_id
USE mp, ONLY : mp_barrier, mp_bcast,mp_sum
USE mp_world, ONLY : mpime
#endif
implicit none
!
INTEGER :: nks, nkstot
! number of k-points per pool
! total number of k-points
INTEGER :: f_in(nks), f_out(nkstot)
! input ( only for k-points of mypool )
! output ( contains values for all k-point )
!
#ifdef __PARA
INTEGER :: rest, nbase
! the rest of the integer division nkstot / npo
! the position in the original list
!
rest = nkstot / kunit - ( nkstot / kunit / npool ) * npool
!
nbase = nks * my_pool_id
!
IF ( ( my_pool_id + 1 ) > rest ) nbase = nbase + rest * kunit
f_out = 0
f_out((nbase+1):(nbase+nks)) = f_in(1:nks)
!
! ... reduce across the pools
!
CALL mp_sum(f_out,inter_pool_comm)
!
#else
f_out(:) = f_in(:)
!
#endif
!
end subroutine poolgather_int1
!
!--------------------------------------------------------------------
subroutine poolgather_int (nsize, nkstot, nks, f_in, f_out)
!--------------------------------------------------------------------
!
! gather the kpoints and the electronic eigenvalues
! across the pools
! works with the double grid (k and k+q)
! define rest and nbase as in loadkmesh_para subroutine
!
!--------------------------------------------------------------------
USE kinds, ONLY : DP
#ifdef __PARA
USE mp_global, ONLY : my_pool_id, nproc_pool, &
inter_pool_comm, me_pool, root_pool, kunit,npool, my_pool_id
USE mp, ONLY : mp_barrier, mp_bcast,mp_sum
USE mp_world, ONLY : mpime
#endif
implicit none
!
INTEGER :: nsize, nks, nkstot
! first dimension of vectors f_in and f_out
! number of k-points per pool
! total number of k-points
INTEGER :: f_in(nsize,nks), f_out(nsize,nkstot)
! input ( only for k-points of mypool )
! output ( contains values for all k-point )
!
#ifdef __PARA
INTEGER :: rest, nbase
! the rest of the integer division nkstot / npo
! the position in the original list
!
rest = nkstot / kunit - ( nkstot / kunit / npool ) * npool
!
nbase = nks * my_pool_id
!
IF ( ( my_pool_id + 1 ) > rest ) nbase = nbase + rest * kunit
f_out = 0.d0
f_out(:,(nbase+1):(nbase+nks)) = f_in(:,1:nks)
!
! ... reduce across the pools
!
CALL mp_sum(f_out,inter_pool_comm)
!
#else
f_out(:,:) = f_in(:,:)
!
#endif
!
end subroutine poolgather_int
......@@ -451,8 +451,8 @@ SUBROUTINE compute_amn_para
!
USE io_global, ONLY : stdout
USE kinds, ONLY : DP
USE klist, ONLY : xk, nks
USE wvfct, ONLY : nbnd, npw, npwx, igk, g2kin