
! Copyright (C) 2006 J. K. Dewhurst, S. Sharma and C. Ambrosch-Draxl.
! This file is distributed under the terms of the GNU General Public License.
! See the file COPYING for license details.

subroutine zrhogp(jlgpr,ylmgp,sfacgp,zrhomt,zrhoir,zrho0)
use modmain
implicit none
! arguments
real(8), intent(in) :: jlgpr(0:lmaxo,nrcmtmax,nspecies)
complex(8), intent(in) :: ylmgp(lmmaxo),sfacgp(natmtot)
complex(8), intent(in) :: zrhomt(npcmtmax,natmtot),zrhoir(ngtot)
complex(8), intent(out) :: zrho0
! local variables
integer is,ias
integer nrc,nrci,ir,irc
integer lmax,l,m,lm,i
real(8) t0,t1,t2
complex(8) zsum1,zsum2
! automatic arrays
real(8) fr1(nrcmtmax),fr2(nrcmtmax)
! external functions
real(8) fintgt
external fintgt
!-----------------------------------!
!     interstitial contribution     !
!-----------------------------------!
! (note that the phase exp(ip.r) is implicit)
zrho0=0.d0
do ir=1,ngtot
  zrho0=zrho0+cfunir(ir)*zrhoir(ir)
end do
zrho0=zrho0/dble(ngtot)
!---------------------------------!
!     muffin-tin contribution     !
!---------------------------------!
! (note that the phase exp(ip.r) is explicit)
t0=fourpi/omega
do ias=1,natmtot
  is=idxis(ias)
  nrc=nrcmt(is)
  nrci=nrcmti(is)
  lmax=lmaxi
  i=0
  do irc=1,nrc
    i=i+1
    zsum1=jlgpr(0,irc,is)*zrhomt(i,ias)*ylmgp(1)
    lm=1
    do l=1,lmax
      lm=lm+1
      i=i+1
      zsum2=zrhomt(i,ias)*ylmgp(lm)
      do m=1-l,l
        lm=lm+1
        i=i+1
        zsum2=zsum2+zrhomt(i,ias)*ylmgp(lm)
      end do
      zsum1=zsum1+jlgpr(l,irc,is)*zilc(l)*zsum2
    end do
    zsum1=zsum1*r2cmt(irc,is)
    fr1(irc)=dble(zsum1)
    fr2(irc)=aimag(zsum1)
    if (irc.eq.nrci) lmax=lmaxo
  end do
  t1=fintgt(-1,nrc,rcmt(:,is),fr1)
  t2=fintgt(-1,nrc,rcmt(:,is),fr2)
  zrho0=zrho0+t0*conjg(sfacgp(ias))*cmplx(t1,t2,8)
end do
return
end subroutine

