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 ******************************************************************* c ****** This subroutine calculates the denominator ********** 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