Commit 6fe8fd11 authored by giannozz's avatar giannozz

Merge branch 'develop01' into 'develop'

Use internal to EPW klists:

See merge request !410
parents 2be08d0e 5dc4bedc
......@@ -114,7 +114,8 @@
USE becmod, ONLY : becp, deallocate_bec_type
USE elph2, ONLY : el_ph_mat, epf17, epsi, etf,&
etq, et_all, wf, wkf, wqf, &
xkq, xk_all, zstar, xkf, xqf, epmatwp, eps_rpa
xkq, zstar, xkf, xqf, epmatwp, eps_rpa
USE klist_epw, ONLY : xk_all, xk_loc, xk_cryst
USE epwcom, ONLY : epbread, epwread
USE modes, ONLY : npert, u, name_rap_mode, num_rap_mode
USE qpoint, ONLY : eigqts, igkq
......@@ -141,10 +142,8 @@
IF(ALLOCATED(wkf)) DEALLOCATE (wkf)
IF(ALLOCATED(xqf)) DEALLOCATE (xqf)
IF(ALLOCATED(wqf)) DEALLOCATE (wqf)
IF(ALLOCATED(xk_all)) DEALLOCATE (xk_all)
IF(ALLOCATED(et_all)) DEALLOCATE (et_all)
IF(ALLOCATED(eps_rpa)) DEALLOCATE (eps_rpa)
IF(ALLOCATED(eps_rpa)) DEALLOCATE (eps_rpa)
!
ELSE
!
......@@ -212,7 +211,9 @@
IF(ALLOCATED(wkf)) DEALLOCATE (wkf)
IF(ALLOCATED(xqf)) DEALLOCATE (xqf)
IF(ALLOCATED(wqf)) DEALLOCATE (wqf)
IF(ALLOCATED(xk_all)) DEALLOCATE (xk_all)
IF(ALLOCATED(xk_all)) DEALLOCATE (xk_all)
IF(ALLOCATED(xk_loc)) DEALLOCATE (xk_loc)
IF(ALLOCATED(xk_cryst)) DEALLOCATE (xk_cryst)
IF(ALLOCATED(et_all)) DEALLOCATE (et_all)
IF(ALLOCATED(eps_rpa)) DEALLOCATE (eps_rpa)
ENDIF ! epwread .and. .not. epbread
......
......@@ -364,7 +364,7 @@
USE cell_base, ONLY : at, bg
USE start_k, ONLY : nk1, nk2, nk3
USE pwcom, ONLY : nkstot
USE epwcom, ONLY : xk_cryst
USE klist_epw, ONLY : xk_cryst
USE io_global, ONLY : stdout, meta_ionode
USE io_files, ONLY : prefix
USE io_epw, ONLY : iukgmap
......
......@@ -37,7 +37,6 @@
eps_rpa(:) ! screening
REAL(KIND=DP), ALLOCATABLE ::&
a_all(:,:), &! electronic spectral function du to electron-phonon interaction
xk_all(:,:), &! full k point grid, coarse (3, nkstot)
et_all(:,:), &! full eigenvalue list, coarse (nbnd, nkstot)
et_ks(:,:), &! lda eigenvalues
et_mb(:,:), &! gw eigenvalues
......
......@@ -64,7 +64,8 @@
USE wavefunctions, ONLY : evc
USE io_files, ONLY : diropn, seqopn
USE wvfct, ONLY : npwx
USE pwcom, ONLY : current_spin, isk, lsda, nbnd, xk, nks
USE pwcom, ONLY : current_spin, isk, lsda, nbnd, nks
USE klist_epw, ONLY : xk_loc, xk_all
USE cell_base, ONLY : tpiba
USE gvect, ONLY : ngm, g
USE uspp, ONLY : vkb
......@@ -77,7 +78,7 @@
USE lrus, ONLY : becp1
USE becmod, ONLY : calbec
USE elph2, ONLY : shift, gmap, el_ph_mat, umat, umatq, igk_k_all, &
umat_all, xk_all, et_all, xkq, etq, igkq, igk, &
umat_all, et_all, xkq, etq, igkq, igk, &
ngk_all, lower_band, upper_band
USE fft_base, ONLY : dffts
USE constants_epw, ONLY : czero, cone, ci, zero
......@@ -233,7 +234,7 @@
! (we need to make sure that xk(:,ikq) is really k+q for the KB projectors
! below and also that the eigenvalues are taken correctly in ephwann)
!
CALL ktokpmq( xk(:,ik), xq, +1, ipool, nkq, nkq_abs )
CALL ktokpmq( xk_loc(:,ik), xq, +1, ipool, nkq, nkq_abs )
!
! we define xkq(:,ik) and etq(:,ik) for the current xq
!
......@@ -277,8 +278,8 @@
! With this option, different compilers and different machines
! should always give the same wavefunctions.
!
CALL ktokpmq( xk(:,ik), zero_vect, +1, ipool, nkk, nkk_abs )
CALL ktokpmq( xkq(:,ik), zero_vect, +1, ipool, nkk, nkq_abs )
CALL ktokpmq(xk_loc(:,ik), zero_vect, +1, ipool, nkk, nkk_abs)
CALL ktokpmq(xkq(:,ik), zero_vect, +1, ipool, nkk, nkq_abs)
!
IF ( .not. ALLOCATED(umat) ) ALLOCATE( umat(nbnd,nbnd,nks) )
IF ( .not. ALLOCATED(umatq) ) ALLOCATE( umatq(nbnd,nbnd,nks) )
......@@ -341,7 +342,7 @@
! Since in QE a normal rotation s is defined as S^-1 we have here
! sxk = S(k).
!
CALL rotate_cart( xk(:,ik), s(:,:,isym), sxk )
CALL rotate_cart( xk_loc(:,ik), s(:,:,isym), sxk )
!
! here we generate vkb on the igk() set and for k ...
CALL init_us_2( npw, igk, sxk, vkb )
......
......@@ -35,7 +35,7 @@
USE ions_base, ONLY : nat, nsp, tau, ityp
USE control_flags, ONLY : iverbosity
USE io_epw, ONLY : iuepb, iuqpeig
USE pwcom, ONLY : et, xk, nks, nbnd, nkstot
USE pwcom, ONLY : et, nks, nbnd, nkstot
USE cell_base, ONLY : at, bg
USE symm_base, ONLY : irt, s, nsym, ft, sname, invs, s_axis_to_cart, &
sr, nrot, copy_sym, set_sym_bl, find_sym, &
......@@ -47,9 +47,10 @@
USE lr_symm_base, ONLY : minus_q, rtau, gi, gimq, irotmq, nsymq, invsymq
USE epwcom, ONLY : epbread, epbwrite, epwread, lifc, etf_mem, vme, &
nbndsub, iswitch, kmaps, eig_read, 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, et_mb, et_ks, &
zstar, epsi, cu, cuq, lwin, lwinq, bmat, igk_k_all, &
ngk_all, exband
USE klist_epw, ONLY : xk_all
USE constants_epw, ONLY : ryd2ev, zero, czero
USE fft_base, ONLY : dfftp
USE control_ph, ONLY : u_from_file
......@@ -266,22 +267,20 @@
ENDIF
!
! Do not recompute dipole matrix elements
IF ( epwread .and. .not. epbread ) THEN
IF ( epwread .AND. .NOT. epbread ) THEN
CONTINUE
ELSE
! compute coarse grid dipole matrix elements. Very fast
IF (.not. vme) CALL compute_pmn_para
IF (.NOT. vme) CALL compute_pmn_para
ENDIF
!
! gather electronic eigenvalues for subsequent shuffle
!
ALLOCATE( xk_all(3,nkstot), et_all(nbnd,nkstot) )
xk_all(:,:) = zero
ALLOCATE (et_all(nbnd, nkstot))
et_all(:,:) = zero
CALL poolgather( 3, nkstot, nks, xk(:,1:nks), xk_all)
CALL poolgather(nbnd, nkstot, nks, et(1:nbnd,1:nks), et_all)
!
IF (.not.kmaps) THEN
IF (.NOT. kmaps) THEN
CALL start_clock('kmaps')
CALL createkmap_pw2
CALL stop_clock('kmaps')
......
......@@ -17,9 +17,6 @@
!! This is the main EPW driver which sets the phases on the wavefunctions,
!! calls [[wann_run]] and [[elphon_shuffle_wrap]]
!!
!! @Note
!! 8/14/08 lnscf is unnecessary, as is nqs, iq_start
!!
USE io_global, ONLY : stdout, ionode
USE mp, ONLY : mp_bcast, mp_barrier
USE mp_world, ONLY : mpime
......@@ -31,57 +28,55 @@
USE environment, ONLY : environment_start
USE elph2, ONLY : elph
USE close_epw, ONLY : close_final, deallocate_epw
! Flag to perform an electron-phonon calculation. If .true.
! the code will enter in [[elphon_shuffle_wrap]]
!
IMPLICIT NONE
!
CHARACTER (LEN=12) :: code = 'EPW'
CHARACTER(LEN=12) :: code = 'EPW'
!! Name of the program
!
version_number = '5.1.0'
!
CALL init_clocks( .TRUE. )
CALL init_clocks(.TRUE.)
!
CALL start_clock( 'EPW' )
CALL start_clock('EPW')
!
gamma_only = .FALSE.
!
CALL mp_startup(start_images=.true.)
CALL mp_startup(start_images = .TRUE.)
!
! Display the logo
IF (mpime.eq.ionode_id) then
WRITE(stdout,'(a)') " "
WRITE(stdout,'(a)') " ``:oss/ "
WRITE(stdout,'(a)') " `.+s+. .+ys--yh+ `./ss+. "
WRITE(stdout,'(a)') " -sh//yy+` +yy +yy -+h+-oyy "
WRITE(stdout,'(a)') " -yh- .oyy/.-sh. .syo-.:sy- /yh "
WRITE(stdout,'(a)') " `.-.` `yh+ -oyyyo. `/syys: oys `.` "
WRITE(stdout,'(a)') " `/+ssys+-` `sh+ ` oys` .:osyo` "
WRITE(stdout,'(a)') " -yh- ./syyooyo` .sys+/oyo--yh/ "
WRITE(stdout,'(a)') " `yy+ .-:-. `-/+/:` -sh- "
WRITE(stdout,'(a)') " /yh. oys "
WRITE(stdout,'(a)') " ``..---hho---------` .---------..` `.-----.` -hd+---. "
WRITE(stdout,'(a)') " `./osmNMMMMMMMMMMMMMMMs. +NNMMMMMMMMNNmh+. yNMMMMMNm- oNMMMMMNmo++:` "
WRITE(stdout,'(a)') " +sy--/sdMMMhyyyyyyyNMMh- .oyNMMmyyyyyhNMMm+` -yMMMdyyo:` .oyyNMMNhs+syy` "
WRITE(stdout,'(a)') " -yy/ /MMM+.`-+/``mMMy- `mMMh:`````.dMMN:` `MMMy-`-dhhy```mMMy:``+hs "
WRITE(stdout,'(a)') " -yy+` /MMMo:-mMM+`-oo/. mMMh: `dMMN/` dMMm:`dMMMMy..MMMo-.+yo` "
WRITE(stdout,'(a)') " .sys`/MMMMNNMMMs- mMMmyooooymMMNo: oMMM/sMMMMMM++MMN//oh: "
WRITE(stdout,'(a)') " `sh+/MMMhyyMMMs- `-` mMMMMMMMMMNmy+-` -MMMhMMMsmMMmdMMd/yy+ "
WRITE(stdout,'(a)') " `-/+++oyy-/MMM+.`/hh/.`mNm:` mMMd+/////:-.` NMMMMMd/:NMMMMMy:/yyo/:.` "
WRITE(stdout,'(a)') " +os+//:-..-oMMMo:--:::-/MMMo. .-mMMd+---` hMMMMN+. oMMMMMo. `-+osyso:` "
WRITE(stdout,'(a)') " syo `mNMMMMMNNNNNNNNMMMo.oNNMMMMMNNNN:` +MMMMs:` dMMMN/` ``:syo "
WRITE(stdout,'(a)') " /yh` :syyyyyyyyyyyyyyyy+.`+syyyyyyyyo:` .oyys:` .oyys:` +yh "
WRITE(stdout,'(a)') " -yh- ```````````````` ````````` `` `` oys "
WRITE(stdout,'(a)') " -+h/------------------------::::::::://////++++++++++++++++++++++///////::::/yd: "
WRITE(stdout,'(a)') " shdddddddddddddddddddddddddddddhhhhhhhhyyyyyssssssssssssssssyyyyyyyhhhhhhhddddh` "
WRITE(stdout,'(a)') " "
WRITE(stdout,'(a)') " S. Ponce, E. R. Margine, C. Verdi, and F. Giustino, "
WRITE(stdout,'(a)') " Comput. Phys. Commun. 209, 116 (2016) "
WRITE(stdout,'(a)') " "
IF (mpime == ionode_id) then
WRITE(stdout, '(a)') " "
WRITE(stdout, '(a)') " ``:oss/ "
WRITE(stdout, '(a)') " `.+s+. .+ys--yh+ `./ss+. "
WRITE(stdout, '(a)') " -sh//yy+` +yy +yy -+h+-oyy "
WRITE(stdout, '(a)') " -yh- .oyy/.-sh. .syo-.:sy- /yh "
WRITE(stdout, '(a)') " `.-.` `yh+ -oyyyo. `/syys: oys `.` "
WRITE(stdout, '(a)') " `/+ssys+-` `sh+ ` oys` .:osyo` "
WRITE(stdout, '(a)') " -yh- ./syyooyo` .sys+/oyo--yh/ "
WRITE(stdout, '(a)') " `yy+ .-:-. `-/+/:` -sh- "
WRITE(stdout, '(a)') " /yh. oys "
WRITE(stdout, '(a)') " ``..---hho---------` .---------..` `.-----.` -hd+---. "
WRITE(stdout, '(a)') " `./osmNMMMMMMMMMMMMMMMs. +NNMMMMMMMMNNmh+. yNMMMMMNm- oNMMMMMNmo++:` "
WRITE(stdout, '(a)') " +sy--/sdMMMhyyyyyyyNMMh- .oyNMMmyyyyyhNMMm+` -yMMMdyyo:` .oyyNMMNhs+syy` "
WRITE(stdout, '(a)') " -yy/ /MMM+.`-+/``mMMy- `mMMh:`````.dMMN:` `MMMy-`-dhhy```mMMy:``+hs "
WRITE(stdout, '(a)') " -yy+` /MMMo:-mMM+`-oo/. mMMh: `dMMN/` dMMm:`dMMMMy..MMMo-.+yo` "
WRITE(stdout, '(a)') " .sys`/MMMMNNMMMs- mMMmyooooymMMNo: oMMM/sMMMMMM++MMN//oh: "
WRITE(stdout, '(a)') " `sh+/MMMhyyMMMs- `-` mMMMMMMMMMNmy+-` -MMMhMMMsmMMmdMMd/yy+ "
WRITE(stdout, '(a)') " `-/+++oyy-/MMM+.`/hh/.`mNm:` mMMd+/////:-.` NMMMMMd/:NMMMMMy:/yyo/:.` "
WRITE(stdout, '(a)') " +os+//:-..-oMMMo:--:::-/MMMo. .-mMMd+---` hMMMMN+. oMMMMMo. `-+osyso:` "
WRITE(stdout, '(a)') " syo `mNMMMMMNNNNNNNNMMMo.oNNMMMMMNNNN:` +MMMMs:` dMMMN/` ``:syo "
WRITE(stdout, '(a)') " /yh` :syyyyyyyyyyyyyyyy+.`+syyyyyyyyo:` .oyys:` .oyys:` +yh "
WRITE(stdout, '(a)') " -yh- ```````````````` ````````` `` `` oys "
WRITE(stdout, '(a)') " -+h/------------------------::::::::://////++++++++++++++++++++++///////::::/yd: "
WRITE(stdout, '(a)') " shdddddddddddddddddddddddddddddhhhhhhhhyyyyyssssssssssssssssyyyyyyyhhhhhhhddddh` "
WRITE(stdout, '(a)') " "
WRITE(stdout, '(a)') " S. Ponce, E. R. Margine, C. Verdi, and F. Giustino, "
WRITE(stdout, '(a)') " Comput. Phys. Commun. 209, 116 (2016) "
WRITE(stdout, '(a)') " "
ENDIF
!
CALL environment_start ( code )
CALL environment_start(code)
!
! Read in the input file
!
......@@ -89,7 +84,7 @@
!
CALL allocate_epwq
!
IF ( epwread .AND. .NOT. epbread ) THEN
IF (epwread .AND. .NOT. epbread) THEN
WRITE(stdout,'(a)') " "
WRITE(stdout,'(a)') " ------------------------------------------------------------------------ "
WRITE(stdout,'(a)') " RESTART - RESTART - RESTART - RESTART "
......@@ -106,24 +101,24 @@
!
CALL epw_summary
!
IF ( ep_coupling ) THEN
IF (ep_coupling) THEN
!
! In case of restart with arbitrary number of cores.
IF ( epwread .AND. .NOT. epbread ) THEN
IF (epwread .AND. .NOT. epbread) THEN
CONTINUE
ELSE
CALL openfilepw
ENDIF
!
CALL print_clock( 'EPW' )
CALL print_clock('EPW')
!
IF ( epwread .AND. .NOT. epbread ) THEN
IF (epwread .AND. .NOT. epbread) THEN
CONTINUE
ELSE
CALL epw_init(.true.)
CALL epw_init(.TRUE.)
ENDIF
!
CALL print_clock( 'EPW' )
CALL print_clock('EPW')
!
! Generates the perturbation matrix which fixes the gauge of
! the calculated wavefunctions
......@@ -143,7 +138,7 @@
trim(filukk) , ' from disk', repeat('-',67)
ENDIF
!
IF ( elph ) THEN
IF (elph) THEN
!
! CALL dvanqq2()
!
......@@ -153,7 +148,7 @@
!
! ... cleanup of the variables
!
CALL clean_pw( .FALSE. )
CALL clean_pw(.FALSE.)
CALL deallocate_epw
!
! ... Close the files
......@@ -162,11 +157,11 @@
!
ENDIF
!
IF ( cumulant .and. ionode ) THEN
IF (cumulant .AND. ionode) THEN
CALL spectral_cumulant()
ENDIF
!
IF ( eliashberg ) THEN
IF (eliashberg) THEN
CALL eliashberg_eqs()
ENDIF
!
......
......@@ -25,7 +25,8 @@
USE lrus, ONLY : becp1
USE uspp, ONLY : vkb
USE pwcom, ONLY : npwx, nbnd, nks, lsda, current_spin, &
isk, xk
isk
USE klist_epw, ONLY : xk_loc
USE constants, ONLY : tpi
USE constants_epw, ONLY : zero, czero, cone
USE cell_base, ONLY : tpiba2, tpiba, bg, omega
......@@ -113,7 +114,7 @@
!
! ... d) The functions vkb(k+G)
!
CALL init_us_2( ngk(ik), igk_k(1,ik), xk(1,ik), vkb )
CALL init_us_2( ngk(ik), igk_k(1,ik), xk_loc(1,ik), vkb )
!
! ... read the wavefunctions at k
!
......@@ -132,12 +133,12 @@
DO ibnd = 1, nbnd
DO ig = 1, ngk(ik)
aux1(ig,ibnd) = evc(ig,ibnd) * tpiba * cone * &
( xk(ipol,ik) + g(ipol,igk_k(ig,ik)) )
( xk_loc(ipol,ik) + g(ipol,igk_k(ig,ik)) )
ENDDO
IF (noncolin) THEN
DO ig = 1, ngk(ik)
aux1(ig+npwx,ibnd) = evc(ig+npwx,ibnd) * tpiba *cone *&
( xk(ipol,ik) + g(ipol,igk_k(ig,ik)) )
( xk_loc(ipol,ik) + g(ipol,igk_k(ig,ik)) )
ENDDO
ENDIF
ENDDO
......
......@@ -20,9 +20,10 @@
!! SP: Image parallelization added
!!
USE ions_base, ONLY : nat, ntyp => nsp
USE cell_base, ONLY : at
USE mp, ONLY : mp_bcast
USE wvfct, ONLY : nbnd
USE klist, ONLY : nks
USE klist, ONLY : nks, xk, nkstot
USE lsda_mod, ONLY : lsda
USE fixed_occ, ONLY : tfixed_occ
USE qpoint, ONLY : xq
......@@ -58,6 +59,7 @@
restart_filq, prtgkk, nel, meff, epsiHEG, lphase, &
omegamin, omegamax, omegastep, n_r, lindabs, &
mob_maxiter, use_ws, epmatkqread, selecqread
USE klist_epw, ONLY : xk_all, xk_loc, xk_cryst
USE elph2, ONLY : elph
USE start_k, ONLY : nk1, nk2, nk3
USE constants_epw, ONLY : ryd2mev, ryd2ev, ev2cmm1, kelvin2eV, zero
......@@ -68,7 +70,7 @@
USE partial, ONLY : atomo, nat_todo
USE constants, ONLY : AMU_RY
USE mp_global, ONLY : my_pool_id, me_pool
USE io_global, ONLY : meta_ionode, meta_ionode_id
USE io_global, ONLY : meta_ionode, meta_ionode_id, ionode_id
USE io_epw, ONLY : iunkf, iunqf
#if defined(__NAG)
USE F90_UNIX_ENV, ONLY : iargc, getarg
......@@ -89,6 +91,8 @@
!! auxilary variable for saving the modenum
INTEGER :: i
!! Counter for loops
INTEGER :: ik
!! Counter on k-points
INTEGER :: nk1tmp
!! temp vars for saving kgrid info
INTEGER :: nk2tmp
......@@ -185,13 +189,13 @@
!
! added by @ RM
!
! ephwrite : if true write el-phonon matrix elements on the fine mesh to file
! ephwrite : if true write el-phonon matrix elements on the fine mesh to file
! eps_acustic : min phonon frequency for e-p and a2f calculations (units of cm-1)
! band_plot : if true write files to plot band structure and phonon dispersion
! degaussq : smearing for sum over q in e-ph coupling (units of meV)
! delta_qsmear : change in energy for each additional smearing in the a2f (units of meV)
! nqsmear : number of smearings used to calculate a2f
! nqstep : number of bins for frequency used to calculate a2f
! band_plot : if true write files to plot band structure and phonon dispersion
! degaussq : smearing for sum over q in e-ph coupling (units of meV)
! delta_qsmear: change in energy for each additional smearing in the a2f (units of meV)
! nqsmear : number of smearings used to calculate a2f
! nqstep : number of bins for frequency used to calculate a2f
! nswfc : nr. of grid points between (0,wsfc) in Eliashberg equations
! nswc : nr. of grid points between (wsfc,wscut)
! pwc : power used to define nswc for non-uniform grid real-axis calculations
......@@ -292,6 +296,7 @@
! omegastep : Photon energy step in evaluating phonon-assisted absorption spectra (in eV)
! n_r : constant refractive index
! lindabs : do phonon-assisted absorption
!
nk1tmp = 0
nk2tmp = 0
nk3tmp = 0
......@@ -307,13 +312,13 @@
!
ENDIF
!
CALL mp_bcast(ios, meta_ionode_id, world_comm )
CALL errore( 'epw_readin', 'reading title ', ABS( ios ) )
CALL mp_bcast(title, meta_ionode_id, world_comm )
CALL mp_bcast(ios, meta_ionode_id, world_comm)
CALL errore('epw_readin', 'reading title ', ABS( ios ))
CALL mp_bcast(title, meta_ionode_id, world_comm)
!
! Rewind the input if the title is actually the beginning of inputph namelist
!
IF( imatches("&inputepw", title) ) THEN
IF(imatches("&inputepw", title)) THEN
WRITE(*, '(6x,a)') "Title line not specified: using 'default'."
title='default'
IF (meta_ionode) REWIND(5, iostat=ios)
......@@ -611,8 +616,8 @@
!
! thickness and smearing width of the Fermi surface
! from eV to Ryd
fsthick = fsthick / ryd2ev
degaussw = degaussw / ryd2ev
fsthick = fsthick / ryd2ev
degaussw = degaussw / ryd2ev
delta_smear = delta_smear / ryd2ev
!
! smearing of phonon in a2f
......@@ -686,18 +691,41 @@
!
modenum_aux = modenum
!
! SP: This initialized nspin and nspin_mag
IF ( epwread .and. .not. epbread ) THEN
! SP: This initialized xk, nspin and nspin_mag
IF (epwread .AND. .NOT. epbread) THEN
CONTINUE
ELSE
CALL read_file
CALL read_file()
!
! We define the global list of coarse grid k-points (cart and cryst)
ALLOCATE (xk_all(3, nkstot))
ALLOCATE (xk_cryst(3, nkstot))
xk_all(:,:) = zero
xk_cryst(:,:) = zero
DO ik=1, nkstot
xk_all(:, ik) = xk(:, ik)
xk_cryst(:, ik) = xk(:, ik)
ENDDO
! bring k-points from cartesian to crystal coordinates
CALL cryst_to_cart(nkstot, xk_cryst, at, -1)
! Only master has the correct full list of kpt. Therefore bcast to all cores
CALL mp_bcast(xk_all, ionode_id, world_comm)
CALL mp_bcast(xk_cryst, ionode_id, world_comm)
!
! We define the local list of kpt
ALLOCATE (xk_loc(3, nks))
xk_loc(:,:) = zero
DO ik=1, nks
xk_loc(:, ik) = xk(:, ik)
ENDDO
!
ENDIF
!
! nbnd comes out of readfile
IF (nbndsub.eq.0) nbndsub = nbnd
IF (nbndsub == 0) nbndsub = nbnd
!
#if defined(__MPI)
IF (.not.(me_pool /=0 .or. my_pool_id /=0)) THEN
IF (.NOT. (me_pool /=0 .OR. my_pool_id /=0)) THEN
nk1 = nk1tmp
nk2 = nk2tmp
nk3 = nk3tmp
......@@ -711,10 +739,10 @@
IF (gamma_only) CALL errore('epw_readin',&
'cannot start from pw.x data file using Gamma-point tricks',1)
!
IF (modenum_aux .ne. -1) THEN
IF (modenum_aux /= -1) THEN
modenum = modenum_aux
iswitch = -4
ELSEIF (modenum .eq. 0) THEN
ELSEIF (modenum == 0) THEN
iswitch = -2
ELSE
iswitch = -4
......
......@@ -22,7 +22,7 @@
USE cell_base, ONLY : at, bg
USE io_global, ONLY : stdout, ionode, ionode_id
USE io_files, ONLY : tmp_dir
USE klist, ONLY : xk, nks, nkstot
USE klist, ONLY : nks, nkstot
USE lsda_mod, ONLY : nspin, starting_magnetization
USE scf, ONLY : v, vrs, vltot, rho, kedtau
USE gvect, ONLY : ngm
......@@ -44,8 +44,9 @@
USE mp_global, ONLY : world_comm
USE mp, ONLY : mp_bcast
USE mp_pools, ONLY : inter_pool_comm
USE epwcom, ONLY : xk_cryst, scattering, nstemp, tempsmin, tempsmax, &
USE epwcom, ONLY : scattering, nstemp, tempsmin, tempsmax, &
temps
USE klist_epw, ONLY : xk_cryst
USE fft_base, ONLY : dfftp
USE gvecs, ONLY : doublegrid
USE start_k, ONLY : nk1, nk2, nk3
......@@ -70,15 +71,6 @@
!
CALL start_clock('epw_setup')
!
! 0) Set up list of kpoints in crystal coordinates
!
DO jk = 1, nkstot
xk_cryst(:,jk) = xk(:,jk)
ENDDO
! bring k-points from cartesian to crystal coordinates
CALL cryst_to_cart(nkstot, xk_cryst, at, -1)
CALL mp_bcast(xk_cryst,ionode_id,world_comm)
!
! loosy tolerance: not important
DO jk = 1, nkstot
xx_c = xk_cryst(1,jk) * nk1
......
......@@ -22,7 +22,8 @@
USE ions_base, ONLY : nat, ityp, atm, tau, ntyp => nsp, amass
USE io_global, ONLY : stdout
USE cell_base, ONLY : at, bg, ibrav, alat, omega, celldm
USE klist, ONLY : lgauss, degauss, ngauss, nkstot, xk, wk
USE klist, ONLY : lgauss, degauss, ngauss, nkstot, wk
USE klist_epw, ONLY : xk_all
USE gvect, ONLY : gcutm, ngm
USE gvecs, ONLY : dual, doublegrid, gcutms, ngms
USE gvecw, ONLY : ecutwfc
......@@ -206,15 +207,15 @@
WRITE(stdout, '(23x,"cart. coord. in units 2pi/a_0")')
DO ik = 1, nkstot
WRITE(stdout, '(8x,"k(",i5,") = (",3f12.7,"), wk =",f12.7)') ik, &
(xk(ipol,ik) , ipol = 1, 3), wk(ik)
(xk_all(ipol,ik) , ipol = 1, 3), wk(ik)
ENDDO
ENDIF
IF (iverbosity.eq.1) THEN
WRITE(stdout, '(/23x,"cryst. coord.")')
DO ik = 1, nkstot
DO ipol = 1, 3
xkg(ipol) = at(1,ipol) * xk(1,ik) + at(2,ipol) * xk(2,ik) &
+ at(3,ipol) * xk(3,ik)
xkg(ipol) = at(1,ipol) * xk_all(1,ik) + at(2,ipol) * xk_all(2,ik) &
+ at(3,ipol) * xk_all(3,ik)
! xkg are the components of xk in the reciprocal lattice basis
ENDDO
WRITE(stdout, '(8x,"k(",i5,") = (",3f12.7,"), wk =",f12.7)') &
......
......@@ -327,8 +327,14 @@ MODULE klist_epw
!
SAVE
!
INTEGER :: kmap(npk) ! map of k+q grid into k grid
REAL(DP) :: xk_cryst(3,npk) ! List of all kpoints in crystal coordinates
INTEGER :: kmap(npk)
!! map of k+q grid into k grid
REAL(kind=DP), ALLOCATABLE :: xk_loc(:, :)
!! List of local (each cores) kpoints in cartesian coordinates
REAL(kind=DP), ALLOCATABLE :: xk_all(:, :)
!! List of all kpoints in cartesian coordinates
REAL(kind=DP), ALLOCATABLE :: xk_cryst(:, :)
!! List of all kpoints in crystal coordinates
!
END MODULE klist_epw
!
......
......@@ -7,7 +7,7 @@
! present distribution, or http://www.gnu.org/copyleft.gpl.txt .
!
!--------------------------------------------------------
subroutine ktokpmq ( xk, xq, sign, ipool, nkq, nkq_abs)
subroutine ktokpmq(xk, xq, sign, ipool, nkq, nkq_abs)
!--------------------------------------------------------
!!
!! For a given k point in cart coord, find the index
......@@ -23,7 +23,7 @@
use pwcom, ONLY : nkstot
USE cell_base, ONLY : at
USE start_k, ONLY : nk1, nk2, nk3
use epwcom, ONLY : xk_cryst
use klist_epw, ONLY : xk_cryst
USE mp_global, ONLY : nproc_pool, npool
USE mp_images, ONLY : nproc_image
USE mp, ONLY : mp_barrier, mp_bcast
......@@ -107,9 +107,9 @@
n = 0
found = .false.
DO ik = 1, nkstot
xx_c = xk_cryst(1,ik) * nk1
yy_c = xk_cryst(2,ik) * nk2
zz_c = xk_cryst(3,ik) * nk3
xx_c = xk_cryst(1, ik) * nk1
yy_c = xk_cryst(2, ik) * nk2
zz_c = xk_cryst(3, ik) * nk3
!
! check that the k-mesh was defined in the positive region of 1st BZ
!
......@@ -129,7 +129,7 @@
! since coarse k- and q- meshes are commensurate, one can easily find n
! n = nint(xx) * nk2 * nk3 + nint(yy) * nk3 + nint(zz) + 1
!
IF (n .eq. 0) call errore('ktokpmq','problem indexing k+q',1)
IF (n == 0) call errore('ktokpmq','problem indexing k+q',1)
!
! Now n represents the index of k+sign*q in the original k grid.
! In the parallel case we have to find the corresponding pool
......
......@@ -679,7 +679,8 @@
!!
USE kinds, ONLY : DP
USE io_global, ONLY : stdout
USE klist, ONLY : xk, nks, igk_k
USE klist, ONLY : nks, igk_k
USE klist_epw, ONLY : xk_loc
USE wvfct, ONLY : nbnd, npw, npwx, g2kin
USE wavefunctions, ONLY : evc
USE gvect, ONLY : g, ngm
......@@ -775,19 +776,19 @@
WRITE(stdout,'(6x,a,i5,a,i4,a)') 'k points = ',iknum, ' in ', npool, ' pools'
#endif
!
DO ik = 1, nks
DO ik=1, nks
!
! returns in-pool index nkq and absolute index nkq_abs of xk
CALL ktokpmq( xk(:,ik), zero_vect, +1, ipool, nkq, nkq_abs )
CALL ktokpmq(xk_loc(:,ik), zero_vect, +1, ipool, nkq, nkq_abs)
ik_g = nkq_abs
!
WRITE(stdout,'(5x,i8, " of ", i4,a)') ik , nks, ' on ionode'
CALL flush(stdout)
CALL FLUSH(stdout)
! SP: Replaced by our wrapper to deal with parallel
CALL readwfc( my_pool_id+1, ik, evc )
!
! sorts k+G vectors in order of increasing magnitude, up to ecut
CALL gk_sort( xk(1,ik), ngm, g, gcutw, npw, igk_k(1,ik), g2kin )
CALL gk_sort( xk_loc(1,ik), ngm, g, gcutw, npw, igk_k(1,ik), g2kin )
!
CALL generate_guiding_functions( ik ) ! they are called gf(npw,n_proj)
......@@ -801,7 +802,7 @@
! USPP
!
IF (any_uspp) THEN
CALL init_us_2( npw, igk_k(1,ik), xk(1,ik), vkb )
CALL init_us_2( npw, igk_k(1,ik), xk_loc(1,ik), vkb )
! below we compute the product of beta functions with trial func.
IF (noncolin) THEN
CALL calbec( npw, vkb, gf_spinor, becp, n_proj )
......@@ -1013,7 +1014,8 @@
USE units_lr, ONLY : lrwfc, iuwfc
USE fft_base, ONLY : dffts
USE fft_interfaces, ONLY : fwfft, invfft
USE klist, ONLY : nkstot, xk, nks, igk_k
USE klist, ONLY : nkstot, nks, igk_k
USE klist_epw, ONLY : xk_all, xk_loc
USE gvect, ONLY : g, ngm, gstart
USE gvecw, ONLY : gcutw