ECCE @ EIC Software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
luradk.f
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file luradk.f
1 
2 C*********************************************************************
3 
4  SUBROUTINE luradk(ECM,MK,PAK,THEK,PHIK,ALPK)
5 
6 C...Purpose: to generate initial state photon radiation.
7  common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
8  SAVE /ludat1/
9 
10 C...Function: cumulative hard photon spectrum in QFD case.
11  fxk(xx)=2.*log(xx)+parj(161)*log(1.-xx)+parj(162)*xx+
12  &parj(163)*log((xx-szm)**2+szw**2)+parj(164)*atan((xx-szm)/szw)
13 
14 C...Determine whether radiative photon or not.
15  mk=0
16  pak=0.
17  IF(parj(160).LT.rlu(0)) RETURN
18  mk=1
19 
20 C...Photon energy range. Find photon momentum in QED case.
21  xkl=parj(135)
22  xku=min(parj(136),1.-(2.*parj(127)/ecm)**2)
23  IF(mstj(102).LE.1) THEN
24  100 xk=1./(1.+(1./xkl-1.)*((1./xku-1.)/(1./xkl-1.))**rlu(0))
25  IF(1.+(1.-xk)**2.LT.2.*rlu(0)) goto 100
26 
27 C...Ditto in QFD case, by numerical inversion of integrated spectrum.
28  ELSE
29  szm=1.-(parj(123)/ecm)**2
30  szw=parj(123)*parj(124)/ecm**2
31  fxkl=fxk(xkl)
32  fxku=fxk(xku)
33  fxkd=1e-4*(fxku-fxkl)
34  fxkr=fxkl+rlu(0)*(fxku-fxkl)
35  nxk=0
36  110 nxk=nxk+1
37  xk=0.5*(xkl+xku)
38  fxkv=fxk(xk)
39  IF(fxkv.GT.fxkr) THEN
40  xku=xk
41  fxku=fxkv
42  ELSE
43  xkl=xk
44  fxkl=fxkv
45  ENDIF
46  IF(nxk.LT.15.AND.fxku-fxkl.GT.fxkd) goto 110
47  xk=xkl+(xku-xkl)*(fxkr-fxkl)/(fxku-fxkl)
48  ENDIF
49  pak=0.5*ecm*xk
50 
51 C...Photon polar and azimuthal angle.
52  pme=2.*(ulmass(11)/ecm)**2
53  120 cthm=pme*(2./pme)**rlu(0)
54  IF(1.-(xk**2*cthm*(1.-0.5*cthm)+2.*(1.-xk)*pme/max(pme,
55  &cthm*(1.-0.5*cthm)))/(1.+(1.-xk)**2).LT.rlu(0)) goto 120
56  cthe=1.-cthm
57  IF(rlu(0).GT.0.5) cthe=-cthe
58  sthe=sqrt(max(0.,(cthm-pme)*(2.-cthm)))
59  thek=ulangl(cthe,sthe)
60  phik=paru(2)*rlu(0)
61 
62 C...Rotation angle for hadronic system.
63  sgn=1.
64  IF(0.5*(2.-xk*(1.-cthe))**2/((2.-xk)**2+(xk*cthe)**2).GT.
65  &rlu(0)) sgn=-1.
66  alpk=asin(sgn*sthe*(xk-sgn*(2.*sqrt(1.-xk)-2.+xk)*cthe)/
67  &(2.-xk*(1.-sgn*cthe)))
68 
69  RETURN
70  END