]>
Commit | Line | Data |
---|---|---|
1 | C********************************************************************* | |
2 | C* This version of Jetset 7.4 was altered by | |
3 | C* | |
4 | C* Frank Wuerthwein (fkw@fnal.gov) 3/22/00 | |
5 | C* | |
6 | C* to be compatible with Pythia 6.115 . | |
7 | C* Changes are in LYGIVE to adjust common blocks to PYTHIA 6.115 | |
8 | C* This involves array sizes, double precision, and some rearrangement | |
9 | C* of common block content for the common blocks: | |
10 | C* PYSUBS, PYPARS, PYINT1,2,3,4,5,6,7 | |
11 | C* LYLOGO is only affected by the switch to DOUBLE PRECISION. | |
12 | C* | |
13 | C* The switch to double precission is implemented such that only the | |
14 | C* REAL 's in PYxxxx commons are explicitly defined as DOUPLE PRECISION. | |
15 | C* All of Jetset remains REAL rather than DOUBLE PRECISION . | |
16 | C* | |
17 | C* WARNING | |
18 | C* | |
19 | C* All common blocks and symbol names were renamed to avoid possible | |
20 | C* conflicts with other instances of JETSET (J. Beringer, 4/6/2006). | |
21 | C* | |
22 | C********************************************************************* | |
23 | C* ** | |
24 | C* December 1993 ** | |
25 | C* ** | |
26 | C* The Lund Monte Carlo for Jet Fragmentation and e+e- Physics ** | |
27 | C* ** | |
28 | C* JETSET version 7.4 ** | |
29 | C* ** | |
30 | C* Torbjorn Sjostrand ** | |
31 | C* Department of theoretical physics 2 ** | |
32 | C* University of Lund ** | |
33 | C* Solvegatan 14A, S-223 62 Lund, Sweden ** | |
34 | C* E-mail torbjorn@thep.lu.se ** | |
35 | C* phone +46 - 46 - 222 48 16 ** | |
36 | C* ** | |
37 | C* LYSHOW is written together with Mats Bengtsson ** | |
38 | C* ** | |
39 | C* The latest program version and documentation is found on WWW ** | |
40 | C* http://thep.lu.se/tf2/staff/torbjorn/Welcome.html ** | |
41 | C* ** | |
42 | C* Copyright Torbjorn Sjostrand and CERN, Geneva 1993 ** | |
43 | C* ** | |
44 | C********************************************************************* | |
45 | C********************************************************************* | |
46 | C * | |
47 | C List of subprograms in order of appearance, with main purpose * | |
48 | C (S = subroutine, F = function, B = block data) * | |
49 | C * | |
50 | C S LY1ENT to fill one entry (= parton or particle) * | |
51 | C S LY2ENT to fill two entries * | |
52 | C S LY3ENT to fill three entries * | |
53 | C S LY4ENT to fill four entries * | |
54 | C S LYJOIN to connect entries with colour flow information * | |
55 | C S LYGIVE to fill (or query) commonblock variables * | |
56 | C S LYEXEC to administrate fragmentation and decay chain * | |
57 | C S LYPREP to rearrange showered partons along strings * | |
58 | C S LYSTRF to do string fragmentation of jet system * | |
59 | C S LYINDF to do independent fragmentation of one or many jets * | |
60 | C S LYDECY to do the decay of a particle * | |
61 | C S LYKFDI to select parton and hadron flavours in fragm * | |
62 | C S LYPTDI to select transverse momenta in fragm * | |
63 | C S LYZDIS to select longitudinal scaling variable in fragm * | |
64 | C S LYSHOW to do timelike parton shower evolution * | |
65 | C S LYBOEI to include Bose-Einstein effects (crudely) * | |
66 | C F UYMASS to give the mass of a particle or parton * | |
67 | C S LYNAME to give the name of a particle or parton * | |
68 | C F LYCHGE to give three times the electric charge * | |
69 | C F LYCOMP to compress standard KF flavour code to internal KC * | |
70 | C S LYERRM to write error messages and abort faulty run * | |
71 | C F UYALEM to give the alpha_electromagnetic value * | |
72 | C F UYALPS to give the alpha_strong value * | |
73 | C F UYANGL to give the angle from known x and y components * | |
74 | C F RLY to provide a random number generator * | |
75 | C S RLYGET to save the state of the random number generator * | |
76 | C S RLYSET to set the state of the random number generator * | |
77 | C S LYROBO to rotate and/or boost an event * | |
78 | C S LYEDIT to remove unwanted entries from record * | |
79 | C S LYLIST to list event record or particle data * | |
80 | C S LYLOGO to write a logo for JETSET and PYTHIA * | |
81 | C S LYUPDA to update particle data * | |
82 | C F KLY to provide integer-valued event information * | |
83 | C F PLY to provide real-valued event information * | |
84 | C S LYSPHE to perform sphericity analysis * | |
85 | C S LYTHRU to perform thrust analysis * | |
86 | C S LYCLUS to perform three-dimensional cluster analysis * | |
87 | C S LYCELL to perform cluster analysis in (eta, phi, E_T) * | |
88 | C S LYJMAS to give high and low jet mass of event * | |
89 | C S LYFOWO to give Fox-Wolfram moments * | |
90 | C S LYTABU to analyze events, with tabular output * | |
91 | C * | |
92 | C S LYEEVT to administrate the generation of an e+e- event * | |
93 | C S LYXTOT to give the total cross-section at given CM energy * | |
94 | C S LYRADK to generate initial state photon radiation * | |
95 | C S LYXKFL to select flavour of primary qqbar pair * | |
96 | C S LYXJET to select (matrix element) jet multiplicity * | |
97 | C S LYX3JT to select kinematics of three-jet event * | |
98 | C S LYX4JT to select kinematics of four-jet event * | |
99 | C S LYXDIF to select angular orientation of event * | |
100 | C S LYONIA to perform generation of onium decay to gluons * | |
101 | C * | |
102 | C S LYHEPC to convert between /LYJETS/ and /XHEPEVT/ records * | |
103 | C S LYTEST to test the proper functioning of the package * | |
104 | C B LYDATA to contain default values and particle data * | |
105 | C * | |
106 | C********************************************************************* | |
107 | ||
108 | SUBROUTINE LY1ENT(IP,KF,PE,THE,PHI) | |
109 | ||
110 | C...Purpose: to store one parton/particle in commonblock LUJETS. | |
111 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
112 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
113 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
114 | SAVE /LYJETS/,/LYDAT1/,/LYDAT2/ | |
115 | ||
116 | C...Standard checks. | |
117 | MSTU(28)=0 | |
118 | IF(MSTU(12).GE.1) CALL LYLIST(0) | |
119 | IPA=MAX(1,IABS(IP)) | |
120 | IF(IPA.GT.MSTU(4)) CALL LYERRM(21, | |
121 | &'(LY1ENT:) writing outside LUJETS memory') | |
122 | KC=LYCOMP(KF) | |
123 | IF(KC.EQ.0) CALL LYERRM(12,'(LY1ENT:) unknown flavour code') | |
124 | ||
125 | C...Find mass. Reset K, P and V vectors. | |
126 | PM=0. | |
127 | IF(MSTU(10).EQ.1) PM=P(IPA,5) | |
128 | IF(MSTU(10).GE.2) PM=UYMASS(KF) | |
129 | DO 100 J=1,5 | |
130 | K(IPA,J)=0 | |
131 | P(IPA,J)=0. | |
132 | V(IPA,J)=0. | |
133 | 100 CONTINUE | |
134 | ||
135 | C...Store parton/particle in K and P vectors. | |
136 | K(IPA,1)=1 | |
137 | IF(IP.LT.0) K(IPA,1)=2 | |
138 | K(IPA,2)=KF | |
139 | P(IPA,5)=PM | |
140 | P(IPA,4)=MAX(PE,PM) | |
141 | PA=SQRT(P(IPA,4)**2-P(IPA,5)**2) | |
142 | P(IPA,1)=PA*SIN(THE)*COS(PHI) | |
143 | P(IPA,2)=PA*SIN(THE)*SIN(PHI) | |
144 | P(IPA,3)=PA*COS(THE) | |
145 | ||
146 | C...Set N. Optionally fragment/decay. | |
147 | N=IPA | |
148 | IF(IP.EQ.0) CALL LYEXEC | |
149 | ||
150 | RETURN | |
151 | END | |
152 | ||
153 | C********************************************************************* | |
154 | ||
155 | SUBROUTINE LY2ENT(IP,KF1,KF2,PECM) | |
156 | ||
157 | C...Purpose: to store two partons/particles in their CM frame, | |
158 | C...with the first along the +z axis. | |
159 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
160 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
161 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
162 | SAVE /LYJETS/,/LYDAT1/,/LYDAT2/ | |
163 | ||
164 | C...Standard checks. | |
165 | MSTU(28)=0 | |
166 | IF(MSTU(12).GE.1) CALL LYLIST(0) | |
167 | IPA=MAX(1,IABS(IP)) | |
168 | IF(IPA.GT.MSTU(4)-1) CALL LYERRM(21, | |
169 | &'(LY2ENT:) writing outside LUJETS memory') | |
170 | KC1=LYCOMP(KF1) | |
171 | KC2=LYCOMP(KF2) | |
172 | IF(KC1.EQ.0.OR.KC2.EQ.0) CALL LYERRM(12, | |
173 | &'(LY2ENT:) unknown flavour code') | |
174 | ||
175 | C...Find masses. Reset K, P and V vectors. | |
176 | PM1=0. | |
177 | IF(MSTU(10).EQ.1) PM1=P(IPA,5) | |
178 | IF(MSTU(10).GE.2) PM1=UYMASS(KF1) | |
179 | PM2=0. | |
180 | IF(MSTU(10).EQ.1) PM2=P(IPA+1,5) | |
181 | IF(MSTU(10).GE.2) PM2=UYMASS(KF2) | |
182 | DO 110 I=IPA,IPA+1 | |
183 | DO 100 J=1,5 | |
184 | K(I,J)=0 | |
185 | P(I,J)=0. | |
186 | V(I,J)=0. | |
187 | 100 CONTINUE | |
188 | 110 CONTINUE | |
189 | ||
190 | C...Check flavours. | |
191 | KQ1=KCHG(KC1,2)*ISIGN(1,KF1) | |
192 | KQ2=KCHG(KC2,2)*ISIGN(1,KF2) | |
193 | IF(MSTU(19).EQ.1) THEN | |
194 | MSTU(19)=0 | |
195 | ELSE | |
196 | IF(KQ1+KQ2.NE.0.AND.KQ1+KQ2.NE.4) CALL LYERRM(2, | |
197 | & '(LY2ENT:) unphysical flavour combination') | |
198 | ENDIF | |
199 | K(IPA,2)=KF1 | |
200 | K(IPA+1,2)=KF2 | |
201 | ||
202 | C...Store partons/particles in K vectors for normal case. | |
203 | IF(IP.GE.0) THEN | |
204 | K(IPA,1)=1 | |
205 | IF(KQ1.NE.0.AND.KQ2.NE.0) K(IPA,1)=2 | |
206 | K(IPA+1,1)=1 | |
207 | ||
208 | C...Store partons in K vectors for parton shower evolution. | |
209 | ELSE | |
210 | K(IPA,1)=3 | |
211 | K(IPA+1,1)=3 | |
212 | K(IPA,4)=MSTU(5)*(IPA+1) | |
213 | K(IPA,5)=K(IPA,4) | |
214 | K(IPA+1,4)=MSTU(5)*IPA | |
215 | K(IPA+1,5)=K(IPA+1,4) | |
216 | ENDIF | |
217 | ||
218 | C...Check kinematics and store partons/particles in P vectors. | |
219 | IF(PECM.LE.PM1+PM2) CALL LYERRM(13, | |
220 | &'(LY2ENT:) energy smaller than sum of masses') | |
221 | PA=SQRT(MAX(0.,(PECM**2-PM1**2-PM2**2)**2-(2.*PM1*PM2)**2))/ | |
222 | &(2.*PECM) | |
223 | P(IPA,3)=PA | |
224 | P(IPA,4)=SQRT(PM1**2+PA**2) | |
225 | P(IPA,5)=PM1 | |
226 | P(IPA+1,3)=-PA | |
227 | P(IPA+1,4)=SQRT(PM2**2+PA**2) | |
228 | P(IPA+1,5)=PM2 | |
229 | ||
230 | C...Set N. Optionally fragment/decay. | |
231 | N=IPA+1 | |
232 | IF(IP.EQ.0) CALL LYEXEC | |
233 | ||
234 | RETURN | |
235 | END | |
236 | ||
237 | C********************************************************************* | |
238 | ||
239 | SUBROUTINE LY3ENT(IP,KF1,KF2,KF3,PECM,X1,X3) | |
240 | ||
241 | C...Purpose: to store three partons or particles in their CM frame, | |
242 | C...with the first along the +z axis and the third in the (x,z) | |
243 | C...plane with x > 0. | |
244 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
245 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
246 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
247 | SAVE /LYJETS/,/LYDAT1/,/LYDAT2/ | |
248 | ||
249 | C...Standard checks. | |
250 | MSTU(28)=0 | |
251 | IF(MSTU(12).GE.1) CALL LYLIST(0) | |
252 | IPA=MAX(1,IABS(IP)) | |
253 | IF(IPA.GT.MSTU(4)-2) CALL LYERRM(21, | |
254 | &'(LY3ENT:) writing outside LUJETS memory') | |
255 | KC1=LYCOMP(KF1) | |
256 | KC2=LYCOMP(KF2) | |
257 | KC3=LYCOMP(KF3) | |
258 | IF(KC1.EQ.0.OR.KC2.EQ.0.OR.KC3.EQ.0) CALL LYERRM(12, | |
259 | &'(LY3ENT:) unknown flavour code') | |
260 | ||
261 | C...Find masses. Reset K, P and V vectors. | |
262 | PM1=0. | |
263 | IF(MSTU(10).EQ.1) PM1=P(IPA,5) | |
264 | IF(MSTU(10).GE.2) PM1=UYMASS(KF1) | |
265 | PM2=0. | |
266 | IF(MSTU(10).EQ.1) PM2=P(IPA+1,5) | |
267 | IF(MSTU(10).GE.2) PM2=UYMASS(KF2) | |
268 | PM3=0. | |
269 | IF(MSTU(10).EQ.1) PM3=P(IPA+2,5) | |
270 | IF(MSTU(10).GE.2) PM3=UYMASS(KF3) | |
271 | DO 110 I=IPA,IPA+2 | |
272 | DO 100 J=1,5 | |
273 | K(I,J)=0 | |
274 | P(I,J)=0. | |
275 | V(I,J)=0. | |
276 | 100 CONTINUE | |
277 | 110 CONTINUE | |
278 | ||
279 | C...Check flavours. | |
280 | KQ1=KCHG(KC1,2)*ISIGN(1,KF1) | |
281 | KQ2=KCHG(KC2,2)*ISIGN(1,KF2) | |
282 | KQ3=KCHG(KC3,2)*ISIGN(1,KF3) | |
283 | IF(MSTU(19).EQ.1) THEN | |
284 | MSTU(19)=0 | |
285 | ELSEIF(KQ1.EQ.0.AND.KQ2.EQ.0.AND.KQ3.EQ.0) THEN | |
286 | ELSEIF(KQ1.NE.0.AND.KQ2.EQ.2.AND.(KQ1+KQ3.EQ.0.OR. | |
287 | &KQ1+KQ3.EQ.4)) THEN | |
288 | ELSE | |
289 | CALL LYERRM(2,'(LY3ENT:) unphysical flavour combination') | |
290 | ENDIF | |
291 | K(IPA,2)=KF1 | |
292 | K(IPA+1,2)=KF2 | |
293 | K(IPA+2,2)=KF3 | |
294 | ||
295 | C...Store partons/particles in K vectors for normal case. | |
296 | IF(IP.GE.0) THEN | |
297 | K(IPA,1)=1 | |
298 | IF(KQ1.NE.0.AND.(KQ2.NE.0.OR.KQ3.NE.0)) K(IPA,1)=2 | |
299 | K(IPA+1,1)=1 | |
300 | IF(KQ2.NE.0.AND.KQ3.NE.0) K(IPA+1,1)=2 | |
301 | K(IPA+2,1)=1 | |
302 | ||
303 | C...Store partons in K vectors for parton shower evolution. | |
304 | ELSE | |
305 | K(IPA,1)=3 | |
306 | K(IPA+1,1)=3 | |
307 | K(IPA+2,1)=3 | |
308 | KCS=4 | |
309 | IF(KQ1.EQ.-1) KCS=5 | |
310 | K(IPA,KCS)=MSTU(5)*(IPA+1) | |
311 | K(IPA,9-KCS)=MSTU(5)*(IPA+2) | |
312 | K(IPA+1,KCS)=MSTU(5)*(IPA+2) | |
313 | K(IPA+1,9-KCS)=MSTU(5)*IPA | |
314 | K(IPA+2,KCS)=MSTU(5)*IPA | |
315 | K(IPA+2,9-KCS)=MSTU(5)*(IPA+1) | |
316 | ENDIF | |
317 | ||
318 | C...Check kinematics. | |
319 | MKERR=0 | |
320 | IF(0.5*X1*PECM.LE.PM1.OR.0.5*(2.-X1-X3)*PECM.LE.PM2.OR. | |
321 | &0.5*X3*PECM.LE.PM3) MKERR=1 | |
322 | PA1=SQRT(MAX(1E-10,(0.5*X1*PECM)**2-PM1**2)) | |
323 | PA2=SQRT(MAX(1E-10,(0.5*(2.-X1-X3)*PECM)**2-PM2**2)) | |
324 | PA3=SQRT(MAX(1E-10,(0.5*X3*PECM)**2-PM3**2)) | |
325 | CTHE2=(PA3**2-PA1**2-PA2**2)/(2.*PA1*PA2) | |
326 | CTHE3=(PA2**2-PA1**2-PA3**2)/(2.*PA1*PA3) | |
327 | IF(ABS(CTHE2).GE.1.001.OR.ABS(CTHE3).GE.1.001) MKERR=1 | |
328 | CTHE3=MAX(-1.,MIN(1.,CTHE3)) | |
329 | IF(MKERR.NE.0) CALL LYERRM(13, | |
330 | &'(LY3ENT:) unphysical kinematical variable setup') | |
331 | ||
332 | C...Store partons/particles in P vectors. | |
333 | P(IPA,3)=PA1 | |
334 | P(IPA,4)=SQRT(PA1**2+PM1**2) | |
335 | P(IPA,5)=PM1 | |
336 | P(IPA+2,1)=PA3*SQRT(1.-CTHE3**2) | |
337 | P(IPA+2,3)=PA3*CTHE3 | |
338 | P(IPA+2,4)=SQRT(PA3**2+PM3**2) | |
339 | P(IPA+2,5)=PM3 | |
340 | P(IPA+1,1)=-P(IPA+2,1) | |
341 | P(IPA+1,3)=-P(IPA,3)-P(IPA+2,3) | |
342 | P(IPA+1,4)=SQRT(P(IPA+1,1)**2+P(IPA+1,3)**2+PM2**2) | |
343 | P(IPA+1,5)=PM2 | |
344 | ||
345 | C...Set N. Optionally fragment/decay. | |
346 | N=IPA+2 | |
347 | IF(IP.EQ.0) CALL LYEXEC | |
348 | ||
349 | RETURN | |
350 | END | |
351 | ||
352 | C********************************************************************* | |
353 | ||
354 | SUBROUTINE LY4ENT(IP,KF1,KF2,KF3,KF4,PECM,X1,X2,X4,X12,X14) | |
355 | ||
356 | C...Purpose: to store four partons or particles in their CM frame, with | |
357 | C...the first along the +z axis, the last in the xz plane with x > 0 | |
358 | C...and the second having y < 0 and y > 0 with equal probability. | |
359 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
360 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
361 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
362 | SAVE /LYJETS/,/LYDAT1/,/LYDAT2/ | |
363 | ||
364 | C...Standard checks. | |
365 | MSTU(28)=0 | |
366 | IF(MSTU(12).GE.1) CALL LYLIST(0) | |
367 | IPA=MAX(1,IABS(IP)) | |
368 | IF(IPA.GT.MSTU(4)-3) CALL LYERRM(21, | |
369 | &'(LY4ENT:) writing outside LUJETS momory') | |
370 | KC1=LYCOMP(KF1) | |
371 | KC2=LYCOMP(KF2) | |
372 | KC3=LYCOMP(KF3) | |
373 | KC4=LYCOMP(KF4) | |
374 | IF(KC1.EQ.0.OR.KC2.EQ.0.OR.KC3.EQ.0.OR.KC4.EQ.0) CALL LYERRM(12, | |
375 | &'(LY4ENT:) unknown flavour code') | |
376 | ||
377 | C...Find masses. Reset K, P and V vectors. | |
378 | PM1=0. | |
379 | IF(MSTU(10).EQ.1) PM1=P(IPA,5) | |
380 | IF(MSTU(10).GE.2) PM1=UYMASS(KF1) | |
381 | PM2=0. | |
382 | IF(MSTU(10).EQ.1) PM2=P(IPA+1,5) | |
383 | IF(MSTU(10).GE.2) PM2=UYMASS(KF2) | |
384 | PM3=0. | |
385 | IF(MSTU(10).EQ.1) PM3=P(IPA+2,5) | |
386 | IF(MSTU(10).GE.2) PM3=UYMASS(KF3) | |
387 | PM4=0. | |
388 | IF(MSTU(10).EQ.1) PM4=P(IPA+3,5) | |
389 | IF(MSTU(10).GE.2) PM4=UYMASS(KF4) | |
390 | DO 110 I=IPA,IPA+3 | |
391 | DO 100 J=1,5 | |
392 | K(I,J)=0 | |
393 | P(I,J)=0. | |
394 | V(I,J)=0. | |
395 | 100 CONTINUE | |
396 | 110 CONTINUE | |
397 | ||
398 | C...Check flavours. | |
399 | KQ1=KCHG(KC1,2)*ISIGN(1,KF1) | |
400 | KQ2=KCHG(KC2,2)*ISIGN(1,KF2) | |
401 | KQ3=KCHG(KC3,2)*ISIGN(1,KF3) | |
402 | KQ4=KCHG(KC4,2)*ISIGN(1,KF4) | |
403 | IF(MSTU(19).EQ.1) THEN | |
404 | MSTU(19)=0 | |
405 | ELSEIF(KQ1.EQ.0.AND.KQ2.EQ.0.AND.KQ3.EQ.0.AND.KQ4.EQ.0) THEN | |
406 | ELSEIF(KQ1.NE.0.AND.KQ2.EQ.2.AND.KQ3.EQ.2.AND.(KQ1+KQ4.EQ.0.OR. | |
407 | &KQ1+KQ4.EQ.4)) THEN | |
408 | ELSEIF(KQ1.NE.0.AND.KQ1+KQ2.EQ.0.AND.KQ3.NE.0.AND.KQ3+KQ4.EQ.0.) | |
409 | &THEN | |
410 | ELSE | |
411 | CALL LYERRM(2,'(LY4ENT:) unphysical flavour combination') | |
412 | ENDIF | |
413 | K(IPA,2)=KF1 | |
414 | K(IPA+1,2)=KF2 | |
415 | K(IPA+2,2)=KF3 | |
416 | K(IPA+3,2)=KF4 | |
417 | ||
418 | C...Store partons/particles in K vectors for normal case. | |
419 | IF(IP.GE.0) THEN | |
420 | K(IPA,1)=1 | |
421 | IF(KQ1.NE.0.AND.(KQ2.NE.0.OR.KQ3.NE.0.OR.KQ4.NE.0)) K(IPA,1)=2 | |
422 | K(IPA+1,1)=1 | |
423 | IF(KQ2.NE.0.AND.KQ1+KQ2.NE.0.AND.(KQ3.NE.0.OR.KQ4.NE.0)) | |
424 | & K(IPA+1,1)=2 | |
425 | K(IPA+2,1)=1 | |
426 | IF(KQ3.NE.0.AND.KQ4.NE.0) K(IPA+2,1)=2 | |
427 | K(IPA+3,1)=1 | |
428 | ||
429 | C...Store partons for parton shower evolution from q-g-g-qbar or | |
430 | C...g-g-g-g event. | |
431 | ELSEIF(KQ1+KQ2.NE.0) THEN | |
432 | K(IPA,1)=3 | |
433 | K(IPA+1,1)=3 | |
434 | K(IPA+2,1)=3 | |
435 | K(IPA+3,1)=3 | |
436 | KCS=4 | |
437 | IF(KQ1.EQ.-1) KCS=5 | |
438 | K(IPA,KCS)=MSTU(5)*(IPA+1) | |
439 | K(IPA,9-KCS)=MSTU(5)*(IPA+3) | |
440 | K(IPA+1,KCS)=MSTU(5)*(IPA+2) | |
441 | K(IPA+1,9-KCS)=MSTU(5)*IPA | |
442 | K(IPA+2,KCS)=MSTU(5)*(IPA+3) | |
443 | K(IPA+2,9-KCS)=MSTU(5)*(IPA+1) | |
444 | K(IPA+3,KCS)=MSTU(5)*IPA | |
445 | K(IPA+3,9-KCS)=MSTU(5)*(IPA+2) | |
446 | ||
447 | C...Store partons for parton shower evolution from q-qbar-q-qbar event. | |
448 | ELSE | |
449 | K(IPA,1)=3 | |
450 | K(IPA+1,1)=3 | |
451 | K(IPA+2,1)=3 | |
452 | K(IPA+3,1)=3 | |
453 | K(IPA,4)=MSTU(5)*(IPA+1) | |
454 | K(IPA,5)=K(IPA,4) | |
455 | K(IPA+1,4)=MSTU(5)*IPA | |
456 | K(IPA+1,5)=K(IPA+1,4) | |
457 | K(IPA+2,4)=MSTU(5)*(IPA+3) | |
458 | K(IPA+2,5)=K(IPA+2,4) | |
459 | K(IPA+3,4)=MSTU(5)*(IPA+2) | |
460 | K(IPA+3,5)=K(IPA+3,4) | |
461 | ENDIF | |
462 | ||
463 | C...Check kinematics. | |
464 | MKERR=0 | |
465 | IF(0.5*X1*PECM.LE.PM1.OR.0.5*X2*PECM.LE.PM2.OR.0.5*(2.-X1-X2-X4)* | |
466 | &PECM.LE.PM3.OR.0.5*X4*PECM.LE.PM4) MKERR=1 | |
467 | PA1=SQRT(MAX(1E-10,(0.5*X1*PECM)**2-PM1**2)) | |
468 | PA2=SQRT(MAX(1E-10,(0.5*X2*PECM)**2-PM2**2)) | |
469 | PA4=SQRT(MAX(1E-10,(0.5*X4*PECM)**2-PM4**2)) | |
470 | X24=X1+X2+X4-1.-X12-X14+(PM3**2-PM1**2-PM2**2-PM4**2)/PECM**2 | |
471 | CTHE4=(X1*X4-2.*X14)*PECM**2/(4.*PA1*PA4) | |
472 | IF(ABS(CTHE4).GE.1.002) MKERR=1 | |
473 | CTHE4=MAX(-1.,MIN(1.,CTHE4)) | |
474 | STHE4=SQRT(1.-CTHE4**2) | |
475 | CTHE2=(X1*X2-2.*X12)*PECM**2/(4.*PA1*PA2) | |
476 | IF(ABS(CTHE2).GE.1.002) MKERR=1 | |
477 | CTHE2=MAX(-1.,MIN(1.,CTHE2)) | |
478 | STHE2=SQRT(1.-CTHE2**2) | |
479 | CPHI2=((X2*X4-2.*X24)*PECM**2-4.*PA2*CTHE2*PA4*CTHE4)/ | |
480 | &MAX(1E-8*PECM**2,4.*PA2*STHE2*PA4*STHE4) | |
481 | IF(ABS(CPHI2).GE.1.05) MKERR=1 | |
482 | CPHI2=MAX(-1.,MIN(1.,CPHI2)) | |
483 | IF(MKERR.EQ.1) CALL LYERRM(13, | |
484 | &'(LY4ENT:) unphysical kinematical variable setup') | |
485 | ||
486 | C...Store partons/particles in P vectors. | |
487 | P(IPA,3)=PA1 | |
488 | P(IPA,4)=SQRT(PA1**2+PM1**2) | |
489 | P(IPA,5)=PM1 | |
490 | P(IPA+3,1)=PA4*STHE4 | |
491 | P(IPA+3,3)=PA4*CTHE4 | |
492 | P(IPA+3,4)=SQRT(PA4**2+PM4**2) | |
493 | P(IPA+3,5)=PM4 | |
494 | P(IPA+1,1)=PA2*STHE2*CPHI2 | |
495 | P(IPA+1,2)=PA2*STHE2*SQRT(1.-CPHI2**2)*(-1.)**INT(RLY(0)+0.5) | |
496 | P(IPA+1,3)=PA2*CTHE2 | |
497 | P(IPA+1,4)=SQRT(PA2**2+PM2**2) | |
498 | P(IPA+1,5)=PM2 | |
499 | P(IPA+2,1)=-P(IPA+1,1)-P(IPA+3,1) | |
500 | P(IPA+2,2)=-P(IPA+1,2) | |
501 | P(IPA+2,3)=-P(IPA,3)-P(IPA+1,3)-P(IPA+3,3) | |
502 | P(IPA+2,4)=SQRT(P(IPA+2,1)**2+P(IPA+2,2)**2+P(IPA+2,3)**2+PM3**2) | |
503 | P(IPA+2,5)=PM3 | |
504 | ||
505 | C...Set N. Optionally fragment/decay. | |
506 | N=IPA+3 | |
507 | IF(IP.EQ.0) CALL LYEXEC | |
508 | ||
509 | RETURN | |
510 | END | |
511 | ||
512 | C********************************************************************* | |
513 | ||
514 | SUBROUTINE LYJOIN(NJOIN,IJOIN) | |
515 | ||
516 | C...Purpose: to connect a sequence of partons with colour flow indices, | |
517 | C...as required for subsequent shower evolution (or other operations). | |
518 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
519 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
520 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
521 | SAVE /LYJETS/,/LYDAT1/,/LYDAT2/ | |
522 | DIMENSION IJOIN(*) | |
523 | ||
524 | C...Check that partons are of right types to be connected. | |
525 | IF(NJOIN.LT.2) GOTO 120 | |
526 | KQSUM=0 | |
527 | DO 100 IJN=1,NJOIN | |
528 | I=IJOIN(IJN) | |
529 | IF(I.LE.0.OR.I.GT.N) GOTO 120 | |
530 | IF(K(I,1).LT.1.OR.K(I,1).GT.3) GOTO 120 | |
531 | KC=LYCOMP(K(I,2)) | |
532 | IF(KC.EQ.0) GOTO 120 | |
533 | KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) | |
534 | IF(KQ.EQ.0) GOTO 120 | |
535 | IF(IJN.NE.1.AND.IJN.NE.NJOIN.AND.KQ.NE.2) GOTO 120 | |
536 | IF(KQ.NE.2) KQSUM=KQSUM+KQ | |
537 | IF(IJN.EQ.1) KQS=KQ | |
538 | 100 CONTINUE | |
539 | IF(KQSUM.NE.0) GOTO 120 | |
540 | ||
541 | C...Connect the partons sequentially (closing for gluon loop). | |
542 | KCS=(9-KQS)/2 | |
543 | IF(KQS.EQ.2) KCS=INT(4.5+RLY(0)) | |
544 | DO 110 IJN=1,NJOIN | |
545 | I=IJOIN(IJN) | |
546 | K(I,1)=3 | |
547 | IF(IJN.NE.1) IP=IJOIN(IJN-1) | |
548 | IF(IJN.EQ.1) IP=IJOIN(NJOIN) | |
549 | IF(IJN.NE.NJOIN) IN=IJOIN(IJN+1) | |
550 | IF(IJN.EQ.NJOIN) IN=IJOIN(1) | |
551 | K(I,KCS)=MSTU(5)*IN | |
552 | K(I,9-KCS)=MSTU(5)*IP | |
553 | IF(IJN.EQ.1.AND.KQS.NE.2) K(I,9-KCS)=0 | |
554 | IF(IJN.EQ.NJOIN.AND.KQS.NE.2) K(I,KCS)=0 | |
555 | 110 CONTINUE | |
556 | ||
557 | C...Error exit: no action taken. | |
558 | RETURN | |
559 | 120 CALL LYERRM(12, | |
560 | &'(LYJOIN:) given entries can not be joined by one string') | |
561 | ||
562 | RETURN | |
563 | END | |
564 | ||
565 | C********************************************************************* | |
566 | ||
567 | SUBROUTINE LYGIVE(CHIN) | |
568 | ||
569 | C...Purpose: to set values of commonblock variables (also in PYTHIA!). | |
570 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
571 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
572 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
573 | COMMON/LYDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) | |
574 | COMMON/LYDAT4/CHAF(500) | |
575 | CHARACTER CHAF*8 | |
576 | COMMON/LYDATR/MRLU(6),RRLU(100) | |
577 | c DOUBLE PRECISION KFIN,CKIN | |
578 | c COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200) | |
579 | c DOUBLE PRECISION PARP,PARI | |
580 | c COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
581 | c DOUBLE PRECISION VINT | |
582 | c COMMON/PYINT1/MINT(400),VINT(400) | |
583 | c DOUBLE PRECISION KFPR,COEF | |
584 | c COMMON/PYINT2/ISET(500),KFPR(500,2),COEF(500,20),ICOL(40,4,2) | |
585 | c DOUBLE PRECISION XSFX,SIGH | |
586 | c COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) | |
587 | c DOUBLE PRECISION WIDS | |
588 | c COMMON/PYINT4/MWID(500),WIDS(500,5) | |
589 | c DOUBLE PRECISION XSEC | |
590 | c COMMON/PYINT5/NGENPD,NGEN(0:500,3),XSEC(0:500,3) | |
591 | c CHARACTER PROC*28 | |
592 | c COMMON/PYINT6/PROC(0:500) | |
593 | c DOUBLE PRECISION SIGT | |
594 | c COMMON/PYINT7/SIGT(0:6,0:6,0:5) | |
595 | SAVE /LYJETS/,/LYDAT1/,/LYDAT2/,/LYDAT3/,/LYDAT4/,/LYDATR/ | |
596 | c SAVE /PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/, | |
597 | c &/PYINT5/,/PYINT6/,/PYINT7/ | |
598 | CHARACTER CHIN*(*),CHFIX*104,CHBIT*104,CHOLD*8,CHNEW*8,CHOLD2*28, | |
599 | &CHNEW2*28,CHNAM*4,CHVAR(19)*4,CHALP(2)*26,CHIND*8,CHINI*10, | |
600 | &CHINR*16 | |
601 | DIMENSION MSVAR(43,8) | |
602 | ||
603 | C...For each variable to be translated give: name, | |
604 | C...integer/real/character, no. of indices, lower&upper index bounds. | |
605 | cfkw 3/29/00 I changed the dimension of CHVAR such that it includes only | |
606 | cfkw variables names from LUxxxx common blocks. | |
607 | cfkw However, I left MSVAR untouched out of fear of screwing it | |
608 | cfkw up royally !!! | |
609 | DATA CHVAR/'N','K','P','V','MSTU','PARU','MSTJ','PARJ','KCHG', | |
610 | &'PMAS','PARF','VCKM','MDCY','MDME','BRAT','KFDP','CHAF','MRLU', | |
611 | &'RRLU'/ | |
612 | c ,'MSEL','MSUB','KFIN','CKIN','MSTP','PARP','MSTI','PARI', | |
613 | c &'MINT','VINT','ISET','KFPR','COEF','ICOL','XSFX','ISIG','SIGH', | |
614 | c &'WIDP','WIDE','WIDS','NGEN','XSEC','PROC','SIGT'/ | |
615 | DATA ((MSVAR(I,J),J=1,8),I=1,43)/ 1,7*0, 1,2,1,4000,1,5,2*0, | |
616 | & 2,2,1,4000,1,5,2*0, 2,2,1,4000,1,5,2*0, 1,1,1,200,4*0, | |
617 | & 2,1,1,200,4*0, 1,1,1,200,4*0, 2,1,1,200,4*0, | |
618 | & 1,2,1,500,1,3,2*0, 2,2,1,500,1,4,2*0, 2,1,1,2000,4*0, | |
619 | & 2,2,1,4,1,4,2*0, 1,2,1,500,1,3,2*0, 1,2,1,2000,1,2,2*0, | |
620 | & 2,1,1,2000,4*0, 1,2,1,2000,1,5,2*0, 3,1,1,500,4*0, | |
621 | & 1,1,1,6,4*0, 2,1,1,100,4*0, | |
622 | & 1,7*0, 1,1,1,200,4*0, 1,2,1,2,-40,40,2*0, 2,1,1,200,4*0, | |
623 | & 1,1,1,200,4*0, 2,1,1,200,4*0, 1,1,1,200,4*0, 2,1,1,200,4*0, | |
624 | & 1,1,1,400,4*0, 2,1,1,400,4*0, 1,1,1,200,4*0, | |
625 | & 1,2,1,200,1,2,2*0, 2,2,1,200,1,20,2*0, 1,3,1,40,1,4,1,2, | |
626 | & 2,2,1,2,-40,40,2*0, 1,2,1,1000,1,3,2*0, 2,1,1,1000,4*0, | |
627 | & 2,2,21,40,0,40,2*0, 2,2,21,40,0,40,2*0, 2,2,21,40,1,3,2*0, | |
628 | & 1,2,0,200,1,3,2*0, 2,2,0,200,1,3,2*0, 4,1,0,200,4*0, | |
629 | & 2,3,0,6,0,6,0,5/ | |
630 | DATA CHALP/'abcdefghijklmnopqrstuvwxyz', | |
631 | &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ | |
632 | ||
633 | C...Length of character variable. Subdivide it into instructions. | |
634 | IF(MSTU(12).GE.1) CALL LYLIST(0) | |
635 | CHBIT=CHIN//' ' | |
636 | LBIT=101 | |
637 | 100 LBIT=LBIT-1 | |
638 | IF(CHBIT(LBIT:LBIT).EQ.' ') GOTO 100 | |
639 | LTOT=0 | |
640 | DO 110 LCOM=1,LBIT | |
641 | IF(CHBIT(LCOM:LCOM).EQ.' ') GOTO 110 | |
642 | LTOT=LTOT+1 | |
643 | CHFIX(LTOT:LTOT)=CHBIT(LCOM:LCOM) | |
644 | 110 CONTINUE | |
645 | LLOW=0 | |
646 | 120 LHIG=LLOW+1 | |
647 | 130 LHIG=LHIG+1 | |
648 | IF(LHIG.LE.LTOT.AND.CHFIX(LHIG:LHIG).NE.';') GOTO 130 | |
649 | LBIT=LHIG-LLOW-1 | |
650 | CHBIT(1:LBIT)=CHFIX(LLOW+1:LHIG-1) | |
651 | ||
652 | C...Identify commonblock variable. | |
653 | LNAM=1 | |
654 | 140 LNAM=LNAM+1 | |
655 | IF(CHBIT(LNAM:LNAM).NE.'('.AND.CHBIT(LNAM:LNAM).NE.'='.AND. | |
656 | &LNAM.LE.4) GOTO 140 | |
657 | CHNAM=CHBIT(1:LNAM-1)//' ' | |
658 | DO 160 LCOM=1,LNAM-1 | |
659 | DO 150 LALP=1,26 | |
660 | IF(CHNAM(LCOM:LCOM).EQ.CHALP(1)(LALP:LALP)) CHNAM(LCOM:LCOM)= | |
661 | &CHALP(2)(LALP:LALP) | |
662 | 150 CONTINUE | |
663 | 160 CONTINUE | |
664 | IVAR=0 | |
665 | c DO 170 IV=1,43 | |
666 | DO 170 IV=1,19 | |
667 | IF(CHNAM.EQ.CHVAR(IV)) IVAR=IV | |
668 | 170 CONTINUE | |
669 | IF(IVAR.EQ.0) THEN | |
670 | CALL LYERRM(18,'(LYGIVE:) do not recognize variable '//CHNAM) | |
671 | LLOW=LHIG | |
672 | IF(LLOW.LT.LTOT) GOTO 120 | |
673 | RETURN | |
674 | ENDIF | |
675 | ||
676 | C...Identify any indices. | |
677 | I1=0 | |
678 | I2=0 | |
679 | I3=0 | |
680 | NINDX=0 | |
681 | IF(CHBIT(LNAM:LNAM).EQ.'(') THEN | |
682 | LIND=LNAM | |
683 | 180 LIND=LIND+1 | |
684 | IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 180 | |
685 | CHIND=' ' | |
686 | IF((CHBIT(LNAM+1:LNAM+1).EQ.'C'.OR.CHBIT(LNAM+1:LNAM+1).EQ.'c'). | |
687 | & AND.(IVAR.EQ.9.OR.IVAR.EQ.10.OR.IVAR.EQ.13.OR.IVAR.EQ.17)) THEN | |
688 | CHIND(LNAM-LIND+11:8)=CHBIT(LNAM+2:LIND-1) | |
689 | READ(CHIND,'(I8)') KF | |
690 | I1=LYCOMP(KF) | |
691 | ELSEIF(CHBIT(LNAM+1:LNAM+1).EQ.'C'.OR.CHBIT(LNAM+1:LNAM+1).EQ. | |
692 | & 'c') THEN | |
693 | CALL LYERRM(18,'(LYGIVE:) not allowed to use C index for '// | |
694 | & CHNAM) | |
695 | LLOW=LHIG | |
696 | IF(LLOW.LT.LTOT) GOTO 120 | |
697 | RETURN | |
698 | ELSE | |
699 | CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1) | |
700 | READ(CHIND,'(I8)') I1 | |
701 | ENDIF | |
702 | LNAM=LIND | |
703 | IF(CHBIT(LNAM:LNAM).EQ.')') LNAM=LNAM+1 | |
704 | NINDX=1 | |
705 | ENDIF | |
706 | IF(CHBIT(LNAM:LNAM).EQ.',') THEN | |
707 | LIND=LNAM | |
708 | 190 LIND=LIND+1 | |
709 | IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 190 | |
710 | CHIND=' ' | |
711 | CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1) | |
712 | READ(CHIND,'(I8)') I2 | |
713 | LNAM=LIND | |
714 | IF(CHBIT(LNAM:LNAM).EQ.')') LNAM=LNAM+1 | |
715 | NINDX=2 | |
716 | ENDIF | |
717 | IF(CHBIT(LNAM:LNAM).EQ.',') THEN | |
718 | LIND=LNAM | |
719 | 200 LIND=LIND+1 | |
720 | IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 200 | |
721 | CHIND=' ' | |
722 | CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1) | |
723 | READ(CHIND,'(I8)') I3 | |
724 | LNAM=LIND+1 | |
725 | NINDX=3 | |
726 | ENDIF | |
727 | ||
728 | C...Check that indices allowed. | |
729 | IERR=0 | |
730 | IF(NINDX.NE.MSVAR(IVAR,2)) IERR=1 | |
731 | IF(NINDX.GE.1.AND.(I1.LT.MSVAR(IVAR,3).OR.I1.GT.MSVAR(IVAR,4))) | |
732 | &IERR=2 | |
733 | IF(NINDX.GE.2.AND.(I2.LT.MSVAR(IVAR,5).OR.I2.GT.MSVAR(IVAR,6))) | |
734 | &IERR=3 | |
735 | IF(NINDX.EQ.3.AND.(I3.LT.MSVAR(IVAR,7).OR.I3.GT.MSVAR(IVAR,8))) | |
736 | &IERR=4 | |
737 | IF(CHBIT(LNAM:LNAM).NE.'=') IERR=5 | |
738 | IF(IERR.GE.1) THEN | |
739 | CALL LYERRM(18,'(LYGIVE:) unallowed indices for '// | |
740 | & CHBIT(1:LNAM-1)) | |
741 | LLOW=LHIG | |
742 | IF(LLOW.LT.LTOT) GOTO 120 | |
743 | RETURN | |
744 | ENDIF | |
745 | ||
746 | C...Save old value of variable. | |
747 | IF(IVAR.EQ.1) THEN | |
748 | IOLD=N | |
749 | ELSEIF(IVAR.EQ.2) THEN | |
750 | IOLD=K(I1,I2) | |
751 | ELSEIF(IVAR.EQ.3) THEN | |
752 | ROLD=P(I1,I2) | |
753 | ELSEIF(IVAR.EQ.4) THEN | |
754 | ROLD=V(I1,I2) | |
755 | ELSEIF(IVAR.EQ.5) THEN | |
756 | IOLD=MSTU(I1) | |
757 | ELSEIF(IVAR.EQ.6) THEN | |
758 | ROLD=PARU(I1) | |
759 | ELSEIF(IVAR.EQ.7) THEN | |
760 | IOLD=MSTJ(I1) | |
761 | ELSEIF(IVAR.EQ.8) THEN | |
762 | ROLD=PARJ(I1) | |
763 | ELSEIF(IVAR.EQ.9) THEN | |
764 | IOLD=KCHG(I1,I2) | |
765 | ELSEIF(IVAR.EQ.10) THEN | |
766 | ROLD=PMAS(I1,I2) | |
767 | ELSEIF(IVAR.EQ.11) THEN | |
768 | ROLD=PARF(I1) | |
769 | ELSEIF(IVAR.EQ.12) THEN | |
770 | ROLD=VCKM(I1,I2) | |
771 | ELSEIF(IVAR.EQ.13) THEN | |
772 | IOLD=MDCY(I1,I2) | |
773 | ELSEIF(IVAR.EQ.14) THEN | |
774 | IOLD=MDME(I1,I2) | |
775 | ELSEIF(IVAR.EQ.15) THEN | |
776 | ROLD=BRAT(I1) | |
777 | ELSEIF(IVAR.EQ.16) THEN | |
778 | IOLD=KFDP(I1,I2) | |
779 | ELSEIF(IVAR.EQ.17) THEN | |
780 | CHOLD=CHAF(I1) | |
781 | ELSEIF(IVAR.EQ.18) THEN | |
782 | IOLD=MRLU(I1) | |
783 | ELSEIF(IVAR.EQ.19) THEN | |
784 | ROLD=RRLU(I1) | |
785 | cfkw 3/29/00 comment out all variables that exist only in PYxxxx commons | |
786 | cfkw as those commons are commented above anyway. | |
787 | c ELSEIF(IVAR.EQ.20) THEN | |
788 | c IOLD=MSEL | |
789 | c ELSEIF(IVAR.EQ.21) THEN | |
790 | c IOLD=MSUB(I1) | |
791 | c ELSEIF(IVAR.EQ.22) THEN | |
792 | c IOLD=KFIN(I1,I2) | |
793 | c ELSEIF(IVAR.EQ.23) THEN | |
794 | c ROLD=CKIN(I1) | |
795 | c ELSEIF(IVAR.EQ.24) THEN | |
796 | c IOLD=MSTP(I1) | |
797 | c ELSEIF(IVAR.EQ.25) THEN | |
798 | c ROLD=PARP(I1) | |
799 | c ELSEIF(IVAR.EQ.26) THEN | |
800 | c IOLD=MSTI(I1) | |
801 | c ELSEIF(IVAR.EQ.27) THEN | |
802 | c ROLD=PARI(I1) | |
803 | c ELSEIF(IVAR.EQ.28) THEN | |
804 | c IOLD=MINT(I1) | |
805 | c ELSEIF(IVAR.EQ.29) THEN | |
806 | c ROLD=VINT(I1) | |
807 | c ELSEIF(IVAR.EQ.30) THEN | |
808 | c IOLD=ISET(I1) | |
809 | c ELSEIF(IVAR.EQ.31) THEN | |
810 | c IOLD=KFPR(I1,I2) | |
811 | c ELSEIF(IVAR.EQ.32) THEN | |
812 | c ROLD=COEF(I1,I2) | |
813 | c ELSEIF(IVAR.EQ.33) THEN | |
814 | c IOLD=ICOL(I1,I2,I3) | |
815 | c ELSEIF(IVAR.EQ.34) THEN | |
816 | c ROLD=XSFX(I1,I2) | |
817 | c ELSEIF(IVAR.EQ.35) THEN | |
818 | c IOLD=ISIG(I1,I2) | |
819 | c ELSEIF(IVAR.EQ.36) THEN | |
820 | c ROLD=SIGH(I1) | |
821 | c ELSEIF(IVAR.EQ.37) THEN | |
822 | c ROLD=WIDP(I1,I2) | |
823 | c ELSEIF(IVAR.EQ.38) THEN | |
824 | c ROLD=WIDE(I1,I2) | |
825 | c ELSEIF(IVAR.EQ.39) THEN | |
826 | c ROLD=WIDS(I1,I2) | |
827 | c ELSEIF(IVAR.EQ.40) THEN | |
828 | c IOLD=NGEN(I1,I2) | |
829 | c ELSEIF(IVAR.EQ.41) THEN | |
830 | c ROLD=XSEC(I1,I2) | |
831 | c ELSEIF(IVAR.EQ.42) THEN | |
832 | c CHOLD2=PROC(I1) | |
833 | c ELSEIF(IVAR.EQ.43) THEN | |
834 | c ROLD=SIGT(I1,I2,I3) | |
835 | ELSE | |
836 | CALL LYERRM(18,'(LYGIVE:) IVAR screwup '//CHNAM) | |
837 | ENDIF | |
838 | ||
839 | C...Print current value of variable. Loop back. | |
840 | IF(LNAM.GE.LBIT) THEN | |
841 | CHBIT(LNAM:14)=' ' | |
842 | CHBIT(15:60)=' has the value ' | |
843 | IF(MSVAR(IVAR,1).EQ.1) THEN | |
844 | WRITE(CHBIT(51:60),'(I10)') IOLD | |
845 | ELSEIF(MSVAR(IVAR,1).EQ.2) THEN | |
846 | WRITE(CHBIT(47:60),'(F14.5)') ROLD | |
847 | ELSEIF(MSVAR(IVAR,1).EQ.3) THEN | |
848 | CHBIT(53:60)=CHOLD | |
849 | ELSE | |
850 | CHBIT(33:60)=CHOLD | |
851 | ENDIF | |
852 | IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60) | |
853 | LLOW=LHIG | |
854 | IF(LLOW.LT.LTOT) GOTO 120 | |
855 | RETURN | |
856 | ENDIF | |
857 | ||
858 | C...Read in new variable value. | |
859 | IF(MSVAR(IVAR,1).EQ.1) THEN | |
860 | CHINI=' ' | |
861 | CHINI(LNAM-LBIT+11:10)=CHBIT(LNAM+1:LBIT) | |
862 | READ(CHINI,'(I10)') INEW | |
863 | ELSEIF(MSVAR(IVAR,1).EQ.2) THEN | |
864 | CHINR=' ' | |
865 | CHINR(LNAM-LBIT+17:16)=CHBIT(LNAM+1:LBIT) | |
866 | READ(CHINR,'(F16.2)') RNEW | |
867 | ELSEIF(MSVAR(IVAR,1).EQ.3) THEN | |
868 | CHNEW=CHBIT(LNAM+1:LBIT)//' ' | |
869 | ELSE | |
870 | CHNEW2=CHBIT(LNAM+1:LBIT)//' ' | |
871 | ENDIF | |
872 | ||
873 | C...Store new variable value. | |
874 | IF(IVAR.EQ.1) THEN | |
875 | N=INEW | |
876 | ELSEIF(IVAR.EQ.2) THEN | |
877 | K(I1,I2)=INEW | |
878 | ELSEIF(IVAR.EQ.3) THEN | |
879 | P(I1,I2)=RNEW | |
880 | ELSEIF(IVAR.EQ.4) THEN | |
881 | V(I1,I2)=RNEW | |
882 | ELSEIF(IVAR.EQ.5) THEN | |
883 | MSTU(I1)=INEW | |
884 | ELSEIF(IVAR.EQ.6) THEN | |
885 | PARU(I1)=RNEW | |
886 | ELSEIF(IVAR.EQ.7) THEN | |
887 | MSTJ(I1)=INEW | |
888 | ELSEIF(IVAR.EQ.8) THEN | |
889 | PARJ(I1)=RNEW | |
890 | ELSEIF(IVAR.EQ.9) THEN | |
891 | KCHG(I1,I2)=INEW | |
892 | ELSEIF(IVAR.EQ.10) THEN | |
893 | PMAS(I1,I2)=RNEW | |
894 | ELSEIF(IVAR.EQ.11) THEN | |
895 | PARF(I1)=RNEW | |
896 | ELSEIF(IVAR.EQ.12) THEN | |
897 | VCKM(I1,I2)=RNEW | |
898 | ELSEIF(IVAR.EQ.13) THEN | |
899 | MDCY(I1,I2)=INEW | |
900 | ELSEIF(IVAR.EQ.14) THEN | |
901 | MDME(I1,I2)=INEW | |
902 | ELSEIF(IVAR.EQ.15) THEN | |
903 | BRAT(I1)=RNEW | |
904 | ELSEIF(IVAR.EQ.16) THEN | |
905 | KFDP(I1,I2)=INEW | |
906 | ELSEIF(IVAR.EQ.17) THEN | |
907 | CHAF(I1)=CHNEW | |
908 | ELSEIF(IVAR.EQ.18) THEN | |
909 | MRLU(I1)=INEW | |
910 | ELSEIF(IVAR.EQ.19) THEN | |
911 | RRLU(I1)=RNEW | |
912 | cfkw 3/29/00 comment out all variables that exist only in PYxxxx commons | |
913 | cfkw as those commons are commented above anyway. | |
914 | c ELSEIF(IVAR.EQ.20) THEN | |
915 | c MSEL=INEW | |
916 | c ELSEIF(IVAR.EQ.21) THEN | |
917 | c MSUB(I1)=INEW | |
918 | c ELSEIF(IVAR.EQ.22) THEN | |
919 | c KFIN(I1,I2)=INEW | |
920 | c ELSEIF(IVAR.EQ.23) THEN | |
921 | c CKIN(I1)=RNEW | |
922 | c ELSEIF(IVAR.EQ.24) THEN | |
923 | c MSTP(I1)=INEW | |
924 | c ELSEIF(IVAR.EQ.25) THEN | |
925 | c PARP(I1)=RNEW | |
926 | c ELSEIF(IVAR.EQ.26) THEN | |
927 | c MSTI(I1)=INEW | |
928 | c ELSEIF(IVAR.EQ.27) THEN | |
929 | c PARI(I1)=RNEW | |
930 | c ELSEIF(IVAR.EQ.28) THEN | |
931 | c MINT(I1)=INEW | |
932 | c ELSEIF(IVAR.EQ.29) THEN | |
933 | c VINT(I1)=RNEW | |
934 | c ELSEIF(IVAR.EQ.30) THEN | |
935 | c ISET(I1)=INEW | |
936 | c ELSEIF(IVAR.EQ.31) THEN | |
937 | c KFPR(I1,I2)=INEW | |
938 | c ELSEIF(IVAR.EQ.32) THEN | |
939 | c COEF(I1,I2)=RNEW | |
940 | c ELSEIF(IVAR.EQ.33) THEN | |
941 | c ICOL(I1,I2,I3)=INEW | |
942 | c ELSEIF(IVAR.EQ.34) THEN | |
943 | c XSFX(I1,I2)=RNEW | |
944 | c ELSEIF(IVAR.EQ.35) THEN | |
945 | c ISIG(I1,I2)=INEW | |
946 | c ELSEIF(IVAR.EQ.36) THEN | |
947 | c SIGH(I1)=RNEW | |
948 | c ELSEIF(IVAR.EQ.37) THEN | |
949 | c WIDP(I1,I2)=RNEW | |
950 | c ELSEIF(IVAR.EQ.38) THEN | |
951 | c WIDE(I1,I2)=RNEW | |
952 | c ELSEIF(IVAR.EQ.39) THEN | |
953 | c WIDS(I1,I2)=RNEW | |
954 | c ELSEIF(IVAR.EQ.40) THEN | |
955 | c NGEN(I1,I2)=INEW | |
956 | c ELSEIF(IVAR.EQ.41) THEN | |
957 | c XSEC(I1,I2)=RNEW | |
958 | c ELSEIF(IVAR.EQ.42) THEN | |
959 | c PROC(I1)=CHNEW2 | |
960 | c ELSEIF(IVAR.EQ.43) THEN | |
961 | c SIGT(I1,I2,I3)=RNEW | |
962 | ELSE | |
963 | CALL LYERRM(18,'(LYGIVE:) IVAR screwup '//CHNAM) | |
964 | ENDIF | |
965 | ||
966 | C...Write old and new value. Loop back. | |
967 | CHBIT(LNAM:14)=' ' | |
968 | CHBIT(15:60)=' changed from to ' | |
969 | IF(MSVAR(IVAR,1).EQ.1) THEN | |
970 | WRITE(CHBIT(33:42),'(I10)') IOLD | |
971 | WRITE(CHBIT(51:60),'(I10)') INEW | |
972 | IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60) | |
973 | ELSEIF(MSVAR(IVAR,1).EQ.2) THEN | |
974 | WRITE(CHBIT(29:42),'(F14.5)') ROLD | |
975 | WRITE(CHBIT(47:60),'(F14.5)') RNEW | |
976 | IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60) | |
977 | ELSEIF(MSVAR(IVAR,1).EQ.3) THEN | |
978 | CHBIT(35:42)=CHOLD | |
979 | CHBIT(53:60)=CHNEW | |
980 | IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60) | |
981 | ELSE | |
982 | CHBIT(15:88)=' changed from '//CHOLD2//' to '//CHNEW2 | |
983 | IF(MSTU(13).GE.1) WRITE(MSTU(11),5100) CHBIT(1:88) | |
984 | ENDIF | |
985 | LLOW=LHIG | |
986 | IF(LLOW.LT.LTOT) GOTO 120 | |
987 | ||
988 | C...Format statement for output on unit MSTU(11) (by default 6). | |
989 | 5000 FORMAT(5X,A60) | |
990 | 5100 FORMAT(5X,A88) | |
991 | ||
992 | RETURN | |
993 | END | |
994 | ||
995 | C********************************************************************* | |
996 | ||
997 | SUBROUTINE LYEXEC | |
998 | ||
999 | C...Purpose: to administrate the fragmentation and decay chain. | |
1000 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
1001 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
1002 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
1003 | COMMON/LYDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) | |
1004 | SAVE /LYJETS/,/LYDAT1/,/LYDAT2/,/LYDAT3/ | |
1005 | DIMENSION PS(2,6) | |
1006 | ||
1007 | C...Initialize and reset. | |
1008 | MSTU(24)=0 | |
1009 | IF(MSTU(12).GE.1) CALL LYLIST(0) | |
1010 | MSTU(31)=MSTU(31)+1 | |
1011 | MSTU(1)=0 | |
1012 | MSTU(2)=0 | |
1013 | MSTU(3)=0 | |
1014 | IF(MSTU(17).LE.0) MSTU(90)=0 | |
1015 | MCONS=1 | |
1016 | ||
1017 | C...Sum up momentum, energy and charge for starting entries. | |
1018 | NSAV=N | |
1019 | DO 110 I=1,2 | |
1020 | DO 100 J=1,6 | |
1021 | PS(I,J)=0. | |
1022 | 100 CONTINUE | |
1023 | 110 CONTINUE | |
1024 | DO 130 I=1,N | |
1025 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 130 | |
1026 | DO 120 J=1,4 | |
1027 | PS(1,J)=PS(1,J)+P(I,J) | |
1028 | 120 CONTINUE | |
1029 | PS(1,6)=PS(1,6)+LYCHGE(K(I,2)) | |
1030 | 130 CONTINUE | |
1031 | PARU(21)=PS(1,4) | |
1032 | ||
1033 | C...Prepare system for subsequent fragmentation/decay. | |
1034 | CALL LYPREP(0) | |
1035 | ||
1036 | C...Loop through jet fragmentation and particle decays. | |
1037 | MBE=0 | |
1038 | 140 MBE=MBE+1 | |
1039 | IP=0 | |
1040 | 150 IP=IP+1 | |
1041 | KC=0 | |
1042 | IF(K(IP,1).GT.0.AND.K(IP,1).LE.10) KC=LYCOMP(K(IP,2)) | |
1043 | IF(KC.EQ.0) THEN | |
1044 | ||
1045 | C...Particle decay if unstable and allowed. Save long-lived particle | |
1046 | C...decays until second pass after Bose-Einstein effects. | |
1047 | ELSEIF(KCHG(KC,2).EQ.0) THEN | |
1048 | IF(MSTJ(21).GE.1.AND.MDCY(KC,1).GE.1.AND.(MSTJ(51).LE.0.OR.MBE | |
1049 | & .EQ.2.OR.PMAS(KC,2).GE.PARJ(91).OR.IABS(K(IP,2)).EQ.311)) | |
1050 | & CALL LYDECY(IP) | |
1051 | ||
1052 | C...Decay products may develop a shower. | |
1053 | IF(MSTJ(92).GT.0) THEN | |
1054 | IP1=MSTJ(92) | |
1055 | QMAX=SQRT(MAX(0.,(P(IP1,4)+P(IP1+1,4))**2-(P(IP1,1)+P(IP1+1, | |
1056 | & 1))**2-(P(IP1,2)+P(IP1+1,2))**2-(P(IP1,3)+P(IP1+1,3))**2)) | |
1057 | CALL LYSHOW(IP1,IP1+1,QMAX) | |
1058 | CALL LYPREP(IP1) | |
1059 | MSTJ(92)=0 | |
1060 | ELSEIF(MSTJ(92).LT.0) THEN | |
1061 | IP1=-MSTJ(92) | |
1062 | CALL LYSHOW(IP1,-3,P(IP,5)) | |
1063 | CALL LYPREP(IP1) | |
1064 | MSTJ(92)=0 | |
1065 | ENDIF | |
1066 | ||
1067 | C...Jet fragmentation: string or independent fragmentation. | |
1068 | ELSEIF(K(IP,1).EQ.1.OR.K(IP,1).EQ.2) THEN | |
1069 | MFRAG=MSTJ(1) | |
1070 | IF(MFRAG.GE.1.AND.K(IP,1).EQ.1) MFRAG=2 | |
1071 | IF(MSTJ(21).GE.2.AND.K(IP,1).EQ.2.AND.N.GT.IP) THEN | |
1072 | IF(K(IP+1,1).EQ.1.AND.K(IP+1,3).EQ.K(IP,3).AND. | |
1073 | & K(IP,3).GT.0.AND.K(IP,3).LT.IP) THEN | |
1074 | IF(KCHG(LYCOMP(K(K(IP,3),2)),2).EQ.0) MFRAG=MIN(1,MFRAG) | |
1075 | ENDIF | |
1076 | ENDIF | |
1077 | IF(MFRAG.EQ.1) CALL LYSTRF(IP) | |
1078 | IF(MFRAG.EQ.2) CALL LYINDF(IP) | |
1079 | IF(MFRAG.EQ.2.AND.K(IP,1).EQ.1) MCONS=0 | |
1080 | IF(MFRAG.EQ.2.AND.(MSTJ(3).LE.0.OR.MOD(MSTJ(3),5).EQ.0)) MCONS=0 | |
1081 | ENDIF | |
1082 | ||
1083 | C...Loop back if enough space left in LUJETS and no error abort. | |
1084 | IF(MSTU(24).NE.0.AND.MSTU(21).GE.2) THEN | |
1085 | ELSEIF(IP.LT.N.AND.N.LT.MSTU(4)-20-MSTU(32)) THEN | |
1086 | GOTO 150 | |
1087 | ELSEIF(IP.LT.N) THEN | |
1088 | CALL LYERRM(11,'(LYEXEC:) no more memory left in LUJETS') | |
1089 | ENDIF | |
1090 | ||
1091 | C...Include simple Bose-Einstein effect parametrization if desired. | |
1092 | IF(MBE.EQ.1.AND.MSTJ(51).GE.1) THEN | |
1093 | CALL LYBOEI(NSAV) | |
1094 | GOTO 140 | |
1095 | ENDIF | |
1096 | ||
1097 | C...Check that momentum, energy and charge were conserved. | |
1098 | DO 170 I=1,N | |
1099 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 170 | |
1100 | DO 160 J=1,4 | |
1101 | PS(2,J)=PS(2,J)+P(I,J) | |
1102 | 160 CONTINUE | |
1103 | PS(2,6)=PS(2,6)+LYCHGE(K(I,2)) | |
1104 | 170 CONTINUE | |
1105 | PDEV=(ABS(PS(2,1)-PS(1,1))+ABS(PS(2,2)-PS(1,2))+ABS(PS(2,3)- | |
1106 | &PS(1,3))+ABS(PS(2,4)-PS(1,4)))/(1.+ABS(PS(2,4))+ABS(PS(1,4))) | |
1107 | IF(MCONS.EQ.1.AND.PDEV.GT.PARU(11)) CALL LYERRM(15, | |
1108 | &'(LYEXEC:) four-momentum was not conserved') | |
1109 | IF(MCONS.EQ.1.AND.ABS(PS(2,6)-PS(1,6)).GT.0.1) CALL LYERRM(15, | |
1110 | &'(LYEXEC:) charge was not conserved') | |
1111 | ||
1112 | RETURN | |
1113 | END | |
1114 | ||
1115 | C********************************************************************* | |
1116 | ||
1117 | SUBROUTINE LYPREP(IP) | |
1118 | ||
1119 | C...Purpose: to rearrange partons along strings, to allow small systems | |
1120 | C...to collapse into one or two particles and to check flavours. | |
1121 | IMPLICIT DOUBLE PRECISION(D) | |
1122 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
1123 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
1124 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
1125 | COMMON/LYDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) | |
1126 | SAVE /LYJETS/,/LYDAT1/,/LYDAT2/,/LYDAT3/ | |
1127 | DIMENSION DPS(5),DPC(5),UE(3) | |
1128 | ||
1129 | C...Rearrange parton shower product listing along strings: begin loop. | |
1130 | I1=N | |
1131 | DO 130 MQGST=1,2 | |
1132 | DO 120 I=MAX(1,IP),N | |
1133 | IF(K(I,1).NE.3) GOTO 120 | |
1134 | KC=LYCOMP(K(I,2)) | |
1135 | IF(KC.EQ.0) GOTO 120 | |
1136 | KQ=KCHG(KC,2) | |
1137 | IF(KQ.EQ.0.OR.(MQGST.EQ.1.AND.KQ.EQ.2)) GOTO 120 | |
1138 | ||
1139 | C...Pick up loose string end. | |
1140 | KCS=4 | |
1141 | IF(KQ*ISIGN(1,K(I,2)).LT.0) KCS=5 | |
1142 | IA=I | |
1143 | NSTP=0 | |
1144 | 100 NSTP=NSTP+1 | |
1145 | IF(NSTP.GT.4*N) THEN | |
1146 | CALL LYERRM(14,'(LYPREP:) caught in infinite loop') | |
1147 | RETURN | |
1148 | ENDIF | |
1149 | ||
1150 | C...Copy undecayed parton. | |
1151 | IF(K(IA,1).EQ.3) THEN | |
1152 | IF(I1.GE.MSTU(4)-MSTU(32)-5) THEN | |
1153 | CALL LYERRM(11,'(LYPREP:) no more memory left in LUJETS') | |
1154 | RETURN | |
1155 | ENDIF | |
1156 | I1=I1+1 | |
1157 | K(I1,1)=2 | |
1158 | IF(NSTP.GE.2.AND.IABS(K(IA,2)).NE.21) K(I1,1)=1 | |
1159 | K(I1,2)=K(IA,2) | |
1160 | K(I1,3)=IA | |
1161 | K(I1,4)=0 | |
1162 | K(I1,5)=0 | |
1163 | DO 110 J=1,5 | |
1164 | P(I1,J)=P(IA,J) | |
1165 | V(I1,J)=V(IA,J) | |
1166 | 110 CONTINUE | |
1167 | K(IA,1)=K(IA,1)+10 | |
1168 | IF(K(I1,1).EQ.1) GOTO 120 | |
1169 | ENDIF | |
1170 | ||
1171 | C...Go to next parton in colour space. | |
1172 | IB=IA | |
1173 | IF(MOD(K(IB,KCS)/MSTU(5)**2,2).EQ.0.AND.MOD(K(IB,KCS),MSTU(5)) | |
1174 | &.NE.0) THEN | |
1175 | IA=MOD(K(IB,KCS),MSTU(5)) | |
1176 | K(IB,KCS)=K(IB,KCS)+MSTU(5)**2 | |
1177 | MREV=0 | |
1178 | ELSE | |
1179 | IF(K(IB,KCS).GE.2*MSTU(5)**2.OR.MOD(K(IB,KCS)/MSTU(5),MSTU(5)) | |
1180 | & .EQ.0) KCS=9-KCS | |
1181 | IA=MOD(K(IB,KCS)/MSTU(5),MSTU(5)) | |
1182 | K(IB,KCS)=K(IB,KCS)+2*MSTU(5)**2 | |
1183 | MREV=1 | |
1184 | ENDIF | |
1185 | IF(IA.LE.0.OR.IA.GT.N) THEN | |
1186 | CALL LYERRM(12,'(LYPREP:) colour rearrangement failed') | |
1187 | RETURN | |
1188 | ENDIF | |
1189 | IF(MOD(K(IA,4)/MSTU(5),MSTU(5)).EQ.IB.OR.MOD(K(IA,5)/MSTU(5), | |
1190 | &MSTU(5)).EQ.IB) THEN | |
1191 | IF(MREV.EQ.1) KCS=9-KCS | |
1192 | IF(MOD(K(IA,KCS)/MSTU(5),MSTU(5)).NE.IB) KCS=9-KCS | |
1193 | K(IA,KCS)=K(IA,KCS)+2*MSTU(5)**2 | |
1194 | ELSE | |
1195 | IF(MREV.EQ.0) KCS=9-KCS | |
1196 | IF(MOD(K(IA,KCS),MSTU(5)).NE.IB) KCS=9-KCS | |
1197 | K(IA,KCS)=K(IA,KCS)+MSTU(5)**2 | |
1198 | ENDIF | |
1199 | IF(IA.NE.I) GOTO 100 | |
1200 | K(I1,1)=1 | |
1201 | 120 CONTINUE | |
1202 | 130 CONTINUE | |
1203 | N=I1 | |
1204 | IF(MSTJ(14).LT.0) RETURN | |
1205 | ||
1206 | C...Find lowest-mass colour singlet jet system, OK if above threshold. | |
1207 | IF(MSTJ(14).EQ.0) GOTO 320 | |
1208 | NS=N | |
1209 | 140 NSIN=N-NS | |
1210 | PDM=1.+PARJ(32) | |
1211 | IC=0 | |
1212 | DO 190 I=MAX(1,IP),NS | |
1213 | IF(K(I,1).NE.1.AND.K(I,1).NE.2) THEN | |
1214 | ELSEIF(K(I,1).EQ.2.AND.IC.EQ.0) THEN | |
1215 | NSIN=NSIN+1 | |
1216 | IC=I | |
1217 | DO 150 J=1,4 | |
1218 | DPS(J)=P(I,J) | |
1219 | 150 CONTINUE | |
1220 | MSTJ(93)=1 | |
1221 | DPS(5)=UYMASS(K(I,2)) | |
1222 | ELSEIF(K(I,1).EQ.2) THEN | |
1223 | DO 160 J=1,4 | |
1224 | DPS(J)=DPS(J)+P(I,J) | |
1225 | 160 CONTINUE | |
1226 | ELSEIF(IC.NE.0.AND.KCHG(LYCOMP(K(I,2)),2).NE.0) THEN | |
1227 | DO 170 J=1,4 | |
1228 | DPS(J)=DPS(J)+P(I,J) | |
1229 | 170 CONTINUE | |
1230 | MSTJ(93)=1 | |
1231 | DPS(5)=DPS(5)+UYMASS(K(I,2)) | |
1232 | PD=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2))-DPS(5) | |
1233 | IF(PD.LT.PDM) THEN | |
1234 | PDM=PD | |
1235 | DO 180 J=1,5 | |
1236 | DPC(J)=DPS(J) | |
1237 | 180 CONTINUE | |
1238 | IC1=IC | |
1239 | IC2=I | |
1240 | ENDIF | |
1241 | IC=0 | |
1242 | ELSE | |
1243 | NSIN=NSIN+1 | |
1244 | ENDIF | |
1245 | 190 CONTINUE | |
1246 | IF(PDM.GE.PARJ(32)) GOTO 320 | |
1247 | ||
1248 | C...Fill small-mass system as cluster. | |
1249 | NSAV=N | |
1250 | PECM=SQRT(MAX(0D0,DPC(4)**2-DPC(1)**2-DPC(2)**2-DPC(3)**2)) | |
1251 | K(N+1,1)=11 | |
1252 | K(N+1,2)=91 | |
1253 | K(N+1,3)=IC1 | |
1254 | K(N+1,4)=N+2 | |
1255 | K(N+1,5)=N+3 | |
1256 | P(N+1,1)=DPC(1) | |
1257 | P(N+1,2)=DPC(2) | |
1258 | P(N+1,3)=DPC(3) | |
1259 | P(N+1,4)=DPC(4) | |
1260 | P(N+1,5)=PECM | |
1261 | ||
1262 | C...Form two particles from flavours of lowest-mass system, if feasible. | |
1263 | K(N+2,1)=1 | |
1264 | K(N+3,1)=1 | |
1265 | IF(MSTU(16).NE.2) THEN | |
1266 | K(N+2,3)=N+1 | |
1267 | K(N+3,3)=N+1 | |
1268 | ELSE | |
1269 | K(N+2,3)=IC1 | |
1270 | K(N+3,3)=IC2 | |
1271 | ENDIF | |
1272 | K(N+2,4)=0 | |
1273 | K(N+3,4)=0 | |
1274 | K(N+2,5)=0 | |
1275 | K(N+3,5)=0 | |
1276 | IF(IABS(K(IC1,2)).NE.21) THEN | |
1277 | KC1=LYCOMP(K(IC1,2)) | |
1278 | KC2=LYCOMP(K(IC2,2)) | |
1279 | IF(KC1.EQ.0.OR.KC2.EQ.0) GOTO 320 | |
1280 | KQ1=KCHG(KC1,2)*ISIGN(1,K(IC1,2)) | |
1281 | KQ2=KCHG(KC2,2)*ISIGN(1,K(IC2,2)) | |
1282 | IF(KQ1+KQ2.NE.0) GOTO 320 | |
1283 | 200 CALL LYKFDI(K(IC1,2),0,KFLN,K(N+2,2)) | |
1284 | CALL LYKFDI(K(IC2,2),-KFLN,KFLDMP,K(N+3,2)) | |
1285 | IF(K(N+2,2).EQ.0.OR.K(N+3,2).EQ.0) GOTO 200 | |
1286 | ELSE | |
1287 | IF(IABS(K(IC2,2)).NE.21) GOTO 320 | |
1288 | 210 CALL LYKFDI(1+INT((2.+PARJ(2))*RLY(0)),0,KFLN,KFDMP) | |
1289 | CALL LYKFDI(KFLN,0,KFLM,K(N+2,2)) | |
1290 | CALL LYKFDI(-KFLN,-KFLM,KFLDMP,K(N+3,2)) | |
1291 | IF(K(N+2,2).EQ.0.OR.K(N+3,2).EQ.0) GOTO 210 | |
1292 | ENDIF | |
1293 | P(N+2,5)=UYMASS(K(N+2,2)) | |
1294 | P(N+3,5)=UYMASS(K(N+3,2)) | |
1295 | IF(P(N+2,5)+P(N+3,5)+PARJ(64).GE.PECM.AND.NSIN.EQ.1) GOTO 320 | |
1296 | IF(P(N+2,5)+P(N+3,5)+PARJ(64).GE.PECM) GOTO 260 | |
1297 | ||
1298 | C...Perform two-particle decay of jet system, if possible. | |
1299 | IF(PECM.GE.0.02*DPC(4)) THEN | |
1300 | PA=SQRT((PECM**2-(P(N+2,5)+P(N+3,5))**2)*(PECM**2- | |
1301 | & (P(N+2,5)-P(N+3,5))**2))/(2.*PECM) | |
1302 | UE(3)=2.*RLY(0)-1. | |
1303 | PHI=PARU(2)*RLY(0) | |
1304 | UE(1)=SQRT(1.-UE(3)**2)*COS(PHI) | |
1305 | UE(2)=SQRT(1.-UE(3)**2)*SIN(PHI) | |
1306 | DO 220 J=1,3 | |
1307 | P(N+2,J)=PA*UE(J) | |
1308 | P(N+3,J)=-PA*UE(J) | |
1309 | 220 CONTINUE | |
1310 | P(N+2,4)=SQRT(PA**2+P(N+2,5)**2) | |
1311 | P(N+3,4)=SQRT(PA**2+P(N+3,5)**2) | |
1312 | MSTU(33)=1 | |
1313 | CALL LUDBRB(N+2,N+3,0.,0.,DPC(1)/DPC(4),DPC(2)/DPC(4), | |
1314 | & DPC(3)/DPC(4)) | |
1315 | ELSE | |
1316 | NP=0 | |
1317 | DO 230 I=IC1,IC2 | |
1318 | IF(K(I,1).EQ.1.OR.K(I,1).EQ.2) NP=NP+1 | |
1319 | 230 CONTINUE | |
1320 | HA=P(IC1,4)*P(IC2,4)-P(IC1,1)*P(IC2,1)-P(IC1,2)*P(IC2,2)- | |
1321 | & P(IC1,3)*P(IC2,3) | |
1322 | IF(NP.GE.3.OR.HA.LE.1.25*P(IC1,5)*P(IC2,5)) GOTO 260 | |
1323 | HD1=0.5*(P(N+2,5)**2-P(IC1,5)**2) | |
1324 | HD2=0.5*(P(N+3,5)**2-P(IC2,5)**2) | |
1325 | HR=SQRT(MAX(0.,((HA-HD1-HD2)**2-(P(N+2,5)*P(N+3,5))**2)/ | |
1326 | & (HA**2-(P(IC1,5)*P(IC2,5))**2)))-1. | |
1327 | HC=P(IC1,5)**2+2.*HA+P(IC2,5)**2 | |
1328 | HK1=((P(IC2,5)**2+HA)*HR+HD1-HD2)/HC | |
1329 | HK2=((P(IC1,5)**2+HA)*HR+HD2-HD1)/HC | |
1330 | DO 240 J=1,4 | |
1331 | P(N+2,J)=(1.+HK1)*P(IC1,J)-HK2*P(IC2,J) | |
1332 | P(N+3,J)=(1.+HK2)*P(IC2,J)-HK1*P(IC1,J) | |
1333 | 240 CONTINUE | |
1334 | ENDIF | |
1335 | DO 250 J=1,4 | |
1336 | V(N+1,J)=V(IC1,J) | |
1337 | V(N+2,J)=V(IC1,J) | |
1338 | V(N+3,J)=V(IC2,J) | |
1339 | 250 CONTINUE | |
1340 | V(N+1,5)=0. | |
1341 | V(N+2,5)=0. | |
1342 | V(N+3,5)=0. | |
1343 | N=N+3 | |
1344 | GOTO 300 | |
1345 | ||
1346 | C...Else form one particle from the flavours available, if possible. | |
1347 | 260 K(N+1,5)=N+2 | |
1348 | IF(IABS(K(IC1,2)).GT.100.AND.IABS(K(IC2,2)).GT.100) THEN | |
1349 | GOTO 320 | |
1350 | ELSEIF(IABS(K(IC1,2)).NE.21) THEN | |
1351 | CALL LYKFDI(K(IC1,2),K(IC2,2),KFLDMP,K(N+2,2)) | |
1352 | ELSE | |
1353 | KFLN=1+INT((2.+PARJ(2))*RLY(0)) | |
1354 | CALL LYKFDI(KFLN,-KFLN,KFLDMP,K(N+2,2)) | |
1355 | ENDIF | |
1356 | IF(K(N+2,2).EQ.0) GOTO 260 | |
1357 | P(N+2,5)=UYMASS(K(N+2,2)) | |
1358 | ||
1359 | C...Find parton/particle which combines to largest extra mass. | |
1360 | IR=0 | |
1361 | HA=0. | |
1362 | HSM=0. | |
1363 | DO 280 MCOMB=1,3 | |
1364 | IF(IR.NE.0) GOTO 280 | |
1365 | DO 270 I=MAX(1,IP),N | |
1366 | IF(K(I,1).LE.0.OR.K(I,1).GT.10.OR.(I.GE.IC1.AND.I.LE.IC2 | |
1367 | &.AND.K(I,1).GE.1.AND.K(I,1).LE.2)) GOTO 270 | |
1368 | IF(MCOMB.EQ.1) KCI=LYCOMP(K(I,2)) | |
1369 | IF(MCOMB.EQ.1.AND.KCI.EQ.0) GOTO 270 | |
1370 | IF(MCOMB.EQ.1.AND.KCHG(KCI,2).EQ.0.AND.I.LE.NS) GOTO 270 | |
1371 | IF(MCOMB.EQ.2.AND.IABS(K(I,2)).GT.10.AND.IABS(K(I,2)).LE.100) | |
1372 | &GOTO 270 | |
1373 | HCR=DPC(4)*P(I,4)-DPC(1)*P(I,1)-DPC(2)*P(I,2)-DPC(3)*P(I,3) | |
1374 | HSR=2.*HCR+PECM**2-P(N+2,5)**2-2.*P(N+2,5)*P(I,5) | |
1375 | IF(HSR.GT.HSM) THEN | |
1376 | IR=I | |
1377 | HA=HCR | |
1378 | HSM=HSR | |
1379 | ENDIF | |
1380 | 270 CONTINUE | |
1381 | 280 CONTINUE | |
1382 | ||
1383 | C...Shuffle energy and momentum to put new particle on mass shell. | |
1384 | IF(IR.NE.0) THEN | |
1385 | HB=PECM**2+HA | |
1386 | HC=P(N+2,5)**2+HA | |
1387 | HD=P(IR,5)**2+HA | |
1388 | HK2=0.5*(HB*SQRT(MAX(0.,((HB+HC)**2-4.*(HB+HD)*P(N+2,5)**2)/ | |
1389 | & (HA**2-(PECM*P(IR,5))**2)))-(HB+HC))/(HB+HD) | |
1390 | HK1=(0.5*(P(N+2,5)**2-PECM**2)+HD*HK2)/HB | |
1391 | DO 290 J=1,4 | |
1392 | P(N+2,J)=(1.+HK1)*DPC(J)-HK2*P(IR,J) | |
1393 | P(IR,J)=(1.+HK2)*P(IR,J)-HK1*DPC(J) | |
1394 | V(N+1,J)=V(IC1,J) | |
1395 | V(N+2,J)=V(IC1,J) | |
1396 | 290 CONTINUE | |
1397 | V(N+1,5)=0. | |
1398 | V(N+2,5)=0. | |
1399 | N=N+2 | |
1400 | ELSE | |
1401 | CALL LYERRM(3,'(LYPREP:) no match for collapsing cluster') | |
1402 | RETURN | |
1403 | ENDIF | |
1404 | ||
1405 | C...Mark collapsed system and store daughter pointers. Iterate. | |
1406 | 300 DO 310 I=IC1,IC2 | |
1407 | IF((K(I,1).EQ.1.OR.K(I,1).EQ.2).AND.KCHG(LYCOMP(K(I,2)),2).NE.0) | |
1408 | &THEN | |
1409 | K(I,1)=K(I,1)+10 | |
1410 | IF(MSTU(16).NE.2) THEN | |
1411 | K(I,4)=NSAV+1 | |
1412 | K(I,5)=NSAV+1 | |
1413 | ELSE | |
1414 | K(I,4)=NSAV+2 | |
1415 | K(I,5)=N | |
1416 | ENDIF | |
1417 | ENDIF | |
1418 | 310 CONTINUE | |
1419 | IF(N.LT.MSTU(4)-MSTU(32)-5) GOTO 140 | |
1420 | ||
1421 | C...Check flavours and invariant masses in parton systems. | |
1422 | 320 NP=0 | |
1423 | KFN=0 | |
1424 | KQS=0 | |
1425 | NJU=0 | |
1426 | DO 330 J=1,5 | |
1427 | DPS(J)=0. | |
1428 | 330 CONTINUE | |
1429 | DO 360 I=MAX(1,IP),N | |
1430 | IF(K(I,1).EQ.41) NJU=NJU+1 | |
1431 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 360 | |
1432 | KC=LYCOMP(K(I,2)) | |
1433 | IF(KC.EQ.0) GOTO 360 | |
1434 | KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) | |
1435 | IF(KQ.EQ.0) GOTO 360 | |
1436 | NP=NP+1 | |
1437 | IF(KQ.NE.2) THEN | |
1438 | KFN=KFN+1 | |
1439 | KQS=KQS+KQ | |
1440 | MSTJ(93)=1 | |
1441 | DPS(5)=DPS(5)+UYMASS(K(I,2)) | |
1442 | ENDIF | |
1443 | DO 340 J=1,4 | |
1444 | DPS(J)=DPS(J)+P(I,J) | |
1445 | 340 CONTINUE | |
1446 | IF(K(I,1).EQ.1) THEN | |
1447 | NFERR=0 | |
1448 | IF(NJU.EQ.0.AND.NP.NE.1) THEN | |
1449 | IF(KFN.EQ.1.OR.KFN.GE.3.OR.KQS.NE.0) NFERR=1 | |
1450 | ELSEIF(NJU.EQ.1) THEN | |
1451 | IF(KFN.NE.3.OR.IABS(KQS).NE.3) NFERR=1 | |
1452 | ELSEIF(NJU.EQ.2) THEN | |
1453 | IF(KFN.NE.4.OR.KQS.NE.0) NFERR=1 | |
1454 | ELSEIF(NJU.GE.3) THEN | |
1455 | NFERR=1 | |
1456 | ENDIF | |
1457 | IF(NFERR.EQ.1) CALL | |
1458 | & LYERRM(2,'(LYPREP:) unphysical flavour combination') | |
1459 | IF(NP.NE.1.AND.DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2.LT. | |
1460 | & (0.9*PARJ(32)+DPS(5))**2) CALL LYERRM(3, | |
1461 | & '(LYPREP:) too small mass in jet system') | |
1462 | NP=0 | |
1463 | KFN=0 | |
1464 | KQS=0 | |
1465 | NJU=0 | |
1466 | DO 350 J=1,5 | |
1467 | DPS(J)=0. | |
1468 | 350 CONTINUE | |
1469 | ENDIF | |
1470 | 360 CONTINUE | |
1471 | ||
1472 | RETURN | |
1473 | END | |
1474 | ||
1475 | C********************************************************************* | |
1476 | ||
1477 | SUBROUTINE LYSTRF(IP) | |
1478 | C...Purpose: to handle the fragmentation of an arbitrary colour singlet | |
1479 | C...jet system according to the Lund string fragmentation model. | |
1480 | IMPLICIT DOUBLE PRECISION(D) | |
1481 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
1482 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
1483 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
1484 | SAVE /LYJETS/,/LYDAT1/,/LYDAT2/ | |
1485 | DIMENSION DPS(5),KFL(3),PMQ(3),PX(3),PY(3),GAM(3),IE(2),PR(2), | |
1486 | &IN(9),DHM(4),DHG(4),DP(5,5),IRANK(2),MJU(4),IJU(3),PJU(5,5), | |
1487 | &TJU(5),KFJH(2),NJS(2),KFJS(2),PJS(4,5),MSTU9T(8),PARU9T(8) | |
1488 | ||
1489 | C...Function: four-product of two vectors. | |
1490 | FOUR(I,J)=P(I,4)*P(J,4)-P(I,1)*P(J,1)-P(I,2)*P(J,2)-P(I,3)*P(J,3) | |
1491 | DFOUR(I,J)=DP(I,4)*DP(J,4)-DP(I,1)*DP(J,1)-DP(I,2)*DP(J,2)- | |
1492 | &DP(I,3)*DP(J,3) | |
1493 | ||
1494 | C...Reset counters. Identify parton system. | |
1495 | MSTJ(91)=0 | |
1496 | NSAV=N | |
1497 | MSTU90=MSTU(90) | |
1498 | NP=0 | |
1499 | KQSUM=0 | |
1500 | DO 100 J=1,5 | |
1501 | DPS(J)=0D0 | |
1502 | 100 CONTINUE | |
1503 | MJU(1)=0 | |
1504 | MJU(2)=0 | |
1505 | I=IP-1 | |
1506 | 110 I=I+1 | |
1507 | IF(I.GT.MIN(N,MSTU(4)-MSTU(32))) THEN | |
1508 | CALL LYERRM(12,'(LYSTRF:) failed to reconstruct jet system') | |
1509 | IF(MSTU(21).GE.1) RETURN | |
1510 | ENDIF | |
1511 | IF(K(I,1).NE.1.AND.K(I,1).NE.2.AND.K(I,1).NE.41) GOTO 110 | |
1512 | KC=LYCOMP(K(I,2)) | |
1513 | IF(KC.EQ.0) GOTO 110 | |
1514 | KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) | |
1515 | IF(KQ.EQ.0) GOTO 110 | |
1516 | IF(N+5*NP+11.GT.MSTU(4)-MSTU(32)-5) THEN | |
1517 | CALL LYERRM(11,'(LYSTRF:) no more memory left in LUJETS') | |
1518 | IF(MSTU(21).GE.1) RETURN | |
1519 | ENDIF | |
1520 | ||
1521 | C...Take copy of partons to be considered. Check flavour sum. | |
1522 | NP=NP+1 | |
1523 | DO 120 J=1,5 | |
1524 | K(N+NP,J)=K(I,J) | |
1525 | P(N+NP,J)=P(I,J) | |
1526 | IF(J.NE.4) DPS(J)=DPS(J)+P(I,J) | |
1527 | 120 CONTINUE | |
1528 | DPS(4)=DPS(4)+SQRT(DBLE(P(I,1))**2+DBLE(P(I,2))**2+ | |
1529 | &DBLE(P(I,3))**2+DBLE(P(I,5))**2) | |
1530 | K(N+NP,3)=I | |
1531 | IF(KQ.NE.2) KQSUM=KQSUM+KQ | |
1532 | IF(K(I,1).EQ.41) THEN | |
1533 | KQSUM=KQSUM+2*KQ | |
1534 | IF(KQSUM.EQ.KQ) MJU(1)=N+NP | |
1535 | IF(KQSUM.NE.KQ) MJU(2)=N+NP | |
1536 | ENDIF | |
1537 | IF(K(I,1).EQ.2.OR.K(I,1).EQ.41) GOTO 110 | |
1538 | IF(KQSUM.NE.0) THEN | |
1539 | CALL LYERRM(12,'(LYSTRF:) unphysical flavour combination') | |
1540 | IF(MSTU(21).GE.1) RETURN | |
1541 | ENDIF | |
1542 | ||
1543 | C...Boost copied system to CM frame (for better numerical precision). | |
1544 | IF(ABS(DPS(3)).LT.0.99D0*DPS(4)) THEN | |
1545 | MBST=0 | |
1546 | MSTU(33)=1 | |
1547 | CALL LUDBRB(N+1,N+NP,0.,0.,-DPS(1)/DPS(4),-DPS(2)/DPS(4), | |
1548 | & -DPS(3)/DPS(4)) | |
1549 | ELSE | |
1550 | MBST=1 | |
1551 | HHBZ=SQRT(MAX(1D-6,DPS(4)+DPS(3))/MAX(1D-6,DPS(4)-DPS(3))) | |
1552 | DO 130 I=N+1,N+NP | |
1553 | HHPMT=P(I,1)**2+P(I,2)**2+P(I,5)**2 | |
1554 | IF(P(I,3).GT.0.) THEN | |
1555 | HHPEZ=(P(I,4)+P(I,3))/HHBZ | |
1556 | P(I,3)=0.5*(HHPEZ-HHPMT/HHPEZ) | |
1557 | P(I,4)=0.5*(HHPEZ+HHPMT/HHPEZ) | |
1558 | ELSE | |
1559 | HHPEZ=(P(I,4)-P(I,3))*HHBZ | |
1560 | P(I,3)=-0.5*(HHPEZ-HHPMT/HHPEZ) | |
1561 | P(I,4)=0.5*(HHPEZ+HHPMT/HHPEZ) | |
1562 | ENDIF | |
1563 | 130 CONTINUE | |
1564 | ENDIF | |
1565 | ||
1566 | C...Search for very nearby partons that may be recombined. | |
1567 | NTRYR=0 | |
1568 | PARU12=PARU(12) | |
1569 | PARU13=PARU(13) | |
1570 | MJU(3)=MJU(1) | |
1571 | MJU(4)=MJU(2) | |
1572 | NR=NP | |
1573 | 140 IF(NR.GE.3) THEN | |
1574 | PDRMIN=2.*PARU12 | |
1575 | DO 150 I=N+1,N+NR | |
1576 | IF(I.EQ.N+NR.AND.IABS(K(N+1,2)).NE.21) GOTO 150 | |
1577 | I1=I+1 | |
1578 | IF(I.EQ.N+NR) I1=N+1 | |
1579 | IF(K(I,1).EQ.41.OR.K(I1,1).EQ.41) GOTO 150 | |
1580 | IF(MJU(1).NE.0.AND.I1.LT.MJU(1).AND.IABS(K(I1,2)).NE.21) | |
1581 | & GOTO 150 | |
1582 | IF(MJU(2).NE.0.AND.I.GT.MJU(2).AND.IABS(K(I,2)).NE.21) GOTO 150 | |
1583 | PAP=SQRT((P(I,1)**2+P(I,2)**2+P(I,3)**2)*(P(I1,1)**2+ | |
1584 | & P(I1,2)**2+P(I1,3)**2)) | |
1585 | PVP=P(I,1)*P(I1,1)+P(I,2)*P(I1,2)+P(I,3)*P(I1,3) | |
1586 | PDR=4.*(PAP-PVP)**2/MAX(1E-6,PARU13**2*PAP+2.*(PAP-PVP)) | |
1587 | IF(PDR.LT.PDRMIN) THEN | |
1588 | IR=I | |
1589 | PDRMIN=PDR | |
1590 | ENDIF | |
1591 | 150 CONTINUE | |
1592 | ||
1593 | C...Recombine very nearby partons to avoid machine precision problems. | |
1594 | IF(PDRMIN.LT.PARU12.AND.IR.EQ.N+NR) THEN | |
1595 | DO 160 J=1,4 | |
1596 | P(N+1,J)=P(N+1,J)+P(N+NR,J) | |
1597 | 160 CONTINUE | |
1598 | P(N+1,5)=SQRT(MAX(0.,P(N+1,4)**2-P(N+1,1)**2-P(N+1,2)**2- | |
1599 | & P(N+1,3)**2)) | |
1600 | NR=NR-1 | |
1601 | GOTO 140 | |
1602 | ELSEIF(PDRMIN.LT.PARU12) THEN | |
1603 | DO 170 J=1,4 | |
1604 | P(IR,J)=P(IR,J)+P(IR+1,J) | |
1605 | 170 CONTINUE | |
1606 | P(IR,5)=SQRT(MAX(0.,P(IR,4)**2-P(IR,1)**2-P(IR,2)**2- | |
1607 | & P(IR,3)**2)) | |
1608 | DO 190 I=IR+1,N+NR-1 | |
1609 | K(I,2)=K(I+1,2) | |
1610 | DO 180 J=1,5 | |
1611 | P(I,J)=P(I+1,J) | |
1612 | 180 CONTINUE | |
1613 | 190 CONTINUE | |
1614 | IF(IR.EQ.N+NR-1) K(IR,2)=K(N+NR,2) | |
1615 | NR=NR-1 | |
1616 | IF(MJU(1).GT.IR) MJU(1)=MJU(1)-1 | |
1617 | IF(MJU(2).GT.IR) MJU(2)=MJU(2)-1 | |
1618 | GOTO 140 | |
1619 | ENDIF | |
1620 | ENDIF | |
1621 | NTRYR=NTRYR+1 | |
1622 | ||
1623 | C...Reset particle counter. Skip ahead if no junctions are present; | |
1624 | C...this is usually the case! | |
1625 | NRS=MAX(5*NR+11,NP) | |
1626 | NTRY=0 | |
1627 | 200 NTRY=NTRY+1 | |
1628 | IF(NTRY.GT.100.AND.NTRYR.LE.4) THEN | |
1629 | PARU12=4.*PARU12 | |
1630 | PARU13=2.*PARU13 | |
1631 | GOTO 140 | |
1632 | ELSEIF(NTRY.GT.100) THEN | |
1633 | CALL LYERRM(14,'(LYSTRF:) caught in infinite loop') | |
1634 | IF(MSTU(21).GE.1) RETURN | |
1635 | ENDIF | |
1636 | I=N+NRS | |
1637 | MSTU(90)=MSTU90 | |
1638 | IF(MJU(1).EQ.0.AND.MJU(2).EQ.0) GOTO 580 | |
1639 | DO 570 JT=1,2 | |
1640 | NJS(JT)=0 | |
1641 | IF(MJU(JT).EQ.0) GOTO 570 | |
1642 | JS=3-2*JT | |
1643 | ||
1644 | C...Find and sum up momentum on three sides of junction. Check flavours. | |
1645 | DO 220 IU=1,3 | |
1646 | IJU(IU)=0 | |
1647 | DO 210 J=1,5 | |
1648 | PJU(IU,J)=0. | |
1649 | 210 CONTINUE | |
1650 | 220 CONTINUE | |
1651 | IU=0 | |
1652 | DO 240 I1=N+1+(JT-1)*(NR-1),N+NR+(JT-1)*(1-NR),JS | |
1653 | IF(K(I1,2).NE.21.AND.IU.LE.2) THEN | |
1654 | IU=IU+1 | |
1655 | IJU(IU)=I1 | |
1656 | ENDIF | |
1657 | DO 230 J=1,4 | |
1658 | PJU(IU,J)=PJU(IU,J)+P(I1,J) | |
1659 | 230 CONTINUE | |
1660 | 240 CONTINUE | |
1661 | DO 250 IU=1,3 | |
1662 | PJU(IU,5)=SQRT(PJU(IU,1)**2+PJU(IU,2)**2+PJU(IU,3)**2) | |
1663 | 250 CONTINUE | |
1664 | IF(K(IJU(3),2)/100.NE.10*K(IJU(1),2)+K(IJU(2),2).AND. | |
1665 | &K(IJU(3),2)/100.NE.10*K(IJU(2),2)+K(IJU(1),2)) THEN | |
1666 | CALL LYERRM(12,'(LYSTRF:) unphysical flavour combination') | |
1667 | IF(MSTU(21).GE.1) RETURN | |
1668 | ENDIF | |
1669 | ||
1670 | C...Calculate (approximate) boost to rest frame of junction. | |
1671 | T12=(PJU(1,1)*PJU(2,1)+PJU(1,2)*PJU(2,2)+PJU(1,3)*PJU(2,3))/ | |
1672 | &(PJU(1,5)*PJU(2,5)) | |
1673 | T13=(PJU(1,1)*PJU(3,1)+PJU(1,2)*PJU(3,2)+PJU(1,3)*PJU(3,3))/ | |
1674 | &(PJU(1,5)*PJU(3,5)) | |
1675 | T23=(PJU(2,1)*PJU(3,1)+PJU(2,2)*PJU(3,2)+PJU(2,3)*PJU(3,3))/ | |
1676 | &(PJU(2,5)*PJU(3,5)) | |
1677 | T11=SQRT((2./3.)*(1.-T12)*(1.-T13)/(1.-T23)) | |
1678 | T22=SQRT((2./3.)*(1.-T12)*(1.-T23)/(1.-T13)) | |
1679 | TSQ=SQRT((2.*T11*T22+T12-1.)*(1.+T12)) | |
1680 | T1F=(TSQ-T22*(1.+T12))/(1.-T12**2) | |
1681 | T2F=(TSQ-T11*(1.+T12))/(1.-T12**2) | |
1682 | DO 260 J=1,3 | |
1683 | TJU(J)=-(T1F*PJU(1,J)/PJU(1,5)+T2F*PJU(2,J)/PJU(2,5)) | |
1684 | 260 CONTINUE | |
1685 | TJU(4)=SQRT(1.+TJU(1)**2+TJU(2)**2+TJU(3)**2) | |
1686 | DO 270 IU=1,3 | |
1687 | PJU(IU,5)=TJU(4)*PJU(IU,4)-TJU(1)*PJU(IU,1)-TJU(2)*PJU(IU,2)- | |
1688 | &TJU(3)*PJU(IU,3) | |
1689 | 270 CONTINUE | |
1690 | ||
1691 | C...Put junction at rest if motion could give inconsistencies. | |
1692 | IF(PJU(1,5)+PJU(2,5).GT.PJU(1,4)+PJU(2,4)) THEN | |
1693 | DO 280 J=1,3 | |
1694 | TJU(J)=0. | |
1695 | 280 CONTINUE | |
1696 | TJU(4)=1. | |
1697 | PJU(1,5)=PJU(1,4) | |
1698 | PJU(2,5)=PJU(2,4) | |
1699 | PJU(3,5)=PJU(3,4) | |
1700 | ENDIF | |
1701 | ||
1702 | C...Start preparing for fragmentation of two strings from junction. | |
1703 | ISTA=I | |
1704 | DO 550 IU=1,2 | |
1705 | NS=JS*(IJU(IU+1)-IJU(IU)) | |
1706 | ||
1707 | C...Junction strings: find longitudinal string directions. | |
1708 | DO 310 IS=1,NS | |
1709 | IS1=IJU(IU)+IS-1 | |
1710 | IS2=IJU(IU)+IS | |
1711 | DO 290 J=1,5 | |
1712 | DP(1,J)=0.5*P(IS1,J) | |
1713 | IF(IS.EQ.1) DP(1,J)=P(IS1,J) | |
1714 | DP(2,J)=0.5*P(IS2,J) | |
1715 | IF(IS.EQ.NS) DP(2,J)=-PJU(IU,J) | |
1716 | 290 CONTINUE | |
1717 | IF(IS.EQ.NS) DP(2,4)=SQRT(PJU(IU,1)**2+PJU(IU,2)**2+PJU(IU,3)**2) | |
1718 | IF(IS.EQ.NS) DP(2,5)=0. | |
1719 | DP(3,5)=DFOUR(1,1) | |
1720 | DP(4,5)=DFOUR(2,2) | |
1721 | DHKC=DFOUR(1,2) | |
1722 | IF(DP(3,5)+2.*DHKC+DP(4,5).LE.0.) THEN | |
1723 | DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) | |
1724 | DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) | |
1725 | DP(3,5)=0D0 | |
1726 | DP(4,5)=0D0 | |
1727 | DHKC=DFOUR(1,2) | |
1728 | ENDIF | |
1729 | DHKS=SQRT(DHKC**2-DP(3,5)*DP(4,5)) | |
1730 | DHK1=0.5*((DP(4,5)+DHKC)/DHKS-1.) | |
1731 | DHK2=0.5*((DP(3,5)+DHKC)/DHKS-1.) | |
1732 | IN1=N+NR+4*IS-3 | |
1733 | P(IN1,5)=SQRT(DP(3,5)+2.*DHKC+DP(4,5)) | |
1734 | DO 300 J=1,4 | |
1735 | P(IN1,J)=(1.+DHK1)*DP(1,J)-DHK2*DP(2,J) | |
1736 | P(IN1+1,J)=(1.+DHK2)*DP(2,J)-DHK1*DP(1,J) | |
1737 | 300 CONTINUE | |
1738 | 310 CONTINUE | |
1739 | ||
1740 | C...Junction strings: initialize flavour, momentum and starting pos. | |
1741 | ISAV=I | |
1742 | MSTU91=MSTU(90) | |
1743 | 320 NTRY=NTRY+1 | |
1744 | IF(NTRY.GT.100.AND.NTRYR.LE.4) THEN | |
1745 | PARU12=4.*PARU12 | |
1746 | PARU13=2.*PARU13 | |
1747 | GOTO 140 | |
1748 | ELSEIF(NTRY.GT.100) THEN | |
1749 | CALL LYERRM(14,'(LYSTRF:) caught in infinite loop') | |
1750 | IF(MSTU(21).GE.1) RETURN | |
1751 | ENDIF | |
1752 | I=ISAV | |
1753 | MSTU(90)=MSTU91 | |
1754 | IRANKJ=0 | |
1755 | IE(1)=K(N+1+(JT/2)*(NP-1),3) | |
1756 | IN(4)=N+NR+1 | |
1757 | IN(5)=IN(4)+1 | |
1758 | IN(6)=N+NR+4*NS+1 | |
1759 | DO 340 JQ=1,2 | |
1760 | DO 330 IN1=N+NR+2+JQ,N+NR+4*NS-2+JQ,4 | |
1761 | P(IN1,1)=2-JQ | |
1762 | P(IN1,2)=JQ-1 | |
1763 | P(IN1,3)=1. | |
1764 | 330 CONTINUE | |
1765 | 340 CONTINUE | |
1766 | KFL(1)=K(IJU(IU),2) | |
1767 | PX(1)=0. | |
1768 | PY(1)=0. | |
1769 | GAM(1)=0. | |
1770 | DO 350 J=1,5 | |
1771 | PJU(IU+3,J)=0. | |
1772 | 350 CONTINUE | |
1773 | ||
1774 | C...Junction strings: find initial transverse directions. | |
1775 | DO 360 J=1,4 | |
1776 | DP(1,J)=P(IN(4),J) | |
1777 | DP(2,J)=P(IN(4)+1,J) | |
1778 | DP(3,J)=0. | |
1779 | DP(4,J)=0. | |
1780 | 360 CONTINUE | |
1781 | DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) | |
1782 | DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) | |
1783 | DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4) | |
1784 | DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4) | |
1785 | DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4) | |
1786 | IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1. | |
1787 | IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1. | |
1788 | IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1. | |
1789 | IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1. | |
1790 | DHC12=DFOUR(1,2) | |
1791 | DHCX1=DFOUR(3,1)/DHC12 | |
1792 | DHCX2=DFOUR(3,2)/DHC12 | |
1793 | DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12) | |
1794 | DHCY1=DFOUR(4,1)/DHC12 | |
1795 | DHCY2=DFOUR(4,2)/DHC12 | |
1796 | DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12 | |
1797 | DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2) | |
1798 | DO 370 J=1,4 | |
1799 | DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J)) | |
1800 | P(IN(6),J)=DP(3,J) | |
1801 | P(IN(6)+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)- | |
1802 | &DHCYX*DP(3,J)) | |
1803 | 370 CONTINUE | |
1804 | ||
1805 | C...Junction strings: produce new particle, origin. | |
1806 | 380 I=I+1 | |
1807 | IF(2*I-NSAV.GE.MSTU(4)-MSTU(32)-5) THEN | |
1808 | CALL LYERRM(11,'(LYSTRF:) no more memory left in LUJETS') | |
1809 | IF(MSTU(21).GE.1) RETURN | |
1810 | ENDIF | |
1811 | IRANKJ=IRANKJ+1 | |
1812 | K(I,1)=1 | |
1813 | K(I,3)=IE(1) | |
1814 | K(I,4)=0 | |
1815 | K(I,5)=0 | |
1816 | ||
1817 | C...Junction strings: generate flavour, hadron, pT, z and Gamma. | |
1818 | 390 CALL LYKFDI(KFL(1),0,KFL(3),K(I,2)) | |
1819 | IF(K(I,2).EQ.0) GOTO 320 | |
1820 | IF(MSTJ(12).GE.3.AND.IRANKJ.EQ.1.AND.IABS(KFL(1)).LE.10.AND. | |
1821 | &IABS(KFL(3)).GT.10) THEN | |
1822 | IF(RLY(0).GT.PARJ(19)) GOTO 390 | |
1823 | ENDIF | |
1824 | P(I,5)=UYMASS(K(I,2)) | |
1825 | CALL LYPTDI(KFL(1),PX(3),PY(3)) | |
1826 | PR(1)=P(I,5)**2+(PX(1)+PX(3))**2+(PY(1)+PY(3))**2 | |
1827 | CALL LYZDIS(KFL(1),KFL(3),PR(1),Z) | |
1828 | IF(IABS(KFL(1)).GE.4.AND.IABS(KFL(1)).LE.8.AND. | |
1829 | &MSTU(90).LT.8) THEN | |
1830 | MSTU(90)=MSTU(90)+1 | |
1831 | MSTU(90+MSTU(90))=I | |
1832 | PARU(90+MSTU(90))=Z | |
1833 | ENDIF | |
1834 | GAM(3)=(1.-Z)*(GAM(1)+PR(1)/Z) | |
1835 | DO 400 J=1,3 | |
1836 | IN(J)=IN(3+J) | |
1837 | 400 CONTINUE | |
1838 | ||
1839 | C...Junction strings: stepping within or from 'low' string region easy. | |
1840 | IF(IN(1)+1.EQ.IN(2).AND.Z*P(IN(1)+2,3)*P(IN(2)+2,3)* | |
1841 | &P(IN(1),5)**2.GE.PR(1)) THEN | |
1842 | P(IN(1)+2,4)=Z*P(IN(1)+2,3) | |
1843 | P(IN(2)+2,4)=PR(1)/(P(IN(1)+2,4)*P(IN(1),5)**2) | |
1844 | DO 410 J=1,4 | |
1845 | P(I,J)=(PX(1)+PX(3))*P(IN(3),J)+(PY(1)+PY(3))*P(IN(3)+1,J) | |
1846 | 410 CONTINUE | |
1847 | GOTO 500 | |
1848 | ELSEIF(IN(1)+1.EQ.IN(2)) THEN | |
1849 | P(IN(2)+2,4)=P(IN(2)+2,3) | |
1850 | P(IN(2)+2,1)=1. | |
1851 | IN(2)=IN(2)+4 | |
1852 | IF(IN(2).GT.N+NR+4*NS) GOTO 320 | |
1853 | IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN | |
1854 | P(IN(1)+2,4)=P(IN(1)+2,3) | |
1855 | P(IN(1)+2,1)=0. | |
1856 | IN(1)=IN(1)+4 | |
1857 | ENDIF | |
1858 | ENDIF | |
1859 | ||
1860 | C...Junction strings: find new transverse directions. | |
1861 | 420 IF(IN(1).GT.N+NR+4*NS.OR.IN(2).GT.N+NR+4*NS.OR. | |
1862 | &IN(1).GT.IN(2)) GOTO 320 | |
1863 | IF(IN(1).NE.IN(4).OR.IN(2).NE.IN(5)) THEN | |
1864 | DO 430 J=1,4 | |
1865 | DP(1,J)=P(IN(1),J) | |
1866 | DP(2,J)=P(IN(2),J) | |
1867 | DP(3,J)=0. | |
1868 | DP(4,J)=0. | |
1869 | 430 CONTINUE | |
1870 | DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) | |
1871 | DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) | |
1872 | DHC12=DFOUR(1,2) | |
1873 | IF(DHC12.LE.1E-2) THEN | |
1874 | P(IN(1)+2,4)=P(IN(1)+2,3) | |
1875 | P(IN(1)+2,1)=0. | |
1876 | IN(1)=IN(1)+4 | |
1877 | GOTO 420 | |
1878 | ENDIF | |
1879 | IN(3)=N+NR+4*NS+5 | |
1880 | DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4) | |
1881 | DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4) | |
1882 | DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4) | |
1883 | IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1. | |
1884 | IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1. | |
1885 | IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1. | |
1886 | IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1. | |
1887 | DHCX1=DFOUR(3,1)/DHC12 | |
1888 | DHCX2=DFOUR(3,2)/DHC12 | |
1889 | DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12) | |
1890 | DHCY1=DFOUR(4,1)/DHC12 | |
1891 | DHCY2=DFOUR(4,2)/DHC12 | |
1892 | DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12 | |
1893 | DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2) | |
1894 | DO 440 J=1,4 | |
1895 | DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J)) | |
1896 | P(IN(3),J)=DP(3,J) | |
1897 | P(IN(3)+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)- | |
1898 | & DHCYX*DP(3,J)) | |
1899 | 440 CONTINUE | |
1900 | C...Express pT with respect to new axes, if sensible. | |
1901 | PXP=-(PX(3)*FOUR(IN(6),IN(3))+PY(3)*FOUR(IN(6)+1,IN(3))) | |
1902 | PYP=-(PX(3)*FOUR(IN(6),IN(3)+1)+PY(3)*FOUR(IN(6)+1,IN(3)+1)) | |
1903 | IF(ABS(PXP**2+PYP**2-PX(3)**2-PY(3)**2).LT.0.01) THEN | |
1904 | PX(3)=PXP | |
1905 | PY(3)=PYP | |
1906 | ENDIF | |
1907 | ENDIF | |
1908 | ||
1909 | C...Junction strings: sum up known four-momentum, coefficients for m2. | |
1910 | DO 470 J=1,4 | |
1911 | DHG(J)=0. | |
1912 | P(I,J)=PX(1)*P(IN(6),J)+PY(1)*P(IN(6)+1,J)+PX(3)*P(IN(3),J)+ | |
1913 | &PY(3)*P(IN(3)+1,J) | |
1914 | DO 450 IN1=IN(4),IN(1)-4,4 | |
1915 | P(I,J)=P(I,J)+P(IN1+2,3)*P(IN1,J) | |
1916 | 450 CONTINUE | |
1917 | DO 460 IN2=IN(5),IN(2)-4,4 | |
1918 | P(I,J)=P(I,J)+P(IN2+2,3)*P(IN2,J) | |
1919 | 460 CONTINUE | |
1920 | 470 CONTINUE | |
1921 | DHM(1)=FOUR(I,I) | |
1922 | DHM(2)=2.*FOUR(I,IN(1)) | |
1923 | DHM(3)=2.*FOUR(I,IN(2)) | |
1924 | DHM(4)=2.*FOUR(IN(1),IN(2)) | |
1925 | ||
1926 | C...Junction strings: find coefficients for Gamma expression. | |
1927 | DO 490 IN2=IN(1)+1,IN(2),4 | |
1928 | DO 480 IN1=IN(1),IN2-1,4 | |
1929 | DHC=2.*FOUR(IN1,IN2) | |
1930 | DHG(1)=DHG(1)+P(IN1+2,1)*P(IN2+2,1)*DHC | |
1931 | IF(IN1.EQ.IN(1)) DHG(2)=DHG(2)-P(IN2+2,1)*DHC | |
1932 | IF(IN2.EQ.IN(2)) DHG(3)=DHG(3)+P(IN1+2,1)*DHC | |
1933 | IF(IN1.EQ.IN(1).AND.IN2.EQ.IN(2)) DHG(4)=DHG(4)-DHC | |
1934 | 480 CONTINUE | |
1935 | 490 CONTINUE | |
1936 | ||
1937 | C...Junction strings: solve (m2, Gamma) equation system for energies. | |
1938 | DHS1=DHM(3)*DHG(4)-DHM(4)*DHG(3) | |
1939 | IF(ABS(DHS1).LT.1E-4) GOTO 320 | |
1940 | DHS2=DHM(4)*(GAM(3)-DHG(1))-DHM(2)*DHG(3)-DHG(4)* | |
1941 | &(P(I,5)**2-DHM(1))+DHG(2)*DHM(3) | |
1942 | DHS3=DHM(2)*(GAM(3)-DHG(1))-DHG(2)*(P(I,5)**2-DHM(1)) | |
1943 | P(IN(2)+2,4)=0.5*(SQRT(MAX(0D0,DHS2**2-4.*DHS1*DHS3))/ABS(DHS1)- | |
1944 | &DHS2/DHS1) | |
1945 | IF(DHM(2)+DHM(4)*P(IN(2)+2,4).LE.0.) GOTO 320 | |
1946 | P(IN(1)+2,4)=(P(I,5)**2-DHM(1)-DHM(3)*P(IN(2)+2,4))/ | |
1947 | &(DHM(2)+DHM(4)*P(IN(2)+2,4)) | |
1948 | ||
1949 | C...Junction strings: step to new region if necessary. | |
1950 | IF(P(IN(2)+2,4).GT.P(IN(2)+2,3)) THEN | |
1951 | P(IN(2)+2,4)=P(IN(2)+2,3) | |
1952 | P(IN(2)+2,1)=1. | |
1953 | IN(2)=IN(2)+4 | |
1954 | IF(IN(2).GT.N+NR+4*NS) GOTO 320 | |
1955 | IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN | |
1956 | P(IN(1)+2,4)=P(IN(1)+2,3) | |
1957 | P(IN(1)+2,1)=0. | |
1958 | IN(1)=IN(1)+4 | |
1959 | ENDIF | |
1960 | GOTO 420 | |
1961 | ELSEIF(P(IN(1)+2,4).GT.P(IN(1)+2,3)) THEN | |
1962 | P(IN(1)+2,4)=P(IN(1)+2,3) | |
1963 | P(IN(1)+2,1)=0. | |
1964 | IN(1)=IN(1)+JS | |
1965 | GOTO 820 | |
1966 | ENDIF | |
1967 | ||
1968 | C...Junction strings: particle four-momentum, remainder, loop back. | |
1969 | 500 DO 510 J=1,4 | |
1970 | P(I,J)=P(I,J)+P(IN(1)+2,4)*P(IN(1),J)+P(IN(2)+2,4)*P(IN(2),J) | |
1971 | PJU(IU+3,J)=PJU(IU+3,J)+P(I,J) | |
1972 | 510 CONTINUE | |
1973 | IF(P(I,4).LT.P(I,5)) GOTO 320 | |
1974 | PJU(IU+3,5)=TJU(4)*PJU(IU+3,4)-TJU(1)*PJU(IU+3,1)- | |
1975 | &TJU(2)*PJU(IU+3,2)-TJU(3)*PJU(IU+3,3) | |
1976 | IF(PJU(IU+3,5).LT.PJU(IU,5)) THEN | |
1977 | KFL(1)=-KFL(3) | |
1978 | PX(1)=-PX(3) | |
1979 | PY(1)=-PY(3) | |
1980 | GAM(1)=GAM(3) | |
1981 | IF(IN(3).NE.IN(6)) THEN | |
1982 | DO 520 J=1,4 | |
1983 | P(IN(6),J)=P(IN(3),J) | |
1984 | P(IN(6)+1,J)=P(IN(3)+1,J) | |
1985 | 520 CONTINUE | |
1986 | ENDIF | |
1987 | DO 530 JQ=1,2 | |
1988 | IN(3+JQ)=IN(JQ) | |
1989 | P(IN(JQ)+2,3)=P(IN(JQ)+2,3)-P(IN(JQ)+2,4) | |
1990 | P(IN(JQ)+2,1)=P(IN(JQ)+2,1)-(3-2*JQ)*P(IN(JQ)+2,4) | |
1991 | 530 CONTINUE | |
1992 | GOTO 380 | |
1993 | ENDIF | |
1994 | ||
1995 | C...Junction strings: save quantities left after each string. | |
1996 | IF(IABS(KFL(1)).GT.10) GOTO 320 | |
1997 | I=I-1 | |
1998 | KFJH(IU)=KFL(1) | |
1999 | DO 540 J=1,4 | |
2000 | PJU(IU+3,J)=PJU(IU+3,J)-P(I+1,J) | |
2001 | 540 CONTINUE | |
2002 | 550 CONTINUE | |
2003 | ||
2004 | C...Junction strings: put together to new effective string endpoint. | |
2005 | NJS(JT)=I-ISTA | |
2006 | KFJS(JT)=K(K(MJU(JT+2),3),2) | |
2007 | KFLS=2*INT(RLY(0)+3.*PARJ(4)/(1.+3.*PARJ(4)))+1 | |
2008 | IF(KFJH(1).EQ.KFJH(2)) KFLS=3 | |
2009 | IF(ISTA.NE.I) KFJS(JT)=ISIGN(1000*MAX(IABS(KFJH(1)), | |
2010 | &IABS(KFJH(2)))+100*MIN(IABS(KFJH(1)),IABS(KFJH(2)))+ | |
2011 | &KFLS,KFJH(1)) | |
2012 | DO 560 J=1,4 | |
2013 | PJS(JT,J)=PJU(1,J)+PJU(2,J)+P(MJU(JT),J) | |
2014 | PJS(JT+2,J)=PJU(4,J)+PJU(5,J) | |
2015 | 560 CONTINUE | |
2016 | PJS(JT,5)=SQRT(MAX(0.,PJS(JT,4)**2-PJS(JT,1)**2-PJS(JT,2)**2- | |
2017 | &PJS(JT,3)**2)) | |
2018 | 570 CONTINUE | |
2019 | ||
2020 | C...Open versus closed strings. Choose breakup region for latter. | |
2021 | 580 IF(MJU(1).NE.0.AND.MJU(2).NE.0) THEN | |
2022 | NS=MJU(2)-MJU(1) | |
2023 | NB=MJU(1)-N | |
2024 | ELSEIF(MJU(1).NE.0) THEN | |
2025 | NS=N+NR-MJU(1) | |
2026 | NB=MJU(1)-N | |
2027 | ELSEIF(MJU(2).NE.0) THEN | |
2028 | NS=MJU(2)-N | |
2029 | NB=1 | |
2030 | ELSEIF(IABS(K(N+1,2)).NE.21) THEN | |
2031 | NS=NR-1 | |
2032 | NB=1 | |
2033 | ELSE | |
2034 | NS=NR+1 | |
2035 | W2SUM=0. | |
2036 | DO 590 IS=1,NR | |
2037 | P(N+NR+IS,1)=0.5*FOUR(N+IS,N+IS+1-NR*(IS/NR)) | |
2038 | W2SUM=W2SUM+P(N+NR+IS,1) | |
2039 | 590 CONTINUE | |
2040 | W2RAN=RLY(0)*W2SUM | |
2041 | NB=0 | |
2042 | 600 NB=NB+1 | |
2043 | W2SUM=W2SUM-P(N+NR+NB,1) | |
2044 | IF(W2SUM.GT.W2RAN.AND.NB.LT.NR) GOTO 600 | |
2045 | ENDIF | |
2046 | ||
2047 | C...Find longitudinal string directions (i.e. lightlike four-vectors). | |
2048 | DO 630 IS=1,NS | |
2049 | IS1=N+IS+NB-1-NR*((IS+NB-2)/NR) | |
2050 | IS2=N+IS+NB-NR*((IS+NB-1)/NR) | |
2051 | DO 610 J=1,5 | |
2052 | DP(1,J)=P(IS1,J) | |
2053 | IF(IABS(K(IS1,2)).EQ.21) DP(1,J)=0.5*DP(1,J) | |
2054 | IF(IS1.EQ.MJU(1)) DP(1,J)=PJS(1,J)-PJS(3,J) | |
2055 | DP(2,J)=P(IS2,J) | |
2056 | IF(IABS(K(IS2,2)).EQ.21) DP(2,J)=0.5*DP(2,J) | |
2057 | IF(IS2.EQ.MJU(2)) DP(2,J)=PJS(2,J)-PJS(4,J) | |
2058 | 610 CONTINUE | |
2059 | DP(3,5)=DFOUR(1,1) | |
2060 | DP(4,5)=DFOUR(2,2) | |
2061 | DHKC=DFOUR(1,2) | |
2062 | IF(DP(3,5)+2.*DHKC+DP(4,5).LE.0.) THEN | |
2063 | DP(3,5)=DP(1,5)**2 | |
2064 | DP(4,5)=DP(2,5)**2 | |
2065 | DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2+DP(1,5)**2) | |
2066 | DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2+DP(2,5)**2) | |
2067 | DHKC=DFOUR(1,2) | |
2068 | ENDIF | |
2069 | DHKS=SQRT(DHKC**2-DP(3,5)*DP(4,5)) | |
2070 | DHK1=0.5*((DP(4,5)+DHKC)/DHKS-1.) | |
2071 | DHK2=0.5*((DP(3,5)+DHKC)/DHKS-1.) | |
2072 | IN1=N+NR+4*IS-3 | |
2073 | P(IN1,5)=SQRT(DP(3,5)+2.*DHKC+DP(4,5)) | |
2074 | DO 620 J=1,4 | |
2075 | P(IN1,J)=(1.+DHK1)*DP(1,J)-DHK2*DP(2,J) | |
2076 | P(IN1+1,J)=(1.+DHK2)*DP(2,J)-DHK1*DP(1,J) | |
2077 | 620 CONTINUE | |
2078 | 630 CONTINUE | |
2079 | ||
2080 | C...Begin initialization: sum up energy, set starting position. | |
2081 | ISAV=I | |
2082 | MSTU91=MSTU(90) | |
2083 | 640 NTRY=NTRY+1 | |
2084 | IF(NTRY.GT.100.AND.NTRYR.LE.4) THEN | |
2085 | PARU12=4.*PARU12 | |
2086 | PARU13=2.*PARU13 | |
2087 | GOTO 140 | |
2088 | ELSEIF(NTRY.GT.100) THEN | |
2089 | CALL LYERRM(14,'(LYSTRF:) caught in infinite loop') | |
2090 | IF(MSTU(21).GE.1) RETURN | |
2091 | ENDIF | |
2092 | I=ISAV | |
2093 | MSTU(90)=MSTU91 | |
2094 | DO 660 J=1,4 | |
2095 | P(N+NRS,J)=0. | |
2096 | DO 650 IS=1,NR | |
2097 | P(N+NRS,J)=P(N+NRS,J)+P(N+IS,J) | |
2098 | 650 CONTINUE | |
2099 | 660 CONTINUE | |
2100 | DO 680 JT=1,2 | |
2101 | IRANK(JT)=0 | |
2102 | IF(MJU(JT).NE.0) IRANK(JT)=NJS(JT) | |
2103 | IF(NS.GT.NR) IRANK(JT)=1 | |
2104 | IE(JT)=K(N+1+(JT/2)*(NP-1),3) | |
2105 | IN(3*JT+1)=N+NR+1+4*(JT/2)*(NS-1) | |
2106 | IN(3*JT+2)=IN(3*JT+1)+1 | |
2107 | IN(3*JT+3)=N+NR+4*NS+2*JT-1 | |
2108 | DO 670 IN1=N+NR+2+JT,N+NR+4*NS-2+JT,4 | |
2109 | P(IN1,1)=2-JT | |
2110 | P(IN1,2)=JT-1 | |
2111 | P(IN1,3)=1. | |
2112 | 670 CONTINUE | |
2113 | 680 CONTINUE | |
2114 | ||
2115 | C...Initialize flavour and pT variables for open string. | |
2116 | IF(NS.LT.NR) THEN | |
2117 | PX(1)=0. | |
2118 | PY(1)=0. | |
2119 | IF(NS.EQ.1.AND.MJU(1)+MJU(2).EQ.0) CALL LYPTDI(0,PX(1),PY(1)) | |
2120 | PX(2)=-PX(1) | |
2121 | PY(2)=-PY(1) | |
2122 | DO 690 JT=1,2 | |
2123 | KFL(JT)=K(IE(JT),2) | |
2124 | IF(MJU(JT).NE.0) KFL(JT)=KFJS(JT) | |
2125 | MSTJ(93)=1 | |
2126 | PMQ(JT)=UYMASS(KFL(JT)) | |
2127 | GAM(JT)=0. | |
2128 | 690 CONTINUE | |
2129 | ||
2130 | C...Closed string: random initial breakup flavour, pT and vertex. | |
2131 | ELSE | |
2132 | KFL(3)=INT(1.+(2.+PARJ(2))*RLY(0))*(-1)**INT(RLY(0)+0.5) | |
2133 | CALL LYKFDI(KFL(3),0,KFL(1),KDUMP) | |
2134 | KFL(2)=-KFL(1) | |
2135 | IF(IABS(KFL(1)).GT.10.AND.RLY(0).GT.0.5) THEN | |
2136 | KFL(2)=-(KFL(1)+ISIGN(10000,KFL(1))) | |
2137 | ELSEIF(IABS(KFL(1)).GT.10) THEN | |
2138 | KFL(1)=-(KFL(2)+ISIGN(10000,KFL(2))) | |
2139 | ENDIF | |
2140 | CALL LYPTDI(KFL(1),PX(1),PY(1)) | |
2141 | PX(2)=-PX(1) | |
2142 | PY(2)=-PY(1) | |
2143 | PR3=MIN(25.,0.1*P(N+NR+1,5)**2) | |
2144 | 700 CALL LYZDIS(KFL(1),KFL(2),PR3,Z) | |
2145 | ZR=PR3/(Z*P(N+NR+1,5)**2) | |
2146 | IF(ZR.GE.1.) GOTO 700 | |
2147 | DO 710 JT=1,2 | |
2148 | MSTJ(93)=1 | |
2149 | PMQ(JT)=UYMASS(KFL(JT)) | |
2150 | GAM(JT)=PR3*(1.-Z)/Z | |
2151 | IN1=N+NR+3+4*(JT/2)*(NS-1) | |
2152 | P(IN1,JT)=1.-Z | |
2153 | P(IN1,3-JT)=JT-1 | |
2154 | P(IN1,3)=(2-JT)*(1.-Z)+(JT-1)*Z | |
2155 | P(IN1+1,JT)=ZR | |
2156 | P(IN1+1,3-JT)=2-JT | |
2157 | P(IN1+1,3)=(2-JT)*(1.-ZR)+(JT-1)*ZR | |
2158 | 710 CONTINUE | |
2159 | ENDIF | |
2160 | ||
2161 | C...Find initial transverse directions (i.e. spacelike four-vectors). | |
2162 | DO 750 JT=1,2 | |
2163 | IF(JT.EQ.1.OR.NS.EQ.NR-1) THEN | |
2164 | IN1=IN(3*JT+1) | |
2165 | IN3=IN(3*JT+3) | |
2166 | DO 720 J=1,4 | |
2167 | DP(1,J)=P(IN1,J) | |
2168 | DP(2,J)=P(IN1+1,J) | |
2169 | DP(3,J)=0. | |
2170 | DP(4,J)=0. | |
2171 | 720 CONTINUE | |
2172 | DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) | |
2173 | DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) | |
2174 | DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4) | |
2175 | DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4) | |
2176 | DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4) | |
2177 | IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1. | |
2178 | IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1. | |
2179 | IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1. | |
2180 | IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1. | |
2181 | DHC12=DFOUR(1,2) | |
2182 | DHCX1=DFOUR(3,1)/DHC12 | |
2183 | DHCX2=DFOUR(3,2)/DHC12 | |
2184 | DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12) | |
2185 | DHCY1=DFOUR(4,1)/DHC12 | |
2186 | DHCY2=DFOUR(4,2)/DHC12 | |
2187 | DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12 | |
2188 | DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2) | |
2189 | DO 730 J=1,4 | |
2190 | DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J)) | |
2191 | P(IN3,J)=DP(3,J) | |
2192 | P(IN3+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)- | |
2193 | & DHCYX*DP(3,J)) | |
2194 | 730 CONTINUE | |
2195 | ELSE | |
2196 | DO 740 J=1,4 | |
2197 | P(IN3+2,J)=P(IN3,J) | |
2198 | P(IN3+3,J)=P(IN3+1,J) | |
2199 | 740 CONTINUE | |
2200 | ENDIF | |
2201 | 750 CONTINUE | |
2202 | ||
2203 | C...Remove energy used up in junction string fragmentation. | |
2204 | IF(MJU(1)+MJU(2).GT.0) THEN | |
2205 | DO 770 JT=1,2 | |
2206 | IF(NJS(JT).EQ.0) GOTO 770 | |
2207 | DO 760 J=1,4 | |
2208 | P(N+NRS,J)=P(N+NRS,J)-PJS(JT+2,J) | |
2209 | 760 CONTINUE | |
2210 | 770 CONTINUE | |
2211 | ENDIF | |
2212 | ||
2213 | C...Produce new particle: side, origin. | |
2214 | 780 I=I+1 | |
2215 | IF(2*I-NSAV.GE.MSTU(4)-MSTU(32)-5) THEN | |
2216 | CALL LYERRM(11,'(LYSTRF:) no more memory left in LUJETS') | |
2217 | IF(MSTU(21).GE.1) RETURN | |
2218 | ENDIF | |
2219 | JT=1.5+RLY(0) | |
2220 | IF(IABS(KFL(3-JT)).GT.10) JT=3-JT | |
2221 | IF(IABS(KFL(3-JT)).GE.4.AND.IABS(KFL(3-JT)).LE.8) JT=3-JT | |
2222 | JR=3-JT | |
2223 | JS=3-2*JT | |
2224 | IRANK(JT)=IRANK(JT)+1 | |
2225 | K(I,1)=1 | |
2226 | K(I,3)=IE(JT) | |
2227 | K(I,4)=0 | |
2228 | K(I,5)=0 | |
2229 | ||
2230 | C...Generate flavour, hadron and pT. | |
2231 | 790 CALL LYKFDI(KFL(JT),0,KFL(3),K(I,2)) | |
2232 | IF(K(I,2).EQ.0) GOTO 640 | |
2233 | IF(MSTJ(12).GE.3.AND.IRANK(JT).EQ.1.AND.IABS(KFL(JT)).LE.10.AND. | |
2234 | &IABS(KFL(3)).GT.10) THEN | |
2235 | IF(RLY(0).GT.PARJ(19)) GOTO 790 | |
2236 | ENDIF | |
2237 | P(I,5)=UYMASS(K(I,2)) | |
2238 | CALL LYPTDI(KFL(JT),PX(3),PY(3)) | |
2239 | PR(JT)=P(I,5)**2+(PX(JT)+PX(3))**2+(PY(JT)+PY(3))**2 | |
2240 | ||
2241 | C...Final hadrons for small invariant mass. | |
2242 | MSTJ(93)=1 | |
2243 | PMQ(3)=UYMASS(KFL(3)) | |
2244 | PARJST=PARJ(33) | |
2245 | IF(MSTJ(11).EQ.2) PARJST=PARJ(34) | |
2246 | WMIN=PARJST+PMQ(1)+PMQ(2)+PARJ(36)*PMQ(3) | |
2247 | IF(IABS(KFL(JT)).GT.10.AND.IABS(KFL(3)).GT.10) WMIN= | |
2248 | &WMIN-0.5*PARJ(36)*PMQ(3) | |
2249 | WREM2=FOUR(N+NRS,N+NRS) | |
2250 | IF(WREM2.LT.0.10) GOTO 640 | |
2251 | IF(WREM2.LT.MAX(WMIN*(1.+(2.*RLY(0)-1.)*PARJ(37)), | |
2252 | &PARJ(32)+PMQ(1)+PMQ(2))**2) GOTO 940 | |
2253 | ||
2254 | C...Choose z, which gives Gamma. Shift z for heavy flavours. | |
2255 | CALL LYZDIS(KFL(JT),KFL(3),PR(JT),Z) | |
2256 | IF(IABS(KFL(JT)).GE.4.AND.IABS(KFL(JT)).LE.8.AND. | |
2257 | &MSTU(90).LT.8) THEN | |
2258 | MSTU(90)=MSTU(90)+1 | |
2259 | MSTU(90+MSTU(90))=I | |
2260 | PARU(90+MSTU(90))=Z | |
2261 | ENDIF | |
2262 | KFL1A=IABS(KFL(1)) | |
2263 | KFL2A=IABS(KFL(2)) | |
2264 | IF(MAX(MOD(KFL1A,10),MOD(KFL1A/1000,10),MOD(KFL2A,10), | |
2265 | &MOD(KFL2A/1000,10)).GE.4) THEN | |
2266 | PR(JR)=(PMQ(JR)+PMQ(3))**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2 | |
2267 | PW12=SQRT(MAX(0.,(WREM2-PR(1)-PR(2))**2-4.*PR(1)*PR(2))) | |
2268 | Z=(WREM2+PR(JT)-PR(JR)+PW12*(2.*Z-1.))/(2.*WREM2) | |
2269 | PR(JR)=(PMQ(JR)+PARJST)**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2 | |
2270 | IF((1.-Z)*(WREM2-PR(JT)/Z).LT.PR(JR)) GOTO 940 | |
2271 | ENDIF | |
2272 | GAM(3)=(1.-Z)*(GAM(JT)+PR(JT)/Z) | |
2273 | DO 800 J=1,3 | |
2274 | IN(J)=IN(3*JT+J) | |
2275 | 800 CONTINUE | |
2276 | ||
2277 | C...Stepping within or from 'low' string region easy. | |
2278 | IF(IN(1)+1.EQ.IN(2).AND.Z*P(IN(1)+2,3)*P(IN(2)+2,3)* | |
2279 | &P(IN(1),5)**2.GE.PR(JT)) THEN | |
2280 | P(IN(JT)+2,4)=Z*P(IN(JT)+2,3) | |
2281 | P(IN(JR)+2,4)=PR(JT)/(P(IN(JT)+2,4)*P(IN(1),5)**2) | |
2282 | DO 810 J=1,4 | |
2283 | P(I,J)=(PX(JT)+PX(3))*P(IN(3),J)+(PY(JT)+PY(3))*P(IN(3)+1,J) | |
2284 | 810 CONTINUE | |
2285 | GOTO 900 | |
2286 | ELSEIF(IN(1)+1.EQ.IN(2)) THEN | |
2287 | P(IN(JR)+2,4)=P(IN(JR)+2,3) | |
2288 | P(IN(JR)+2,JT)=1. | |
2289 | IN(JR)=IN(JR)+4*JS | |
2290 | IF(JS*IN(JR).GT.JS*IN(4*JR)) GOTO 640 | |
2291 | IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN | |
2292 | P(IN(JT)+2,4)=P(IN(JT)+2,3) | |
2293 | P(IN(JT)+2,JT)=0. | |
2294 | IN(JT)=IN(JT)+4*JS | |
2295 | ENDIF | |
2296 | ENDIF | |
2297 | ||
2298 | C...Find new transverse directions (i.e. spacelike string vectors). | |
2299 | 820 IF(JS*IN(1).GT.JS*IN(3*JR+1).OR.JS*IN(2).GT.JS*IN(3*JR+2).OR. | |
2300 | &IN(1).GT.IN(2)) GOTO 640 | |
2301 | IF(IN(1).NE.IN(3*JT+1).OR.IN(2).NE.IN(3*JT+2)) THEN | |
2302 | DO 830 J=1,4 | |
2303 | DP(1,J)=P(IN(1),J) | |
2304 | DP(2,J)=P(IN(2),J) | |
2305 | DP(3,J)=0. | |
2306 | DP(4,J)=0. | |
2307 | 830 CONTINUE | |
2308 | DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) | |
2309 | DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) | |
2310 | DHC12=DFOUR(1,2) | |
2311 | IF(DHC12.LE.1E-2) THEN | |
2312 | P(IN(JT)+2,4)=P(IN(JT)+2,3) | |
2313 | P(IN(JT)+2,JT)=0. | |
2314 | IN(JT)=IN(JT)+4*JS | |
2315 | GOTO 820 | |
2316 | ENDIF | |
2317 | IN(3)=N+NR+4*NS+5 | |
2318 | DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4) | |
2319 | DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4) | |
2320 | DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4) | |
2321 | IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1. | |
2322 | IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1. | |
2323 | IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1. | |
2324 | IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1. | |
2325 | DHCX1=DFOUR(3,1)/DHC12 | |
2326 | DHCX2=DFOUR(3,2)/DHC12 | |
2327 | DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12) | |
2328 | DHCY1=DFOUR(4,1)/DHC12 | |
2329 | DHCY2=DFOUR(4,2)/DHC12 | |
2330 | DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12 | |
2331 | DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2) | |
2332 | DO 840 J=1,4 | |
2333 | DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J)) | |
2334 | P(IN(3),J)=DP(3,J) | |
2335 | P(IN(3)+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)- | |
2336 | & DHCYX*DP(3,J)) | |
2337 | 840 CONTINUE | |
2338 | C...Express pT with respect to new axes, if sensible. | |
2339 | PXP=-(PX(3)*FOUR(IN(3*JT+3),IN(3))+PY(3)* | |
2340 | & FOUR(IN(3*JT+3)+1,IN(3))) | |
2341 | PYP=-(PX(3)*FOUR(IN(3*JT+3),IN(3)+1)+PY(3)* | |
2342 | & FOUR(IN(3*JT+3)+1,IN(3)+1)) | |
2343 | IF(ABS(PXP**2+PYP**2-PX(3)**2-PY(3)**2).LT.0.01) THEN | |
2344 | PX(3)=PXP | |
2345 | PY(3)=PYP | |
2346 | ENDIF | |
2347 | ENDIF | |
2348 | ||
2349 | C...Sum up known four-momentum. Gives coefficients for m2 expression. | |
2350 | DO 870 J=1,4 | |
2351 | DHG(J)=0. | |
2352 | P(I,J)=PX(JT)*P(IN(3*JT+3),J)+PY(JT)*P(IN(3*JT+3)+1,J)+ | |
2353 | &PX(3)*P(IN(3),J)+PY(3)*P(IN(3)+1,J) | |
2354 | DO 850 IN1=IN(3*JT+1),IN(1)-4*JS,4*JS | |
2355 | P(I,J)=P(I,J)+P(IN1+2,3)*P(IN1,J) | |
2356 | 850 CONTINUE | |
2357 | DO 860 IN2=IN(3*JT+2),IN(2)-4*JS,4*JS | |
2358 | P(I,J)=P(I,J)+P(IN2+2,3)*P(IN2,J) | |
2359 | 860 CONTINUE | |
2360 | 870 CONTINUE | |
2361 | DHM(1)=FOUR(I,I) | |
2362 | DHM(2)=2.*FOUR(I,IN(1)) | |
2363 | DHM(3)=2.*FOUR(I,IN(2)) | |
2364 | DHM(4)=2.*FOUR(IN(1),IN(2)) | |
2365 | ||
2366 | C...Find coefficients for Gamma expression. | |
2367 | DO 890 IN2=IN(1)+1,IN(2),4 | |
2368 | DO 880 IN1=IN(1),IN2-1,4 | |
2369 | DHC=2.*FOUR(IN1,IN2) | |
2370 | DHG(1)=DHG(1)+P(IN1+2,JT)*P(IN2+2,JT)*DHC | |
2371 | IF(IN1.EQ.IN(1)) DHG(2)=DHG(2)-JS*P(IN2+2,JT)*DHC | |
2372 | IF(IN2.EQ.IN(2)) DHG(3)=DHG(3)+JS*P(IN1+2,JT)*DHC | |
2373 | IF(IN1.EQ.IN(1).AND.IN2.EQ.IN(2)) DHG(4)=DHG(4)-DHC | |
2374 | 880 CONTINUE | |
2375 | 890 CONTINUE | |
2376 | ||
2377 | C...Solve (m2, Gamma) equation system for energies taken. | |
2378 | DHS1=DHM(JR+1)*DHG(4)-DHM(4)*DHG(JR+1) | |
2379 | IF(ABS(DHS1).LT.1E-4) GOTO 640 | |
2380 | DHS2=DHM(4)*(GAM(3)-DHG(1))-DHM(JT+1)*DHG(JR+1)-DHG(4)* | |
2381 | &(P(I,5)**2-DHM(1))+DHG(JT+1)*DHM(JR+1) | |
2382 | DHS3=DHM(JT+1)*(GAM(3)-DHG(1))-DHG(JT+1)*(P(I,5)**2-DHM(1)) | |
2383 | P(IN(JR)+2,4)=0.5*(SQRT(MAX(0D0,DHS2**2-4.*DHS1*DHS3))/ABS(DHS1)- | |
2384 | &DHS2/DHS1) | |
2385 | IF(DHM(JT+1)+DHM(4)*P(IN(JR)+2,4).LE.0.) GOTO 640 | |
2386 | P(IN(JT)+2,4)=(P(I,5)**2-DHM(1)-DHM(JR+1)*P(IN(JR)+2,4))/ | |
2387 | &(DHM(JT+1)+DHM(4)*P(IN(JR)+2,4)) | |
2388 | ||
2389 | C...Step to new region if necessary. | |
2390 | IF(P(IN(JR)+2,4).GT.P(IN(JR)+2,3)) THEN | |
2391 | P(IN(JR)+2,4)=P(IN(JR)+2,3) | |
2392 | P(IN(JR)+2,JT)=1. | |
2393 | IN(JR)=IN(JR)+4*JS | |
2394 | IF(JS*IN(JR).GT.JS*IN(4*JR)) GOTO 640 | |
2395 | IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN | |
2396 | P(IN(JT)+2,4)=P(IN(JT)+2,3) | |
2397 | P(IN(JT)+2,JT)=0. | |
2398 | IN(JT)=IN(JT)+4*JS | |
2399 | ENDIF | |
2400 | GOTO 820 | |
2401 | ELSEIF(P(IN(JT)+2,4).GT.P(IN(JT)+2,3)) THEN | |
2402 | P(IN(JT)+2,4)=P(IN(JT)+2,3) | |
2403 | P(IN(JT)+2,JT)=0. | |
2404 | IN(JT)=IN(JT)+4*JS | |
2405 | GOTO 820 | |
2406 | ENDIF | |
2407 | ||
2408 | C...Four-momentum of particle. Remaining quantities. Loop back. | |
2409 | 900 DO 910 J=1,4 | |
2410 | P(I,J)=P(I,J)+P(IN(1)+2,4)*P(IN(1),J)+P(IN(2)+2,4)*P(IN(2),J) | |
2411 | P(N+NRS,J)=P(N+NRS,J)-P(I,J) | |
2412 | 910 CONTINUE | |
2413 | IF(P(I,4).LT.P(I,5)) GOTO 640 | |
2414 | KFL(JT)=-KFL(3) | |
2415 | PMQ(JT)=PMQ(3) | |
2416 | PX(JT)=-PX(3) | |
2417 | PY(JT)=-PY(3) | |
2418 | GAM(JT)=GAM(3) | |
2419 | IF(IN(3).NE.IN(3*JT+3)) THEN | |
2420 | DO 920 J=1,4 | |
2421 | P(IN(3*JT+3),J)=P(IN(3),J) | |
2422 | P(IN(3*JT+3)+1,J)=P(IN(3)+1,J) | |
2423 | 920 CONTINUE | |
2424 | ENDIF | |
2425 | DO 930 JQ=1,2 | |
2426 | IN(3*JT+JQ)=IN(JQ) | |
2427 | P(IN(JQ)+2,3)=P(IN(JQ)+2,3)-P(IN(JQ)+2,4) | |
2428 | P(IN(JQ)+2,JT)=P(IN(JQ)+2,JT)-JS*(3-2*JQ)*P(IN(JQ)+2,4) | |
2429 | 930 CONTINUE | |
2430 | GOTO 780 | |
2431 | ||
2432 | C...Final hadron: side, flavour, hadron, mass. | |
2433 | 940 I=I+1 | |
2434 | K(I,1)=1 | |
2435 | K(I,3)=IE(JR) | |
2436 | K(I,4)=0 | |
2437 | K(I,5)=0 | |
2438 | CALL LYKFDI(KFL(JR),-KFL(3),KFLDMP,K(I,2)) | |
2439 | IF(K(I,2).EQ.0) GOTO 640 | |
2440 | P(I,5)=UYMASS(K(I,2)) | |
2441 | PR(JR)=P(I,5)**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2 | |
2442 | ||
2443 | C...Final two hadrons: find common setup of four-vectors. | |
2444 | JQ=1 | |
2445 | IF(P(IN(4)+2,3)*P(IN(5)+2,3)*FOUR(IN(4),IN(5)).LT.P(IN(7),3)* | |
2446 | &P(IN(8),3)*FOUR(IN(7),IN(8))) JQ=2 | |
2447 | DHC12=FOUR(IN(3*JQ+1),IN(3*JQ+2)) | |
2448 | DHR1=FOUR(N+NRS,IN(3*JQ+2))/DHC12 | |
2449 | DHR2=FOUR(N+NRS,IN(3*JQ+1))/DHC12 | |
2450 | IF(IN(4).NE.IN(7).OR.IN(5).NE.IN(8)) THEN | |
2451 | PX(3-JQ)=-FOUR(N+NRS,IN(3*JQ+3))-PX(JQ) | |
2452 | PY(3-JQ)=-FOUR(N+NRS,IN(3*JQ+3)+1)-PY(JQ) | |
2453 | PR(3-JQ)=P(I+(JT+JQ-3)**2-1,5)**2+(PX(3-JQ)+(2*JQ-3)*JS* | |
2454 | & PX(3))**2+(PY(3-JQ)+(2*JQ-3)*JS*PY(3))**2 | |
2455 | ENDIF | |
2456 | ||
2457 | C...Solve kinematics for final two hadrons, if possible. | |
2458 | WREM2=WREM2+(PX(1)+PX(2))**2+(PY(1)+PY(2))**2 | |
2459 | FD=(SQRT(PR(1))+SQRT(PR(2)))/SQRT(WREM2) | |
2460 | IF(MJU(1)+MJU(2).NE.0.AND.I.EQ.ISAV+2.AND.FD.GE.1.) GOTO 200 | |
2461 | IF(FD.GE.1.) GOTO 640 | |
2462 | FA=WREM2+PR(JT)-PR(JR) | |
2463 | IF(MSTJ(11).NE.2) PREV=0.5*EXP(MAX(-50.,LOG(FD)*PARJ(38)* | |
2464 | &(PR(1)+PR(2))**2)) | |
2465 | IF(MSTJ(11).EQ.2) PREV=0.5*FD**PARJ(39) | |
2466 | FB=SIGN(SQRT(MAX(0.,FA**2-4.*WREM2*PR(JT))),JS*(RLY(0)-PREV)) | |
2467 | KFL1A=IABS(KFL(1)) | |
2468 | KFL2A=IABS(KFL(2)) | |
2469 | IF(MAX(MOD(KFL1A,10),MOD(KFL1A/1000,10),MOD(KFL2A,10), | |
2470 | &MOD(KFL2A/1000,10)).GE.6) FB=SIGN(SQRT(MAX(0.,FA**2- | |
2471 | &4.*WREM2*PR(JT))),FLOAT(JS)) | |
2472 | DO 950 J=1,4 | |
2473 | P(I-1,J)=(PX(JT)+PX(3))*P(IN(3*JQ+3),J)+(PY(JT)+PY(3))* | |
2474 | &P(IN(3*JQ+3)+1,J)+0.5*(DHR1*(FA+FB)*P(IN(3*JQ+1),J)+ | |
2475 | &DHR2*(FA-FB)*P(IN(3*JQ+2),J))/WREM2 | |
2476 | P(I,J)=P(N+NRS,J)-P(I-1,J) | |
2477 | 950 CONTINUE | |
2478 | IF(P(I-1,4).LT.P(I-1,5).OR.P(I,4).LT.P(I,5)) GOTO 640 | |
2479 | ||
2480 | C...Mark jets as fragmented and give daughter pointers. | |
2481 | N=I-NRS+1 | |
2482 | DO 960 I=NSAV+1,NSAV+NP | |
2483 | IM=K(I,3) | |
2484 | K(IM,1)=K(IM,1)+10 | |
2485 | IF(MSTU(16).NE.2) THEN | |
2486 | K(IM,4)=NSAV+1 | |
2487 | K(IM,5)=NSAV+1 | |
2488 | ELSE | |
2489 | K(IM,4)=NSAV+2 | |
2490 | K(IM,5)=N | |
2491 | ENDIF | |
2492 | 960 CONTINUE | |
2493 | ||
2494 | C...Document string system. Move up particles. | |
2495 | NSAV=NSAV+1 | |
2496 | K(NSAV,1)=11 | |
2497 | K(NSAV,2)=92 | |
2498 | K(NSAV,3)=IP | |
2499 | K(NSAV,4)=NSAV+1 | |
2500 | K(NSAV,5)=N | |
2501 | DO 970 J=1,4 | |
2502 | P(NSAV,J)=DPS(J) | |
2503 | V(NSAV,J)=V(IP,J) | |
2504 | 970 CONTINUE | |
2505 | P(NSAV,5)=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2)) | |
2506 | V(NSAV,5)=0. | |
2507 | DO 990 I=NSAV+1,N | |
2508 | DO 980 J=1,5 | |
2509 | K(I,J)=K(I+NRS-1,J) | |
2510 | P(I,J)=P(I+NRS-1,J) | |
2511 | V(I,J)=0. | |
2512 | 980 CONTINUE | |
2513 | 990 CONTINUE | |
2514 | MSTU91=MSTU(90) | |
2515 | DO 1000 IZ=MSTU90+1,MSTU91 | |
2516 | MSTU9T(IZ)=MSTU(90+IZ)-NRS+1-NSAV+N | |
2517 | PARU9T(IZ)=PARU(90+IZ) | |
2518 | 1000 CONTINUE | |
2519 | MSTU(90)=MSTU90 | |
2520 | ||
2521 | C...Order particles in rank along the chain. Update mother pointer. | |
2522 | DO 1020 I=NSAV+1,N | |
2523 | DO 1010 J=1,5 | |
2524 | K(I-NSAV+N,J)=K(I,J) | |
2525 | P(I-NSAV+N,J)=P(I,J) | |
2526 | 1010 CONTINUE | |
2527 | 1020 CONTINUE | |
2528 | I1=NSAV | |
2529 | DO 1050 I=N+1,2*N-NSAV | |
2530 | IF(K(I,3).NE.IE(1)) GOTO 1050 | |
2531 | I1=I1+1 | |
2532 | DO 1030 J=1,5 | |
2533 | K(I1,J)=K(I,J) | |
2534 | P(I1,J)=P(I,J) | |
2535 | 1030 CONTINUE | |
2536 | IF(MSTU(16).NE.2) K(I1,3)=NSAV | |
2537 | DO 1040 IZ=MSTU90+1,MSTU91 | |
2538 | IF(MSTU9T(IZ).EQ.I) THEN | |
2539 | MSTU(90)=MSTU(90)+1 | |
2540 | MSTU(90+MSTU(90))=I1 | |
2541 | PARU(90+MSTU(90))=PARU9T(IZ) | |
2542 | ENDIF | |
2543 | 1040 CONTINUE | |
2544 | 1050 CONTINUE | |
2545 | DO 1080 I=2*N-NSAV,N+1,-1 | |
2546 | IF(K(I,3).EQ.IE(1)) GOTO 1080 | |
2547 | I1=I1+1 | |
2548 | DO 1060 J=1,5 | |
2549 | K(I1,J)=K(I,J) | |
2550 | P(I1,J)=P(I,J) | |
2551 | 1060 CONTINUE | |
2552 | IF(MSTU(16).NE.2) K(I1,3)=NSAV | |
2553 | DO 1070 IZ=MSTU90+1,MSTU91 | |
2554 | IF(MSTU9T(IZ).EQ.I) THEN | |
2555 | MSTU(90)=MSTU(90)+1 | |
2556 | MSTU(90+MSTU(90))=I1 | |
2557 | PARU(90+MSTU(90))=PARU9T(IZ) | |
2558 | ENDIF | |
2559 | 1070 CONTINUE | |
2560 | 1080 CONTINUE | |
2561 | ||
2562 | C...Boost back particle system. Set production vertices. | |
2563 | IF(MBST.EQ.0) THEN | |
2564 | MSTU(33)=1 | |
2565 | CALL LUDBRB(NSAV+1,N,0.,0.,DPS(1)/DPS(4),DPS(2)/DPS(4), | |
2566 | & DPS(3)/DPS(4)) | |
2567 | ELSE | |
2568 | DO 1090 I=NSAV+1,N | |
2569 | HHPMT=P(I,1)**2+P(I,2)**2+P(I,5)**2 | |
2570 | IF(P(I,3).GT.0.) THEN | |
2571 | HHPEZ=(P(I,4)+P(I,3))*HHBZ | |
2572 | P(I,3)=0.5*(HHPEZ-HHPMT/HHPEZ) | |
2573 | P(I,4)=0.5*(HHPEZ+HHPMT/HHPEZ) | |
2574 | ELSE | |
2575 | HHPEZ=(P(I,4)-P(I,3))/HHBZ | |
2576 | P(I,3)=-0.5*(HHPEZ-HHPMT/HHPEZ) | |
2577 | P(I,4)=0.5*(HHPEZ+HHPMT/HHPEZ) | |
2578 | ENDIF | |
2579 | 1090 CONTINUE | |
2580 | ENDIF | |
2581 | DO 1110 I=NSAV+1,N | |
2582 | DO 1100 J=1,4 | |
2583 | V(I,J)=V(IP,J) | |
2584 | 1100 CONTINUE | |
2585 | 1110 CONTINUE | |
2586 | ||
2587 | RETURN | |
2588 | END | |
2589 | ||
2590 | C********************************************************************* | |
2591 | ||
2592 | SUBROUTINE LYINDF(IP) | |
2593 | ||
2594 | C...Purpose: to handle the fragmentation of a jet system (or a single | |
2595 | C...jet) according to independent fragmentation models. | |
2596 | IMPLICIT DOUBLE PRECISION(D) | |
2597 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
2598 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
2599 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
2600 | SAVE /LYJETS/,/LYDAT1/,/LYDAT2/ | |
2601 | DIMENSION DPS(5),PSI(4),NFI(3),NFL(3),IFET(3),KFLF(3), | |
2602 | &KFLO(2),PXO(2),PYO(2),WO(2) | |
2603 | ||
2604 | C...Reset counters. Identify parton system and take copy. Check flavour. | |
2605 | NSAV=N | |
2606 | MSTU90=MSTU(90) | |
2607 | NJET=0 | |
2608 | KQSUM=0 | |
2609 | DO 100 J=1,5 | |
2610 | DPS(J)=0. | |
2611 | 100 CONTINUE | |
2612 | I=IP-1 | |
2613 | 110 I=I+1 | |
2614 | IF(I.GT.MIN(N,MSTU(4)-MSTU(32))) THEN | |
2615 | CALL LYERRM(12,'(LYINDF:) failed to reconstruct jet system') | |
2616 | IF(MSTU(21).GE.1) RETURN | |
2617 | ENDIF | |
2618 | IF(K(I,1).NE.1.AND.K(I,1).NE.2) GOTO 110 | |
2619 | KC=LYCOMP(K(I,2)) | |
2620 | IF(KC.EQ.0) GOTO 110 | |
2621 | KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) | |
2622 | IF(KQ.EQ.0) GOTO 110 | |
2623 | NJET=NJET+1 | |
2624 | IF(KQ.NE.2) KQSUM=KQSUM+KQ | |
2625 | DO 120 J=1,5 | |
2626 | K(NSAV+NJET,J)=K(I,J) | |
2627 | P(NSAV+NJET,J)=P(I,J) | |
2628 | DPS(J)=DPS(J)+P(I,J) | |
2629 | 120 CONTINUE | |
2630 | K(NSAV+NJET,3)=I | |
2631 | IF(K(I,1).EQ.2.OR.(MSTJ(3).LE.5.AND.N.GT.I.AND. | |
2632 | &K(I+1,1).EQ.2)) GOTO 110 | |
2633 | IF(NJET.NE.1.AND.KQSUM.NE.0) THEN | |
2634 | CALL LYERRM(12,'(LYINDF:) unphysical flavour combination') | |
2635 | IF(MSTU(21).GE.1) RETURN | |
2636 | ENDIF | |
2637 | ||
2638 | C...Boost copied system to CM frame. Find CM energy and sum flavours. | |
2639 | IF(NJET.NE.1) THEN | |
2640 | MSTU(33)=1 | |
2641 | CALL LUDBRB(NSAV+1,NSAV+NJET,0.,0.,-DPS(1)/DPS(4), | |
2642 | & -DPS(2)/DPS(4),-DPS(3)/DPS(4)) | |
2643 | ENDIF | |
2644 | PECM=0. | |
2645 | DO 130 J=1,3 | |
2646 | NFI(J)=0 | |
2647 | 130 CONTINUE | |
2648 | DO 140 I=NSAV+1,NSAV+NJET | |
2649 | PECM=PECM+P(I,4) | |
2650 | KFA=IABS(K(I,2)) | |
2651 | IF(KFA.LE.3) THEN | |
2652 | NFI(KFA)=NFI(KFA)+ISIGN(1,K(I,2)) | |
2653 | ELSEIF(KFA.GT.1000) THEN | |
2654 | KFLA=MOD(KFA/1000,10) | |
2655 | KFLB=MOD(KFA/100,10) | |
2656 | IF(KFLA.LE.3) NFI(KFLA)=NFI(KFLA)+ISIGN(1,K(I,2)) | |
2657 | IF(KFLB.LE.3) NFI(KFLB)=NFI(KFLB)+ISIGN(1,K(I,2)) | |
2658 | ENDIF | |
2659 | 140 CONTINUE | |
2660 | ||
2661 | C...Loop over attempts made. Reset counters. | |
2662 | NTRY=0 | |
2663 | 150 NTRY=NTRY+1 | |
2664 | IF(NTRY.GT.200) THEN | |
2665 | CALL LYERRM(14,'(LYINDF:) caught in infinite loop') | |
2666 | IF(MSTU(21).GE.1) RETURN | |
2667 | ENDIF | |
2668 | N=NSAV+NJET | |
2669 | MSTU(90)=MSTU90 | |
2670 | DO 160 J=1,3 | |
2671 | NFL(J)=NFI(J) | |
2672 | IFET(J)=0 | |
2673 | KFLF(J)=0 | |
2674 | 160 CONTINUE | |
2675 | ||
2676 | C...Loop over jets to be fragmented. | |
2677 | DO 230 IP1=NSAV+1,NSAV+NJET | |
2678 | MSTJ(91)=0 | |
2679 | NSAV1=N | |
2680 | MSTU91=MSTU(90) | |
2681 | ||
2682 | C...Initial flavour and momentum values. Jet along +z axis. | |
2683 | KFLH=IABS(K(IP1,2)) | |
2684 | IF(KFLH.GT.10) KFLH=MOD(KFLH/1000,10) | |
2685 | KFLO(2)=0 | |
2686 | WF=P(IP1,4)+SQRT(P(IP1,1)**2+P(IP1,2)**2+P(IP1,3)**2) | |
2687 | ||
2688 | C...Initial values for quark or diquark jet. | |
2689 | 170 IF(IABS(K(IP1,2)).NE.21) THEN | |
2690 | NSTR=1 | |
2691 | KFLO(1)=K(IP1,2) | |
2692 | CALL LYPTDI(0,PXO(1),PYO(1)) | |
2693 | WO(1)=WF | |
2694 | ||
2695 | C...Initial values for gluon treated like random quark jet. | |
2696 | ELSEIF(MSTJ(2).LE.2) THEN | |
2697 | NSTR=1 | |
2698 | IF(MSTJ(2).EQ.2) MSTJ(91)=1 | |
2699 | KFLO(1)=INT(1.+(2.+PARJ(2))*RLY(0))*(-1)**INT(RLY(0)+0.5) | |
2700 | CALL LYPTDI(0,PXO(1),PYO(1)) | |
2701 | WO(1)=WF | |
2702 | ||
2703 | C...Initial values for gluon treated like quark-antiquark jet pair, | |
2704 | C...sharing energy according to Altarelli-Parisi splitting function. | |
2705 | ELSE | |
2706 | NSTR=2 | |
2707 | IF(MSTJ(2).EQ.4) MSTJ(91)=1 | |
2708 | KFLO(1)=INT(1.+(2.+PARJ(2))*RLY(0))*(-1)**INT(RLY(0)+0.5) | |
2709 | KFLO(2)=-KFLO(1) | |
2710 | CALL LYPTDI(0,PXO(1),PYO(1)) | |
2711 | PXO(2)=-PXO(1) | |
2712 | PYO(2)=-PYO(1) | |
2713 | WO(1)=WF*RLY(0)**(1./3.) | |
2714 | WO(2)=WF-WO(1) | |
2715 | ENDIF | |
2716 | ||
2717 | C...Initial values for rank, flavour, pT and W+. | |
2718 | DO 220 ISTR=1,NSTR | |
2719 | 180 I=N | |
2720 | MSTU(90)=MSTU91 | |
2721 | IRANK=0 | |
2722 | KFL1=KFLO(ISTR) | |
2723 | PX1=PXO(ISTR) | |
2724 | PY1=PYO(ISTR) | |
2725 | W=WO(ISTR) | |
2726 | ||
2727 | C...New hadron. Generate flavour and hadron species. | |
2728 | 190 I=I+1 | |
2729 | IF(I.GE.MSTU(4)-MSTU(32)-NJET-5) THEN | |
2730 | CALL LYERRM(11,'(LYINDF:) no more memory left in LUJETS') | |
2731 | IF(MSTU(21).GE.1) RETURN | |
2732 | ENDIF | |
2733 | IRANK=IRANK+1 | |
2734 | K(I,1)=1 | |
2735 | K(I,3)=IP1 | |
2736 | K(I,4)=0 | |
2737 | K(I,5)=0 | |
2738 | 200 CALL LYKFDI(KFL1,0,KFL2,K(I,2)) | |
2739 | IF(K(I,2).EQ.0) GOTO 180 | |
2740 | IF(MSTJ(12).GE.3.AND.IRANK.EQ.1.AND.IABS(KFL1).LE.10.AND. | |
2741 | &IABS(KFL2).GT.10) THEN | |
2742 | IF(RLY(0).GT.PARJ(19)) GOTO 200 | |
2743 | ENDIF | |
2744 | ||
2745 | C...Find hadron mass. Generate four-momentum. | |
2746 | P(I,5)=UYMASS(K(I,2)) | |
2747 | CALL LYPTDI(KFL1,PX2,PY2) | |
2748 | P(I,1)=PX1+PX2 | |
2749 | P(I,2)=PY1+PY2 | |
2750 | PR=P(I,5)**2+P(I,1)**2+P(I,2)**2 | |
2751 | CALL LYZDIS(KFL1,KFL2,PR,Z) | |
2752 | MZSAV=0 | |
2753 | IF(IABS(KFL1).GE.4.AND.IABS(KFL1).LE.8.AND.MSTU(90).LT.8) THEN | |
2754 | MZSAV=1 | |
2755 | MSTU(90)=MSTU(90)+1 | |
2756 | MSTU(90+MSTU(90))=I | |
2757 | PARU(90+MSTU(90))=Z | |
2758 | ENDIF | |
2759 | P(I,3)=0.5*(Z*W-PR/MAX(1E-4,Z*W)) | |
2760 | P(I,4)=0.5*(Z*W+PR/MAX(1E-4,Z*W)) | |
2761 | IF(MSTJ(3).GE.1.AND.IRANK.EQ.1.AND.KFLH.GE.4.AND. | |
2762 | &P(I,3).LE.0.001) THEN | |
2763 | IF(W.GE.P(I,5)+0.5*PARJ(32)) GOTO 180 | |
2764 | P(I,3)=0.0001 | |
2765 | P(I,4)=SQRT(PR) | |
2766 | Z=P(I,4)/W | |
2767 | ENDIF | |
2768 | ||
2769 | C...Remaining flavour and momentum. | |
2770 | KFL1=-KFL2 | |
2771 | PX1=-PX2 | |
2772 | PY1=-PY2 | |
2773 | W=(1.-Z)*W | |
2774 | DO 210 J=1,5 | |
2775 | V(I,J)=0. | |
2776 | 210 CONTINUE | |
2777 | ||
2778 | C...Check if pL acceptable. Go back for new hadron if enough energy. | |
2779 | IF(MSTJ(3).GE.0.AND.P(I,3).LT.0.) THEN | |
2780 | I=I-1 | |
2781 | IF(MZSAV.EQ.1) MSTU(90)=MSTU(90)-1 | |
2782 | ENDIF | |
2783 | IF(W.GT.PARJ(31)) GOTO 190 | |
2784 | N=I | |
2785 | 220 CONTINUE | |
2786 | IF(MOD(MSTJ(3),5).EQ.4.AND.N.EQ.NSAV1) WF=WF+0.1*PARJ(32) | |
2787 | IF(MOD(MSTJ(3),5).EQ.4.AND.N.EQ.NSAV1) GOTO 170 | |
2788 | ||
2789 | C...Rotate jet to new direction. | |
2790 | THE=UYANGL(P(IP1,3),SQRT(P(IP1,1)**2+P(IP1,2)**2)) | |
2791 | PHI=UYANGL(P(IP1,1),P(IP1,2)) | |
2792 | MSTU(33)=1 | |
2793 | CALL LUDBRB(NSAV1+1,N,THE,PHI,0D0,0D0,0D0) | |
2794 | K(K(IP1,3),4)=NSAV1+1 | |
2795 | K(K(IP1,3),5)=N | |
2796 | ||
2797 | C...End of jet generation loop. Skip conservation in some cases. | |
2798 | 230 CONTINUE | |
2799 | IF(NJET.EQ.1.OR.MSTJ(3).LE.0) GOTO 490 | |
2800 | IF(MOD(MSTJ(3),5).NE.0.AND.N-NSAV-NJET.LT.2) GOTO 150 | |
2801 | ||
2802 | C...Subtract off produced hadron flavours, finished if zero. | |
2803 | DO 240 I=NSAV+NJET+1,N | |
2804 | KFA=IABS(K(I,2)) | |
2805 | KFLA=MOD(KFA/1000,10) | |
2806 | KFLB=MOD(KFA/100,10) | |
2807 | KFLC=MOD(KFA/10,10) | |
2808 | IF(KFLA.EQ.0) THEN | |
2809 | IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)-ISIGN(1,K(I,2))*(-1)**KFLB | |
2810 | IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)+ISIGN(1,K(I,2))*(-1)**KFLB | |
2811 | ELSE | |
2812 | IF(KFLA.LE.3) NFL(KFLA)=NFL(KFLA)-ISIGN(1,K(I,2)) | |
2813 | IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)-ISIGN(1,K(I,2)) | |
2814 | IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)-ISIGN(1,K(I,2)) | |
2815 | ENDIF | |
2816 | 240 CONTINUE | |
2817 | NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+ | |
2818 | &NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3 | |
2819 | IF(NREQ.EQ.0) GOTO 320 | |
2820 | ||
2821 | C...Take away flavour of low-momentum particles until enough freedom. | |
2822 | NREM=0 | |
2823 | 250 IREM=0 | |
2824 | P2MIN=PECM**2 | |
2825 | DO 260 I=NSAV+NJET+1,N | |
2826 | P2=P(I,1)**2+P(I,2)**2+P(I,3)**2 | |
2827 | IF(K(I,1).EQ.1.AND.P2.LT.P2MIN) IREM=I | |
2828 | IF(K(I,1).EQ.1.AND.P2.LT.P2MIN) P2MIN=P2 | |
2829 | 260 CONTINUE | |
2830 | IF(IREM.EQ.0) GOTO 150 | |
2831 | K(IREM,1)=7 | |
2832 | KFA=IABS(K(IREM,2)) | |
2833 | KFLA=MOD(KFA/1000,10) | |
2834 | KFLB=MOD(KFA/100,10) | |
2835 | KFLC=MOD(KFA/10,10) | |
2836 | IF(KFLA.GE.4.OR.KFLB.GE.4) K(IREM,1)=8 | |
2837 | IF(K(IREM,1).EQ.8) GOTO 250 | |
2838 | IF(KFLA.EQ.0) THEN | |
2839 | ISGN=ISIGN(1,K(IREM,2))*(-1)**KFLB | |
2840 | IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)+ISGN | |
2841 | IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)-ISGN | |
2842 | ELSE | |
2843 | IF(KFLA.LE.3) NFL(KFLA)=NFL(KFLA)+ISIGN(1,K(IREM,2)) | |
2844 | IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)+ISIGN(1,K(IREM,2)) | |
2845 | IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)+ISIGN(1,K(IREM,2)) | |
2846 | ENDIF | |
2847 | NREM=NREM+1 | |
2848 | NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+ | |
2849 | &NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3 | |
2850 | IF(NREQ.GT.NREM) GOTO 250 | |
2851 | DO 270 I=NSAV+NJET+1,N | |
2852 | IF(K(I,1).EQ.8) K(I,1)=1 | |
2853 | 270 CONTINUE | |
2854 | ||
2855 | C...Find combination of existing and new flavours for hadron. | |
2856 | 280 NFET=2 | |
2857 | IF(NFL(1)+NFL(2)+NFL(3).NE.0) NFET=3 | |
2858 | IF(NREQ.LT.NREM) NFET=1 | |
2859 | IF(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3)).EQ.0) NFET=0 | |
2860 | DO 290 J=1,NFET | |
2861 | IFET(J)=1+(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3)))*RLY(0) | |
2862 | KFLF(J)=ISIGN(1,NFL(1)) | |
2863 | IF(IFET(J).GT.IABS(NFL(1))) KFLF(J)=ISIGN(2,NFL(2)) | |
2864 | IF(IFET(J).GT.IABS(NFL(1))+IABS(NFL(2))) KFLF(J)=ISIGN(3,NFL(3)) | |
2865 | 290 CONTINUE | |
2866 | IF(NFET.EQ.2.AND.(IFET(1).EQ.IFET(2).OR.KFLF(1)*KFLF(2).GT.0)) | |
2867 | &GOTO 280 | |
2868 | IF(NFET.EQ.3.AND.(IFET(1).EQ.IFET(2).OR.IFET(1).EQ.IFET(3).OR. | |
2869 | &IFET(2).EQ.IFET(3).OR.KFLF(1)*KFLF(2).LT.0.OR.KFLF(1)*KFLF(3) | |
2870 | &.LT.0.OR.KFLF(1)*(NFL(1)+NFL(2)+NFL(3)).LT.0)) GOTO 280 | |
2871 | IF(NFET.EQ.0) KFLF(1)=1+INT((2.+PARJ(2))*RLY(0)) | |
2872 | IF(NFET.EQ.0) KFLF(2)=-KFLF(1) | |
2873 | IF(NFET.EQ.1) KFLF(2)=ISIGN(1+INT((2.+PARJ(2))*RLY(0)),-KFLF(1)) | |
2874 | IF(NFET.LE.2) KFLF(3)=0 | |
2875 | IF(KFLF(3).NE.0) THEN | |
2876 | KFLFC=ISIGN(1000*MAX(IABS(KFLF(1)),IABS(KFLF(3)))+ | |
2877 | & 100*MIN(IABS(KFLF(1)),IABS(KFLF(3)))+1,KFLF(1)) | |
2878 | IF(KFLF(1).EQ.KFLF(3).OR.(1.+3.*PARJ(4))*RLY(0).GT.1.) | |
2879 | & KFLFC=KFLFC+ISIGN(2,KFLFC) | |
2880 | ELSE | |
2881 | KFLFC=KFLF(1) | |
2882 | ENDIF | |
2883 | CALL LYKFDI(KFLFC,KFLF(2),KFLDMP,KF) | |
2884 | IF(KF.EQ.0) GOTO 280 | |
2885 | DO 300 J=1,MAX(2,NFET) | |
2886 | NFL(IABS(KFLF(J)))=NFL(IABS(KFLF(J)))-ISIGN(1,KFLF(J)) | |
2887 | 300 CONTINUE | |
2888 | ||
2889 | C...Store hadron at random among free positions. | |
2890 | NPOS=MIN(1+INT(RLY(0)*NREM),NREM) | |
2891 | DO 310 I=NSAV+NJET+1,N | |
2892 | IF(K(I,1).EQ.7) NPOS=NPOS-1 | |
2893 | IF(K(I,1).EQ.1.OR.NPOS.NE.0) GOTO 310 | |
2894 | K(I,1)=1 | |
2895 | K(I,2)=KF | |
2896 | P(I,5)=UYMASS(K(I,2)) | |
2897 | P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2) | |
2898 | 310 CONTINUE | |
2899 | NREM=NREM-1 | |
2900 | NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+ | |
2901 | &NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3 | |
2902 | IF(NREM.GT.0) GOTO 280 | |
2903 | ||
2904 | C...Compensate for missing momentum in global scheme (3 options). | |
2905 | 320 IF(MOD(MSTJ(3),5).NE.0.AND.MOD(MSTJ(3),5).NE.4) THEN | |
2906 | DO 340 J=1,3 | |
2907 | PSI(J)=0. | |
2908 | DO 330 I=NSAV+NJET+1,N | |
2909 | PSI(J)=PSI(J)+P(I,J) | |
2910 | 330 CONTINUE | |
2911 | 340 CONTINUE | |
2912 | PSI(4)=PSI(1)**2+PSI(2)**2+PSI(3)**2 | |
2913 | PWS=0. | |
2914 | DO 350 I=NSAV+NJET+1,N | |
2915 | IF(MOD(MSTJ(3),5).EQ.1) PWS=PWS+P(I,4) | |
2916 | IF(MOD(MSTJ(3),5).EQ.2) PWS=PWS+SQRT(P(I,5)**2+(PSI(1)*P(I,1)+ | |
2917 | & PSI(2)*P(I,2)+PSI(3)*P(I,3))**2/PSI(4)) | |
2918 | IF(MOD(MSTJ(3),5).EQ.3) PWS=PWS+1. | |
2919 | 350 CONTINUE | |
2920 | DO 370 I=NSAV+NJET+1,N | |
2921 | IF(MOD(MSTJ(3),5).EQ.1) PW=P(I,4) | |
2922 | IF(MOD(MSTJ(3),5).EQ.2) PW=SQRT(P(I,5)**2+(PSI(1)*P(I,1)+ | |
2923 | & PSI(2)*P(I,2)+PSI(3)*P(I,3))**2/PSI(4)) | |
2924 | IF(MOD(MSTJ(3),5).EQ.3) PW=1. | |
2925 | DO 360 J=1,3 | |
2926 | P(I,J)=P(I,J)-PSI(J)*PW/PWS | |
2927 | 360 CONTINUE | |
2928 | P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2) | |
2929 | 370 CONTINUE | |
2930 | ||
2931 | C...Compensate for missing momentum withing each jet separately. | |
2932 | ELSEIF(MOD(MSTJ(3),5).EQ.4) THEN | |
2933 | DO 390 I=N+1,N+NJET | |
2934 | K(I,1)=0 | |
2935 | DO 380 J=1,5 | |
2936 | P(I,J)=0. | |
2937 | 380 CONTINUE | |
2938 | 390 CONTINUE | |
2939 | DO 410 I=NSAV+NJET+1,N | |
2940 | IR1=K(I,3) | |
2941 | IR2=N+IR1-NSAV | |
2942 | K(IR2,1)=K(IR2,1)+1 | |
2943 | PLS=(P(I,1)*P(IR1,1)+P(I,2)*P(IR1,2)+P(I,3)*P(IR1,3))/ | |
2944 | & (P(IR1,1)**2+P(IR1,2)**2+P(IR1,3)**2) | |
2945 | DO 400 J=1,3 | |
2946 | P(IR2,J)=P(IR2,J)+P(I,J)-PLS*P(IR1,J) | |
2947 | 400 CONTINUE | |
2948 | P(IR2,4)=P(IR2,4)+P(I,4) | |
2949 | P(IR2,5)=P(IR2,5)+PLS | |
2950 | 410 CONTINUE | |
2951 | PSS=0. | |
2952 | DO 420 I=N+1,N+NJET | |
2953 | IF(K(I,1).NE.0) PSS=PSS+P(I,4)/(PECM*(0.8*P(I,5)+0.2)) | |
2954 | 420 CONTINUE | |
2955 | DO 440 I=NSAV+NJET+1,N | |
2956 | IR1=K(I,3) | |
2957 | IR2=N+IR1-NSAV | |
2958 | PLS=(P(I,1)*P(IR1,1)+P(I,2)*P(IR1,2)+P(I,3)*P(IR1,3))/ | |
2959 | & (P(IR1,1)**2+P(IR1,2)**2+P(IR1,3)**2) | |
2960 | DO 430 J=1,3 | |
2961 | P(I,J)=P(I,J)-P(IR2,J)/K(IR2,1)+(1./(P(IR2,5)*PSS)-1.)*PLS* | |
2962 | & P(IR1,J) | |
2963 | 430 CONTINUE | |
2964 | P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2) | |
2965 | 440 CONTINUE | |
2966 | ENDIF | |
2967 | ||
2968 | C...Scale momenta for energy conservation. | |
2969 | IF(MOD(MSTJ(3),5).NE.0) THEN | |
2970 | PMS=0. | |
2971 | PES=0. | |
2972 | PQS=0. | |
2973 | DO 450 I=NSAV+NJET+1,N | |
2974 | PMS=PMS+P(I,5) | |
2975 | PES=PES+P(I,4) | |
2976 | PQS=PQS+P(I,5)**2/P(I,4) | |
2977 | 450 CONTINUE | |
2978 | IF(PMS.GE.PECM) GOTO 150 | |
2979 | NECO=0 | |
2980 | 460 NECO=NECO+1 | |
2981 | PFAC=(PECM-PQS)/(PES-PQS) | |
2982 | PES=0. | |
2983 | PQS=0. | |
2984 | DO 480 I=NSAV+NJET+1,N | |
2985 | DO 470 J=1,3 | |
2986 | P(I,J)=PFAC*P(I,J) | |
2987 | 470 CONTINUE | |
2988 | P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2) | |
2989 | PES=PES+P(I,4) | |
2990 | PQS=PQS+P(I,5)**2/P(I,4) | |
2991 | 480 CONTINUE | |
2992 | IF(NECO.LT.10.AND.ABS(PECM-PES).GT.2E-6*PECM) GOTO 460 | |
2993 | ENDIF | |
2994 | ||
2995 | C...Origin of produced particles and parton daughter pointers. | |
2996 | 490 DO 500 I=NSAV+NJET+1,N | |
2997 | IF(MSTU(16).NE.2) K(I,3)=NSAV+1 | |
2998 | IF(MSTU(16).EQ.2) K(I,3)=K(K(I,3),3) | |
2999 | 500 CONTINUE | |
3000 | DO 510 I=NSAV+1,NSAV+NJET | |
3001 | I1=K(I,3) | |
3002 | K(I1,1)=K(I1,1)+10 | |
3003 | IF(MSTU(16).NE.2) THEN | |
3004 | K(I1,4)=NSAV+1 | |
3005 | K(I1,5)=NSAV+1 | |
3006 | ELSE | |
3007 | K(I1,4)=K(I1,4)-NJET+1 | |
3008 | K(I1,5)=K(I1,5)-NJET+1 | |
3009 | IF(K(I1,5).LT.K(I1,4)) THEN | |
3010 | K(I1,4)=0 | |
3011 | K(I1,5)=0 | |
3012 | ENDIF | |
3013 | ENDIF | |
3014 | 510 CONTINUE | |
3015 | ||
3016 | C...Document independent fragmentation system. Remove copy of jets. | |
3017 | NSAV=NSAV+1 | |
3018 | K(NSAV,1)=11 | |
3019 | K(NSAV,2)=93 | |
3020 | K(NSAV,3)=IP | |
3021 | K(NSAV,4)=NSAV+1 | |
3022 | K(NSAV,5)=N-NJET+1 | |
3023 | DO 520 J=1,4 | |
3024 | P(NSAV,J)=DPS(J) | |
3025 | V(NSAV,J)=V(IP,J) | |
3026 | 520 CONTINUE | |
3027 | P(NSAV,5)=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2)) | |
3028 | V(NSAV,5)=0. | |
3029 | DO 540 I=NSAV+NJET,N | |
3030 | DO 530 J=1,5 | |
3031 | K(I-NJET+1,J)=K(I,J) | |
3032 | P(I-NJET+1,J)=P(I,J) | |
3033 | V(I-NJET+1,J)=V(I,J) | |
3034 | 530 CONTINUE | |
3035 | 540 CONTINUE | |
3036 | N=N-NJET+1 | |
3037 | DO 550 IZ=MSTU90+1,MSTU(90) | |
3038 | MSTU(90+IZ)=MSTU(90+IZ)-NJET+1 | |
3039 | 550 CONTINUE | |
3040 | ||
3041 | C...Boost back particle system. Set production vertices. | |
3042 | IF(NJET.NE.1) CALL LUDBRB(NSAV+1,N,0.,0.,DPS(1)/DPS(4), | |
3043 | &DPS(2)/DPS(4),DPS(3)/DPS(4)) | |
3044 | DO 570 I=NSAV+1,N | |
3045 | DO 560 J=1,4 | |
3046 | V(I,J)=V(IP,J) | |
3047 | 560 CONTINUE | |
3048 | 570 CONTINUE | |
3049 | ||
3050 | RETURN | |
3051 | END | |
3052 | ||
3053 | C********************************************************************* | |
3054 | ||
3055 | SUBROUTINE LYDECY(IP) | |
3056 | ||
3057 | C...Purpose: to handle the decay of unstable particles. | |
3058 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
3059 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
3060 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
3061 | COMMON/LYDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) | |
3062 | SAVE /LYJETS/,/LYDAT1/,/LYDAT2/,/LYDAT3/ | |
3063 | DIMENSION VDCY(4),KFLO(4),KFL1(4),PV(10,5),RORD(10),UE(3),BE(3), | |
3064 | &WTCOR(10),PTAU(4),PCMTAU(4) | |
3065 | DOUBLE PRECISION DBETAU(3) | |
3066 | DATA WTCOR/2.,5.,15.,60.,250.,1500.,1.2E4,1.2E5,150.,16./ | |
3067 | ||
3068 | C...Functions: momentum in two-particle decays, four-product and | |
3069 | C...matrix element times phase space in weak decays. | |
3070 | PAWT(A,B,C)=SQRT(ABS((A**2-(B+C)**2)*(A**2-(B-C)**2)))/(2.*A) | |
3071 | C...........added ABS because would go 10**-7 LT 0 (precision thing?) | |
3072 | C...........once per few 10**5 events -- jmiles 22.June.02 | |
3073 | FOUR(I,J)=P(I,4)*P(J,4)-P(I,1)*P(J,1)-P(I,2)*P(J,2)-P(I,3)*P(J,3) | |
3074 | HMEPS(HA)=((1.-HRQ-HA)**2+3.*HA*(1.+HRQ-HA))* | |
3075 | &SQRT((1.-HRQ-HA)**2-4.*HRQ*HA) | |
3076 | ||
3077 | C...Initial values. | |
3078 | NTRY=0 | |
3079 | NSAV=N | |
3080 | KFA=IABS(K(IP,2)) | |
3081 | KFS=ISIGN(1,K(IP,2)) | |
3082 | KC=LYCOMP(KFA) | |
3083 | MSTJ(92)=0 | |
3084 | ||
3085 | C...Choose lifetime and determine decay vertex. | |
3086 | IF(K(IP,1).EQ.5) THEN | |
3087 | V(IP,5)=0. | |
3088 | ELSEIF(K(IP,1).NE.4) THEN | |
3089 | V(IP,5)=-PMAS(KC,4)*LOG(RLY(0)) | |
3090 | ENDIF | |
3091 | DO 100 J=1,4 | |
3092 | VDCY(J)=V(IP,J)+V(IP,5)*P(IP,J)/P(IP,5) | |
3093 | 100 CONTINUE | |
3094 | ||
3095 | C...Determine whether decay allowed or not. | |
3096 | MOUT=0 | |
3097 | IF(MSTJ(22).EQ.2) THEN | |
3098 | IF(PMAS(KC,4).GT.PARJ(71)) MOUT=1 | |
3099 | ELSEIF(MSTJ(22).EQ.3) THEN | |
3100 | IF(VDCY(1)**2+VDCY(2)**2+VDCY(3)**2.GT.PARJ(72)**2) MOUT=1 | |
3101 | ELSEIF(MSTJ(22).EQ.4) THEN | |
3102 | IF(VDCY(1)**2+VDCY(2)**2.GT.PARJ(73)**2) MOUT=1 | |
3103 | IF(ABS(VDCY(3)).GT.PARJ(74)) MOUT=1 | |
3104 | ENDIF | |
3105 | IF(MOUT.EQ.1.AND.K(IP,1).NE.5) THEN | |
3106 | K(IP,1)=4 | |
3107 | RETURN | |
3108 | ENDIF | |
3109 | ||
3110 | C...Interface to external tau decay library (for tau polarization). | |
3111 | IF(KFA.EQ.15.AND.MSTJ(28).GE.1) THEN | |
3112 | ||
3113 | C...Starting values for pointers and momenta. | |
3114 | ITAU=IP | |
3115 | DO 110 J=1,4 | |
3116 | PTAU(J)=P(ITAU,J) | |
3117 | PCMTAU(J)=P(ITAU,J) | |
3118 | 110 CONTINUE | |
3119 | ||
3120 | C...Iterate to find position and code of mother of tau. | |
3121 | IMTAU=ITAU | |
3122 | 120 IMTAU=K(IMTAU,3) | |
3123 | ||
3124 | IF(IMTAU.EQ.0) THEN | |
3125 | C...If no known origin then impossible to do anything further. | |
3126 | KFORIG=0 | |
3127 | IORIG=0 | |
3128 | ||
3129 | ELSEIF(K(IMTAU,2).EQ.K(ITAU,2)) THEN | |
3130 | C...If tau -> tau + gamma then add gamma energy and loop. | |
3131 | IF(K(K(IMTAU,4),2).EQ.22) THEN | |
3132 | DO 130 J=1,4 | |
3133 | PCMTAU(J)=PCMTAU(J)+P(K(IMTAU,4),J) | |
3134 | 130 CONTINUE | |
3135 | ELSEIF(K(K(IMTAU,5),2).EQ.22) THEN | |
3136 | DO 140 J=1,4 | |
3137 | PCMTAU(J)=PCMTAU(J)+P(K(IMTAU,5),J) | |
3138 | 140 CONTINUE | |
3139 | ENDIF | |
3140 | GOTO 120 | |
3141 | ||
3142 | ELSEIF(IABS(K(IMTAU,2)).GT.100) THEN | |
3143 | C...If coming from weak decay of hadron then W is not stored in record, | |
3144 | C...but can be reconstructed by adding neutrino momentum. | |
3145 | KFORIG=-ISIGN(24,K(ITAU,2)) | |
3146 | IORIG=0 | |
3147 | DO 160 II=K(IMTAU,4),K(IMTAU,5) | |
3148 | IF(K(II,2)*ISIGN(1,K(ITAU,2)).EQ.-16) THEN | |
3149 | DO 150 J=1,4 | |
3150 | PCMTAU(J)=PCMTAU(J)+P(II,J) | |
3151 | 150 CONTINUE | |
3152 | ENDIF | |
3153 | 160 CONTINUE | |
3154 | ||
3155 | ELSE | |
3156 | C...If coming from resonance decay then find latest copy of this | |
3157 | C...resonance (may not completely agree). | |
3158 | KFORIG=K(IMTAU,2) | |
3159 | IORIG=IMTAU | |
3160 | DO 170 II=IMTAU+1,IP-1 | |
3161 | IF(K(II,2).EQ.KFORIG.AND.K(II,3).EQ.IORIG.AND. | |
3162 | & ABS(P(II,5)-P(IORIG,5)).LT.1E-5*P(IORIG,5)) IORIG=II | |
3163 | 170 CONTINUE | |
3164 | DO 180 J=1,4 | |
3165 | PCMTAU(J)=P(IORIG,J) | |
3166 | 180 CONTINUE | |
3167 | ENDIF | |
3168 | ||
3169 | C...Boost tau to rest frame of production process (where known) | |
3170 | C...and rotate it to sit along +z axis. | |
3171 | DO 190 J=1,3 | |
3172 | DBETAU(J)=PCMTAU(J)/PCMTAU(4) | |
3173 | 190 CONTINUE | |
3174 | IF(KFORIG.NE.0) CALL LUDBRB(ITAU,ITAU,0.,0.,-DBETAU(1), | |
3175 | & -DBETAU(2),-DBETAU(3)) | |
3176 | PHITAU=UYANGL(P(ITAU,1),P(ITAU,2)) | |
3177 | CALL LUDBRB(ITAU,ITAU,0.,-PHITAU,0D0,0D0,0D0) | |
3178 | THETAU=UYANGL(P(ITAU,3),P(ITAU,1)) | |
3179 | CALL LUDBRB(ITAU,ITAU,-THETAU,0.,0D0,0D0,0D0) | |
3180 | ||
3181 | C...Call tau decay routine (if meaningful) and fill extra info. | |
3182 | IF(KFORIG.NE.0.OR.MSTJ(28).EQ.2) THEN | |
3183 | CALL LYTAUD(ITAU,IORIG,KFORIG,NDECAY) | |
3184 | DO 200 II=NSAV+1,NSAV+NDECAY | |
3185 | K(II,1)=1 | |
3186 | K(II,3)=IP | |
3187 | K(II,4)=0 | |
3188 | K(II,5)=0 | |
3189 | 200 CONTINUE | |
3190 | N=NSAV+NDECAY | |
3191 | ENDIF | |
3192 | ||
3193 | C...Boost back decay tau and decay products. | |
3194 | DO 210 J=1,4 | |
3195 | P(ITAU,J)=PTAU(J) | |
3196 | 210 CONTINUE | |
3197 | IF(KFORIG.NE.0.OR.MSTJ(28).EQ.2) THEN | |
3198 | CALL LUDBRB(NSAV+1,N,THETAU,PHITAU,0D0,0D0,0D0) | |
3199 | IF(KFORIG.NE.0) CALL LUDBRB(NSAV+1,N,0.,0.,DBETAU(1), | |
3200 | & DBETAU(2),DBETAU(3)) | |
3201 | ||
3202 | C...Skip past ordinary tau decay treatment. | |
3203 | MMAT=0 | |
3204 | MBST=0 | |
3205 | ND=0 | |
3206 | GOTO 660 | |
3207 | ENDIF | |
3208 | ENDIF | |
3209 | ||
3210 | C...B-B~ mixing: flip sign of meson appropriately. | |
3211 | MMIX=0 | |
3212 | IF((KFA.EQ.511.OR.KFA.EQ.531).AND.MSTJ(26).GE.1) THEN | |
3213 | XBBMIX=PARJ(76) | |
3214 | IF(KFA.EQ.531) XBBMIX=PARJ(77) | |
3215 | IF(SIN(0.5*XBBMIX*V(IP,5)/PMAS(KC,4))**2.GT.RLY(0)) MMIX=1 | |
3216 | IF(MMIX.EQ.1) KFS=-KFS | |
3217 | ENDIF | |
3218 | ||
3219 | C...Check existence of decay channels. Particle/antiparticle rules. | |
3220 | KCA=KC | |
3221 | IF(MDCY(KC,2).GT.0) THEN | |
3222 | MDMDCY=MDME(MDCY(KC,2),2) | |
3223 | IF(MDMDCY.GT.80.AND.MDMDCY.LE.90) KCA=MDMDCY | |
3224 | ENDIF | |
3225 | IF(MDCY(KCA,2).LE.0.OR.MDCY(KCA,3).LE.0) THEN | |
3226 | CALL LYERRM(9,'(LYDECY:) no decay channel defined') | |
3227 | RETURN | |
3228 | ENDIF | |
3229 | IF(MOD(KFA/1000,10).EQ.0.AND.(KCA.EQ.85.OR.KCA.EQ.87)) KFS=-KFS | |
3230 | IF(KCHG(KC,3).EQ.0) THEN | |
3231 | KFSP=1 | |
3232 | KFSN=0 | |
3233 | IF(RLY(0).GT.0.5) KFS=-KFS | |
3234 | ELSEIF(KFS.GT.0) THEN | |
3235 | KFSP=1 | |
3236 | KFSN=0 | |
3237 | ELSE | |
3238 | KFSP=0 | |
3239 | KFSN=1 | |
3240 | ENDIF | |
3241 | ||
3242 | C...Sum branching ratios of allowed decay channels. | |
3243 | 220 NOPE=0 | |
3244 | BRSU=0. | |
3245 | DO 230 IDL=MDCY(KCA,2),MDCY(KCA,2)+MDCY(KCA,3)-1 | |
3246 | IF(MDME(IDL,1).NE.1.AND.KFSP*MDME(IDL,1).NE.2.AND. | |
3247 | &KFSN*MDME(IDL,1).NE.3) GOTO 230 | |
3248 | IF(MDME(IDL,2).GT.100) GOTO 230 | |
3249 | NOPE=NOPE+1 | |
3250 | BRSU=BRSU+BRAT(IDL) | |
3251 | 230 CONTINUE | |
3252 | IF(NOPE.EQ.0) THEN | |
3253 | CALL LYERRM(2,'(LYDECY:) all decay channels closed by user') | |
3254 | RETURN | |
3255 | ENDIF | |
3256 | ||
3257 | C...Select decay channel among allowed ones. | |
3258 | 240 RBR=BRSU*RLY(0) | |
3259 | IDL=MDCY(KCA,2)-1 | |
3260 | 250 IDL=IDL+1 | |
3261 | IF(MDME(IDL,1).NE.1.AND.KFSP*MDME(IDL,1).NE.2.AND. | |
3262 | &KFSN*MDME(IDL,1).NE.3) THEN | |
3263 | IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1) GOTO 250 | |
3264 | ELSEIF(MDME(IDL,2).GT.100) THEN | |
3265 | IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1) GOTO 250 | |
3266 | ELSE | |
3267 | IDC=IDL | |
3268 | RBR=RBR-BRAT(IDL) | |
3269 | IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1.AND.RBR.GT.0.) GOTO 250 | |
3270 | ENDIF | |
3271 | ||
3272 | C...Start readout of decay channel: matrix element, reset counters. | |
3273 | MMAT=MDME(IDC,2) | |
3274 | 260 NTRY=NTRY+1 | |
3275 | IF(NTRY.GT.1000) THEN | |
3276 | CALL LYERRM(14,'(LYDECY:) caught in infinite loop') | |
3277 | IF(MSTU(21).GE.1) RETURN | |
3278 | ENDIF | |
3279 | I=N | |
3280 | NP=0 | |
3281 | NQ=0 | |
3282 | MBST=0 | |
3283 | IF(MMAT.GE.11.AND.MMAT.NE.46.AND.P(IP,4).GT.20.*P(IP,5)) MBST=1 | |
3284 | DO 270 J=1,4 | |
3285 | PV(1,J)=0. | |
3286 | IF(MBST.EQ.0) PV(1,J)=P(IP,J) | |
3287 | 270 CONTINUE | |
3288 | IF(MBST.EQ.1) PV(1,4)=P(IP,5) | |
3289 | PV(1,5)=P(IP,5) | |
3290 | PS=0. | |
3291 | PSQ=0. | |
3292 | MREM=0 | |
3293 | MHADDY=0 | |
3294 | IF(KFA.GT.80) MHADDY=1 | |
3295 | ||
3296 | C...Read out decay products. Convert to standard flavour code. | |
3297 | JTMAX=5 | |
3298 | IF(MDME(IDC+1,2).EQ.101) JTMAX=10 | |
3299 | DO 280 JT=1,JTMAX | |
3300 | IF(JT.LE.5) KP=KFDP(IDC,JT) | |
3301 | IF(JT.GE.6) KP=KFDP(IDC+1,JT-5) | |
3302 | IF(KP.EQ.0) GOTO 280 | |
3303 | KPA=IABS(KP) | |
3304 | KCP=LYCOMP(KPA) | |
3305 | IF(KPA.GT.80) MHADDY=1 | |
3306 | IF(KCHG(KCP,3).EQ.0.AND.KPA.NE.81.AND.KPA.NE.82) THEN | |
3307 | KFP=KP | |
3308 | ELSEIF(KPA.NE.81.AND.KPA.NE.82) THEN | |
3309 | KFP=KFS*KP | |
3310 | ELSEIF(KPA.EQ.81.AND.MOD(KFA/1000,10).EQ.0) THEN | |
3311 | KFP=-KFS*MOD(KFA/10,10) | |
3312 | ELSEIF(KPA.EQ.81.AND.MOD(KFA/100,10).GE.MOD(KFA/10,10)) THEN | |
3313 | KFP=KFS*(100*MOD(KFA/10,100)+3) | |
3314 | ELSEIF(KPA.EQ.81) THEN | |
3315 | KFP=KFS*(1000*MOD(KFA/10,10)+100*MOD(KFA/100,10)+1) | |
3316 | ELSEIF(KP.EQ.82) THEN | |
3317 | CALL LYKFDI(-KFS*INT(1.+(2.+PARJ(2))*RLY(0)),0,KFP,KDUMP) | |
3318 | IF(KFP.EQ.0) GOTO 260 | |
3319 | MSTJ(93)=1 | |
3320 | IF(PV(1,5).LT.PARJ(32)+2.*UYMASS(KFP)) GOTO 260 | |
3321 | ELSEIF(KP.EQ.-82) THEN | |
3322 | KFP=-KFP | |
3323 | IF(IABS(KFP).GT.10) KFP=KFP+ISIGN(10000,KFP) | |
3324 | ENDIF | |
3325 | IF(KPA.EQ.81.OR.KPA.EQ.82) KCP=LYCOMP(KFP) | |
3326 | ||
3327 | C...Add decay product to event record or to quark flavour list. | |
3328 | KFPA=IABS(KFP) | |
3329 | KQP=KCHG(KCP,2) | |
3330 | IF(MMAT.GE.11.AND.MMAT.LE.30.AND.KQP.NE.0) THEN | |
3331 | NQ=NQ+1 | |
3332 | KFLO(NQ)=KFP | |
3333 | MSTJ(93)=2 | |
3334 | PSQ=PSQ+UYMASS(KFLO(NQ)) | |
3335 | ELSEIF((MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.48).AND.NP.EQ.3.AND. | |
3336 | &MOD(NQ,2).EQ.1) THEN | |
3337 | NQ=NQ-1 | |
3338 | PS=PS-P(I,5) | |
3339 | K(I,1)=1 | |
3340 | KFI=K(I,2) | |
3341 | CALL LYKFDI(KFP,KFI,KFLDMP,K(I,2)) | |
3342 | IF(K(I,2).EQ.0) GOTO 260 | |
3343 | MSTJ(93)=1 | |
3344 | P(I,5)=UYMASS(K(I,2)) | |
3345 | PS=PS+P(I,5) | |
3346 | ELSE | |
3347 | I=I+1 | |
3348 | NP=NP+1 | |
3349 | IF(MMAT.NE.33.AND.KQP.NE.0) NQ=NQ+1 | |
3350 | IF(MMAT.EQ.33.AND.KQP.NE.0.AND.KQP.NE.2) NQ=NQ+1 | |
3351 | K(I,1)=1+MOD(NQ,2) | |
3352 | IF(MMAT.EQ.4.AND.JT.LE.2.AND.KFP.EQ.21) K(I,1)=2 | |
3353 | IF(MMAT.EQ.4.AND.JT.EQ.3) K(I,1)=1 | |
3354 | K(I,2)=KFP | |
3355 | K(I,3)=IP | |
3356 | K(I,4)=0 | |
3357 | K(I,5)=0 | |
3358 | P(I,5)=UYMASS(KFP) | |
3359 | IF(MMAT.EQ.45.AND.KFPA.EQ.89) P(I,5)=PARJ(32) | |
3360 | PS=PS+P(I,5) | |
3361 | ENDIF | |
3362 | 280 CONTINUE | |
3363 | ||
3364 | C...Check masses for resonance decays. | |
3365 | IF(MHADDY.EQ.0) THEN | |
3366 | IF(PS+PARJ(64).GT.PV(1,5)) GOTO 240 | |
3367 | ENDIF | |
3368 | ||
3369 | C...Choose decay multiplicity in phase space model. | |
3370 | 290 IF(MMAT.GE.11.AND.MMAT.LE.30) THEN | |
3371 | PSP=PS | |
3372 | CNDE=PARJ(61)*LOG(MAX((PV(1,5)-PS-PSQ)/PARJ(62),1.1)) | |
3373 | IF(MMAT.EQ.12) CNDE=CNDE+PARJ(63) | |
3374 | 300 NTRY=NTRY+1 | |
3375 | IF(NTRY.GT.1000) THEN | |
3376 | CALL LYERRM(14,'(LYDECY:) caught in infinite loop') | |
3377 | IF(MSTU(21).GE.1) RETURN | |
3378 | ENDIF | |
3379 | IF(MMAT.LE.20) THEN | |
3380 | GAUSS=SQRT(-2.*CNDE*LOG(MAX(1E-10,RLY(0))))* | |
3381 | & SIN(PARU(2)*RLY(0)) | |
3382 | ND=0.5+0.5*NP+0.25*NQ+CNDE+GAUSS | |
3383 | IF(ND.LT.NP+NQ/2.OR.ND.LT.2.OR.ND.GT.10) GOTO 300 | |
3384 | IF(MMAT.EQ.13.AND.ND.EQ.2) GOTO 300 | |
3385 | IF(MMAT.EQ.14.AND.ND.LE.3) GOTO 300 | |
3386 | IF(MMAT.EQ.15.AND.ND.LE.4) GOTO 300 | |
3387 | ELSE | |
3388 | ND=MMAT-20 | |
3389 | ENDIF | |
3390 | ||
3391 | C...Form hadrons from flavour content. | |
3392 | DO 310 JT=1,4 | |
3393 | KFL1(JT)=KFLO(JT) | |
3394 | 310 CONTINUE | |
3395 | IF(ND.EQ.NP+NQ/2) GOTO 330 | |
3396 | DO 320 I=N+NP+1,N+ND-NQ/2 | |
3397 | JT=1+INT((NQ-1)*RLY(0)) | |
3398 | CALL LYKFDI(KFL1(JT),0,KFL2,K(I,2)) | |
3399 | IF(K(I,2).EQ.0) GOTO 300 | |
3400 | KFL1(JT)=-KFL2 | |
3401 | 320 CONTINUE | |
3402 | 330 JT=2 | |
3403 | JT2=3 | |
3404 | JT3=4 | |
3405 | IF(NQ.EQ.4.AND.RLY(0).LT.PARJ(66)) JT=4 | |
3406 | IF(JT.EQ.4.AND.ISIGN(1,KFL1(1)*(10-IABS(KFL1(1))))* | |
3407 | & ISIGN(1,KFL1(JT)*(10-IABS(KFL1(JT)))).GT.0) JT=3 | |
3408 | IF(JT.EQ.3) JT2=2 | |
3409 | IF(JT.EQ.4) JT3=2 | |
3410 | CALL LYKFDI(KFL1(1),KFL1(JT),KFLDMP,K(N+ND-NQ/2+1,2)) | |
3411 | IF(K(N+ND-NQ/2+1,2).EQ.0) GOTO 300 | |
3412 | IF(NQ.EQ.4) CALL LYKFDI(KFL1(JT2),KFL1(JT3),KFLDMP,K(N+ND,2)) | |
3413 | IF(NQ.EQ.4.AND.K(N+ND,2).EQ.0) GOTO 300 | |
3414 | ||
3415 | C...Check that sum of decay product masses not too large. | |
3416 | PS=PSP | |
3417 | DO 340 I=N+NP+1,N+ND | |
3418 | K(I,1)=1 | |
3419 | K(I,3)=IP | |
3420 | K(I,4)=0 | |
3421 | K(I,5)=0 | |
3422 | P(I,5)=UYMASS(K(I,2)) | |
3423 | PS=PS+P(I,5) | |
3424 | 340 CONTINUE | |
3425 | IF(PS+PARJ(64).GT.PV(1,5)) GOTO 300 | |
3426 | ||
3427 | C...Rescale energy to subtract off spectator quark mass. | |
3428 | ELSEIF((MMAT.EQ.31.OR.MMAT.EQ.33.OR.MMAT.EQ.44.OR.MMAT.EQ.45) | |
3429 | &.AND.NP.GE.3) THEN | |
3430 | PS=PS-P(N+NP,5) | |
3431 | PQT=(P(N+NP,5)+PARJ(65))/PV(1,5) | |
3432 | DO 350 J=1,5 | |
3433 | P(N+NP,J)=PQT*PV(1,J) | |
3434 | PV(1,J)=(1.-PQT)*PV(1,J) | |
3435 | 350 CONTINUE | |
3436 | IF(PS+PARJ(64).GT.PV(1,5)) GOTO 260 | |
3437 | ND=NP-1 | |
3438 | MREM=1 | |
3439 | ||
3440 | C...Phase space factors imposed in W decay. | |
3441 | ELSEIF(MMAT.EQ.46) THEN | |
3442 | MSTJ(93)=1 | |
3443 | PSMC=UYMASS(K(N+1,2)) | |
3444 | MSTJ(93)=1 | |
3445 | PSMC=PSMC+UYMASS(K(N+2,2)) | |
3446 | IF(MAX(PS,PSMC)+PARJ(32).GT.PV(1,5)) GOTO 240 | |
3447 | HR1=(P(N+1,5)/PV(1,5))**2 | |
3448 | HR2=(P(N+2,5)/PV(1,5))**2 | |
3449 | IF((1.-HR1-HR2)*(2.+HR1+HR2)*SQRT((1.-HR1-HR2)**2-4.*HR1*HR2) | |
3450 | & .LT.2.*RLY(0)) GOTO 240 | |
3451 | ND=NP | |
3452 | ||
3453 | C...Fully specified final state: check mass broadening effects. | |
3454 | ELSE | |
3455 | IF(NP.GE.2.AND.PS+PARJ(64).GT.PV(1,5)) GOTO 260 | |
3456 | ND=NP | |
3457 | ENDIF | |
3458 | ||
3459 | C...Select W mass in decay Q -> W + q, without W propagator. | |
3460 | IF(MMAT.EQ.45.AND.MSTJ(25).LE.0) THEN | |
3461 | HLQ=(PARJ(32)/PV(1,5))**2 | |
3462 | HUQ=(1.-(P(N+2,5)+PARJ(64))/PV(1,5))**2 | |
3463 | HRQ=(P(N+2,5)/PV(1,5))**2 | |
3464 | 360 HW=HLQ+RLY(0)*(HUQ-HLQ) | |
3465 | IF(HMEPS(HW).LT.RLY(0)) GOTO 360 | |
3466 | P(N+1,5)=PV(1,5)*SQRT(HW) | |
3467 | ||
3468 | C...Ditto, including W propagator. Divide mass range into three regions. | |
3469 | ELSEIF(MMAT.EQ.45) THEN | |
3470 | HQW=(PV(1,5)/PMAS(24,1))**2 | |
3471 | HLW=(PARJ(32)/PMAS(24,1))**2 | |
3472 | HUW=((PV(1,5)-P(N+2,5)-PARJ(64))/PMAS(24,1))**2 | |
3473 | HRQ=(P(N+2,5)/PV(1,5))**2 | |
3474 | HG=PMAS(24,2)/PMAS(24,1) | |
3475 | HATL=ATAN((HLW-1.)/HG) | |
3476 | HM=MIN(1.,HUW-0.001) | |
3477 | HMV1=HMEPS(HM/HQW)/((HM-1.)**2+HG**2) | |
3478 | 370 HM=HM-HG | |
3479 | HMV2=HMEPS(HM/HQW)/((HM-1.)**2+HG**2) | |
3480 | IF(HMV2.GT.HMV1.AND.HM-HG.GT.HLW) THEN | |
3481 | HMV1=HMV2 | |
3482 | GOTO 370 | |
3483 | ENDIF | |
3484 | HMV=MIN(2.*HMV1,HMEPS(HM/HQW)/HG**2) | |
3485 | HM1=1.-SQRT(1./HMV-HG**2) | |
3486 | IF(HM1.GT.HLW.AND.HM1.LT.HM) THEN | |
3487 | HM=HM1 | |
3488 | ELSEIF(HMV2.LE.HMV1) THEN | |
3489 | HM=MAX(HLW,HM-MIN(0.1,1.-HM)) | |
3490 | ENDIF | |
3491 | HATM=ATAN((HM-1.)/HG) | |
3492 | HWT1=(HATM-HATL)/HG | |
3493 | HWT2=HMV*(MIN(1.,HUW)-HM) | |
3494 | HWT3=0. | |
3495 | IF(HUW.GT.1.) THEN | |
3496 | HATU=ATAN((HUW-1.)/HG) | |
3497 | HMP1=HMEPS(1./HQW) | |
3498 | HWT3=HMP1*HATU/HG | |
3499 | ENDIF | |
3500 | ||
3501 | C...Select mass region and W mass there. Accept according to weight. | |
3502 | 380 HREG=RLY(0)*(HWT1+HWT2+HWT3) | |
3503 | IF(HREG.LE.HWT1) THEN | |
3504 | HW=1.+HG*TAN(HATL+RLY(0)*(HATM-HATL)) | |
3505 | HACC=HMEPS(HW/HQW) | |
3506 | ELSEIF(HREG.LE.HWT1+HWT2) THEN | |
3507 | HW=HM+RLY(0)*(MIN(1.,HUW)-HM) | |
3508 | HACC=HMEPS(HW/HQW)/((HW-1.)**2+HG**2)/HMV | |
3509 | ELSE | |
3510 | HW=1.+HG*TAN(RLY(0)*HATU) | |
3511 | HACC=HMEPS(HW/HQW)/HMP1 | |
3512 | ENDIF | |
3513 | IF(HACC.LT.RLY(0)) GOTO 380 | |
3514 | P(N+1,5)=PMAS(24,1)*SQRT(HW) | |
3515 | ENDIF | |
3516 | ||
3517 | C...Determine position of grandmother, number of sisters, Q -> W sign. | |
3518 | NM=0 | |
3519 | KFAS=0 | |
3520 | MSGN=0 | |
3521 | IF(MMAT.EQ.3.OR.MMAT.EQ.46) THEN | |
3522 | IM=K(IP,3) | |
3523 | IF(IM.LT.0.OR.IM.GE.IP) IM=0 | |
3524 | IF(MMAT.EQ.46.AND.MSTJ(27).EQ.1) THEN | |
3525 | IM=0 | |
3526 | ELSEIF(MMAT.EQ.46.AND.MSTJ(27).GE.2.AND.IM.NE.0) THEN | |
3527 | IF(K(IM,2).EQ.94) THEN | |
3528 | IM=K(K(IM,3),3) | |
3529 | IF(IM.LT.0.OR.IM.GE.IP) IM=0 | |
3530 | ENDIF | |
3531 | ENDIF | |
3532 | IF(IM.NE.0) KFAM=IABS(K(IM,2)) | |
3533 | IF(IM.NE.0.AND.MMAT.EQ.3) THEN | |
3534 | DO 390 IL=MAX(IP-2,IM+1),MIN(IP+2,N) | |
3535 | IF(K(IL,3).EQ.IM) NM=NM+1 | |
3536 | IF(K(IL,3).EQ.IM.AND.IL.NE.IP) ISIS=IL | |
3537 | 390 CONTINUE | |
3538 | IF(NM.NE.2.OR.KFAM.LE.100.OR.MOD(KFAM,10).NE.1.OR. | |
3539 | & MOD(KFAM/1000,10).NE.0) NM=0 | |
3540 | IF(NM.EQ.2) THEN | |
3541 | KFAS=IABS(K(ISIS,2)) | |
3542 | IF((KFAS.LE.100.OR.MOD(KFAS,10).NE.1.OR. | |
3543 | & MOD(KFAS/1000,10).NE.0).AND.KFAS.NE.22) NM=0 | |
3544 | ENDIF | |
3545 | ELSEIF(IM.NE.0.AND.MMAT.EQ.46) THEN | |
3546 | MSGN=ISIGN(1,K(IM,2)*K(IP,2)) | |
3547 | IF(KFAM.GT.100.AND.MOD(KFAM/1000,10).EQ.0) MSGN= | |
3548 | & MSGN*(-1)**MOD(KFAM/100,10) | |
3549 | ENDIF | |
3550 | ENDIF | |
3551 | ||
3552 | C...Kinematics of one-particle decays. | |
3553 | IF(ND.EQ.1) THEN | |
3554 | DO 400 J=1,4 | |
3555 | P(N+1,J)=P(IP,J) | |
3556 | 400 CONTINUE | |
3557 | GOTO 660 | |
3558 | ENDIF | |
3559 | ||
3560 | C...Calculate maximum weight ND-particle decay. | |
3561 | PV(ND,5)=P(N+ND,5) | |
3562 | IF(ND.GE.3) THEN | |
3563 | WTMAX=1./WTCOR(ND-2) | |
3564 | PMAX=PV(1,5)-PS+P(N+ND,5) | |
3565 | PMIN=0. | |
3566 | DO 410 IL=ND-1,1,-1 | |
3567 | PMAX=PMAX+P(N+IL,5) | |
3568 | PMIN=PMIN+P(N+IL+1,5) | |
3569 | WTMAX=WTMAX*PAWT(PMAX,PMIN,P(N+IL,5)) | |
3570 | 410 CONTINUE | |
3571 | ENDIF | |
3572 | ||
3573 | C...Find virtual gamma mass in Dalitz decay. | |
3574 | 420 IF(ND.EQ.2) THEN | |
3575 | ELSEIF(MMAT.EQ.2) THEN | |
3576 | PMES=4.*PMAS(11,1)**2 | |
3577 | PMRHO2=PMAS(131,1)**2 | |
3578 | PGRHO2=PMAS(131,2)**2 | |
3579 | 430 PMST=PMES*(P(IP,5)**2/PMES)**RLY(0) | |
3580 | WT=(1+0.5*PMES/PMST)*SQRT(MAX(0.,1.-PMES/PMST))* | |
3581 | & (1.-PMST/P(IP,5)**2)**3*(1.+PGRHO2/PMRHO2)/ | |
3582 | & ((1.-PMST/PMRHO2)**2+PGRHO2/PMRHO2) | |
3583 | IF(WT.LT.RLY(0)) GOTO 430 | |
3584 | PV(2,5)=MAX(2.00001*PMAS(11,1),SQRT(PMST)) | |
3585 | ||
3586 | C...M-generator gives weight. If rejected, try again. | |
3587 | ELSE | |
3588 | 440 RORD(1)=1. | |
3589 | DO 470 IL1=2,ND-1 | |
3590 | RSAV=RLY(0) | |
3591 | DO 450 IL2=IL1-1,1,-1 | |
3592 | IF(RSAV.LE.RORD(IL2)) GOTO 460 | |
3593 | RORD(IL2+1)=RORD(IL2) | |
3594 | 450 CONTINUE | |
3595 | 460 RORD(IL2+1)=RSAV | |
3596 | 470 CONTINUE | |
3597 | RORD(ND)=0. | |
3598 | WT=1. | |
3599 | DO 480 IL=ND-1,1,-1 | |
3600 | PV(IL,5)=PV(IL+1,5)+P(N+IL,5)+(RORD(IL)-RORD(IL+1))*(PV(1,5)-PS) | |
3601 | WT=WT*PAWT(PV(IL,5),PV(IL+1,5),P(N+IL,5)) | |
3602 | 480 CONTINUE | |
3603 | IF(WT.LT.RLY(0)*WTMAX) GOTO 440 | |
3604 | ENDIF | |
3605 | ||
3606 | C...Perform two-particle decays in respective CM frame. | |
3607 | 490 DO 510 IL=1,ND-1 | |
3608 | PA=PAWT(PV(IL,5),PV(IL+1,5),P(N+IL,5)) | |
3609 | UE(3)=2.*RLY(0)-1. | |
3610 | PHI=PARU(2)*RLY(0) | |
3611 | UE(1)=SQRT(1.-UE(3)**2)*COS(PHI) | |
3612 | UE(2)=SQRT(1.-UE(3)**2)*SIN(PHI) | |
3613 | DO 500 J=1,3 | |
3614 | P(N+IL,J)=PA*UE(J) | |
3615 | PV(IL+1,J)=-PA*UE(J) | |
3616 | 500 CONTINUE | |
3617 | P(N+IL,4)=SQRT(PA**2+P(N+IL,5)**2) | |
3618 | PV(IL+1,4)=SQRT(PA**2+PV(IL+1,5)**2) | |
3619 | 510 CONTINUE | |
3620 | ||
3621 | C...Lorentz transform decay products to lab frame. | |
3622 | DO 520 J=1,4 | |
3623 | P(N+ND,J)=PV(ND,J) | |
3624 | 520 CONTINUE | |
3625 | DO 560 IL=ND-1,1,-1 | |
3626 | DO 530 J=1,3 | |
3627 | BE(J)=PV(IL,J)/PV(IL,4) | |
3628 | 530 CONTINUE | |
3629 | GA=PV(IL,4)/PV(IL,5) | |
3630 | DO 550 I=N+IL,N+ND | |
3631 | BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3) | |
3632 | DO 540 J=1,3 | |
3633 | P(I,J)=P(I,J)+GA*(GA*BEP/(1.+GA)+P(I,4))*BE(J) | |
3634 | 540 CONTINUE | |
3635 | P(I,4)=GA*(P(I,4)+BEP) | |
3636 | 550 CONTINUE | |
3637 | 560 CONTINUE | |
3638 | ||
3639 | C...Check that no infinite loop in matrix element weight. | |
3640 | NTRY=NTRY+1 | |
3641 | IF(NTRY.GT.800) GOTO 590 | |
3642 | ||
3643 | C...Matrix elements for omega and phi decays. | |
3644 | IF(MMAT.EQ.1) THEN | |
3645 | WT=(P(N+1,5)*P(N+2,5)*P(N+3,5))**2-(P(N+1,5)*FOUR(N+2,N+3))**2 | |
3646 | & -(P(N+2,5)*FOUR(N+1,N+3))**2-(P(N+3,5)*FOUR(N+1,N+2))**2 | |
3647 | & +2.*FOUR(N+1,N+2)*FOUR(N+1,N+3)*FOUR(N+2,N+3) | |
3648 | IF(MAX(WT*WTCOR(9)/P(IP,5)**6,0.001).LT.RLY(0)) GOTO 420 | |
3649 | ||
3650 | C...Matrix elements for pi0 or eta Dalitz decay to gamma e+ e-. | |
3651 | ELSEIF(MMAT.EQ.2) THEN | |
3652 | FOUR12=FOUR(N+1,N+2) | |
3653 | FOUR13=FOUR(N+1,N+3) | |
3654 | WT=(PMST-0.5*PMES)*(FOUR12**2+FOUR13**2)+ | |
3655 | & PMES*(FOUR12*FOUR13+FOUR12**2+FOUR13**2) | |
3656 | IF(WT.LT.RLY(0)*0.25*PMST*(P(IP,5)**2-PMST)**2) GOTO 490 | |
3657 | ||
3658 | C...Matrix element for S0 -> S1 + V1 -> S1 + S2 + S3 (S scalar, | |
3659 | C...V vector), of form cos**2(theta02) in V1 rest frame, and for | |
3660 | C...S0 -> gamma + V1 -> gamma + S2 + S3, of form sin**2(theta02). | |
3661 | ELSEIF(MMAT.EQ.3.AND.NM.EQ.2) THEN | |
3662 | FOUR10=FOUR(IP,IM) | |
3663 | FOUR12=FOUR(IP,N+1) | |
3664 | FOUR02=FOUR(IM,N+1) | |
3665 | PMS1=P(IP,5)**2 | |
3666 | PMS0=P(IM,5)**2 | |
3667 | PMS2=P(N+1,5)**2 | |
3668 | IF(KFAS.NE.22) HNUM=(FOUR10*FOUR12-PMS1*FOUR02)**2 | |
3669 | IF(KFAS.EQ.22) HNUM=PMS1*(2.*FOUR10*FOUR12*FOUR02- | |
3670 | & PMS1*FOUR02**2-PMS0*FOUR12**2-PMS2*FOUR10**2+PMS1*PMS0*PMS2) | |
3671 | HNUM=MAX(1E-6*PMS1**2*PMS0*PMS2,HNUM) | |
3672 | HDEN=(FOUR10**2-PMS1*PMS0)*(FOUR12**2-PMS1*PMS2) | |
3673 | IF(HNUM.LT.RLY(0)*HDEN) GOTO 490 | |
3674 | ||
3675 | C...Matrix element for "onium" -> g + g + g or gamma + g + g. | |
3676 | ELSEIF(MMAT.EQ.4) THEN | |
3677 | HX1=2.*FOUR(IP,N+1)/P(IP,5)**2 | |
3678 | HX2=2.*FOUR(IP,N+2)/P(IP,5)**2 | |
3679 | HX3=2.*FOUR(IP,N+3)/P(IP,5)**2 | |
3680 | WT=((1.-HX1)/(HX2*HX3))**2+((1.-HX2)/(HX1*HX3))**2+ | |
3681 | & ((1.-HX3)/(HX1*HX2))**2 | |
3682 | IF(WT.LT.2.*RLY(0)) GOTO 420 | |
3683 | IF(K(IP+1,2).EQ.22.AND.(1.-HX1)*P(IP,5)**2.LT.4.*PARJ(32)**2) | |
3684 | & GOTO 420 | |
3685 | ||
3686 | C...Effective matrix element for nu spectrum in tau -> nu + hadrons. | |
3687 | ELSEIF(MMAT.EQ.41) THEN | |
3688 | HX1=2.*FOUR(IP,N+1)/P(IP,5)**2 | |
3689 | HXM=MIN(0.75,2.*(1.-PS/P(IP,5))) | |
3690 | IF(HX1*(3.-2.*HX1).LT.RLY(0)*HXM*(3.-2.*HXM)) GOTO 420 | |
3691 | ||
3692 | C...Matrix elements for weak decays (only semileptonic for c and b) | |
3693 | ELSEIF((MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.44.OR.MMAT.EQ.48) | |
3694 | &.AND.ND.EQ.3) THEN | |
3695 | IF(MBST.EQ.0) WT=FOUR(IP,N+1)*FOUR(N+2,N+3) | |
3696 | IF(MBST.EQ.1) WT=P(IP,5)*P(N+1,4)*FOUR(N+2,N+3) | |
3697 | IF(WT.LT.RLY(0)*P(IP,5)*PV(1,5)**3/WTCOR(10)) GOTO 420 | |
3698 | ELSEIF(MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.44.OR.MMAT.EQ.48) THEN | |
3699 | DO 580 J=1,4 | |
3700 | P(N+NP+1,J)=0. | |
3701 | DO 570 IS=N+3,N+NP | |
3702 | P(N+NP+1,J)=P(N+NP+1,J)+P(IS,J) | |
3703 | 570 CONTINUE | |
3704 | 580 CONTINUE | |
3705 | IF(MBST.EQ.0) WT=FOUR(IP,N+1)*FOUR(N+2,N+NP+1) | |
3706 | IF(MBST.EQ.1) WT=P(IP,5)*P(N+1,4)*FOUR(N+2,N+NP+1) | |
3707 | IF(WT.LT.RLY(0)*P(IP,5)*PV(1,5)**3/WTCOR(10)) GOTO 420 | |
3708 | ||
3709 | C...Angular distribution in W decay. | |
3710 | ELSEIF(MMAT.EQ.46.AND.MSGN.NE.0) THEN | |
3711 | IF(MSGN.GT.0) WT=FOUR(IM,N+1)*FOUR(N+2,IP+1) | |
3712 | IF(MSGN.LT.0) WT=FOUR(IM,N+2)*FOUR(N+1,IP+1) | |
3713 | IF(WT.LT.RLY(0)*P(IM,5)**4/WTCOR(10)) GOTO 490 | |
3714 | ENDIF | |
3715 | ||
3716 | C...Scale back energy and reattach spectator. | |
3717 | 590 IF(MREM.EQ.1) THEN | |
3718 | DO 600 J=1,5 | |
3719 | PV(1,J)=PV(1,J)/(1.-PQT) | |
3720 | 600 CONTINUE | |
3721 | ND=ND+1 | |
3722 | MREM=0 | |
3723 | ENDIF | |
3724 | ||
3725 | C...Low invariant mass for system with spectator quark gives particle, | |
3726 | C...not two jets. Readjust momenta accordingly. | |
3727 | IF((MMAT.EQ.31.OR.MMAT.EQ.45).AND.ND.EQ.3) THEN | |
3728 | MSTJ(93)=1 | |
3729 | PM2=UYMASS(K(N+2,2)) | |
3730 | MSTJ(93)=1 | |
3731 | PM3=UYMASS(K(N+3,2)) | |
3732 | IF(P(N+2,5)**2+P(N+3,5)**2+2.*FOUR(N+2,N+3).GE. | |
3733 | & (PARJ(32)+PM2+PM3)**2) GOTO 660 | |
3734 | K(N+2,1)=1 | |
3735 | KFTEMP=K(N+2,2) | |
3736 | CALL LYKFDI(KFTEMP,K(N+3,2),KFLDMP,K(N+2,2)) | |
3737 | IF(K(N+2,2).EQ.0) GOTO 260 | |
3738 | P(N+2,5)=UYMASS(K(N+2,2)) | |
3739 | PS=P(N+1,5)+P(N+2,5) | |
3740 | PV(2,5)=P(N+2,5) | |
3741 | MMAT=0 | |
3742 | ND=2 | |
3743 | GOTO 490 | |
3744 | ELSEIF(MMAT.EQ.44) THEN | |
3745 | MSTJ(93)=1 | |
3746 | PM3=UYMASS(K(N+3,2)) | |
3747 | MSTJ(93)=1 | |
3748 | PM4=UYMASS(K(N+4,2)) | |
3749 | IF(P(N+3,5)**2+P(N+4,5)**2+2.*FOUR(N+3,N+4).GE. | |
3750 | & (PARJ(32)+PM3+PM4)**2) GOTO 630 | |
3751 | K(N+3,1)=1 | |
3752 | KFTEMP=K(N+3,2) | |
3753 | CALL LYKFDI(KFTEMP,K(N+4,2),KFLDMP,K(N+3,2)) | |
3754 | IF(K(N+3,2).EQ.0) GOTO 260 | |
3755 | P(N+3,5)=UYMASS(K(N+3,2)) | |
3756 | DO 610 J=1,3 | |
3757 | P(N+3,J)=P(N+3,J)+P(N+4,J) | |
3758 | 610 CONTINUE | |
3759 | P(N+3,4)=SQRT(P(N+3,1)**2+P(N+3,2)**2+P(N+3,3)**2+P(N+3,5)**2) | |
3760 | HA=P(N+1,4)**2-P(N+2,4)**2 | |
3761 | HB=HA-(P(N+1,5)**2-P(N+2,5)**2) | |
3762 | HC=(P(N+1,1)-P(N+2,1))**2+(P(N+1,2)-P(N+2,2))**2+ | |
3763 | & (P(N+1,3)-P(N+2,3))**2 | |
3764 | HD=(PV(1,4)-P(N+3,4))**2 | |
3765 | HE=HA**2-2.*HD*(P(N+1,4)**2+P(N+2,4)**2)+HD**2 | |
3766 | HF=HD*HC-HB**2 | |
3767 | HG=HD*HC-HA*HB | |
3768 | HH=(SQRT(HG**2+HE*HF)-HG)/(2.*HF) | |
3769 | DO 620 J=1,3 | |
3770 | PCOR=HH*(P(N+1,J)-P(N+2,J)) | |
3771 | P(N+1,J)=P(N+1,J)+PCOR | |
3772 | P(N+2,J)=P(N+2,J)-PCOR | |
3773 | 620 CONTINUE | |
3774 | P(N+1,4)=SQRT(P(N+1,1)**2+P(N+1,2)**2+P(N+1,3)**2+P(N+1,5)**2) | |
3775 | P(N+2,4)=SQRT(P(N+2,1)**2+P(N+2,2)**2+P(N+2,3)**2+P(N+2,5)**2) | |
3776 | ND=ND-1 | |
3777 | ENDIF | |
3778 | ||
3779 | C...Check invariant mass of W jets. May give one particle or start over. | |
3780 | 630 IF((MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.44.OR.MMAT.EQ.48) | |
3781 | &.AND.IABS(K(N+1,2)).LT.10) THEN | |
3782 | PMR=SQRT(MAX(0.,P(N+1,5)**2+P(N+2,5)**2+2.*FOUR(N+1,N+2))) | |
3783 | MSTJ(93)=1 | |
3784 | PM1=UYMASS(K(N+1,2)) | |
3785 | MSTJ(93)=1 | |
3786 | PM2=UYMASS(K(N+2,2)) | |
3787 | IF(PMR.GT.PARJ(32)+PM1+PM2) GOTO 640 | |
3788 | KFLDUM=INT(1.5+RLY(0)) | |
3789 | CALL LYKFDI(K(N+1,2),-ISIGN(KFLDUM,K(N+1,2)),KFLDMP,KF1) | |
3790 | CALL LYKFDI(K(N+2,2),-ISIGN(KFLDUM,K(N+2,2)),KFLDMP,KF2) | |
3791 | IF(KF1.EQ.0.OR.KF2.EQ.0) GOTO 260 | |
3792 | PSM=UYMASS(KF1)+UYMASS(KF2) | |
3793 | IF((MMAT.EQ.42.OR.MMAT.EQ.48).AND.PMR.GT.PARJ(64)+PSM) GOTO 640 | |
3794 | IF(MMAT.GE.43.AND.PMR.GT.0.2*PARJ(32)+PSM) GOTO 640 | |
3795 | IF(MMAT.EQ.48) GOTO 420 | |
3796 | IF(ND.EQ.4.OR.KFA.EQ.15) GOTO 260 | |
3797 | K(N+1,1)=1 | |
3798 | KFTEMP=K(N+1,2) | |
3799 | CALL LYKFDI(KFTEMP,K(N+2,2),KFLDMP,K(N+1,2)) | |
3800 | IF(K(N+1,2).EQ.0) GOTO 260 | |
3801 | P(N+1,5)=UYMASS(K(N+1,2)) | |
3802 | K(N+2,2)=K(N+3,2) | |
3803 | P(N+2,5)=P(N+3,5) | |
3804 | PS=P(N+1,5)+P(N+2,5) | |
3805 | IF(PS+PARJ(64).GT.PV(1,5)) GOTO 260 | |
3806 | PV(2,5)=P(N+3,5) | |
3807 | MMAT=0 | |
3808 | ND=2 | |
3809 | GOTO 490 | |
3810 | ENDIF | |
3811 | ||
3812 | C...Phase space decay of partons from W decay. | |
3813 | 640 IF((MMAT.EQ.42.OR.MMAT.EQ.48).AND.IABS(K(N+1,2)).LT.10) THEN | |
3814 | KFLO(1)=K(N+1,2) | |
3815 | KFLO(2)=K(N+2,2) | |
3816 | K(N+1,1)=K(N+3,1) | |
3817 | K(N+1,2)=K(N+3,2) | |
3818 | DO 650 J=1,5 | |
3819 | PV(1,J)=P(N+1,J)+P(N+2,J) | |
3820 | P(N+1,J)=P(N+3,J) | |
3821 | 650 CONTINUE | |
3822 | PV(1,5)=PMR | |
3823 | N=N+1 | |
3824 | NP=0 | |
3825 | NQ=2 | |
3826 | PS=0. | |
3827 | MSTJ(93)=2 | |
3828 | PSQ=UYMASS(KFLO(1)) | |
3829 | MSTJ(93)=2 | |
3830 | PSQ=PSQ+UYMASS(KFLO(2)) | |
3831 | MMAT=11 | |
3832 | GOTO 290 | |
3833 | ENDIF | |
3834 | ||
3835 | C...Boost back for rapidly moving particle. | |
3836 | 660 N=N+ND | |
3837 | IF(MBST.EQ.1) THEN | |
3838 | DO 670 J=1,3 | |
3839 | BE(J)=P(IP,J)/P(IP,4) | |
3840 | 670 CONTINUE | |
3841 | GA=P(IP,4)/P(IP,5) | |
3842 | DO 690 I=NSAV+1,N | |
3843 | BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3) | |
3844 | DO 680 J=1,3 | |
3845 | P(I,J)=P(I,J)+GA*(GA*BEP/(1.+GA)+P(I,4))*BE(J) | |
3846 | 680 CONTINUE | |
3847 | P(I,4)=GA*(P(I,4)+BEP) | |
3848 | 690 CONTINUE | |
3849 | ENDIF | |
3850 | ||
3851 | C...Fill in position of decay vertex. | |
3852 | DO 710 I=NSAV+1,N | |
3853 | DO 700 J=1,4 | |
3854 | V(I,J)=VDCY(J) | |
3855 | 700 CONTINUE | |
3856 | V(I,5)=0. | |
3857 | 710 CONTINUE | |
3858 | ||
3859 | C...Set up for parton shower evolution from jets. | |
3860 | IF(MSTJ(23).GE.1.AND.MMAT.EQ.4.AND.K(NSAV+1,2).EQ.21) THEN | |
3861 | K(NSAV+1,1)=3 | |
3862 | K(NSAV+2,1)=3 | |
3863 | K(NSAV+3,1)=3 | |
3864 | K(NSAV+1,4)=MSTU(5)*(NSAV+2) | |
3865 | K(NSAV+1,5)=MSTU(5)*(NSAV+3) | |
3866 | K(NSAV+2,4)=MSTU(5)*(NSAV+3) | |
3867 | K(NSAV+2,5)=MSTU(5)*(NSAV+1) | |
3868 | K(NSAV+3,4)=MSTU(5)*(NSAV+1) | |
3869 | K(NSAV+3,5)=MSTU(5)*(NSAV+2) | |
3870 | MSTJ(92)=-(NSAV+1) | |
3871 | ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.4) THEN | |
3872 | K(NSAV+2,1)=3 | |
3873 | K(NSAV+3,1)=3 | |
3874 | K(NSAV+2,4)=MSTU(5)*(NSAV+3) | |
3875 | K(NSAV+2,5)=MSTU(5)*(NSAV+3) | |
3876 | K(NSAV+3,4)=MSTU(5)*(NSAV+2) | |
3877 | K(NSAV+3,5)=MSTU(5)*(NSAV+2) | |
3878 | MSTJ(92)=NSAV+2 | |
3879 | ELSEIF(MSTJ(23).GE.1.AND.(MMAT.EQ.32.OR.MMAT.EQ.44.OR.MMAT.EQ.46) | |
3880 | &.AND.IABS(K(NSAV+1,2)).LE.10.AND.IABS(K(NSAV+2,2)).LE.10) THEN | |
3881 | K(NSAV+1,1)=3 | |
3882 | K(NSAV+2,1)=3 | |
3883 | K(NSAV+1,4)=MSTU(5)*(NSAV+2) | |
3884 | K(NSAV+1,5)=MSTU(5)*(NSAV+2) | |
3885 | K(NSAV+2,4)=MSTU(5)*(NSAV+1) | |
3886 | K(NSAV+2,5)=MSTU(5)*(NSAV+1) | |
3887 | MSTJ(92)=NSAV+1 | |
3888 | ELSEIF(MSTJ(23).GE.1.AND.(MMAT.EQ.32.OR.MMAT.EQ.44.OR.MMAT.EQ.46) | |
3889 | &.AND.IABS(K(NSAV+1,2)).LE.20.AND.IABS(K(NSAV+2,2)).LE.20) THEN | |
3890 | MSTJ(92)=NSAV+1 | |
3891 | ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.33.AND.IABS(K(NSAV+2,2)).EQ.21) | |
3892 | &THEN | |
3893 | K(NSAV+1,1)=3 | |
3894 | K(NSAV+2,1)=3 | |
3895 | K(NSAV+3,1)=3 | |
3896 | KCP=LYCOMP(K(NSAV+1,2)) | |
3897 | KQP=KCHG(KCP,2)*ISIGN(1,K(NSAV+1,2)) | |
3898 | JCON=4 | |
3899 | IF(KQP.LT.0) JCON=5 | |
3900 | K(NSAV+1,JCON)=MSTU(5)*(NSAV+2) | |
3901 | K(NSAV+2,9-JCON)=MSTU(5)*(NSAV+1) | |
3902 | K(NSAV+2,JCON)=MSTU(5)*(NSAV+3) | |
3903 | K(NSAV+3,9-JCON)=MSTU(5)*(NSAV+2) | |
3904 | MSTJ(92)=NSAV+1 | |
3905 | ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.33) THEN | |
3906 | K(NSAV+1,1)=3 | |
3907 | K(NSAV+3,1)=3 | |
3908 | K(NSAV+1,4)=MSTU(5)*(NSAV+3) | |
3909 | K(NSAV+1,5)=MSTU(5)*(NSAV+3) | |
3910 | K(NSAV+3,4)=MSTU(5)*(NSAV+1) | |
3911 | K(NSAV+3,5)=MSTU(5)*(NSAV+1) | |
3912 | MSTJ(92)=NSAV+1 | |
3913 | ||
3914 | C...Set up for parton shower evolution in t -> W + b. | |
3915 | ELSEIF(MSTJ(27).GE.1.AND.MMAT.EQ.45.AND.ND.EQ.3) THEN | |
3916 | K(NSAV+2,1)=3 | |
3917 | K(NSAV+3,1)=3 | |
3918 | K(NSAV+2,4)=MSTU(5)*(NSAV+3) | |
3919 | K(NSAV+2,5)=MSTU(5)*(NSAV+3) | |
3920 | K(NSAV+3,4)=MSTU(5)*(NSAV+2) | |
3921 | K(NSAV+3,5)=MSTU(5)*(NSAV+2) | |
3922 | MSTJ(92)=NSAV+1 | |
3923 | ENDIF | |
3924 | ||
3925 | C...Mark decayed particle; special option for B-B~ mixing. | |
3926 | IF(K(IP,1).EQ.5) K(IP,1)=15 | |
3927 | IF(K(IP,1).LE.10) K(IP,1)=11 | |
3928 | IF(MMIX.EQ.1.AND.MSTJ(26).EQ.2.AND.K(IP,1).EQ.11) K(IP,1)=12 | |
3929 | K(IP,4)=NSAV+1 | |
3930 | K(IP,5)=N | |
3931 | ||
3932 | RETURN | |
3933 | END | |
3934 | ||
3935 | C********************************************************************* | |
3936 | ||
3937 | SUBROUTINE LYKFDI(KFL1,KFL2,KFL3,KF) | |
3938 | ||
3939 | C...Purpose: to generate a new flavour pair and combine off a hadron. | |
3940 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
3941 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
3942 | SAVE /LYDAT1/,/LYDAT2/ | |
3943 | ||
3944 | C...Default flavour values. Input consistency checks. | |
3945 | KF1A=IABS(KFL1) | |
3946 | KF2A=IABS(KFL2) | |
3947 | KFL3=0 | |
3948 | KF=0 | |
3949 | IF(KF1A.EQ.0) RETURN | |
3950 | IF(KF2A.NE.0) THEN | |
3951 | IF(KF1A.LE.10.AND.KF2A.LE.10.AND.KFL1*KFL2.GT.0) RETURN | |
3952 | IF(KF1A.GT.10.AND.KF2A.GT.10) RETURN | |
3953 | IF((KF1A.GT.10.OR.KF2A.GT.10).AND.KFL1*KFL2.LT.0) RETURN | |
3954 | ENDIF | |
3955 | ||
3956 | C...Check if tabulated flavour probabilities are to be used. | |
3957 | IF(MSTJ(15).EQ.1) THEN | |
3958 | KTAB1=-1 | |
3959 | IF(KF1A.GE.1.AND.KF1A.LE.6) KTAB1=KF1A | |
3960 | KFL1A=MOD(KF1A/1000,10) | |
3961 | KFL1B=MOD(KF1A/100,10) | |
3962 | KFL1S=MOD(KF1A,10) | |
3963 | IF(KFL1A.GE.1.AND.KFL1A.LE.4.AND.KFL1B.GE.1.AND.KFL1B.LE.4) | |
3964 | & KTAB1=6+KFL1A*(KFL1A-2)+2*KFL1B+(KFL1S-1)/2 | |
3965 | IF(KFL1A.GE.1.AND.KFL1A.LE.4.AND.KFL1A.EQ.KFL1B) KTAB1=KTAB1-1 | |
3966 | IF(KF1A.GE.1.AND.KF1A.LE.6) KFL1A=KF1A | |
3967 | KTAB2=0 | |
3968 | IF(KF2A.NE.0) THEN | |
3969 | KTAB2=-1 | |
3970 | IF(KF2A.GE.1.AND.KF2A.LE.6) KTAB2=KF2A | |
3971 | KFL2A=MOD(KF2A/1000,10) | |
3972 | KFL2B=MOD(KF2A/100,10) | |
3973 | KFL2S=MOD(KF2A,10) | |
3974 | IF(KFL2A.GE.1.AND.KFL2A.LE.4.AND.KFL2B.GE.1.AND.KFL2B.LE.4) | |
3975 | & KTAB2=6+KFL2A*(KFL2A-2)+2*KFL2B+(KFL2S-1)/2 | |
3976 | IF(KFL2A.GE.1.AND.KFL2A.LE.4.AND.KFL2A.EQ.KFL2B) KTAB2=KTAB2-1 | |
3977 | ENDIF | |
3978 | IF(KTAB1.GE.0.AND.KTAB2.GE.0) GOTO 150 | |
3979 | ENDIF | |
3980 | ||
3981 | C...Parameters and breaking diquark parameter combinations. | |
3982 | 100 PAR2=PARJ(2) | |
3983 | PAR3=PARJ(3) | |
3984 | PAR4=3.*PARJ(4) | |
3985 | IF(MSTJ(12).GE.2) THEN | |
3986 | PAR3M=SQRT(PARJ(3)) | |
3987 | PAR4M=1./(3.*SQRT(PARJ(4))) | |
3988 | PARDM=PARJ(7)/(PARJ(7)+PAR3M*PARJ(6)) | |
3989 | PARS0=PARJ(5)*(2.+(1.+PAR2*PAR3M*PARJ(7))*(1.+PAR4M)) | |
3990 | PARS1=PARJ(7)*PARS0/(2.*PAR3M)+PARJ(5)*(PARJ(6)*(1.+PAR4M)+ | |
3991 | & PAR2*PAR3M*PARJ(6)*PARJ(7)) | |
3992 | PARS2=PARJ(5)*2.*PARJ(6)*PARJ(7)*(PAR2*PARJ(7)+(1.+PAR4M)/PAR3M) | |
3993 | PARSM=MAX(PARS0,PARS1,PARS2) | |
3994 | PAR4=PAR4*(1.+PARSM)/(1.+PARSM/(3.*PAR4M)) | |
3995 | ENDIF | |
3996 | ||
3997 | C...Choice of whether to generate meson or baryon. | |
3998 | 110 MBARY=0 | |
3999 | KFDA=0 | |
4000 | IF(KF1A.LE.10) THEN | |
4001 | IF(KF2A.EQ.0.AND.MSTJ(12).GE.1.AND.(1.+PARJ(1))*RLY(0).GT.1.) | |
4002 | & MBARY=1 | |
4003 | IF(KF2A.GT.10) MBARY=2 | |
4004 | IF(KF2A.GT.10.AND.KF2A.LE.10000) KFDA=KF2A | |
4005 | ELSE | |
4006 | MBARY=2 | |
4007 | IF(KF1A.LE.10000) KFDA=KF1A | |
4008 | ENDIF | |
4009 | ||
4010 | C...Possibility of process diquark -> meson + new diquark. | |
4011 | IF(KFDA.NE.0.AND.MSTJ(12).GE.2) THEN | |
4012 | KFLDA=MOD(KFDA/1000,10) | |
4013 | KFLDB=MOD(KFDA/100,10) | |
4014 | KFLDS=MOD(KFDA,10) | |
4015 | WTDQ=PARS0 | |
4016 | IF(MAX(KFLDA,KFLDB).EQ.3) WTDQ=PARS1 | |
4017 | IF(MIN(KFLDA,KFLDB).EQ.3) WTDQ=PARS2 | |
4018 | IF(KFLDS.EQ.1) WTDQ=WTDQ/(3.*PAR4M) | |
4019 | IF((1.+WTDQ)*RLY(0).GT.1.) MBARY=-1 | |
4020 | IF(MBARY.EQ.-1.AND.KF2A.NE.0) RETURN | |
4021 | ENDIF | |
4022 | ||
4023 | C...Flavour for meson, possibly with new flavour. | |
4024 | IF(MBARY.LE.0) THEN | |
4025 | KFS=ISIGN(1,KFL1) | |
4026 | IF(MBARY.EQ.0) THEN | |
4027 | IF(KF2A.EQ.0) KFL3=ISIGN(1+INT((2.+PAR2)*RLY(0)),-KFL1) | |
4028 | KFLA=MAX(KF1A,KF2A+IABS(KFL3)) | |
4029 | KFLB=MIN(KF1A,KF2A+IABS(KFL3)) | |
4030 | IF(KFLA.NE.KF1A) KFS=-KFS | |
4031 | ||
4032 | C...Splitting of diquark into meson plus new diquark. | |
4033 | ELSE | |
4034 | KFL1A=MOD(KF1A/1000,10) | |
4035 | KFL1B=MOD(KF1A/100,10) | |
4036 | 120 KFL1D=KFL1A+INT(RLY(0)+0.5)*(KFL1B-KFL1A) | |
4037 | KFL1E=KFL1A+KFL1B-KFL1D | |
4038 | IF((KFL1D.EQ.3.AND.RLY(0).GT.PARDM).OR.(KFL1E.EQ.3.AND. | |
4039 | & RLY(0).LT.PARDM)) THEN | |
4040 | KFL1D=KFL1A+KFL1B-KFL1D | |
4041 | KFL1E=KFL1A+KFL1B-KFL1E | |
4042 | ENDIF | |
4043 | KFL3A=1+INT((2.+PAR2*PAR3M*PARJ(7))*RLY(0)) | |
4044 | IF((KFL1E.NE.KFL3A.AND.RLY(0).GT.(1.+PAR4M)/MAX(2.,1.+PAR4M)) | |
4045 | & .OR.(KFL1E.EQ.KFL3A.AND.RLY(0).GT.2./MAX(2.,1.+PAR4M))) | |
4046 | & GOTO 120 | |
4047 | KFLDS=3 | |
4048 | IF(KFL1E.NE.KFL3A) KFLDS=2*INT(RLY(0)+1./(1.+PAR4M))+1 | |
4049 | KFL3=ISIGN(10000+1000*MAX(KFL1E,KFL3A)+100*MIN(KFL1E,KFL3A)+ | |
4050 | & KFLDS,-KFL1) | |
4051 | KFLA=MAX(KFL1D,KFL3A) | |
4052 | KFLB=MIN(KFL1D,KFL3A) | |
4053 | IF(KFLA.NE.KFL1D) KFS=-KFS | |
4054 | ENDIF | |
4055 | ||
4056 | C...Form meson, with spin and flavour mixing for diagonal states. | |
4057 | IF(KFLA.LE.2) KMUL=INT(PARJ(11)+RLY(0)) | |
4058 | IF(KFLA.EQ.3) KMUL=INT(PARJ(12)+RLY(0)) | |
4059 | IF(KFLA.GE.4) KMUL=INT(PARJ(13)+RLY(0)) | |
4060 | IF(KMUL.EQ.0.AND.PARJ(14).GT.0.) THEN | |
4061 | IF(RLY(0).LT.PARJ(14)) KMUL=2 | |
4062 | ELSEIF(KMUL.EQ.1.AND.PARJ(15)+PARJ(16)+PARJ(17).GT.0.) THEN | |
4063 | RMUL=RLY(0) | |
4064 | IF(RMUL.LT.PARJ(15)) KMUL=3 | |
4065 | IF(KMUL.EQ.1.AND.RMUL.LT.PARJ(15)+PARJ(16)) KMUL=4 | |
4066 | IF(KMUL.EQ.1.AND.RMUL.LT.PARJ(15)+PARJ(16)+PARJ(17)) KMUL=5 | |
4067 | ENDIF | |
4068 | KFLS=3 | |
4069 | IF(KMUL.EQ.0.OR.KMUL.EQ.3) KFLS=1 | |
4070 | IF(KMUL.EQ.5) KFLS=5 | |
4071 | IF(KFLA.NE.KFLB) THEN | |
4072 | KF=(100*KFLA+10*KFLB+KFLS)*KFS*(-1)**KFLA | |
4073 | ELSE | |
4074 | RMIX=RLY(0) | |
4075 | IMIX=2*KFLA+10*KMUL | |
4076 | IF(KFLA.LE.3) KF=110*(1+INT(RMIX+PARF(IMIX-1))+ | |
4077 | & INT(RMIX+PARF(IMIX)))+KFLS | |
4078 | IF(KFLA.GE.4) KF=110*KFLA+KFLS | |
4079 | ENDIF | |
4080 | IF(KMUL.EQ.2.OR.KMUL.EQ.3) KF=KF+ISIGN(10000,KF) | |
4081 | IF(KMUL.EQ.4) KF=KF+ISIGN(20000,KF) | |
4082 | ||
4083 | C...Optional extra suppression of eta and eta'. | |
4084 | IF(KF.EQ.221) THEN | |
4085 | IF(RLY(0).GT.PARJ(25)) GOTO 110 | |
4086 | ELSEIF(KF.EQ.331) THEN | |
4087 | IF(RLY(0).GT.PARJ(26)) GOTO 110 | |
4088 | ENDIF | |
4089 | ||
4090 | C...Generate diquark flavour. | |
4091 | ELSE | |
4092 | 130 IF(KF1A.LE.10.AND.KF2A.EQ.0) THEN | |
4093 | KFLA=KF1A | |
4094 | 140 KFLB=1+INT((2.+PAR2*PAR3)*RLY(0)) | |
4095 | KFLC=1+INT((2.+PAR2*PAR3)*RLY(0)) | |
4096 | KFLDS=1 | |
4097 | IF(KFLB.GE.KFLC) KFLDS=3 | |
4098 | IF(KFLDS.EQ.1.AND.PAR4*RLY(0).GT.1.) GOTO 140 | |
4099 | IF(KFLDS.EQ.3.AND.PAR4.LT.RLY(0)) GOTO 140 | |
4100 | KFL3=ISIGN(1000*MAX(KFLB,KFLC)+100*MIN(KFLB,KFLC)+KFLDS,KFL1) | |
4101 | ||
4102 | C...Take diquark flavour from input. | |
4103 | ELSEIF(KF1A.LE.10) THEN | |
4104 | KFLA=KF1A | |
4105 | KFLB=MOD(KF2A/1000,10) | |
4106 | KFLC=MOD(KF2A/100,10) | |
4107 | KFLDS=MOD(KF2A,10) | |
4108 | ||
4109 | C...Generate (or take from input) quark to go with diquark. | |
4110 | ELSE | |
4111 | IF(KF2A.EQ.0) KFL3=ISIGN(1+INT((2.+PAR2)*RLY(0)),KFL1) | |
4112 | KFLA=KF2A+IABS(KFL3) | |
4113 | KFLB=MOD(KF1A/1000,10) | |
4114 | KFLC=MOD(KF1A/100,10) | |
4115 | KFLDS=MOD(KF1A,10) | |
4116 | ENDIF | |
4117 | ||
4118 | C...SU(6) factors for formation of baryon. Try again if fails. | |
4119 | KBARY=KFLDS | |
4120 | IF(KFLDS.EQ.3.AND.KFLB.NE.KFLC) KBARY=5 | |
4121 | IF(KFLA.NE.KFLB.AND.KFLA.NE.KFLC) KBARY=KBARY+1 | |
4122 | WT=PARF(60+KBARY)+PARJ(18)*PARF(70+KBARY) | |
4123 | IF(MBARY.EQ.1.AND.MSTJ(12).GE.2) THEN | |
4124 | WTDQ=PARS0 | |
4125 | IF(MAX(KFLB,KFLC).EQ.3) WTDQ=PARS1 | |
4126 | IF(MIN(KFLB,KFLC).EQ.3) WTDQ=PARS2 | |
4127 | IF(KFLDS.EQ.1) WTDQ=WTDQ/(3.*PAR4M) | |
4128 | IF(KFLDS.EQ.1) WT=WT*(1.+WTDQ)/(1.+PARSM/(3.*PAR4M)) | |
4129 | IF(KFLDS.EQ.3) WT=WT*(1.+WTDQ)/(1.+PARSM) | |
4130 | ENDIF | |
4131 | IF(KF2A.EQ.0.AND.WT.LT.RLY(0)) GOTO 130 | |
4132 | ||
4133 | C...Form baryon. Distinguish Lambda- and Sigmalike baryons. | |
4134 | KFLD=MAX(KFLA,KFLB,KFLC) | |
4135 | KFLF=MIN(KFLA,KFLB,KFLC) | |
4136 | KFLE=KFLA+KFLB+KFLC-KFLD-KFLF | |
4137 | KFLS=2 | |
4138 | IF((PARF(60+KBARY)+PARJ(18)*PARF(70+KBARY))*RLY(0).GT. | |
4139 | & PARF(60+KBARY)) KFLS=4 | |
4140 | KFLL=0 | |
4141 | IF(KFLS.EQ.2.AND.KFLD.GT.KFLE.AND.KFLE.GT.KFLF) THEN | |
4142 | IF(KFLDS.EQ.1.AND.KFLA.EQ.KFLD) KFLL=1 | |
4143 | IF(KFLDS.EQ.1.AND.KFLA.NE.KFLD) KFLL=INT(0.25+RLY(0)) | |
4144 | IF(KFLDS.EQ.3.AND.KFLA.NE.KFLD) KFLL=INT(0.75+RLY(0)) | |
4145 | ENDIF | |
4146 | IF(KFLL.EQ.0) KF=ISIGN(1000*KFLD+100*KFLE+10*KFLF+KFLS,KFL1) | |
4147 | IF(KFLL.EQ.1) KF=ISIGN(1000*KFLD+100*KFLF+10*KFLE+KFLS,KFL1) | |
4148 | ENDIF | |
4149 | RETURN | |
4150 | ||
4151 | C...Use tabulated probabilities to select new flavour and hadron. | |
4152 | 150 IF(KTAB2.EQ.0.AND.MSTJ(12).LE.0) THEN | |
4153 | KT3L=1 | |
4154 | KT3U=6 | |
4155 | ELSEIF(KTAB2.EQ.0.AND.KTAB1.GE.7.AND.MSTJ(12).LE.1) THEN | |
4156 | KT3L=1 | |
4157 | KT3U=6 | |
4158 | ELSEIF(KTAB2.EQ.0) THEN | |
4159 | KT3L=1 | |
4160 | KT3U=22 | |
4161 | ELSE | |
4162 | KT3L=KTAB2 | |
4163 | KT3U=KTAB2 | |
4164 | ENDIF | |
4165 | RFL=0. | |
4166 | DO 170 KTS=0,2 | |
4167 | DO 160 KT3=KT3L,KT3U | |
4168 | RFL=RFL+PARF(120+80*KTAB1+25*KTS+KT3) | |
4169 | 160 CONTINUE | |
4170 | 170 CONTINUE | |
4171 | RFL=RLY(0)*RFL | |
4172 | DO 190 KTS=0,2 | |
4173 | KTABS=KTS | |
4174 | DO 180 KT3=KT3L,KT3U | |
4175 | KTAB3=KT3 | |
4176 | RFL=RFL-PARF(120+80*KTAB1+25*KTS+KT3) | |
4177 | IF(RFL.LE.0.) GOTO 200 | |
4178 | 180 CONTINUE | |
4179 | 190 CONTINUE | |
4180 | 200 CONTINUE | |
4181 | ||
4182 | C...Reconstruct flavour of produced quark/diquark. | |
4183 | IF(KTAB3.LE.6) THEN | |
4184 | KFL3A=KTAB3 | |
4185 | KFL3B=0 | |
4186 | KFL3=ISIGN(KFL3A,KFL1*(2*KTAB1-13)) | |
4187 | ELSE | |
4188 | KFL3A=1 | |
4189 | IF(KTAB3.GE.8) KFL3A=2 | |
4190 | IF(KTAB3.GE.11) KFL3A=3 | |
4191 | IF(KTAB3.GE.16) KFL3A=4 | |
4192 | KFL3B=(KTAB3-6-KFL3A*(KFL3A-2))/2 | |
4193 | KFL3=1000*KFL3A+100*KFL3B+1 | |
4194 | IF(KFL3A.EQ.KFL3B.OR.KTAB3.NE.6+KFL3A*(KFL3A-2)+2*KFL3B) KFL3= | |
4195 | & KFL3+2 | |
4196 | KFL3=ISIGN(KFL3,KFL1*(13-2*KTAB1)) | |
4197 | ENDIF | |
4198 | ||
4199 | C...Reconstruct meson code. | |
4200 | IF(KFL3A.EQ.KFL1A.AND.KFL3B.EQ.KFL1B.AND.(KFL3A.LE.3.OR. | |
4201 | &KFL3B.NE.0)) THEN | |
4202 | RFL=RLY(0)*(PARF(143+80*KTAB1+25*KTABS)+PARF(144+80*KTAB1+ | |
4203 | & 25*KTABS)+PARF(145+80*KTAB1+25*KTABS)) | |
4204 | KF=110+2*KTABS+1 | |
4205 | IF(RFL.GT.PARF(143+80*KTAB1+25*KTABS)) KF=220+2*KTABS+1 | |
4206 | IF(RFL.GT.PARF(143+80*KTAB1+25*KTABS)+PARF(144+80*KTAB1+ | |
4207 | & 25*KTABS)) KF=330+2*KTABS+1 | |
4208 | ELSEIF(KTAB1.LE.6.AND.KTAB3.LE.6) THEN | |
4209 | KFLA=MAX(KTAB1,KTAB3) | |
4210 | KFLB=MIN(KTAB1,KTAB3) | |
4211 | KFS=ISIGN(1,KFL1) | |
4212 | IF(KFLA.NE.KF1A) KFS=-KFS | |
4213 | KF=(100*KFLA+10*KFLB+2*KTABS+1)*KFS*(-1)**KFLA | |
4214 | ELSEIF(KTAB1.GE.7.AND.KTAB3.GE.7) THEN | |
4215 | KFS=ISIGN(1,KFL1) | |
4216 | IF(KFL1A.EQ.KFL3A) THEN | |
4217 | KFLA=MAX(KFL1B,KFL3B) | |
4218 | KFLB=MIN(KFL1B,KFL3B) | |
4219 | IF(KFLA.NE.KFL1B) KFS=-KFS | |
4220 | ELSEIF(KFL1A.EQ.KFL3B) THEN | |
4221 | KFLA=KFL3A | |
4222 | KFLB=KFL1B | |
4223 | KFS=-KFS | |
4224 | ELSEIF(KFL1B.EQ.KFL3A) THEN | |
4225 | KFLA=KFL1A | |
4226 | KFLB=KFL3B | |
4227 | ELSEIF(KFL1B.EQ.KFL3B) THEN | |
4228 | KFLA=MAX(KFL1A,KFL3A) | |
4229 | KFLB=MIN(KFL1A,KFL3A) | |
4230 | IF(KFLA.NE.KFL1A) KFS=-KFS | |
4231 | ELSE | |
4232 | CALL LYERRM(2,'(LYKFDI:) no matching flavours for qq -> qq') | |
4233 | GOTO 100 | |
4234 | ENDIF | |
4235 | KF=(100*KFLA+10*KFLB+2*KTABS+1)*KFS*(-1)**KFLA | |
4236 | ||
4237 | C...Reconstruct baryon code. | |
4238 | ELSE | |
4239 | IF(KTAB1.GE.7) THEN | |
4240 | KFLA=KFL3A | |
4241 | KFLB=KFL1A | |
4242 | KFLC=KFL1B | |
4243 | ELSE | |
4244 | KFLA=KFL1A | |
4245 | KFLB=KFL3A | |
4246 | KFLC=KFL3B | |
4247 | ENDIF | |
4248 | KFLD=MAX(KFLA,KFLB,KFLC) | |
4249 | KFLF=MIN(KFLA,KFLB,KFLC) | |
4250 | KFLE=KFLA+KFLB+KFLC-KFLD-KFLF | |
4251 | IF(KTABS.EQ.0) KF=ISIGN(1000*KFLD+100*KFLF+10*KFLE+2,KFL1) | |
4252 | IF(KTABS.GE.1) KF=ISIGN(1000*KFLD+100*KFLE+10*KFLF+2*KTABS,KFL1) | |
4253 | ENDIF | |
4254 | ||
4255 | C...Check that constructed flavour code is an allowed one. | |
4256 | IF(KFL2.NE.0) KFL3=0 | |
4257 | KC=LYCOMP(KF) | |
4258 | IF(KC.EQ.0) THEN | |
4259 | CALL LYERRM(2,'(LYKFDI:) user-defined flavour probabilities '// | |
4260 | & 'failed') | |
4261 | GOTO 100 | |
4262 | ENDIF | |
4263 | ||
4264 | RETURN | |
4265 | END | |
4266 | ||
4267 | C********************************************************************* | |
4268 | ||
4269 | SUBROUTINE LYPTDI(KFL,PX,PY) | |
4270 | ||
4271 | C...Purpose: to generate transverse momentum according to a Gaussian. | |
4272 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
4273 | SAVE /LYDAT1/ | |
4274 | ||
4275 | C...Generate p_T and azimuthal angle, gives p_x and p_y. | |
4276 | KFLA=IABS(KFL) | |
4277 | PT=PARJ(21)*SQRT(-LOG(MAX(1E-10,RLY(0)))) | |
4278 | IF(PARJ(23).GT.RLY(0)) PT=PARJ(24)*PT | |
4279 | IF(MSTJ(91).EQ.1) PT=PARJ(22)*PT | |
4280 | IF(KFLA.EQ.0.AND.MSTJ(13).LE.0) PT=0. | |
4281 | PHI=PARU(2)*RLY(0) | |
4282 | PX=PT*COS(PHI) | |
4283 | PY=PT*SIN(PHI) | |
4284 | ||
4285 | RETURN | |
4286 | END | |
4287 | ||
4288 | C********************************************************************* | |
4289 | ||
4290 | SUBROUTINE LYZDIS(KFL1,KFL2,PR,Z) | |
4291 | ||
4292 | C...Purpose: to generate the longitudinal splitting variable z. | |
4293 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
4294 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
4295 | SAVE /LYDAT1/,/LYDAT2/ | |
4296 | ||
4297 | C...Check if heavy flavour fragmentation. | |
4298 | KFLA=IABS(KFL1) | |
4299 | KFLB=IABS(KFL2) | |
4300 | KFLH=KFLA | |
4301 | IF(KFLA.GE.10) KFLH=MOD(KFLA/1000,10) | |
4302 | ||
4303 | C...Lund symmetric scaling function: determine parameters of shape. | |
4304 | IF(MSTJ(11).EQ.1.OR.(MSTJ(11).EQ.3.AND.KFLH.LE.3).OR. | |
4305 | &MSTJ(11).GE.4) THEN | |
4306 | FA=PARJ(41) | |
4307 | IF(MSTJ(91).EQ.1) FA=PARJ(43) | |
4308 | IF(KFLB.GE.10) FA=FA+PARJ(45) | |
4309 | FBB=PARJ(42) | |
4310 | IF(MSTJ(91).EQ.1) FBB=PARJ(44) | |
4311 | FB=FBB*PR | |
4312 | FC=1. | |
4313 | IF(KFLA.GE.10) FC=FC-PARJ(45) | |
4314 | IF(KFLB.GE.10) FC=FC+PARJ(45) | |
4315 | IF(MSTJ(11).GE.4.AND.KFLH.GE.4.AND.KFLH.LE.5) THEN | |
4316 | FRED=PARJ(46) | |
4317 | IF(MSTJ(11).EQ.5.AND.KFLH.EQ.5) FRED=PARJ(47) | |
4318 | FC=FC+FRED*FBB*PARF(100+KFLH)**2 | |
4319 | ELSEIF(MSTJ(11).GE.4.AND.KFLH.GE.6.AND.KFLH.LE.8) THEN | |
4320 | FRED=PARJ(46) | |
4321 | IF(MSTJ(11).EQ.5) FRED=PARJ(48) | |
4322 | FC=FC+FRED*FBB*PMAS(KFLH,1)**2 | |
4323 | ENDIF | |
4324 | MC=1 | |
4325 | IF(ABS(FC-1.).GT.0.01) MC=2 | |
4326 | ||
4327 | C...Determine position of maximum. Special cases for a = 0 or a = c. | |
4328 | IF(FA.LT.0.02) THEN | |
4329 | MA=1 | |
4330 | ZMAX=1. | |
4331 | IF(FC.GT.FB) ZMAX=FB/FC | |
4332 | ELSEIF(ABS(FC-FA).LT.0.01) THEN | |
4333 | MA=2 | |
4334 | ZMAX=FB/(FB+FC) | |
4335 | ELSE | |
4336 | MA=3 | |
4337 | ZMAX=0.5*(FB+FC-SQRT((FB-FC)**2+4.*FA*FB))/(FC-FA) | |
4338 | IF(ZMAX.GT.0.9999.AND.FB.GT.100.) ZMAX=MIN(ZMAX,1.-FA/FB) | |
4339 | ENDIF | |
4340 | ||
4341 | C...Subdivide z range if distribution very peaked near endpoint. | |
4342 | MMAX=2 | |
4343 | IF(ZMAX.LT.0.1) THEN | |
4344 | MMAX=1 | |
4345 | ZDIV=2.75*ZMAX | |
4346 | IF(MC.EQ.1) THEN | |
4347 | FINT=1.-LOG(ZDIV) | |
4348 | ELSE | |
4349 | ZDIVC=ZDIV**(1.-FC) | |
4350 | FINT=1.+(1.-1./ZDIVC)/(FC-1.) | |
4351 | ENDIF | |
4352 | ELSEIF(ZMAX.GT.0.85.AND.FB.GT.1.) THEN | |
4353 | MMAX=3 | |
4354 | FSCB=SQRT(4.+(FC/FB)**2) | |
4355 | ZDIV=FSCB-1./ZMAX-(FC/FB)*LOG(ZMAX*0.5*(FSCB+FC/FB)) | |
4356 | IF(MA.GE.2) ZDIV=ZDIV+(FA/FB)*LOG(1.-ZMAX) | |
4357 | ZDIV=MIN(ZMAX,MAX(0.,ZDIV)) | |
4358 | FINT=1.+FB*(1.-ZDIV) | |
4359 | ENDIF | |
4360 | ||
4361 | C...Choice of z, preweighted for peaks at low or high z. | |
4362 | 100 Z=RLY(0) | |
4363 | FPRE=1. | |
4364 | IF(MMAX.EQ.1) THEN | |
4365 | IF(FINT*RLY(0).LE.1.) THEN | |
4366 | Z=ZDIV*Z | |
4367 | ELSEIF(MC.EQ.1) THEN | |
4368 | Z=ZDIV**Z | |
4369 | FPRE=ZDIV/Z | |
4370 | ELSE | |
4371 | Z=(ZDIVC+Z*(1.-ZDIVC))**(1./(1.-FC)) | |
4372 | FPRE=(ZDIV/Z)**FC | |
4373 | ENDIF | |
4374 | ELSEIF(MMAX.EQ.3) THEN | |
4375 | IF(FINT*RLY(0).LE.1.) THEN | |
4376 | Z=ZDIV+LOG(Z)/FB | |
4377 | FPRE=EXP(FB*(Z-ZDIV)) | |
4378 | ELSE | |
4379 | Z=ZDIV+Z*(1.-ZDIV) | |
4380 | ENDIF | |
4381 | ENDIF | |
4382 | ||
4383 | C...Weighting according to correct formula. | |
4384 | IF(Z.LE.0..OR.Z.GE.1.) GOTO 100 | |
4385 | FEXP=FC*LOG(ZMAX/Z)+FB*(1./ZMAX-1./Z) | |
4386 | IF(MA.GE.2) FEXP=FEXP+FA*LOG((1.-Z)/(1.-ZMAX)) | |
4387 | FVAL=EXP(MAX(-50.,MIN(50.,FEXP))) | |
4388 | IF(FVAL.LT.RLY(0)*FPRE) GOTO 100 | |
4389 | ||
4390 | C...Generate z according to Field-Feynman, SLAC, (1-z)**c OR z**c. | |
4391 | ELSE | |
4392 | FC=PARJ(50+MAX(1,KFLH)) | |
4393 | IF(MSTJ(91).EQ.1) FC=PARJ(59) | |
4394 | 110 Z=RLY(0) | |
4395 | IF(FC.GE.0..AND.FC.LE.1.) THEN | |
4396 | IF(FC.GT.RLY(0)) Z=1.-Z**(1./3.) | |
4397 | ELSEIF(FC.GT.-1.AND.FC.LT.0.) THEN | |
4398 | IF(-4.*FC*Z*(1.-Z)**2.LT.RLY(0)*((1.-Z)**2-FC*Z)**2) GOTO 110 | |
4399 | ELSE | |
4400 | IF(FC.GT.0.) Z=1.-Z**(1./FC) | |
4401 | IF(FC.LT.0.) Z=Z**(-1./FC) | |
4402 | ENDIF | |
4403 | ENDIF | |
4404 | ||
4405 | RETURN | |
4406 | END | |
4407 | ||
4408 | C********************************************************************* | |
4409 | ||
4410 | SUBROUTINE LYSHOW(IP1,IP2,QMAX) | |
4411 | ||
4412 | C...Purpose: to generate timelike parton showers from given partons. | |
4413 | IMPLICIT DOUBLE PRECISION(D) | |
4414 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
4415 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
4416 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
4417 | SAVE /LYJETS/,/LYDAT1/,/LYDAT2/ | |
4418 | DIMENSION PMTH(5,50),PS(5),PMA(4),PMSD(4),IEP(4),IPA(4), | |
4419 | &KFLA(4),KFLD(4),KFL(4),ITRY(4),ISI(4),ISL(4),DP(4),DPT(5,4), | |
4420 | &KSH(0:40),KCII(2),NIIS(2),IIIS(2,2),THEIIS(2,2),PHIIIS(2,2), | |
4421 | &ISII(2) | |
4422 | ||
4423 | C...Initialization of cutoff masses etc. | |
4424 | IF(MSTJ(41).LE.0.OR.(MSTJ(41).EQ.1.AND.QMAX.LE.PARJ(82)).OR. | |
4425 | &QMAX.LE.MIN(PARJ(82),PARJ(83))) RETURN | |
4426 | DO 100 IFL=0,40 | |
4427 | KSH(IFL)=0 | |
4428 | 100 CONTINUE | |
4429 | KSH(21)=1 | |
4430 | PMTH(1,21)=UYMASS(21) | |
4431 | PMTH(2,21)=SQRT(PMTH(1,21)**2+0.25*PARJ(82)**2) | |
4432 | PMTH(3,21)=2.*PMTH(2,21) | |
4433 | PMTH(4,21)=PMTH(3,21) | |
4434 | PMTH(5,21)=PMTH(3,21) | |
4435 | PMTH(1,22)=UYMASS(22) | |
4436 | PMTH(2,22)=SQRT(PMTH(1,22)**2+0.25*PARJ(83)**2) | |
4437 | PMTH(3,22)=2.*PMTH(2,22) | |
4438 | PMTH(4,22)=PMTH(3,22) | |
4439 | PMTH(5,22)=PMTH(3,22) | |
4440 | PMQTH1=PARJ(82) | |
4441 | IF(MSTJ(41).GE.2) PMQTH1=MIN(PARJ(82),PARJ(83)) | |
4442 | PMQTH2=PMTH(2,21) | |
4443 | IF(MSTJ(41).GE.2) PMQTH2=MIN(PMTH(2,21),PMTH(2,22)) | |
4444 | DO 110 IFL=1,8 | |
4445 | KSH(IFL)=1 | |
4446 | PMTH(1,IFL)=UYMASS(IFL) | |
4447 | PMTH(2,IFL)=SQRT(PMTH(1,IFL)**2+0.25*PMQTH1**2) | |
4448 | PMTH(3,IFL)=PMTH(2,IFL)+PMQTH2 | |
4449 | PMTH(4,IFL)=SQRT(PMTH(1,IFL)**2+0.25*PARJ(82)**2)+PMTH(2,21) | |
4450 | PMTH(5,IFL)=SQRT(PMTH(1,IFL)**2+0.25*PARJ(83)**2)+PMTH(2,22) | |
4451 | 110 CONTINUE | |
4452 | DO 120 IFL=11,17,2 | |
4453 | IF(MSTJ(41).GE.2) KSH(IFL)=1 | |
4454 | PMTH(1,IFL)=UYMASS(IFL) | |
4455 | PMTH(2,IFL)=SQRT(PMTH(1,IFL)**2+0.25*PARJ(83)**2) | |
4456 | PMTH(3,IFL)=PMTH(2,IFL)+PMTH(2,22) | |
4457 | PMTH(4,IFL)=PMTH(3,IFL) | |
4458 | PMTH(5,IFL)=PMTH(3,IFL) | |
4459 | 120 CONTINUE | |
4460 | PT2MIN=MAX(0.5*PARJ(82),1.1*PARJ(81))**2 | |
4461 | ALAMS=PARJ(81)**2 | |
4462 | ALFM=LOG(PT2MIN/ALAMS) | |
4463 | ||
4464 | C...Store positions of shower initiating partons. | |
4465 | IF(IP1.GT.0.AND.IP1.LE.MIN(N,MSTU(4)-MSTU(32)).AND.IP2.EQ.0) THEN | |
4466 | NPA=1 | |
4467 | IPA(1)=IP1 | |
4468 | ELSEIF(MIN(IP1,IP2).GT.0.AND.MAX(IP1,IP2).LE.MIN(N,MSTU(4)- | |
4469 | &MSTU(32))) THEN | |
4470 | NPA=2 | |
4471 | IPA(1)=IP1 | |
4472 | IPA(2)=IP2 | |
4473 | ELSEIF(IP1.GT.0.AND.IP1.LE.MIN(N,MSTU(4)-MSTU(32)).AND.IP2.LT.0 | |
4474 | &.AND.IP2.GE.-3) THEN | |
4475 | NPA=IABS(IP2) | |
4476 | DO 130 I=1,NPA | |
4477 | IPA(I)=IP1+I-1 | |
4478 | 130 CONTINUE | |
4479 | ELSE | |
4480 | CALL LYERRM(12, | |
4481 | & '(LYSHOW:) failed to reconstruct showering system') | |
4482 | IF(MSTU(21).GE.1) RETURN | |
4483 | ENDIF | |
4484 | ||
4485 | C...Check on phase space available for emission. | |
4486 | IREJ=0 | |
4487 | DO 140 J=1,5 | |
4488 | PS(J)=0. | |
4489 | 140 CONTINUE | |
4490 | PM=0. | |
4491 | DO 160 I=1,NPA | |
4492 | KFLA(I)=IABS(K(IPA(I),2)) | |
4493 | PMA(I)=P(IPA(I),5) | |
4494 | C...Special cutoff masses for t, l, h with variable masses. | |
4495 | IFLA=KFLA(I) | |
4496 | IF(KFLA(I).GE.6.AND.KFLA(I).LE.8) THEN | |
4497 | IFLA=37+KFLA(I)+ISIGN(2,K(IPA(I),2)) | |
4498 | PMTH(1,IFLA)=PMA(I) | |
4499 | PMTH(2,IFLA)=SQRT(PMTH(1,IFLA)**2+0.25*PMQTH1**2) | |
4500 | PMTH(3,IFLA)=PMTH(2,IFLA)+PMQTH2 | |
4501 | PMTH(4,IFLA)=SQRT(PMTH(1,IFLA)**2+0.25*PARJ(82)**2)+PMTH(2,21) | |
4502 | PMTH(5,IFLA)=SQRT(PMTH(1,IFLA)**2+0.25*PARJ(83)**2)+PMTH(2,22) | |
4503 | ENDIF | |
4504 | IF(KFLA(I).LE.40) THEN | |
4505 | IF(KSH(KFLA(I)).EQ.1) PMA(I)=PMTH(3,IFLA) | |
4506 | ENDIF | |
4507 | PM=PM+PMA(I) | |
4508 | IF(KFLA(I).GT.40) THEN | |
4509 | IREJ=IREJ+1 | |
4510 | ELSE | |
4511 | IF(KSH(KFLA(I)).EQ.0.OR.PMA(I).GT.QMAX) IREJ=IREJ+1 | |
4512 | ENDIF | |
4513 | DO 150 J=1,4 | |
4514 | PS(J)=PS(J)+P(IPA(I),J) | |
4515 | 150 CONTINUE | |
4516 | 160 CONTINUE | |
4517 | IF(IREJ.EQ.NPA) RETURN | |
4518 | PS(5)=SQRT(MAX(0.,PS(4)**2-PS(1)**2-PS(2)**2-PS(3)**2)) | |
4519 | IF(NPA.EQ.1) PS(5)=PS(4) | |
4520 | IF(PS(5).LE.PM+PMQTH1) RETURN | |
4521 | ||
4522 | C...Check if 3-jet matrix elements to be used. | |
4523 | M3JC=0 | |
4524 | IF(NPA.EQ.2.AND.MSTJ(47).GE.1) THEN | |
4525 | IF(KFLA(1).GE.1.AND.KFLA(1).LE.8.AND.KFLA(2).GE.1.AND. | |
4526 | & KFLA(2).LE.8) M3JC=1 | |
4527 | IF((KFLA(1).EQ.11.OR.KFLA(1).EQ.13.OR.KFLA(1).EQ.15.OR. | |
4528 | & KFLA(1).EQ.17).AND.KFLA(2).EQ.KFLA(1)) M3JC=1 | |
4529 | IF((KFLA(1).EQ.11.OR.KFLA(1).EQ.13.OR.KFLA(1).EQ.15.OR. | |
4530 | & KFLA(1).EQ.17).AND.KFLA(2).EQ.KFLA(1)+1) M3JC=1 | |
4531 | IF((KFLA(1).EQ.12.OR.KFLA(1).EQ.14.OR.KFLA(1).EQ.16.OR. | |
4532 | & KFLA(1).EQ.18).AND.KFLA(2).EQ.KFLA(1)-1) M3JC=1 | |
4533 | IF(MSTJ(47).EQ.2.OR.MSTJ(47).EQ.4) M3JC=1 | |
4534 | M3JCM=0 | |
4535 | IF(M3JC.EQ.1.AND.MSTJ(47).GE.3.AND.KFLA(1).EQ.KFLA(2)) THEN | |
4536 | M3JCM=1 | |
4537 | QME=(2.*PMTH(1,KFLA(1))/PS(5))**2 | |
4538 | ENDIF | |
4539 | ENDIF | |
4540 | ||
4541 | C...Find if interference with initial state partons. | |
4542 | MIIS=0 | |
4543 | IF(MSTJ(50).GE.1.AND.MSTJ(50).LE.3.AND.NPA.EQ.2) MIIS=MSTJ(50) | |
4544 | IF(MIIS.NE.0) THEN | |
4545 | DO 180 I=1,2 | |
4546 | KCII(I)=0 | |
4547 | KCA=LYCOMP(KFLA(I)) | |
4548 | IF(KCA.NE.0) KCII(I)=KCHG(KCA,2)*ISIGN(1,K(IPA(I),2)) | |
4549 | NIIS(I)=0 | |
4550 | IF(KCII(I).NE.0) THEN | |
4551 | DO 170 J=1,2 | |
4552 | ICSI=MOD(K(IPA(I),3+J)/MSTU(5),MSTU(5)) | |
4553 | IF(ICSI.GT.0.AND.ICSI.NE.IPA(1).AND.ICSI.NE.IPA(2).AND. | |
4554 | & (KCII(I).EQ.(-1)**(J+1).OR.KCII(I).EQ.2)) THEN | |
4555 | NIIS(I)=NIIS(I)+1 | |
4556 | IIIS(I,NIIS(I))=ICSI | |
4557 | ENDIF | |
4558 | 170 CONTINUE | |
4559 | ENDIF | |
4560 | 180 CONTINUE | |
4561 | IF(NIIS(1)+NIIS(2).EQ.0) MIIS=0 | |
4562 | ENDIF | |
4563 | ||
4564 | C...Boost interfering initial partons to rest frame | |
4565 | C...and reconstruct their polar and azimuthal angles. | |
4566 | IF(MIIS.NE.0) THEN | |
4567 | DO 200 I=1,2 | |
4568 | DO 190 J=1,5 | |
4569 | K(N+I,J)=K(IPA(I),J) | |
4570 | P(N+I,J)=P(IPA(I),J) | |
4571 | V(N+I,J)=0. | |
4572 | 190 CONTINUE | |
4573 | 200 CONTINUE | |
4574 | DO 220 I=3,2+NIIS(1) | |
4575 | DO 210 J=1,5 | |
4576 | K(N+I,J)=K(IIIS(1,I-2),J) | |
4577 | P(N+I,J)=P(IIIS(1,I-2),J) | |
4578 | V(N+I,J)=0. | |
4579 | 210 CONTINUE | |
4580 | 220 CONTINUE | |
4581 | DO 240 I=3+NIIS(1),2+NIIS(1)+NIIS(2) | |
4582 | DO 230 J=1,5 | |
4583 | K(N+I,J)=K(IIIS(2,I-2-NIIS(1)),J) | |
4584 | P(N+I,J)=P(IIIS(2,I-2-NIIS(1)),J) | |
4585 | V(N+I,J)=0. | |
4586 | 230 CONTINUE | |
4587 | 240 CONTINUE | |
4588 | CALL LUDBRB(N+1,N+2+NIIS(1)+NIIS(2),0.,0.,-DBLE(PS(1)/PS(4)), | |
4589 | & -DBLE(PS(2)/PS(4)),-DBLE(PS(3)/PS(4))) | |
4590 | PHI=UYANGL(P(N+1,1),P(N+1,2)) | |
4591 | CALL LUDBRB(N+1,N+2+NIIS(1)+NIIS(2),0.,-PHI,0D0,0D0,0D0) | |
4592 | THE=UYANGL(P(N+1,3),P(N+1,1)) | |
4593 | CALL LUDBRB(N+1,N+2+NIIS(1)+NIIS(2),-THE,0.,0D0,0D0,0D0) | |
4594 | DO 250 I=3,2+NIIS(1) | |
4595 | THEIIS(1,I-2)=UYANGL(P(N+I,3),SQRT(P(N+I,1)**2+P(N+I,2)**2)) | |
4596 | PHIIIS(1,I-2)=UYANGL(P(N+I,1),P(N+I,2)) | |
4597 | 250 CONTINUE | |
4598 | DO 260 I=3+NIIS(1),2+NIIS(1)+NIIS(2) | |
4599 | THEIIS(2,I-2-NIIS(1))=PARU(1)-UYANGL(P(N+I,3), | |
4600 | & SQRT(P(N+I,1)**2+P(N+I,2)**2)) | |
4601 | PHIIIS(2,I-2-NIIS(1))=UYANGL(P(N+I,1),P(N+I,2)) | |
4602 | 260 CONTINUE | |
4603 | ENDIF | |
4604 | ||
4605 | C...Define imagined single initiator of shower for parton system. | |
4606 | NS=N | |
4607 | IF(N.GT.MSTU(4)-MSTU(32)-5) THEN | |
4608 | CALL LYERRM(11,'(LYSHOW:) no more memory left in LUJETS') | |
4609 | IF(MSTU(21).GE.1) RETURN | |
4610 | ENDIF | |
4611 | IF(NPA.GE.2) THEN | |
4612 | K(N+1,1)=11 | |
4613 | K(N+1,2)=21 | |
4614 | K(N+1,3)=0 | |
4615 | K(N+1,4)=0 | |
4616 | K(N+1,5)=0 | |
4617 | P(N+1,1)=0. | |
4618 | P(N+1,2)=0. | |
4619 | P(N+1,3)=0. | |
4620 | P(N+1,4)=PS(5) | |
4621 | P(N+1,5)=PS(5) | |
4622 | V(N+1,5)=PS(5)**2 | |
4623 | N=N+1 | |
4624 | ENDIF | |
4625 | ||
4626 | C...Loop over partons that may branch. | |
4627 | NEP=NPA | |
4628 | IM=NS | |
4629 | IF(NPA.EQ.1) IM=NS-1 | |
4630 | 270 IM=IM+1 | |
4631 | IF(N.GT.NS) THEN | |
4632 | IF(IM.GT.N) GOTO 510 | |
4633 | KFLM=IABS(K(IM,2)) | |
4634 | IF(KFLM.GT.40) GOTO 270 | |
4635 | IF(KSH(KFLM).EQ.0) GOTO 270 | |
4636 | IFLM=KFLM | |
4637 | IF(KFLM.GE.6.AND.KFLM.LE.8) IFLM=37+KFLM+ISIGN(2,K(IM,2)) | |
4638 | IF(P(IM,5).LT.PMTH(2,IFLM)) GOTO 270 | |
4639 | IGM=K(IM,3) | |
4640 | ELSE | |
4641 | IGM=-1 | |
4642 | ENDIF | |
4643 | IF(N+NEP.GT.MSTU(4)-MSTU(32)-5) THEN | |
4644 | CALL LYERRM(11,'(LYSHOW:) no more memory left in LUJETS') | |
4645 | IF(MSTU(21).GE.1) RETURN | |
4646 | ENDIF | |
4647 | ||
4648 | C...Position of aunt (sister to branching parton). | |
4649 | C...Origin and flavour of daughters. | |
4650 | IAU=0 | |
4651 | IF(IGM.GT.0) THEN | |
4652 | IF(K(IM-1,3).EQ.IGM) IAU=IM-1 | |
4653 | IF(N.GE.IM+1.AND.K(IM+1,3).EQ.IGM) IAU=IM+1 | |
4654 | ENDIF | |
4655 | IF(IGM.GE.0) THEN | |
4656 | K(IM,4)=N+1 | |
4657 | DO 280 I=1,NEP | |
4658 | K(N+I,3)=IM | |
4659 | 280 CONTINUE | |
4660 | ELSE | |
4661 | K(N+1,3)=IPA(1) | |
4662 | ENDIF | |
4663 | IF(IGM.LE.0) THEN | |
4664 | DO 290 I=1,NEP | |
4665 | K(N+I,2)=K(IPA(I),2) | |
4666 | 290 CONTINUE | |
4667 | ELSEIF(KFLM.NE.21) THEN | |
4668 | K(N+1,2)=K(IM,2) | |
4669 | K(N+2,2)=K(IM,5) | |
4670 | ELSEIF(K(IM,5).EQ.21) THEN | |
4671 | K(N+1,2)=21 | |
4672 | K(N+2,2)=21 | |
4673 | ELSE | |
4674 | K(N+1,2)=K(IM,5) | |
4675 | K(N+2,2)=-K(IM,5) | |
4676 | ENDIF | |
4677 | ||
4678 | C...Reset flags on daughers and tries made. | |
4679 | DO 300 IP=1,NEP | |
4680 | K(N+IP,1)=3 | |
4681 | K(N+IP,4)=0 | |
4682 | K(N+IP,5)=0 | |
4683 | KFLD(IP)=IABS(K(N+IP,2)) | |
4684 | IF(KCHG(LYCOMP(KFLD(IP)),2).EQ.0) K(N+IP,1)=1 | |
4685 | ITRY(IP)=0 | |
4686 | ISL(IP)=0 | |
4687 | ISI(IP)=0 | |
4688 | IF(KFLD(IP).LE.40) THEN | |
4689 | IF(KSH(KFLD(IP)).EQ.1) ISI(IP)=1 | |
4690 | ENDIF | |
4691 | 300 CONTINUE | |
4692 | ISLM=0 | |
4693 | ||
4694 | C...Maximum virtuality of daughters. | |
4695 | IF(IGM.LE.0) THEN | |
4696 | DO 310 I=1,NPA | |
4697 | IF(NPA.GE.3) P(N+I,4)=(PS(4)*P(IPA(I),4)-PS(1)*P(IPA(I),1)- | |
4698 | & PS(2)*P(IPA(I),2)-PS(3)*P(IPA(I),3))/PS(5) | |
4699 | P(N+I,5)=MIN(QMAX,PS(5)) | |
4700 | IF(NPA.GE.3) P(N+I,5)=MIN(P(N+I,5),P(N+I,4)) | |
4701 | IF(ISI(I).EQ.0) P(N+I,5)=P(IPA(I),5) | |
4702 | 310 CONTINUE | |
4703 | ELSE | |
4704 | IF(MSTJ(43).LE.2) PEM=V(IM,2) | |
4705 | IF(MSTJ(43).GE.3) PEM=P(IM,4) | |
4706 | P(N+1,5)=MIN(P(IM,5),V(IM,1)*PEM) | |
4707 | P(N+2,5)=MIN(P(IM,5),(1.-V(IM,1))*PEM) | |
4708 | IF(K(N+2,2).EQ.22) P(N+2,5)=PMTH(1,22) | |
4709 | ENDIF | |
4710 | DO 320 I=1,NEP | |
4711 | PMSD(I)=P(N+I,5) | |
4712 | IF(ISI(I).EQ.1) THEN | |
4713 | IFLD=KFLD(I) | |
4714 | IF(KFLD(I).GE.6.AND.KFLD(I).LE.8) IFLD=37+KFLD(I)+ | |
4715 | & ISIGN(2,K(N+I,2)) | |
4716 | IF(P(N+I,5).LE.PMTH(3,IFLD)) P(N+I,5)=PMTH(1,IFLD) | |
4717 | ENDIF | |
4718 | V(N+I,5)=P(N+I,5)**2 | |
4719 | 320 CONTINUE | |
4720 | ||
4721 | C...Choose one of the daughters for evolution. | |
4722 | 330 INUM=0 | |
4723 | IF(NEP.EQ.1) INUM=1 | |
4724 | DO 340 I=1,NEP | |
4725 | IF(INUM.EQ.0.AND.ISL(I).EQ.1) INUM=I | |
4726 | 340 CONTINUE | |
4727 | DO 350 I=1,NEP | |
4728 | IF(INUM.EQ.0.AND.ITRY(I).EQ.0.AND.ISI(I).EQ.1) THEN | |
4729 | IFLD=KFLD(I) | |
4730 | IF(KFLD(I).GE.6.AND.KFLD(I).LE.8) IFLD=37+KFLD(I)+ | |
4731 | & ISIGN(2,K(N+I,2)) | |
4732 | IF(P(N+I,5).GE.PMTH(2,IFLD)) INUM=I | |
4733 | ENDIF | |
4734 | 350 CONTINUE | |
4735 | IF(INUM.EQ.0) THEN | |
4736 | RMAX=0. | |
4737 | DO 360 I=1,NEP | |
4738 | IF(ISI(I).EQ.1.AND.PMSD(I).GE.PMQTH2) THEN | |
4739 | RPM=P(N+I,5)/PMSD(I) | |
4740 | IFLD=KFLD(I) | |
4741 | IF(KFLD(I).GE.6.AND.KFLD(I).LE.8) IFLD=37+KFLD(I)+ | |
4742 | & ISIGN(2,K(N+I,2)) | |
4743 | IF(RPM.GT.RMAX.AND.P(N+I,5).GE.PMTH(2,IFLD)) THEN | |
4744 | RMAX=RPM | |
4745 | INUM=I | |
4746 | ENDIF | |
4747 | ENDIF | |
4748 | 360 CONTINUE | |
4749 | ENDIF | |
4750 | ||
4751 | C...Store information on choice of evolving daughter. | |
4752 | INUM=MAX(1,INUM) | |
4753 | IEP(1)=N+INUM | |
4754 | DO 370 I=2,NEP | |
4755 | IEP(I)=IEP(I-1)+1 | |
4756 | IF(IEP(I).GT.N+NEP) IEP(I)=N+1 | |
4757 | 370 CONTINUE | |
4758 | DO 380 I=1,NEP | |
4759 | KFL(I)=IABS(K(IEP(I),2)) | |
4760 | 380 CONTINUE | |
4761 | ITRY(INUM)=ITRY(INUM)+1 | |
4762 | IF(ITRY(INUM).GT.200) THEN | |
4763 | CALL LYERRM(14,'(LYSHOW:) caught in infinite loop') | |
4764 | IF(MSTU(21).GE.1) RETURN | |
4765 | ENDIF | |
4766 | Z=0.5 | |
4767 | IF(KFL(1).GT.40) GOTO 430 | |
4768 | IF(KSH(KFL(1)).EQ.0) GOTO 430 | |
4769 | IFL=KFL(1) | |
4770 | IF(KFL(1).GE.6.AND.KFL(1).LE.8) IFL=37+KFL(1)+ | |
4771 | &ISIGN(2,K(IEP(1),2)) | |
4772 | IF(P(IEP(1),5).LT.PMTH(2,IFL)) GOTO 430 | |
4773 | ||
4774 | C...Select side for interference with initial state partons. | |
4775 | IF(MIIS.GE.1.AND.IEP(1).LE.NS+3) THEN | |
4776 | III=IEP(1)-NS-1 | |
4777 | ISII(III)=0 | |
4778 | IF(IABS(KCII(III)).EQ.1.AND.NIIS(III).EQ.1) THEN | |
4779 | ISII(III)=1 | |
4780 | ELSEIF(KCII(III).EQ.2.AND.NIIS(III).EQ.1) THEN | |
4781 | IF(RLY(0).GT.0.5) ISII(III)=1 | |
4782 | ELSEIF(KCII(III).EQ.2.AND.NIIS(III).EQ.2) THEN | |
4783 | ISII(III)=1 | |
4784 | IF(RLY(0).GT.0.5) ISII(III)=2 | |
4785 | ENDIF | |
4786 | ENDIF | |
4787 | ||
4788 | C...Calculate allowed z range. | |
4789 | IF(NEP.EQ.1) THEN | |
4790 | PMED=PS(4) | |
4791 | ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN | |
4792 | PMED=P(IM,5) | |
4793 | ELSE | |
4794 | IF(INUM.EQ.1) PMED=V(IM,1)*PEM | |
4795 | IF(INUM.EQ.2) PMED=(1.-V(IM,1))*PEM | |
4796 | ENDIF | |
4797 | IF(MOD(MSTJ(43),2).EQ.1) THEN | |
4798 | ZC=PMTH(2,21)/PMED | |
4799 | ZCE=PMTH(2,22)/PMED | |
4800 | ELSE | |
4801 | ZC=0.5*(1.-SQRT(MAX(0.,1.-(2.*PMTH(2,21)/PMED)**2))) | |
4802 | IF(ZC.LT.1E-4) ZC=(PMTH(2,21)/PMED)**2 | |
4803 | ZCE=0.5*(1.-SQRT(MAX(0.,1.-(2.*PMTH(2,22)/PMED)**2))) | |
4804 | IF(ZCE.LT.1E-4) ZCE=(PMTH(2,22)/PMED)**2 | |
4805 | ENDIF | |
4806 | ZC=MIN(ZC,0.491) | |
4807 | ZCE=MIN(ZCE,0.491) | |
4808 | IF((MSTJ(41).EQ.1.AND.ZC.GT.0.49).OR.(MSTJ(41).GE.2.AND. | |
4809 | &MIN(ZC,ZCE).GT.0.49)) THEN | |
4810 | P(IEP(1),5)=PMTH(1,IFL) | |
4811 | V(IEP(1),5)=P(IEP(1),5)**2 | |
4812 | GOTO 430 | |
4813 | ENDIF | |
4814 | ||
4815 | C...Integral of Altarelli-Parisi z kernel for QCD. | |
4816 | IF(MSTJ(49).EQ.0.AND.KFL(1).EQ.21) THEN | |
4817 | FBR=6.*LOG((1.-ZC)/ZC)+MSTJ(45)*(0.5-ZC) | |
4818 | ELSEIF(MSTJ(49).EQ.0) THEN | |
4819 | FBR=(8./3.)*LOG((1.-ZC)/ZC) | |
4820 | ||
4821 | C...Integral of Altarelli-Parisi z kernel for scalar gluon. | |
4822 | ELSEIF(MSTJ(49).EQ.1.AND.KFL(1).EQ.21) THEN | |
4823 | FBR=(PARJ(87)+MSTJ(45)*PARJ(88))*(1.-2.*ZC) | |
4824 | ELSEIF(MSTJ(49).EQ.1) THEN | |
4825 | FBR=(1.-2.*ZC)/3. | |
4826 | IF(IGM.EQ.0.AND.M3JC.EQ.1) FBR=4.*FBR | |
4827 | ||
4828 | C...Integral of Altarelli-Parisi z kernel for Abelian vector gluon. | |
4829 | ELSEIF(KFL(1).EQ.21) THEN | |
4830 | FBR=6.*MSTJ(45)*(0.5-ZC) | |
4831 | ELSE | |
4832 | FBR=2.*LOG((1.-ZC)/ZC) | |
4833 | ENDIF | |
4834 | ||
4835 | C...Reset QCD probability for lepton. | |
4836 | IF(KFL(1).GE.11.AND.KFL(1).LE.18) FBR=0. | |
4837 | ||
4838 | C...Integral of Altarelli-Parisi kernel for photon emission. | |
4839 | IF(MSTJ(41).GE.2.AND.KFL(1).GE.1.AND.KFL(1).LE.18) THEN | |
4840 | FBRE=(KCHG(KFL(1),1)/3.)**2*2.*LOG((1.-ZCE)/ZCE) | |
4841 | IF(MSTJ(41).EQ.10) FBRE=PARJ(84)*FBRE | |
4842 | ENDIF | |
4843 | ||
4844 | C...Inner veto algorithm starts. Find maximum mass for evolution. | |
4845 | 390 PMS=V(IEP(1),5) | |
4846 | IF(IGM.GE.0) THEN | |
4847 | PM2=0. | |
4848 | DO 400 I=2,NEP | |
4849 | PM=P(IEP(I),5) | |
4850 | IF(KFL(I).LE.40) THEN | |
4851 | IFLI=KFL(I) | |
4852 | IF(KFL(I).GE.6.AND.KFL(I).LE.8) IFLI=37+KFL(I)+ | |
4853 | & ISIGN(2,K(IEP(I),2)) | |
4854 | IF(KSH(KFL(I)).EQ.1) PM=PMTH(2,IFLI) | |
4855 | ENDIF | |
4856 | PM2=PM2+PM | |
4857 | 400 CONTINUE | |
4858 | PMS=MIN(PMS,(P(IM,5)-PM2)**2) | |
4859 | ENDIF | |
4860 | ||
4861 | C...Select mass for daughter in QCD evolution. | |
4862 | B0=27./6. | |
4863 | DO 410 IFF=4,MSTJ(45) | |
4864 | IF(PMS.GT.4.*PMTH(2,IFF)**2) B0=(33.-2.*IFF)/6. | |
4865 | 410 CONTINUE | |
4866 | IF(FBR.LT.1E-3) THEN | |
4867 | PMSQCD=0. | |
4868 | ELSEIF(MSTJ(44).LE.0) THEN | |
4869 | PMSQCD=PMS*EXP(MAX(-50.,LOG(RLY(0))*PARU(2)/(PARU(111)*FBR))) | |
4870 | ELSEIF(MSTJ(44).EQ.1) THEN | |
4871 | PMSQCD=4.*ALAMS*(0.25*PMS/ALAMS)**(RLY(0)**(B0/FBR)) | |
4872 | ELSE | |
4873 | PMSQCD=PMS*EXP(MAX(-50.,ALFM*B0*LOG(RLY(0))/FBR)) | |
4874 | ENDIF | |
4875 | IF(ZC.GT.0.49.OR.PMSQCD.LE.PMTH(4,IFL)**2) PMSQCD=PMTH(2,IFL)**2 | |
4876 | V(IEP(1),5)=PMSQCD | |
4877 | MCE=1 | |
4878 | ||
4879 | C...Select mass for daughter in QED evolution. | |
4880 | IF(MSTJ(41).GE.2.AND.KFL(1).GE.1.AND.KFL(1).LE.18) THEN | |
4881 | PMSQED=PMS*EXP(MAX(-50.,LOG(RLY(0))*PARU(2)/(PARU(101)*FBRE))) | |
4882 | IF(ZCE.GT.0.49.OR.PMSQED.LE.PMTH(5,IFL)**2) PMSQED= | |
4883 | & PMTH(2,IFL)**2 | |
4884 | IF(PMSQED.GT.PMSQCD) THEN | |
4885 | V(IEP(1),5)=PMSQED | |
4886 | MCE=2 | |
4887 | ENDIF | |
4888 | ENDIF | |
4889 | ||
4890 | C...Check whether daughter mass below cutoff. | |
4891 | P(IEP(1),5)=SQRT(V(IEP(1),5)) | |
4892 | IF(P(IEP(1),5).LE.PMTH(3,IFL)) THEN | |
4893 | P(IEP(1),5)=PMTH(1,IFL) | |
4894 | V(IEP(1),5)=P(IEP(1),5)**2 | |
4895 | GOTO 430 | |
4896 | ENDIF | |
4897 | ||
4898 | C...Select z value of branching: q -> qgamma. | |
4899 | IF(MCE.EQ.2) THEN | |
4900 | Z=1.-(1.-ZCE)*(ZCE/(1.-ZCE))**RLY(0) | |
4901 | IF(1.+Z**2.LT.2.*RLY(0)) GOTO 390 | |
4902 | K(IEP(1),5)=22 | |
4903 | ||
4904 | C...Select z value of branching: q -> qg, g -> gg, g -> qqbar. | |
4905 | ELSEIF(MSTJ(49).NE.1.AND.KFL(1).NE.21) THEN | |
4906 | Z=1.-(1.-ZC)*(ZC/(1.-ZC))**RLY(0) | |
4907 | IF(1.+Z**2.LT.2.*RLY(0)) GOTO 390 | |
4908 | K(IEP(1),5)=21 | |
4909 | ELSEIF(MSTJ(49).EQ.0.AND.MSTJ(45)*(0.5-ZC).LT.RLY(0)*FBR) THEN | |
4910 | Z=(1.-ZC)*(ZC/(1.-ZC))**RLY(0) | |
4911 | IF(RLY(0).GT.0.5) Z=1.-Z | |
4912 | IF((1.-Z*(1.-Z))**2.LT.RLY(0)) GOTO 390 | |
4913 | K(IEP(1),5)=21 | |
4914 | ELSEIF(MSTJ(49).NE.1) THEN | |
4915 | Z=ZC+(1.-2.*ZC)*RLY(0) | |
4916 | IF(Z**2+(1.-Z)**2.LT.RLY(0)) GOTO 390 | |
4917 | KFLB=1+INT(MSTJ(45)*RLY(0)) | |
4918 | PMQ=4.*PMTH(2,KFLB)**2/V(IEP(1),5) | |
4919 | IF(PMQ.GE.1.) GOTO 390 | |
4920 | PMQ0=4.*PMTH(2,21)**2/V(IEP(1),5) | |
4921 | IF(MOD(MSTJ(43),2).EQ.0.AND.(1.+0.5*PMQ)*SQRT(1.-PMQ).LT. | |
4922 | & RLY(0)*(1.+0.5*PMQ0)*SQRT(1.-PMQ0)) GOTO 390 | |
4923 | K(IEP(1),5)=KFLB | |
4924 | ||
4925 | C...Ditto for scalar gluon model. | |
4926 | ELSEIF(KFL(1).NE.21) THEN | |
4927 | Z=1.-SQRT(ZC**2+RLY(0)*(1.-2.*ZC)) | |
4928 | K(IEP(1),5)=21 | |
4929 | ELSEIF(RLY(0)*(PARJ(87)+MSTJ(45)*PARJ(88)).LE.PARJ(87)) THEN | |
4930 | Z=ZC+(1.-2.*ZC)*RLY(0) | |
4931 | K(IEP(1),5)=21 | |
4932 | ELSE | |
4933 | Z=ZC+(1.-2.*ZC)*RLY(0) | |
4934 | KFLB=1+INT(MSTJ(45)*RLY(0)) | |
4935 | PMQ=4.*PMTH(2,KFLB)**2/V(IEP(1),5) | |
4936 | IF(PMQ.GE.1.) GOTO 390 | |
4937 | K(IEP(1),5)=KFLB | |
4938 | ENDIF | |
4939 | IF(MCE.EQ.1.AND.MSTJ(44).GE.2) THEN | |
4940 | IF(Z*(1.-Z)*V(IEP(1),5).LT.PT2MIN) GOTO 390 | |
4941 | IF(ALFM/LOG(V(IEP(1),5)*Z*(1.-Z)/ALAMS).LT.RLY(0)) GOTO 390 | |
4942 | ENDIF | |
4943 | ||
4944 | C...Check if z consistent with chosen m. | |
4945 | IF(KFL(1).EQ.21) THEN | |
4946 | KFLGD1=IABS(K(IEP(1),5)) | |
4947 | KFLGD2=KFLGD1 | |
4948 | ELSE | |
4949 | KFLGD1=KFL(1) | |
4950 | KFLGD2=IABS(K(IEP(1),5)) | |
4951 | ENDIF | |
4952 | IF(NEP.EQ.1) THEN | |
4953 | PED=PS(4) | |
4954 | ELSEIF(NEP.GE.3) THEN | |
4955 | PED=P(IEP(1),4) | |
4956 | ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN | |
4957 | PED=0.5*(V(IM,5)+V(IEP(1),5)-PM2**2)/P(IM,5) | |
4958 | ELSE | |
4959 | IF(IEP(1).EQ.N+1) PED=V(IM,1)*PEM | |
4960 | IF(IEP(1).EQ.N+2) PED=(1.-V(IM,1))*PEM | |
4961 | ENDIF | |
4962 | IF(MOD(MSTJ(43),2).EQ.1) THEN | |
4963 | IFLGD1=KFLGD1 | |
4964 | IF(KFLGD1.GE.6.AND.KFLGD1.LE.8) IFLGD1=IFL | |
4965 | PMQTH3=0.5*PARJ(82) | |
4966 | IF(KFLGD2.EQ.22) PMQTH3=0.5*PARJ(83) | |
4967 | PMQ1=(PMTH(1,IFLGD1)**2+PMQTH3**2)/V(IEP(1),5) | |
4968 | PMQ2=(PMTH(1,KFLGD2)**2+PMQTH3**2)/V(IEP(1),5) | |
4969 | ZD=SQRT(MAX(0.,(1.-V(IEP(1),5)/PED**2)*((1.-PMQ1-PMQ2)**2- | |
4970 | & 4.*PMQ1*PMQ2))) | |
4971 | ZH=1.+PMQ1-PMQ2 | |
4972 | ELSE | |
4973 | ZD=SQRT(MAX(0.,1.-V(IEP(1),5)/PED**2)) | |
4974 | ZH=1. | |
4975 | ENDIF | |
4976 | ZL=0.5*(ZH-ZD) | |
4977 | ZU=0.5*(ZH+ZD) | |
4978 | IF(Z.LT.ZL.OR.Z.GT.ZU) GOTO 390 | |
4979 | IF(KFL(1).EQ.21) V(IEP(1),3)=LOG(ZU*(1.-ZL)/MAX(1E-20,ZL* | |
4980 | &(1.-ZU))) | |
4981 | IF(KFL(1).NE.21) V(IEP(1),3)=LOG((1.-ZL)/MAX(1E-10,1.-ZU)) | |
4982 | ||
4983 | C...Width suppression for q -> q + g. | |
4984 | IF(MSTJ(40).NE.0.AND.KFL(1).NE.21) THEN | |
4985 | IF(IGM.EQ.0) THEN | |
4986 | EGLU=0.5*PS(5)*(1.-Z)*(1.+V(IEP(1),5)/V(NS+1,5)) | |
4987 | ELSE | |
4988 | EGLU=PMED*(1.-Z) | |
4989 | ENDIF | |
4990 | CHI=PARJ(89)**2/(PARJ(89)**2+EGLU**2) | |
4991 | IF(MSTJ(40).EQ.1) THEN | |
4992 | IF(CHI.LT.RLY(0)) GOTO 390 | |
4993 | ELSEIF(MSTJ(40).EQ.2) THEN | |
4994 | IF(1.-CHI.LT.RLY(0)) GOTO 390 | |
4995 | ENDIF | |
4996 | ENDIF | |
4997 | ||
4998 | C...Three-jet matrix element correction. | |
4999 | IF(IGM.EQ.0.AND.M3JC.EQ.1) THEN | |
5000 | X1=Z*(1.+V(IEP(1),5)/V(NS+1,5)) | |
5001 | X2=1.-V(IEP(1),5)/V(NS+1,5) | |
5002 | X3=(1.-X1)+(1.-X2) | |
5003 | IF(MCE.EQ.2) THEN | |
5004 | KI1=K(IPA(INUM),2) | |
5005 | KI2=K(IPA(3-INUM),2) | |
5006 | QF1=KCHG(IABS(KI1),1)*ISIGN(1,KI1)/3. | |
5007 | QF2=KCHG(IABS(KI2),1)*ISIGN(1,KI2)/3. | |
5008 | WSHOW=QF1**2*(1.-X1)/X3*(1.+(X1/(2.-X2))**2)+ | |
5009 | & QF2**2*(1.-X2)/X3*(1.+(X2/(2.-X1))**2) | |
5010 | WME=(QF1*(1.-X1)/X3-QF2*(1.-X2)/X3)**2*(X1**2+X2**2) | |
5011 | ELSEIF(MSTJ(49).NE.1) THEN | |
5012 | WSHOW=1.+(1.-X1)/X3*(X1/(2.-X2))**2+ | |
5013 | & (1.-X2)/X3*(X2/(2.-X1))**2 | |
5014 | WME=X1**2+X2**2 | |
5015 | IF(M3JCM.EQ.1) WME=WME-QME*X3-0.5*QME**2- | |
5016 | & (0.5*QME+0.25*QME**2)*((1.-X2)/MAX(1E-7,1.-X1)+ | |
5017 | & (1.-X1)/MAX(1E-7,1.-X2)) | |
5018 | ELSE | |
5019 | WSHOW=4.*X3*((1.-X1)/(2.-X2)**2+(1.-X2)/(2.-X1)**2) | |
5020 | WME=X3**2 | |
5021 | IF(MSTJ(102).GE.2) WME=X3**2-2.*(1.+X3)*(1.-X1)*(1.-X2)* | |
5022 | & PARJ(171) | |
5023 | ENDIF | |
5024 | IF(WME.LT.RLY(0)*WSHOW) GOTO 390 | |
5025 | ||
5026 | C...Impose angular ordering by rejection of nonordered emission. | |
5027 | ELSEIF(MCE.EQ.1.AND.IGM.GT.0.AND.MSTJ(42).GE.2) THEN | |
5028 | MAOM=1 | |
5029 | ZM=V(IM,1) | |
5030 | IF(IEP(1).EQ.N+2) ZM=1.-V(IM,1) | |
5031 | THE2ID=Z*(1.-Z)*(ZM*P(IM,4))**2/V(IEP(1),5) | |
5032 | IAOM=IM | |
5033 | 420 IF(K(IAOM,5).EQ.22) THEN | |
5034 | IAOM=K(IAOM,3) | |
5035 | IF(K(IAOM,3).LE.NS) MAOM=0 | |
5036 | IF(MAOM.EQ.1) GOTO 420 | |
5037 | ENDIF | |
5038 | IF(MAOM.EQ.1) THEN | |
5039 | THE2IM=V(IAOM,1)*(1.-V(IAOM,1))*P(IAOM,4)**2/V(IAOM,5) | |
5040 | IF(THE2ID.LT.THE2IM) GOTO 390 | |
5041 | ENDIF | |
5042 | ENDIF | |
5043 | ||
5044 | C...Impose user-defined maximum angle at first branching. | |
5045 | IF(MSTJ(48).EQ.1) THEN | |
5046 | IF(NEP.EQ.1.AND.IM.EQ.NS) THEN | |
5047 | THE2ID=Z*(1.-Z)*PS(4)**2/V(IEP(1),5) | |
5048 | IF(THE2ID.LT.1./PARJ(85)**2) GOTO 390 | |
5049 | ELSEIF(NEP.EQ.2.AND.IEP(1).EQ.NS+2) THEN | |
5050 | THE2ID=Z*(1.-Z)*(0.5*P(IM,4))**2/V(IEP(1),5) | |
5051 | IF(THE2ID.LT.1./PARJ(85)**2) GOTO 390 | |
5052 | ELSEIF(NEP.EQ.2.AND.IEP(1).EQ.NS+3) THEN | |
5053 | THE2ID=Z*(1.-Z)*(0.5*P(IM,4))**2/V(IEP(1),5) | |
5054 | IF(THE2ID.LT.1./PARJ(86)**2) GOTO 390 | |
5055 | ENDIF | |
5056 | ENDIF | |
5057 | ||
5058 | C...Impose angular constraint in first branching from interference | |
5059 | C...with initial state partons. | |
5060 | IF(MIIS.GE.2.AND.IEP(1).LE.NS+3) THEN | |
5061 | THE2D=MAX((1.-Z)/Z,Z/(1.-Z))*V(IEP(1),5)/(0.5*P(IM,4))**2 | |
5062 | IF(IEP(1).EQ.NS+2.AND.ISII(1).GE.1) THEN | |
5063 | IF(THE2D.GT.THEIIS(1,ISII(1))**2) GOTO 390 | |
5064 | ELSEIF(IEP(1).EQ.NS+3.AND.ISII(2).GE.1) THEN | |
5065 | IF(THE2D.GT.THEIIS(2,ISII(2))**2) GOTO 390 | |
5066 | ENDIF | |
5067 | ENDIF | |
5068 | ||
5069 | C...End of inner veto algorithm. Check if only one leg evolved so far. | |
5070 | 430 V(IEP(1),1)=Z | |
5071 | ISL(1)=0 | |
5072 | ISL(2)=0 | |
5073 | IF(NEP.EQ.1) GOTO 460 | |
5074 | IF(NEP.EQ.2.AND.P(IEP(1),5)+P(IEP(2),5).GE.P(IM,5)) GOTO 330 | |
5075 | DO 440 I=1,NEP | |
5076 | IF(ITRY(I).EQ.0.AND.KFLD(I).LE.40) THEN | |
5077 | IF(KSH(KFLD(I)).EQ.1) THEN | |
5078 | IFLD=KFLD(I) | |
5079 | IF(KFLD(I).GE.6.AND.KFLD(I).LE.8) IFLD=37+KFLD(I)+ | |
5080 | & ISIGN(2,K(N+I,2)) | |
5081 | IF(P(N+I,5).GE.PMTH(2,IFLD)) GOTO 330 | |
5082 | ENDIF | |
5083 | ENDIF | |
5084 | 440 CONTINUE | |
5085 | ||
5086 | C...Check if chosen multiplet m1,m2,z1,z2 is physical. | |
5087 | IF(NEP.EQ.3) THEN | |
5088 | PA1S=(P(N+1,4)+P(N+1,5))*(P(N+1,4)-P(N+1,5)) | |
5089 | PA2S=(P(N+2,4)+P(N+2,5))*(P(N+2,4)-P(N+2,5)) | |
5090 | PA3S=(P(N+3,4)+P(N+3,5))*(P(N+3,4)-P(N+3,5)) | |
5091 | PTS=0.25*(2.*PA1S*PA2S+2.*PA1S*PA3S+2.*PA2S*PA3S- | |
5092 | & PA1S**2-PA2S**2-PA3S**2)/PA1S | |
5093 | IF(PTS.LE.0.) GOTO 330 | |
5094 | ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2.OR.MOD(MSTJ(43),2).EQ.0) THEN | |
5095 | DO 450 I1=N+1,N+2 | |
5096 | KFLDA=IABS(K(I1,2)) | |
5097 | IF(KFLDA.GT.40) GOTO 450 | |
5098 | IF(KSH(KFLDA).EQ.0) GOTO 450 | |
5099 | IFLDA=KFLDA | |
5100 | IF(KFLDA.GE.6.AND.KFLDA.LE.8) IFLDA=37+KFLDA+ | |
5101 | & ISIGN(2,K(I1,2)) | |
5102 | IF(P(I1,5).LT.PMTH(2,IFLDA)) GOTO 450 | |
5103 | IF(KFLDA.EQ.21) THEN | |
5104 | KFLGD1=IABS(K(I1,5)) | |
5105 | KFLGD2=KFLGD1 | |
5106 | ELSE | |
5107 | KFLGD1=KFLDA | |
5108 | KFLGD2=IABS(K(I1,5)) | |
5109 | ENDIF | |
5110 | I2=2*N+3-I1 | |
5111 | IF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN | |
5112 | PED=0.5*(V(IM,5)+V(I1,5)-V(I2,5))/P(IM,5) | |
5113 | ELSE | |
5114 | IF(I1.EQ.N+1) ZM=V(IM,1) | |
5115 | IF(I1.EQ.N+2) ZM=1.-V(IM,1) | |
5116 | PML=SQRT((V(IM,5)-V(N+1,5)-V(N+2,5))**2- | |
5117 | & 4.*V(N+1,5)*V(N+2,5)) | |
5118 | PED=PEM*(0.5*(V(IM,5)-PML+V(I1,5)-V(I2,5))+PML*ZM)/V(IM,5) | |
5119 | ENDIF | |
5120 | IF(MOD(MSTJ(43),2).EQ.1) THEN | |
5121 | PMQTH3=0.5*PARJ(82) | |
5122 | IF(KFLGD2.EQ.22) PMQTH3=0.5*PARJ(83) | |
5123 | IFLGD1=KFLGD1 | |
5124 | IF(KFLGD1.GE.6.AND.KFLGD1.LE.8) IFLGD1=IFLDA | |
5125 | PMQ1=(PMTH(1,IFLGD1)**2+PMQTH3**2)/V(I1,5) | |
5126 | PMQ2=(PMTH(1,KFLGD2)**2+PMQTH3**2)/V(I1,5) | |
5127 | ZD=SQRT(MAX(0.,(1.-V(I1,5)/PED**2)*((1.-PMQ1-PMQ2)**2- | |
5128 | & 4.*PMQ1*PMQ2))) | |
5129 | ZH=1.+PMQ1-PMQ2 | |
5130 | ELSE | |
5131 | ZD=SQRT(MAX(0.,1.-V(I1,5)/PED**2)) | |
5132 | ZH=1. | |
5133 | ENDIF | |
5134 | ZL=0.5*(ZH-ZD) | |
5135 | ZU=0.5*(ZH+ZD) | |
5136 | IF(I1.EQ.N+1.AND.(V(I1,1).LT.ZL.OR.V(I1,1).GT.ZU)) ISL(1)=1 | |
5137 | IF(I1.EQ.N+2.AND.(V(I1,1).LT.ZL.OR.V(I1,1).GT.ZU)) ISL(2)=1 | |
5138 | IF(KFLDA.EQ.21) V(I1,4)=LOG(ZU*(1.-ZL)/MAX(1E-20,ZL*(1.-ZU))) | |
5139 | IF(KFLDA.NE.21) V(I1,4)=LOG((1.-ZL)/MAX(1E-10,1.-ZU)) | |
5140 | 450 CONTINUE | |
5141 | IF(ISL(1).EQ.1.AND.ISL(2).EQ.1.AND.ISLM.NE.0) THEN | |
5142 | ISL(3-ISLM)=0 | |
5143 | ISLM=3-ISLM | |
5144 | ELSEIF(ISL(1).EQ.1.AND.ISL(2).EQ.1) THEN | |
5145 | ZDR1=MAX(0.,V(N+1,3)/MAX(1E-6,V(N+1,4))-1.) | |
5146 | ZDR2=MAX(0.,V(N+2,3)/MAX(1E-6,V(N+2,4))-1.) | |
5147 | IF(ZDR2.GT.RLY(0)*(ZDR1+ZDR2)) ISL(1)=0 | |
5148 | IF(ISL(1).EQ.1) ISL(2)=0 | |
5149 | IF(ISL(1).EQ.0) ISLM=1 | |
5150 | IF(ISL(2).EQ.0) ISLM=2 | |
5151 | ENDIF | |
5152 | IF(ISL(1).EQ.1.OR.ISL(2).EQ.1) GOTO 330 | |
5153 | ENDIF | |
5154 | IFLD1=KFLD(1) | |
5155 | IF(KFLD(1).GE.6.AND.KFLD(1).LE.8) IFLD1=37+KFLD(1)+ | |
5156 | &ISIGN(2,K(N+1,2)) | |
5157 | IFLD2=KFLD(2) | |
5158 | IF(KFLD(2).GE.6.AND.KFLD(2).LE.8) IFLD2=37+KFLD(2)+ | |
5159 | &ISIGN(2,K(N+2,2)) | |
5160 | IF(IGM.GT.0.AND.MOD(MSTJ(43),2).EQ.1.AND.(P(N+1,5).GE. | |
5161 | &PMTH(2,IFLD1).OR.P(N+2,5).GE.PMTH(2,IFLD2))) THEN | |
5162 | PMQ1=V(N+1,5)/V(IM,5) | |
5163 | PMQ2=V(N+2,5)/V(IM,5) | |
5164 | ZD=SQRT(MAX(0.,(1.-V(IM,5)/PEM**2)*((1.-PMQ1-PMQ2)**2- | |
5165 | & 4.*PMQ1*PMQ2))) | |
5166 | ZH=1.+PMQ1-PMQ2 | |
5167 | ZL=0.5*(ZH-ZD) | |
5168 | ZU=0.5*(ZH+ZD) | |
5169 | IF(V(IM,1).LT.ZL.OR.V(IM,1).GT.ZU) GOTO 330 | |
5170 | ENDIF | |
5171 | ||
5172 | C...Accepted branch. Construct four-momentum for initial partons. | |
5173 | 460 MAZIP=0 | |
5174 | MAZIC=0 | |
5175 | IF(NEP.EQ.1) THEN | |
5176 | P(N+1,1)=0. | |
5177 | P(N+1,2)=0. | |
5178 | P(N+1,3)=SQRT(MAX(0.,(P(IPA(1),4)+P(N+1,5))*(P(IPA(1),4)- | |
5179 | & P(N+1,5)))) | |
5180 | P(N+1,4)=P(IPA(1),4) | |
5181 | V(N+1,2)=P(N+1,4) | |
5182 | ELSEIF(IGM.EQ.0.AND.NEP.EQ.2) THEN | |
5183 | PED1=0.5*(V(IM,5)+V(N+1,5)-V(N+2,5))/P(IM,5) | |
5184 | P(N+1,1)=0. | |
5185 | P(N+1,2)=0. | |
5186 | P(N+1,3)=SQRT(MAX(0.,(PED1+P(N+1,5))*(PED1-P(N+1,5)))) | |
5187 | P(N+1,4)=PED1 | |
5188 | P(N+2,1)=0. | |
5189 | P(N+2,2)=0. | |
5190 | P(N+2,3)=-P(N+1,3) | |
5191 | P(N+2,4)=P(IM,5)-PED1 | |
5192 | V(N+1,2)=P(N+1,4) | |
5193 | V(N+2,2)=P(N+2,4) | |
5194 | ELSEIF(NEP.EQ.3) THEN | |
5195 | P(N+1,1)=0. | |
5196 | P(N+1,2)=0. | |
5197 | P(N+1,3)=SQRT(MAX(0.,PA1S)) | |
5198 | P(N+2,1)=SQRT(PTS) | |
5199 | P(N+2,2)=0. | |
5200 | P(N+2,3)=0.5*(PA3S-PA2S-PA1S)/P(N+1,3) | |
5201 | P(N+3,1)=-P(N+2,1) | |
5202 | P(N+3,2)=0. | |
5203 | P(N+3,3)=-(P(N+1,3)+P(N+2,3)) | |
5204 | V(N+1,2)=P(N+1,4) | |
5205 | V(N+2,2)=P(N+2,4) | |
5206 | V(N+3,2)=P(N+3,4) | |
5207 | ||
5208 | C...Construct transverse momentum for ordinary branching in shower. | |
5209 | ELSE | |
5210 | ZM=V(IM,1) | |
5211 | PZM=SQRT(MAX(0.,(PEM+P(IM,5))*(PEM-P(IM,5)))) | |
5212 | PMLS=(V(IM,5)-V(N+1,5)-V(N+2,5))**2-4.*V(N+1,5)*V(N+2,5) | |
5213 | IF(PZM.LE.0.) THEN | |
5214 | PTS=0. | |
5215 | ELSEIF(MOD(MSTJ(43),2).EQ.1) THEN | |
5216 | PTS=(PEM**2*(ZM*(1.-ZM)*V(IM,5)-(1.-ZM)*V(N+1,5)- | |
5217 | & ZM*V(N+2,5))-0.25*PMLS)/PZM**2 | |
5218 | ELSE | |
5219 | PTS=PMLS*(ZM*(1.-ZM)*PEM**2/V(IM,5)-0.25)/PZM**2 | |
5220 | ENDIF | |
5221 | PT=SQRT(MAX(0.,PTS)) | |
5222 | ||
5223 | C...Find coefficient of azimuthal asymmetry due to gluon polarization. | |
5224 | HAZIP=0. | |
5225 | IF(MSTJ(49).NE.1.AND.MOD(MSTJ(46),2).EQ.1.AND.K(IM,2).EQ.21. | |
5226 | & AND.IAU.NE.0) THEN | |
5227 | IF(K(IGM,3).NE.0) MAZIP=1 | |
5228 | ZAU=V(IGM,1) | |
5229 | IF(IAU.EQ.IM+1) ZAU=1.-V(IGM,1) | |
5230 | IF(MAZIP.EQ.0) ZAU=0. | |
5231 | IF(K(IGM,2).NE.21) THEN | |
5232 | HAZIP=2.*ZAU/(1.+ZAU**2) | |
5233 | ELSE | |
5234 | HAZIP=(ZAU/(1.-ZAU*(1.-ZAU)))**2 | |
5235 | ENDIF | |
5236 | IF(K(N+1,2).NE.21) THEN | |
5237 | HAZIP=HAZIP*(-2.*ZM*(1.-ZM))/(1.-2.*ZM*(1.-ZM)) | |
5238 | ELSE | |
5239 | HAZIP=HAZIP*(ZM*(1.-ZM)/(1.-ZM*(1.-ZM)))**2 | |
5240 | ENDIF | |
5241 | ENDIF | |
5242 | ||
5243 | C...Find coefficient of azimuthal asymmetry due to soft gluon | |
5244 | C...interference. | |
5245 | HAZIC=0. | |
5246 | IF(MSTJ(49).NE.2.AND.MSTJ(46).GE.2.AND.(K(N+1,2).EQ.21.OR. | |
5247 | & K(N+2,2).EQ.21).AND.IAU.NE.0) THEN | |
5248 | IF(K(IGM,3).NE.0) MAZIC=N+1 | |
5249 | IF(K(IGM,3).NE.0.AND.K(N+1,2).NE.21) MAZIC=N+2 | |
5250 | IF(K(IGM,3).NE.0.AND.K(N+1,2).EQ.21.AND.K(N+2,2).EQ.21.AND. | |
5251 | & ZM.GT.0.5) MAZIC=N+2 | |
5252 | IF(K(IAU,2).EQ.22) MAZIC=0 | |
5253 | ZS=ZM | |
5254 | IF(MAZIC.EQ.N+2) ZS=1.-ZM | |
5255 | ZGM=V(IGM,1) | |
5256 | IF(IAU.EQ.IM-1) ZGM=1.-V(IGM,1) | |
5257 | IF(MAZIC.EQ.0) ZGM=1. | |
5258 | IF(MAZIC.NE.0) HAZIC=(P(IM,5)/P(IGM,5))* | |
5259 | & SQRT((1.-ZS)*(1.-ZGM)/(ZS*ZGM)) | |
5260 | HAZIC=MIN(0.95,HAZIC) | |
5261 | ENDIF | |
5262 | ENDIF | |
5263 | ||
5264 | C...Construct kinematics for ordinary branching in shower. | |
5265 | 470 IF(NEP.EQ.2.AND.IGM.GT.0) THEN | |
5266 | IF(MOD(MSTJ(43),2).EQ.1) THEN | |
5267 | P(N+1,4)=PEM*V(IM,1) | |
5268 | ELSE | |
5269 | P(N+1,4)=PEM*(0.5*(V(IM,5)-SQRT(PMLS)+V(N+1,5)-V(N+2,5))+ | |
5270 | & SQRT(PMLS)*ZM)/V(IM,5) | |
5271 | ENDIF | |
5272 | PHI=PARU(2)*RLY(0) | |
5273 | P(N+1,1)=PT*COS(PHI) | |
5274 | P(N+1,2)=PT*SIN(PHI) | |
5275 | IF(PZM.GT.0.) THEN | |
5276 | P(N+1,3)=0.5*(V(N+2,5)-V(N+1,5)-V(IM,5)+2.*PEM*P(N+1,4))/PZM | |
5277 | ELSE | |
5278 | P(N+1,3)=0. | |
5279 | ENDIF | |
5280 | P(N+2,1)=-P(N+1,1) | |
5281 | P(N+2,2)=-P(N+1,2) | |
5282 | P(N+2,3)=PZM-P(N+1,3) | |
5283 | P(N+2,4)=PEM-P(N+1,4) | |
5284 | IF(MSTJ(43).LE.2) THEN | |
5285 | V(N+1,2)=(PEM*P(N+1,4)-PZM*P(N+1,3))/P(IM,5) | |
5286 | V(N+2,2)=(PEM*P(N+2,4)-PZM*P(N+2,3))/P(IM,5) | |
5287 | ENDIF | |
5288 | ENDIF | |
5289 | ||
5290 | C...Rotate and boost daughters. | |
5291 | IF(IGM.GT.0) THEN | |
5292 | IF(MSTJ(43).LE.2) THEN | |
5293 | BEX=P(IGM,1)/P(IGM,4) | |
5294 | BEY=P(IGM,2)/P(IGM,4) | |
5295 | BEZ=P(IGM,3)/P(IGM,4) | |
5296 | GA=P(IGM,4)/P(IGM,5) | |
5297 | GABEP=GA*(GA*(BEX*P(IM,1)+BEY*P(IM,2)+BEZ*P(IM,3))/(1.+GA)- | |
5298 | & P(IM,4)) | |
5299 | ELSE | |
5300 | BEX=0. | |
5301 | BEY=0. | |
5302 | BEZ=0. | |
5303 | GA=1. | |
5304 | GABEP=0. | |
5305 | ENDIF | |
5306 | THE=UYANGL(P(IM,3)+GABEP*BEZ,SQRT((P(IM,1)+GABEP*BEX)**2+ | |
5307 | & (P(IM,2)+GABEP*BEY)**2)) | |
5308 | PHI=UYANGL(P(IM,1)+GABEP*BEX,P(IM,2)+GABEP*BEY) | |
5309 | DO 480 I=N+1,N+2 | |
5310 | DP(1)=COS(THE)*COS(PHI)*P(I,1)-SIN(PHI)*P(I,2)+ | |
5311 | & SIN(THE)*COS(PHI)*P(I,3) | |
5312 | DP(2)=COS(THE)*SIN(PHI)*P(I,1)+COS(PHI)*P(I,2)+ | |
5313 | & SIN(THE)*SIN(PHI)*P(I,3) | |
5314 | DP(3)=-SIN(THE)*P(I,1)+COS(THE)*P(I,3) | |
5315 | DP(4)=P(I,4) | |
5316 | DBP=BEX*DP(1)+BEY*DP(2)+BEZ*DP(3) | |
5317 | DGABP=GA*(GA*DBP/(1D0+GA)+DP(4)) | |
5318 | P(I,1)=DP(1)+DGABP*BEX | |
5319 | P(I,2)=DP(2)+DGABP*BEY | |
5320 | P(I,3)=DP(3)+DGABP*BEZ | |
5321 | P(I,4)=GA*(DP(4)+DBP) | |
5322 | 480 CONTINUE | |
5323 | ENDIF | |
5324 | ||
5325 | C...Weight with azimuthal distribution, if required. | |
5326 | IF(MAZIP.NE.0.OR.MAZIC.NE.0) THEN | |
5327 | DO 490 J=1,3 | |
5328 | DPT(1,J)=P(IM,J) | |
5329 | DPT(2,J)=P(IAU,J) | |
5330 | DPT(3,J)=P(N+1,J) | |
5331 | 490 CONTINUE | |
5332 | DPMA=DPT(1,1)*DPT(2,1)+DPT(1,2)*DPT(2,2)+DPT(1,3)*DPT(2,3) | |
5333 | DPMD=DPT(1,1)*DPT(3,1)+DPT(1,2)*DPT(3,2)+DPT(1,3)*DPT(3,3) | |
5334 | DPMM=DPT(1,1)**2+DPT(1,2)**2+DPT(1,3)**2 | |
5335 | DO 500 J=1,3 | |
5336 | DPT(4,J)=DPT(2,J)-DPMA*DPT(1,J)/DPMM | |
5337 | DPT(5,J)=DPT(3,J)-DPMD*DPT(1,J)/DPMM | |
5338 | 500 CONTINUE | |
5339 | DPT(4,4)=SQRT(DPT(4,1)**2+DPT(4,2)**2+DPT(4,3)**2) | |
5340 | DPT(5,4)=SQRT(DPT(5,1)**2+DPT(5,2)**2+DPT(5,3)**2) | |
5341 | IF(MIN(DPT(4,4),DPT(5,4)).GT.0.1*PARJ(82)) THEN | |
5342 | CAD=(DPT(4,1)*DPT(5,1)+DPT(4,2)*DPT(5,2)+ | |
5343 | & DPT(4,3)*DPT(5,3))/(DPT(4,4)*DPT(5,4)) | |
5344 | IF(MAZIP.NE.0) THEN | |
5345 | IF(1.+HAZIP*(2.*CAD**2-1.).LT.RLY(0)*(1.+ABS(HAZIP))) | |
5346 | & GOTO 470 | |
5347 | ENDIF | |
5348 | IF(MAZIC.NE.0) THEN | |
5349 | IF(MAZIC.EQ.N+2) CAD=-CAD | |
5350 | IF((1.-HAZIC)*(1.-HAZIC*CAD)/(1.+HAZIC**2-2.*HAZIC*CAD) | |
5351 | & .LT.RLY(0)) GOTO 470 | |
5352 | ENDIF | |
5353 | ENDIF | |
5354 | ENDIF | |
5355 | ||
5356 | C...Azimuthal anisotropy due to interference with initial state partons. | |
5357 | IF(MOD(MIIS,2).EQ.1.AND.IGM.EQ.NS+1.AND.(K(N+1,2).EQ.21.OR. | |
5358 | &K(N+2,2).EQ.21)) THEN | |
5359 | III=IM-NS-1 | |
5360 | IF(ISII(III).GE.1) THEN | |
5361 | IAZIID=N+1 | |
5362 | IF(K(N+1,2).NE.21) IAZIID=N+2 | |
5363 | IF(K(N+1,2).EQ.21.AND.K(N+2,2).EQ.21.AND. | |
5364 | & P(N+1,4).GT.P(N+2,4)) IAZIID=N+2 | |
5365 | THEIID=UYANGL(P(IAZIID,3),SQRT(P(IAZIID,1)**2+P(IAZIID,2)**2)) | |
5366 | IF(III.EQ.2) THEIID=PARU(1)-THEIID | |
5367 | PHIIID=UYANGL(P(IAZIID,1),P(IAZIID,2)) | |
5368 | HAZII=MIN(0.95,THEIID/THEIIS(III,ISII(III))) | |
5369 | CAD=COS(PHIIID-PHIIIS(III,ISII(III))) | |
5370 | PHIREL=ABS(PHIIID-PHIIIS(III,ISII(III))) | |
5371 | IF(PHIREL.GT.PARU(1)) PHIREL=PARU(2)-PHIREL | |
5372 | IF((1.-HAZII)*(1.-HAZII*CAD)/(1.+HAZII**2-2.*HAZII*CAD) | |
5373 | & .LT.RLY(0)) GOTO 470 | |
5374 | ENDIF | |
5375 | ENDIF | |
5376 | ||
5377 | C...Continue loop over partons that may branch, until none left. | |
5378 | IF(IGM.GE.0) K(IM,1)=14 | |
5379 | N=N+NEP | |
5380 | NEP=2 | |
5381 | IF(N.GT.MSTU(4)-MSTU(32)-5) THEN | |
5382 | CALL LYERRM(11,'(LYSHOW:) no more memory left in LUJETS') | |
5383 | IF(MSTU(21).GE.1) N=NS | |
5384 | IF(MSTU(21).GE.1) RETURN | |
5385 | ENDIF | |
5386 | GOTO 270 | |
5387 | ||
5388 | C...Set information on imagined shower initiator. | |
5389 | 510 IF(NPA.GE.2) THEN | |
5390 | K(NS+1,1)=11 | |
5391 | K(NS+1,2)=94 | |
5392 | K(NS+1,3)=IP1 | |
5393 | IF(IP2.GT.0.AND.IP2.LT.IP1) K(NS+1,3)=IP2 | |
5394 | K(NS+1,4)=NS+2 | |
5395 | K(NS+1,5)=NS+1+NPA | |
5396 | IIM=1 | |
5397 | ELSE | |
5398 | IIM=0 | |
5399 | ENDIF | |
5400 | ||
5401 | C...Reconstruct string drawing information. | |
5402 | DO 520 I=NS+1+IIM,N | |
5403 | IF(K(I,1).LE.10.AND.K(I,2).EQ.22) THEN | |
5404 | K(I,1)=1 | |
5405 | ELSEIF(K(I,1).LE.10.AND.IABS(K(I,2)).GE.11.AND. | |
5406 | &IABS(K(I,2)).LE.18) THEN | |
5407 | K(I,1)=1 | |
5408 | ELSEIF(K(I,1).LE.10) THEN | |
5409 | K(I,4)=MSTU(5)*(K(I,4)/MSTU(5)) | |
5410 | K(I,5)=MSTU(5)*(K(I,5)/MSTU(5)) | |
5411 | ELSEIF(K(MOD(K(I,4),MSTU(5))+1,2).NE.22) THEN | |
5412 | ID1=MOD(K(I,4),MSTU(5)) | |
5413 | IF(K(I,2).GE.1.AND.K(I,2).LE.8) ID1=MOD(K(I,4),MSTU(5))+1 | |
5414 | ID2=2*MOD(K(I,4),MSTU(5))+1-ID1 | |
5415 | K(I,4)=MSTU(5)*(K(I,4)/MSTU(5))+ID1 | |
5416 | K(I,5)=MSTU(5)*(K(I,5)/MSTU(5))+ID2 | |
5417 | K(ID1,4)=K(ID1,4)+MSTU(5)*I | |
5418 | K(ID1,5)=K(ID1,5)+MSTU(5)*ID2 | |
5419 | K(ID2,4)=K(ID2,4)+MSTU(5)*ID1 | |
5420 | K(ID2,5)=K(ID2,5)+MSTU(5)*I | |
5421 | ELSE | |
5422 | ID1=MOD(K(I,4),MSTU(5)) | |
5423 | ID2=ID1+1 | |
5424 | K(I,4)=MSTU(5)*(K(I,4)/MSTU(5))+ID1 | |
5425 | K(I,5)=MSTU(5)*(K(I,5)/MSTU(5))+ID1 | |
5426 | IF(IABS(K(I,2)).LE.10.OR.K(ID1,1).GE.11) THEN | |
5427 | K(ID1,4)=K(ID1,4)+MSTU(5)*I | |
5428 | K(ID1,5)=K(ID1,5)+MSTU(5)*I | |
5429 | ELSE | |
5430 | K(ID1,4)=0 | |
5431 | K(ID1,5)=0 | |
5432 | ENDIF | |
5433 | K(ID2,4)=0 | |
5434 | K(ID2,5)=0 | |
5435 | ENDIF | |
5436 | 520 CONTINUE | |
5437 | ||
5438 | C...Transformation from CM frame. | |
5439 | IF(NPA.GE.2) THEN | |
5440 | BEX=PS(1)/PS(4) | |
5441 | BEY=PS(2)/PS(4) | |
5442 | BEZ=PS(3)/PS(4) | |
5443 | GA=PS(4)/PS(5) | |
5444 | GABEP=GA*(GA*(BEX*P(IPA(1),1)+BEY*P(IPA(1),2)+BEZ*P(IPA(1),3)) | |
5445 | & /(1.+GA)-P(IPA(1),4)) | |
5446 | ELSE | |
5447 | BEX=0. | |
5448 | BEY=0. | |
5449 | BEZ=0. | |
5450 | GABEP=0. | |
5451 | ENDIF | |
5452 | THE=UYANGL(P(IPA(1),3)+GABEP*BEZ,SQRT((P(IPA(1),1) | |
5453 | &+GABEP*BEX)**2+(P(IPA(1),2)+GABEP*BEY)**2)) | |
5454 | PHI=UYANGL(P(IPA(1),1)+GABEP*BEX,P(IPA(1),2)+GABEP*BEY) | |
5455 | IF(NPA.EQ.3) THEN | |
5456 | CHI=UYANGL(COS(THE)*COS(PHI)*(P(IPA(2),1)+GABEP*BEX)+COS(THE)* | |
5457 | & SIN(PHI)*(P(IPA(2),2)+GABEP*BEY)-SIN(THE)*(P(IPA(2),3)+GABEP* | |
5458 | & BEZ),-SIN(PHI)*(P(IPA(2),1)+GABEP*BEX)+COS(PHI)*(P(IPA(2),2)+ | |
5459 | & GABEP*BEY)) | |
5460 | MSTU(33)=1 | |
5461 | CALL LUDBRB(NS+1,N,0.,CHI,0D0,0D0,0D0) | |
5462 | ENDIF | |
5463 | DBEX=DBLE(BEX) | |
5464 | DBEY=DBLE(BEY) | |
5465 | DBEZ=DBLE(BEZ) | |
5466 | MSTU(33)=1 | |
5467 | CALL LUDBRB(NS+1,N,THE,PHI,DBEX,DBEY,DBEZ) | |
5468 | ||
5469 | C...Decay vertex of shower. | |
5470 | DO 540 I=NS+1,N | |
5471 | DO 530 J=1,5 | |
5472 | V(I,J)=V(IP1,J) | |
5473 | 530 CONTINUE | |
5474 | 540 CONTINUE | |
5475 | ||
5476 | C...Delete trivial shower, else connect initiators. | |
5477 | IF(N.EQ.NS+NPA+IIM) THEN | |
5478 | N=NS | |
5479 | ELSE | |
5480 | DO 550 IP=1,NPA | |
5481 | K(IPA(IP),1)=14 | |
5482 | K(IPA(IP),4)=K(IPA(IP),4)+NS+IIM+IP | |
5483 | K(IPA(IP),5)=K(IPA(IP),5)+NS+IIM+IP | |
5484 | K(NS+IIM+IP,3)=IPA(IP) | |
5485 | IF(IIM.EQ.1.AND.MSTU(16).NE.2) K(NS+IIM+IP,3)=NS+1 | |
5486 | IF(K(NS+IIM+IP,1).NE.1) THEN | |
5487 | K(NS+IIM+IP,4)=MSTU(5)*IPA(IP)+K(NS+IIM+IP,4) | |
5488 | K(NS+IIM+IP,5)=MSTU(5)*IPA(IP)+K(NS+IIM+IP,5) | |
5489 | ENDIF | |
5490 | 550 CONTINUE | |
5491 | ENDIF | |
5492 | ||
5493 | RETURN | |
5494 | END | |
5495 | ||
5496 | C********************************************************************* | |
5497 | ||
5498 | SUBROUTINE LYBOEI(NSAV) | |
5499 | ||
5500 | C...Purpose: to modify event so as to approximately take into account | |
5501 | C...Bose-Einstein effects according to a simple phenomenological | |
5502 | C...parametrization. | |
5503 | IMPLICIT DOUBLE PRECISION(D) | |
5504 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
5505 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
5506 | SAVE /LYJETS/,/LYDAT1/ | |
5507 | DIMENSION DPS(4),KFBE(9),NBE(0:9),BEI(100) | |
5508 | DATA KFBE/211,-211,111,321,-321,130,310,221,331/ | |
5509 | ||
5510 | C...Boost event to overall CM frame. Calculate CM energy. | |
5511 | IF((MSTJ(51).NE.1.AND.MSTJ(51).NE.2).OR.N-NSAV.LE.1) RETURN | |
5512 | DO 100 J=1,4 | |
5513 | DPS(J)=0. | |
5514 | 100 CONTINUE | |
5515 | DO 120 I=1,N | |
5516 | KFA=IABS(K(I,2)) | |
5517 | IF(K(I,1).LE.10.AND.((KFA.GT.10.AND.KFA.LE.20).OR.KFA.EQ.22).AND. | |
5518 | &K(I,3).GT.0) THEN | |
5519 | KFMA=IABS(K(K(I,3),2)) | |
5520 | IF(KFMA.GT.10.AND.KFMA.LE.80) K(I,1)=-K(I,1) | |
5521 | ELSEIF(KFA.EQ.22.AND.K(I,3).EQ.0) THEN | |
5522 | K(I,1)=-K(I,1) | |
5523 | ENDIF | |
5524 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 120 | |
5525 | DO 110 J=1,4 | |
5526 | DPS(J)=DPS(J)+P(I,J) | |
5527 | 110 CONTINUE | |
5528 | 120 CONTINUE | |
5529 | CALL LUDBRB(0,0,0.,0.,-DPS(1)/DPS(4),-DPS(2)/DPS(4), | |
5530 | &-DPS(3)/DPS(4)) | |
5531 | PECM=0. | |
5532 | DO 130 I=1,N | |
5533 | IF(K(I,1).GE.1.AND.K(I,1).LE.10) PECM=PECM+P(I,4) | |
5534 | 130 CONTINUE | |
5535 | ||
5536 | C...Reserve copy of particles by species at end of record. | |
5537 | NBE(0)=N+MSTU(3) | |
5538 | DO 160 IBE=1,MIN(9,MSTJ(52)) | |
5539 | NBE(IBE)=NBE(IBE-1) | |
5540 | DO 150 I=NSAV+1,N | |
5541 | IF(K(I,2).NE.KFBE(IBE)) GOTO 150 | |
5542 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 150 | |
5543 | IF(NBE(IBE).GE.MSTU(4)-MSTU(32)-5) THEN | |
5544 | CALL LYERRM(11,'(LYBOEI:) no more memory left in LUJETS') | |
5545 | RETURN | |
5546 | ENDIF | |
5547 | NBE(IBE)=NBE(IBE)+1 | |
5548 | K(NBE(IBE),1)=I | |
5549 | DO 140 J=1,3 | |
5550 | P(NBE(IBE),J)=0. | |
5551 | 140 CONTINUE | |
5552 | 150 CONTINUE | |
5553 | 160 CONTINUE | |
5554 | IF(NBE(MIN(9,MSTJ(52)))-NBE(0).LE.1) GOTO 280 | |
5555 | ||
5556 | C...Tabulate integral for subsequent momentum shift. | |
5557 | DO 220 IBE=1,MIN(9,MSTJ(52)) | |
5558 | IF(IBE.NE.1.AND.IBE.NE.4.AND.IBE.LE.7) GOTO 180 | |
5559 | IF(IBE.EQ.1.AND.MAX(NBE(1)-NBE(0),NBE(2)-NBE(1),NBE(3)-NBE(2)) | |
5560 | &.LE.1) GOTO 180 | |
5561 | IF(IBE.EQ.4.AND.MAX(NBE(4)-NBE(3),NBE(5)-NBE(4),NBE(6)-NBE(5), | |
5562 | &NBE(7)-NBE(6)).LE.1) GOTO 180 | |
5563 | IF(IBE.GE.8.AND.NBE(IBE)-NBE(IBE-1).LE.1) GOTO 180 | |
5564 | IF(IBE.EQ.1) PMHQ=2.*UYMASS(211) | |
5565 | IF(IBE.EQ.4) PMHQ=2.*UYMASS(321) | |
5566 | IF(IBE.EQ.8) PMHQ=2.*UYMASS(221) | |
5567 | IF(IBE.EQ.9) PMHQ=2.*UYMASS(331) | |
5568 | QDEL=0.1*MIN(PMHQ,PARJ(93)) | |
5569 | IF(MSTJ(51).EQ.1) THEN | |
5570 | NBIN=MIN(100,NINT(9.*PARJ(93)/QDEL)) | |
5571 | BEEX=EXP(0.5*QDEL/PARJ(93)) | |
5572 | BERT=EXP(-QDEL/PARJ(93)) | |
5573 | ELSE | |
5574 | NBIN=MIN(100,NINT(3.*PARJ(93)/QDEL)) | |
5575 | ENDIF | |
5576 | DO 170 IBIN=1,NBIN | |
5577 | QBIN=QDEL*(IBIN-0.5) | |
5578 | BEI(IBIN)=QDEL*(QBIN**2+QDEL**2/12.)/SQRT(QBIN**2+PMHQ**2) | |
5579 | IF(MSTJ(51).EQ.1) THEN | |
5580 | BEEX=BEEX*BERT | |
5581 | BEI(IBIN)=BEI(IBIN)*BEEX | |
5582 | ELSE | |
5583 | BEI(IBIN)=BEI(IBIN)*EXP(-(QBIN/PARJ(93))**2) | |
5584 | ENDIF | |
5585 | IF(IBIN.GE.2) BEI(IBIN)=BEI(IBIN)+BEI(IBIN-1) | |
5586 | 170 CONTINUE | |
5587 | ||
5588 | C...Loop through particle pairs and find old relative momentum. | |
5589 | 180 DO 210 I1M=NBE(IBE-1)+1,NBE(IBE)-1 | |
5590 | I1=K(I1M,1) | |
5591 | DO 200 I2M=I1M+1,NBE(IBE) | |
5592 | I2=K(I2M,1) | |
5593 | Q2OLD=MAX(0.,(P(I1,4)+P(I2,4))**2-(P(I1,1)+P(I2,1))**2-(P(I1,2)+ | |
5594 | &P(I2,2))**2-(P(I1,3)+P(I2,3))**2-(P(I1,5)+P(I2,5))**2) | |
5595 | QOLD=SQRT(Q2OLD) | |
5596 | ||
5597 | C...Calculate new relative momentum. | |
5598 | IF(QOLD.LT.1E-3*QDEL) THEN | |
5599 | GOTO 200 | |
5600 | ELSEIF(QOLD.LE.QDEL) THEN | |
5601 | QMOV=QOLD/3. | |
5602 | ELSEIF(QOLD.LT.(NBIN-0.1)*QDEL) THEN | |
5603 | RBIN=QOLD/QDEL | |
5604 | IBIN=RBIN | |
5605 | RINP=(RBIN**3-IBIN**3)/(3*IBIN*(IBIN+1)+1) | |
5606 | QMOV=(BEI(IBIN)+RINP*(BEI(IBIN+1)-BEI(IBIN)))* | |
5607 | & SQRT(Q2OLD+PMHQ**2)/Q2OLD | |
5608 | ELSE | |
5609 | QMOV=BEI(NBIN)*SQRT(Q2OLD+PMHQ**2)/Q2OLD | |
5610 | ENDIF | |
5611 | Q2NEW=Q2OLD*(QOLD/(QOLD+3.*PARJ(92)*QMOV))**(2./3.) | |
5612 | ||
5613 | C...Calculate and save shift to be performed on three-momenta. | |
5614 | HC1=(P(I1,4)+P(I2,4))**2-(Q2OLD-Q2NEW) | |
5615 | HC2=(Q2OLD-Q2NEW)*(P(I1,4)-P(I2,4))**2 | |
5616 | HA=0.5*(1.-SQRT(HC1*Q2NEW/(HC1*Q2OLD-HC2))) | |
5617 | DO 190 J=1,3 | |
5618 | PD=HA*(P(I2,J)-P(I1,J)) | |
5619 | P(I1M,J)=P(I1M,J)+PD | |
5620 | P(I2M,J)=P(I2M,J)-PD | |
5621 | 190 CONTINUE | |
5622 | 200 CONTINUE | |
5623 | 210 CONTINUE | |
5624 | 220 CONTINUE | |
5625 | ||
5626 | C...Shift momenta and recalculate energies. | |
5627 | DO 240 IM=NBE(0)+1,NBE(MIN(9,MSTJ(52))) | |
5628 | I=K(IM,1) | |
5629 | DO 230 J=1,3 | |
5630 | P(I,J)=P(I,J)+P(IM,J) | |
5631 | 230 CONTINUE | |
5632 | P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
5633 | 240 CONTINUE | |
5634 | ||
5635 | C...Rescale all momenta for energy conservation. | |
5636 | PES=0. | |
5637 | PQS=0. | |
5638 | DO 250 I=1,N | |
5639 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 250 | |
5640 | PES=PES+P(I,4) | |
5641 | PQS=PQS+P(I,5)**2/P(I,4) | |
5642 | 250 CONTINUE | |
5643 | FAC=(PECM-PQS)/(PES-PQS) | |
5644 | DO 270 I=1,N | |
5645 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 270 | |
5646 | DO 260 J=1,3 | |
5647 | P(I,J)=FAC*P(I,J) | |
5648 | 260 CONTINUE | |
5649 | P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
5650 | 270 CONTINUE | |
5651 | ||
5652 | C...Boost back to correct reference frame. | |
5653 | 280 CALL LUDBRB(0,0,0.,0.,DPS(1)/DPS(4),DPS(2)/DPS(4),DPS(3)/DPS(4)) | |
5654 | DO 290 I=1,N | |
5655 | IF(K(I,1).LT.0) K(I,1)=-K(I,1) | |
5656 | 290 CONTINUE | |
5657 | ||
5658 | RETURN | |
5659 | END | |
5660 | ||
5661 | C********************************************************************* | |
5662 | ||
5663 | FUNCTION UYMASS(KF) | |
5664 | ||
5665 | C...Purpose: to give the mass of a particle/parton. | |
5666 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
5667 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
5668 | SAVE /LYDAT1/,/LYDAT2/ | |
5669 | ||
5670 | C...Reset variables. Compressed code. | |
5671 | UYMASS=0. | |
5672 | KFA=IABS(KF) | |
5673 | KC=LYCOMP(KF) | |
5674 | IF(KC.EQ.0) RETURN | |
5675 | PARF(106)=PMAS(6,1) | |
5676 | PARF(107)=PMAS(7,1) | |
5677 | PARF(108)=PMAS(8,1) | |
5678 | ||
5679 | C...Guarantee use of constituent masses for internal checks. | |
5680 | IF((MSTJ(93).EQ.1.OR.MSTJ(93).EQ.2).AND.KFA.LE.10) THEN | |
5681 | UYMASS=PARF(100+KFA) | |
5682 | IF(MSTJ(93).EQ.2) UYMASS=MAX(0.,UYMASS-PARF(121)) | |
5683 | ||
5684 | C...Masses that can be read directly off table. | |
5685 | ELSEIF(KFA.LE.100.OR.KC.LE.80.OR.KC.GT.100) THEN | |
5686 | UYMASS=PMAS(KC,1) | |
5687 | ||
5688 | C...Find constituent partons and their masses. | |
5689 | ELSE | |
5690 | KFLA=MOD(KFA/1000,10) | |
5691 | KFLB=MOD(KFA/100,10) | |
5692 | KFLC=MOD(KFA/10,10) | |
5693 | KFLS=MOD(KFA,10) | |
5694 | KFLR=MOD(KFA/10000,10) | |
5695 | PMA=PARF(100+KFLA) | |
5696 | PMB=PARF(100+KFLB) | |
5697 | PMC=PARF(100+KFLC) | |
5698 | ||
5699 | C...Construct masses for various meson, diquark and baryon cases. | |
5700 | IF(KFLA.EQ.0.AND.KFLR.EQ.0.AND.KFLS.LE.3) THEN | |
5701 | IF(KFLS.EQ.1) PMSPL=-3./(PMB*PMC) | |
5702 | IF(KFLS.GE.3) PMSPL=1./(PMB*PMC) | |
5703 | UYMASS=PARF(111)+PMB+PMC+PARF(113)*PARF(101)**2*PMSPL | |
5704 | ELSEIF(KFLA.EQ.0) THEN | |
5705 | KMUL=2 | |
5706 | IF(KFLS.EQ.1) KMUL=3 | |
5707 | IF(KFLR.EQ.2) KMUL=4 | |
5708 | IF(KFLS.EQ.5) KMUL=5 | |
5709 | UYMASS=PARF(113+KMUL)+PMB+PMC | |
5710 | ELSEIF(KFLC.EQ.0) THEN | |
5711 | IF(KFLS.EQ.1) PMSPL=-3./(PMA*PMB) | |
5712 | IF(KFLS.EQ.3) PMSPL=1./(PMA*PMB) | |
5713 | UYMASS=2.*PARF(112)/3.+PMA+PMB+PARF(114)*PARF(101)**2*PMSPL | |
5714 | IF(MSTJ(93).EQ.1) UYMASS=PMA+PMB | |
5715 | IF(MSTJ(93).EQ.2) UYMASS=MAX(0.,UYMASS-PARF(122)- | |
5716 | & 2.*PARF(112)/3.) | |
5717 | ELSE | |
5718 | IF(KFLS.EQ.2.AND.KFLA.EQ.KFLB) THEN | |
5719 | PMSPL=1./(PMA*PMB)-2./(PMA*PMC)-2./(PMB*PMC) | |
5720 | ELSEIF(KFLS.EQ.2.AND.KFLB.GE.KFLC) THEN | |
5721 | PMSPL=-2./(PMA*PMB)-2./(PMA*PMC)+1./(PMB*PMC) | |
5722 | ELSEIF(KFLS.EQ.2) THEN | |
5723 | PMSPL=-3./(PMB*PMC) | |
5724 | ELSE | |
5725 | PMSPL=1./(PMA*PMB)+1./(PMA*PMC)+1./(PMB*PMC) | |
5726 | ENDIF | |
5727 | UYMASS=PARF(112)+PMA+PMB+PMC+PARF(114)*PARF(101)**2*PMSPL | |
5728 | ENDIF | |
5729 | ENDIF | |
5730 | ||
5731 | C...Optional mass broadening according to truncated Breit-Wigner | |
5732 | C...(either in m or in m^2). | |
5733 | IF(MSTJ(24).GE.1.AND.PMAS(KC,2).GT.1E-4) THEN | |
5734 | IF(MSTJ(24).EQ.1.OR.(MSTJ(24).EQ.2.AND.KFA.GT.100)) THEN | |
5735 | UYMASS=UYMASS+0.5*PMAS(KC,2)*TAN((2.*RLY(0)-1.)* | |
5736 | & ATAN(2.*PMAS(KC,3)/PMAS(KC,2))) | |
5737 | ELSE | |
5738 | PM0=UYMASS | |
5739 | PMLOW=ATAN((MAX(0.,PM0-PMAS(KC,3))**2-PM0**2)/ | |
5740 | & (PM0*PMAS(KC,2))) | |
5741 | PMUPP=ATAN(((PM0+PMAS(KC,3))**2-PM0**2)/(PM0*PMAS(KC,2))) | |
5742 | UYMASS=SQRT(MAX(0.,PM0**2+PM0*PMAS(KC,2)*TAN(PMLOW+ | |
5743 | & (PMUPP-PMLOW)*RLY(0)))) | |
5744 | ENDIF | |
5745 | ENDIF | |
5746 | MSTJ(93)=0 | |
5747 | ||
5748 | RETURN | |
5749 | END | |
5750 | ||
5751 | C********************************************************************* | |
5752 | ||
5753 | SUBROUTINE LYNAME(KF,CHAU) | |
5754 | ||
5755 | C...Purpose: to give the particle/parton name as a character string. | |
5756 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
5757 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
5758 | COMMON/LYDAT4/CHAF(500) | |
5759 | CHARACTER CHAF*8 | |
5760 | SAVE /LYDAT1/,/LYDAT2/,/LYDAT4/ | |
5761 | CHARACTER CHAU*16 | |
5762 | ||
5763 | C...Initial values. Charge. Subdivide code. | |
5764 | CHAU=' ' | |
5765 | KFA=IABS(KF) | |
5766 | KC=LYCOMP(KF) | |
5767 | IF(KC.EQ.0) RETURN | |
5768 | KQ=LYCHGE(KF) | |
5769 | KFLA=MOD(KFA/1000,10) | |
5770 | KFLB=MOD(KFA/100,10) | |
5771 | KFLC=MOD(KFA/10,10) | |
5772 | KFLS=MOD(KFA,10) | |
5773 | KFLR=MOD(KFA/10000,10) | |
5774 | ||
5775 | C...Read out root name and spin for simple particle. | |
5776 | IF(KFA.LE.100.OR.(KFA.GT.100.AND.KC.GT.100)) THEN | |
5777 | CHAU=CHAF(KC) | |
5778 | LEN=0 | |
5779 | DO 100 LEM=1,8 | |
5780 | IF(CHAU(LEM:LEM).NE.' ') LEN=LEM | |
5781 | 100 CONTINUE | |
5782 | ||
5783 | C...Construct root name for diquark. Add on spin. | |
5784 | ELSEIF(KFLC.EQ.0) THEN | |
5785 | CHAU(1:2)=CHAF(KFLA)(1:1)//CHAF(KFLB)(1:1) | |
5786 | IF(KFLS.EQ.1) CHAU(3:4)='_0' | |
5787 | IF(KFLS.EQ.3) CHAU(3:4)='_1' | |
5788 | LEN=4 | |
5789 | ||
5790 | C...Construct root name for heavy meson. Add on spin and heavy flavour. | |
5791 | ELSEIF(KFLA.EQ.0) THEN | |
5792 | IF(KFLB.EQ.5) CHAU(1:1)='B' | |
5793 | IF(KFLB.EQ.6) CHAU(1:1)='T' | |
5794 | IF(KFLB.EQ.7) CHAU(1:1)='L' | |
5795 | IF(KFLB.EQ.8) CHAU(1:1)='H' | |
5796 | LEN=1 | |
5797 | IF(KFLR.EQ.0.AND.KFLS.EQ.1) THEN | |
5798 | ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.3) THEN | |
5799 | CHAU(2:2)='*' | |
5800 | LEN=2 | |
5801 | ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.3) THEN | |
5802 | CHAU(2:3)='_1' | |
5803 | LEN=3 | |
5804 | ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.1) THEN | |
5805 | CHAU(2:4)='*_0' | |
5806 | LEN=4 | |
5807 | ELSEIF(KFLR.EQ.2) THEN | |
5808 | CHAU(2:4)='*_1' | |
5809 | LEN=4 | |
5810 | ELSEIF(KFLS.EQ.5) THEN | |
5811 | CHAU(2:4)='*_2' | |
5812 | LEN=4 | |
5813 | ENDIF | |
5814 | IF(KFLC.GE.3.AND.KFLR.EQ.0.AND.KFLS.LE.3) THEN | |
5815 | CHAU(LEN+1:LEN+2)='_'//CHAF(KFLC)(1:1) | |
5816 | LEN=LEN+2 | |
5817 | ELSEIF(KFLC.GE.3) THEN | |
5818 | CHAU(LEN+1:LEN+1)=CHAF(KFLC)(1:1) | |
5819 | LEN=LEN+1 | |
5820 | ENDIF | |
5821 | ||
5822 | C...Construct root name and spin for heavy baryon. | |
5823 | ELSE | |
5824 | IF(KFLB.LE.2.AND.KFLC.LE.2) THEN | |
5825 | CHAU='Sigma ' | |
5826 | IF(KFLC.GT.KFLB) CHAU='Lambda' | |
5827 | IF(KFLS.EQ.4) CHAU='Sigma*' | |
5828 | LEN=5 | |
5829 | IF(CHAU(6:6).NE.' ') LEN=6 | |
5830 | ELSEIF(KFLB.LE.2.OR.KFLC.LE.2) THEN | |
5831 | CHAU='Xi ' | |
5832 | IF(KFLA.GT.KFLB.AND.KFLB.GT.KFLC) CHAU='Xi''' | |
5833 | IF(KFLS.EQ.4) CHAU='Xi*' | |
5834 | LEN=2 | |
5835 | IF(CHAU(3:3).NE.' ') LEN=3 | |
5836 | ELSE | |
5837 | CHAU='Omega ' | |
5838 | IF(KFLA.GT.KFLB.AND.KFLB.GT.KFLC) CHAU='Omega''' | |
5839 | IF(KFLS.EQ.4) CHAU='Omega*' | |
5840 | LEN=5 | |
5841 | IF(CHAU(6:6).NE.' ') LEN=6 | |
5842 | ENDIF | |
5843 | ||
5844 | C...Add on heavy flavour content for heavy baryon. | |
5845 | CHAU(LEN+1:LEN+2)='_'//CHAF(KFLA)(1:1) | |
5846 | LEN=LEN+2 | |
5847 | IF(KFLB.GE.KFLC.AND.KFLC.GE.4) THEN | |
5848 | CHAU(LEN+1:LEN+2)=CHAF(KFLB)(1:1)//CHAF(KFLC)(1:1) | |
5849 | LEN=LEN+2 | |
5850 | ELSEIF(KFLB.GE.KFLC.AND.KFLB.GE.4) THEN | |
5851 | CHAU(LEN+1:LEN+1)=CHAF(KFLB)(1:1) | |
5852 | LEN=LEN+1 | |
5853 | ELSEIF(KFLC.GT.KFLB.AND.KFLB.GE.4) THEN | |
5854 | CHAU(LEN+1:LEN+2)=CHAF(KFLC)(1:1)//CHAF(KFLB)(1:1) | |
5855 | LEN=LEN+2 | |
5856 | ELSEIF(KFLC.GT.KFLB.AND.KFLC.GE.4) THEN | |
5857 | CHAU(LEN+1:LEN+1)=CHAF(KFLC)(1:1) | |
5858 | LEN=LEN+1 | |
5859 | ENDIF | |
5860 | ENDIF | |
5861 | ||
5862 | C...Add on bar sign for antiparticle (where necessary). | |
5863 | IF(KF.GT.0.OR.LEN.EQ.0) THEN | |
5864 | ELSEIF(KFA.GT.10.AND.KFA.LE.40.AND.KQ.NE.0.AND.MOD(KQ,3).EQ.0) | |
5865 | &THEN | |
5866 | ELSEIF(KFA.EQ.89.OR.(KFA.GE.91.AND.KFA.LE.99)) THEN | |
5867 | ELSEIF(KFA.GT.100.AND.KFLA.EQ.0.AND.KQ.NE.0) THEN | |
5868 | ELSEIF(MSTU(15).LE.1) THEN | |
5869 | CHAU(LEN+1:LEN+1)='~' | |
5870 | LEN=LEN+1 | |
5871 | ELSE | |
5872 | CHAU(LEN+1:LEN+3)='bar' | |
5873 | LEN=LEN+3 | |
5874 | ENDIF | |
5875 | ||
5876 | C...Add on charge where applicable (conventional cases skipped). | |
5877 | IF(KQ.EQ.6) CHAU(LEN+1:LEN+2)='++' | |
5878 | IF(KQ.EQ.-6) CHAU(LEN+1:LEN+2)='--' | |
5879 | IF(KQ.EQ.3) CHAU(LEN+1:LEN+1)='+' | |
5880 | IF(KQ.EQ.-3) CHAU(LEN+1:LEN+1)='-' | |
5881 | IF(KQ.EQ.0.AND.(KFA.LE.22.OR.LEN.EQ.0)) THEN | |
5882 | ELSEIF(KQ.EQ.0.AND.(KFA.GE.81.AND.KFA.LE.100)) THEN | |
5883 | ELSEIF(KFA.EQ.28.OR.KFA.EQ.29) THEN | |
5884 | ELSEIF(KFA.GT.100.AND.KFLA.EQ.0.AND.KFLB.EQ.KFLC.AND. | |
5885 | &KFLB.NE.1) THEN | |
5886 | ELSEIF(KQ.EQ.0) THEN | |
5887 | CHAU(LEN+1:LEN+1)='0' | |
5888 | ENDIF | |
5889 | ||
5890 | RETURN | |
5891 | END | |
5892 | ||
5893 | C********************************************************************* | |
5894 | ||
5895 | FUNCTION LYCHGE(KF) | |
5896 | ||
5897 | C...Purpose: to give three times the charge for a particle/parton. | |
5898 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
5899 | SAVE /LYDAT2/ | |
5900 | ||
5901 | C...Initial values. Simple case of direct readout. | |
5902 | LYCHGE=0 | |
5903 | KFA=IABS(KF) | |
5904 | KC=LYCOMP(KFA) | |
5905 | IF(KC.EQ.0) THEN | |
5906 | ELSEIF(KFA.LE.100.OR.KC.LE.80.OR.KC.GT.100) THEN | |
5907 | LYCHGE=KCHG(KC,1) | |
5908 | ||
5909 | C...Construction from quark content for heavy meson, diquark, baryon. | |
5910 | ELSEIF(MOD(KFA/1000,10).EQ.0) THEN | |
5911 | LYCHGE=(KCHG(MOD(KFA/100,10),1)-KCHG(MOD(KFA/10,10),1))* | |
5912 | & (-1)**MOD(KFA/100,10) | |
5913 | ELSEIF(MOD(KFA/10,10).EQ.0) THEN | |
5914 | LYCHGE=KCHG(MOD(KFA/1000,10),1)+KCHG(MOD(KFA/100,10),1) | |
5915 | ELSE | |
5916 | LYCHGE=KCHG(MOD(KFA/1000,10),1)+KCHG(MOD(KFA/100,10),1)+ | |
5917 | & KCHG(MOD(KFA/10,10),1) | |
5918 | ENDIF | |
5919 | ||
5920 | C...Add on correct sign. | |
5921 | LYCHGE=LYCHGE*ISIGN(1,KF) | |
5922 | ||
5923 | RETURN | |
5924 | END | |
5925 | ||
5926 | C********************************************************************* | |
5927 | integer function lycomp_beg(kfa) | |
5928 | * | |
5929 | * | |
5930 | * called by modified LYCOMP_BEG to add user defined particles | |
5931 | * | |
5932 | * added ASLUND backward compatibility Dec 1994 | |
5933 | * added LYCOMP_BEG=410+abs(KF)/100 000 July 1994 | |
5934 | * added UPS 4S,5S Jan 1994 | |
5935 | * added all bb-onia below threshold Jun 97 RW | |
5936 | * | |
5937 | * NOTE: ASLUND version maps LYCOMP_BEG = 400 + KFA/1 000 000 | |
5938 | * | |
5939 | * Doug Wright Oct 1994 | |
5940 | * R.Waldi Nov 1997 | |
5941 | ||
5942 | implicit none | |
5943 | ||
5944 | C #include "beget.inc" (Don't need beget.inc) 1/16/98 | |
5945 | ||
5946 | integer N_BB | |
5947 | PARAMETER (N_BB = 22) | |
5948 | integer KF_BB(N_BB),KC_BB(N_BB),I | |
5949 | ||
5950 | DATA KF_BB | |
5951 | * UPS(3S),UPS(4S),UPS(5S),UPS_1(1D),UPS_2(1D),UPS_3(1D) | |
5952 | 1 / 60553, 70553, 80553, 120553, 30555, 557, | |
5953 | * UPS_1(2D),UPS_2(2D),UPS_3(2D),chi_0b(2P),chi_1b(2P),chi_2b(2P) | |
5954 | 1 130553, 50555, 10557, 30551, 50553, 10555, | |
5955 | * h_b(2P),chi_0b(3P),chi_1b(3P),chi_2b(3P),h_b(3P),eta_b(2S), | |
5956 | 1 40553, 50551, 110553, 20555, 100553, 20551, | |
5957 | * eta_b(3S),eta_2b(1D),eta_2b(2D),eta_c(2S) | |
5958 | 1 40551, 40555, 60555, 20441/ | |
5959 | DATA KC_BB | |
5960 | * UPS(3S),UPS(4S),UPS(5S),UPS_1(1D),UPS_2(1D),UPS_3(1D) | |
5961 | 1 / 403, 404, 405, 416, 417, 418, | |
5962 | * UPS_1(2D),UPS_2(2D),UPS_3(2D),chi_0b(2P),chi_1b(2P),chi_2b(2P) | |
5963 | 1 419, 420, 421, 410, 411, 412, | |
5964 | * h_b(2P),chi_0b(3P),chi_1b(3P),chi_2b(3P),h_b(3P),eta_b(2S), | |
5965 | 1 422, 413, 414, 415, 423, 401, | |
5966 | * eta_b(3S),eta_2b(1D),eta_2b(2D),eta_c(2S) | |
5967 | 1 402, 424, 425, 460/ | |
5968 | ||
5969 | integer kfa | |
5970 | ||
5971 | LYCOMP_BEG = 0 | |
5972 | IF( KFA.GE.1000000) THEN ! for ASLUND backward compatibility | |
5973 | LYCOMP_BEG = 400 + MOD(KFA/1 000 000,100) | |
5974 | c ELSEIF(KFA.GE.100000) THEN | |
5975 | c LYCOMP_BEG = 410 + MOD(KFA/100 000, 90) | |
5976 | ELSE | |
5977 | DO 100 I=1,N_BB | |
5978 | IF(KFA.eq.KF_BB(I)) THEN | |
5979 | LYCOMP_BEG = KC_BB(I) | |
5980 | GOTO 110 | |
5981 | ENDIF | |
5982 | 100 CONTINUE | |
5983 | 110 CONTINUE | |
5984 | ENDIF | |
5985 | end | |
5986 | ||
5987 | C********************************************************************* | |
5988 | ||
5989 | FUNCTION LYCOMP(KF) | |
5990 | implicit none | |
5991 | *****-*****************************************************************-******* | |
5992 | C...Purpose: to compress the standard KF codes for use in mass and decay | |
5993 | C...arrays; also to check whether a given code actually is defined. | |
5994 | C.. History: | |
5995 | C | |
5996 | C 12-Aug-1997 - Lockman : implicit none added; save KFTAB, KCTAB | |
5997 | C... modified R.Waldi/92-07.v7.4:97-06 beget conv./stdhep, 97/11 evtgen | |
5998 | C 11-Sep-2000 - Mark Ian Williams added X_su/d/s for BtoXsgamma model | |
5999 | *****-*****************************************************************-******* | |
6000 | integer kf | |
6001 | integer lycomp, lycomp_beg | |
6002 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
6003 | SAVE /LYDAT2/ | |
6004 | integer kchg | |
6005 | real*4 pmas, parf, vckm | |
6006 | * DIMENSION KFTAB(25),KCTAB(25) | |
6007 | integer KFTAB(25),KCTAB(25) | |
6008 | save KFTAB, KCTAB | |
6009 | integer kfa, ikf, kfla, kflb, kflc, kfls, kflr | |
6010 | DATA KFTAB/211,111,221,311,321,130,310,213,113,223, | |
6011 | &313,323,2112,2212,210,2110,2210,110,220,330,440,30443,30553,0,0/ | |
6012 | DATA KCTAB/101,111,112,102,103,221,222,121,131,132, | |
6013 | &122,123,332,333,281,282,283,284,285,286,287,231,235,0,0/ | |
6014 | ||
6015 | C...Starting values. | |
6016 | LYCOMP=lycomp_beg(KF) | |
6017 | IF (LYCOMP .NE. 0) RETURN | |
6018 | ||
6019 | KFA=IABS(KF) | |
6020 | ||
6021 | C...Subdivide KF code into constituent pieces. | |
6022 | ||
6023 | KFLR=MOD(KFA/10000,10) | |
6024 | KFLA=MOD(KFA/1000,10) | |
6025 | KFLB=MOD(KFA/100,10) | |
6026 | KFLC=MOD(KFA/10,10) | |
6027 | KFLS=MOD(KFA,10) | |
6028 | ||
6029 | C...Hardwire the return code for -42 since EvtJetSet updates the particles | |
6030 | C too late for the Xu- decays to be recognized | |
6031 | IF (KF.EQ.-42) THEN | |
6032 | LYCOMP=KFA | |
6033 | RETURN | |
6034 | ENDIF | |
6035 | ||
6036 | C...Allow for massive sbar-u, sbar-d, sbar-s systems | |
6037 | IF (KFA.EQ.30343.OR.KFA.EQ.30353.OR.KFA.EQ.30363) THEN | |
6038 | LYCOMP=451+KFLC | |
6039 | RETURN | |
6040 | ENDIF | |
6041 | ||
6042 | C...Simple cases: direct translation or table. | |
6043 | IF(KFA.EQ.0.OR.KFA.GE.100000) THEN | |
6044 | RETURN | |
6045 | ELSEIF(KFA.LE.100) THEN | |
6046 | LYCOMP=KFA | |
6047 | IF(KF.LT.0.AND.KCHG(KFA,3).EQ.0) LYCOMP=0 | |
6048 | RETURN | |
6049 | ELSE | |
6050 | DO 100 IKF=1,23 | |
6051 | IF(KFA.EQ.KFTAB(IKF)) THEN | |
6052 | LYCOMP=KCTAB(IKF) | |
6053 | IF(KF.LT.0.AND.KCHG(LYCOMP,3).EQ.0) LYCOMP=0 | |
6054 | RETURN | |
6055 | ENDIF | |
6056 | 100 CONTINUE | |
6057 | ENDIF | |
6058 | ||
6059 | C...Mesons. | |
6060 | IF(KFA-10000*KFLR.LT.1000) THEN | |
6061 | IF(KFLB.EQ.0.OR.KFLB.EQ.9.OR.KFLC.EQ.0.OR.KFLC.EQ.9) THEN | |
6062 | ELSEIF(KFLB.LT.KFLC) THEN | |
6063 | ELSEIF(KF.LT.0.AND.KFLB.EQ.KFLC) THEN | |
6064 | ELSEIF(KFLB.EQ.KFLC) THEN | |
6065 | IF(KFLR.EQ.0.AND.KFLS.EQ.1) THEN | |
6066 | LYCOMP=110+KFLB | |
6067 | ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.3) THEN | |
6068 | LYCOMP=130+KFLB | |
6069 | ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.3) THEN | |
6070 | LYCOMP=150+KFLB | |
6071 | ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.1) THEN | |
6072 | LYCOMP=170+KFLB | |
6073 | ELSEIF(KFLR.EQ.2.AND.KFLS.EQ.3) THEN | |
6074 | LYCOMP=190+KFLB | |
6075 | ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.5) THEN | |
6076 | LYCOMP=210+KFLB | |
6077 | ENDIF | |
6078 | ELSEIF(KFLB.LE.5) THEN | |
6079 | IF(KFLR.EQ.0.AND.KFLS.EQ.1) THEN | |
6080 | LYCOMP=100+((KFLB-1)*(KFLB-2))/2+KFLC | |
6081 | ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.3) THEN | |
6082 | LYCOMP=120+((KFLB-1)*(KFLB-2))/2+KFLC | |
6083 | ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.3) THEN | |
6084 | LYCOMP=140+((KFLB-1)*(KFLB-2))/2+KFLC | |
6085 | ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.1) THEN | |
6086 | LYCOMP=160+((KFLB-1)*(KFLB-2))/2+KFLC | |
6087 | ELSEIF(KFLR.EQ.2.AND.KFLS.EQ.3) THEN | |
6088 | LYCOMP=180+((KFLB-1)*(KFLB-2))/2+KFLC | |
6089 | ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.5) THEN | |
6090 | LYCOMP=200+((KFLB-1)*(KFLB-2))/2+KFLC | |
6091 | ENDIF | |
6092 | ELSEIF((KFLS.EQ.1.AND.KFLR.LE.1).OR.(KFLS.EQ.3.AND.KFLR.LE.2) | |
6093 | & .OR.(KFLS.EQ.5.AND.KFLR.EQ.0)) THEN | |
6094 | LYCOMP=80+KFLB | |
6095 | ENDIF | |
6096 | ||
6097 | C...Diquarks. | |
6098 | ELSEIF((KFLR.EQ.0.OR.KFLR.EQ.1).AND.KFLC.EQ.0) THEN | |
6099 | IF(KFLS.NE.1.AND.KFLS.NE.3) THEN | |
6100 | ELSEIF(KFLA.EQ.9.OR.KFLB.EQ.0.OR.KFLB.EQ.9) THEN | |
6101 | ELSEIF(KFLA.LT.KFLB) THEN | |
6102 | ELSEIF(KFLS.EQ.1.AND.KFLA.EQ.KFLB) THEN | |
6103 | ELSE | |
6104 | LYCOMP=90 | |
6105 | ENDIF | |
6106 | ||
6107 | C...Spin 1/2 baryons. | |
6108 | ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.2) THEN | |
6109 | IF(KFLA.EQ.9.OR.KFLB.EQ.0.OR.KFLB.EQ.9.OR.KFLC.EQ.9) THEN | |
6110 | ELSEIF(KFLA.LE.KFLC.OR.KFLA.LT.KFLB) THEN | |
6111 | ELSEIF(KFLA.GE.6.OR.KFLB.GE.4.OR.KFLC.GE.4) THEN | |
6112 | LYCOMP=80+KFLA | |
6113 | ELSEIF(KFLB.LT.KFLC) THEN | |
6114 | LYCOMP=300+((KFLA+1)*KFLA*(KFLA-1))/6+(KFLC*(KFLC-1))/2+KFLB | |
6115 | ELSE | |
6116 | LYCOMP=330+((KFLA+1)*KFLA*(KFLA-1))/6+(KFLB*(KFLB-1))/2+KFLC | |
6117 | ENDIF | |
6118 | ||
6119 | C...Spin 3/2 baryons. | |
6120 | ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.4) THEN | |
6121 | IF(KFLA.EQ.9.OR.KFLB.EQ.0.OR.KFLB.EQ.9.OR.KFLC.EQ.9) THEN | |
6122 | ELSEIF(KFLA.LT.KFLB.OR.KFLB.LT.KFLC) THEN | |
6123 | ELSEIF(KFLA.GE.6.OR.KFLB.GE.4) THEN | |
6124 | LYCOMP=80+KFLA | |
6125 | ELSE | |
6126 | LYCOMP=360+((KFLA+1)*KFLA*(KFLA-1))/6+(KFLB*(KFLB-1))/2+KFLC | |
6127 | ENDIF | |
6128 | ENDIF | |
6129 | ||
6130 | RETURN | |
6131 | END | |
6132 | ||
6133 | C********************************************************************* | |
6134 | ||
6135 | SUBROUTINE LYERRM(MERR,CHMESS) | |
6136 | ||
6137 | C...Purpose: to inform user of errors in program execution. | |
6138 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
6139 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
6140 | SAVE /LYJETS/,/LYDAT1/ | |
6141 | CHARACTER CHMESS*(*) | |
6142 | ||
6143 | C...Write first few warnings, then be silent. | |
6144 | IF(MERR.LE.10) THEN | |
6145 | MSTU(27)=MSTU(27)+1 | |
6146 | MSTU(28)=MERR | |
6147 | IF(MSTU(25).EQ.1.AND.MSTU(27).LE.MSTU(26)) WRITE(MSTU(11),5000) | |
6148 | & MERR,MSTU(31),CHMESS | |
6149 | ||
6150 | C...Write first few errors, then be silent or stop program. | |
6151 | ELSEIF(MERR.LE.20) THEN | |
6152 | MSTU(23)=MSTU(23)+1 | |
6153 | MSTU(24)=MERR-10 | |
6154 | IF(MSTU(21).GE.1.AND.MSTU(23).LE.MSTU(22)) WRITE(MSTU(11),5100) | |
6155 | & MERR-10,MSTU(31),CHMESS | |
6156 | IF(MSTU(21).GE.2.AND.MSTU(23).GT.MSTU(22)) THEN | |
6157 | WRITE(MSTU(11),5100) MERR-10,MSTU(31),CHMESS | |
6158 | WRITE(MSTU(11),5200) | |
6159 | IF(MERR.NE.17) CALL LYLIST(2) | |
6160 | STOP | |
6161 | ENDIF | |
6162 | ||
6163 | C...Stop program in case of irreparable error. | |
6164 | ELSE | |
6165 | WRITE(MSTU(11),5300) MERR-20,MSTU(31),CHMESS | |
6166 | STOP | |
6167 | ENDIF | |
6168 | ||
6169 | C...Formats for output. | |
6170 | 5000 FORMAT(/5X,'Advisory warning type',I2,' given after',I6, | |
6171 | &' LYEXEC calls:'/5X,A) | |
6172 | 5100 FORMAT(/5X,'Error type',I2,' has occured after',I6, | |
6173 | &' LYEXEC calls:'/5X,A) | |
6174 | 5200 FORMAT(5X,'Execution will be stopped after listing of last ', | |
6175 | &'event!') | |
6176 | 5300 FORMAT(/5X,'Fatal error type',I2,' has occured after',I6, | |
6177 | &' LYEXEC calls:'/5X,A/5X,'Execution will now be stopped!') | |
6178 | ||
6179 | RETURN | |
6180 | END | |
6181 | ||
6182 | C********************************************************************* | |
6183 | ||
6184 | FUNCTION UYALEM(Q2) | |
6185 | ||
6186 | C...Purpose: to calculate the running alpha_electromagnetic. | |
6187 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
6188 | SAVE /LYDAT1/ | |
6189 | ||
6190 | C...Calculate real part of photon vacuum polarization. | |
6191 | C...For leptons simplify by using asymptotic (Q^2 >> m^2) expressions. | |
6192 | C...For hadrons use parametrization of H. Burkhardt et al. | |
6193 | C...See R. Kleiss et al, CERN 89-08, vol. 3, pp. 129-131. | |
6194 | AEMPI=PARU(101)/(3.*PARU(1)) | |
6195 | IF(MSTU(101).LE.0.OR.Q2.LT.2E-6) THEN | |
6196 | RPIGG=0. | |
6197 | ELSEIF(MSTU(101).EQ.2.AND.Q2.LT.PARU(104)) THEN | |
6198 | RPIGG=0. | |
6199 | ELSEIF(MSTU(101).EQ.2) THEN | |
6200 | RPIGG=1.-PARU(101)/PARU(103) | |
6201 | ELSEIF(Q2.LT.0.09) THEN | |
6202 | RPIGG=AEMPI*(13.4916+LOG(Q2))+0.00835*LOG(1.+Q2) | |
6203 | ELSEIF(Q2.LT.9.) THEN | |
6204 | RPIGG=AEMPI*(16.3200+2.*LOG(Q2))+0.00238*LOG(1.+3.927*Q2) | |
6205 | ELSEIF(Q2.LT.1E4) THEN | |
6206 | RPIGG=AEMPI*(13.4955+3.*LOG(Q2))+0.00165+0.00299*LOG(1.+Q2) | |
6207 | ELSE | |
6208 | RPIGG=AEMPI*(13.4955+3.*LOG(Q2))+0.00221+0.00293*LOG(1.+Q2) | |
6209 | ENDIF | |
6210 | ||
6211 | C...Calculate running alpha_em. | |
6212 | UYALEM=PARU(101)/(1.-RPIGG) | |
6213 | PARU(108)=UYALEM | |
6214 | ||
6215 | RETURN | |
6216 | END | |
6217 | ||
6218 | C********************************************************************* | |
6219 | ||
6220 | FUNCTION UYALPS(Q2) | |
6221 | ||
6222 | C...Purpose: to give the value of alpha_strong. | |
6223 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
6224 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
6225 | SAVE /LYDAT1/,/LYDAT2/ | |
6226 | ||
6227 | C...Constant alpha_strong trivial. | |
6228 | IF(MSTU(111).LE.0) THEN | |
6229 | UYALPS=PARU(111) | |
6230 | MSTU(118)=MSTU(112) | |
6231 | PARU(117)=0. | |
6232 | PARU(118)=PARU(111) | |
6233 | RETURN | |
6234 | ENDIF | |
6235 | ||
6236 | C...Find effective Q2, number of flavours and Lambda. | |
6237 | Q2EFF=Q2 | |
6238 | IF(MSTU(115).GE.2) Q2EFF=MAX(Q2,PARU(114)) | |
6239 | NF=MSTU(112) | |
6240 | ALAM2=PARU(112)**2 | |
6241 | 100 IF(NF.GT.MAX(2,MSTU(113))) THEN | |
6242 | Q2THR=PARU(113)*PMAS(NF,1)**2 | |
6243 | IF(Q2EFF.LT.Q2THR) THEN | |
6244 | NF=NF-1 | |
6245 | ALAM2=ALAM2*(Q2THR/ALAM2)**(2./(33.-2.*NF)) | |
6246 | GOTO 100 | |
6247 | ENDIF | |
6248 | ENDIF | |
6249 | 110 IF(NF.LT.MIN(8,MSTU(114))) THEN | |
6250 | Q2THR=PARU(113)*PMAS(NF+1,1)**2 | |
6251 | IF(Q2EFF.GT.Q2THR) THEN | |
6252 | NF=NF+1 | |
6253 | ALAM2=ALAM2*(ALAM2/Q2THR)**(2./(33.-2.*NF)) | |
6254 | GOTO 110 | |
6255 | ENDIF | |
6256 | ENDIF | |
6257 | IF(MSTU(115).EQ.1) Q2EFF=Q2EFF+ALAM2 | |
6258 | PARU(117)=SQRT(ALAM2) | |
6259 | ||
6260 | C...Evaluate first or second order alpha_strong. | |
6261 | B0=(33.-2.*NF)/6. | |
6262 | ALGQ=LOG(MAX(1.0001,Q2EFF/ALAM2)) | |
6263 | IF(MSTU(111).EQ.1) THEN | |
6264 | UYALPS=MIN(PARU(115),PARU(2)/(B0*ALGQ)) | |
6265 | ELSE | |
6266 | B1=(153.-19.*NF)/6. | |
6267 | UYALPS=MIN(PARU(115),PARU(2)/(B0*ALGQ)*(1.-B1*LOG(ALGQ)/ | |
6268 | & (B0**2*ALGQ))) | |
6269 | ENDIF | |
6270 | MSTU(118)=NF | |
6271 | PARU(118)=UYALPS | |
6272 | ||
6273 | RETURN | |
6274 | END | |
6275 | ||
6276 | C********************************************************************* | |
6277 | ||
6278 | FUNCTION UYANGL(X,Y) | |
6279 | ||
6280 | C...Purpose: to reconstruct an angle from given x and y coordinates. | |
6281 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
6282 | SAVE /LYDAT1/ | |
6283 | ||
6284 | UYANGL=0. | |
6285 | R=SQRT(X**2+Y**2) | |
6286 | IF(R.LT.1E-20) RETURN | |
6287 | IF(ABS(X)/R.LT.0.8) THEN | |
6288 | UYANGL=SIGN(ACOS(X/R),Y) | |
6289 | ELSE | |
6290 | UYANGL=ASIN(Y/R) | |
6291 | IF(X.LT.0..AND.UYANGL.GE.0.) THEN | |
6292 | UYANGL=PARU(1)-UYANGL | |
6293 | ELSEIF(X.LT.0.) THEN | |
6294 | UYANGL=-PARU(1)-UYANGL | |
6295 | ENDIF | |
6296 | ENDIF | |
6297 | ||
6298 | RETURN | |
6299 | END | |
6300 | ||
6301 | C********************************************************************* | |
6302 | c | |
6303 | c FUNCTION RLU(IDUMMY) | |
6304 | c | |
6305 | cC...Purpose: to generate random numbers uniformly distributed between | |
6306 | cC...0 and 1, excluding the endpoints. | |
6307 | c COMMON/LYDATR/MRLU(6),RRLU(100) | |
6308 | c SAVE /LYDATR/ | |
6309 | c EQUIVALENCE (MRLU1,MRLU(1)),(MRLU2,MRLU(2)),(MRLU3,MRLU(3)), | |
6310 | c &(MRLU4,MRLU(4)),(MRLU5,MRLU(5)),(MRLU6,MRLU(6)), | |
6311 | c &(RRLU98,RRLU(98)),(RRLU99,RRLU(99)),(RRLU00,RRLU(100)) | |
6312 | c | |
6313 | cC...Initialize generation from given seed. | |
6314 | c IF(MRLU2.EQ.0) THEN | |
6315 | c IJ=MOD(MRLU1/30082,31329) | |
6316 | c KL=MOD(MRLU1,30082) | |
6317 | c I=MOD(IJ/177,177)+2 | |
6318 | c J=MOD(IJ,177)+2 | |
6319 | c K=MOD(KL/169,178)+1 | |
6320 | c L=MOD(KL,169) | |
6321 | c DO 110 II=1,97 | |
6322 | c S=0. | |
6323 | c T=0.5 | |
6324 | c DO 100 JJ=1,24 | |
6325 | c M=MOD(MOD(I*J,179)*K,179) | |
6326 | c I=J | |
6327 | c J=K | |
6328 | c K=M | |
6329 | c L=MOD(53*L+1,169) | |
6330 | c IF(MOD(L*M,64).GE.32) S=S+T | |
6331 | c T=0.5*T | |
6332 | c 100 CONTINUE | |
6333 | c RRLU(II)=S | |
6334 | c 110 CONTINUE | |
6335 | c TWOM24=1. | |
6336 | c DO 120 I24=1,24 | |
6337 | c TWOM24=0.5*TWOM24 | |
6338 | c 120 CONTINUE | |
6339 | c RRLU98=362436.*TWOM24 | |
6340 | c RRLU99=7654321.*TWOM24 | |
6341 | c RRLU00=16777213.*TWOM24 | |
6342 | c MRLU2=1 | |
6343 | c MRLU3=0 | |
6344 | c MRLU4=97 | |
6345 | c MRLU5=33 | |
6346 | c ENDIF | |
6347 | c | |
6348 | cC...Generate next random number. | |
6349 | c 130 RUNI=RRLU(MRLU4)-RRLU(MRLU5) | |
6350 | c IF(RUNI.LT.0.) RUNI=RUNI+1. | |
6351 | c RRLU(MRLU4)=RUNI | |
6352 | c MRLU4=MRLU4-1 | |
6353 | c IF(MRLU4.EQ.0) MRLU4=97 | |
6354 | c MRLU5=MRLU5-1 | |
6355 | c IF(MRLU5.EQ.0) MRLU5=97 | |
6356 | c RRLU98=RRLU98-RRLU99 | |
6357 | c IF(RRLU98.LT.0.) RRLU98=RRLU98+RRLU00 | |
6358 | c RUNI=RUNI-RRLU98 | |
6359 | c IF(RUNI.LT.0.) RUNI=RUNI+1. | |
6360 | c IF(RUNI.LE.0.OR.RUNI.GE.1.) GOTO 130 | |
6361 | c | |
6362 | cC...Update counters. Random number to output. | |
6363 | c MRLU3=MRLU3+1 | |
6364 | c IF(MRLU3.EQ.1000000000) THEN | |
6365 | c MRLU2=MRLU2+1 | |
6366 | c MRLU3=0 | |
6367 | c ENDIF | |
6368 | c RLU=RUNI | |
6369 | c | |
6370 | c RETURN | |
6371 | c END | |
6372 | c | |
6373 | C********************************************************************* | |
6374 | ||
6375 | SUBROUTINE RLYGET(LFN,MOVE) | |
6376 | ||
6377 | C...Purpose: to dump the state of the random number generator on a file | |
6378 | C...for subsequent startup from this state onwards. | |
6379 | COMMON/LYDATR/MRLU(6),RRLU(100) | |
6380 | SAVE /LYDATR/ | |
6381 | CHARACTER CHERR*8 | |
6382 | ||
6383 | C...Backspace required number of records (or as many as there are). | |
6384 | IF(MOVE.LT.0) THEN | |
6385 | NBCK=MIN(MRLU(6),-MOVE) | |
6386 | DO 100 IBCK=1,NBCK | |
6387 | BACKSPACE(LFN,ERR=110,IOSTAT=IERR) | |
6388 | 100 CONTINUE | |
6389 | MRLU(6)=MRLU(6)-NBCK | |
6390 | ENDIF | |
6391 | ||
6392 | C...Unformatted write on unit LFN. | |
6393 | WRITE(LFN,ERR=110,IOSTAT=IERR) (MRLU(I1),I1=1,5), | |
6394 | &(RRLU(I2),I2=1,100) | |
6395 | MRLU(6)=MRLU(6)+1 | |
6396 | RETURN | |
6397 | ||
6398 | C...Write error. | |
6399 | 110 WRITE(CHERR,'(I8)') IERR | |
6400 | CALL LYERRM(18,'(RLYGET:) error when accessing file, IOSTAT ='// | |
6401 | &CHERR) | |
6402 | ||
6403 | RETURN | |
6404 | END | |
6405 | ||
6406 | C********************************************************************* | |
6407 | ||
6408 | SUBROUTINE RLYSET(LFN,MOVE) | |
6409 | ||
6410 | C...Purpose: to read a state of the random number generator from a file | |
6411 | C...for subsequent generation from this state onwards. | |
6412 | COMMON/LYDATR/MRLU(6),RRLU(100) | |
6413 | SAVE /LYDATR/ | |
6414 | CHARACTER CHERR*8 | |
6415 | ||
6416 | C...Backspace required number of records (or as many as there are). | |
6417 | IF(MOVE.LT.0) THEN | |
6418 | NBCK=MIN(MRLU(6),-MOVE) | |
6419 | DO 100 IBCK=1,NBCK | |
6420 | BACKSPACE(LFN,ERR=120,IOSTAT=IERR) | |
6421 | 100 CONTINUE | |
6422 | MRLU(6)=MRLU(6)-NBCK | |
6423 | ENDIF | |
6424 | ||
6425 | C...Unformatted read from unit LFN. | |
6426 | NFOR=1+MAX(0,MOVE) | |
6427 | DO 110 IFOR=1,NFOR | |
6428 | READ(LFN,ERR=120,IOSTAT=IERR) (MRLU(I1),I1=1,5), | |
6429 | &(RRLU(I2),I2=1,100) | |
6430 | 110 CONTINUE | |
6431 | MRLU(6)=MRLU(6)+NFOR | |
6432 | RETURN | |
6433 | ||
6434 | C...Write error. | |
6435 | 120 WRITE(CHERR,'(I8)') IERR | |
6436 | CALL LYERRM(18,'(RLYSET:) error when accessing file, IOSTAT ='// | |
6437 | &CHERR) | |
6438 | ||
6439 | RETURN | |
6440 | END | |
6441 | ||
6442 | C********************************************************************* | |
6443 | ||
6444 | SUBROUTINE LYROBO(THE,PHI,BEX,BEY,BEZ) | |
6445 | ||
6446 | C...Purpose: to perform rotations and boosts. | |
6447 | IMPLICIT DOUBLE PRECISION(D) | |
6448 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
6449 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
6450 | SAVE /LYJETS/,/LYDAT1/ | |
6451 | DIMENSION ROT(3,3),PR(3),VR(3),DP(4),DV(4) | |
6452 | ||
6453 | C...Find range of rotation/boost. Convert boost to double precision. | |
6454 | IMIN=1 | |
6455 | IF(MSTU(1).GT.0) IMIN=MSTU(1) | |
6456 | IMAX=N | |
6457 | IF(MSTU(2).GT.0) IMAX=MSTU(2) | |
6458 | DBX=BEX | |
6459 | DBY=BEY | |
6460 | DBZ=BEZ | |
6461 | GOTO 120 | |
6462 | ||
6463 | C...Entry for specific range and double precision boost. | |
6464 | ENTRY LUDBRB(IMI,IMA,THE,PHI,DBEX,DBEY,DBEZ) | |
6465 | IMIN=IMI | |
6466 | IF(IMIN.LE.0) IMIN=1 | |
6467 | IMAX=IMA | |
6468 | IF(IMAX.LE.0) IMAX=N | |
6469 | DBX=DBEX | |
6470 | DBY=DBEY | |
6471 | DBZ=DBEZ | |
6472 | ||
6473 | C...Optional resetting of V (when not set before.) | |
6474 | IF(MSTU(33).NE.0) THEN | |
6475 | DO 110 I=MIN(IMIN,MSTU(4)),MIN(IMAX,MSTU(4)) | |
6476 | DO 100 J=1,5 | |
6477 | V(I,J)=0. | |
6478 | 100 CONTINUE | |
6479 | 110 CONTINUE | |
6480 | MSTU(33)=0 | |
6481 | ENDIF | |
6482 | ||
6483 | C...Check range of rotation/boost. | |
6484 | 120 IF(IMIN.GT.MSTU(4).OR.IMAX.GT.MSTU(4)) THEN | |
6485 | CALL LYERRM(11,'(LYROBO:) range outside LUJETS memory') | |
6486 | RETURN | |
6487 | ENDIF | |
6488 | ||
6489 | C...Rotate, typically from z axis to direction (theta,phi). | |
6490 | IF(THE**2+PHI**2.GT.1E-20) THEN | |
6491 | ROT(1,1)=COS(THE)*COS(PHI) | |
6492 | ROT(1,2)=-SIN(PHI) | |
6493 | ROT(1,3)=SIN(THE)*COS(PHI) | |
6494 | ROT(2,1)=COS(THE)*SIN(PHI) | |
6495 | ROT(2,2)=COS(PHI) | |
6496 | ROT(2,3)=SIN(THE)*SIN(PHI) | |
6497 | ROT(3,1)=-SIN(THE) | |
6498 | ROT(3,2)=0. | |
6499 | ROT(3,3)=COS(THE) | |
6500 | DO 150 I=IMIN,IMAX | |
6501 | IF(K(I,1).LE.0) GOTO 150 | |
6502 | DO 130 J=1,3 | |
6503 | PR(J)=P(I,J) | |
6504 | VR(J)=V(I,J) | |
6505 | 130 CONTINUE | |
6506 | DO 140 J=1,3 | |
6507 | P(I,J)=ROT(J,1)*PR(1)+ROT(J,2)*PR(2)+ROT(J,3)*PR(3) | |
6508 | V(I,J)=ROT(J,1)*VR(1)+ROT(J,2)*VR(2)+ROT(J,3)*VR(3) | |
6509 | 140 CONTINUE | |
6510 | 150 CONTINUE | |
6511 | ENDIF | |
6512 | ||
6513 | C...Boost, typically from rest to momentum/energy=beta. | |
6514 | IF(DBX**2+DBY**2+DBZ**2.GT.1E-20) THEN | |
6515 | DB=SQRT(DBX**2+DBY**2+DBZ**2) | |
6516 | IF(DB.GT.0.99999999D0) THEN | |
6517 | C...Rescale boost vector if too close to unity. | |
6518 | CALL LYERRM(3,'(LYROBO:) boost vector too large') | |
6519 | DBX=DBX*(0.99999999D0/DB) | |
6520 | DBY=DBY*(0.99999999D0/DB) | |
6521 | DBZ=DBZ*(0.99999999D0/DB) | |
6522 | DB=0.99999999D0 | |
6523 | ENDIF | |
6524 | DGA=1D0/SQRT(1D0-DB**2) | |
6525 | DO 170 I=IMIN,IMAX | |
6526 | IF(K(I,1).LE.0) GOTO 170 | |
6527 | DO 160 J=1,4 | |
6528 | DP(J)=P(I,J) | |
6529 | DV(J)=V(I,J) | |
6530 | 160 CONTINUE | |
6531 | DBP=DBX*DP(1)+DBY*DP(2)+DBZ*DP(3) | |
6532 | DGABP=DGA*(DGA*DBP/(1D0+DGA)+DP(4)) | |
6533 | P(I,1)=DP(1)+DGABP*DBX | |
6534 | P(I,2)=DP(2)+DGABP*DBY | |
6535 | P(I,3)=DP(3)+DGABP*DBZ | |
6536 | P(I,4)=DGA*(DP(4)+DBP) | |
6537 | DBV=DBX*DV(1)+DBY*DV(2)+DBZ*DV(3) | |
6538 | DGABV=DGA*(DGA*DBV/(1D0+DGA)+DV(4)) | |
6539 | V(I,1)=DV(1)+DGABV*DBX | |
6540 | V(I,2)=DV(2)+DGABV*DBY | |
6541 | V(I,3)=DV(3)+DGABV*DBZ | |
6542 | V(I,4)=DGA*(DV(4)+DBV) | |
6543 | 170 CONTINUE | |
6544 | ENDIF | |
6545 | ||
6546 | RETURN | |
6547 | END | |
6548 | ||
6549 | C********************************************************************* | |
6550 | ||
6551 | SUBROUTINE LYEDIT(MEDIT) | |
6552 | ||
6553 | C...Purpose: to perform global manipulations on the event record, | |
6554 | C...in particular to exclude unstable or undetectable partons/particles. | |
6555 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
6556 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
6557 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
6558 | SAVE /LYJETS/,/LYDAT1/,/LYDAT2/ | |
6559 | DIMENSION NS(2),PTS(2),PLS(2) | |
6560 | ||
6561 | C...Remove unwanted partons/particles. | |
6562 | IF((MEDIT.GE.0.AND.MEDIT.LE.3).OR.MEDIT.EQ.5) THEN | |
6563 | IMAX=N | |
6564 | IF(MSTU(2).GT.0) IMAX=MSTU(2) | |
6565 | I1=MAX(1,MSTU(1))-1 | |
6566 | DO 110 I=MAX(1,MSTU(1)),IMAX | |
6567 | IF(K(I,1).EQ.0.OR.K(I,1).GT.20) GOTO 110 | |
6568 | IF(MEDIT.EQ.1) THEN | |
6569 | IF(K(I,1).GT.10) GOTO 110 | |
6570 | ELSEIF(MEDIT.EQ.2) THEN | |
6571 | IF(K(I,1).GT.10) GOTO 110 | |
6572 | KC=LYCOMP(K(I,2)) | |
6573 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.KC.EQ.18) | |
6574 | & GOTO 110 | |
6575 | ELSEIF(MEDIT.EQ.3) THEN | |
6576 | IF(K(I,1).GT.10) GOTO 110 | |
6577 | KC=LYCOMP(K(I,2)) | |
6578 | IF(KC.EQ.0) GOTO 110 | |
6579 | IF(KCHG(KC,2).EQ.0.AND.LYCHGE(K(I,2)).EQ.0) GOTO 110 | |
6580 | ELSEIF(MEDIT.EQ.5) THEN | |
6581 | IF(K(I,1).EQ.13.OR.K(I,1).EQ.14) GOTO 110 | |
6582 | KC=LYCOMP(K(I,2)) | |
6583 | IF(KC.EQ.0) GOTO 110 | |
6584 | IF(K(I,1).GE.11.AND.KCHG(KC,2).EQ.0) GOTO 110 | |
6585 | ENDIF | |
6586 | ||
6587 | C...Pack remaining partons/particles. Origin no longer known. | |
6588 | I1=I1+1 | |
6589 | DO 100 J=1,5 | |
6590 | K(I1,J)=K(I,J) | |
6591 | P(I1,J)=P(I,J) | |
6592 | V(I1,J)=V(I,J) | |
6593 | 100 CONTINUE | |
6594 | K(I1,3)=0 | |
6595 | 110 CONTINUE | |
6596 | IF(I1.LT.N) MSTU(3)=0 | |
6597 | IF(I1.LT.N) MSTU(70)=0 | |
6598 | N=I1 | |
6599 | ||
6600 | C...Selective removal of class of entries. New position of retained. | |
6601 | ELSEIF(MEDIT.GE.11.AND.MEDIT.LE.15) THEN | |
6602 | I1=0 | |
6603 | DO 120 I=1,N | |
6604 | K(I,3)=MOD(K(I,3),MSTU(5)) | |
6605 | IF(MEDIT.EQ.11.AND.K(I,1).LT.0) GOTO 120 | |
6606 | IF(MEDIT.EQ.12.AND.K(I,1).EQ.0) GOTO 120 | |
6607 | IF(MEDIT.EQ.13.AND.(K(I,1).EQ.11.OR.K(I,1).EQ.12.OR. | |
6608 | & K(I,1).EQ.15).AND.K(I,2).NE.94) GOTO 120 | |
6609 | IF(MEDIT.EQ.14.AND.(K(I,1).EQ.13.OR.K(I,1).EQ.14.OR. | |
6610 | & K(I,2).EQ.94)) GOTO 120 | |
6611 | IF(MEDIT.EQ.15.AND.K(I,1).GE.21) GOTO 120 | |
6612 | I1=I1+1 | |
6613 | K(I,3)=K(I,3)+MSTU(5)*I1 | |
6614 | 120 CONTINUE | |
6615 | ||
6616 | C...Find new event history information and replace old. | |
6617 | DO 140 I=1,N | |
6618 | IF(K(I,1).LE.0.OR.K(I,1).GT.20.OR.K(I,3)/MSTU(5).EQ.0) GOTO 140 | |
6619 | ID=I | |
6620 | 130 IM=MOD(K(ID,3),MSTU(5)) | |
6621 | IF(MEDIT.EQ.13.AND.IM.GT.0.AND.IM.LE.N) THEN | |
6622 | IF((K(IM,1).EQ.11.OR.K(IM,1).EQ.12.OR.K(IM,1).EQ.15).AND. | |
6623 | & K(IM,2).NE.94) THEN | |
6624 | ID=IM | |
6625 | GOTO 130 | |
6626 | ENDIF | |
6627 | ELSEIF(MEDIT.EQ.14.AND.IM.GT.0.AND.IM.LE.N) THEN | |
6628 | IF(K(IM,1).EQ.13.OR.K(IM,1).EQ.14.OR.K(IM,2).EQ.94) THEN | |
6629 | ID=IM | |
6630 | GOTO 130 | |
6631 | ENDIF | |
6632 | ENDIF | |
6633 | K(I,3)=MSTU(5)*(K(I,3)/MSTU(5)) | |
6634 | IF(IM.NE.0) K(I,3)=K(I,3)+K(IM,3)/MSTU(5) | |
6635 | IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) THEN | |
6636 | IF(K(I,4).GT.0.AND.K(I,4).LE.MSTU(4)) K(I,4)= | |
6637 | & K(K(I,4),3)/MSTU(5) | |
6638 | IF(K(I,5).GT.0.AND.K(I,5).LE.MSTU(4)) K(I,5)= | |
6639 | & K(K(I,5),3)/MSTU(5) | |
6640 | ELSE | |
6641 | KCM=MOD(K(I,4)/MSTU(5),MSTU(5)) | |
6642 | IF(KCM.GT.0.AND.KCM.LE.MSTU(4)) KCM=K(KCM,3)/MSTU(5) | |
6643 | KCD=MOD(K(I,4),MSTU(5)) | |
6644 | IF(KCD.GT.0.AND.KCD.LE.MSTU(4)) KCD=K(KCD,3)/MSTU(5) | |
6645 | K(I,4)=MSTU(5)**2*(K(I,4)/MSTU(5)**2)+MSTU(5)*KCM+KCD | |
6646 | KCM=MOD(K(I,5)/MSTU(5),MSTU(5)) | |
6647 | IF(KCM.GT.0.AND.KCM.LE.MSTU(4)) KCM=K(KCM,3)/MSTU(5) | |
6648 | KCD=MOD(K(I,5),MSTU(5)) | |
6649 | IF(KCD.GT.0.AND.KCD.LE.MSTU(4)) KCD=K(KCD,3)/MSTU(5) | |
6650 | K(I,5)=MSTU(5)**2*(K(I,5)/MSTU(5)**2)+MSTU(5)*KCM+KCD | |
6651 | ENDIF | |
6652 | 140 CONTINUE | |
6653 | ||
6654 | C...Pack remaining entries. | |
6655 | I1=0 | |
6656 | MSTU90=MSTU(90) | |
6657 | MSTU(90)=0 | |
6658 | DO 170 I=1,N | |
6659 | IF(K(I,3)/MSTU(5).EQ.0) GOTO 170 | |
6660 | I1=I1+1 | |
6661 | DO 150 J=1,5 | |
6662 | K(I1,J)=K(I,J) | |
6663 | P(I1,J)=P(I,J) | |
6664 | V(I1,J)=V(I,J) | |
6665 | 150 CONTINUE | |
6666 | K(I1,3)=MOD(K(I1,3),MSTU(5)) | |
6667 | DO 160 IZ=1,MSTU90 | |
6668 | IF(I.EQ.MSTU(90+IZ)) THEN | |
6669 | MSTU(90)=MSTU(90)+1 | |
6670 | MSTU(90+MSTU(90))=I1 | |
6671 | PARU(90+MSTU(90))=PARU(90+IZ) | |
6672 | ENDIF | |
6673 | 160 CONTINUE | |
6674 | 170 CONTINUE | |
6675 | IF(I1.LT.N) MSTU(3)=0 | |
6676 | IF(I1.LT.N) MSTU(70)=0 | |
6677 | N=I1 | |
6678 | ||
6679 | C...Fill in some missing daughter pointers (lost in colour flow). | |
6680 | ELSEIF(MEDIT.EQ.16) THEN | |
6681 | DO 190 I=1,N | |
6682 | IF(K(I,1).LE.10.OR.K(I,1).GT.20) GOTO 190 | |
6683 | IF(K(I,4).NE.0.OR.K(I,5).NE.0) GOTO 190 | |
6684 | C...Find daughters who point to mother. | |
6685 | DO 180 I1=I+1,N | |
6686 | IF(K(I1,3).NE.I) THEN | |
6687 | ELSEIF(K(I,4).EQ.0) THEN | |
6688 | K(I,4)=I1 | |
6689 | ELSE | |
6690 | K(I,5)=I1 | |
6691 | ENDIF | |
6692 | 180 CONTINUE | |
6693 | IF(K(I,5).EQ.0) K(I,5)=K(I,4) | |
6694 | IF(K(I,4).NE.0) GOTO 190 | |
6695 | C...Find daughters who point to documentation version of mother. | |
6696 | IM=K(I,3) | |
6697 | IF(IM.LE.0.OR.IM.GE.I) GOTO 190 | |
6698 | IF(K(IM,1).LE.20.OR.K(IM,1).GT.30) GOTO 190 | |
6699 | IF(K(IM,2).NE.K(I,2).OR.ABS(P(IM,5)-P(I,5)).GT.1E-2) GOTO 190 | |
6700 | DO 182 I1=I+1,N | |
6701 | IF(K(I1,3).NE.IM) THEN | |
6702 | ELSEIF(K(I,4).EQ.0) THEN | |
6703 | K(I,4)=I1 | |
6704 | ELSE | |
6705 | K(I,5)=I1 | |
6706 | ENDIF | |
6707 | 182 CONTINUE | |
6708 | IF(K(I,5).EQ.0) K(I,5)=K(I,4) | |
6709 | IF(K(I,4).NE.0) GOTO 190 | |
6710 | C...Find daughters who point to documentation daughters who, | |
6711 | C...in their turn, point to documentation mother. | |
6712 | ID1=IM | |
6713 | ID2=IM | |
6714 | DO 184 I1=IM+1,I-1 | |
6715 | IF(K(I1,3).EQ.IM.AND.K(I1,1).GT.20.AND.K(I1,1).LE.30) THEN | |
6716 | ID2=I1 | |
6717 | IF(ID1.EQ.IM) ID1=I1 | |
6718 | ENDIF | |
6719 | 184 CONTINUE | |
6720 | DO 186 I1=I+1,N | |
6721 | IF(K(I1,3).NE.ID1.AND.K(I1,3).NE.ID2) THEN | |
6722 | ELSEIF(K(I,4).EQ.0) THEN | |
6723 | K(I,4)=I1 | |
6724 | ELSE | |
6725 | K(I,5)=I1 | |
6726 | ENDIF | |
6727 | 186 CONTINUE | |
6728 | IF(K(I,5).EQ.0) K(I,5)=K(I,4) | |
6729 | 190 CONTINUE | |
6730 | ||
6731 | C...Save top entries at bottom of LUJETS commonblock. | |
6732 | ELSEIF(MEDIT.EQ.21) THEN | |
6733 | IF(2*N.GE.MSTU(4)) THEN | |
6734 | CALL LYERRM(11,'(LYEDIT:) no more memory left in LUJETS') | |
6735 | RETURN | |
6736 | ENDIF | |
6737 | DO 210 I=1,N | |
6738 | DO 200 J=1,5 | |
6739 | K(MSTU(4)-I,J)=K(I,J) | |
6740 | P(MSTU(4)-I,J)=P(I,J) | |
6741 | V(MSTU(4)-I,J)=V(I,J) | |
6742 | 200 CONTINUE | |
6743 | 210 CONTINUE | |
6744 | MSTU(32)=N | |
6745 | ||
6746 | C...Restore bottom entries of commonblock LUJETS to top. | |
6747 | ELSEIF(MEDIT.EQ.22) THEN | |
6748 | DO 230 I=1,MSTU(32) | |
6749 | DO 220 J=1,5 | |
6750 | K(I,J)=K(MSTU(4)-I,J) | |
6751 | P(I,J)=P(MSTU(4)-I,J) | |
6752 | V(I,J)=V(MSTU(4)-I,J) | |
6753 | 220 CONTINUE | |
6754 | 230 CONTINUE | |
6755 | N=MSTU(32) | |
6756 | ||
6757 | C...Mark primary entries at top of commonblock LUJETS as untreated. | |
6758 | ELSEIF(MEDIT.EQ.23) THEN | |
6759 | I1=0 | |
6760 | DO 240 I=1,N | |
6761 | KH=K(I,3) | |
6762 | IF(KH.GE.1) THEN | |
6763 | IF(K(KH,1).GT.20) KH=0 | |
6764 | ENDIF | |
6765 | IF(KH.NE.0) GOTO 250 | |
6766 | I1=I1+1 | |
6767 | IF(K(I,1).GT.10.AND.K(I,1).LE.20) K(I,1)=K(I,1)-10 | |
6768 | 240 CONTINUE | |
6769 | 250 N=I1 | |
6770 | ||
6771 | C...Place largest axis along z axis and second largest in xy plane. | |
6772 | ELSEIF(MEDIT.EQ.31.OR.MEDIT.EQ.32) THEN | |
6773 | CALL LUDBRB(1,N+MSTU(3),0.,-UYANGL(P(MSTU(61),1), | |
6774 | & P(MSTU(61),2)),0D0,0D0,0D0) | |
6775 | CALL LUDBRB(1,N+MSTU(3),-UYANGL(P(MSTU(61),3), | |
6776 | & P(MSTU(61),1)),0.,0D0,0D0,0D0) | |
6777 | CALL LUDBRB(1,N+MSTU(3),0.,-UYANGL(P(MSTU(61)+1,1), | |
6778 | & P(MSTU(61)+1,2)),0D0,0D0,0D0) | |
6779 | IF(MEDIT.EQ.31) RETURN | |
6780 | ||
6781 | C...Rotate to put slim jet along +z axis. | |
6782 | DO 260 IS=1,2 | |
6783 | NS(IS)=0 | |
6784 | PTS(IS)=0. | |
6785 | PLS(IS)=0. | |
6786 | 260 CONTINUE | |
6787 | DO 270 I=1,N | |
6788 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 270 | |
6789 | IF(MSTU(41).GE.2) THEN | |
6790 | KC=LYCOMP(K(I,2)) | |
6791 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. | |
6792 | & KC.EQ.18) GOTO 270 | |
6793 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LYCHGE(K(I,2)).EQ.0) | |
6794 | & GOTO 270 | |
6795 | ENDIF | |
6796 | IS=2.-SIGN(0.5,P(I,3)) | |
6797 | NS(IS)=NS(IS)+1 | |
6798 | PTS(IS)=PTS(IS)+SQRT(P(I,1)**2+P(I,2)**2) | |
6799 | 270 CONTINUE | |
6800 | IF(NS(1)*PTS(2)**2.LT.NS(2)*PTS(1)**2) | |
6801 | & CALL LUDBRB(1,N+MSTU(3),PARU(1),0.,0D0,0D0,0D0) | |
6802 | ||
6803 | C...Rotate to put second largest jet into -z,+x quadrant. | |
6804 | DO 280 I=1,N | |
6805 | IF(P(I,3).GE.0.) GOTO 280 | |
6806 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 280 | |
6807 | IF(MSTU(41).GE.2) THEN | |
6808 | KC=LYCOMP(K(I,2)) | |
6809 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. | |
6810 | & KC.EQ.18) GOTO 280 | |
6811 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LYCHGE(K(I,2)).EQ.0) | |
6812 | & GOTO 280 | |
6813 | ENDIF | |
6814 | IS=2.-SIGN(0.5,P(I,1)) | |
6815 | PLS(IS)=PLS(IS)-P(I,3) | |
6816 | 280 CONTINUE | |
6817 | IF(PLS(2).GT.PLS(1)) CALL LUDBRB(1,N+MSTU(3),0.,PARU(1), | |
6818 | & 0D0,0D0,0D0) | |
6819 | ENDIF | |
6820 | ||
6821 | RETURN | |
6822 | END | |
6823 | ||
6824 | C********************************************************************* | |
6825 | ||
6826 | SUBROUTINE LYLIST(MLIST) | |
6827 | ||
6828 | C...Purpose: to give program heading, or list an event, or particle | |
6829 | C...data, or current parameter values. | |
6830 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
6831 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
6832 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
6833 | COMMON/LYDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) | |
6834 | SAVE /LYJETS/,/LYDAT1/,/LYDAT2/,/LYDAT3/ | |
6835 | CHARACTER CHAP*16,CHAC*16,CHAN*16,CHAD(5)*16,CHDL(7)*4 | |
6836 | DIMENSION PS(6) | |
6837 | DATA CHDL/'(())',' ','()','!!','<>','==','(==)'/ | |
6838 | ||
6839 | C...Initialization printout: version number and date of last change. | |
6840 | IF(MLIST.EQ.0.OR.MSTU(12).EQ.1) THEN | |
6841 | CALL LYLOGO | |
6842 | MSTU(12)=0 | |
6843 | IF(MLIST.EQ.0) RETURN | |
6844 | ENDIF | |
6845 | ||
6846 | C...List event data, including additional lines after N. | |
6847 | IF(MLIST.GE.1.AND.MLIST.LE.3) THEN | |
6848 | IF(MLIST.EQ.1) WRITE(MSTU(11),5100) | |
6849 | IF(MLIST.EQ.2) WRITE(MSTU(11),5200) | |
6850 | IF(MLIST.EQ.3) WRITE(MSTU(11),5300) | |
6851 | LMX=12 | |
6852 | IF(MLIST.GE.2) LMX=16 | |
6853 | ISTR=0 | |
6854 | IMAX=N | |
6855 | IF(MSTU(2).GT.0) IMAX=MSTU(2) | |
6856 | DO 120 I=MAX(1,MSTU(1)),MAX(IMAX,N+MAX(0,MSTU(3))) | |
6857 | IF((I.GT.IMAX.AND.I.LE.N).OR.K(I,1).LT.0) GOTO 120 | |
6858 | ||
6859 | C...Get particle name, pad it and check it is not too long. | |
6860 | CALL LYNAME(K(I,2),CHAP) | |
6861 | LEN=0 | |
6862 | DO 100 LEM=1,16 | |
6863 | IF(CHAP(LEM:LEM).NE.' ') LEN=LEM | |
6864 | 100 CONTINUE | |
6865 | MDL=(K(I,1)+19)/10 | |
6866 | LDL=0 | |
6867 | IF(MDL.EQ.2.OR.MDL.GE.8) THEN | |
6868 | CHAC=CHAP | |
6869 | IF(LEN.GT.LMX) CHAC(LMX:LMX)='?' | |
6870 | ELSE | |
6871 | LDL=1 | |
6872 | IF(MDL.EQ.1.OR.MDL.EQ.7) LDL=2 | |
6873 | IF(LEN.EQ.0) THEN | |
6874 | CHAC=CHDL(MDL)(1:2*LDL)//' ' | |
6875 | ELSE | |
6876 | CHAC=CHDL(MDL)(1:LDL)//CHAP(1:MIN(LEN,LMX-2*LDL))// | |
6877 | & CHDL(MDL)(LDL+1:2*LDL)//' ' | |
6878 | IF(LEN+2*LDL.GT.LMX) CHAC(LMX:LMX)='?' | |
6879 | ENDIF | |
6880 | ENDIF | |
6881 | ||
6882 | C...Add information on string connection. | |
6883 | IF(K(I,1).EQ.1.OR.K(I,1).EQ.2.OR.K(I,1).EQ.11.OR.K(I,1).EQ.12) | |
6884 | & THEN | |
6885 | KC=LYCOMP(K(I,2)) | |
6886 | KCC=0 | |
6887 | IF(KC.NE.0) KCC=KCHG(KC,2) | |
6888 | IF(IABS(K(I,2)).EQ.39) THEN | |
6889 | IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='X' | |
6890 | ELSEIF(KCC.NE.0.AND.ISTR.EQ.0) THEN | |
6891 | ISTR=1 | |
6892 | IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='A' | |
6893 | ELSEIF(KCC.NE.0.AND.(K(I,1).EQ.2.OR.K(I,1).EQ.12)) THEN | |
6894 | IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='I' | |
6895 | ELSEIF(KCC.NE.0) THEN | |
6896 | ISTR=0 | |
6897 | IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='V' | |
6898 | ENDIF | |
6899 | ENDIF | |
6900 | ||
6901 | C...Write data for particle/jet. | |
6902 | IF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.9999.) THEN | |
6903 | WRITE(MSTU(11),5400) I,CHAC(1:12),(K(I,J1),J1=1,3), | |
6904 | & (P(I,J2),J2=1,5) | |
6905 | ELSEIF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.99999.) THEN | |
6906 | WRITE(MSTU(11),5500) I,CHAC(1:12),(K(I,J1),J1=1,3), | |
6907 | & (P(I,J2),J2=1,5) | |
6908 | ELSEIF(MLIST.EQ.1) THEN | |
6909 | WRITE(MSTU(11),5600) I,CHAC(1:12),(K(I,J1),J1=1,3), | |
6910 | & (P(I,J2),J2=1,5) | |
6911 | ELSEIF(MSTU(5).EQ.10000.AND.(K(I,1).EQ.3.OR.K(I,1).EQ.13.OR. | |
6912 | & K(I,1).EQ.14)) THEN | |
6913 | WRITE(MSTU(11),5700) I,CHAC,(K(I,J1),J1=1,3), | |
6914 | & K(I,4)/100000000,MOD(K(I,4)/10000,10000),MOD(K(I,4),10000), | |
6915 | & K(I,5)/100000000,MOD(K(I,5)/10000,10000),MOD(K(I,5),10000), | |
6916 | & (P(I,J2),J2=1,5) | |
6917 | ELSE | |
6918 | WRITE(MSTU(11),5800) I,CHAC,(K(I,J1),J1=1,5),(P(I,J2),J2=1,5) | |
6919 | ENDIF | |
6920 | IF(MLIST.EQ.3) WRITE(MSTU(11),5900) (V(I,J),J=1,5) | |
6921 | ||
6922 | C...Insert extra separator lines specified by user. | |
6923 | IF(MSTU(70).GE.1) THEN | |
6924 | ISEP=0 | |
6925 | DO 110 J=1,MIN(10,MSTU(70)) | |
6926 | IF(I.EQ.MSTU(70+J)) ISEP=1 | |
6927 | 110 CONTINUE | |
6928 | IF(ISEP.EQ.1.AND.MLIST.EQ.1) WRITE(MSTU(11),6000) | |
6929 | IF(ISEP.EQ.1.AND.MLIST.GE.2) WRITE(MSTU(11),6100) | |
6930 | ENDIF | |
6931 | 120 CONTINUE | |
6932 | ||
6933 | C...Sum of charges and momenta. | |
6934 | DO 130 J=1,6 | |
6935 | PS(J)=PLY(0,J) | |
6936 | 130 CONTINUE | |
6937 | IF(MLIST.EQ.1.AND.ABS(PS(4)).LT.9999.) THEN | |
6938 | WRITE(MSTU(11),6200) PS(6),(PS(J),J=1,5) | |
6939 | ELSEIF(MLIST.EQ.1.AND.ABS(PS(4)).LT.99999.) THEN | |
6940 | WRITE(MSTU(11),6300) PS(6),(PS(J),J=1,5) | |
6941 | ELSEIF(MLIST.EQ.1) THEN | |
6942 | WRITE(MSTU(11),6400) PS(6),(PS(J),J=1,5) | |
6943 | ELSE | |
6944 | WRITE(MSTU(11),6500) PS(6),(PS(J),J=1,5) | |
6945 | ENDIF | |
6946 | ||
6947 | C...Give simple list of KF codes defined in program. | |
6948 | ELSEIF(MLIST.EQ.11) THEN | |
6949 | WRITE(MSTU(11),6600) | |
6950 | DO 140 KF=1,40 | |
6951 | CALL LYNAME(KF,CHAP) | |
6952 | CALL LYNAME(-KF,CHAN) | |
6953 | IF(CHAP.NE.' '.AND.CHAN.EQ.' ') WRITE(MSTU(11),6700) KF,CHAP | |
6954 | IF(CHAN.NE.' ') WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN | |
6955 | 140 CONTINUE | |
6956 | DO 170 KFLS=1,3,2 | |
6957 | DO 160 KFLA=1,8 | |
6958 | DO 150 KFLB=1,KFLA-(3-KFLS)/2 | |
6959 | KF=1000*KFLA+100*KFLB+KFLS | |
6960 | CALL LYNAME(KF,CHAP) | |
6961 | CALL LYNAME(-KF,CHAN) | |
6962 | WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN | |
6963 | 150 CONTINUE | |
6964 | 160 CONTINUE | |
6965 | 170 CONTINUE | |
6966 | KF=130 | |
6967 | CALL LYNAME(KF,CHAP) | |
6968 | WRITE(MSTU(11),6700) KF,CHAP | |
6969 | KF=310 | |
6970 | CALL LYNAME(KF,CHAP) | |
6971 | WRITE(MSTU(11),6700) KF,CHAP | |
6972 | DO 200 KMUL=0,5 | |
6973 | KFLS=3 | |
6974 | IF(KMUL.EQ.0.OR.KMUL.EQ.3) KFLS=1 | |
6975 | IF(KMUL.EQ.5) KFLS=5 | |
6976 | KFLR=0 | |
6977 | IF(KMUL.EQ.2.OR.KMUL.EQ.3) KFLR=1 | |
6978 | IF(KMUL.EQ.4) KFLR=2 | |
6979 | DO 190 KFLB=1,8 | |
6980 | DO 180 KFLC=1,KFLB-1 | |
6981 | KF=10000*KFLR+100*KFLB+10*KFLC+KFLS | |
6982 | CALL LYNAME(KF,CHAP) | |
6983 | CALL LYNAME(-KF,CHAN) | |
6984 | WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN | |
6985 | 180 CONTINUE | |
6986 | KF=10000*KFLR+110*KFLB+KFLS | |
6987 | CALL LYNAME(KF,CHAP) | |
6988 | WRITE(MSTU(11),6700) KF,CHAP | |
6989 | 190 CONTINUE | |
6990 | 200 CONTINUE | |
6991 | KF=30443 | |
6992 | CALL LYNAME(KF,CHAP) | |
6993 | WRITE(MSTU(11),6700) KF,CHAP | |
6994 | KF=30553 | |
6995 | CALL LYNAME(KF,CHAP) | |
6996 | WRITE(MSTU(11),6700) KF,CHAP | |
6997 | DO 240 KFLSP=1,3 | |
6998 | KFLS=2+2*(KFLSP/3) | |
6999 | DO 230 KFLA=1,8 | |
7000 | DO 220 KFLB=1,KFLA | |
7001 | DO 210 KFLC=1,KFLB | |
7002 | IF(KFLSP.EQ.1.AND.(KFLA.EQ.KFLB.OR.KFLB.EQ.KFLC)) GOTO 210 | |
7003 | IF(KFLSP.EQ.2.AND.KFLA.EQ.KFLC) GOTO 210 | |
7004 | IF(KFLSP.EQ.1) KF=1000*KFLA+100*KFLC+10*KFLB+KFLS | |
7005 | IF(KFLSP.GE.2) KF=1000*KFLA+100*KFLB+10*KFLC+KFLS | |
7006 | CALL LYNAME(KF,CHAP) | |
7007 | CALL LYNAME(-KF,CHAN) | |
7008 | WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN | |
7009 | 210 CONTINUE | |
7010 | 220 CONTINUE | |
7011 | 230 CONTINUE | |
7012 | 240 CONTINUE | |
7013 | ||
7014 | C...List parton/particle data table. Check whether to be listed. | |
7015 | ELSEIF(MLIST.EQ.12) THEN | |
7016 | WRITE(MSTU(11),6800) | |
7017 | MSTJ24=MSTJ(24) | |
7018 | MSTJ(24)=0 | |
7019 | KFMAX=30553 | |
7020 | IF(MSTU(2).NE.0) KFMAX=MSTU(2) | |
7021 | DO 270 KF=MAX(1,MSTU(1)),KFMAX | |
7022 | KC=LYCOMP(KF) | |
7023 | IF(KC.EQ.0) GOTO 270 | |
7024 | IF(MSTU(14).EQ.0.AND.KF.GT.100.AND.KC.LE.100) GOTO 270 | |
7025 | IF(MSTU(14).GT.0.AND.KF.GT.100.AND.MAX(MOD(KF/1000,10), | |
7026 | & MOD(KF/100,10)).GT.MSTU(14)) GOTO 270 | |
7027 | IF(MSTU(14).GT.0.AND.KF.GT.100.AND.KC.EQ.90) GOTO 270 | |
7028 | ||
7029 | C...Find particle name and mass. Print information. | |
7030 | CALL LYNAME(KF,CHAP) | |
7031 | IF(KF.LE.100.AND.CHAP.EQ.' '.AND.MDCY(KC,2).EQ.0) GOTO 270 | |
7032 | CALL LYNAME(-KF,CHAN) | |
7033 | PM=UYMASS(KF) | |
7034 | WRITE(MSTU(11),6900) KF,KC,CHAP,CHAN,KCHG(KC,1),KCHG(KC,2), | |
7035 | & KCHG(KC,3),PM,PMAS(KC,2),PMAS(KC,3),PMAS(KC,4),MDCY(KC,1) | |
7036 | ||
7037 | C...Particle decay: channel number, branching ration, matrix element, | |
7038 | C...decay products. | |
7039 | IF(KF.GT.100.AND.KC.LE.100) GOTO 270 | |
7040 | DO 260 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1 | |
7041 | DO 250 J=1,5 | |
7042 | CALL LYNAME(KFDP(IDC,J),CHAD(J)) | |
7043 | 250 CONTINUE | |
7044 | WRITE(MSTU(11),7000) IDC,MDME(IDC,1),MDME(IDC,2),BRAT(IDC), | |
7045 | & (CHAD(J),J=1,5) | |
7046 | 260 CONTINUE | |
7047 | 270 CONTINUE | |
7048 | MSTJ(24)=MSTJ24 | |
7049 | ||
7050 | C...List parameter value table. | |
7051 | ELSEIF(MLIST.EQ.13) THEN | |
7052 | WRITE(MSTU(11),7100) | |
7053 | DO 280 I=1,200 | |
7054 | WRITE(MSTU(11),7200) I,MSTU(I),PARU(I),MSTJ(I),PARJ(I),PARF(I) | |
7055 | 280 CONTINUE | |
7056 | ENDIF | |
7057 | ||
7058 | C...Format statements for output on unit MSTU(11) (by default 6). | |
7059 | 5100 FORMAT(///28X,'Event listing (summary)'//4X,'I particle/jet KS', | |
7060 | &5X,'KF orig p_x p_y p_z E m'/) | |
7061 | 5200 FORMAT(///28X,'Event listing (standard)'//4X,'I particle/jet', | |
7062 | &' K(I,1) K(I,2) K(I,3) K(I,4) K(I,5) P(I,1)', | |
7063 | &' P(I,2) P(I,3) P(I,4) P(I,5)'/) | |
7064 | 5300 FORMAT(///28X,'Event listing (with vertices)'//4X,'I particle/j', | |
7065 | &'et K(I,1) K(I,2) K(I,3) K(I,4) K(I,5) P(I,1)', | |
7066 | &' P(I,2) P(I,3) P(I,4) P(I,5)'/73X, | |
7067 | &'V(I,1) V(I,2) V(I,3) V(I,4) V(I,5)'/) | |
7068 | 5400 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.3) | |
7069 | 5500 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.2) | |
7070 | 5600 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.1) | |
7071 | 5700 FORMAT(1X,I4,2X,A16,1X,I3,1X,I8,2X,I4,2(3X,I1,2I4),5F13.5) | |
7072 | 5800 FORMAT(1X,I4,2X,A16,1X,I3,1X,I8,2X,I4,2(3X,I9),5F13.5) | |
7073 | 5900 FORMAT(66X,5(1X,F12.3)) | |
7074 | 6000 FORMAT(1X,78('=')) | |
7075 | 6100 FORMAT(1X,130('=')) | |
7076 | 6200 FORMAT(19X,'sum:',F6.2,5X,5F9.3) | |
7077 | 6300 FORMAT(19X,'sum:',F6.2,5X,5F9.2) | |
7078 | 6400 FORMAT(19X,'sum:',F6.2,5X,5F9.1) | |
7079 | 6500 FORMAT(19X,'sum charge:',F6.2,3X,'sum momentum and inv. mass:', | |
7080 | &5F13.5) | |
7081 | 6600 FORMAT(///20X,'List of KF codes in program'/) | |
7082 | 6700 FORMAT(4X,I6,4X,A16,6X,I6,4X,A16) | |
7083 | 6800 FORMAT(///30X,'Particle/parton data table'//5X,'KF',5X,'KC',4X, | |
7084 | &'particle',8X,'antiparticle',6X,'chg col anti',8X,'mass',7X, | |
7085 | &'width',7X,'w-cut',5X,'lifetime',1X,'decay'/11X,'IDC',1X,'on/off', | |
7086 | &1X,'ME',3X,'Br.rat.',4X,'decay products') | |
7087 | 6900 FORMAT(/1X,I6,3X,I4,4X,A16,A16,3I5,1X,F12.5,2(1X,F11.5), | |
7088 | &2X,F12.5,3X,I2) | |
7089 | 7000 FORMAT(10X,I4,2X,I3,2X,I3,2X,F8.5,4X,5A16) | |
7090 | 7100 FORMAT(///20X,'Parameter value table'//4X,'I',3X,'MSTU(I)', | |
7091 | &8X,'PARU(I)',3X,'MSTJ(I)',8X,'PARJ(I)',8X,'PARF(I)') | |
7092 | 7200 FORMAT(1X,I4,1X,I9,1X,F14.5,1X,I9,1X,F14.5,1X,F14.5) | |
7093 | ||
7094 | RETURN | |
7095 | END | |
7096 | ||
7097 | C********************************************************************* | |
7098 | ||
7099 | SUBROUTINE LYLOGO | |
7100 | ||
7101 | C...Purpose: to write logo for JETSET and PYTHIA programs. | |
7102 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
7103 | c DOUBLE PRECISION PARP,PARI | |
7104 | c COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
7105 | SAVE /LYDAT1/ | |
7106 | c SAVE /PYPARS/ | |
7107 | CHARACTER MONTH(12)*3, LOGO(48)*32, REFER(22)*36, LINE*79, | |
7108 | &VERS*1, SUBV*3, DATE*2, YEAR*4 | |
7109 | ||
7110 | C...Data on months, logo, titles, and references. | |
7111 | DATA MONTH/'Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep', | |
7112 | &'Oct','Nov','Dec'/ | |
7113 | DATA (LOGO(J),J=1,10)/ | |
7114 | &'PPP Y Y TTTTT H H III A ', | |
7115 | &'P P Y Y T H H I A A ', | |
7116 | &'PPP Y T HHHHH I AAAAA', | |
7117 | &'P Y T H H I A A', | |
7118 | &'P Y T H H III A A', | |
7119 | &'JJJJ EEEE TTTTT SSS EEEE TTTTT', | |
7120 | &' J E T S E T ', | |
7121 | &' J EEE T SSS EEE T ', | |
7122 | &'J J E T S E T ', | |
7123 | &' JJ EEEE T SSS EEEE T '/ | |
7124 | DATA (LOGO(J),J=11,29)/ | |
7125 | &' *......* ', | |
7126 | &' *:::!!:::::::::::* ', | |
7127 | &' *::::::!!::::::::::::::* ', | |
7128 | &' *::::::::!!::::::::::::::::* ', | |
7129 | &' *:::::::::!!:::::::::::::::::* ', | |
7130 | &' *:::::::::!!:::::::::::::::::* ', | |
7131 | &' *::::::::!!::::::::::::::::*! ', | |
7132 | &' *::::::!!::::::::::::::* !! ', | |
7133 | &' !! *:::!!:::::::::::* !! ', | |
7134 | &' !! !* -><- * !! ', | |
7135 | &' !! !! !! ', | |
7136 | &' !! !! !! ', | |
7137 | &' !! !! ', | |
7138 | &' !! ep !! ', | |
7139 | &' !! !! ', | |
7140 | &' !! pp !! ', | |
7141 | &' !! e+e- !! ', | |
7142 | &' !! !! ', | |
7143 | &' !! '/ | |
7144 | DATA (LOGO(J),J=30,48)/ | |
7145 | &'Welcome to the Lund Monte Carlo!', | |
7146 | &' ', | |
7147 | &' This jetset version x.xxx ', | |
7148 | &'can coexist with xx xxx 199x', | |
7149 | &' PYTHIA !!! ', | |
7150 | &' it was altered by fkw x.xxx ', | |
7151 | &' on 3.29.00 xx xxx 199x', | |
7152 | &' to this effect !!! ', | |
7153 | &' Main author: ', | |
7154 | &' Torbjorn Sjostrand ', | |
7155 | &' Dept. of theoretical physics 2 ', | |
7156 | &' University of Lund ', | |
7157 | &' Solvegatan 14A ', | |
7158 | &' S-223 62 Lund, Sweden ', | |
7159 | &' phone: +46 - 46 - 222 48 16 ', | |
7160 | &' E-mail: torbjorn@thep.lu.se ', | |
7161 | &' ', | |
7162 | &' Copyright Torbjorn Sjostrand ', | |
7163 | &' and CERN, Geneva 1993 '/ | |
7164 | DATA (REFER(J),J=1,6)/ | |
7165 | &'The latest program versions and docu', | |
7166 | &'mentation is found on WWW address ', | |
7167 | &'http://thep.lu.se/tf2/staff/torbjorn', | |
7168 | &'/Welcome.html ', | |
7169 | &' ', | |
7170 | &' This is fkw version !!! '/ | |
7171 | DATA (REFER(J),J=7,22)/ | |
7172 | &'When you cite these programs, priori', | |
7173 | &'ty should always be given to the ', | |
7174 | &'latest published description. Curren', | |
7175 | &'tly this is ', | |
7176 | &'T. Sjostrand, Computer Physics Commu', | |
7177 | &'n. 82 (1994) 74. ', | |
7178 | &'The most recent long description (un', | |
7179 | &'published) is ', | |
7180 | &'T. Sjostrand, LU TP 95-20 and CERN-T', | |
7181 | &'H.7112/93 (revised August 1995). ', | |
7182 | &'Also remember that the programs, to ', | |
7183 | &'a large extent, represent original ', | |
7184 | &'physics research. Other publications', | |
7185 | &' of special relevance to your ', | |
7186 | &'studies may therefore deserve separa', | |
7187 | &'te mention. '/ | |
7188 | ||
7189 | C...Check if PYTHIA linked. | |
7190 | c IF(MSTP(183)/10.NE.199) THEN | |
7191 | LOGO(32)=' Warning: this is jetset7.4_fkw ' | |
7192 | LOGO(33)='All refs to pythia were excised!' | |
7193 | c ELSE | |
7194 | c WRITE(VERS,'(I1)') MSTP(181) | |
7195 | c LOGO(32)(26:26)=VERS | |
7196 | c WRITE(SUBV,'(I3)') MSTP(182) | |
7197 | c LOGO(32)(28:30)=SUBV | |
7198 | c WRITE(DATE,'(I2)') MSTP(185) | |
7199 | c LOGO(33)(22:23)=DATE | |
7200 | c LOGO(33)(25:27)=MONTH(MSTP(184)) | |
7201 | c WRITE(YEAR,'(I4)') MSTP(183) | |
7202 | c LOGO(33)(29:32)=YEAR | |
7203 | c ENDIF | |
7204 | ||
7205 | C...Check if JETSET linked. | |
7206 | IF(MSTU(183)/10.NE.199) THEN | |
7207 | LOGO(35)=' Error: JETSET is not loaded! ' | |
7208 | LOGO(36)='Did you remember to link LYDATA?' | |
7209 | ELSE | |
7210 | WRITE(VERS,'(I1)') MSTU(181) | |
7211 | LOGO(35)(26:26)=VERS | |
7212 | WRITE(SUBV,'(I3)') MSTU(182) | |
7213 | LOGO(35)(28:30)=SUBV | |
7214 | WRITE(DATE,'(I2)') MSTU(185) | |
7215 | LOGO(36)(22:23)=DATE | |
7216 | LOGO(36)(25:27)=MONTH(MSTU(184)) | |
7217 | WRITE(YEAR,'(I4)') MSTU(183) | |
7218 | LOGO(36)(29:32)=YEAR | |
7219 | ENDIF | |
7220 | ||
7221 | C...Loop over lines in header. Define page feed and side borders. | |
7222 | DO 100 ILIN=1,48 | |
7223 | LINE=' ' | |
7224 | IF(ILIN.EQ.1) THEN | |
7225 | LINE(1:1)='1' | |
7226 | ELSE | |
7227 | LINE(2:3)='**' | |
7228 | LINE(78:79)='**' | |
7229 | ENDIF | |
7230 | ||
7231 | C...Separator lines and logos. | |
7232 | IF(ILIN.EQ.2.OR.ILIN.EQ.3.OR.ILIN.EQ.47.OR.ILIN.EQ.48) THEN | |
7233 | LINE(4:77)='***********************************************'// | |
7234 | & '***************************' | |
7235 | ELSEIF(ILIN.GE.6.AND.ILIN.LE.10) THEN | |
7236 | LINE(6:37)=LOGO(ILIN-5) | |
7237 | LINE(44:75)=LOGO(ILIN) | |
7238 | ELSEIF(ILIN.GE.13.AND.ILIN.LE.31) THEN | |
7239 | LINE(6:37)=LOGO(ILIN-2) | |
7240 | LINE(44:75)=LOGO(ILIN+17) | |
7241 | ELSEIF(ILIN.GE.34.AND.ILIN.LE.44) THEN | |
7242 | LINE(5:40)=REFER(2*ILIN-67) | |
7243 | LINE(41:76)=REFER(2*ILIN-66) | |
7244 | ENDIF | |
7245 | ||
7246 | C...Write lines to appropriate unit. | |
7247 | IF(MSTU(183)/10.EQ.199) THEN | |
7248 | WRITE(MSTU(11),'(A79)') LINE | |
7249 | ELSE | |
7250 | WRITE(*,'(A79)') LINE | |
7251 | ENDIF | |
7252 | 100 CONTINUE | |
7253 | ||
7254 | C...Check that matching subversions are linked. | |
7255 | c IF(MSTU(183)/10.EQ.199.AND.MSTP(183)/10.EQ.199) THEN | |
7256 | c IF(MSTU(182).LT.MSTP(186)) WRITE(MSTU(11), | |
7257 | WRITE(MSTU(11), | |
7258 | & '(/'' Warning: Jetset7.4_fkw independent of PYTHIA!''/)') | |
7259 | c IF(MSTP(182).LT.MSTU(186)) WRITE(MSTU(11), | |
7260 | c & '(/'' Warning: PYTHIA subversion too old for JETSET''/)') | |
7261 | c ENDIF | |
7262 | ||
7263 | RETURN | |
7264 | END | |
7265 | ||
7266 | C********************************************************************* | |
7267 | ||
7268 | SUBROUTINE LYUPDA(MUPDA,LFN) | |
7269 | ||
7270 | C...Purpose: to facilitate the updating of particle and decay data. | |
7271 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
7272 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
7273 | COMMON/LYDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) | |
7274 | COMMON/LYDAT4/CHAF(500) | |
7275 | CHARACTER CHAF*8 | |
7276 | SAVE /LYDAT1/,/LYDAT2/,/LYDAT3/,/LYDAT4/ | |
7277 | CHARACTER CHINL*80,CHKC*4,CHVAR(19)*9,CHLIN*72, | |
7278 | &CHBLK(20)*72,CHOLD*12,CHTMP*12,CHNEW*12,CHCOM*12 | |
7279 | DATA CHVAR/ 'KCHG(I,1)','KCHG(I,2)','KCHG(I,3)','PMAS(I,1)', | |
7280 | &'PMAS(I,2)','PMAS(I,3)','PMAS(I,4)','MDCY(I,1)','MDCY(I,2)', | |
7281 | &'MDCY(I,3)','MDME(I,1)','MDME(I,2)','BRAT(I) ','KFDP(I,1)', | |
7282 | &'KFDP(I,2)','KFDP(I,3)','KFDP(I,4)','KFDP(I,5)','CHAF(I) '/ | |
7283 | ||
7284 | C...Write information on file for editing. | |
7285 | IF(MSTU(12).GE.1) CALL LYLIST(0) | |
7286 | IF(MUPDA.EQ.1) THEN | |
7287 | DO 110 KC=1,MSTU(6) | |
7288 | WRITE(LFN,5000) KC,CHAF(KC),(KCHG(KC,J1),J1=1,3), | |
7289 | & (PMAS(KC,J2),J2=1,4),MDCY(KC,1) | |
7290 | DO 100 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1 | |
7291 | WRITE(LFN,5100) MDME(IDC,1),MDME(IDC,2),BRAT(IDC), | |
7292 | & (KFDP(IDC,J),J=1,5) | |
7293 | 100 CONTINUE | |
7294 | 110 CONTINUE | |
7295 | ||
7296 | C...Reset variables and read information from edited file. | |
7297 | ELSEIF(MUPDA.EQ.2) THEN | |
7298 | DO 130 I=1,MSTU(7) | |
7299 | MDME(I,1)=1 | |
7300 | MDME(I,2)=0 | |
7301 | BRAT(I)=0. | |
7302 | DO 120 J=1,5 | |
7303 | KFDP(I,J)=0 | |
7304 | 120 CONTINUE | |
7305 | 130 CONTINUE | |
7306 | KC=0 | |
7307 | IDC=0 | |
7308 | NDC=0 | |
7309 | 140 READ(LFN,5200,END=150) CHINL | |
7310 | IF(CHINL(2:5).NE.' ') THEN | |
7311 | CHKC=CHINL(2:5) | |
7312 | IF(KC.NE.0) THEN | |
7313 | MDCY(KC,2)=0 | |
7314 | IF(NDC.NE.0) MDCY(KC,2)=IDC+1-NDC | |
7315 | MDCY(KC,3)=NDC | |
7316 | ENDIF | |
7317 | READ(CHKC,5300) KC | |
7318 | IF(KC.LE.0.OR.KC.GT.MSTU(6)) CALL LYERRM(27, | |
7319 | & '(LYUPDA:) Read KC code illegal, KC ='//CHKC) | |
7320 | READ(CHINL,5000) KCR,CHAF(KC),(KCHG(KC,J1),J1=1,3), | |
7321 | & (PMAS(KC,J2),J2=1,4),MDCY(KC,1) | |
7322 | NDC=0 | |
7323 | ELSE | |
7324 | IDC=IDC+1 | |
7325 | NDC=NDC+1 | |
7326 | IF(IDC.GE.MSTU(7)) CALL LYERRM(27, | |
7327 | & '(LYUPDA:) Decay data arrays full by KC ='//CHKC) | |
7328 | READ(CHINL,5100) MDME(IDC,1),MDME(IDC,2),BRAT(IDC), | |
7329 | & (KFDP(IDC,J),J=1,5) | |
7330 | ENDIF | |
7331 | GOTO 140 | |
7332 | 150 MDCY(KC,2)=0 | |
7333 | IF(NDC.NE.0) MDCY(KC,2)=IDC+1-NDC | |
7334 | MDCY(KC,3)=NDC | |
7335 | ||
7336 | C...Perform possible tests that new information is consistent. | |
7337 | MSTJ24=MSTJ(24) | |
7338 | MSTJ(24)=0 | |
7339 | DO 180 KC=1,MSTU(6) | |
7340 | WRITE(CHKC,5300) KC | |
7341 | IF(MIN(PMAS(KC,1),PMAS(KC,2),PMAS(KC,3),PMAS(KC,1)-PMAS(KC,3), | |
7342 | & PMAS(KC,4)).LT.0..OR.MDCY(KC,3).LT.0) CALL LYERRM(17, | |
7343 | & '(LYUPDA:) Mass/width/life/(# channels) wrong for KC ='//CHKC) | |
7344 | BRSUM=0. | |
7345 | DO 170 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1 | |
7346 | IF(MDME(IDC,2).GT.80) GOTO 170 | |
7347 | KQ=KCHG(KC,1) | |
7348 | PMS=PMAS(KC,1)-PMAS(KC,3)-PARJ(64) | |
7349 | MERR=0 | |
7350 | DO 160 J=1,5 | |
7351 | KP=KFDP(IDC,J) | |
7352 | IF(KP.EQ.0.OR.KP.EQ.81.OR.IABS(KP).EQ.82) THEN | |
7353 | ELSEIF(LYCOMP(KP).EQ.0) THEN | |
7354 | MERR=3 | |
7355 | ELSE | |
7356 | KQ=KQ-LYCHGE(KP) | |
7357 | PMS=PMS-UYMASS(KP) | |
7358 | ENDIF | |
7359 | 160 CONTINUE | |
7360 | IF(KQ.NE.0) MERR=MAX(2,MERR) | |
7361 | IF(KFDP(IDC,2).NE.0.AND.(KC.LE.20.OR.KC.GT.40).AND. | |
7362 | & (KC.LE.80.OR.KC.GT.100).AND.MDME(IDC,2).NE.34.AND. | |
7363 | & MDME(IDC,2).NE.61.AND.PMS.LT.0.) MERR=MAX(1,MERR) | |
7364 | IF(MERR.EQ.3) CALL LYERRM(17, | |
7365 | & '(LYUPDA:) Unknown particle code in decay of KC ='//CHKC) | |
7366 | IF(MERR.EQ.2) CALL LYERRM(17, | |
7367 | & '(LYUPDA:) Charge not conserved in decay of KC ='//CHKC) | |
7368 | IF(MERR.EQ.1) CALL LYERRM(7, | |
7369 | & '(LYUPDA:) Kinematically unallowed decay of KC ='//CHKC) | |
7370 | BRSUM=BRSUM+BRAT(IDC) | |
7371 | 170 CONTINUE | |
7372 | WRITE(CHTMP,5500) BRSUM | |
7373 | IF(ABS(BRSUM).GT.0.0005.AND.ABS(BRSUM-1.).GT.0.0005) CALL | |
7374 | & LYERRM(7,'(LYUPDA:) Sum of branching ratios is '//CHTMP(5:12)// | |
7375 | & ' for KC ='//CHKC) | |
7376 | 180 CONTINUE | |
7377 | MSTJ(24)=MSTJ24 | |
7378 | ||
7379 | C...Initialize writing of DATA statements for inclusion in program. | |
7380 | ELSEIF(MUPDA.EQ.3) THEN | |
7381 | DO 250 IVAR=1,19 | |
7382 | NDIM=MSTU(6) | |
7383 | IF(IVAR.GE.11.AND.IVAR.LE.18) NDIM=MSTU(7) | |
7384 | NLIN=1 | |
7385 | CHLIN=' ' | |
7386 | CHLIN(7:35)='DATA ('//CHVAR(IVAR)//',I= 1, )/' | |
7387 | LLIN=35 | |
7388 | CHOLD='START' | |
7389 | ||
7390 | C...Loop through variables for conversion to characters. | |
7391 | DO 230 IDIM=1,NDIM | |
7392 | IF(IVAR.EQ.1) WRITE(CHTMP,5400) KCHG(IDIM,1) | |
7393 | IF(IVAR.EQ.2) WRITE(CHTMP,5400) KCHG(IDIM,2) | |
7394 | IF(IVAR.EQ.3) WRITE(CHTMP,5400) KCHG(IDIM,3) | |
7395 | IF(IVAR.EQ.4) WRITE(CHTMP,5500) PMAS(IDIM,1) | |
7396 | IF(IVAR.EQ.5) WRITE(CHTMP,5500) PMAS(IDIM,2) | |
7397 | IF(IVAR.EQ.6) WRITE(CHTMP,5500) PMAS(IDIM,3) | |
7398 | IF(IVAR.EQ.7) WRITE(CHTMP,5500) PMAS(IDIM,4) | |
7399 | IF(IVAR.EQ.8) WRITE(CHTMP,5400) MDCY(IDIM,1) | |
7400 | IF(IVAR.EQ.9) WRITE(CHTMP,5400) MDCY(IDIM,2) | |
7401 | IF(IVAR.EQ.10) WRITE(CHTMP,5400) MDCY(IDIM,3) | |
7402 | IF(IVAR.EQ.11) WRITE(CHTMP,5400) MDME(IDIM,1) | |
7403 | IF(IVAR.EQ.12) WRITE(CHTMP,5400) MDME(IDIM,2) | |
7404 | IF(IVAR.EQ.13) WRITE(CHTMP,5500) BRAT(IDIM) | |
7405 | IF(IVAR.EQ.14) WRITE(CHTMP,5400) KFDP(IDIM,1) | |
7406 | IF(IVAR.EQ.15) WRITE(CHTMP,5400) KFDP(IDIM,2) | |
7407 | IF(IVAR.EQ.16) WRITE(CHTMP,5400) KFDP(IDIM,3) | |
7408 | IF(IVAR.EQ.17) WRITE(CHTMP,5400) KFDP(IDIM,4) | |
7409 | IF(IVAR.EQ.18) WRITE(CHTMP,5400) KFDP(IDIM,5) | |
7410 | IF(IVAR.EQ.19) CHTMP=CHAF(IDIM) | |
7411 | ||
7412 | C...Length of variable, trailing decimal zeros, quotation marks. | |
7413 | LLOW=1 | |
7414 | LHIG=1 | |
7415 | DO 190 LL=1,12 | |
7416 | IF(CHTMP(13-LL:13-LL).NE.' ') LLOW=13-LL | |
7417 | IF(CHTMP(LL:LL).NE.' ') LHIG=LL | |
7418 | 190 CONTINUE | |
7419 | CHNEW=CHTMP(LLOW:LHIG)//' ' | |
7420 | LNEW=1+LHIG-LLOW | |
7421 | IF((IVAR.GE.4.AND.IVAR.LE.7).OR.IVAR.EQ.13) THEN | |
7422 | LNEW=LNEW+1 | |
7423 | 200 LNEW=LNEW-1 | |
7424 | IF(CHNEW(LNEW:LNEW).EQ.'0') GOTO 200 | |
7425 | IF(LNEW.EQ.1) CHNEW(1:2)='0.' | |
7426 | IF(LNEW.EQ.1) LNEW=2 | |
7427 | ELSEIF(IVAR.EQ.19) THEN | |
7428 | DO 210 LL=LNEW,1,-1 | |
7429 | IF(CHNEW(LL:LL).EQ.'''') THEN | |
7430 | CHTMP=CHNEW | |
7431 | CHNEW=CHTMP(1:LL)//''''//CHTMP(LL+1:11) | |
7432 | LNEW=LNEW+1 | |
7433 | ENDIF | |
7434 | 210 CONTINUE | |
7435 | CHTMP=CHNEW | |
7436 | CHNEW(1:LNEW+2)=''''//CHTMP(1:LNEW)//'''' | |
7437 | LNEW=LNEW+2 | |
7438 | ENDIF | |
7439 | ||
7440 | C...Form composite character string, often including repetition counter. | |
7441 | IF(CHNEW.NE.CHOLD) THEN | |
7442 | NRPT=1 | |
7443 | CHOLD=CHNEW | |
7444 | CHCOM=CHNEW | |
7445 | LCOM=LNEW | |
7446 | ELSE | |
7447 | LRPT=LNEW+1 | |
7448 | IF(NRPT.GE.2) LRPT=LNEW+3 | |
7449 | IF(NRPT.GE.10) LRPT=LNEW+4 | |
7450 | IF(NRPT.GE.100) LRPT=LNEW+5 | |
7451 | IF(NRPT.GE.1000) LRPT=LNEW+6 | |
7452 | LLIN=LLIN-LRPT | |
7453 | NRPT=NRPT+1 | |
7454 | WRITE(CHTMP,5400) NRPT | |
7455 | LRPT=1 | |
7456 | IF(NRPT.GE.10) LRPT=2 | |
7457 | IF(NRPT.GE.100) LRPT=3 | |
7458 | IF(NRPT.GE.1000) LRPT=4 | |
7459 | CHCOM(1:LRPT+1+LNEW)=CHTMP(13-LRPT:12)//'*'//CHNEW(1:LNEW) | |
7460 | LCOM=LRPT+1+LNEW | |
7461 | ENDIF | |
7462 | ||
7463 | C...Add characters to end of line, to new line (after storing old line), | |
7464 | C...or to new block of lines (after writing old block). | |
7465 | IF(LLIN+LCOM.LE.70) THEN | |
7466 | CHLIN(LLIN+1:LLIN+LCOM+1)=CHCOM(1:LCOM)//',' | |
7467 | LLIN=LLIN+LCOM+1 | |
7468 | ELSEIF(NLIN.LE.19) THEN | |
7469 | CHLIN(LLIN+1:72)=' ' | |
7470 | CHBLK(NLIN)=CHLIN | |
7471 | NLIN=NLIN+1 | |
7472 | CHLIN(6:6+LCOM+1)='&'//CHCOM(1:LCOM)//',' | |
7473 | LLIN=6+LCOM+1 | |
7474 | ELSE | |
7475 | CHLIN(LLIN:72)='/'//' ' | |
7476 | CHBLK(NLIN)=CHLIN | |
7477 | WRITE(CHTMP,5400) IDIM-NRPT | |
7478 | CHBLK(1)(30:33)=CHTMP(9:12) | |
7479 | DO 220 ILIN=1,NLIN | |
7480 | WRITE(LFN,5600) CHBLK(ILIN) | |
7481 | 220 CONTINUE | |
7482 | NLIN=1 | |
7483 | CHLIN=' ' | |
7484 | CHLIN(7:35+LCOM+1)='DATA ('//CHVAR(IVAR)//',I= , )/'// | |
7485 | & CHCOM(1:LCOM)//',' | |
7486 | WRITE(CHTMP,5400) IDIM-NRPT+1 | |
7487 | CHLIN(25:28)=CHTMP(9:12) | |
7488 | LLIN=35+LCOM+1 | |
7489 | ENDIF | |
7490 | 230 CONTINUE | |
7491 | ||
7492 | C...Write final block of lines. | |
7493 | CHLIN(LLIN:72)='/'//' ' | |
7494 | CHBLK(NLIN)=CHLIN | |
7495 | WRITE(CHTMP,5400) NDIM | |
7496 | CHBLK(1)(30:33)=CHTMP(9:12) | |
7497 | DO 240 ILIN=1,NLIN | |
7498 | WRITE(LFN,5600) CHBLK(ILIN) | |
7499 | 240 CONTINUE | |
7500 | 250 CONTINUE | |
7501 | ENDIF | |
7502 | ||
7503 | C...Formats for reading and writing particle data. | |
7504 | 5000 FORMAT(1X,I4,2X,A8,3I3,3F12.5,2X,F12.5,I3) | |
7505 | 5100 FORMAT(5X,2I5,F12.5,5I8) | |
7506 | 5200 FORMAT(A80) | |
7507 | 5300 FORMAT(I4) | |
7508 | 5400 FORMAT(I12) | |
7509 | 5500 FORMAT(F12.5) | |
7510 | 5600 FORMAT(A72) | |
7511 | ||
7512 | RETURN | |
7513 | END | |
7514 | ||
7515 | C********************************************************************* | |
7516 | ||
7517 | FUNCTION KLY(I,J) | |
7518 | ||
7519 | C...Purpose: to provide various integer-valued event related data. | |
7520 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
7521 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
7522 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
7523 | SAVE /LYJETS/,/LYDAT1/,/LYDAT2/ | |
7524 | ||
7525 | C...Default value. For I=0 number of entries, number of stable entries | |
7526 | C...or 3 times total charge. | |
7527 | KLY=0 | |
7528 | IF(I.LT.0.OR.I.GT.MSTU(4).OR.J.LE.0) THEN | |
7529 | ELSEIF(I.EQ.0.AND.J.EQ.1) THEN | |
7530 | KLY=N | |
7531 | ELSEIF(I.EQ.0.AND.(J.EQ.2.OR.J.EQ.6)) THEN | |
7532 | DO 100 I1=1,N | |
7533 | IF(J.EQ.2.AND.K(I1,1).GE.1.AND.K(I1,1).LE.10) KLY=KLY+1 | |
7534 | IF(J.EQ.6.AND.K(I1,1).GE.1.AND.K(I1,1).LE.10) KLY=KLY+ | |
7535 | & LYCHGE(K(I1,2)) | |
7536 | 100 CONTINUE | |
7537 | ELSEIF(I.EQ.0) THEN | |
7538 | ||
7539 | C...For I > 0 direct readout of K matrix or charge. | |
7540 | ELSEIF(J.LE.5) THEN | |
7541 | KLY=K(I,J) | |
7542 | ELSEIF(J.EQ.6) THEN | |
7543 | KLY=LYCHGE(K(I,2)) | |
7544 | ||
7545 | C...Status (existing/fragmented/decayed), parton/hadron separation. | |
7546 | ELSEIF(J.LE.8) THEN | |
7547 | IF(K(I,1).GE.1.AND.K(I,1).LE.10) KLY=1 | |
7548 | IF(J.EQ.8) KLY=KLY*K(I,2) | |
7549 | ELSEIF(J.LE.12) THEN | |
7550 | KFA=IABS(K(I,2)) | |
7551 | KC=LYCOMP(KFA) | |
7552 | KQ=0 | |
7553 | IF(KC.NE.0) KQ=KCHG(KC,2) | |
7554 | IF(J.EQ.9.AND.KC.NE.0.AND.KQ.NE.0) KLY=K(I,2) | |
7555 | IF(J.EQ.10.AND.KC.NE.0.AND.KQ.EQ.0) KLY=K(I,2) | |
7556 | IF(J.EQ.11) KLY=KC | |
7557 | IF(J.EQ.12) KLY=KQ*ISIGN(1,K(I,2)) | |
7558 | ||
7559 | C...Heaviest flavour in hadron/diquark. | |
7560 | ELSEIF(J.EQ.13) THEN | |
7561 | KFA=IABS(K(I,2)) | |
7562 | KLY=MOD(KFA/100,10)*(-1)**MOD(KFA/100,10) | |
7563 | IF(KFA.LT.10) KLY=KFA | |
7564 | IF(MOD(KFA/1000,10).NE.0) KLY=MOD(KFA/1000,10) | |
7565 | KLY=KLY*ISIGN(1,K(I,2)) | |
7566 | ||
7567 | C...Particle history: generation, ancestor, rank. | |
7568 | ELSEIF(J.LE.15) THEN | |
7569 | I2=I | |
7570 | I1=I | |
7571 | 110 KLY=KLY+1 | |
7572 | I2=I1 | |
7573 | I1=K(I1,3) | |
7574 | IF(I1.GT.0.AND.K(I1,1).GT.0.AND.K(I1,1).LE.20) GOTO 110 | |
7575 | IF(J.EQ.15) KLY=I2 | |
7576 | ELSEIF(J.EQ.16) THEN | |
7577 | KFA=IABS(K(I,2)) | |
7578 | IF(K(I,1).LE.20.AND.((KFA.GE.11.AND.KFA.LE.20).OR.KFA.EQ.22.OR. | |
7579 | & (KFA.GT.100.AND.MOD(KFA/10,10).NE.0))) THEN | |
7580 | I1=I | |
7581 | 120 I2=I1 | |
7582 | I1=K(I1,3) | |
7583 | IF(I1.GT.0) THEN | |
7584 | KFAM=IABS(K(I1,2)) | |
7585 | ILP=1 | |
7586 | IF(KFAM.NE.0.AND.KFAM.LE.10) ILP=0 | |
7587 | IF(KFAM.EQ.21.OR.KFAM.EQ.91.OR.KFAM.EQ.92.OR.KFAM.EQ.93) | |
7588 | & ILP=0 | |
7589 | IF(KFAM.GT.100.AND.MOD(KFAM/10,10).EQ.0) ILP=0 | |
7590 | IF(ILP.EQ.1) GOTO 120 | |
7591 | ENDIF | |
7592 | IF(K(I1,1).EQ.12) THEN | |
7593 | DO 130 I3=I1+1,I2 | |
7594 | IF(K(I3,3).EQ.K(I2,3).AND.K(I3,2).NE.91.AND.K(I3,2).NE.92 | |
7595 | & .AND.K(I3,2).NE.93) KLY=KLY+1 | |
7596 | 130 CONTINUE | |
7597 | ELSE | |
7598 | I3=I2 | |
7599 | 140 KLY=KLY+1 | |
7600 | I3=I3+1 | |
7601 | IF(I3.LT.N.AND.K(I3,3).EQ.K(I2,3)) GOTO 140 | |
7602 | ENDIF | |
7603 | ENDIF | |
7604 | ||
7605 | C...Particle coming from collapsing jet system or not. | |
7606 | ELSEIF(J.EQ.17) THEN | |
7607 | I1=I | |
7608 | 150 KLY=KLY+1 | |
7609 | I3=I1 | |
7610 | I1=K(I1,3) | |
7611 | I0=MAX(1,I1) | |
7612 | KC=LYCOMP(K(I0,2)) | |
7613 | IF(I1.EQ.0.OR.K(I0,1).LE.0.OR.K(I0,1).GT.20.OR.KC.EQ.0) THEN | |
7614 | IF(KLY.EQ.1) KLY=-1 | |
7615 | IF(KLY.GT.1) KLY=0 | |
7616 | RETURN | |
7617 | ENDIF | |
7618 | IF(KCHG(KC,2).EQ.0) GOTO 150 | |
7619 | IF(K(I1,1).NE.12) KLY=0 | |
7620 | IF(K(I1,1).NE.12) RETURN | |
7621 | I2=I1 | |
7622 | 160 I2=I2+1 | |
7623 | IF(I2.LT.N.AND.K(I2,1).NE.11) GOTO 160 | |
7624 | K3M=K(I3-1,3) | |
7625 | IF(K3M.GE.I1.AND.K3M.LE.I2) KLY=0 | |
7626 | K3P=K(I3+1,3) | |
7627 | IF(I3.LT.N.AND.K3P.GE.I1.AND.K3P.LE.I2) KLY=0 | |
7628 | ||
7629 | C...Number of decay products. Colour flow. | |
7630 | ELSEIF(J.EQ.18) THEN | |
7631 | IF(K(I,1).EQ.11.OR.K(I,1).EQ.12) KLY=MAX(0,K(I,5)-K(I,4)+1) | |
7632 | IF(K(I,4).EQ.0.OR.K(I,5).EQ.0) KLY=0 | |
7633 | ELSEIF(J.LE.22) THEN | |
7634 | IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) RETURN | |
7635 | IF(J.EQ.19) KLY=MOD(K(I,4)/MSTU(5),MSTU(5)) | |
7636 | IF(J.EQ.20) KLY=MOD(K(I,5)/MSTU(5),MSTU(5)) | |
7637 | IF(J.EQ.21) KLY=MOD(K(I,4),MSTU(5)) | |
7638 | IF(J.EQ.22) KLY=MOD(K(I,5),MSTU(5)) | |
7639 | ELSE | |
7640 | ENDIF | |
7641 | ||
7642 | RETURN | |
7643 | END | |
7644 | ||
7645 | C********************************************************************* | |
7646 | ||
7647 | FUNCTION PLY(I,J) | |
7648 | ||
7649 | C...Purpose: to provide various real-valued event related data. | |
7650 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
7651 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
7652 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
7653 | SAVE /LYJETS/,/LYDAT1/,/LYDAT2/ | |
7654 | DIMENSION PSUM(4) | |
7655 | ||
7656 | C...Set default value. For I = 0 sum of momenta or charges, | |
7657 | C...or invariant mass of system. | |
7658 | PLY=0. | |
7659 | IF(I.LT.0.OR.I.GT.MSTU(4).OR.J.LE.0) THEN | |
7660 | ELSEIF(I.EQ.0.AND.J.LE.4) THEN | |
7661 | DO 100 I1=1,N | |
7662 | IF(K(I1,1).GT.0.AND.K(I1,1).LE.10) PLY=PLY+P(I1,J) | |
7663 | 100 CONTINUE | |
7664 | ELSEIF(I.EQ.0.AND.J.EQ.5) THEN | |
7665 | DO 120 J1=1,4 | |
7666 | PSUM(J1)=0. | |
7667 | DO 110 I1=1,N | |
7668 | IF(K(I1,1).GT.0.AND.K(I1,1).LE.10) PSUM(J1)=PSUM(J1)+P(I1,J1) | |
7669 | 110 CONTINUE | |
7670 | 120 CONTINUE | |
7671 | PLY=SQRT(MAX(0.,PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-PSUM(3)**2)) | |
7672 | ELSEIF(I.EQ.0.AND.J.EQ.6) THEN | |
7673 | DO 130 I1=1,N | |
7674 | IF(K(I1,1).GT.0.AND.K(I1,1).LE.10) PLY=PLY+LYCHGE(K(I1,2))/3. | |
7675 | 130 CONTINUE | |
7676 | ELSEIF(I.EQ.0) THEN | |
7677 | ||
7678 | C...Direct readout of P matrix. | |
7679 | ELSEIF(J.LE.5) THEN | |
7680 | PLY=P(I,J) | |
7681 | ||
7682 | C...Charge, total momentum, transverse momentum, transverse mass. | |
7683 | ELSEIF(J.LE.12) THEN | |
7684 | IF(J.EQ.6) PLY=LYCHGE(K(I,2))/3. | |
7685 | IF(J.EQ.7.OR.J.EQ.8) PLY=P(I,1)**2+P(I,2)**2+P(I,3)**2 | |
7686 | IF(J.EQ.9.OR.J.EQ.10) PLY=P(I,1)**2+P(I,2)**2 | |
7687 | IF(J.EQ.11.OR.J.EQ.12) PLY=P(I,5)**2+P(I,1)**2+P(I,2)**2 | |
7688 | IF(J.EQ.8.OR.J.EQ.10.OR.J.EQ.12) PLY=SQRT(PLY) | |
7689 | ||
7690 | C...Theta and phi angle in radians or degrees. | |
7691 | ELSEIF(J.LE.16) THEN | |
7692 | IF(J.LE.14) PLY=UYANGL(P(I,3),SQRT(P(I,1)**2+P(I,2)**2)) | |
7693 | IF(J.GE.15) PLY=UYANGL(P(I,1),P(I,2)) | |
7694 | IF(J.EQ.14.OR.J.EQ.16) PLY=PLY*180./PARU(1) | |
7695 | ||
7696 | C...True rapidity, rapidity with pion mass, pseudorapidity. | |
7697 | ELSEIF(J.LE.19) THEN | |
7698 | PMR=0. | |
7699 | IF(J.EQ.17) PMR=P(I,5) | |
7700 | IF(J.EQ.18) PMR=UYMASS(211) | |
7701 | PR=MAX(1E-20,PMR**2+P(I,1)**2+P(I,2)**2) | |
7702 | PLY=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/SQRT(PR), | |
7703 | & 1E20)),P(I,3)) | |
7704 | ||
7705 | C...Energy and momentum fractions (only to be used in CM frame). | |
7706 | ELSEIF(J.LE.25) THEN | |
7707 | IF(J.EQ.20) PLY=2.*SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)/PARU(21) | |
7708 | IF(J.EQ.21) PLY=2.*P(I,3)/PARU(21) | |
7709 | IF(J.EQ.22) PLY=2.*SQRT(P(I,1)**2+P(I,2)**2)/PARU(21) | |
7710 | IF(J.EQ.23) PLY=2.*P(I,4)/PARU(21) | |
7711 | IF(J.EQ.24) PLY=(P(I,4)+P(I,3))/PARU(21) | |
7712 | IF(J.EQ.25) PLY=(P(I,4)-P(I,3))/PARU(21) | |
7713 | ENDIF | |
7714 | ||
7715 | RETURN | |
7716 | END | |
7717 | ||
7718 | C********************************************************************* | |
7719 | ||
7720 | SUBROUTINE LYSPHE(SPH,APL) | |
7721 | ||
7722 | C...Purpose: to perform sphericity tensor analysis to give sphericity, | |
7723 | C...aplanarity and the related event axes. | |
7724 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
7725 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
7726 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
7727 | SAVE /LYJETS/,/LYDAT1/,/LYDAT2/ | |
7728 | DIMENSION SM(3,3),SV(3,3) | |
7729 | ||
7730 | C...Calculate matrix to be diagonalized. | |
7731 | NP=0 | |
7732 | DO 110 J1=1,3 | |
7733 | DO 100 J2=J1,3 | |
7734 | SM(J1,J2)=0. | |
7735 | 100 CONTINUE | |
7736 | 110 CONTINUE | |
7737 | PS=0. | |
7738 | DO 140 I=1,N | |
7739 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 140 | |
7740 | IF(MSTU(41).GE.2) THEN | |
7741 | KC=LYCOMP(K(I,2)) | |
7742 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. | |
7743 | & KC.EQ.18) GOTO 140 | |
7744 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LYCHGE(K(I,2)).EQ.0) | |
7745 | & GOTO 140 | |
7746 | ENDIF | |
7747 | NP=NP+1 | |
7748 | PA=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
7749 | PWT=1. | |
7750 | IF(ABS(PARU(41)-2.).GT.0.001) PWT=MAX(1E-10,PA)**(PARU(41)-2.) | |
7751 | DO 130 J1=1,3 | |
7752 | DO 120 J2=J1,3 | |
7753 | SM(J1,J2)=SM(J1,J2)+PWT*P(I,J1)*P(I,J2) | |
7754 | 120 CONTINUE | |
7755 | 130 CONTINUE | |
7756 | PS=PS+PWT*PA**2 | |
7757 | 140 CONTINUE | |
7758 | ||
7759 | C...Very low multiplicities (0 or 1) not considered. | |
7760 | IF(NP.LE.1) THEN | |
7761 | CALL LYERRM(8,'(LYSPHE:) too few particles for analysis') | |
7762 | SPH=-1. | |
7763 | APL=-1. | |
7764 | RETURN | |
7765 | ENDIF | |
7766 | DO 160 J1=1,3 | |
7767 | DO 150 J2=J1,3 | |
7768 | SM(J1,J2)=SM(J1,J2)/PS | |
7769 | 150 CONTINUE | |
7770 | 160 CONTINUE | |
7771 | ||
7772 | C...Find eigenvalues to matrix (third degree equation). | |
7773 | SQ=(SM(1,1)*SM(2,2)+SM(1,1)*SM(3,3)+SM(2,2)*SM(3,3)-SM(1,2)**2- | |
7774 | &SM(1,3)**2-SM(2,3)**2)/3.-1./9. | |
7775 | SR=-0.5*(SQ+1./9.+SM(1,1)*SM(2,3)**2+SM(2,2)*SM(1,3)**2+SM(3,3)* | |
7776 | &SM(1,2)**2-SM(1,1)*SM(2,2)*SM(3,3))+SM(1,2)*SM(1,3)*SM(2,3)+1./27. | |
7777 | SP=COS(ACOS(MAX(MIN(SR/SQRT(-SQ**3),1.),-1.))/3.) | |
7778 | P(N+1,4)=1./3.+SQRT(-SQ)*MAX(2.*SP,SQRT(3.*(1.-SP**2))-SP) | |
7779 | P(N+3,4)=1./3.+SQRT(-SQ)*MIN(2.*SP,-SQRT(3.*(1.-SP**2))-SP) | |
7780 | P(N+2,4)=1.-P(N+1,4)-P(N+3,4) | |
7781 | IF(P(N+2,4).LT.1E-5) THEN | |
7782 | CALL LYERRM(8,'(LYSPHE:) all particles back-to-back') | |
7783 | SPH=-1. | |
7784 | APL=-1. | |
7785 | RETURN | |
7786 | ENDIF | |
7787 | ||
7788 | C...Find first and last eigenvector by solving equation system. | |
7789 | DO 240 I=1,3,2 | |
7790 | DO 180 J1=1,3 | |
7791 | SV(J1,J1)=SM(J1,J1)-P(N+I,4) | |
7792 | DO 170 J2=J1+1,3 | |
7793 | SV(J1,J2)=SM(J1,J2) | |
7794 | SV(J2,J1)=SM(J1,J2) | |
7795 | 170 CONTINUE | |
7796 | 180 CONTINUE | |
7797 | SMAX=0. | |
7798 | DO 200 J1=1,3 | |
7799 | DO 190 J2=1,3 | |
7800 | IF(ABS(SV(J1,J2)).LE.SMAX) GOTO 190 | |
7801 | JA=J1 | |
7802 | JB=J2 | |
7803 | SMAX=ABS(SV(J1,J2)) | |
7804 | 190 CONTINUE | |
7805 | 200 CONTINUE | |
7806 | SMAX=0. | |
7807 | DO 220 J3=JA+1,JA+2 | |
7808 | J1=J3-3*((J3-1)/3) | |
7809 | RL=SV(J1,JB)/SV(JA,JB) | |
7810 | DO 210 J2=1,3 | |
7811 | SV(J1,J2)=SV(J1,J2)-RL*SV(JA,J2) | |
7812 | IF(ABS(SV(J1,J2)).LE.SMAX) GOTO 210 | |
7813 | JC=J1 | |
7814 | SMAX=ABS(SV(J1,J2)) | |
7815 | 210 CONTINUE | |
7816 | 220 CONTINUE | |
7817 | JB1=JB+1-3*(JB/3) | |
7818 | JB2=JB+2-3*((JB+1)/3) | |
7819 | P(N+I,JB1)=-SV(JC,JB2) | |
7820 | P(N+I,JB2)=SV(JC,JB1) | |
7821 | P(N+I,JB)=-(SV(JA,JB1)*P(N+I,JB1)+SV(JA,JB2)*P(N+I,JB2))/ | |
7822 | &SV(JA,JB) | |
7823 | PA=SQRT(P(N+I,1)**2+P(N+I,2)**2+P(N+I,3)**2) | |
7824 | SGN=(-1.)**INT(RLY(0)+0.5) | |
7825 | DO 230 J=1,3 | |
7826 | P(N+I,J)=SGN*P(N+I,J)/PA | |
7827 | 230 CONTINUE | |
7828 | 240 CONTINUE | |
7829 | ||
7830 | C...Middle axis orthogonal to other two. Fill other codes. | |
7831 | SGN=(-1.)**INT(RLY(0)+0.5) | |
7832 | P(N+2,1)=SGN*(P(N+1,2)*P(N+3,3)-P(N+1,3)*P(N+3,2)) | |
7833 | P(N+2,2)=SGN*(P(N+1,3)*P(N+3,1)-P(N+1,1)*P(N+3,3)) | |
7834 | P(N+2,3)=SGN*(P(N+1,1)*P(N+3,2)-P(N+1,2)*P(N+3,1)) | |
7835 | DO 260 I=1,3 | |
7836 | K(N+I,1)=31 | |
7837 | K(N+I,2)=95 | |
7838 | K(N+I,3)=I | |
7839 | K(N+I,4)=0 | |
7840 | K(N+I,5)=0 | |
7841 | P(N+I,5)=0. | |
7842 | DO 250 J=1,5 | |
7843 | V(I,J)=0. | |
7844 | 250 CONTINUE | |
7845 | 260 CONTINUE | |
7846 | ||
7847 | C...Calculate sphericity and aplanarity. Select storing option. | |
7848 | SPH=1.5*(P(N+2,4)+P(N+3,4)) | |
7849 | APL=1.5*P(N+3,4) | |
7850 | MSTU(61)=N+1 | |
7851 | MSTU(62)=NP | |
7852 | IF(MSTU(43).LE.1) MSTU(3)=3 | |
7853 | IF(MSTU(43).GE.2) N=N+3 | |
7854 | ||
7855 | RETURN | |
7856 | END | |
7857 | ||
7858 | C********************************************************************* | |
7859 | ||
7860 | SUBROUTINE LYTHRU(THR,OBL) | |
7861 | ||
7862 | C...Purpose: to perform thrust analysis to give thrust, oblateness | |
7863 | C...and the related event axes. | |
7864 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
7865 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
7866 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
7867 | SAVE /LYJETS/,/LYDAT1/,/LYDAT2/ | |
7868 | DIMENSION TDI(3),TPR(3) | |
7869 | ||
7870 | C...Take copy of particles that are to be considered in thrust analysis. | |
7871 | NP=0 | |
7872 | PS=0. | |
7873 | DO 100 I=1,N | |
7874 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 100 | |
7875 | IF(MSTU(41).GE.2) THEN | |
7876 | KC=LYCOMP(K(I,2)) | |
7877 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. | |
7878 | & KC.EQ.18) GOTO 100 | |
7879 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LYCHGE(K(I,2)).EQ.0) | |
7880 | & GOTO 100 | |
7881 | ENDIF | |
7882 | IF(N+NP+MSTU(44)+15.GE.MSTU(4)-MSTU(32)-5) THEN | |
7883 | CALL LYERRM(11,'(LYTHRU:) no more memory left in LUJETS') | |
7884 | THR=-2. | |
7885 | OBL=-2. | |
7886 | RETURN | |
7887 | ENDIF | |
7888 | NP=NP+1 | |
7889 | K(N+NP,1)=23 | |
7890 | P(N+NP,1)=P(I,1) | |
7891 | P(N+NP,2)=P(I,2) | |
7892 | P(N+NP,3)=P(I,3) | |
7893 | P(N+NP,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
7894 | P(N+NP,5)=1. | |
7895 | IF(ABS(PARU(42)-1.).GT.0.001) P(N+NP,5)=P(N+NP,4)**(PARU(42)-1.) | |
7896 | PS=PS+P(N+NP,4)*P(N+NP,5) | |
7897 | 100 CONTINUE | |
7898 | ||
7899 | C...Very low multiplicities (0 or 1) not considered. | |
7900 | IF(NP.LE.1) THEN | |
7901 | CALL LYERRM(8,'(LYTHRU:) too few particles for analysis') | |
7902 | THR=-1. | |
7903 | OBL=-1. | |
7904 | RETURN | |
7905 | ENDIF | |
7906 | ||
7907 | C...Loop over thrust and major. T axis along z direction in latter case. | |
7908 | DO 320 ILD=1,2 | |
7909 | IF(ILD.EQ.2) THEN | |
7910 | K(N+NP+1,1)=31 | |
7911 | PHI=UYANGL(P(N+NP+1,1),P(N+NP+1,2)) | |
7912 | MSTU(33)=1 | |
7913 | CALL LUDBRB(N+1,N+NP+1,0.,-PHI,0D0,0D0,0D0) | |
7914 | THE=UYANGL(P(N+NP+1,3),P(N+NP+1,1)) | |
7915 | CALL LUDBRB(N+1,N+NP+1,-THE,0.,0D0,0D0,0D0) | |
7916 | ENDIF | |
7917 | ||
7918 | C...Find and order particles with highest p (pT for major). | |
7919 | DO 110 ILF=N+NP+4,N+NP+MSTU(44)+4 | |
7920 | P(ILF,4)=0. | |
7921 | 110 CONTINUE | |
7922 | DO 160 I=N+1,N+NP | |
7923 | IF(ILD.EQ.2) P(I,4)=SQRT(P(I,1)**2+P(I,2)**2) | |
7924 | DO 130 ILF=N+NP+MSTU(44)+3,N+NP+4,-1 | |
7925 | IF(P(I,4).LE.P(ILF,4)) GOTO 140 | |
7926 | DO 120 J=1,5 | |
7927 | P(ILF+1,J)=P(ILF,J) | |
7928 | 120 CONTINUE | |
7929 | 130 CONTINUE | |
7930 | ILF=N+NP+3 | |
7931 | 140 DO 150 J=1,5 | |
7932 | P(ILF+1,J)=P(I,J) | |
7933 | 150 CONTINUE | |
7934 | 160 CONTINUE | |
7935 | ||
7936 | C...Find and order initial axes with highest thrust (major). | |
7937 | DO 170 ILG=N+NP+MSTU(44)+5,N+NP+MSTU(44)+15 | |
7938 | P(ILG,4)=0. | |
7939 | 170 CONTINUE | |
7940 | NC=2**(MIN(MSTU(44),NP)-1) | |
7941 | DO 250 ILC=1,NC | |
7942 | DO 180 J=1,3 | |
7943 | TDI(J)=0. | |
7944 | 180 CONTINUE | |
7945 | DO 200 ILF=1,MIN(MSTU(44),NP) | |
7946 | SGN=P(N+NP+ILF+3,5) | |
7947 | IF(2**ILF*((ILC+2**(ILF-1)-1)/2**ILF).GE.ILC) SGN=-SGN | |
7948 | DO 190 J=1,4-ILD | |
7949 | TDI(J)=TDI(J)+SGN*P(N+NP+ILF+3,J) | |
7950 | 190 CONTINUE | |
7951 | 200 CONTINUE | |
7952 | TDS=TDI(1)**2+TDI(2)**2+TDI(3)**2 | |
7953 | DO 220 ILG=N+NP+MSTU(44)+MIN(ILC,10)+4,N+NP+MSTU(44)+5,-1 | |
7954 | IF(TDS.LE.P(ILG,4)) GOTO 230 | |
7955 | DO 210 J=1,4 | |
7956 | P(ILG+1,J)=P(ILG,J) | |
7957 | 210 CONTINUE | |
7958 | 220 CONTINUE | |
7959 | ILG=N+NP+MSTU(44)+4 | |
7960 | 230 DO 240 J=1,3 | |
7961 | P(ILG+1,J)=TDI(J) | |
7962 | 240 CONTINUE | |
7963 | P(ILG+1,4)=TDS | |
7964 | 250 CONTINUE | |
7965 | ||
7966 | C...Iterate direction of axis until stable maximum. | |
7967 | P(N+NP+ILD,4)=0. | |
7968 | ILG=0 | |
7969 | 260 ILG=ILG+1 | |
7970 | THP=0. | |
7971 | 270 THPS=THP | |
7972 | DO 280 J=1,3 | |
7973 | IF(THP.LE.1E-10) TDI(J)=P(N+NP+MSTU(44)+4+ILG,J) | |
7974 | IF(THP.GT.1E-10) TDI(J)=TPR(J) | |
7975 | TPR(J)=0. | |
7976 | 280 CONTINUE | |
7977 | DO 300 I=N+1,N+NP | |
7978 | SGN=SIGN(P(I,5),TDI(1)*P(I,1)+TDI(2)*P(I,2)+TDI(3)*P(I,3)) | |
7979 | DO 290 J=1,4-ILD | |
7980 | TPR(J)=TPR(J)+SGN*P(I,J) | |
7981 | 290 CONTINUE | |
7982 | 300 CONTINUE | |
7983 | THP=SQRT(TPR(1)**2+TPR(2)**2+TPR(3)**2)/PS | |
7984 | IF(THP.GE.THPS+PARU(48)) GOTO 270 | |
7985 | ||
7986 | C...Save good axis. Try new initial axis until a number of tries agree. | |
7987 | IF(THP.LT.P(N+NP+ILD,4)-PARU(48).AND.ILG.LT.MIN(10,NC)) GOTO 260 | |
7988 | IF(THP.GT.P(N+NP+ILD,4)+PARU(48)) THEN | |
7989 | IAGR=0 | |
7990 | SGN=(-1.)**INT(RLY(0)+0.5) | |
7991 | DO 310 J=1,3 | |
7992 | P(N+NP+ILD,J)=SGN*TPR(J)/(PS*THP) | |
7993 | 310 CONTINUE | |
7994 | P(N+NP+ILD,4)=THP | |
7995 | P(N+NP+ILD,5)=0. | |
7996 | ENDIF | |
7997 | IAGR=IAGR+1 | |
7998 | IF(IAGR.LT.MSTU(45).AND.ILG.LT.MIN(10,NC)) GOTO 260 | |
7999 | 320 CONTINUE | |
8000 | ||
8001 | C...Find minor axis and value by orthogonality. | |
8002 | SGN=(-1.)**INT(RLY(0)+0.5) | |
8003 | P(N+NP+3,1)=-SGN*P(N+NP+2,2) | |
8004 | P(N+NP+3,2)=SGN*P(N+NP+2,1) | |
8005 | P(N+NP+3,3)=0. | |
8006 | THP=0. | |
8007 | DO 330 I=N+1,N+NP | |
8008 | THP=THP+P(I,5)*ABS(P(N+NP+3,1)*P(I,1)+P(N+NP+3,2)*P(I,2)) | |
8009 | 330 CONTINUE | |
8010 | P(N+NP+3,4)=THP/PS | |
8011 | P(N+NP+3,5)=0. | |
8012 | ||
8013 | C...Fill axis information. Rotate back to original coordinate system. | |
8014 | DO 350 ILD=1,3 | |
8015 | K(N+ILD,1)=31 | |
8016 | K(N+ILD,2)=96 | |
8017 | K(N+ILD,3)=ILD | |
8018 | K(N+ILD,4)=0 | |
8019 | K(N+ILD,5)=0 | |
8020 | DO 340 J=1,5 | |
8021 | P(N+ILD,J)=P(N+NP+ILD,J) | |
8022 | V(N+ILD,J)=0. | |
8023 | 340 CONTINUE | |
8024 | 350 CONTINUE | |
8025 | CALL LUDBRB(N+1,N+3,THE,PHI,0D0,0D0,0D0) | |
8026 | ||
8027 | C...Calculate thrust and oblateness. Select storing option. | |
8028 | THR=P(N+1,4) | |
8029 | OBL=P(N+2,4)-P(N+3,4) | |
8030 | MSTU(61)=N+1 | |
8031 | MSTU(62)=NP | |
8032 | IF(MSTU(43).LE.1) MSTU(3)=3 | |
8033 | IF(MSTU(43).GE.2) N=N+3 | |
8034 | ||
8035 | RETURN | |
8036 | END | |
8037 | ||
8038 | C********************************************************************* | |
8039 | ||
8040 | SUBROUTINE LYCLUS(NJET) | |
8041 | ||
8042 | C...Purpose: to subdivide the particle content of an event into | |
8043 | C...jets/clusters. | |
8044 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
8045 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
8046 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
8047 | SAVE /LYJETS/,/LYDAT1/,/LYDAT2/ | |
8048 | DIMENSION PS(5) | |
8049 | SAVE NSAV,NP,PS,PSS,RINIT,NPRE,NREM | |
8050 | ||
8051 | C...Functions: distance measure in pT, (pseudo)mass or Durham pT. | |
8052 | R2T(I1,I2)=(P(I1,5)*P(I2,5)-P(I1,1)*P(I2,1)-P(I1,2)*P(I2,2)- | |
8053 | &P(I1,3)*P(I2,3))*2.*P(I1,5)*P(I2,5)/(0.0001+P(I1,5)+P(I2,5))**2 | |
8054 | R2M(I1,I2)=2.*P(I1,4)*P(I2,4)*(1.-(P(I1,1)*P(I2,1)+P(I1,2)* | |
8055 | &P(I2,2)+P(I1,3)*P(I2,3))/(P(I1,5)*P(I2,5))) | |
8056 | R2D(I1,I2)=2.*MIN(P(I1,4),P(I2,4))**2*(1.-(P(I1,1)*P(I2,1)+ | |
8057 | &P(I1,2)*P(I2,2)+P(I1,3)*P(I2,3))/(P(I1,5)*P(I2,5))) | |
8058 | ||
8059 | C...If first time, reset. If reentering, skip preliminaries. | |
8060 | IF(MSTU(48).LE.0) THEN | |
8061 | NP=0 | |
8062 | DO 100 J=1,5 | |
8063 | PS(J)=0. | |
8064 | 100 CONTINUE | |
8065 | PSS=0. | |
8066 | ELSE | |
8067 | NJET=NSAV | |
8068 | IF(MSTU(43).GE.2) N=N-NJET | |
8069 | DO 110 I=N+1,N+NJET | |
8070 | P(I,5)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
8071 | 110 CONTINUE | |
8072 | IF(MSTU(46).LE.3.OR.MSTU(46).EQ.5) THEN | |
8073 | R2ACC=PARU(44)**2 | |
8074 | ELSE | |
8075 | R2ACC=PARU(45)*PS(5)**2 | |
8076 | ENDIF | |
8077 | NLOOP=0 | |
8078 | GOTO 300 | |
8079 | ENDIF | |
8080 | ||
8081 | C...Find which particles are to be considered in cluster search. | |
8082 | DO 140 I=1,N | |
8083 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 140 | |
8084 | IF(MSTU(41).GE.2) THEN | |
8085 | KC=LYCOMP(K(I,2)) | |
8086 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. | |
8087 | & KC.EQ.18) GOTO 140 | |
8088 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LYCHGE(K(I,2)).EQ.0) | |
8089 | & GOTO 140 | |
8090 | ENDIF | |
8091 | IF(N+2*NP.GE.MSTU(4)-MSTU(32)-5) THEN | |
8092 | CALL LYERRM(11,'(LYCLUS:) no more memory left in LUJETS') | |
8093 | NJET=-1 | |
8094 | RETURN | |
8095 | ENDIF | |
8096 | ||
8097 | C...Take copy of these particles, with space left for jets later on. | |
8098 | NP=NP+1 | |
8099 | K(N+NP,3)=I | |
8100 | DO 120 J=1,5 | |
8101 | P(N+NP,J)=P(I,J) | |
8102 | 120 CONTINUE | |
8103 | IF(MSTU(42).EQ.0) P(N+NP,5)=0. | |
8104 | IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) P(N+NP,5)=PMAS(101,1) | |
8105 | P(N+NP,4)=SQRT(P(N+NP,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
8106 | P(N+NP,5)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
8107 | DO 130 J=1,4 | |
8108 | PS(J)=PS(J)+P(N+NP,J) | |
8109 | 130 CONTINUE | |
8110 | PSS=PSS+P(N+NP,5) | |
8111 | 140 CONTINUE | |
8112 | DO 160 I=N+1,N+NP | |
8113 | K(I+NP,3)=K(I,3) | |
8114 | DO 150 J=1,5 | |
8115 | P(I+NP,J)=P(I,J) | |
8116 | 150 CONTINUE | |
8117 | 160 CONTINUE | |
8118 | PS(5)=SQRT(MAX(0.,PS(4)**2-PS(1)**2-PS(2)**2-PS(3)**2)) | |
8119 | ||
8120 | C...Very low multiplicities not considered. | |
8121 | IF(NP.LT.MSTU(47)) THEN | |
8122 | CALL LYERRM(8,'(LYCLUS:) too few particles for analysis') | |
8123 | NJET=-1 | |
8124 | RETURN | |
8125 | ENDIF | |
8126 | ||
8127 | C...Find precluster configuration. If too few jets, make harder cuts. | |
8128 | NLOOP=0 | |
8129 | IF(MSTU(46).LE.3.OR.MSTU(46).EQ.5) THEN | |
8130 | R2ACC=PARU(44)**2 | |
8131 | ELSE | |
8132 | R2ACC=PARU(45)*PS(5)**2 | |
8133 | ENDIF | |
8134 | RINIT=1.25*PARU(43) | |
8135 | IF(NP.LE.MSTU(47)+2) RINIT=0. | |
8136 | 170 RINIT=0.8*RINIT | |
8137 | NPRE=0 | |
8138 | NREM=NP | |
8139 | DO 180 I=N+NP+1,N+2*NP | |
8140 | K(I,4)=0 | |
8141 | 180 CONTINUE | |
8142 | ||
8143 | C...Sum up small momentum region. Jet if enough absolute momentum. | |
8144 | IF(MSTU(46).LE.2) THEN | |
8145 | DO 190 J=1,4 | |
8146 | P(N+1,J)=0. | |
8147 | 190 CONTINUE | |
8148 | DO 210 I=N+NP+1,N+2*NP | |
8149 | IF(P(I,5).GT.2.*RINIT) GOTO 210 | |
8150 | NREM=NREM-1 | |
8151 | K(I,4)=1 | |
8152 | DO 200 J=1,4 | |
8153 | P(N+1,J)=P(N+1,J)+P(I,J) | |
8154 | 200 CONTINUE | |
8155 | 210 CONTINUE | |
8156 | P(N+1,5)=SQRT(P(N+1,1)**2+P(N+1,2)**2+P(N+1,3)**2) | |
8157 | IF(P(N+1,5).GT.2.*RINIT) NPRE=1 | |
8158 | IF(RINIT.GE.0.2*PARU(43).AND.NPRE+NREM.LT.MSTU(47)) GOTO 170 | |
8159 | IF(NREM.EQ.0) GOTO 170 | |
8160 | ENDIF | |
8161 | ||
8162 | C...Find fastest remaining particle. | |
8163 | 220 NPRE=NPRE+1 | |
8164 | PMAX=0. | |
8165 | DO 230 I=N+NP+1,N+2*NP | |
8166 | IF(K(I,4).NE.0.OR.P(I,5).LE.PMAX) GOTO 230 | |
8167 | IMAX=I | |
8168 | PMAX=P(I,5) | |
8169 | 230 CONTINUE | |
8170 | DO 240 J=1,5 | |
8171 | P(N+NPRE,J)=P(IMAX,J) | |
8172 | 240 CONTINUE | |
8173 | NREM=NREM-1 | |
8174 | K(IMAX,4)=NPRE | |
8175 | ||
8176 | C...Sum up precluster around it according to pT separation. | |
8177 | IF(MSTU(46).LE.2) THEN | |
8178 | DO 260 I=N+NP+1,N+2*NP | |
8179 | IF(K(I,4).NE.0) GOTO 260 | |
8180 | R2=R2T(I,IMAX) | |
8181 | IF(R2.GT.RINIT**2) GOTO 260 | |
8182 | NREM=NREM-1 | |
8183 | K(I,4)=NPRE | |
8184 | DO 250 J=1,4 | |
8185 | P(N+NPRE,J)=P(N+NPRE,J)+P(I,J) | |
8186 | 250 CONTINUE | |
8187 | 260 CONTINUE | |
8188 | P(N+NPRE,5)=SQRT(P(N+NPRE,1)**2+P(N+NPRE,2)**2+P(N+NPRE,3)**2) | |
8189 | ||
8190 | C...Sum up precluster around it according to mass or | |
8191 | C...Durham pT separation. | |
8192 | ELSE | |
8193 | 270 IMIN=0 | |
8194 | R2MIN=RINIT**2 | |
8195 | DO 280 I=N+NP+1,N+2*NP | |
8196 | IF(K(I,4).NE.0) GOTO 280 | |
8197 | IF(MSTU(46).LE.4) THEN | |
8198 | R2=R2M(I,N+NPRE) | |
8199 | ELSE | |
8200 | R2=R2D(I,N+NPRE) | |
8201 | ENDIF | |
8202 | IF(R2.GE.R2MIN) GOTO 280 | |
8203 | IMIN=I | |
8204 | R2MIN=R2 | |
8205 | 280 CONTINUE | |
8206 | IF(IMIN.NE.0) THEN | |
8207 | DO 290 J=1,4 | |
8208 | P(N+NPRE,J)=P(N+NPRE,J)+P(IMIN,J) | |
8209 | 290 CONTINUE | |
8210 | P(N+NPRE,5)=SQRT(P(N+NPRE,1)**2+P(N+NPRE,2)**2+P(N+NPRE,3)**2) | |
8211 | NREM=NREM-1 | |
8212 | K(IMIN,4)=NPRE | |
8213 | GOTO 270 | |
8214 | ENDIF | |
8215 | ENDIF | |
8216 | ||
8217 | C...Check if more preclusters to be found. Start over if too few. | |
8218 | IF(RINIT.GE.0.2*PARU(43).AND.NPRE+NREM.LT.MSTU(47)) GOTO 170 | |
8219 | IF(NREM.GT.0) GOTO 220 | |
8220 | NJET=NPRE | |
8221 | ||
8222 | C...Reassign all particles to nearest jet. Sum up new jet momenta. | |
8223 | 300 TSAV=0. | |
8224 | PSJT=0. | |
8225 | 310 IF(MSTU(46).LE.1) THEN | |
8226 | DO 330 I=N+1,N+NJET | |
8227 | DO 320 J=1,4 | |
8228 | V(I,J)=0. | |
8229 | 320 CONTINUE | |
8230 | 330 CONTINUE | |
8231 | DO 360 I=N+NP+1,N+2*NP | |
8232 | R2MIN=PSS**2 | |
8233 | DO 340 IJET=N+1,N+NJET | |
8234 | IF(P(IJET,5).LT.RINIT) GOTO 340 | |
8235 | R2=R2T(I,IJET) | |
8236 | IF(R2.GE.R2MIN) GOTO 340 | |
8237 | IMIN=IJET | |
8238 | R2MIN=R2 | |
8239 | 340 CONTINUE | |
8240 | K(I,4)=IMIN-N | |
8241 | DO 350 J=1,4 | |
8242 | V(IMIN,J)=V(IMIN,J)+P(I,J) | |
8243 | 350 CONTINUE | |
8244 | 360 CONTINUE | |
8245 | PSJT=0. | |
8246 | DO 380 I=N+1,N+NJET | |
8247 | DO 370 J=1,4 | |
8248 | P(I,J)=V(I,J) | |
8249 | 370 CONTINUE | |
8250 | P(I,5)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
8251 | PSJT=PSJT+P(I,5) | |
8252 | 380 CONTINUE | |
8253 | ENDIF | |
8254 | ||
8255 | C...Find two closest jets. | |
8256 | R2MIN=2.*MAX(R2ACC,PS(5)**2) | |
8257 | DO 400 ITRY1=N+1,N+NJET-1 | |
8258 | DO 390 ITRY2=ITRY1+1,N+NJET | |
8259 | IF(MSTU(46).LE.2) THEN | |
8260 | R2=R2T(ITRY1,ITRY2) | |
8261 | ELSEIF(MSTU(46).LE.4) THEN | |
8262 | R2=R2M(ITRY1,ITRY2) | |
8263 | ELSE | |
8264 | R2=R2D(ITRY1,ITRY2) | |
8265 | ENDIF | |
8266 | IF(R2.GE.R2MIN) GOTO 390 | |
8267 | IMIN1=ITRY1 | |
8268 | IMIN2=ITRY2 | |
8269 | R2MIN=R2 | |
8270 | 390 CONTINUE | |
8271 | 400 CONTINUE | |
8272 | ||
8273 | C...If allowed, join two closest jets and start over. | |
8274 | IF(NJET.GT.MSTU(47).AND.R2MIN.LT.R2ACC) THEN | |
8275 | IREC=MIN(IMIN1,IMIN2) | |
8276 | IDEL=MAX(IMIN1,IMIN2) | |
8277 | DO 410 J=1,4 | |
8278 | P(IREC,J)=P(IMIN1,J)+P(IMIN2,J) | |
8279 | 410 CONTINUE | |
8280 | P(IREC,5)=SQRT(P(IREC,1)**2+P(IREC,2)**2+P(IREC,3)**2) | |
8281 | DO 430 I=IDEL+1,N+NJET | |
8282 | DO 420 J=1,5 | |
8283 | P(I-1,J)=P(I,J) | |
8284 | 420 CONTINUE | |
8285 | 430 CONTINUE | |
8286 | IF(MSTU(46).GE.2) THEN | |
8287 | DO 440 I=N+NP+1,N+2*NP | |
8288 | IORI=N+K(I,4) | |
8289 | IF(IORI.EQ.IDEL) K(I,4)=IREC-N | |
8290 | IF(IORI.GT.IDEL) K(I,4)=K(I,4)-1 | |
8291 | 440 CONTINUE | |
8292 | ENDIF | |
8293 | NJET=NJET-1 | |
8294 | GOTO 300 | |
8295 | ||
8296 | C...Divide up broad jet if empty cluster in list of final ones. | |
8297 | ELSEIF(NJET.EQ.MSTU(47).AND.MSTU(46).LE.1.AND.NLOOP.LE.2) THEN | |
8298 | DO 450 I=N+1,N+NJET | |
8299 | K(I,5)=0 | |
8300 | 450 CONTINUE | |
8301 | DO 460 I=N+NP+1,N+2*NP | |
8302 | K(N+K(I,4),5)=K(N+K(I,4),5)+1 | |
8303 | 460 CONTINUE | |
8304 | IEMP=0 | |
8305 | DO 470 I=N+1,N+NJET | |
8306 | IF(K(I,5).EQ.0) IEMP=I | |
8307 | 470 CONTINUE | |
8308 | IF(IEMP.NE.0) THEN | |
8309 | NLOOP=NLOOP+1 | |
8310 | ISPL=0 | |
8311 | R2MAX=0. | |
8312 | DO 480 I=N+NP+1,N+2*NP | |
8313 | IF(K(N+K(I,4),5).LE.1.OR.P(I,5).LT.RINIT) GOTO 480 | |
8314 | IJET=N+K(I,4) | |
8315 | R2=R2T(I,IJET) | |
8316 | IF(R2.LE.R2MAX) GOTO 480 | |
8317 | ISPL=I | |
8318 | R2MAX=R2 | |
8319 | 480 CONTINUE | |
8320 | IF(ISPL.NE.0) THEN | |
8321 | IJET=N+K(ISPL,4) | |
8322 | DO 490 J=1,4 | |
8323 | P(IEMP,J)=P(ISPL,J) | |
8324 | P(IJET,J)=P(IJET,J)-P(ISPL,J) | |
8325 | 490 CONTINUE | |
8326 | P(IEMP,5)=P(ISPL,5) | |
8327 | P(IJET,5)=SQRT(P(IJET,1)**2+P(IJET,2)**2+P(IJET,3)**2) | |
8328 | IF(NLOOP.LE.2) GOTO 300 | |
8329 | ENDIF | |
8330 | ENDIF | |
8331 | ENDIF | |
8332 | ||
8333 | C...If generalized thrust has not yet converged, continue iteration. | |
8334 | IF(MSTU(46).LE.1.AND.NLOOP.LE.2.AND.PSJT/PSS.GT.TSAV+PARU(48)) | |
8335 | &THEN | |
8336 | TSAV=PSJT/PSS | |
8337 | GOTO 310 | |
8338 | ENDIF | |
8339 | ||
8340 | C...Reorder jets according to energy. | |
8341 | DO 510 I=N+1,N+NJET | |
8342 | DO 500 J=1,5 | |
8343 | V(I,J)=P(I,J) | |
8344 | 500 CONTINUE | |
8345 | 510 CONTINUE | |
8346 | DO 540 INEW=N+1,N+NJET | |
8347 | PEMAX=0. | |
8348 | DO 520 ITRY=N+1,N+NJET | |
8349 | IF(V(ITRY,4).LE.PEMAX) GOTO 520 | |
8350 | IMAX=ITRY | |
8351 | PEMAX=V(ITRY,4) | |
8352 | 520 CONTINUE | |
8353 | K(INEW,1)=31 | |
8354 | K(INEW,2)=97 | |
8355 | K(INEW,3)=INEW-N | |
8356 | K(INEW,4)=0 | |
8357 | DO 530 J=1,5 | |
8358 | P(INEW,J)=V(IMAX,J) | |
8359 | 530 CONTINUE | |
8360 | V(IMAX,4)=-1. | |
8361 | K(IMAX,5)=INEW | |
8362 | 540 CONTINUE | |
8363 | ||
8364 | C...Clean up particle-jet assignments and jet information. | |
8365 | DO 550 I=N+NP+1,N+2*NP | |
8366 | IORI=K(N+K(I,4),5) | |
8367 | K(I,4)=IORI-N | |
8368 | IF(K(K(I,3),1).NE.3) K(K(I,3),4)=IORI-N | |
8369 | K(IORI,4)=K(IORI,4)+1 | |
8370 | 550 CONTINUE | |
8371 | IEMP=0 | |
8372 | PSJT=0. | |
8373 | DO 570 I=N+1,N+NJET | |
8374 | K(I,5)=0 | |
8375 | PSJT=PSJT+P(I,5) | |
8376 | P(I,5)=SQRT(MAX(P(I,4)**2-P(I,5)**2,0.)) | |
8377 | DO 560 J=1,5 | |
8378 | V(I,J)=0. | |
8379 | 560 CONTINUE | |
8380 | IF(K(I,4).EQ.0) IEMP=I | |
8381 | 570 CONTINUE | |
8382 | ||
8383 | C...Select storing option. Output variables. Check for failure. | |
8384 | MSTU(61)=N+1 | |
8385 | MSTU(62)=NP | |
8386 | MSTU(63)=NPRE | |
8387 | PARU(61)=PS(5) | |
8388 | PARU(62)=PSJT/PSS | |
8389 | PARU(63)=SQRT(R2MIN) | |
8390 | IF(NJET.LE.1) PARU(63)=0. | |
8391 | IF(IEMP.NE.0) THEN | |
8392 | CALL LYERRM(8,'(LYCLUS:) failed to reconstruct as requested') | |
8393 | NJET=-1 | |
8394 | ENDIF | |
8395 | IF(MSTU(43).LE.1) MSTU(3)=NJET | |
8396 | IF(MSTU(43).GE.2) N=N+NJET | |
8397 | NSAV=NJET | |
8398 | ||
8399 | RETURN | |
8400 | END | |
8401 | ||
8402 | C********************************************************************* | |
8403 | ||
8404 | SUBROUTINE LYCELL(NJET) | |
8405 | ||
8406 | C...Purpose: to provide a simple way of jet finding in an eta-phi-ET | |
8407 | C...coordinate frame, as used for calorimeters at hadron colliders. | |
8408 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
8409 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
8410 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
8411 | SAVE /LYJETS/,/LYDAT1/,/LYDAT2/ | |
8412 | ||
8413 | C...Loop over all particles. Find cell that was hit by given particle. | |
8414 | PTLRAT=1./SINH(PARU(51))**2 | |
8415 | NP=0 | |
8416 | NC=N | |
8417 | DO 110 I=1,N | |
8418 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 110 | |
8419 | IF(P(I,1)**2+P(I,2)**2.LE.PTLRAT*P(I,3)**2) GOTO 110 | |
8420 | IF(MSTU(41).GE.2) THEN | |
8421 | KC=LYCOMP(K(I,2)) | |
8422 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. | |
8423 | & KC.EQ.18) GOTO 110 | |
8424 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LYCHGE(K(I,2)).EQ.0) | |
8425 | & GOTO 110 | |
8426 | ENDIF | |
8427 | NP=NP+1 | |
8428 | PT=SQRT(P(I,1)**2+P(I,2)**2) | |
8429 | ETA=SIGN(LOG((SQRT(PT**2+P(I,3)**2)+ABS(P(I,3)))/PT),P(I,3)) | |
8430 | IETA=MAX(1,MIN(MSTU(51),1+INT(MSTU(51)*0.5*(ETA/PARU(51)+1.)))) | |
8431 | PHI=UYANGL(P(I,1),P(I,2)) | |
8432 | IPHI=MAX(1,MIN(MSTU(52),1+INT(MSTU(52)*0.5*(PHI/PARU(1)+1.)))) | |
8433 | IETPH=MSTU(52)*IETA+IPHI | |
8434 | ||
8435 | C...Add to cell already hit, or book new cell. | |
8436 | DO 100 IC=N+1,NC | |
8437 | IF(IETPH.EQ.K(IC,3)) THEN | |
8438 | K(IC,4)=K(IC,4)+1 | |
8439 | P(IC,5)=P(IC,5)+PT | |
8440 | GOTO 110 | |
8441 | ENDIF | |
8442 | 100 CONTINUE | |
8443 | IF(NC.GE.MSTU(4)-MSTU(32)-5) THEN | |
8444 | CALL LYERRM(11,'(LYCELL:) no more memory left in LUJETS') | |
8445 | NJET=-2 | |
8446 | RETURN | |
8447 | ENDIF | |
8448 | NC=NC+1 | |
8449 | K(NC,3)=IETPH | |
8450 | K(NC,4)=1 | |
8451 | K(NC,5)=2 | |
8452 | P(NC,1)=(PARU(51)/MSTU(51))*(2*IETA-1-MSTU(51)) | |
8453 | P(NC,2)=(PARU(1)/MSTU(52))*(2*IPHI-1-MSTU(52)) | |
8454 | P(NC,5)=PT | |
8455 | 110 CONTINUE | |
8456 | ||
8457 | C...Smear true bin content by calorimeter resolution. | |
8458 | IF(MSTU(53).GE.1) THEN | |
8459 | DO 130 IC=N+1,NC | |
8460 | PEI=P(IC,5) | |
8461 | IF(MSTU(53).EQ.2) PEI=P(IC,5)*COSH(P(IC,1)) | |
8462 | 120 PEF=PEI+PARU(55)*SQRT(-2.*LOG(MAX(1E-10,RLY(0)))*PEI)* | |
8463 | & COS(PARU(2)*RLY(0)) | |
8464 | IF(PEF.LT.0..OR.PEF.GT.PARU(56)*PEI) GOTO 120 | |
8465 | P(IC,5)=PEF | |
8466 | IF(MSTU(53).EQ.2) P(IC,5)=PEF/COSH(P(IC,1)) | |
8467 | 130 CONTINUE | |
8468 | ENDIF | |
8469 | ||
8470 | C...Remove cells below threshold. | |
8471 | IF(PARU(58).GT.0.) THEN | |
8472 | NCC=NC | |
8473 | NC=N | |
8474 | DO 140 IC=N+1,NCC | |
8475 | IF(P(IC,5).GT.PARU(58)) THEN | |
8476 | NC=NC+1 | |
8477 | K(NC,3)=K(IC,3) | |
8478 | K(NC,4)=K(IC,4) | |
8479 | K(NC,5)=K(IC,5) | |
8480 | P(NC,1)=P(IC,1) | |
8481 | P(NC,2)=P(IC,2) | |
8482 | P(NC,5)=P(IC,5) | |
8483 | ENDIF | |
8484 | 140 CONTINUE | |
8485 | ENDIF | |
8486 | ||
8487 | C...Find initiator cell: the one with highest pT of not yet used ones. | |
8488 | NJ=NC | |
8489 | 150 ETMAX=0. | |
8490 | DO 160 IC=N+1,NC | |
8491 | IF(K(IC,5).NE.2) GOTO 160 | |
8492 | IF(P(IC,5).LE.ETMAX) GOTO 160 | |
8493 | ICMAX=IC | |
8494 | ETA=P(IC,1) | |
8495 | PHI=P(IC,2) | |
8496 | ETMAX=P(IC,5) | |
8497 | 160 CONTINUE | |
8498 | IF(ETMAX.LT.PARU(52)) GOTO 220 | |
8499 | IF(NJ.GE.MSTU(4)-MSTU(32)-5) THEN | |
8500 | CALL LYERRM(11,'(LYCELL:) no more memory left in LUJETS') | |
8501 | NJET=-2 | |
8502 | RETURN | |
8503 | ENDIF | |
8504 | K(ICMAX,5)=1 | |
8505 | NJ=NJ+1 | |
8506 | K(NJ,4)=0 | |
8507 | K(NJ,5)=1 | |
8508 | P(NJ,1)=ETA | |
8509 | P(NJ,2)=PHI | |
8510 | P(NJ,3)=0. | |
8511 | P(NJ,4)=0. | |
8512 | P(NJ,5)=0. | |
8513 | ||
8514 | C...Sum up unused cells within required distance of initiator. | |
8515 | DO 170 IC=N+1,NC | |
8516 | IF(K(IC,5).EQ.0) GOTO 170 | |
8517 | IF(ABS(P(IC,1)-ETA).GT.PARU(54)) GOTO 170 | |
8518 | DPHIA=ABS(P(IC,2)-PHI) | |
8519 | IF(DPHIA.GT.PARU(54).AND.DPHIA.LT.PARU(2)-PARU(54)) GOTO 170 | |
8520 | PHIC=P(IC,2) | |
8521 | IF(DPHIA.GT.PARU(1)) PHIC=PHIC+SIGN(PARU(2),PHI) | |
8522 | IF((P(IC,1)-ETA)**2+(PHIC-PHI)**2.GT.PARU(54)**2) GOTO 170 | |
8523 | K(IC,5)=-K(IC,5) | |
8524 | K(NJ,4)=K(NJ,4)+K(IC,4) | |
8525 | P(NJ,3)=P(NJ,3)+P(IC,5)*P(IC,1) | |
8526 | P(NJ,4)=P(NJ,4)+P(IC,5)*PHIC | |
8527 | P(NJ,5)=P(NJ,5)+P(IC,5) | |
8528 | 170 CONTINUE | |
8529 | ||
8530 | C...Reject cluster below minimum ET, else accept. | |
8531 | IF(P(NJ,5).LT.PARU(53)) THEN | |
8532 | NJ=NJ-1 | |
8533 | DO 180 IC=N+1,NC | |
8534 | IF(K(IC,5).LT.0) K(IC,5)=-K(IC,5) | |
8535 | 180 CONTINUE | |
8536 | ELSEIF(MSTU(54).LE.2) THEN | |
8537 | P(NJ,3)=P(NJ,3)/P(NJ,5) | |
8538 | P(NJ,4)=P(NJ,4)/P(NJ,5) | |
8539 | IF(ABS(P(NJ,4)).GT.PARU(1)) P(NJ,4)=P(NJ,4)-SIGN(PARU(2), | |
8540 | & P(NJ,4)) | |
8541 | DO 190 IC=N+1,NC | |
8542 | IF(K(IC,5).LT.0) K(IC,5)=0 | |
8543 | 190 CONTINUE | |
8544 | ELSE | |
8545 | DO 200 J=1,4 | |
8546 | P(NJ,J)=0. | |
8547 | 200 CONTINUE | |
8548 | DO 210 IC=N+1,NC | |
8549 | IF(K(IC,5).GE.0) GOTO 210 | |
8550 | P(NJ,1)=P(NJ,1)+P(IC,5)*COS(P(IC,2)) | |
8551 | P(NJ,2)=P(NJ,2)+P(IC,5)*SIN(P(IC,2)) | |
8552 | P(NJ,3)=P(NJ,3)+P(IC,5)*SINH(P(IC,1)) | |
8553 | P(NJ,4)=P(NJ,4)+P(IC,5)*COSH(P(IC,1)) | |
8554 | K(IC,5)=0 | |
8555 | 210 CONTINUE | |
8556 | ENDIF | |
8557 | GOTO 150 | |
8558 | ||
8559 | C...Arrange clusters in falling ET sequence. | |
8560 | 220 DO 250 I=1,NJ-NC | |
8561 | ETMAX=0. | |
8562 | DO 230 IJ=NC+1,NJ | |
8563 | IF(K(IJ,5).EQ.0) GOTO 230 | |
8564 | IF(P(IJ,5).LT.ETMAX) GOTO 230 | |
8565 | IJMAX=IJ | |
8566 | ETMAX=P(IJ,5) | |
8567 | 230 CONTINUE | |
8568 | K(IJMAX,5)=0 | |
8569 | K(N+I,1)=31 | |
8570 | K(N+I,2)=98 | |
8571 | K(N+I,3)=I | |
8572 | K(N+I,4)=K(IJMAX,4) | |
8573 | K(N+I,5)=0 | |
8574 | DO 240 J=1,5 | |
8575 | P(N+I,J)=P(IJMAX,J) | |
8576 | V(N+I,J)=0. | |
8577 | 240 CONTINUE | |
8578 | 250 CONTINUE | |
8579 | NJET=NJ-NC | |
8580 | ||
8581 | C...Convert to massless or massive four-vectors. | |
8582 | IF(MSTU(54).EQ.2) THEN | |
8583 | DO 260 I=N+1,N+NJET | |
8584 | ETA=P(I,3) | |
8585 | P(I,1)=P(I,5)*COS(P(I,4)) | |
8586 | P(I,2)=P(I,5)*SIN(P(I,4)) | |
8587 | P(I,3)=P(I,5)*SINH(ETA) | |
8588 | P(I,4)=P(I,5)*COSH(ETA) | |
8589 | P(I,5)=0. | |
8590 | 260 CONTINUE | |
8591 | ELSEIF(MSTU(54).GE.3) THEN | |
8592 | DO 270 I=N+1,N+NJET | |
8593 | P(I,5)=SQRT(MAX(0.,P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2)) | |
8594 | 270 CONTINUE | |
8595 | ENDIF | |
8596 | ||
8597 | C...Information about storage. | |
8598 | MSTU(61)=N+1 | |
8599 | MSTU(62)=NP | |
8600 | MSTU(63)=NC-N | |
8601 | IF(MSTU(43).LE.1) MSTU(3)=NJET | |
8602 | IF(MSTU(43).GE.2) N=N+NJET | |
8603 | ||
8604 | RETURN | |
8605 | END | |
8606 | ||
8607 | C********************************************************************* | |
8608 | ||
8609 | SUBROUTINE LYJMAS(PMH,PML) | |
8610 | ||
8611 | C...Purpose: to determine, approximately, the two jet masses that | |
8612 | C...minimize the sum m_H^2 + m_L^2, a la Clavelli and Wyler. | |
8613 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
8614 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
8615 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
8616 | SAVE /LYJETS/,/LYDAT1/,/LYDAT2/ | |
8617 | DIMENSION SM(3,3),SAX(3),PS(3,5) | |
8618 | ||
8619 | C...Reset. | |
8620 | NP=0 | |
8621 | DO 120 J1=1,3 | |
8622 | DO 100 J2=J1,3 | |
8623 | SM(J1,J2)=0. | |
8624 | 100 CONTINUE | |
8625 | DO 110 J2=1,4 | |
8626 | PS(J1,J2)=0. | |
8627 | 110 CONTINUE | |
8628 | 120 CONTINUE | |
8629 | PSS=0. | |
8630 | ||
8631 | C...Take copy of particles that are to be considered in mass analysis. | |
8632 | DO 170 I=1,N | |
8633 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 170 | |
8634 | IF(MSTU(41).GE.2) THEN | |
8635 | KC=LYCOMP(K(I,2)) | |
8636 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. | |
8637 | & KC.EQ.18) GOTO 170 | |
8638 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LYCHGE(K(I,2)).EQ.0) | |
8639 | & GOTO 170 | |
8640 | ENDIF | |
8641 | IF(N+NP+1.GE.MSTU(4)-MSTU(32)-5) THEN | |
8642 | CALL LYERRM(11,'(LYJMAS:) no more memory left in LUJETS') | |
8643 | PMH=-2. | |
8644 | PML=-2. | |
8645 | RETURN | |
8646 | ENDIF | |
8647 | NP=NP+1 | |
8648 | DO 130 J=1,5 | |
8649 | P(N+NP,J)=P(I,J) | |
8650 | 130 CONTINUE | |
8651 | IF(MSTU(42).EQ.0) P(N+NP,5)=0. | |
8652 | IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) P(N+NP,5)=PMAS(101,1) | |
8653 | P(N+NP,4)=SQRT(P(N+NP,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
8654 | ||
8655 | C...Fill information in sphericity tensor and total momentum vector. | |
8656 | DO 150 J1=1,3 | |
8657 | DO 140 J2=J1,3 | |
8658 | SM(J1,J2)=SM(J1,J2)+P(I,J1)*P(I,J2) | |
8659 | 140 CONTINUE | |
8660 | 150 CONTINUE | |
8661 | PSS=PSS+(P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
8662 | DO 160 J=1,4 | |
8663 | PS(3,J)=PS(3,J)+P(N+NP,J) | |
8664 | 160 CONTINUE | |
8665 | 170 CONTINUE | |
8666 | ||
8667 | C...Very low multiplicities (0 or 1) not considered. | |
8668 | IF(NP.LE.1) THEN | |
8669 | CALL LYERRM(8,'(LYJMAS:) too few particles for analysis') | |
8670 | PMH=-1. | |
8671 | PML=-1. | |
8672 | RETURN | |
8673 | ENDIF | |
8674 | PARU(61)=SQRT(MAX(0.,PS(3,4)**2-PS(3,1)**2-PS(3,2)**2-PS(3,3)**2)) | |
8675 | ||
8676 | C...Find largest eigenvalue to matrix (third degree equation). | |
8677 | DO 190 J1=1,3 | |
8678 | DO 180 J2=J1,3 | |
8679 | SM(J1,J2)=SM(J1,J2)/PSS | |
8680 | 180 CONTINUE | |
8681 | 190 CONTINUE | |
8682 | SQ=(SM(1,1)*SM(2,2)+SM(1,1)*SM(3,3)+SM(2,2)*SM(3,3)-SM(1,2)**2- | |
8683 | &SM(1,3)**2-SM(2,3)**2)/3.-1./9. | |
8684 | SR=-0.5*(SQ+1./9.+SM(1,1)*SM(2,3)**2+SM(2,2)*SM(1,3)**2+SM(3,3)* | |
8685 | &SM(1,2)**2-SM(1,1)*SM(2,2)*SM(3,3))+SM(1,2)*SM(1,3)*SM(2,3)+1./27. | |
8686 | SP=COS(ACOS(MAX(MIN(SR/SQRT(-SQ**3),1.),-1.))/3.) | |
8687 | SMA=1./3.+SQRT(-SQ)*MAX(2.*SP,SQRT(3.*(1.-SP**2))-SP) | |
8688 | ||
8689 | C...Find largest eigenvector by solving equation system. | |
8690 | DO 210 J1=1,3 | |
8691 | SM(J1,J1)=SM(J1,J1)-SMA | |
8692 | DO 200 J2=J1+1,3 | |
8693 | SM(J2,J1)=SM(J1,J2) | |
8694 | 200 CONTINUE | |
8695 | 210 CONTINUE | |
8696 | SMAX=0. | |
8697 | DO 230 J1=1,3 | |
8698 | DO 220 J2=1,3 | |
8699 | IF(ABS(SM(J1,J2)).LE.SMAX) GOTO 220 | |
8700 | JA=J1 | |
8701 | JB=J2 | |
8702 | SMAX=ABS(SM(J1,J2)) | |
8703 | 220 CONTINUE | |
8704 | 230 CONTINUE | |
8705 | SMAX=0. | |
8706 | DO 250 J3=JA+1,JA+2 | |
8707 | J1=J3-3*((J3-1)/3) | |
8708 | RL=SM(J1,JB)/SM(JA,JB) | |
8709 | DO 240 J2=1,3 | |
8710 | SM(J1,J2)=SM(J1,J2)-RL*SM(JA,J2) | |
8711 | IF(ABS(SM(J1,J2)).LE.SMAX) GOTO 240 | |
8712 | JC=J1 | |
8713 | SMAX=ABS(SM(J1,J2)) | |
8714 | 240 CONTINUE | |
8715 | 250 CONTINUE | |
8716 | JB1=JB+1-3*(JB/3) | |
8717 | JB2=JB+2-3*((JB+1)/3) | |
8718 | SAX(JB1)=-SM(JC,JB2) | |
8719 | SAX(JB2)=SM(JC,JB1) | |
8720 | SAX(JB)=-(SM(JA,JB1)*SAX(JB1)+SM(JA,JB2)*SAX(JB2))/SM(JA,JB) | |
8721 | ||
8722 | C...Divide particles into two initial clusters by hemisphere. | |
8723 | DO 270 I=N+1,N+NP | |
8724 | PSAX=P(I,1)*SAX(1)+P(I,2)*SAX(2)+P(I,3)*SAX(3) | |
8725 | IS=1 | |
8726 | IF(PSAX.LT.0.) IS=2 | |
8727 | K(I,3)=IS | |
8728 | DO 260 J=1,4 | |
8729 | PS(IS,J)=PS(IS,J)+P(I,J) | |
8730 | 260 CONTINUE | |
8731 | 270 CONTINUE | |
8732 | PMS=MAX(1E-10,PS(1,4)**2-PS(1,1)**2-PS(1,2)**2-PS(1,3)**2)+ | |
8733 | &MAX(1E-10,PS(2,4)**2-PS(2,1)**2-PS(2,2)**2-PS(2,3)**2) | |
8734 | ||
8735 | C...Reassign one particle at a time; find maximum decrease of m^2 sum. | |
8736 | 280 PMD=0. | |
8737 | IM=0 | |
8738 | DO 290 J=1,4 | |
8739 | PS(3,J)=PS(1,J)-PS(2,J) | |
8740 | 290 CONTINUE | |
8741 | DO 300 I=N+1,N+NP | |
8742 | PPS=P(I,4)*PS(3,4)-P(I,1)*PS(3,1)-P(I,2)*PS(3,2)-P(I,3)*PS(3,3) | |
8743 | IF(K(I,3).EQ.1) PMDI=2.*(P(I,5)**2-PPS) | |
8744 | IF(K(I,3).EQ.2) PMDI=2.*(P(I,5)**2+PPS) | |
8745 | IF(PMDI.LT.PMD) THEN | |
8746 | PMD=PMDI | |
8747 | IM=I | |
8748 | ENDIF | |
8749 | 300 CONTINUE | |
8750 | ||
8751 | C...Loop back if significant reduction in sum of m^2. | |
8752 | IF(PMD.LT.-PARU(48)*PMS) THEN | |
8753 | PMS=PMS+PMD | |
8754 | IS=K(IM,3) | |
8755 | DO 310 J=1,4 | |
8756 | PS(IS,J)=PS(IS,J)-P(IM,J) | |
8757 | PS(3-IS,J)=PS(3-IS,J)+P(IM,J) | |
8758 | 310 CONTINUE | |
8759 | K(IM,3)=3-IS | |
8760 | GOTO 280 | |
8761 | ENDIF | |
8762 | ||
8763 | C...Final masses and output. | |
8764 | MSTU(61)=N+1 | |
8765 | MSTU(62)=NP | |
8766 | PS(1,5)=SQRT(MAX(0.,PS(1,4)**2-PS(1,1)**2-PS(1,2)**2-PS(1,3)**2)) | |
8767 | PS(2,5)=SQRT(MAX(0.,PS(2,4)**2-PS(2,1)**2-PS(2,2)**2-PS(2,3)**2)) | |
8768 | PMH=MAX(PS(1,5),PS(2,5)) | |
8769 | PML=MIN(PS(1,5),PS(2,5)) | |
8770 | ||
8771 | RETURN | |
8772 | END | |
8773 | ||
8774 | C********************************************************************* | |
8775 | ||
8776 | SUBROUTINE LYFOWO(H10,H20,H30,H40) | |
8777 | ||
8778 | C...Purpose: to calculate the first few Fox-Wolfram moments. | |
8779 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
8780 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
8781 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
8782 | SAVE /LYJETS/,/LYDAT1/,/LYDAT2/ | |
8783 | ||
8784 | C...Copy momenta for particles and calculate H0. | |
8785 | NP=0 | |
8786 | H0=0. | |
8787 | HD=0. | |
8788 | DO 110 I=1,N | |
8789 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 110 | |
8790 | IF(MSTU(41).GE.2) THEN | |
8791 | KC=LYCOMP(K(I,2)) | |
8792 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. | |
8793 | & KC.EQ.18) GOTO 110 | |
8794 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LYCHGE(K(I,2)).EQ.0) | |
8795 | & GOTO 110 | |
8796 | ENDIF | |
8797 | IF(N+NP.GE.MSTU(4)-MSTU(32)-5) THEN | |
8798 | CALL LYERRM(11,'(LYFOWO:) no more memory left in LUJETS') | |
8799 | H10=-1. | |
8800 | H20=-1. | |
8801 | H30=-1. | |
8802 | H40=-1. | |
8803 | RETURN | |
8804 | ENDIF | |
8805 | NP=NP+1 | |
8806 | DO 100 J=1,3 | |
8807 | P(N+NP,J)=P(I,J) | |
8808 | 100 CONTINUE | |
8809 | P(N+NP,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
8810 | H0=H0+P(N+NP,4) | |
8811 | HD=HD+P(N+NP,4)**2 | |
8812 | 110 CONTINUE | |
8813 | H0=H0**2 | |
8814 | ||
8815 | C...Very low multiplicities (0 or 1) not considered. | |
8816 | IF(NP.LE.1) THEN | |
8817 | CALL LYERRM(8,'(LYFOWO:) too few particles for analysis') | |
8818 | H10=-1. | |
8819 | H20=-1. | |
8820 | H30=-1. | |
8821 | H40=-1. | |
8822 | RETURN | |
8823 | ENDIF | |
8824 | ||
8825 | C...Calculate H1 - H4. | |
8826 | H10=0. | |
8827 | H20=0. | |
8828 | H30=0. | |
8829 | H40=0. | |
8830 | DO 130 I1=N+1,N+NP | |
8831 | DO 120 I2=I1+1,N+NP | |
8832 | CTHE=(P(I1,1)*P(I2,1)+P(I1,2)*P(I2,2)+P(I1,3)*P(I2,3))/ | |
8833 | &(P(I1,4)*P(I2,4)) | |
8834 | H10=H10+P(I1,4)*P(I2,4)*CTHE | |
8835 | H20=H20+P(I1,4)*P(I2,4)*(1.5*CTHE**2-0.5) | |
8836 | H30=H30+P(I1,4)*P(I2,4)*(2.5*CTHE**3-1.5*CTHE) | |
8837 | H40=H40+P(I1,4)*P(I2,4)*(4.375*CTHE**4-3.75*CTHE**2+0.375) | |
8838 | 120 CONTINUE | |
8839 | 130 CONTINUE | |
8840 | ||
8841 | C...Calculate H1/H0 - H4/H0. Output. | |
8842 | MSTU(61)=N+1 | |
8843 | MSTU(62)=NP | |
8844 | H10=(HD+2.*H10)/H0 | |
8845 | H20=(HD+2.*H20)/H0 | |
8846 | H30=(HD+2.*H30)/H0 | |
8847 | H40=(HD+2.*H40)/H0 | |
8848 | ||
8849 | RETURN | |
8850 | END | |
8851 | ||
8852 | C********************************************************************* | |
8853 | ||
8854 | SUBROUTINE LYTABU(MTABU) | |
8855 | ||
8856 | C...Purpose: to evaluate various properties of an event, with | |
8857 | C...statistics accumulated during the course of the run and | |
8858 | C...printed at the end. | |
8859 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
8860 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
8861 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
8862 | COMMON/LYDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) | |
8863 | SAVE /LYJETS/,/LYDAT1/,/LYDAT2/,/LYDAT3/ | |
8864 | DIMENSION KFIS(100,2),NPIS(100,0:10),KFFS(400),NPFS(400,4), | |
8865 | &FEVFM(10,4),FM1FM(3,10,4),FM2FM(3,10,4),FMOMA(4),FMOMS(4), | |
8866 | &FEVEE(50),FE1EC(50),FE2EC(50),FE1EA(25),FE2EA(25), | |
8867 | &KFDM(8),KFDC(200,0:8),NPDC(200) | |
8868 | SAVE NEVIS,NKFIS,KFIS,NPIS,NEVFS,NPRFS,NFIFS,NCHFS,NKFFS, | |
8869 | &KFFS,NPFS,NEVFM,NMUFM,FM1FM,FM2FM,NEVEE,FE1EC,FE2EC,FE1EA, | |
8870 | &FE2EA,NEVDC,NKFDC,NREDC,KFDC,NPDC | |
8871 | CHARACTER CHAU*16,CHIS(2)*12,CHDC(8)*12 | |
8872 | DATA NEVIS/0/,NKFIS/0/,NEVFS/0/,NPRFS/0/,NFIFS/0/,NCHFS/0/, | |
8873 | &NKFFS/0/,NEVFM/0/,NMUFM/0/,FM1FM/120*0./,FM2FM/120*0./, | |
8874 | &NEVEE/0/,FE1EC/50*0./,FE2EC/50*0./,FE1EA/25*0./,FE2EA/25*0./, | |
8875 | &NEVDC/0/,NKFDC/0/,NREDC/0/ | |
8876 | ||
8877 | C...Reset statistics on initial parton state. | |
8878 | IF(MTABU.EQ.10) THEN | |
8879 | NEVIS=0 | |
8880 | NKFIS=0 | |
8881 | ||
8882 | C...Identify and order flavour content of initial state. | |
8883 | ELSEIF(MTABU.EQ.11) THEN | |
8884 | NEVIS=NEVIS+1 | |
8885 | KFM1=2*IABS(MSTU(161)) | |
8886 | IF(MSTU(161).GT.0) KFM1=KFM1-1 | |
8887 | KFM2=2*IABS(MSTU(162)) | |
8888 | IF(MSTU(162).GT.0) KFM2=KFM2-1 | |
8889 | KFMN=MIN(KFM1,KFM2) | |
8890 | KFMX=MAX(KFM1,KFM2) | |
8891 | DO 100 I=1,NKFIS | |
8892 | IF(KFMN.EQ.KFIS(I,1).AND.KFMX.EQ.KFIS(I,2)) THEN | |
8893 | IKFIS=-I | |
8894 | GOTO 110 | |
8895 | ELSEIF(KFMN.LT.KFIS(I,1).OR.(KFMN.EQ.KFIS(I,1).AND. | |
8896 | & KFMX.LT.KFIS(I,2))) THEN | |
8897 | IKFIS=I | |
8898 | GOTO 110 | |
8899 | ENDIF | |
8900 | 100 CONTINUE | |
8901 | IKFIS=NKFIS+1 | |
8902 | 110 IF(IKFIS.LT.0) THEN | |
8903 | IKFIS=-IKFIS | |
8904 | ELSE | |
8905 | IF(NKFIS.GE.100) RETURN | |
8906 | DO 130 I=NKFIS,IKFIS,-1 | |
8907 | KFIS(I+1,1)=KFIS(I,1) | |
8908 | KFIS(I+1,2)=KFIS(I,2) | |
8909 | DO 120 J=0,10 | |
8910 | NPIS(I+1,J)=NPIS(I,J) | |
8911 | 120 CONTINUE | |
8912 | 130 CONTINUE | |
8913 | NKFIS=NKFIS+1 | |
8914 | KFIS(IKFIS,1)=KFMN | |
8915 | KFIS(IKFIS,2)=KFMX | |
8916 | DO 140 J=0,10 | |
8917 | NPIS(IKFIS,J)=0 | |
8918 | 140 CONTINUE | |
8919 | ENDIF | |
8920 | NPIS(IKFIS,0)=NPIS(IKFIS,0)+1 | |
8921 | ||
8922 | C...Count number of partons in initial state. | |
8923 | NP=0 | |
8924 | DO 160 I=1,N | |
8925 | IF(K(I,1).LE.0.OR.K(I,1).GT.12) THEN | |
8926 | ELSEIF(IABS(K(I,2)).GT.80.AND.IABS(K(I,2)).LE.100) THEN | |
8927 | ELSEIF(IABS(K(I,2)).GT.100.AND.MOD(IABS(K(I,2))/10,10).NE.0) | |
8928 | & THEN | |
8929 | ELSE | |
8930 | IM=I | |
8931 | 150 IM=K(IM,3) | |
8932 | IF(IM.LE.0.OR.IM.GT.N) THEN | |
8933 | NP=NP+1 | |
8934 | ELSEIF(K(IM,1).LE.0.OR.K(IM,1).GT.20) THEN | |
8935 | NP=NP+1 | |
8936 | ELSEIF(IABS(K(IM,2)).GT.80.AND.IABS(K(IM,2)).LE.100) THEN | |
8937 | ELSEIF(IABS(K(IM,2)).GT.100.AND.MOD(IABS(K(IM,2))/10,10).NE.0) | |
8938 | & THEN | |
8939 | ELSE | |
8940 | GOTO 150 | |
8941 | ENDIF | |
8942 | ENDIF | |
8943 | 160 CONTINUE | |
8944 | NPCO=MAX(NP,1) | |
8945 | IF(NP.GE.6) NPCO=6 | |
8946 | IF(NP.GE.8) NPCO=7 | |
8947 | IF(NP.GE.11) NPCO=8 | |
8948 | IF(NP.GE.16) NPCO=9 | |
8949 | IF(NP.GE.26) NPCO=10 | |
8950 | NPIS(IKFIS,NPCO)=NPIS(IKFIS,NPCO)+1 | |
8951 | MSTU(62)=NP | |
8952 | ||
8953 | C...Write statistics on initial parton state. | |
8954 | ELSEIF(MTABU.EQ.12) THEN | |
8955 | FAC=1./MAX(1,NEVIS) | |
8956 | WRITE(MSTU(11),5000) NEVIS | |
8957 | DO 170 I=1,NKFIS | |
8958 | KFMN=KFIS(I,1) | |
8959 | IF(KFMN.EQ.0) KFMN=KFIS(I,2) | |
8960 | KFM1=(KFMN+1)/2 | |
8961 | IF(2*KFM1.EQ.KFMN) KFM1=-KFM1 | |
8962 | CALL LYNAME(KFM1,CHAU) | |
8963 | CHIS(1)=CHAU(1:12) | |
8964 | IF(CHAU(13:13).NE.' ') CHIS(1)(12:12)='?' | |
8965 | KFMX=KFIS(I,2) | |
8966 | IF(KFIS(I,1).EQ.0) KFMX=0 | |
8967 | KFM2=(KFMX+1)/2 | |
8968 | IF(2*KFM2.EQ.KFMX) KFM2=-KFM2 | |
8969 | CALL LYNAME(KFM2,CHAU) | |
8970 | CHIS(2)=CHAU(1:12) | |
8971 | IF(CHAU(13:13).NE.' ') CHIS(2)(12:12)='?' | |
8972 | WRITE(MSTU(11),5100) CHIS(1),CHIS(2),FAC*NPIS(I,0), | |
8973 | & (NPIS(I,J)/FLOAT(NPIS(I,0)),J=1,10) | |
8974 | 170 CONTINUE | |
8975 | ||
8976 | C...Copy statistics on initial parton state into /LYJETS/. | |
8977 | ELSEIF(MTABU.EQ.13) THEN | |
8978 | FAC=1./MAX(1,NEVIS) | |
8979 | DO 190 I=1,NKFIS | |
8980 | KFMN=KFIS(I,1) | |
8981 | IF(KFMN.EQ.0) KFMN=KFIS(I,2) | |
8982 | KFM1=(KFMN+1)/2 | |
8983 | IF(2*KFM1.EQ.KFMN) KFM1=-KFM1 | |
8984 | KFMX=KFIS(I,2) | |
8985 | IF(KFIS(I,1).EQ.0) KFMX=0 | |
8986 | KFM2=(KFMX+1)/2 | |
8987 | IF(2*KFM2.EQ.KFMX) KFM2=-KFM2 | |
8988 | K(I,1)=32 | |
8989 | K(I,2)=99 | |
8990 | K(I,3)=KFM1 | |
8991 | K(I,4)=KFM2 | |
8992 | K(I,5)=NPIS(I,0) | |
8993 | DO 180 J=1,5 | |
8994 | P(I,J)=FAC*NPIS(I,J) | |
8995 | V(I,J)=FAC*NPIS(I,J+5) | |
8996 | 180 CONTINUE | |
8997 | 190 CONTINUE | |
8998 | N=NKFIS | |
8999 | DO 200 J=1,5 | |
9000 | K(N+1,J)=0 | |
9001 | P(N+1,J)=0. | |
9002 | V(N+1,J)=0. | |
9003 | 200 CONTINUE | |
9004 | K(N+1,1)=32 | |
9005 | K(N+1,2)=99 | |
9006 | K(N+1,5)=NEVIS | |
9007 | MSTU(3)=1 | |
9008 | ||
9009 | C...Reset statistics on number of particles/partons. | |
9010 | ELSEIF(MTABU.EQ.20) THEN | |
9011 | NEVFS=0 | |
9012 | NPRFS=0 | |
9013 | NFIFS=0 | |
9014 | NCHFS=0 | |
9015 | NKFFS=0 | |
9016 | ||
9017 | C...Identify whether particle/parton is primary or not. | |
9018 | ELSEIF(MTABU.EQ.21) THEN | |
9019 | NEVFS=NEVFS+1 | |
9020 | MSTU(62)=0 | |
9021 | DO 260 I=1,N | |
9022 | IF(K(I,1).LE.0.OR.K(I,1).GT.20.OR.K(I,1).EQ.13) GOTO 260 | |
9023 | MSTU(62)=MSTU(62)+1 | |
9024 | KC=LYCOMP(K(I,2)) | |
9025 | MPRI=0 | |
9026 | IF(K(I,3).LE.0.OR.K(I,3).GT.N) THEN | |
9027 | MPRI=1 | |
9028 | ELSEIF(K(K(I,3),1).LE.0.OR.K(K(I,3),1).GT.20) THEN | |
9029 | MPRI=1 | |
9030 | ELSEIF(K(K(I,3),2).GE.91.AND.K(K(I,3),2).LE.93) THEN | |
9031 | MPRI=1 | |
9032 | ELSEIF(KC.EQ.0) THEN | |
9033 | ELSEIF(K(K(I,3),1).EQ.13) THEN | |
9034 | IM=K(K(I,3),3) | |
9035 | IF(IM.LE.0.OR.IM.GT.N) THEN | |
9036 | MPRI=1 | |
9037 | ELSEIF(K(IM,1).LE.0.OR.K(IM,1).GT.20) THEN | |
9038 | MPRI=1 | |
9039 | ENDIF | |
9040 | ELSEIF(KCHG(KC,2).EQ.0) THEN | |
9041 | KCM=LYCOMP(K(K(I,3),2)) | |
9042 | IF(KCM.NE.0) THEN | |
9043 | IF(KCHG(KCM,2).NE.0) MPRI=1 | |
9044 | ENDIF | |
9045 | ENDIF | |
9046 | IF(KC.NE.0.AND.MPRI.EQ.1) THEN | |
9047 | IF(KCHG(KC,2).EQ.0) NPRFS=NPRFS+1 | |
9048 | ENDIF | |
9049 | IF(K(I,1).LE.10) THEN | |
9050 | NFIFS=NFIFS+1 | |
9051 | IF(LYCHGE(K(I,2)).NE.0) NCHFS=NCHFS+1 | |
9052 | ENDIF | |
9053 | ||
9054 | C...Fill statistics on number of particles/partons in event. | |
9055 | KFA=IABS(K(I,2)) | |
9056 | KFS=3-ISIGN(1,K(I,2))-MPRI | |
9057 | DO 210 IP=1,NKFFS | |
9058 | IF(KFA.EQ.KFFS(IP)) THEN | |
9059 | IKFFS=-IP | |
9060 | GOTO 220 | |
9061 | ELSEIF(KFA.LT.KFFS(IP)) THEN | |
9062 | IKFFS=IP | |
9063 | GOTO 220 | |
9064 | ENDIF | |
9065 | 210 CONTINUE | |
9066 | IKFFS=NKFFS+1 | |
9067 | 220 IF(IKFFS.LT.0) THEN | |
9068 | IKFFS=-IKFFS | |
9069 | ELSE | |
9070 | IF(NKFFS.GE.400) RETURN | |
9071 | DO 240 IP=NKFFS,IKFFS,-1 | |
9072 | KFFS(IP+1)=KFFS(IP) | |
9073 | DO 230 J=1,4 | |
9074 | NPFS(IP+1,J)=NPFS(IP,J) | |
9075 | 230 CONTINUE | |
9076 | 240 CONTINUE | |
9077 | NKFFS=NKFFS+1 | |
9078 | KFFS(IKFFS)=KFA | |
9079 | DO 250 J=1,4 | |
9080 | NPFS(IKFFS,J)=0 | |
9081 | 250 CONTINUE | |
9082 | ENDIF | |
9083 | NPFS(IKFFS,KFS)=NPFS(IKFFS,KFS)+1 | |
9084 | 260 CONTINUE | |
9085 | ||
9086 | C...Write statistics on particle/parton composition of events. | |
9087 | ELSEIF(MTABU.EQ.22) THEN | |
9088 | FAC=1./MAX(1,NEVFS) | |
9089 | WRITE(MSTU(11),5200) NEVFS,FAC*NPRFS,FAC*NFIFS,FAC*NCHFS | |
9090 | DO 270 I=1,NKFFS | |
9091 | CALL LYNAME(KFFS(I),CHAU) | |
9092 | KC=LYCOMP(KFFS(I)) | |
9093 | MDCYF=0 | |
9094 | IF(KC.NE.0) MDCYF=MDCY(KC,1) | |
9095 | WRITE(MSTU(11),5300) KFFS(I),CHAU,MDCYF,(FAC*NPFS(I,J),J=1,4), | |
9096 | & FAC*(NPFS(I,1)+NPFS(I,2)+NPFS(I,3)+NPFS(I,4)) | |
9097 | 270 CONTINUE | |
9098 | ||
9099 | C...Copy particle/parton composition information into /LYJETS/. | |
9100 | ELSEIF(MTABU.EQ.23) THEN | |
9101 | FAC=1./MAX(1,NEVFS) | |
9102 | DO 290 I=1,NKFFS | |
9103 | K(I,1)=32 | |
9104 | K(I,2)=99 | |
9105 | K(I,3)=KFFS(I) | |
9106 | K(I,4)=0 | |
9107 | K(I,5)=NPFS(I,1)+NPFS(I,2)+NPFS(I,3)+NPFS(I,4) | |
9108 | DO 280 J=1,4 | |
9109 | P(I,J)=FAC*NPFS(I,J) | |
9110 | V(I,J)=0. | |
9111 | 280 CONTINUE | |
9112 | P(I,5)=FAC*K(I,5) | |
9113 | V(I,5)=0. | |
9114 | 290 CONTINUE | |
9115 | N=NKFFS | |
9116 | DO 300 J=1,5 | |
9117 | K(N+1,J)=0 | |
9118 | P(N+1,J)=0. | |
9119 | V(N+1,J)=0. | |
9120 | 300 CONTINUE | |
9121 | K(N+1,1)=32 | |
9122 | K(N+1,2)=99 | |
9123 | K(N+1,5)=NEVFS | |
9124 | P(N+1,1)=FAC*NPRFS | |
9125 | P(N+1,2)=FAC*NFIFS | |
9126 | P(N+1,3)=FAC*NCHFS | |
9127 | MSTU(3)=1 | |
9128 | ||
9129 | C...Reset factorial moments statistics. | |
9130 | ELSEIF(MTABU.EQ.30) THEN | |
9131 | NEVFM=0 | |
9132 | NMUFM=0 | |
9133 | DO 330 IM=1,3 | |
9134 | DO 320 IB=1,10 | |
9135 | DO 310 IP=1,4 | |
9136 | FM1FM(IM,IB,IP)=0. | |
9137 | FM2FM(IM,IB,IP)=0. | |
9138 | 310 CONTINUE | |
9139 | 320 CONTINUE | |
9140 | 330 CONTINUE | |
9141 | ||
9142 | C...Find particles to include, with (pion,pseudo)rapidity and azimuth. | |
9143 | ELSEIF(MTABU.EQ.31) THEN | |
9144 | NEVFM=NEVFM+1 | |
9145 | NLOW=N+MSTU(3) | |
9146 | NUPP=NLOW | |
9147 | DO 410 I=1,N | |
9148 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 410 | |
9149 | IF(MSTU(41).GE.2) THEN | |
9150 | KC=LYCOMP(K(I,2)) | |
9151 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. | |
9152 | & KC.EQ.18) GOTO 410 | |
9153 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LYCHGE(K(I,2)).EQ.0) | |
9154 | & GOTO 410 | |
9155 | ENDIF | |
9156 | PMR=0. | |
9157 | IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) PMR=UYMASS(211) | |
9158 | IF(MSTU(42).GE.2) PMR=P(I,5) | |
9159 | PR=MAX(1E-20,PMR**2+P(I,1)**2+P(I,2)**2) | |
9160 | YETA=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/SQRT(PR), | |
9161 | & 1E20)),P(I,3)) | |
9162 | IF(ABS(YETA).GT.PARU(57)) GOTO 410 | |
9163 | PHI=UYANGL(P(I,1),P(I,2)) | |
9164 | IYETA=512.*(YETA+PARU(57))/(2.*PARU(57)) | |
9165 | IYETA=MAX(0,MIN(511,IYETA)) | |
9166 | IPHI=512.*(PHI+PARU(1))/PARU(2) | |
9167 | IPHI=MAX(0,MIN(511,IPHI)) | |
9168 | IYEP=0 | |
9169 | DO 340 IB=0,9 | |
9170 | IYEP=IYEP+4**IB*(2*MOD(IYETA/2**IB,2)+MOD(IPHI/2**IB,2)) | |
9171 | 340 CONTINUE | |
9172 | ||
9173 | C...Order particles in (pseudo)rapidity and/or azimuth. | |
9174 | IF(NUPP.GT.MSTU(4)-5-MSTU(32)) THEN | |
9175 | CALL LYERRM(11,'(LYTABU:) no more memory left in LUJETS') | |
9176 | RETURN | |
9177 | ENDIF | |
9178 | NUPP=NUPP+1 | |
9179 | IF(NUPP.EQ.NLOW+1) THEN | |
9180 | K(NUPP,1)=IYETA | |
9181 | K(NUPP,2)=IPHI | |
9182 | K(NUPP,3)=IYEP | |
9183 | ELSE | |
9184 | DO 350 I1=NUPP-1,NLOW+1,-1 | |
9185 | IF(IYETA.GE.K(I1,1)) GOTO 360 | |
9186 | K(I1+1,1)=K(I1,1) | |
9187 | 350 CONTINUE | |
9188 | 360 K(I1+1,1)=IYETA | |
9189 | DO 370 I1=NUPP-1,NLOW+1,-1 | |
9190 | IF(IPHI.GE.K(I1,2)) GOTO 380 | |
9191 | K(I1+1,2)=K(I1,2) | |
9192 | 370 CONTINUE | |
9193 | 380 K(I1+1,2)=IPHI | |
9194 | DO 390 I1=NUPP-1,NLOW+1,-1 | |
9195 | IF(IYEP.GE.K(I1,3)) GOTO 400 | |
9196 | K(I1+1,3)=K(I1,3) | |
9197 | 390 CONTINUE | |
9198 | 400 K(I1+1,3)=IYEP | |
9199 | ENDIF | |
9200 | 410 CONTINUE | |
9201 | K(NUPP+1,1)=2**10 | |
9202 | K(NUPP+1,2)=2**10 | |
9203 | K(NUPP+1,3)=4**10 | |
9204 | ||
9205 | C...Calculate sum of factorial moments in event. | |
9206 | DO 480 IM=1,3 | |
9207 | DO 430 IB=1,10 | |
9208 | DO 420 IP=1,4 | |
9209 | FEVFM(IB,IP)=0. | |
9210 | 420 CONTINUE | |
9211 | 430 CONTINUE | |
9212 | DO 450 IB=1,10 | |
9213 | IF(IM.LE.2) IBIN=2**(10-IB) | |
9214 | IF(IM.EQ.3) IBIN=4**(10-IB) | |
9215 | IAGR=K(NLOW+1,IM)/IBIN | |
9216 | NAGR=1 | |
9217 | DO 440 I=NLOW+2,NUPP+1 | |
9218 | ICUT=K(I,IM)/IBIN | |
9219 | IF(ICUT.EQ.IAGR) THEN | |
9220 | NAGR=NAGR+1 | |
9221 | ELSE | |
9222 | IF(NAGR.EQ.1) THEN | |
9223 | ELSEIF(NAGR.EQ.2) THEN | |
9224 | FEVFM(IB,1)=FEVFM(IB,1)+2. | |
9225 | ELSEIF(NAGR.EQ.3) THEN | |
9226 | FEVFM(IB,1)=FEVFM(IB,1)+6. | |
9227 | FEVFM(IB,2)=FEVFM(IB,2)+6. | |
9228 | ELSEIF(NAGR.EQ.4) THEN | |
9229 | FEVFM(IB,1)=FEVFM(IB,1)+12. | |
9230 | FEVFM(IB,2)=FEVFM(IB,2)+24. | |
9231 | FEVFM(IB,3)=FEVFM(IB,3)+24. | |
9232 | ELSE | |
9233 | FEVFM(IB,1)=FEVFM(IB,1)+NAGR*(NAGR-1.) | |
9234 | FEVFM(IB,2)=FEVFM(IB,2)+NAGR*(NAGR-1.)*(NAGR-2.) | |
9235 | FEVFM(IB,3)=FEVFM(IB,3)+NAGR*(NAGR-1.)*(NAGR-2.)*(NAGR-3.) | |
9236 | FEVFM(IB,4)=FEVFM(IB,4)+NAGR*(NAGR-1.)*(NAGR-2.)*(NAGR-3.)* | |
9237 | & (NAGR-4.) | |
9238 | ENDIF | |
9239 | IAGR=ICUT | |
9240 | NAGR=1 | |
9241 | ENDIF | |
9242 | 440 CONTINUE | |
9243 | 450 CONTINUE | |
9244 | ||
9245 | C...Add results to total statistics. | |
9246 | DO 470 IB=10,1,-1 | |
9247 | DO 460 IP=1,4 | |
9248 | IF(FEVFM(1,IP).LT.0.5) THEN | |
9249 | FEVFM(IB,IP)=0. | |
9250 | ELSEIF(IM.LE.2) THEN | |
9251 | FEVFM(IB,IP)=2.**((IB-1)*IP)*FEVFM(IB,IP)/FEVFM(1,IP) | |
9252 | ELSE | |
9253 | FEVFM(IB,IP)=4.**((IB-1)*IP)*FEVFM(IB,IP)/FEVFM(1,IP) | |
9254 | ENDIF | |
9255 | FM1FM(IM,IB,IP)=FM1FM(IM,IB,IP)+FEVFM(IB,IP) | |
9256 | FM2FM(IM,IB,IP)=FM2FM(IM,IB,IP)+FEVFM(IB,IP)**2 | |
9257 | 460 CONTINUE | |
9258 | 470 CONTINUE | |
9259 | 480 CONTINUE | |
9260 | NMUFM=NMUFM+(NUPP-NLOW) | |
9261 | MSTU(62)=NUPP-NLOW | |
9262 | ||
9263 | C...Write accumulated statistics on factorial moments. | |
9264 | ELSEIF(MTABU.EQ.32) THEN | |
9265 | FAC=1./MAX(1,NEVFM) | |
9266 | IF(MSTU(42).LE.0) WRITE(MSTU(11),5400) NEVFM,'eta' | |
9267 | IF(MSTU(42).EQ.1) WRITE(MSTU(11),5400) NEVFM,'ypi' | |
9268 | IF(MSTU(42).GE.2) WRITE(MSTU(11),5400) NEVFM,'y ' | |
9269 | DO 510 IM=1,3 | |
9270 | WRITE(MSTU(11),5500) | |
9271 | DO 500 IB=1,10 | |
9272 | BYETA=2.*PARU(57) | |
9273 | IF(IM.NE.2) BYETA=BYETA/2**(IB-1) | |
9274 | BPHI=PARU(2) | |
9275 | IF(IM.NE.1) BPHI=BPHI/2**(IB-1) | |
9276 | IF(IM.LE.2) BNAVE=FAC*NMUFM/FLOAT(2**(IB-1)) | |
9277 | IF(IM.EQ.3) BNAVE=FAC*NMUFM/FLOAT(4**(IB-1)) | |
9278 | DO 490 IP=1,4 | |
9279 | FMOMA(IP)=FAC*FM1FM(IM,IB,IP) | |
9280 | FMOMS(IP)=SQRT(MAX(0.,FAC*(FAC*FM2FM(IM,IB,IP)-FMOMA(IP)**2))) | |
9281 | 490 CONTINUE | |
9282 | WRITE(MSTU(11),5600) BYETA,BPHI,BNAVE,(FMOMA(IP),FMOMS(IP), | |
9283 | & IP=1,4) | |
9284 | 500 CONTINUE | |
9285 | 510 CONTINUE | |
9286 | ||
9287 | C...Copy statistics on factorial moments into /LYJETS/. | |
9288 | ELSEIF(MTABU.EQ.33) THEN | |
9289 | FAC=1./MAX(1,NEVFM) | |
9290 | DO 540 IM=1,3 | |
9291 | DO 530 IB=1,10 | |
9292 | I=10*(IM-1)+IB | |
9293 | K(I,1)=32 | |
9294 | K(I,2)=99 | |
9295 | K(I,3)=1 | |
9296 | IF(IM.NE.2) K(I,3)=2**(IB-1) | |
9297 | K(I,4)=1 | |
9298 | IF(IM.NE.1) K(I,4)=2**(IB-1) | |
9299 | K(I,5)=0 | |
9300 | P(I,1)=2.*PARU(57)/K(I,3) | |
9301 | V(I,1)=PARU(2)/K(I,4) | |
9302 | DO 520 IP=1,4 | |
9303 | P(I,IP+1)=FAC*FM1FM(IM,IB,IP) | |
9304 | V(I,IP+1)=SQRT(MAX(0.,FAC*(FAC*FM2FM(IM,IB,IP)-P(I,IP+1)**2))) | |
9305 | 520 CONTINUE | |
9306 | 530 CONTINUE | |
9307 | 540 CONTINUE | |
9308 | N=30 | |
9309 | DO 550 J=1,5 | |
9310 | K(N+1,J)=0 | |
9311 | P(N+1,J)=0. | |
9312 | V(N+1,J)=0. | |
9313 | 550 CONTINUE | |
9314 | K(N+1,1)=32 | |
9315 | K(N+1,2)=99 | |
9316 | K(N+1,5)=NEVFM | |
9317 | MSTU(3)=1 | |
9318 | ||
9319 | C...Reset statistics on Energy-Energy Correlation. | |
9320 | ELSEIF(MTABU.EQ.40) THEN | |
9321 | NEVEE=0 | |
9322 | DO 560 J=1,25 | |
9323 | FE1EC(J)=0. | |
9324 | FE2EC(J)=0. | |
9325 | FE1EC(51-J)=0. | |
9326 | FE2EC(51-J)=0. | |
9327 | FE1EA(J)=0. | |
9328 | FE2EA(J)=0. | |
9329 | 560 CONTINUE | |
9330 | ||
9331 | C...Find particles to include, with proper assumed mass. | |
9332 | ELSEIF(MTABU.EQ.41) THEN | |
9333 | NEVEE=NEVEE+1 | |
9334 | NLOW=N+MSTU(3) | |
9335 | NUPP=NLOW | |
9336 | ECM=0. | |
9337 | DO 570 I=1,N | |
9338 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 570 | |
9339 | IF(MSTU(41).GE.2) THEN | |
9340 | KC=LYCOMP(K(I,2)) | |
9341 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. | |
9342 | & KC.EQ.18) GOTO 570 | |
9343 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LYCHGE(K(I,2)).EQ.0) | |
9344 | & GOTO 570 | |
9345 | ENDIF | |
9346 | PMR=0. | |
9347 | IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) PMR=UYMASS(211) | |
9348 | IF(MSTU(42).GE.2) PMR=P(I,5) | |
9349 | IF(NUPP.GT.MSTU(4)-5-MSTU(32)) THEN | |
9350 | CALL LYERRM(11,'(LYTABU:) no more memory left in LUJETS') | |
9351 | RETURN | |
9352 | ENDIF | |
9353 | NUPP=NUPP+1 | |
9354 | P(NUPP,1)=P(I,1) | |
9355 | P(NUPP,2)=P(I,2) | |
9356 | P(NUPP,3)=P(I,3) | |
9357 | P(NUPP,4)=SQRT(PMR**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
9358 | P(NUPP,5)=MAX(1E-10,SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)) | |
9359 | ECM=ECM+P(NUPP,4) | |
9360 | 570 CONTINUE | |
9361 | IF(NUPP.EQ.NLOW) RETURN | |
9362 | ||
9363 | C...Analyze Energy-Energy Correlation in event. | |
9364 | FAC=(2./ECM**2)*50./PARU(1) | |
9365 | DO 580 J=1,50 | |
9366 | FEVEE(J)=0. | |
9367 | 580 CONTINUE | |
9368 | DO 600 I1=NLOW+2,NUPP | |
9369 | DO 590 I2=NLOW+1,I1-1 | |
9370 | CTHE=(P(I1,1)*P(I2,1)+P(I1,2)*P(I2,2)+P(I1,3)*P(I2,3))/ | |
9371 | & (P(I1,5)*P(I2,5)) | |
9372 | THE=ACOS(MAX(-1.,MIN(1.,CTHE))) | |
9373 | ITHE=MAX(1,MIN(50,1+INT(50.*THE/PARU(1)))) | |
9374 | FEVEE(ITHE)=FEVEE(ITHE)+FAC*P(I1,4)*P(I2,4) | |
9375 | 590 CONTINUE | |
9376 | 600 CONTINUE | |
9377 | DO 610 J=1,25 | |
9378 | FE1EC(J)=FE1EC(J)+FEVEE(J) | |
9379 | FE2EC(J)=FE2EC(J)+FEVEE(J)**2 | |
9380 | FE1EC(51-J)=FE1EC(51-J)+FEVEE(51-J) | |
9381 | FE2EC(51-J)=FE2EC(51-J)+FEVEE(51-J)**2 | |
9382 | FE1EA(J)=FE1EA(J)+(FEVEE(51-J)-FEVEE(J)) | |
9383 | FE2EA(J)=FE2EA(J)+(FEVEE(51-J)-FEVEE(J))**2 | |
9384 | 610 CONTINUE | |
9385 | MSTU(62)=NUPP-NLOW | |
9386 | ||
9387 | C...Write statistics on Energy-Energy Correlation. | |
9388 | ELSEIF(MTABU.EQ.42) THEN | |
9389 | FAC=1./MAX(1,NEVEE) | |
9390 | WRITE(MSTU(11),5700) NEVEE | |
9391 | DO 620 J=1,25 | |
9392 | FEEC1=FAC*FE1EC(J) | |
9393 | FEES1=SQRT(MAX(0.,FAC*(FAC*FE2EC(J)-FEEC1**2))) | |
9394 | FEEC2=FAC*FE1EC(51-J) | |
9395 | FEES2=SQRT(MAX(0.,FAC*(FAC*FE2EC(51-J)-FEEC2**2))) | |
9396 | FEECA=FAC*FE1EA(J) | |
9397 | FEESA=SQRT(MAX(0.,FAC*(FAC*FE2EA(J)-FEECA**2))) | |
9398 | WRITE(MSTU(11),5800) 3.6*(J-1),3.6*J,FEEC1,FEES1,FEEC2,FEES2, | |
9399 | & FEECA,FEESA | |
9400 | 620 CONTINUE | |
9401 | ||
9402 | C...Copy statistics on Energy-Energy Correlation into /LYJETS/. | |
9403 | ELSEIF(MTABU.EQ.43) THEN | |
9404 | FAC=1./MAX(1,NEVEE) | |
9405 | DO 630 I=1,25 | |
9406 | K(I,1)=32 | |
9407 | K(I,2)=99 | |
9408 | K(I,3)=0 | |
9409 | K(I,4)=0 | |
9410 | K(I,5)=0 | |
9411 | P(I,1)=FAC*FE1EC(I) | |
9412 | V(I,1)=SQRT(MAX(0.,FAC*(FAC*FE2EC(I)-P(I,1)**2))) | |
9413 | P(I,2)=FAC*FE1EC(51-I) | |
9414 | V(I,2)=SQRT(MAX(0.,FAC*(FAC*FE2EC(51-I)-P(I,2)**2))) | |
9415 | P(I,3)=FAC*FE1EA(I) | |
9416 | V(I,3)=SQRT(MAX(0.,FAC*(FAC*FE2EA(I)-P(I,3)**2))) | |
9417 | P(I,4)=PARU(1)*(I-1)/50. | |
9418 | P(I,5)=PARU(1)*I/50. | |
9419 | V(I,4)=3.6*(I-1) | |
9420 | V(I,5)=3.6*I | |
9421 | 630 CONTINUE | |
9422 | N=25 | |
9423 | DO 640 J=1,5 | |
9424 | K(N+1,J)=0 | |
9425 | P(N+1,J)=0. | |
9426 | V(N+1,J)=0. | |
9427 | 640 CONTINUE | |
9428 | K(N+1,1)=32 | |
9429 | K(N+1,2)=99 | |
9430 | K(N+1,5)=NEVEE | |
9431 | MSTU(3)=1 | |
9432 | ||
9433 | C...Reset statistics on decay channels. | |
9434 | ELSEIF(MTABU.EQ.50) THEN | |
9435 | NEVDC=0 | |
9436 | NKFDC=0 | |
9437 | NREDC=0 | |
9438 | ||
9439 | C...Identify and order flavour content of final state. | |
9440 | ELSEIF(MTABU.EQ.51) THEN | |
9441 | NEVDC=NEVDC+1 | |
9442 | NDS=0 | |
9443 | DO 670 I=1,N | |
9444 | IF(K(I,1).LE.0.OR.K(I,1).GE.6) GOTO 670 | |
9445 | NDS=NDS+1 | |
9446 | IF(NDS.GT.8) THEN | |
9447 | NREDC=NREDC+1 | |
9448 | RETURN | |
9449 | ENDIF | |
9450 | KFM=2*IABS(K(I,2)) | |
9451 | IF(K(I,2).LT.0) KFM=KFM-1 | |
9452 | DO 650 IDS=NDS-1,1,-1 | |
9453 | IIN=IDS+1 | |
9454 | IF(KFM.LT.KFDM(IDS)) GOTO 660 | |
9455 | KFDM(IDS+1)=KFDM(IDS) | |
9456 | 650 CONTINUE | |
9457 | IIN=1 | |
9458 | 660 KFDM(IIN)=KFM | |
9459 | 670 CONTINUE | |
9460 | ||
9461 | C...Find whether old or new final state. | |
9462 | DO 690 IDC=1,NKFDC | |
9463 | IF(NDS.LT.KFDC(IDC,0)) THEN | |
9464 | IKFDC=IDC | |
9465 | GOTO 700 | |
9466 | ELSEIF(NDS.EQ.KFDC(IDC,0)) THEN | |
9467 | DO 680 I=1,NDS | |
9468 | IF(KFDM(I).LT.KFDC(IDC,I)) THEN | |
9469 | IKFDC=IDC | |
9470 | GOTO 700 | |
9471 | ELSEIF(KFDM(I).GT.KFDC(IDC,I)) THEN | |
9472 | GOTO 690 | |
9473 | ENDIF | |
9474 | 680 CONTINUE | |
9475 | IKFDC=-IDC | |
9476 | GOTO 700 | |
9477 | ENDIF | |
9478 | 690 CONTINUE | |
9479 | IKFDC=NKFDC+1 | |
9480 | 700 IF(IKFDC.LT.0) THEN | |
9481 | IKFDC=-IKFDC | |
9482 | ELSEIF(NKFDC.GE.200) THEN | |
9483 | NREDC=NREDC+1 | |
9484 | RETURN | |
9485 | ELSE | |
9486 | DO 720 IDC=NKFDC,IKFDC,-1 | |
9487 | NPDC(IDC+1)=NPDC(IDC) | |
9488 | DO 710 I=0,8 | |
9489 | KFDC(IDC+1,I)=KFDC(IDC,I) | |
9490 | 710 CONTINUE | |
9491 | 720 CONTINUE | |
9492 | NKFDC=NKFDC+1 | |
9493 | KFDC(IKFDC,0)=NDS | |
9494 | DO 730 I=1,NDS | |
9495 | KFDC(IKFDC,I)=KFDM(I) | |
9496 | 730 CONTINUE | |
9497 | NPDC(IKFDC)=0 | |
9498 | ENDIF | |
9499 | NPDC(IKFDC)=NPDC(IKFDC)+1 | |
9500 | ||
9501 | C...Write statistics on decay channels. | |
9502 | ELSEIF(MTABU.EQ.52) THEN | |
9503 | FAC=1./MAX(1,NEVDC) | |
9504 | WRITE(MSTU(11),5900) NEVDC | |
9505 | DO 750 IDC=1,NKFDC | |
9506 | DO 740 I=1,KFDC(IDC,0) | |
9507 | KFM=KFDC(IDC,I) | |
9508 | KF=(KFM+1)/2 | |
9509 | IF(2*KF.NE.KFM) KF=-KF | |
9510 | CALL LYNAME(KF,CHAU) | |
9511 | CHDC(I)=CHAU(1:12) | |
9512 | IF(CHAU(13:13).NE.' ') CHDC(I)(12:12)='?' | |
9513 | 740 CONTINUE | |
9514 | WRITE(MSTU(11),6000) FAC*NPDC(IDC),(CHDC(I),I=1,KFDC(IDC,0)) | |
9515 | 750 CONTINUE | |
9516 | IF(NREDC.NE.0) WRITE(MSTU(11),6100) FAC*NREDC | |
9517 | ||
9518 | C...Copy statistics on decay channels into /LYJETS/. | |
9519 | ELSEIF(MTABU.EQ.53) THEN | |
9520 | FAC=1./MAX(1,NEVDC) | |
9521 | DO 780 IDC=1,NKFDC | |
9522 | K(IDC,1)=32 | |
9523 | K(IDC,2)=99 | |
9524 | K(IDC,3)=0 | |
9525 | K(IDC,4)=0 | |
9526 | K(IDC,5)=KFDC(IDC,0) | |
9527 | DO 760 J=1,5 | |
9528 | P(IDC,J)=0. | |
9529 | V(IDC,J)=0. | |
9530 | 760 CONTINUE | |
9531 | DO 770 I=1,KFDC(IDC,0) | |
9532 | KFM=KFDC(IDC,I) | |
9533 | KF=(KFM+1)/2 | |
9534 | IF(2*KF.NE.KFM) KF=-KF | |
9535 | IF(I.LE.5) P(IDC,I)=KF | |
9536 | IF(I.GE.6) V(IDC,I-5)=KF | |
9537 | 770 CONTINUE | |
9538 | V(IDC,5)=FAC*NPDC(IDC) | |
9539 | 780 CONTINUE | |
9540 | N=NKFDC | |
9541 | DO 790 J=1,5 | |
9542 | K(N+1,J)=0 | |
9543 | P(N+1,J)=0. | |
9544 | V(N+1,J)=0. | |
9545 | 790 CONTINUE | |
9546 | K(N+1,1)=32 | |
9547 | K(N+1,2)=99 | |
9548 | K(N+1,5)=NEVDC | |
9549 | V(N+1,5)=FAC*NREDC | |
9550 | MSTU(3)=1 | |
9551 | ENDIF | |
9552 | ||
9553 | C...Format statements for output on unit MSTU(11) (default 6). | |
9554 | 5000 FORMAT(///20X,'Event statistics - initial state'/ | |
9555 | &20X,'based on an analysis of ',I6,' events'// | |
9556 | &3X,'Main flavours after',8X,'Fraction',4X,'Subfractions ', | |
9557 | &'according to fragmenting system multiplicity'/ | |
9558 | &4X,'hard interaction',24X,'1',7X,'2',7X,'3',7X,'4',7X,'5', | |
9559 | &6X,'6-7',5X,'8-10',3X,'11-15',3X,'16-25',4X,'>25'/) | |
9560 | 5100 FORMAT(3X,A12,1X,A12,F10.5,1X,10F8.4) | |
9561 | 5200 FORMAT(///20X,'Event statistics - final state'/ | |
9562 | &20X,'based on an analysis of ',I7,' events'// | |
9563 | &5X,'Mean primary multiplicity =',F10.4/ | |
9564 | &5X,'Mean final multiplicity =',F10.4/ | |
9565 | &5X,'Mean charged multiplicity =',F10.4// | |
9566 | &5X,'Number of particles produced per event (directly and via ', | |
9567 | &'decays/branchings)'/ | |
9568 | &5X,'KF Particle/jet MDCY',10X,'Particles',13X,'Antiparticles', | |
9569 | &8X,'Total'/35X,'prim seco prim seco'/) | |
9570 | 5300 FORMAT(1X,I6,4X,A16,I2,5(1X,F11.6)) | |
9571 | 5400 FORMAT(///20X,'Factorial moments analysis of multiplicity'/ | |
9572 | &20X,'based on an analysis of ',I6,' events'// | |
9573 | &3X,'delta-',A3,' delta-phi <n>/bin',10X,'<F2>',18X,'<F3>', | |
9574 | &18X,'<F4>',18X,'<F5>'/35X,4(' value error ')) | |
9575 | 5500 FORMAT(10X) | |
9576 | 5600 FORMAT(2X,2F10.4,F12.4,4(F12.4,F10.4)) | |
9577 | 5700 FORMAT(///20X,'Energy-Energy Correlation and Asymmetry'/ | |
9578 | &20X,'based on an analysis of ',I6,' events'// | |
9579 | &2X,'theta range',8X,'EEC(theta)',8X,'EEC(180-theta)',7X, | |
9580 | &'EECA(theta)'/2X,'in degrees ',3(' value error')/) | |
9581 | 5800 FORMAT(2X,F4.1,' - ',F4.1,3(F11.4,F9.4)) | |
9582 | 5900 FORMAT(///20X,'Decay channel analysis - final state'/ | |
9583 | &20X,'based on an analysis of ',I6,' events'// | |
9584 | &2X,'Probability',10X,'Complete final state'/) | |
9585 | 6000 FORMAT(2X,F9.5,5X,8(A12,1X)) | |
9586 | 6100 FORMAT(2X,F9.5,5X,'into other channels (more than 8 particles ', | |
9587 | &'or table overflow)') | |
9588 | ||
9589 | RETURN | |
9590 | END | |
9591 | ||
9592 | C********************************************************************* | |
9593 | ||
9594 | SUBROUTINE LYEEVT(KFL,ECM) | |
9595 | ||
9596 | C...Purpose: to handle the generation of an e+e- annihilation jet event. | |
9597 | IMPLICIT DOUBLE PRECISION(D) | |
9598 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
9599 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
9600 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
9601 | SAVE /LYJETS/,/LYDAT1/,/LYDAT2/ | |
9602 | ||
9603 | C...Check input parameters. | |
9604 | IF(MSTU(12).GE.1) CALL LYLIST(0) | |
9605 | IF(KFL.LT.0.OR.KFL.GT.8) THEN | |
9606 | CALL LYERRM(16,'(LYEEVT:) called with unknown flavour code') | |
9607 | IF(MSTU(21).GE.1) RETURN | |
9608 | ENDIF | |
9609 | IF(KFL.LE.5) ECMMIN=PARJ(127)+2.02*PARF(100+MAX(1,KFL)) | |
9610 | IF(KFL.GE.6) ECMMIN=PARJ(127)+2.02*PMAS(KFL,1) | |
9611 | IF(ECM.LT.ECMMIN) THEN | |
9612 | CALL LYERRM(16,'(LYEEVT:) called with too small CM energy') | |
9613 | IF(MSTU(21).GE.1) RETURN | |
9614 | ENDIF | |
9615 | ||
9616 | C...Check consistency of MSTJ options set. | |
9617 | IF(MSTJ(109).EQ.2.AND.MSTJ(110).NE.1) THEN | |
9618 | CALL LYERRM(6, | |
9619 | & '(LYEEVT:) MSTJ(109) value requires MSTJ(110) = 1') | |
9620 | MSTJ(110)=1 | |
9621 | ENDIF | |
9622 | IF(MSTJ(109).EQ.2.AND.MSTJ(111).NE.0) THEN | |
9623 | CALL LYERRM(6, | |
9624 | & '(LYEEVT:) MSTJ(109) value requires MSTJ(111) = 0') | |
9625 | MSTJ(111)=0 | |
9626 | ENDIF | |
9627 | ||
9628 | C...Initialize alpha_strong and total cross-section. | |
9629 | MSTU(111)=MSTJ(108) | |
9630 | IF(MSTJ(108).EQ.2.AND.(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.1)) | |
9631 | &MSTU(111)=1 | |
9632 | PARU(112)=PARJ(121) | |
9633 | IF(MSTU(111).EQ.2) PARU(112)=PARJ(122) | |
9634 | IF(MSTJ(116).GT.0.AND.(MSTJ(116).GE.2.OR.ABS(ECM-PARJ(151)).GE. | |
9635 | &PARJ(139).OR.10*MSTJ(102)+KFL.NE.MSTJ(119))) CALL LYXTOT(KFL,ECM, | |
9636 | &XTOT) | |
9637 | IF(MSTJ(116).GE.3) MSTJ(116)=1 | |
9638 | PARJ(171)=0. | |
9639 | ||
9640 | C...Add initial e+e- to event record (documentation only). | |
9641 | NTRY=0 | |
9642 | 100 NTRY=NTRY+1 | |
9643 | IF(NTRY.GT.100) THEN | |
9644 | CALL LYERRM(14,'(LYEEVT:) caught in an infinite loop') | |
9645 | RETURN | |
9646 | ENDIF | |
9647 | MSTU(24)=0 | |
9648 | NC=0 | |
9649 | IF(MSTJ(115).GE.2) THEN | |
9650 | NC=NC+2 | |
9651 | CALL LY1ENT(NC-1,11,0.5*ECM,0.,0.) | |
9652 | K(NC-1,1)=21 | |
9653 | CALL LY1ENT(NC,-11,0.5*ECM,PARU(1),0.) | |
9654 | K(NC,1)=21 | |
9655 | ENDIF | |
9656 | ||
9657 | C...Radiative photon (in initial state). | |
9658 | MK=0 | |
9659 | ECMC=ECM | |
9660 | IF(MSTJ(107).GE.1.AND.MSTJ(116).GE.1) CALL LYRADK(ECM,MK,PAK, | |
9661 | &THEK,PHIK,ALPK) | |
9662 | IF(MK.EQ.1) ECMC=SQRT(ECM*(ECM-2.*PAK)) | |
9663 | IF(MSTJ(115).GE.1.AND.MK.EQ.1) THEN | |
9664 | NC=NC+1 | |
9665 | CALL LY1ENT(NC,22,PAK,THEK,PHIK) | |
9666 | K(NC,3)=MIN(MSTJ(115)/2,1) | |
9667 | ENDIF | |
9668 | ||
9669 | C...Virtual exchange boson (gamma or Z0). | |
9670 | IF(MSTJ(115).GE.3) THEN | |
9671 | NC=NC+1 | |
9672 | KF=22 | |
9673 | IF(MSTJ(102).EQ.2) KF=23 | |
9674 | MSTU10=MSTU(10) | |
9675 | MSTU(10)=1 | |
9676 | P(NC,5)=ECMC | |
9677 | CALL LY1ENT(NC,KF,ECMC,0.,0.) | |
9678 | K(NC,1)=21 | |
9679 | K(NC,3)=1 | |
9680 | MSTU(10)=MSTU10 | |
9681 | ENDIF | |
9682 | ||
9683 | C...Choice of flavour and jet configuration. | |
9684 | CALL LYXKFL(KFL,ECM,ECMC,KFLC) | |
9685 | IF(KFLC.EQ.0) GOTO 100 | |
9686 | CALL LYXJET(ECMC,NJET,CUT) | |
9687 | KFLN=21 | |
9688 | IF(NJET.EQ.4) CALL LYX4JT(NJET,CUT,KFLC,ECMC,KFLN,X1,X2,X4, | |
9689 | &X12,X14) | |
9690 | IF(NJET.EQ.3) CALL LYX3JT(NJET,CUT,KFLC,ECMC,X1,X3) | |
9691 | IF(NJET.EQ.2) MSTJ(120)=1 | |
9692 | ||
9693 | C...Fill jet configuration and origin. | |
9694 | IF(NJET.EQ.2.AND.MSTJ(101).NE.5) CALL LY2ENT(NC+1,KFLC,-KFLC,ECMC) | |
9695 | IF(NJET.EQ.2.AND.MSTJ(101).EQ.5) CALL LY2ENT(-(NC+1),KFLC,-KFLC, | |
9696 | &ECMC) | |
9697 | IF(NJET.EQ.3) CALL LY3ENT(NC+1,KFLC,21,-KFLC,ECMC,X1,X3) | |
9698 | IF(NJET.EQ.4.AND.KFLN.EQ.21) CALL LY4ENT(NC+1,KFLC,KFLN,KFLN, | |
9699 | &-KFLC,ECMC,X1,X2,X4,X12,X14) | |
9700 | IF(NJET.EQ.4.AND.KFLN.NE.21) CALL LY4ENT(NC+1,KFLC,-KFLN,KFLN, | |
9701 | &-KFLC,ECMC,X1,X2,X4,X12,X14) | |
9702 | IF(MSTU(24).NE.0) GOTO 100 | |
9703 | DO 110 IP=NC+1,N | |
9704 | K(IP,3)=K(IP,3)+MIN(MSTJ(115)/2,1)+(MSTJ(115)/3)*(NC-1) | |
9705 | 110 CONTINUE | |
9706 | ||
9707 | C...Angular orientation according to matrix element. | |
9708 | IF(MSTJ(106).EQ.1) THEN | |
9709 | CALL LYXDIF(NC,NJET,KFLC,ECMC,CHI,THE,PHI) | |
9710 | CALL LUDBRB(NC+1,N,0.,CHI,0D0,0D0,0D0) | |
9711 | CALL LUDBRB(NC+1,N,THE,PHI,0D0,0D0,0D0) | |
9712 | ENDIF | |
9713 | ||
9714 | C...Rotation and boost from radiative photon. | |
9715 | IF(MK.EQ.1) THEN | |
9716 | DBEK=-PAK/(ECM-PAK) | |
9717 | NMIN=NC+1-MSTJ(115)/3 | |
9718 | CALL LUDBRB(NMIN,N,0.,-PHIK,0D0,0D0,0D0) | |
9719 | CALL LUDBRB(NMIN,N,ALPK,0.,DBEK*SIN(THEK),0D0,DBEK*COS(THEK)) | |
9720 | CALL LUDBRB(NMIN,N,0.,PHIK,0D0,0D0,0D0) | |
9721 | ENDIF | |
9722 | ||
9723 | C...Generate parton shower. Rearrange along strings and check. | |
9724 | IF(MSTJ(101).EQ.5) THEN | |
9725 | CALL LYSHOW(N-1,N,ECMC) | |
9726 | MSTJ14=MSTJ(14) | |
9727 | IF(MSTJ(105).EQ.-1) MSTJ(14)=-1 | |
9728 | IF(MSTJ(105).GE.0) MSTU(28)=0 | |
9729 | CALL LYPREP(0) | |
9730 | MSTJ(14)=MSTJ14 | |
9731 | IF(MSTJ(105).GE.0.AND.MSTU(28).NE.0) GOTO 100 | |
9732 | ENDIF | |
9733 | ||
9734 | C...Fragmentation/decay generation. Information for LYTABU. | |
9735 | IF(MSTJ(105).EQ.1) CALL LYEXEC | |
9736 | MSTU(161)=KFLC | |
9737 | MSTU(162)=-KFLC | |
9738 | ||
9739 | RETURN | |
9740 | END | |
9741 | ||
9742 | C********************************************************************* | |
9743 | ||
9744 | SUBROUTINE LYXTOT(KFL,ECM,XTOT) | |
9745 | ||
9746 | C...Purpose: to calculate total cross-section, including initial | |
9747 | C...state radiation effects. | |
9748 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
9749 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
9750 | SAVE /LYDAT1/,/LYDAT2/ | |
9751 | ||
9752 | C...Status, (optimized) Q^2 scale, alpha_strong. | |
9753 | PARJ(151)=ECM | |
9754 | MSTJ(119)=10*MSTJ(102)+KFL | |
9755 | IF(MSTJ(111).EQ.0) THEN | |
9756 | Q2R=ECM**2 | |
9757 | ELSEIF(MSTU(111).EQ.0) THEN | |
9758 | PARJ(168)=MIN(1.,MAX(PARJ(128),EXP(-12.*PARU(1)/ | |
9759 | & ((33.-2.*MSTU(112))*PARU(111))))) | |
9760 | Q2R=PARJ(168)*ECM**2 | |
9761 | ELSE | |
9762 | PARJ(168)=MIN(1.,MAX(PARJ(128),PARU(112)/ECM, | |
9763 | & (2.*PARU(112)/ECM)**2)) | |
9764 | Q2R=PARJ(168)*ECM**2 | |
9765 | ENDIF | |
9766 | ALSPI=UYALPS(Q2R)/PARU(1) | |
9767 | ||
9768 | C...QCD corrections factor in R. | |
9769 | IF(MSTJ(101).EQ.0.OR.MSTJ(109).EQ.1) THEN | |
9770 | RQCD=1. | |
9771 | ELSEIF(IABS(MSTJ(101)).EQ.1.AND.MSTJ(109).EQ.0) THEN | |
9772 | RQCD=1.+ALSPI | |
9773 | ELSEIF(MSTJ(109).EQ.0) THEN | |
9774 | RQCD=1.+ALSPI+(1.986-0.115*MSTU(118))*ALSPI**2 | |
9775 | IF(MSTJ(111).EQ.1) RQCD=MAX(1.,RQCD+(33.-2.*MSTU(112))/12.* | |
9776 | & LOG(PARJ(168))*ALSPI**2) | |
9777 | ELSEIF(IABS(MSTJ(101)).EQ.1) THEN | |
9778 | RQCD=1.+(3./4.)*ALSPI | |
9779 | ELSE | |
9780 | RQCD=1.+(3./4.)*ALSPI-(3./32.+0.519*MSTU(118))*ALSPI**2 | |
9781 | ENDIF | |
9782 | ||
9783 | C...Calculate Z0 width if default value not acceptable. | |
9784 | IF(MSTJ(102).GE.3) THEN | |
9785 | RVA=3.*(3.+(4.*PARU(102)-1.)**2)+6.*RQCD*(2.+(1.-8.*PARU(102)/ | |
9786 | & 3.)**2+(4.*PARU(102)/3.-1.)**2) | |
9787 | DO 100 KFLC=5,6 | |
9788 | VQ=1. | |
9789 | IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(MAX(0.,1.-(2.*UYMASS(KFLC)/ | |
9790 | & ECM)**2)) | |
9791 | IF(KFLC.EQ.5) VF=4.*PARU(102)/3.-1. | |
9792 | IF(KFLC.EQ.6) VF=1.-8.*PARU(102)/3. | |
9793 | RVA=RVA+3.*RQCD*(0.5*VQ*(3.-VQ**2)*VF**2+VQ**3) | |
9794 | 100 CONTINUE | |
9795 | PARJ(124)=PARU(101)*PARJ(123)*RVA/(48.*PARU(102)*(1.-PARU(102))) | |
9796 | ENDIF | |
9797 | ||
9798 | C...Calculate propagator and related constants for QFD case. | |
9799 | POLL=1.-PARJ(131)*PARJ(132) | |
9800 | IF(MSTJ(102).GE.2) THEN | |
9801 | SFF=1./(16.*PARU(102)*(1.-PARU(102))) | |
9802 | SFW=ECM**4/((ECM**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2) | |
9803 | SFI=SFW*(1.-(PARJ(123)/ECM)**2) | |
9804 | VE=4.*PARU(102)-1. | |
9805 | SF1I=SFF*(VE*POLL+PARJ(132)-PARJ(131)) | |
9806 | SF1W=SFF**2*((VE**2+1.)*POLL+2.*VE*(PARJ(132)-PARJ(131))) | |
9807 | HF1I=SFI*SF1I | |
9808 | HF1W=SFW*SF1W | |
9809 | ENDIF | |
9810 | ||
9811 | C...Loop over different flavours: charge, velocity. | |
9812 | RTOT=0. | |
9813 | RQQ=0. | |
9814 | RQV=0. | |
9815 | RVA=0. | |
9816 | DO 110 KFLC=1,MAX(MSTJ(104),KFL) | |
9817 | IF(KFL.GT.0.AND.KFLC.NE.KFL) GOTO 110 | |
9818 | MSTJ(93)=1 | |
9819 | PMQ=UYMASS(KFLC) | |
9820 | IF(ECM.LT.2.*PMQ+PARJ(127)) GOTO 110 | |
9821 | QF=KCHG(KFLC,1)/3. | |
9822 | VQ=1. | |
9823 | IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(1.-(2.*PMQ/ECM)**2) | |
9824 | ||
9825 | C...Calculate R and sum of charges for QED or QFD case. | |
9826 | RQQ=RQQ+3.*QF**2*POLL | |
9827 | IF(MSTJ(102).LE.1) THEN | |
9828 | RTOT=RTOT+3.*0.5*VQ*(3.-VQ**2)*QF**2*POLL | |
9829 | ELSE | |
9830 | VF=SIGN(1.,QF)-4.*QF*PARU(102) | |
9831 | RQV=RQV-6.*QF*VF*SF1I | |
9832 | RVA=RVA+3.*(VF**2+1.)*SF1W | |
9833 | RTOT=RTOT+3.*(0.5*VQ*(3.-VQ**2)*(QF**2*POLL-2.*QF*VF*HF1I+ | |
9834 | & VF**2*HF1W)+VQ**3*HF1W) | |
9835 | ENDIF | |
9836 | 110 CONTINUE | |
9837 | RSUM=RQQ | |
9838 | IF(MSTJ(102).GE.2) RSUM=RQQ+SFI*RQV+SFW*RVA | |
9839 | ||
9840 | C...Calculate cross-section, including QCD corrections. | |
9841 | PARJ(141)=RQQ | |
9842 | PARJ(142)=RTOT | |
9843 | PARJ(143)=RTOT*RQCD | |
9844 | PARJ(144)=PARJ(143) | |
9845 | PARJ(145)=PARJ(141)*86.8/ECM**2 | |
9846 | PARJ(146)=PARJ(142)*86.8/ECM**2 | |
9847 | PARJ(147)=PARJ(143)*86.8/ECM**2 | |
9848 | PARJ(148)=PARJ(147) | |
9849 | PARJ(157)=RSUM*RQCD | |
9850 | PARJ(158)=0. | |
9851 | PARJ(159)=0. | |
9852 | XTOT=PARJ(147) | |
9853 | IF(MSTJ(107).LE.0) RETURN | |
9854 | ||
9855 | C...Virtual cross-section. | |
9856 | XKL=PARJ(135) | |
9857 | XKU=MIN(PARJ(136),1.-(2.*PARJ(127)/ECM)**2) | |
9858 | ALE=2.*LOG(ECM/UYMASS(11))-1. | |
9859 | SIGV=ALE/3.+2.*LOG(ECM**2/(UYMASS(13)*UYMASS(15)))/3.-4./3.+ | |
9860 | &1.526*LOG(ECM**2/0.932) | |
9861 | ||
9862 | C...Soft and hard radiative cross-section in QED case. | |
9863 | IF(MSTJ(102).LE.1) THEN | |
9864 | SIGV=1.5*ALE-0.5+PARU(1)**2/3.+2.*SIGV | |
9865 | SIGS=ALE*(2.*LOG(XKL)-LOG(1.-XKL)-XKL) | |
9866 | SIGH=ALE*(2.*LOG(XKU/XKL)-LOG((1.-XKU)/(1.-XKL))-(XKU-XKL)) | |
9867 | ||
9868 | C...Soft and hard radiative cross-section in QFD case. | |
9869 | ELSE | |
9870 | SZM=1.-(PARJ(123)/ECM)**2 | |
9871 | SZW=PARJ(123)*PARJ(124)/ECM**2 | |
9872 | PARJ(161)=-RQQ/RSUM | |
9873 | PARJ(162)=-(RQQ+RQV+RVA)/RSUM | |
9874 | PARJ(163)=(RQV*(1.-0.5*SZM-SFI)+RVA*(1.5-SZM-SFW))/RSUM | |
9875 | PARJ(164)=(RQV*SZW**2*(1.-2.*SFW)+RVA*(2.*SFI+SZW**2-4.+3.*SZM- | |
9876 | & SZM**2))/(SZW*RSUM) | |
9877 | SIGV=1.5*ALE-0.5+PARU(1)**2/3.+((2.*RQQ+SFI*RQV)/RSUM)*SIGV+ | |
9878 | & (SZW*SFW*RQV/RSUM)*PARU(1)*20./9. | |
9879 | SIGS=ALE*(2.*LOG(XKL)+PARJ(161)*LOG(1.-XKL)+PARJ(162)*XKL+ | |
9880 | & PARJ(163)*LOG(((XKL-SZM)**2+SZW**2)/(SZM**2+SZW**2))+ | |
9881 | & PARJ(164)*(ATAN((XKL-SZM)/SZW)-ATAN(-SZM/SZW))) | |
9882 | SIGH=ALE*(2.*LOG(XKU/XKL)+PARJ(161)*LOG((1.-XKU)/(1.-XKL))+ | |
9883 | & PARJ(162)*(XKU-XKL)+PARJ(163)*LOG(((XKU-SZM)**2+SZW**2)/ | |
9884 | & ((XKL-SZM)**2+SZW**2))+PARJ(164)*(ATAN((XKU-SZM)/SZW)- | |
9885 | & ATAN((XKL-SZM)/SZW))) | |
9886 | ENDIF | |
9887 | ||
9888 | C...Total cross-section and fraction of hard photon events. | |
9889 | PARJ(160)=SIGH/(PARU(1)/PARU(101)+SIGV+SIGS+SIGH) | |
9890 | PARJ(157)=RSUM*(1.+(PARU(101)/PARU(1))*(SIGV+SIGS+SIGH))*RQCD | |
9891 | PARJ(144)=PARJ(157) | |
9892 | PARJ(148)=PARJ(144)*86.8/ECM**2 | |
9893 | XTOT=PARJ(148) | |
9894 | ||
9895 | RETURN | |
9896 | END | |
9897 | ||
9898 | C********************************************************************* | |
9899 | ||
9900 | SUBROUTINE LYRADK(ECM,MK,PAK,THEK,PHIK,ALPK) | |
9901 | ||
9902 | C...Purpose: to generate initial state photon radiation. | |
9903 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
9904 | SAVE /LYDAT1/ | |
9905 | ||
9906 | C...Function: cumulative hard photon spectrum in QFD case. | |
9907 | FXK(XX)=2.*LOG(XX)+PARJ(161)*LOG(1.-XX)+PARJ(162)*XX+ | |
9908 | &PARJ(163)*LOG((XX-SZM)**2+SZW**2)+PARJ(164)*ATAN((XX-SZM)/SZW) | |
9909 | ||
9910 | C...Determine whether radiative photon or not. | |
9911 | MK=0 | |
9912 | PAK=0. | |
9913 | IF(PARJ(160).LT.RLY(0)) RETURN | |
9914 | MK=1 | |
9915 | ||
9916 | C...Photon energy range. Find photon momentum in QED case. | |
9917 | XKL=PARJ(135) | |
9918 | XKU=MIN(PARJ(136),1.-(2.*PARJ(127)/ECM)**2) | |
9919 | IF(MSTJ(102).LE.1) THEN | |
9920 | 100 XK=1./(1.+(1./XKL-1.)*((1./XKU-1.)/(1./XKL-1.))**RLY(0)) | |
9921 | IF(1.+(1.-XK)**2.LT.2.*RLY(0)) GOTO 100 | |
9922 | ||
9923 | C...Ditto in QFD case, by numerical inversion of integrated spectrum. | |
9924 | ELSE | |
9925 | SZM=1.-(PARJ(123)/ECM)**2 | |
9926 | SZW=PARJ(123)*PARJ(124)/ECM**2 | |
9927 | FXKL=FXK(XKL) | |
9928 | FXKU=FXK(XKU) | |
9929 | FXKD=1E-4*(FXKU-FXKL) | |
9930 | FXKR=FXKL+RLY(0)*(FXKU-FXKL) | |
9931 | NXK=0 | |
9932 | 110 NXK=NXK+1 | |
9933 | XK=0.5*(XKL+XKU) | |
9934 | FXKV=FXK(XK) | |
9935 | IF(FXKV.GT.FXKR) THEN | |
9936 | XKU=XK | |
9937 | FXKU=FXKV | |
9938 | ELSE | |
9939 | XKL=XK | |
9940 | FXKL=FXKV | |
9941 | ENDIF | |
9942 | IF(NXK.LT.15.AND.FXKU-FXKL.GT.FXKD) GOTO 110 | |
9943 | XK=XKL+(XKU-XKL)*(FXKR-FXKL)/(FXKU-FXKL) | |
9944 | ENDIF | |
9945 | PAK=0.5*ECM*XK | |
9946 | ||
9947 | C...Photon polar and azimuthal angle. | |
9948 | PME=2.*(UYMASS(11)/ECM)**2 | |
9949 | 120 CTHM=PME*(2./PME)**RLY(0) | |
9950 | IF(1.-(XK**2*CTHM*(1.-0.5*CTHM)+2.*(1.-XK)*PME/MAX(PME, | |
9951 | &CTHM*(1.-0.5*CTHM)))/(1.+(1.-XK)**2).LT.RLY(0)) GOTO 120 | |
9952 | CTHE=1.-CTHM | |
9953 | IF(RLY(0).GT.0.5) CTHE=-CTHE | |
9954 | STHE=SQRT(MAX(0.,(CTHM-PME)*(2.-CTHM))) | |
9955 | THEK=UYANGL(CTHE,STHE) | |
9956 | PHIK=PARU(2)*RLY(0) | |
9957 | ||
9958 | C...Rotation angle for hadronic system. | |
9959 | SGN=1. | |
9960 | IF(0.5*(2.-XK*(1.-CTHE))**2/((2.-XK)**2+(XK*CTHE)**2).GT. | |
9961 | &RLY(0)) SGN=-1. | |
9962 | ALPK=ASIN(SGN*STHE*(XK-SGN*(2.*SQRT(1.-XK)-2.+XK)*CTHE)/ | |
9963 | &(2.-XK*(1.-SGN*CTHE))) | |
9964 | ||
9965 | RETURN | |
9966 | END | |
9967 | ||
9968 | C********************************************************************* | |
9969 | ||
9970 | SUBROUTINE LYXKFL(KFL,ECM,ECMC,KFLC) | |
9971 | ||
9972 | C...Purpose: to select flavour for produced qqbar pair. | |
9973 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
9974 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
9975 | SAVE /LYDAT1/,/LYDAT2/ | |
9976 | ||
9977 | C...Calculate maximum weight in QED or QFD case. | |
9978 | IF(MSTJ(102).LE.1) THEN | |
9979 | RFMAX=4./9. | |
9980 | ELSE | |
9981 | POLL=1.-PARJ(131)*PARJ(132) | |
9982 | SFF=1./(16.*PARU(102)*(1.-PARU(102))) | |
9983 | SFW=ECMC**4/((ECMC**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2) | |
9984 | SFI=SFW*(1.-(PARJ(123)/ECMC)**2) | |
9985 | VE=4.*PARU(102)-1. | |
9986 | HF1I=SFI*SFF*(VE*POLL+PARJ(132)-PARJ(131)) | |
9987 | HF1W=SFW*SFF**2*((VE**2+1.)*POLL+2.*VE*(PARJ(132)-PARJ(131))) | |
9988 | RFMAX=MAX(4./9.*POLL-4./3.*(1.-8.*PARU(102)/3.)*HF1I+ | |
9989 | & ((1.-8.*PARU(102)/3.)**2+1.)*HF1W,1./9.*POLL+2./3.* | |
9990 | & (-1.+4.*PARU(102)/3.)*HF1I+((-1.+4.*PARU(102)/3.)**2+1.)*HF1W) | |
9991 | ENDIF | |
9992 | ||
9993 | C...Choose flavour. Gives charge and velocity. | |
9994 | NTRY=0 | |
9995 | 100 NTRY=NTRY+1 | |
9996 | IF(NTRY.GT.100) THEN | |
9997 | CALL LYERRM(14,'(LYXKFL:) caught in an infinite loop') | |
9998 | KFLC=0 | |
9999 | RETURN | |
10000 | ENDIF | |
10001 | KFLC=KFL | |
10002 | IF(KFL.LE.0) KFLC=1+INT(MSTJ(104)*RLY(0)) | |
10003 | MSTJ(93)=1 | |
10004 | PMQ=UYMASS(KFLC) | |
10005 | IF(ECM.LT.2.*PMQ+PARJ(127)) GOTO 100 | |
10006 | QF=KCHG(KFLC,1)/3. | |
10007 | VQ=1. | |
10008 | IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(MAX(0.,1.-(2.*PMQ/ECMC)**2)) | |
10009 | ||
10010 | C...Calculate weight in QED or QFD case. | |
10011 | IF(MSTJ(102).LE.1) THEN | |
10012 | RF=QF**2 | |
10013 | RFV=0.5*VQ*(3.-VQ**2)*QF**2 | |
10014 | ELSE | |
10015 | VF=SIGN(1.,QF)-4.*QF*PARU(102) | |
10016 | RF=QF**2*POLL-2.*QF*VF*HF1I+(VF**2+1.)*HF1W | |
10017 | RFV=0.5*VQ*(3.-VQ**2)*(QF**2*POLL-2.*QF*VF*HF1I+VF**2*HF1W)+ | |
10018 | & VQ**3*HF1W | |
10019 | IF(RFV.GT.0.) PARJ(171)=MIN(1.,VQ**3*HF1W/RFV) | |
10020 | ENDIF | |
10021 | ||
10022 | C...Weighting or new event (radiative photon). Cross-section update. | |
10023 | IF(KFL.LE.0.AND.RF.LT.RLY(0)*RFMAX) GOTO 100 | |
10024 | PARJ(158)=PARJ(158)+1. | |
10025 | IF(ECMC.LT.2.*PMQ+PARJ(127).OR.RFV.LT.RLY(0)*RF) KFLC=0 | |
10026 | IF(MSTJ(107).LE.0.AND.KFLC.EQ.0) GOTO 100 | |
10027 | IF(KFLC.NE.0) PARJ(159)=PARJ(159)+1. | |
10028 | PARJ(144)=PARJ(157)*PARJ(159)/PARJ(158) | |
10029 | PARJ(148)=PARJ(144)*86.8/ECM**2 | |
10030 | ||
10031 | RETURN | |
10032 | END | |
10033 | ||
10034 | C********************************************************************* | |
10035 | ||
10036 | SUBROUTINE LYXJET(ECM,NJET,CUT) | |
10037 | ||
10038 | C...Purpose: to select number of jets in matrix element approach. | |
10039 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
10040 | SAVE /LYDAT1/ | |
10041 | DIMENSION ZHUT(5) | |
10042 | ||
10043 | C...Relative three-jet rate in Zhu second order parametrization. | |
10044 | DATA ZHUT/3.0922, 6.2291, 7.4782, 7.8440, 8.2560/ | |
10045 | ||
10046 | C...Trivial result for two-jets only, including parton shower. | |
10047 | IF(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.5) THEN | |
10048 | CUT=0. | |
10049 | ||
10050 | C...QCD and Abelian vector gluon theory: Q^2 for jet rate and R. | |
10051 | ELSEIF(MSTJ(109).EQ.0.OR.MSTJ(109).EQ.2) THEN | |
10052 | CF=4./3. | |
10053 | IF(MSTJ(109).EQ.2) CF=1. | |
10054 | IF(MSTJ(111).EQ.0) THEN | |
10055 | Q2=ECM**2 | |
10056 | Q2R=ECM**2 | |
10057 | ELSEIF(MSTU(111).EQ.0) THEN | |
10058 | PARJ(169)=MIN(1.,PARJ(129)) | |
10059 | Q2=PARJ(169)*ECM**2 | |
10060 | PARJ(168)=MIN(1.,MAX(PARJ(128),EXP(-12.*PARU(1)/ | |
10061 | & ((33.-2.*MSTU(112))*PARU(111))))) | |
10062 | Q2R=PARJ(168)*ECM**2 | |
10063 | ELSE | |
10064 | PARJ(169)=MIN(1.,MAX(PARJ(129),(2.*PARU(112)/ECM)**2)) | |
10065 | Q2=PARJ(169)*ECM**2 | |
10066 | PARJ(168)=MIN(1.,MAX(PARJ(128),PARU(112)/ECM, | |
10067 | & (2.*PARU(112)/ECM)**2)) | |
10068 | Q2R=PARJ(168)*ECM**2 | |
10069 | ENDIF | |
10070 | ||
10071 | C...alpha_strong for R and R itself. | |
10072 | ALSPI=(3./4.)*CF*UYALPS(Q2R)/PARU(1) | |
10073 | IF(IABS(MSTJ(101)).EQ.1) THEN | |
10074 | RQCD=1.+ALSPI | |
10075 | ELSEIF(MSTJ(109).EQ.0) THEN | |
10076 | RQCD=1.+ALSPI+(1.986-0.115*MSTU(118))*ALSPI**2 | |
10077 | IF(MSTJ(111).EQ.1) RQCD=MAX(1.,RQCD+(33.-2.*MSTU(112))/12.* | |
10078 | & LOG(PARJ(168))*ALSPI**2) | |
10079 | ELSE | |
10080 | RQCD=1.+ALSPI-(3./32.+0.519*MSTU(118))*(4.*ALSPI/3.)**2 | |
10081 | ENDIF | |
10082 | ||
10083 | C...alpha_strong for jet rate. Initial value for y cut. | |
10084 | ALSPI=(3./4.)*CF*UYALPS(Q2)/PARU(1) | |
10085 | CUT=MAX(0.001,PARJ(125),(PARJ(126)/ECM)**2) | |
10086 | IF(IABS(MSTJ(101)).LE.1.OR.(MSTJ(109).EQ.0.AND.MSTJ(111).EQ.0)) | |
10087 | & CUT=MAX(CUT,EXP(-SQRT(0.75/ALSPI))/2.) | |
10088 | IF(MSTJ(110).EQ.2) CUT=MAX(0.01,MIN(0.05,CUT)) | |
10089 | ||
10090 | C...Parametrization of first order three-jet cross-section. | |
10091 | 100 IF(MSTJ(101).EQ.0.OR.CUT.GE.0.25) THEN | |
10092 | PARJ(152)=0. | |
10093 | ELSE | |
10094 | PARJ(152)=(2.*ALSPI/3.)*((3.-6.*CUT+2.*LOG(CUT))* | |
10095 | & LOG(CUT/(1.-2.*CUT))+(2.5+1.5*CUT-6.571)*(1.-3.*CUT)+ | |
10096 | & 5.833*(1.-3.*CUT)**2-3.894*(1.-3.*CUT)**3+ | |
10097 | & 1.342*(1.-3.*CUT)**4)/RQCD | |
10098 | IF(MSTJ(109).EQ.2.AND.(MSTJ(101).EQ.2.OR.MSTJ(101).LE.-2)) | |
10099 | & PARJ(152)=0. | |
10100 | ENDIF | |
10101 | ||
10102 | C...Parametrization of second order three-jet cross-section. | |
10103 | IF(IABS(MSTJ(101)).LE.1.OR.MSTJ(101).EQ.3.OR.MSTJ(109).EQ.2.OR. | |
10104 | & CUT.GE.0.25) THEN | |
10105 | PARJ(153)=0. | |
10106 | ELSEIF(MSTJ(110).LE.1) THEN | |
10107 | CT=LOG(1./CUT-2.) | |
10108 | PARJ(153)=ALSPI**2*CT**2*(2.419+0.5989*CT+0.6782*CT**2- | |
10109 | & 0.2661*CT**3+0.01159*CT**4)/RQCD | |
10110 | ||
10111 | C...Interpolation in second/first order ratio for Zhu parametrization. | |
10112 | ELSEIF(MSTJ(110).EQ.2) THEN | |
10113 | IZA=0 | |
10114 | DO 110 IY=1,5 | |
10115 | IF(ABS(CUT-0.01*IY).LT.0.0001) IZA=IY | |
10116 | 110 CONTINUE | |
10117 | IF(IZA.NE.0) THEN | |
10118 | ZHURAT=ZHUT(IZA) | |
10119 | ELSE | |
10120 | IZ=100.*CUT | |
10121 | ZHURAT=ZHUT(IZ)+(100.*CUT-IZ)*(ZHUT(IZ+1)-ZHUT(IZ)) | |
10122 | ENDIF | |
10123 | PARJ(153)=ALSPI*PARJ(152)*ZHURAT | |
10124 | ENDIF | |
10125 | ||
10126 | C...Shift in second order three-jet cross-section with optimized Q^2. | |
10127 | IF(MSTJ(111).EQ.1.AND.IABS(MSTJ(101)).GE.2.AND.MSTJ(101).NE.3. | |
10128 | & AND.CUT.LT.0.25) PARJ(153)=PARJ(153)+(33.-2.*MSTU(112))/12.* | |
10129 | & LOG(PARJ(169))*ALSPI*PARJ(152) | |
10130 | ||
10131 | C...Parametrization of second order four-jet cross-section. | |
10132 | IF(IABS(MSTJ(101)).LE.1.OR.CUT.GE.0.125) THEN | |
10133 | PARJ(154)=0. | |
10134 | ELSE | |
10135 | CT=LOG(1./CUT-5.) | |
10136 | IF(CUT.LE.0.018) THEN | |
10137 | XQQGG=6.349-4.330*CT+0.8304*CT**2 | |
10138 | IF(MSTJ(109).EQ.2) XQQGG=(4./3.)**2*(3.035-2.091*CT+ | |
10139 | & 0.4059*CT**2) | |
10140 | XQQQQ=1.25*(-0.1080+0.01486*CT+0.009364*CT**2) | |
10141 | IF(MSTJ(109).EQ.2) XQQQQ=8.*XQQQQ | |
10142 | ELSE | |
10143 | XQQGG=-0.09773+0.2959*CT-0.2764*CT**2+0.08832*CT**3 | |
10144 | IF(MSTJ(109).EQ.2) XQQGG=(4./3.)**2*(-0.04079+0.1340*CT- | |
10145 | & 0.1326*CT**2+0.04365*CT**3) | |
10146 | XQQQQ=1.25*(0.003661-0.004888*CT-0.001081*CT**2+0.002093* | |
10147 | & CT**3) | |
10148 | IF(MSTJ(109).EQ.2) XQQQQ=8.*XQQQQ | |
10149 | ENDIF | |
10150 | PARJ(154)=ALSPI**2*CT**2*(XQQGG+XQQQQ)/RQCD | |
10151 | PARJ(155)=XQQQQ/(XQQGG+XQQQQ) | |
10152 | ENDIF | |
10153 | ||
10154 | C...If negative three-jet rate, change y' optimization parameter. | |
10155 | IF(MSTJ(111).EQ.1.AND.PARJ(152)+PARJ(153).LT.0..AND. | |
10156 | & PARJ(169).LT.0.99) THEN | |
10157 | PARJ(169)=MIN(1.,1.2*PARJ(169)) | |
10158 | Q2=PARJ(169)*ECM**2 | |
10159 | ALSPI=(3./4.)*CF*UYALPS(Q2)/PARU(1) | |
10160 | GOTO 100 | |
10161 | ENDIF | |
10162 | ||
10163 | C...If too high cross-section, use harder cuts, or fail. | |
10164 | IF(PARJ(152)+PARJ(153)+PARJ(154).GE.1) THEN | |
10165 | IF(MSTJ(110).EQ.2.AND.CUT.GT.0.0499.AND.MSTJ(111).EQ.1.AND. | |
10166 | & PARJ(169).LT.0.99) THEN | |
10167 | PARJ(169)=MIN(1.,1.2*PARJ(169)) | |
10168 | Q2=PARJ(169)*ECM**2 | |
10169 | ALSPI=(3./4.)*CF*UYALPS(Q2)/PARU(1) | |
10170 | GOTO 100 | |
10171 | ELSEIF(MSTJ(110).EQ.2.AND.CUT.GT.0.0499) THEN | |
10172 | CALL LYERRM(26, | |
10173 | & '(LYXJET:) no allowed y cut value for Zhu parametrization') | |
10174 | ENDIF | |
10175 | CUT=0.26*(4.*CUT)**(PARJ(152)+PARJ(153)+PARJ(154))**(-1./3.) | |
10176 | IF(MSTJ(110).EQ.2) CUT=MAX(0.01,MIN(0.05,CUT)) | |
10177 | GOTO 100 | |
10178 | ENDIF | |
10179 | ||
10180 | C...Scalar gluon (first order only). | |
10181 | ELSE | |
10182 | ALSPI=UYALPS(ECM**2)/PARU(1) | |
10183 | CUT=MAX(0.001,PARJ(125),(PARJ(126)/ECM)**2,EXP(-3./ALSPI)) | |
10184 | PARJ(152)=0. | |
10185 | IF(CUT.LT.0.25) PARJ(152)=(ALSPI/3.)*((1.-2.*CUT)* | |
10186 | & LOG((1.-2.*CUT)/CUT)+0.5*(9.*CUT**2-1.)) | |
10187 | PARJ(153)=0. | |
10188 | PARJ(154)=0. | |
10189 | ENDIF | |
10190 | ||
10191 | C...Select number of jets. | |
10192 | PARJ(150)=CUT | |
10193 | IF(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.5) THEN | |
10194 | NJET=2 | |
10195 | ELSEIF(MSTJ(101).LE.0) THEN | |
10196 | NJET=MIN(4,2-MSTJ(101)) | |
10197 | ELSE | |
10198 | RNJ=RLY(0) | |
10199 | NJET=2 | |
10200 | IF(PARJ(152)+PARJ(153)+PARJ(154).GT.RNJ) NJET=3 | |
10201 | IF(PARJ(154).GT.RNJ) NJET=4 | |
10202 | ENDIF | |
10203 | ||
10204 | RETURN | |
10205 | END | |
10206 | ||
10207 | C********************************************************************* | |
10208 | ||
10209 | SUBROUTINE LYX3JT(NJET,CUT,KFL,ECM,X1,X2) | |
10210 | ||
10211 | C...Purpose: to select the kinematical variables of three-jet events. | |
10212 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
10213 | SAVE /LYDAT1/ | |
10214 | DIMENSION ZHUP(5,12) | |
10215 | ||
10216 | C...Coefficients of Zhu second order parametrization. | |
10217 | DATA ((ZHUP(IC1,IC2),IC2=1,12),IC1=1,5)/ | |
10218 | & 18.29, 89.56, 4.541, -52.09, -109.8, 24.90, | |
10219 | & 11.63, 3.683, 17.50, 0.002440, -1.362, -0.3537, | |
10220 | & 11.42, 6.299, -22.55, -8.915, 59.25, -5.855, | |
10221 | & -32.85, -1.054, -16.90, 0.006489, -0.8156, 0.01095, | |
10222 | & 7.847, -3.964, -35.83, 1.178, 29.39, 0.2806, | |
10223 | & 47.82, -12.36, -56.72, 0.04054, -0.4365, 0.6062, | |
10224 | & 5.441, -56.89, -50.27, 15.13, 114.3, -18.19, | |
10225 | & 97.05, -1.890, -139.9, 0.08153, -0.4984, 0.9439, | |
10226 | & -17.65, 51.44, -58.32, 70.95, -255.7, -78.99, | |
10227 | & 476.9, 29.65, -239.3, 0.4745, -1.174, 6.081/ | |
10228 | ||
10229 | C...Dilogarithm of x for x<0.5 (x>0.5 obtained by analytic trick). | |
10230 | DILOG(X)=X+X**2/4.+X**3/9.+X**4/16.+X**5/25.+X**6/36.+X**7/49. | |
10231 | ||
10232 | C...Event type. Mass effect factors and other common constants. | |
10233 | MSTJ(120)=2 | |
10234 | MSTJ(121)=0 | |
10235 | PMQ=UYMASS(KFL) | |
10236 | QME=(2.*PMQ/ECM)**2 | |
10237 | IF(MSTJ(109).NE.1) THEN | |
10238 | CUTL=LOG(CUT) | |
10239 | CUTD=LOG(1./CUT-2.) | |
10240 | IF(MSTJ(109).EQ.0) THEN | |
10241 | CF=4./3. | |
10242 | CN=3. | |
10243 | TR=2. | |
10244 | WTMX=MIN(20.,37.-6.*CUTD) | |
10245 | IF(MSTJ(110).EQ.2) WTMX=2.*(7.5+80.*CUT) | |
10246 | ELSE | |
10247 | CF=1. | |
10248 | CN=0. | |
10249 | TR=12. | |
10250 | WTMX=0. | |
10251 | ENDIF | |
10252 | ||
10253 | C...Alpha_strong and effects of optimized Q^2 scale. Maximum weight. | |
10254 | ALS2PI=PARU(118)/PARU(2) | |
10255 | WTOPT=0. | |
10256 | IF(MSTJ(111).EQ.1) WTOPT=(33.-2.*MSTU(112))/6.*LOG(PARJ(169))* | |
10257 | & ALS2PI | |
10258 | WTMAX=MAX(0.,1.+WTOPT+ALS2PI*WTMX) | |
10259 | ||
10260 | C...Choose three-jet events in allowed region. | |
10261 | 100 NJET=3 | |
10262 | 110 Y13L=CUTL+CUTD*RLY(0) | |
10263 | Y23L=CUTL+CUTD*RLY(0) | |
10264 | Y13=EXP(Y13L) | |
10265 | Y23=EXP(Y23L) | |
10266 | Y12=1.-Y13-Y23 | |
10267 | IF(Y12.LE.CUT) GOTO 110 | |
10268 | IF(Y13**2+Y23**2+2.*Y12.LE.2.*RLY(0)) GOTO 110 | |
10269 | ||
10270 | C...Second order corrections. | |
10271 | IF(MSTJ(101).EQ.2.AND.MSTJ(110).LE.1) THEN | |
10272 | Y12L=LOG(Y12) | |
10273 | Y13M=LOG(1.-Y13) | |
10274 | Y23M=LOG(1.-Y23) | |
10275 | Y12M=LOG(1.-Y12) | |
10276 | IF(Y13.LE.0.5) Y13I=DILOG(Y13) | |
10277 | IF(Y13.GE.0.5) Y13I=1.644934-Y13L*Y13M-DILOG(1.-Y13) | |
10278 | IF(Y23.LE.0.5) Y23I=DILOG(Y23) | |
10279 | IF(Y23.GE.0.5) Y23I=1.644934-Y23L*Y23M-DILOG(1.-Y23) | |
10280 | IF(Y12.LE.0.5) Y12I=DILOG(Y12) | |
10281 | IF(Y12.GE.0.5) Y12I=1.644934-Y12L*Y12M-DILOG(1.-Y12) | |
10282 | WT1=(Y13**2+Y23**2+2.*Y12)/(Y13*Y23) | |
10283 | WT2=CF*(-2.*(CUTL-Y12L)**2-3.*CUTL-1.+3.289868+ | |
10284 | & 2.*(2.*CUTL-Y12L)*CUT/Y12)+ | |
10285 | & CN*((CUTL-Y12L)**2-(CUTL-Y13L)**2-(CUTL-Y23L)**2-11.*CUTL/6.+ | |
10286 | & 67./18.+1.644934-(2.*CUTL-Y12L)*CUT/Y12+(2.*CUTL-Y13L)* | |
10287 | & CUT/Y13+(2.*CUTL-Y23L)*CUT/Y23)+ | |
10288 | & TR*(2.*CUTL/3.-10./9.)+ | |
10289 | & CF*(Y12/(Y12+Y13)+Y12/(Y12+Y23)+(Y12+Y23)/Y13+(Y12+Y13)/Y23+ | |
10290 | & Y13L*(4.*Y12**2+2.*Y12*Y13+4.*Y12*Y23+Y13*Y23)/(Y12+Y23)**2+ | |
10291 | & Y23L*(4.*Y12**2+2.*Y12*Y23+4.*Y12*Y13+Y13*Y23)/(Y12+Y13)**2)/ | |
10292 | & WT1+ | |
10293 | & CN*(Y13L*Y13/(Y12+Y23)+Y23L*Y23/(Y12+Y13))/WT1+ | |
10294 | & (CN-2.*CF)*((Y12**2+(Y12+Y13)**2)*(Y12L*Y23L-Y12L*Y12M-Y23L* | |
10295 | & Y23M+1.644934-Y12I-Y23I)/(Y13*Y23)+(Y12**2+(Y12+Y23)**2)* | |
10296 | & (Y12L*Y13L-Y12L*Y12M-Y13L*Y13M+1.644934-Y12I-Y13I)/ | |
10297 | & (Y13*Y23)+(Y13**2+Y23**2)/(Y13*Y23*(Y13+Y23))- | |
10298 | & 2.*Y12L*Y12**2/(Y13+Y23)**2-4.*Y12L*Y12/(Y13+Y23))/WT1- | |
10299 | & CN*(Y13L*Y23L-Y13L*Y13M-Y23L*Y23M+1.644934-Y13I-Y23I) | |
10300 | IF(1.+WTOPT+ALS2PI*WT2.LE.0.) MSTJ(121)=1 | |
10301 | IF(1.+WTOPT+ALS2PI*WT2.LE.WTMAX*RLY(0)) GOTO 110 | |
10302 | PARJ(156)=(WTOPT+ALS2PI*WT2)/(1.+WTOPT+ALS2PI*WT2) | |
10303 | ||
10304 | ELSEIF(MSTJ(101).EQ.2.AND.MSTJ(110).EQ.2) THEN | |
10305 | C...Second order corrections; Zhu parametrization of ERT. | |
10306 | ZX=(Y23-Y13)**2 | |
10307 | ZY=1.-Y12 | |
10308 | IZA=0 | |
10309 | DO 120 IY=1,5 | |
10310 | IF(ABS(CUT-0.01*IY).LT.0.0001) IZA=IY | |
10311 | 120 CONTINUE | |
10312 | IF(IZA.NE.0) THEN | |
10313 | IZ=IZA | |
10314 | WT2=ZHUP(IZ,1)+ZHUP(IZ,2)*ZX+ZHUP(IZ,3)*ZX**2+(ZHUP(IZ,4)+ | |
10315 | & ZHUP(IZ,5)*ZX)*ZY+(ZHUP(IZ,6)+ZHUP(IZ,7)*ZX)*ZY**2+ | |
10316 | & (ZHUP(IZ,8)+ZHUP(IZ,9)*ZX)*ZY**3+ZHUP(IZ,10)/(ZX-ZY**2)+ | |
10317 | & ZHUP(IZ,11)/(1.-ZY)+ZHUP(IZ,12)/ZY | |
10318 | ELSE | |
10319 | IZ=100.*CUT | |
10320 | WTL=ZHUP(IZ,1)+ZHUP(IZ,2)*ZX+ZHUP(IZ,3)*ZX**2+(ZHUP(IZ,4)+ | |
10321 | & ZHUP(IZ,5)*ZX)*ZY+(ZHUP(IZ,6)+ZHUP(IZ,7)*ZX)*ZY**2+ | |
10322 | & (ZHUP(IZ,8)+ZHUP(IZ,9)*ZX)*ZY**3+ZHUP(IZ,10)/(ZX-ZY**2)+ | |
10323 | & ZHUP(IZ,11)/(1.-ZY)+ZHUP(IZ,12)/ZY | |
10324 | IZ=IZ+1 | |
10325 | WTU=ZHUP(IZ,1)+ZHUP(IZ,2)*ZX+ZHUP(IZ,3)*ZX**2+(ZHUP(IZ,4)+ | |
10326 | & ZHUP(IZ,5)*ZX)*ZY+(ZHUP(IZ,6)+ZHUP(IZ,7)*ZX)*ZY**2+ | |
10327 | & (ZHUP(IZ,8)+ZHUP(IZ,9)*ZX)*ZY**3+ZHUP(IZ,10)/(ZX-ZY**2)+ | |
10328 | & ZHUP(IZ,11)/(1.-ZY)+ZHUP(IZ,12)/ZY | |
10329 | WT2=WTL+(WTU-WTL)*(100.*CUT+1.-IZ) | |
10330 | ENDIF | |
10331 | IF(1.+WTOPT+2.*ALS2PI*WT2.LE.0.) MSTJ(121)=1 | |
10332 | IF(1.+WTOPT+2.*ALS2PI*WT2.LE.WTMAX*RLY(0)) GOTO 110 | |
10333 | PARJ(156)=(WTOPT+2.*ALS2PI*WT2)/(1.+WTOPT+2.*ALS2PI*WT2) | |
10334 | ENDIF | |
10335 | ||
10336 | C...Impose mass cuts (gives two jets). For fixed jet number new try. | |
10337 | X1=1.-Y23 | |
10338 | X2=1.-Y13 | |
10339 | X3=1.-Y12 | |
10340 | IF(4.*Y23*Y13*Y12/X3**2.LE.QME) NJET=2 | |
10341 | IF(MOD(MSTJ(103),4).GE.2.AND.IABS(MSTJ(101)).LE.1.AND.QME*X3+ | |
10342 | & 0.5*QME**2+(0.5*QME+0.25*QME**2)*((1.-X2)/(1.-X1)+ | |
10343 | & (1.-X1)/(1.-X2)).GT.(X1**2+X2**2)*RLY(0)) NJET=2 | |
10344 | IF(MSTJ(101).EQ.-1.AND.NJET.EQ.2) GOTO 100 | |
10345 | ||
10346 | C...Scalar gluon model (first order only, no mass effects). | |
10347 | ELSE | |
10348 | 130 NJET=3 | |
10349 | 140 X3=SQRT(4.*CUT**2+RLY(0)*((1.-CUT)**2-4.*CUT**2)) | |
10350 | IF(LOG((X3-CUT)/CUT).LE.RLY(0)*LOG((1.-2.*CUT)/CUT)) GOTO 140 | |
10351 | YD=SIGN(2.*CUT*((X3-CUT)/CUT)**RLY(0)-X3,RLY(0)-0.5) | |
10352 | X1=1.-0.5*(X3+YD) | |
10353 | X2=1.-0.5*(X3-YD) | |
10354 | IF(4.*(1.-X1)*(1.-X2)*(1.-X3)/X3**2.LE.QME) NJET=2 | |
10355 | IF(MSTJ(102).GE.2) THEN | |
10356 | IF(X3**2-2.*(1.+X3)*(1.-X1)*(1.-X2)*PARJ(171).LT. | |
10357 | & X3**2*RLY(0)) NJET=2 | |
10358 | ENDIF | |
10359 | IF(MSTJ(101).EQ.-1.AND.NJET.EQ.2) GOTO 130 | |
10360 | ENDIF | |
10361 | ||
10362 | RETURN | |
10363 | END | |
10364 | ||
10365 | C********************************************************************* | |
10366 | ||
10367 | SUBROUTINE LYX4JT(NJET,CUT,KFL,ECM,KFLN,X1,X2,X4,X12,X14) | |
10368 | ||
10369 | C...Purpose: to select the kinematical variables of four-jet events. | |
10370 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
10371 | SAVE /LYDAT1/ | |
10372 | DIMENSION WTA(4),WTB(4),WTC(4),WTD(4),WTE(4) | |
10373 | ||
10374 | C...Common constants. Colour factors for QCD and Abelian gluon theory. | |
10375 | PMQ=UYMASS(KFL) | |
10376 | QME=(2.*PMQ/ECM)**2 | |
10377 | CT=LOG(1./CUT-5.) | |
10378 | IF(MSTJ(109).EQ.0) THEN | |
10379 | CF=4./3. | |
10380 | CN=3. | |
10381 | TR=2.5 | |
10382 | ELSE | |
10383 | CF=1. | |
10384 | CN=0. | |
10385 | TR=15. | |
10386 | ENDIF | |
10387 | ||
10388 | C...Choice of process (qqbargg or qqbarqqbar). | |
10389 | 100 NJET=4 | |
10390 | IT=1 | |
10391 | IF(PARJ(155).GT.RLY(0)) IT=2 | |
10392 | IF(MSTJ(101).LE.-3) IT=-MSTJ(101)-2 | |
10393 | IF(IT.EQ.1) WTMX=0.7/CUT**2 | |
10394 | IF(IT.EQ.1.AND.MSTJ(109).EQ.2) WTMX=0.6/CUT**2 | |
10395 | IF(IT.EQ.2) WTMX=0.1125*CF*TR/CUT**2 | |
10396 | ID=1 | |
10397 | ||
10398 | C...Sample the five kinematical variables (for qqgg preweighted in y34). | |
10399 | 110 Y134=3.*CUT+(1.-6.*CUT)*RLY(0) | |
10400 | Y234=3.*CUT+(1.-6.*CUT)*RLY(0) | |
10401 | IF(IT.EQ.1) Y34=(1.-5.*CUT)*EXP(-CT*RLY(0)) | |
10402 | IF(IT.EQ.2) Y34=CUT+(1.-6.*CUT)*RLY(0) | |
10403 | IF(Y34.LE.Y134+Y234-1..OR.Y34.GE.Y134*Y234) GOTO 110 | |
10404 | VT=RLY(0) | |
10405 | CP=COS(PARU(1)*RLY(0)) | |
10406 | Y14=(Y134-Y34)*VT | |
10407 | Y13=Y134-Y14-Y34 | |
10408 | VB=Y34*(1.-Y134-Y234+Y34)/((Y134-Y34)*(Y234-Y34)) | |
10409 | Y24=0.5*(Y234-Y34)*(1.-4.*SQRT(MAX(0.,VT*(1.-VT)*VB*(1.-VB)))* | |
10410 | &CP-(1.-2.*VT)*(1.-2.*VB)) | |
10411 | Y23=Y234-Y34-Y24 | |
10412 | Y12=1.-Y134-Y23-Y24 | |
10413 | IF(MIN(Y12,Y13,Y14,Y23,Y24).LE.CUT) GOTO 110 | |
10414 | Y123=Y12+Y13+Y23 | |
10415 | Y124=Y12+Y14+Y24 | |
10416 | ||
10417 | C...Calculate matrix elements for qqgg or qqqq process. | |
10418 | IC=0 | |
10419 | WTTOT=0. | |
10420 | 120 IC=IC+1 | |
10421 | IF(IT.EQ.1) THEN | |
10422 | WTA(IC)=(Y12*Y34**2-Y13*Y24*Y34+Y14*Y23*Y34+3.*Y12*Y23*Y34+ | |
10423 | & 3.*Y12*Y14*Y34+4.*Y12**2*Y34-Y13*Y23*Y24+2.*Y12*Y23*Y24- | |
10424 | & Y13*Y14*Y24-2.*Y12*Y13*Y24+2.*Y12**2*Y24+Y14*Y23**2+2.*Y12* | |
10425 | & Y23**2+Y14**2*Y23+4.*Y12*Y14*Y23+4.*Y12**2*Y23+2.*Y12*Y14**2+ | |
10426 | & 2.*Y12*Y13*Y14+4.*Y12**2*Y14+2.*Y12**2*Y13+2.*Y12**3)/(2.*Y13* | |
10427 | & Y134*Y234*Y24)+(Y24*Y34+Y12*Y34+Y13*Y24-Y14*Y23+Y12*Y13)/(Y13* | |
10428 | & Y134**2)+2.*Y23*(1.-Y13)/(Y13*Y134*Y24)+Y34/(2.*Y13*Y24) | |
10429 | WTB(IC)=(Y12*Y24*Y34+Y12*Y14*Y34-Y13*Y24**2+Y13*Y14*Y24+2.*Y12* | |
10430 | & Y14*Y24)/(Y13*Y134*Y23*Y14)+Y12*(1.+Y34)*Y124/(Y134*Y234*Y14* | |
10431 | & Y24)-(2.*Y13*Y24+Y14**2+Y13*Y23+2.*Y12*Y13)/(Y13*Y134*Y14)+ | |
10432 | & Y12*Y123*Y124/(2.*Y13*Y14*Y23*Y24) | |
10433 | WTC(IC)=-(5.*Y12*Y34**2+2.*Y12*Y24*Y34+2.*Y12*Y23*Y34+2.*Y12* | |
10434 | & Y14*Y34+2.*Y12*Y13*Y34+4.*Y12**2*Y34-Y13*Y24**2+Y14*Y23*Y24+ | |
10435 | & Y13*Y23*Y24+Y13*Y14*Y24-Y12*Y14*Y24-Y13**2*Y24-3.*Y12*Y13*Y24- | |
10436 | & Y14*Y23**2-Y14**2*Y23+Y13*Y14*Y23-3.*Y12*Y14*Y23-Y12*Y13*Y23)/ | |
10437 | & (4.*Y134*Y234*Y34**2)+(3.*Y12*Y34**2-3.*Y13*Y24*Y34+3.*Y12*Y24* | |
10438 | & Y34+3.*Y14*Y23*Y34-Y13*Y24**2-Y12*Y23*Y34+6.*Y12*Y14*Y34+2.*Y12* | |
10439 | & Y13*Y34-2.*Y12**2*Y34+Y14*Y23*Y24-3.*Y13*Y23*Y24-2.*Y13*Y14* | |
10440 | & Y24+4.*Y12*Y14*Y24+2.*Y12*Y13*Y24+3.*Y14*Y23**2+2.*Y14**2*Y23+ | |
10441 | & 2.*Y14**2*Y12+2.*Y12**2*Y14+6.*Y12*Y14*Y23-2.*Y12*Y13**2- | |
10442 | & 2.*Y12**2*Y13)/(4.*Y13*Y134*Y234*Y34) | |
10443 | WTC(IC)=WTC(IC)+(2.*Y12*Y34**2-2.*Y13*Y24*Y34+Y12*Y24*Y34+ | |
10444 | & 4.*Y13*Y23*Y34+4.*Y12*Y14*Y34+2.*Y12*Y13*Y34+2.*Y12**2*Y34- | |
10445 | & Y13*Y24**2+3.*Y14*Y23*Y24+4.*Y13*Y23*Y24-2.*Y13*Y14*Y24+ | |
10446 | & 4.*Y12*Y14*Y24+2.*Y12*Y13*Y24+2.*Y14*Y23**2+4.*Y13*Y23**2+ | |
10447 | & 2.*Y13*Y14*Y23+2.*Y12*Y14*Y23+4.*Y12*Y13*Y23+2.*Y12*Y14**2+4.* | |
10448 | & Y12**2*Y13+4.*Y12*Y13*Y14+2.*Y12**2*Y14)/(4.*Y13*Y134*Y24*Y34)- | |
10449 | & (Y12*Y34**2-2.*Y14*Y24*Y34-2.*Y13*Y24*Y34-Y14*Y23*Y34+Y13*Y23* | |
10450 | & Y34+Y12*Y14*Y34+2.*Y12*Y13*Y34-2.*Y14**2*Y24-4.*Y13*Y14*Y24- | |
10451 | & 4.*Y13**2*Y24-Y14**2*Y23-Y13**2*Y23+Y12*Y13*Y14-Y12*Y13**2)/ | |
10452 | & (2.*Y13*Y34*Y134**2)+(Y12*Y34**2-4.*Y14*Y24*Y34-2.*Y13*Y24*Y34- | |
10453 | & 2.*Y14*Y23*Y34-4.*Y13*Y23*Y34-4.*Y12*Y14*Y34-4.*Y12*Y13*Y34- | |
10454 | & 2.*Y13*Y14*Y24+2.*Y13**2*Y24+2.*Y14**2*Y23-2.*Y13*Y14*Y23- | |
10455 | & Y12*Y14**2-6.*Y12*Y13*Y14-Y12*Y13**2)/(4.*Y34**2*Y134**2) | |
10456 | WTTOT=WTTOT+Y34*CF*(CF*WTA(IC)+(CF-0.5*CN)*WTB(IC)+CN*WTC(IC))/ | |
10457 | & 8. | |
10458 | ELSE | |
10459 | WTD(IC)=(Y13*Y23*Y34+Y12*Y23*Y34-Y12**2*Y34+Y13*Y23*Y24+2.*Y12* | |
10460 | & Y23*Y24-Y14*Y23**2+Y12*Y13*Y24+Y12*Y14*Y23+Y12*Y13*Y14)/(Y13**2* | |
10461 | & Y123**2)-(Y12*Y34**2-Y13*Y24*Y34+Y12*Y24*Y34-Y14*Y23*Y34-Y12* | |
10462 | & Y23*Y34-Y13*Y24**2+Y14*Y23*Y24-Y13*Y23*Y24-Y13**2*Y24+Y14* | |
10463 | & Y23**2)/(Y13**2*Y123*Y134)+(Y13*Y14*Y12+Y34*Y14*Y12-Y34**2*Y12+ | |
10464 | & Y13*Y14*Y24+2.*Y34*Y14*Y24-Y23*Y14**2+Y34*Y13*Y24+Y34*Y23*Y14+ | |
10465 | & Y34*Y13*Y23)/(Y13**2*Y134**2)-(Y34*Y12**2-Y13*Y24*Y12+Y34*Y24* | |
10466 | & Y12-Y23*Y14*Y12-Y34*Y14*Y12-Y13*Y24**2+Y23*Y14*Y24-Y13*Y14*Y24- | |
10467 | & Y13**2*Y24+Y23*Y14**2)/(Y13**2*Y134*Y123) | |
10468 | WTE(IC)=(Y12*Y34*(Y23-Y24+Y14+Y13)+Y13*Y24**2-Y14*Y23*Y24+Y13* | |
10469 | & Y23*Y24+Y13*Y14*Y24+Y13**2*Y24-Y14*Y23*(Y14+Y23+Y13))/(Y13*Y23* | |
10470 | & Y123*Y134)-Y12*(Y12*Y34-Y23*Y24-Y13*Y24-Y14*Y23-Y14*Y13)/(Y13* | |
10471 | & Y23*Y123**2)-(Y14+Y13)*(Y24+Y23)*Y34/(Y13*Y23*Y134*Y234)+ | |
10472 | & (Y12*Y34*(Y14-Y24+Y23+Y13)+Y13*Y24**2-Y23*Y14*Y24+Y13*Y14*Y24+ | |
10473 | & Y13*Y23*Y24+Y13**2*Y24-Y23*Y14*(Y14+Y23+Y13))/(Y13*Y14*Y134* | |
10474 | & Y123)-Y34*(Y34*Y12-Y14*Y24-Y13*Y24-Y23*Y14-Y23*Y13)/(Y13*Y14* | |
10475 | & Y134**2)-(Y23+Y13)*(Y24+Y14)*Y12/(Y13*Y14*Y123*Y124) | |
10476 | WTTOT=WTTOT+CF*(TR*WTD(IC)+(CF-0.5*CN)*WTE(IC))/16. | |
10477 | ENDIF | |
10478 | ||
10479 | C...Permutations of momenta in matrix element. Weighting. | |
10480 | 130 IF(IC.EQ.1.OR.IC.EQ.3.OR.ID.EQ.2.OR.ID.EQ.3) THEN | |
10481 | YSAV=Y13 | |
10482 | Y13=Y14 | |
10483 | Y14=YSAV | |
10484 | YSAV=Y23 | |
10485 | Y23=Y24 | |
10486 | Y24=YSAV | |
10487 | YSAV=Y123 | |
10488 | Y123=Y124 | |
10489 | Y124=YSAV | |
10490 | ENDIF | |
10491 | IF(IC.EQ.2.OR.IC.EQ.4.OR.ID.EQ.3.OR.ID.EQ.4) THEN | |
10492 | YSAV=Y13 | |
10493 | Y13=Y23 | |
10494 | Y23=YSAV | |
10495 | YSAV=Y14 | |
10496 | Y14=Y24 | |
10497 | Y24=YSAV | |
10498 | YSAV=Y134 | |
10499 | Y134=Y234 | |
10500 | Y234=YSAV | |
10501 | ENDIF | |
10502 | IF(IC.LE.3) GOTO 120 | |
10503 | IF(ID.EQ.1.AND.WTTOT.LT.RLY(0)*WTMX) GOTO 110 | |
10504 | IC=5 | |
10505 | ||
10506 | C...qqgg events: string configuration and event type. | |
10507 | IF(IT.EQ.1) THEN | |
10508 | IF(MSTJ(109).EQ.0.AND.ID.EQ.1) THEN | |
10509 | PARJ(156)=Y34*(2.*(WTA(1)+WTA(2)+WTA(3)+WTA(4))+4.*(WTC(1)+ | |
10510 | & WTC(2)+WTC(3)+WTC(4)))/(9.*WTTOT) | |
10511 | IF(WTA(2)+WTA(4)+2.*(WTC(2)+WTC(4)).GT.RLY(0)*(WTA(1)+WTA(2)+ | |
10512 | & WTA(3)+WTA(4)+2.*(WTC(1)+WTC(2)+WTC(3)+WTC(4)))) ID=2 | |
10513 | IF(ID.EQ.2) GOTO 130 | |
10514 | ELSEIF(MSTJ(109).EQ.2.AND.ID.EQ.1) THEN | |
10515 | PARJ(156)=Y34*(WTA(1)+WTA(2)+WTA(3)+WTA(4))/(8.*WTTOT) | |
10516 | IF(WTA(2)+WTA(4).GT.RLY(0)*(WTA(1)+WTA(2)+WTA(3)+WTA(4))) ID=2 | |
10517 | IF(ID.EQ.2) GOTO 130 | |
10518 | ENDIF | |
10519 | MSTJ(120)=3 | |
10520 | IF(MSTJ(109).EQ.0.AND.0.5*Y34*(WTC(1)+WTC(2)+WTC(3)+WTC(4)).GT. | |
10521 | & RLY(0)*WTTOT) MSTJ(120)=4 | |
10522 | KFLN=21 | |
10523 | ||
10524 | C...Mass cuts. Kinematical variables out. | |
10525 | IF(Y12.LE.CUT+QME) NJET=2 | |
10526 | IF(NJET.EQ.2) GOTO 150 | |
10527 | Q12=0.5*(1.-SQRT(1.-QME/Y12)) | |
10528 | X1=1.-(1.-Q12)*Y234-Q12*Y134 | |
10529 | X4=1.-(1.-Q12)*Y134-Q12*Y234 | |
10530 | X2=1.-Y124 | |
10531 | X12=(1.-Q12)*Y13+Q12*Y23 | |
10532 | X14=Y12-0.5*QME | |
10533 | IF(Y134*Y234/((1.-X1)*(1.-X4)).LE.RLY(0)) NJET=2 | |
10534 | ||
10535 | C...qqbarqqbar events: string configuration, choose new flavour. | |
10536 | ELSE | |
10537 | IF(ID.EQ.1) THEN | |
10538 | WTR=RLY(0)*(WTD(1)+WTD(2)+WTD(3)+WTD(4)) | |
10539 | IF(WTR.LT.WTD(2)+WTD(3)+WTD(4)) ID=2 | |
10540 | IF(WTR.LT.WTD(3)+WTD(4)) ID=3 | |
10541 | IF(WTR.LT.WTD(4)) ID=4 | |
10542 | IF(ID.GE.2) GOTO 130 | |
10543 | ENDIF | |
10544 | MSTJ(120)=5 | |
10545 | PARJ(156)=CF*TR*(WTD(1)+WTD(2)+WTD(3)+WTD(4))/(16.*WTTOT) | |
10546 | 140 KFLN=1+INT(5.*RLY(0)) | |
10547 | IF(KFLN.NE.KFL.AND.0.2*PARJ(156).LE.RLY(0)) GOTO 140 | |
10548 | IF(KFLN.EQ.KFL.AND.1.-0.8*PARJ(156).LE.RLY(0)) GOTO 140 | |
10549 | IF(KFLN.GT.MSTJ(104)) NJET=2 | |
10550 | PMQN=UYMASS(KFLN) | |
10551 | QMEN=(2.*PMQN/ECM)**2 | |
10552 | ||
10553 | C...Mass cuts. Kinematical variables out. | |
10554 | IF(Y24.LE.CUT+QME.OR.Y13.LE.1.1*QMEN) NJET=2 | |
10555 | IF(NJET.EQ.2) GOTO 150 | |
10556 | Q24=0.5*(1.-SQRT(1.-QME/Y24)) | |
10557 | Q13=0.5*(1.-SQRT(1.-QMEN/Y13)) | |
10558 | X1=1.-(1.-Q24)*Y123-Q24*Y134 | |
10559 | X4=1.-(1.-Q24)*Y134-Q24*Y123 | |
10560 | X2=1.-(1.-Q13)*Y234-Q13*Y124 | |
10561 | X12=(1.-Q24)*((1.-Q13)*Y14+Q13*Y34)+Q24*((1.-Q13)*Y12+Q13*Y23) | |
10562 | X14=Y24-0.5*QME | |
10563 | X34=(1.-Q24)*((1.-Q13)*Y23+Q13*Y12)+Q24*((1.-Q13)*Y34+Q13*Y14) | |
10564 | IF(PMQ**2+PMQN**2+MIN(X12,X34)*ECM**2.LE. | |
10565 | & (PARJ(127)+PMQ+PMQN)**2) NJET=2 | |
10566 | IF(Y123*Y134/((1.-X1)*(1.-X4)).LE.RLY(0)) NJET=2 | |
10567 | ENDIF | |
10568 | 150 IF(MSTJ(101).LE.-2.AND.NJET.EQ.2) GOTO 100 | |
10569 | ||
10570 | RETURN | |
10571 | END | |
10572 | ||
10573 | C********************************************************************* | |
10574 | ||
10575 | SUBROUTINE LYXDIF(NC,NJET,KFL,ECM,CHI,THE,PHI) | |
10576 | ||
10577 | C...Purpose: to give the angular orientation of events. | |
10578 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
10579 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
10580 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
10581 | SAVE /LYJETS/,/LYDAT1/,/LYDAT2/ | |
10582 | ||
10583 | C...Charge. Factors depending on polarization for QED case. | |
10584 | QF=KCHG(KFL,1)/3. | |
10585 | POLL=1.-PARJ(131)*PARJ(132) | |
10586 | POLD=PARJ(132)-PARJ(131) | |
10587 | IF(MSTJ(102).LE.1.OR.MSTJ(109).EQ.1) THEN | |
10588 | HF1=POLL | |
10589 | HF2=0. | |
10590 | HF3=PARJ(133)**2 | |
10591 | HF4=0. | |
10592 | ||
10593 | C...Factors depending on flavour, energy and polarization for QFD case. | |
10594 | ELSE | |
10595 | SFF=1./(16.*PARU(102)*(1.-PARU(102))) | |
10596 | SFW=ECM**4/((ECM**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2) | |
10597 | SFI=SFW*(1.-(PARJ(123)/ECM)**2) | |
10598 | AE=-1. | |
10599 | VE=4.*PARU(102)-1. | |
10600 | AF=SIGN(1.,QF) | |
10601 | VF=AF-4.*QF*PARU(102) | |
10602 | HF1=QF**2*POLL-2.*QF*VF*SFI*SFF*(VE*POLL-AE*POLD)+ | |
10603 | & (VF**2+AF**2)*SFW*SFF**2*((VE**2+AE**2)*POLL-2.*VE*AE*POLD) | |
10604 | HF2=-2.*QF*AF*SFI*SFF*(AE*POLL-VE*POLD)+2.*VF*AF*SFW*SFF**2* | |
10605 | & (2.*VE*AE*POLL-(VE**2+AE**2)*POLD) | |
10606 | HF3=PARJ(133)**2*(QF**2-2.*QF*VF*SFI*SFF*VE+(VF**2+AF**2)* | |
10607 | & SFW*SFF**2*(VE**2-AE**2)) | |
10608 | HF4=-PARJ(133)**2*2.*QF*VF*SFW*(PARJ(123)*PARJ(124)/ECM**2)* | |
10609 | & SFF*AE | |
10610 | ENDIF | |
10611 | ||
10612 | C...Mass factor. Differential cross-sections for two-jet events. | |
10613 | SQ2=SQRT(2.) | |
10614 | QME=0. | |
10615 | IF(MSTJ(103).GE.4.AND.IABS(MSTJ(101)).LE.1.AND.MSTJ(102).LE.1.AND. | |
10616 | &MSTJ(109).NE.1) QME=(2.*UYMASS(KFL)/ECM)**2 | |
10617 | IF(NJET.EQ.2) THEN | |
10618 | SIGU=4.*SQRT(1.-QME) | |
10619 | SIGL=2.*QME*SQRT(1.-QME) | |
10620 | SIGT=0. | |
10621 | SIGI=0. | |
10622 | SIGA=0. | |
10623 | SIGP=4. | |
10624 | ||
10625 | C...Kinematical variables. Reduce four-jet event to three-jet one. | |
10626 | ELSE | |
10627 | IF(NJET.EQ.3) THEN | |
10628 | X1=2.*P(NC+1,4)/ECM | |
10629 | X2=2.*P(NC+3,4)/ECM | |
10630 | ELSE | |
10631 | ECMR=P(NC+1,4)+P(NC+4,4)+SQRT((P(NC+2,1)+P(NC+3,1))**2+ | |
10632 | & (P(NC+2,2)+P(NC+3,2))**2+(P(NC+2,3)+P(NC+3,3))**2) | |
10633 | X1=2.*P(NC+1,4)/ECMR | |
10634 | X2=2.*P(NC+4,4)/ECMR | |
10635 | ENDIF | |
10636 | ||
10637 | C...Differential cross-sections for three-jet (or reduced four-jet). | |
10638 | XQ=(1.-X1)/(1.-X2) | |
10639 | CT12=(X1*X2-2.*X1-2.*X2+2.+QME)/SQRT((X1**2-QME)*(X2**2-QME)) | |
10640 | ST12=SQRT(1.-CT12**2) | |
10641 | IF(MSTJ(109).NE.1) THEN | |
10642 | SIGU=2.*X1**2+X2**2*(1.+CT12**2)-QME*(3.+CT12**2-X1-X2)- | |
10643 | & QME*X1/XQ+0.5*QME*((X2**2-QME)*ST12**2-2.*X2)*XQ | |
10644 | SIGL=(X2*ST12)**2-QME*(3.-CT12**2-2.5*(X1+X2)+X1*X2+QME)+ | |
10645 | & 0.5*QME*(X1**2-X1-QME)/XQ+0.5*QME*((X2**2-QME)*CT12**2-X2)*XQ | |
10646 | SIGT=0.5*(X2**2-QME-0.5*QME*(X2**2-QME)/XQ)*ST12**2 | |
10647 | SIGI=((1.-0.5*QME*XQ)*(X2**2-QME)*ST12*CT12+QME*(1.-X1-X2+ | |
10648 | & 0.5*X1*X2+0.5*QME)*ST12/CT12)/SQ2 | |
10649 | SIGA=X2**2*ST12/SQ2 | |
10650 | SIGP=2.*(X1**2-X2**2*CT12) | |
10651 | ||
10652 | C...Differential cross-sect for scalar gluons (no mass effects). | |
10653 | ELSE | |
10654 | X3=2.-X1-X2 | |
10655 | XT=X2*ST12 | |
10656 | CT13=SQRT(MAX(0.,1.-(XT/X3)**2)) | |
10657 | SIGU=(1.-PARJ(171))*(X3**2-0.5*XT**2)+ | |
10658 | & PARJ(171)*(X3**2-0.5*XT**2-4.*(1.-X1)*(1.-X2)**2/X1) | |
10659 | SIGL=(1.-PARJ(171))*0.5*XT**2+ | |
10660 | & PARJ(171)*0.5*(1.-X1)**2*XT**2 | |
10661 | SIGT=(1.-PARJ(171))*0.25*XT**2+ | |
10662 | & PARJ(171)*0.25*XT**2*(1.-2.*X1) | |
10663 | SIGI=-(0.5/SQ2)*((1.-PARJ(171))*XT*X3*CT13+ | |
10664 | & PARJ(171)*XT*((1.-2.*X1)*X3*CT13-X1*(X1-X2))) | |
10665 | SIGA=(0.25/SQ2)*XT*(2.*(1.-X1)-X1*X3) | |
10666 | SIGP=X3**2-2.*(1.-X1)*(1.-X2)/X1 | |
10667 | ENDIF | |
10668 | ENDIF | |
10669 | ||
10670 | C...Upper bounds for differential cross-section. | |
10671 | HF1A=ABS(HF1) | |
10672 | HF2A=ABS(HF2) | |
10673 | HF3A=ABS(HF3) | |
10674 | HF4A=ABS(HF4) | |
10675 | SIGMAX=(2.*HF1A+HF3A+HF4A)*ABS(SIGU)+2.*(HF1A+HF3A+HF4A)* | |
10676 | &ABS(SIGL)+2.*(HF1A+2.*HF3A+2.*HF4A)*ABS(SIGT)+2.*SQ2* | |
10677 | &(HF1A+2.*HF3A+2.*HF4A)*ABS(SIGI)+4.*SQ2*HF2A*ABS(SIGA)+ | |
10678 | &2.*HF2A*ABS(SIGP) | |
10679 | ||
10680 | C...Generate angular orientation according to differential cross-sect. | |
10681 | 100 CHI=PARU(2)*RLY(0) | |
10682 | CTHE=2.*RLY(0)-1. | |
10683 | PHI=PARU(2)*RLY(0) | |
10684 | CCHI=COS(CHI) | |
10685 | SCHI=SIN(CHI) | |
10686 | C2CHI=COS(2.*CHI) | |
10687 | S2CHI=SIN(2.*CHI) | |
10688 | THE=ACOS(CTHE) | |
10689 | STHE=SIN(THE) | |
10690 | C2PHI=COS(2.*(PHI-PARJ(134))) | |
10691 | S2PHI=SIN(2.*(PHI-PARJ(134))) | |
10692 | SIG=((1.+CTHE**2)*HF1+STHE**2*(C2PHI*HF3-S2PHI*HF4))*SIGU+ | |
10693 | &2.*(STHE**2*HF1-STHE**2*(C2PHI*HF3-S2PHI*HF4))*SIGL+ | |
10694 | &2.*(STHE**2*C2CHI*HF1+((1.+CTHE**2)*C2CHI*C2PHI-2.*CTHE*S2CHI* | |
10695 | &S2PHI)*HF3-((1.+CTHE**2)*C2CHI*S2PHI+2.*CTHE*S2CHI*C2PHI)*HF4)* | |
10696 | &SIGT-2.*SQ2*(2.*STHE*CTHE*CCHI*HF1-2.*STHE*(CTHE*CCHI*C2PHI- | |
10697 | &SCHI*S2PHI)*HF3+2.*STHE*(CTHE*CCHI*S2PHI+SCHI*C2PHI)*HF4)*SIGI+ | |
10698 | &4.*SQ2*STHE*CCHI*HF2*SIGA+2.*CTHE*HF2*SIGP | |
10699 | IF(SIG.LT.SIGMAX*RLY(0)) GOTO 100 | |
10700 | ||
10701 | RETURN | |
10702 | END | |
10703 | ||
10704 | C********************************************************************* | |
10705 | ||
10706 | SUBROUTINE LYONIA(KFL,ECM) | |
10707 | ||
10708 | C...Purpose: to generate Upsilon and toponium decays into three | |
10709 | C...gluons or two gluons and a photon. | |
10710 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
10711 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
10712 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
10713 | SAVE /LYJETS/,/LYDAT1/,/LYDAT2/ | |
10714 | ||
10715 | C...Printout. Check input parameters. | |
10716 | IF(MSTU(12).GE.1) CALL LYLIST(0) | |
10717 | IF(KFL.LT.0.OR.KFL.GT.8) THEN | |
10718 | CALL LYERRM(16,'(LYONIA:) called with unknown flavour code') | |
10719 | IF(MSTU(21).GE.1) RETURN | |
10720 | ENDIF | |
10721 | IF(ECM.LT.PARJ(127)+2.02*PARF(101)) THEN | |
10722 | CALL LYERRM(16,'(LYONIA:) called with too small CM energy') | |
10723 | IF(MSTU(21).GE.1) RETURN | |
10724 | ENDIF | |
10725 | ||
10726 | C...Initial e+e- and onium state (optional). | |
10727 | NC=0 | |
10728 | IF(MSTJ(115).GE.2) THEN | |
10729 | NC=NC+2 | |
10730 | CALL LY1ENT(NC-1,11,0.5*ECM,0.,0.) | |
10731 | K(NC-1,1)=21 | |
10732 | CALL LY1ENT(NC,-11,0.5*ECM,PARU(1),0.) | |
10733 | K(NC,1)=21 | |
10734 | ENDIF | |
10735 | KFLC=IABS(KFL) | |
10736 | IF(MSTJ(115).GE.3.AND.KFLC.GE.5) THEN | |
10737 | NC=NC+1 | |
10738 | KF=110*KFLC+3 | |
10739 | MSTU10=MSTU(10) | |
10740 | MSTU(10)=1 | |
10741 | P(NC,5)=ECM | |
10742 | CALL LY1ENT(NC,KF,ECM,0.,0.) | |
10743 | K(NC,1)=21 | |
10744 | K(NC,3)=1 | |
10745 | MSTU(10)=MSTU10 | |
10746 | ENDIF | |
10747 | ||
10748 | C...Choose x1 and x2 according to matrix element. | |
10749 | NTRY=0 | |
10750 | 100 X1=RLY(0) | |
10751 | X2=RLY(0) | |
10752 | X3=2.-X1-X2 | |
10753 | IF(X3.GE.1..OR.((1.-X1)/(X2*X3))**2+((1.-X2)/(X1*X3))**2+ | |
10754 | &((1.-X3)/(X1*X2))**2.LE.2.*RLY(0)) GOTO 100 | |
10755 | NTRY=NTRY+1 | |
10756 | NJET=3 | |
10757 | IF(MSTJ(101).LE.4) CALL LY3ENT(NC+1,21,21,21,ECM,X1,X3) | |
10758 | IF(MSTJ(101).GE.5) CALL LY3ENT(-(NC+1),21,21,21,ECM,X1,X3) | |
10759 | ||
10760 | C...Photon-gluon-gluon events. Small system modifications. Jet origin. | |
10761 | MSTU(111)=MSTJ(108) | |
10762 | IF(MSTJ(108).EQ.2.AND.(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.1)) | |
10763 | &MSTU(111)=1 | |
10764 | PARU(112)=PARJ(121) | |
10765 | IF(MSTU(111).EQ.2) PARU(112)=PARJ(122) | |
10766 | QF=0. | |
10767 | IF(KFLC.NE.0) QF=KCHG(KFLC,1)/3. | |
10768 | RGAM=7.2*QF**2*PARU(101)/UYALPS(ECM**2) | |
10769 | MK=0 | |
10770 | ECMC=ECM | |
10771 | IF(RLY(0).GT.RGAM/(1.+RGAM)) THEN | |
10772 | IF(1.-MAX(X1,X2,X3).LE.MAX((PARJ(126)/ECM)**2,PARJ(125))) | |
10773 | & NJET=2 | |
10774 | IF(NJET.EQ.2.AND.MSTJ(101).LE.4) CALL LY2ENT(NC+1,21,21,ECM) | |
10775 | IF(NJET.EQ.2.AND.MSTJ(101).GE.5) CALL LY2ENT(-(NC+1),21,21,ECM) | |
10776 | ELSE | |
10777 | MK=1 | |
10778 | ECMC=SQRT(1.-X1)*ECM | |
10779 | IF(ECMC.LT.2.*PARJ(127)) GOTO 100 | |
10780 | K(NC+1,1)=1 | |
10781 | K(NC+1,2)=22 | |
10782 | K(NC+1,4)=0 | |
10783 | K(NC+1,5)=0 | |
10784 | IF(MSTJ(101).GE.5) K(NC+2,4)=MSTU(5)*(NC+3) | |
10785 | IF(MSTJ(101).GE.5) K(NC+2,5)=MSTU(5)*(NC+3) | |
10786 | IF(MSTJ(101).GE.5) K(NC+3,4)=MSTU(5)*(NC+2) | |
10787 | IF(MSTJ(101).GE.5) K(NC+3,5)=MSTU(5)*(NC+2) | |
10788 | NJET=2 | |
10789 | IF(ECMC.LT.4.*PARJ(127)) THEN | |
10790 | MSTU10=MSTU(10) | |
10791 | MSTU(10)=1 | |
10792 | P(NC+2,5)=ECMC | |
10793 | CALL LY1ENT(NC+2,83,0.5*(X2+X3)*ECM,PARU(1),0.) | |
10794 | MSTU(10)=MSTU10 | |
10795 | NJET=0 | |
10796 | ENDIF | |
10797 | ENDIF | |
10798 | DO 110 IP=NC+1,N | |
10799 | K(IP,3)=K(IP,3)+(MSTJ(115)/2)+(KFLC/5)*(MSTJ(115)/3)*(NC-1) | |
10800 | 110 CONTINUE | |
10801 | ||
10802 | C...Differential cross-sections. Upper limit for cross-section. | |
10803 | IF(MSTJ(106).EQ.1) THEN | |
10804 | SQ2=SQRT(2.) | |
10805 | HF1=1.-PARJ(131)*PARJ(132) | |
10806 | HF3=PARJ(133)**2 | |
10807 | CT13=(X1*X3-2.*X1-2.*X3+2.)/(X1*X3) | |
10808 | ST13=SQRT(1.-CT13**2) | |
10809 | SIGL=0.5*X3**2*((1.-X2)**2+(1.-X3)**2)*ST13**2 | |
10810 | SIGU=(X1*(1.-X1))**2+(X2*(1.-X2))**2+(X3*(1.-X3))**2-SIGL | |
10811 | SIGT=0.5*SIGL | |
10812 | SIGI=(SIGL*CT13/ST13+0.5*X1*X3*(1.-X2)**2*ST13)/SQ2 | |
10813 | SIGMAX=(2.*HF1+HF3)*ABS(SIGU)+2.*(HF1+HF3)*ABS(SIGL)+2.*(HF1+ | |
10814 | & 2.*HF3)*ABS(SIGT)+2.*SQ2*(HF1+2.*HF3)*ABS(SIGI) | |
10815 | ||
10816 | C...Angular orientation of event. | |
10817 | 120 CHI=PARU(2)*RLY(0) | |
10818 | CTHE=2.*RLY(0)-1. | |
10819 | PHI=PARU(2)*RLY(0) | |
10820 | CCHI=COS(CHI) | |
10821 | SCHI=SIN(CHI) | |
10822 | C2CHI=COS(2.*CHI) | |
10823 | S2CHI=SIN(2.*CHI) | |
10824 | THE=ACOS(CTHE) | |
10825 | STHE=SIN(THE) | |
10826 | C2PHI=COS(2.*(PHI-PARJ(134))) | |
10827 | S2PHI=SIN(2.*(PHI-PARJ(134))) | |
10828 | SIG=((1.+CTHE**2)*HF1+STHE**2*C2PHI*HF3)*SIGU+2.*(STHE**2*HF1- | |
10829 | & STHE**2*C2PHI*HF3)*SIGL+2.*(STHE**2*C2CHI*HF1+((1.+CTHE**2)* | |
10830 | & C2CHI*C2PHI-2.*CTHE*S2CHI*S2PHI)*HF3)*SIGT-2.*SQ2*(2.*STHE*CTHE* | |
10831 | & CCHI*HF1-2.*STHE*(CTHE*CCHI*C2PHI-SCHI*S2PHI)*HF3)*SIGI | |
10832 | IF(SIG.LT.SIGMAX*RLY(0)) GOTO 120 | |
10833 | CALL LUDBRB(NC+1,N,0.,CHI,0D0,0D0,0D0) | |
10834 | CALL LUDBRB(NC+1,N,THE,PHI,0D0,0D0,0D0) | |
10835 | ENDIF | |
10836 | ||
10837 | C...Generate parton shower. Rearrange along strings and check. | |
10838 | IF(MSTJ(101).GE.5.AND.NJET.GE.2) THEN | |
10839 | CALL LYSHOW(NC+MK+1,-NJET,ECMC) | |
10840 | MSTJ14=MSTJ(14) | |
10841 | IF(MSTJ(105).EQ.-1) MSTJ(14)=-1 | |
10842 | IF(MSTJ(105).GE.0) MSTU(28)=0 | |
10843 | CALL LYPREP(0) | |
10844 | MSTJ(14)=MSTJ14 | |
10845 | IF(MSTJ(105).GE.0.AND.MSTU(28).NE.0) GOTO 100 | |
10846 | ENDIF | |
10847 | ||
10848 | C...Generate fragmentation. Information for LYTABU: | |
10849 | IF(MSTJ(105).EQ.1) CALL LYEXEC | |
10850 | MSTU(161)=110*KFLC+3 | |
10851 | MSTU(162)=0 | |
10852 | ||
10853 | RETURN | |
10854 | END | |
10855 | ||
10856 | C********************************************************************* | |
10857 | ||
10858 | SUBROUTINE LYHEPC(MCONV) | |
10859 | ||
10860 | C...Purpose: to convert JETSET event record contents to or from | |
10861 | C...the standard event record commonblock. | |
10862 | C...Note that HEPEVT is in double precision according to LEP 2 standard. | |
10863 | C...W. H. Bell --- Changed HEPEVT common block to match EvtGen. | |
10864 | PARAMETER (NMXHEP=4000) | |
10865 | COMMON/XHEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), | |
10866 | &JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP) | |
10867 | REAL*8 PHEP,VHEP | |
10868 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
10869 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
10870 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
10871 | SAVE /XHEPEVT/ | |
10872 | SAVE /LYJETS/,/LYDAT1/,/LYDAT2/ | |
10873 | ||
10874 | C...Conversion from JETSET to standard, the easy part. | |
10875 | IF(MCONV.EQ.1) THEN | |
10876 | NEVHEP=0 | |
10877 | IF(N.GT.NMXHEP) CALL LYERRM(8, | |
10878 | & '(LYHEPC:) no more space in /HEPEVT/') | |
10879 | NHEP=MIN(N,NMXHEP) | |
10880 | DO 140 I=1,NHEP | |
10881 | ISTHEP(I)=0 | |
10882 | IF(K(I,1).GE.1.AND.K(I,1).LE.10) ISTHEP(I)=1 | |
10883 | IF(K(I,1).GE.11.AND.K(I,1).LE.20) ISTHEP(I)=2 | |
10884 | IF(K(I,1).GE.21.AND.K(I,1).LE.30) ISTHEP(I)=3 | |
10885 | IF(K(I,1).GE.31.AND.K(I,1).LE.100) ISTHEP(I)=K(I,1) | |
10886 | IDHEP(I)=K(I,2) | |
10887 | JMOHEP(1,I)=K(I,3) | |
10888 | JMOHEP(2,I)=0 | |
10889 | IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) THEN | |
10890 | JDAHEP(1,I)=K(I,4) | |
10891 | JDAHEP(2,I)=K(I,5) | |
10892 | ELSE | |
10893 | JDAHEP(1,I)=0 | |
10894 | JDAHEP(2,I)=0 | |
10895 | ENDIF | |
10896 | DO 100 J=1,5 | |
10897 | PHEP(J,I)=P(I,J) | |
10898 | 100 CONTINUE | |
10899 | DO 110 J=1,4 | |
10900 | VHEP(J,I)=V(I,J) | |
10901 | 110 CONTINUE | |
10902 | ||
10903 | C...Check if new event (from pileup). | |
10904 | IF(I.EQ.1) THEN | |
10905 | INEW=1 | |
10906 | ELSE | |
10907 | IF(K(I,1).EQ.21.AND.K(I-1,1).NE.21) INEW=I | |
10908 | ENDIF | |
10909 | ||
10910 | C...Fill in missing mother information. | |
10911 | IF(I.GE.INEW+2.AND.K(I,1).EQ.21.AND.K(I,3).EQ.0) THEN | |
10912 | IMO1=I-2 | |
10913 | IF(I.GE.INEW+3.AND.K(I-1,1).EQ.21.AND.K(I-1,3).EQ.0) | |
10914 | & IMO1=IMO1-1 | |
10915 | JMOHEP(1,I)=IMO1 | |
10916 | JMOHEP(2,I)=IMO1+1 | |
10917 | ELSEIF(K(I,2).GE.91.AND.K(I,2).LE.93) THEN | |
10918 | I1=K(I,3)-1 | |
10919 | 120 I1=I1+1 | |
10920 | IF(I1.GE.I) CALL LYERRM(8, | |
10921 | & '(LYHEPC:) translation of inconsistent event history') | |
10922 | IF(I1.LT.I.AND.K(I1,1).NE.1.AND.K(I1,1).NE.11) GOTO 120 | |
10923 | KC=LYCOMP(K(I1,2)) | |
10924 | IF(I1.LT.I.AND.KC.EQ.0) GOTO 120 | |
10925 | IF(I1.LT.I.AND.KCHG(KC,2).EQ.0) GOTO 120 | |
10926 | JMOHEP(2,I)=I1 | |
10927 | ELSEIF(K(I,2).EQ.94) THEN | |
10928 | NJET=2 | |
10929 | IF(NHEP.GE.I+3.AND.K(I+3,3).LE.I) NJET=3 | |
10930 | IF(NHEP.GE.I+4.AND.K(I+4,3).LE.I) NJET=4 | |
10931 | JMOHEP(2,I)=MOD(K(I+NJET,4)/MSTU(5),MSTU(5)) | |
10932 | IF(JMOHEP(2,I).EQ.JMOHEP(1,I)) JMOHEP(2,I)= | |
10933 | & MOD(K(I+1,4)/MSTU(5),MSTU(5)) | |
10934 | ENDIF | |
10935 | ||
10936 | C...Fill in missing daughter information. | |
10937 | IF(K(I,2).EQ.94.AND.MSTU(16).NE.2) THEN | |
10938 | DO 130 I1=JDAHEP(1,I),JDAHEP(2,I) | |
10939 | I2=MOD(K(I1,4)/MSTU(5),MSTU(5)) | |
10940 | JDAHEP(1,I2)=I | |
10941 | 130 CONTINUE | |
10942 | ENDIF | |
10943 | IF(K(I,2).GE.91.AND.K(I,2).LE.94) GOTO 140 | |
10944 | I1=JMOHEP(1,I) | |
10945 | IF(I1.LE.0.OR.I1.GT.NHEP) GOTO 140 | |
10946 | IF(K(I1,1).NE.13.AND.K(I1,1).NE.14) GOTO 140 | |
10947 | IF(JDAHEP(1,I1).EQ.0) THEN | |
10948 | JDAHEP(1,I1)=I | |
10949 | ELSE | |
10950 | JDAHEP(2,I1)=I | |
10951 | ENDIF | |
10952 | 140 CONTINUE | |
10953 | DO 150 I=1,NHEP | |
10954 | IF(K(I,1).NE.13.AND.K(I,1).NE.14) GOTO 150 | |
10955 | IF(JDAHEP(2,I).EQ.0) JDAHEP(2,I)=JDAHEP(1,I) | |
10956 | 150 CONTINUE | |
10957 | ||
10958 | C...Conversion from standard to JETSET, the easy part. | |
10959 | ELSE | |
10960 | IF(NHEP.GT.MSTU(4)) CALL LYERRM(8, | |
10961 | & '(LYHEPC:) no more space in /LYJETS/') | |
10962 | N=MIN(NHEP,MSTU(4)) | |
10963 | NKQ=0 | |
10964 | KQSUM=0 | |
10965 | DO 180 I=1,N | |
10966 | K(I,1)=0 | |
10967 | IF(ISTHEP(I).EQ.1) K(I,1)=1 | |
10968 | IF(ISTHEP(I).EQ.2) K(I,1)=11 | |
10969 | IF(ISTHEP(I).EQ.3) K(I,1)=21 | |
10970 | K(I,2)=IDHEP(I) | |
10971 | K(I,3)=JMOHEP(1,I) | |
10972 | K(I,4)=JDAHEP(1,I) | |
10973 | K(I,5)=JDAHEP(2,I) | |
10974 | DO 160 J=1,5 | |
10975 | P(I,J)=PHEP(J,I) | |
10976 | 160 CONTINUE | |
10977 | DO 170 J=1,4 | |
10978 | V(I,J)=VHEP(J,I) | |
10979 | 170 CONTINUE | |
10980 | V(I,5)=0. | |
10981 | IF(ISTHEP(I).EQ.2.AND.PHEP(4,I).GT.PHEP(5,I)) THEN | |
10982 | I1=JDAHEP(1,I) | |
10983 | IF(I1.GT.0.AND.I1.LE.NHEP) V(I,5)=(VHEP(4,I1)-VHEP(4,I))* | |
10984 | & PHEP(5,I)/PHEP(4,I) | |
10985 | ENDIF | |
10986 | ||
10987 | C...Fill in missing information on colour connection in jet systems. | |
10988 | IF(ISTHEP(I).EQ.1) THEN | |
10989 | KC=LYCOMP(K(I,2)) | |
10990 | KQ=0 | |
10991 | IF(KC.NE.0) KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) | |
10992 | IF(KQ.NE.0) NKQ=NKQ+1 | |
10993 | IF(KQ.NE.2) KQSUM=KQSUM+KQ | |
10994 | IF(KQ.NE.0.AND.KQSUM.NE.0) THEN | |
10995 | K(I,1)=2 | |
10996 | ELSEIF(KQ.EQ.2.AND.I.LT.N) THEN | |
10997 | IF(K(I+1,2).EQ.21) K(I,1)=2 | |
10998 | ENDIF | |
10999 | ENDIF | |
11000 | 180 CONTINUE | |
11001 | IF(NKQ.EQ.1.OR.KQSUM.NE.0) CALL LYERRM(8, | |
11002 | & '(LYHEPC:) input parton configuration not colour singlet') | |
11003 | ENDIF | |
11004 | ||
11005 | END | |
11006 | ||
11007 | C********************************************************************* | |
11008 | ||
11009 | SUBROUTINE LYTEST(MTEST) | |
11010 | ||
11011 | C...Purpose: to provide a simple program (disguised as subroutine) to | |
11012 | C...run at installation as a check that the program works as intended. | |
11013 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
11014 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
11015 | SAVE /LYJETS/,/LYDAT1/ | |
11016 | DIMENSION PSUM(5),PINI(6),PFIN(6) | |
11017 | ||
11018 | C...Loop over events to be generated. | |
11019 | IF(MTEST.GE.1) CALL LYTABU(20) | |
11020 | NERR=0 | |
11021 | DO 180 IEV=1,600 | |
11022 | ||
11023 | C...Reset parameter values. Switch on some nonstandard features. | |
11024 | MSTJ(1)=1 | |
11025 | MSTJ(3)=0 | |
11026 | MSTJ(11)=1 | |
11027 | MSTJ(42)=2 | |
11028 | MSTJ(43)=4 | |
11029 | MSTJ(44)=2 | |
11030 | PARJ(17)=0.1 | |
11031 | PARJ(22)=1.5 | |
11032 | PARJ(43)=1. | |
11033 | PARJ(54)=-0.05 | |
11034 | MSTJ(101)=5 | |
11035 | MSTJ(104)=5 | |
11036 | MSTJ(105)=0 | |
11037 | MSTJ(107)=1 | |
11038 | IF(IEV.EQ.301.OR.IEV.EQ.351.OR.IEV.EQ.401) MSTJ(116)=3 | |
11039 | ||
11040 | C...Ten events each for some single jets configurations. | |
11041 | IF(IEV.LE.50) THEN | |
11042 | ITY=(IEV+9)/10 | |
11043 | MSTJ(3)=-1 | |
11044 | IF(ITY.EQ.3.OR.ITY.EQ.4) MSTJ(11)=2 | |
11045 | IF(ITY.EQ.1) CALL LY1ENT(1,1,15.,0.,0.) | |
11046 | IF(ITY.EQ.2) CALL LY1ENT(1,3101,15.,0.,0.) | |
11047 | IF(ITY.EQ.3) CALL LY1ENT(1,-2203,15.,0.,0.) | |
11048 | IF(ITY.EQ.4) CALL LY1ENT(1,-4,30.,0.,0.) | |
11049 | IF(ITY.EQ.5) CALL LY1ENT(1,21,15.,0.,0.) | |
11050 | ||
11051 | C...Ten events each for some simple jet systems; string fragmentation. | |
11052 | ELSEIF(IEV.LE.130) THEN | |
11053 | ITY=(IEV-41)/10 | |
11054 | IF(ITY.EQ.1) CALL LY2ENT(1,1,-1,40.) | |
11055 | IF(ITY.EQ.2) CALL LY2ENT(1,4,-4,30.) | |
11056 | IF(ITY.EQ.3) CALL LY2ENT(1,2,2103,100.) | |
11057 | IF(ITY.EQ.4) CALL LY2ENT(1,21,21,40.) | |
11058 | IF(ITY.EQ.5) CALL LY3ENT(1,2101,21,-3203,30.,0.6,0.8) | |
11059 | IF(ITY.EQ.6) CALL LY3ENT(1,5,21,-5,40.,0.9,0.8) | |
11060 | IF(ITY.EQ.7) CALL LY3ENT(1,21,21,21,60.,0.7,0.5) | |
11061 | IF(ITY.EQ.8) CALL LY4ENT(1,2,21,21,-2,40.,0.4,0.64,0.6,0.12,0.2) | |
11062 | ||
11063 | C...Seventy events with independent fragmentation and momentum cons. | |
11064 | ELSEIF(IEV.LE.200) THEN | |
11065 | ITY=1+(IEV-131)/16 | |
11066 | MSTJ(2)=1+MOD(IEV-131,4) | |
11067 | MSTJ(3)=1+MOD((IEV-131)/4,4) | |
11068 | IF(ITY.EQ.1) CALL LY2ENT(1,4,-5,40.) | |
11069 | IF(ITY.EQ.2) CALL LY3ENT(1,3,21,-3,40.,0.9,0.4) | |
11070 | IF(ITY.EQ.3) CALL LY4ENT(1,2,21,21,-2,40.,0.4,0.64,0.6,0.12,0.2) | |
11071 | IF(ITY.GE.4) CALL LY4ENT(1,2,-3,3,-2,40.,0.4,0.64,0.6,0.12,0.2) | |
11072 | ||
11073 | C...A hundred events with random jets (check invariant mass). | |
11074 | ELSEIF(IEV.LE.300) THEN | |
11075 | 100 DO 110 J=1,5 | |
11076 | PSUM(J)=0. | |
11077 | 110 CONTINUE | |
11078 | NJET=2.+6.*RLY(0) | |
11079 | DO 130 I=1,NJET | |
11080 | KFL=21 | |
11081 | IF(I.EQ.1) KFL=INT(1.+4.*RLY(0)) | |
11082 | IF(I.EQ.NJET) KFL=-INT(1.+4.*RLY(0)) | |
11083 | EJET=5.+20.*RLY(0) | |
11084 | THETA=ACOS(2.*RLY(0)-1.) | |
11085 | PHI=6.2832*RLY(0) | |
11086 | IF(I.LT.NJET) CALL LY1ENT(-I,KFL,EJET,THETA,PHI) | |
11087 | IF(I.EQ.NJET) CALL LY1ENT(I,KFL,EJET,THETA,PHI) | |
11088 | IF(I.EQ.1.OR.I.EQ.NJET) MSTJ(93)=1 | |
11089 | IF(I.EQ.1.OR.I.EQ.NJET) PSUM(5)=PSUM(5)+UYMASS(KFL) | |
11090 | DO 120 J=1,4 | |
11091 | PSUM(J)=PSUM(J)+P(I,J) | |
11092 | 120 CONTINUE | |
11093 | 130 CONTINUE | |
11094 | IF(PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-PSUM(3)**2.LT. | |
11095 | & (PSUM(5)+PARJ(32))**2) GOTO 100 | |
11096 | ||
11097 | C...Fifty e+e- continuum events with matrix elements. | |
11098 | ELSEIF(IEV.LE.350) THEN | |
11099 | MSTJ(101)=2 | |
11100 | CALL LYEEVT(0,40.) | |
11101 | ||
11102 | C...Fifty e+e- continuum event with varying shower options. | |
11103 | ELSEIF(IEV.LE.400) THEN | |
11104 | MSTJ(42)=1+MOD(IEV,2) | |
11105 | MSTJ(43)=1+MOD(IEV/2,4) | |
11106 | MSTJ(44)=MOD(IEV/8,3) | |
11107 | CALL LYEEVT(0,90.) | |
11108 | ||
11109 | C...Fifty e+e- continuum events with coherent shower, including top. | |
11110 | ELSEIF(IEV.LE.450) THEN | |
11111 | MSTJ(104)=6 | |
11112 | CALL LYEEVT(0,500.) | |
11113 | ||
11114 | C...Fifty Upsilon decays to ggg or gammagg with coherent shower. | |
11115 | ELSEIF(IEV.LE.500) THEN | |
11116 | CALL LYONIA(5,9.46) | |
11117 | ||
11118 | C...One decay each for some heavy mesons. | |
11119 | ELSEIF(IEV.LE.560) THEN | |
11120 | ITY=IEV-501 | |
11121 | KFLS=2*(ITY/20)+1 | |
11122 | KFLB=8-MOD(ITY/5,4) | |
11123 | KFLC=KFLB-MOD(ITY,5) | |
11124 | CALL LY1ENT(1,100*KFLB+10*KFLC+KFLS,0.,0.,0.) | |
11125 | ||
11126 | C...One decay each for some heavy baryons. | |
11127 | ELSEIF(IEV.LE.600) THEN | |
11128 | ITY=IEV-561 | |
11129 | KFLS=2*(ITY/20)+2 | |
11130 | KFLA=8-MOD(ITY/5,4) | |
11131 | KFLB=KFLA-MOD(ITY,5) | |
11132 | KFLC=MAX(1,KFLB-1) | |
11133 | CALL LY1ENT(1,1000*KFLA+100*KFLB+10*KFLC+KFLS,0.,0.,0.) | |
11134 | ENDIF | |
11135 | ||
11136 | C...Generate event. Find total momentum, energy and charge. | |
11137 | DO 140 J=1,4 | |
11138 | PINI(J)=PLY(0,J) | |
11139 | 140 CONTINUE | |
11140 | PINI(6)=PLY(0,6) | |
11141 | CALL LYEXEC | |
11142 | DO 150 J=1,4 | |
11143 | PFIN(J)=PLY(0,J) | |
11144 | 150 CONTINUE | |
11145 | PFIN(6)=PLY(0,6) | |
11146 | ||
11147 | C...Check conservation of energy, momentum and charge; | |
11148 | C...usually exact, but only approximate for single jets. | |
11149 | MERR=0 | |
11150 | IF(IEV.LE.50) THEN | |
11151 | IF((PFIN(1)-PINI(1))**2+(PFIN(2)-PINI(2))**2.GE.4.) MERR=MERR+1 | |
11152 | EPZREM=PINI(4)+PINI(3)-PFIN(4)-PFIN(3) | |
11153 | IF(EPZREM.LT.0..OR.EPZREM.GT.2.*PARJ(31)) MERR=MERR+1 | |
11154 | IF(ABS(PFIN(6)-PINI(6)).GT.2.1) MERR=MERR+1 | |
11155 | ELSE | |
11156 | DO 160 J=1,4 | |
11157 | IF(ABS(PFIN(J)-PINI(J)).GT.0.0001*PINI(4)) MERR=MERR+1 | |
11158 | 160 CONTINUE | |
11159 | IF(ABS(PFIN(6)-PINI(6)).GT.0.1) MERR=MERR+1 | |
11160 | ENDIF | |
11161 | IF(MERR.NE.0) WRITE(MSTU(11),5000) (PINI(J),J=1,4),PINI(6), | |
11162 | &(PFIN(J),J=1,4),PFIN(6) | |
11163 | ||
11164 | C...Check that all KF codes are known ones, and that partons/particles | |
11165 | C...satisfy energy-momentum-mass relation. Store particle statistics. | |
11166 | DO 170 I=1,N | |
11167 | IF(K(I,1).GT.20) GOTO 170 | |
11168 | IF(LYCOMP(K(I,2)).EQ.0) THEN | |
11169 | WRITE(MSTU(11),5100) I | |
11170 | MERR=MERR+1 | |
11171 | ENDIF | |
11172 | PD=P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2-P(I,5)**2 | |
11173 | IF(ABS(PD).GT.MAX(0.1,0.001*P(I,4)**2).OR.P(I,4).LT.0.) THEN | |
11174 | WRITE(MSTU(11),5200) I | |
11175 | MERR=MERR+1 | |
11176 | ENDIF | |
11177 | 170 CONTINUE | |
11178 | IF(MTEST.GE.1) CALL LYTABU(21) | |
11179 | ||
11180 | C...List all erroneous events and some normal ones. | |
11181 | IF(MERR.NE.0.OR.MSTU(24).NE.0.OR.MSTU(28).NE.0) THEN | |
11182 | CALL LYLIST(2) | |
11183 | ELSEIF(MTEST.GE.1.AND.MOD(IEV-5,100).EQ.0) THEN | |
11184 | CALL LYLIST(1) | |
11185 | ENDIF | |
11186 | ||
11187 | C...Stop execution if too many errors. | |
11188 | IF(MERR.NE.0) NERR=NERR+1 | |
11189 | IF(NERR.GE.10) THEN | |
11190 | WRITE(MSTU(11),5300) IEV | |
11191 | STOP | |
11192 | ENDIF | |
11193 | 180 CONTINUE | |
11194 | ||
11195 | C...Summarize result of run. | |
11196 | IF(MTEST.GE.1) CALL LYTABU(22) | |
11197 | IF(NERR.EQ.0) WRITE(MSTU(11),5400) | |
11198 | IF(NERR.GT.0) WRITE(MSTU(11),5500) NERR | |
11199 | ||
11200 | C...Reset commonblock variables changed during run. | |
11201 | MSTJ(2)=3 | |
11202 | PARJ(17)=0. | |
11203 | PARJ(22)=1. | |
11204 | PARJ(43)=0.5 | |
11205 | PARJ(54)=0. | |
11206 | MSTJ(105)=1 | |
11207 | MSTJ(107)=0 | |
11208 | ||
11209 | C...Format statements for output. | |
11210 | 5000 FORMAT(/' Momentum, energy and/or charge were not conserved ', | |
11211 | &'in following event'/' sum of',9X,'px',11X,'py',11X,'pz',11X, | |
11212 | &'E',8X,'charge'/' before',2X,4(1X,F12.5),1X,F8.2/' after',3X, | |
11213 | &4(1X,F12.5),1X,F8.2) | |
11214 | 5100 FORMAT(/5X,'Entry no.',I4,' in following event not known code') | |
11215 | 5200 FORMAT(/5X,'Entry no.',I4,' in following event has faulty ', | |
11216 | &'kinematics') | |
11217 | 5300 FORMAT(/5X,'Ten errors experienced by event ',I3/ | |
11218 | &5X,'Something is seriously wrong! Execution stopped now!') | |
11219 | 5400 FORMAT(//5X,'End result of LYTEST: no errors detected.') | |
11220 | 5500 FORMAT(//5X,'End result of LYTEST:',I2,' errors detected.'/ | |
11221 | &5X,'This should not have happened!') | |
11222 | ||
11223 | RETURN | |
11224 | END | |
11225 | ||
11226 | C********************************************************************* | |
11227 | ||
11228 | BLOCK DATA LYDATA | |
11229 | ||
11230 | C...Purpose: to give default values to parameters and particle and | |
11231 | C...decay data. | |
11232 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
11233 | COMMON/LYDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
11234 | COMMON/LYDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) | |
11235 | COMMON/LYDAT4/CHAF(500) | |
11236 | CHARACTER CHAF*8 | |
11237 | COMMON/LYDATR/MRLU(6),RRLU(100) | |
11238 | SAVE /LYDAT1/,/LYDAT2/,/LYDAT3/,/LYDAT4/,/LYDATR/ | |
11239 | ||
11240 | C...LUDAT1, containing status codes and most parameters. | |
11241 | DATA MSTU/ | |
11242 | & 0, 0, 0, 4000,10000, 500, 2000, 0, 0, 2, | |
11243 | 1 6, 1, 1, 0, 1, 1, 0, 0, 0, 0, | |
11244 | 2 2, 10, 0, 0, 1, 10, 0, 0, 0, 0, | |
11245 | 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
11246 | 4 2, 2, 1, 4, 2, 1, 1, 0, 0, 0, | |
11247 | 5 25, 24, 0, 1, 0, 0, 0, 0, 0, 0, | |
11248 | 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
11249 | 7 30*0, | |
11250 | & 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
11251 | 1 1, 5, 3, 5, 0, 0, 0, 0, 0, 0, | |
11252 | 2 60*0, | |
11253 | 8 7, 410, 1997, 01, 20, 700, 0, 0, 0, 0, | |
11254 | 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ | |
11255 | DATA PARU/ | |
11256 | & 3.1415927, 6.2831854, 0.1973, 5.068, 0.3894, 2.568, 4*0., | |
11257 | 1 0.001, 0.09, 0.01, 0., 0., 0., 0., 0., 0., 0., | |
11258 | 2 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., | |
11259 | 3 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., | |
11260 | 4 2.0, 1.0, 0.25, 2.5, 0.05, 0., 0., 0.0001, 0., 0., | |
11261 | 5 2.5, 1.5, 7.0, 1.0, 0.5, 2.0, 3.2, 0., 0., 0., | |
11262 | 6 40*0., | |
11263 | & 0.00729735, 0.232, 0.007764, 1.0, 1.16639E-5, 0., 0., 0., | |
11264 | & 0., 0., | |
11265 | 1 0.20, 0.25, 1.0, 4.0, 10., 0., 0., 0., 0., 0., | |
11266 | 2 -0.693, -1.0, 0.387, 1.0, -0.08, -1.0, 1.0, 1.0, 1.0, 0., | |
11267 | 3 1.0, -1.0, 1.0, -1.0, 1.0, 0., 0., 0., 0., 0., | |
11268 | 4 5.0, 1.0, 1.0, 0., 1.0, 1.0, 0., 0., 0., 0., | |
11269 | 5 1.0, 0., 0., 0., 1000., 1.0, 1.0, 1.0, 1.0, 0., | |
11270 | 6 1.0, 1.0, 1.0, 1.0, 1.0, 0., 0., 0., 0., 0., | |
11271 | 7 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 0., 0., 0., | |
11272 | 8 1.0, 1.0, 1.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0, 0., | |
11273 | 9 0., 0., 0., 0., 1.0, 0., 0., 0., 0., 0./ | |
11274 | DATA MSTJ/ | |
11275 | & 1, 3, 0, 0, 0, 0, 0, 0, 0, 0, | |
11276 | 1 4, 2, 0, 1, 0, 0, 0, 0, 0, 0, | |
11277 | 2 2, 1, 1, 2, 1, 2, 2, 0, 0, 0, | |
11278 | 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
11279 | 4 2, 2, 4, 2, 5, 3, 3, 0, 0, 3, | |
11280 | 5 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, | |
11281 | 6 40*0, | |
11282 | & 5, 2, 7, 5, 1, 1, 0, 2, 0, 2, | |
11283 | 1 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, | |
11284 | 2 80*0/ | |
11285 | DATA PARJ/ | |
11286 | & 0.10, 0.30, 0.40, 0.05, 0.50, 0.50, 0.50, 0., 0., 0., | |
11287 | 1 0.50, 0.60, 0.75, 0., 0., 0., 0., 1.0, 1.0, 0., | |
11288 | 2 0.36, 1.0, 0.01, 2.0, 1.0, 0.4, 0., 0., 0., 0., | |
11289 | 3 0.10, 1.0, 0.8, 1.5, 0., 2.0, 0.2, 2.5, 0.6, 0., | |
11290 | 4 0.3, 0.58, 0.5, 0.9, 0.5, 1.0, 1.0, 1.0, 0., 0., | |
11291 | 5 0.77,0.77,0.77,-0.05,-0.005,-0.00001,-0.00001,-0.00001,1.0,0., | |
11292 | 6 4.5, 0.7, 0., 0.003, 0.5, 0.5, 0., 0., 0., 0., | |
11293 | 7 10., 1000., 100., 1000., 0., 0.7, 10., 0., 0., 0., | |
11294 | 8 0.29, 1.0, 1.0, 0., 10., 10., 0., 0., 0., 0., | |
11295 | 9 0.02, 1.0, 0.2, 0., 0., 0., 0., 0., 0., 0., | |
11296 | & 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., | |
11297 | 1 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., | |
11298 | 2 1.0, 0.25,91.187,2.489, 0.01, 2.0, 1.0, 0.25,0.002, 0., | |
11299 | 3 0., 0., 0., 0., 0.01, 0.99, 0., 0., 0.2, 0., | |
11300 | 4 60*0./ | |
11301 | ||
11302 | C...LUDAT2, with particle data and flavour treatment parameters. | |
11303 | DATA (KCHG(I,1),I= 1, 500)/-1,2,-1,2,-1,2,-1,2,2*0,-3,0,-3,0, | |
11304 | &-3,0,-3,6*0,3,9*0,3,2*0,3,0,-1,44*0,2,-1,2,-1,2,3,11*0,3,0,2*3,0, | |
11305 | &3,0,3,0,3,10*0,3,0,2*3,0,3,0,3,0,3,10*0,3,0,2*3,0,3,0,3,0,3,10*0, | |
11306 | &3,0,2*3,0,3,0,3,0,3,10*0,3,0,2*3,0,3,0,3,0,3,10*0,3,0,2*3,0,3,0, | |
11307 | &3,0,3,70*0,3,0,3,28*0,3,2*0,3,8*0,-3,8*0,3,0,-3,0,3,-3,3*0,3,6,0, | |
11308 | &3,5*0,-3,0,3,-3,0,-3,4*0,-3,0,3,6,-3,0,3,-3,0,-3,0,3,6,0,3,5*0, | |
11309 | &-3,0,3,-3,0,-3,114*0/ | |
11310 | DATA (KCHG(I,2),I= 1, 500)/8*1,12*0,2,16*0,2,1,50*0,-1,410*0/ | |
11311 | DATA (KCHG(I,3),I= 1, 500)/8*1,2*0,8*1,5*0,1,9*0,1,2*0,1,0,2*1, | |
11312 | &41*0,1,0,7*1,10*0,10*1,10*0,10*1,10*0,10*1,10*0,10*1,10*0,10*1, | |
11313 | &10*0,10*1,70*0,3*1,22*0,1,5*0,1,0,2*1,6*0,1,0,2*1,6*0,2*1,0,5*1, | |
11314 | &0,6*1,4*0,6*1,4*0,16*1,4*0,6*1,114*0/ | |
11315 | DATA (PMAS(I,1),I= 1, 500)/0.0099,0.0056,0.199,1.35,5.,160., | |
11316 | &2*250.,2*0.,0.00051,0.,0.1057,0.,1.777,0.,250.,5*0.,91.187,80.25, | |
11317 | &80.,6*0.,500.,900.,500.,3*300.,350.,200.,5000.,60*0.,0.1396, | |
11318 | &0.4977,0.4936,1.8693,1.8645,1.9688,5.2787,5.2786,5.47972,6.594, | |
11319 | &0.135,0.5475,0.9578,2.9788,9.4,320.,2*500.,2*0.,0.7669,0.8961, | |
11320 | &0.8916,2.0101,2.0071,2.11,2*5.325,5.5068,6.602,0.7683,0.782, | |
11321 | &1.0194,3.0969,9.4603,320.,2*500.,2*0.,1.232,2*1.29,2*2.424,2.536, | |
11322 | &2*5.73,5.97,7.3,1.232,1.17,1.4,3.46,9.875,320.,2*500.,2*0.,0.983, | |
11323 | &2*1.429,2*2.272,2.5,2*5.68,5.92,7.25,0.9827,1.,1.4,3.4151,9.8598, | |
11324 | &320.,2*500.,2*0.,1.26,2*1.402,2*2.372,2.56,2*5.78,6.02,7.3,1.26, | |
11325 | &1.282,1.42,3.5106,9.8919,320.,2*500.,2*0.,1.318,1.432,1.425, | |
11326 | &2*2.46,2.61,2*5.83,6.07,7.35,1.318,1.275,1.525,3.5562,9.9132, | |
11327 | &320.,2*500.,2*0.,2*0.4977,8*0.,3.686,3*0.,10.0233,70*0.,1.1156, | |
11328 | &5*0.,2.2849,0.,2.473,2.466,6*0.,5.641,0.,2*5.84,6*0.,0.9396, | |
11329 | &0.9383,0.,1.1974,1.1926,1.1894,1.3213,1.3149,0.,2.4525,2.4529, | |
11330 | &2.4527,2*2.55,2.73,4*0.,3*5.8,2*5.96,6.12,4*0.,1.234,1.233,1.232, | |
11331 | &1.231,1.3872,1.3837,1.3828,1.535,1.5318,1.6724,3*2.5,2*2.63,2.8, | |
11332 | &4*0.,3*5.81,2*5.97,6.13,114*0./ | |
11333 | DATA (PMAS(I,2),I= 1, 500)/22*0.,2.489,2.066,88*0.,0.0002, | |
11334 | &0.001,6*0.,0.149,0.0505,0.0498,7*0.,0.151,0.00843,0.0044,7*0., | |
11335 | &0.155,2*0.09,2*0.02,0.,4*0.05,0.155,0.36,0.08,2*0.01,5*0.,0.057, | |
11336 | &2*0.287,7*0.05,0.057,0.,0.25,0.014,6*0.,0.4,2*0.174,7*0.05,0.4, | |
11337 | &0.024,0.06,0.0009,6*0.,0.11,0.109,0.098,2*0.019,5*0.02,0.11, | |
11338 | &0.185,0.076,0.002,146*0.,4*0.12,0.0394,0.036,0.0358,0.0099, | |
11339 | &0.0091,131*0./ | |
11340 | DATA (PMAS(I,3),I= 1, 500)/22*0.,2*20.,88*0.,0.002,0.005,6*0., | |
11341 | &0.4,2*0.2,7*0.,0.4,0.1,0.015,7*0.,0.25,0.005,0.01,2*0.08,0., | |
11342 | &4*0.1,0.25,0.2,0.001,2*0.02,5*0.,0.05,2*0.4,6*0.1,2*0.05,0.,0.35, | |
11343 | &0.05,6*0.,3*0.3,2*0.1,0.03,4*0.1,0.3,0.05,0.02,0.001,6*0.,0.25, | |
11344 | &4*0.12,5*0.05,0.25,0.17,0.2,0.01,146*0.,4*0.14,0.04,2*0.035, | |
11345 | &2*0.05,131*0./ | |
11346 | DATA (PMAS(I,4),I= 1, 500)/12*0.,658650.,0.,0.0914,68*0.,0.1, | |
11347 | &0.387,15*0.,7804.,0.,3709.,0.32,0.1259,0.135,3*0.387,0.15,110*0., | |
11348 | &15500.,26.75,83*0.,78.88,5*0.,0.057,0.,0.025,0.09,6*0.,0.387,0., | |
11349 | &2*0.387,9*0.,44.3,0.,23.95,49.1,86.9,6*0.,0.13,9*0.,0.387,13*0., | |
11350 | &24.60001,130*0./ | |
11351 | DATA PARF/ | |
11352 | & 0.5, 0.25, 0.5, 0.25, 1., 0.5, 0., 0., 0., 0., | |
11353 | 1 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0., | |
11354 | 2 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0., | |
11355 | 3 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0., | |
11356 | 4 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0., | |
11357 | 5 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0., | |
11358 | 6 0.75, 0.5, 0., 0.1667, 0.0833, 0.1667, 0., 0., 0., 0., | |
11359 | 7 0., 0., 1., 0.3333, 0.6667, 0.3333, 0., 0., 0., 0., | |
11360 | 8 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., | |
11361 | 9 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., | |
11362 | & 0.325, 0.325, 0.5, 1.6, 5.0, 0., 0., 0., 0., 0., | |
11363 | 1 0., 0.11, 0.16, 0.048, 0.50, 0.45, 0.55, 0.60, 0., 0., | |
11364 | 2 0.2, 0.1, 0., 0., 0., 0., 0., 0., 0., 0., | |
11365 | 3 1870*0./ | |
11366 | DATA ((VCKM(I,J),J=1,4),I=1,4)/ | |
11367 | 1 0.95113, 0.04884, 0.00003, 0.00000, | |
11368 | 2 0.04884, 0.94940, 0.00176, 0.00000, | |
11369 | 3 0.00003, 0.00176, 0.99821, 0.00000, | |
11370 | 4 0.00000, 0.00000, 0.00000, 1.00000/ | |
11371 | ||
11372 | C...LUDAT3, with particle decay parameters and data. | |
11373 | DATA (MDCY(I,1),I= 1, 500)/5*0,3*1,6*0,1,0,1,5*0,3*1,6*0,1,0,1, | |
11374 | &2*0,4*1,42*0,7*1,12*0,1,0,15*1,2*0,18*1,2*0,18*1,2*0,18*1,2*0, | |
11375 | &18*1,2*0,18*1,3*0,1,8*0,1,3*0,1,70*0,1,5*0,1,0,2*1,6*0,1,0,2*1, | |
11376 | &9*0,5*1,0,6*1,4*0,6*1,4*0,16*1,4*0,6*1,114*0/ | |
11377 | DATA (MDCY(I,2),I= 1, 500)/1,9,17,25,33,41,50,60,2*0,70,74,76, | |
11378 | &81,83,124,126,132,2*0,135,144,156,172,192,6*0,209,0,231,254,274, | |
11379 | &292,301,304,305,42*0,314,315,319,328,331,336,338,11*0,358,359, | |
11380 | &361,367,430,491,524,560,596,635,666,668,675,681,682,683,684,685, | |
11381 | &2*0,686,688,691,694,697,699,700,701,702,703,704,708,713,721,724, | |
11382 | &733,734,735,2*0,736,737,742,747,749,751,753,755,757,759,761,762, | |
11383 | &765,769,770,771,772,773,2*0,774,775,777,779,781,783,785,787,789, | |
11384 | &791,793,794,799,804,806,808,809,810,2*0,811,813,815,817,819,821, | |
11385 | &823,825,827,829,831,833,846,850,852,854,855,856,2*0,857,863,873, | |
11386 | &884,892,900,904,912,920,924,928,936,945,951,953,955,956,957,2*0, | |
11387 | &958,966,8*0,968,3*0,979,70*0,993,5*0,997,0,1073,1074,6*0,1075,0, | |
11388 | &1092,1093,9*0,1094,1096,1097,1100,1101,0,1103,1104,1105,1106, | |
11389 | &1107,1108,4*0,1109,1110,1111,1112,1113,1114,4*0,1115,1116,1119, | |
11390 | &1122,1123,1126,1129,1132,1134,1136,1140,1141,1142,1143,1145,1147, | |
11391 | &4*0,1148,1149,1150,1151,1152,1153,114*0/ | |
11392 | DATA (MDCY(I,3),I= 1, 500)/5*8,9,2*10,2*0,4,2,5,2,41,2,6,3,2*0, | |
11393 | &9,12,16,20,17,6*0,22,0,23,20,18,9,3,1,9,42*0,1,4,9,3,5,2,20,11*0, | |
11394 | &1,2,6,63,61,33,2*36,39,31,2,7,6,5*1,2*0,2,3*3,2,5*1,4,5,8,3,9, | |
11395 | &3*1,2*0,1,2*5,7*2,1,3,4,5*1,2*0,1,9*2,1,2*5,2*2,3*1,2*0,11*2,13, | |
11396 | &4,2*2,3*1,2*0,6,10,11,2*8,4,2*8,2*4,8,9,6,2*2,3*1,2*0,8,2,8*0,11, | |
11397 | &3*0,14,70*0,4,5*0,76,0,2*1,6*0,17,0,2*1,9*0,2,1,3,1,2,0,6*1,4*0, | |
11398 | &6*1,4*0,1,2*3,1,3*3,2*2,4,3*1,2*2,1,4*0,6*1,114*0/ | |
11399 | DATA (MDME(I,1),I= 1,2000)/6*1,-1,7*1,-1,7*1,-1,7*1,-1,7*1,-1, | |
11400 | &7*1,-1,1,-1,8*1,2*-1,8*1,2*-1,61*1,-1,2*1,-1,6*1,2*-1,7*1,2*-1, | |
11401 | &3*1,-1,6*1,2*-1,6*1,2*-1,3*1,-1,3*1,-1,3*1,5*-1,3*1,-1,6*1,2*-1, | |
11402 | &3*1,-1,11*1,2*-1,6*1,8*-1,3*1,-1,3*1,-1,3*1,5*-1,3*1,4*-1,6*1, | |
11403 | &2*-1,3*1,-1,5*1,-1,8*1,2*-1,3*1,-1,9*1,-1,3*1,-1,9*1,2*-1,2*1,-1, | |
11404 | &16*1,-1,2*1,3*-1,1665*1/ | |
11405 | DATA (MDME(I,2),I= 1,2000)/75*102,42,6*102,2*42,2*0,7*41,2*0, | |
11406 | &24*41,6*102,45,29*102,8*32,8*0,16*32,4*0,8*32,4*0,32,4*0,8*32, | |
11407 | &14*0,16*32,7*0,8*32,4*0,32,7*0,8*32,4*0,32,5*0,4*32,5*0,3*32,0, | |
11408 | &6*32,3*0,12,2*42,2*11,9*42,2*45,31,2*45,2*33,31,2*45,20*46,7*0, | |
11409 | &24*42,41*0,16*42,46*0,10*42,20*0,2*13,14*42,16*0,48,3*13,16*42, | |
11410 | &16*0,48,3*13,16*42,19*0,48,3*13,2*42,0,2*11,28*42,0,2,4*0,2,8*0, | |
11411 | &12,32,86,87,88,3,0,2*3,0,2*3,0,2*3,0,3,6*0,3,3*0,1,0,3,2*0,2*3, | |
11412 | &3*0,1,4*0,12,3*0,4*32,2*4,86,87,88,33*0,12,32,86,87,88,31*0,12,0, | |
11413 | &32,86,87,88,40*0,12,0,32,86,87,88,95*0,12,0,32,86,87,88,2*0,4*42, | |
11414 | &6*0,12,11*0,4*32,2*4,9*0,14*42,52*0,10*13,2*84,3*42,8*0,48,3*13, | |
11415 | &2*42,2*85,14*0,84,5*0,85,886*0/ | |
11416 | DATA (BRAT(I) ,I= 1, 439)/75*0.,1.,6*0.,0.179,0.178,0.116, | |
11417 | &0.235,0.005,0.056,0.018,0.023,0.011,2*0.004,0.0067,0.014,2*0.002, | |
11418 | &2*0.001,0.0022,0.054,0.002,0.016,0.005,0.011,0.0101,5*0.006, | |
11419 | &0.002,2*0.001,5*0.002,6*0.,1.,29*0.,0.15394,0.11936,0.15394, | |
11420 | &0.11926,0.15254,3*0.,0.03368,0.06664,0.03368,0.06664,0.03368, | |
11421 | &0.06664,2*0.,0.3214,0.0165,2*0.,0.0165,0.3207,2*0.,0.00001, | |
11422 | &0.00059,6*0.,3*0.1081,3*0.,0.0003,0.048,0.8705,4*0.,0.0002, | |
11423 | &0.0603,0.,0.0199,0.0008,3*0.,0.143,0.111,0.143,0.111,0.143,0.085, | |
11424 | &2*0.,0.03,0.058,0.03,0.058,0.03,0.058,8*0.,0.25,0.01,2*0.,0.01, | |
11425 | &0.25,4*0.,0.24,5*0.,3*0.08,6*0.,0.01,0.08,0.82,5*0.,0.09,11*0., | |
11426 | &0.01,0.08,0.82,5*0.,0.09,9*0.,1.,6*0.,0.01,0.98,0.01,1.,4*0.215, | |
11427 | &2*0.,2*0.07,0.,1.,2*0.08,0.76,0.08,2*0.105,0.04,0.5,0.08,0.14, | |
11428 | &0.01,0.015,0.005,1.,3*0.,1.,4*0.,1.,0.25,0.01,2*0.,0.01,0.25, | |
11429 | &4*0.,0.24,5*0.,3*0.08,0.,1.,2*0.5,0.635,0.212,0.056,0.017,0.048, | |
11430 | &0.032,0.07,0.065,2*0.005,2*0.011,5*0.001,0.07,0.065,2*0.005, | |
11431 | &2*0.011,5*0.001,0.026,0.019,0.066,0.041,0.045,0.076,0.0073, | |
11432 | &2*0.0047,0.026,0.001,0.0006,0.0066,0.005,2*0.003,2*0.0006, | |
11433 | &2*0.001,0.006,0.005,0.012,0.0057,0.067,0.008,0.0022,0.027,0.004, | |
11434 | &0.019,0.012,0.002,0.009,0.0218,0.001,0.022,0.087,0.001,0.0019, | |
11435 | &0.0015,0.0028,0.034,0.027,2*0.002,2*0.004,2*0.002,0.034,0.027/ | |
11436 | DATA (BRAT(I) ,I= 440, 655)/2*0.002,2*0.004,2*0.002,0.0365, | |
11437 | &0.045,0.073,0.062,3*0.021,0.0061,0.015,0.025,0.0088,0.074,0.0109, | |
11438 | &0.0041,0.002,0.0035,0.0011,0.001,0.0027,2*0.0016,0.0018,0.011, | |
11439 | &0.0063,0.0052,0.018,0.016,0.0034,0.0036,0.0009,0.0006,0.015, | |
11440 | &0.0923,0.018,0.022,0.0077,0.009,0.0075,0.024,0.0085,0.067,0.0511, | |
11441 | &0.017,0.0004,0.0028,0.01,2*0.02,0.03,2*0.005,2*0.02,0.03,2*0.005, | |
11442 | &0.015,0.037,0.028,0.079,0.095,0.052,0.0078,4*0.001,0.028,0.033, | |
11443 | &0.026,0.05,0.01,4*0.005,0.25,0.0952,0.02,0.055,2*0.005,0.008, | |
11444 | &0.012,0.02,0.055,2*0.005,0.008,0.012,0.01,0.03,0.0035,0.011, | |
11445 | &0.0055,0.0042,0.009,0.018,0.015,0.0185,0.0135,0.025,0.0004, | |
11446 | &0.0007,0.0008,0.0014,0.0019,0.0025,0.4291,0.08,0.07,0.02,0.015, | |
11447 | &0.005,0.02,0.055,2*0.005,0.008,0.012,0.02,0.055,2*0.005,0.008, | |
11448 | &0.012,0.01,0.03,0.0035,0.011,0.0055,0.0042,0.009,0.018,0.015, | |
11449 | &0.0185,0.0135,0.025,0.0004,0.0007,0.0008,0.0014,0.0019,0.0025, | |
11450 | &0.4291,0.08,0.07,0.02,0.015,0.005,0.02,0.055,2*0.005,0.008,0.012, | |
11451 | &0.02,0.055,2*0.005,0.008,0.012,0.01,0.03,0.0035,0.011,0.0055, | |
11452 | &0.0042,0.009,0.018,0.015,0.0185,0.0135,0.025,2*0.0002,0.0007, | |
11453 | &2*0.0004,0.0014,0.001,0.0009,0.0025,0.4291,0.08,0.07,0.02,0.015, | |
11454 | &0.005,0.047,0.122,0.006,0.012,0.035,0.012,0.035,0.003,0.007,0.15, | |
11455 | &0.037,0.008,0.002,0.05,0.015,0.003,0.001,0.014,0.042,0.014,0.042/ | |
11456 | DATA (BRAT(I) ,I= 656, 931)/0.24,0.065,0.012,0.003,0.001,0.002, | |
11457 | &0.001,0.002,0.014,0.003,0.988,0.012,0.389,0.319,0.2367,0.049, | |
11458 | &0.005,0.001,0.0003,0.441,0.206,0.3,0.03,0.022,0.001,5*1.,0.99955, | |
11459 | &0.00045,0.665,0.333,0.002,0.666,0.333,0.001,0.65,0.3,0.05,0.56, | |
11460 | &0.44,5*1.,0.99912,0.00079,0.00005,0.00004,0.888,0.085,0.021, | |
11461 | &2*0.003,0.49,0.344,3*0.043,0.023,0.013,0.001,0.0627,0.0597, | |
11462 | &0.8776,3*0.027,0.015,0.045,0.015,0.045,0.77,0.029,4*1.,0.28,0.14, | |
11463 | &0.313,0.157,0.11,0.28,0.14,0.313,0.157,0.11,0.667,0.333,0.667, | |
11464 | &0.333,2*0.5,0.667,0.333,0.667,0.333,4*0.5,1.,0.333,0.334,0.333, | |
11465 | &4*0.25,6*1.,0.667,0.333,0.667,0.333,0.667,0.333,0.667,0.333, | |
11466 | &2*0.5,0.667,0.333,0.667,0.333,4*0.5,1.,0.52,0.26,0.11,2*0.055, | |
11467 | &0.62,0.31,0.035,2*0.0175,0.007,0.993,0.02,0.98,3*1.,2*0.5,0.667, | |
11468 | &0.333,0.667,0.333,0.667,0.333,0.667,0.333,2*0.5,0.667,0.333, | |
11469 | &0.667,0.333,6*0.5,3*0.12,0.097,0.043,4*0.095,4*0.03,4*0.25,0.273, | |
11470 | &0.727,0.35,0.65,3*1.,2*0.35,0.144,0.105,0.048,0.003,0.333,0.166, | |
11471 | &0.168,0.084,0.087,0.043,0.059,2*0.029,0.002,0.332,0.166,0.168, | |
11472 | &0.084,0.086,0.043,0.059,2*0.029,2*0.002,0.3,0.15,0.16,0.08,0.13, | |
11473 | &0.06,0.08,0.04,0.3,0.15,0.16,0.08,0.13,0.06,0.08,0.04,2*0.3, | |
11474 | &2*0.2,0.3,0.15,0.16,0.08,0.13,0.06,0.08,0.04,0.3,0.15,0.16,0.08, | |
11475 | &0.13,0.06,0.08,0.04,2*0.3,2*0.2,2*0.3,2*0.2,2*0.35,0.144,0.105/ | |
11476 | DATA (BRAT(I) ,I= 932,2000)/0.024,2*0.012,0.003,0.566,0.283, | |
11477 | &0.069,0.028,0.023,2*0.0115,0.005,0.003,0.356,2*0.178,0.28, | |
11478 | &2*0.004,0.135,0.865,0.22,0.78,3*1.,0.217,0.124,2*0.193,2*0.135, | |
11479 | &0.002,0.001,0.686,0.314,2*0.0083,0.1866,0.324,0.184,0.027,0.001, | |
11480 | &0.093,0.087,0.078,0.0028,3*0.014,0.008,0.024,0.008,0.024,0.425, | |
11481 | &0.02,0.185,0.088,0.043,0.067,0.066,0.641,0.357,2*0.001,0.018, | |
11482 | &2*0.005,0.003,0.002,2*0.006,0.018,2*0.005,0.003,0.002,2*0.006, | |
11483 | &0.0066,0.025,0.016,0.0088,2*0.005,0.0058,0.005,0.0055,4*0.004, | |
11484 | &2*0.002,2*0.004,0.003,0.002,2*0.003,3*0.002,2*0.001,0.002, | |
11485 | &2*0.001,2*0.002,0.0013,0.0018,5*0.001,4*0.003,2*0.005,2*0.002, | |
11486 | &2*0.001,2*0.002,2*0.001,0.2432,0.057,2*0.035,0.15,2*0.075,0.03, | |
11487 | &2*0.015,2*1.,2*0.105,0.04,0.0077,0.02,0.0235,0.0285,0.0435, | |
11488 | &0.0011,0.0022,0.0044,0.4291,0.08,0.07,0.02,0.015,0.005,2*1., | |
11489 | &0.999,0.001,1.,0.516,0.483,0.001,1.,0.995,0.005,13*1.,0.331, | |
11490 | &0.663,0.006,0.663,0.331,0.006,1.,0.88,2*0.06,0.88,2*0.06,0.88, | |
11491 | &2*0.06,0.667,2*0.333,0.667,0.676,0.234,0.085,0.005,3*1.,4*0.5, | |
11492 | &7*1.,847*0./ | |
11493 | DATA (KFDP(I,1),I= 1, 507)/21,22,23,4*-24,25,21,22,23,4*24,25, | |
11494 | &21,22,23,4*-24,25,21,22,23,4*24,25,21,22,23,4*-24,25,21,22,23, | |
11495 | &4*24,25,37,21,22,23,4*-24,25,2*-37,21,22,23,4*24,25,2*37,22,23, | |
11496 | &-24,25,23,24,-12,22,23,-24,25,23,24,-12,-14,35*16,22,23,-24,25, | |
11497 | &23,24,-89,22,23,-24,25,-37,23,24,37,1,2,3,4,5,6,7,8,21,1,2,3,4,5, | |
11498 | &6,7,8,11,13,15,17,1,2,3,4,5,6,7,8,11,12,13,14,15,16,17,18,4*-1, | |
11499 | &4*-3,4*-5,4*-7,-11,-13,-15,-17,1,2,3,4,5,6,7,8,11,13,15,17,21, | |
11500 | &2*22,23,24,1,2,3,4,5,6,7,8,11,12,13,14,15,16,17,18,24,37,2*23,25, | |
11501 | &35,4*-1,4*-3,4*-5,4*-7,-11,-13,-15,-17,3*24,1,2,3,4,5,6,7,8,11, | |
11502 | &13,15,17,21,2*22,23,24,23,25,36,1,2,3,4,5,6,7,8,11,13,15,17,21, | |
11503 | &2*22,23,24,23,-1,-3,-5,-7,-11,-13,-15,-17,24,5,6,21,2,1,2,3,4,5, | |
11504 | &6,11,13,15,82,-11,-13,2*2,-12,-14,-16,2*-2,2*-4,-2,-4,2*89,37, | |
11505 | &2*-89,2*5,-37,2*89,4*-1,4*-3,4*-5,4*-7,-11,-13,-15,-17,-13,130, | |
11506 | &310,-13,3*211,12,14,11*-11,11*-13,-311,-313,-311,-313,-20313, | |
11507 | &2*-311,-313,-311,-313,2*111,2*221,2*331,2*113,2*223,2*333,-311, | |
11508 | &-313,2*-321,211,-311,-321,333,-311,-313,-321,211,2*-321,2*-311, | |
11509 | &-321,211,113,8*-11,8*-13,-321,-323,-321,-323,-311,2*-313,-311, | |
11510 | &-313,2*-311,-321,-10323,-321,-323,-321,-311,2*-313,211,111,333, | |
11511 | &3*-321,-311,-313,-321,-313,310,333,211,2*-321,-311,-313,-311,211, | |
11512 | &-321,3*-311,211,113,321,-15,5*-11,5*-13,221,331,333,221,331,333/ | |
11513 | DATA (KFDP(I,1),I= 508, 924)/10221,211,213,211,213,321,323,321, | |
11514 | &323,2212,221,331,333,221,2*2,6*12,6*14,2*16,3*-411,3*-413,2*-411, | |
11515 | &2*-413,2*441,2*443,2*20443,2*2,2*4,2,4,6*12,6*14,2*16,3*-421, | |
11516 | &3*-423,2*-421,2*-423,2*441,2*443,2*20443,2*2,2*4,2,4,6*12,6*14, | |
11517 | &2*16,3*-431,3*-433,2*-431,2*-433,3*441,3*443,3*20443,2*2,2*4,2,4, | |
11518 | &16,2*4,2*12,2*14,2*16,4*2,4*4,2*-11,2*-13,2*-1,2*-3,2*-11,2*-13, | |
11519 | &2*-1,3*22,111,211,2*22,211,22,211,111,3*22,111,82,21,3*0,2*211, | |
11520 | &321,3*311,2*321,421,2*411,2*421,431,511,521,531,541,211,111,13, | |
11521 | &11,211,22,211,2*111,321,130,-213,113,213,211,22,111,11,13,82,11, | |
11522 | &13,15,1,2,3,4,21,22,3*0,223,321,311,323,313,2*311,321,313,323, | |
11523 | &321,423,2*413,2*423,413,523,2*513,2*523,2*513,523,223,213,113, | |
11524 | &-213,313,-313,323,-323,82,21,3*0,221,321,2*311,321,421,2*411,421, | |
11525 | &411,421,521,2*511,2*521,2*511,521,221,211,111,321,130,310,211, | |
11526 | &111,321,130,310,443,82,553,21,3*0,113,213,323,2*313,323,423, | |
11527 | &2*413,2*423,413,523,2*513,2*523,2*513,523,213,-213,10211,10111, | |
11528 | &-10211,2*221,213,2*113,-213,2*321,2*311,313,-313,323,-323,443,82, | |
11529 | &553,21,3*0,213,113,221,223,321,211,321,311,323,313,323,313,321, | |
11530 | &4*311,321,313,323,313,323,311,4*321,421,411,423,413,423,413,421, | |
11531 | &2*411,421,413,423,413,423,411,2*421,411,423,413,521,511,523,513, | |
11532 | &523,513,521,2*511,521,513,523,513,523,511,2*521,511,523,513,511/ | |
11533 | DATA (KFDP(I,1),I= 925,2000)/521,513,523,213,-213,221,223,321, | |
11534 | &130,310,111,211,111,2*211,321,130,310,221,111,321,130,310,221, | |
11535 | &211,111,443,82,553,21,3*0,111,211,-12,12,-14,14,211,111,211,111, | |
11536 | &11,13,82,4*443,10441,20443,445,441,11,13,15,1,2,3,4,21,22,2*553, | |
11537 | &10551,20553,555,2212,2*2112,-12,7*-11,7*-13,2*2224,2*2212,2*2214, | |
11538 | &2*3122,2*3212,2*3214,5*3222,4*3224,2*3322,3324,2*2224,7*2212, | |
11539 | &5*2214,2*2112,2*2114,2*3122,2*3212,2*3214,2*3222,2*3224,4*2,3, | |
11540 | &2*2,1,2*2,2*0,-12,-14,-16,5*4122,441,443,20443,2*-2,2*-4,-2,-4, | |
11541 | &2*0,2112,-12,3122,2212,2112,2212,3*3122,3*4122,4132,4232,0, | |
11542 | &3*5122,5132,5232,0,2112,2212,2*2112,2212,2112,2*2212,3122,3212, | |
11543 | &3112,3122,3222,3112,3122,3222,3212,3322,3312,3322,3312,3122,3322, | |
11544 | &3312,-12,3*4122,2*4132,2*4232,4332,3*5122,5132,5232,5332,847*0/ | |
11545 | DATA (KFDP(I,2),I= 1, 476)/3*1,2,4,6,8,1,3*2,1,3,5,7,2,3*3,2,4, | |
11546 | &6,8,3,3*4,1,3,5,7,4,3*5,2,4,6,8,5,3*6,1,3,5,7,6,5,3*7,2,4,6,8,7, | |
11547 | &4,6,3*8,1,3,5,7,8,5,7,2*11,12,11,12,2*11,2*13,14,13,14,13,11,13, | |
11548 | &-211,-213,-211,-213,-211,-213,3*-211,-321,-323,-321,-323,3*-321, | |
11549 | &4*-211,-213,-211,-213,-211,-213,-211,-213,-211,-213,6*-211,2*15, | |
11550 | &16,15,16,15,18,2*17,18,17,2*18,2*17,-1,-2,-3,-4,-5,-6,-7,-8,21, | |
11551 | &-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,-1,-2,-3,-4,-5,-6,-7,-8, | |
11552 | &-11,-12,-13,-14,-15,-16,-17,-18,2,4,6,8,2,4,6,8,2,4,6,8,2,4,6,8, | |
11553 | &12,14,16,18,-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,21,22,2*23, | |
11554 | &-24,-1,-2,-3,-4,-5,-6,-7,-8,-11,-12,-13,-14,-15,-16,-17,-18,-24, | |
11555 | &-37,22,25,2*36,2,4,6,8,2,4,6,8,2,4,6,8,2,4,6,8,12,14,16,18,23,22, | |
11556 | &25,-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,21,22,2*23,-24,2*25, | |
11557 | &36,-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,21,22,2*23,-24,25,2,4, | |
11558 | &6,8,12,14,16,18,25,-5,-6,21,11,-3,-4,-5,-6,-7,-8,-13,-15,-17,-82, | |
11559 | &12,14,-1,-3,11,13,15,1,4,3,4,1,3,5,3,5,6,4,21,22,4,7,5,2,4,6,8,2, | |
11560 | &4,6,8,2,4,6,8,2,4,6,8,12,14,16,18,14,2*0,14,111,211,111,-11,-13, | |
11561 | &11*12,11*14,2*211,2*213,211,20213,2*321,2*323,211,213,211,213, | |
11562 | &211,213,211,213,211,213,211,213,3*211,213,211,2*321,8*211,2*113, | |
11563 | &2*211,8*12,8*14,2*211,2*213,2*111,221,2*113,223,333,20213,211, | |
11564 | &2*321,323,2*311,313,-211,111,113,2*211,321,2*211,311,321,310,211/ | |
11565 | DATA (KFDP(I,2),I= 477, 857)/-211,4*211,321,4*211,113,2*211,-321, | |
11566 | &16,5*12,5*14,3*211,3*213,211,2*111,2*113,2*-311,2*-313,-2112, | |
11567 | &3*321,323,2*-1,6*-11,6*-13,2*-15,211,213,20213,211,213,20213,431, | |
11568 | &433,431,433,311,313,311,313,311,313,-1,-4,-3,-4,-1,-3,6*-11, | |
11569 | &6*-13,2*-15,211,213,20213,211,213,20213,431,433,431,433,321,323, | |
11570 | &321,323,321,323,-1,-4,-3,-4,-1,-3,6*-11,6*-13,2*-15,211,213, | |
11571 | &20213,211,213,20213,431,433,431,433,221,331,333,221,331,333,221, | |
11572 | &331,333,-1,-4,-3,-4,-1,-3,-15,-3,-1,2*-11,2*-13,2*-15,-1,-4,-3, | |
11573 | &-4,-3,-4,-1,-4,2*12,2*14,2,3,2,3,2*12,2*14,2,1,22,11,22,111,-211, | |
11574 | &211,11,-211,13,-211,111,113,223,22,111,-82,21,3*0,111,22,-211, | |
11575 | &111,22,211,111,22,211,111,22,111,6*22,-211,22,-13,-11,-211,111, | |
11576 | &-211,2*111,-321,310,211,111,2*-211,221,22,-11,-13,-82,-11,-13, | |
11577 | &-15,-1,-2,-3,-4,2*21,3*0,211,-213,113,-211,111,223,213,113,211, | |
11578 | &111,223,211,111,-211,111,321,311,-211,111,211,111,-321,-311,411, | |
11579 | &421,111,-211,111,211,-311,311,-321,321,-82,21,3*0,211,-211,111, | |
11580 | &211,111,211,111,-211,111,311,321,-211,111,211,111,-321,-311,411, | |
11581 | &421,111,-211,111,-321,130,310,-211,111,-321,130,310,22,-82,22,21, | |
11582 | &3*0,211,111,-211,111,211,111,211,111,-211,111,321,311,-211,111, | |
11583 | &211,111,-321,-311,411,421,-211,211,-211,111,2*211,111,-211,211, | |
11584 | &111,211,-321,2*-311,-321,-311,311,-321,321,22,-82,22,21,3*0,111/ | |
11585 | DATA (KFDP(I,2),I= 858,2000)/3*211,-311,22,-211,111,-211,111, | |
11586 | &-211,211,-213,113,223,221,211,111,211,111,2*211,213,113,223,221, | |
11587 | &22,211,111,211,111,4*211,-211,111,-211,111,-211,211,-211,211,321, | |
11588 | &311,321,311,-211,111,-211,111,-211,211,-211,2*211,111,211,111, | |
11589 | &4*211,-321,-311,-321,-311,411,421,411,421,-211,211,111,211,-321, | |
11590 | &130,310,22,-211,111,2*-211,-321,130,310,221,111,-321,130,310,221, | |
11591 | &-211,111,22,-82,22,21,3*0,111,-211,11,-11,13,-13,-211,111,-211, | |
11592 | &111,-11,-13,-82,211,111,221,111,4*22,-11,-13,-15,-1,-2,-3,-4, | |
11593 | &2*21,211,111,3*22,-211,111,22,11,7*12,7*14,-321,-323,-311,-313, | |
11594 | &-311,-313,211,213,211,213,211,213,111,221,331,113,223,111,221, | |
11595 | &113,223,321,323,321,-211,-213,111,221,331,113,223,333,10221,111, | |
11596 | &221,331,113,223,211,213,211,213,321,323,321,323,321,323,311,313, | |
11597 | &311,313,2*-1,-3,-1,2203,3201,3203,2203,2101,2103,2*0,11,13,15, | |
11598 | &-211,-213,-20213,-431,-433,3*3122,1,4,3,4,1,3,2*0,-211,11,22,111, | |
11599 | &211,22,-211,111,22,-211,111,211,2*22,0,-211,111,211,2*22,0, | |
11600 | &2*-211,111,22,111,211,22,211,2*-211,2*111,-211,2*211,111,211, | |
11601 | &-211,2*111,211,-321,-211,111,11,-211,111,211,111,22,111,2*22, | |
11602 | &-211,111,211,3*22,847*0/ | |
11603 | DATA (KFDP(I,3),I= 1, 944)/75*0,14,6*0,2*16,2*0,5*111,310,130, | |
11604 | &2*0,2*111,310,130,321,113,211,223,221,2*113,2*211,2*223,2*221, | |
11605 | &2*113,221,113,2*213,-213,195*0,4*3,4*4,1,4,3,2*2,10*81,25*0,-211, | |
11606 | &3*111,-311,-313,-311,-321,-313,-323,111,221,331,113,223,-311, | |
11607 | &-313,-311,-321,-313,-323,111,221,331,113,223,22*0,111,113,2*211, | |
11608 | &-211,-311,211,111,3*211,-211,7*211,-321,-323,-311,-321,-313,-323, | |
11609 | &-211,-213,-321,-323,-311,-321,-313,-323,-211,-213,22*0,111,113, | |
11610 | &-311,2*-211,211,-211,310,-211,2*111,211,2*-211,-321,-211,2*211, | |
11611 | &-211,111,-211,2*211,0,221,331,333,321,311,221,331,333,321,311, | |
11612 | &20*0,3,0,-411,-413,-10413,-10411,-20413,-415,-411,-413,-10413, | |
11613 | &-10411,-20413,-415,-411,-413,16*0,-4,-1,-4,-3,2*-2,-421,-423, | |
11614 | &-10423,-10421,-20423,-425,-421,-423,-10423,-10421,-20423,-425, | |
11615 | &-421,-423,16*0,-4,-1,-4,-3,2*-2,-431,-433,-10433,-10431,-20433, | |
11616 | &-435,-431,-433,-10433,-10431,-20433,-435,-431,-433,19*0,-4,-1,-4, | |
11617 | &-3,2*-2,3*0,441,443,441,443,441,443,-4,-1,-4,-3,-4,-3,-4,-1,531, | |
11618 | &533,531,533,3,2,3,2,511,513,511,513,1,2,0,-11,0,2*111,-211,-11, | |
11619 | &11,-13,2*221,3*0,111,27*0,111,2*0,22,111,5*0,111,12*0,2*21,103*0, | |
11620 | &-211,2*111,-211,3*111,-211,111,211,14*0,111,6*0,111,-211,8*0,111, | |
11621 | &-211,9*0,111,-211,111,-211,4*0,111,-211,111,-211,8*0,111,-211, | |
11622 | &111,-211,4*0,111,-211,111,-211,11*0,-211,6*0,111,211,4*0,111/ | |
11623 | DATA (KFDP(I,3),I= 945,2000)/13*0,2*111,211,-211,211,-211,7*0, | |
11624 | &-211,111,13*0,2*21,-211,111,6*0,2212,3122,3212,3214,2112,2114, | |
11625 | &2212,2112,3122,3212,3214,2112,2114,2212,2112,52*0,3*3,1,8*0, | |
11626 | &3*4122,8*0,4,1,4,3,2*2,3*0,2112,43*0,3322,861*0/ | |
11627 | DATA (KFDP(I,4),I= 1,2000)/88*0,3*111,8*0,-211,0,-211,3*0,111, | |
11628 | &2*-211,0,111,0,2*111,113,221,111,-213,-211,211,195*0,13*81,41*0, | |
11629 | &111,211,111,211,7*0,111,211,111,211,35*0,2*-211,2*111,211,111, | |
11630 | &-211,2*211,2*-211,2*0,-211,111,-211,111,4*0,-211,111,-211,111, | |
11631 | &34*0,111,-211,3*111,3*-211,2*111,3*-211,4*0,-321,-311,3*0,-321, | |
11632 | &-311,20*0,-3,31*0,6*1,30*0,6*2,33*0,6*3,9*0,8*4,4*0,4*-5,4*0, | |
11633 | &2*-5,7*0,-11,264*0,111,-211,4*0,111,57*0,-211,111,5*0,-211,111, | |
11634 | &52*0,2101,2103,2*2101,19*0,6*2101,909*0/ | |
11635 | DATA (KFDP(I,5),I= 1,2000)/90*0,111,16*0,111,7*0,111,0,2*111, | |
11636 | &303*0,-211,2*111,-211,111,-211,111,54*0,111,-211,3*111,-211,111, | |
11637 | &1510*0/ | |
11638 | ||
11639 | C...LUDAT4, with character strings. | |
11640 | DATA (CHAF(I) ,I= 1, 281)/'d','u','s','c','b','t','l','h', | |
11641 | &2*' ','e','nu_e','mu','nu_mu','tau','nu_tau','chi','nu_chi', | |
11642 | &2*' ','g','gamma','Z','W','H',2*' ','reggeon','pomeron',2*' ', | |
11643 | &'Z''','Z"','W''','H''','A','H','eta_tech','LQ_ue','R',40*' ', | |
11644 | &'specflav','rndmflav','phasespa','c-hadron','b-hadron', | |
11645 | &'t-hadron','l-hadron','h-hadron','Wvirt','diquark','cluster', | |
11646 | &'string','indep.','CMshower','SPHEaxis','THRUaxis','CLUSjet', | |
11647 | &'CELLjet','table',' ','pi',2*'K',2*'D','D_s',2*'B','B_s','B_c', | |
11648 | &'pi','eta','eta''','eta_c','eta_b','eta_t','eta_l','eta_h',2*' ', | |
11649 | &'rho',2*'K*',2*'D*','D*_s',2*'B*','B*_s','B*_c','rho','omega', | |
11650 | &'phi','J/psi','Upsilon','Theta','Theta_l','Theta_h',2*' ','b_1', | |
11651 | &2*'K_1',2*'D_1','D_1s',2*'B_1','B_1s','B_1c','b_1','h_1','h''_1', | |
11652 | &'h_1c','h_1b','h_1t','h_1l','h_1h',2*' ','a_0',2*'K*_0',2*'D*_0', | |
11653 | &'D*_0s',2*'B*_0','B*_0s','B*_0c','a_0','f_0','f''_0','chi_0c', | |
11654 | &'chi_0b','chi_0t','chi_0l','chi_0h',2*' ','a_1',2*'K*_1', | |
11655 | &2*'D*_1','D*_1s',2*'B*_1','B*_1s','B*_1c','a_1','f_1','f''_1', | |
11656 | &'chi_1c','chi_1b','chi_1t','chi_1l','chi_1h',2*' ','a_2', | |
11657 | &2*'K*_2',2*'D*_2','D*_2s',2*'B*_2','B*_2s','B*_2c','a_2','f_2', | |
11658 | &'f''_2','chi_2c','chi_2b','chi_2t','chi_2l','chi_2h',2*' ','K_L', | |
11659 | &'K_S',8*' ','psi''',3*' ','Upsilon''',45*' ','pi_diffr'/ | |
11660 | DATA (CHAF(I) ,I= 282, 500)/'n_diffr','p_diffr','rho_diff', | |
11661 | &'omega_di','phi_diff','J/psi_di',18*' ','Lambda',5*' ', | |
11662 | &'Lambda_c',' ',2*'Xi_c',6*' ','Lambda_b',' ',2*'Xi_b',6*' ','n', | |
11663 | &'p',' ',3*'Sigma',2*'Xi',' ',3*'Sigma_c',2*'Xi''_c','Omega_c', | |
11664 | &4*' ',3*'Sigma_b',2*'Xi''_b','Omega_b',4*' ',4*'Delta', | |
11665 | &3*'Sigma*',2*'Xi*','Omega',3*'Sigma*_c',2*'Xi*_c','Omega*_c', | |
11666 | &4*' ',3*'Sigma*_b',2*'Xi*_b','Omega*_b',114*' '/ | |
11667 | ||
11668 | C...LUDATR, with initial values for the random number generator. | |
11669 | DATA MRLU/19780503,0,0,97,33,0/ | |
11670 | ||
11671 | END | |
11672 | ||
11673 | C********************************************************************* | |
11674 | ||
11675 | SUBROUTINE LYTAUD(ITAU,IORIG,KFORIG,NDECAY) | |
11676 | ||
11677 | C...Dummy routine, to be replaced by user, to handle the decay of a | |
11678 | C...polarized tau lepton. | |
11679 | C...Input: | |
11680 | C...ITAU is the position where the decaying tau is stored in /LYJETS/. | |
11681 | C...IORIG is the position where the mother of the tau is stored; | |
11682 | C... is 0 when the mother is not stored. | |
11683 | C...KFORIG is the flavour of the mother of the tau; | |
11684 | C... is 0 when the mother is not known. | |
11685 | C...Note that IORIG=0 does not necessarily imply KFORIG=0; | |
11686 | C... e.g. in B hadron semileptonic decays the W propagator | |
11687 | C... is not explicitly stored but the W code is still unambiguous. | |
11688 | C...Output: | |
11689 | C...NDECAY is the number of decay products in the current tau decay. | |
11690 | C...These decay products should be added to the /LYJETS/ common block, | |
11691 | C...in positions N+1 through N+NDECAY. For each product I you must | |
11692 | C...give the flavour codes K(I,2) and the five-momenta P(I,1), P(I,2), | |
11693 | C...P(I,3), P(I,4) and P(I,5). The rest will be stored automatically. | |
11694 | ||
11695 | COMMON/LYJETS/N,K(4000,5),P(4000,5),V(4000,5) | |
11696 | COMMON/LYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
11697 | SAVE /LYJETS/,/LYDAT1/ | |
11698 | ||
11699 | C...Stop program if this routine is ever called. | |
11700 | C...You should not copy these lines to your own routine. | |
11701 | NDECAY=ITAU+IORIG+KFORIG | |
11702 | WRITE(MSTU(11),5000) | |
11703 | IF(RLY(0).LT.10.) STOP | |
11704 | ||
11705 | C...Format for error printout. | |
11706 | 5000 FORMAT(1X,'Error: you did not link your LYTAUD routine ', | |
11707 | &'correctly.'/1X,'Dummy routine in JETSET file called instead.'/ | |
11708 | &1X,'Execution stopped!') | |
11709 | ||
11710 | ||
11711 | RETURN | |
11712 | END |