!
  !-----------------------------------------------------------------------
  subroutine createkmap2 ( xxq )
  !-----------------------------------------------------------------------
  !
  !  generate teh map k+q --> k for folding the rotation matrix U(k+q) 
  !  
  !  in parallel case, this subroutine must be called only by first proc 
  !  (which has all the kpoints)
  !
  !-----------------------------------------------------------------------
  !
  USE kinds, only : DP
  USE cell_base, ONLY : at, bg
  USE klist, ONLY : nkstot, nks, xk, kmap
  USE pwcom, ONLY : nk1, nk2, nk3
  use io_global, only : stdout
  USE control_flags, ONLY : iverbosity
  USE control_ph, ONLY : lgamma
  USE para, only : kunit
  implicit none
  !
  real(kind=DP) :: eps, xxq (3), xx, yy, zz
  integer :: i, k, n, iukmap, ik, j, nksqtot, ikk, ikq
  logical :: in_the_list
  !
  !  the first proc keeps a copy of all kpoints !
  !
  nksqtot = nkstot / kunit 
  !
  ! bring q in crystal coordinates and check commensuration
  ! 
  !  loosy tolerance: not important since k+q is defined trhough nint() 
  eps = 1.d-5 
  ! 
  call cryst_to_cart (1,xxq,at,-1)
  !
  xx = xxq(1)*nk1 
  yy = xxq(2)*nk2 
  zz = xxq(3)*nk3 
  in_the_list = abs(xx-nint(xx)).le.eps .and. &
                abs(yy-nint(yy)).le.eps .and. &
                abs(zz-nint(zz)).le.eps
  if (iverbosity.eq.1) &
    write(stdout,'(a,3i3)') '  q in integer coord:',nint(xx),nint(yy),nint(zz)
  if (.not.in_the_list) call errore('create_kmap2','q-vec not commensurate',1)
  !
  !  bring all the k's in crystal coordinates 
  !
  call cryst_to_cart ( nkstot, xk, at, -1)
  !
  do ik = 1, nksqtot
    !
    if (lgamma) then
      ikk = ik 
      ikq = ik 
    else
      ikk = 2 * ik - 1
      ikq = 2 * ik 
    endif
    !
    !  check that the k's are actually on a uniform mesh centered at gamma
    !
    xx = xk(1, ikk)*nk1
    yy = xk(2, ikk)*nk2
    zz = xk(3, ikk)*nk3
    if (iverbosity.eq.1) &
      write(stdout,'(a,i3,a,3i3)') 'ik = ',ik,',   k   in integer coord:',nint(xx),nint(yy),nint(zz)
    in_the_list = abs(xx-nint(xx)).le.eps .and. &
                  abs(yy-nint(yy)).le.eps .and. &
                  abs(zz-nint(zz)).le.eps
    if (.not.in_the_list) call errore('createkmap2','is this a uniform k-mesh?',1)
    !
    !  now add the phonon wavevector and check that k+q falls again on the k grid
    !
    xk (:, ikq) = xk (:, ikk) + xxq (:)
    !
    xx = xk(1, ikq)*nk1
    yy = xk(2, ikq)*nk2
    zz = xk(3, ikq)*nk3
    if (iverbosity.eq.1) &
      write(stdout,'(a,i3,a,3i3)') 'ik = ',ik,',   k+q in integer coord:',nint(xx),nint(yy),nint(zz)
    in_the_list = abs(xx-nint(xx)).le.eps .and. &
                  abs(yy-nint(yy)).le.eps .and. &
                  abs(zz-nint(zz)).le.eps
    if (.not.in_the_list) call errore('createkmap2','k+q does not fall on k-grid',1)
    !
    !  find the index of this k+q in the k-grid
    !
    i = mod ( nint ( xx + 2*nk1), nk1 ) 
    j = mod ( nint ( yy + 2*nk2), nk2 ) 
    k = mod ( nint ( zz + 2*nk3), nk3 ) 
    if (iverbosity.eq.1) &
      write(stdout,'(a,i3,a,3i3)') 'ik = ',ik,', f-k+q in integer coord:',i,j,k
    n = i*nk2*nk3 + j*nk3 + k + 1 
    kmap( ik ) = n
    !
  enddo
  !
  ! bring everybody back to cartesian coordinates 
  !
  call cryst_to_cart ( 1, xxq, bg, 1) 
  call cryst_to_cart ( nkstot, xk, bg, 1)
  !
  return
  end subroutine createkmap2