!===========================================================================
!
! Module mtxelmultiply_m
!
! (1) mtxelMultiply()   Refactored from main.f90 By (PWD)     
!                                           Last Modified 10/21/2010 (PWD)
!
!     Combine the <c,k|e^(-i(q+G).r)|v,k+q><v,k+q|e^(i(q+G`).r)|c,k>
!                 -------------------------------------------------
!                                  energy denominator
!     Input:
!       pol%eden(band,spin) = 1/(e_val-e_cond) = energy denominators
!       pol%gme(band,g-vector,spin) = plane wave matrix elements
!       pol%isrtx   orders the |G(i)|^2   i=1,pol%nmtx
!       vwfn%isort  orders |qk+g|^2    (in vwfn type)
!
!       energies are apparently assumed in Rydbergs.
!
!===========================================================================

#include "f_defs.h"

module mtxelmultiply_m

  use global_m
  use blas_m
  use scalapack_m

  implicit none

  private

  public :: &
    mtxelMultiply

contains

  subroutine mtxelmultiply(scal,ntot,nrk,nst,fact,vwfn,gmetempr,gmetempc,chilocal, &
    polgme,pol,indt,pht,ipe,ispin)
    type (scalapack), intent(in) :: scal
    integer, intent(in) :: ntot
    integer, intent(in) :: nrk
    integer, intent(in) :: nst(:) !< (nrk)
    real(DP), intent(in) :: fact
    type (valence_wfns), intent(in) :: vwfn
    SCALAR, dimension(:,:), intent(inout) :: gmetempr(:,:),gmetempc(:,:)
    SCALAR, dimension(:,:), intent(inout) :: chilocal(:,:)
    SCALAR, intent(in) :: polgme(:,:,:,:,:,:)
    type (polarizability), intent(inout) :: pol
    integer, dimension(:,:,:), intent(in) :: indt
    SCALAR, dimension(:,:,:), intent(in) :: pht
    integer, intent(in) :: ipe
    integer, intent(in) :: ispin

    SCALAR :: negfact
    integer, allocatable :: tmprowindex(:),tmpcolindex(:)
    SCALAR, allocatable :: tmprowph(:),tmpcolph(:)
    integer :: irk, iv, ilimit, j, it, icurr, itot, mytot
    
    PUSH_SUB(mtxelMultiply)
    
    itot=0
    negfact = -1D0*fact
    
    if (peinf%inode.eq.0) call timacc(31,1)

    SAFE_ALLOCATE(tmprowindex,(scal%nprd(ipe)))
    SAFE_ALLOCATE(tmpcolindex,(scal%npcd(ipe)))
    SAFE_ALLOCATE(tmprowph,(scal%nprd(ipe)))
    SAFE_ALLOCATE(tmpcolph,(scal%npcd(ipe)))

    do irk = 1, nrk
      do it = 1, nst(irk) 

        do icurr=1,scal%nprd(ipe)
          tmprowindex(icurr) = indt(scal%imyrowd(icurr,ipe),it,irk)
          tmprowph(icurr) = pht(scal%imyrowd(icurr,ipe),it,irk)
        enddo
        do icurr=1,scal%npcd(ipe)
          tmpcolindex(icurr) = indt(scal%imycold(icurr,ipe),it,irk)
          tmpcolph(icurr) = pht(scal%imycold(icurr,ipe),it,irk)
        enddo
        
        do iv = 1,vwfn%nband+pol%ncrit
          if (peinf%doiownv(iv)) then
            ilimit = peinf%ncownactual
          else
            ilimit = 0
          endif
          
!$OMP PARALLEL private (mytot)
!$OMP DO
          do j = 1, ilimit 
            
            mytot = itot + j
            
            do icurr=1,scal%nprd(ipe)
              gmetempr(icurr,mytot)=polgme( &
                tmprowindex(icurr),j,peinf%indexv(iv), &
                ispin,irk,pol%os_para_freqs)* &
                tmprowph(icurr)
            enddo
            
            do icurr=1,scal%npcd(ipe)
              gmetempc(mytot,icurr)= &
                MYCONJG(polgme(tmpcolindex(icurr),j,peinf%indexv(iv),ispin,irk,pol%os_para_freqs)*tmpcolph(icurr))
            enddo
            
          enddo ! j
!$OMP END DO
!$OMP END PARALLEL
          itot = itot+ilimit
        enddo ! iv
      enddo ! it
    enddo ! irk
    
    if (peinf%inode.eq.0) call timacc(31,2)
    
    if (peinf%inode.eq.0) call timacc(30,1)
    
    if (ntot.ne.0) then
      call X(gemm)('n','n',scal%nprd(ipe),scal%npcd(ipe),ntot, &
        negfact,gmetempr,scal%nprd(ipe),gmetempc,ntot,ZERO,chilocal,scal%nprd(ipe))
      !call X(gemm)('n','t',scal%nprd(ipe),scal%npcd(ipe),ntot, &
      !  -ONE,gmetempr,scal%nprd(ipe),gmetempc,scal%npcd(ipe),ZERO,chilocal,scal%nprd(ipe))
    end if

    if (peinf%inode.eq.0) call timacc(30,2)

    SAFE_DEALLOCATE(tmprowindex)
    SAFE_DEALLOCATE(tmpcolindex)    
    SAFE_DEALLOCATE(tmprowph)
    SAFE_DEALLOCATE(tmpcolph)    
    
    POP_SUB(mtxelMultiply)
    
    return
    
  end subroutine mtxelMultiply
  
end module mtxelmultiply_m
