!===============================================================================
!
! Routines:
!
! (1) mtxel_m()         Originally By MLT               Last Modified 6/5/2008 JRD
!
!     input: crys, wfnc, wfnvq, gvec, eqp, xct types
!            ik   label of k-point in FBZ
!
!     output: s0  matrix element of the momentum operator at point ik
!
!     Calculates the momentum operator between two sets of wavefunctions
!     < ic,k | P dot 2 (G+k+q) exp(-i q.r) | iv,k+q > / | P |
!     Division by ( E_c^LDA - E_v^LDA ) is done only if divide_energy = .true.
!     Each set has its own isort vector and the number of bands is nband
!     The momentum operator is divided by electron mass m = 0.5 (in Ry atomic units)
!     q is an optional small shift to k in reciprocal space
!     P is the polarization vector
!
! (2) mtxel_v()         Originally By MLT       Last Modified: 6/5/2008 (JRD)
!
!     input: wfnc, wfnvq, gvec types
!            qshift   length of the q-shift vector
!
!     output: s0   velocity matrix elements at a k-point
!
!     Calculates the velocity operator between two sets of wavefunctions
!     < ic,k | exp(-i q.r) | iv,k+q > / q
!     Note that this form is also correct for intraband transitions. --FHJ
!     Each set has its own isort vector and the number of bands is nband
!     q is a small but finite shift to k in reciprocal space
!
!===============================================================================

#include "f_defs.h"

module mtxel_optical_m

  use global_m
  implicit none

  private
  public :: mtxel_m, mtxel_v

contains

subroutine mtxel_m(crys,wfnc,wfnvq,gvec,eqp,xct,s0_dim1,s0_dim2,s0,ik,divide_energy)
  type (crystal), intent(in) :: crys
  type (wavefunction), intent(in) :: wfnc, wfnvq
  type (gspace), intent(in) :: gvec
  type (eqpinfo), intent(in) :: eqp
  type (xctinfo), intent(in) :: xct
  integer, intent(in) :: s0_dim1, s0_dim2
  SCALAR, intent(out) :: s0(:,:,:) !< (s0_dim1, s0_dim2, wfnc%nspin)
  integer, intent(in) :: ik
  logical, intent(in) :: divide_energy
  
  real(DP) :: kpg(3)
  integer :: ig, igq, ic, iv, isc
  integer, allocatable :: isorti(:)
  real(DP) :: fac
  SCALAR :: sum
  
!---------------------------------
! Initialize isorti array

  PUSH_SUB(mtxel_m)

  s0 = ZERO
  SAFE_ALLOCATE(isorti, (gvec%ng))
  isorti(:)=0
  do ig=1, gvec%ng
    isorti(wfnvq%isort(ig)) = ig
  enddo

!----------------------------------
! Check if the polarization vector is properly defined

  if (abs(xct%lpol).lt.TOL_Zero) then
    write(0,*) xct%lpol, xct%pol(:)
    call die("zero length polarization vector")
  endif

!----------------------------------
! Calculate s0(ic,iv) = < ic,k | P dot 2 (G+k+q) exp(-i q.r) | iv,k+q > / | P |
!                     / ( E_c^LDA - E_v^LDA )
! Here, q = 0 and (P dot 2 (G+k)) is replaced with (P dot 2 G)
! because < ic,k | P dot 2 k | iv, k > = P dot 2 k < ic,k | iv,k > = 0
! (only true for interband transitions. --DAS)

  do isc=1,wfnc%nspin
    do ic=1,s0_dim1
      do iv=1,s0_dim2
        sum=ZERO
        do ig=1, wfnc%ng
          igq=isorti(wfnc%isort(ig))
          kpg(:) = gvec%components(:,wfnc%isort(ig))
          fac=DOT_PRODUCT(xct%pol,MATMUL(crys%bdot,kpg))
          if (igq.gt.wfnvq%ng) exit
          sum = sum + MYCONJG(wfnc%cg(ig,ic,isc)) * wfnvq%cg(igq,iv,isc) * fac
        enddo
        s0(ic,iv,isc) = 2.d0 * sum / xct%lpol
        if(divide_energy) then
          s0(ic,iv,isc) = s0(ic,iv,isc) / (eqp%eclda(ic,ik,isc)-eqp%evlda(iv,ik,isc))
        endif
      enddo
    enddo
  enddo
  
  SAFE_DEALLOCATE(isorti)
  
  POP_SUB(mtxel_m)
  
  return
end subroutine mtxel_m

!===============================================================================

subroutine mtxel_v(wfnc,wfnvq,gvec,qshift,s0_dim1,s0_dim2,s0)

  use global_m
  implicit none

  type (wavefunction), intent(in) :: wfnc, wfnvq
  type (gspace), intent(in) :: gvec
  real(DP), intent(in) :: qshift
  integer, intent(in) :: s0_dim1, s0_dim2
  SCALAR, intent(out) :: s0(:,:,:) !< (s0_dim1, s0_dim2, wfnc%nspin)
  
  integer :: ig, igq, ic, iv, isc
  integer, allocatable :: isorti(:)
  SCALAR :: sum

!--------------------------------
! Initialize isorti array

  PUSH_SUB(mtxel_v)
  
  s0 = ZERO
  SAFE_ALLOCATE(isorti, (gvec%ng))
  isorti(:)=0
  do ig=1, gvec%ng
    isorti(wfnvq%isort(ig)) = ig
  enddo

!--------------------------------
! Calculate s0(ic,iv) = < ic,k | exp(-i q.r) | iv,k+q > / q

  do isc=1,wfnc%nspin
    do ic=1,s0_dim1
      do iv=1,s0_dim2
        sum=ZERO
        do ig=1, wfnc%ng
          igq=isorti(wfnc%isort(ig))
          if (igq.gt.wfnvq%ng) exit
          sum = sum + MYCONJG(wfnc%cg(ig,ic,isc)) * wfnvq%cg(igq,iv,isc)
        enddo
        s0(ic,iv,isc) = sum / qshift
      enddo ! iv
    enddo ! ic
  enddo ! isc
  
  SAFE_DEALLOCATE(isorti)
  
  POP_SUB(mtxel_v)
  
  return
end subroutine mtxel_v

end module mtxel_optical_m
