c/* %W%      latest revision %G% %U% */
      subroutine DENOM( k0, Mnuc, Enuck0, Epk0, psfac, kg, wt, den )
********************************************************************************

      implicit real*8 ( a-h , m , o-z )

      integer code

      real*8   k , k2 , kg , ko2 , k0

      dimension   den(*)
      dimension   kg(*) , wt(*)

      common /params/   hbarc , pi , Mp , MN , nZ , nA , nes , nwaves
      common /inputs/   Tlab , b , y1 , y2 , xnang ,  code , lmax ,
     $                  ngp , nr

********************************************************************************

      Mnuc2 = Mnuc * Mnuc
      Mp2 = Mp * Mp
      mr = Mnuc * Mp / ( Mnuc + Mp )

      ko2 = k0 * k0

      n1 = ngp + 1
      piinv = 1. / pi
      rhl1 = mr + mr
      rhl2 = ( rhl1 + rhl1 ) * piinv
      rhl3 = piinv + piinv
      rhl4 = rhl3 + rhl3

      sum = 0.

      if ( nr .le. 0 ) then
         psfac = k0 * rhl1
      else
         psfac = 2. * k0 * Epk0 * Enuck0/( Epk0 + Enuck0 )
      endif

      do 10 i = 1 , ngp
         k = kg(i)
         k2 = k * k
         if ( nr .le. 0 ) then
            den(i) = k2 * wt(i) * rhl2/( k2 - ko2 )
         else
            Enuck = SQRT( k2 + Mnuc2 )
            Epk = SQRT( k2 + Mp2 )
            den(i) = rhl3 * k2 * wt(i)/( Enuck + Epk - Enuck0 - Epk0 )
            if ( nr .gt. 4 ) then
               den(i) = rhl3 * k2 * wt(i)/( (k2 - ko2)/(psfac/k0) )
            endif
         endif
         sum = sum + wt(i)/( k2 - ko2 )
  10  continue

      if ( nr .le. 0 ) then
         den(n1) = -sum * rhl2 * ko2
      else
         den(n1) = -sum * rhl4 * ko2 * Enuck0 * Epk0/( Enuck0 + Epk0 )
      endif

      RETURN
      end
