EIC Software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
lqev.F
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file lqev.F
1 
2 C **********************************************************************
3 
4  SUBROUTINE lqev
5 
6  IMPLICIT NONE
7 
8 C...Generate an ordinary 2-jet event, q-event.
9 
10 *
11 * to avoid variable conflictions, a second keep element is necessary
12 * with the same common block name (see LPTOU2)
13 *
14  COMMON /leptou/ cut(14),lst(40),parl(30),
15  & x,y,w2,q2,u
16  REAL cut,parl,x,y,w2,q2,u
17  INTEGER lst
18  SAVE /leptou/
19 
20  COMMON /linter/ pari(50),ewqc(2,2,8),qc(8),zl(2,4),zq(2,8),pq(17)
21  REAL pari,ewqc,qc,zl,zq,pq
22  SAVE /linter/
23 
24  INTEGER nlupdm,nplbuf
25  parameter(nlupdm=4000,nplbuf=5)
26  common/lujets/n,k(nlupdm,5),p(nlupdm,nplbuf),v(nlupdm,5)
27  INTEGER n,k
28  REAL p,v
29  SAVE /lujets/
30 
31  common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
32  INTEGER mstu,mstj
33  REAL paru,parj
34  SAVE /ludat1/
35 
36  common/ludat2/kchg(500,3),pmas(500,4),parf(2000),vckm(4,4)
37  INTEGER kchg
38  REAL pmas,parf,vckm
39  SAVE /ludat2/
40 
41 
42  INTEGER ifl,iflr,iflrar,iflro,nremh,k2,iflar
43  REAL w,amifl,xt,amk2,amiflr,pt,phi,pt2,tm2k2,ek2,pzk2,epz,wt,
44  +tmiflr,eifl,eiflr,ther,thek2
45  REAL ulmass,ulangl
46  INTEGER kfiflr,lucomp,kfk2
47 
48  lst(24)=1
49  w=sqrt(w2)
50 
51 C...Choose flavour of scattered quark and target remnant.
52  200 CALL lflav(ifl,iflr)
53  IF(lst(21).NE.0) goto 200
54 
55  goto 210
56 C...Entry used for Ariadne
57  entry lqevar(iflar,iflrar)
58  ifl=iflar
59  iflr=iflrar
60  lst(24)=1
61  w=sqrt(w2)
62 
63  210 CONTINUE
64  mstj(93)=1
65  amifl=ulmass(ifl)
66  mstj(93)=1
67  amiflr=ulmass(iflr)
68  IF(lst(14).EQ.0.OR.iflr.GT.10
69  &.OR.(lst(8).GE.2.AND.mod(lst(8),10).NE.9)) THEN
70 C...Check if energy in jet system is enough for fragmentation.
71  IF(w.LT.amifl+amiflr+parj(32)) goto 200
72  CALL lu2ent(mstu(1),ifl,iflr,w)
73  k(mstu(1)+1,3)=2
74  ELSE
75 C...Target remnant is not a simple diquark, special treatment needed.
76  IF(w.LT.amifl+amiflr+0.9+parj(32)) goto 200
77  iflro=iflr
78  nremh=0
79  300 nremh=nremh+1
80  IF(nremh.GT.100) goto 999
81 C...Give balancing pt to IFLQ and IFLQQ.
82  CALL lprikt(parl(14),pt,phi)
83  CALL lremh(iflro,pt,iflr,k2,xt)
84  mstj(93)=1
85  amiflr=ulmass(iflr)
86 CJR--
87  kfiflr=lucomp(iflr)
88  IF (kfiflr.EQ.90) THEN
89  amiflr=amiflr-2.*parl(20)
90  ELSEIF (1.LE.kfiflr .AND. kfiflr.LE.6) THEN
91  amiflr=amiflr-parl(20)
92  ENDIF
93  mstj(93)=1
94  amk2=ulmass(k2)
95  kfk2=lucomp(k2)
96  IF (kfk2.EQ.90) THEN
97  amk2=amk2-2.*parl(20)
98  ELSEIF (1.LE.kfk2 .AND. kfk2.LE.6) THEN
99  amk2=amk2-parl(20)
100  ENDIF
101 CJR--
102  pt2=pt**2
103  tm2k2=amk2**2+pt2
104  ek2=.5*(xt*w+tm2k2/xt/w)
105  pzk2=-.5*(xt*w-tm2k2/xt/w)
106  epz=w-tm2k2/xt/w
107  wt=(1.-xt)*w*epz-pt2
108 C...Check if energy in jet system is enough for fragmentation.
109  IF(wt.LT.(amifl+amiflr+parj(32))**2) goto 300
110  wt=sqrt(wt+pt2)
111  tmiflr=amiflr**2+pt2
112  eifl=.5*(wt+(amifl**2-tmiflr)/wt)
113  eiflr=.5*(wt+(-amifl**2+tmiflr)/wt)
114  ther=ulangl(-sqrt(eiflr**2-tmiflr),pt)
115 C...Form jet system.
116 C...Use the same mass as above to avoid momentum non-conservation
117  mstu(10)=1
118  p(mstu(1),5)=amifl
119  CALL lu1ent(-mstu(1),ifl,eifl,0.,0.)
120  mstu(10)=1
121  p(mstu(1)+1,5)=amiflr
122  CALL lu1ent(mstu(1)+1,iflr,eiflr,ther,phi)
123  CALL ludbrb(mstu(1),0,0.,0.,0.d0,0.d0,
124  & (dble(epz)-(1.d0-dble(xt))*dble(w))/
125  & (dble(epz)+(1.d0-dble(xt))*dble(w)))
126  thek2=ulangl(pzk2,pt)
127 C...Add formed "target" particle.
128  mstu(10)=1
129  p(mstu(1)+2,5)=amk2
130  CALL lu1ent(mstu(1)+2,k2,ek2,thek2,phi+3.1415927)
131  mstu(10)=2
132  k(mstu(1)+1,3)=2
133  k(mstu(1)+2,3)=2
134 CIC...Target remnants required to go backwards in hadronic cms
135  IF(p(mstu(1)+1,3).GT.0..OR.p(mstu(1)+2,3).GT.0.) goto 300
136  ENDIF
137 
138 CAE...Set reasonable values to the ME variables xp,zq and phi
139  parl(28)=1.0
140  parl(29)=1.0
141  parl(30)=0.0
142 
143  lst(21)=0
144  RETURN
145 
146  999 lst(21)=3
147  RETURN
148  END