Analysis Software
Documentation for sPHENIX simulation software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
lueevt.f
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file lueevt.f
1 
2 C*********************************************************************
3 
4  SUBROUTINE lueevt(KFL,ECM)
5 
6 C...Purpose: to handle the generation of an e+e- annihilation jet event.
7  IMPLICIT DOUBLE PRECISION(d)
8  common/lujets/n,k(9000,5),p(9000,5),v(9000,5)
9  SAVE /lujets/
10  common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
11  SAVE /ludat1/
12  common/ludat2/kchg(500,3),pmas(500,4),parf(2000),vckm(4,4)
13  SAVE /ludat2/
14 
15 C...Check input parameters.
16  IF(mstu(12).GE.1) CALL lulist(0)
17  IF(kfl.LT.0.OR.kfl.GT.8) THEN
18  CALL luerrm(16,'(LUEEVT:) called with unknown flavour code')
19  IF(mstu(21).GE.1) RETURN
20  ENDIF
21  IF(kfl.LE.5) ecmmin=parj(127)+2.02*parf(100+max(1,kfl))
22  IF(kfl.GE.6) ecmmin=parj(127)+2.02*pmas(kfl,1)
23  IF(ecm.LT.ecmmin) THEN
24  CALL luerrm(16,'(LUEEVT:) called with too small CM energy')
25  IF(mstu(21).GE.1) RETURN
26  ENDIF
27 
28 C...Check consistency of MSTJ options set.
29  IF(mstj(109).EQ.2.AND.mstj(110).NE.1) THEN
30  CALL luerrm(6,
31  & '(LUEEVT:) MSTJ(109) value requires MSTJ(110) = 1')
32  mstj(110)=1
33  ENDIF
34  IF(mstj(109).EQ.2.AND.mstj(111).NE.0) THEN
35  CALL luerrm(6,
36  & '(LUEEVT:) MSTJ(109) value requires MSTJ(111) = 0')
37  mstj(111)=0
38  ENDIF
39 
40 C...Initialize alpha_strong and total cross-section.
41  mstu(111)=mstj(108)
42  IF(mstj(108).EQ.2.AND.(mstj(101).EQ.0.OR.mstj(101).EQ.1))
43  &mstu(111)=1
44  paru(112)=parj(121)
45  IF(mstu(111).EQ.2) paru(112)=parj(122)
46  IF(mstj(116).GT.0.AND.(mstj(116).GE.2.OR.abs(ecm-parj(151)).GE.
47  &parj(139).OR.10*mstj(102)+kfl.NE.mstj(119))) CALL luxtot(kfl,ecm,
48  &xtot)
49  IF(mstj(116).GE.3) mstj(116)=1
50 
51 C...Add initial e+e- to event record (documentation only).
52  ntry=0
53  100 ntry=ntry+1
54  IF(ntry.GT.100) THEN
55  CALL luerrm(14,'(LUEEVT:) caught in an infinite loop')
56  RETURN
57  ENDIF
58  nc=0
59  IF(mstj(115).GE.2) THEN
60  nc=nc+2
61  CALL lu1ent(nc-1,11,0.5*ecm,0.,0.)
62  k(nc-1,1)=21
63  CALL lu1ent(nc,-11,0.5*ecm,paru(1),0.)
64  k(nc,1)=21
65  ENDIF
66 
67 C...Radiative photon (in initial state).
68  mk=0
69  ecmc=ecm
70  IF(mstj(107).GE.1.AND.mstj(116).GE.1) CALL luradk(ecm,mk,pak,
71  &thek,phik,alpk)
72  IF(mk.EQ.1) ecmc=sqrt(ecm*(ecm-2.*pak))
73  IF(mstj(115).GE.1.AND.mk.EQ.1) THEN
74  nc=nc+1
75  CALL lu1ent(nc,22,pak,thek,phik)
76  k(nc,3)=min(mstj(115)/2,1)
77  ENDIF
78 
79 C...Virtual exchange boson (gamma or Z0).
80  IF(mstj(115).GE.3) THEN
81  nc=nc+1
82  kf=22
83  IF(mstj(102).EQ.2) kf=23
84  mstu10=mstu(10)
85  mstu(10)=1
86  p(nc,5)=ecmc
87  CALL lu1ent(nc,kf,ecmc,0.,0.)
88  k(nc,1)=21
89  k(nc,3)=1
90  mstu(10)=mstu10
91  ENDIF
92 
93 C...Choice of flavour and jet configuration.
94  CALL luxkfl(kfl,ecm,ecmc,kflc)
95  IF(kflc.EQ.0) goto 100
96  CALL luxjet(ecmc,njet,cut)
97  kfln=21
98  IF(njet.EQ.4) CALL lux4jt(njet,cut,kflc,ecmc,kfln,x1,x2,x4,
99  &x12,x14)
100  IF(njet.EQ.3) CALL lux3jt(njet,cut,kflc,ecmc,x1,x3)
101  IF(njet.EQ.2) mstj(120)=1
102 
103 C...Fill jet configuration and origin.
104  IF(njet.EQ.2.AND.mstj(101).NE.5) CALL lu2ent(nc+1,kflc,-kflc,ecmc)
105  IF(njet.EQ.2.AND.mstj(101).EQ.5) CALL lu2ent(-(nc+1),kflc,-kflc,
106  &ecmc)
107  IF(njet.EQ.3) CALL lu3ent(nc+1,kflc,21,-kflc,ecmc,x1,x3)
108  IF(njet.EQ.4.AND.kfln.EQ.21) CALL lu4ent(nc+1,kflc,kfln,kfln,
109  &-kflc,ecmc,x1,x2,x4,x12,x14)
110  IF(njet.EQ.4.AND.kfln.NE.21) CALL lu4ent(nc+1,kflc,-kfln,kfln,
111  &-kflc,ecmc,x1,x2,x4,x12,x14)
112  DO 110 ip=nc+1,n
113  110 k(ip,3)=k(ip,3)+min(mstj(115)/2,1)+(mstj(115)/3)*(nc-1)
114 
115 C...Angular orientation according to matrix element.
116  IF(mstj(106).EQ.1) THEN
117  CALL luxdif(nc,njet,kflc,ecmc,chi,the,phi)
118  CALL ludbrb(nc+1,n,0.,chi,0d0,0d0,0d0)
119  CALL ludbrb(nc+1,n,the,phi,0d0,0d0,0d0)
120  ENDIF
121 
122 C...Rotation and boost from radiative photon.
123  IF(mk.EQ.1) THEN
124  dbek=-pak/(ecm-pak)
125  nmin=nc+1-mstj(115)/3
126  CALL ludbrb(nmin,n,0.,-phik,0d0,0d0,0d0)
127  CALL ludbrb(nmin,n,alpk,0.,dbek*sin(thek),0d0,dbek*cos(thek))
128  CALL ludbrb(nmin,n,0.,phik,0d0,0d0,0d0)
129  ENDIF
130 
131 C...Generate parton shower. Rearrange along strings and check.
132  IF(mstj(101).EQ.5) THEN
133  CALL lushow(n-1,n,ecmc)
134  mstj14=mstj(14)
135  IF(mstj(105).EQ.-1) mstj(14)=0
136  IF(mstj(105).GE.0) mstu(28)=0
137  CALL luprep(0)
138  mstj(14)=mstj14
139  IF(mstj(105).GE.0.AND.mstu(28).NE.0) goto 100
140  ENDIF
141 
142 C...Fragmentation/decay generation. Information for LUTABU.
143  IF(mstj(105).EQ.1) CALL luexec
144  mstu(161)=kflc
145  mstu(162)=-kflc
146 
147  RETURN
148  END