!
! Copyright (C) 2001-2008 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 .
!
!--------------------------------------------------------
subroutine add_zstar_ue_us(imode0,npe)
  !----------===============-------------------------------
  !! Add the contribution of the modes \( \text{imode0}+1 \rightarrow 
  !! \text{imode}+\text{npe}\) to the effective charges \(Z(\text{Us},E)\)
  !! (Us=scf,E=bare).
  !
  !! This subroutine is just for the USPP case.
  !
  !! \(\text{trans} =\text{TRUE}\) is needed for this calculation to
  !! be meaningful.
  !

  USE kinds, ONLY : DP
  USE klist, ONLY : xk, wk, ngk, igk_k
  USE uspp,  ONLY : nkb, vkb
  USE wvfct, ONLY : npwx, nbnd
  USE noncollin_module,   ONLY : npol
  USE wavefunctions,    ONLY : evc
  USE buffers, ONLY: get_buffer
  USE qpoint,     ONLY : nksq, ikks
  USE efield_mod, ONLY: zstarue0_rec
  USE eqv,        ONLY : dpsi, dvpsi
  USE modes,      ONLY : u
  USE units_ph,   ONLY : iucom, lrcom
  USE units_lr,   ONLY : iuwfc, lrwfc
  USE mp_bands,   ONLY: intra_bgrp_comm
  USE mp,         ONLY: mp_sum
  USE control_lr, ONLY : nbnd_occ
  USE uspp_init,        ONLY : init_us_2

  implicit none

  integer, intent(in) :: imode0
  !! input: the starting mode
  integer, intent(in) :: npe
  !! input: the number of perturbations

  integer :: ik, ikk, jpol, nrec, mode, ipert, ibnd, jbnd, i,j
  INTEGER :: npw, npwq
  real(DP) :: weight

  complex(DP), allocatable :: pdsp(:,:)
  complex(DP), allocatable :: dvkb(:,:,:)
  !  auxiliary space for <psi|ds/du|psi>

  call start_clock('add_zstar_us')
!  call compute_qdipol(dpqq)

  allocate (pdsp(nbnd,nbnd))
  allocate (dvkb(npwx,nkb,3))
  do ik = 1, nksq
     ikk = ikks(ik)
     npw = ngk(ikk)    
     npwq = npw
     weight = wk (ikk)
     if (nksq.gt.1) call get_buffer (evc, lrwfc, iuwfc, ikk)
     call init_us_2 (npw, igk_k(1,ikk), xk (1, ikk), vkb)
     call dvkb3(ik,dvkb)
     do ipert = 1, npe
        mode = imode0 + ipert
        do jpol = 1, 3
           dvpsi = (0.d0,0.d0)
           !
           ! read/compute the Commutator with the additional term
           call dvpsi_e(ik,jpol)
           !
           ! Calculate the matrix elements <psi_v'k|dS/du|psi_vk>
           ! Note: we need becp1
           !
           pdsp = (0.d0,0.d0)
           call psidspsi (ik, u (1, mode), pdsp )
#if defined(__MPI)
           call mp_sum(pdsp, intra_bgrp_comm )
#endif
           !
           ! add the term of the double summation
           !
           do ibnd = 1, nbnd_occ(ikk)
              do jbnd = 1, nbnd_occ(ikk)
                 zstarue0_rec(mode,jpol)=zstarue0_rec(mode,jpol) +           &
                      weight *                                          &
                      dot_product(evc(1:npwx*npol,ibnd), &
                           dvpsi(1:npwx*npol,jbnd))*pdsp(jbnd,ibnd)
              enddo
           enddo

           dvpsi = (0.d0,0.d0)
           dpsi  = (0.d0,0.d0)
           !
           ! For the last part, we read the commutator from disc,
           ! but this time we calculate
           ! dS/du P_c [H-eS]|psi> + (dK(r)/du - dS/du)r|psi>
           !
           ! first we read  P_c [H-eS]|psi> and store it in dpsi
           !
           nrec = (jpol - 1) * nksq + ik
           call get_buffer (dpsi, lrcom, iucom, nrec)
           !
           ! Apply the matrix dS/du, the result is stored in dvpsi
           !
           call add_for_charges(ik, u(1,mode))
           !
           ! Add  (dK(r)/du - dS/du) r | psi>
           !
           call add_dkmds(ik, u(1,mode),jpol, dvkb)
           !
           ! And calculate finally the scalar product
           !
           do ibnd = 1, nbnd_occ(ik)
              zstarue0_rec(mode,jpol)=zstarue0_rec(mode,jpol) - weight *   &
                   dot_product(evc(1:npwx*npol,ibnd),dvpsi(1:npwx*npol,ibnd))
           enddo
        enddo
     enddo
  enddo

  deallocate(dvkb)
  deallocate(pdsp)
  call stop_clock('add_zstar_us')

  return
end subroutine add_zstar_ue_us

