]>
Commit | Line | Data |
---|---|---|
0119ef9a | 1 | c.................... hipyset1.35.f |
2 | C | |
3 | C | |
4 | C | |
5 | C Modified for HIJING program | |
6 | c | |
7 | c modification July 22, 1997 In pyremnn put an upper limit | |
8 | c on the total pt kick the parton can accumulate via multiple | |
9 | C scattering. Set the upper limit to be the sqrt(s)/2, | |
10 | c this is fix cronin bug for Pb+Pb events at SPS energy. | |
11 | c | |
12 | C | |
13 | C Last modification Oct. 1993 to comply with non-vax | |
14 | C machines' compiler | |
15 | C | |
16 | C********************************************************************* | |
17 | ||
18 | cms | |
19 | cms gsfs 8/2009 Renamed common block PYINT4A due to conflict with something in CMSSW | |
20 | cms | |
21 | SUBROUTINE LU2ENT(IP,KF1,KF2,PECM) | |
22 | ||
23 | C...Purpose: to store two partons/particles in their CM frame, | |
24 | C...with the first along the +z axis. | |
25 | COMMON/LUJETSA/N,K(9000,5),P(9000,5),V(9000,5) | |
26 | SAVE /LUJETSA/ | |
27 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
28 | SAVE /LUDAT1A/ | |
29 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
30 | SAVE /LUDAT2A/ | |
31 | ||
32 | C...Standard checks. | |
33 | MSTU(28)=0 | |
34 | IF(MSTU(12).GE.1) CALL LULIST(0) | |
35 | IPA=MAX(1,IABS(IP)) | |
36 | IF(IPA.GT.MSTU(4)-1) CALL LUERRM(21, | |
37 | &'(LU2ENT:) writing outside LUJETSA memory') | |
38 | KC1=LUCOMP(KF1) | |
39 | KC2=LUCOMP(KF2) | |
40 | IF(KC1.EQ.0.OR.KC2.EQ.0) CALL LUERRM(12, | |
41 | &'(LU2ENT:) unknown flavour code') | |
42 | ||
43 | C...Find masses. Reset K, P and V vectors. | |
44 | PM1=0. | |
45 | IF(MSTU(10).EQ.1) PM1=P(IPA,5) | |
46 | IF(MSTU(10).GE.2) PM1=ULMASS(KF1) | |
47 | PM2=0. | |
48 | IF(MSTU(10).EQ.1) PM2=P(IPA+1,5) | |
49 | IF(MSTU(10).GE.2) PM2=ULMASS(KF2) | |
50 | DO 100 I=IPA,IPA+1 | |
51 | DO 100 J=1,5 | |
52 | K(I,J)=0 | |
53 | P(I,J)=0. | |
54 | 100 V(I,J)=0. | |
55 | ||
56 | C...Check flavours. | |
57 | KQ1=KCHG(KC1,2)*ISIGN(1,KF1) | |
58 | KQ2=KCHG(KC2,2)*ISIGN(1,KF2) | |
59 | IF(KQ1+KQ2.NE.0.AND.KQ1+KQ2.NE.4) CALL LUERRM(2, | |
60 | &'(LU2ENT:) unphysical flavour combination') | |
61 | K(IPA,2)=KF1 | |
62 | K(IPA+1,2)=KF2 | |
63 | ||
64 | C...Store partons/particles in K vectors for normal case. | |
65 | IF(IP.GE.0) THEN | |
66 | K(IPA,1)=1 | |
67 | IF(KQ1.NE.0.AND.KQ2.NE.0) K(IPA,1)=2 | |
68 | K(IPA+1,1)=1 | |
69 | ||
70 | C...Store partons in K vectors for parton shower evolution. | |
71 | ELSE | |
72 | IF(KQ1.EQ.0.OR.KQ2.EQ.0) CALL LUERRM(2, | |
73 | & '(LU2ENT:) requested flavours can not develop parton shower') | |
74 | K(IPA,1)=3 | |
75 | K(IPA+1,1)=3 | |
76 | K(IPA,4)=MSTU(5)*(IPA+1) | |
77 | K(IPA,5)=K(IPA,4) | |
78 | K(IPA+1,4)=MSTU(5)*IPA | |
79 | K(IPA+1,5)=K(IPA+1,4) | |
80 | ENDIF | |
81 | ||
82 | C...Check kinematics and store partons/particles in P vectors. | |
83 | IF(PECM.LE.PM1+PM2) CALL LUERRM(13, | |
84 | &'(LU2ENT:) energy smaller than sum of masses') | |
85 | PA=SQRT(MAX(0.,(PECM**2-PM1**2-PM2**2)**2-(2.*PM1*PM2)**2))/ | |
86 | &(2.*PECM) | |
87 | P(IPA,3)=PA | |
88 | P(IPA,4)=SQRT(PM1**2+PA**2) | |
89 | P(IPA,5)=PM1 | |
90 | P(IPA+1,3)=-PA | |
91 | P(IPA+1,4)=SQRT(PM2**2+PA**2) | |
92 | P(IPA+1,5)=PM2 | |
93 | ||
94 | C...Set N. Optionally fragment/decay. | |
95 | N=IPA+1 | |
96 | IF(IP.EQ.0) CALL LUEXEC | |
97 | ||
98 | RETURN | |
99 | END | |
100 | ||
101 | C********************************************************************* | |
102 | ||
103 | SUBROUTINE LUGIVE(CHIN) | |
104 | ||
105 | C...Purpose: to set values of commonblock variables. | |
106 | COMMON/LUJETSA/N,K(9000,5),P(9000,5),V(9000,5) | |
107 | SAVE /LUJETSA/ | |
108 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
109 | SAVE /LUDAT1A/ | |
110 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
111 | SAVE /LUDAT2A/ | |
112 | COMMON/LUDAT3A/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) | |
113 | SAVE /LUDAT3A/ | |
114 | COMMON/LUDAT4A/CHAF(500) | |
115 | CHARACTER CHAF*8 | |
116 | SAVE /LUDAT4A/ | |
117 | CHARACTER CHIN*(*),CHFIX*104,CHBIT*104,CHOLD*8,CHNEW*8, | |
118 | &CHNAM*4,CHVAR(17)*4,CHALP(2)*26,CHIND*8,CHINI*10,CHINR*16 | |
119 | DATA CHVAR/'N','K','P','V','MSTU','PARU','MSTJ','PARJ','KCHG', | |
120 | &'PMAS','PARF','VCKM','MDCY','MDME','BRAT','KFDP','CHAF'/ | |
121 | DATA CHALP/'abcdefghijklmnopqrstuvwxyz', | |
122 | &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ | |
123 | ||
124 | C...Length of character variable. Subdivide it into instructions. | |
125 | IF(MSTU(12).GE.1) CALL LULIST(0) | |
126 | CHBIT=CHIN//' ' | |
127 | LBIT=101 | |
128 | 100 LBIT=LBIT-1 | |
129 | IF(CHBIT(LBIT:LBIT).EQ.' ') GOTO 100 | |
130 | LTOT=0 | |
131 | DO 110 LCOM=1,LBIT | |
132 | IF(CHBIT(LCOM:LCOM).EQ.' ') GOTO 110 | |
133 | LTOT=LTOT+1 | |
134 | CHFIX(LTOT:LTOT)=CHBIT(LCOM:LCOM) | |
135 | 110 CONTINUE | |
136 | LLOW=0 | |
137 | 120 LHIG=LLOW+1 | |
138 | 130 LHIG=LHIG+1 | |
139 | IF(LHIG.LE.LTOT.AND.CHFIX(LHIG:LHIG).NE.';') GOTO 130 | |
140 | LBIT=LHIG-LLOW-1 | |
141 | CHBIT(1:LBIT)=CHFIX(LLOW+1:LHIG-1) | |
142 | ||
143 | C...Identify commonblock variable. | |
144 | LNAM=1 | |
145 | 140 LNAM=LNAM+1 | |
146 | IF(CHBIT(LNAM:LNAM).NE.'('.AND.CHBIT(LNAM:LNAM).NE.'='.AND. | |
147 | &LNAM.LE.4) GOTO 140 | |
148 | CHNAM=CHBIT(1:LNAM-1)//' ' | |
149 | DO 150 LCOM=1,LNAM-1 | |
150 | DO 150 LALP=1,26 | |
151 | 150 IF(CHNAM(LCOM:LCOM).EQ.CHALP(1)(LALP:LALP)) CHNAM(LCOM:LCOM)= | |
152 | &CHALP(2)(LALP:LALP) | |
153 | IVAR=0 | |
154 | DO 160 IV=1,17 | |
155 | 160 IF(CHNAM.EQ.CHVAR(IV)) IVAR=IV | |
156 | IF(IVAR.EQ.0) THEN | |
157 | CALL LUERRM(18,'(LUGIVE:) do not recognize variable '//CHNAM) | |
158 | LLOW=LHIG | |
159 | IF(LLOW.LT.LTOT) GOTO 120 | |
160 | RETURN | |
161 | ENDIF | |
162 | ||
163 | C...Identify any indices. | |
164 | I=0 | |
165 | J=0 | |
166 | IF(CHBIT(LNAM:LNAM).EQ.'(') THEN | |
167 | LIND=LNAM | |
168 | 170 LIND=LIND+1 | |
169 | IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 170 | |
170 | CHIND=' ' | |
171 | IF((CHBIT(LNAM+1:LNAM+1).EQ.'C'.OR.CHBIT(LNAM+1:LNAM+1).EQ.'c'). | |
172 | & AND.(IVAR.EQ.9.OR.IVAR.EQ.10.OR.IVAR.EQ.13.OR.IVAR.EQ.17)) THEN | |
173 | CHIND(LNAM-LIND+11:8)=CHBIT(LNAM+2:LIND-1) | |
174 | READ(CHIND,'(I8)') I1 | |
175 | I=LUCOMP(I1) | |
176 | ELSE | |
177 | CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1) | |
178 | READ(CHIND,'(I8)') I | |
179 | ENDIF | |
180 | LNAM=LIND | |
181 | IF(CHBIT(LNAM:LNAM).EQ.')') LNAM=LNAM+1 | |
182 | ENDIF | |
183 | IF(CHBIT(LNAM:LNAM).EQ.',') THEN | |
184 | LIND=LNAM | |
185 | 180 LIND=LIND+1 | |
186 | IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 180 | |
187 | CHIND=' ' | |
188 | CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1) | |
189 | READ(CHIND,'(I8)') J | |
190 | LNAM=LIND+1 | |
191 | ENDIF | |
192 | ||
193 | C...Check that indices allowed and save old value. | |
194 | IERR=1 | |
195 | IF(CHBIT(LNAM:LNAM).NE.'=') GOTO 190 | |
196 | IF(IVAR.EQ.1) THEN | |
197 | IF(I.NE.0.OR.J.NE.0) GOTO 190 | |
198 | IOLD=N | |
199 | ELSEIF(IVAR.EQ.2) THEN | |
200 | IF(I.LT.1.OR.I.GT.MSTU(4).OR.J.LT.1.OR.J.GT.5) GOTO 190 | |
201 | IOLD=K(I,J) | |
202 | ELSEIF(IVAR.EQ.3) THEN | |
203 | IF(I.LT.1.OR.I.GT.MSTU(4).OR.J.LT.1.OR.J.GT.5) GOTO 190 | |
204 | ROLD=P(I,J) | |
205 | ELSEIF(IVAR.EQ.4) THEN | |
206 | IF(I.LT.1.OR.I.GT.MSTU(4).OR.J.LT.1.OR.J.GT.5) GOTO 190 | |
207 | ROLD=V(I,J) | |
208 | ELSEIF(IVAR.EQ.5) THEN | |
209 | IF(I.LT.1.OR.I.GT.200.OR.J.NE.0) GOTO 190 | |
210 | IOLD=MSTU(I) | |
211 | ELSEIF(IVAR.EQ.6) THEN | |
212 | IF(I.LT.1.OR.I.GT.200.OR.J.NE.0) GOTO 190 | |
213 | ROLD=PARU(I) | |
214 | ELSEIF(IVAR.EQ.7) THEN | |
215 | IF(I.LT.1.OR.I.GT.200.OR.J.NE.0) GOTO 190 | |
216 | IOLD=MSTJ(I) | |
217 | ELSEIF(IVAR.EQ.8) THEN | |
218 | IF(I.LT.1.OR.I.GT.200.OR.J.NE.0) GOTO 190 | |
219 | ROLD=PARJ(I) | |
220 | ELSEIF(IVAR.EQ.9) THEN | |
221 | IF(I.LT.1.OR.I.GT.MSTU(6).OR.J.LT.1.OR.J.GT.3) GOTO 190 | |
222 | IOLD=KCHG(I,J) | |
223 | ELSEIF(IVAR.EQ.10) THEN | |
224 | IF(I.LT.1.OR.I.GT.MSTU(6).OR.J.LT.1.OR.J.GT.4) GOTO 190 | |
225 | ROLD=PMAS(I,J) | |
226 | ELSEIF(IVAR.EQ.11) THEN | |
227 | IF(I.LT.1.OR.I.GT.2000.OR.J.NE.0) GOTO 190 | |
228 | ROLD=PARF(I) | |
229 | ELSEIF(IVAR.EQ.12) THEN | |
230 | IF(I.LT.1.OR.I.GT.4.OR.J.LT.1.OR.J.GT.4) GOTO 190 | |
231 | ROLD=VCKM(I,J) | |
232 | ELSEIF(IVAR.EQ.13) THEN | |
233 | IF(I.LT.1.OR.I.GT.MSTU(6).OR.J.LT.1.OR.J.GT.3) GOTO 190 | |
234 | IOLD=MDCY(I,J) | |
235 | ELSEIF(IVAR.EQ.14) THEN | |
236 | IF(I.LT.1.OR.I.GT.MSTU(7).OR.J.LT.1.OR.J.GT.2) GOTO 190 | |
237 | IOLD=MDME(I,J) | |
238 | ELSEIF(IVAR.EQ.15) THEN | |
239 | IF(I.LT.1.OR.I.GT.MSTU(7).OR.J.NE.0) GOTO 190 | |
240 | ROLD=BRAT(I) | |
241 | ELSEIF(IVAR.EQ.16) THEN | |
242 | IF(I.LT.1.OR.I.GT.MSTU(7).OR.J.LT.1.OR.J.GT.5) GOTO 190 | |
243 | IOLD=KFDP(I,J) | |
244 | ELSEIF(IVAR.EQ.17) THEN | |
245 | IF(I.LT.1.OR.I.GT.MSTU(6).OR.J.NE.0) GOTO 190 | |
246 | CHOLD=CHAF(I) | |
247 | ENDIF | |
248 | IERR=0 | |
249 | 190 IF(IERR.EQ.1) THEN | |
250 | CALL LUERRM(18,'(LUGIVE:) unallowed indices for '// | |
251 | & CHBIT(1:LNAM-1)) | |
252 | LLOW=LHIG | |
253 | IF(LLOW.LT.LTOT) GOTO 120 | |
254 | RETURN | |
255 | ENDIF | |
256 | ||
257 | C...Print current value of variable. Loop back. | |
258 | IF(LNAM.GE.LBIT) THEN | |
259 | CHBIT(LNAM:14)=' ' | |
260 | CHBIT(15:60)=' has the value ' | |
261 | IF(IVAR.EQ.1.OR.IVAR.EQ.2.OR.IVAR.EQ.5.OR.IVAR.EQ.7.OR. | |
262 | & IVAR.EQ.9.OR.IVAR.EQ.13.OR.IVAR.EQ.14.OR.IVAR.EQ.16) THEN | |
263 | WRITE(CHBIT(51:60),'(I10)') IOLD | |
264 | ELSEIF(IVAR.NE.17) THEN | |
265 | WRITE(CHBIT(47:60),'(F14.5)') ROLD | |
266 | ELSE | |
267 | CHBIT(53:60)=CHOLD | |
268 | ENDIF | |
269 | IF(MSTU(13).GE.1) WRITE(MSTU(11),1000) CHBIT(1:60) | |
270 | LLOW=LHIG | |
271 | IF(LLOW.LT.LTOT) GOTO 120 | |
272 | RETURN | |
273 | ENDIF | |
274 | ||
275 | C...Read in new variable value. | |
276 | IF(IVAR.EQ.1.OR.IVAR.EQ.2.OR.IVAR.EQ.5.OR.IVAR.EQ.7.OR. | |
277 | &IVAR.EQ.9.OR.IVAR.EQ.13.OR.IVAR.EQ.14.OR.IVAR.EQ.16) THEN | |
278 | CHINI=' ' | |
279 | CHINI(LNAM-LBIT+11:10)=CHBIT(LNAM+1:LBIT) | |
280 | READ(CHINI,'(I10)') INEW | |
281 | ELSEIF(IVAR.NE.17) THEN | |
282 | CHINR=' ' | |
283 | CHINR(LNAM-LBIT+17:16)=CHBIT(LNAM+1:LBIT) | |
284 | READ(CHINR,'(F16.2)') RNEW | |
285 | ELSE | |
286 | CHNEW=CHBIT(LNAM+1:LBIT)//' ' | |
287 | ENDIF | |
288 | ||
289 | C...Store new variable value. | |
290 | IF(IVAR.EQ.1) THEN | |
291 | N=INEW | |
292 | ELSEIF(IVAR.EQ.2) THEN | |
293 | K(I,J)=INEW | |
294 | ELSEIF(IVAR.EQ.3) THEN | |
295 | P(I,J)=RNEW | |
296 | ELSEIF(IVAR.EQ.4) THEN | |
297 | V(I,J)=RNEW | |
298 | ELSEIF(IVAR.EQ.5) THEN | |
299 | MSTU(I)=INEW | |
300 | ELSEIF(IVAR.EQ.6) THEN | |
301 | PARU(I)=RNEW | |
302 | ELSEIF(IVAR.EQ.7) THEN | |
303 | MSTJ(I)=INEW | |
304 | ELSEIF(IVAR.EQ.8) THEN | |
305 | PARJ(I)=RNEW | |
306 | ELSEIF(IVAR.EQ.9) THEN | |
307 | KCHG(I,J)=INEW | |
308 | ELSEIF(IVAR.EQ.10) THEN | |
309 | PMAS(I,J)=RNEW | |
310 | ELSEIF(IVAR.EQ.11) THEN | |
311 | PARF(I)=RNEW | |
312 | ELSEIF(IVAR.EQ.12) THEN | |
313 | VCKM(I,J)=RNEW | |
314 | ELSEIF(IVAR.EQ.13) THEN | |
315 | MDCY(I,J)=INEW | |
316 | ELSEIF(IVAR.EQ.14) THEN | |
317 | MDME(I,J)=INEW | |
318 | ELSEIF(IVAR.EQ.15) THEN | |
319 | BRAT(I)=RNEW | |
320 | ELSEIF(IVAR.EQ.16) THEN | |
321 | KFDP(I,J)=INEW | |
322 | ELSEIF(IVAR.EQ.17) THEN | |
323 | CHAF(I)=CHNEW | |
324 | ENDIF | |
325 | ||
326 | C...Write old and new value. Loop back. | |
327 | CHBIT(LNAM:14)=' ' | |
328 | CHBIT(15:60)=' changed from to ' | |
329 | IF(IVAR.EQ.1.OR.IVAR.EQ.2.OR.IVAR.EQ.5.OR.IVAR.EQ.7.OR. | |
330 | &IVAR.EQ.9.OR.IVAR.EQ.13.OR.IVAR.EQ.14.OR.IVAR.EQ.16) THEN | |
331 | WRITE(CHBIT(33:42),'(I10)') IOLD | |
332 | WRITE(CHBIT(51:60),'(I10)') INEW | |
333 | ELSEIF(IVAR.NE.17) THEN | |
334 | WRITE(CHBIT(29:42),'(F14.5)') ROLD | |
335 | WRITE(CHBIT(47:60),'(F14.5)') RNEW | |
336 | ELSE | |
337 | CHBIT(35:42)=CHOLD | |
338 | CHBIT(53:60)=CHNEW | |
339 | ENDIF | |
340 | IF(MSTU(13).GE.1) WRITE(MSTU(11),1000) CHBIT(1:60) | |
341 | LLOW=LHIG | |
342 | IF(LLOW.LT.LTOT) GOTO 120 | |
343 | ||
344 | C...Format statement for output on unit MSTU(11) (by default 6). | |
345 | 1000 FORMAT(5X,A60) | |
346 | ||
347 | RETURN | |
348 | END | |
349 | ||
350 | C********************************************************************* | |
351 | ||
352 | SUBROUTINE LUEXEC | |
353 | ||
354 | C...Purpose: to administrate the fragmentation and decay chain. | |
355 | COMMON/LUJETSA/N,K(9000,5),P(9000,5),V(9000,5) | |
356 | SAVE /LUJETSA/ | |
357 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
358 | SAVE /LUDAT1A/ | |
359 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
360 | SAVE /LUDAT2A/ | |
361 | COMMON/LUDAT3A/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) | |
362 | SAVE /LUDAT3A/ | |
363 | DIMENSION PS(2,6) | |
364 | ||
365 | C...Initialize and reset. | |
366 | MSTU(24)=0 | |
367 | IF(MSTU(12).GE.1) CALL LULIST(0) | |
368 | MSTU(31)=MSTU(31)+1 | |
369 | MSTU(1)=0 | |
370 | MSTU(2)=0 | |
371 | MSTU(3)=0 | |
372 | MCONS=1 | |
373 | ||
374 | C...Sum up momentum, energy and charge for starting entries. | |
375 | NSAV=N | |
376 | DO 100 I=1,2 | |
377 | DO 100 J=1,6 | |
378 | 100 PS(I,J)=0. | |
379 | DO 120 I=1,N | |
380 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 120 | |
381 | DO 110 J=1,4 | |
382 | 110 PS(1,J)=PS(1,J)+P(I,J) | |
383 | PS(1,6)=PS(1,6)+LUCHGE(K(I,2)) | |
384 | 120 CONTINUE | |
385 | PARU(21)=PS(1,4) | |
386 | ||
387 | C...Prepare system for subsequent fragmentation/decay. | |
388 | CALL LUPREP(0) | |
389 | ||
390 | C...Loop through jet fragmentation and particle decays. | |
391 | MBE=0 | |
392 | 130 MBE=MBE+1 | |
393 | IP=0 | |
394 | 140 IP=IP+1 | |
395 | KC=0 | |
396 | IF(K(IP,1).GT.0.AND.K(IP,1).LE.10) KC=LUCOMP(K(IP,2)) | |
397 | IF(KC.EQ.0) THEN | |
398 | ||
399 | C...Particle decay if unstable and allowed. Save long-lived particle | |
400 | C...decays until second pass after Bose-Einstein effects. | |
401 | ELSEIF(KCHG(KC,2).EQ.0) THEN | |
402 | clin-4/2008 break up compound IF statements: | |
403 | c IF(MSTJ(21).GE.1.AND.MDCY(KC,1).GE.1.AND.(MSTJ(51).LE.0.OR.MBE. | |
404 | c & EQ.2.OR.PMAS(KC,2).GE.PARJ(91).OR.IABS(K(IP,2)).EQ.311)) | |
405 | c & CALL LUDECY(IP) | |
406 | if(MSTJ(21).GE.1.AND.MDCY(KC,1).GE.1) then | |
407 | if(MSTJ(51).LE.0.OR.MBE.EQ.2.OR.PMAS(KC,2).GE.PARJ(91) | |
408 | & .OR.IABS(K(IP,2)).EQ.311) | |
409 | & CALL LUDECY(IP) | |
410 | endif | |
411 | c | |
412 | C...Decay products may develop a shower. | |
413 | IF(MSTJ(92).GT.0) THEN | |
414 | IP1=MSTJ(92) | |
415 | QMAX=SQRT(MAX(0.,(P(IP1,4)+P(IP1+1,4))**2-(P(IP1,1)+P(IP1+1, | |
416 | & 1))**2-(P(IP1,2)+P(IP1+1,2))**2-(P(IP1,3)+P(IP1+1,3))**2)) | |
417 | CALL LUSHOW(IP1,IP1+1,QMAX) | |
418 | CALL LUPREP(IP1) | |
419 | MSTJ(92)=0 | |
420 | ELSEIF(MSTJ(92).LT.0) THEN | |
421 | IP1=-MSTJ(92) | |
422 | clin-8/19/02 avoid actual argument in common blocks of LUSHOW: | |
423 | c CALL LUSHOW(IP1,-3,P(IP,5)) | |
424 | pip5=P(IP,5) | |
425 | CALL LUSHOW(IP1,-3,pip5) | |
426 | CALL LUPREP(IP1) | |
427 | MSTJ(92)=0 | |
428 | ENDIF | |
429 | ||
430 | C...Jet fragmentation: string or independent fragmentation. | |
431 | ELSEIF(K(IP,1).EQ.1.OR.K(IP,1).EQ.2) THEN | |
432 | MFRAG=MSTJ(1) | |
433 | IF(MFRAG.GE.1.AND.K(IP,1).EQ.1) MFRAG=2 | |
434 | IF(MSTJ(21).GE.2.AND.K(IP,1).EQ.2.AND.N.GT.IP) THEN | |
435 | IF(K(IP+1,1).EQ.1.AND.K(IP+1,3).EQ.K(IP,3).AND. | |
436 | & K(IP,3).GT.0.AND.K(IP,3).LT.IP) THEN | |
437 | IF(KCHG(LUCOMP(K(K(IP,3),2)),2).EQ.0) MFRAG=MIN(1,MFRAG) | |
438 | ENDIF | |
439 | ENDIF | |
440 | IF(MFRAG.EQ.1) then | |
441 | CALL LUSTRF(IP) | |
442 | endif | |
443 | IF(MFRAG.EQ.2) CALL LUINDF(IP) | |
444 | IF(MFRAG.EQ.2.AND.K(IP,1).EQ.1) MCONS=0 | |
445 | IF(MFRAG.EQ.2.AND.(MSTJ(3).LE.0.OR.MOD(MSTJ(3),5).EQ.0)) MCONS=0 | |
446 | ENDIF | |
447 | ||
448 | C...Loop back if enough space left in LUJETSA and no error abort. | |
449 | IF(MSTU(24).NE.0.AND.MSTU(21).GE.2) THEN | |
450 | ELSEIF(IP.LT.N.AND.N.LT.MSTU(4)-20-MSTU(32)) THEN | |
451 | GOTO 140 | |
452 | ELSEIF(IP.LT.N) THEN | |
453 | CALL LUERRM(11,'(LUEXEC:) no more memory left in LUJETSA') | |
454 | ENDIF | |
455 | ||
456 | C...Include simple Bose-Einstein effect parametrization if desired. | |
457 | IF(MBE.EQ.1.AND.MSTJ(51).GE.1) THEN | |
458 | CALL LUBOEI(NSAV) | |
459 | GOTO 130 | |
460 | ENDIF | |
461 | ||
462 | C...Check that momentum, energy and charge were conserved. | |
463 | DO 160 I=1,N | |
464 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 160 | |
465 | DO 150 J=1,4 | |
466 | 150 PS(2,J)=PS(2,J)+P(I,J) | |
467 | PS(2,6)=PS(2,6)+LUCHGE(K(I,2)) | |
468 | 160 CONTINUE | |
469 | PDEV=(ABS(PS(2,1)-PS(1,1))+ABS(PS(2,2)-PS(1,2))+ABS(PS(2,3)- | |
470 | &PS(1,3))+ABS(PS(2,4)-PS(1,4)))/(1.+ABS(PS(2,4))+ABS(PS(1,4))) | |
471 | IF(MCONS.EQ.1.AND.PDEV.GT.PARU(11)) CALL LUERRM(15, | |
472 | &'(LUEXEC:) four-momentum was not conserved') | |
473 | c IF(MCONS.EQ.1.AND.PDEV.GT.PARU(11)) then | |
474 | c CALL LUERRM(15, | |
475 | c &'(LUEXEC:) four-momentum was not conserved') | |
476 | c write(6,*) 'PS1,2=',PS(1,1),PS(1,2),PS(1,3),PS(1,4), | |
477 | c 1 '*',PS(2,1),PS(2,2),PS(2,3),PS(2,4) | |
478 | c endif | |
479 | ||
480 | IF(MCONS.EQ.1.AND.ABS(PS(2,6)-PS(1,6)).GT.0.1) CALL LUERRM(15, | |
481 | &'(LUEXEC:) charge was not conserved') | |
482 | ||
483 | RETURN | |
484 | END | |
485 | ||
486 | C********************************************************************* | |
487 | ||
488 | SUBROUTINE LUPREP(IP) | |
489 | ||
490 | C...Purpose: to rearrange partons along strings, to allow small systems | |
491 | C...to collapse into one or two particles and to check flavours. | |
492 | IMPLICIT DOUBLE PRECISION(D) | |
493 | COMMON/LUJETSA/N,K(9000,5),P(9000,5),V(9000,5) | |
494 | SAVE /LUJETSA/ | |
495 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
496 | SAVE /LUDAT1A/ | |
497 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
498 | SAVE /LUDAT2A/ | |
499 | COMMON/LUDAT3A/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) | |
500 | SAVE /LUDAT3A/ | |
501 | DIMENSION DPS(5),DPC(5),UE(3) | |
502 | ||
503 | ic1=0 | |
504 | ic2=0 | |
505 | kci=0 | |
506 | C...Rearrange parton shower product listing along strings: begin loop. | |
507 | I1=N | |
508 | DO 130 MQGST=1,2 | |
509 | DO 120 I=MAX(1,IP),N | |
510 | IF(K(I,1).NE.3) GOTO 120 | |
511 | KC=LUCOMP(K(I,2)) | |
512 | IF(KC.EQ.0) GOTO 120 | |
513 | KQ=KCHG(KC,2) | |
514 | IF(KQ.EQ.0.OR.(MQGST.EQ.1.AND.KQ.EQ.2)) GOTO 120 | |
515 | ||
516 | C...Pick up loose string end. | |
517 | KCS=4 | |
518 | IF(KQ*ISIGN(1,K(I,2)).LT.0) KCS=5 | |
519 | IA=I | |
520 | NSTP=0 | |
521 | 100 NSTP=NSTP+1 | |
522 | IF(NSTP.GT.4*N) THEN | |
523 | CALL LUERRM(14,'(LUPREP:) caught in infinite loop') | |
524 | RETURN | |
525 | ENDIF | |
526 | ||
527 | C...Copy undecayed parton. | |
528 | IF(K(IA,1).EQ.3) THEN | |
529 | IF(I1.GE.MSTU(4)-MSTU(32)-5) THEN | |
530 | CALL LUERRM(11,'(LUPREP:) no more memory left in LUJETSA') | |
531 | RETURN | |
532 | ENDIF | |
533 | I1=I1+1 | |
534 | K(I1,1)=2 | |
535 | IF(NSTP.GE.2.AND.IABS(K(IA,2)).NE.21) K(I1,1)=1 | |
536 | K(I1,2)=K(IA,2) | |
537 | K(I1,3)=IA | |
538 | K(I1,4)=0 | |
539 | K(I1,5)=0 | |
540 | DO 110 J=1,5 | |
541 | P(I1,J)=P(IA,J) | |
542 | 110 V(I1,J)=V(IA,J) | |
543 | K(IA,1)=K(IA,1)+10 | |
544 | IF(K(I1,1).EQ.1) GOTO 120 | |
545 | ENDIF | |
546 | ||
547 | C...Go to next parton in colour space. | |
548 | IB=IA | |
549 | IF(MOD(K(IB,KCS)/MSTU(5)**2,2).EQ.0.AND.MOD(K(IB,KCS),MSTU(5)). | |
550 | &NE.0) THEN | |
551 | IA=MOD(K(IB,KCS),MSTU(5)) | |
552 | K(IB,KCS)=K(IB,KCS)+MSTU(5)**2 | |
553 | MREV=0 | |
554 | ELSE | |
555 | IF(K(IB,KCS).GE.2*MSTU(5)**2.OR.MOD(K(IB,KCS)/MSTU(5),MSTU(5)). | |
556 | & EQ.0) KCS=9-KCS | |
557 | IA=MOD(K(IB,KCS)/MSTU(5),MSTU(5)) | |
558 | K(IB,KCS)=K(IB,KCS)+2*MSTU(5)**2 | |
559 | MREV=1 | |
560 | ENDIF | |
561 | IF(IA.LE.0.OR.IA.GT.N) THEN | |
562 | CALL LUERRM(12,'(LUPREP:) colour rearrangement failed') | |
563 | RETURN | |
564 | ENDIF | |
565 | IF(MOD(K(IA,4)/MSTU(5),MSTU(5)).EQ.IB.OR.MOD(K(IA,5)/MSTU(5), | |
566 | &MSTU(5)).EQ.IB) THEN | |
567 | IF(MREV.EQ.1) KCS=9-KCS | |
568 | IF(MOD(K(IA,KCS)/MSTU(5),MSTU(5)).NE.IB) KCS=9-KCS | |
569 | K(IA,KCS)=K(IA,KCS)+2*MSTU(5)**2 | |
570 | ELSE | |
571 | IF(MREV.EQ.0) KCS=9-KCS | |
572 | IF(MOD(K(IA,KCS),MSTU(5)).NE.IB) KCS=9-KCS | |
573 | K(IA,KCS)=K(IA,KCS)+MSTU(5)**2 | |
574 | ENDIF | |
575 | IF(IA.NE.I) GOTO 100 | |
576 | K(I1,1)=1 | |
577 | 120 CONTINUE | |
578 | 130 CONTINUE | |
579 | N=I1 | |
580 | ||
581 | C...Find lowest-mass colour singlet jet system, OK if above thresh. | |
582 | IF(MSTJ(14).LE.0) GOTO 320 | |
583 | NS=N | |
584 | 140 NSIN=N-NS | |
585 | PDM=1.+PARJ(32) | |
586 | IC=0 | |
587 | DO 190 I=MAX(1,IP),NS | |
588 | IF(K(I,1).NE.1.AND.K(I,1).NE.2) THEN | |
589 | ELSEIF(K(I,1).EQ.2.AND.IC.EQ.0) THEN | |
590 | NSIN=NSIN+1 | |
591 | IC=I | |
592 | DO 150 J=1,4 | |
593 | 150 DPS(J)=dble(P(I,J)) | |
594 | MSTJ(93)=1 | |
595 | DPS(5)=dble(ULMASS(K(I,2))) | |
596 | ELSEIF(K(I,1).EQ.2) THEN | |
597 | DO 160 J=1,4 | |
598 | 160 DPS(J)=DPS(J)+dble(P(I,J)) | |
599 | ELSEIF(IC.NE.0.AND.KCHG(LUCOMP(K(I,2)),2).NE.0) THEN | |
600 | DO 170 J=1,4 | |
601 | 170 DPS(J)=DPS(J)+dble(P(I,J)) | |
602 | MSTJ(93)=1 | |
603 | DPS(5)=DPS(5)+dble(ULMASS(K(I,2))) | |
604 | PD=sngl(SQRT(MAX(0D0,DPS(4)**2 | |
605 | 1 -DPS(1)**2-DPS(2)**2-DPS(3)**2))-DPS(5)) | |
606 | IF(PD.LT.PDM) THEN | |
607 | PDM=PD | |
608 | DO 180 J=1,5 | |
609 | 180 DPC(J)=DPS(J) | |
610 | IC1=IC | |
611 | IC2=I | |
612 | ENDIF | |
613 | IC=0 | |
614 | ELSE | |
615 | NSIN=NSIN+1 | |
616 | ENDIF | |
617 | 190 CONTINUE | |
618 | IF(PDM.GE.PARJ(32)) GOTO 320 | |
619 | ||
620 | C...Fill small-mass system as cluster. | |
621 | NSAV=N | |
622 | PECM=sngl(SQRT(MAX(0D0,DPC(4)**2-DPC(1)**2-DPC(2)**2-DPC(3)**2))) | |
623 | K(N+1,1)=11 | |
624 | K(N+1,2)=91 | |
625 | K(N+1,3)=IC1 | |
626 | K(N+1,4)=N+2 | |
627 | K(N+1,5)=N+3 | |
628 | P(N+1,1)=sngl(DPC(1)) | |
629 | P(N+1,2)=sngl(DPC(2)) | |
630 | P(N+1,3)=sngl(DPC(3)) | |
631 | P(N+1,4)=sngl(DPC(4)) | |
632 | P(N+1,5)=PECM | |
633 | ||
634 | C...Form two particles from flavours of lowest-mass system, if feasible. | |
635 | K(N+2,1)=1 | |
636 | K(N+3,1)=1 | |
637 | IF(MSTU(16).NE.2) THEN | |
638 | K(N+2,3)=N+1 | |
639 | K(N+3,3)=N+1 | |
640 | ELSE | |
641 | K(N+2,3)=IC1 | |
642 | K(N+3,3)=IC2 | |
643 | ENDIF | |
644 | K(N+2,4)=0 | |
645 | K(N+3,4)=0 | |
646 | K(N+2,5)=0 | |
647 | K(N+3,5)=0 | |
648 | IF(IABS(K(IC1,2)).NE.21) THEN | |
649 | KC1=LUCOMP(K(IC1,2)) | |
650 | KC2=LUCOMP(K(IC2,2)) | |
651 | IF(KC1.EQ.0.OR.KC2.EQ.0) GOTO 320 | |
652 | KQ1=KCHG(KC1,2)*ISIGN(1,K(IC1,2)) | |
653 | KQ2=KCHG(KC2,2)*ISIGN(1,K(IC2,2)) | |
654 | IF(KQ1+KQ2.NE.0) GOTO 320 | |
655 | 200 CALL LUKFDI(K(IC1,2),0,KFLN,K(N+2,2)) | |
656 | CALL LUKFDI(K(IC2,2),-KFLN,KFLDMP,K(N+3,2)) | |
657 | IF(K(N+2,2).EQ.0.OR.K(N+3,2).EQ.0) GOTO 200 | |
658 | ELSE | |
659 | IF(IABS(K(IC2,2)).NE.21) GOTO 320 | |
660 | 210 CALL LUKFDI(1+INT((2.+PARJ(2))*RLU(0)),0,KFLN,KFDMP) | |
661 | CALL LUKFDI(KFLN,0,KFLM,K(N+2,2)) | |
662 | CALL LUKFDI(-KFLN,-KFLM,KFLDMP,K(N+3,2)) | |
663 | IF(K(N+2,2).EQ.0.OR.K(N+3,2).EQ.0) GOTO 210 | |
664 | ENDIF | |
665 | P(N+2,5)=ULMASS(K(N+2,2)) | |
666 | P(N+3,5)=ULMASS(K(N+3,2)) | |
667 | IF(P(N+2,5)+P(N+3,5)+PARJ(64).GE.PECM.AND.NSIN.EQ.1) GOTO 320 | |
668 | IF(P(N+2,5)+P(N+3,5)+PARJ(64).GE.PECM) GOTO 260 | |
669 | ||
670 | C...Perform two-particle decay of jet system, if possible. | |
671 | IF(PECM.GE.0.02d0*DPC(4)) THEN | |
672 | PA=SQRT((PECM**2-(P(N+2,5)+P(N+3,5))**2)*(PECM**2- | |
673 | & (P(N+2,5)-P(N+3,5))**2))/(2.*PECM) | |
674 | UE(3)=2.*RLU(0)-1. | |
675 | PHI=PARU(2)*RLU(0) | |
676 | UE(1)=SQRT(1.-UE(3)**2)*COS(PHI) | |
677 | UE(2)=SQRT(1.-UE(3)**2)*SIN(PHI) | |
678 | DO 220 J=1,3 | |
679 | P(N+2,J)=PA*UE(J) | |
680 | 220 P(N+3,J)=-PA*UE(J) | |
681 | P(N+2,4)=SQRT(PA**2+P(N+2,5)**2) | |
682 | P(N+3,4)=SQRT(PA**2+P(N+3,5)**2) | |
683 | CALL LUDBRB(N+2,N+3,0.,0.,DPC(1)/DPC(4),DPC(2)/DPC(4), | |
684 | & DPC(3)/DPC(4)) | |
685 | ELSE | |
686 | NP=0 | |
687 | DO 230 I=IC1,IC2 | |
688 | 230 IF(K(I,1).EQ.1.OR.K(I,1).EQ.2) NP=NP+1 | |
689 | HA=P(IC1,4)*P(IC2,4)-P(IC1,1)*P(IC2,1)-P(IC1,2)*P(IC2,2)- | |
690 | & P(IC1,3)*P(IC2,3) | |
691 | IF(NP.GE.3.OR.HA.LE.1.25*P(IC1,5)*P(IC2,5)) GOTO 260 | |
692 | HD1=0.5*(P(N+2,5)**2-P(IC1,5)**2) | |
693 | HD2=0.5*(P(N+3,5)**2-P(IC2,5)**2) | |
694 | HR=SQRT(MAX(0.,((HA-HD1-HD2)**2-(P(N+2,5)*P(N+3,5))**2)/ | |
695 | & (HA**2-(P(IC1,5)*P(IC2,5))**2)))-1. | |
696 | HC=P(IC1,5)**2+2.*HA+P(IC2,5)**2 | |
697 | HK1=((P(IC2,5)**2+HA)*HR+HD1-HD2)/HC | |
698 | HK2=((P(IC1,5)**2+HA)*HR+HD2-HD1)/HC | |
699 | DO 240 J=1,4 | |
700 | P(N+2,J)=(1.+HK1)*P(IC1,J)-HK2*P(IC2,J) | |
701 | 240 P(N+3,J)=(1.+HK2)*P(IC2,J)-HK1*P(IC1,J) | |
702 | ENDIF | |
703 | DO 250 J=1,4 | |
704 | V(N+1,J)=V(IC1,J) | |
705 | V(N+2,J)=V(IC1,J) | |
706 | 250 V(N+3,J)=V(IC2,J) | |
707 | V(N+1,5)=0. | |
708 | V(N+2,5)=0. | |
709 | V(N+3,5)=0. | |
710 | N=N+3 | |
711 | GOTO 300 | |
712 | ||
713 | C...Else form one particle from the flavours available, if possible. | |
714 | 260 K(N+1,5)=N+2 | |
715 | IF(IABS(K(IC1,2)).GT.100.AND.IABS(K(IC2,2)).GT.100) THEN | |
716 | GOTO 320 | |
717 | ELSEIF(IABS(K(IC1,2)).NE.21) THEN | |
718 | CALL LUKFDI(K(IC1,2),K(IC2,2),KFLDMP,K(N+2,2)) | |
719 | ELSE | |
720 | KFLN=1+INT((2.+PARJ(2))*RLU(0)) | |
721 | CALL LUKFDI(KFLN,-KFLN,KFLDMP,K(N+2,2)) | |
722 | ENDIF | |
723 | IF(K(N+2,2).EQ.0) GOTO 260 | |
724 | P(N+2,5)=ULMASS(K(N+2,2)) | |
725 | ||
726 | C...Find parton/particle which combines to largest extra mass. | |
727 | IR=0 | |
728 | HA=0. | |
729 | DO 280 MCOMB=1,3 | |
730 | IF(IR.NE.0) GOTO 280 | |
731 | DO 270 I=MAX(1,IP),N | |
732 | IF(K(I,1).LE.0.OR.K(I,1).GT.10.OR.(I.GE.IC1.AND.I.LE.IC2. | |
733 | &AND.K(I,1).GE.1.AND.K(I,1).LE.2)) GOTO 270 | |
734 | IF(MCOMB.EQ.1) KCI=LUCOMP(K(I,2)) | |
735 | IF(MCOMB.EQ.1.AND.KCI.EQ.0) GOTO 270 | |
736 | IF(MCOMB.EQ.1.AND.KCHG(KCI,2).EQ.0.AND.I.LE.NS) GOTO 270 | |
737 | IF(MCOMB.EQ.2.AND.IABS(K(I,2)).GT.10.AND.IABS(K(I,2)).LE.100) | |
738 | &GOTO 270 | |
739 | HCR=sngl(DPC(4))*P(I,4)-sngl(DPC(1))*P(I,1) | |
740 | 1 -sngl(DPC(2))*P(I,2)-sngl(DPC(3))*P(I,3) | |
741 | IF(HCR.GT.HA) THEN | |
742 | IR=I | |
743 | HA=HCR | |
744 | ENDIF | |
745 | 270 CONTINUE | |
746 | 280 CONTINUE | |
747 | ||
748 | C...Shuffle energy and momentum to put new particle on mass shell. | |
749 | HB=PECM**2+HA | |
750 | HC=P(N+2,5)**2+HA | |
751 | HD=P(IR,5)**2+HA | |
752 | C******************CHANGES BY HIJING************ | |
753 | HK2=0.0 | |
754 | IF(HA**2-(PECM*P(IR,5))**2.EQ.0.0.OR.HB+HD.EQ.0.0) GO TO 285 | |
755 | C****************** | |
756 | HK2=0.5*(HB*SQRT(((HB+HC)**2-4.*(HB+HD)*P(N+2,5)**2)/ | |
757 | &(HA**2-(PECM*P(IR,5))**2))-(HB+HC))/(HB+HD) | |
758 | 285 HK1=(0.5*(P(N+2,5)**2-PECM**2)+HD*HK2)/HB | |
759 | DO 290 J=1,4 | |
760 | P(N+2,J)=(1.+HK1)*sngl(DPC(J))-HK2*P(IR,J) | |
761 | P(IR,J)=(1.+HK2)*P(IR,J)-HK1*sngl(DPC(J)) | |
762 | V(N+1,J)=V(IC1,J) | |
763 | 290 V(N+2,J)=V(IC1,J) | |
764 | V(N+1,5)=0. | |
765 | V(N+2,5)=0. | |
766 | N=N+2 | |
767 | ||
768 | C...Mark collapsed system and store daughter pointers. Iterate. | |
769 | 300 DO 310 I=IC1,IC2 | |
770 | IF((K(I,1).EQ.1.OR.K(I,1).EQ.2).AND.KCHG(LUCOMP(K(I,2)),2).NE.0) | |
771 | &THEN | |
772 | K(I,1)=K(I,1)+10 | |
773 | IF(MSTU(16).NE.2) THEN | |
774 | K(I,4)=NSAV+1 | |
775 | K(I,5)=NSAV+1 | |
776 | ELSE | |
777 | K(I,4)=NSAV+2 | |
778 | K(I,5)=N | |
779 | ENDIF | |
780 | ENDIF | |
781 | 310 CONTINUE | |
782 | IF(N.LT.MSTU(4)-MSTU(32)-5) GOTO 140 | |
783 | ||
784 | C...Check flavours and invariant masses in parton systems. | |
785 | 320 NP=0 | |
786 | KFN=0 | |
787 | KQS=0 | |
788 | DO 330 J=1,5 | |
789 | 330 DPS(J)=0d0 | |
790 | DO 360 I=MAX(1,IP),N | |
791 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 360 | |
792 | KC=LUCOMP(K(I,2)) | |
793 | IF(KC.EQ.0) GOTO 360 | |
794 | KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) | |
795 | IF(KQ.EQ.0) GOTO 360 | |
796 | NP=NP+1 | |
797 | IF(KQ.NE.2) THEN | |
798 | KFN=KFN+1 | |
799 | KQS=KQS+KQ | |
800 | MSTJ(93)=1 | |
801 | DPS(5)=DPS(5)+dble(ULMASS(K(I,2))) | |
802 | ENDIF | |
803 | DO 340 J=1,4 | |
804 | 340 DPS(J)=DPS(J)+dble(P(I,J)) | |
805 | ||
806 | clin-4/12/01: | |
807 | c np: # of partons, KFN: number of quarks and diquarks, | |
808 | c KC=0 for color singlet system, -1 for quarks and anti-diquarks, | |
809 | c 1 for quarks and anti-diquarks, and 2 for gluons: | |
810 | IF(K(I,1).EQ.1) THEN | |
811 | clin-4/12/01 end of color singlet system. | |
812 | IF(NP.NE.1.AND.(KFN.EQ.1.OR.KFN.GE.3.OR.KQS.NE.0)) CALL | |
813 | & LUERRM(2,'(LUPREP:) unphysical flavour combination') | |
814 | ||
815 | clin-4/16/01: 'jet system' should be defined as np.ne.2: | |
816 | c IF(NP.NE.1.AND.DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2.LT. | |
817 | c & (0.9*PARJ(32)+DPS(5))**2) CALL LUERRM(3, | |
818 | c & '(LUPREP:) too small mass in jet system') | |
819 | IF(NP.NE.2.AND.DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2.LT. | |
820 | & (0.9d0*dble(PARJ(32))+DPS(5))**2) then | |
821 | CALL LUERRM(3, | |
822 | & '(LUPREP:) too small mass in jet system') | |
823 | write (6,*) 'DPS(1-5),KI1-5=',DPS(1),DPS(2),DPS(3),DPS(4), | |
824 | 1 DPS(5),'*',K(I,1),K(I,2),K(I,3),K(I,4),K(I,5) | |
825 | endif | |
826 | ||
827 | NP=0 | |
828 | KFN=0 | |
829 | KQS=0 | |
830 | DO 350 J=1,5 | |
831 | 350 DPS(J)=0d0 | |
832 | ENDIF | |
833 | 360 CONTINUE | |
834 | ||
835 | RETURN | |
836 | END | |
837 | ||
838 | C********************************************************************* | |
839 | ||
840 | SUBROUTINE LUSTRF(IP) | |
841 | C...Purpose: to handle the fragmentation of an arbitrary colour singlet | |
842 | C...jet system according to the Lund string fragmentation model. | |
843 | IMPLICIT DOUBLE PRECISION(D) | |
844 | COMMON/LUJETSA/N,K(9000,5),P(9000,5),V(9000,5) | |
845 | SAVE /LUJETSA/ | |
846 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
847 | SAVE /LUDAT1A/ | |
848 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
849 | SAVE /LUDAT2A/ | |
850 | DIMENSION DPS(5),KFL(3),PMQ(3),PX(3),PY(3),GAM(3),IE(2),PR(2), | |
851 | &IN(9),DHM(4),DHG(4),DP(5,5),IRANK(2),MJU(4),IJU(3),PJU(5,5), | |
852 | &TJU(5),KFJH(2),NJS(2),KFJS(2),PJS(4,5) | |
853 | ||
854 | C...Function: four-product of two vectors. | |
855 | 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) | |
856 | DFOUR(I,J)=DP(I,4)*DP(J,4)-DP(I,1)*DP(J,1)-DP(I,2)*DP(J,2)- | |
857 | &DP(I,3)*DP(J,3) | |
858 | ||
859 | ir=0 | |
860 | in3=0 | |
861 | jr=0 | |
862 | prev=0 | |
863 | ||
864 | C...Reset counters. Identify parton system. | |
865 | MSTJ(91)=0 | |
866 | NSAV=N | |
867 | NP=0 | |
868 | KQSUM=0 | |
869 | DO 100 J=1,5 | |
870 | 100 DPS(J)=0d0 | |
871 | MJU(1)=0 | |
872 | MJU(2)=0 | |
873 | I=IP-1 | |
874 | 110 I=I+1 | |
875 | IF(I.GT.MIN(N,MSTU(4)-MSTU(32))) THEN | |
876 | CALL LUERRM(12,'(LUSTRF:) failed to reconstruct jet system') | |
877 | IF(MSTU(21).GE.1) RETURN | |
878 | ENDIF | |
879 | IF(K(I,1).NE.1.AND.K(I,1).NE.2.AND.K(I,1).NE.41) GOTO 110 | |
880 | KC=LUCOMP(K(I,2)) | |
881 | IF(KC.EQ.0) GOTO 110 | |
882 | KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) | |
883 | IF(KQ.EQ.0) GOTO 110 | |
884 | IF(N+5*NP+11.GT.MSTU(4)-MSTU(32)-5) THEN | |
885 | CALL LUERRM(11,'(LUSTRF:) no more memory left in LUJETSA') | |
886 | IF(MSTU(21).GE.1) RETURN | |
887 | ENDIF | |
888 | ||
889 | C...Take copy of partons to be considered. Check flavour sum. | |
890 | NP=NP+1 | |
891 | DO 120 J=1,5 | |
892 | K(N+NP,J)=K(I,J) | |
893 | P(N+NP,J)=P(I,J) | |
894 | 120 DPS(J)=DPS(J)+dble(P(I,J)) | |
895 | K(N+NP,3)=I | |
896 | IF(P(N+NP,4)**2.LT.P(N+NP,1)**2+P(N+NP,2)**2+P(N+NP,3)**2) THEN | |
897 | P(N+NP,4)=SQRT(P(N+NP,1)**2+P(N+NP,2)**2+P(N+NP,3)**2+ | |
898 | & P(N+NP,5)**2) | |
899 | DPS(4)=DPS(4)+dble(MAX(0.,P(N+NP,4)-P(I,4))) | |
900 | ENDIF | |
901 | IF(KQ.NE.2) KQSUM=KQSUM+KQ | |
902 | IF(K(I,1).EQ.41) THEN | |
903 | KQSUM=KQSUM+2*KQ | |
904 | IF(KQSUM.EQ.KQ) MJU(1)=N+NP | |
905 | IF(KQSUM.NE.KQ) MJU(2)=N+NP | |
906 | ENDIF | |
907 | IF(K(I,1).EQ.2.OR.K(I,1).EQ.41) GOTO 110 | |
908 | IF(KQSUM.NE.0) THEN | |
909 | CALL LUERRM(12,'(LUSTRF:) unphysical flavour combination') | |
910 | IF(MSTU(21).GE.1) RETURN | |
911 | ENDIF | |
912 | ||
913 | C...Boost copied system to CM frame (for better numerical precision). | |
914 | CALL LUDBRB(N+1,N+NP,0.,0.,-DPS(1)/DPS(4),-DPS(2)/DPS(4), | |
915 | &-DPS(3)/DPS(4)) | |
916 | ||
917 | C...Search for very nearby partons that may be recombined. | |
918 | NTRYR=0 | |
919 | PARU12=PARU(12) | |
920 | PARU13=PARU(13) | |
921 | MJU(3)=MJU(1) | |
922 | MJU(4)=MJU(2) | |
923 | NR=NP | |
924 | 130 IF(NR.GE.3) THEN | |
925 | PDRMIN=2.*PARU12 | |
926 | DO 140 I=N+1,N+NR | |
927 | IF(I.EQ.N+NR.AND.IABS(K(N+1,2)).NE.21) GOTO 140 | |
928 | I1=I+1 | |
929 | IF(I.EQ.N+NR) I1=N+1 | |
930 | IF(K(I,1).EQ.41.OR.K(I1,1).EQ.41) GOTO 140 | |
931 | IF(MJU(1).NE.0.AND.I1.LT.MJU(1).AND.IABS(K(I1,2)).NE.21) | |
932 | & GOTO 140 | |
933 | IF(MJU(2).NE.0.AND.I.GT.MJU(2).AND.IABS(K(I,2)).NE.21) GOTO 140 | |
934 | PAP=SQRT((P(I,1)**2+P(I,2)**2+P(I,3)**2)*(P(I1,1)**2+ | |
935 | & P(I1,2)**2+P(I1,3)**2)) | |
936 | PVP=P(I,1)*P(I1,1)+P(I,2)*P(I1,2)+P(I,3)*P(I1,3) | |
937 | PDR=4.*(PAP-PVP)**2/(PARU13**2*PAP+2.*(PAP-PVP)) | |
938 | IF(PDR.LT.PDRMIN) THEN | |
939 | IR=I | |
940 | PDRMIN=PDR | |
941 | ENDIF | |
942 | 140 CONTINUE | |
943 | ||
944 | C...Recombine very nearby partons to avoid machine precision problems. | |
945 | IF(PDRMIN.LT.PARU12.AND.IR.EQ.N+NR) THEN | |
946 | DO 150 J=1,4 | |
947 | 150 P(N+1,J)=P(N+1,J)+P(N+NR,J) | |
948 | P(N+1,5)=SQRT(MAX(0.,P(N+1,4)**2-P(N+1,1)**2-P(N+1,2)**2- | |
949 | & P(N+1,3)**2)) | |
950 | NR=NR-1 | |
951 | GOTO 130 | |
952 | ELSEIF(PDRMIN.LT.PARU12) THEN | |
953 | DO 160 J=1,4 | |
954 | 160 P(IR,J)=P(IR,J)+P(IR+1,J) | |
955 | P(IR,5)=SQRT(MAX(0.,P(IR,4)**2-P(IR,1)**2-P(IR,2)**2- | |
956 | & P(IR,3)**2)) | |
957 | DO 170 I=IR+1,N+NR-1 | |
958 | K(I,2)=K(I+1,2) | |
959 | DO 170 J=1,5 | |
960 | 170 P(I,J)=P(I+1,J) | |
961 | IF(IR.EQ.N+NR-1) K(IR,2)=K(N+NR,2) | |
962 | NR=NR-1 | |
963 | IF(MJU(1).GT.IR) MJU(1)=MJU(1)-1 | |
964 | IF(MJU(2).GT.IR) MJU(2)=MJU(2)-1 | |
965 | GOTO 130 | |
966 | ENDIF | |
967 | ENDIF | |
968 | NTRYR=NTRYR+1 | |
969 | ||
970 | C...Reset particle counter. Skip ahead if no junctions are present; | |
971 | C...this is usually the case! | |
972 | NRS=MAX(5*NR+11,NP) | |
973 | NTRY=0 | |
974 | 180 NTRY=NTRY+1 | |
975 | IF(NTRY.GT.100.AND.NTRYR.LE.4) THEN | |
976 | PARU12=4.*PARU12 | |
977 | PARU13=2.*PARU13 | |
978 | GOTO 130 | |
979 | ELSEIF(NTRY.GT.100) THEN | |
980 | CALL LUERRM(14,'(LUSTRF:) caught in infinite loop') | |
981 | IF(MSTU(21).GE.1) RETURN | |
982 | ENDIF | |
983 | I=N+NRS | |
984 | IF(MJU(1).EQ.0.AND.MJU(2).EQ.0) GOTO 500 | |
985 | DO 490 JT=1,2 | |
986 | NJS(JT)=0 | |
987 | IF(MJU(JT).EQ.0) GOTO 490 | |
988 | JS=3-2*JT | |
989 | ||
990 | C...Find and sum up momentum on three sides of junction. Check flavours. | |
991 | DO 190 IU=1,3 | |
992 | IJU(IU)=0 | |
993 | DO 190 J=1,5 | |
994 | 190 PJU(IU,J)=0. | |
995 | IU=0 | |
996 | DO 200 I1=N+1+(JT-1)*(NR-1),N+NR+(JT-1)*(1-NR),JS | |
997 | IF(K(I1,2).NE.21.AND.IU.LE.2) THEN | |
998 | IU=IU+1 | |
999 | IJU(IU)=I1 | |
1000 | ENDIF | |
1001 | DO 200 J=1,4 | |
1002 | 200 PJU(IU,J)=PJU(IU,J)+P(I1,J) | |
1003 | DO 210 IU=1,3 | |
1004 | 210 PJU(IU,5)=SQRT(PJU(IU,1)**2+PJU(IU,2)**2+PJU(IU,3)**2) | |
1005 | IF(K(IJU(3),2)/100.NE.10*K(IJU(1),2)+K(IJU(2),2).AND. | |
1006 | &K(IJU(3),2)/100.NE.10*K(IJU(2),2)+K(IJU(1),2)) THEN | |
1007 | CALL LUERRM(12,'(LUSTRF:) unphysical flavour combination') | |
1008 | IF(MSTU(21).GE.1) RETURN | |
1009 | ENDIF | |
1010 | ||
1011 | C...Calculate (approximate) boost to rest frame of junction. | |
1012 | T12=(PJU(1,1)*PJU(2,1)+PJU(1,2)*PJU(2,2)+PJU(1,3)*PJU(2,3))/ | |
1013 | &(PJU(1,5)*PJU(2,5)) | |
1014 | T13=(PJU(1,1)*PJU(3,1)+PJU(1,2)*PJU(3,2)+PJU(1,3)*PJU(3,3))/ | |
1015 | &(PJU(1,5)*PJU(3,5)) | |
1016 | T23=(PJU(2,1)*PJU(3,1)+PJU(2,2)*PJU(3,2)+PJU(2,3)*PJU(3,3))/ | |
1017 | &(PJU(2,5)*PJU(3,5)) | |
1018 | T11=SQRT((2./3.)*(1.-T12)*(1.-T13)/(1.-T23)) | |
1019 | T22=SQRT((2./3.)*(1.-T12)*(1.-T23)/(1.-T13)) | |
1020 | TSQ=SQRT((2.*T11*T22+T12-1.)*(1.+T12)) | |
1021 | T1F=(TSQ-T22*(1.+T12))/(1.-T12**2) | |
1022 | T2F=(TSQ-T11*(1.+T12))/(1.-T12**2) | |
1023 | DO 220 J=1,3 | |
1024 | 220 TJU(J)=-(T1F*PJU(1,J)/PJU(1,5)+T2F*PJU(2,J)/PJU(2,5)) | |
1025 | TJU(4)=SQRT(1.+TJU(1)**2+TJU(2)**2+TJU(3)**2) | |
1026 | DO 230 IU=1,3 | |
1027 | 230 PJU(IU,5)=TJU(4)*PJU(IU,4)-TJU(1)*PJU(IU,1)-TJU(2)*PJU(IU,2)- | |
1028 | &TJU(3)*PJU(IU,3) | |
1029 | ||
1030 | C...Put junction at rest if motion could give inconsistencies. | |
1031 | IF(PJU(1,5)+PJU(2,5).GT.PJU(1,4)+PJU(2,4)) THEN | |
1032 | DO 240 J=1,3 | |
1033 | 240 TJU(J)=0. | |
1034 | TJU(4)=1. | |
1035 | PJU(1,5)=PJU(1,4) | |
1036 | PJU(2,5)=PJU(2,4) | |
1037 | PJU(3,5)=PJU(3,4) | |
1038 | ENDIF | |
1039 | ||
1040 | C...Start preparing for fragmentation of two strings from junction. | |
1041 | ISTA=I | |
1042 | DO 470 IU=1,2 | |
1043 | NS=IJU(IU+1)-IJU(IU) | |
1044 | ||
1045 | C...Junction strings: find longitudinal string directions. | |
1046 | DO 260 IS=1,NS | |
1047 | IS1=IJU(IU)+IS-1 | |
1048 | IS2=IJU(IU)+IS | |
1049 | DO 250 J=1,5 | |
1050 | DP(1,J)=dble(0.5*P(IS1,J)) | |
1051 | IF(IS.EQ.1) DP(1,J)=dble(P(IS1,J)) | |
1052 | DP(2,J)=dble(0.5*P(IS2,J)) | |
1053 | 250 IF(IS.EQ.NS) DP(2,J)=-dble(PJU(IU,J)) | |
1054 | IF(IS.EQ.NS) DP(2,4)=dble( | |
1055 | 1 SQRT(PJU(IU,1)**2+PJU(IU,2)**2+PJU(IU,3)**2)) | |
1056 | IF(IS.EQ.NS) DP(2,5)=0d0 | |
1057 | DP(3,5)=DFOUR(1,1) | |
1058 | DP(4,5)=DFOUR(2,2) | |
1059 | DHKC=DFOUR(1,2) | |
1060 | IF(DP(3,5)+2d0*DHKC+DP(4,5).LE.0d0) THEN | |
1061 | DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) | |
1062 | DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) | |
1063 | DP(3,5)=0D0 | |
1064 | DP(4,5)=0D0 | |
1065 | DHKC=DFOUR(1,2) | |
1066 | ENDIF | |
1067 | DHKS=SQRT(DHKC**2-DP(3,5)*DP(4,5)) | |
1068 | DHK1=0.5d0*((DP(4,5)+DHKC)/DHKS-1d0) | |
1069 | DHK2=0.5d0*((DP(3,5)+DHKC)/DHKS-1d0) | |
1070 | IN1=N+NR+4*IS-3 | |
1071 | P(IN1,5)=sngl(SQRT(DP(3,5)+2d0*DHKC+DP(4,5))) | |
1072 | DO 260 J=1,4 | |
1073 | P(IN1,J)=sngl((1d0+DHK1)*DP(1,J)-DHK2*DP(2,J)) | |
1074 | 260 P(IN1+1,J)=sngl((1d0+DHK2)*DP(2,J)-DHK1*DP(1,J)) | |
1075 | ||
1076 | C...Junction strings: initialize flavour, momentum and starting pos. | |
1077 | ISAV=I | |
1078 | 270 NTRY=NTRY+1 | |
1079 | IF(NTRY.GT.100.AND.NTRYR.LE.4) THEN | |
1080 | PARU12=4.*PARU12 | |
1081 | PARU13=2.*PARU13 | |
1082 | GOTO 130 | |
1083 | ELSEIF(NTRY.GT.100) THEN | |
1084 | CALL LUERRM(14,'(LUSTRF:) caught in infinite loop') | |
1085 | IF(MSTU(21).GE.1) RETURN | |
1086 | ENDIF | |
1087 | I=ISAV | |
1088 | IRANKJ=0 | |
1089 | IE(1)=K(N+1+(JT/2)*(NP-1),3) | |
1090 | IN(4)=N+NR+1 | |
1091 | IN(5)=IN(4)+1 | |
1092 | IN(6)=N+NR+4*NS+1 | |
1093 | DO 280 JQ=1,2 | |
1094 | DO 280 IN1=N+NR+2+JQ,N+NR+4*NS-2+JQ,4 | |
1095 | P(IN1,1)=2-JQ | |
1096 | P(IN1,2)=JQ-1 | |
1097 | 280 P(IN1,3)=1. | |
1098 | KFL(1)=K(IJU(IU),2) | |
1099 | PX(1)=0. | |
1100 | PY(1)=0. | |
1101 | GAM(1)=0. | |
1102 | DO 290 J=1,5 | |
1103 | 290 PJU(IU+3,J)=0. | |
1104 | ||
1105 | C...Junction strings: find initial transverse directions. | |
1106 | DO 300 J=1,4 | |
1107 | DP(1,J)=dble(P(IN(4),J)) | |
1108 | DP(2,J)=dble(P(IN(4)+1,J)) | |
1109 | DP(3,J)=0d0 | |
1110 | 300 DP(4,J)=0d0 | |
1111 | DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) | |
1112 | DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) | |
1113 | DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4) | |
1114 | DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4) | |
1115 | DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4) | |
1116 | IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1d0 | |
1117 | IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1d0 | |
1118 | IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1d0 | |
1119 | IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1d0 | |
1120 | DHC12=DFOUR(1,2) | |
1121 | DHCX1=DFOUR(3,1)/DHC12 | |
1122 | DHCX2=DFOUR(3,2)/DHC12 | |
1123 | DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12) | |
1124 | DHCY1=DFOUR(4,1)/DHC12 | |
1125 | DHCY2=DFOUR(4,2)/DHC12 | |
1126 | DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12 | |
1127 | DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2) | |
1128 | DO 310 J=1,4 | |
1129 | DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J)) | |
1130 | P(IN(6),J)=sngl(DP(3,J)) | |
1131 | 310 P(IN(6)+1,J)=sngl(DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)- | |
1132 | &DHCYX*DP(3,J))) | |
1133 | ||
1134 | C...Junction strings: produce new particle, origin. | |
1135 | 320 I=I+1 | |
1136 | IF(2*I-NSAV.GE.MSTU(4)-MSTU(32)-5) THEN | |
1137 | CALL LUERRM(11,'(LUSTRF:) no more memory left in LUJETSA') | |
1138 | IF(MSTU(21).GE.1) RETURN | |
1139 | ENDIF | |
1140 | IRANKJ=IRANKJ+1 | |
1141 | K(I,1)=1 | |
1142 | K(I,3)=IE(1) | |
1143 | K(I,4)=0 | |
1144 | K(I,5)=0 | |
1145 | ||
1146 | C...Junction strings: generate flavour, hadron, pT, z and Gamma. | |
1147 | 330 CALL LUKFDI(KFL(1),0,KFL(3),K(I,2)) | |
1148 | IF(K(I,2).EQ.0) GOTO 270 | |
1149 | IF(MSTJ(12).GE.3.AND.IRANKJ.EQ.1.AND.IABS(KFL(1)).LE.10.AND. | |
1150 | &IABS(KFL(3)).GT.10) THEN | |
1151 | IF(RLU(0).GT.PARJ(19)) GOTO 330 | |
1152 | ENDIF | |
1153 | P(I,5)=ULMASS(K(I,2)) | |
1154 | CALL LUPTDI(KFL(1),PX(3),PY(3)) | |
1155 | PR(1)=P(I,5)**2+(PX(1)+PX(3))**2+(PY(1)+PY(3))**2 | |
1156 | CALL LUZDIS(KFL(1),KFL(3),PR(1),Z) | |
1157 | GAM(3)=(1.-Z)*(GAM(1)+PR(1)/Z) | |
1158 | DO 340 J=1,3 | |
1159 | 340 IN(J)=IN(3+J) | |
1160 | ||
1161 | C...Junction strings: stepping within or from 'low' string region easy. | |
1162 | IF(IN(1)+1.EQ.IN(2).AND.Z*P(IN(1)+2,3)*P(IN(2)+2,3)* | |
1163 | &P(IN(1),5)**2.GE.PR(1)) THEN | |
1164 | P(IN(1)+2,4)=Z*P(IN(1)+2,3) | |
1165 | P(IN(2)+2,4)=PR(1)/(P(IN(1)+2,4)*P(IN(1),5)**2) | |
1166 | DO 350 J=1,4 | |
1167 | 350 P(I,J)=(PX(1)+PX(3))*P(IN(3),J)+(PY(1)+PY(3))*P(IN(3)+1,J) | |
1168 | GOTO 420 | |
1169 | ELSEIF(IN(1)+1.EQ.IN(2)) THEN | |
1170 | P(IN(2)+2,4)=P(IN(2)+2,3) | |
1171 | P(IN(2)+2,1)=1. | |
1172 | IN(2)=IN(2)+4 | |
1173 | IF(IN(2).GT.N+NR+4*NS) GOTO 270 | |
1174 | IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN | |
1175 | P(IN(1)+2,4)=P(IN(1)+2,3) | |
1176 | P(IN(1)+2,1)=0. | |
1177 | IN(1)=IN(1)+4 | |
1178 | ENDIF | |
1179 | ENDIF | |
1180 | ||
1181 | C...Junction strings: find new transverse directions. | |
1182 | 360 IF(IN(1).GT.N+NR+4*NS.OR.IN(2).GT.N+NR+4*NS.OR. | |
1183 | &IN(1).GT.IN(2)) GOTO 270 | |
1184 | IF(IN(1).NE.IN(4).OR.IN(2).NE.IN(5)) THEN | |
1185 | DO 370 J=1,4 | |
1186 | DP(1,J)=dble(P(IN(1),J)) | |
1187 | DP(2,J)=dble(P(IN(2),J)) | |
1188 | DP(3,J)=0d0 | |
1189 | 370 DP(4,J)=0d0 | |
1190 | DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) | |
1191 | DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) | |
1192 | DHC12=DFOUR(1,2) | |
1193 | IF(DHC12.LE.1E-2) THEN | |
1194 | P(IN(1)+2,4)=P(IN(1)+2,3) | |
1195 | P(IN(1)+2,1)=0. | |
1196 | IN(1)=IN(1)+4 | |
1197 | GOTO 360 | |
1198 | ENDIF | |
1199 | IN(3)=N+NR+4*NS+5 | |
1200 | DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4) | |
1201 | DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4) | |
1202 | DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4) | |
1203 | IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1d0 | |
1204 | IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1d0 | |
1205 | IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1d0 | |
1206 | IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1d0 | |
1207 | DHCX1=DFOUR(3,1)/DHC12 | |
1208 | DHCX2=DFOUR(3,2)/DHC12 | |
1209 | DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12) | |
1210 | DHCY1=DFOUR(4,1)/DHC12 | |
1211 | DHCY2=DFOUR(4,2)/DHC12 | |
1212 | DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12 | |
1213 | DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2) | |
1214 | DO 380 J=1,4 | |
1215 | DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J)) | |
1216 | P(IN(3),J)=sngl(DP(3,J)) | |
1217 | 380 P(IN(3)+1,J)=sngl(DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)- | |
1218 | & DHCYX*DP(3,J))) | |
1219 | C...Express pT with respect to new axes, if sensible. | |
1220 | PXP=-(PX(3)*FOUR(IN(6),IN(3))+PY(3)*FOUR(IN(6)+1,IN(3))) | |
1221 | PYP=-(PX(3)*FOUR(IN(6),IN(3)+1)+PY(3)*FOUR(IN(6)+1,IN(3)+1)) | |
1222 | IF(ABS(PXP**2+PYP**2-PX(3)**2-PY(3)**2).LT.0.01) THEN | |
1223 | PX(3)=PXP | |
1224 | PY(3)=PYP | |
1225 | ENDIF | |
1226 | ENDIF | |
1227 | ||
1228 | C...Junction strings: sum up known four-momentum, coefficients for m2. | |
1229 | DO 400 J=1,4 | |
1230 | DHG(J)=0d0 | |
1231 | P(I,J)=PX(1)*P(IN(6),J)+PY(1)*P(IN(6)+1,J)+PX(3)*P(IN(3),J)+ | |
1232 | &PY(3)*P(IN(3)+1,J) | |
1233 | DO 390 IN1=IN(4),IN(1)-4,4 | |
1234 | 390 P(I,J)=P(I,J)+P(IN1+2,3)*P(IN1,J) | |
1235 | DO 400 IN2=IN(5),IN(2)-4,4 | |
1236 | 400 P(I,J)=P(I,J)+P(IN2+2,3)*P(IN2,J) | |
1237 | DHM(1)=dble(FOUR(I,I)) | |
1238 | DHM(2)=dble(2.*FOUR(I,IN(1))) | |
1239 | DHM(3)=dble(2.*FOUR(I,IN(2))) | |
1240 | DHM(4)=dble(2.*FOUR(IN(1),IN(2))) | |
1241 | ||
1242 | C...Junction strings: find coefficients for Gamma expression. | |
1243 | DO 410 IN2=IN(1)+1,IN(2),4 | |
1244 | DO 410 IN1=IN(1),IN2-1,4 | |
1245 | DHC=dble(2.*FOUR(IN1,IN2)) | |
1246 | DHG(1)=DHG(1)+dble(P(IN1+2,1)*P(IN2+2,1))*DHC | |
1247 | IF(IN1.EQ.IN(1)) DHG(2)=DHG(2)-dble(P(IN2+2,1))*DHC | |
1248 | IF(IN2.EQ.IN(2)) DHG(3)=DHG(3)+dble(P(IN1+2,1))*DHC | |
1249 | 410 IF(IN1.EQ.IN(1).AND.IN2.EQ.IN(2)) DHG(4)=DHG(4)-DHC | |
1250 | ||
1251 | C...Junction strings: solve (m2, Gamma) equation system for energies. | |
1252 | DHS1=DHM(3)*DHG(4)-DHM(4)*DHG(3) | |
1253 | IF(ABS(DHS1).LT.1E-4) GOTO 270 | |
1254 | DHS2=DHM(4)*(dble(GAM(3))-DHG(1))-DHM(2)*DHG(3)-DHG(4)* | |
1255 | &(dble(P(I,5))**2-DHM(1))+DHG(2)*DHM(3) | |
1256 | DHS3=DHM(2)*(dble(GAM(3))-DHG(1)) | |
1257 | 1 -DHG(2)*(dble(P(I,5))**2-DHM(1)) | |
1258 | P(IN(2)+2,4)=0.5*sngl(SQRT(MAX(0D0,DHS2**2-4d0*DHS1*DHS3)) | |
1259 | & /ABS(DHS1)-DHS2/DHS1) | |
1260 | IF(DHM(2)+DHM(4)*dble(P(IN(2)+2,4)).LE.0d0) GOTO 270 | |
1261 | P(IN(1)+2,4)=(P(I,5)**2-sngl(DHM(1))-sngl(DHM(3))*P(IN(2)+2,4))/ | |
1262 | &(sngl(DHM(2))+sngl(DHM(4))*P(IN(2)+2,4)) | |
1263 | ||
1264 | C...Junction strings: step to new region if necessary. | |
1265 | IF(P(IN(2)+2,4).GT.P(IN(2)+2,3)) THEN | |
1266 | P(IN(2)+2,4)=P(IN(2)+2,3) | |
1267 | P(IN(2)+2,1)=1. | |
1268 | IN(2)=IN(2)+4 | |
1269 | IF(IN(2).GT.N+NR+4*NS) GOTO 270 | |
1270 | IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN | |
1271 | P(IN(1)+2,4)=P(IN(1)+2,3) | |
1272 | P(IN(1)+2,1)=0. | |
1273 | IN(1)=IN(1)+4 | |
1274 | ENDIF | |
1275 | GOTO 360 | |
1276 | ELSEIF(P(IN(1)+2,4).GT.P(IN(1)+2,3)) THEN | |
1277 | P(IN(1)+2,4)=P(IN(1)+2,3) | |
1278 | P(IN(1)+2,1)=0. | |
1279 | IN(1)=IN(1)+JS | |
1280 | GOTO 710 | |
1281 | ENDIF | |
1282 | ||
1283 | C...Junction strings: particle four-momentum, remainder, loop back. | |
1284 | 420 DO 430 J=1,4 | |
1285 | P(I,J)=P(I,J)+P(IN(1)+2,4)*P(IN(1),J)+P(IN(2)+2,4)*P(IN(2),J) | |
1286 | 430 PJU(IU+3,J)=PJU(IU+3,J)+P(I,J) | |
1287 | IF(P(I,4).LE.0.) GOTO 270 | |
1288 | PJU(IU+3,5)=TJU(4)*PJU(IU+3,4)-TJU(1)*PJU(IU+3,1)- | |
1289 | &TJU(2)*PJU(IU+3,2)-TJU(3)*PJU(IU+3,3) | |
1290 | IF(PJU(IU+3,5).LT.PJU(IU,5)) THEN | |
1291 | KFL(1)=-KFL(3) | |
1292 | PX(1)=-PX(3) | |
1293 | PY(1)=-PY(3) | |
1294 | GAM(1)=GAM(3) | |
1295 | IF(IN(3).NE.IN(6)) THEN | |
1296 | DO 440 J=1,4 | |
1297 | P(IN(6),J)=P(IN(3),J) | |
1298 | 440 P(IN(6)+1,J)=P(IN(3)+1,J) | |
1299 | ENDIF | |
1300 | DO 450 JQ=1,2 | |
1301 | IN(3+JQ)=IN(JQ) | |
1302 | P(IN(JQ)+2,3)=P(IN(JQ)+2,3)-P(IN(JQ)+2,4) | |
1303 | 450 P(IN(JQ)+2,1)=P(IN(JQ)+2,1)-(3-2*JQ)*P(IN(JQ)+2,4) | |
1304 | GOTO 320 | |
1305 | ENDIF | |
1306 | ||
1307 | C...Junction strings: save quantities left after each string. | |
1308 | IF(IABS(KFL(1)).GT.10) GOTO 270 | |
1309 | I=I-1 | |
1310 | KFJH(IU)=KFL(1) | |
1311 | DO 460 J=1,4 | |
1312 | 460 PJU(IU+3,J)=PJU(IU+3,J)-P(I+1,J) | |
1313 | 470 CONTINUE | |
1314 | ||
1315 | C...Junction strings: put together to new effective string endpoint. | |
1316 | NJS(JT)=I-ISTA | |
1317 | KFJS(JT)=K(K(MJU(JT+2),3),2) | |
1318 | KFLS=2*INT(RLU(0)+3.*PARJ(4)/(1.+3.*PARJ(4)))+1 | |
1319 | IF(KFJH(1).EQ.KFJH(2)) KFLS=3 | |
1320 | IF(ISTA.NE.I) KFJS(JT)=ISIGN(1000*MAX(IABS(KFJH(1)), | |
1321 | &IABS(KFJH(2)))+100*MIN(IABS(KFJH(1)),IABS(KFJH(2)))+ | |
1322 | &KFLS,KFJH(1)) | |
1323 | DO 480 J=1,4 | |
1324 | PJS(JT,J)=PJU(1,J)+PJU(2,J)+P(MJU(JT),J) | |
1325 | 480 PJS(JT+2,J)=PJU(4,J)+PJU(5,J) | |
1326 | PJS(JT,5)=SQRT(MAX(0.,PJS(JT,4)**2-PJS(JT,1)**2-PJS(JT,2)**2- | |
1327 | &PJS(JT,3)**2)) | |
1328 | 490 CONTINUE | |
1329 | ||
1330 | C...Open versus closed strings. Choose breakup region for latter. | |
1331 | 500 IF(MJU(1).NE.0.AND.MJU(2).NE.0) THEN | |
1332 | NS=MJU(2)-MJU(1) | |
1333 | NB=MJU(1)-N | |
1334 | ELSEIF(MJU(1).NE.0) THEN | |
1335 | NS=N+NR-MJU(1) | |
1336 | NB=MJU(1)-N | |
1337 | ELSEIF(MJU(2).NE.0) THEN | |
1338 | NS=MJU(2)-N | |
1339 | NB=1 | |
1340 | ELSEIF(IABS(K(N+1,2)).NE.21) THEN | |
1341 | NS=NR-1 | |
1342 | NB=1 | |
1343 | ELSE | |
1344 | NS=NR+1 | |
1345 | W2SUM=0. | |
1346 | DO 510 IS=1,NR | |
1347 | P(N+NR+IS,1)=0.5*FOUR(N+IS,N+IS+1-NR*(IS/NR)) | |
1348 | 510 W2SUM=W2SUM+P(N+NR+IS,1) | |
1349 | W2RAN=RLU(0)*W2SUM | |
1350 | NB=0 | |
1351 | 520 NB=NB+1 | |
1352 | W2SUM=W2SUM-P(N+NR+NB,1) | |
1353 | IF(W2SUM.GT.W2RAN.AND.NB.LT.NR) GOTO 520 | |
1354 | ENDIF | |
1355 | ||
1356 | C...Find longitudinal string directions (i.e. lightlike four-vectors). | |
1357 | DO 540 IS=1,NS | |
1358 | IS1=N+IS+NB-1-NR*((IS+NB-2)/NR) | |
1359 | IS2=N+IS+NB-NR*((IS+NB-1)/NR) | |
1360 | DO 530 J=1,5 | |
1361 | DP(1,J)=dble(P(IS1,J)) | |
1362 | IF(IABS(K(IS1,2)).EQ.21) DP(1,J)=0.5d0*DP(1,J) | |
1363 | IF(IS1.EQ.MJU(1)) DP(1,J)=dble(PJS(1,J)-PJS(3,J)) | |
1364 | DP(2,J)=dble(P(IS2,J)) | |
1365 | IF(IABS(K(IS2,2)).EQ.21) DP(2,J)=0.5d0*DP(2,J) | |
1366 | 530 IF(IS2.EQ.MJU(2)) DP(2,J)=dble(PJS(2,J)-PJS(4,J)) | |
1367 | DP(3,5)=DFOUR(1,1) | |
1368 | DP(4,5)=DFOUR(2,2) | |
1369 | DHKC=DFOUR(1,2) | |
1370 | IF(DP(3,5)+2.d0*DHKC+DP(4,5).LE.0.d0) THEN | |
1371 | DP(3,5)=DP(1,5)**2 | |
1372 | DP(4,5)=DP(2,5)**2 | |
1373 | DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2+DP(1,5)**2) | |
1374 | DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2+DP(2,5)**2) | |
1375 | DHKC=DFOUR(1,2) | |
1376 | ENDIF | |
1377 | DHKS=SQRT(DHKC**2-DP(3,5)*DP(4,5)) | |
1378 | DHK1=0.5d0*((DP(4,5)+DHKC)/DHKS-1.d0) | |
1379 | DHK2=0.5d0*((DP(3,5)+DHKC)/DHKS-1.d0) | |
1380 | IN1=N+NR+4*IS-3 | |
1381 | P(IN1,5)=SQRT(sngl(DP(3,5)+2.d0*DHKC+DP(4,5))) | |
1382 | DO 540 J=1,4 | |
1383 | P(IN1,J)=sngl((1.d0+DHK1)*DP(1,J)-DHK2*DP(2,J)) | |
1384 | 540 P(IN1+1,J)=sngl((1.d0+DHK2)*DP(2,J)-DHK1*DP(1,J)) | |
1385 | ||
1386 | C...Begin initialization: sum up energy, set starting position. | |
1387 | ISAV=I | |
1388 | 550 NTRY=NTRY+1 | |
1389 | IF(NTRY.GT.100.AND.NTRYR.LE.4) THEN | |
1390 | PARU12=4.*PARU12 | |
1391 | PARU13=2.*PARU13 | |
1392 | GOTO 130 | |
1393 | ELSEIF(NTRY.GT.100) THEN | |
1394 | CALL LUERRM(14,'(LUSTRF:) caught in infinite loop') | |
1395 | IF(MSTU(21).GE.1) RETURN | |
1396 | ENDIF | |
1397 | I=ISAV | |
1398 | DO 560 J=1,4 | |
1399 | P(N+NRS,J)=0. | |
1400 | DO 560 IS=1,NR | |
1401 | 560 P(N+NRS,J)=P(N+NRS,J)+P(N+IS,J) | |
1402 | DO 570 JT=1,2 | |
1403 | IRANK(JT)=0 | |
1404 | IF(MJU(JT).NE.0) IRANK(JT)=NJS(JT) | |
1405 | IF(NS.GT.NR) IRANK(JT)=1 | |
1406 | IE(JT)=K(N+1+(JT/2)*(NP-1),3) | |
1407 | IN(3*JT+1)=N+NR+1+4*(JT/2)*(NS-1) | |
1408 | IN(3*JT+2)=IN(3*JT+1)+1 | |
1409 | IN(3*JT+3)=N+NR+4*NS+2*JT-1 | |
1410 | DO 570 IN1=N+NR+2+JT,N+NR+4*NS-2+JT,4 | |
1411 | P(IN1,1)=2-JT | |
1412 | P(IN1,2)=JT-1 | |
1413 | 570 P(IN1,3)=1. | |
1414 | ||
1415 | C...Initialize flavour and pT variables for open string. | |
1416 | IF(NS.LT.NR) THEN | |
1417 | PX(1)=0. | |
1418 | PY(1)=0. | |
1419 | IF(NS.EQ.1.AND.MJU(1)+MJU(2).EQ.0) CALL LUPTDI(0,PX(1),PY(1)) | |
1420 | PX(2)=-PX(1) | |
1421 | PY(2)=-PY(1) | |
1422 | DO 580 JT=1,2 | |
1423 | KFL(JT)=K(IE(JT),2) | |
1424 | IF(MJU(JT).NE.0) KFL(JT)=KFJS(JT) | |
1425 | MSTJ(93)=1 | |
1426 | PMQ(JT)=ULMASS(KFL(JT)) | |
1427 | 580 GAM(JT)=0. | |
1428 | ||
1429 | C...Closed string: random initial breakup flavour, pT and vertex. | |
1430 | ELSE | |
1431 | KFL(3)=INT(1.+(2.+PARJ(2))*RLU(0))*(-1)**INT(RLU(0)+0.5) | |
1432 | CALL LUKFDI(KFL(3),0,KFL(1),KDUMP) | |
1433 | KFL(2)=-KFL(1) | |
1434 | IF(IABS(KFL(1)).GT.10.AND.RLU(0).GT.0.5) THEN | |
1435 | KFL(2)=-(KFL(1)+ISIGN(10000,KFL(1))) | |
1436 | ELSEIF(IABS(KFL(1)).GT.10) THEN | |
1437 | KFL(1)=-(KFL(2)+ISIGN(10000,KFL(2))) | |
1438 | ENDIF | |
1439 | CALL LUPTDI(KFL(1),PX(1),PY(1)) | |
1440 | PX(2)=-PX(1) | |
1441 | PY(2)=-PY(1) | |
1442 | PR3=MIN(25.,0.1*P(N+NR+1,5)**2) | |
1443 | 590 CALL LUZDIS(KFL(1),KFL(2),PR3,Z) | |
1444 | ZR=PR3/(Z*P(N+NR+1,5)**2) | |
1445 | IF(ZR.GE.1.) GOTO 590 | |
1446 | ||
1447 | DO 600 JT=1,2 | |
1448 | MSTJ(93)=1 | |
1449 | PMQ(JT)=ULMASS(KFL(JT)) | |
1450 | GAM(JT)=PR3*(1.-Z)/Z | |
1451 | IN1=N+NR+3+4*(JT/2)*(NS-1) | |
1452 | P(IN1,JT)=1.-Z | |
1453 | P(IN1,3-JT)=JT-1 | |
1454 | P(IN1,3)=(2-JT)*(1.-Z)+(JT-1)*Z | |
1455 | P(IN1+1,JT)=ZR | |
1456 | P(IN1+1,3-JT)=2-JT | |
1457 | 600 P(IN1+1,3)=(2-JT)*(1.-ZR)+(JT-1)*ZR | |
1458 | ENDIF | |
1459 | ||
1460 | C...Find initial transverse directions (i.e. spacelike four-vectors). | |
1461 | DO 640 JT=1,2 | |
1462 | IF(JT.EQ.1.OR.NS.EQ.NR-1) THEN | |
1463 | IN1=IN(3*JT+1) | |
1464 | IN3=IN(3*JT+3) | |
1465 | DO 610 J=1,4 | |
1466 | DP(1,J)=dble(P(IN1,J)) | |
1467 | DP(2,J)=dble(P(IN1+1,J)) | |
1468 | DP(3,J)=0.d0 | |
1469 | 610 DP(4,J)=0.d0 | |
1470 | DP(1,4)=DSQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) | |
1471 | DP(2,4)=DSQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) | |
1472 | DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4) | |
1473 | DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4) | |
1474 | DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4) | |
1475 | IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1.d0 | |
1476 | IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1.d0 | |
1477 | IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1.d0 | |
1478 | IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1.d0 | |
1479 | DHC12=DFOUR(1,2) | |
1480 | DHCX1=DFOUR(3,1)/DHC12 | |
1481 | DHCX2=DFOUR(3,2)/DHC12 | |
1482 | DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12) | |
1483 | DHCY1=DFOUR(4,1)/DHC12 | |
1484 | DHCY2=DFOUR(4,2)/DHC12 | |
1485 | DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12 | |
1486 | DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2) | |
1487 | DO 620 J=1,4 | |
1488 | DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J)) | |
1489 | P(IN3,J)=sngl(DP(3,J)) | |
1490 | 620 P(IN3+1,J)=sngl(DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)- | |
1491 | & DHCYX*DP(3,J))) | |
1492 | ELSE | |
1493 | DO 630 J=1,4 | |
1494 | P(IN3+2,J)=P(IN3,J) | |
1495 | 630 P(IN3+3,J)=P(IN3+1,J) | |
1496 | ENDIF | |
1497 | 640 CONTINUE | |
1498 | ||
1499 | C...Remove energy used up in junction string fragmentation. | |
1500 | IF(MJU(1)+MJU(2).GT.0) THEN | |
1501 | DO 660 JT=1,2 | |
1502 | IF(NJS(JT).EQ.0) GOTO 660 | |
1503 | DO 650 J=1,4 | |
1504 | 650 P(N+NRS,J)=P(N+NRS,J)-PJS(JT+2,J) | |
1505 | 660 CONTINUE | |
1506 | ENDIF | |
1507 | ||
1508 | C...Produce new particle: side, origin. | |
1509 | 670 I=I+1 | |
1510 | IF(2*I-NSAV.GE.MSTU(4)-MSTU(32)-5) THEN | |
1511 | CALL LUERRM(11,'(LUSTRF:) no more memory left in LUJETSA') | |
1512 | IF(MSTU(21).GE.1) RETURN | |
1513 | ENDIF | |
1514 | JT=int(1.5+RLU(0)) | |
1515 | IF(IABS(KFL(3-JT)).GT.10) JT=3-JT | |
1516 | JR=3-JT | |
1517 | JS=3-2*JT | |
1518 | IRANK(JT)=IRANK(JT)+1 | |
1519 | K(I,1)=1 | |
1520 | K(I,3)=IE(JT) | |
1521 | K(I,4)=0 | |
1522 | K(I,5)=0 | |
1523 | ||
1524 | C...Generate flavour, hadron and pT. | |
1525 | 680 CALL LUKFDI(KFL(JT),0,KFL(3),K(I,2)) | |
1526 | IF(K(I,2).EQ.0) GOTO 550 | |
1527 | IF(MSTJ(12).GE.3.AND.IRANK(JT).EQ.1.AND.IABS(KFL(JT)).LE.10.AND. | |
1528 | &IABS(KFL(3)).GT.10) THEN | |
1529 | IF(RLU(0).GT.PARJ(19)) GOTO 680 | |
1530 | ENDIF | |
1531 | P(I,5)=ULMASS(K(I,2)) | |
1532 | CALL LUPTDI(KFL(JT),PX(3),PY(3)) | |
1533 | PR(JT)=P(I,5)**2+(PX(JT)+PX(3))**2+(PY(JT)+PY(3))**2 | |
1534 | ||
1535 | C...Final hadrons for small invariant mass. | |
1536 | MSTJ(93)=1 | |
1537 | PMQ(3)=ULMASS(KFL(3)) | |
1538 | WMIN=PARJ(32+MSTJ(11))+PMQ(1)+PMQ(2)+PARJ(36)*PMQ(3) | |
1539 | IF(IABS(KFL(JT)).GT.10.AND.IABS(KFL(3)).GT.10) WMIN= | |
1540 | &WMIN-0.5*PARJ(36)*PMQ(3) | |
1541 | WREM2=FOUR(N+NRS,N+NRS) | |
1542 | IF(WREM2.LT.0.10) GOTO 550 | |
1543 | IF(WREM2.LT.MAX(WMIN*(1.+(2.*RLU(0)-1.)*PARJ(37)), | |
1544 | &PARJ(32)+PMQ(1)+PMQ(2))**2) GOTO 810 | |
1545 | ||
1546 | C...Choose z, which gives Gamma. Shift z for heavy flavours. | |
1547 | CALL LUZDIS(KFL(JT),KFL(3),PR(JT),Z) | |
1548 | ||
1549 | KFL1A=IABS(KFL(1)) | |
1550 | KFL2A=IABS(KFL(2)) | |
1551 | IF(MAX(MOD(KFL1A,10),MOD(KFL1A/1000,10),MOD(KFL2A,10), | |
1552 | &MOD(KFL2A/1000,10)).GE.4) THEN | |
1553 | PR(JR)=(PMQ(JR)+PMQ(3))**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2 | |
1554 | PW12=SQRT(MAX(0.,(WREM2-PR(1)-PR(2))**2-4.*PR(1)*PR(2))) | |
1555 | Z=(WREM2+PR(JT)-PR(JR)+PW12*(2.*Z-1.))/(2.*WREM2) | |
1556 | PR(JR)=(PMQ(JR)+PARJ(32+MSTJ(11)))**2+(PX(JR)-PX(3))**2+ | |
1557 | & (PY(JR)-PY(3))**2 | |
1558 | IF((1.-Z)*(WREM2-PR(JT)/Z).LT.PR(JR)) GOTO 810 | |
1559 | ENDIF | |
1560 | GAM(3)=(1.-Z)*(GAM(JT)+PR(JT)/Z) | |
1561 | DO 690 J=1,3 | |
1562 | 690 IN(J)=IN(3*JT+J) | |
1563 | ||
1564 | C...Stepping within or from 'low' string region easy. | |
1565 | IF(IN(1)+1.EQ.IN(2).AND.Z*P(IN(1)+2,3)*P(IN(2)+2,3)* | |
1566 | &P(IN(1),5)**2.GE.PR(JT)) THEN | |
1567 | P(IN(JT)+2,4)=Z*P(IN(JT)+2,3) | |
1568 | P(IN(JR)+2,4)=PR(JT)/(P(IN(JT)+2,4)*P(IN(1),5)**2) | |
1569 | DO 700 J=1,4 | |
1570 | 700 P(I,J)=(PX(JT)+PX(3))*P(IN(3),J)+(PY(JT)+PY(3))*P(IN(3)+1,J) | |
1571 | GOTO 770 | |
1572 | ELSEIF(IN(1)+1.EQ.IN(2)) THEN | |
1573 | P(IN(JR)+2,4)=P(IN(JR)+2,3) | |
1574 | P(IN(JR)+2,JT)=1. | |
1575 | IN(JR)=IN(JR)+4*JS | |
1576 | IF(JS*IN(JR).GT.JS*IN(4*JR)) GOTO 550 | |
1577 | IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN | |
1578 | P(IN(JT)+2,4)=P(IN(JT)+2,3) | |
1579 | P(IN(JT)+2,JT)=0. | |
1580 | IN(JT)=IN(JT)+4*JS | |
1581 | ENDIF | |
1582 | ENDIF | |
1583 | ||
1584 | C...Find new transverse directions (i.e. spacelike string vectors). | |
1585 | 710 IF(JS*IN(1).GT.JS*IN(3*JR+1).OR.JS*IN(2).GT.JS*IN(3*JR+2).OR. | |
1586 | &IN(1).GT.IN(2)) GOTO 550 | |
1587 | IF(IN(1).NE.IN(3*JT+1).OR.IN(2).NE.IN(3*JT+2)) THEN | |
1588 | DO 720 J=1,4 | |
1589 | DP(1,J)=dble(P(IN(1),J)) | |
1590 | DP(2,J)=dble(P(IN(2),J)) | |
1591 | DP(3,J)=0.d0 | |
1592 | 720 DP(4,J)=0.d0 | |
1593 | DP(1,4)=DSQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) | |
1594 | DP(2,4)=DSQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) | |
1595 | DHC12=DFOUR(1,2) | |
1596 | IF(DHC12.LE.1E-2) THEN | |
1597 | P(IN(JT)+2,4)=P(IN(JT)+2,3) | |
1598 | P(IN(JT)+2,JT)=0. | |
1599 | IN(JT)=IN(JT)+4*JS | |
1600 | GOTO 710 | |
1601 | ENDIF | |
1602 | IN(3)=N+NR+4*NS+5 | |
1603 | DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4) | |
1604 | DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4) | |
1605 | DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4) | |
1606 | IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1.d0 | |
1607 | IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1.d0 | |
1608 | IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1.d0 | |
1609 | IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1.d0 | |
1610 | DHCX1=DFOUR(3,1)/DHC12 | |
1611 | DHCX2=DFOUR(3,2)/DHC12 | |
1612 | DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12) | |
1613 | DHCY1=DFOUR(4,1)/DHC12 | |
1614 | DHCY2=DFOUR(4,2)/DHC12 | |
1615 | DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12 | |
1616 | DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2) | |
1617 | DO 730 J=1,4 | |
1618 | DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J)) | |
1619 | P(IN(3),J)=sngl(DP(3,J)) | |
1620 | 730 P(IN(3)+1,J)=sngl(DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)- | |
1621 | & DHCYX*DP(3,J))) | |
1622 | C...Express pT with respect to new axes, if sensible. | |
1623 | PXP=-(PX(3)*FOUR(IN(3*JT+3),IN(3))+PY(3)* | |
1624 | & FOUR(IN(3*JT+3)+1,IN(3))) | |
1625 | PYP=-(PX(3)*FOUR(IN(3*JT+3),IN(3)+1)+PY(3)* | |
1626 | & FOUR(IN(3*JT+3)+1,IN(3)+1)) | |
1627 | IF(ABS(PXP**2+PYP**2-PX(3)**2-PY(3)**2).LT.0.01) THEN | |
1628 | PX(3)=PXP | |
1629 | PY(3)=PYP | |
1630 | ENDIF | |
1631 | ENDIF | |
1632 | ||
1633 | C...Sum up known four-momentum. Gives coefficients for m2 expression. | |
1634 | DO 750 J=1,4 | |
1635 | DHG(J)=0.d0 | |
1636 | P(I,J)=PX(JT)*P(IN(3*JT+3),J)+PY(JT)*P(IN(3*JT+3)+1,J)+ | |
1637 | &PX(3)*P(IN(3),J)+PY(3)*P(IN(3)+1,J) | |
1638 | DO 740 IN1=IN(3*JT+1),IN(1)-4*JS,4*JS | |
1639 | 740 P(I,J)=P(I,J)+P(IN1+2,3)*P(IN1,J) | |
1640 | DO 750 IN2=IN(3*JT+2),IN(2)-4*JS,4*JS | |
1641 | 750 P(I,J)=P(I,J)+P(IN2+2,3)*P(IN2,J) | |
1642 | DHM(1)=dble(FOUR(I,I)) | |
1643 | DHM(2)=dble(2.*FOUR(I,IN(1))) | |
1644 | DHM(3)=dble(2.*FOUR(I,IN(2))) | |
1645 | DHM(4)=dble(2.*FOUR(IN(1),IN(2))) | |
1646 | ||
1647 | C...Find coefficients for Gamma expression. | |
1648 | DO 760 IN2=IN(1)+1,IN(2),4 | |
1649 | DO 760 IN1=IN(1),IN2-1,4 | |
1650 | DHC=dble(2.*FOUR(IN1,IN2)) | |
1651 | DHG(1)=DHG(1)+dble(P(IN1+2,JT)*P(IN2+2,JT))*DHC | |
1652 | IF(IN1.EQ.IN(1)) DHG(2)=DHG(2)-dble(float(JS)*P(IN2+2,JT))*DHC | |
1653 | IF(IN2.EQ.IN(2)) DHG(3)=DHG(3)+dble(float(JS)*P(IN1+2,JT))*DHC | |
1654 | 760 IF(IN1.EQ.IN(1).AND.IN2.EQ.IN(2)) DHG(4)=DHG(4)-DHC | |
1655 | ||
1656 | C...Solve (m2, Gamma) equation system for energies taken. | |
1657 | DHS1=DHM(JR+1)*DHG(4)-DHM(4)*DHG(JR+1) | |
1658 | IF(ABS(DHS1).LT.1E-4) GOTO 550 | |
1659 | DHS2=DHM(4)*(dble(GAM(3))-DHG(1))-DHM(JT+1)*DHG(JR+1)-DHG(4)* | |
1660 | &(dble(P(I,5))**2-DHM(1))+DHG(JT+1)*DHM(JR+1) | |
1661 | DHS3=DHM(JT+1)*(dble(GAM(3))-DHG(1))-DHG(JT+1) | |
1662 | & *(dble(P(I,5))**2-DHM(1)) | |
1663 | P(IN(JR)+2,4)=0.5*sngl((SQRT(MAX(0D0,DHS2**2-4.d0*DHS1*DHS3))) | |
1664 | &/ABS(DHS1)-DHS2/DHS1) | |
1665 | IF(DHM(JT+1)+DHM(4)*dble(P(IN(JR)+2,4)).LE.0.d0) GOTO 550 | |
1666 | P(IN(JT)+2,4)=(P(I,5)**2-sngl(DHM(1))-sngl(DHM(JR+1)) | |
1667 | & *P(IN(JR)+2,4))/(sngl(DHM(JT+1))+sngl(DHM(4))*P(IN(JR)+2,4)) | |
1668 | ||
1669 | C...Step to new region if necessary. | |
1670 | IF(P(IN(JR)+2,4).GT.P(IN(JR)+2,3)) THEN | |
1671 | P(IN(JR)+2,4)=P(IN(JR)+2,3) | |
1672 | P(IN(JR)+2,JT)=1. | |
1673 | IN(JR)=IN(JR)+4*JS | |
1674 | IF(JS*IN(JR).GT.JS*IN(4*JR)) GOTO 550 | |
1675 | IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN | |
1676 | P(IN(JT)+2,4)=P(IN(JT)+2,3) | |
1677 | P(IN(JT)+2,JT)=0. | |
1678 | IN(JT)=IN(JT)+4*JS | |
1679 | ENDIF | |
1680 | GOTO 710 | |
1681 | ELSEIF(P(IN(JT)+2,4).GT.P(IN(JT)+2,3)) THEN | |
1682 | P(IN(JT)+2,4)=P(IN(JT)+2,3) | |
1683 | P(IN(JT)+2,JT)=0. | |
1684 | IN(JT)=IN(JT)+4*JS | |
1685 | GOTO 710 | |
1686 | ENDIF | |
1687 | ||
1688 | C...Four-momentum of particle. Remaining quantities. Loop back. | |
1689 | 770 DO 780 J=1,4 | |
1690 | P(I,J)=P(I,J)+P(IN(1)+2,4)*P(IN(1),J)+P(IN(2)+2,4)*P(IN(2),J) | |
1691 | 780 P(N+NRS,J)=P(N+NRS,J)-P(I,J) | |
1692 | IF(P(I,4).LE.0.) GOTO 550 | |
1693 | KFL(JT)=-KFL(3) | |
1694 | PMQ(JT)=PMQ(3) | |
1695 | PX(JT)=-PX(3) | |
1696 | PY(JT)=-PY(3) | |
1697 | GAM(JT)=GAM(3) | |
1698 | IF(IN(3).NE.IN(3*JT+3)) THEN | |
1699 | DO 790 J=1,4 | |
1700 | P(IN(3*JT+3),J)=P(IN(3),J) | |
1701 | 790 P(IN(3*JT+3)+1,J)=P(IN(3)+1,J) | |
1702 | ENDIF | |
1703 | DO 800 JQ=1,2 | |
1704 | IN(3*JT+JQ)=IN(JQ) | |
1705 | P(IN(JQ)+2,3)=P(IN(JQ)+2,3)-P(IN(JQ)+2,4) | |
1706 | 800 P(IN(JQ)+2,JT)=P(IN(JQ)+2,JT)-JS*(3-2*JQ)*P(IN(JQ)+2,4) | |
1707 | GOTO 670 | |
1708 | ||
1709 | C...Final hadron: side, flavour, hadron, mass. | |
1710 | 810 I=I+1 | |
1711 | K(I,1)=1 | |
1712 | K(I,3)=IE(JR) | |
1713 | K(I,4)=0 | |
1714 | K(I,5)=0 | |
1715 | CALL LUKFDI(KFL(JR),-KFL(3),KFLDMP,K(I,2)) | |
1716 | IF(K(I,2).EQ.0) GOTO 550 | |
1717 | P(I,5)=ULMASS(K(I,2)) | |
1718 | PR(JR)=P(I,5)**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2 | |
1719 | ||
1720 | C...Final two hadrons: find common setup of four-vectors. | |
1721 | JQ=1 | |
1722 | IF(P(IN(4)+2,3)*P(IN(5)+2,3)*FOUR(IN(4),IN(5)).LT.P(IN(7),3)* | |
1723 | &P(IN(8),3)*FOUR(IN(7),IN(8))) JQ=2 | |
1724 | DHC12=dble(FOUR(IN(3*JQ+1),IN(3*JQ+2))) | |
1725 | DHR1=dble(FOUR(N+NRS,IN(3*JQ+2)))/DHC12 | |
1726 | DHR2=dble(FOUR(N+NRS,IN(3*JQ+1)))/DHC12 | |
1727 | IF(IN(4).NE.IN(7).OR.IN(5).NE.IN(8)) THEN | |
1728 | PX(3-JQ)=-FOUR(N+NRS,IN(3*JQ+3))-PX(JQ) | |
1729 | PY(3-JQ)=-FOUR(N+NRS,IN(3*JQ+3)+1)-PY(JQ) | |
1730 | PR(3-JQ)=P(I+(JT+JQ-3)**2-1,5)**2+(PX(3-JQ)+(2*JQ-3)*JS* | |
1731 | & PX(3))**2+(PY(3-JQ)+(2*JQ-3)*JS*PY(3))**2 | |
1732 | ENDIF | |
1733 | ||
1734 | C...Solve kinematics for final two hadrons, if possible. | |
1735 | WREM2=WREM2+(PX(1)+PX(2))**2+(PY(1)+PY(2))**2 | |
1736 | FD=(SQRT(PR(1))+SQRT(PR(2)))/SQRT(WREM2) | |
1737 | IF(MJU(1)+MJU(2).NE.0.AND.I.EQ.ISAV+2.AND.FD.GE.1.) GOTO 180 | |
1738 | IF(FD.GE.1.) GOTO 550 | |
1739 | FA=WREM2+PR(JT)-PR(JR) | |
1740 | IF(MSTJ(11).EQ.2) PREV=0.5*FD**PARJ(37+MSTJ(11)) | |
1741 | IF(MSTJ(11).NE.2) PREV=0.5*EXP(MAX(-100.,LOG(FD)* | |
1742 | &PARJ(37+MSTJ(11))*(PR(1)+PR(2))**2)) | |
1743 | FB=SIGN(SQRT(MAX(0.,FA**2-4.*WREM2*PR(JT))),JS*(RLU(0)-PREV)) | |
1744 | KFL1A=IABS(KFL(1)) | |
1745 | KFL2A=IABS(KFL(2)) | |
1746 | IF(MAX(MOD(KFL1A,10),MOD(KFL1A/1000,10),MOD(KFL2A,10), | |
1747 | &MOD(KFL2A/1000,10)).GE.6) FB=SIGN(SQRT(MAX(0.,FA**2- | |
1748 | &4.*WREM2*PR(JT))),FLOAT(JS)) | |
1749 | DO 820 J=1,4 | |
1750 | P(I-1,J)=(PX(JT)+PX(3))*P(IN(3*JQ+3),J)+(PY(JT)+PY(3))* | |
1751 | &P(IN(3*JQ+3)+1,J)+0.5*(sngl(DHR1)*(FA+FB)*P(IN(3*JQ+1),J)+ | |
1752 | &sngl(DHR2)*(FA-FB)*P(IN(3*JQ+2),J))/WREM2 | |
1753 | 820 P(I,J)=P(N+NRS,J)-P(I-1,J) | |
1754 | ||
1755 | C...Mark jets as fragmented and give daughter pointers. | |
1756 | N=I-NRS+1 | |
1757 | DO 830 I=NSAV+1,NSAV+NP | |
1758 | IM=K(I,3) | |
1759 | K(IM,1)=K(IM,1)+10 | |
1760 | IF(MSTU(16).NE.2) THEN | |
1761 | K(IM,4)=NSAV+1 | |
1762 | K(IM,5)=NSAV+1 | |
1763 | ELSE | |
1764 | K(IM,4)=NSAV+2 | |
1765 | K(IM,5)=N | |
1766 | ENDIF | |
1767 | 830 CONTINUE | |
1768 | ||
1769 | C...Document string system. Move up particles. | |
1770 | NSAV=NSAV+1 | |
1771 | K(NSAV,1)=11 | |
1772 | K(NSAV,2)=92 | |
1773 | K(NSAV,3)=IP | |
1774 | K(NSAV,4)=NSAV+1 | |
1775 | K(NSAV,5)=N | |
1776 | DO 840 J=1,4 | |
1777 | P(NSAV,J)=sngl(DPS(J)) | |
1778 | 840 V(NSAV,J)=V(IP,J) | |
1779 | P(NSAV,5)=SQRT(sngl(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2 | |
1780 | & -DPS(3)**2))) | |
1781 | V(NSAV,5)=0. | |
1782 | DO 850 I=NSAV+1,N | |
1783 | ||
1784 | DO 850 J=1,5 | |
1785 | K(I,J)=K(I+NRS-1,J) | |
1786 | P(I,J)=P(I+NRS-1,J) | |
1787 | 850 V(I,J)=0. | |
1788 | ||
1789 | C...Order particles in rank along the chain. Update mother pointer. | |
1790 | DO 860 I=NSAV+1,N | |
1791 | DO 860 J=1,5 | |
1792 | K(I-NSAV+N,J)=K(I,J) | |
1793 | 860 P(I-NSAV+N,J)=P(I,J) | |
1794 | I1=NSAV | |
1795 | DO 880 I=N+1,2*N-NSAV | |
1796 | IF(K(I,3).NE.IE(1)) GOTO 880 | |
1797 | I1=I1+1 | |
1798 | DO 870 J=1,5 | |
1799 | K(I1,J)=K(I,J) | |
1800 | 870 P(I1,J)=P(I,J) | |
1801 | IF(MSTU(16).NE.2) K(I1,3)=NSAV | |
1802 | 880 CONTINUE | |
1803 | DO 900 I=2*N-NSAV,N+1,-1 | |
1804 | IF(K(I,3).EQ.IE(1)) GOTO 900 | |
1805 | I1=I1+1 | |
1806 | DO 890 J=1,5 | |
1807 | K(I1,J)=K(I,J) | |
1808 | 890 P(I1,J)=P(I,J) | |
1809 | IF(MSTU(16).NE.2) K(I1,3)=NSAV | |
1810 | 900 CONTINUE | |
1811 | ||
1812 | C...Boost back particle system. Set production vertices. | |
1813 | CALL LUDBRB(NSAV+1,N,0.,0.,DPS(1)/DPS(4),DPS(2)/DPS(4), | |
1814 | &DPS(3)/DPS(4)) | |
1815 | DO 910 I=NSAV+1,N | |
1816 | ||
1817 | DO 910 J=1,4 | |
1818 | 910 V(I,J)=V(IP,J) | |
1819 | ||
1820 | RETURN | |
1821 | END | |
1822 | ||
1823 | C********************************************************************* | |
1824 | ||
1825 | SUBROUTINE LUINDF(IP) | |
1826 | ||
1827 | C...Purpose: to handle the fragmentation of a jet system (or a single | |
1828 | C...jet) according to independent fragmentation models. | |
1829 | IMPLICIT DOUBLE PRECISION(D) | |
1830 | COMMON/LUJETSA/N,K(9000,5),P(9000,5),V(9000,5) | |
1831 | SAVE /LUJETSA/ | |
1832 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
1833 | SAVE /LUDAT1A/ | |
1834 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
1835 | SAVE /LUDAT2A/ | |
1836 | DIMENSION DPS(5),PSI(4),NFI(3),NFL(3),IFET(3),KFLF(3), | |
1837 | &KFLO(2),PXO(2),PYO(2),WO(2) | |
1838 | ||
1839 | pw=0. | |
1840 | C...Reset counters. Identify parton system and take copy. Check flavour. | |
1841 | NSAV=N | |
1842 | NJET=0 | |
1843 | KQSUM=0 | |
1844 | DO 100 J=1,5 | |
1845 | 100 DPS(J)=0.d0 | |
1846 | I=IP-1 | |
1847 | 110 I=I+1 | |
1848 | IF(I.GT.MIN(N,MSTU(4)-MSTU(32))) THEN | |
1849 | CALL LUERRM(12,'(LUINDF:) failed to reconstruct jet system') | |
1850 | IF(MSTU(21).GE.1) RETURN | |
1851 | ENDIF | |
1852 | IF(K(I,1).NE.1.AND.K(I,1).NE.2) GOTO 110 | |
1853 | KC=LUCOMP(K(I,2)) | |
1854 | IF(KC.EQ.0) GOTO 110 | |
1855 | KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) | |
1856 | IF(KQ.EQ.0) GOTO 110 | |
1857 | NJET=NJET+1 | |
1858 | IF(KQ.NE.2) KQSUM=KQSUM+KQ | |
1859 | DO 120 J=1,5 | |
1860 | K(NSAV+NJET,J)=K(I,J) | |
1861 | P(NSAV+NJET,J)=P(I,J) | |
1862 | 120 DPS(J)=DPS(J)+dble(P(I,J)) | |
1863 | K(NSAV+NJET,3)=I | |
1864 | IF(K(I,1).EQ.2.OR.(MSTJ(3).LE.5.AND.N.GT.I.AND. | |
1865 | &K(I+1,1).EQ.2)) GOTO 110 | |
1866 | IF(NJET.NE.1.AND.KQSUM.NE.0) THEN | |
1867 | CALL LUERRM(12,'(LUINDF:) unphysical flavour combination') | |
1868 | IF(MSTU(21).GE.1) RETURN | |
1869 | ENDIF | |
1870 | ||
1871 | C...Boost copied system to CM frame. Find CM energy and sum flavours. | |
1872 | IF(NJET.NE.1) CALL LUDBRB(NSAV+1,NSAV+NJET,0.,0.,-DPS(1)/DPS(4), | |
1873 | &-DPS(2)/DPS(4),-DPS(3)/DPS(4)) | |
1874 | PECM=0. | |
1875 | DO 130 J=1,3 | |
1876 | 130 NFI(J)=0 | |
1877 | DO 140 I=NSAV+1,NSAV+NJET | |
1878 | PECM=PECM+P(I,4) | |
1879 | KFA=IABS(K(I,2)) | |
1880 | IF(KFA.LE.3) THEN | |
1881 | NFI(KFA)=NFI(KFA)+ISIGN(1,K(I,2)) | |
1882 | ELSEIF(KFA.GT.1000) THEN | |
1883 | KFLA=MOD(KFA/1000,10) | |
1884 | KFLB=MOD(KFA/100,10) | |
1885 | IF(KFLA.LE.3) NFI(KFLA)=NFI(KFLA)+ISIGN(1,K(I,2)) | |
1886 | IF(KFLB.LE.3) NFI(KFLB)=NFI(KFLB)+ISIGN(1,K(I,2)) | |
1887 | ENDIF | |
1888 | 140 CONTINUE | |
1889 | ||
1890 | C...Loop over attempts made. Reset counters. | |
1891 | NTRY=0 | |
1892 | 150 NTRY=NTRY+1 | |
1893 | N=NSAV+NJET | |
1894 | IF(NTRY.GT.200) THEN | |
1895 | CALL LUERRM(14,'(LUINDF:) caught in infinite loop') | |
1896 | IF(MSTU(21).GE.1) RETURN | |
1897 | ENDIF | |
1898 | DO 160 J=1,3 | |
1899 | NFL(J)=NFI(J) | |
1900 | IFET(J)=0 | |
1901 | 160 KFLF(J)=0 | |
1902 | ||
1903 | C...Loop over jets to be fragmented. | |
1904 | DO 230 IP1=NSAV+1,NSAV+NJET | |
1905 | MSTJ(91)=0 | |
1906 | NSAV1=N | |
1907 | ||
1908 | C...Initial flavour and momentum values. Jet along +z axis. | |
1909 | KFLH=IABS(K(IP1,2)) | |
1910 | IF(KFLH.GT.10) KFLH=MOD(KFLH/1000,10) | |
1911 | KFLO(2)=0 | |
1912 | WF=P(IP1,4)+SQRT(P(IP1,1)**2+P(IP1,2)**2+P(IP1,3)**2) | |
1913 | ||
1914 | C...Initial values for quark or diquark jet. | |
1915 | 170 IF(IABS(K(IP1,2)).NE.21) THEN | |
1916 | NSTR=1 | |
1917 | KFLO(1)=K(IP1,2) | |
1918 | CALL LUPTDI(0,PXO(1),PYO(1)) | |
1919 | WO(1)=WF | |
1920 | ||
1921 | C...Initial values for gluon treated like random quark jet. | |
1922 | ELSEIF(MSTJ(2).LE.2) THEN | |
1923 | NSTR=1 | |
1924 | IF(MSTJ(2).EQ.2) MSTJ(91)=1 | |
1925 | KFLO(1)=INT(1.+(2.+PARJ(2))*RLU(0))*(-1)**INT(RLU(0)+0.5) | |
1926 | CALL LUPTDI(0,PXO(1),PYO(1)) | |
1927 | WO(1)=WF | |
1928 | ||
1929 | C...Initial values for gluon treated like quark-antiquark jet pair, | |
1930 | C...sharing energy according to Altarelli-Parisi splitting function. | |
1931 | ELSE | |
1932 | NSTR=2 | |
1933 | IF(MSTJ(2).EQ.4) MSTJ(91)=1 | |
1934 | KFLO(1)=INT(1.+(2.+PARJ(2))*RLU(0))*(-1)**INT(RLU(0)+0.5) | |
1935 | KFLO(2)=-KFLO(1) | |
1936 | CALL LUPTDI(0,PXO(1),PYO(1)) | |
1937 | PXO(2)=-PXO(1) | |
1938 | PYO(2)=-PYO(1) | |
1939 | WO(1)=WF*RLU(0)**(1./3.) | |
1940 | WO(2)=WF-WO(1) | |
1941 | ENDIF | |
1942 | ||
1943 | C...Initial values for rank, flavour, pT and W+. | |
1944 | DO 220 ISTR=1,NSTR | |
1945 | 180 I=N | |
1946 | IRANK=0 | |
1947 | KFL1=KFLO(ISTR) | |
1948 | PX1=PXO(ISTR) | |
1949 | PY1=PYO(ISTR) | |
1950 | W=WO(ISTR) | |
1951 | ||
1952 | C...New hadron. Generate flavour and hadron species. | |
1953 | 190 I=I+1 | |
1954 | IF(I.GE.MSTU(4)-MSTU(32)-NJET-5) THEN | |
1955 | CALL LUERRM(11,'(LUINDF:) no more memory left in LUJETSA') | |
1956 | IF(MSTU(21).GE.1) RETURN | |
1957 | ENDIF | |
1958 | IRANK=IRANK+1 | |
1959 | K(I,1)=1 | |
1960 | K(I,3)=IP1 | |
1961 | K(I,4)=0 | |
1962 | K(I,5)=0 | |
1963 | 200 CALL LUKFDI(KFL1,0,KFL2,K(I,2)) | |
1964 | IF(K(I,2).EQ.0) GOTO 180 | |
1965 | IF(MSTJ(12).GE.3.AND.IRANK.EQ.1.AND.IABS(KFL1).LE.10.AND. | |
1966 | &IABS(KFL2).GT.10) THEN | |
1967 | IF(RLU(0).GT.PARJ(19)) GOTO 200 | |
1968 | ENDIF | |
1969 | ||
1970 | C...Find hadron mass. Generate four-momentum. | |
1971 | P(I,5)=ULMASS(K(I,2)) | |
1972 | CALL LUPTDI(KFL1,PX2,PY2) | |
1973 | P(I,1)=PX1+PX2 | |
1974 | P(I,2)=PY1+PY2 | |
1975 | PR=P(I,5)**2+P(I,1)**2+P(I,2)**2 | |
1976 | CALL LUZDIS(KFL1,KFL2,PR,Z) | |
1977 | P(I,3)=0.5*(Z*W-PR/(Z*W)) | |
1978 | P(I,4)=0.5*(Z*W+PR/(Z*W)) | |
1979 | IF(MSTJ(3).GE.1.AND.IRANK.EQ.1.AND.KFLH.GE.4.AND. | |
1980 | &P(I,3).LE.0.001) THEN | |
1981 | IF(W.GE.P(I,5)+0.5*PARJ(32)) GOTO 180 | |
1982 | P(I,3)=0.0001 | |
1983 | P(I,4)=SQRT(PR) | |
1984 | Z=P(I,4)/W | |
1985 | ENDIF | |
1986 | ||
1987 | C...Remaining flavour and momentum. | |
1988 | KFL1=-KFL2 | |
1989 | PX1=-PX2 | |
1990 | PY1=-PY2 | |
1991 | W=(1.-Z)*W | |
1992 | DO 210 J=1,5 | |
1993 | 210 V(I,J)=0. | |
1994 | ||
1995 | C...Check if pL acceptable. Go back for new hadron if enough energy. | |
1996 | IF(MSTJ(3).GE.0.AND.P(I,3).LT.0.) I=I-1 | |
1997 | IF(W.GT.PARJ(31)) GOTO 190 | |
1998 | 220 N=I | |
1999 | IF(MOD(MSTJ(3),5).EQ.4.AND.N.EQ.NSAV1) WF=WF+0.1*PARJ(32) | |
2000 | IF(MOD(MSTJ(3),5).EQ.4.AND.N.EQ.NSAV1) GOTO 170 | |
2001 | ||
2002 | C...Rotate jet to new direction. | |
2003 | THE=ULANGL(P(IP1,3),SQRT(P(IP1,1)**2+P(IP1,2)**2)) | |
2004 | PHI=ULANGL(P(IP1,1),P(IP1,2)) | |
2005 | CALL LUDBRB(NSAV1+1,N,THE,PHI,0D0,0D0,0D0) | |
2006 | K(K(IP1,3),4)=NSAV1+1 | |
2007 | K(K(IP1,3),5)=N | |
2008 | ||
2009 | C...End of jet generation loop. Skip conservation in some cases. | |
2010 | 230 CONTINUE | |
2011 | IF(NJET.EQ.1.OR.MSTJ(3).LE.0) GOTO 470 | |
2012 | IF(MOD(MSTJ(3),5).NE.0.AND.N-NSAV-NJET.LT.2) GOTO 150 | |
2013 | ||
2014 | C...Subtract off produced hadron flavours, finished if zero. | |
2015 | DO 240 I=NSAV+NJET+1,N | |
2016 | KFA=IABS(K(I,2)) | |
2017 | KFLA=MOD(KFA/1000,10) | |
2018 | KFLB=MOD(KFA/100,10) | |
2019 | KFLC=MOD(KFA/10,10) | |
2020 | IF(KFLA.EQ.0) THEN | |
2021 | IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)-ISIGN(1,K(I,2))*(-1)**KFLB | |
2022 | IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)+ISIGN(1,K(I,2))*(-1)**KFLB | |
2023 | ELSE | |
2024 | IF(KFLA.LE.3) NFL(KFLA)=NFL(KFLA)-ISIGN(1,K(I,2)) | |
2025 | IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)-ISIGN(1,K(I,2)) | |
2026 | IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)-ISIGN(1,K(I,2)) | |
2027 | ENDIF | |
2028 | 240 CONTINUE | |
2029 | NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+ | |
2030 | &NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3 | |
2031 | IF(NREQ.EQ.0) GOTO 320 | |
2032 | ||
2033 | C...Take away flavour of low-momentum particles until enough freedom. | |
2034 | NREM=0 | |
2035 | 250 IREM=0 | |
2036 | P2MIN=PECM**2 | |
2037 | DO 260 I=NSAV+NJET+1,N | |
2038 | P2=P(I,1)**2+P(I,2)**2+P(I,3)**2 | |
2039 | IF(K(I,1).EQ.1.AND.P2.LT.P2MIN) IREM=I | |
2040 | 260 IF(K(I,1).EQ.1.AND.P2.LT.P2MIN) P2MIN=P2 | |
2041 | IF(IREM.EQ.0) GOTO 150 | |
2042 | K(IREM,1)=7 | |
2043 | KFA=IABS(K(IREM,2)) | |
2044 | KFLA=MOD(KFA/1000,10) | |
2045 | KFLB=MOD(KFA/100,10) | |
2046 | KFLC=MOD(KFA/10,10) | |
2047 | IF(KFLA.GE.4.OR.KFLB.GE.4) K(IREM,1)=8 | |
2048 | IF(K(IREM,1).EQ.8) GOTO 250 | |
2049 | IF(KFLA.EQ.0) THEN | |
2050 | ISGN=ISIGN(1,K(IREM,2))*(-1)**KFLB | |
2051 | IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)+ISGN | |
2052 | IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)-ISGN | |
2053 | ELSE | |
2054 | IF(KFLA.LE.3) NFL(KFLA)=NFL(KFLA)+ISIGN(1,K(IREM,2)) | |
2055 | IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)+ISIGN(1,K(IREM,2)) | |
2056 | IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)+ISIGN(1,K(IREM,2)) | |
2057 | ENDIF | |
2058 | NREM=NREM+1 | |
2059 | NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+ | |
2060 | &NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3 | |
2061 | IF(NREQ.GT.NREM) GOTO 250 | |
2062 | DO 270 I=NSAV+NJET+1,N | |
2063 | 270 IF(K(I,1).EQ.8) K(I,1)=1 | |
2064 | ||
2065 | C...Find combination of existing and new flavours for hadron. | |
2066 | 280 NFET=2 | |
2067 | IF(NFL(1)+NFL(2)+NFL(3).NE.0) NFET=3 | |
2068 | IF(NREQ.LT.NREM) NFET=1 | |
2069 | IF(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3)).EQ.0) NFET=0 | |
2070 | DO 290 J=1,NFET | |
2071 | IFET(J)=1+int((IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3)))*RLU(0)) | |
2072 | KFLF(J)=ISIGN(1,NFL(1)) | |
2073 | IF(IFET(J).GT.IABS(NFL(1))) KFLF(J)=ISIGN(2,NFL(2)) | |
2074 | 290 IF(IFET(J).GT.IABS(NFL(1))+IABS(NFL(2))) KFLF(J)=ISIGN(3,NFL(3)) | |
2075 | IF(NFET.EQ.2.AND.(IFET(1).EQ.IFET(2).OR.KFLF(1)*KFLF(2).GT.0)) | |
2076 | &GOTO 280 | |
2077 | IF(NFET.EQ.3.AND.(IFET(1).EQ.IFET(2).OR.IFET(1).EQ.IFET(3).OR. | |
2078 | &IFET(2).EQ.IFET(3).OR.KFLF(1)*KFLF(2).LT.0.OR.KFLF(1)*KFLF(3). | |
2079 | <.0.OR.KFLF(1)*(NFL(1)+NFL(2)+NFL(3)).LT.0)) GOTO 280 | |
2080 | IF(NFET.EQ.0) KFLF(1)=1+INT((2.+PARJ(2))*RLU(0)) | |
2081 | IF(NFET.EQ.0) KFLF(2)=-KFLF(1) | |
2082 | IF(NFET.EQ.1) KFLF(2)=ISIGN(1+INT((2.+PARJ(2))*RLU(0)),-KFLF(1)) | |
2083 | IF(NFET.LE.2) KFLF(3)=0 | |
2084 | IF(KFLF(3).NE.0) THEN | |
2085 | KFLFC=ISIGN(1000*MAX(IABS(KFLF(1)),IABS(KFLF(3)))+ | |
2086 | & 100*MIN(IABS(KFLF(1)),IABS(KFLF(3)))+1,KFLF(1)) | |
2087 | IF(KFLF(1).EQ.KFLF(3).OR.(1.+3.*PARJ(4))*RLU(0).GT.1.) | |
2088 | & KFLFC=KFLFC+ISIGN(2,KFLFC) | |
2089 | ELSE | |
2090 | KFLFC=KFLF(1) | |
2091 | ENDIF | |
2092 | CALL LUKFDI(KFLFC,KFLF(2),KFLDMP,KF) | |
2093 | IF(KF.EQ.0) GOTO 280 | |
2094 | DO 300 J=1,MAX(2,NFET) | |
2095 | 300 NFL(IABS(KFLF(J)))=NFL(IABS(KFLF(J)))-ISIGN(1,KFLF(J)) | |
2096 | ||
2097 | C...Store hadron at random among free positions. | |
2098 | NPOS=MIN(1+INT(RLU(0)*NREM),NREM) | |
2099 | DO 310 I=NSAV+NJET+1,N | |
2100 | IF(K(I,1).EQ.7) NPOS=NPOS-1 | |
2101 | IF(K(I,1).EQ.1.OR.NPOS.NE.0) GOTO 310 | |
2102 | K(I,1)=1 | |
2103 | K(I,2)=KF | |
2104 | P(I,5)=ULMASS(K(I,2)) | |
2105 | P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2) | |
2106 | 310 CONTINUE | |
2107 | NREM=NREM-1 | |
2108 | NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+ | |
2109 | &NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3 | |
2110 | IF(NREM.GT.0) GOTO 280 | |
2111 | ||
2112 | C...Compensate for missing momentum in global scheme (3 options). | |
2113 | 320 IF(MOD(MSTJ(3),5).NE.0.AND.MOD(MSTJ(3),5).NE.4) THEN | |
2114 | DO 330 J=1,3 | |
2115 | PSI(J)=0. | |
2116 | DO 330 I=NSAV+NJET+1,N | |
2117 | 330 PSI(J)=PSI(J)+P(I,J) | |
2118 | PSI(4)=PSI(1)**2+PSI(2)**2+PSI(3)**2 | |
2119 | PWS=0. | |
2120 | DO 340 I=NSAV+NJET+1,N | |
2121 | IF(MOD(MSTJ(3),5).EQ.1) PWS=PWS+P(I,4) | |
2122 | IF(MOD(MSTJ(3),5).EQ.2) PWS=PWS+SQRT(P(I,5)**2+(PSI(1)*P(I,1)+ | |
2123 | & PSI(2)*P(I,2)+PSI(3)*P(I,3))**2/PSI(4)) | |
2124 | 340 IF(MOD(MSTJ(3),5).EQ.3) PWS=PWS+1. | |
2125 | DO 360 I=NSAV+NJET+1,N | |
2126 | IF(MOD(MSTJ(3),5).EQ.1) PW=P(I,4) | |
2127 | IF(MOD(MSTJ(3),5).EQ.2) PW=SQRT(P(I,5)**2+(PSI(1)*P(I,1)+ | |
2128 | & PSI(2)*P(I,2)+PSI(3)*P(I,3))**2/PSI(4)) | |
2129 | IF(MOD(MSTJ(3),5).EQ.3) PW=1. | |
2130 | DO 350 J=1,3 | |
2131 | 350 P(I,J)=P(I,J)-PSI(J)*PW/PWS | |
2132 | 360 P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2) | |
2133 | ||
2134 | C...Compensate for missing momentum withing each jet separately. | |
2135 | ELSEIF(MOD(MSTJ(3),5).EQ.4) THEN | |
2136 | DO 370 I=N+1,N+NJET | |
2137 | K(I,1)=0 | |
2138 | DO 370 J=1,5 | |
2139 | 370 P(I,J)=0. | |
2140 | DO 390 I=NSAV+NJET+1,N | |
2141 | IR1=K(I,3) | |
2142 | IR2=N+IR1-NSAV | |
2143 | K(IR2,1)=K(IR2,1)+1 | |
2144 | PLS=(P(I,1)*P(IR1,1)+P(I,2)*P(IR1,2)+P(I,3)*P(IR1,3))/ | |
2145 | & (P(IR1,1)**2+P(IR1,2)**2+P(IR1,3)**2) | |
2146 | DO 380 J=1,3 | |
2147 | 380 P(IR2,J)=P(IR2,J)+P(I,J)-PLS*P(IR1,J) | |
2148 | P(IR2,4)=P(IR2,4)+P(I,4) | |
2149 | 390 P(IR2,5)=P(IR2,5)+PLS | |
2150 | PSS=0. | |
2151 | DO 400 I=N+1,N+NJET | |
2152 | 400 IF(K(I,1).NE.0) PSS=PSS+P(I,4)/(PECM*(0.8*P(I,5)+0.2)) | |
2153 | DO 420 I=NSAV+NJET+1,N | |
2154 | IR1=K(I,3) | |
2155 | IR2=N+IR1-NSAV | |
2156 | PLS=(P(I,1)*P(IR1,1)+P(I,2)*P(IR1,2)+P(I,3)*P(IR1,3))/ | |
2157 | & (P(IR1,1)**2+P(IR1,2)**2+P(IR1,3)**2) | |
2158 | DO 410 J=1,3 | |
2159 | 410 P(I,J)=P(I,J)-P(IR2,J)/K(IR2,1)+(1./(P(IR2,5)*PSS)-1.)*PLS* | |
2160 | & P(IR1,J) | |
2161 | 420 P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2) | |
2162 | ENDIF | |
2163 | ||
2164 | C...Scale momenta for energy conservation. | |
2165 | IF(MOD(MSTJ(3),5).NE.0) THEN | |
2166 | PMS=0. | |
2167 | PES=0. | |
2168 | PQS=0. | |
2169 | DO 430 I=NSAV+NJET+1,N | |
2170 | PMS=PMS+P(I,5) | |
2171 | PES=PES+P(I,4) | |
2172 | 430 PQS=PQS+P(I,5)**2/P(I,4) | |
2173 | IF(PMS.GE.PECM) GOTO 150 | |
2174 | NECO=0 | |
2175 | 440 NECO=NECO+1 | |
2176 | PFAC=(PECM-PQS)/(PES-PQS) | |
2177 | PES=0. | |
2178 | PQS=0. | |
2179 | DO 460 I=NSAV+NJET+1,N | |
2180 | DO 450 J=1,3 | |
2181 | 450 P(I,J)=PFAC*P(I,J) | |
2182 | P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2) | |
2183 | PES=PES+P(I,4) | |
2184 | 460 PQS=PQS+P(I,5)**2/P(I,4) | |
2185 | IF(NECO.LT.10.AND.ABS(PECM-PES).GT.2E-6*PECM) GOTO 440 | |
2186 | ENDIF | |
2187 | ||
2188 | C...Origin of produced particles and parton daughter pointers. | |
2189 | 470 DO 480 I=NSAV+NJET+1,N | |
2190 | IF(MSTU(16).NE.2) K(I,3)=NSAV+1 | |
2191 | 480 IF(MSTU(16).EQ.2) K(I,3)=K(K(I,3),3) | |
2192 | DO 490 I=NSAV+1,NSAV+NJET | |
2193 | I1=K(I,3) | |
2194 | K(I1,1)=K(I1,1)+10 | |
2195 | IF(MSTU(16).NE.2) THEN | |
2196 | K(I1,4)=NSAV+1 | |
2197 | K(I1,5)=NSAV+1 | |
2198 | ELSE | |
2199 | K(I1,4)=K(I1,4)-NJET+1 | |
2200 | K(I1,5)=K(I1,5)-NJET+1 | |
2201 | IF(K(I1,5).LT.K(I1,4)) THEN | |
2202 | K(I1,4)=0 | |
2203 | K(I1,5)=0 | |
2204 | ENDIF | |
2205 | ENDIF | |
2206 | 490 CONTINUE | |
2207 | ||
2208 | C...Document independent fragmentation system. Remove copy of jets. | |
2209 | NSAV=NSAV+1 | |
2210 | K(NSAV,1)=11 | |
2211 | K(NSAV,2)=93 | |
2212 | K(NSAV,3)=IP | |
2213 | K(NSAV,4)=NSAV+1 | |
2214 | K(NSAV,5)=N-NJET+1 | |
2215 | DO 500 J=1,4 | |
2216 | P(NSAV,J)=sngl(DPS(J)) | |
2217 | 500 V(NSAV,J)=V(IP,J) | |
2218 | P(NSAV,5)=SQRT(sngl(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2 | |
2219 | & -DPS(3)**2))) | |
2220 | V(NSAV,5)=0. | |
2221 | DO 510 I=NSAV+NJET,N | |
2222 | DO 510 J=1,5 | |
2223 | K(I-NJET+1,J)=K(I,J) | |
2224 | P(I-NJET+1,J)=P(I,J) | |
2225 | 510 V(I-NJET+1,J)=V(I,J) | |
2226 | N=N-NJET+1 | |
2227 | ||
2228 | C...Boost back particle system. Set production vertices. | |
2229 | IF(NJET.NE.1) CALL LUDBRB(NSAV+1,N,0.,0.,DPS(1)/DPS(4), | |
2230 | &DPS(2)/DPS(4),DPS(3)/DPS(4)) | |
2231 | DO 520 I=NSAV+1,N | |
2232 | DO 520 J=1,4 | |
2233 | 520 V(I,J)=V(IP,J) | |
2234 | ||
2235 | RETURN | |
2236 | END | |
2237 | ||
2238 | C********************************************************************* | |
2239 | ||
2240 | SUBROUTINE LUDECY(IP) | |
2241 | ||
2242 | C...Purpose: to handle the decay of unstable particles. | |
2243 | COMMON/LUJETSA/N,K(9000,5),P(9000,5),V(9000,5) | |
2244 | SAVE /LUJETSA/ | |
2245 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
2246 | SAVE /LUDAT1A/ | |
2247 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
2248 | SAVE /LUDAT2A/ | |
2249 | COMMON/LUDAT3A/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) | |
2250 | SAVE /LUDAT3A/ | |
2251 | DIMENSION VDCY(4),KFLO(4),KFL1(4),PV(10,5),RORD(10),UE(3),BE(3), | |
2252 | &WTCOR(10) | |
2253 | clin-2/18/03 for resonance decay in hadron cascade: | |
2254 | common/resdcy/NSAV,iksdcy | |
2255 | SAVE /resdcy/ | |
2256 | DATA WTCOR/2.,5.,15.,60.,250.,1500.,1.2E4,1.2E5,150.,16./ | |
2257 | ||
2258 | C...Functions: momentum in two-particle decays, four-product and | |
2259 | C...matrix element times phase space in weak decays. | |
2260 | PAWT(A,B,C)=SQRT((A**2-(B+C)**2)*(A**2-(B-C)**2))/(2.*A) | |
2261 | 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) | |
2262 | HMEPS(HA)=((1.-HRQ-HA)**2+3.*HA*(1.+HRQ-HA))* | |
2263 | &SQRT((1.-HRQ-HA)**2-4.*HRQ*HA) | |
2264 | ||
2265 | C...Initial values. | |
2266 | ||
2267 | idc=0 | |
2268 | pqt=0. | |
2269 | hatu=0. | |
2270 | hmp1=0. | |
2271 | im=0 | |
2272 | kfam=0 | |
2273 | wtmax=0. | |
2274 | pmes=0. | |
2275 | pmst=0. | |
2276 | wt=0. | |
2277 | pmr=0. | |
2278 | ||
2279 | NTRY=0 | |
2280 | NSAV=N | |
2281 | KFA=IABS(K(IP,2)) | |
2282 | KFS=ISIGN(1,K(IP,2)) | |
2283 | KC=LUCOMP(KFA) | |
2284 | MSTJ(92)=0 | |
2285 | ||
2286 | C...Choose lifetime and determine decay vertex. | |
2287 | IF(K(IP,1).EQ.5) THEN | |
2288 | V(IP,5)=0. | |
2289 | ELSEIF(K(IP,1).NE.4) THEN | |
2290 | V(IP,5)=-PMAS(KC,4)*LOG(RLU(0)) | |
2291 | ENDIF | |
2292 | DO 100 J=1,4 | |
2293 | 100 VDCY(J)=V(IP,J)+V(IP,5)*P(IP,J)/P(IP,5) | |
2294 | ||
2295 | C...Determine whether decay allowed or not. | |
2296 | MOUT=0 | |
2297 | IF(MSTJ(22).EQ.2) THEN | |
2298 | IF(PMAS(KC,4).GT.PARJ(71)) MOUT=1 | |
2299 | ELSEIF(MSTJ(22).EQ.3) THEN | |
2300 | IF(VDCY(1)**2+VDCY(2)**2+VDCY(3)**2.GT.PARJ(72)**2) MOUT=1 | |
2301 | ELSEIF(MSTJ(22).EQ.4) THEN | |
2302 | IF(VDCY(1)**2+VDCY(2)**2.GT.PARJ(73)**2) MOUT=1 | |
2303 | IF(ABS(VDCY(3)).GT.PARJ(74)) MOUT=1 | |
2304 | ENDIF | |
2305 | IF(MOUT.EQ.1.AND.K(IP,1).NE.5) THEN | |
2306 | K(IP,1)=4 | |
2307 | RETURN | |
2308 | ENDIF | |
2309 | ||
2310 | C...Check existence of decay channels. Particle/antiparticle rules. | |
2311 | KCA=KC | |
2312 | IF(MDCY(KC,2).GT.0) THEN | |
2313 | MDMDCY=MDME(MDCY(KC,2),2) | |
2314 | IF(MDMDCY.GT.80.AND.MDMDCY.LE.90) KCA=MDMDCY | |
2315 | ENDIF | |
2316 | IF(MDCY(KCA,2).LE.0.OR.MDCY(KCA,3).LE.0) THEN | |
2317 | CALL LUERRM(9,'(LUDECY:) no decay channel defined') | |
2318 | RETURN | |
2319 | ENDIF | |
2320 | IF(MOD(KFA/1000,10).EQ.0.AND.(KCA.EQ.85.OR.KCA.EQ.87)) KFS=-KFS | |
2321 | IF(KCHG(KC,3).EQ.0) THEN | |
2322 | KFSP=1 | |
2323 | KFSN=0 | |
2324 | IF(RLU(0).GT.0.5) KFS=-KFS | |
2325 | ELSEIF(KFS.GT.0) THEN | |
2326 | KFSP=1 | |
2327 | KFSN=0 | |
2328 | ELSE | |
2329 | KFSP=0 | |
2330 | KFSN=1 | |
2331 | ENDIF | |
2332 | ||
2333 | C...Sum branching ratios of allowed decay channels. | |
2334 | clin 110 NOPE=0 | |
2335 | NOPE=0 | |
2336 | BRSU=0. | |
2337 | DO 120 IDL=MDCY(KCA,2),MDCY(KCA,2)+MDCY(KCA,3)-1 | |
2338 | IF(MDME(IDL,1).NE.1.AND.KFSP*MDME(IDL,1).NE.2.AND. | |
2339 | &KFSN*MDME(IDL,1).NE.3) GOTO 120 | |
2340 | IF(MDME(IDL,2).GT.100) GOTO 120 | |
2341 | NOPE=NOPE+1 | |
2342 | BRSU=BRSU+BRAT(IDL) | |
2343 | 120 CONTINUE | |
2344 | IF(NOPE.EQ.0) THEN | |
2345 | CALL LUERRM(2,'(LUDECY:) all decay channels closed by user') | |
2346 | RETURN | |
2347 | ENDIF | |
2348 | ||
2349 | C...Select decay channel among allowed ones. | |
2350 | 130 RBR=BRSU*RLU(0) | |
2351 | IDL=MDCY(KCA,2)-1 | |
2352 | 140 IDL=IDL+1 | |
2353 | IF(MDME(IDL,1).NE.1.AND.KFSP*MDME(IDL,1).NE.2.AND. | |
2354 | &KFSN*MDME(IDL,1).NE.3) THEN | |
2355 | IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1) GOTO 140 | |
2356 | ELSEIF(MDME(IDL,2).GT.100) THEN | |
2357 | IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1) GOTO 140 | |
2358 | ELSE | |
2359 | IDC=IDL | |
2360 | RBR=RBR-BRAT(IDL) | |
2361 | IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1.AND.RBR.GT.0.) GOTO 140 | |
2362 | ENDIF | |
2363 | ||
2364 | C...Start readout of decay channel: matrix element, reset counters. | |
2365 | MMAT=MDME(IDC,2) | |
2366 | 150 NTRY=NTRY+1 | |
2367 | IF(NTRY.GT.1000) THEN | |
2368 | CALL LUERRM(14,'(LUDECY:) caught in infinite loop') | |
2369 | IF(MSTU(21).GE.1) RETURN | |
2370 | ENDIF | |
2371 | I=N | |
2372 | NP=0 | |
2373 | NQ=0 | |
2374 | MBST=0 | |
2375 | IF(MMAT.GE.11.AND.MMAT.NE.46.AND.P(IP,4).GT.20.*P(IP,5)) MBST=1 | |
2376 | DO 160 J=1,4 | |
2377 | PV(1,J)=0. | |
2378 | 160 IF(MBST.EQ.0) PV(1,J)=P(IP,J) | |
2379 | IF(MBST.EQ.1) PV(1,4)=P(IP,5) | |
2380 | PV(1,5)=P(IP,5) | |
2381 | PS=0. | |
2382 | PSQ=0. | |
2383 | MREM=0 | |
2384 | ||
2385 | C...Read out decay products. Convert to standard flavour code. | |
2386 | JTMAX=5 | |
2387 | IF(MDME(IDC+1,2).EQ.101) JTMAX=10 | |
2388 | DO 170 JT=1,JTMAX | |
2389 | IF(JT.LE.5) KP=KFDP(IDC,JT) | |
2390 | IF(JT.GE.6) KP=KFDP(IDC+1,JT-5) | |
2391 | IF(KP.EQ.0) GOTO 170 | |
2392 | KPA=IABS(KP) | |
2393 | KCP=LUCOMP(KPA) | |
2394 | IF(KCHG(KCP,3).EQ.0.AND.KPA.NE.81.AND.KPA.NE.82) THEN | |
2395 | KFP=KP | |
2396 | ELSEIF(KPA.NE.81.AND.KPA.NE.82) THEN | |
2397 | KFP=KFS*KP | |
2398 | ELSEIF(KPA.EQ.81.AND.MOD(KFA/1000,10).EQ.0) THEN | |
2399 | KFP=-KFS*MOD(KFA/10,10) | |
2400 | ELSEIF(KPA.EQ.81.AND.MOD(KFA/100,10).GE.MOD(KFA/10,10)) THEN | |
2401 | KFP=KFS*(100*MOD(KFA/10,100)+3) | |
2402 | ELSEIF(KPA.EQ.81) THEN | |
2403 | KFP=KFS*(1000*MOD(KFA/10,10)+100*MOD(KFA/100,10)+1) | |
2404 | ELSEIF(KP.EQ.82) THEN | |
2405 | CALL LUKFDI(-KFS*INT(1.+(2.+PARJ(2))*RLU(0)),0,KFP,KDUMP) | |
2406 | IF(KFP.EQ.0) GOTO 150 | |
2407 | MSTJ(93)=1 | |
2408 | IF(PV(1,5).LT.PARJ(32)+2.*ULMASS(KFP)) GOTO 150 | |
2409 | ELSEIF(KP.EQ.-82) THEN | |
2410 | KFP=-KFP | |
2411 | IF(IABS(KFP).GT.10) KFP=KFP+ISIGN(10000,KFP) | |
2412 | ENDIF | |
2413 | IF(KPA.EQ.81.OR.KPA.EQ.82) KCP=LUCOMP(KFP) | |
2414 | ||
2415 | C...Add decay product to event record or to quark flavour list. | |
2416 | KFPA=IABS(KFP) | |
2417 | KQP=KCHG(KCP,2) | |
2418 | IF(MMAT.GE.11.AND.MMAT.LE.30.AND.KQP.NE.0) THEN | |
2419 | NQ=NQ+1 | |
2420 | KFLO(NQ)=KFP | |
2421 | MSTJ(93)=2 | |
2422 | PSQ=PSQ+ULMASS(KFLO(NQ)) | |
2423 | ELSEIF(MMAT.GE.42.AND.MMAT.LE.43.AND.NP.EQ.3.AND.MOD(NQ,2).EQ.1) | |
2424 | &THEN | |
2425 | NQ=NQ-1 | |
2426 | PS=PS-P(I,5) | |
2427 | K(I,1)=1 | |
2428 | KFI=K(I,2) | |
2429 | CALL LUKFDI(KFP,KFI,KFLDMP,K(I,2)) | |
2430 | IF(K(I,2).EQ.0) GOTO 150 | |
2431 | MSTJ(93)=1 | |
2432 | P(I,5)=ULMASS(K(I,2)) | |
2433 | PS=PS+P(I,5) | |
2434 | ELSE | |
2435 | I=I+1 | |
2436 | NP=NP+1 | |
2437 | IF(MMAT.NE.33.AND.KQP.NE.0) NQ=NQ+1 | |
2438 | IF(MMAT.EQ.33.AND.KQP.NE.0.AND.KQP.NE.2) NQ=NQ+1 | |
2439 | K(I,1)=1+MOD(NQ,2) | |
2440 | IF(MMAT.EQ.4.AND.JT.LE.2.AND.KFP.EQ.21) K(I,1)=2 | |
2441 | IF(MMAT.EQ.4.AND.JT.EQ.3) K(I,1)=1 | |
2442 | K(I,2)=KFP | |
2443 | K(I,3)=IP | |
2444 | K(I,4)=0 | |
2445 | K(I,5)=0 | |
2446 | P(I,5)=ULMASS(KFP) | |
2447 | IF(MMAT.EQ.45.AND.KFPA.EQ.89) P(I,5)=PARJ(32) | |
2448 | PS=PS+P(I,5) | |
2449 | ENDIF | |
2450 | 170 CONTINUE | |
2451 | ||
2452 | C...Choose decay multiplicity in phase space model. | |
2453 | 180 IF(MMAT.GE.11.AND.MMAT.LE.30) THEN | |
2454 | PSP=PS | |
2455 | CNDE=PARJ(61)*LOG(MAX((PV(1,5)-PS-PSQ)/PARJ(62),1.1)) | |
2456 | IF(MMAT.EQ.12) CNDE=CNDE+PARJ(63) | |
2457 | 190 NTRY=NTRY+1 | |
2458 | IF(NTRY.GT.1000) THEN | |
2459 | CALL LUERRM(14,'(LUDECY:) caught in infinite loop') | |
2460 | IF(MSTU(21).GE.1) RETURN | |
2461 | ENDIF | |
2462 | IF(MMAT.LE.20) THEN | |
2463 | GAUSS=SQRT(-2.*CNDE*LOG(MAX(1E-10,RLU(0))))* | |
2464 | & SIN(PARU(2)*RLU(0)) | |
2465 | ND=int(0.5+0.5*NP+0.25*NQ+CNDE+GAUSS) | |
2466 | IF(ND.LT.NP+NQ/2.OR.ND.LT.2.OR.ND.GT.10) GOTO 190 | |
2467 | IF(MMAT.EQ.13.AND.ND.EQ.2) GOTO 190 | |
2468 | IF(MMAT.EQ.14.AND.ND.LE.3) GOTO 190 | |
2469 | IF(MMAT.EQ.15.AND.ND.LE.4) GOTO 190 | |
2470 | ELSE | |
2471 | ND=MMAT-20 | |
2472 | ENDIF | |
2473 | ||
2474 | C...Form hadrons from flavour content. | |
2475 | DO 200 JT=1,4 | |
2476 | 200 KFL1(JT)=KFLO(JT) | |
2477 | IF(ND.EQ.NP+NQ/2) GOTO 220 | |
2478 | DO 210 I=N+NP+1,N+ND-NQ/2 | |
2479 | JT=1+INT((NQ-1)*RLU(0)) | |
2480 | CALL LUKFDI(KFL1(JT),0,KFL2,K(I,2)) | |
2481 | IF(K(I,2).EQ.0) GOTO 190 | |
2482 | 210 KFL1(JT)=-KFL2 | |
2483 | 220 JT=2 | |
2484 | JT2=3 | |
2485 | JT3=4 | |
2486 | IF(NQ.EQ.4.AND.RLU(0).LT.PARJ(66)) JT=4 | |
2487 | IF(JT.EQ.4.AND.ISIGN(1,KFL1(1)*(10-IABS(KFL1(1))))* | |
2488 | & ISIGN(1,KFL1(JT)*(10-IABS(KFL1(JT)))).GT.0) JT=3 | |
2489 | IF(JT.EQ.3) JT2=2 | |
2490 | IF(JT.EQ.4) JT3=2 | |
2491 | CALL LUKFDI(KFL1(1),KFL1(JT),KFLDMP,K(N+ND-NQ/2+1,2)) | |
2492 | IF(K(N+ND-NQ/2+1,2).EQ.0) GOTO 190 | |
2493 | IF(NQ.EQ.4) CALL LUKFDI(KFL1(JT2),KFL1(JT3),KFLDMP,K(N+ND,2)) | |
2494 | IF(NQ.EQ.4.AND.K(N+ND,2).EQ.0) GOTO 190 | |
2495 | ||
2496 | C...Check that sum of decay product masses not too large. | |
2497 | PS=PSP | |
2498 | DO 230 I=N+NP+1,N+ND | |
2499 | K(I,1)=1 | |
2500 | K(I,3)=IP | |
2501 | K(I,4)=0 | |
2502 | K(I,5)=0 | |
2503 | P(I,5)=ULMASS(K(I,2)) | |
2504 | 230 PS=PS+P(I,5) | |
2505 | IF(PS+PARJ(64).GT.PV(1,5)) GOTO 190 | |
2506 | ||
2507 | C...Rescale energy to subtract off spectator quark mass. | |
2508 | ELSEIF((MMAT.EQ.31.OR.MMAT.EQ.33.OR.MMAT.EQ.44.OR.MMAT.EQ.45). | |
2509 | &AND.NP.GE.3) THEN | |
2510 | PS=PS-P(N+NP,5) | |
2511 | PQT=(P(N+NP,5)+PARJ(65))/PV(1,5) | |
2512 | DO 240 J=1,5 | |
2513 | P(N+NP,J)=PQT*PV(1,J) | |
2514 | 240 PV(1,J)=(1.-PQT)*PV(1,J) | |
2515 | IF(PS+PARJ(64).GT.PV(1,5)) GOTO 150 | |
2516 | ND=NP-1 | |
2517 | MREM=1 | |
2518 | ||
2519 | C...Phase space factors imposed in W decay. | |
2520 | ELSEIF(MMAT.EQ.46) THEN | |
2521 | MSTJ(93)=1 | |
2522 | PSMC=ULMASS(K(N+1,2)) | |
2523 | MSTJ(93)=1 | |
2524 | PSMC=PSMC+ULMASS(K(N+2,2)) | |
2525 | IF(MAX(PS,PSMC)+PARJ(32).GT.PV(1,5)) GOTO 130 | |
2526 | HR1=(P(N+1,5)/PV(1,5))**2 | |
2527 | HR2=(P(N+2,5)/PV(1,5))**2 | |
2528 | IF((1.-HR1-HR2)*(2.+HR1+HR2)*SQRT((1.-HR1-HR2)**2-4.*HR1*HR2). | |
2529 | & LT.2.*RLU(0)) GOTO 130 | |
2530 | ND=NP | |
2531 | ||
2532 | C...Fully specified final state: check mass broadening effects. | |
2533 | ELSE | |
2534 | IF(NP.GE.2.AND.PS+PARJ(64).GT.PV(1,5)) GOTO 150 | |
2535 | ND=NP | |
2536 | ENDIF | |
2537 | ||
2538 | C...Select W mass in decay Q -> W + q, without W propagator. | |
2539 | IF(MMAT.EQ.45.AND.MSTJ(25).LE.0) THEN | |
2540 | HLQ=(PARJ(32)/PV(1,5))**2 | |
2541 | HUQ=(1.-(P(N+2,5)+PARJ(64))/PV(1,5))**2 | |
2542 | HRQ=(P(N+2,5)/PV(1,5))**2 | |
2543 | 250 HW=HLQ+RLU(0)*(HUQ-HLQ) | |
2544 | IF(HMEPS(HW).LT.RLU(0)) GOTO 250 | |
2545 | P(N+1,5)=PV(1,5)*SQRT(HW) | |
2546 | ||
2547 | C...Ditto, including W propagator. Divide mass range into three regions. | |
2548 | ELSEIF(MMAT.EQ.45) THEN | |
2549 | HQW=(PV(1,5)/PMAS(24,1))**2 | |
2550 | HLW=(PARJ(32)/PMAS(24,1))**2 | |
2551 | HUW=((PV(1,5)-P(N+2,5)-PARJ(64))/PMAS(24,1))**2 | |
2552 | HRQ=(P(N+2,5)/PV(1,5))**2 | |
2553 | HG=PMAS(24,2)/PMAS(24,1) | |
2554 | HATL=ATAN((HLW-1.)/HG) | |
2555 | HM=MIN(1.,HUW-0.001) | |
2556 | HMV1=HMEPS(HM/HQW)/((HM-1.)**2+HG**2) | |
2557 | 260 HM=HM-HG | |
2558 | HMV2=HMEPS(HM/HQW)/((HM-1.)**2+HG**2) | |
2559 | HSAV1=HMEPS(HM/HQW) | |
2560 | HSAV2=1./((HM-1.)**2+HG**2) | |
2561 | IF(HMV2.GT.HMV1.AND.HM-HG.GT.HLW) THEN | |
2562 | HMV1=HMV2 | |
2563 | GOTO 260 | |
2564 | ENDIF | |
2565 | HMV=MIN(2.*HMV1,HMEPS(HM/HQW)/HG**2) | |
2566 | HM1=1.-SQRT(1./HMV-HG**2) | |
2567 | IF(HM1.GT.HLW.AND.HM1.LT.HM) THEN | |
2568 | HM=HM1 | |
2569 | ELSEIF(HMV2.LE.HMV1) THEN | |
2570 | HM=MAX(HLW,HM-MIN(0.1,1.-HM)) | |
2571 | ENDIF | |
2572 | HATM=ATAN((HM-1.)/HG) | |
2573 | HWT1=(HATM-HATL)/HG | |
2574 | HWT2=HMV*(MIN(1.,HUW)-HM) | |
2575 | HWT3=0. | |
2576 | IF(HUW.GT.1.) THEN | |
2577 | HATU=ATAN((HUW-1.)/HG) | |
2578 | HMP1=HMEPS(1./HQW) | |
2579 | HWT3=HMP1*HATU/HG | |
2580 | ENDIF | |
2581 | ||
2582 | C...Select mass region and W mass there. Accept according to weight. | |
2583 | 270 HREG=RLU(0)*(HWT1+HWT2+HWT3) | |
2584 | IF(HREG.LE.HWT1) THEN | |
2585 | HW=1.+HG*TAN(HATL+RLU(0)*(HATM-HATL)) | |
2586 | HACC=HMEPS(HW/HQW) | |
2587 | ELSEIF(HREG.LE.HWT1+HWT2) THEN | |
2588 | HW=HM+RLU(0)*(MIN(1.,HUW)-HM) | |
2589 | HACC=HMEPS(HW/HQW)/((HW-1.)**2+HG**2)/HMV | |
2590 | ELSE | |
2591 | HW=1.+HG*TAN(RLU(0)*HATU) | |
2592 | HACC=HMEPS(HW/HQW)/HMP1 | |
2593 | ENDIF | |
2594 | IF(HACC.LT.RLU(0)) GOTO 270 | |
2595 | P(N+1,5)=PMAS(24,1)*SQRT(HW) | |
2596 | ENDIF | |
2597 | ||
2598 | C...Determine position of grandmother, number of sisters, Q -> W sign. | |
2599 | NM=0 | |
2600 | MSGN=0 | |
2601 | IF(MMAT.EQ.3.OR.MMAT.EQ.46) THEN | |
2602 | IM=K(IP,3) | |
2603 | IF(IM.LT.0.OR.IM.GE.IP) IM=0 | |
2604 | IF(IM.NE.0) KFAM=IABS(K(IM,2)) | |
2605 | IF(IM.NE.0.AND.MMAT.EQ.3) THEN | |
2606 | DO 280 IL=MAX(IP-2,IM+1),MIN(IP+2,N) | |
2607 | 280 IF(K(IL,3).EQ.IM) NM=NM+1 | |
2608 | IF(NM.NE.2.OR.KFAM.LE.100.OR.MOD(KFAM,10).NE.1.OR. | |
2609 | & MOD(KFAM/1000,10).NE.0) NM=0 | |
2610 | ELSEIF(IM.NE.0.AND.MMAT.EQ.46) THEN | |
2611 | MSGN=ISIGN(1,K(IM,2)*K(IP,2)) | |
2612 | IF(KFAM.GT.100.AND.MOD(KFAM/1000,10).EQ.0) MSGN= | |
2613 | & MSGN*(-1)**MOD(KFAM/100,10) | |
2614 | ENDIF | |
2615 | ENDIF | |
2616 | ||
2617 | C...Kinematics of one-particle decays. | |
2618 | IF(ND.EQ.1) THEN | |
2619 | DO 290 J=1,4 | |
2620 | 290 P(N+1,J)=P(IP,J) | |
2621 | GOTO 510 | |
2622 | ENDIF | |
2623 | ||
2624 | C...Calculate maximum weight ND-particle decay. | |
2625 | PV(ND,5)=P(N+ND,5) | |
2626 | IF(ND.GE.3) THEN | |
2627 | WTMAX=1./WTCOR(ND-2) | |
2628 | PMAX=PV(1,5)-PS+P(N+ND,5) | |
2629 | PMIN=0. | |
2630 | DO 300 IL=ND-1,1,-1 | |
2631 | PMAX=PMAX+P(N+IL,5) | |
2632 | PMIN=PMIN+P(N+IL+1,5) | |
2633 | 300 WTMAX=WTMAX*PAWT(PMAX,PMIN,P(N+IL,5)) | |
2634 | ENDIF | |
2635 | ||
2636 | C...Find virtual gamma mass in Dalitz decay. | |
2637 | 310 IF(ND.EQ.2) THEN | |
2638 | ELSEIF(MMAT.EQ.2) THEN | |
2639 | PMES=4.*PMAS(11,1)**2 | |
2640 | PMRHO2=PMAS(131,1)**2 | |
2641 | PGRHO2=PMAS(131,2)**2 | |
2642 | 320 PMST=PMES*(P(IP,5)**2/PMES)**RLU(0) | |
2643 | WT=(1+0.5*PMES/PMST)*SQRT(MAX(0.,1.-PMES/PMST))* | |
2644 | & (1.-PMST/P(IP,5)**2)**3*(1.+PGRHO2/PMRHO2)/ | |
2645 | & ((1.-PMST/PMRHO2)**2+PGRHO2/PMRHO2) | |
2646 | IF(WT.LT.RLU(0)) GOTO 320 | |
2647 | PV(2,5)=MAX(2.00001*PMAS(11,1),SQRT(PMST)) | |
2648 | ||
2649 | C...M-generator gives weight. If rejected, try again. | |
2650 | ELSE | |
2651 | 330 RORD(1)=1. | |
2652 | DO 350 IL1=2,ND-1 | |
2653 | RSAV=RLU(0) | |
2654 | DO 340 IL2=IL1-1,1,-1 | |
2655 | IF(RSAV.LE.RORD(IL2)) GOTO 350 | |
2656 | 340 RORD(IL2+1)=RORD(IL2) | |
2657 | 350 RORD(IL2+1)=RSAV | |
2658 | RORD(ND)=0. | |
2659 | WT=1. | |
2660 | DO 360 IL=ND-1,1,-1 | |
2661 | PV(IL,5)=PV(IL+1,5)+P(N+IL,5)+(RORD(IL)-RORD(IL+1))*(PV(1,5)-PS) | |
2662 | 360 WT=WT*PAWT(PV(IL,5),PV(IL+1,5),P(N+IL,5)) | |
2663 | IF(WT.LT.RLU(0)*WTMAX) GOTO 330 | |
2664 | ENDIF | |
2665 | ||
2666 | C...Perform two-particle decays in respective CM frame. | |
2667 | 370 DO 390 IL=1,ND-1 | |
2668 | PA=PAWT(PV(IL,5),PV(IL+1,5),P(N+IL,5)) | |
2669 | UE(3)=2.*RLU(0)-1. | |
2670 | PHI=PARU(2)*RLU(0) | |
2671 | UE(1)=SQRT(1.-UE(3)**2)*COS(PHI) | |
2672 | UE(2)=SQRT(1.-UE(3)**2)*SIN(PHI) | |
2673 | DO 380 J=1,3 | |
2674 | P(N+IL,J)=PA*UE(J) | |
2675 | 380 PV(IL+1,J)=-PA*UE(J) | |
2676 | P(N+IL,4)=SQRT(PA**2+P(N+IL,5)**2) | |
2677 | 390 PV(IL+1,4)=SQRT(PA**2+PV(IL+1,5)**2) | |
2678 | ||
2679 | C...Lorentz transform decay products to lab frame. | |
2680 | DO 400 J=1,4 | |
2681 | 400 P(N+ND,J)=PV(ND,J) | |
2682 | DO 430 IL=ND-1,1,-1 | |
2683 | DO 410 J=1,3 | |
2684 | 410 BE(J)=PV(IL,J)/PV(IL,4) | |
2685 | GA=PV(IL,4)/PV(IL,5) | |
2686 | DO 430 I=N+IL,N+ND | |
2687 | BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3) | |
2688 | DO 420 J=1,3 | |
2689 | 420 P(I,J)=P(I,J)+GA*(GA*BEP/(1.+GA)+P(I,4))*BE(J) | |
2690 | 430 P(I,4)=GA*(P(I,4)+BEP) | |
2691 | ||
2692 | C...Matrix elements for omega and phi decays. | |
2693 | IF(MMAT.EQ.1) THEN | |
2694 | WT=(P(N+1,5)*P(N+2,5)*P(N+3,5))**2-(P(N+1,5)*FOUR(N+2,N+3))**2 | |
2695 | & -(P(N+2,5)*FOUR(N+1,N+3))**2-(P(N+3,5)*FOUR(N+1,N+2))**2 | |
2696 | & +2.*FOUR(N+1,N+2)*FOUR(N+1,N+3)*FOUR(N+2,N+3) | |
2697 | IF(MAX(WT*WTCOR(9)/P(IP,5)**6,0.001).LT.RLU(0)) GOTO 310 | |
2698 | ||
2699 | C...Matrix elements for pi0 or eta Dalitz decay to gamma e+ e-. | |
2700 | ELSEIF(MMAT.EQ.2) THEN | |
2701 | FOUR12=FOUR(N+1,N+2) | |
2702 | FOUR13=FOUR(N+1,N+3) | |
2703 | FOUR23=0.5*PMST-0.25*PMES | |
2704 | WT=(PMST-0.5*PMES)*(FOUR12**2+FOUR13**2)+ | |
2705 | & PMES*(FOUR12*FOUR13+FOUR12**2+FOUR13**2) | |
2706 | IF(WT.LT.RLU(0)*0.25*PMST*(P(IP,5)**2-PMST)**2) GOTO 370 | |
2707 | ||
2708 | C...Matrix element for S0 -> S1 + V1 -> S1 + S2 + S3 (S scalar, | |
2709 | C...V vector), of form cos**2(theta02) in V1 rest frame. | |
2710 | ELSEIF(MMAT.EQ.3.AND.NM.EQ.2) THEN | |
2711 | IF((P(IP,5)**2*FOUR(IM,N+1)-FOUR(IP,IM)*FOUR(IP,N+1))**2.LE. | |
2712 | & RLU(0)*(FOUR(IP,IM)**2-(P(IP,5)*P(IM,5))**2)*(FOUR(IP,N+1)**2- | |
2713 | & (P(IP,5)*P(N+1,5))**2)) GOTO 370 | |
2714 | ||
2715 | C...Matrix element for "onium" -> g + g + g or gamma + g + g. | |
2716 | ELSEIF(MMAT.EQ.4) THEN | |
2717 | HX1=2.*FOUR(IP,N+1)/P(IP,5)**2 | |
2718 | HX2=2.*FOUR(IP,N+2)/P(IP,5)**2 | |
2719 | HX3=2.*FOUR(IP,N+3)/P(IP,5)**2 | |
2720 | WT=((1.-HX1)/(HX2*HX3))**2+((1.-HX2)/(HX1*HX3))**2+ | |
2721 | & ((1.-HX3)/(HX1*HX2))**2 | |
2722 | IF(WT.LT.2.*RLU(0)) GOTO 310 | |
2723 | IF(K(IP+1,2).EQ.22.AND.(1.-HX1)*P(IP,5)**2.LT.4.*PARJ(32)**2) | |
2724 | & GOTO 310 | |
2725 | ||
2726 | C...Effective matrix element for nu spectrum in tau -> nu + hadrons. | |
2727 | ELSEIF(MMAT.EQ.41) THEN | |
2728 | HX1=2.*FOUR(IP,N+1)/P(IP,5)**2 | |
2729 | IF(8.*HX1*(3.-2.*HX1)/9..LT.RLU(0)) GOTO 310 | |
2730 | ||
2731 | C...Matrix elements for weak decays (only semileptonic for c and b) | |
2732 | ELSEIF(MMAT.GE.42.AND.MMAT.LE.44.AND.ND.EQ.3) THEN | |
2733 | IF(MBST.EQ.0) WT=FOUR(IP,N+1)*FOUR(N+2,N+3) | |
2734 | IF(MBST.EQ.1) WT=P(IP,5)*P(N+1,4)*FOUR(N+2,N+3) | |
2735 | IF(WT.LT.RLU(0)*P(IP,5)*PV(1,5)**3/WTCOR(10)) GOTO 310 | |
2736 | ELSEIF(MMAT.GE.42.AND.MMAT.LE.44) THEN | |
2737 | DO 440 J=1,4 | |
2738 | P(N+NP+1,J)=0. | |
2739 | DO 440 IS=N+3,N+NP | |
2740 | 440 P(N+NP+1,J)=P(N+NP+1,J)+P(IS,J) | |
2741 | IF(MBST.EQ.0) WT=FOUR(IP,N+1)*FOUR(N+2,N+NP+1) | |
2742 | IF(MBST.EQ.1) WT=P(IP,5)*P(N+1,4)*FOUR(N+2,N+NP+1) | |
2743 | IF(WT.LT.RLU(0)*P(IP,5)*PV(1,5)**3/WTCOR(10)) GOTO 310 | |
2744 | ||
2745 | C...Angular distribution in W decay. | |
2746 | ELSEIF(MMAT.EQ.46.AND.MSGN.NE.0) THEN | |
2747 | IF(MSGN.GT.0) WT=FOUR(IM,N+1)*FOUR(N+2,IP+1) | |
2748 | IF(MSGN.LT.0) WT=FOUR(IM,N+2)*FOUR(N+1,IP+1) | |
2749 | IF(WT.LT.RLU(0)*P(IM,5)**4/WTCOR(10)) GOTO 370 | |
2750 | ENDIF | |
2751 | ||
2752 | C...Scale back energy and reattach spectator. | |
2753 | IF(MREM.EQ.1) THEN | |
2754 | DO 450 J=1,5 | |
2755 | 450 PV(1,J)=PV(1,J)/(1.-PQT) | |
2756 | ND=ND+1 | |
2757 | MREM=0 | |
2758 | ENDIF | |
2759 | ||
2760 | C...Low invariant mass for system with spectator quark gives particle, | |
2761 | C...not two jets. Readjust momenta accordingly. | |
2762 | IF((MMAT.EQ.31.OR.MMAT.EQ.45).AND.ND.EQ.3) THEN | |
2763 | MSTJ(93)=1 | |
2764 | PM2=ULMASS(K(N+2,2)) | |
2765 | MSTJ(93)=1 | |
2766 | PM3=ULMASS(K(N+3,2)) | |
2767 | IF(P(N+2,5)**2+P(N+3,5)**2+2.*FOUR(N+2,N+3).GE. | |
2768 | & (PARJ(32)+PM2+PM3)**2) GOTO 510 | |
2769 | K(N+2,1)=1 | |
2770 | KFTEMP=K(N+2,2) | |
2771 | CALL LUKFDI(KFTEMP,K(N+3,2),KFLDMP,K(N+2,2)) | |
2772 | IF(K(N+2,2).EQ.0) GOTO 150 | |
2773 | P(N+2,5)=ULMASS(K(N+2,2)) | |
2774 | PS=P(N+1,5)+P(N+2,5) | |
2775 | PV(2,5)=P(N+2,5) | |
2776 | MMAT=0 | |
2777 | ND=2 | |
2778 | GOTO 370 | |
2779 | ELSEIF(MMAT.EQ.44) THEN | |
2780 | MSTJ(93)=1 | |
2781 | PM3=ULMASS(K(N+3,2)) | |
2782 | MSTJ(93)=1 | |
2783 | PM4=ULMASS(K(N+4,2)) | |
2784 | IF(P(N+3,5)**2+P(N+4,5)**2+2.*FOUR(N+3,N+4).GE. | |
2785 | & (PARJ(32)+PM3+PM4)**2) GOTO 480 | |
2786 | K(N+3,1)=1 | |
2787 | KFTEMP=K(N+3,2) | |
2788 | CALL LUKFDI(KFTEMP,K(N+4,2),KFLDMP,K(N+3,2)) | |
2789 | IF(K(N+3,2).EQ.0) GOTO 150 | |
2790 | P(N+3,5)=ULMASS(K(N+3,2)) | |
2791 | DO 460 J=1,3 | |
2792 | 460 P(N+3,J)=P(N+3,J)+P(N+4,J) | |
2793 | 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) | |
2794 | HA=P(N+1,4)**2-P(N+2,4)**2 | |
2795 | HB=HA-(P(N+1,5)**2-P(N+2,5)**2) | |
2796 | HC=(P(N+1,1)-P(N+2,1))**2+(P(N+1,2)-P(N+2,2))**2+ | |
2797 | & (P(N+1,3)-P(N+2,3))**2 | |
2798 | HD=(PV(1,4)-P(N+3,4))**2 | |
2799 | HE=HA**2-2.*HD*(P(N+1,4)**2+P(N+2,4)**2)+HD**2 | |
2800 | HF=HD*HC-HB**2 | |
2801 | HG=HD*HC-HA*HB | |
2802 | HH=(SQRT(HG**2+HE*HF)-HG)/(2.*HF) | |
2803 | DO 470 J=1,3 | |
2804 | PCOR=HH*(P(N+1,J)-P(N+2,J)) | |
2805 | P(N+1,J)=P(N+1,J)+PCOR | |
2806 | 470 P(N+2,J)=P(N+2,J)-PCOR | |
2807 | 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) | |
2808 | 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) | |
2809 | ND=ND-1 | |
2810 | ENDIF | |
2811 | ||
2812 | C...Check invariant mass of W jets. May give one particle or start over. | |
2813 | 480 IF(MMAT.GE.42.AND.MMAT.LE.44.AND.IABS(K(N+1,2)).LT.10) THEN | |
2814 | PMR=SQRT(MAX(0.,P(N+1,5)**2+P(N+2,5)**2+2.*FOUR(N+1,N+2))) | |
2815 | MSTJ(93)=1 | |
2816 | PM1=ULMASS(K(N+1,2)) | |
2817 | MSTJ(93)=1 | |
2818 | PM2=ULMASS(K(N+2,2)) | |
2819 | IF(PMR.GT.PARJ(32)+PM1+PM2) GOTO 490 | |
2820 | KFLDUM=INT(1.5+RLU(0)) | |
2821 | CALL LUKFDI(K(N+1,2),-ISIGN(KFLDUM,K(N+1,2)),KFLDMP,KF1) | |
2822 | CALL LUKFDI(K(N+2,2),-ISIGN(KFLDUM,K(N+2,2)),KFLDMP,KF2) | |
2823 | IF(KF1.EQ.0.OR.KF2.EQ.0) GOTO 150 | |
2824 | PSM=ULMASS(KF1)+ULMASS(KF2) | |
2825 | IF(MMAT.EQ.42.AND.PMR.GT.PARJ(64)+PSM) GOTO 490 | |
2826 | IF(MMAT.GE.43.AND.PMR.GT.0.2*PARJ(32)+PSM) GOTO 490 | |
2827 | IF(ND.EQ.4.OR.KFA.EQ.15) GOTO 150 | |
2828 | K(N+1,1)=1 | |
2829 | KFTEMP=K(N+1,2) | |
2830 | CALL LUKFDI(KFTEMP,K(N+2,2),KFLDMP,K(N+1,2)) | |
2831 | IF(K(N+1,2).EQ.0) GOTO 150 | |
2832 | P(N+1,5)=ULMASS(K(N+1,2)) | |
2833 | K(N+2,2)=K(N+3,2) | |
2834 | P(N+2,5)=P(N+3,5) | |
2835 | PS=P(N+1,5)+P(N+2,5) | |
2836 | PV(2,5)=P(N+3,5) | |
2837 | MMAT=0 | |
2838 | ND=2 | |
2839 | GOTO 370 | |
2840 | ENDIF | |
2841 | ||
2842 | C...Phase space decay of partons from W decay. | |
2843 | 490 IF(MMAT.EQ.42.AND.IABS(K(N+1,2)).LT.10) THEN | |
2844 | KFLO(1)=K(N+1,2) | |
2845 | KFLO(2)=K(N+2,2) | |
2846 | K(N+1,1)=K(N+3,1) | |
2847 | K(N+1,2)=K(N+3,2) | |
2848 | DO 500 J=1,5 | |
2849 | PV(1,J)=P(N+1,J)+P(N+2,J) | |
2850 | 500 P(N+1,J)=P(N+3,J) | |
2851 | PV(1,5)=PMR | |
2852 | N=N+1 | |
2853 | NP=0 | |
2854 | NQ=2 | |
2855 | PS=0. | |
2856 | MSTJ(93)=2 | |
2857 | PSQ=ULMASS(KFLO(1)) | |
2858 | MSTJ(93)=2 | |
2859 | PSQ=PSQ+ULMASS(KFLO(2)) | |
2860 | MMAT=11 | |
2861 | GOTO 180 | |
2862 | ENDIF | |
2863 | ||
2864 | C...Boost back for rapidly moving particle. | |
2865 | 510 N=N+ND | |
2866 | IF(MBST.EQ.1) THEN | |
2867 | DO 520 J=1,3 | |
2868 | 520 BE(J)=P(IP,J)/P(IP,4) | |
2869 | GA=P(IP,4)/P(IP,5) | |
2870 | DO 540 I=NSAV+1,N | |
2871 | BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3) | |
2872 | DO 530 J=1,3 | |
2873 | 530 P(I,J)=P(I,J)+GA*(GA*BEP/(1.+GA)+P(I,4))*BE(J) | |
2874 | 540 P(I,4)=GA*(P(I,4)+BEP) | |
2875 | ENDIF | |
2876 | ||
2877 | C...Fill in position of decay vertex. | |
2878 | DO 560 I=NSAV+1,N | |
2879 | DO 550 J=1,4 | |
2880 | 550 V(I,J)=VDCY(J) | |
2881 | 560 V(I,5)=0. | |
2882 | ||
2883 | C...Set up for parton shower evolution from jets. | |
2884 | IF(MSTJ(23).GE.1.AND.MMAT.EQ.4.AND.K(NSAV+1,2).EQ.21) THEN | |
2885 | K(NSAV+1,1)=3 | |
2886 | K(NSAV+2,1)=3 | |
2887 | K(NSAV+3,1)=3 | |
2888 | K(NSAV+1,4)=MSTU(5)*(NSAV+2) | |
2889 | K(NSAV+1,5)=MSTU(5)*(NSAV+3) | |
2890 | K(NSAV+2,4)=MSTU(5)*(NSAV+3) | |
2891 | K(NSAV+2,5)=MSTU(5)*(NSAV+1) | |
2892 | K(NSAV+3,4)=MSTU(5)*(NSAV+1) | |
2893 | K(NSAV+3,5)=MSTU(5)*(NSAV+2) | |
2894 | MSTJ(92)=-(NSAV+1) | |
2895 | ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.4) THEN | |
2896 | K(NSAV+2,1)=3 | |
2897 | K(NSAV+3,1)=3 | |
2898 | K(NSAV+2,4)=MSTU(5)*(NSAV+3) | |
2899 | K(NSAV+2,5)=MSTU(5)*(NSAV+3) | |
2900 | K(NSAV+3,4)=MSTU(5)*(NSAV+2) | |
2901 | K(NSAV+3,5)=MSTU(5)*(NSAV+2) | |
2902 | MSTJ(92)=NSAV+2 | |
2903 | ELSEIF(MSTJ(23).GE.1.AND.(MMAT.EQ.32.OR.MMAT.EQ.44.OR.MMAT.EQ.46). | |
2904 | &AND.IABS(K(NSAV+1,2)).LE.10.AND.IABS(K(NSAV+2,2)).LE.10) THEN | |
2905 | K(NSAV+1,1)=3 | |
2906 | K(NSAV+2,1)=3 | |
2907 | K(NSAV+1,4)=MSTU(5)*(NSAV+2) | |
2908 | K(NSAV+1,5)=MSTU(5)*(NSAV+2) | |
2909 | K(NSAV+2,4)=MSTU(5)*(NSAV+1) | |
2910 | K(NSAV+2,5)=MSTU(5)*(NSAV+1) | |
2911 | MSTJ(92)=NSAV+1 | |
2912 | ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.33.AND.IABS(K(NSAV+2,2)).EQ.21) | |
2913 | &THEN | |
2914 | K(NSAV+1,1)=3 | |
2915 | K(NSAV+2,1)=3 | |
2916 | K(NSAV+3,1)=3 | |
2917 | KCP=LUCOMP(K(NSAV+1,2)) | |
2918 | KQP=KCHG(KCP,2)*ISIGN(1,K(NSAV+1,2)) | |
2919 | JCON=4 | |
2920 | IF(KQP.LT.0) JCON=5 | |
2921 | K(NSAV+1,JCON)=MSTU(5)*(NSAV+2) | |
2922 | K(NSAV+2,9-JCON)=MSTU(5)*(NSAV+1) | |
2923 | K(NSAV+2,JCON)=MSTU(5)*(NSAV+3) | |
2924 | K(NSAV+3,9-JCON)=MSTU(5)*(NSAV+2) | |
2925 | MSTJ(92)=NSAV+1 | |
2926 | ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.33) THEN | |
2927 | K(NSAV+1,1)=3 | |
2928 | K(NSAV+3,1)=3 | |
2929 | K(NSAV+1,4)=MSTU(5)*(NSAV+3) | |
2930 | K(NSAV+1,5)=MSTU(5)*(NSAV+3) | |
2931 | K(NSAV+3,4)=MSTU(5)*(NSAV+1) | |
2932 | K(NSAV+3,5)=MSTU(5)*(NSAV+1) | |
2933 | MSTJ(92)=NSAV+1 | |
2934 | ENDIF | |
2935 | ||
2936 | C...Mark decayed particle. | |
2937 | IF(K(IP,1).EQ.5) K(IP,1)=15 | |
2938 | IF(K(IP,1).LE.10) K(IP,1)=11 | |
2939 | K(IP,4)=NSAV+1 | |
2940 | K(IP,5)=N | |
2941 | ||
2942 | RETURN | |
2943 | END | |
2944 | ||
2945 | C********************************************************************* | |
2946 | ||
2947 | SUBROUTINE LUKFDI(KFL1,KFL2,KFL3,KF) | |
2948 | ||
2949 | C...Purpose: to generate a new flavour pair and combine off a hadron. | |
2950 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
2951 | SAVE /LUDAT1A/ | |
2952 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
2953 | SAVE /LUDAT2A/ | |
2954 | ||
2955 | par3m=0. | |
2956 | par4m=0. | |
2957 | pardm=0. | |
2958 | pars0=0. | |
2959 | pars1=0. | |
2960 | pars2=0. | |
2961 | parsm=0. | |
2962 | kmul=0 | |
2963 | ktab3=0 | |
2964 | ||
2965 | C...Default flavour values. Input consistency checks. | |
2966 | KF1A=IABS(KFL1) | |
2967 | KF2A=IABS(KFL2) | |
2968 | KFL3=0 | |
2969 | KF=0 | |
2970 | IF(KF1A.EQ.0) RETURN | |
2971 | IF(KF2A.NE.0) THEN | |
2972 | IF(KF1A.LE.10.AND.KF2A.LE.10.AND.KFL1*KFL2.GT.0) RETURN | |
2973 | IF(KF1A.GT.10.AND.KF2A.GT.10) RETURN | |
2974 | IF((KF1A.GT.10.OR.KF2A.GT.10).AND.KFL1*KFL2.LT.0) RETURN | |
2975 | ENDIF | |
2976 | ||
2977 | C...Check if tabulated flavour probabilities are to be used. | |
2978 | IF(MSTJ(15).EQ.1) THEN | |
2979 | KTAB1=-1 | |
2980 | IF(KF1A.GE.1.AND.KF1A.LE.6) KTAB1=KF1A | |
2981 | KFL1A=MOD(KF1A/1000,10) | |
2982 | KFL1B=MOD(KF1A/100,10) | |
2983 | KFL1S=MOD(KF1A,10) | |
2984 | IF(KFL1A.GE.1.AND.KFL1A.LE.4.AND.KFL1B.GE.1.AND.KFL1B.LE.4) | |
2985 | & KTAB1=6+KFL1A*(KFL1A-2)+2*KFL1B+(KFL1S-1)/2 | |
2986 | IF(KFL1A.GE.1.AND.KFL1A.LE.4.AND.KFL1A.EQ.KFL1B) KTAB1=KTAB1-1 | |
2987 | IF(KF1A.GE.1.AND.KF1A.LE.6) KFL1A=KF1A | |
2988 | KTAB2=0 | |
2989 | IF(KF2A.NE.0) THEN | |
2990 | KTAB2=-1 | |
2991 | IF(KF2A.GE.1.AND.KF2A.LE.6) KTAB2=KF2A | |
2992 | KFL2A=MOD(KF2A/1000,10) | |
2993 | KFL2B=MOD(KF2A/100,10) | |
2994 | KFL2S=MOD(KF2A,10) | |
2995 | IF(KFL2A.GE.1.AND.KFL2A.LE.4.AND.KFL2B.GE.1.AND.KFL2B.LE.4) | |
2996 | & KTAB2=6+KFL2A*(KFL2A-2)+2*KFL2B+(KFL2S-1)/2 | |
2997 | IF(KFL2A.GE.1.AND.KFL2A.LE.4.AND.KFL2A.EQ.KFL2B) KTAB2=KTAB2-1 | |
2998 | ENDIF | |
2999 | IF(KTAB1.GE.0.AND.KTAB2.GE.0) GOTO 140 | |
3000 | ENDIF | |
3001 | ||
3002 | C...Parameters and breaking diquark parameter combinations. | |
3003 | 100 PAR2=PARJ(2) | |
3004 | PAR3=PARJ(3) | |
3005 | PAR4=3.*PARJ(4) | |
3006 | IF(MSTJ(12).GE.2) THEN | |
3007 | PAR3M=SQRT(PARJ(3)) | |
3008 | PAR4M=1./(3.*SQRT(PARJ(4))) | |
3009 | PARDM=PARJ(7)/(PARJ(7)+PAR3M*PARJ(6)) | |
3010 | PARS0=PARJ(5)*(2.+(1.+PAR2*PAR3M*PARJ(7))*(1.+PAR4M)) | |
3011 | PARS1=PARJ(7)*PARS0/(2.*PAR3M)+PARJ(5)*(PARJ(6)*(1.+PAR4M)+ | |
3012 | & PAR2*PAR3M*PARJ(6)*PARJ(7)) | |
3013 | PARS2=PARJ(5)*2.*PARJ(6)*PARJ(7)*(PAR2*PARJ(7)+(1.+PAR4M)/PAR3M) | |
3014 | PARSM=MAX(PARS0,PARS1,PARS2) | |
3015 | PAR4=PAR4*(1.+PARSM)/(1.+PARSM/(3.*PAR4M)) | |
3016 | ENDIF | |
3017 | ||
3018 | C...Choice of whether to generate meson or baryon. | |
3019 | MBARY=0 | |
3020 | KFDA=0 | |
3021 | IF(KF1A.LE.10) THEN | |
3022 | IF(KF2A.EQ.0.AND.MSTJ(12).GE.1.AND.(1.+PARJ(1))*RLU(0).GT.1.) | |
3023 | & MBARY=1 | |
3024 | IF(KF2A.GT.10) MBARY=2 | |
3025 | IF(KF2A.GT.10.AND.KF2A.LE.10000) KFDA=KF2A | |
3026 | ELSE | |
3027 | MBARY=2 | |
3028 | IF(KF1A.LE.10000) KFDA=KF1A | |
3029 | ENDIF | |
3030 | ||
3031 | C...Possibility of process diquark -> meson + new diquark. | |
3032 | IF(KFDA.NE.0.AND.MSTJ(12).GE.2) THEN | |
3033 | KFLDA=MOD(KFDA/1000,10) | |
3034 | KFLDB=MOD(KFDA/100,10) | |
3035 | KFLDS=MOD(KFDA,10) | |
3036 | WTDQ=PARS0 | |
3037 | IF(MAX(KFLDA,KFLDB).EQ.3) WTDQ=PARS1 | |
3038 | IF(MIN(KFLDA,KFLDB).EQ.3) WTDQ=PARS2 | |
3039 | IF(KFLDS.EQ.1) WTDQ=WTDQ/(3.*PAR4M) | |
3040 | IF((1.+WTDQ)*RLU(0).GT.1.) MBARY=-1 | |
3041 | IF(MBARY.EQ.-1.AND.KF2A.NE.0) RETURN | |
3042 | ENDIF | |
3043 | ||
3044 | C...Flavour for meson, possibly with new flavour. | |
3045 | IF(MBARY.LE.0) THEN | |
3046 | KFS=ISIGN(1,KFL1) | |
3047 | IF(MBARY.EQ.0) THEN | |
3048 | IF(KF2A.EQ.0) KFL3=ISIGN(1+INT((2.+PAR2)*RLU(0)),-KFL1) | |
3049 | KFLA=MAX(KF1A,KF2A+IABS(KFL3)) | |
3050 | KFLB=MIN(KF1A,KF2A+IABS(KFL3)) | |
3051 | IF(KFLA.NE.KF1A) KFS=-KFS | |
3052 | ||
3053 | C...Splitting of diquark into meson plus new diquark. | |
3054 | ELSE | |
3055 | KFL1A=MOD(KF1A/1000,10) | |
3056 | KFL1B=MOD(KF1A/100,10) | |
3057 | 110 KFL1D=KFL1A+INT(RLU(0)+0.5)*(KFL1B-KFL1A) | |
3058 | KFL1E=KFL1A+KFL1B-KFL1D | |
3059 | IF((KFL1D.EQ.3.AND.RLU(0).GT.PARDM).OR.(KFL1E.EQ.3.AND. | |
3060 | & RLU(0).LT.PARDM)) THEN | |
3061 | KFL1D=KFL1A+KFL1B-KFL1D | |
3062 | KFL1E=KFL1A+KFL1B-KFL1E | |
3063 | ENDIF | |
3064 | KFL3A=1+INT((2.+PAR2*PAR3M*PARJ(7))*RLU(0)) | |
3065 | IF((KFL1E.NE.KFL3A.AND.RLU(0).GT.(1.+PAR4M)/MAX(2.,1.+PAR4M)). | |
3066 | & OR.(KFL1E.EQ.KFL3A.AND.RLU(0).GT.2./MAX(2.,1.+PAR4M))) | |
3067 | & GOTO 110 | |
3068 | KFLDS=3 | |
3069 | IF(KFL1E.NE.KFL3A) KFLDS=2*INT(RLU(0)+1./(1.+PAR4M))+1 | |
3070 | KFL3=ISIGN(10000+1000*MAX(KFL1E,KFL3A)+100*MIN(KFL1E,KFL3A)+ | |
3071 | & KFLDS,-KFL1) | |
3072 | KFLA=MAX(KFL1D,KFL3A) | |
3073 | KFLB=MIN(KFL1D,KFL3A) | |
3074 | IF(KFLA.NE.KFL1D) KFS=-KFS | |
3075 | ENDIF | |
3076 | ||
3077 | C...Form meson, with spin and flavour mixing for diagonal states. | |
3078 | IF(KFLA.LE.2) KMUL=INT(PARJ(11)+RLU(0)) | |
3079 | IF(KFLA.EQ.3) KMUL=INT(PARJ(12)+RLU(0)) | |
3080 | IF(KFLA.GE.4) KMUL=INT(PARJ(13)+RLU(0)) | |
3081 | IF(KMUL.EQ.0.AND.PARJ(14).GT.0.) THEN | |
3082 | IF(RLU(0).LT.PARJ(14)) KMUL=2 | |
3083 | ELSEIF(KMUL.EQ.1.AND.PARJ(15)+PARJ(16)+PARJ(17).GT.0.) THEN | |
3084 | RMUL=RLU(0) | |
3085 | IF(RMUL.LT.PARJ(15)) KMUL=3 | |
3086 | IF(KMUL.EQ.1.AND.RMUL.LT.PARJ(15)+PARJ(16)) KMUL=4 | |
3087 | IF(KMUL.EQ.1.AND.RMUL.LT.PARJ(15)+PARJ(16)+PARJ(17)) KMUL=5 | |
3088 | ENDIF | |
3089 | KFLS=3 | |
3090 | IF(KMUL.EQ.0.OR.KMUL.EQ.3) KFLS=1 | |
3091 | IF(KMUL.EQ.5) KFLS=5 | |
3092 | IF(KFLA.NE.KFLB) THEN | |
3093 | KF=(100*KFLA+10*KFLB+KFLS)*KFS*(-1)**KFLA | |
3094 | ELSE | |
3095 | RMIX=RLU(0) | |
3096 | IMIX=2*KFLA+10*KMUL | |
3097 | IF(KFLA.LE.3) KF=110*(1+INT(RMIX+PARF(IMIX-1))+ | |
3098 | & INT(RMIX+PARF(IMIX)))+KFLS | |
3099 | IF(KFLA.GE.4) KF=110*KFLA+KFLS | |
3100 | ENDIF | |
3101 | IF(KMUL.EQ.2.OR.KMUL.EQ.3) KF=KF+ISIGN(10000,KF) | |
3102 | IF(KMUL.EQ.4) KF=KF+ISIGN(20000,KF) | |
3103 | ||
3104 | C...Generate diquark flavour. | |
3105 | ELSE | |
3106 | 120 IF(KF1A.LE.10.AND.KF2A.EQ.0) THEN | |
3107 | KFLA=KF1A | |
3108 | 130 KFLB=1+INT((2.+PAR2*PAR3)*RLU(0)) | |
3109 | KFLC=1+INT((2.+PAR2*PAR3)*RLU(0)) | |
3110 | KFLDS=1 | |
3111 | IF(KFLB.GE.KFLC) KFLDS=3 | |
3112 | IF(KFLDS.EQ.1.AND.PAR4*RLU(0).GT.1.) GOTO 130 | |
3113 | IF(KFLDS.EQ.3.AND.PAR4.LT.RLU(0)) GOTO 130 | |
3114 | KFL3=ISIGN(1000*MAX(KFLB,KFLC)+100*MIN(KFLB,KFLC)+KFLDS,KFL1) | |
3115 | ||
3116 | C...Take diquark flavour from input. | |
3117 | ELSEIF(KF1A.LE.10) THEN | |
3118 | KFLA=KF1A | |
3119 | KFLB=MOD(KF2A/1000,10) | |
3120 | KFLC=MOD(KF2A/100,10) | |
3121 | KFLDS=MOD(KF2A,10) | |
3122 | ||
3123 | C...Generate (or take from input) quark to go with diquark. | |
3124 | ELSE | |
3125 | IF(KF2A.EQ.0) KFL3=ISIGN(1+INT((2.+PAR2)*RLU(0)),KFL1) | |
3126 | KFLA=KF2A+IABS(KFL3) | |
3127 | KFLB=MOD(KF1A/1000,10) | |
3128 | KFLC=MOD(KF1A/100,10) | |
3129 | KFLDS=MOD(KF1A,10) | |
3130 | ENDIF | |
3131 | ||
3132 | C...SU(6) factors for formation of baryon. Try again if fails. | |
3133 | KBARY=KFLDS | |
3134 | IF(KFLDS.EQ.3.AND.KFLB.NE.KFLC) KBARY=5 | |
3135 | IF(KFLA.NE.KFLB.AND.KFLA.NE.KFLC) KBARY=KBARY+1 | |
3136 | WT=PARF(60+KBARY)+PARJ(18)*PARF(70+KBARY) | |
3137 | IF(MBARY.EQ.1.AND.MSTJ(12).GE.2) THEN | |
3138 | WTDQ=PARS0 | |
3139 | IF(MAX(KFLB,KFLC).EQ.3) WTDQ=PARS1 | |
3140 | IF(MIN(KFLB,KFLC).EQ.3) WTDQ=PARS2 | |
3141 | IF(KFLDS.EQ.1) WTDQ=WTDQ/(3.*PAR4M) | |
3142 | IF(KFLDS.EQ.1) WT=WT*(1.+WTDQ)/(1.+PARSM/(3.*PAR4M)) | |
3143 | IF(KFLDS.EQ.3) WT=WT*(1.+WTDQ)/(1.+PARSM) | |
3144 | ENDIF | |
3145 | IF(KF2A.EQ.0.AND.WT.LT.RLU(0)) GOTO 120 | |
3146 | ||
3147 | C...Form baryon. Distinguish Lambda- and Sigmalike baryons. | |
3148 | KFLD=MAX(KFLA,KFLB,KFLC) | |
3149 | KFLF=MIN(KFLA,KFLB,KFLC) | |
3150 | KFLE=KFLA+KFLB+KFLC-KFLD-KFLF | |
3151 | KFLS=2 | |
3152 | IF((PARF(60+KBARY)+PARJ(18)*PARF(70+KBARY))*RLU(0).GT. | |
3153 | & PARF(60+KBARY)) KFLS=4 | |
3154 | KFLL=0 | |
3155 | IF(KFLS.EQ.2.AND.KFLD.GT.KFLE.AND.KFLE.GT.KFLF) THEN | |
3156 | IF(KFLDS.EQ.1.AND.KFLA.EQ.KFLD) KFLL=1 | |
3157 | IF(KFLDS.EQ.1.AND.KFLA.NE.KFLD) KFLL=INT(0.25+RLU(0)) | |
3158 | IF(KFLDS.EQ.3.AND.KFLA.NE.KFLD) KFLL=INT(0.75+RLU(0)) | |
3159 | ENDIF | |
3160 | IF(KFLL.EQ.0) KF=ISIGN(1000*KFLD+100*KFLE+10*KFLF+KFLS,KFL1) | |
3161 | IF(KFLL.EQ.1) KF=ISIGN(1000*KFLD+100*KFLF+10*KFLE+KFLS,KFL1) | |
3162 | ENDIF | |
3163 | RETURN | |
3164 | ||
3165 | C...Use tabulated probabilities to select new flavour and hadron. | |
3166 | 140 IF(KTAB2.EQ.0.AND.MSTJ(12).LE.0) THEN | |
3167 | KT3L=1 | |
3168 | KT3U=6 | |
3169 | ELSEIF(KTAB2.EQ.0.AND.KTAB1.GE.7.AND.MSTJ(12).LE.1) THEN | |
3170 | KT3L=1 | |
3171 | KT3U=6 | |
3172 | ELSEIF(KTAB2.EQ.0) THEN | |
3173 | KT3L=1 | |
3174 | KT3U=22 | |
3175 | ELSE | |
3176 | KT3L=KTAB2 | |
3177 | KT3U=KTAB2 | |
3178 | ENDIF | |
3179 | RFL=0. | |
3180 | DO 150 KTS=0,2 | |
3181 | DO 150 KT3=KT3L,KT3U | |
3182 | RFL=RFL+PARF(120+80*KTAB1+25*KTS+KT3) | |
3183 | 150 CONTINUE | |
3184 | RFL=RLU(0)*RFL | |
3185 | DO 160 KTS=0,2 | |
3186 | KTABS=KTS | |
3187 | DO 160 KT3=KT3L,KT3U | |
3188 | KTAB3=KT3 | |
3189 | RFL=RFL-PARF(120+80*KTAB1+25*KTS+KT3) | |
3190 | 160 IF(RFL.LE.0.) GOTO 170 | |
3191 | 170 CONTINUE | |
3192 | ||
3193 | C...Reconstruct flavour of produced quark/diquark. | |
3194 | IF(KTAB3.LE.6) THEN | |
3195 | KFL3A=KTAB3 | |
3196 | KFL3B=0 | |
3197 | KFL3=ISIGN(KFL3A,KFL1*(2*KTAB1-13)) | |
3198 | ELSE | |
3199 | KFL3A=1 | |
3200 | IF(KTAB3.GE.8) KFL3A=2 | |
3201 | IF(KTAB3.GE.11) KFL3A=3 | |
3202 | IF(KTAB3.GE.16) KFL3A=4 | |
3203 | KFL3B=(KTAB3-6-KFL3A*(KFL3A-2))/2 | |
3204 | KFL3=1000*KFL3A+100*KFL3B+1 | |
3205 | IF(KFL3A.EQ.KFL3B.OR.KTAB3.NE.6+KFL3A*(KFL3A-2)+2*KFL3B) KFL3= | |
3206 | & KFL3+2 | |
3207 | KFL3=ISIGN(KFL3,KFL1*(13-2*KTAB1)) | |
3208 | ENDIF | |
3209 | ||
3210 | C...Reconstruct meson code. | |
3211 | IF(KFL3A.EQ.KFL1A.AND.KFL3B.EQ.KFL1B.AND.(KFL3A.LE.3.OR. | |
3212 | &KFL3B.NE.0)) THEN | |
3213 | RFL=RLU(0)*(PARF(143+80*KTAB1+25*KTABS)+PARF(144+80*KTAB1+ | |
3214 | & 25*KTABS)+PARF(145+80*KTAB1+25*KTABS)) | |
3215 | KF=110+2*KTABS+1 | |
3216 | IF(RFL.GT.PARF(143+80*KTAB1+25*KTABS)) KF=220+2*KTABS+1 | |
3217 | IF(RFL.GT.PARF(143+80*KTAB1+25*KTABS)+PARF(144+80*KTAB1+ | |
3218 | & 25*KTABS)) KF=330+2*KTABS+1 | |
3219 | ELSEIF(KTAB1.LE.6.AND.KTAB3.LE.6) THEN | |
3220 | KFLA=MAX(KTAB1,KTAB3) | |
3221 | KFLB=MIN(KTAB1,KTAB3) | |
3222 | KFS=ISIGN(1,KFL1) | |
3223 | IF(KFLA.NE.KF1A) KFS=-KFS | |
3224 | KF=(100*KFLA+10*KFLB+2*KTABS+1)*KFS*(-1)**KFLA | |
3225 | ELSEIF(KTAB1.GE.7.AND.KTAB3.GE.7) THEN | |
3226 | KFS=ISIGN(1,KFL1) | |
3227 | IF(KFL1A.EQ.KFL3A) THEN | |
3228 | KFLA=MAX(KFL1B,KFL3B) | |
3229 | KFLB=MIN(KFL1B,KFL3B) | |
3230 | IF(KFLA.NE.KFL1B) KFS=-KFS | |
3231 | ELSEIF(KFL1A.EQ.KFL3B) THEN | |
3232 | KFLA=KFL3A | |
3233 | KFLB=KFL1B | |
3234 | KFS=-KFS | |
3235 | ELSEIF(KFL1B.EQ.KFL3A) THEN | |
3236 | KFLA=KFL1A | |
3237 | KFLB=KFL3B | |
3238 | ELSEIF(KFL1B.EQ.KFL3B) THEN | |
3239 | KFLA=MAX(KFL1A,KFL3A) | |
3240 | KFLB=MIN(KFL1A,KFL3A) | |
3241 | IF(KFLA.NE.KFL1A) KFS=-KFS | |
3242 | ELSE | |
3243 | CALL LUERRM(2,'(LUKFDI:) no matching flavours for qq -> qq') | |
3244 | GOTO 100 | |
3245 | ENDIF | |
3246 | KF=(100*KFLA+10*KFLB+2*KTABS+1)*KFS*(-1)**KFLA | |
3247 | ||
3248 | C...Reconstruct baryon code. | |
3249 | ELSE | |
3250 | IF(KTAB1.GE.7) THEN | |
3251 | KFLA=KFL3A | |
3252 | KFLB=KFL1A | |
3253 | KFLC=KFL1B | |
3254 | ELSE | |
3255 | KFLA=KFL1A | |
3256 | KFLB=KFL3A | |
3257 | KFLC=KFL3B | |
3258 | ENDIF | |
3259 | KFLD=MAX(KFLA,KFLB,KFLC) | |
3260 | KFLF=MIN(KFLA,KFLB,KFLC) | |
3261 | KFLE=KFLA+KFLB+KFLC-KFLD-KFLF | |
3262 | IF(KTABS.EQ.0) KF=ISIGN(1000*KFLD+100*KFLF+10*KFLE+2,KFL1) | |
3263 | IF(KTABS.GE.1) KF=ISIGN(1000*KFLD+100*KFLE+10*KFLF+2*KTABS,KFL1) | |
3264 | ENDIF | |
3265 | ||
3266 | C...Check that constructed flavour code is an allowed one. | |
3267 | IF(KFL2.NE.0) KFL3=0 | |
3268 | KC=LUCOMP(KF) | |
3269 | IF(KC.EQ.0) THEN | |
3270 | CALL LUERRM(2,'(LUKFDI:) user-defined flavour probabilities '// | |
3271 | & 'failed') | |
3272 | GOTO 100 | |
3273 | ENDIF | |
3274 | ||
3275 | RETURN | |
3276 | END | |
3277 | ||
3278 | C********************************************************************* | |
3279 | ||
3280 | SUBROUTINE LUPTDI(KFL,PX,PY) | |
3281 | ||
3282 | C...Purpose: to generate transverse momentum according to a Gaussian. | |
3283 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
3284 | SAVE /LUDAT1A/ | |
3285 | ||
3286 | C...Generate p_T and azimuthal angle, gives p_x and p_y. | |
3287 | KFLA=IABS(KFL) | |
3288 | PT=PARJ(21)*SQRT(-LOG(MAX(1E-10,RLU(0)))) | |
3289 | IF(MSTJ(91).EQ.1) PT=PARJ(22)*PT | |
3290 | IF(KFLA.EQ.0.AND.MSTJ(13).LE.0) PT=0. | |
3291 | PHI=PARU(2)*RLU(0) | |
3292 | PX=PT*COS(PHI) | |
3293 | PY=PT*SIN(PHI) | |
3294 | ||
3295 | RETURN | |
3296 | END | |
3297 | ||
3298 | C********************************************************************* | |
3299 | ||
3300 | SUBROUTINE LUZDIS(KFL1,KFL2,PR,Z) | |
3301 | ||
3302 | C...Purpose: to generate the longitudinal splitting variable z. | |
3303 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
3304 | SAVE /LUDAT1A/ | |
3305 | ||
3306 | zdiv=0. | |
3307 | fint=0. | |
3308 | zdivc=0. | |
3309 | ||
3310 | C...Check if heavy flavour fragmentation. | |
3311 | KFLA=IABS(KFL1) | |
3312 | KFLB=IABS(KFL2) | |
3313 | KFLH=KFLA | |
3314 | IF(KFLA.GE.10) KFLH=MOD(KFLA/1000,10) | |
3315 | ||
3316 | C...Lund symmetric scaling function: determine parameters of shape. | |
3317 | IF(MSTJ(11).EQ.1.OR.(MSTJ(11).EQ.3.AND.KFLH.LE.3)) THEN | |
3318 | FA=PARJ(41) | |
3319 | IF(MSTJ(91).EQ.1) FA=PARJ(43) | |
3320 | IF(KFLB.GE.10) FA=FA+PARJ(45) | |
3321 | FB=PARJ(42)*PR | |
3322 | IF(MSTJ(91).EQ.1) FB=PARJ(44)*PR | |
3323 | FC=1. | |
3324 | IF(KFLA.GE.10) FC=FC-PARJ(45) | |
3325 | IF(KFLB.GE.10) FC=FC+PARJ(45) | |
3326 | MC=1 | |
3327 | IF(ABS(FC-1.).GT.0.01) MC=2 | |
3328 | ||
3329 | C...Determine position of maximum. Special cases for a = 0 or a = c. | |
3330 | IF(FA.LT.0.02) THEN | |
3331 | MA=1 | |
3332 | ZMAX=1. | |
3333 | IF(FC.GT.FB) ZMAX=FB/FC | |
3334 | ELSEIF(ABS(FC-FA).LT.0.01) THEN | |
3335 | MA=2 | |
3336 | ZMAX=FB/(FB+FC) | |
3337 | ELSE | |
3338 | MA=3 | |
3339 | ZMAX=0.5*(FB+FC-SQRT((FB-FC)**2+4.*FA*FB))/(FC-FA) | |
3340 | IF(ZMAX.GT.0.99.AND.FB.GT.100.) ZMAX=1.-FA/FB | |
3341 | ENDIF | |
3342 | ||
3343 | C...Subdivide z range if distribution very peaked near endpoint. | |
3344 | MMAX=2 | |
3345 | IF(ZMAX.LT.0.1) THEN | |
3346 | MMAX=1 | |
3347 | ZDIV=2.75*ZMAX | |
3348 | IF(MC.EQ.1) THEN | |
3349 | FINT=1.-LOG(ZDIV) | |
3350 | ELSE | |
3351 | ZDIVC=ZDIV**(1.-FC) | |
3352 | FINT=1.+(1.-1./ZDIVC)/(FC-1.) | |
3353 | ENDIF | |
3354 | ELSEIF(ZMAX.GT.0.85.AND.FB.GT.1.) THEN | |
3355 | MMAX=3 | |
3356 | FSCB=SQRT(4.+(FC/FB)**2) | |
3357 | ZDIV=FSCB-1./ZMAX-(FC/FB)*LOG(ZMAX*0.5*(FSCB+FC/FB)) | |
3358 | IF(MA.GE.2) ZDIV=ZDIV+(FA/FB)*LOG(1.-ZMAX) | |
3359 | ZDIV=MIN(ZMAX,MAX(0.,ZDIV)) | |
3360 | FINT=1.+FB*(1.-ZDIV) | |
3361 | ENDIF | |
3362 | ||
3363 | C...Choice of z, preweighted for peaks at low or high z. | |
3364 | 100 Z=RLU(0) | |
3365 | FPRE=1. | |
3366 | IF(MMAX.EQ.1) THEN | |
3367 | IF(FINT*RLU(0).LE.1.) THEN | |
3368 | Z=ZDIV*Z | |
3369 | ELSEIF(MC.EQ.1) THEN | |
3370 | Z=ZDIV**Z | |
3371 | FPRE=ZDIV/Z | |
3372 | ELSE | |
3373 | Z=1./(ZDIVC+Z*(1.-ZDIVC))**(1./(1.-FC)) | |
3374 | FPRE=(ZDIV/Z)**FC | |
3375 | ENDIF | |
3376 | ELSEIF(MMAX.EQ.3) THEN | |
3377 | IF(FINT*RLU(0).LE.1.) THEN | |
3378 | Z=ZDIV+LOG(Z)/FB | |
3379 | FPRE=EXP(FB*(Z-ZDIV)) | |
3380 | ELSE | |
3381 | Z=ZDIV+Z*(1.-ZDIV) | |
3382 | ENDIF | |
3383 | ENDIF | |
3384 | ||
3385 | C...Weighting according to correct formula. | |
3386 | IF(Z.LE.FB/(50.+FB).OR.Z.GE.1.) GOTO 100 | |
3387 | FVAL=(ZMAX/Z)**FC*EXP(FB*(1./ZMAX-1./Z)) | |
3388 | IF(MA.GE.2) FVAL=((1.-Z)/(1.-ZMAX))**FA*FVAL | |
3389 | IF(FVAL.LT.RLU(0)*FPRE) GOTO 100 | |
3390 | ||
3391 | C...Generate z according to Field-Feynman, SLAC, (1-z)**c OR z**c. | |
3392 | ELSE | |
3393 | FC=PARJ(50+MAX(1,KFLH)) | |
3394 | IF(MSTJ(91).EQ.1) FC=PARJ(59) | |
3395 | 110 Z=RLU(0) | |
3396 | IF(FC.GE.0..AND.FC.LE.1.) THEN | |
3397 | IF(FC.GT.RLU(0)) Z=1.-Z**(1./3.) | |
3398 | ELSEIF(FC.GT.-1.) THEN | |
3399 | IF(-4.*FC*Z*(1.-Z)**2.LT.RLU(0)*((1.-Z)**2-FC*Z)**2) GOTO 110 | |
3400 | ELSE | |
3401 | IF(FC.GT.0.) Z=1.-Z**(1./FC) | |
3402 | IF(FC.LT.0.) Z=Z**(-1./FC) | |
3403 | ENDIF | |
3404 | ENDIF | |
3405 | ||
3406 | RETURN | |
3407 | END | |
3408 | ||
3409 | C********************************************************************* | |
3410 | ||
3411 | SUBROUTINE LUSHOW(IP1,IP2,QMAX) | |
3412 | ||
3413 | C...Purpose: to generate timelike parton showers from given partons. | |
3414 | IMPLICIT DOUBLE PRECISION(D) | |
3415 | COMMON/LUJETSA/N,K(9000,5),P(9000,5),V(9000,5) | |
3416 | SAVE /LUJETSA/ | |
3417 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
3418 | SAVE /LUDAT1A/ | |
3419 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
3420 | SAVE /LUDAT2A/ | |
3421 | DIMENSION PMTH(5,40),PS(5),PMA(4),PMSD(4),IEP(4),IPA(4), | |
3422 | &KFLA(4),KFLD(4),KFL(4),ITRY(4),ISI(4),ISL(4),DP(4),DPT(5,4) | |
3423 | ||
3424 | npa=0 | |
3425 | kflm=0 | |
3426 | pem=0. | |
3427 | pmed=0. | |
3428 | fbre=0. | |
3429 | pm2=0. | |
3430 | ped=0. | |
3431 | zm=0. | |
3432 | pa1s=0. | |
3433 | pa2s=0. | |
3434 | pa3s=0. | |
3435 | pts=0. | |
3436 | pzm=0. | |
3437 | pmls=0. | |
3438 | pt=0. | |
3439 | hazip=0. | |
3440 | hazic=0. | |
3441 | ||
3442 | C...Initialization of cutoff masses etc. | |
3443 | IF(MSTJ(41).LE.0.OR.(MSTJ(41).EQ.1.AND.QMAX.LE.PARJ(82)).OR. | |
3444 | &QMAX.LE.MIN(PARJ(82),PARJ(83)).OR.MSTJ(41).GE.3) RETURN | |
3445 | PMTH(1,21)=ULMASS(21) | |
3446 | PMTH(2,21)=SQRT(PMTH(1,21)**2+0.25*PARJ(82)**2) | |
3447 | PMTH(3,21)=2.*PMTH(2,21) | |
3448 | PMTH(4,21)=PMTH(3,21) | |
3449 | PMTH(5,21)=PMTH(3,21) | |
3450 | PMTH(1,22)=ULMASS(22) | |
3451 | PMTH(2,22)=SQRT(PMTH(1,22)**2+0.25*PARJ(83)**2) | |
3452 | PMTH(3,22)=2.*PMTH(2,22) | |
3453 | PMTH(4,22)=PMTH(3,22) | |
3454 | PMTH(5,22)=PMTH(3,22) | |
3455 | PMQTH1=PARJ(82) | |
3456 | IF(MSTJ(41).EQ.2) PMQTH1=MIN(PARJ(82),PARJ(83)) | |
3457 | PMQTH2=PMTH(2,21) | |
3458 | IF(MSTJ(41).EQ.2) PMQTH2=MIN(PMTH(2,21),PMTH(2,22)) | |
3459 | DO 100 IF=1,8 | |
3460 | PMTH(1,IF)=ULMASS(IF) | |
3461 | PMTH(2,IF)=SQRT(PMTH(1,IF)**2+0.25*PMQTH1**2) | |
3462 | PMTH(3,IF)=PMTH(2,IF)+PMQTH2 | |
3463 | PMTH(4,IF)=SQRT(PMTH(1,IF)**2+0.25*PARJ(82)**2)+PMTH(2,21) | |
3464 | 100 PMTH(5,IF)=SQRT(PMTH(1,IF)**2+0.25*PARJ(83)**2)+PMTH(2,22) | |
3465 | PT2MIN=MAX(0.5*PARJ(82),1.1*PARJ(81))**2 | |
3466 | ALAMS=PARJ(81)**2 | |
3467 | ALFM=LOG(PT2MIN/ALAMS) | |
3468 | ||
3469 | C...Store positions of shower initiating partons. | |
3470 | M3JC=0 | |
3471 | IF(IP1.GT.0.AND.IP1.LE.MIN(N,MSTU(4)-MSTU(32)).AND.IP2.EQ.0) THEN | |
3472 | NPA=1 | |
3473 | IPA(1)=IP1 | |
3474 | ELSEIF(MIN(IP1,IP2).GT.0.AND.MAX(IP1,IP2).LE.MIN(N,MSTU(4)- | |
3475 | &MSTU(32))) THEN | |
3476 | NPA=2 | |
3477 | IPA(1)=IP1 | |
3478 | IPA(2)=IP2 | |
3479 | ELSEIF(IP1.GT.0.AND.IP1.LE.MIN(N,MSTU(4)-MSTU(32)).AND.IP2.LT.0. | |
3480 | &AND.IP2.GE.-3) THEN | |
3481 | NPA=IABS(IP2) | |
3482 | DO 110 I=1,NPA | |
3483 | 110 IPA(I)=IP1+I-1 | |
3484 | ELSE | |
3485 | CALL LUERRM(12, | |
3486 | & '(LUSHOW:) failed to reconstruct showering system') | |
3487 | IF(MSTU(21).GE.1) RETURN | |
3488 | ENDIF | |
3489 | ||
3490 | C...Check on phase space available for emission. | |
3491 | IREJ=0 | |
3492 | DO 120 J=1,5 | |
3493 | 120 PS(J)=0. | |
3494 | PM=0. | |
3495 | DO 130 I=1,NPA | |
3496 | KFLA(I)=IABS(K(IPA(I),2)) | |
3497 | PMA(I)=P(IPA(I),5) | |
3498 | IF(KFLA(I).NE.0.AND.(KFLA(I).LE.8.OR.KFLA(I).EQ.21)) | |
3499 | &PMA(I)=PMTH(3,KFLA(I)) | |
3500 | PM=PM+PMA(I) | |
3501 | IF(KFLA(I).EQ.0.OR.(KFLA(I).GT.8.AND.KFLA(I).NE.21).OR. | |
3502 | &PMA(I).GT.QMAX) IREJ=IREJ+1 | |
3503 | DO 130 J=1,4 | |
3504 | 130 PS(J)=PS(J)+P(IPA(I),J) | |
3505 | IF(IREJ.EQ.NPA) RETURN | |
3506 | PS(5)=SQRT(MAX(0.,PS(4)**2-PS(1)**2-PS(2)**2-PS(3)**2)) | |
3507 | IF(NPA.EQ.1) PS(5)=PS(4) | |
3508 | IF(PS(5).LE.PM+PMQTH1) RETURN | |
3509 | IF(NPA.EQ.2.AND.MSTJ(47).GE.1) THEN | |
3510 | IF(KFLA(1).GE.1.AND.KFLA(1).LE.8.AND.KFLA(2).GE.1.AND. | |
3511 | & KFLA(2).LE.8) M3JC=1 | |
3512 | IF(MSTJ(47).GE.2) M3JC=1 | |
3513 | ENDIF | |
3514 | ||
3515 | C...Define imagined single initiator of shower for parton system. | |
3516 | NS=N | |
3517 | IF(N.GT.MSTU(4)-MSTU(32)-5) THEN | |
3518 | CALL LUERRM(11,'(LUSHOW:) no more memory left in LUJETSA') | |
3519 | IF(MSTU(21).GE.1) RETURN | |
3520 | ENDIF | |
3521 | IF(NPA.GE.2) THEN | |
3522 | K(N+1,1)=11 | |
3523 | K(N+1,2)=21 | |
3524 | K(N+1,3)=0 | |
3525 | K(N+1,4)=0 | |
3526 | K(N+1,5)=0 | |
3527 | P(N+1,1)=0. | |
3528 | P(N+1,2)=0. | |
3529 | P(N+1,3)=0. | |
3530 | P(N+1,4)=PS(5) | |
3531 | P(N+1,5)=PS(5) | |
3532 | V(N+1,5)=PS(5)**2 | |
3533 | N=N+1 | |
3534 | ENDIF | |
3535 | ||
3536 | C...Loop over partons that may branch. | |
3537 | NEP=NPA | |
3538 | IM=NS | |
3539 | IF(NPA.EQ.1) IM=NS-1 | |
3540 | 140 IM=IM+1 | |
3541 | IF(N.GT.NS) THEN | |
3542 | IF(IM.GT.N) GOTO 380 | |
3543 | KFLM=IABS(K(IM,2)) | |
3544 | IF(KFLM.EQ.0.OR.(KFLM.GT.8.AND.KFLM.NE.21)) GOTO 140 | |
3545 | IF(P(IM,5).LT.PMTH(2,KFLM)) GOTO 140 | |
3546 | IGM=K(IM,3) | |
3547 | ELSE | |
3548 | IGM=-1 | |
3549 | ENDIF | |
3550 | IF(N+NEP.GT.MSTU(4)-MSTU(32)-5) THEN | |
3551 | CALL LUERRM(11,'(LUSHOW:) no more memory left in LUJETSA') | |
3552 | IF(MSTU(21).GE.1) RETURN | |
3553 | ENDIF | |
3554 | ||
3555 | C...Position of aunt (sister to branching parton). | |
3556 | C...Origin and flavour of daughters. | |
3557 | IAU=0 | |
3558 | IF(IGM.GT.0) THEN | |
3559 | IF(K(IM-1,3).EQ.IGM) IAU=IM-1 | |
3560 | IF(N.GE.IM+1.AND.K(IM+1,3).EQ.IGM) IAU=IM+1 | |
3561 | ENDIF | |
3562 | IF(IGM.GE.0) THEN | |
3563 | K(IM,4)=N+1 | |
3564 | DO 150 I=1,NEP | |
3565 | 150 K(N+I,3)=IM | |
3566 | ELSE | |
3567 | K(N+1,3)=IPA(1) | |
3568 | ENDIF | |
3569 | IF(IGM.LE.0) THEN | |
3570 | DO 160 I=1,NEP | |
3571 | 160 K(N+I,2)=K(IPA(I),2) | |
3572 | ELSEIF(KFLM.NE.21) THEN | |
3573 | K(N+1,2)=K(IM,2) | |
3574 | K(N+2,2)=K(IM,5) | |
3575 | ELSEIF(K(IM,5).EQ.21) THEN | |
3576 | K(N+1,2)=21 | |
3577 | K(N+2,2)=21 | |
3578 | ELSE | |
3579 | K(N+1,2)=K(IM,5) | |
3580 | K(N+2,2)=-K(IM,5) | |
3581 | ENDIF | |
3582 | ||
3583 | C...Reset flags on daughers and tries made. | |
3584 | DO 170 IP=1,NEP | |
3585 | K(N+IP,1)=3 | |
3586 | K(N+IP,4)=0 | |
3587 | K(N+IP,5)=0 | |
3588 | KFLD(IP)=IABS(K(N+IP,2)) | |
3589 | ITRY(IP)=0 | |
3590 | ISL(IP)=0 | |
3591 | ISI(IP)=0 | |
3592 | 170 IF(KFLD(IP).GT.0.AND.(KFLD(IP).LE.8.OR.KFLD(IP).EQ.21)) ISI(IP)=1 | |
3593 | ISLM=0 | |
3594 | ||
3595 | C...Maximum virtuality of daughters. | |
3596 | IF(IGM.LE.0) THEN | |
3597 | DO 180 I=1,NPA | |
3598 | IF(NPA.GE.3) P(N+I,4)=(PS(4)*P(IPA(I),4)-PS(1)*P(IPA(I),1)- | |
3599 | & PS(2)*P(IPA(I),2)-PS(3)*P(IPA(I),3))/PS(5) | |
3600 | P(N+I,5)=MIN(QMAX,PS(5)) | |
3601 | IF(NPA.GE.3) P(N+I,5)=MIN(P(N+I,5),P(N+I,4)) | |
3602 | 180 IF(ISI(I).EQ.0) P(N+I,5)=P(IPA(I),5) | |
3603 | ELSE | |
3604 | IF(MSTJ(43).LE.2) PEM=V(IM,2) | |
3605 | IF(MSTJ(43).GE.3) PEM=P(IM,4) | |
3606 | P(N+1,5)=MIN(P(IM,5),V(IM,1)*PEM) | |
3607 | P(N+2,5)=MIN(P(IM,5),(1.-V(IM,1))*PEM) | |
3608 | IF(K(N+2,2).EQ.22) P(N+2,5)=PMTH(1,22) | |
3609 | ENDIF | |
3610 | DO 190 I=1,NEP | |
3611 | PMSD(I)=P(N+I,5) | |
3612 | IF(ISI(I).EQ.1) THEN | |
3613 | IF(P(N+I,5).LE.PMTH(3,KFLD(I))) P(N+I,5)=PMTH(1,KFLD(I)) | |
3614 | ENDIF | |
3615 | 190 V(N+I,5)=P(N+I,5)**2 | |
3616 | ||
3617 | C...Choose one of the daughters for evolution. | |
3618 | 200 INUM=0 | |
3619 | IF(NEP.EQ.1) INUM=1 | |
3620 | DO 210 I=1,NEP | |
3621 | 210 IF(INUM.EQ.0.AND.ISL(I).EQ.1) INUM=I | |
3622 | DO 220 I=1,NEP | |
3623 | IF(INUM.EQ.0.AND.ITRY(I).EQ.0.AND.ISI(I).EQ.1) THEN | |
3624 | IF(P(N+I,5).GE.PMTH(2,KFLD(I))) INUM=I | |
3625 | ENDIF | |
3626 | 220 CONTINUE | |
3627 | IF(INUM.EQ.0) THEN | |
3628 | RMAX=0. | |
3629 | DO 230 I=1,NEP | |
3630 | IF(ISI(I).EQ.1.AND.PMSD(I).GE.PMQTH2) THEN | |
3631 | RPM=P(N+I,5)/PMSD(I) | |
3632 | IF(RPM.GT.RMAX.AND.P(N+I,5).GE.PMTH(2,KFLD(I))) THEN | |
3633 | RMAX=RPM | |
3634 | INUM=I | |
3635 | ENDIF | |
3636 | ENDIF | |
3637 | 230 CONTINUE | |
3638 | ENDIF | |
3639 | ||
3640 | C...Store information on choice of evolving daughter. | |
3641 | INUM=MAX(1,INUM) | |
3642 | IEP(1)=N+INUM | |
3643 | DO 240 I=2,NEP | |
3644 | IEP(I)=IEP(I-1)+1 | |
3645 | 240 IF(IEP(I).GT.N+NEP) IEP(I)=N+1 | |
3646 | DO 250 I=1,NEP | |
3647 | 250 KFL(I)=IABS(K(IEP(I),2)) | |
3648 | ITRY(INUM)=ITRY(INUM)+1 | |
3649 | IF(ITRY(INUM).GT.200) THEN | |
3650 | CALL LUERRM(14,'(LUSHOW:) caught in infinite loop') | |
3651 | IF(MSTU(21).GE.1) RETURN | |
3652 | ENDIF | |
3653 | Z=0.5 | |
3654 | IF(KFL(1).EQ.0.OR.(KFL(1).GT.8.AND.KFL(1).NE.21)) GOTO 300 | |
3655 | IF(P(IEP(1),5).LT.PMTH(2,KFL(1))) GOTO 300 | |
3656 | ||
3657 | C...Calculate allowed z range. | |
3658 | IF(NEP.EQ.1) THEN | |
3659 | PMED=PS(4) | |
3660 | ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN | |
3661 | PMED=P(IM,5) | |
3662 | ELSE | |
3663 | IF(INUM.EQ.1) PMED=V(IM,1)*PEM | |
3664 | IF(INUM.EQ.2) PMED=(1.-V(IM,1))*PEM | |
3665 | ENDIF | |
3666 | IF(MOD(MSTJ(43),2).EQ.1) THEN | |
3667 | ZC=PMTH(2,21)/PMED | |
3668 | ZCE=PMTH(2,22)/PMED | |
3669 | ELSE | |
3670 | ZC=0.5*(1.-SQRT(MAX(0.,1.-(2.*PMTH(2,21)/PMED)**2))) | |
3671 | IF(ZC.LT.1E-4) ZC=(PMTH(2,21)/PMED)**2 | |
3672 | ZCE=0.5*(1.-SQRT(MAX(0.,1.-(2.*PMTH(2,22)/PMED)**2))) | |
3673 | IF(ZCE.LT.1E-4) ZCE=(PMTH(2,22)/PMED)**2 | |
3674 | ENDIF | |
3675 | ZC=MIN(ZC,0.491) | |
3676 | ZCE=MIN(ZCE,0.491) | |
3677 | IF((MSTJ(41).EQ.1.AND.ZC.GT.0.49).OR.(MSTJ(41).EQ.2.AND. | |
3678 | &MIN(ZC,ZCE).GT.0.49)) THEN | |
3679 | P(IEP(1),5)=PMTH(1,KFL(1)) | |
3680 | V(IEP(1),5)=P(IEP(1),5)**2 | |
3681 | GOTO 300 | |
3682 | ENDIF | |
3683 | ||
3684 | C...Integral of Altarelli-Parisi z kernel for QCD. | |
3685 | IF(MSTJ(49).EQ.0.AND.KFL(1).EQ.21) THEN | |
3686 | FBR=6.*LOG((1.-ZC)/ZC)+MSTJ(45)*(0.5-ZC) | |
3687 | ELSEIF(MSTJ(49).EQ.0) THEN | |
3688 | FBR=(8./3.)*LOG((1.-ZC)/ZC) | |
3689 | ||
3690 | C...Integral of Altarelli-Parisi z kernel for scalar gluon. | |
3691 | ELSEIF(MSTJ(49).EQ.1.AND.KFL(1).EQ.21) THEN | |
3692 | FBR=(PARJ(87)+MSTJ(45)*PARJ(88))*(1.-2.*ZC) | |
3693 | ELSEIF(MSTJ(49).EQ.1) THEN | |
3694 | FBR=(1.-2.*ZC)/3. | |
3695 | IF(IGM.EQ.0.AND.M3JC.EQ.1) FBR=4.*FBR | |
3696 | ||
3697 | C...Integral of Altarelli-Parisi z kernel for Abelian vector gluon. | |
3698 | ELSEIF(KFL(1).EQ.21) THEN | |
3699 | FBR=6.*MSTJ(45)*(0.5-ZC) | |
3700 | ELSE | |
3701 | FBR=2.*LOG((1.-ZC)/ZC) | |
3702 | ENDIF | |
3703 | ||
3704 | C...Integral of Altarelli-Parisi kernel for photon emission. | |
3705 | IF(MSTJ(41).EQ.2.AND.KFL(1).GE.1.AND.KFL(1).LE.8) | |
3706 | &FBRE=(KCHG(KFL(1),1)/3.)**2*2.*LOG((1.-ZCE)/ZCE) | |
3707 | ||
3708 | C...Inner veto algorithm starts. Find maximum mass for evolution. | |
3709 | 260 PMS=V(IEP(1),5) | |
3710 | IF(IGM.GE.0) THEN | |
3711 | PM2=0. | |
3712 | DO 270 I=2,NEP | |
3713 | PM=P(IEP(I),5) | |
3714 | IF(KFL(I).GT.0.AND.(KFL(I).LE.8.OR.KFL(I).EQ.21)) PM= | |
3715 | & PMTH(2,KFL(I)) | |
3716 | 270 PM2=PM2+PM | |
3717 | PMS=MIN(PMS,(P(IM,5)-PM2)**2) | |
3718 | ENDIF | |
3719 | ||
3720 | C...Select mass for daughter in QCD evolution. | |
3721 | B0=27./6. | |
3722 | DO 280 IF=4,MSTJ(45) | |
3723 | 280 IF(PMS.GT.4.*PMTH(2,IF)**2) B0=(33.-2.*IF)/6. | |
3724 | IF(MSTJ(44).LE.0) THEN | |
3725 | PMSQCD=PMS*EXP(MAX(-100.,LOG(RLU(0))*PARU(2)/(PARU(111)*FBR))) | |
3726 | ELSEIF(MSTJ(44).EQ.1) THEN | |
3727 | PMSQCD=4.*ALAMS*(0.25*PMS/ALAMS)**(RLU(0)**(B0/FBR)) | |
3728 | ELSE | |
3729 | PMSQCD=PMS*RLU(0)**(ALFM*B0/FBR) | |
3730 | ENDIF | |
3731 | IF(ZC.GT.0.49.OR.PMSQCD.LE.PMTH(4,KFL(1))**2) PMSQCD= | |
3732 | &PMTH(2,KFL(1))**2 | |
3733 | V(IEP(1),5)=PMSQCD | |
3734 | MCE=1 | |
3735 | ||
3736 | C...Select mass for daughter in QED evolution. | |
3737 | IF(MSTJ(41).EQ.2.AND.KFL(1).GE.1.AND.KFL(1).LE.8) THEN | |
3738 | PMSQED=PMS*EXP(MAX(-100.,LOG(RLU(0))*PARU(2)/(PARU(101)*FBRE))) | |
3739 | IF(ZCE.GT.0.49.OR.PMSQED.LE.PMTH(5,KFL(1))**2) PMSQED= | |
3740 | & PMTH(2,KFL(1))**2 | |
3741 | IF(PMSQED.GT.PMSQCD) THEN | |
3742 | V(IEP(1),5)=PMSQED | |
3743 | MCE=2 | |
3744 | ENDIF | |
3745 | ENDIF | |
3746 | ||
3747 | C...Check whether daughter mass below cutoff. | |
3748 | P(IEP(1),5)=SQRT(V(IEP(1),5)) | |
3749 | IF(P(IEP(1),5).LE.PMTH(3,KFL(1))) THEN | |
3750 | P(IEP(1),5)=PMTH(1,KFL(1)) | |
3751 | V(IEP(1),5)=P(IEP(1),5)**2 | |
3752 | GOTO 300 | |
3753 | ENDIF | |
3754 | ||
3755 | C...Select z value of branching: q -> qgamma. | |
3756 | IF(MCE.EQ.2) THEN | |
3757 | Z=1.-(1.-ZCE)*(ZCE/(1.-ZCE))**RLU(0) | |
3758 | IF(1.+Z**2.LT.2.*RLU(0)) GOTO 260 | |
3759 | K(IEP(1),5)=22 | |
3760 | ||
3761 | C...Select z value of branching: q -> qg, g -> gg, g -> qqbar. | |
3762 | ELSEIF(MSTJ(49).NE.1.AND.KFL(1).NE.21) THEN | |
3763 | Z=1.-(1.-ZC)*(ZC/(1.-ZC))**RLU(0) | |
3764 | IF(1.+Z**2.LT.2.*RLU(0)) GOTO 260 | |
3765 | K(IEP(1),5)=21 | |
3766 | ELSEIF(MSTJ(49).EQ.0.AND.MSTJ(45)*(0.5-ZC).LT.RLU(0)*FBR) THEN | |
3767 | Z=(1.-ZC)*(ZC/(1.-ZC))**RLU(0) | |
3768 | IF(RLU(0).GT.0.5) Z=1.-Z | |
3769 | IF((1.-Z*(1.-Z))**2.LT.RLU(0)) GOTO 260 | |
3770 | K(IEP(1),5)=21 | |
3771 | ELSEIF(MSTJ(49).NE.1) THEN | |
3772 | Z=ZC+(1.-2.*ZC)*RLU(0) | |
3773 | IF(Z**2+(1.-Z)**2.LT.RLU(0)) GOTO 260 | |
3774 | KFLB=1+INT(MSTJ(45)*RLU(0)) | |
3775 | PMQ=4.*PMTH(2,KFLB)**2/V(IEP(1),5) | |
3776 | IF(PMQ.GE.1.) GOTO 260 | |
3777 | PMQ0=4.*PMTH(2,21)**2/V(IEP(1),5) | |
3778 | IF(MOD(MSTJ(43),2).EQ.0.AND.(1.+0.5*PMQ)*SQRT(1.-PMQ).LT. | |
3779 | & RLU(0)*(1.+0.5*PMQ0)*SQRT(1.-PMQ0)) GOTO 260 | |
3780 | K(IEP(1),5)=KFLB | |
3781 | ||
3782 | C...Ditto for scalar gluon model. | |
3783 | ELSEIF(KFL(1).NE.21) THEN | |
3784 | Z=1.-SQRT(ZC**2+RLU(0)*(1.-2.*ZC)) | |
3785 | K(IEP(1),5)=21 | |
3786 | ELSEIF(RLU(0)*(PARJ(87)+MSTJ(45)*PARJ(88)).LE.PARJ(87)) THEN | |
3787 | Z=ZC+(1.-2.*ZC)*RLU(0) | |
3788 | K(IEP(1),5)=21 | |
3789 | ELSE | |
3790 | Z=ZC+(1.-2.*ZC)*RLU(0) | |
3791 | KFLB=1+INT(MSTJ(45)*RLU(0)) | |
3792 | PMQ=4.*PMTH(2,KFLB)**2/V(IEP(1),5) | |
3793 | IF(PMQ.GE.1.) GOTO 260 | |
3794 | K(IEP(1),5)=KFLB | |
3795 | ENDIF | |
3796 | IF(MCE.EQ.1.AND.MSTJ(44).GE.2) THEN | |
3797 | IF(Z*(1.-Z)*V(IEP(1),5).LT.PT2MIN) GOTO 260 | |
3798 | IF(ALFM/LOG(V(IEP(1),5)*Z*(1.-Z)/ALAMS).LT.RLU(0)) GOTO 260 | |
3799 | ENDIF | |
3800 | ||
3801 | C...Check if z consistent with chosen m. | |
3802 | IF(KFL(1).EQ.21) THEN | |
3803 | KFLGD1=IABS(K(IEP(1),5)) | |
3804 | KFLGD2=KFLGD1 | |
3805 | ELSE | |
3806 | KFLGD1=KFL(1) | |
3807 | KFLGD2=IABS(K(IEP(1),5)) | |
3808 | ENDIF | |
3809 | IF(NEP.EQ.1) THEN | |
3810 | PED=PS(4) | |
3811 | ELSEIF(NEP.GE.3) THEN | |
3812 | PED=P(IEP(1),4) | |
3813 | ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN | |
3814 | PED=0.5*(V(IM,5)+V(IEP(1),5)-PM2**2)/P(IM,5) | |
3815 | ELSE | |
3816 | IF(IEP(1).EQ.N+1) PED=V(IM,1)*PEM | |
3817 | IF(IEP(1).EQ.N+2) PED=(1.-V(IM,1))*PEM | |
3818 | ENDIF | |
3819 | IF(MOD(MSTJ(43),2).EQ.1) THEN | |
3820 | PMQTH3=0.5*PARJ(82) | |
3821 | IF(KFLGD2.EQ.22) PMQTH3=0.5*PARJ(83) | |
3822 | PMQ1=(PMTH(1,KFLGD1)**2+PMQTH3**2)/V(IEP(1),5) | |
3823 | PMQ2=(PMTH(1,KFLGD2)**2+PMQTH3**2)/V(IEP(1),5) | |
3824 | ZD=SQRT(MAX(0.,(1.-V(IEP(1),5)/PED**2)*((1.-PMQ1-PMQ2)**2- | |
3825 | & 4.*PMQ1*PMQ2))) | |
3826 | ZH=1.+PMQ1-PMQ2 | |
3827 | ELSE | |
3828 | ZD=SQRT(MAX(0.,1.-V(IEP(1),5)/PED**2)) | |
3829 | ZH=1. | |
3830 | ENDIF | |
3831 | ZL=0.5*(ZH-ZD) | |
3832 | ZU=0.5*(ZH+ZD) | |
3833 | IF(Z.LT.ZL.OR.Z.GT.ZU) GOTO 260 | |
3834 | IF(KFL(1).EQ.21) V(IEP(1),3)=LOG(ZU*(1.-ZL)/MAX(1E-20,ZL* | |
3835 | &(1.-ZU))) | |
3836 | IF(KFL(1).NE.21) V(IEP(1),3)=LOG((1.-ZL)/MAX(1E-10,1.-ZU)) | |
3837 | ||
3838 | C...Three-jet matrix element correction. | |
3839 | IF(IGM.EQ.0.AND.M3JC.EQ.1) THEN | |
3840 | X1=Z*(1.+V(IEP(1),5)/V(NS+1,5)) | |
3841 | X2=1.-V(IEP(1),5)/V(NS+1,5) | |
3842 | X3=(1.-X1)+(1.-X2) | |
3843 | IF(MCE.EQ.2) THEN | |
3844 | KI1=K(IPA(INUM),2) | |
3845 | KI2=K(IPA(3-INUM),2) | |
3846 | QF1=KCHG(IABS(KI1),1)*ISIGN(1,KI1)/3. | |
3847 | QF2=KCHG(IABS(KI2),1)*ISIGN(1,KI2)/3. | |
3848 | WSHOW=QF1**2*(1.-X1)/X3*(1.+(X1/(2.-X2))**2)+ | |
3849 | & QF2**2*(1.-X2)/X3*(1.+(X2/(2.-X1))**2) | |
3850 | WME=(QF1*(1.-X1)/X3-QF2*(1.-X2)/X3)**2*(X1**2+X2**2) | |
3851 | ELSEIF(MSTJ(49).NE.1) THEN | |
3852 | WSHOW=1.+(1.-X1)/X3*(X1/(2.-X2))**2+ | |
3853 | & (1.-X2)/X3*(X2/(2.-X1))**2 | |
3854 | WME=X1**2+X2**2 | |
3855 | ELSE | |
3856 | WSHOW=4.*X3*((1.-X1)/(2.-X2)**2+(1.-X2)/(2.-X1)**2) | |
3857 | WME=X3**2 | |
3858 | ENDIF | |
3859 | IF(WME.LT.RLU(0)*WSHOW) GOTO 260 | |
3860 | ||
3861 | C...Impose angular ordering by rejection of nonordered emission. | |
3862 | ELSEIF(MCE.EQ.1.AND.IGM.GT.0.AND.MSTJ(42).GE.2) THEN | |
3863 | MAOM=1 | |
3864 | ZM=V(IM,1) | |
3865 | IF(IEP(1).EQ.N+2) ZM=1.-V(IM,1) | |
3866 | THE2ID=Z*(1.-Z)*(ZM*P(IM,4))**2/V(IEP(1),5) | |
3867 | IAOM=IM | |
3868 | 290 IF(K(IAOM,5).EQ.22) THEN | |
3869 | IAOM=K(IAOM,3) | |
3870 | IF(K(IAOM,3).LE.NS) MAOM=0 | |
3871 | IF(MAOM.EQ.1) GOTO 290 | |
3872 | ENDIF | |
3873 | IF(MAOM.EQ.1) THEN | |
3874 | THE2IM=V(IAOM,1)*(1.-V(IAOM,1))*P(IAOM,4)**2/V(IAOM,5) | |
3875 | IF(THE2ID.LT.THE2IM) GOTO 260 | |
3876 | ENDIF | |
3877 | ENDIF | |
3878 | ||
3879 | C...Impose user-defined maximum angle at first branching. | |
3880 | IF(MSTJ(48).EQ.1) THEN | |
3881 | IF(NEP.EQ.1.AND.IM.EQ.NS) THEN | |
3882 | THE2ID=Z*(1.-Z)*PS(4)**2/V(IEP(1),5) | |
3883 | IF(THE2ID.LT.1./PARJ(85)**2) GOTO 260 | |
3884 | ELSEIF(NEP.EQ.2.AND.IEP(1).EQ.NS+2) THEN | |
3885 | THE2ID=Z*(1.-Z)*(0.5*P(IM,4))**2/V(IEP(1),5) | |
3886 | IF(THE2ID.LT.1./PARJ(85)**2) GOTO 260 | |
3887 | ELSEIF(NEP.EQ.2.AND.IEP(1).EQ.NS+3) THEN | |
3888 | THE2ID=Z*(1.-Z)*(0.5*P(IM,4))**2/V(IEP(1),5) | |
3889 | IF(THE2ID.LT.1./PARJ(86)**2) GOTO 260 | |
3890 | ENDIF | |
3891 | ENDIF | |
3892 | ||
3893 | C...End of inner veto algorithm. Check if only one leg evolved so far. | |
3894 | 300 V(IEP(1),1)=Z | |
3895 | ISL(1)=0 | |
3896 | ISL(2)=0 | |
3897 | IF(NEP.EQ.1) GOTO 330 | |
3898 | IF(NEP.EQ.2.AND.P(IEP(1),5)+P(IEP(2),5).GE.P(IM,5)) GOTO 200 | |
3899 | DO 310 I=1,NEP | |
3900 | IF(ITRY(I).EQ.0.AND.KFLD(I).GT.0.AND.(KFLD(I).LE.8.OR.KFLD(I).EQ. | |
3901 | &21)) THEN | |
3902 | IF(P(N+I,5).GE.PMTH(2,KFLD(I))) GOTO 200 | |
3903 | ENDIF | |
3904 | 310 CONTINUE | |
3905 | ||
3906 | C...Check if chosen multiplet m1,m2,z1,z2 is physical. | |
3907 | IF(NEP.EQ.3) THEN | |
3908 | PA1S=(P(N+1,4)+P(N+1,5))*(P(N+1,4)-P(N+1,5)) | |
3909 | PA2S=(P(N+2,4)+P(N+2,5))*(P(N+2,4)-P(N+2,5)) | |
3910 | PA3S=(P(N+3,4)+P(N+3,5))*(P(N+3,4)-P(N+3,5)) | |
3911 | PTS=0.25*(2.*PA1S*PA2S+2.*PA1S*PA3S+2.*PA2S*PA3S- | |
3912 | & PA1S**2-PA2S**2-PA3S**2)/PA1S | |
3913 | IF(PTS.LE.0.) GOTO 200 | |
3914 | ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2.OR.MOD(MSTJ(43),2).EQ.0) THEN | |
3915 | DO 320 I1=N+1,N+2 | |
3916 | KFLDA=IABS(K(I1,2)) | |
3917 | IF(KFLDA.EQ.0.OR.(KFLDA.GT.8.AND.KFLDA.NE.21)) GOTO 320 | |
3918 | IF(P(I1,5).LT.PMTH(2,KFLDA)) GOTO 320 | |
3919 | IF(KFLDA.EQ.21) THEN | |
3920 | KFLGD1=IABS(K(I1,5)) | |
3921 | KFLGD2=KFLGD1 | |
3922 | ELSE | |
3923 | KFLGD1=KFLDA | |
3924 | KFLGD2=IABS(K(I1,5)) | |
3925 | ENDIF | |
3926 | I2=2*N+3-I1 | |
3927 | IF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN | |
3928 | PED=0.5*(V(IM,5)+V(I1,5)-V(I2,5))/P(IM,5) | |
3929 | ELSE | |
3930 | IF(I1.EQ.N+1) ZM=V(IM,1) | |
3931 | IF(I1.EQ.N+2) ZM=1.-V(IM,1) | |
3932 | PML=SQRT((V(IM,5)-V(N+1,5)-V(N+2,5))**2- | |
3933 | & 4.*V(N+1,5)*V(N+2,5)) | |
3934 | PED=PEM*(0.5*(V(IM,5)-PML+V(I1,5)-V(I2,5))+PML*ZM)/V(IM,5) | |
3935 | ENDIF | |
3936 | IF(MOD(MSTJ(43),2).EQ.1) THEN | |
3937 | PMQTH3=0.5*PARJ(82) | |
3938 | IF(KFLGD2.EQ.22) PMQTH3=0.5*PARJ(83) | |
3939 | PMQ1=(PMTH(1,KFLGD1)**2+PMQTH3**2)/V(I1,5) | |
3940 | PMQ2=(PMTH(1,KFLGD2)**2+PMQTH3**2)/V(I1,5) | |
3941 | ZD=SQRT(MAX(0.,(1.-V(I1,5)/PED**2)*((1.-PMQ1-PMQ2)**2- | |
3942 | & 4.*PMQ1*PMQ2))) | |
3943 | ZH=1.+PMQ1-PMQ2 | |
3944 | ELSE | |
3945 | ZD=SQRT(MAX(0.,1.-V(I1,5)/PED**2)) | |
3946 | ZH=1. | |
3947 | ENDIF | |
3948 | ZL=0.5*(ZH-ZD) | |
3949 | ZU=0.5*(ZH+ZD) | |
3950 | IF(I1.EQ.N+1.AND.(V(I1,1).LT.ZL.OR.V(I1,1).GT.ZU)) ISL(1)=1 | |
3951 | IF(I1.EQ.N+2.AND.(V(I1,1).LT.ZL.OR.V(I1,1).GT.ZU)) ISL(2)=1 | |
3952 | IF(KFLDA.EQ.21) V(I1,4)=LOG(ZU*(1.-ZL)/MAX(1E-20,ZL*(1.-ZU))) | |
3953 | IF(KFLDA.NE.21) V(I1,4)=LOG((1.-ZL)/MAX(1E-10,1.-ZU)) | |
3954 | 320 CONTINUE | |
3955 | IF(ISL(1).EQ.1.AND.ISL(2).EQ.1.AND.ISLM.NE.0) THEN | |
3956 | ISL(3-ISLM)=0 | |
3957 | ISLM=3-ISLM | |
3958 | ELSEIF(ISL(1).EQ.1.AND.ISL(2).EQ.1) THEN | |
3959 | ZDR1=MAX(0.,V(N+1,3)/V(N+1,4)-1.) | |
3960 | ZDR2=MAX(0.,V(N+2,3)/V(N+2,4)-1.) | |
3961 | IF(ZDR2.GT.RLU(0)*(ZDR1+ZDR2)) ISL(1)=0 | |
3962 | IF(ISL(1).EQ.1) ISL(2)=0 | |
3963 | IF(ISL(1).EQ.0) ISLM=1 | |
3964 | IF(ISL(2).EQ.0) ISLM=2 | |
3965 | ENDIF | |
3966 | IF(ISL(1).EQ.1.OR.ISL(2).EQ.1) GOTO 200 | |
3967 | ENDIF | |
3968 | IF(IGM.GT.0.AND.MOD(MSTJ(43),2).EQ.1.AND.(P(N+1,5).GE. | |
3969 | &PMTH(2,KFLD(1)).OR.P(N+2,5).GE.PMTH(2,KFLD(2)))) THEN | |
3970 | PMQ1=V(N+1,5)/V(IM,5) | |
3971 | PMQ2=V(N+2,5)/V(IM,5) | |
3972 | ZD=SQRT(MAX(0.,(1.-V(IM,5)/PEM**2)*((1.-PMQ1-PMQ2)**2- | |
3973 | & 4.*PMQ1*PMQ2))) | |
3974 | ZH=1.+PMQ1-PMQ2 | |
3975 | ZL=0.5*(ZH-ZD) | |
3976 | ZU=0.5*(ZH+ZD) | |
3977 | IF(V(IM,1).LT.ZL.OR.V(IM,1).GT.ZU) GOTO 200 | |
3978 | ENDIF | |
3979 | ||
3980 | C...Accepted branch. Construct four-momentum for initial partons. | |
3981 | 330 MAZIP=0 | |
3982 | MAZIC=0 | |
3983 | IF(NEP.EQ.1) THEN | |
3984 | P(N+1,1)=0. | |
3985 | P(N+1,2)=0. | |
3986 | P(N+1,3)=SQRT(MAX(0.,(P(IPA(1),4)+P(N+1,5))*(P(IPA(1),4)- | |
3987 | & P(N+1,5)))) | |
3988 | P(N+1,4)=P(IPA(1),4) | |
3989 | V(N+1,2)=P(N+1,4) | |
3990 | ELSEIF(IGM.EQ.0.AND.NEP.EQ.2) THEN | |
3991 | PED1=0.5*(V(IM,5)+V(N+1,5)-V(N+2,5))/P(IM,5) | |
3992 | P(N+1,1)=0. | |
3993 | P(N+1,2)=0. | |
3994 | P(N+1,3)=SQRT(MAX(0.,(PED1+P(N+1,5))*(PED1-P(N+1,5)))) | |
3995 | P(N+1,4)=PED1 | |
3996 | P(N+2,1)=0. | |
3997 | P(N+2,2)=0. | |
3998 | P(N+2,3)=-P(N+1,3) | |
3999 | P(N+2,4)=P(IM,5)-PED1 | |
4000 | V(N+1,2)=P(N+1,4) | |
4001 | V(N+2,2)=P(N+2,4) | |
4002 | ELSEIF(NEP.EQ.3) THEN | |
4003 | P(N+1,1)=0. | |
4004 | P(N+1,2)=0. | |
4005 | P(N+1,3)=SQRT(MAX(0.,PA1S)) | |
4006 | P(N+2,1)=SQRT(PTS) | |
4007 | P(N+2,2)=0. | |
4008 | P(N+2,3)=0.5*(PA3S-PA2S-PA1S)/P(N+1,3) | |
4009 | P(N+3,1)=-P(N+2,1) | |
4010 | P(N+3,2)=0. | |
4011 | P(N+3,3)=-(P(N+1,3)+P(N+2,3)) | |
4012 | V(N+1,2)=P(N+1,4) | |
4013 | V(N+2,2)=P(N+2,4) | |
4014 | V(N+3,2)=P(N+3,4) | |
4015 | ||
4016 | C...Construct transverse momentum for ordinary branching in shower. | |
4017 | ELSE | |
4018 | ZM=V(IM,1) | |
4019 | PZM=SQRT(MAX(0.,(PEM+P(IM,5))*(PEM-P(IM,5)))) | |
4020 | PMLS=(V(IM,5)-V(N+1,5)-V(N+2,5))**2-4.*V(N+1,5)*V(N+2,5) | |
4021 | IF(PZM.LE.0.) THEN | |
4022 | PTS=0. | |
4023 | ELSEIF(MOD(MSTJ(43),2).EQ.1) THEN | |
4024 | PTS=(PEM**2*(ZM*(1.-ZM)*V(IM,5)-(1.-ZM)*V(N+1,5)- | |
4025 | & ZM*V(N+2,5))-0.25*PMLS)/PZM**2 | |
4026 | ELSE | |
4027 | PTS=PMLS*(ZM*(1.-ZM)*PEM**2/V(IM,5)-0.25)/PZM**2 | |
4028 | ENDIF | |
4029 | PT=SQRT(MAX(0.,PTS)) | |
4030 | ||
4031 | C...Find coefficient of azimuthal asymmetry due to gluon polarization. | |
4032 | HAZIP=0. | |
4033 | IF(MSTJ(49).NE.1.AND.MOD(MSTJ(46),2).EQ.1.AND.K(IM,2).EQ.21. | |
4034 | & AND.IAU.NE.0) THEN | |
4035 | IF(K(IGM,3).NE.0) MAZIP=1 | |
4036 | ZAU=V(IGM,1) | |
4037 | IF(IAU.EQ.IM+1) ZAU=1.-V(IGM,1) | |
4038 | IF(MAZIP.EQ.0) ZAU=0. | |
4039 | IF(K(IGM,2).NE.21) THEN | |
4040 | HAZIP=2.*ZAU/(1.+ZAU**2) | |
4041 | ELSE | |
4042 | HAZIP=(ZAU/(1.-ZAU*(1.-ZAU)))**2 | |
4043 | ENDIF | |
4044 | IF(K(N+1,2).NE.21) THEN | |
4045 | HAZIP=HAZIP*(-2.*ZM*(1.-ZM))/(1.-2.*ZM*(1.-ZM)) | |
4046 | ELSE | |
4047 | HAZIP=HAZIP*(ZM*(1.-ZM)/(1.-ZM*(1.-ZM)))**2 | |
4048 | ENDIF | |
4049 | ENDIF | |
4050 | ||
4051 | C...Find coefficient of azimuthal asymmetry due to soft gluon | |
4052 | C...interference. | |
4053 | HAZIC=0. | |
4054 | IF(MSTJ(46).GE.2.AND.(K(N+1,2).EQ.21.OR.K(N+2,2).EQ.21). | |
4055 | & AND.IAU.NE.0) THEN | |
4056 | IF(K(IGM,3).NE.0) MAZIC=N+1 | |
4057 | IF(K(IGM,3).NE.0.AND.K(N+1,2).NE.21) MAZIC=N+2 | |
4058 | IF(K(IGM,3).NE.0.AND.K(N+1,2).EQ.21.AND.K(N+2,2).EQ.21.AND. | |
4059 | & ZM.GT.0.5) MAZIC=N+2 | |
4060 | IF(K(IAU,2).EQ.22) MAZIC=0 | |
4061 | ZS=ZM | |
4062 | IF(MAZIC.EQ.N+2) ZS=1.-ZM | |
4063 | ZGM=V(IGM,1) | |
4064 | IF(IAU.EQ.IM-1) ZGM=1.-V(IGM,1) | |
4065 | IF(MAZIC.EQ.0) ZGM=1. | |
4066 | HAZIC=(P(IM,5)/P(IGM,5))*SQRT((1.-ZS)*(1.-ZGM)/(ZS*ZGM)) | |
4067 | HAZIC=MIN(0.95,HAZIC) | |
4068 | ENDIF | |
4069 | ENDIF | |
4070 | ||
4071 | C...Construct kinematics for ordinary branching in shower. | |
4072 | 340 IF(NEP.EQ.2.AND.IGM.GT.0) THEN | |
4073 | IF(MOD(MSTJ(43),2).EQ.1) THEN | |
4074 | P(N+1,4)=PEM*V(IM,1) | |
4075 | ELSE | |
4076 | P(N+1,4)=PEM*(0.5*(V(IM,5)-SQRT(PMLS)+V(N+1,5)-V(N+2,5))+ | |
4077 | & SQRT(PMLS)*ZM)/V(IM,5) | |
4078 | ENDIF | |
4079 | PHI=PARU(2)*RLU(0) | |
4080 | P(N+1,1)=PT*COS(PHI) | |
4081 | P(N+1,2)=PT*SIN(PHI) | |
4082 | IF(PZM.GT.0.) THEN | |
4083 | P(N+1,3)=0.5*(V(N+2,5)-V(N+1,5)-V(IM,5)+2.*PEM*P(N+1,4))/PZM | |
4084 | ELSE | |
4085 | P(N+1,3)=0. | |
4086 | ENDIF | |
4087 | P(N+2,1)=-P(N+1,1) | |
4088 | P(N+2,2)=-P(N+1,2) | |
4089 | P(N+2,3)=PZM-P(N+1,3) | |
4090 | P(N+2,4)=PEM-P(N+1,4) | |
4091 | IF(MSTJ(43).LE.2) THEN | |
4092 | V(N+1,2)=(PEM*P(N+1,4)-PZM*P(N+1,3))/P(IM,5) | |
4093 | V(N+2,2)=(PEM*P(N+2,4)-PZM*P(N+2,3))/P(IM,5) | |
4094 | ENDIF | |
4095 | ENDIF | |
4096 | ||
4097 | C...Rotate and boost daughters. | |
4098 | IF(IGM.GT.0) THEN | |
4099 | IF(MSTJ(43).LE.2) THEN | |
4100 | BEX=P(IGM,1)/P(IGM,4) | |
4101 | BEY=P(IGM,2)/P(IGM,4) | |
4102 | BEZ=P(IGM,3)/P(IGM,4) | |
4103 | GA=P(IGM,4)/P(IGM,5) | |
4104 | GABEP=GA*(GA*(BEX*P(IM,1)+BEY*P(IM,2)+BEZ*P(IM,3))/(1.+GA)- | |
4105 | & P(IM,4)) | |
4106 | ELSE | |
4107 | BEX=0. | |
4108 | BEY=0. | |
4109 | BEZ=0. | |
4110 | GA=1. | |
4111 | GABEP=0. | |
4112 | ENDIF | |
4113 | THE=ULANGL(P(IM,3)+GABEP*BEZ,SQRT((P(IM,1)+GABEP*BEX)**2+ | |
4114 | & (P(IM,2)+GABEP*BEY)**2)) | |
4115 | PHI=ULANGL(P(IM,1)+GABEP*BEX,P(IM,2)+GABEP*BEY) | |
4116 | DO 350 I=N+1,N+2 | |
4117 | DP(1)=dble(COS(THE)*COS(PHI)*P(I,1)-SIN(PHI)*P(I,2)+ | |
4118 | & SIN(THE)*COS(PHI)*P(I,3)) | |
4119 | DP(2)=dble(COS(THE)*SIN(PHI)*P(I,1)+COS(PHI)*P(I,2)+ | |
4120 | & SIN(THE)*SIN(PHI)*P(I,3)) | |
4121 | DP(3)=dble(-SIN(THE)*P(I,1)+COS(THE)*P(I,3)) | |
4122 | DP(4)=dble(P(I,4)) | |
4123 | DBP=dble(BEX)*DP(1)+dble(BEY)*DP(2)+dble(BEZ)*DP(3) | |
4124 | DGABP=dble(GA)*(dble(GA)*DBP/(1D0+dble(GA))+DP(4)) | |
4125 | P(I,1)=sngl(DP(1)+DGABP*dble(BEX)) | |
4126 | P(I,2)=sngl(DP(2)+DGABP*dble(BEY)) | |
4127 | P(I,3)=sngl(DP(3)+DGABP*dble(BEZ)) | |
4128 | 350 P(I,4)=GA*sngl(DP(4)+DBP) | |
4129 | ENDIF | |
4130 | ||
4131 | C...Weight with azimuthal distribution, if required. | |
4132 | IF(MAZIP.NE.0.OR.MAZIC.NE.0) THEN | |
4133 | DO 360 J=1,3 | |
4134 | DPT(1,J)=dble(P(IM,J)) | |
4135 | DPT(2,J)=dble(P(IAU,J)) | |
4136 | 360 DPT(3,J)=dble(P(N+1,J)) | |
4137 | DPMA=DPT(1,1)*DPT(2,1)+DPT(1,2)*DPT(2,2)+DPT(1,3)*DPT(2,3) | |
4138 | DPMD=DPT(1,1)*DPT(3,1)+DPT(1,2)*DPT(3,2)+DPT(1,3)*DPT(3,3) | |
4139 | DPMM=DPT(1,1)**2+DPT(1,2)**2+DPT(1,3)**2 | |
4140 | DO 370 J=1,3 | |
4141 | DPT(4,J)=DPT(2,J)-DPMA*DPT(1,J)/DPMM | |
4142 | 370 DPT(5,J)=DPT(3,J)-DPMD*DPT(1,J)/DPMM | |
4143 | DPT(4,4)=DSQRT(DPT(4,1)**2+DPT(4,2)**2+DPT(4,3)**2) | |
4144 | DPT(5,4)=DSQRT(DPT(5,1)**2+DPT(5,2)**2+DPT(5,3)**2) | |
4145 | IF(MIN(DPT(4,4),DPT(5,4)).GT.0.1*PARJ(82)) THEN | |
4146 | CAD=sngl((DPT(4,1)*DPT(5,1)+DPT(4,2)*DPT(5,2)+ | |
4147 | & DPT(4,3)*DPT(5,3))/(DPT(4,4)*DPT(5,4))) | |
4148 | IF(MAZIP.NE.0) THEN | |
4149 | IF(1.+HAZIP*(2.*CAD**2-1.).LT.RLU(0)*(1.+ABS(HAZIP))) | |
4150 | & GOTO 340 | |
4151 | ENDIF | |
4152 | IF(MAZIC.NE.0) THEN | |
4153 | IF(MAZIC.EQ.N+2) CAD=-CAD | |
4154 | IF((1.-HAZIC)*(1.-HAZIC*CAD)/(1.+HAZIC**2-2.*HAZIC*CAD). | |
4155 | & LT.RLU(0)) GOTO 340 | |
4156 | ENDIF | |
4157 | ENDIF | |
4158 | ENDIF | |
4159 | ||
4160 | C...Continue loop over partons that may branch, until none left. | |
4161 | IF(IGM.GE.0) K(IM,1)=14 | |
4162 | N=N+NEP | |
4163 | NEP=2 | |
4164 | IF(N.GT.MSTU(4)-MSTU(32)-5) THEN | |
4165 | CALL LUERRM(11,'(LUSHOW:) no more memory left in LUJETSA') | |
4166 | IF(MSTU(21).GE.1) N=NS | |
4167 | IF(MSTU(21).GE.1) RETURN | |
4168 | ENDIF | |
4169 | GOTO 140 | |
4170 | ||
4171 | C...Set information on imagined shower initiator. | |
4172 | 380 IF(NPA.GE.2) THEN | |
4173 | K(NS+1,1)=11 | |
4174 | K(NS+1,2)=94 | |
4175 | K(NS+1,3)=IP1 | |
4176 | IF(IP2.GT.0.AND.IP2.LT.IP1) K(NS+1,3)=IP2 | |
4177 | K(NS+1,4)=NS+2 | |
4178 | K(NS+1,5)=NS+1+NPA | |
4179 | IIM=1 | |
4180 | ELSE | |
4181 | IIM=0 | |
4182 | ENDIF | |
4183 | ||
4184 | C...Reconstruct string drawing information. | |
4185 | DO 390 I=NS+1+IIM,N | |
4186 | IF(K(I,1).LE.10.AND.K(I,2).EQ.22) THEN | |
4187 | K(I,1)=1 | |
4188 | ELSEIF(K(I,1).LE.10) THEN | |
4189 | K(I,4)=MSTU(5)*(K(I,4)/MSTU(5)) | |
4190 | K(I,5)=MSTU(5)*(K(I,5)/MSTU(5)) | |
4191 | ELSEIF(K(MOD(K(I,4),MSTU(5))+1,2).NE.22) THEN | |
4192 | ID1=MOD(K(I,4),MSTU(5)) | |
4193 | IF(K(I,2).GE.1.AND.K(I,2).LE.8) ID1=MOD(K(I,4),MSTU(5))+1 | |
4194 | ID2=2*MOD(K(I,4),MSTU(5))+1-ID1 | |
4195 | K(I,4)=MSTU(5)*(K(I,4)/MSTU(5))+ID1 | |
4196 | K(I,5)=MSTU(5)*(K(I,5)/MSTU(5))+ID2 | |
4197 | K(ID1,4)=K(ID1,4)+MSTU(5)*I | |
4198 | K(ID1,5)=K(ID1,5)+MSTU(5)*ID2 | |
4199 | K(ID2,4)=K(ID2,4)+MSTU(5)*ID1 | |
4200 | K(ID2,5)=K(ID2,5)+MSTU(5)*I | |
4201 | ELSE | |
4202 | ID1=MOD(K(I,4),MSTU(5)) | |
4203 | ID2=ID1+1 | |
4204 | K(I,4)=MSTU(5)*(K(I,4)/MSTU(5))+ID1 | |
4205 | K(I,5)=MSTU(5)*(K(I,5)/MSTU(5))+ID1 | |
4206 | K(ID1,4)=K(ID1,4)+MSTU(5)*I | |
4207 | K(ID1,5)=K(ID1,5)+MSTU(5)*I | |
4208 | K(ID2,4)=0 | |
4209 | K(ID2,5)=0 | |
4210 | ENDIF | |
4211 | 390 CONTINUE | |
4212 | ||
4213 | C...Transformation from CM frame. | |
4214 | IF(NPA.GE.2) THEN | |
4215 | BEX=PS(1)/PS(4) | |
4216 | BEY=PS(2)/PS(4) | |
4217 | BEZ=PS(3)/PS(4) | |
4218 | GA=PS(4)/PS(5) | |
4219 | GABEP=GA*(GA*(BEX*P(IPA(1),1)+BEY*P(IPA(1),2)+BEZ*P(IPA(1),3)) | |
4220 | & /(1.+GA)-P(IPA(1),4)) | |
4221 | ELSE | |
4222 | BEX=0. | |
4223 | BEY=0. | |
4224 | BEZ=0. | |
4225 | GABEP=0. | |
4226 | ENDIF | |
4227 | THE=ULANGL(P(IPA(1),3)+GABEP*BEZ,SQRT((P(IPA(1),1) | |
4228 | &+GABEP*BEX)**2+(P(IPA(1),2)+GABEP*BEY)**2)) | |
4229 | PHI=ULANGL(P(IPA(1),1)+GABEP*BEX,P(IPA(1),2)+GABEP*BEY) | |
4230 | IF(NPA.EQ.3) THEN | |
4231 | CHI=ULANGL(COS(THE)*COS(PHI)*(P(IPA(2),1)+GABEP*BEX)+COS(THE)* | |
4232 | & SIN(PHI)*(P(IPA(2),2)+GABEP*BEY)-SIN(THE)*(P(IPA(2),3)+GABEP* | |
4233 | & BEZ),-SIN(PHI)*(P(IPA(2),1)+GABEP*BEX)+COS(PHI)*(P(IPA(2),2)+ | |
4234 | & GABEP*BEY)) | |
4235 | CALL LUDBRB(NS+1,N,0.,CHI,0D0,0D0,0D0) | |
4236 | ENDIF | |
4237 | DBEX=DBLE(BEX) | |
4238 | DBEY=DBLE(BEY) | |
4239 | DBEZ=DBLE(BEZ) | |
4240 | CALL LUDBRB(NS+1,N,THE,PHI,DBEX,DBEY,DBEZ) | |
4241 | ||
4242 | C...Decay vertex of shower. | |
4243 | DO 400 I=NS+1,N | |
4244 | DO 400 J=1,5 | |
4245 | 400 V(I,J)=V(IP1,J) | |
4246 | ||
4247 | C...Delete trivial shower, else connect initiators. | |
4248 | IF(N.EQ.NS+NPA+IIM) THEN | |
4249 | N=NS | |
4250 | ELSE | |
4251 | DO 410 IP=1,NPA | |
4252 | K(IPA(IP),1)=14 | |
4253 | K(IPA(IP),4)=K(IPA(IP),4)+NS+IIM+IP | |
4254 | K(IPA(IP),5)=K(IPA(IP),5)+NS+IIM+IP | |
4255 | K(NS+IIM+IP,3)=IPA(IP) | |
4256 | IF(IIM.EQ.1.AND.MSTU(16).NE.2) K(NS+IIM+IP,3)=NS+1 | |
4257 | K(NS+IIM+IP,4)=MSTU(5)*IPA(IP)+K(NS+IIM+IP,4) | |
4258 | 410 K(NS+IIM+IP,5)=MSTU(5)*IPA(IP)+K(NS+IIM+IP,5) | |
4259 | ENDIF | |
4260 | ||
4261 | RETURN | |
4262 | END | |
4263 | ||
4264 | C********************************************************************* | |
4265 | ||
4266 | SUBROUTINE LUBOEI(NSAV) | |
4267 | ||
4268 | C...Purpose: to modify event so as to approximately take into account | |
4269 | C...Bose-Einstein effects according to a simple phenomenological | |
4270 | C...parametrization. | |
4271 | IMPLICIT DOUBLE PRECISION(D) | |
4272 | COMMON/LUJETSA/N,K(9000,5),P(9000,5),V(9000,5) | |
4273 | SAVE /LUJETSA/ | |
4274 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
4275 | SAVE /LUDAT1A/ | |
4276 | DIMENSION DPS(4),KFBE(9),NBE(0:9),BEI(100) | |
4277 | DATA KFBE/211,-211,111,321,-321,130,310,221,331/ | |
4278 | ||
4279 | pmhq=0. | |
4280 | qdel=0. | |
4281 | nbin=0 | |
4282 | beex=0. | |
4283 | bert=0. | |
4284 | ||
4285 | C...Boost event to overall CM frame. Calculate CM energy. | |
4286 | IF((MSTJ(51).NE.1.AND.MSTJ(51).NE.2).OR.N-NSAV.LE.1) RETURN | |
4287 | DO 100 J=1,4 | |
4288 | 100 DPS(J)=0.d0 | |
4289 | DO 120 I=1,N | |
4290 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 120 | |
4291 | DO 110 J=1,4 | |
4292 | 110 DPS(J)=DPS(J)+dble(P(I,J)) | |
4293 | 120 CONTINUE | |
4294 | CALL LUDBRB(0,0,0.,0.,-DPS(1)/DPS(4),-DPS(2)/DPS(4), | |
4295 | &-DPS(3)/DPS(4)) | |
4296 | PECM=0. | |
4297 | DO 130 I=1,N | |
4298 | 130 IF(K(I,1).GE.1.AND.K(I,1).LE.10) PECM=PECM+P(I,4) | |
4299 | ||
4300 | C...Reserve copy of particles by species at end of record. | |
4301 | NBE(0)=N+MSTU(3) | |
4302 | DO 160 IBE=1,MIN(9,MSTJ(51)) | |
4303 | NBE(IBE)=NBE(IBE-1) | |
4304 | DO 150 I=NSAV+1,N | |
4305 | IF(K(I,2).NE.KFBE(IBE)) GOTO 150 | |
4306 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 150 | |
4307 | IF(NBE(IBE).GE.MSTU(4)-MSTU(32)-5) THEN | |
4308 | CALL LUERRM(11,'(LUBOEI:) no more memory left in LUJETSA') | |
4309 | RETURN | |
4310 | ENDIF | |
4311 | NBE(IBE)=NBE(IBE)+1 | |
4312 | K(NBE(IBE),1)=I | |
4313 | DO 140 J=1,3 | |
4314 | 140 P(NBE(IBE),J)=0. | |
4315 | 150 CONTINUE | |
4316 | 160 CONTINUE | |
4317 | ||
4318 | C...Tabulate integral for subsequent momentum shift. | |
4319 | DO 210 IBE=1,MIN(9,MSTJ(51)) | |
4320 | IF(IBE.NE.1.AND.IBE.NE.4.AND.IBE.LE.7) GOTO 180 | |
4321 | IF(IBE.EQ.1.AND.MAX(NBE(1)-NBE(0),NBE(2)-NBE(1),NBE(3)-NBE(2)). | |
4322 | &LE.1) GOTO 180 | |
4323 | IF(IBE.EQ.4.AND.MAX(NBE(4)-NBE(3),NBE(5)-NBE(4),NBE(6)-NBE(5), | |
4324 | &NBE(7)-NBE(6)).LE.1) GOTO 180 | |
4325 | IF(IBE.GE.8.AND.NBE(IBE)-NBE(IBE-1).LE.1) GOTO 180 | |
4326 | IF(IBE.EQ.1) PMHQ=2.*ULMASS(211) | |
4327 | IF(IBE.EQ.4) PMHQ=2.*ULMASS(321) | |
4328 | IF(IBE.EQ.8) PMHQ=2.*ULMASS(221) | |
4329 | IF(IBE.EQ.9) PMHQ=2.*ULMASS(331) | |
4330 | QDEL=0.1*MIN(PMHQ,PARJ(93)) | |
4331 | IF(MSTJ(51).EQ.1) THEN | |
4332 | NBIN=MIN(100,NINT(9.*PARJ(93)/QDEL)) | |
4333 | BEEX=EXP(0.5*QDEL/PARJ(93)) | |
4334 | BERT=EXP(-QDEL/PARJ(93)) | |
4335 | ELSE | |
4336 | NBIN=MIN(100,NINT(3.*PARJ(93)/QDEL)) | |
4337 | ENDIF | |
4338 | DO 170 IBIN=1,NBIN | |
4339 | QBIN=QDEL*(IBIN-0.5) | |
4340 | BEI(IBIN)=QDEL*(QBIN**2+QDEL**2/12.)/SQRT(QBIN**2+PMHQ**2) | |
4341 | IF(MSTJ(51).EQ.1) THEN | |
4342 | BEEX=BEEX*BERT | |
4343 | BEI(IBIN)=BEI(IBIN)*BEEX | |
4344 | ELSE | |
4345 | BEI(IBIN)=BEI(IBIN)*EXP(-(QBIN/PARJ(93))**2) | |
4346 | ENDIF | |
4347 | 170 IF(IBIN.GE.2) BEI(IBIN)=BEI(IBIN)+BEI(IBIN-1) | |
4348 | ||
4349 | C...Loop through particle pairs and find old relative momentum. | |
4350 | 180 DO 200 I1M=NBE(IBE-1)+1,NBE(IBE)-1 | |
4351 | I1=K(I1M,1) | |
4352 | DO 200 I2M=I1M+1,NBE(IBE) | |
4353 | I2=K(I2M,1) | |
4354 | Q2OLD=MAX(0.,(P(I1,4)+P(I2,4))**2-(P(I1,1)+P(I2,1))**2-(P(I1,2)+ | |
4355 | &P(I2,2))**2-(P(I1,3)+P(I2,3))**2-(P(I1,5)+P(I2,5))**2) | |
4356 | QOLD=SQRT(Q2OLD) | |
4357 | ||
4358 | C...Calculate new relative momentum. | |
4359 | IF(QOLD.LT.0.5*QDEL) THEN | |
4360 | QMOV=QOLD/3. | |
4361 | ELSEIF(QOLD.LT.(NBIN-0.1)*QDEL) THEN | |
4362 | RBIN=QOLD/QDEL | |
4363 | IBIN=int(RBIN) | |
4364 | RINP=(RBIN**3-IBIN**3)/(3*IBIN*(IBIN+1)+1) | |
4365 | QMOV=(BEI(IBIN)+RINP*(BEI(IBIN+1)-BEI(IBIN)))* | |
4366 | & SQRT(Q2OLD+PMHQ**2)/Q2OLD | |
4367 | ELSE | |
4368 | QMOV=BEI(NBIN)*SQRT(Q2OLD+PMHQ**2)/Q2OLD | |
4369 | ENDIF | |
4370 | Q2NEW=Q2OLD*(QOLD/(QOLD+3.*PARJ(92)*QMOV))**(2./3.) | |
4371 | ||
4372 | C...Calculate and save shift to be performed on three-momenta. | |
4373 | HC1=(P(I1,4)+P(I2,4))**2-(Q2OLD-Q2NEW) | |
4374 | HC2=(Q2OLD-Q2NEW)*(P(I1,4)-P(I2,4))**2 | |
4375 | HA=0.5*(1.-SQRT(HC1*Q2NEW/(HC1*Q2OLD-HC2))) | |
4376 | DO 190 J=1,3 | |
4377 | PD=HA*(P(I2,J)-P(I1,J)) | |
4378 | P(I1M,J)=P(I1M,J)+PD | |
4379 | 190 P(I2M,J)=P(I2M,J)-PD | |
4380 | 200 CONTINUE | |
4381 | 210 CONTINUE | |
4382 | ||
4383 | C...Shift momenta and recalculate energies. | |
4384 | DO 230 IM=NBE(0)+1,NBE(MIN(9,MSTJ(51))) | |
4385 | I=K(IM,1) | |
4386 | DO 220 J=1,3 | |
4387 | 220 P(I,J)=P(I,J)+P(IM,J) | |
4388 | 230 P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
4389 | ||
4390 | C...Rescale all momenta for energy conservation. | |
4391 | PES=0. | |
4392 | PQS=0. | |
4393 | DO 240 I=1,N | |
4394 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 240 | |
4395 | PES=PES+P(I,4) | |
4396 | PQS=PQS+P(I,5)**2/P(I,4) | |
4397 | 240 CONTINUE | |
4398 | FAC=(PECM-PQS)/(PES-PQS) | |
4399 | DO 260 I=1,N | |
4400 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 260 | |
4401 | DO 250 J=1,3 | |
4402 | 250 P(I,J)=FAC*P(I,J) | |
4403 | P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
4404 | 260 CONTINUE | |
4405 | ||
4406 | C...Boost back to correct reference frame. | |
4407 | CALL LUDBRB(0,0,0.,0.,DPS(1)/DPS(4),DPS(2)/DPS(4),DPS(3)/DPS(4)) | |
4408 | ||
4409 | RETURN | |
4410 | END | |
4411 | ||
4412 | C********************************************************************* | |
4413 | ||
4414 | FUNCTION ULMASS(KF) | |
4415 | ||
4416 | C...Purpose: to give the mass of a particle/parton. | |
4417 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
4418 | SAVE /LUDAT1A/ | |
4419 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
4420 | SAVE /LUDAT2A/ | |
4421 | ||
4422 | pmspl=0. | |
4423 | ||
4424 | C...Reset variables. Compressed code. | |
4425 | ULMASS=0. | |
4426 | KFA=IABS(KF) | |
4427 | KC=LUCOMP(KF) | |
4428 | IF(KC.EQ.0) RETURN | |
4429 | PARF(106)=PMAS(6,1) | |
4430 | PARF(107)=PMAS(7,1) | |
4431 | PARF(108)=PMAS(8,1) | |
4432 | ||
4433 | C...Guarantee use of constituent masses for internal checks. | |
4434 | IF((MSTJ(93).EQ.1.OR.MSTJ(93).EQ.2).AND.KFA.LE.10) THEN | |
4435 | ULMASS=PARF(100+KFA) | |
4436 | IF(MSTJ(93).EQ.2) ULMASS=MAX(0.,ULMASS-PARF(121)) | |
4437 | ||
4438 | C...Masses that can be read directly off table. | |
4439 | ELSEIF(KFA.LE.100.OR.KC.LE.80.OR.KC.GT.100) THEN | |
4440 | ULMASS=PMAS(KC,1) | |
4441 | ||
4442 | C...Find constituent partons and their masses. | |
4443 | ELSE | |
4444 | KFLA=MOD(KFA/1000,10) | |
4445 | KFLB=MOD(KFA/100,10) | |
4446 | KFLC=MOD(KFA/10,10) | |
4447 | KFLS=MOD(KFA,10) | |
4448 | KFLR=MOD(KFA/10000,10) | |
4449 | PMA=PARF(100+KFLA) | |
4450 | PMB=PARF(100+KFLB) | |
4451 | PMC=PARF(100+KFLC) | |
4452 | ||
4453 | C...Construct masses for various meson, diquark and baryon cases. | |
4454 | IF(KFLA.EQ.0.AND.KFLR.EQ.0.AND.KFLS.LE.3) THEN | |
4455 | IF(KFLS.EQ.1) PMSPL=-3./(PMB*PMC) | |
4456 | IF(KFLS.GE.3) PMSPL=1./(PMB*PMC) | |
4457 | ULMASS=PARF(111)+PMB+PMC+PARF(113)*PARF(101)**2*PMSPL | |
4458 | ELSEIF(KFLA.EQ.0) THEN | |
4459 | KMUL=2 | |
4460 | IF(KFLS.EQ.1) KMUL=3 | |
4461 | IF(KFLR.EQ.2) KMUL=4 | |
4462 | IF(KFLS.EQ.5) KMUL=5 | |
4463 | ULMASS=PARF(113+KMUL)+PMB+PMC | |
4464 | ELSEIF(KFLC.EQ.0) THEN | |
4465 | IF(KFLS.EQ.1) PMSPL=-3./(PMA*PMB) | |
4466 | IF(KFLS.EQ.3) PMSPL=1./(PMA*PMB) | |
4467 | ULMASS=2.*PARF(112)/3.+PMA+PMB+PARF(114)*PARF(101)**2*PMSPL | |
4468 | IF(MSTJ(93).EQ.1) ULMASS=PMA+PMB | |
4469 | IF(MSTJ(93).EQ.2) ULMASS=MAX(0.,ULMASS-PARF(122)- | |
4470 | & 2.*PARF(112)/3.) | |
4471 | ELSE | |
4472 | IF(KFLS.EQ.2.AND.KFLA.EQ.KFLB) THEN | |
4473 | PMSPL=1./(PMA*PMB)-2./(PMA*PMC)-2./(PMB*PMC) | |
4474 | ELSEIF(KFLS.EQ.2.AND.KFLB.GE.KFLC) THEN | |
4475 | PMSPL=-2./(PMA*PMB)-2./(PMA*PMC)+1./(PMB*PMC) | |
4476 | ELSEIF(KFLS.EQ.2) THEN | |
4477 | PMSPL=-3./(PMB*PMC) | |
4478 | ELSE | |
4479 | PMSPL=1./(PMA*PMB)+1./(PMA*PMC)+1./(PMB*PMC) | |
4480 | ENDIF | |
4481 | ULMASS=PARF(112)+PMA+PMB+PMC+PARF(114)*PARF(101)**2*PMSPL | |
4482 | ENDIF | |
4483 | ENDIF | |
4484 | ||
4485 | C...Optional mass broadening according to truncated Breit-Wigner | |
4486 | C...(either in m or in m^2). | |
4487 | IF(MSTJ(24).GE.1.AND.PMAS(KC,2).GT.1E-4) THEN | |
4488 | IF(MSTJ(24).EQ.1.OR.(MSTJ(24).EQ.2.AND.KFA.GT.100)) THEN | |
4489 | ULMASS=ULMASS+0.5*PMAS(KC,2)*TAN((2.*RLU(0)-1.)* | |
4490 | & ATAN(2.*PMAS(KC,3)/PMAS(KC,2))) | |
4491 | ELSE | |
4492 | PM0=ULMASS | |
4493 | PMLOW=ATAN((MAX(0.,PM0-PMAS(KC,3))**2-PM0**2)/ | |
4494 | & (PM0*PMAS(KC,2))) | |
4495 | PMUPP=ATAN((PM0+PMAS(KC,3))**2-PM0**2)/(PM0*PMAS(KC,2)) | |
4496 | ULMASS=SQRT(MAX(0.,PM0**2+PM0*PMAS(KC,2)*TAN(PMLOW+ | |
4497 | & (PMUPP-PMLOW)*RLU(0)))) | |
4498 | ENDIF | |
4499 | ENDIF | |
4500 | MSTJ(93)=0 | |
4501 | ||
4502 | RETURN | |
4503 | END | |
4504 | ||
4505 | C********************************************************************* | |
4506 | ||
4507 | SUBROUTINE LUNAME(KF,CHAU) | |
4508 | ||
4509 | C...Purpose: to give the particle/parton name as a character string. | |
4510 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
4511 | SAVE /LUDAT1A/ | |
4512 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
4513 | SAVE /LUDAT2A/ | |
4514 | COMMON/LUDAT4A/CHAF(500) | |
4515 | CHARACTER CHAF*8 | |
4516 | SAVE /LUDAT4A/ | |
4517 | CHARACTER CHAU*16 | |
4518 | ||
4519 | C...Initial values. Charge. Subdivide code. | |
4520 | CHAU=' ' | |
4521 | KFA=IABS(KF) | |
4522 | KC=LUCOMP(KF) | |
4523 | IF(KC.EQ.0) RETURN | |
4524 | KQ=LUCHGE(KF) | |
4525 | KFLA=MOD(KFA/1000,10) | |
4526 | KFLB=MOD(KFA/100,10) | |
4527 | KFLC=MOD(KFA/10,10) | |
4528 | KFLS=MOD(KFA,10) | |
4529 | KFLR=MOD(KFA/10000,10) | |
4530 | ||
4531 | C...Read out root name and spin for simple particle. | |
4532 | IF(KFA.LE.100.OR.(KFA.GT.100.AND.KC.GT.100)) THEN | |
4533 | CHAU=CHAF(KC) | |
4534 | LEN=0 | |
4535 | DO 100 LEM=1,8 | |
4536 | 100 IF(CHAU(LEM:LEM).NE.' ') LEN=LEM | |
4537 | ||
4538 | C...Construct root name for diquark. Add on spin. | |
4539 | ELSEIF(KFLC.EQ.0) THEN | |
4540 | CHAU(1:2)=CHAF(KFLA)(1:1)//CHAF(KFLB)(1:1) | |
4541 | IF(KFLS.EQ.1) CHAU(3:4)='_0' | |
4542 | IF(KFLS.EQ.3) CHAU(3:4)='_1' | |
4543 | LEN=4 | |
4544 | ||
4545 | C...Construct root name for heavy meson. Add on spin and heavy flavour. | |
4546 | ELSEIF(KFLA.EQ.0) THEN | |
4547 | IF(KFLB.EQ.5) CHAU(1:1)='B' | |
4548 | IF(KFLB.EQ.6) CHAU(1:1)='T' | |
4549 | IF(KFLB.EQ.7) CHAU(1:1)='L' | |
4550 | IF(KFLB.EQ.8) CHAU(1:1)='H' | |
4551 | LEN=1 | |
4552 | IF(KFLR.EQ.0.AND.KFLS.EQ.1) THEN | |
4553 | ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.3) THEN | |
4554 | CHAU(2:2)='*' | |
4555 | LEN=2 | |
4556 | ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.3) THEN | |
4557 | CHAU(2:3)='_1' | |
4558 | LEN=3 | |
4559 | ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.1) THEN | |
4560 | CHAU(2:4)='*_0' | |
4561 | LEN=4 | |
4562 | ELSEIF(KFLR.EQ.2) THEN | |
4563 | CHAU(2:4)='*_1' | |
4564 | LEN=4 | |
4565 | ELSEIF(KFLS.EQ.5) THEN | |
4566 | CHAU(2:4)='*_2' | |
4567 | LEN=4 | |
4568 | ENDIF | |
4569 | IF(KFLC.GE.3.AND.KFLR.EQ.0.AND.KFLS.LE.3) THEN | |
4570 | CHAU(LEN+1:LEN+2)='_'//CHAF(KFLC)(1:1) | |
4571 | LEN=LEN+2 | |
4572 | ELSEIF(KFLC.GE.3) THEN | |
4573 | CHAU(LEN+1:LEN+1)=CHAF(KFLC)(1:1) | |
4574 | LEN=LEN+1 | |
4575 | ENDIF | |
4576 | ||
4577 | C...Construct root name and spin for heavy baryon. | |
4578 | ELSE | |
4579 | IF(KFLB.LE.2.AND.KFLC.LE.2) THEN | |
4580 | CHAU='Sigma ' | |
4581 | IF(KFLC.GT.KFLB) CHAU='Lambda' | |
4582 | IF(KFLS.EQ.4) CHAU='Sigma*' | |
4583 | LEN=5 | |
4584 | IF(CHAU(6:6).NE.' ') LEN=6 | |
4585 | ELSEIF(KFLB.LE.2.OR.KFLC.LE.2) THEN | |
4586 | CHAU='Xi ' | |
4587 | IF(KFLA.GT.KFLB.AND.KFLB.GT.KFLC) CHAU='Xi''' | |
4588 | IF(KFLS.EQ.4) CHAU='Xi*' | |
4589 | LEN=2 | |
4590 | IF(CHAU(3:3).NE.' ') LEN=3 | |
4591 | ELSE | |
4592 | CHAU='Omega ' | |
4593 | IF(KFLA.GT.KFLB.AND.KFLB.GT.KFLC) CHAU='Omega''' | |
4594 | IF(KFLS.EQ.4) CHAU='Omega*' | |
4595 | LEN=5 | |
4596 | IF(CHAU(6:6).NE.' ') LEN=6 | |
4597 | ENDIF | |
4598 | ||
4599 | C...Add on heavy flavour content for heavy baryon. | |
4600 | CHAU(LEN+1:LEN+2)='_'//CHAF(KFLA)(1:1) | |
4601 | LEN=LEN+2 | |
4602 | IF(KFLB.GE.KFLC.AND.KFLC.GE.4) THEN | |
4603 | CHAU(LEN+1:LEN+2)=CHAF(KFLB)(1:1)//CHAF(KFLC)(1:1) | |
4604 | LEN=LEN+2 | |
4605 | ELSEIF(KFLB.GE.KFLC.AND.KFLB.GE.4) THEN | |
4606 | CHAU(LEN+1:LEN+1)=CHAF(KFLB)(1:1) | |
4607 | LEN=LEN+1 | |
4608 | ELSEIF(KFLC.GT.KFLB.AND.KFLB.GE.4) THEN | |
4609 | CHAU(LEN+1:LEN+2)=CHAF(KFLC)(1:1)//CHAF(KFLB)(1:1) | |
4610 | LEN=LEN+2 | |
4611 | ELSEIF(KFLC.GT.KFLB.AND.KFLC.GE.4) THEN | |
4612 | CHAU(LEN+1:LEN+1)=CHAF(KFLC)(1:1) | |
4613 | LEN=LEN+1 | |
4614 | ENDIF | |
4615 | ENDIF | |
4616 | ||
4617 | C...Add on bar sign for antiparticle (where necessary). | |
4618 | IF(KF.GT.0.OR.LEN.EQ.0) THEN | |
4619 | ELSEIF(KFA.GT.10.AND.KFA.LE.40.AND.KQ.NE.0) THEN | |
4620 | ELSEIF(KFA.EQ.89.OR.(KFA.GE.91.AND.KFA.LE.99)) THEN | |
4621 | ELSEIF(KFA.GT.100.AND.KFLA.EQ.0.AND.KQ.NE.0) THEN | |
4622 | ELSEIF(MSTU(15).LE.1) THEN | |
4623 | CHAU(LEN+1:LEN+1)='~' | |
4624 | LEN=LEN+1 | |
4625 | ELSE | |
4626 | CHAU(LEN+1:LEN+3)='bar' | |
4627 | LEN=LEN+3 | |
4628 | ENDIF | |
4629 | ||
4630 | C...Add on charge where applicable (conventional cases skipped). | |
4631 | IF(KQ.EQ.6) CHAU(LEN+1:LEN+2)='++' | |
4632 | IF(KQ.EQ.-6) CHAU(LEN+1:LEN+2)='--' | |
4633 | IF(KQ.EQ.3) CHAU(LEN+1:LEN+1)='+' | |
4634 | IF(KQ.EQ.-3) CHAU(LEN+1:LEN+1)='-' | |
4635 | IF(KQ.EQ.0.AND.(KFA.LE.22.OR.LEN.EQ.0)) THEN | |
4636 | ELSEIF(KQ.EQ.0.AND.(KFA.GE.81.AND.KFA.LE.100)) THEN | |
4637 | ELSEIF(KFA.GT.100.AND.KFLA.EQ.0.AND.KFLB.EQ.KFLC.AND. | |
4638 | &KFLB.NE.1) THEN | |
4639 | ELSEIF(KQ.EQ.0) THEN | |
4640 | CHAU(LEN+1:LEN+1)='0' | |
4641 | ENDIF | |
4642 | ||
4643 | RETURN | |
4644 | END | |
4645 | ||
4646 | C********************************************************************* | |
4647 | ||
4648 | FUNCTION LUCHGE(KF) | |
4649 | ||
4650 | C...Purpose: to give three times the charge for a particle/parton. | |
4651 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
4652 | SAVE /LUDAT2A/ | |
4653 | ||
4654 | C...Initial values. Simple case of direct readout. | |
4655 | LUCHGE=0 | |
4656 | KFA=IABS(KF) | |
4657 | KC=LUCOMP(KFA) | |
4658 | IF(KC.EQ.0) THEN | |
4659 | ELSEIF(KFA.LE.100.OR.KC.LE.80.OR.KC.GT.100) THEN | |
4660 | LUCHGE=KCHG(KC,1) | |
4661 | ||
4662 | C...Construction from quark content for heavy meson, diquark, baryon. | |
4663 | ELSEIF(MOD(KFA/1000,10).EQ.0) THEN | |
4664 | LUCHGE=(KCHG(MOD(KFA/100,10),1)-KCHG(MOD(KFA/10,10),1))* | |
4665 | & (-1)**MOD(KFA/100,10) | |
4666 | ELSEIF(MOD(KFA/10,10).EQ.0) THEN | |
4667 | LUCHGE=KCHG(MOD(KFA/1000,10),1)+KCHG(MOD(KFA/100,10),1) | |
4668 | ELSE | |
4669 | LUCHGE=KCHG(MOD(KFA/1000,10),1)+KCHG(MOD(KFA/100,10),1)+ | |
4670 | & KCHG(MOD(KFA/10,10),1) | |
4671 | ENDIF | |
4672 | ||
4673 | C...Add on correct sign. | |
4674 | LUCHGE=LUCHGE*ISIGN(1,KF) | |
4675 | ||
4676 | RETURN | |
4677 | END | |
4678 | ||
4679 | C********************************************************************* | |
4680 | ||
4681 | FUNCTION LUCOMP(KF) | |
4682 | ||
4683 | C...Purpose: to compress the standard KF codes for use in mass and decay | |
4684 | C...arrays; also to check whether a given code actually is defined. | |
4685 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
4686 | SAVE /LUDAT2A/ | |
4687 | ||
4688 | C...Subdivide KF code into constituent pieces. | |
4689 | LUCOMP=0 | |
4690 | KFA=IABS(KF) | |
4691 | KFLA=MOD(KFA/1000,10) | |
4692 | KFLB=MOD(KFA/100,10) | |
4693 | KFLC=MOD(KFA/10,10) | |
4694 | KFLS=MOD(KFA,10) | |
4695 | KFLR=MOD(KFA/10000,10) | |
4696 | ||
4697 | C...Simple cases: direct translation or special codes. | |
4698 | IF(KFA.EQ.0.OR.KFA.GE.100000) THEN | |
4699 | ELSEIF(KFA.LE.100) THEN | |
4700 | LUCOMP=KFA | |
4701 | IF(KF.LT.0.AND.KCHG(KFA,3).EQ.0) LUCOMP=0 | |
4702 | ELSEIF(KFLS.EQ.0) THEN | |
4703 | IF(KF.EQ.130) LUCOMP=221 | |
4704 | IF(KF.EQ.310) LUCOMP=222 | |
4705 | IF(KFA.EQ.210) LUCOMP=281 | |
4706 | IF(KFA.EQ.2110) LUCOMP=282 | |
4707 | IF(KFA.EQ.2210) LUCOMP=283 | |
4708 | ||
4709 | C...Mesons. | |
4710 | ELSEIF(KFA-10000*KFLR.LT.1000) THEN | |
4711 | IF(KFLB.EQ.0.OR.KFLB.EQ.9.OR.KFLC.EQ.0.OR.KFLC.EQ.9) THEN | |
4712 | ELSEIF(KFLB.LT.KFLC) THEN | |
4713 | ELSEIF(KF.LT.0.AND.KFLB.EQ.KFLC) THEN | |
4714 | ELSEIF(KFLB.EQ.KFLC) THEN | |
4715 | IF(KFLR.EQ.0.AND.KFLS.EQ.1) THEN | |
4716 | LUCOMP=110+KFLB | |
4717 | ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.3) THEN | |
4718 | LUCOMP=130+KFLB | |
4719 | ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.3) THEN | |
4720 | LUCOMP=150+KFLB | |
4721 | ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.1) THEN | |
4722 | LUCOMP=170+KFLB | |
4723 | ELSEIF(KFLR.EQ.2.AND.KFLS.EQ.3) THEN | |
4724 | LUCOMP=190+KFLB | |
4725 | ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.5) THEN | |
4726 | LUCOMP=210+KFLB | |
4727 | ENDIF | |
4728 | ELSEIF(KFLB.LE.5.AND.KFLC.LE.3) THEN | |
4729 | IF(KFLR.EQ.0.AND.KFLS.EQ.1) THEN | |
4730 | LUCOMP=100+((KFLB-1)*(KFLB-2))/2+KFLC | |
4731 | ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.3) THEN | |
4732 | LUCOMP=120+((KFLB-1)*(KFLB-2))/2+KFLC | |
4733 | ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.3) THEN | |
4734 | LUCOMP=140+((KFLB-1)*(KFLB-2))/2+KFLC | |
4735 | ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.1) THEN | |
4736 | LUCOMP=160+((KFLB-1)*(KFLB-2))/2+KFLC | |
4737 | ELSEIF(KFLR.EQ.2.AND.KFLS.EQ.3) THEN | |
4738 | LUCOMP=180+((KFLB-1)*(KFLB-2))/2+KFLC | |
4739 | ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.5) THEN | |
4740 | LUCOMP=200+((KFLB-1)*(KFLB-2))/2+KFLC | |
4741 | ENDIF | |
4742 | ELSEIF((KFLS.EQ.1.AND.KFLR.LE.1).OR.(KFLS.EQ.3.AND.KFLR.LE.2). | |
4743 | & OR.(KFLS.EQ.5.AND.KFLR.EQ.0)) THEN | |
4744 | LUCOMP=80+KFLB | |
4745 | ENDIF | |
4746 | ||
4747 | C...Diquarks. | |
4748 | ELSEIF((KFLR.EQ.0.OR.KFLR.EQ.1).AND.KFLC.EQ.0) THEN | |
4749 | IF(KFLS.NE.1.AND.KFLS.NE.3) THEN | |
4750 | ELSEIF(KFLA.EQ.9.OR.KFLB.EQ.0.OR.KFLB.EQ.9) THEN | |
4751 | ELSEIF(KFLA.LT.KFLB) THEN | |
4752 | ELSEIF(KFLS.EQ.1.AND.KFLA.EQ.KFLB) THEN | |
4753 | ELSE | |
4754 | LUCOMP=90 | |
4755 | ENDIF | |
4756 | ||
4757 | C...Spin 1/2 baryons. | |
4758 | ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.2) THEN | |
4759 | IF(KFLA.EQ.9.OR.KFLB.EQ.0.OR.KFLB.EQ.9.OR.KFLC.EQ.9) THEN | |
4760 | ELSEIF(KFLA.LE.KFLC.OR.KFLA.LT.KFLB) THEN | |
4761 | ELSEIF(KFLA.GE.6.OR.KFLB.GE.4.OR.KFLC.GE.4) THEN | |
4762 | LUCOMP=80+KFLA | |
4763 | ELSEIF(KFLB.LT.KFLC) THEN | |
4764 | LUCOMP=300+((KFLA+1)*KFLA*(KFLA-1))/6+(KFLC*(KFLC-1))/2+KFLB | |
4765 | ELSE | |
4766 | LUCOMP=330+((KFLA+1)*KFLA*(KFLA-1))/6+(KFLB*(KFLB-1))/2+KFLC | |
4767 | ENDIF | |
4768 | ||
4769 | C...Spin 3/2 baryons. | |
4770 | ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.4) THEN | |
4771 | IF(KFLA.EQ.9.OR.KFLB.EQ.0.OR.KFLB.EQ.9.OR.KFLC.EQ.9) THEN | |
4772 | ELSEIF(KFLA.LT.KFLB.OR.KFLB.LT.KFLC) THEN | |
4773 | ELSEIF(KFLA.GE.6.OR.KFLB.GE.4) THEN | |
4774 | LUCOMP=80+KFLA | |
4775 | ELSE | |
4776 | LUCOMP=360+((KFLA+1)*KFLA*(KFLA-1))/6+(KFLB*(KFLB-1))/2+KFLC | |
4777 | ENDIF | |
4778 | ENDIF | |
4779 | ||
4780 | RETURN | |
4781 | END | |
4782 | ||
4783 | C********************************************************************* | |
4784 | ||
4785 | SUBROUTINE LUERRM(MERR,CHMESS) | |
4786 | ||
4787 | C...Purpose: to inform user of errors in program execution. | |
4788 | COMMON/LUJETSA/N,K(9000,5),P(9000,5),V(9000,5) | |
4789 | SAVE /LUJETSA/ | |
4790 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
4791 | SAVE /LUDAT1A/ | |
4792 | CHARACTER CHMESS*(*) | |
4793 | ||
4794 | write (6,*) 'merr,chmess=',merr,chmess | |
4795 | ||
4796 | C...Write first few warnings, then be silent. | |
4797 | IF(MERR.LE.10) THEN | |
4798 | MSTU(27)=MSTU(27)+1 | |
4799 | MSTU(28)=MERR | |
4800 | IF(MSTU(25).EQ.1.AND.MSTU(27).LE.MSTU(26)) WRITE(MSTU(11),1000) | |
4801 | & MERR,MSTU(31),CHMESS | |
4802 | ||
4803 | C...Write first few errors, then be silent or stop program. | |
4804 | ELSEIF(MERR.LE.20) THEN | |
4805 | MSTU(23)=MSTU(23)+1 | |
4806 | MSTU(24)=MERR-10 | |
4807 | IF(MSTU(21).GE.1.AND.MSTU(23).LE.MSTU(22)) WRITE(MSTU(11),1100) | |
4808 | & MERR-10,MSTU(31),CHMESS | |
4809 | IF(MSTU(21).GE.2.AND.MSTU(23).GT.MSTU(22)) THEN | |
4810 | WRITE(MSTU(11),1100) MERR-10,MSTU(31),CHMESS | |
4811 | WRITE(MSTU(11),1200) | |
4812 | IF(MERR.NE.17) CALL LULIST(2) | |
4813 | STOP | |
4814 | ENDIF | |
4815 | ||
4816 | C...Stop program in case of irreparable error. | |
4817 | ELSE | |
4818 | WRITE(MSTU(11),1300) MERR-20,MSTU(31),CHMESS | |
4819 | STOP | |
4820 | ENDIF | |
4821 | ||
4822 | C...Formats for output. | |
4823 | 1000 FORMAT(/5X,'Advisory warning type',I2,' given after',I6, | |
4824 | &' LUEXEC calls:'/5X,A) | |
4825 | 1100 FORMAT(/5X,'Error type',I2,' has occured after',I6, | |
4826 | &' LUEXEC calls:'/5X,A) | |
4827 | 1200 FORMAT(5X,'Execution will be stopped after listing of last ', | |
4828 | &'event!') | |
4829 | 1300 FORMAT(/5X,'Fatal error type',I2,' has occured after',I6, | |
4830 | &' LUEXEC calls:'/5X,A/5X,'Execution will now be stopped!') | |
4831 | ||
4832 | RETURN | |
4833 | END | |
4834 | ||
4835 | C********************************************************************* | |
4836 | ||
4837 | FUNCTION ULALPS(Q2) | |
4838 | ||
4839 | C...Purpose: to give the value of alpha_strong. | |
4840 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
4841 | SAVE /LUDAT1A/ | |
4842 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
4843 | SAVE /LUDAT2A/ | |
4844 | ||
4845 | C...Constant alpha_strong trivial. | |
4846 | IF(MSTU(111).LE.0) THEN | |
4847 | ULALPS=PARU(111) | |
4848 | MSTU(118)=MSTU(112) | |
4849 | PARU(117)=0. | |
4850 | PARU(118)=PARU(111) | |
4851 | RETURN | |
4852 | ENDIF | |
4853 | ||
4854 | C...Find effective Q2, number of flavours and Lambda. | |
4855 | Q2EFF=Q2 | |
4856 | IF(MSTU(115).GE.2) Q2EFF=MAX(Q2,PARU(114)) | |
4857 | NF=MSTU(112) | |
4858 | ALAM2=PARU(112)**2 | |
4859 | 100 IF(NF.GT.MAX(2,MSTU(113))) THEN | |
4860 | Q2THR=PARU(113)*PMAS(NF,1)**2 | |
4861 | IF(Q2EFF.LT.Q2THR) THEN | |
4862 | NF=NF-1 | |
4863 | ALAM2=ALAM2*(Q2THR/ALAM2)**(2./(33.-2.*NF)) | |
4864 | GOTO 100 | |
4865 | ENDIF | |
4866 | ENDIF | |
4867 | 110 IF(NF.LT.MIN(8,MSTU(114))) THEN | |
4868 | Q2THR=PARU(113)*PMAS(NF+1,1)**2 | |
4869 | IF(Q2EFF.GT.Q2THR) THEN | |
4870 | NF=NF+1 | |
4871 | ALAM2=ALAM2*(ALAM2/Q2THR)**(2./(33.-2.*NF)) | |
4872 | GOTO 110 | |
4873 | ENDIF | |
4874 | ENDIF | |
4875 | IF(MSTU(115).EQ.1) Q2EFF=Q2EFF+ALAM2 | |
4876 | PARU(117)=SQRT(ALAM2) | |
4877 | ||
4878 | C...Evaluate first or second order alpha_strong. | |
4879 | B0=(33.-2.*NF)/6. | |
4880 | ALGQ=LOG(Q2EFF/ALAM2) | |
4881 | IF(MSTU(111).EQ.1) THEN | |
4882 | ULALPS=PARU(2)/(B0*ALGQ) | |
4883 | ELSE | |
4884 | B1=(153.-19.*NF)/6. | |
4885 | ULALPS=PARU(2)/(B0*ALGQ)*(1.-B1*LOG(ALGQ)/(B0**2*ALGQ)) | |
4886 | ENDIF | |
4887 | MSTU(118)=NF | |
4888 | PARU(118)=ULALPS | |
4889 | ||
4890 | RETURN | |
4891 | END | |
4892 | ||
4893 | C********************************************************************* | |
4894 | ||
4895 | FUNCTION ULANGL(X,Y) | |
4896 | ||
4897 | C...Purpose: to reconstruct an angle from given x and y coordinates. | |
4898 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
4899 | SAVE /LUDAT1A/ | |
4900 | ||
4901 | ULANGL=0. | |
4902 | R=SQRT(X**2+Y**2) | |
4903 | IF(R.LT.1E-20) RETURN | |
4904 | IF(ABS(X)/R.LT.0.8) THEN | |
4905 | ULANGL=SIGN(ACOS(X/R),Y) | |
4906 | ELSE | |
4907 | ULANGL=ASIN(Y/R) | |
4908 | IF(X.LT.0..AND.ULANGL.GE.0.) THEN | |
4909 | ULANGL=PARU(1)-ULANGL | |
4910 | ELSEIF(X.LT.0.) THEN | |
4911 | ULANGL=-PARU(1)-ULANGL | |
4912 | ENDIF | |
4913 | ENDIF | |
4914 | ||
4915 | RETURN | |
4916 | END | |
4917 | ||
4918 | C********************************************************************* | |
4919 | c$$$ | |
4920 | c$$$ FUNCTION RLU(IDUM) | |
4921 | c$$$ | |
4922 | c$$$C...Purpose: to generate random numbers uniformly distributed between | |
4923 | c$$$C...0 and 1, excluding the endpoints. | |
4924 | c$$$ COMMON/LUDATRA/MRLU(6),RRLU(100) | |
4925 | c$$$ SAVE /LUDATRA/ | |
4926 | c$$$ EQUIVALENCE (MRLU1,MRLU(1)),(MRLU2,MRLU(2)),(MRLU3,MRLU(3)), | |
4927 | c$$$ &(MRLU4,MRLU(4)),(MRLU5,MRLU(5)),(MRLU6,MRLU(6)), | |
4928 | c$$$ &(RRLU98,RRLU(98)),(RRLU99,RRLU(99)),(RRLU00,RRLU(100)) | |
4929 | c$$$ | |
4930 | c$$$C...Initialize generation from given seed. | |
4931 | c$$$ IDUM=IDUM | |
4932 | c$$$ IF(MRLU2.EQ.0) THEN | |
4933 | c$$$ IJ=MOD(MRLU1/30082,31329) | |
4934 | c$$$ KL=MOD(MRLU1,30082) | |
4935 | c$$$ I=MOD(IJ/177,177)+2 | |
4936 | c$$$ J=MOD(IJ,177)+2 | |
4937 | c$$$ K=MOD(KL/169,178)+1 | |
4938 | c$$$ L=MOD(KL,169) | |
4939 | c$$$ DO 110 II=1,97 | |
4940 | c$$$ S=0. | |
4941 | c$$$ T=0.5 | |
4942 | c$$$ DO 100 JJ=1,24 | |
4943 | c$$$ M=MOD(MOD(I*J,179)*K,179) | |
4944 | c$$$ I=J | |
4945 | c$$$ J=K | |
4946 | c$$$ K=M | |
4947 | c$$$ L=MOD(53*L+1,169) | |
4948 | c$$$ IF(MOD(L*M,64).GE.32) S=S+T | |
4949 | c$$$ 100 T=0.5*T | |
4950 | c$$$ 110 RRLU(II)=S | |
4951 | c$$$ TWOM24=1. | |
4952 | c$$$ DO 120 I24=1,24 | |
4953 | c$$$ 120 TWOM24=0.5*TWOM24 | |
4954 | c$$$ RRLU98=362436.*TWOM24 | |
4955 | c$$$ RRLU99=7654321.*TWOM24 | |
4956 | c$$$ RRLU00=16777213.*TWOM24 | |
4957 | c$$$ MRLU2=1 | |
4958 | c$$$ MRLU3=0 | |
4959 | c$$$ MRLU4=97 | |
4960 | c$$$ MRLU5=33 | |
4961 | c$$$ ENDIF | |
4962 | c$$$ | |
4963 | c$$$C...Generate next random number. | |
4964 | c$$$ 130 RUNI=RRLU(MRLU4)-RRLU(MRLU5) | |
4965 | c$$$ IF(RUNI.LT.0.) RUNI=RUNI+1. | |
4966 | c$$$ RRLU(MRLU4)=RUNI | |
4967 | c$$$ MRLU4=MRLU4-1 | |
4968 | c$$$ IF(MRLU4.EQ.0) MRLU4=97 | |
4969 | c$$$ MRLU5=MRLU5-1 | |
4970 | c$$$ IF(MRLU5.EQ.0) MRLU5=97 | |
4971 | c$$$ RRLU98=RRLU98-RRLU99 | |
4972 | c$$$ IF(RRLU98.LT.0.) RRLU98=RRLU98+RRLU00 | |
4973 | c$$$ RUNI=RUNI-RRLU98 | |
4974 | c$$$ IF(RUNI.LT.0.) RUNI=RUNI+1. | |
4975 | c$$$ IF(RUNI.LE.0.OR.RUNI.GE.1.) GOTO 130 | |
4976 | c$$$ | |
4977 | c$$$C...Update counters. Random number to output. | |
4978 | c$$$ MRLU3=MRLU3+1 | |
4979 | c$$$ IF(MRLU3.EQ.1000000000) THEN | |
4980 | c$$$ MRLU2=MRLU2+1 | |
4981 | c$$$ MRLU3=0 | |
4982 | c$$$ ENDIF | |
4983 | c$$$ RLU=RUNI | |
4984 | c$$$ | |
4985 | c$$$ RETURN | |
4986 | c$$$ END | |
4987 | ||
4988 | C********************************************************************* | |
4989 | ||
4990 | SUBROUTINE LUROBO(THE,PHI,BEX,BEY,BEZ) | |
4991 | ||
4992 | C...Purpose: to perform rotations and boosts. | |
4993 | IMPLICIT DOUBLE PRECISION(D) | |
4994 | COMMON/LUJETSA/N,K(9000,5),P(9000,5),V(9000,5) | |
4995 | SAVE /LUJETSA/ | |
4996 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
4997 | SAVE /LUDAT1A/ | |
4998 | DIMENSION ROT(3,3),PR(3),VR(3),DP(4),DV(4) | |
4999 | ||
5000 | C...Find range of rotation/boost. Convert boost to double precision. | |
5001 | IMIN=1 | |
5002 | IF(MSTU(1).GT.0) IMIN=MSTU(1) | |
5003 | IMAX=N | |
5004 | IF(MSTU(2).GT.0) IMAX=MSTU(2) | |
5005 | DBX=dble(BEX) | |
5006 | DBY=dble(BEY) | |
5007 | DBZ=dble(BEZ) | |
5008 | GOTO 100 | |
5009 | ||
5010 | C...Entry for specific range and double precision boost. | |
5011 | ENTRY LUDBRB(IMI,IMA,THE,PHI,DBEX,DBEY,DBEZ) | |
5012 | IMIN=IMI | |
5013 | IF(IMIN.LE.0) IMIN=1 | |
5014 | IMAX=IMA | |
5015 | IF(IMAX.LE.0) IMAX=N | |
5016 | DBX=DBEX | |
5017 | DBY=DBEY | |
5018 | DBZ=DBEZ | |
5019 | ||
5020 | C...Check range of rotation/boost. | |
5021 | 100 IF(IMIN.GT.MSTU(4).OR.IMAX.GT.MSTU(4)) THEN | |
5022 | CALL LUERRM(11,'(LUROBO:) range outside LUJETSA memory') | |
5023 | RETURN | |
5024 | ENDIF | |
5025 | ||
5026 | C...Rotate, typically from z axis to direction (theta,phi). | |
5027 | IF(THE**2+PHI**2.GT.1E-20) THEN | |
5028 | ROT(1,1)=COS(THE)*COS(PHI) | |
5029 | ROT(1,2)=-SIN(PHI) | |
5030 | ROT(1,3)=SIN(THE)*COS(PHI) | |
5031 | ROT(2,1)=COS(THE)*SIN(PHI) | |
5032 | ROT(2,2)=COS(PHI) | |
5033 | ROT(2,3)=SIN(THE)*SIN(PHI) | |
5034 | ROT(3,1)=-SIN(THE) | |
5035 | ROT(3,2)=0. | |
5036 | ROT(3,3)=COS(THE) | |
5037 | DO 130 I=IMIN,IMAX | |
5038 | IF(K(I,1).LE.0) GOTO 130 | |
5039 | DO 110 J=1,3 | |
5040 | PR(J)=P(I,J) | |
5041 | 110 VR(J)=V(I,J) | |
5042 | DO 120 J=1,3 | |
5043 | P(I,J)=ROT(J,1)*PR(1)+ROT(J,2)*PR(2)+ROT(J,3)*PR(3) | |
5044 | 120 V(I,J)=ROT(J,1)*VR(1)+ROT(J,2)*VR(2)+ROT(J,3)*VR(3) | |
5045 | 130 CONTINUE | |
5046 | ENDIF | |
5047 | ||
5048 | C...Boost, typically from rest to momentum/energy=beta. | |
5049 | IF(DBX**2+DBY**2+DBZ**2.GT.1E-20) THEN | |
5050 | DB=SQRT(DBX**2+DBY**2+DBZ**2) | |
5051 | IF(DB.GT.0.99999999D0) THEN | |
5052 | C...Rescale boost vector if too close to unity. | |
5053 | CALL LUERRM(3,'(LUROBO:) boost vector too large') | |
5054 | DBX=DBX*(0.99999999D0/DB) | |
5055 | DBY=DBY*(0.99999999D0/DB) | |
5056 | DBZ=DBZ*(0.99999999D0/DB) | |
5057 | DB=0.99999999D0 | |
5058 | ENDIF | |
5059 | DGA=1D0/SQRT(1D0-DB**2) | |
5060 | DO 150 I=IMIN,IMAX | |
5061 | IF(K(I,1).LE.0) GOTO 150 | |
5062 | DO 140 J=1,4 | |
5063 | DP(J)=dble(P(I,J)) | |
5064 | 140 DV(J)=dble(V(I,J)) | |
5065 | DBP=DBX*DP(1)+DBY*DP(2)+DBZ*DP(3) | |
5066 | DGABP=DGA*(DGA*DBP/(1D0+DGA)+DP(4)) | |
5067 | P(I,1)=sngl(DP(1)+DGABP*DBX) | |
5068 | P(I,2)=sngl(DP(2)+DGABP*DBY) | |
5069 | P(I,3)=sngl(DP(3)+DGABP*DBZ) | |
5070 | P(I,4)=sngl(DGA*(DP(4)+DBP)) | |
5071 | DBV=DBX*DV(1)+DBY*DV(2)+DBZ*DV(3) | |
5072 | DGABV=DGA*(DGA*DBV/(1D0+DGA)+DV(4)) | |
5073 | V(I,1)=sngl(DV(1)+DGABV*DBX) | |
5074 | V(I,2)=sngl(DV(2)+DGABV*DBY) | |
5075 | V(I,3)=sngl(DV(3)+DGABV*DBZ) | |
5076 | V(I,4)=sngl(DGA*(DV(4)+DBV)) | |
5077 | 150 CONTINUE | |
5078 | ENDIF | |
5079 | ||
5080 | RETURN | |
5081 | END | |
5082 | ||
5083 | C********************************************************************* | |
5084 | C THIS SUBROUTINE IS ONLY FOR THE USE OF HIJING TO ROTATE OR BOOST | |
5085 | C THE FOUR MOMENTUM ONLY | |
5086 | C********************************************************************* | |
5087 | ||
5088 | SUBROUTINE HIROBO(THE,PHI,BEX,BEY,BEZ) | |
5089 | ||
5090 | C...Purpose: to perform rotations and boosts. | |
5091 | IMPLICIT DOUBLE PRECISION(D) | |
5092 | COMMON/LUJETSA/N,K(9000,5),P(9000,5),V(9000,5) | |
5093 | SAVE /LUJETSA/ | |
5094 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
5095 | SAVE /LUDAT1A/ | |
5096 | DIMENSION ROT(3,3),PR(3),VR(3),DP(4),DV(4) | |
5097 | ||
5098 | DV(1)=DV(1) | |
5099 | VR(1)=VR(1) | |
5100 | C...Find range of rotation/boost. Convert boost to double precision. | |
5101 | IMIN=1 | |
5102 | IF(MSTU(1).GT.0) IMIN=MSTU(1) | |
5103 | IMAX=N | |
5104 | IF(MSTU(2).GT.0) IMAX=MSTU(2) | |
5105 | DBX=dble(BEX) | |
5106 | DBY=dble(BEY) | |
5107 | DBZ=dble(BEZ) | |
5108 | ||
5109 | C...Check range of rotation/boost. | |
5110 | IF(IMIN.GT.MSTU(4).OR.IMAX.GT.MSTU(4)) THEN | |
5111 | CALL LUERRM(11,'(LUROBO:) range outside LUJETSA memory') | |
5112 | RETURN | |
5113 | ENDIF | |
5114 | ||
5115 | C...Rotate, typically from z axis to direction (theta,phi). | |
5116 | IF(THE**2+PHI**2.GT.1E-20) THEN | |
5117 | ROT(1,1)=COS(THE)*COS(PHI) | |
5118 | ROT(1,2)=-SIN(PHI) | |
5119 | ROT(1,3)=SIN(THE)*COS(PHI) | |
5120 | ROT(2,1)=COS(THE)*SIN(PHI) | |
5121 | ROT(2,2)=COS(PHI) | |
5122 | ROT(2,3)=SIN(THE)*SIN(PHI) | |
5123 | ROT(3,1)=-SIN(THE) | |
5124 | ROT(3,2)=0. | |
5125 | ROT(3,3)=COS(THE) | |
5126 | DO 130 I=IMIN,IMAX | |
5127 | IF(K(I,1).LE.0) GOTO 130 | |
5128 | DO 110 J=1,3 | |
5129 | 110 PR(J)=P(I,J) | |
5130 | DO 120 J=1,3 | |
5131 | 120 P(I,J)=ROT(J,1)*PR(1)+ROT(J,2)*PR(2)+ROT(J,3)*PR(3) | |
5132 | 130 CONTINUE | |
5133 | ENDIF | |
5134 | ||
5135 | C...Boost, typically from rest to momentum/energy=beta. | |
5136 | IF(DBX**2+DBY**2+DBZ**2.GT.1E-20) THEN | |
5137 | DB=SQRT(DBX**2+DBY**2+DBZ**2) | |
5138 | IF(DB.GT.0.99999999D0) THEN | |
5139 | C...Rescale boost vector if too close to unity. | |
5140 | CALL LUERRM(3,'(LUROBO:) boost vector too large') | |
5141 | DBX=DBX*(0.99999999D0/DB) | |
5142 | DBY=DBY*(0.99999999D0/DB) | |
5143 | DBZ=DBZ*(0.99999999D0/DB) | |
5144 | DB=0.99999999D0 | |
5145 | ENDIF | |
5146 | DGA=1D0/SQRT(1D0-DB**2) | |
5147 | DO 150 I=IMIN,IMAX | |
5148 | IF(K(I,1).LE.0) GOTO 150 | |
5149 | DO 140 J=1,4 | |
5150 | 140 DP(J)=dble(P(I,J)) | |
5151 | DBP=DBX*DP(1)+DBY*DP(2)+DBZ*DP(3) | |
5152 | DGABP=DGA*(DGA*DBP/(1D0+DGA)+DP(4)) | |
5153 | P(I,1)=sngl(DP(1)+DGABP*DBX) | |
5154 | P(I,2)=sngl(DP(2)+DGABP*DBY) | |
5155 | P(I,3)=sngl(DP(3)+DGABP*DBZ) | |
5156 | P(I,4)=sngl(DGA*(DP(4)+DBP)) | |
5157 | 150 CONTINUE | |
5158 | ENDIF | |
5159 | ||
5160 | RETURN | |
5161 | END | |
5162 | ||
5163 | C********************************************************************* | |
5164 | ||
5165 | SUBROUTINE LUEDIT(MEDIT) | |
5166 | ||
5167 | C...Purpose: to perform global manipulations on the event record, | |
5168 | C...in particular to exclude unstable or undetectable partons/particles. | |
5169 | COMMON/LUJETSA/N,K(9000,5),P(9000,5),V(9000,5) | |
5170 | SAVE /LUJETSA/ | |
5171 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
5172 | SAVE /LUDAT1A/ | |
5173 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
5174 | SAVE /LUDAT2A/ | |
5175 | DIMENSION NS(2),PTS(2),PLS(2) | |
5176 | ||
5177 | C...Remove unwanted partons/particles. | |
5178 | IF((MEDIT.GE.0.AND.MEDIT.LE.3).OR.MEDIT.EQ.5) THEN | |
5179 | IMAX=N | |
5180 | IF(MSTU(2).GT.0) IMAX=MSTU(2) | |
5181 | I1=MAX(1,MSTU(1))-1 | |
5182 | DO 110 I=MAX(1,MSTU(1)),IMAX | |
5183 | IF(K(I,1).EQ.0.OR.K(I,1).GT.20) GOTO 110 | |
5184 | IF(MEDIT.EQ.1) THEN | |
5185 | IF(K(I,1).GT.10) GOTO 110 | |
5186 | ELSEIF(MEDIT.EQ.2) THEN | |
5187 | IF(K(I,1).GT.10) GOTO 110 | |
5188 | KC=LUCOMP(K(I,2)) | |
5189 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.KC.EQ.18) | |
5190 | & GOTO 110 | |
5191 | ELSEIF(MEDIT.EQ.3) THEN | |
5192 | IF(K(I,1).GT.10) GOTO 110 | |
5193 | KC=LUCOMP(K(I,2)) | |
5194 | IF(KC.EQ.0) GOTO 110 | |
5195 | IF(KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) GOTO 110 | |
5196 | ELSEIF(MEDIT.EQ.5) THEN | |
5197 | IF(K(I,1).EQ.13.OR.K(I,1).EQ.14) GOTO 110 | |
5198 | KC=LUCOMP(K(I,2)) | |
5199 | IF(KC.EQ.0) GOTO 110 | |
5200 | IF(K(I,1).GE.11.AND.KCHG(KC,2).EQ.0) GOTO 110 | |
5201 | ENDIF | |
5202 | ||
5203 | C...Pack remaining partons/particles. Origin no longer known. | |
5204 | I1=I1+1 | |
5205 | DO 100 J=1,5 | |
5206 | K(I1,J)=K(I,J) | |
5207 | P(I1,J)=P(I,J) | |
5208 | 100 V(I1,J)=V(I,J) | |
5209 | K(I1,3)=0 | |
5210 | 110 CONTINUE | |
5211 | N=I1 | |
5212 | ||
5213 | C...Selective removal of class of entries. New position of retained. | |
5214 | ELSEIF(MEDIT.GE.11.AND.MEDIT.LE.15) THEN | |
5215 | I1=0 | |
5216 | DO 120 I=1,N | |
5217 | K(I,3)=MOD(K(I,3),MSTU(5)) | |
5218 | IF(MEDIT.EQ.11.AND.K(I,1).LT.0) GOTO 120 | |
5219 | IF(MEDIT.EQ.12.AND.K(I,1).EQ.0) GOTO 120 | |
5220 | IF(MEDIT.EQ.13.AND.(K(I,1).EQ.11.OR.K(I,1).EQ.12.OR. | |
5221 | & K(I,1).EQ.15).AND.K(I,2).NE.94) GOTO 120 | |
5222 | IF(MEDIT.EQ.14.AND.(K(I,1).EQ.13.OR.K(I,1).EQ.14.OR. | |
5223 | & K(I,2).EQ.94)) GOTO 120 | |
5224 | IF(MEDIT.EQ.15.AND.K(I,1).GE.21) GOTO 120 | |
5225 | I1=I1+1 | |
5226 | K(I,3)=K(I,3)+MSTU(5)*I1 | |
5227 | 120 CONTINUE | |
5228 | ||
5229 | C...Find new event history information and replace old. | |
5230 | DO 140 I=1,N | |
5231 | IF(K(I,1).LE.0.OR.K(I,1).GT.20.OR.K(I,3)/MSTU(5).EQ.0) GOTO 140 | |
5232 | ID=I | |
5233 | 130 IM=MOD(K(ID,3),MSTU(5)) | |
5234 | IF(MEDIT.EQ.13.AND.IM.GT.0.AND.IM.LE.N) THEN | |
5235 | IF((K(IM,1).EQ.11.OR.K(IM,1).EQ.12.OR.K(IM,1).EQ.15).AND. | |
5236 | & K(IM,2).NE.94) THEN | |
5237 | ID=IM | |
5238 | GOTO 130 | |
5239 | ENDIF | |
5240 | ELSEIF(MEDIT.EQ.14.AND.IM.GT.0.AND.IM.LE.N) THEN | |
5241 | IF(K(IM,1).EQ.13.OR.K(IM,1).EQ.14.OR.K(IM,2).EQ.94) THEN | |
5242 | ID=IM | |
5243 | GOTO 130 | |
5244 | ENDIF | |
5245 | ENDIF | |
5246 | K(I,3)=MSTU(5)*(K(I,3)/MSTU(5)) | |
5247 | IF(IM.NE.0) K(I,3)=K(I,3)+K(IM,3)/MSTU(5) | |
5248 | IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) THEN | |
5249 | IF(K(I,4).GT.0.AND.K(I,4).LE.MSTU(4)) K(I,4)= | |
5250 | & K(K(I,4),3)/MSTU(5) | |
5251 | IF(K(I,5).GT.0.AND.K(I,5).LE.MSTU(4)) K(I,5)= | |
5252 | & K(K(I,5),3)/MSTU(5) | |
5253 | ELSE | |
5254 | KCM=MOD(K(I,4)/MSTU(5),MSTU(5)) | |
5255 | IF(KCM.GT.0.AND.KCM.LE.MSTU(4)) KCM=K(KCM,3)/MSTU(5) | |
5256 | KCD=MOD(K(I,4),MSTU(5)) | |
5257 | IF(KCD.GT.0.AND.KCD.LE.MSTU(4)) KCD=K(KCD,3)/MSTU(5) | |
5258 | K(I,4)=MSTU(5)**2*(K(I,4)/MSTU(5)**2)+MSTU(5)*KCM+KCD | |
5259 | KCM=MOD(K(I,5)/MSTU(5),MSTU(5)) | |
5260 | IF(KCM.GT.0.AND.KCM.LE.MSTU(4)) KCM=K(KCM,3)/MSTU(5) | |
5261 | KCD=MOD(K(I,5),MSTU(5)) | |
5262 | IF(KCD.GT.0.AND.KCD.LE.MSTU(4)) KCD=K(KCD,3)/MSTU(5) | |
5263 | K(I,5)=MSTU(5)**2*(K(I,5)/MSTU(5)**2)+MSTU(5)*KCM+KCD | |
5264 | ENDIF | |
5265 | 140 CONTINUE | |
5266 | ||
5267 | C...Pack remaining entries. | |
5268 | I1=0 | |
5269 | DO 160 I=1,N | |
5270 | IF(K(I,3)/MSTU(5).EQ.0) GOTO 160 | |
5271 | I1=I1+1 | |
5272 | DO 150 J=1,5 | |
5273 | K(I1,J)=K(I,J) | |
5274 | P(I1,J)=P(I,J) | |
5275 | 150 V(I1,J)=V(I,J) | |
5276 | K(I1,3)=MOD(K(I1,3),MSTU(5)) | |
5277 | 160 CONTINUE | |
5278 | N=I1 | |
5279 | ||
5280 | C...Save top entries at bottom of LUJETSA commonblock. | |
5281 | ELSEIF(MEDIT.EQ.21) THEN | |
5282 | IF(2*N.GE.MSTU(4)) THEN | |
5283 | CALL LUERRM(11,'(LUEDIT:) no more memory left in LUJETSA') | |
5284 | RETURN | |
5285 | ENDIF | |
5286 | DO 170 I=1,N | |
5287 | DO 170 J=1,5 | |
5288 | K(MSTU(4)-I,J)=K(I,J) | |
5289 | P(MSTU(4)-I,J)=P(I,J) | |
5290 | 170 V(MSTU(4)-I,J)=V(I,J) | |
5291 | MSTU(32)=N | |
5292 | ||
5293 | C...Restore bottom entries of commonblock LUJETSA to top. | |
5294 | ELSEIF(MEDIT.EQ.22) THEN | |
5295 | DO 180 I=1,MSTU(32) | |
5296 | DO 180 J=1,5 | |
5297 | K(I,J)=K(MSTU(4)-I,J) | |
5298 | P(I,J)=P(MSTU(4)-I,J) | |
5299 | 180 V(I,J)=V(MSTU(4)-I,J) | |
5300 | N=MSTU(32) | |
5301 | ||
5302 | C...Mark primary entries at top of commonblock LUJETSA as untreated. | |
5303 | ELSEIF(MEDIT.EQ.23) THEN | |
5304 | I1=0 | |
5305 | DO 190 I=1,N | |
5306 | KH=K(I,3) | |
5307 | IF(KH.GE.1) THEN | |
5308 | IF(K(KH,1).GT.20) KH=0 | |
5309 | ENDIF | |
5310 | IF(KH.NE.0) GOTO 200 | |
5311 | I1=I1+1 | |
5312 | 190 IF(K(I,1).GT.10.AND.K(I,1).LE.20) K(I,1)=K(I,1)-10 | |
5313 | 200 N=I1 | |
5314 | ||
5315 | C...Place largest axis along z axis and second largest in xy plane. | |
5316 | ELSEIF(MEDIT.EQ.31.OR.MEDIT.EQ.32) THEN | |
5317 | CALL LUDBRB(1,N+MSTU(3),0.,-ULANGL(P(MSTU(61),1), | |
5318 | & P(MSTU(61),2)),0D0,0D0,0D0) | |
5319 | CALL LUDBRB(1,N+MSTU(3),-ULANGL(P(MSTU(61),3), | |
5320 | & P(MSTU(61),1)),0.,0D0,0D0,0D0) | |
5321 | CALL LUDBRB(1,N+MSTU(3),0.,-ULANGL(P(MSTU(61)+1,1), | |
5322 | & P(MSTU(61)+1,2)),0D0,0D0,0D0) | |
5323 | IF(MEDIT.EQ.31) RETURN | |
5324 | ||
5325 | C...Rotate to put slim jet along +z axis. | |
5326 | DO 210 IS=1,2 | |
5327 | NS(IS)=0 | |
5328 | PTS(IS)=0. | |
5329 | 210 PLS(IS)=0. | |
5330 | DO 220 I=1,N | |
5331 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 220 | |
5332 | IF(MSTU(41).GE.2) THEN | |
5333 | KC=LUCOMP(K(I,2)) | |
5334 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. | |
5335 | & KC.EQ.18) GOTO 220 | |
5336 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) | |
5337 | & GOTO 220 | |
5338 | ENDIF | |
5339 | IS=int(2.-SIGN(0.5,P(I,3))) | |
5340 | NS(IS)=NS(IS)+1 | |
5341 | PTS(IS)=PTS(IS)+SQRT(P(I,1)**2+P(I,2)**2) | |
5342 | 220 CONTINUE | |
5343 | IF(NS(1)*PTS(2)**2.LT.NS(2)*PTS(1)**2) | |
5344 | & CALL LUDBRB(1,N+MSTU(3),PARU(1),0.,0D0,0D0,0D0) | |
5345 | ||
5346 | C...Rotate to put second largest jet into -z,+x quadrant. | |
5347 | DO 230 I=1,N | |
5348 | IF(P(I,3).GE.0.) GOTO 230 | |
5349 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 230 | |
5350 | IF(MSTU(41).GE.2) THEN | |
5351 | KC=LUCOMP(K(I,2)) | |
5352 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. | |
5353 | & KC.EQ.18) GOTO 230 | |
5354 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) | |
5355 | & GOTO 230 | |
5356 | ENDIF | |
5357 | IS=int(2.-SIGN(0.5,P(I,1))) | |
5358 | PLS(IS)=PLS(IS)-P(I,3) | |
5359 | 230 CONTINUE | |
5360 | IF(PLS(2).GT.PLS(1)) CALL LUDBRB(1,N+MSTU(3),0.,PARU(1), | |
5361 | & 0D0,0D0,0D0) | |
5362 | ENDIF | |
5363 | ||
5364 | RETURN | |
5365 | END | |
5366 | ||
5367 | C********************************************************************* | |
5368 | ||
5369 | SUBROUTINE LULIST(MLIST) | |
5370 | ||
5371 | C...Purpose: to give program heading, or list an event, or particle | |
5372 | C...data, or current parameter values. | |
5373 | COMMON/LUJETSA/N,K(9000,5),P(9000,5),V(9000,5) | |
5374 | SAVE /LUJETSA/ | |
5375 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
5376 | SAVE /LUDAT1A/ | |
5377 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
5378 | SAVE /LUDAT2A/ | |
5379 | COMMON/LUDAT3A/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) | |
5380 | SAVE /LUDAT3A/ | |
5381 | CHARACTER CHAP*16,CHAC*16,CHAN*16,CHAD(5)*16,CHMO(12)*3,CHDL(7)*4 | |
5382 | DIMENSION PS(6) | |
5383 | DATA CHMO/'Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep', | |
5384 | &'Oct','Nov','Dec'/,CHDL/'(())',' ','()','!!','<>','==','(==)'/ | |
5385 | ||
5386 | CHMO(1)=CHMO(1) | |
5387 | C...Initialization printout: version number and date of last change. | |
5388 | C IF(MLIST.EQ.0.OR.MSTU(12).EQ.1) THEN | |
5389 | C WRITE(MSTU(11),1000) MSTU(181),MSTU(182),MSTU(185), | |
5390 | C & CHMO(MSTU(184)),MSTU(183) | |
5391 | C MSTU(12)=0 | |
5392 | C IF(MLIST.EQ.0) RETURN | |
5393 | C ENDIF | |
5394 | ||
5395 | C...List event data, including additional lines after N. | |
5396 | IF(MLIST.GE.1.AND.MLIST.LE.3) THEN | |
5397 | IF(MLIST.EQ.1) WRITE(MSTU(11),1100) | |
5398 | IF(MLIST.EQ.2) WRITE(MSTU(11),1200) | |
5399 | IF(MLIST.EQ.3) WRITE(MSTU(11),1300) | |
5400 | LMX=12 | |
5401 | IF(MLIST.GE.2) LMX=16 | |
5402 | ISTR=0 | |
5403 | IMAX=N | |
5404 | IF(MSTU(2).GT.0) IMAX=MSTU(2) | |
5405 | DO 120 I=MAX(1,MSTU(1)),MAX(IMAX,N+MAX(0,MSTU(3))) | |
5406 | IF((I.GT.IMAX.AND.I.LE.N).OR.K(I,1).LT.0) GOTO 120 | |
5407 | ||
5408 | C...Get particle name, pad it and check it is not too long. | |
5409 | CALL LUNAME(K(I,2),CHAP) | |
5410 | LEN=0 | |
5411 | DO 100 LEM=1,16 | |
5412 | 100 IF(CHAP(LEM:LEM).NE.' ') LEN=LEM | |
5413 | MDL=(K(I,1)+19)/10 | |
5414 | LDL=0 | |
5415 | IF(MDL.EQ.2.OR.MDL.GE.8) THEN | |
5416 | CHAC=CHAP | |
5417 | IF(LEN.GT.LMX) CHAC(LMX:LMX)='?' | |
5418 | ELSE | |
5419 | LDL=1 | |
5420 | IF(MDL.EQ.1.OR.MDL.EQ.7) LDL=2 | |
5421 | IF(LEN.EQ.0) THEN | |
5422 | CHAC=CHDL(MDL)(1:2*LDL)//' ' | |
5423 | ELSE | |
5424 | CHAC=CHDL(MDL)(1:LDL)//CHAP(1:MIN(LEN,LMX-2*LDL))// | |
5425 | & CHDL(MDL)(LDL+1:2*LDL)//' ' | |
5426 | IF(LEN+2*LDL.GT.LMX) CHAC(LMX:LMX)='?' | |
5427 | ENDIF | |
5428 | ENDIF | |
5429 | ||
5430 | C...Add information on string connection. | |
5431 | IF(K(I,1).EQ.1.OR.K(I,1).EQ.2.OR.K(I,1).EQ.11.OR.K(I,1).EQ.12) | |
5432 | & THEN | |
5433 | KC=LUCOMP(K(I,2)) | |
5434 | KCC=0 | |
5435 | IF(KC.NE.0) KCC=KCHG(KC,2) | |
5436 | IF(KCC.NE.0.AND.ISTR.EQ.0) THEN | |
5437 | ISTR=1 | |
5438 | IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='A' | |
5439 | ELSEIF(KCC.NE.0.AND.(K(I,1).EQ.2.OR.K(I,1).EQ.12)) THEN | |
5440 | IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='I' | |
5441 | ELSEIF(KCC.NE.0) THEN | |
5442 | ISTR=0 | |
5443 | IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='V' | |
5444 | ENDIF | |
5445 | ENDIF | |
5446 | ||
5447 | C...Write data for particle/jet. | |
5448 | IF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.9999.) THEN | |
5449 | WRITE(MSTU(11),1400) I,CHAC(1:12),(K(I,J1),J1=1,3), | |
5450 | & (P(I,J2),J2=1,5) | |
5451 | ELSEIF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.99999.) THEN | |
5452 | WRITE(MSTU(11),1500) I,CHAC(1:12),(K(I,J1),J1=1,3), | |
5453 | & (P(I,J2),J2=1,5) | |
5454 | ELSEIF(MLIST.EQ.1) THEN | |
5455 | WRITE(MSTU(11),1600) I,CHAC(1:12),(K(I,J1),J1=1,3), | |
5456 | & (P(I,J2),J2=1,5) | |
5457 | ELSEIF(MSTU(5).EQ.10000.AND.(K(I,1).EQ.3.OR.K(I,1).EQ.13.OR. | |
5458 | & K(I,1).EQ.14)) THEN | |
5459 | WRITE(MSTU(11),1700) I,CHAC,(K(I,J1),J1=1,3), | |
5460 | & K(I,4)/100000000,MOD(K(I,4)/10000,10000),MOD(K(I,4),10000), | |
5461 | & K(I,5)/100000000,MOD(K(I,5)/10000,10000),MOD(K(I,5),10000), | |
5462 | & (P(I,J2),J2=1,5) | |
5463 | ELSE | |
5464 | WRITE(MSTU(11),1800) I,CHAC,(K(I,J1),J1=1,5),(P(I,J2),J2=1,5) | |
5465 | ENDIF | |
5466 | IF(MLIST.EQ.3) WRITE(MSTU(11),1900) (V(I,J),J=1,5) | |
5467 | ||
5468 | C...Insert extra separator lines specified by user. | |
5469 | IF(MSTU(70).GE.1) THEN | |
5470 | ISEP=0 | |
5471 | DO 110 J=1,MIN(10,MSTU(70)) | |
5472 | 110 IF(I.EQ.MSTU(70+J)) ISEP=1 | |
5473 | IF(ISEP.EQ.1.AND.MLIST.EQ.1) WRITE(MSTU(11),2000) | |
5474 | IF(ISEP.EQ.1.AND.MLIST.GE.2) WRITE(MSTU(11),2100) | |
5475 | ENDIF | |
5476 | 120 CONTINUE | |
5477 | ||
5478 | C...Sum of charges and momenta. | |
5479 | DO 130 J=1,6 | |
5480 | 130 PS(J)=PLU(0,J) | |
5481 | IF(MLIST.EQ.1.AND.ABS(PS(4)).LT.9999.) THEN | |
5482 | WRITE(MSTU(11),2200) PS(6),(PS(J),J=1,5) | |
5483 | ELSEIF(MLIST.EQ.1.AND.ABS(PS(4)).LT.99999.) THEN | |
5484 | WRITE(MSTU(11),2300) PS(6),(PS(J),J=1,5) | |
5485 | ELSEIF(MLIST.EQ.1) THEN | |
5486 | WRITE(MSTU(11),2400) PS(6),(PS(J),J=1,5) | |
5487 | ELSE | |
5488 | WRITE(MSTU(11),2500) PS(6),(PS(J),J=1,5) | |
5489 | ENDIF | |
5490 | ||
5491 | C...Give simple list of KF codes defined in program. | |
5492 | ELSEIF(MLIST.EQ.11) THEN | |
5493 | WRITE(MSTU(11),2600) | |
5494 | DO 140 KF=1,40 | |
5495 | CALL LUNAME(KF,CHAP) | |
5496 | CALL LUNAME(-KF,CHAN) | |
5497 | IF(CHAP.NE.' '.AND.CHAN.EQ.' ') WRITE(MSTU(11),2700) KF,CHAP | |
5498 | 140 IF(CHAN.NE.' ') WRITE(MSTU(11),2700) KF,CHAP,-KF,CHAN | |
5499 | DO 150 KFLS=1,3,2 | |
5500 | DO 150 KFLA=1,8 | |
5501 | DO 150 KFLB=1,KFLA-(3-KFLS)/2 | |
5502 | KF=1000*KFLA+100*KFLB+KFLS | |
5503 | CALL LUNAME(KF,CHAP) | |
5504 | CALL LUNAME(-KF,CHAN) | |
5505 | 150 WRITE(MSTU(11),2700) KF,CHAP,-KF,CHAN | |
5506 | DO 170 KMUL=0,5 | |
5507 | KFLS=3 | |
5508 | IF(KMUL.EQ.0.OR.KMUL.EQ.3) KFLS=1 | |
5509 | IF(KMUL.EQ.5) KFLS=5 | |
5510 | KFLR=0 | |
5511 | IF(KMUL.EQ.2.OR.KMUL.EQ.3) KFLR=1 | |
5512 | IF(KMUL.EQ.4) KFLR=2 | |
5513 | DO 170 KFLB=1,8 | |
5514 | DO 160 KFLC=1,KFLB-1 | |
5515 | KF=10000*KFLR+100*KFLB+10*KFLC+KFLS | |
5516 | CALL LUNAME(KF,CHAP) | |
5517 | CALL LUNAME(-KF,CHAN) | |
5518 | 160 WRITE(MSTU(11),2700) KF,CHAP,-KF,CHAN | |
5519 | KF=10000*KFLR+110*KFLB+KFLS | |
5520 | CALL LUNAME(KF,CHAP) | |
5521 | 170 WRITE(MSTU(11),2700) KF,CHAP | |
5522 | KF=130 | |
5523 | CALL LUNAME(KF,CHAP) | |
5524 | WRITE(MSTU(11),2700) KF,CHAP | |
5525 | KF=310 | |
5526 | CALL LUNAME(KF,CHAP) | |
5527 | WRITE(MSTU(11),2700) KF,CHAP | |
5528 | DO 190 KFLSP=1,3 | |
5529 | KFLS=2+2*(KFLSP/3) | |
5530 | DO 190 KFLA=1,8 | |
5531 | DO 190 KFLB=1,KFLA | |
5532 | DO 180 KFLC=1,KFLB | |
5533 | IF(KFLSP.EQ.1.AND.(KFLA.EQ.KFLB.OR.KFLB.EQ.KFLC)) GOTO 180 | |
5534 | IF(KFLSP.EQ.2.AND.KFLA.EQ.KFLC) GOTO 180 | |
5535 | IF(KFLSP.EQ.1) KF=1000*KFLA+100*KFLC+10*KFLB+KFLS | |
5536 | IF(KFLSP.GE.2) KF=1000*KFLA+100*KFLB+10*KFLC+KFLS | |
5537 | CALL LUNAME(KF,CHAP) | |
5538 | CALL LUNAME(-KF,CHAN) | |
5539 | WRITE(MSTU(11),2700) KF,CHAP,-KF,CHAN | |
5540 | 180 CONTINUE | |
5541 | 190 CONTINUE | |
5542 | ||
5543 | C...List parton/particle data table. Check whether to be listed. | |
5544 | ELSEIF(MLIST.EQ.12) THEN | |
5545 | WRITE(MSTU(11),2800) | |
5546 | MSTJ24=MSTJ(24) | |
5547 | MSTJ(24)=0 | |
5548 | KFMAX=20883 | |
5549 | IF(MSTU(2).NE.0) KFMAX=MSTU(2) | |
5550 | DO 220 KF=MAX(1,MSTU(1)),KFMAX | |
5551 | KC=LUCOMP(KF) | |
5552 | IF(KC.EQ.0) GOTO 220 | |
5553 | IF(MSTU(14).EQ.0.AND.KF.GT.100.AND.KC.LE.100) GOTO 220 | |
5554 | IF(MSTU(14).GT.0.AND.KF.GT.100.AND.MAX(MOD(KF/1000,10), | |
5555 | & MOD(KF/100,10)).GT.MSTU(14)) GOTO 220 | |
5556 | ||
5557 | C...Find particle name and mass. Print information. | |
5558 | CALL LUNAME(KF,CHAP) | |
5559 | IF(KF.LE.100.AND.CHAP.EQ.' '.AND.MDCY(KC,2).EQ.0) GOTO 220 | |
5560 | CALL LUNAME(-KF,CHAN) | |
5561 | PM=ULMASS(KF) | |
5562 | WRITE(MSTU(11),2900) KF,KC,CHAP,CHAN,KCHG(KC,1),KCHG(KC,2), | |
5563 | & KCHG(KC,3),PM,PMAS(KC,2),PMAS(KC,3),PMAS(KC,4),MDCY(KC,1) | |
5564 | ||
5565 | C...Particle decay: channel number, branching ration, matrix element, | |
5566 | C...decay products. | |
5567 | IF(KF.GT.100.AND.KC.LE.100) GOTO 220 | |
5568 | DO 210 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1 | |
5569 | DO 200 J=1,5 | |
5570 | 200 CALL LUNAME(KFDP(IDC,J),CHAD(J)) | |
5571 | 210 WRITE(MSTU(11),3000) IDC,MDME(IDC,1),MDME(IDC,2),BRAT(IDC), | |
5572 | & (CHAD(J),J=1,5) | |
5573 | 220 CONTINUE | |
5574 | MSTJ(24)=MSTJ24 | |
5575 | ||
5576 | C...List parameter value table. | |
5577 | ELSEIF(MLIST.EQ.13) THEN | |
5578 | WRITE(MSTU(11),3100) | |
5579 | DO 230 I=1,200 | |
5580 | 230 WRITE(MSTU(11),3200) I,MSTU(I),PARU(I),MSTJ(I),PARJ(I),PARF(I) | |
5581 | ENDIF | |
5582 | ||
5583 | C...Format statements for output on unit MSTU(11) (by default 6). | |
5584 | clin 1000 FORMAT(///20X,'The Lund Monte Carlo - JETSET version ',I1,'.',I1/ | |
5585 | clin &20X,'** Last date of change: ',I2,1X,A3,1X,I4,' **'/) | |
5586 | 1100 FORMAT(///28X,'Event listing (summary)'//4X,'I particle/jet KS', | |
5587 | &5X,'KF orig p_x p_y p_z E m'/) | |
5588 | 1200 FORMAT(///28X,'Event listing (standard)'//4X,'I particle/jet', | |
5589 | &' K(I,1) K(I,2) K(I,3) K(I,4) K(I,5) P(I,1)', | |
5590 | &' P(I,2) P(I,3) P(I,4) P(I,5)'/) | |
5591 | 1300 FORMAT(///28X,'Event listing (with vertices)'//4X,'I particle/j', | |
5592 | &'et K(I,1) K(I,2) K(I,3) K(I,4) K(I,5) P(I,1)', | |
5593 | &' P(I,2) P(I,3) P(I,4) P(I,5)'/73X, | |
5594 | &'V(I,1) V(I,2) V(I,3) V(I,4) V(I,5)'/) | |
5595 | 1400 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.3) | |
5596 | 1500 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.2) | |
5597 | 1600 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.1) | |
5598 | 1700 FORMAT(1X,I4,2X,A16,1X,I3,1X,I8,2X,I4,2(3X,I1,2I4),5F13.5) | |
5599 | 1800 FORMAT(1X,I4,2X,A16,1X,I3,1X,I8,2X,I4,2(3X,I9),5F13.5) | |
5600 | 1900 FORMAT(66X,5(1X,F12.3)) | |
5601 | 2000 FORMAT(1X,78('=')) | |
5602 | 2100 FORMAT(1X,130('=')) | |
5603 | 2200 FORMAT(19X,'sum:',F6.2,5X,5F9.3) | |
5604 | 2300 FORMAT(19X,'sum:',F6.2,5X,5F9.2) | |
5605 | 2400 FORMAT(19X,'sum:',F6.2,5X,5F9.1) | |
5606 | 2500 FORMAT(19X,'sum charge:',F6.2,3X,'sum momentum and inv. mass:', | |
5607 | &5F13.5) | |
5608 | 2600 FORMAT(///20X,'List of KF codes in program'/) | |
5609 | 2700 FORMAT(4X,I6,4X,A16,6X,I6,4X,A16) | |
5610 | 2800 FORMAT(///30X,'Particle/parton data table'//5X,'KF',5X,'KC',4X, | |
5611 | &'particle',8X,'antiparticle',6X,'chg col anti',8X,'mass',7X, | |
5612 | &'width',7X,'w-cut',5X,'lifetime',1X,'decay'/11X,'IDC',1X,'on/off', | |
5613 | &1X,'ME',3X,'Br.rat.',4X,'decay products') | |
5614 | 2900 FORMAT(/1X,I6,3X,I4,4X,A16,A16,3I5,1X,F12.5,2(1X,F11.5), | |
5615 | &2X,F12.5,3X,I2) | |
5616 | 3000 FORMAT(10X,I4,2X,I3,2X,I3,2X,F8.5,4X,5A16) | |
5617 | 3100 FORMAT(///20X,'Parameter value table'//4X,'I',3X,'MSTU(I)', | |
5618 | &8X,'PARU(I)',3X,'MSTJ(I)',8X,'PARJ(I)',8X,'PARF(I)') | |
5619 | 3200 FORMAT(1X,I4,1X,I9,1X,F14.5,1X,I9,1X,F14.5,1X,F14.5) | |
5620 | ||
5621 | RETURN | |
5622 | END | |
5623 | ||
5624 | C********************************************************************* | |
5625 | ||
5626 | FUNCTION PLU(I,J) | |
5627 | ||
5628 | C...Purpose: to provide various real-valued event related data. | |
5629 | COMMON/LUJETSA/N,K(9000,5),P(9000,5),V(9000,5) | |
5630 | SAVE /LUJETSA/ | |
5631 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
5632 | SAVE /LUDAT1A/ | |
5633 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
5634 | SAVE /LUDAT2A/ | |
5635 | DIMENSION PSUM(4) | |
5636 | ||
5637 | C...Set default value. For I = 0 sum of momenta or charges, | |
5638 | C...or invariant mass of system. | |
5639 | PLU=0. | |
5640 | IF(I.LT.0.OR.I.GT.MSTU(4).OR.J.LE.0) THEN | |
5641 | ELSEIF(I.EQ.0.AND.J.LE.4) THEN | |
5642 | DO 100 I1=1,N | |
5643 | 100 IF(K(I1,1).GT.0.AND.K(I1,1).LE.10) PLU=PLU+P(I1,J) | |
5644 | ELSEIF(I.EQ.0.AND.J.EQ.5) THEN | |
5645 | DO 110 J1=1,4 | |
5646 | PSUM(J1)=0. | |
5647 | DO 110 I1=1,N | |
5648 | 110 IF(K(I1,1).GT.0.AND.K(I1,1).LE.10) PSUM(J1)=PSUM(J1)+P(I1,J1) | |
5649 | PLU=SQRT(MAX(0.,PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-PSUM(3)**2)) | |
5650 | ELSEIF(I.EQ.0.AND.J.EQ.6) THEN | |
5651 | DO 120 I1=1,N | |
5652 | 120 IF(K(I1,1).GT.0.AND.K(I1,1).LE.10) PLU=PLU+LUCHGE(K(I1,2))/3. | |
5653 | ELSEIF(I.EQ.0) THEN | |
5654 | ||
5655 | C...Direct readout of P matrix. | |
5656 | ELSEIF(J.LE.5) THEN | |
5657 | PLU=P(I,J) | |
5658 | ||
5659 | C...Charge, total momentum, transverse momentum, transverse mass. | |
5660 | ELSEIF(J.LE.12) THEN | |
5661 | IF(J.EQ.6) PLU=LUCHGE(K(I,2))/3. | |
5662 | IF(J.EQ.7.OR.J.EQ.8) PLU=P(I,1)**2+P(I,2)**2+P(I,3)**2 | |
5663 | IF(J.EQ.9.OR.J.EQ.10) PLU=P(I,1)**2+P(I,2)**2 | |
5664 | IF(J.EQ.11.OR.J.EQ.12) PLU=P(I,5)**2+P(I,1)**2+P(I,2)**2 | |
5665 | IF(J.EQ.8.OR.J.EQ.10.OR.J.EQ.12) PLU=SQRT(PLU) | |
5666 | ||
5667 | C...Theta and phi angle in radians or degrees. | |
5668 | ELSEIF(J.LE.16) THEN | |
5669 | IF(J.LE.14) PLU=ULANGL(P(I,3),SQRT(P(I,1)**2+P(I,2)**2)) | |
5670 | IF(J.GE.15) PLU=ULANGL(P(I,1),P(I,2)) | |
5671 | IF(J.EQ.14.OR.J.EQ.16) PLU=PLU*180./PARU(1) | |
5672 | ||
5673 | C...True rapidity, rapidity with pion mass, pseudorapidity. | |
5674 | ELSEIF(J.LE.19) THEN | |
5675 | PMR=0. | |
5676 | IF(J.EQ.17) PMR=P(I,5) | |
5677 | IF(J.EQ.18) PMR=ULMASS(211) | |
5678 | PR=MAX(1E-20,PMR**2+P(I,1)**2+P(I,2)**2) | |
5679 | PLU=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/SQRT(PR), | |
5680 | & 1E20)),P(I,3)) | |
5681 | ||
5682 | C...Energy and momentum fractions (only to be used in CM frame). | |
5683 | ELSEIF(J.LE.25) THEN | |
5684 | IF(J.EQ.20) PLU=2.*SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)/PARU(21) | |
5685 | IF(J.EQ.21) PLU=2.*P(I,3)/PARU(21) | |
5686 | IF(J.EQ.22) PLU=2.*SQRT(P(I,1)**2+P(I,2)**2)/PARU(21) | |
5687 | IF(J.EQ.23) PLU=2.*P(I,4)/PARU(21) | |
5688 | IF(J.EQ.24) PLU=(P(I,4)+P(I,3))/PARU(21) | |
5689 | IF(J.EQ.25) PLU=(P(I,4)-P(I,3))/PARU(21) | |
5690 | ENDIF | |
5691 | ||
5692 | RETURN | |
5693 | END | |
5694 | ||
5695 | C********************************************************************* | |
5696 | ||
5697 | BLOCK DATA LUDATA | |
5698 | ||
5699 | C...Purpose: to give default values to parameters and particle and | |
5700 | C...decay data. | |
5701 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
5702 | SAVE /LUDAT1A/ | |
5703 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
5704 | SAVE /LUDAT2A/ | |
5705 | COMMON/LUDAT3A/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) | |
5706 | SAVE /LUDAT3A/ | |
5707 | COMMON/LUDAT4A/CHAF(500) | |
5708 | CHARACTER CHAF*8 | |
5709 | SAVE /LUDAT4A/ | |
5710 | COMMON/LUDATRA/MRLU(6),RRLU(100) | |
5711 | SAVE /LUDATRA/ | |
5712 | ||
5713 | C...LUDAT1A, containing status codes and most parameters. | |
5714 | DATA MSTU/ | |
5715 | & 0, 0, 0, 9000,10000, 500, 2000, 0, 0, 2, | |
5716 | 1 6, 1, 1, 0, 1, 1, 0, 0, 0, 0, | |
5717 | 2 2, 10, 0, 0, 1, 10, 0, 0, 0, 0, | |
5718 | 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
5719 | 4 2, 2, 1, 4, 2, 1, 1, 0, 0, 0, | |
5720 | 5 25, 24, 0, 1, 0, 0, 0, 0, 0, 0, | |
5721 | 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
5722 | 7 40*0, | |
5723 | 1 1, 5, 3, 5, 0, 0, 0, 0, 0, 0, | |
5724 | 2 60*0, | |
5725 | 8 7, 2, 1989, 11, 25, 0, 0, 0, 0, 0, | |
5726 | 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ | |
5727 | DATA PARU/ | |
5728 | & 3.1415927, 6.2831854, 0.1973, 5.068, 0.3894, 2.568, 4*0., | |
5729 | 1 0.001, 0.09, 0.01, 0., 0., 0., 0., 0., 0., 0., | |
5730 | 2 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., | |
5731 | 3 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., | |
5732 | 4 2.0, 1.0, 0.25, 2.5, 0.05, 0., 0., 0.0001, 0., 0., | |
5733 | 5 2.5, 1.5, 7.0, 1.0, 0.5, 2.0, 3.2, 0., 0., 0., | |
5734 | 6 40*0., | |
5735 | & 0.0072974, 0.230, 0., 0., 0., 0., 0., 0., 0., 0., | |
5736 | 1 0.20, 0.25, 1.0, 4.0, 0., 0., 0., 0., 0., 0., | |
5737 | 2 1.0, 0., 0., 0., 0., 0., 0., 0., 0., 0., | |
5738 | 3 70*0./ | |
5739 | DATA MSTJ/ | |
5740 | & 1, 3, 0, 0, 0, 0, 0, 0, 0, 0, | |
5741 | 1 1, 2, 0, 1, 0, 0, 0, 0, 0, 0, | |
5742 | 2 2, 1, 1, 2, 1, 0, 0, 0, 0, 0, | |
5743 | 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
5744 | 4 1, 2, 4, 2, 5, 0, 1, 0, 0, 0, | |
5745 | 5 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, | |
5746 | 6 40*0, | |
5747 | & 5, 2, 7, 5, 1, 1, 0, 2, 0, 1, | |
5748 | 1 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, | |
5749 | 2 80*0/ | |
5750 | DATA PARJ/ | |
5751 | & 0.10, 0.30, 0.40, 0.05, 0.50, 0.50, 0.50, 0., 0., 0., | |
5752 | 1 0.50, 0.60, 0.75, 0., 0., 0., 0., 1.0, 1.0, 0., | |
5753 | 2 0.35, 1.0, 0., 0., 0., 0., 0., 0., 0., 0., | |
5754 | 3 0.10, 1.0, 0.8, 1.5, 0.8, 2.0, 0.2, 2.5, 0.6, 2.5, | |
5755 | 4 0.5, 0.9, 0.5, 0.9, 0.5, 0., 0., 0., 0., 0., | |
5756 | 5 0.77, 0.77, 0.77, 0., 0., 0., 0., 0., 1.0, 0., | |
5757 | 6 4.5, 0.7, 0., 0.003, 0.5, 0.5, 0., 0., 0., 0., | |
5758 | 7 10., 1000., 100., 1000., 0., 0., 0., 0., 0., 0., | |
5759 | 8 0.4, 1.0, 1.0, 0., 10., 10., 0., 0., 0., 0., | |
5760 | 9 0.02, 1.0, 0.2, 0., 0., 0., 0., 0., 0., 0., | |
5761 | & 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., | |
5762 | 1 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., | |
5763 | 2 1.5, 0.5, 91.2, 2.40, 0.02, 2.0, 1.0, 0.25,0.002, 0., | |
5764 | 3 0., 0., 0., 0., 0.01, 0.99, 0., 0., 0.2, 0., | |
5765 | 4 60*0./ | |
5766 | ||
5767 | C...LUDAT2A, with particle data and flavour treatment parameters. | |
5768 | DATA (KCHG(I,1),I= 1, 500)/-1,2,-1,2,-1,2,-1,2,2*0,-3,0,-3,0, | |
5769 | &-3,0,-3,6*0,3,9*0,3,2*0,3,46*0,2,-1,2,-1,2,3,11*0,3,0,2*3, | |
5770 | &0,3,0,3,12*0,3,0,2*3,0,3,0,3,12*0,3,0,2*3,0,3,0,3,12*0,3,0,2*3,0, | |
5771 | &3,0,3,12*0,3,0,2*3,0,3,0,3,12*0,3,0,2*3,0,3,0,3,72*0,3,0,3,28*0, | |
5772 | &3,2*0,3,8*0,-3,8*0,3,0,-3,0,3,-3,3*0,3,6,0,3,5*0,-3,0,3,-3,0,-3, | |
5773 | &4*0,-3,0,3,6,-3,0,3,-3,0,-3,0,3,6,0,3,5*0,-3,0,3,-3,0,-3,114*0/ | |
5774 | DATA (KCHG(I,2),I= 1, 500)/8*1,12*0,2,68*0,-1,410*0/ | |
5775 | DATA (KCHG(I,3),I= 1, 500)/8*1,2*0,8*1,5*0,1,9*0,1,2*0,1,2*0,1, | |
5776 | &41*0,1,0,7*1,10*0,9*1,11*0,9*1,11*0,9*1,11*0,9*1,11*0,9*1, | |
5777 | &11*0,9*1,71*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, | |
5778 | &0,6*1,4*0,6*1,4*0,16*1,4*0,6*1,114*0/ | |
5779 | DATA (PMAS(I,1),I= 1, 500)/.0099,.0056,.199,1.35,5.,90.,120., | |
5780 | &200.,2*0.,.00051,0.,.1057,0.,1.7841,0.,60.,5*0.,91.2,80.,15., | |
5781 | &6*0.,300.,900.,600.,300.,900.,300.,2*0.,5000.,60*0.,.1396,.4977, | |
5782 | &.4936,1.8693,1.8645,1.9693,5.2794,5.2776,5.47972,0.,.135,.5488, | |
5783 | &.9575,2.9796,9.4,117.99,238.,397.,2*0.,.7669,.8962,.8921, | |
5784 | &2.0101,2.0071,2.1127,2*5.3354,5.5068,0.,.77,.782,1.0194,3.0969, | |
5785 | &9.4603,118.,238.,397.,2*0.,1.233,2*1.3,2*2.322,2.51,2*5.73,5.97, | |
5786 | &0.,1.233,1.17,1.41,3.46,9.875,118.42,238.42,397.42,2*0., | |
5787 | &.983,2*1.429,2*2.272,2.46,2*5.68,5.92,0.,.983,1.,1.4,3.4151, | |
5788 | &9.8598,118.4,238.4,397.4,2*0.,1.26,2*1.401,2*2.372, | |
5789 | &2.56,2*5.78,6.02,0.,1.26,1.283,1.422,3.5106,9.8919,118.5,238.5, | |
5790 | &397.5,2*0.,1.318,2*1.426,2*2.422,2.61,2*5.83,6.07,0.,1.318,1.274, | |
5791 | &1.525,3.5563,9.9132,118.45,238.45,397.45,2*0.,2*.4977, | |
5792 | &83*0.,1.1156,5*0.,2.2849,0.,2*2.46,6*0.,5.62,0.,2*5.84,6*0., | |
5793 | &.9396,.9383,0.,1.1974,1.1926,1.1894,1.3213,1.3149,0.,2.454, | |
5794 | &2.4529,2.4522,2*2.55,2.73,4*0.,3*5.8,2*5.96,6.12,4*0.,1.234, | |
5795 | &1.233,1.232,1.231,1.3872,1.3837,1.3828,1.535,1.5318,1.6724,3*2.5, | |
5796 | &2*2.63,2.8,4*0.,3*5.81,2*5.97,6.13,114*0./ | |
5797 | DATA (PMAS(I,2),I= 1, 500)/22*0.,2.4,2.3,88*0.,.0002,.001, | |
5798 | &6*0.,.149,.0505,.0513,7*0.,.153,.0085,.0044,7*0.,.15,2*.09,2*.06, | |
5799 | &.04,3*.1,0.,.15,.335,.08,2*.01,5*0.,.057,2*.287,2*.06,.04,3*.1, | |
5800 | &0.,.057,0.,.25,.0135,6*0.,.4,2*.184,2*.06,.04,3*.1,0.,.4,.025, | |
5801 | &.055,.0135,6*0.,.11,.115,.099,2*.06,4*.1,0.,.11,.185,.076,.0026, | |
5802 | &146*0.,4*.115,.039,2*.036,.0099,.0091,131*0./ | |
5803 | DATA (PMAS(I,3),I= 1, 500)/22*0.,2*20.,88*0.,.002,.005,6*0.,.4, | |
5804 | &2*.2,7*0.,.4,.1,.015,7*0.,.25,2*.01,3*.08,2*.2,.12,0.,.25,.2, | |
5805 | &.001,2*.02,5*0.,.05,2*.4,3*.08,2*.2,.12,0.,.05,0.,.35,.05,6*0., | |
5806 | &3*.3,2*.08,.06,2*.2,.12,0.,.3,.05,.025,.001,6*0.,.25,4*.12,4*.2, | |
5807 | &0.,.25,.17,.2,.01,146*0.,4*.14,.04,2*.035,2*.05,131*0./ | |
5808 | DATA (PMAS(I,4),I= 1, 500)/12*0.,658650.,0.,.091,68*0.,.1,.43, | |
5809 | &15*0.,7803.,0.,3709.,.32,.128,.131,3*.393,84*0.,.004,26*0., | |
5810 | &15540.,26.75,83*0.,78.88,5*0.,.054,0.,2*.13,6*0.,.393,0.,2*.393, | |
5811 | &9*0.,44.3,0.,24.,49.1,86.9,6*0.,.13,9*0.,.393,13*0.,24.6,130*0./ | |
5812 | DATA PARF/ | |
5813 | & 0.5, 0.25, 0.5, 0.25, 1., 0.5, 0., 0., 0., 0., | |
5814 | 1 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0., | |
5815 | 2 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0., | |
5816 | 3 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0., | |
5817 | 4 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0., | |
5818 | 5 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0., | |
5819 | 6 0.75, 0.5, 0., 0.1667, 0.0833, 0.1667, 0., 0., 0., 0., | |
5820 | 7 0., 0., 1., 0.3333, 0.6667, 0.3333, 0., 0., 0., 0., | |
5821 | 8 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., | |
5822 | 9 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., | |
5823 | & 0.325, 0.325, 0.5, 1.6, 5.0, 0., 0., 0., 0., 0., | |
5824 | 1 0., 0.11, 0.16, 0.048, 0.50, 0.45, 0.55, 0.60, 0., 0., | |
5825 | 2 0.2, 0.1, 0., 0., 0., 0., 0., 0., 0., 0., | |
5826 | 3 1870*0./ | |
5827 | DATA ((VCKM(I,J),J=1,4),I=1,4)/ | |
5828 | 1 0.95150, 0.04847, 0.00003, 0.00000, | |
5829 | 2 0.04847, 0.94936, 0.00217, 0.00000, | |
5830 | 3 0.00003, 0.00217, 0.99780, 0.00000, | |
5831 | 4 0.00000, 0.00000, 0.00000, 1.00000/ | |
5832 | ||
5833 | C...LUDAT3A, with particle decay parameters and data. | |
5834 | DATA (MDCY(I,1),I= 1, 500)/14*0,1,0,1,5*0,3*1,6*0,1,4*0,1,2*0, | |
5835 | &1,42*0,7*1,12*0,1,0,6*1,0,8*1,2*0,9*1,0,8*1,2*0,9*1,0,8*1,2*0, | |
5836 | &9*1,0,8*1,2*0,9*1,0,8*1,2*0,9*1,0,8*1,3*0,1,83*0,1,5*0,1,0,2*1, | |
5837 | &6*0,1,0,2*1,9*0,5*1,0,6*1,4*0,6*1,4*0,16*1,4*0,6*1,114*0/ | |
5838 | DATA (MDCY(I,2),I= 1, 500)/1,9,17,25,33,41,49,57,2*0,65,69,71, | |
5839 | &76,78,118,120,125,2*0,127,136,149,166,186,6*0,203,4*0,219,2*0, | |
5840 | &227,42*0,236,237,241,250,252,254,256,11*0,276,277,279,285,406, | |
5841 | &574,606,607,608,0,609,611,617,623,624,625,626,627,2*0,628,629, | |
5842 | &632,635,638,640,641,642,643,0,644,645,650,658,661,670,685,686, | |
5843 | &2*0,687,688,693,698,700,702,703,705,707,0,709,710,713,717,718, | |
5844 | &719,721,722,2*0,723,726,728,730,734,738,740,744,748,0,752,755, | |
5845 | &759,763,765,767,769,770,2*0,771,773,775,777,779,781,784,786,788, | |
5846 | &0,791,793,806,810,812,814,816,817,2*0,818,824,835,846,854,862, | |
5847 | &867,875,883,0,888,895,903,905,907,909,911,912,2*0,913,921,83*0, | |
5848 | &923,5*0,927,0,1001,1002,6*0,1003,0,1004,1005,9*0,1006,1008,1009, | |
5849 | &1012,1013,0,1015,1016,1017,1018,1019,1020,4*0,1021,1022,1023, | |
5850 | &1024,1025,1026,4*0,1027,1028,1031,1034,1035,1038,1041,1044,1046, | |
5851 | &1048,1052,1053,1054,1055,1057,1059,4*0,1060,1061,1062,1063,1064, | |
5852 | &1065,114*0/ | |
5853 | DATA (MDCY(I,3),I= 1, 500)/8*8,2*0,4,2,5,2,40,2,5,2,2*0,9,13, | |
5854 | &17,20,17,6*0,16,4*0,8,2*0,9,42*0,1,4,9,3*2,20,11*0,1,2,6,121,168, | |
5855 | &32,3*1,0,2,2*6,5*1,2*0,1,3*3,2,4*1,0,1,5,8,3,9,15,2*1,2*0,1,2*5, | |
5856 | &2*2,1,3*2,0,1,3,4,2*1,2,2*1,2*0,3,2*2,2*4,2,3*4,0,3,2*4,3*2,2*1, | |
5857 | &2*0,5*2,3,2*2,3,0,2,13,4,3*2,2*1,2*0,6,2*11,2*8,5,2*8,5,0,7,8, | |
5858 | &4*2,2*1,2*0,8,2,83*0,4,5*0,74,0,2*1,6*0,1,0,2*1,9*0,2,1,3,1,2,0, | |
5859 | &6*1,4*0,6*1,4*0,1,2*3,1,3*3,2*2,4,3*1,2*2,1,4*0,6*1,114*0/ | |
5860 | DATA (MDME(I,1),I= 1,2000)/6*1,-1,7*1,-1,7*1,-1,7*1,-1,7*1,-1, | |
5861 | &7*1,-1,85*1,2*-1,7*1,2*-1,3*1,2*-1,6*1,2*-1,6*1,3*-1,3*1,-1,3*1, | |
5862 | &-1,3*1,5*-1,3*1,-1,6*1,2*-1,3*1,-1,11*1,2*-1,6*1,2*-1,3*1,-1,3*1, | |
5863 | &-1,4*1,2*-1,2*1,-1,488*1,2*0,1275*1/ | |
5864 | DATA (MDME(I,2),I= 1,2000)/70*102,42,6*102,2*42,2*0,7*41,2*0, | |
5865 | &23*41,6*102,45,28*102,8*32,9*0,16*32,4*0,8*32,4*0,32,4*0,8*32, | |
5866 | &8*0,4*32,4*0,6*32,3*0,12,2*42,2*11,9*42,6*45,20*46,7*0,34*42, | |
5867 | &86*0,2*25,26,24*42,142*0,25,26,0,10*42,19*0,2*13,3*85,0,2,4*0,2, | |
5868 | &8*0,2*32,87,88,3*3,0,2*3,0,2*3,0,3,5*0,3,1,0,3,2*0,2*3,3*0,1,4*0, | |
5869 | &12,3*0,4*32,2*4,6*0,5*32,2*4,2*45,87,88,30*0,12,32,0,32,87,88, | |
5870 | &41*0,12,0,32,0,32,87,88,40*0,12,0,32,0,32,87,88,88*0,12,0,32,0, | |
5871 | &32,87,88,2*0,4*42,8*0,14*42,50*0,10*13,2*84,3*85,14*0,84,5*0,85, | |
5872 | &974*0/ | |
5873 | DATA (BRAT(I) ,I= 1, 525)/70*0.,1.,6*0.,2*.177,.108,.225,.003, | |
5874 | &.06,.02,.025,.013,2*.004,.007,.014,2*.002,2*.001,.054,.014,.016, | |
5875 | &.005,2*.012,5*.006,.002,2*.001,5*.002,6*0.,1.,28*0.,.143,.111, | |
5876 | &.143,.111,.143,.085,2*0.,.03,.058,.03,.058,.03,.058,3*0.,.25,.01, | |
5877 | &2*0.,.01,.25,4*0.,.24,5*0.,3*.08,3*0.,.01,.08,.82,5*0.,.09,6*0., | |
5878 | &.143,.111,.143,.111,.143,.085,2*0.,.03,.058,.03,.058,.03,.058, | |
5879 | &4*0.,1.,5*0.,4*.215,2*0.,2*.07,0.,1.,2*.08,.76,.08,2*.112,.05, | |
5880 | &.476,.08,.14,.01,.015,.005,1.,0.,1.,0.,1.,0.,.25,.01,2*0.,.01, | |
5881 | &.25,4*0.,.24,5*0.,3*.08,0.,1.,2*.5,.635,.212,.056,.017,.048,.032, | |
5882 | &.035,.03,2*.015,.044,2*.022,9*.001,.035,.03,2*.015,.044,2*.022, | |
5883 | &9*.001,.028,.017,.066,.02,.008,2*.006,.003,.001,2*.002,.003,.001, | |
5884 | &2*.002,.005,.002,.005,.006,.004,.012,2*.005,.008,2*.005,.037, | |
5885 | &.004,.067,2*.01,2*.001,3*.002,.003,8*.002,.005,4*.004,.015,.005, | |
5886 | &.027,2*.005,.007,.014,.007,.01,.008,.012,.015,11*.002,3*.004, | |
5887 | &.002,.004,6*.002,2*.004,.005,.011,.005,.015,.02,2*.01,3*.004, | |
5888 | &5*.002,.015,.02,2*.01,3*.004,5*.002,.038,.048,.082,.06,.028,.021, | |
5889 | &2*.005,2*.002,.005,.018,.005,.01,.008,.005,3*.004,.001,3*.003, | |
5890 | &.001,2*.002,.003,2*.002,2*.001,.002,.001,.002,.001,.005,4*.003, | |
5891 | &.001,2*.002,.003,2*.001,.013,.03,.058,.055,3*.003,2*.01,.007, | |
5892 | &.019,4*.005,.015,3*.005,8*.002,3*.001,.002,2*.001,.003,16*.001/ | |
5893 | DATA (BRAT(I) ,I= 526, 893)/.019,2*.003,.002,.005,.004,.008, | |
5894 | &.003,.006,.003,.01,5*.002,2*.001,2*.002,11*.001,.002,14*.001, | |
5895 | &.018,.005,.01,2*.015,.017,4*.015,.017,3*.015,.025,.08,2*.025,.04, | |
5896 | &.001,2*.005,.02,.04,2*.06,.04,.01,4*.005,.25,.115,3*1.,.988,.012, | |
5897 | &.389,.319,.237,.049,.005,.001,.441,.205,.301,.03,.022,.001,6*1., | |
5898 | &.665,.333,.002,.666,.333,.001,.49,.34,.17,.52,.48,5*1.,.893,.08, | |
5899 | &.017,2*.005,.495,.343,3*.043,.019,.013,.001,2*.069,.862,3*.027, | |
5900 | &.015,.045,.015,.045,.77,.029,6*.02,5*.05,.115,.015,.5,0.,3*1., | |
5901 | &.28,.14,.313,.157,.11,.28,.14,.313,.157,.11,.667,.333,.667,.333, | |
5902 | &1.,.667,.333,.667,.333,2*.5,1.,.333,.334,.333,4*.25,2*1.,.3,.7, | |
5903 | &2*1.,.8,2*.1,.667,.333,.667,.333,.6,.3,.067,.033,.6,.3,.067,.033, | |
5904 | &2*.5,.6,.3,.067,.033,.6,.3,.067,.033,2*.4,2*.1,.8,2*.1,.52,.26, | |
5905 | &2*.11,.62,.31,2*.035,.007,.993,.02,.98,.3,.7,2*1.,2*.5,.667,.333, | |
5906 | &.667,.333,.667,.333,.667,.333,2*.35,.3,.667,.333,.667,.333,2*.35, | |
5907 | &.3,2*.5,3*.14,.1,.05,4*.08,.028,.027,.028,.027,4*.25,.273,.727, | |
5908 | &.35,.65,.3,.7,2*1.,2*.35,.144,.105,.048,.003,.332,.166,.168,.084, | |
5909 | &.086,.043,.059,2*.029,2*.002,.332,.166,.168,.084,.086,.043,.059, | |
5910 | &2*.029,2*.002,.3,.15,.16,.08,.13,.06,.08,.04,.3,.15,.16,.08,.13, | |
5911 | &.06,.08,.04,2*.4,.1,2*.05,.3,.15,.16,.08,.13,.06,.08,.04,.3,.15, | |
5912 | &.16,.08,.13,.06,.08,.04,2*.4,.1,2*.05,2*.35,.144,.105,2*.024/ | |
5913 | DATA (BRAT(I) ,I= 894,2000)/.003,.573,.287,.063,.028,2*.021, | |
5914 | &.004,.003,2*.5,.15,.85,.22,.78,.3,.7,2*1.,.217,.124,2*.193, | |
5915 | &2*.135,.002,.001,.686,.314,.641,.357,2*.001,.018,2*.005,.003, | |
5916 | &.002,2*.006,.018,2*.005,.003,.002,2*.006,.005,.025,.015,.006, | |
5917 | &2*.005,.004,.005,5*.004,2*.002,2*.004,.003,.002,2*.003,3*.002, | |
5918 | &2*.001,.002,2*.001,2*.002,5*.001,4*.003,2*.005,2*.002,2*.001, | |
5919 | &2*.002,2*.001,.255,.057,2*.035,.15,2*.075,.03,2*.015,5*1.,.999, | |
5920 | &.001,1.,.516,.483,.001,1.,.995,.005,13*1.,.331,.663,.006,.663, | |
5921 | &.331,.006,1.,.88,2*.06,.88,2*.06,.88,2*.06,.667,2*.333,.667,.676, | |
5922 | &.234,.085,.005,3*1.,4*.5,7*1.,935*0./ | |
5923 | DATA (KFDP(I,1),I= 1, 499)/21,22,23,4*-24,25,21,22,23,4*24,25, | |
5924 | &21,22,23,4*-24,25,21,22,23,4*24,25,21,22,23,4*-24,25,21,22,23, | |
5925 | &4*24,25,21,22,23,4*-24,25,21,22,23,4*24,25,22,23,-24,25,23,24, | |
5926 | &-12,22,23,-24,25,23,24,-12,-14,34*16,22,23,-24,25,23,24,-89,22, | |
5927 | &23,-24,25,23,24,1,2,3,4,5,6,7,8,21,1,2,3,4,5,6,7,8,11,13,15,17, | |
5928 | &37,1,2,3,4,5,6,7,8,11,12,13,14,15,16,17,18,37,4*-1,4*-3,4*-5, | |
5929 | &4*-7,-11,-13,-15,-17,1,2,3,4,5,6,7,8,11,13,15,17,21,2*22,23,24,1, | |
5930 | &2,3,4,5,6,7,8,11,12,13,14,15,16,17,18,-1,-3,-5,-7,-11,-13,-15, | |
5931 | &-17,1,2,3,4,5,6,11,13,15,82,-11,-13,2*2,-12,-14,-16,2*-2,2*-4,-2, | |
5932 | &-4,2*89,2*-89,2*89,4*-1,4*-3,4*-5,4*-7,-11,-13,-15,-17,-13,130, | |
5933 | &310,-13,3*211,12,14,16*-11,16*-13,-311,-313,-311,-313,-311,-313, | |
5934 | &-311,-313,2*111,2*221,2*331,2*113,2*223,2*333,-311,-313,2*-311, | |
5935 | &-313,3*-311,-321,-323,-321,2*211,2*213,-213,113,3*213,3*211, | |
5936 | &2*213,2*-311,-313,-321,2*-311,-313,-311,-313,4*-311,-321,-323, | |
5937 | &2*-321,3*211,213,2*211,213,5*211,213,4*211,3*213,211,213,321,311, | |
5938 | &3,2*2,12*-11,12*-13,-321,-323,-321,-323,-311,-313,-311,-313,-311, | |
5939 | &-313,-311,-313,-311,-313,-311,-321,-323,-321,-323,211,213,211, | |
5940 | &213,111,221,331,113,223,333,221,331,113,223,113,223,113,223,333, | |
5941 | &223,333,321,323,321,323,311,313,-321,-323,3*-321,-323,2*-321, | |
5942 | &-323,-321,-311,-313,3*-311,-313,2*-311,-313,-321,-323,3*-321/ | |
5943 | DATA (KFDP(I,1),I= 500, 873)/-323,2*-321,-311,2*333,211,213, | |
5944 | &2*211,2*213,4*211,10*111,-321,-323,5*-321,-323,2*-321,-311,-313, | |
5945 | &4*-311,-313,4*-311,-321,-323,2*-321,-323,-321,-313,-311,-313, | |
5946 | &-311,211,213,2*211,213,4*211,111,221,113,223,113,223,2*3,-15, | |
5947 | &5*-11,5*-13,221,331,333,221,331,333,211,213,211,213,321,323,321, | |
5948 | &323,2212,221,331,333,221,2*2,3*0,3*22,111,211,2*22,2*211,111, | |
5949 | &3*22,111,3*21,2*0,211,321,3*311,2*321,421,2*411,2*421,431,511, | |
5950 | &521,531,2*211,22,211,2*111,321,130,-213,113,213,211,22,111,11,13, | |
5951 | &82,11,13,15,1,2,3,4,21,22,11,12,13,14,15,16,1,2,3,4,5,21,22,2*89, | |
5952 | &2*0,223,321,311,323,313,2*311,321,313,323,321,421,2*411,421,433, | |
5953 | &521,2*511,521,523,513,223,213,113,-213,313,-313,323,-323,82,21, | |
5954 | &663,21,2*0,221,213,113,321,2*311,321,421,411,423,413,411,421,413, | |
5955 | &423,431,433,521,511,523,513,511,521,513,523,521,511,531,533,221, | |
5956 | &213,-213,211,111,321,130,211,111,321,130,443,82,553,21,663,21, | |
5957 | &2*0,113,213,323,2*313,323,423,2*413,423,421,411,433,523,2*513, | |
5958 | &523,521,511,533,213,-213,10211,10111,-10211,2*221,213,2*113,-213, | |
5959 | &2*321,2*311,313,-313,323,-323,443,82,553,21,663,21,2*0,213,113, | |
5960 | &221,223,321,211,321,311,323,313,323,313,321,5*311,321,313,323, | |
5961 | &313,323,311,4*321,421,411,423,413,423,413,421,2*411,421,413,423, | |
5962 | &413,423,411,2*421,411,433,2*431,521,511,523,513,523,513,521/ | |
5963 | DATA (KFDP(I,1),I= 874,2000)/2*511,521,513,523,513,523,511,2*521, | |
5964 | &511,533,2*531,213,-213,221,223,321,130,111,211,111,2*211,321,130, | |
5965 | &221,111,321,130,443,82,553,21,663,21,2*0,111,211,-12,12,-14,14, | |
5966 | &211,111,211,111,2212,2*2112,-12,7*-11,7*-13,2*2224,2*2212,2*2214, | |
5967 | &2*3122,2*3212,2*3214,5*3222,4*3224,2*3322,3324,2*2224,5*2212, | |
5968 | &5*2214,2*2112,2*2114,2*3122,2*3212,2*3214,2*3222,2*3224,4*2,3, | |
5969 | &2*2,1,2*2,5*0,2112,-12,3122,2212,2112,2212,3*3122,3*4122,4132, | |
5970 | &4232,0,3*5122,5132,5232,0,2112,2212,2*2112,2212,2112,2*2212,3122, | |
5971 | &3212,3112,3122,3222,3112,3122,3222,3212,3322,3312,3322,3312,3122, | |
5972 | &3322,3312,-12,3*4122,2*4132,2*4232,4332,3*5122,5132,5232,5332, | |
5973 | &935*0/ | |
5974 | DATA (KFDP(I,2),I= 1, 496)/3*1,2,4,6,8,1,3*2,1,3,5,7,2,3*3,2,4, | |
5975 | &6,8,3,3*4,1,3,5,7,4,3*5,2,4,6,8,5,3*6,1,3,5,7,6,3*7,2,4,6,8,7, | |
5976 | &3*8,1,3,5,7,8,2*11,12,11,12,2*11,2*13,14,13,14,13,11,13,-211, | |
5977 | &-213,-211,-213,-211,-213,3*-211,-321,-323,-321,-323,2*-321, | |
5978 | &4*-211,-213,-211,-213,-211,-213,-211,-213,-211,-213,6*-211,2*15, | |
5979 | &16,15,16,15,18,2*17,18,17,18,17,-1,-2,-3,-4,-5,-6,-7,-8,21,-1,-2, | |
5980 | &-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,-37,-1,-2,-3,-4,-5,-6,-7,-8, | |
5981 | &-11,-12,-13,-14,-15,-16,-17,-18,-37,2,4,6,8,2,4,6,8,2,4,6,8,2,4, | |
5982 | &6,8,12,14,16,18,-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,21,22, | |
5983 | &2*23,-24,-1,-2,-3,-4,-5,-6,-7,-8,-11,-12,-13,-14,-15,-16,-17,-18, | |
5984 | &2,4,6,8,12,14,16,18,-3,-4,-5,-6,-7,-8,-13,-15,-17,-82,12,14,-1, | |
5985 | &-3,11,13,15,1,4,3,4,1,3,5,3,6,4,7,5,2,4,6,8,2,4,6,8,2,4,6,8,2,4, | |
5986 | &6,8,12,14,16,18,14,2*0,14,111,211,111,-11,-13,16*12,16*14,2*211, | |
5987 | &2*213,2*321,2*323,211,213,211,213,211,213,211,213,211,213,211, | |
5988 | &213,2*211,213,7*211,213,211,111,211,111,2*211,-213,213,2*113,223, | |
5989 | &2*113,221,321,2*311,321,313,4*211,213,113,213,-213,2*211,213,113, | |
5990 | &111,221,331,111,113,223,4*113,223,6*211,213,4*211,-321,-311,3*-1, | |
5991 | &12*12,12*14,2*211,2*213,2*111,2*221,2*331,2*113,2*223,333,2*321, | |
5992 | &2*323,2*-211,2*-213,6*111,4*221,2*331,3*113,2*223,2*-211,2*-213, | |
5993 | &113,111,2*211,213,6*211,321,2*211,213,211,2*111,113,2*223,2*321/ | |
5994 | DATA (KFDP(I,2),I= 497, 863)/323,321,2*311,313,2*311,111,211, | |
5995 | &2*-211,-213,-211,-213,-211,-213,3*-211,5*111,2*113,223,113,223, | |
5996 | &2*211,213,5*211,213,3*211,213,2*211,2*111,221,113,223,3*321,323, | |
5997 | &2*321,323,311,313,311,313,3*211,2*-211,-213,3*-211,4*111,2*113, | |
5998 | &2*-1,16,5*12,5*14,3*211,3*213,2*111,2*113,2*-311,2*-313,-2112, | |
5999 | &3*321,323,2*-1,3*0,22,11,22,111,-211,211,11,2*-211,111,113,223, | |
6000 | &22,111,3*21,2*0,111,-211,111,22,211,111,22,211,111,22,111,5*22, | |
6001 | &2*-211,111,-211,2*111,-321,310,211,111,2*-211,221,22,-11,-13,-82, | |
6002 | &-11,-13,-15,-1,-2,-3,-4,2*21,-11,-12,-13,-14,-15,-16,-1,-2,-3,-4, | |
6003 | &-5,2*21,5,3,2*0,211,-213,113,-211,111,223,211,111,211,111,223, | |
6004 | &211,111,-211,2*111,-211,111,211,111,-321,-311,111,-211,111,211, | |
6005 | &-311,311,-321,321,-82,21,22,21,2*0,211,111,211,-211,111,211,111, | |
6006 | &211,111,211,111,-211,111,-211,3*111,-211,111,-211,111,211,111, | |
6007 | &211,111,-321,-311,3*111,-211,211,-211,111,-321,310,-211,111,-321, | |
6008 | &310,22,-82,22,21,22,21,2*0,211,111,-211,111,211,111,211,111,-211, | |
6009 | &111,321,311,111,-211,111,211,111,-321,-311,111,-211,211,-211,111, | |
6010 | &2*211,111,-211,211,111,211,-321,2*-311,-321,-311,311,-321,321,22, | |
6011 | &-82,22,21,22,21,2*0,111,3*211,-311,22,-211,111,-211,111,-211,211, | |
6012 | &-213,113,223,221,22,211,111,211,111,2*211,213,113,223,221,22,211, | |
6013 | &111,211,111,4*211,-211,111,-211,111,-211,211,-211,211,321,311/ | |
6014 | DATA (KFDP(I,2),I= 864,2000)/2*111,211,-211,111,-211,111,-211, | |
6015 | &211,-211,2*211,111,211,111,4*211,-321,-311,2*111,211,-211,211, | |
6016 | &111,211,-321,310,22,-211,111,2*-211,-321,310,221,111,-321,310,22, | |
6017 | &-82,22,21,22,21,2*0,111,-211,11,-11,13,-13,-211,111,-211,111, | |
6018 | &-211,111,22,11,7*12,7*14,-321,-323,-311,-313,-311,-313,211,213, | |
6019 | &211,213,211,213,111,221,331,113,223,111,221,113,223,321,323,321, | |
6020 | &-211,-213,111,221,331,113,223,111,221,331,113,223,211,213,211, | |
6021 | &213,321,323,321,323,321,323,311,313,311,313,2*-1,-3,-1,2203, | |
6022 | &2*3201,2203,2101,2103,5*0,-211,11,22,111,211,22,-211,111,22,-211, | |
6023 | &111,211,2*22,0,-211,111,211,2*22,0,2*-211,111,22,111,211,22,211, | |
6024 | &2*-211,2*111,-211,2*211,111,211,-211,2*111,211,-321,-211,111,11, | |
6025 | &-211,111,211,111,22,111,2*22,-211,111,211,3*22,935*0/ | |
6026 | DATA (KFDP(I,3),I= 1, 918)/70*0,14,6*0,2*16,2*0,5*111,310,130, | |
6027 | &2*0,2*111,310,130,113,211,223,221,2*113,2*211,2*223,2*221,2*113, | |
6028 | &221,113,2*213,-213,123*0,4*3,4*4,1,4,3,2*2,6*81,25*0,-211,3*111, | |
6029 | &-311,-313,-311,2*-321,2*-311,111,221,331,113,223,211,111,211,111, | |
6030 | &-311,-313,-311,2*-321,2*-311,111,221,331,113,223,211,111,211,111, | |
6031 | &20*0,3*111,2*221,331,113,223,3*211,-211,111,-211,111,211,111,211, | |
6032 | &-211,111,113,111,223,2*111,-311,4*211,2*111,2*211,111,7*211, | |
6033 | &7*111,113,221,2*223,2*-211,-213,4*-211,-213,-211,-213,-211,2*211, | |
6034 | &2,2*0,-321,-323,-311,-321,-311,2*-321,-211,-213,2*-211,211,-321, | |
6035 | &-323,-311,-321,-311,2*-321,-211,-213,2*-211,211,46*0,3*111,113, | |
6036 | &2*221,331,2*223,-311,3*-211,-213,8*111,113,3*211,213,2*111,-211, | |
6037 | &3*111,113,111,2*113,221,331,223,111,221,331,113,223,113,2*223, | |
6038 | &2*221,3*111,221,113,223,4*211,3*-211,-213,-211,5*111,-321,3*211, | |
6039 | &3*111,2*211,2*111,2*-211,-213,3*111,221,113,223,6*111,3*0,221, | |
6040 | &331,333,321,311,221,331,333,321,311,19*0,3,5*0,-11,0,2*111,-211, | |
6041 | &-11,11,2*221,3*0,111,22*0,111,2*0,22,111,5*0,111,12*0,2*21,11*0, | |
6042 | &2*21,2*-6,111*0,-211,2*111,-211,3*111,-211,111,211,15*0,111,6*0, | |
6043 | &111,-211,9*0,111,-211,9*0,111,-211,111,-211,4*0,111,-211,111, | |
6044 | &-211,4*0,-211,4*0,111,-211,111,-211,4*0,111,-211,111,-211,4*0, | |
6045 | &-211,3*0,-211,5*0,111,211,3*0,111,10*0,2*111,211,-211,211,-211/ | |
6046 | DATA (KFDP(I,3),I= 919,2000)/7*0,2212,3122,3212,3214,2112,2114, | |
6047 | &2212,2112,3122,3212,3214,2112,2114,2212,2112,50*0,3*3,1,12*0, | |
6048 | &2112,43*0,3322,949*0/ | |
6049 | DATA (KFDP(I,4),I= 1,2000)/83*0,3*111,9*0,-211,3*0,111,2*-211, | |
6050 | &0,111,0,2*111,113,221,111,-213,-211,211,123*0,13*81,37*0,111, | |
6051 | &3*211,111,5*0,-211,111,-211,111,2*0,111,3*211,111,5*0,-211,111, | |
6052 | &-211,111,50*0,2*111,2*-211,2*111,-211,211,3*111,211,14*111,221, | |
6053 | &113,223,2*111,2*113,223,2*111,-1,4*0,-211,111,-211,211,111,2*0, | |
6054 | &2*111,-211,2*0,-211,111,-211,211,111,2*0,2*111,-211,96*0,6*111, | |
6055 | &3*-211,-213,4*111,113,6*111,3*-211,3*111,2*-211,2*111,3*-211, | |
6056 | &12*111,6*0,-321,-311,3*0,-321,-311,19*0,-3,11*0,-11,280*0,111, | |
6057 | &-211,3*0,111,29*0,-211,111,5*0,-211,111,50*0,2101,2103,2*2101, | |
6058 | &1006*0/ | |
6059 | DATA (KFDP(I,5),I= 1,2000)/85*0,111,15*0,111,7*0,111,0,2*111, | |
6060 | &175*0,111,-211,111,7*0,2*111,4*0,111,-211,111,7*0,2*111,93*0,111, | |
6061 | &-211,111,3*0,111,-211,4*0,111,-211,111,3*0,111,-211,1571*0/ | |
6062 | ||
6063 | C...LUDAT4A, with character strings. | |
6064 | DATA (CHAF(I) ,I= 1, 331)/'d','u','s','c','b','t','l','h', | |
6065 | &2*' ','e','nu_e','mu','nu_mu','tau','nu_tau','chi','nu_chi', | |
6066 | &2*' ','g','gamma','Z','W','H',6*' ','Z''','Z"','W''','H''','H"', | |
6067 | &'H',2*' ','R',40*' ','specflav','rndmflav','phasespa','c-hadron', | |
6068 | &'b-hadron','t-hadron','l-hadron','h-hadron','Wvirt','diquark', | |
6069 | &'cluster','string','indep.','CMshower','SPHEaxis','THRUaxis', | |
6070 | &'CLUSjet','CELLjet','table',' ','pi',2*'K',2*'D','D_s',2*'B', | |
6071 | &'B_s',' ','pi','eta','eta''','eta_c','eta_b','eta_t','eta_l', | |
6072 | &'eta_h',2*' ','rho',2*'K*',2*'D*','D*_s',2*'B*','B*_s',' ','rho', | |
6073 | &'omega','phi','J/psi','Upsilon','Theta','Theta_l','Theta_h', | |
6074 | &2*' ','b_1',2*'K_1',2*'D_1','D_1s',2*'B_1','B_1s',' ','b_1', | |
6075 | &'h_1','h''_1','h_1c','h_1b','h_1t','h_1l','h_1h',2*' ','a_0', | |
6076 | &2*'K*_0',2*'D*_0','D*_0s',2*'B*_0','B*_0s',' ','a_0','f_0', | |
6077 | &'f''_0','chi_0c','chi_0b','chi_0t','chi_0l','chi_0h',2*' ','a_1', | |
6078 | &2*'K*_1',2*'D*_1','D*_1s',2*'B*_1','B*_1s',' ','a_1','f_1', | |
6079 | &'f''_1','chi_1c','chi_1b','chi_1t','chi_1l','chi_1h',2*' ','a_2', | |
6080 | &2*'K*_2',2*'D*_2','D*_2s',2*'B*_2','B*_2s',' ','a_2','f_2', | |
6081 | &'f''_2','chi_2c','chi_2b','chi_2t','chi_2l','chi_2h',2*' ','K_L', | |
6082 | &'K_S',58*' ','pi_diffr','n_diffr','p_diffr',22*' ','Lambda',5*' ', | |
6083 | &'Lambda_c',' ',2*'Xi_c',6*' ','Lambda_b',' ',2*'Xi_b',6*' '/ | |
6084 | DATA (CHAF(I) ,I= 332, 500)/'n','p',' ',3*'Sigma',2*'Xi',' ', | |
6085 | &3*'Sigma_c',2*'Xi''_c','Omega_c', | |
6086 | &4*' ',3*'Sigma_b',2*'Xi''_b','Omega_b',4*' ',4*'Delta', | |
6087 | &3*'Sigma*',2*'Xi*','Omega',3*'Sigma*_c',2*'Xi*_c','Omega*_c', | |
6088 | &4*' ',3*'Sigma*_b',2*'Xi*_b','Omega*_b',114*' '/ | |
6089 | ||
6090 | C...LUDATRA, with initial values for the random number generator. | |
6091 | DATA MRLU/19780503,0,0,97,33,0/ | |
6092 | ||
6093 | END | |
ce320da8 | 6094 | SUBROUTINE PYINITA(FRAME,BEAM,TARGET,WIN) |
0119ef9a | 6095 | |
6096 | C...Initializes the generation procedure; finds maxima of the | |
6097 | C...differential cross-sections to be used for weighting. | |
6098 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
6099 | SAVE /LUDAT1A/ | |
6100 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
6101 | SAVE /LUDAT2A/ | |
6102 | COMMON/LUDAT3A/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) | |
6103 | SAVE /LUDAT3A/ | |
6104 | COMMON/LUDAT4A/CHAF(500) | |
6105 | CHARACTER CHAF*8 | |
6106 | SAVE /LUDAT4A/ | |
6107 | COMMON/PYSUBSA/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200) | |
6108 | SAVE /PYSUBSA/ | |
6109 | COMMON/PYPARSA/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
6110 | SAVE /PYPARSA/ | |
6111 | COMMON/PYINT1A/MINT(400),VINT(400) | |
6112 | SAVE /PYINT1A/ | |
6113 | COMMON/PYINT2A/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2) | |
6114 | SAVE /PYINT2A/ | |
6115 | COMMON/PYINT5A/NGEN(0:200,3),XSEC(0:200,3) | |
6116 | SAVE /PYINT5A/ | |
6117 | CHARACTER*(*) FRAME,BEAM,TARGET | |
6118 | CHARACTER CHFRAM*8,CHBEAM*8,CHTARG*8,CHMO(12)*3,CHLH(2)*6 | |
6119 | DATA CHMO/'Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep', | |
6120 | &'Oct','Nov','Dec'/, CHLH/'lepton','hadron'/ | |
6121 | ||
6122 | CHMO(1)=CHMO(1) | |
6123 | C...Write headers. | |
6124 | C IF(MSTP(122).GE.1) WRITE(MSTU(11),1000) MSTP(181),MSTP(182), | |
6125 | C &MSTP(185),CHMO(MSTP(184)),MSTP(183) | |
6126 | CALL LULIST(0) | |
6127 | C IF(MSTP(122).GE.1) WRITE(MSTU(11),1100) | |
6128 | ||
6129 | C...Identify beam and target particles and initialize kinematics. | |
6130 | CHFRAM=FRAME//' ' | |
6131 | CHBEAM=BEAM//' ' | |
6132 | CHTARG=TARGET//' ' | |
ce320da8 | 6133 | CALL PYINKIA(CHFRAM,CHBEAM,CHTARG,WIN) |
0119ef9a | 6134 | |
6135 | C...Select partonic subprocesses to be included in the simulation. | |
6136 | IF(MSEL.NE.0) THEN | |
6137 | DO 100 I=1,200 | |
6138 | 100 MSUB(I)=0 | |
6139 | ENDIF | |
6140 | IF(MINT(43).EQ.1.AND.(MSEL.EQ.1.OR.MSEL.EQ.2)) THEN | |
6141 | C...Lepton+lepton -> gamma/Z0 or W. | |
6142 | IF(MINT(11)+MINT(12).EQ.0) MSUB(1)=1 | |
6143 | IF(MINT(11)+MINT(12).NE.0) MSUB(2)=1 | |
6144 | ELSEIF(MSEL.EQ.1) THEN | |
6145 | C...High-pT QCD processes: | |
6146 | MSUB(11)=1 | |
6147 | MSUB(12)=1 | |
6148 | MSUB(13)=1 | |
6149 | MSUB(28)=1 | |
6150 | MSUB(53)=1 | |
6151 | MSUB(68)=1 | |
6152 | IF(MSTP(82).LE.1.AND.CKIN(3).LT.PARP(81)) MSUB(95)=1 | |
6153 | IF(MSTP(82).GE.2.AND.CKIN(3).LT.PARP(82)) MSUB(95)=1 | |
6154 | ELSEIF(MSEL.EQ.2) THEN | |
6155 | C...All QCD processes: | |
6156 | MSUB(11)=1 | |
6157 | MSUB(12)=1 | |
6158 | MSUB(13)=1 | |
6159 | MSUB(28)=1 | |
6160 | MSUB(53)=1 | |
6161 | MSUB(68)=1 | |
6162 | MSUB(91)=1 | |
6163 | MSUB(92)=1 | |
6164 | MSUB(93)=1 | |
6165 | MSUB(95)=1 | |
6166 | ELSEIF(MSEL.GE.4.AND.MSEL.LE.8) THEN | |
6167 | C...Heavy quark production. | |
6168 | MSUB(81)=1 | |
6169 | MSUB(82)=1 | |
6170 | DO 110 J=1,MIN(8,MDCY(21,3)) | |
6171 | 110 MDME(MDCY(21,2)+J-1,1)=0 | |
6172 | MDME(MDCY(21,2)+MSEL-1,1)=1 | |
6173 | ELSEIF(MSEL.EQ.10) THEN | |
6174 | C...Prompt photon production: | |
6175 | MSUB(14)=1 | |
6176 | MSUB(18)=1 | |
6177 | MSUB(29)=1 | |
6178 | ELSEIF(MSEL.EQ.11) THEN | |
6179 | C...Z0/gamma* production: | |
6180 | MSUB(1)=1 | |
6181 | ELSEIF(MSEL.EQ.12) THEN | |
6182 | C...W+/- production: | |
6183 | MSUB(2)=1 | |
6184 | ELSEIF(MSEL.EQ.13) THEN | |
6185 | C...Z0 + jet: | |
6186 | MSUB(15)=1 | |
6187 | MSUB(30)=1 | |
6188 | ELSEIF(MSEL.EQ.14) THEN | |
6189 | C...W+/- + jet: | |
6190 | MSUB(16)=1 | |
6191 | MSUB(31)=1 | |
6192 | ELSEIF(MSEL.EQ.15) THEN | |
6193 | C...Z0 & W+/- pair production: | |
6194 | MSUB(19)=1 | |
6195 | MSUB(20)=1 | |
6196 | MSUB(22)=1 | |
6197 | MSUB(23)=1 | |
6198 | MSUB(25)=1 | |
6199 | ELSEIF(MSEL.EQ.16) THEN | |
6200 | C...H0 production: | |
6201 | MSUB(3)=1 | |
6202 | MSUB(5)=1 | |
6203 | MSUB(8)=1 | |
6204 | MSUB(102)=1 | |
6205 | ELSEIF(MSEL.EQ.17) THEN | |
6206 | C...H0 & Z0 or W+/- pair production: | |
6207 | MSUB(24)=1 | |
6208 | MSUB(26)=1 | |
6209 | ELSEIF(MSEL.EQ.21) THEN | |
6210 | C...Z'0 production: | |
6211 | MSUB(141)=1 | |
6212 | ELSEIF(MSEL.EQ.22) THEN | |
6213 | C...H+/- production: | |
6214 | MSUB(142)=1 | |
6215 | ELSEIF(MSEL.EQ.23) THEN | |
6216 | C...R production: | |
6217 | MSUB(143)=1 | |
6218 | ENDIF | |
6219 | ||
6220 | C...Count number of subprocesses on. | |
6221 | MINT(44)=0 | |
6222 | DO 120 ISUB=1,200 | |
6223 | IF(MINT(43).LT.4.AND.ISUB.GE.91.AND.ISUB.LE.96.AND. | |
6224 | &MSUB(ISUB).EQ.1) THEN | |
6225 | WRITE(MSTU(11),1200) ISUB,CHLH(MINT(41)),CHLH(MINT(42)) | |
6226 | STOP | |
6227 | ELSEIF(MSUB(ISUB).EQ.1.AND.ISET(ISUB).EQ.-1) THEN | |
6228 | WRITE(MSTU(11),1300) ISUB | |
6229 | STOP | |
6230 | ELSEIF(MSUB(ISUB).EQ.1.AND.ISET(ISUB).LE.-2) THEN | |
6231 | WRITE(MSTU(11),1400) ISUB | |
6232 | STOP | |
6233 | ELSEIF(MSUB(ISUB).EQ.1) THEN | |
6234 | MINT(44)=MINT(44)+1 | |
6235 | ENDIF | |
6236 | 120 CONTINUE | |
6237 | IF(MINT(44).EQ.0) THEN | |
6238 | WRITE(MSTU(11),1500) | |
6239 | STOP | |
6240 | ENDIF | |
6241 | MINT(45)=MINT(44)-MSUB(91)-MSUB(92)-MSUB(93)-MSUB(94) | |
6242 | ||
6243 | C...Maximum 4 generations; set maximum number of allowed flavours. | |
6244 | MSTP(1)=MIN(4,MSTP(1)) | |
6245 | MSTU(114)=MIN(MSTU(114),2*MSTP(1)) | |
6246 | MSTP(54)=MIN(MSTP(54),2*MSTP(1)) | |
6247 | ||
6248 | C...Sum up Cabibbo-Kobayashi-Maskawa factors for each quark/lepton. | |
6249 | DO 140 I=-20,20 | |
6250 | VINT(180+I)=0. | |
6251 | IA=IABS(I) | |
6252 | IF(IA.GE.1.AND.IA.LE.2*MSTP(1)) THEN | |
6253 | DO 130 J=1,MSTP(1) | |
6254 | IB=2*J-1+MOD(IA,2) | |
6255 | IPM=(5-ISIGN(1,I))/2 | |
6256 | IDC=J+MDCY(IA,2)+2 | |
6257 | 130 IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.IPM) VINT(180+I)= | |
6258 | & VINT(180+I)+VCKM((IA+1)/2,(IB+1)/2) | |
6259 | ELSEIF(IA.GE.11.AND.IA.LE.10+2*MSTP(1)) THEN | |
6260 | VINT(180+I)=1. | |
6261 | ENDIF | |
6262 | 140 CONTINUE | |
6263 | ||
6264 | C...Choose Lambda value to use in alpha-strong. | |
6265 | MSTU(111)=MSTP(2) | |
6266 | IF(MSTP(3).GE.1) THEN | |
6267 | ALAM=PARP(1) | |
6268 | IF(MSTP(51).EQ.1) ALAM=0.2 | |
6269 | IF(MSTP(51).EQ.2) ALAM=0.29 | |
6270 | IF(MSTP(51).EQ.3) ALAM=0.2 | |
6271 | IF(MSTP(51).EQ.4) ALAM=0.4 | |
6272 | IF(MSTP(51).EQ.11) ALAM=0.16 | |
6273 | IF(MSTP(51).EQ.12) ALAM=0.26 | |
6274 | IF(MSTP(51).EQ.13) ALAM=0.36 | |
6275 | PARP(1)=ALAM | |
6276 | PARP(61)=ALAM | |
6277 | PARU(112)=ALAM | |
6278 | PARJ(81)=ALAM | |
6279 | ENDIF | |
6280 | ||
6281 | C...Initialize widths and partial widths for resonances. | |
ce320da8 | 6282 | CALL PYINREA |
0119ef9a | 6283 | |
6284 | C...Reset variables for cross-section calculation. | |
6285 | DO 150 I=0,200 | |
6286 | DO 150 J=1,3 | |
6287 | NGEN(I,J)=0 | |
6288 | 150 XSEC(I,J)=0. | |
6289 | VINT(108)=0. | |
6290 | ||
6291 | C...Find parametrized total cross-sections. | |
ce320da8 | 6292 | IF(MINT(43).EQ.4) CALL PYXTOTA |
0119ef9a | 6293 | |
6294 | C...Maxima of differential cross-sections. | |
ce320da8 | 6295 | IF(MSTP(121).LE.0) CALL PYMAXIA |
0119ef9a | 6296 | |
6297 | C...Initialize possibility of overlayed events. | |
6298 | IF(MSTP(131).NE.0) CALL PYOVLY(1) | |
6299 | ||
6300 | C...Initialize multiple interactions with variable impact parameter. | |
6301 | IF(MINT(43).EQ.4.AND.(MINT(45).NE.0.OR.MSTP(131).NE.0).AND. | |
ce320da8 | 6302 | &MSTP(82).GE.2) CALL PYMULTA(1) |
0119ef9a | 6303 | C IF(MSTP(122).GE.1) WRITE(MSTU(11),1600) |
6304 | ||
6305 | C...Formats for initialization information. | |
6306 | clin 1000 FORMAT(///20X,'The Lund Monte Carlo - PYTHIA version ',I1,'.',I1/ | |
6307 | clin &20X,'** Last date of change: ',I2,1X,A3,1X,I4,' **'/) | |
ce320da8 | 6308 | clin 1100 FORMAT('1',18('*'),1X,'PYINITA: initialization of PYTHIA ', |
0119ef9a | 6309 | clin &'routines',1X,17('*')) |
6310 | 1200 FORMAT(1X,'Error: process number ',I3,' not meaningful for ',A6, | |
6311 | &'-',A6,' interactions.'/1X,'Execution stopped!') | |
6312 | 1300 FORMAT(1X,'Error: requested subprocess',I4,' not implemented.'/ | |
6313 | &1X,'Execution stopped!') | |
6314 | 1400 FORMAT(1X,'Error: requested subprocess',I4,' not existing.'/ | |
6315 | &1X,'Execution stopped!') | |
6316 | 1500 FORMAT(1X,'Error: no subprocess switched on.'/ | |
6317 | &1X,'Execution stopped.') | |
ce320da8 | 6318 | clin 1600 FORMAT(/1X,22('*'),1X,'PYINITA: initialization completed',1X, |
0119ef9a | 6319 | clin &22('*')) |
6320 | ||
6321 | RETURN | |
6322 | END | |
6323 | ||
6324 | C********************************************************************* | |
6325 | ||
440e3d40 | 6326 | SUBROUTINE PYTHIAA |
0119ef9a | 6327 | |
6328 | C...Administers the generation of a high-pt event via calls to a number | |
6329 | C...of subroutines; also computes cross-sections. | |
6330 | COMMON/LUJETSA/N,K(9000,5),P(9000,5),V(9000,5) | |
6331 | SAVE /LUJETSA/ | |
6332 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
6333 | SAVE /LUDAT1A/ | |
6334 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
6335 | SAVE /LUDAT2A/ | |
6336 | COMMON/PYSUBSA/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200) | |
6337 | SAVE /PYSUBSA/ | |
6338 | COMMON/PYPARSA/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
6339 | SAVE /PYPARSA/ | |
6340 | COMMON/PYINT1A/MINT(400),VINT(400) | |
6341 | SAVE /PYINT1A/ | |
6342 | COMMON/PYINT2A/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2) | |
6343 | SAVE /PYINT2A/ | |
6344 | COMMON/PYINT5A/NGEN(0:200,3),XSEC(0:200,3) | |
6345 | SAVE /PYINT5A/ | |
6346 | ||
6347 | C...Loop over desired number of overlayed events (normally 1). | |
6348 | MINT(7)=0 | |
6349 | MINT(8)=0 | |
6350 | NOVL=1 | |
6351 | IF(MSTP(131).NE.0) CALL PYOVLY(2) | |
6352 | IF(MSTP(131).NE.0) NOVL=MINT(81) | |
6353 | MINT(83)=0 | |
6354 | MINT(84)=MSTP(126) | |
6355 | MSTU(70)=0 | |
6356 | DO 190 IOVL=1,NOVL | |
6357 | IF(MINT(84)+100.GE.MSTU(4)) THEN | |
6358 | CALL LUERRM(11, | |
6359 | & '(PYTHIA:) no more space in LUJETSA for overlayed events') | |
6360 | IF(MSTU(21).GE.1) GOTO 200 | |
6361 | ENDIF | |
6362 | MINT(82)=IOVL | |
6363 | ||
6364 | C...Generate variables of hard scattering. | |
6365 | 100 CONTINUE | |
6366 | IF(IOVL.EQ.1) NGEN(0,2)=NGEN(0,2)+1 | |
6367 | MINT(31)=0 | |
6368 | MINT(51)=0 | |
ce320da8 | 6369 | CALL PYRANDA |
0119ef9a | 6370 | ISUB=MINT(1) |
6371 | IF(IOVL.EQ.1) THEN | |
6372 | NGEN(ISUB,2)=NGEN(ISUB,2)+1 | |
6373 | ||
6374 | C...Store information on hard interaction. | |
6375 | DO 110 J=1,200 | |
6376 | MSTI(J)=0 | |
6377 | 110 PARI(J)=0. | |
6378 | MSTI(1)=MINT(1) | |
6379 | MSTI(2)=MINT(2) | |
6380 | MSTI(11)=MINT(11) | |
6381 | MSTI(12)=MINT(12) | |
6382 | MSTI(15)=MINT(15) | |
6383 | MSTI(16)=MINT(16) | |
6384 | MSTI(17)=MINT(17) | |
6385 | MSTI(18)=MINT(18) | |
6386 | PARI(11)=VINT(1) | |
6387 | PARI(12)=VINT(2) | |
6388 | IF(ISUB.NE.95) THEN | |
6389 | DO 120 J=13,22 | |
6390 | 120 PARI(J)=VINT(30+J) | |
6391 | PARI(33)=VINT(41) | |
6392 | PARI(34)=VINT(42) | |
6393 | PARI(35)=PARI(33)-PARI(34) | |
6394 | PARI(36)=VINT(21) | |
6395 | PARI(37)=VINT(22) | |
6396 | PARI(38)=VINT(26) | |
6397 | PARI(41)=VINT(23) | |
6398 | ENDIF | |
6399 | ENDIF | |
6400 | ||
6401 | IF(MSTP(111).EQ.-1) GOTO 160 | |
6402 | IF(ISUB.LE.90.OR.ISUB.GE.95) THEN | |
6403 | C...Hard scattering (including low-pT): | |
6404 | C...reconstruct kinematics and colour flow of hard scattering. | |
ce320da8 | 6405 | CALL PYSCATA |
0119ef9a | 6406 | IF(MINT(51).EQ.1) GOTO 100 |
6407 | ||
6408 | C...Showering of initial state partons (optional). | |
6409 | IPU1=MINT(84)+1 | |
6410 | IPU2=MINT(84)+2 | |
6411 | IF(MSTP(61).GE.1.AND.MINT(43).NE.1.AND.ISUB.NE.95) | |
ce320da8 | 6412 | & CALL PYSSPAA(IPU1,IPU2) |
0119ef9a | 6413 | NSAV1=N |
6414 | ||
6415 | C...Multiple interactions. | |
6416 | IF(MSTP(81).GE.1.AND.MINT(43).EQ.4.AND.ISUB.NE.95) | |
ce320da8 | 6417 | & CALL PYMULTA(6) |
0119ef9a | 6418 | MINT(1)=ISUB |
6419 | NSAV2=N | |
6420 | ||
6421 | C...Hadron remnants and primordial kT. | |
ce320da8 | 6422 | CALL PYREMNA(IPU1,IPU2) |
0119ef9a | 6423 | IF(MINT(51).EQ.1) GOTO 100 |
6424 | NSAV3=N | |
6425 | ||
6426 | C...Showering of final state partons (optional). | |
6427 | IPU3=MINT(84)+3 | |
6428 | IPU4=MINT(84)+4 | |
6429 | IF(MSTP(71).GE.1.AND.ISUB.NE.95.AND.K(IPU3,1).GT.0.AND. | |
6430 | & K(IPU3,1).LE.10.AND.K(IPU4,1).GT.0.AND.K(IPU4,1).LE.10) THEN | |
6431 | QMAX=SQRT(PARP(71)*VINT(52)) | |
6432 | IF(ISUB.EQ.5) QMAX=SQRT(PMAS(23,1)**2) | |
6433 | IF(ISUB.EQ.8) QMAX=SQRT(PMAS(24,1)**2) | |
6434 | CALL LUSHOW(IPU3,IPU4,QMAX) | |
6435 | ENDIF | |
6436 | ||
6437 | C...Sum up transverse and longitudinal momenta. | |
6438 | IF(IOVL.EQ.1) THEN | |
6439 | PARI(65)=2.*PARI(17) | |
6440 | DO 130 I=MSTP(126)+1,N | |
6441 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 130 | |
6442 | PT=SQRT(P(I,1)**2+P(I,2)**2) | |
6443 | PARI(69)=PARI(69)+PT | |
6444 | IF(I.LE.NSAV1.OR.I.GT.NSAV3) PARI(66)=PARI(66)+PT | |
6445 | IF(I.GT.NSAV1.AND.I.LE.NSAV2) PARI(68)=PARI(68)+PT | |
6446 | 130 CONTINUE | |
6447 | PARI(67)=PARI(68) | |
6448 | PARI(71)=VINT(151) | |
6449 | PARI(72)=VINT(152) | |
6450 | PARI(73)=VINT(151) | |
6451 | PARI(74)=VINT(152) | |
6452 | ENDIF | |
6453 | ||
6454 | C...Decay of final state resonances. | |
ce320da8 | 6455 | IF(MSTP(41).GE.1.AND.ISUB.NE.95) CALL PYRESDA |
0119ef9a | 6456 | |
6457 | ELSE | |
6458 | C...Diffractive and elastic scattering. | |
ce320da8 | 6459 | CALL PYDIFFA |
0119ef9a | 6460 | IF(IOVL.EQ.1) THEN |
6461 | PARI(65)=2.*PARI(17) | |
6462 | PARI(66)=PARI(65) | |
6463 | PARI(69)=PARI(65) | |
6464 | ENDIF | |
6465 | ENDIF | |
6466 | ||
6467 | C...Recalculate energies from momenta and masses (if desired). | |
6468 | IF(MSTP(113).GE.1) THEN | |
6469 | DO 140 I=MINT(83)+1,N | |
6470 | 140 IF(K(I,1).GT.0.AND.K(I,1).LE.10) P(I,4)=SQRT(P(I,1)**2+ | |
6471 | & P(I,2)**2+P(I,3)**2+P(I,5)**2) | |
6472 | ENDIF | |
6473 | ||
6474 | C...Rearrange partons along strings, check invariant mass cuts. | |
6475 | MSTU(28)=0 | |
6476 | CALL LUPREP(MINT(84)+1) | |
6477 | IF(MSTP(112).EQ.1.AND.MSTU(28).EQ.3) GOTO 100 | |
6478 | IF(MSTP(125).EQ.0.OR.MSTP(125).EQ.1) THEN | |
6479 | DO 150 I=MINT(84)+1,N | |
6480 | IF(K(I,2).NE.94) GOTO 150 | |
6481 | K(I+1,3)=MOD(K(I+1,4)/MSTU(5),MSTU(5)) | |
6482 | K(I+2,3)=MOD(K(I+2,4)/MSTU(5),MSTU(5)) | |
6483 | 150 CONTINUE | |
6484 | CALL LUEDIT(12) | |
6485 | CALL LUEDIT(14) | |
6486 | IF(MSTP(125).EQ.0) CALL LUEDIT(15) | |
6487 | IF(MSTP(125).EQ.0) MINT(4)=0 | |
6488 | ENDIF | |
6489 | ||
6490 | C...Introduce separators between sections in LULIST event listing. | |
6491 | IF(IOVL.EQ.1.AND.MSTP(125).LE.0) THEN | |
6492 | MSTU(70)=1 | |
6493 | MSTU(71)=N | |
6494 | ELSEIF(IOVL.EQ.1) THEN | |
6495 | MSTU(70)=3 | |
6496 | MSTU(71)=2 | |
6497 | MSTU(72)=MINT(4) | |
6498 | MSTU(73)=N | |
6499 | ENDIF | |
6500 | ||
6501 | C...Perform hadronization (if desired). | |
6502 | IF(MSTP(111).GE.1) CALL LUEXEC | |
6503 | IF(MSTP(125).EQ.0.OR.MSTP(125).EQ.1) CALL LUEDIT(14) | |
6504 | ||
6505 | C...Calculate Monte Carlo estimates of cross-sections. | |
6506 | 160 IF(IOVL.EQ.1) THEN | |
6507 | IF(MSTP(111).NE.-1) NGEN(ISUB,3)=NGEN(ISUB,3)+1 | |
6508 | NGEN(0,3)=NGEN(0,3)+1 | |
6509 | XSEC(0,3)=0. | |
6510 | DO 170 I=1,200 | |
6511 | IF(I.EQ.96) THEN | |
6512 | XSEC(I,3)=0. | |
6513 | ELSEIF(MSUB(95).EQ.1.AND.(I.EQ.11.OR.I.EQ.12.OR.I.EQ.13.OR. | |
6514 | & I.EQ.28.OR.I.EQ.53.OR.I.EQ.68)) THEN | |
6515 | XSEC(I,3)=XSEC(96,2)*NGEN(I,3)/MAX(1.,FLOAT(NGEN(96,1))* | |
6516 | & FLOAT(NGEN(96,2))) | |
6517 | ELSEIF(NGEN(I,1).EQ.0) THEN | |
6518 | XSEC(I,3)=0. | |
6519 | ELSEIF(NGEN(I,2).EQ.0) THEN | |
6520 | XSEC(I,3)=XSEC(I,2)*NGEN(0,3)/(FLOAT(NGEN(I,1))* | |
6521 | & FLOAT(NGEN(0,2))) | |
6522 | ELSE | |
6523 | XSEC(I,3)=XSEC(I,2)*NGEN(I,3)/(FLOAT(NGEN(I,1))* | |
6524 | & FLOAT(NGEN(I,2))) | |
6525 | ENDIF | |
6526 | 170 XSEC(0,3)=XSEC(0,3)+XSEC(I,3) | |
6527 | IF(MSUB(95).EQ.1) THEN | |
6528 | NGENS=NGEN(91,3)+NGEN(92,3)+NGEN(93,3)+NGEN(94,3)+NGEN(95,3) | |
6529 | XSECS=XSEC(91,3)+XSEC(92,3)+XSEC(93,3)+XSEC(94,3)+XSEC(95,3) | |
6530 | XMAXS=XSEC(95,1) | |
6531 | IF(MSUB(91).EQ.1) XMAXS=XMAXS+XSEC(91,1) | |
6532 | IF(MSUB(92).EQ.1) XMAXS=XMAXS+XSEC(92,1) | |
6533 | IF(MSUB(93).EQ.1) XMAXS=XMAXS+XSEC(93,1) | |
6534 | IF(MSUB(94).EQ.1) XMAXS=XMAXS+XSEC(94,1) | |
6535 | FAC=1. | |
6536 | IF(NGENS.LT.NGEN(0,3)) FAC=(XMAXS-XSECS)/(XSEC(0,3)-XSECS) | |
6537 | XSEC(11,3)=FAC*XSEC(11,3) | |
6538 | XSEC(12,3)=FAC*XSEC(12,3) | |
6539 | XSEC(13,3)=FAC*XSEC(13,3) | |
6540 | XSEC(28,3)=FAC*XSEC(28,3) | |
6541 | XSEC(53,3)=FAC*XSEC(53,3) | |
6542 | XSEC(68,3)=FAC*XSEC(68,3) | |
6543 | XSEC(0,3)=XSEC(91,3)+XSEC(92,3)+XSEC(93,3)+XSEC(94,3)+ | |
6544 | & XSEC(95,1) | |
6545 | ENDIF | |
6546 | ||
6547 | C...Store final information. | |
6548 | MINT(5)=MINT(5)+1 | |
6549 | MSTI(3)=MINT(3) | |
6550 | MSTI(4)=MINT(4) | |
6551 | MSTI(5)=MINT(5) | |
6552 | MSTI(6)=MINT(6) | |
6553 | MSTI(7)=MINT(7) | |
6554 | MSTI(8)=MINT(8) | |
6555 | MSTI(13)=MINT(13) | |
6556 | MSTI(14)=MINT(14) | |
6557 | MSTI(21)=MINT(21) | |
6558 | MSTI(22)=MINT(22) | |
6559 | MSTI(23)=MINT(23) | |
6560 | MSTI(24)=MINT(24) | |
6561 | MSTI(25)=MINT(25) | |
6562 | MSTI(26)=MINT(26) | |
6563 | MSTI(31)=MINT(31) | |
6564 | PARI(1)=XSEC(0,3) | |
6565 | PARI(2)=XSEC(0,3)/MINT(5) | |
6566 | PARI(31)=VINT(141) | |
6567 | PARI(32)=VINT(142) | |
6568 | IF(ISUB.NE.95.AND.MINT(7)*MINT(8).NE.0) THEN | |
6569 | PARI(42)=2.*VINT(47)/VINT(1) | |
6570 | DO 180 IS=7,8 | |
6571 | PARI(36+IS)=P(MINT(IS),3)/VINT(1) | |
6572 | PARI(38+IS)=P(MINT(IS),4)/VINT(1) | |
6573 | I=MINT(IS) | |
6574 | PR=MAX(1E-20,P(I,5)**2+P(I,1)**2+P(I,2)**2) | |
6575 | PARI(40+IS)=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/ | |
6576 | & SQRT(PR),1E20)),P(I,3)) | |
6577 | PR=MAX(1E-20,P(I,1)**2+P(I,2)**2) | |
6578 | PARI(42+IS)=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/ | |
6579 | & SQRT(PR),1E20)),P(I,3)) | |
6580 | PARI(44+IS)=P(I,3)/SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2) | |
6581 | PARI(46+IS)=ULANGL(P(I,3),SQRT(P(I,1)**2+P(I,2)**2)) | |
6582 | PARI(48+IS)=ULANGL(P(I,1),P(I,2)) | |
6583 | 180 CONTINUE | |
6584 | ENDIF | |
6585 | PARI(61)=VINT(148) | |
6586 | IF(ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.3) THEN | |
6587 | MSTU(161)=MINT(21) | |
6588 | MSTU(162)=0 | |
6589 | ELSE | |
6590 | MSTU(161)=MINT(21) | |
6591 | MSTU(162)=MINT(22) | |
6592 | ENDIF | |
6593 | ENDIF | |
6594 | ||
6595 | C...Prepare to go to next overlayed event. | |
6596 | MSTI(41)=IOVL | |
6597 | IF(IOVL.GE.2.AND.IOVL.LE.10) MSTI(40+IOVL)=ISUB | |
6598 | IF(MSTU(70).LT.10) THEN | |
6599 | MSTU(70)=MSTU(70)+1 | |
6600 | MSTU(70+MSTU(70))=N | |
6601 | ENDIF | |
6602 | MINT(83)=N | |
6603 | MINT(84)=N+MSTP(126) | |
6604 | 190 CONTINUE | |
6605 | ||
6606 | C...Information on overlayed events. | |
6607 | IF(MSTP(131).EQ.1.AND.MSTP(133).GE.1) THEN | |
6608 | PARI(91)=VINT(132) | |
6609 | PARI(92)=VINT(133) | |
6610 | PARI(93)=VINT(134) | |
6611 | IF(MSTP(133).EQ.2) PARI(93)=PARI(93)*XSEC(0,3)/VINT(131) | |
6612 | ENDIF | |
6613 | ||
6614 | C...Transform to the desired coordinate frame. | |
ce320da8 | 6615 | 200 CALL PYFRAMA(MSTP(124)) |
0119ef9a | 6616 | |
6617 | RETURN | |
6618 | END | |
6619 | ||
6620 | C********************************************************************* | |
6621 | ||
ce320da8 | 6622 | SUBROUTINE PYINKIA(CHFRAM,CHBEAM,CHTARG,WIN) |
0119ef9a | 6623 | |
6624 | C...Identifies the two incoming particles and sets up kinematics, | |
6625 | C...including rotations and boosts to/from CM frame. | |
6626 | COMMON/LUJETSA/N,K(9000,5),P(9000,5),V(9000,5) | |
6627 | SAVE /LUJETSA/ | |
6628 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
6629 | SAVE /LUDAT1A/ | |
6630 | COMMON/PYSUBSA/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200) | |
6631 | SAVE /PYSUBSA/ | |
6632 | COMMON/PYPARSA/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
6633 | SAVE /PYPARSA/ | |
6634 | COMMON/PYINT1A/MINT(400),VINT(400) | |
6635 | SAVE /PYINT1A/ | |
6636 | CHARACTER CHFRAM*8,CHBEAM*8,CHTARG*8,CHCOM(3)*8,CHALP(2)*26, | |
6637 | &CHIDNT(3)*8,CHTEMP*8,CHCDE(18)*8,CHINIT*76 | |
6638 | DIMENSION LEN(3),KCDE(18) | |
6639 | DATA CHALP/'abcdefghijklmnopqrstuvwxyz', | |
6640 | &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ | |
6641 | DATA CHCDE/'e- ','e+ ','nue ','nue~ ', | |
6642 | &'mu- ','mu+ ','numu ','numu~ ','tau- ', | |
6643 | &'tau+ ','nutau ','nutau~ ','pi+ ','pi- ', | |
6644 | &'n ','n~ ','p ','p~ '/ | |
6645 | DATA KCDE/11,-11,12,-12,13,-13,14,-14,15,-15,16,-16, | |
6646 | &211,-211,2112,-2112,2212,-2212/ | |
6647 | ||
6648 | C...Convert character variables to lowercase and find their length. | |
6649 | CHCOM(1)=CHFRAM | |
6650 | CHCOM(2)=CHBEAM | |
6651 | CHCOM(3)=CHTARG | |
6652 | DO 120 I=1,3 | |
6653 | LEN(I)=8 | |
6654 | DO 100 LL=8,1,-1 | |
6655 | IF(LEN(I).EQ.LL.AND.CHCOM(I)(LL:LL).EQ.' ') LEN(I)=LL-1 | |
6656 | DO 100 LA=1,26 | |
6657 | 100 IF(CHCOM(I)(LL:LL).EQ.CHALP(2)(LA:LA)) CHCOM(I)(LL:LL)= | |
6658 | &CHALP(1)(LA:LA) | |
6659 | CHIDNT(I)=CHCOM(I) | |
6660 | DO 110 LL=1,6 | |
6661 | IF(CHIDNT(I)(LL:LL+2).EQ.'bar') THEN | |
6662 | CHTEMP=CHIDNT(I) | |
6663 | CHIDNT(I)=CHTEMP(1:LL-1)//'~'//CHTEMP(LL+3:8)//' ' | |
6664 | ENDIF | |
6665 | 110 CONTINUE | |
6666 | DO 120 LL=1,8 | |
6667 | IF(CHIDNT(I)(LL:LL).EQ.'_') THEN | |
6668 | CHTEMP=CHIDNT(I) | |
6669 | CHIDNT(I)=CHTEMP(1:LL-1)//CHTEMP(LL+1:8)//' ' | |
6670 | ENDIF | |
6671 | 120 CONTINUE | |
6672 | ||
6673 | C...Set initial state. Error for unknown codes. Reset variables. | |
6674 | N=2 | |
6675 | DO 140 I=1,2 | |
6676 | K(I,2)=0 | |
6677 | DO 130 J=1,18 | |
6678 | 130 IF(CHIDNT(I+1).EQ.CHCDE(J)) K(I,2)=KCDE(J) | |
6679 | P(I,5)=ULMASS(K(I,2)) | |
6680 | MINT(40+I)=1 | |
6681 | IF(IABS(K(I,2)).GT.100) MINT(40+I)=2 | |
6682 | DO 140 J=1,5 | |
6683 | 140 V(I,J)=0. | |
6684 | IF(K(1,2).EQ.0) WRITE(MSTU(11),1000) CHBEAM(1:LEN(2)) | |
6685 | IF(K(2,2).EQ.0) WRITE(MSTU(11),1100) CHTARG(1:LEN(3)) | |
6686 | IF(K(1,2).EQ.0.OR.K(2,2).EQ.0) STOP | |
6687 | DO 150 J=6,10 | |
6688 | 150 VINT(J)=0. | |
6689 | CHINIT=' ' | |
6690 | ||
6691 | C...Set up kinematics for events defined in CM frame. | |
6692 | IF(CHCOM(1)(1:2).EQ.'cm') THEN | |
6693 | IF(CHCOM(2)(1:1).NE.'e') THEN | |
6694 | LOFFS=(34-(LEN(2)+LEN(3)))/2 | |
6695 | CHINIT(LOFFS+1:76)='PYTHIA will be initialized for a '// | |
6696 | & CHCOM(2)(1:LEN(2))//'-'//CHCOM(3)(1:LEN(3))//' collider'//' ' | |
6697 | ELSE | |
6698 | LOFFS=(33-(LEN(2)+LEN(3)))/2 | |
6699 | CHINIT(LOFFS+1:76)='PYTHIA will be initialized for an '// | |
6700 | & CHCOM(2)(1:LEN(2))//'-'//CHCOM(3)(1:LEN(3))//' collider'//' ' | |
6701 | ENDIF | |
6702 | C WRITE(MSTU(11),1200) CHINIT | |
6703 | C WRITE(MSTU(11),1300) WIN | |
6704 | S=WIN**2 | |
6705 | P(1,1)=0. | |
6706 | P(1,2)=0. | |
6707 | P(2,1)=0. | |
6708 | P(2,2)=0. | |
6709 | P(1,3)=SQRT(((S-P(1,5)**2-P(2,5)**2)**2-(2.*P(1,5)*P(2,5))**2)/ | |
6710 | & (4.*S)) | |
6711 | P(2,3)=-P(1,3) | |
6712 | P(1,4)=SQRT(P(1,3)**2+P(1,5)**2) | |
6713 | P(2,4)=SQRT(P(2,3)**2+P(2,5)**2) | |
6714 | ||
6715 | C...Set up kinematics for fixed target events. | |
6716 | ELSEIF(CHCOM(1)(1:3).EQ.'fix') THEN | |
6717 | LOFFS=(29-(LEN(2)+LEN(3)))/2 | |
6718 | CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '// | |
6719 | & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// | |
6720 | & ' fixed target'//' ' | |
6721 | C WRITE(MSTU(11),1200) CHINIT | |
6722 | C WRITE(MSTU(11),1400) WIN | |
6723 | P(1,1)=0. | |
6724 | P(1,2)=0. | |
6725 | P(2,1)=0. | |
6726 | P(2,2)=0. | |
6727 | P(1,3)=WIN | |
6728 | P(1,4)=SQRT(P(1,3)**2+P(1,5)**2) | |
6729 | P(2,3)=0. | |
6730 | P(2,4)=P(2,5) | |
6731 | S=P(1,5)**2+P(2,5)**2+2.*P(2,4)*P(1,4) | |
6732 | VINT(10)=P(1,3)/(P(1,4)+P(2,4)) | |
6733 | CALL LUROBO(0.,0.,0.,0.,-VINT(10)) | |
6734 | C WRITE(MSTU(11),1500) SQRT(S) | |
6735 | ||
6736 | C...Set up kinematics for events in user-defined frame. | |
6737 | ELSEIF(CHCOM(1)(1:3).EQ.'use') THEN | |
6738 | LOFFS=(13-(LEN(1)+LEN(2)))/2 | |
6739 | CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '// | |
6740 | & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))// | |
6741 | & 'user-specified configuration'//' ' | |
6742 | C WRITE(MSTU(11),1200) CHINIT | |
6743 | C WRITE(MSTU(11),1600) | |
6744 | C WRITE(MSTU(11),1700) CHCOM(2),P(1,1),P(1,2),P(1,3) | |
6745 | C WRITE(MSTU(11),1700) CHCOM(3),P(2,1),P(2,2),P(2,3) | |
6746 | P(1,4)=SQRT(P(1,1)**2+P(1,2)**2+P(1,3)**2+P(1,5)**2) | |
6747 | P(2,4)=SQRT(P(2,1)**2+P(2,2)**2+P(2,3)**2+P(2,5)**2) | |
6748 | DO 160 J=1,3 | |
6749 | 160 VINT(7+J)=sngl((DBLE(P(1,J))+DBLE(P(2,J))) | |
6750 | & /DBLE(P(1,4)+P(2,4))) | |
6751 | CALL LUROBO(0.,0.,-VINT(8),-VINT(9),-VINT(10)) | |
6752 | VINT(7)=ULANGL(P(1,1),P(1,2)) | |
6753 | CALL LUROBO(0.,-VINT(7),0.,0.,0.) | |
6754 | VINT(6)=ULANGL(P(1,3),P(1,1)) | |
6755 | CALL LUROBO(-VINT(6),0.,0.,0.,0.) | |
6756 | S=P(1,5)**2+P(2,5)**2+2.*(P(1,4)*P(2,4)-P(1,3)*P(2,3)) | |
6757 | C WRITE(MSTU(11),1500) SQRT(S) | |
6758 | ||
6759 | C...Unknown frame. Error for too low CM energy. | |
6760 | ELSE | |
6761 | WRITE(MSTU(11),1800) CHFRAM(1:LEN(1)) | |
6762 | STOP | |
6763 | ENDIF | |
6764 | IF(S.LT.PARP(2)**2) THEN | |
6765 | WRITE(MSTU(11),1900) SQRT(S) | |
6766 | STOP | |
6767 | ENDIF | |
6768 | ||
6769 | C...Save information on incoming particles. | |
6770 | MINT(11)=K(1,2) | |
6771 | MINT(12)=K(2,2) | |
6772 | MINT(43)=2*MINT(41)+MINT(42)-2 | |
6773 | VINT(1)=SQRT(S) | |
6774 | VINT(2)=S | |
6775 | VINT(3)=P(1,5) | |
6776 | VINT(4)=P(2,5) | |
6777 | VINT(5)=P(1,3) | |
6778 | ||
6779 | C...Store constants to be used in generation. | |
6780 | IF(MSTP(82).LE.1) VINT(149)=4.*PARP(81)**2/S | |
6781 | IF(MSTP(82).GE.2) VINT(149)=4.*PARP(82)**2/S | |
6782 | ||
6783 | C...Formats for initialization and error information. | |
6784 | 1000 FORMAT(1X,'Error: unrecognized beam particle ''',A,'''.'/ | |
6785 | &1X,'Execution stopped!') | |
6786 | 1100 FORMAT(1X,'Error: unrecognized target particle ''',A,'''.'/ | |
6787 | &1X,'Execution stopped!') | |
6788 | clin 1200 FORMAT(/1X,78('=')/1X,'I',76X,'I'/1X,'I',A76,'I') | |
6789 | c 1300 FORMAT(1X,'I',18X,'at',1X,F10.3,1X,'GeV center-of-mass energy', | |
6790 | c &19X,'I'/1X,'I',76X,'I'/1X,78('=')) | |
6791 | c 1400 FORMAT(1X,'I',22X,'at',1X,F10.3,1X,'GeV/c lab-momentum',22X,'I') | |
6792 | c 1500 FORMAT(1X,'I',76X,'I'/1X,'I',11X,'corresponding to',1X,F10.3,1X, | |
6793 | c &'GeV center-of-mass energy',12X,'I'/1X,'I',76X,'I'/1X,78('=')) | |
6794 | c 1600 FORMAT(1X,'I',76X,'I'/1X,'I',24X,'px (GeV/c)',3X,'py (GeV/c)',3X, | |
6795 | c &'pz (GeV/c)',16X,'I') | |
6796 | clin 1700 FORMAT(1X,'I',15X,A8,3(2X,F10.3,1X),15X,'I') | |
6797 | 1800 FORMAT(1X,'Error: unrecognized coordinate frame ''',A,'''.'/ | |
6798 | &1X,'Execution stopped!') | |
6799 | 1900 FORMAT(1X,'Error: too low CM energy,',F8.3,' GeV for event ', | |
6800 | &'generation.'/1X,'Execution stopped!') | |
6801 | ||
6802 | RETURN | |
6803 | END | |
6804 | ||
6805 | C********************************************************************* | |
6806 | ||
ce320da8 | 6807 | SUBROUTINE PYINREA |
0119ef9a | 6808 | |
6809 | C...Calculates full and effective widths of guage bosons, stores masses | |
6810 | C...and widths, rescales coefficients to be used for resonance | |
6811 | C...production generation. | |
6812 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
6813 | SAVE /LUDAT1A/ | |
6814 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
6815 | SAVE /LUDAT2A/ | |
6816 | COMMON/LUDAT3A/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) | |
6817 | SAVE /LUDAT3A/ | |
6818 | COMMON/PYSUBSA/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200) | |
6819 | SAVE /PYSUBSA/ | |
6820 | COMMON/PYPARSA/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
6821 | SAVE /PYPARSA/ | |
6822 | COMMON/PYINT1A/MINT(400),VINT(400) | |
6823 | SAVE /PYINT1A/ | |
6824 | COMMON/PYINT2A/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2) | |
6825 | SAVE /PYINT2A/ | |
6826 | COMMON/PYINT4AA/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3) | |
6827 | SAVE /PYINT4AA/ | |
6828 | COMMON/PYINT6A/PROC(0:200) | |
6829 | CHARACTER PROC*28 | |
6830 | SAVE /PYINT6A/ | |
6831 | DIMENSION WDTP(0:40),WDTE(0:40,0:5) | |
6832 | ||
6833 | kc=0 | |
6834 | ||
6835 | C...Calculate full and effective widths of gauge bosons. | |
6836 | AEM=PARU(101) | |
6837 | XW=PARU(102) | |
6838 | DO 100 I=21,40 | |
6839 | DO 100 J=0,40 | |
6840 | WIDP(I,J)=0. | |
6841 | 100 WIDE(I,J)=0. | |
6842 | ||
6843 | C...W+/-: | |
6844 | WMAS=PMAS(24,1) | |
6845 | WFAC=AEM/(24.*XW)*WMAS | |
ce320da8 | 6846 | CALL PYWIDTA(24,WMAS,WDTP,WDTE) |
0119ef9a | 6847 | WIDS(24,1)=((WDTE(0,1)+WDTE(0,2))*(WDTE(0,1)+WDTE(0,3))+ |
6848 | &(WDTE(0,1)+WDTE(0,2)+WDTE(0,1)+WDTE(0,3))*(WDTE(0,4)+WDTE(0,5))+ | |
6849 | &2.*WDTE(0,4)*WDTE(0,5))/WDTP(0)**2 | |
6850 | WIDS(24,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0) | |
6851 | WIDS(24,3)=(WDTE(0,1)+WDTE(0,3)+WDTE(0,4))/WDTP(0) | |
6852 | DO 110 I=0,40 | |
6853 | WIDP(24,I)=WFAC*WDTP(I) | |
6854 | 110 WIDE(24,I)=WFAC*WDTE(I,0) | |
6855 | ||
6856 | C...H+/-: | |
6857 | HCMAS=PMAS(37,1) | |
6858 | HCFAC=AEM/(8.*XW)*(HCMAS/WMAS)**2*HCMAS | |
ce320da8 | 6859 | CALL PYWIDTA(37,HCMAS,WDTP,WDTE) |
0119ef9a | 6860 | WIDS(37,1)=((WDTE(0,1)+WDTE(0,2))*(WDTE(0,1)+WDTE(0,3))+ |
6861 | &(WDTE(0,1)+WDTE(0,2)+WDTE(0,1)+WDTE(0,3))*(WDTE(0,4)+WDTE(0,5))+ | |
6862 | &2.*WDTE(0,4)*WDTE(0,5))/WDTP(0)**2 | |
6863 | WIDS(37,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0) | |
6864 | WIDS(37,3)=(WDTE(0,1)+WDTE(0,3)+WDTE(0,4))/WDTP(0) | |
6865 | DO 120 I=0,40 | |
6866 | WIDP(37,I)=HCFAC*WDTP(I) | |
6867 | 120 WIDE(37,I)=HCFAC*WDTE(I,0) | |
6868 | ||
6869 | C...Z0: | |
6870 | ZMAS=PMAS(23,1) | |
6871 | ZFAC=AEM/(48.*XW*(1.-XW))*ZMAS | |
ce320da8 | 6872 | CALL PYWIDTA(23,ZMAS,WDTP,WDTE) |
0119ef9a | 6873 | WIDS(23,1)=((WDTE(0,1)+WDTE(0,2))**2+ |
6874 | &2.*(WDTE(0,1)+WDTE(0,2))*(WDTE(0,4)+WDTE(0,5))+ | |
6875 | &2.*WDTE(0,4)*WDTE(0,5))/WDTP(0)**2 | |
6876 | WIDS(23,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0) | |
6877 | WIDS(23,3)=0. | |
6878 | DO 130 I=0,40 | |
6879 | WIDP(23,I)=ZFAC*WDTP(I) | |
6880 | 130 WIDE(23,I)=ZFAC*WDTE(I,0) | |
6881 | ||
6882 | C...H0: | |
6883 | HMAS=PMAS(25,1) | |
6884 | HFAC=AEM/(8.*XW)*(HMAS/WMAS)**2*HMAS | |
ce320da8 | 6885 | CALL PYWIDTA(25,HMAS,WDTP,WDTE) |
0119ef9a | 6886 | WIDS(25,1)=((WDTE(0,1)+WDTE(0,2))**2+ |
6887 | &2.*(WDTE(0,1)+WDTE(0,2))*(WDTE(0,4)+WDTE(0,5))+ | |
6888 | &2.*WDTE(0,4)*WDTE(0,5))/WDTP(0)**2 | |
6889 | WIDS(25,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0) | |
6890 | WIDS(25,3)=0. | |
6891 | DO 140 I=0,40 | |
6892 | WIDP(25,I)=HFAC*WDTP(I) | |
6893 | 140 WIDE(25,I)=HFAC*WDTE(I,0) | |
6894 | ||
6895 | C...Z'0: | |
6896 | ZPMAS=PMAS(32,1) | |
6897 | ZPFAC=AEM/(48.*XW*(1.-XW))*ZPMAS | |
ce320da8 | 6898 | CALL PYWIDTA(32,ZPMAS,WDTP,WDTE) |
0119ef9a | 6899 | WIDS(32,1)=((WDTE(0,1)+WDTE(0,2)+WDTE(0,3))**2+ |
6900 | &2.*(WDTE(0,1)+WDTE(0,2))*(WDTE(0,4)+WDTE(0,5))+ | |
6901 | &2.*WDTE(0,4)*WDTE(0,5))/WDTP(0)**2 | |
6902 | WIDS(32,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0) | |
6903 | WIDS(32,3)=0. | |
6904 | DO 150 I=0,40 | |
6905 | WIDP(32,I)=ZPFAC*WDTP(I) | |
6906 | 150 WIDE(32,I)=ZPFAC*WDTE(I,0) | |
6907 | ||
6908 | C...R: | |
6909 | RMAS=PMAS(40,1) | |
6910 | RFAC=0.08*RMAS/((MSTP(1)-1)*(1.+6.*(1.+ULALPS(RMAS**2)/PARU(1)))) | |
ce320da8 | 6911 | CALL PYWIDTA(40,RMAS,WDTP,WDTE) |
0119ef9a | 6912 | WIDS(40,1)=((WDTE(0,1)+WDTE(0,2))*(WDTE(0,1)+WDTE(0,3))+ |
6913 | &(WDTE(0,1)+WDTE(0,2)+WDTE(0,1)+WDTE(0,3))*(WDTE(0,4)+WDTE(0,5))+ | |
6914 | &2.*WDTE(0,4)*WDTE(0,5))/WDTP(0)**2 | |
6915 | WIDS(40,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0) | |
6916 | WIDS(40,3)=(WDTE(0,1)+WDTE(0,3)+WDTE(0,4))/WDTP(0) | |
6917 | DO 160 I=0,40 | |
6918 | WIDP(40,I)=WFAC*WDTP(I) | |
6919 | 160 WIDE(40,I)=WFAC*WDTE(I,0) | |
6920 | ||
6921 | C...Q: | |
6922 | KFLQM=1 | |
6923 | DO 170 I=1,MIN(8,MDCY(21,3)) | |
6924 | IDC=I+MDCY(21,2)-1 | |
6925 | IF(MDME(IDC,1).LE.0) GOTO 170 | |
6926 | KFLQM=I | |
6927 | 170 CONTINUE | |
6928 | MINT(46)=KFLQM | |
6929 | KFPR(81,1)=KFLQM | |
6930 | KFPR(81,2)=KFLQM | |
6931 | KFPR(82,1)=KFLQM | |
6932 | KFPR(82,2)=KFLQM | |
6933 | ||
6934 | C...Set resonance widths and branching ratios in JETSET. | |
6935 | DO 180 I=1,6 | |
6936 | IF(I.LE.3) KC=I+22 | |
6937 | IF(I.EQ.4) KC=32 | |
6938 | IF(I.EQ.5) KC=37 | |
6939 | IF(I.EQ.6) KC=40 | |
6940 | PMAS(KC,2)=WIDP(KC,0) | |
6941 | PMAS(KC,3)=MIN(0.9*PMAS(KC,1),10.*PMAS(KC,2)) | |
6942 | DO 180 J=1,MDCY(KC,3) | |
6943 | IDC=J+MDCY(KC,2)-1 | |
6944 | BRAT(IDC)=WIDE(KC,J)/WIDE(KC,0) | |
6945 | 180 CONTINUE | |
6946 | ||
6947 | C...Special cases in treatment of gamma*/Z0: redefine process name. | |
6948 | IF(MSTP(43).EQ.1) THEN | |
6949 | PROC(1)='f + fb -> gamma*' | |
6950 | ELSEIF(MSTP(43).EQ.2) THEN | |
6951 | PROC(1)='f + fb -> Z0' | |
6952 | ELSEIF(MSTP(43).EQ.3) THEN | |
6953 | PROC(1)='f + fb -> gamma*/Z0' | |
6954 | ENDIF | |
6955 | ||
6956 | C...Special cases in treatment of gamma*/Z0/Z'0: redefine process name. | |
6957 | IF(MSTP(44).EQ.1) THEN | |
6958 | PROC(141)='f + fb -> gamma*' | |
6959 | ELSEIF(MSTP(44).EQ.2) THEN | |
6960 | PROC(141)='f + fb -> Z0' | |
6961 | ELSEIF(MSTP(44).EQ.3) THEN | |
6962 | PROC(141)='f + fb -> Z''0' | |
6963 | ELSEIF(MSTP(44).EQ.4) THEN | |
6964 | PROC(141)='f + fb -> gamma*/Z0' | |
6965 | ELSEIF(MSTP(44).EQ.5) THEN | |
6966 | PROC(141)='f + fb -> gamma*/Z''0' | |
6967 | ELSEIF(MSTP(44).EQ.6) THEN | |
6968 | PROC(141)='f + fb -> Z0/Z''0' | |
6969 | ELSEIF(MSTP(44).EQ.7) THEN | |
6970 | PROC(141)='f + fb -> gamma*/Z0/Z''0' | |
6971 | ENDIF | |
6972 | ||
6973 | RETURN | |
6974 | END | |
6975 | ||
6976 | C********************************************************************* | |
6977 | ||
ce320da8 | 6978 | SUBROUTINE PYXTOTA |
0119ef9a | 6979 | |
6980 | C...Parametrizes total, double diffractive, single diffractive and | |
6981 | C...elastic cross-sections for different energies and beams. | |
6982 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
6983 | SAVE /LUDAT1A/ | |
6984 | COMMON/PYPARSA/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
6985 | SAVE /PYPARSA/ | |
6986 | COMMON/PYINT1A/MINT(400),VINT(400) | |
6987 | SAVE /PYINT1A/ | |
6988 | COMMON/PYINT5A/NGEN(0:200,3),XSEC(0:200,3) | |
6989 | SAVE /PYINT5A/ | |
6990 | DIMENSION BCS(5,8),BCB(2,5),BCC(3) | |
6991 | ||
6992 | C...The following data lines are coefficients needed in the | |
6993 | C...Block, Cahn parametrization of total cross-section and nuclear | |
6994 | C...slope parameter; see below. | |
6995 | DATA ((BCS(I,J),J=1,8),I=1,5)/ | |
6996 | 1 41.74, 0.66, 0.0000, 337., 0.0, 0.0, -39.3, 0.48, | |
6997 | 2 41.66, 0.60, 0.0000, 306., 0.0, 0.0, -34.6, 0.51, | |
6998 | 3 41.36, 0.63, 0.0000, 299., 7.3, 0.5, -40.4, 0.47, | |
6999 | 4 41.68, 0.63, 0.0083, 330., 0.0, 0.0, -39.0, 0.48, | |
7000 | 5 41.13, 0.59, 0.0074, 278., 10.5, 0.5, -41.2, 0.46/ | |
7001 | DATA ((BCB(I,J),J=1,5),I=1,2)/ | |
7002 | 1 10.79, -0.049, 0.040, 21.5, 1.23, | |
7003 | 2 9.92, -0.027, 0.013, 18.9, 1.07/ | |
7004 | DATA BCC/2.0164346,-0.5590311,0.0376279/ | |
7005 | ||
7006 | C...Total cross-section and nuclear slope parameter for pp and p-pbar | |
7007 | NFIT=MIN(5,MAX(1,MSTP(31))) | |
7008 | SIGP=BCS(NFIT,1)+BCS(NFIT,2)*(-0.25*PARU(1)**2* | |
7009 | &(1.-0.25*BCS(NFIT,3)*PARU(1)**2)+(1.+0.5*BCS(NFIT,3)*PARU(1)**2)* | |
7010 | &(LOG(VINT(2)/BCS(NFIT,4)))**2+BCS(NFIT,3)* | |
7011 | &(LOG(VINT(2)/BCS(NFIT,4)))**4)/ | |
7012 | &((1.-0.25*BCS(NFIT,3)*PARU(1)**2)**2+2.*BCS(NFIT,3)* | |
7013 | &(1.+0.25*BCS(NFIT,3)*PARU(1)**2)*(LOG(VINT(2)/BCS(NFIT,4)))**2+ | |
7014 | &BCS(NFIT,3)**2*(LOG(VINT(2)/BCS(NFIT,4)))**4)+BCS(NFIT,5)* | |
7015 | &VINT(2)**(BCS(NFIT,6)-1.)*SIN(0.5*PARU(1)*BCS(NFIT,6)) | |
7016 | SIGM=-BCS(NFIT,7)*VINT(2)**(BCS(NFIT,8)-1.)* | |
7017 | &COS(0.5*PARU(1)*BCS(NFIT,8)) | |
7018 | REFP=BCS(NFIT,2)*PARU(1)*LOG(VINT(2)/BCS(NFIT,4))/ | |
7019 | &((1.-0.25*BCS(NFIT,3)*PARU(1)**2)**2+2.*BCS(NFIT,3)* | |
7020 | &(1.+0.25*BCS(NFIT,3)*PARU(1)**2)+(LOG(VINT(2)/BCS(NFIT,4)))**2+ | |
7021 | &BCS(NFIT,3)**2*(LOG(VINT(2)/BCS(NFIT,4)))**4)-BCS(NFIT,5)* | |
7022 | &VINT(2)**(BCS(NFIT,6)-1.)*COS(0.5*PARU(1)*BCS(NFIT,6)) | |
7023 | REFM=-BCS(NFIT,7)*VINT(2)**(BCS(NFIT,8)-1.)* | |
7024 | &SIN(0.5*PARU(1)*BCS(NFIT,8)) | |
7025 | SIGMA=SIGP-ISIGN(1,MINT(11)*MINT(12))*SIGM | |
7026 | RHO=(REFP-ISIGN(1,MINT(11)*MINT(12))*REFM)/SIGMA | |
7027 | ||
7028 | C...Nuclear slope parameter B, curvature C: | |
7029 | NFIT=1 | |
7030 | IF(MSTP(31).GE.4) NFIT=2 | |
7031 | BP=BCB(NFIT,1)+BCB(NFIT,2)*LOG(VINT(2))+ | |
7032 | &BCB(NFIT,3)*(LOG(VINT(2)))**2 | |
7033 | BM=BCB(NFIT,4)+BCB(NFIT,5)*LOG(VINT(2)) | |
7034 | B=BP-ISIGN(1,MINT(11)*MINT(12))*SIGM/SIGP*(BM-BP) | |
7035 | VINT(121)=B | |
7036 | C=-0.5*BCC(2)/BCC(3)*(1.-SQRT(MAX(0.,1.+4.*BCC(3)/BCC(2)**2* | |
7037 | &(1.E-03*VINT(1)-BCC(1))))) | |
7038 | VINT(122)=C | |
7039 | ||
7040 | C...Elastic scattering cross-section (fixed by sigma-tot, rho and B). | |
7041 | SIGEL=SIGMA**2*(1.+RHO**2)/(16.*PARU(1)*PARU(5)*B) | |
7042 | ||
7043 | C...Single diffractive scattering cross-section from Goulianos: | |
7044 | SIGSD=2.*0.68*(1.+36./VINT(2))*LOG(0.6+0.1*VINT(2)) | |
7045 | ||
7046 | C...Double diffractive scattering cross-section (essentially fixed by | |
7047 | C...sigma-sd and sigma-el). | |
7048 | SIGDD=SIGSD**2/(3.*SIGEL) | |
7049 | ||
7050 | C...Total non-elastic, non-diffractive cross-section. | |
7051 | SIGND=SIGMA-SIGDD-SIGSD-SIGEL | |
7052 | ||
7053 | C...Rescale for pions. | |
7054 | IF(IABS(MINT(11)).EQ.211.AND.IABS(MINT(12)).EQ.211) THEN | |
7055 | SIGMA=4./9.*SIGMA | |
7056 | SIGDD=4./9.*SIGDD | |
7057 | SIGSD=4./9.*SIGSD | |
7058 | SIGEL=4./9.*SIGEL | |
7059 | SIGND=4./9.*SIGND | |
7060 | ELSEIF(IABS(MINT(11)).EQ.211.OR.IABS(MINT(12)).EQ.211) THEN | |
7061 | SIGMA=2./3.*SIGMA | |
7062 | SIGDD=2./3.*SIGDD | |
7063 | SIGSD=2./3.*SIGSD | |
7064 | SIGEL=2./3.*SIGEL | |
7065 | SIGND=2./3.*SIGND | |
7066 | ENDIF | |
7067 | ||
7068 | C...Save cross-sections in common block PYPARA. | |
7069 | VINT(101)=SIGMA | |
7070 | VINT(102)=SIGEL | |
7071 | VINT(103)=SIGSD | |
7072 | VINT(104)=SIGDD | |
7073 | VINT(106)=SIGND | |
7074 | XSEC(95,1)=SIGND | |
7075 | ||
7076 | RETURN | |
7077 | END | |
7078 | ||
7079 | C********************************************************************* | |
7080 | ||
ce320da8 | 7081 | SUBROUTINE PYMAXIA |
0119ef9a | 7082 | |
7083 | C...Finds optimal set of coefficients for kinematical variable selection | |
7084 | C...and the maximum of the part of the differential cross-section used | |
7085 | C...in the event weighting. | |
7086 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
7087 | SAVE /LUDAT1A/ | |
7088 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
7089 | SAVE /LUDAT2A/ | |
7090 | COMMON/PYSUBSA/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200) | |
7091 | SAVE /PYSUBSA/ | |
7092 | COMMON/PYPARSA/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
7093 | SAVE /PYPARSA/ | |
7094 | COMMON/PYINT1A/MINT(400),VINT(400) | |
7095 | SAVE /PYINT1A/ | |
7096 | COMMON/PYINT2A/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2) | |
7097 | SAVE /PYINT2A/ | |
7098 | COMMON/PYINT3A/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) | |
7099 | SAVE /PYINT3A/ | |
7100 | COMMON/PYINT4AA/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3) | |
7101 | SAVE /PYINT4AA/ | |
7102 | COMMON/PYINT5A/NGEN(0:200,3),XSEC(0:200,3) | |
7103 | SAVE /PYINT5A/ | |
7104 | COMMON/PYINT6A/PROC(0:200) | |
7105 | CHARACTER PROC*28 | |
7106 | SAVE /PYINT6A/ | |
7107 | CHARACTER CVAR(4)*4 | |
7108 | DIMENSION NPTS(4),MVARPT(200,4),VINTPT(200,30),SIGSPT(200), | |
7109 | &NAREL(6),WTREL(6),WTMAT(6,6),COEFU(6),IACCMX(4),SIGSMX(4), | |
7110 | &SIGSSM(3) | |
7111 | DATA CVAR/'tau ','tau''','y* ','cth '/ | |
7112 | ||
7113 | taur1=0. | |
7114 | gamr1=0. | |
7115 | taur2=0. | |
7116 | gamr2=0. | |
7117 | atau3=0. | |
7118 | atau4=0. | |
7119 | atau5=0. | |
7120 | atau6=0. | |
7121 | ioff=0 | |
7122 | vvar=0. | |
7123 | vdel=0. | |
7124 | vmar=0. | |
7125 | ||
7126 | C...Select subprocess to study: skip cases not applicable. | |
7127 | VINT(143)=1. | |
7128 | VINT(144)=1. | |
7129 | XSEC(0,1)=0. | |
7130 | DO 350 ISUB=1,200 | |
7131 | IF(ISUB.GE.91.AND.ISUB.LE.95) THEN | |
7132 | XSEC(ISUB,1)=VINT(ISUB+11) | |
7133 | IF(MSUB(ISUB).NE.1) GOTO 350 | |
7134 | GOTO 340 | |
7135 | ELSEIF(ISUB.EQ.96) THEN | |
7136 | IF(MINT(43).NE.4) GOTO 350 | |
7137 | IF(MSUB(95).NE.1.AND.MSTP(81).LE.0.AND.MSTP(131).LE.0) GOTO 350 | |
7138 | ELSEIF(ISUB.EQ.11.OR.ISUB.EQ.12.OR.ISUB.EQ.13.OR.ISUB.EQ.28.OR. | |
7139 | &ISUB.EQ.53.OR.ISUB.EQ.68) THEN | |
7140 | IF(MSUB(ISUB).NE.1.OR.MSUB(95).EQ.1) GOTO 350 | |
7141 | ELSE | |
7142 | IF(MSUB(ISUB).NE.1) GOTO 350 | |
7143 | ENDIF | |
7144 | MINT(1)=ISUB | |
7145 | ISTSB=ISET(ISUB) | |
7146 | IF(ISUB.EQ.96) ISTSB=2 | |
7147 | IF(MSTP(122).GE.2) WRITE(MSTU(11),1000) ISUB | |
7148 | ||
7149 | C...Find resonances (explicit or implicit in cross-section). | |
7150 | MINT(72)=0 | |
7151 | KFR1=0 | |
7152 | IF(ISTSB.EQ.1.OR.ISTSB.EQ.3) THEN | |
7153 | KFR1=KFPR(ISUB,1) | |
7154 | ELSEIF(ISUB.GE.71.AND.ISUB.LE.77) THEN | |
7155 | KFR1=25 | |
7156 | ENDIF | |
7157 | IF(KFR1.NE.0) THEN | |
7158 | TAUR1=PMAS(KFR1,1)**2/VINT(2) | |
7159 | GAMR1=PMAS(KFR1,1)*PMAS(KFR1,2)/VINT(2) | |
7160 | MINT(72)=1 | |
7161 | MINT(73)=KFR1 | |
7162 | VINT(73)=TAUR1 | |
7163 | VINT(74)=GAMR1 | |
7164 | ENDIF | |
7165 | IF(ISUB.EQ.141) THEN | |
7166 | KFR2=23 | |
7167 | TAUR2=PMAS(KFR2,1)**2/VINT(2) | |
7168 | GAMR2=PMAS(KFR2,1)*PMAS(KFR2,2)/VINT(2) | |
7169 | MINT(72)=2 | |
7170 | MINT(74)=KFR2 | |
7171 | VINT(75)=TAUR2 | |
7172 | VINT(76)=GAMR2 | |
7173 | ENDIF | |
7174 | ||
7175 | C...Find product masses and minimum pT of process. | |
7176 | SQM3=0. | |
7177 | SQM4=0. | |
7178 | MINT(71)=0 | |
7179 | VINT(71)=CKIN(3) | |
7180 | IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN | |
7181 | IF(KFPR(ISUB,1).NE.0) SQM3=PMAS(KFPR(ISUB,1),1)**2 | |
7182 | IF(KFPR(ISUB,2).NE.0) SQM4=PMAS(KFPR(ISUB,2),1)**2 | |
7183 | IF(MIN(SQM3,SQM4).LT.CKIN(6)**2) MINT(71)=1 | |
7184 | IF(MINT(71).EQ.1) VINT(71)=MAX(CKIN(3),CKIN(5)) | |
7185 | IF(ISUB.EQ.96.AND.MSTP(82).LE.1) VINT(71)=PARP(81) | |
7186 | IF(ISUB.EQ.96.AND.MSTP(82).GE.2) VINT(71)=0.08*PARP(82) | |
7187 | ENDIF | |
7188 | VINT(63)=SQM3 | |
7189 | VINT(64)=SQM4 | |
7190 | ||
7191 | C...Number of points for each variable: tau, tau', y*, cos(theta-hat). | |
7192 | NPTS(1)=2+2*MINT(72) | |
7193 | IF(MINT(43).EQ.1.AND.(ISTSB.EQ.1.OR.ISTSB.EQ.2)) NPTS(1)=1 | |
7194 | NPTS(2)=1 | |
7195 | IF(MINT(43).GE.2.AND.(ISTSB.EQ.3.OR.ISTSB.EQ.4)) NPTS(2)=2 | |
7196 | NPTS(3)=1 | |
7197 | IF(MINT(43).EQ.4) NPTS(3)=3 | |
7198 | NPTS(4)=1 | |
7199 | IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) NPTS(4)=5 | |
7200 | NTRY=NPTS(1)*NPTS(2)*NPTS(3)*NPTS(4) | |
7201 | ||
7202 | C...Reset coefficients of cross-section weighting. | |
7203 | DO 100 J=1,20 | |
7204 | 100 COEF(ISUB,J)=0. | |
7205 | COEF(ISUB,1)=1. | |
7206 | COEF(ISUB,7)=0.5 | |
7207 | COEF(ISUB,8)=0.5 | |
7208 | COEF(ISUB,10)=1. | |
7209 | COEF(ISUB,15)=1. | |
7210 | MCTH=0 | |
7211 | MTAUP=0 | |
7212 | CTH=0. | |
7213 | TAUP=0. | |
7214 | SIGSAM=0. | |
7215 | ||
7216 | C...Find limits and select tau, y*, cos(theta-hat) and tau' values, | |
7217 | C...in grid of phase space points. | |
ce320da8 | 7218 | CALL PYKLIMA(1) |
0119ef9a | 7219 | NACC=0 |
7220 | DO 120 ITRY=1,NTRY | |
7221 | IF(MOD(ITRY-1,NPTS(2)*NPTS(3)*NPTS(4)).EQ.0) THEN | |
7222 | MTAU=1+(ITRY-1)/(NPTS(2)*NPTS(3)*NPTS(4)) | |
ce320da8 | 7223 | CALL PYKMAPA(1,MTAU,0.5) |
7224 | IF(ISTSB.EQ.3.OR.ISTSB.EQ.4) CALL PYKLIMA(4) | |
0119ef9a | 7225 | ENDIF |
7226 | IF((ISTSB.EQ.3.OR.ISTSB.EQ.4).AND.MOD(ITRY-1,NPTS(3)*NPTS(4)). | |
7227 | &EQ.0) THEN | |
7228 | MTAUP=1+MOD((ITRY-1)/(NPTS(3)*NPTS(4)),NPTS(2)) | |
ce320da8 | 7229 | CALL PYKMAPA(4,MTAUP,0.5) |
0119ef9a | 7230 | ENDIF |
ce320da8 | 7231 | IF(MOD(ITRY-1,NPTS(3)*NPTS(4)).EQ.0) CALL PYKLIMA(2) |
0119ef9a | 7232 | IF(MOD(ITRY-1,NPTS(4)).EQ.0) THEN |
7233 | MYST=1+MOD((ITRY-1)/NPTS(4),NPTS(3)) | |
ce320da8 | 7234 | CALL PYKMAPA(2,MYST,0.5) |
7235 | CALL PYKLIMA(3) | |
0119ef9a | 7236 | ENDIF |
7237 | IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN | |
7238 | MCTH=1+MOD(ITRY-1,NPTS(4)) | |
ce320da8 | 7239 | CALL PYKMAPA(3,MCTH,0.5) |
0119ef9a | 7240 | ENDIF |
7241 | IF(ISUB.EQ.96) VINT(25)=VINT(21)*(1.-VINT(23)**2) | |
7242 | ||
7243 | C...Calculate and store cross-section. | |
7244 | MINT(51)=0 | |
ce320da8 | 7245 | CALL PYKLIMA(0) |
0119ef9a | 7246 | IF(MINT(51).EQ.1) GOTO 120 |
7247 | NACC=NACC+1 | |
7248 | MVARPT(NACC,1)=MTAU | |
7249 | MVARPT(NACC,2)=MTAUP | |
7250 | MVARPT(NACC,3)=MYST | |
7251 | MVARPT(NACC,4)=MCTH | |
7252 | DO 110 J=1,30 | |
7253 | 110 VINTPT(NACC,J)=VINT(10+J) | |
ce320da8 | 7254 | CALL PYSIGHA(NCHN,SIGS) |
0119ef9a | 7255 | SIGSPT(NACC)=SIGS |
7256 | IF(SIGS.GT.SIGSAM) SIGSAM=SIGS | |
7257 | IF(MSTP(122).GE.2) WRITE(MSTU(11),1100) MTAU,MTAUP,MYST,MCTH, | |
7258 | &VINT(21),VINT(22),VINT(23),VINT(26),SIGS | |
7259 | 120 CONTINUE | |
7260 | IF(SIGSAM.EQ.0.) THEN | |
7261 | WRITE(MSTU(11),1200) ISUB | |
7262 | STOP | |
7263 | ENDIF | |
7264 | ||
7265 | C...Calculate integrals in tau and y* over maximal phase space limits. | |
7266 | TAUMIN=VINT(11) | |
7267 | TAUMAX=VINT(31) | |
7268 | ATAU1=LOG(TAUMAX/TAUMIN) | |
7269 | ATAU2=(TAUMAX-TAUMIN)/(TAUMAX*TAUMIN) | |
7270 | IF(NPTS(1).GE.3) THEN | |
7271 | ATAU3=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR1)/(TAUMAX+TAUR1))/TAUR1 | |
7272 | ATAU4=(ATAN((TAUMAX-TAUR1)/GAMR1)-ATAN((TAUMIN-TAUR1)/GAMR1))/ | |
7273 | & GAMR1 | |
7274 | ENDIF | |
7275 | IF(NPTS(1).GE.5) THEN | |
7276 | ATAU5=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR2)/(TAUMAX+TAUR2))/TAUR2 | |
7277 | ATAU6=(ATAN((TAUMAX-TAUR2)/GAMR2)-ATAN((TAUMIN-TAUR2)/GAMR2))/ | |
7278 | & GAMR2 | |
7279 | ENDIF | |
7280 | YSTMIN=0.5*LOG(TAUMIN) | |
7281 | YSTMAX=-YSTMIN | |
7282 | AYST0=YSTMAX-YSTMIN | |
7283 | AYST1=0.5*(YSTMAX-YSTMIN)**2 | |
7284 | AYST3=2.*(ATAN(EXP(YSTMAX))-ATAN(EXP(YSTMIN))) | |
7285 | ||
7286 | C...Reset. Sum up cross-sections in points calculated. | |
7287 | DO 230 IVAR=1,4 | |
7288 | IF(NPTS(IVAR).EQ.1) GOTO 230 | |
7289 | IF(ISUB.EQ.96.AND.IVAR.EQ.4) GOTO 230 | |
7290 | NBIN=NPTS(IVAR) | |
7291 | DO 130 J1=1,NBIN | |
7292 | NAREL(J1)=0 | |
7293 | WTREL(J1)=0. | |
7294 | COEFU(J1)=0. | |
7295 | DO 130 J2=1,NBIN | |
7296 | 130 WTMAT(J1,J2)=0. | |
7297 | DO 140 IACC=1,NACC | |
7298 | IBIN=MVARPT(IACC,IVAR) | |
7299 | NAREL(IBIN)=NAREL(IBIN)+1 | |
7300 | WTREL(IBIN)=WTREL(IBIN)+SIGSPT(IACC) | |
7301 | ||
7302 | C...Sum up tau cross-section pieces in points used. | |
7303 | IF(IVAR.EQ.1) THEN | |
7304 | TAU=VINTPT(IACC,11) | |
7305 | WTMAT(IBIN,1)=WTMAT(IBIN,1)+1. | |
7306 | WTMAT(IBIN,2)=WTMAT(IBIN,2)+(ATAU1/ATAU2)/TAU | |
7307 | IF(NBIN.GE.3) THEN | |
7308 | WTMAT(IBIN,3)=WTMAT(IBIN,3)+(ATAU1/ATAU3)/(TAU+TAUR1) | |
7309 | WTMAT(IBIN,4)=WTMAT(IBIN,4)+(ATAU1/ATAU4)*TAU/ | |
7310 | & ((TAU-TAUR1)**2+GAMR1**2) | |
7311 | ENDIF | |
7312 | IF(NBIN.GE.5) THEN | |
7313 | WTMAT(IBIN,5)=WTMAT(IBIN,5)+(ATAU1/ATAU5)/(TAU+TAUR2) | |
7314 | WTMAT(IBIN,6)=WTMAT(IBIN,6)+(ATAU1/ATAU6)*TAU/ | |
7315 | & ((TAU-TAUR2)**2+GAMR2**2) | |
7316 | ENDIF | |
7317 | ||
7318 | C...Sum up tau' cross-section pieces in points used. | |
7319 | ELSEIF(IVAR.EQ.2) THEN | |
7320 | TAU=VINTPT(IACC,11) | |
7321 | TAUP=VINTPT(IACC,16) | |
7322 | TAUPMN=VINTPT(IACC,6) | |
7323 | TAUPMX=VINTPT(IACC,26) | |
7324 | ATAUP1=LOG(TAUPMX/TAUPMN) | |
7325 | ATAUP2=((1.-TAU/TAUPMX)**4-(1.-TAU/TAUPMN)**4)/(4.*TAU) | |
7326 | WTMAT(IBIN,1)=WTMAT(IBIN,1)+1. | |
7327 | WTMAT(IBIN,2)=WTMAT(IBIN,2)+(ATAUP1/ATAUP2)*(1.-TAU/TAUP)**3/ | |
7328 | & TAUP | |
7329 | ||
7330 | C...Sum up y* and cos(theta-hat) cross-section pieces in points used. | |
7331 | ELSEIF(IVAR.EQ.3) THEN | |
7332 | YST=VINTPT(IACC,12) | |
7333 | WTMAT(IBIN,1)=WTMAT(IBIN,1)+(AYST0/AYST1)*(YST-YSTMIN) | |
7334 | WTMAT(IBIN,2)=WTMAT(IBIN,2)+(AYST0/AYST1)*(YSTMAX-YST) | |
7335 | WTMAT(IBIN,3)=WTMAT(IBIN,3)+(AYST0/AYST3)/COSH(YST) | |
7336 | ELSE | |
7337 | RM34=2.*SQM3*SQM4/(VINTPT(IACC,11)*VINT(2))**2 | |
7338 | RSQM=1.+RM34 | |
7339 | CTHMAX=SQRT(1.-4.*VINT(71)**2/(TAUMAX*VINT(2))) | |
7340 | CTHMIN=-CTHMAX | |
7341 | IF(CTHMAX.GT.0.9999) RM34=MAX(RM34,2.*VINT(71)**2/ | |
7342 | & (TAUMAX*VINT(2))) | |
7343 | ACTH1=CTHMAX-CTHMIN | |
7344 | ACTH2=LOG(MAX(RM34,RSQM-CTHMIN)/MAX(RM34,RSQM-CTHMAX)) | |
7345 | ACTH3=LOG(MAX(RM34,RSQM+CTHMAX)/MAX(RM34,RSQM+CTHMIN)) | |
7346 | ACTH4=1./MAX(RM34,RSQM-CTHMAX)-1./MAX(RM34,RSQM-CTHMIN) | |
7347 | ACTH5=1./MAX(RM34,RSQM+CTHMIN)-1./MAX(RM34,RSQM+CTHMAX) | |
7348 | CTH=VINTPT(IACC,13) | |
7349 | WTMAT(IBIN,1)=WTMAT(IBIN,1)+1. | |
7350 | WTMAT(IBIN,2)=WTMAT(IBIN,2)+(ACTH1/ACTH2)/MAX(RM34,RSQM-CTH) | |
7351 | WTMAT(IBIN,3)=WTMAT(IBIN,3)+(ACTH1/ACTH3)/MAX(RM34,RSQM+CTH) | |
7352 | WTMAT(IBIN,4)=WTMAT(IBIN,4)+(ACTH1/ACTH4)/MAX(RM34,RSQM-CTH)**2 | |
7353 | WTMAT(IBIN,5)=WTMAT(IBIN,5)+(ACTH1/ACTH5)/MAX(RM34,RSQM+CTH)**2 | |
7354 | ENDIF | |
7355 | 140 CONTINUE | |
7356 | ||
7357 | C...Check that equation system solvable; else trivial way out. | |
7358 | IF(MSTP(122).GE.2) WRITE(MSTU(11),1300) CVAR(IVAR) | |
7359 | MSOLV=1 | |
7360 | DO 150 IBIN=1,NBIN | |
7361 | IF(MSTP(122).GE.2) WRITE(MSTU(11),1400) (WTMAT(IBIN,IRED), | |
7362 | &IRED=1,NBIN),WTREL(IBIN) | |
7363 | 150 IF(NAREL(IBIN).EQ.0) MSOLV=0 | |
7364 | IF(MSOLV.EQ.0) THEN | |
7365 | DO 160 IBIN=1,NBIN | |
7366 | 160 COEFU(IBIN)=1. | |
7367 | ||
7368 | C...Solve to find relative importance of cross-section pieces. | |
7369 | ELSE | |
7370 | DO 170 IRED=1,NBIN-1 | |
7371 | DO 170 IBIN=IRED+1,NBIN | |
7372 | RQT=WTMAT(IBIN,IRED)/WTMAT(IRED,IRED) | |
7373 | WTREL(IBIN)=WTREL(IBIN)-RQT*WTREL(IRED) | |
7374 | DO 170 ICOE=IRED,NBIN | |
7375 | 170 WTMAT(IBIN,ICOE)=WTMAT(IBIN,ICOE)-RQT*WTMAT(IRED,ICOE) | |
7376 | DO 190 IRED=NBIN,1,-1 | |
7377 | DO 180 ICOE=IRED+1,NBIN | |
7378 | 180 WTREL(IRED)=WTREL(IRED)-WTMAT(IRED,ICOE)*COEFU(ICOE) | |
7379 | 190 COEFU(IRED)=WTREL(IRED)/WTMAT(IRED,IRED) | |
7380 | ENDIF | |
7381 | ||
7382 | C...Normalize coefficients, with piece shared democratically. | |
7383 | COEFSU=0. | |
7384 | DO 200 IBIN=1,NBIN | |
7385 | COEFU(IBIN)=MAX(0.,COEFU(IBIN)) | |
7386 | 200 COEFSU=COEFSU+COEFU(IBIN) | |
7387 | IF(IVAR.EQ.1) IOFF=0 | |
7388 | IF(IVAR.EQ.2) IOFF=14 | |
7389 | IF(IVAR.EQ.3) IOFF=6 | |
7390 | IF(IVAR.EQ.4) IOFF=9 | |
7391 | IF(COEFSU.GT.0.) THEN | |
7392 | DO 210 IBIN=1,NBIN | |
7393 | 210 COEF(ISUB,IOFF+IBIN)=PARP(121)/NBIN+(1.-PARP(121))*COEFU(IBIN)/ | |
7394 | & COEFSU | |
7395 | ELSE | |
7396 | DO 220 IBIN=1,NBIN | |
7397 | 220 COEF(ISUB,IOFF+IBIN)=1./NBIN | |
7398 | ENDIF | |
7399 | IF(MSTP(122).GE.2) WRITE(MSTU(11),1500) CVAR(IVAR), | |
7400 | &(COEF(ISUB,IOFF+IBIN),IBIN=1,NBIN) | |
7401 | 230 CONTINUE | |
7402 | ||
7403 | C...Find two most promising maxima among points previously determined. | |
7404 | DO 240 J=1,4 | |
7405 | IACCMX(J)=0 | |
7406 | 240 SIGSMX(J)=0. | |
7407 | NMAX=0 | |
7408 | DO 290 IACC=1,NACC | |
7409 | DO 250 J=1,30 | |
7410 | 250 VINT(10+J)=VINTPT(IACC,J) | |
ce320da8 | 7411 | CALL PYSIGHA(NCHN,SIGS) |
0119ef9a | 7412 | IEQ=0 |
7413 | DO 260 IMV=1,NMAX | |
7414 | 260 IF(ABS(SIGS-SIGSMX(IMV)).LT.1E-4*(SIGS+SIGSMX(IMV))) IEQ=IMV | |
7415 | IF(IEQ.EQ.0) THEN | |
7416 | DO 270 IMV=NMAX,1,-1 | |
7417 | IIN=IMV+1 | |
7418 | IF(SIGS.LE.SIGSMX(IMV)) GOTO 280 | |
7419 | IACCMX(IMV+1)=IACCMX(IMV) | |
7420 | 270 SIGSMX(IMV+1)=SIGSMX(IMV) | |
7421 | IIN=1 | |
7422 | 280 IACCMX(IIN)=IACC | |
7423 | SIGSMX(IIN)=SIGS | |
7424 | IF(NMAX.LE.1) NMAX=NMAX+1 | |
7425 | ENDIF | |
7426 | 290 CONTINUE | |
7427 | ||
7428 | C...Read out starting position for search. | |
7429 | IF(MSTP(122).GE.2) WRITE(MSTU(11),1600) | |
7430 | SIGSAM=SIGSMX(1) | |
7431 | DO 330 IMAX=1,NMAX | |
7432 | IACC=IACCMX(IMAX) | |
7433 | MTAU=MVARPT(IACC,1) | |
7434 | MTAUP=MVARPT(IACC,2) | |
7435 | MYST=MVARPT(IACC,3) | |
7436 | MCTH=MVARPT(IACC,4) | |
7437 | VTAU=0.5 | |
7438 | VYST=0.5 | |
7439 | VCTH=0.5 | |
7440 | VTAUP=0.5 | |
7441 | ||
7442 | C...Starting point and step size in parameter space. | |
7443 | DO 320 IRPT=1,2 | |
7444 | DO 310 IVAR=1,4 | |
7445 | IF(NPTS(IVAR).EQ.1) GOTO 310 | |
7446 | IF(IVAR.EQ.1) VVAR=VTAU | |
7447 | IF(IVAR.EQ.2) VVAR=VTAUP | |
7448 | IF(IVAR.EQ.3) VVAR=VYST | |
7449 | IF(IVAR.EQ.4) VVAR=VCTH | |
7450 | IF(IVAR.EQ.1) MVAR=MTAU | |
7451 | IF(IVAR.EQ.2) MVAR=MTAUP | |
7452 | IF(IVAR.EQ.3) MVAR=MYST | |
7453 | IF(IVAR.EQ.4) MVAR=MCTH | |
7454 | IF(IRPT.EQ.1) VDEL=0.1 | |
7455 | IF(IRPT.EQ.2) VDEL=MAX(0.01,MIN(0.05,VVAR-0.02,0.98-VVAR)) | |
7456 | IF(IRPT.EQ.1) VMAR=0.02 | |
7457 | IF(IRPT.EQ.2) VMAR=0.002 | |
7458 | IMOV0=1 | |
7459 | IF(IRPT.EQ.1.AND.IVAR.EQ.1) IMOV0=0 | |
7460 | DO 300 IMOV=IMOV0,8 | |
7461 | ||
7462 | C...Define new point in parameter space. | |
7463 | IF(IMOV.EQ.0) THEN | |
7464 | INEW=2 | |
7465 | VNEW=VVAR | |
7466 | ELSEIF(IMOV.EQ.1) THEN | |
7467 | INEW=3 | |
7468 | VNEW=VVAR+VDEL | |
7469 | ELSEIF(IMOV.EQ.2) THEN | |
7470 | INEW=1 | |
7471 | VNEW=VVAR-VDEL | |
7472 | ELSEIF(SIGSSM(3).GE.MAX(SIGSSM(1),SIGSSM(2)).AND. | |
7473 | &VVAR+2.*VDEL.LT.1.-VMAR) THEN | |
7474 | VVAR=VVAR+VDEL | |
7475 | SIGSSM(1)=SIGSSM(2) | |
7476 | SIGSSM(2)=SIGSSM(3) | |
7477 | INEW=3 | |
7478 | VNEW=VVAR+VDEL | |
7479 | ELSEIF(SIGSSM(1).GE.MAX(SIGSSM(2),SIGSSM(3)).AND. | |
7480 | &VVAR-2.*VDEL.GT.VMAR) THEN | |
7481 | VVAR=VVAR-VDEL | |
7482 | SIGSSM(3)=SIGSSM(2) | |
7483 | SIGSSM(2)=SIGSSM(1) | |
7484 | INEW=1 | |
7485 | VNEW=VVAR-VDEL | |
7486 | ELSEIF(SIGSSM(3).GE.SIGSSM(1)) THEN | |
7487 | VDEL=0.5*VDEL | |
7488 | VVAR=VVAR+VDEL | |
7489 | SIGSSM(1)=SIGSSM(2) | |
7490 | INEW=2 | |
7491 | VNEW=VVAR | |
7492 | ELSE | |
7493 | VDEL=0.5*VDEL | |
7494 | VVAR=VVAR-VDEL | |
7495 | SIGSSM(3)=SIGSSM(2) | |
7496 | INEW=2 | |
7497 | VNEW=VVAR | |
7498 | ENDIF | |
7499 | ||
7500 | C...Convert to relevant variables and find derived new limits. | |
7501 | IF(IVAR.EQ.1) THEN | |
7502 | VTAU=VNEW | |
ce320da8 | 7503 | CALL PYKMAPA(1,MTAU,VTAU) |
7504 | IF(ISTSB.EQ.3.OR.ISTSB.EQ.4) CALL PYKLIMA(4) | |
0119ef9a | 7505 | ENDIF |
7506 | IF(IVAR.LE.2.AND.(ISTSB.EQ.3.OR.ISTSB.EQ.4)) THEN | |
7507 | IF(IVAR.EQ.2) VTAUP=VNEW | |
ce320da8 | 7508 | CALL PYKMAPA(4,MTAUP,VTAUP) |
0119ef9a | 7509 | ENDIF |
ce320da8 | 7510 | IF(IVAR.LE.2) CALL PYKLIMA(2) |
0119ef9a | 7511 | IF(IVAR.LE.3) THEN |
7512 | IF(IVAR.EQ.3) VYST=VNEW | |
ce320da8 | 7513 | CALL PYKMAPA(2,MYST,VYST) |
7514 | CALL PYKLIMA(3) | |
0119ef9a | 7515 | ENDIF |
7516 | IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN | |
7517 | IF(IVAR.EQ.4) VCTH=VNEW | |
ce320da8 | 7518 | CALL PYKMAPA(3,MCTH,VCTH) |
0119ef9a | 7519 | ENDIF |
7520 | IF(ISUB.EQ.96) VINT(25)=VINT(21)*(1.-VINT(23)**2) | |
7521 | ||
7522 | C...Evaluate cross-section. Save new maximum. Final maximum. | |
ce320da8 | 7523 | CALL PYSIGHA(NCHN,SIGS) |
0119ef9a | 7524 | SIGSSM(INEW)=SIGS |
7525 | IF(SIGS.GT.SIGSAM) SIGSAM=SIGS | |
7526 | IF(MSTP(122).GE.2) WRITE(MSTU(11),1700) IMAX,IVAR,MVAR,IMOV, | |
7527 | &VNEW,VINT(21),VINT(22),VINT(23),VINT(26),SIGS | |
7528 | 300 CONTINUE | |
7529 | 310 CONTINUE | |
7530 | 320 CONTINUE | |
7531 | IF(IMAX.EQ.1) SIGS11=SIGSAM | |
7532 | 330 CONTINUE | |
7533 | XSEC(ISUB,1)=1.05*SIGSAM | |
7534 | 340 IF(ISUB.NE.96) XSEC(0,1)=XSEC(0,1)+XSEC(ISUB,1) | |
7535 | 350 CONTINUE | |
7536 | ||
7537 | C...Print summary table. | |
7538 | IF(MSTP(122).GE.1) THEN | |
7539 | WRITE(MSTU(11),1800) | |
7540 | WRITE(MSTU(11),1900) | |
7541 | DO 360 ISUB=1,200 | |
7542 | IF(MSUB(ISUB).NE.1.AND.ISUB.NE.96) GOTO 360 | |
7543 | IF(ISUB.EQ.96.AND.MINT(43).NE.4) GOTO 360 | |
7544 | IF(ISUB.EQ.96.AND.MSUB(95).NE.1.AND.MSTP(81).LE.0) GOTO 360 | |
7545 | IF(MSUB(95).EQ.1.AND.(ISUB.EQ.11.OR.ISUB.EQ.12.OR.ISUB.EQ.13.OR. | |
7546 | & ISUB.EQ.28.OR.ISUB.EQ.53.OR.ISUB.EQ.68)) GOTO 360 | |
7547 | WRITE(MSTU(11),2000) ISUB,PROC(ISUB),XSEC(ISUB,1) | |
7548 | 360 CONTINUE | |
7549 | WRITE(MSTU(11),2100) | |
7550 | ENDIF | |
7551 | ||
7552 | C...Format statements for maximization results. | |
7553 | 1000 FORMAT(/1X,'Coefficient optimization and maximum search for ', | |
7554 | &'subprocess no',I4/1X,'Coefficient modes tau',10X,'y*',9X, | |
7555 | &'cth',9X,'tau''',7X,'sigma') | |
7556 | 1100 FORMAT(1X,4I4,F12.8,F12.6,F12.7,F12.8,1P,E12.4) | |
7557 | 1200 FORMAT(1X,'Error: requested subprocess ',I3,' has vanishing ', | |
7558 | &'cross-section.'/1X,'Execution stopped!') | |
7559 | 1300 FORMAT(1X,'Coefficients of equation system to be solved for ',A4) | |
7560 | 1400 FORMAT(1X,1P,7E11.3) | |
7561 | 1500 FORMAT(1X,'Result for ',A4,':',6F9.4) | |
7562 | 1600 FORMAT(1X,'Maximum search for given coefficients'/2X,'MAX VAR ', | |
7563 | &'MOD MOV VNEW',7X,'tau',7X,'y*',8X,'cth',7X,'tau''',7X,'sigma') | |
7564 | 1700 FORMAT(1X,4I4,F8.4,F11.7,F9.3,F11.6,F11.7,1P,E12.4) | |
ce320da8 | 7565 | 1800 FORMAT(/1X,8('*'),1X,'PYMAXIA: summary of differential ', |
0119ef9a | 7566 | &'cross-section maximum search',1X,8('*')) |
7567 | 1900 FORMAT(/11X,58('=')/11X,'I',38X,'I',17X,'I'/11X,'I ISUB ', | |
7568 | &'Subprocess name',15X,'I Maximum value I'/11X,'I',38X,'I', | |
7569 | &17X,'I'/11X,58('=')/11X,'I',38X,'I',17X,'I') | |
7570 | 2000 FORMAT(11X,'I',2X,I3,3X,A28,2X,'I',2X,1P,E12.4,3X,'I') | |
7571 | 2100 FORMAT(11X,'I',38X,'I',17X,'I'/11X,58('=')) | |
7572 | ||
7573 | RETURN | |
7574 | END | |
7575 | ||
7576 | C********************************************************************* | |
7577 | ||
7578 | SUBROUTINE PYOVLY(MOVLY) | |
7579 | ||
7580 | C...Initializes multiplicity distribution and selects mutliplicity | |
7581 | C...of overlayed events, i.e. several events occuring at the same | |
7582 | C...beam crossing. | |
7583 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
7584 | SAVE /LUDAT1A/ | |
7585 | COMMON/PYPARSA/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
7586 | SAVE /PYPARSA/ | |
7587 | COMMON/PYINT1A/MINT(400),VINT(400) | |
7588 | SAVE /PYINT1A/ | |
7589 | DIMENSION WTI(0:100) | |
7590 | SAVE IMAX,WTI,WTS | |
7591 | ||
7592 | C...Sum of allowed cross-sections for overlayed events. | |
7593 | IF(MOVLY.EQ.1) THEN | |
7594 | VINT(131)=VINT(106) | |
7595 | IF(MSTP(132).GE.2) VINT(131)=VINT(131)+VINT(104) | |
7596 | IF(MSTP(132).GE.3) VINT(131)=VINT(131)+VINT(103) | |
7597 | IF(MSTP(132).GE.4) VINT(131)=VINT(131)+VINT(102) | |
7598 | ||
7599 | C...Initialize multiplicity distribution for unbiased events. | |
7600 | IF(MSTP(133).EQ.1) THEN | |
7601 | XNAVE=VINT(131)*PARP(131) | |
7602 | IF(XNAVE.GT.40.) WRITE(MSTU(11),1000) XNAVE | |
7603 | WTI(0)=EXP(-MIN(50.,XNAVE)) | |
7604 | WTS=0. | |
7605 | WTN=0. | |
7606 | DO 100 I=1,100 | |
7607 | WTI(I)=WTI(I-1)*XNAVE/I | |
7608 | IF(I-2.5.GT.XNAVE.AND.WTI(I).LT.1E-6) GOTO 110 | |
7609 | WTS=WTS+WTI(I) | |
7610 | WTN=WTN+WTI(I)*I | |
7611 | 100 IMAX=I | |
7612 | 110 VINT(132)=XNAVE | |
7613 | VINT(133)=WTN/WTS | |
7614 | VINT(134)=WTS | |
7615 | ||
7616 | C...Initialize mutiplicity distribution for biased events. | |
7617 | ELSEIF(MSTP(133).EQ.2) THEN | |
7618 | XNAVE=VINT(131)*PARP(131) | |
7619 | IF(XNAVE.GT.40.) WRITE(MSTU(11),1000) XNAVE | |
7620 | WTI(1)=EXP(-MIN(50.,XNAVE))*XNAVE | |
7621 | WTS=WTI(1) | |
7622 | WTN=WTI(1) | |
7623 | DO 120 I=2,100 | |
7624 | WTI(I)=WTI(I-1)*XNAVE/(I-1) | |
7625 | IF(I-2.5.GT.XNAVE.AND.WTI(I).LT.1E-6) GOTO 130 | |
7626 | WTS=WTS+WTI(I) | |
7627 | WTN=WTN+WTI(I)*I | |
7628 | 120 IMAX=I | |
7629 | 130 VINT(132)=XNAVE | |
7630 | VINT(133)=WTN/WTS | |
7631 | VINT(134)=WTS | |
7632 | ENDIF | |
7633 | ||
7634 | C...Pick multiplicity of overlayed events. | |
7635 | ELSE | |
7636 | IF(MSTP(133).EQ.0) THEN | |
7637 | MINT(81)=MAX(1,MSTP(134)) | |
7638 | ELSE | |
7639 | WTR=WTS*RLU(0) | |
7640 | DO 140 I=1,IMAX | |
7641 | MINT(81)=I | |
7642 | WTR=WTR-WTI(I) | |
7643 | IF(WTR.LE.0.) GOTO 150 | |
7644 | 140 CONTINUE | |
7645 | 150 CONTINUE | |
7646 | ENDIF | |
7647 | ENDIF | |
7648 | ||
7649 | C...Format statement for error message. | |
7650 | 1000 FORMAT(1X,'Warning: requested average number of events per bunch', | |
7651 | &'crossing too large, ',1P,E12.4) | |
7652 | ||
7653 | RETURN | |
7654 | END | |
7655 | ||
7656 | C********************************************************************* | |
7657 | ||
ce320da8 | 7658 | SUBROUTINE PYRANDA |
0119ef9a | 7659 | |
7660 | C...Generates quantities characterizing the high-pT scattering at the | |
7661 | C...parton level according to the matrix elements. Chooses incoming, | |
7662 | C...reacting partons, their momentum fractions and one of the possible | |
7663 | C...subprocesses. | |
7664 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
7665 | SAVE /LUDAT1A/ | |
7666 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
7667 | SAVE /LUDAT2A/ | |
7668 | COMMON/PYSUBSA/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200) | |
7669 | SAVE /PYSUBSA/ | |
7670 | COMMON/PYPARSA/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
7671 | SAVE /PYPARSA/ | |
7672 | COMMON/PYINT1A/MINT(400),VINT(400) | |
7673 | SAVE /PYINT1A/ | |
7674 | COMMON/PYINT2A/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2) | |
7675 | SAVE /PYINT2A/ | |
7676 | COMMON/PYINT3A/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) | |
7677 | SAVE /PYINT3A/ | |
7678 | COMMON/PYINT4AA/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3) | |
7679 | SAVE /PYINT4AA/ | |
7680 | COMMON/PYINT5A/NGEN(0:200,3),XSEC(0:200,3) | |
7681 | SAVE /PYINT5A/ | |
7682 | ||
7683 | C...Initial values, specifically for (first) semihard interaction. | |
7684 | MINT(17)=0 | |
7685 | MINT(18)=0 | |
7686 | VINT(143)=1. | |
7687 | VINT(144)=1. | |
ce320da8 | 7688 | IF(MSUB(95).EQ.1.OR.MINT(82).GE.2) CALL PYMULTA(2) |
0119ef9a | 7689 | ISUB=0 |
7690 | 100 MINT(51)=0 | |
7691 | ||
7692 | C...Choice of process type - first event of overlay. | |
7693 | IF(MINT(82).EQ.1.AND.(ISUB.LE.90.OR.ISUB.GT.96)) THEN | |
7694 | RSUB=XSEC(0,1)*RLU(0) | |
7695 | DO 110 I=1,200 | |
7696 | IF(MSUB(I).NE.1) GOTO 110 | |
7697 | ISUB=I | |
7698 | RSUB=RSUB-XSEC(I,1) | |
7699 | IF(RSUB.LE.0.) GOTO 120 | |
7700 | 110 CONTINUE | |
7701 | 120 IF(ISUB.EQ.95) ISUB=96 | |
7702 | ||
7703 | C...Choice of inclusive process type - overlayed events. | |
7704 | ELSEIF(MINT(82).GE.2.AND.ISUB.EQ.0) THEN | |
7705 | RSUB=VINT(131)*RLU(0) | |
7706 | ISUB=96 | |
7707 | IF(RSUB.GT.VINT(106)) ISUB=93 | |
7708 | IF(RSUB.GT.VINT(106)+VINT(104)) ISUB=92 | |
7709 | IF(RSUB.GT.VINT(106)+VINT(104)+VINT(103)) ISUB=91 | |
7710 | ENDIF | |
7711 | IF(MINT(82).EQ.1) NGEN(0,1)=NGEN(0,1)+1 | |
7712 | IF(MINT(82).EQ.1) NGEN(ISUB,1)=NGEN(ISUB,1)+1 | |
7713 | MINT(1)=ISUB | |
7714 | ||
7715 | C...Find resonances (explicit or implicit in cross-section). | |
7716 | MINT(72)=0 | |
7717 | KFR1=0 | |
7718 | IF(ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.3) THEN | |
7719 | KFR1=KFPR(ISUB,1) | |
7720 | ELSEIF(ISUB.GE.71.AND.ISUB.LE.77) THEN | |
7721 | KFR1=25 | |
7722 | ENDIF | |
7723 | IF(KFR1.NE.0) THEN | |
7724 | TAUR1=PMAS(KFR1,1)**2/VINT(2) | |
7725 | GAMR1=PMAS(KFR1,1)*PMAS(KFR1,2)/VINT(2) | |
7726 | MINT(72)=1 | |
7727 | MINT(73)=KFR1 | |
7728 | VINT(73)=TAUR1 | |
7729 | VINT(74)=GAMR1 | |
7730 | ENDIF | |
7731 | IF(ISUB.EQ.141) THEN | |
7732 | KFR2=23 | |
7733 | TAUR2=PMAS(KFR2,1)**2/VINT(2) | |
7734 | GAMR2=PMAS(KFR2,1)*PMAS(KFR2,2)/VINT(2) | |
7735 | MINT(72)=2 | |
7736 | MINT(74)=KFR2 | |
7737 | VINT(75)=TAUR2 | |
7738 | VINT(76)=GAMR2 | |
7739 | ENDIF | |
7740 | ||
7741 | C...Find product masses and minimum pT of process, | |
7742 | C...optionally with broadening according to a truncated Breit-Wigner. | |
7743 | VINT(63)=0. | |
7744 | VINT(64)=0. | |
7745 | MINT(71)=0 | |
7746 | VINT(71)=CKIN(3) | |
7747 | IF(MINT(82).GE.2) VINT(71)=0. | |
7748 | IF(ISET(ISUB).EQ.2.OR.ISET(ISUB).EQ.4) THEN | |
7749 | DO 130 I=1,2 | |
7750 | IF(KFPR(ISUB,I).EQ.0) THEN | |
7751 | ELSEIF(MSTP(42).LE.0) THEN | |
7752 | VINT(62+I)=PMAS(KFPR(ISUB,I),1)**2 | |
7753 | ELSE | |
7754 | VINT(62+I)=ULMASS(KFPR(ISUB,I))**2 | |
7755 | ENDIF | |
7756 | 130 CONTINUE | |
7757 | IF(MIN(VINT(63),VINT(64)).LT.CKIN(6)**2) MINT(71)=1 | |
7758 | IF(MINT(71).EQ.1) VINT(71)=MAX(CKIN(3),CKIN(5)) | |
7759 | ENDIF | |
7760 | ||
7761 | IF(ISET(ISUB).EQ.0) THEN | |
7762 | C...Double or single diffractive, or elastic scattering: | |
7763 | C...choose m^2 according to 1/m^2 (diffractive), constant (elastic) | |
7764 | IS=INT(1.5+RLU(0)) | |
7765 | VINT(63)=VINT(3)**2 | |
7766 | VINT(64)=VINT(4)**2 | |
7767 | IF(ISUB.EQ.92.OR.ISUB.EQ.93) VINT(62+IS)=PARP(111)**2 | |
7768 | IF(ISUB.EQ.93) VINT(65-IS)=PARP(111)**2 | |
7769 | SH=VINT(2) | |
7770 | SQM1=VINT(3)**2 | |
7771 | SQM2=VINT(4)**2 | |
7772 | SQM3=VINT(63) | |
7773 | SQM4=VINT(64) | |
7774 | SQLA12=(SH-SQM1-SQM2)**2-4.*SQM1*SQM2 | |
7775 | SQLA34=(SH-SQM3-SQM4)**2-4.*SQM3*SQM4 | |
7776 | THTER1=SQM1+SQM2+SQM3+SQM4-(SQM1-SQM2)*(SQM3-SQM4)/SH-SH | |
7777 | THTER2=SQRT(MAX(0.,SQLA12))*SQRT(MAX(0.,SQLA34))/SH | |
7778 | THL=0.5*(THTER1-THTER2) | |
7779 | THU=0.5*(THTER1+THTER2) | |
7780 | THM=MIN(MAX(THL,PARP(101)),THU) | |
7781 | JTMAX=0 | |
7782 | IF(ISUB.EQ.92.OR.ISUB.EQ.93) JTMAX=ISUB-91 | |
7783 | DO 140 JT=1,JTMAX | |
7784 | MINT(13+3*JT-IS*(2*JT-3))=1 | |
7785 | SQMMIN=VINT(59+3*JT-IS*(2*JT-3)) | |
7786 | SQMI=VINT(8-3*JT+IS*(2*JT-3))**2 | |
7787 | SQMJ=VINT(3*JT-1-IS*(2*JT-3))**2 | |
7788 | SQMF=VINT(68-3*JT+IS*(2*JT-3)) | |
7789 | SQUA=0.5*SH/SQMI*((1.+(SQMI-SQMJ)/SH)*THM+SQMI-SQMF- | |
7790 | & SQMJ**2/SH+(SQMI+SQMJ)*SQMF/SH+(SQMI-SQMJ)**2/SH**2*SQMF) | |
7791 | QUAR=SH/SQMI*(THM*(THM+SH-SQMI-SQMJ-SQMF*(1.-(SQMI-SQMJ)/SH))+ | |
7792 | & SQMI*SQMJ-SQMJ*SQMF*(1.+(SQMI-SQMJ-SQMF)/SH)) | |
7793 | SQMMAX=SQUA+SQRT(MAX(0.,SQUA**2-QUAR)) | |
7794 | IF(ABS(QUAR/SQUA**2).LT.1.E-06) SQMMAX=0.5*QUAR/SQUA | |
7795 | SQMMAX=MIN(SQMMAX,(VINT(1)-SQRT(SQMF))**2) | |
7796 | VINT(59+3*JT-IS*(2*JT-3))=SQMMIN*(SQMMAX/SQMMIN)**RLU(0) | |
7797 | 140 CONTINUE | |
7798 | C...Choose t-hat according to exp(B*t-hat+C*t-hat^2). | |
7799 | SQM3=VINT(63) | |
7800 | SQM4=VINT(64) | |
7801 | SQLA34=(SH-SQM3-SQM4)**2-4.*SQM3*SQM4 | |
7802 | THTER1=SQM1+SQM2+SQM3+SQM4-(SQM1-SQM2)*(SQM3-SQM4)/SH-SH | |
7803 | THTER2=SQRT(MAX(0.,SQLA12))*SQRT(MAX(0.,SQLA34))/SH | |
7804 | THL=0.5*(THTER1-THTER2) | |
7805 | THU=0.5*(THTER1+THTER2) | |
7806 | B=VINT(121) | |
7807 | C=VINT(122) | |
7808 | IF(ISUB.EQ.92.OR.ISUB.EQ.93) THEN | |
7809 | B=0.5*B | |
7810 | C=0.5*C | |
7811 | ENDIF | |
7812 | THM=MIN(MAX(THL,PARP(101)),THU) | |
7813 | EXPTH=0. | |
7814 | THARG=B*(THM-THU) | |
7815 | IF(THARG.GT.-20.) EXPTH=EXP(THARG) | |
7816 | 150 TH=THU+LOG(EXPTH+(1.-EXPTH)*RLU(0))/B | |
7817 | TH=MAX(THM,MIN(THU,TH)) | |
7818 | RATLOG=MIN((B+C*(TH+THM))*(TH-THM),(B+C*(TH+THU))*(TH-THU)) | |
7819 | IF(RATLOG.LT.LOG(RLU(0))) GOTO 150 | |
7820 | VINT(21)=1. | |
7821 | VINT(22)=0. | |
7822 | VINT(23)=MIN(1.,MAX(-1.,(2.*TH-THTER1)/THTER2)) | |
7823 | ||
7824 | C...Note: in the following, by In is meant the integral over the | |
7825 | C...quantity multiplying coefficient cn. | |
7826 | C...Choose tau according to h1(tau)/tau, where | |
7827 | C...h1(tau) = c0 + I0/I1*c1*1/tau + I0/I2*c2*1/(tau+tau_R) + | |
7828 | C...I0/I3*c3*tau/((s*tau-m^2)^2+(m*Gamma)^2) + | |
7829 | C...I0/I4*c4*1/(tau+tau_R') + | |
7830 | C...I0/I5*c5*tau/((s*tau-m'^2)^2+(m'*Gamma')^2), and | |
7831 | C...c0 + c1 + c2 + c3 + c4 + c5 = 1 | |
7832 | ELSEIF(ISET(ISUB).GE.1.AND.ISET(ISUB).LE.4) THEN | |
ce320da8 | 7833 | CALL PYKLIMA(1) |
0119ef9a | 7834 | IF(MINT(51).NE.0) GOTO 100 |
7835 | RTAU=RLU(0) | |
7836 | MTAU=1 | |
7837 | IF(RTAU.GT.COEF(ISUB,1)) MTAU=2 | |
7838 | IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)) MTAU=3 | |
7839 | IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)+COEF(ISUB,3)) MTAU=4 | |
7840 | IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)+COEF(ISUB,3)+COEF(ISUB,4)) | |
7841 | & MTAU=5 | |
7842 | IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)+COEF(ISUB,3)+COEF(ISUB,4)+ | |
7843 | & COEF(ISUB,5)) MTAU=6 | |
ce320da8 | 7844 | CALL PYKMAPA(1,MTAU,RLU(0)) |
0119ef9a | 7845 | |
7846 | C...2 -> 3, 4 processes: | |
7847 | C...Choose tau' according to h4(tau,tau')/tau', where | |
7848 | C...h4(tau,tau') = c0 + I0/I1*c1*(1 - tau/tau')^3/tau', and | |
7849 | C...c0 + c1 = 1. | |
7850 | IF(ISET(ISUB).EQ.3.OR.ISET(ISUB).EQ.4) THEN | |
ce320da8 | 7851 | CALL PYKLIMA(4) |
0119ef9a | 7852 | IF(MINT(51).NE.0) GOTO 100 |
7853 | RTAUP=RLU(0) | |
7854 | MTAUP=1 | |
7855 | IF(RTAUP.GT.COEF(ISUB,15)) MTAUP=2 | |
ce320da8 | 7856 | CALL PYKMAPA(4,MTAUP,RLU(0)) |
0119ef9a | 7857 | ENDIF |
7858 | ||
7859 | C...Choose y* according to h2(y*), where | |
7860 | C...h2(y*) = I0/I1*c1*(y*-y*min) + I0/I2*c2*(y*max-y*) + | |
7861 | C...I0/I3*c3*1/cosh(y*), I0 = y*max-y*min, and c1 + c2 + c3 = 1. | |
ce320da8 | 7862 | CALL PYKLIMA(2) |
0119ef9a | 7863 | IF(MINT(51).NE.0) GOTO 100 |
7864 | RYST=RLU(0) | |
7865 | MYST=1 | |
7866 | IF(RYST.GT.COEF(ISUB,7)) MYST=2 | |
7867 | IF(RYST.GT.COEF(ISUB,7)+COEF(ISUB,8)) MYST=3 | |
ce320da8 | 7868 | CALL PYKMAPA(2,MYST,RLU(0)) |
0119ef9a | 7869 | |
7870 | C...2 -> 2 processes: | |
7871 | C...Choose cos(theta-hat) (cth) according to h3(cth), where | |
7872 | C...h3(cth) = c0 + I0/I1*c1*1/(A - cth) + I0/I2*c2*1/(A + cth) + | |
7873 | C...I0/I3*c3*1/(A - cth)^2 + I0/I4*c4*1/(A + cth)^2, | |
7874 | C...A = 1 + 2*(m3*m4/sh)^2 (= 1 for massless products), | |
7875 | C...and c0 + c1 + c2 + c3 + c4 = 1. | |
ce320da8 | 7876 | CALL PYKLIMA(3) |
0119ef9a | 7877 | IF(MINT(51).NE.0) GOTO 100 |
7878 | IF(ISET(ISUB).EQ.2.OR.ISET(ISUB).EQ.4) THEN | |
7879 | RCTH=RLU(0) | |
7880 | MCTH=1 | |
7881 | IF(RCTH.GT.COEF(ISUB,10)) MCTH=2 | |
7882 | IF(RCTH.GT.COEF(ISUB,10)+COEF(ISUB,11)) MCTH=3 | |
7883 | IF(RCTH.GT.COEF(ISUB,10)+COEF(ISUB,11)+COEF(ISUB,12)) MCTH=4 | |
7884 | IF(RCTH.GT.COEF(ISUB,10)+COEF(ISUB,11)+COEF(ISUB,12)+ | |
7885 | & COEF(ISUB,13)) MCTH=5 | |
ce320da8 | 7886 | CALL PYKMAPA(3,MCTH,RLU(0)) |
0119ef9a | 7887 | ENDIF |
7888 | ||
7889 | C...Low-pT or multiple interactions (first semihard interaction). | |
7890 | ELSEIF(ISET(ISUB).EQ.5) THEN | |
ce320da8 | 7891 | CALL PYMULTA(3) |
0119ef9a | 7892 | ISUB=MINT(1) |
7893 | ENDIF | |
7894 | ||
7895 | C...Choose azimuthal angle. | |
7896 | VINT(24)=PARU(2)*RLU(0) | |
7897 | ||
7898 | C...Check against user cuts on kinematics at parton level. | |
7899 | MINT(51)=0 | |
ce320da8 | 7900 | IF(ISUB.LE.90.OR.ISUB.GT.100) CALL PYKLIMA(0) |
0119ef9a | 7901 | IF(MINT(51).NE.0) GOTO 100 |
7902 | IF(MINT(82).EQ.1.AND.MSTP(141).GE.1) THEN | |
7903 | MCUT=0 | |
7904 | IF(MSUB(91)+MSUB(92)+MSUB(93)+MSUB(94)+MSUB(95).EQ.0) | |
ce320da8 | 7905 | & CALL PYKCUTA(MCUT) |
0119ef9a | 7906 | IF(MCUT.NE.0) GOTO 100 |
7907 | ENDIF | |
7908 | ||
7909 | C...Calculate differential cross-section for different subprocesses. | |
ce320da8 | 7910 | CALL PYSIGHA(NCHN,SIGS) |
0119ef9a | 7911 | |
7912 | C...Calculations for Monte Carlo estimate of all cross-sections. | |
7913 | IF(MINT(82).EQ.1.AND.ISUB.LE.90.OR.ISUB.GE.96) THEN | |
7914 | XSEC(ISUB,2)=XSEC(ISUB,2)+SIGS | |
7915 | ELSEIF(MINT(82).EQ.1) THEN | |
7916 | XSEC(ISUB,2)=XSEC(ISUB,2)+XSEC(ISUB,1) | |
7917 | ENDIF | |
7918 | ||
7919 | C...Multiple interactions: store results of cross-section calculation. | |
7920 | IF(MINT(43).EQ.4.AND.MSTP(82).GE.3) THEN | |
7921 | VINT(153)=SIGS | |
ce320da8 | 7922 | CALL PYMULTA(4) |
0119ef9a | 7923 | ENDIF |
7924 | ||
7925 | C...Weighting using estimate of maximum of differential cross-section. | |
7926 | VIOL=SIGS/XSEC(ISUB,1) | |
7927 | IF(VIOL.LT.RLU(0)) GOTO 100 | |
7928 | ||
7929 | C...Check for possible violation of estimated maximum of differential | |
7930 | C...cross-section used in weighting. | |
7931 | IF(MSTP(123).LE.0) THEN | |
7932 | IF(VIOL.GT.1.) THEN | |
7933 | WRITE(MSTU(11),1000) VIOL,NGEN(0,3)+1 | |
7934 | WRITE(MSTU(11),1100) ISUB,VINT(21),VINT(22),VINT(23),VINT(26) | |
7935 | STOP | |
7936 | ENDIF | |
7937 | ELSEIF(MSTP(123).EQ.1) THEN | |
7938 | IF(VIOL.GT.VINT(108)) THEN | |
7939 | VINT(108)=VIOL | |
7940 | C IF(VIOL.GT.1.) THEN | |
7941 | C WRITE(MSTU(11),1200) VIOL,NGEN(0,3)+1 | |
7942 | C WRITE(MSTU(11),1100) ISUB,VINT(21),VINT(22),VINT(23), | |
7943 | C & VINT(26) | |
7944 | C ENDIF | |
7945 | ENDIF | |
7946 | ELSEIF(VIOL.GT.VINT(108)) THEN | |
7947 | VINT(108)=VIOL | |
7948 | IF(VIOL.GT.1.) THEN | |
7949 | XDIF=XSEC(ISUB,1)*(VIOL-1.) | |
7950 | XSEC(ISUB,1)=XSEC(ISUB,1)+XDIF | |
7951 | IF(MSUB(ISUB).EQ.1.AND.(ISUB.LE.90.OR.ISUB.GT.96)) | |
7952 | & XSEC(0,1)=XSEC(0,1)+XDIF | |
7953 | C WRITE(MSTU(11),1200) VIOL,NGEN(0,3)+1 | |
7954 | C WRITE(MSTU(11),1100) ISUB,VINT(21),VINT(22),VINT(23),VINT(26) | |
7955 | C IF(ISUB.LE.9) THEN | |
7956 | C WRITE(MSTU(11),1300) ISUB,XSEC(ISUB,1) | |
7957 | C ELSEIF(ISUB.LE.99) THEN | |
7958 | C WRITE(MSTU(11),1400) ISUB,XSEC(ISUB,1) | |
7959 | C ELSE | |
7960 | C WRITE(MSTU(11),1500) ISUB,XSEC(ISUB,1) | |
7961 | C ENDIF | |
7962 | VINT(108)=1. | |
7963 | ENDIF | |
7964 | ENDIF | |
7965 | ||
7966 | C...Multiple interactions: choose impact parameter. | |
7967 | VINT(148)=1. | |
7968 | IF(MINT(43).EQ.4.AND.(ISUB.LE.90.OR.ISUB.GE.96).AND.MSTP(82).GE.3) | |
7969 | &THEN | |
ce320da8 | 7970 | CALL PYMULTA(5) |
0119ef9a | 7971 | IF(VINT(150).LT.RLU(0)) GOTO 100 |
7972 | ENDIF | |
7973 | IF(MINT(82).EQ.1.AND.MSUB(95).EQ.1) THEN | |
7974 | IF(ISUB.LE.90.OR.ISUB.GE.95) NGEN(95,1)=NGEN(95,1)+1 | |
7975 | IF(ISUB.LE.90.OR.ISUB.GE.96) NGEN(96,2)=NGEN(96,2)+1 | |
7976 | ENDIF | |
7977 | IF(ISUB.LE.90.OR.ISUB.GE.96) MINT(31)=MINT(31)+1 | |
7978 | ||
7979 | C...Choose flavour of reacting partons (and subprocess). | |
7980 | RSIGS=SIGS*RLU(0) | |
7981 | QT2=VINT(48) | |
7982 | RQQBAR=PARP(87)*(1.-(QT2/(QT2+(PARP(88)*PARP(82))**2))**2) | |
7983 | IF(ISUB.NE.95.AND.(ISUB.NE.96.OR.MSTP(82).LE.1.OR. | |
7984 | &RLU(0).GT.RQQBAR)) THEN | |
7985 | DO 190 ICHN=1,NCHN | |
7986 | KFL1=ISIG(ICHN,1) | |
7987 | KFL2=ISIG(ICHN,2) | |
7988 | MINT(2)=ISIG(ICHN,3) | |
7989 | RSIGS=RSIGS-SIGH(ICHN) | |
7990 | IF(RSIGS.LE.0.) GOTO 210 | |
7991 | 190 CONTINUE | |
7992 | ||
7993 | C...Multiple interactions: choose qqbar preferentially at small pT. | |
7994 | ELSEIF(ISUB.EQ.96) THEN | |
ce320da8 | 7995 | CALL PYSPLIA(MINT(11),21,KFL1,KFLDUM) |
7996 | CALL PYSPLIA(MINT(12),21,KFL2,KFLDUM) | |
0119ef9a | 7997 | MINT(1)=11 |
7998 | MINT(2)=1 | |
7999 | IF(KFL1.EQ.KFL2.AND.RLU(0).LT.0.5) MINT(2)=2 | |
8000 | ||
8001 | C...Low-pT: choose string drawing configuration. | |
8002 | ELSE | |
8003 | KFL1=21 | |
8004 | KFL2=21 | |
8005 | RSIGS=6.*RLU(0) | |
8006 | MINT(2)=1 | |
8007 | IF(RSIGS.GT.1.) MINT(2)=2 | |
8008 | IF(RSIGS.GT.2.) MINT(2)=3 | |
8009 | ENDIF | |
8010 | ||
8011 | C...Reassign QCD process. Partons before initial state radiation. | |
8012 | 210 IF(MINT(2).GT.10) THEN | |
8013 | MINT(1)=MINT(2)/10 | |
8014 | MINT(2)=MOD(MINT(2),10) | |
8015 | ENDIF | |
8016 | MINT(15)=KFL1 | |
8017 | MINT(16)=KFL2 | |
8018 | MINT(13)=MINT(15) | |
8019 | MINT(14)=MINT(16) | |
8020 | VINT(141)=VINT(41) | |
8021 | VINT(142)=VINT(42) | |
8022 | ||
8023 | C...Format statements for differential cross-section maximum violations. | |
8024 | 1000 FORMAT(1X,'Error: maximum violated by',1P,E11.3,1X, | |
8025 | &'in event',1X,I7,'.'/1X,'Execution stopped!') | |
8026 | 1100 FORMAT(1X,'ISUB = ',I3,'; Point of violation:'/1X,'tau=',1P, | |
8027 | &E11.3,', y* =',E11.3,', cthe = ',0P,F11.7,', tau'' =',1P,E11.3) | |
8028 | clin 1200 FORMAT(1X,'Warning: maximum violated by',1P,E11.3,1X, | |
8029 | c &'in event',1X,I7) | |
8030 | c 1300 FORMAT(1X,'XSEC(',I1,',1) increased to',1P,E11.3) | |
8031 | c 1400 FORMAT(1X,'XSEC(',I2,',1) increased to',1P,E11.3) | |
8032 | clin 1500 FORMAT(1X,'XSEC(',I3,',1) increased to',1P,E11.3) | |
8033 | ||
8034 | RETURN | |
8035 | END | |
8036 | ||
8037 | C********************************************************************* | |
8038 | ||
ce320da8 | 8039 | SUBROUTINE PYSCATA |
0119ef9a | 8040 | |
8041 | C...Finds outgoing flavours and event type; sets up the kinematics | |
8042 | C...and colour flow of the hard scattering. | |
8043 | COMMON/LUJETSA/N,K(9000,5),P(9000,5),V(9000,5) | |
8044 | SAVE /LUJETSA/ | |
8045 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
8046 | SAVE /LUDAT1A/ | |
8047 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
8048 | SAVE /LUDAT2A/ | |
8049 | COMMON/LUDAT3A/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) | |
8050 | SAVE /LUDAT3A/ | |
8051 | COMMON/PYSUBSA/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200) | |
8052 | SAVE /PYSUBSA/ | |
8053 | COMMON/PYPARSA/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
8054 | SAVE /PYPARSA/ | |
8055 | COMMON/PYINT1A/MINT(400),VINT(400) | |
8056 | SAVE /PYINT1A/ | |
8057 | COMMON/PYINT2A/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2) | |
8058 | SAVE /PYINT2A/ | |
8059 | COMMON/PYINT3A/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) | |
8060 | SAVE /PYINT3A/ | |
8061 | COMMON/PYINT4AA/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3) | |
8062 | SAVE /PYINT4AA/ | |
8063 | COMMON/PYINT5A/NGEN(0:200,3),XSEC(0:200,3) | |
8064 | SAVE /PYINT5A/ | |
8065 | DIMENSION WDTP(0:40),WDTE(0:40,0:5),PMQ(2),Z(2),CTHE(2),PHI(2) | |
8066 | ||
8067 | kflq=0 | |
8068 | phir=0. | |
8069 | ||
8070 | C...Choice of subprocess, number of documentation lines. | |
8071 | ISUB=MINT(1) | |
8072 | IDOC=6+ISET(ISUB) | |
8073 | IF(ISUB.EQ.95) IDOC=8 | |
8074 | MINT(3)=IDOC-6 | |
8075 | IF(IDOC.GE.9) IDOC=IDOC+2 | |
8076 | MINT(4)=IDOC | |
8077 | IPU1=MINT(84)+1 | |
8078 | IPU2=MINT(84)+2 | |
8079 | IPU3=MINT(84)+3 | |
8080 | IPU4=MINT(84)+4 | |
8081 | IPU5=MINT(84)+5 | |
8082 | IPU6=MINT(84)+6 | |
8083 | ||
8084 | C...Reset K, P and V vectors. Store incoming particles. | |
8085 | DO 100 JT=1,MSTP(126)+10 | |
8086 | I=MINT(83)+JT | |
8087 | DO 100 J=1,5 | |
8088 | K(I,J)=0 | |
8089 | P(I,J)=0. | |
8090 | 100 V(I,J)=0. | |
8091 | DO 110 JT=1,2 | |
8092 | I=MINT(83)+JT | |
8093 | K(I,1)=21 | |
8094 | K(I,2)=MINT(10+JT) | |
8095 | P(I,1)=0. | |
8096 | P(I,2)=0. | |
8097 | P(I,5)=VINT(2+JT) | |
8098 | P(I,3)=VINT(5)*(-1)**(JT+1) | |
8099 | 110 P(I,4)=SQRT(P(I,3)**2+P(I,5)**2) | |
8100 | MINT(6)=2 | |
8101 | KFRES=0 | |
8102 | ||
8103 | C...Store incoming partons in their CM-frame. | |
8104 | SH=VINT(44) | |
8105 | SHR=SQRT(SH) | |
8106 | SHP=VINT(26)*VINT(2) | |
8107 | SHPR=SQRT(SHP) | |
8108 | SHUSER=SHR | |
8109 | IF(ISET(ISUB).GE.3) SHUSER=SHPR | |
8110 | DO 120 JT=1,2 | |
8111 | I=MINT(84)+JT | |
8112 | K(I,1)=14 | |
8113 | K(I,2)=MINT(14+JT) | |
8114 | K(I,3)=MINT(83)+2+JT | |
8115 | 120 P(I,5)=ULMASS(K(I,2)) | |
8116 | IF(P(IPU1,5)+P(IPU2,5).GE.SHUSER) THEN | |
8117 | P(IPU1,5)=0. | |
8118 | P(IPU2,5)=0. | |
8119 | ENDIF | |
8120 | P(IPU1,4)=0.5*(SHUSER+(P(IPU1,5)**2-P(IPU2,5)**2)/SHUSER) | |
8121 | P(IPU1,3)=SQRT(MAX(0.,P(IPU1,4)**2-P(IPU1,5)**2)) | |
8122 | P(IPU2,4)=SHUSER-P(IPU1,4) | |
8123 | P(IPU2,3)=-P(IPU1,3) | |
8124 | ||
8125 | C...Copy incoming partons to documentation lines. | |
8126 | DO 130 JT=1,2 | |
8127 | I1=MINT(83)+4+JT | |
8128 | I2=MINT(84)+JT | |
8129 | K(I1,1)=21 | |
8130 | K(I1,2)=K(I2,2) | |
8131 | K(I1,3)=I1-2 | |
8132 | DO 130 J=1,5 | |
8133 | 130 P(I1,J)=P(I2,J) | |
8134 | ||
8135 | C...Choose new quark flavour for relevant annihilation graphs. | |
8136 | IF(ISUB.EQ.12.OR.ISUB.EQ.53) THEN | |
ce320da8 | 8137 | CALL PYWIDTA(21,SHR,WDTP,WDTE) |
0119ef9a | 8138 | RKFL=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))*RLU(0) |
8139 | DO 140 I=1,2*MSTP(1) | |
8140 | KFLQ=I | |
8141 | RKFL=RKFL-(WDTE(I,1)+WDTE(I,2)+WDTE(I,4)) | |
8142 | IF(RKFL.LE.0.) GOTO 150 | |
8143 | 140 CONTINUE | |
8144 | 150 CONTINUE | |
8145 | ENDIF | |
8146 | ||
8147 | C...Final state flavours and colour flow: default values. | |
8148 | JS=1 | |
8149 | MINT(21)=MINT(15) | |
8150 | MINT(22)=MINT(16) | |
8151 | MINT(23)=0 | |
8152 | MINT(24)=0 | |
8153 | KCC=20 | |
8154 | KCS=ISIGN(1,MINT(15)) | |
8155 | ||
8156 | IF(ISUB.LE.10) THEN | |
8157 | IF(ISUB.EQ.1) THEN | |
8158 | C...f + fb -> gamma*/Z0. | |
8159 | KFRES=23 | |
8160 | ||
8161 | ELSEIF(ISUB.EQ.2) THEN | |
8162 | C...f + fb' -> W+/- . | |
8163 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
8164 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
8165 | KFRES=ISIGN(24,KCH1+KCH2) | |
8166 | ||
8167 | ELSEIF(ISUB.EQ.3) THEN | |
8168 | C...f + fb -> H0. | |
8169 | KFRES=25 | |
8170 | ||
8171 | ELSEIF(ISUB.EQ.4) THEN | |
8172 | C...gamma + W+/- -> W+/-. | |
8173 | ||
8174 | ELSEIF(ISUB.EQ.5) THEN | |
8175 | C...Z0 + Z0 -> H0. | |
8176 | XH=SH/SHP | |
8177 | MINT(21)=MINT(15) | |
8178 | MINT(22)=MINT(16) | |
8179 | PMQ(1)=ULMASS(MINT(21)) | |
8180 | PMQ(2)=ULMASS(MINT(22)) | |
8181 | 240 JT=INT(1.5+RLU(0)) | |
8182 | ZMIN=2.*PMQ(JT)/SHPR | |
8183 | ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT))) | |
8184 | ZMAX=MIN(1.-XH,ZMAX) | |
8185 | Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU(0) | |
8186 | IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT. | |
8187 | & (1.-XH)**2/(4.*XH)*RLU(0)) GOTO 240 | |
8188 | SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP) | |
8189 | IF(SQC1.LT.1.E-8) GOTO 240 | |
8190 | C1=SQRT(SQC1) | |
8191 | C2=1.+2.*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP) | |
8192 | CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1 | |
8193 | CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT))) | |
8194 | Z(3-JT)=1.-XH/(1.-Z(JT)) | |
8195 | SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP) | |
8196 | IF(SQC1.LT.1.E-8) GOTO 240 | |
8197 | C1=SQRT(SQC1) | |
8198 | C2=1.+2.*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP) | |
8199 | CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1 | |
8200 | CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT))) | |
8201 | PHIR=PARU(2)*RLU(0) | |
8202 | CPHI=COS(PHIR) | |
8203 | ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI | |
8204 | Z1=2.-Z(JT) | |
8205 | Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP) | |
8206 | Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP | |
8207 | Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)* | |
8208 | & PMQ(3-JT)**2/SHP)) | |
8209 | ZMIN=2.*PMQ(3-JT)/SHPR | |
8210 | ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT))) | |
8211 | ZMAX=MIN(1.-XH,ZMAX) | |
8212 | IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 240 | |
8213 | KCC=22 | |
8214 | KFRES=25 | |
8215 | ||
8216 | ELSEIF(ISUB.EQ.6) THEN | |
8217 | C...Z0 + W+/- -> W+/-. | |
8218 | ||
8219 | ELSEIF(ISUB.EQ.7) THEN | |
8220 | C...W+ + W- -> Z0. | |
8221 | ||
8222 | ELSEIF(ISUB.EQ.8) THEN | |
8223 | C...W+ + W- -> H0. | |
8224 | XH=SH/SHP | |
8225 | 250 DO 280 JT=1,2 | |
8226 | I=MINT(14+JT) | |
8227 | IA=IABS(I) | |
8228 | IF(IA.LE.10) THEN | |
8229 | RVCKM=VINT(180+I)*RLU(0) | |
8230 | DO 270 J=1,MSTP(1) | |
8231 | IB=2*J-1+MOD(IA,2) | |
8232 | IPM=(5-ISIGN(1,I))/2 | |
8233 | IDC=J+MDCY(IA,2)+2 | |
8234 | IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 270 | |
8235 | MINT(20+JT)=ISIGN(IB,I) | |
8236 | RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) | |
8237 | IF(RVCKM.LE.0.) GOTO 280 | |
8238 | 270 CONTINUE | |
8239 | ELSE | |
8240 | IB=2*((IA+1)/2)-1+MOD(IA,2) | |
8241 | MINT(20+JT)=ISIGN(IB,I) | |
8242 | ENDIF | |
8243 | 280 PMQ(JT)=ULMASS(MINT(20+JT)) | |
8244 | JT=INT(1.5+RLU(0)) | |
8245 | ZMIN=2.*PMQ(JT)/SHPR | |
8246 | ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT))) | |
8247 | ZMAX=MIN(1.-XH,ZMAX) | |
8248 | Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU(0) | |
8249 | IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT. | |
8250 | & (1.-XH)**2/(4.*XH)*RLU(0)) GOTO 250 | |
8251 | SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP) | |
8252 | IF(SQC1.LT.1.E-8) GOTO 250 | |
8253 | C1=SQRT(SQC1) | |
8254 | C2=1.+2.*(PMAS(24,1)**2-PMQ(JT)**2)/(Z(JT)*SHP) | |
8255 | CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1 | |
8256 | CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT))) | |
8257 | Z(3-JT)=1.-XH/(1.-Z(JT)) | |
8258 | SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP) | |
8259 | IF(SQC1.LT.1.E-8) GOTO 250 | |
8260 | C1=SQRT(SQC1) | |
8261 | C2=1.+2.*(PMAS(24,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP) | |
8262 | CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1 | |
8263 | CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT))) | |
8264 | PHIR=PARU(2)*RLU(0) | |
8265 | CPHI=COS(PHIR) | |
8266 | ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI | |
8267 | Z1=2.-Z(JT) | |
8268 | Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP) | |
8269 | Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP | |
8270 | Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)* | |
8271 | & PMQ(3-JT)**2/SHP)) | |
8272 | ZMIN=2.*PMQ(3-JT)/SHPR | |
8273 | ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT))) | |
8274 | ZMAX=MIN(1.-XH,ZMAX) | |
8275 | IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 250 | |
8276 | KCC=22 | |
8277 | KFRES=25 | |
8278 | ENDIF | |
8279 | ||
8280 | ELSEIF(ISUB.LE.20) THEN | |
8281 | IF(ISUB.EQ.11) THEN | |
8282 | C...f + f' -> f + f'; th = (p(f)-p(f))**2. | |
8283 | KCC=MINT(2) | |
8284 | IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2 | |
8285 | ||
8286 | ELSEIF(ISUB.EQ.12) THEN | |
8287 | C...f + fb -> f' + fb'; th = (p(f)-p(f'))**2. | |
8288 | MINT(21)=ISIGN(KFLQ,MINT(15)) | |
8289 | MINT(22)=-MINT(21) | |
8290 | KCC=4 | |
8291 | ||
8292 | ELSEIF(ISUB.EQ.13) THEN | |
8293 | C...f + fb -> g + g; th arbitrary. | |
8294 | MINT(21)=21 | |
8295 | MINT(22)=21 | |
8296 | KCC=MINT(2)+4 | |
8297 | ||
8298 | ELSEIF(ISUB.EQ.14) THEN | |
8299 | C...f + fb -> g + gam; th arbitrary. | |
8300 | IF(RLU(0).GT.0.5) JS=2 | |
8301 | MINT(20+JS)=21 | |
8302 | MINT(23-JS)=22 | |
8303 | KCC=17+JS | |
8304 | ||
8305 | ELSEIF(ISUB.EQ.15) THEN | |
8306 | C...f + fb -> g + Z0; th arbitrary. | |
8307 | IF(RLU(0).GT.0.5) JS=2 | |
8308 | MINT(20+JS)=21 | |
8309 | MINT(23-JS)=23 | |
8310 | KCC=17+JS | |
8311 | ||
8312 | ELSEIF(ISUB.EQ.16) THEN | |
8313 | C...f + fb' -> g + W+/-; th = (p(f)-p(W-))**2 or (p(fb')-p(W+))**2. | |
8314 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
8315 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
8316 | IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2 | |
8317 | MINT(20+JS)=21 | |
8318 | MINT(23-JS)=ISIGN(24,KCH1+KCH2) | |
8319 | KCC=17+JS | |
8320 | ||
8321 | ELSEIF(ISUB.EQ.17) THEN | |
8322 | C...f + fb -> g + H0; th arbitrary. | |
8323 | IF(RLU(0).GT.0.5) JS=2 | |
8324 | MINT(20+JS)=21 | |
8325 | MINT(23-JS)=25 | |
8326 | KCC=17+JS | |
8327 | ||
8328 | ELSEIF(ISUB.EQ.18) THEN | |
8329 | C...f + fb -> gamma + gamma; th arbitrary. | |
8330 | MINT(21)=22 | |
8331 | MINT(22)=22 | |
8332 | ||
8333 | ELSEIF(ISUB.EQ.19) THEN | |
8334 | C...f + fb -> gamma + Z0; th arbitrary. | |
8335 | IF(RLU(0).GT.0.5) JS=2 | |
8336 | MINT(20+JS)=22 | |
8337 | MINT(23-JS)=23 | |
8338 | ||
8339 | ELSEIF(ISUB.EQ.20) THEN | |
8340 | C...f + fb' -> gamma + W+/-; th = (p(f)-p(W-))**2 or (p(fb')-p(W+))**2. | |
8341 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
8342 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
8343 | IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2 | |
8344 | MINT(20+JS)=22 | |
8345 | MINT(23-JS)=ISIGN(24,KCH1+KCH2) | |
8346 | ENDIF | |
8347 | ||
8348 | ELSEIF(ISUB.LE.30) THEN | |
8349 | IF(ISUB.EQ.21) THEN | |
8350 | C...f + fb -> gamma + H0; th arbitrary. | |
8351 | IF(RLU(0).GT.0.5) JS=2 | |
8352 | MINT(20+JS)=22 | |
8353 | MINT(23-JS)=25 | |
8354 | ||
8355 | ELSEIF(ISUB.EQ.22) THEN | |
8356 | C...f + fb -> Z0 + Z0; th arbitrary. | |
8357 | MINT(21)=23 | |
8358 | MINT(22)=23 | |
8359 | ||
8360 | ELSEIF(ISUB.EQ.23) THEN | |
8361 | C...f + fb' -> Z0 + W+/-; th = (p(f)-p(W-))**2 or (p(fb')-p(W+))**2. | |
8362 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
8363 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
8364 | IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2 | |
8365 | MINT(20+JS)=23 | |
8366 | MINT(23-JS)=ISIGN(24,KCH1+KCH2) | |
8367 | ||
8368 | ELSEIF(ISUB.EQ.24) THEN | |
8369 | C...f + fb -> Z0 + H0; th arbitrary. | |
8370 | IF(RLU(0).GT.0.5) JS=2 | |
8371 | MINT(20+JS)=23 | |
8372 | MINT(23-JS)=25 | |
8373 | ||
8374 | ELSEIF(ISUB.EQ.25) THEN | |
8375 | C...f + fb -> W+ + W-; th = (p(f)-p(W-))**2. | |
8376 | MINT(21)=-ISIGN(24,MINT(15)) | |
8377 | MINT(22)=-MINT(21) | |
8378 | ||
8379 | ELSEIF(ISUB.EQ.26) THEN | |
8380 | C...f + fb' -> W+/- + H0; th = (p(f)-p(W-))**2 or (p(fb')-p(W+))**2. | |
8381 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
8382 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
8383 | IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2 | |
8384 | MINT(20+JS)=ISIGN(24,KCH1+KCH2) | |
8385 | MINT(23-JS)=25 | |
8386 | ||
8387 | ELSEIF(ISUB.EQ.27) THEN | |
8388 | C...f + fb -> H0 + H0. | |
8389 | ||
8390 | ELSEIF(ISUB.EQ.28) THEN | |
8391 | C...f + g -> f + g; th = (p(f)-p(f))**2. | |
8392 | KCC=MINT(2)+6 | |
8393 | IF(MINT(15).EQ.21) KCC=KCC+2 | |
8394 | IF(MINT(15).NE.21) KCS=ISIGN(1,MINT(15)) | |
8395 | IF(MINT(16).NE.21) KCS=ISIGN(1,MINT(16)) | |
8396 | ||
8397 | ELSEIF(ISUB.EQ.29) THEN | |
8398 | C...f + g -> f + gamma; th = (p(f)-p(f))**2. | |
8399 | IF(MINT(15).EQ.21) JS=2 | |
8400 | MINT(23-JS)=22 | |
8401 | KCC=15+JS | |
8402 | KCS=ISIGN(1,MINT(14+JS)) | |
8403 | ||
8404 | ELSEIF(ISUB.EQ.30) THEN | |
8405 | C...f + g -> f + Z0; th = (p(f)-p(f))**2. | |
8406 | IF(MINT(15).EQ.21) JS=2 | |
8407 | MINT(23-JS)=23 | |
8408 | KCC=15+JS | |
8409 | KCS=ISIGN(1,MINT(14+JS)) | |
8410 | ENDIF | |
8411 | ||
8412 | ELSEIF(ISUB.LE.40) THEN | |
8413 | IF(ISUB.EQ.31) THEN | |
8414 | C...f + g -> f' + W+/-; th = (p(f)-p(f'))**2; choose flavour f'. | |
8415 | IF(MINT(15).EQ.21) JS=2 | |
8416 | I=MINT(14+JS) | |
8417 | IA=IABS(I) | |
8418 | MINT(23-JS)=ISIGN(24,KCHG(IA,1)*I) | |
8419 | RVCKM=VINT(180+I)*RLU(0) | |
8420 | DO 220 J=1,MSTP(1) | |
8421 | IB=2*J-1+MOD(IA,2) | |
8422 | IPM=(5-ISIGN(1,I))/2 | |
8423 | IDC=J+MDCY(IA,2)+2 | |
8424 | IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 220 | |
8425 | MINT(20+JS)=ISIGN(IB,I) | |
8426 | RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) | |
8427 | IF(RVCKM.LE.0.) GOTO 230 | |
8428 | 220 CONTINUE | |
8429 | 230 KCC=15+JS | |
8430 | KCS=ISIGN(1,MINT(14+JS)) | |
8431 | ||
8432 | ELSEIF(ISUB.EQ.32) THEN | |
8433 | C...f + g -> f + H0; th = (p(f)-p(f))**2. | |
8434 | IF(MINT(15).EQ.21) JS=2 | |
8435 | MINT(23-JS)=25 | |
8436 | KCC=15+JS | |
8437 | KCS=ISIGN(1,MINT(14+JS)) | |
8438 | ||
8439 | ELSEIF(ISUB.EQ.33) THEN | |
8440 | C...f + gamma -> f + g. | |
8441 | ||
8442 | ELSEIF(ISUB.EQ.34) THEN | |
8443 | C...f + gamma -> f + gamma. | |
8444 | ||
8445 | ELSEIF(ISUB.EQ.35) THEN | |
8446 | C...f + gamma -> f + Z0. | |
8447 | ||
8448 | ELSEIF(ISUB.EQ.36) THEN | |
8449 | C...f + gamma -> f' + W+/-. | |
8450 | ||
8451 | ELSEIF(ISUB.EQ.37) THEN | |
8452 | C...f + gamma -> f + H0. | |
8453 | ||
8454 | ELSEIF(ISUB.EQ.38) THEN | |
8455 | C...f + Z0 -> f + g. | |
8456 | ||
8457 | ELSEIF(ISUB.EQ.39) THEN | |
8458 | C...f + Z0 -> f + gamma. | |
8459 | ||
8460 | ELSEIF(ISUB.EQ.40) THEN | |
8461 | C...f + Z0 -> f + Z0. | |
8462 | ENDIF | |
8463 | ||
8464 | ELSEIF(ISUB.LE.50) THEN | |
8465 | IF(ISUB.EQ.41) THEN | |
8466 | C...f + Z0 -> f' + W+/-. | |
8467 | ||
8468 | ELSEIF(ISUB.EQ.42) THEN | |
8469 | C...f + Z0 -> f + H0. | |
8470 | ||
8471 | ELSEIF(ISUB.EQ.43) THEN | |
8472 | C...f + W+/- -> f' + g. | |
8473 | ||
8474 | ELSEIF(ISUB.EQ.44) THEN | |
8475 | C...f + W+/- -> f' + gamma. | |
8476 | ||
8477 | ELSEIF(ISUB.EQ.45) THEN | |
8478 | C...f + W+/- -> f' + Z0. | |
8479 | ||
8480 | ELSEIF(ISUB.EQ.46) THEN | |
8481 | C...f + W+/- -> f' + W+/-. | |
8482 | ||
8483 | ELSEIF(ISUB.EQ.47) THEN | |
8484 | C...f + W+/- -> f' + H0. | |
8485 | ||
8486 | ELSEIF(ISUB.EQ.48) THEN | |
8487 | C...f + H0 -> f + g. | |
8488 | ||
8489 | ELSEIF(ISUB.EQ.49) THEN | |
8490 | C...f + H0 -> f + gamma. | |
8491 | ||
8492 | ELSEIF(ISUB.EQ.50) THEN | |
8493 | C...f + H0 -> f + Z0. | |
8494 | ENDIF | |
8495 | ||
8496 | ELSEIF(ISUB.LE.60) THEN | |
8497 | IF(ISUB.EQ.51) THEN | |
8498 | C...f + H0 -> f' + W+/-. | |
8499 | ||
8500 | ELSEIF(ISUB.EQ.52) THEN | |
8501 | C...f + H0 -> f + H0. | |
8502 | ||
8503 | ELSEIF(ISUB.EQ.53) THEN | |
8504 | C...g + g -> f + fb; th arbitrary. | |
8505 | KCS=(-1)**INT(1.5+RLU(0)) | |
8506 | MINT(21)=ISIGN(KFLQ,KCS) | |
8507 | MINT(22)=-MINT(21) | |
8508 | KCC=MINT(2)+10 | |
8509 | ||
8510 | ELSEIF(ISUB.EQ.54) THEN | |
8511 | C...g + gamma -> f + fb. | |
8512 | ||
8513 | ELSEIF(ISUB.EQ.55) THEN | |
8514 | C...g + Z0 -> f + fb. | |
8515 | ||
8516 | ELSEIF(ISUB.EQ.56) THEN | |
8517 | C...g + W+/- -> f + fb'. | |
8518 | ||
8519 | ELSEIF(ISUB.EQ.57) THEN | |
8520 | C...g + H0 -> f + fb. | |
8521 | ||
8522 | ELSEIF(ISUB.EQ.58) THEN | |
8523 | C...gamma + gamma -> f + fb. | |
8524 | ||
8525 | ELSEIF(ISUB.EQ.59) THEN | |
8526 | C...gamma + Z0 -> f + fb. | |
8527 | ||
8528 | ELSEIF(ISUB.EQ.60) THEN | |
8529 | C...gamma + W+/- -> f + fb'. | |
8530 | ENDIF | |
8531 | ||
8532 | ELSEIF(ISUB.LE.70) THEN | |
8533 | IF(ISUB.EQ.61) THEN | |
8534 | C...gamma + H0 -> f + fb. | |
8535 | ||
8536 | ELSEIF(ISUB.EQ.62) THEN | |
8537 | C...Z0 + Z0 -> f + fb. | |
8538 | ||
8539 | ELSEIF(ISUB.EQ.63) THEN | |
8540 | C...Z0 + W+/- -> f + fb'. | |
8541 | ||
8542 | ELSEIF(ISUB.EQ.64) THEN | |
8543 | C...Z0 + H0 -> f + fb. | |
8544 | ||
8545 | ELSEIF(ISUB.EQ.65) THEN | |
8546 | C...W+ + W- -> f + fb. | |
8547 | ||
8548 | ELSEIF(ISUB.EQ.66) THEN | |
8549 | C...W+/- + H0 -> f + fb'. | |
8550 | ||
8551 | ELSEIF(ISUB.EQ.67) THEN | |
8552 | C...H0 + H0 -> f + fb. | |
8553 | ||
8554 | ELSEIF(ISUB.EQ.68) THEN | |
8555 | C...g + g -> g + g; th arbitrary. | |
8556 | KCC=MINT(2)+12 | |
8557 | KCS=(-1)**INT(1.5+RLU(0)) | |
8558 | ||
8559 | ELSEIF(ISUB.EQ.69) THEN | |
8560 | C...gamma + gamma -> W+ + W-. | |
8561 | ||
8562 | ELSEIF(ISUB.EQ.70) THEN | |
8563 | C...gamma + W+/- -> gamma + W+/- | |
8564 | ENDIF | |
8565 | ||
8566 | ELSEIF(ISUB.LE.80) THEN | |
8567 | IF(ISUB.EQ.71.OR.ISUB.EQ.72) THEN | |
8568 | C...Z0 + Z0 -> Z0 + Z0; Z0 + Z0 -> W+ + W-. | |
8569 | XH=SH/SHP | |
8570 | MINT(21)=MINT(15) | |
8571 | MINT(22)=MINT(16) | |
8572 | PMQ(1)=ULMASS(MINT(21)) | |
8573 | PMQ(2)=ULMASS(MINT(22)) | |
8574 | 290 JT=INT(1.5+RLU(0)) | |
8575 | ZMIN=2.*PMQ(JT)/SHPR | |
8576 | ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT))) | |
8577 | ZMAX=MIN(1.-XH,ZMAX) | |
8578 | Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU(0) | |
8579 | IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT. | |
8580 | & (1.-XH)**2/(4.*XH)*RLU(0)) GOTO 290 | |
8581 | SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP) | |
8582 | IF(SQC1.LT.1.E-8) GOTO 290 | |
8583 | C1=SQRT(SQC1) | |
8584 | C2=1.+2.*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP) | |
8585 | CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1 | |
8586 | CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT))) | |
8587 | Z(3-JT)=1.-XH/(1.-Z(JT)) | |
8588 | SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP) | |
8589 | IF(SQC1.LT.1.E-8) GOTO 290 | |
8590 | C1=SQRT(SQC1) | |
8591 | C2=1.+2.*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP) | |
8592 | CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1 | |
8593 | CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT))) | |
8594 | PHIR=PARU(2)*RLU(0) | |
8595 | CPHI=COS(PHIR) | |
8596 | ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI | |
8597 | Z1=2.-Z(JT) | |
8598 | Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP) | |
8599 | Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP | |
8600 | Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)* | |
8601 | & PMQ(3-JT)**2/SHP)) | |
8602 | ZMIN=2.*PMQ(3-JT)/SHPR | |
8603 | ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT))) | |
8604 | ZMAX=MIN(1.-XH,ZMAX) | |
8605 | IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 290 | |
8606 | KCC=22 | |
8607 | ||
8608 | ELSEIF(ISUB.EQ.73) THEN | |
8609 | C...Z0 + W+/- -> Z0 + W+/-. | |
8610 | XH=SH/SHP | |
8611 | 300 JT=INT(1.5+RLU(0)) | |
8612 | I=MINT(14+JT) | |
8613 | IA=IABS(I) | |
8614 | IF(IA.LE.10) THEN | |
8615 | RVCKM=VINT(180+I)*RLU(0) | |
8616 | DO 320 J=1,MSTP(1) | |
8617 | IB=2*J-1+MOD(IA,2) | |
8618 | IPM=(5-ISIGN(1,I))/2 | |
8619 | IDC=J+MDCY(IA,2)+2 | |
8620 | IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 320 | |
8621 | MINT(20+JT)=ISIGN(IB,I) | |
8622 | RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) | |
8623 | IF(RVCKM.LE.0.) GOTO 330 | |
8624 | 320 CONTINUE | |
8625 | ELSE | |
8626 | IB=2*((IA+1)/2)-1+MOD(IA,2) | |
8627 | MINT(20+JT)=ISIGN(IB,I) | |
8628 | ENDIF | |
8629 | 330 PMQ(JT)=ULMASS(MINT(20+JT)) | |
8630 | MINT(23-JT)=MINT(17-JT) | |
8631 | PMQ(3-JT)=ULMASS(MINT(23-JT)) | |
8632 | JT=INT(1.5+RLU(0)) | |
8633 | ZMIN=2.*PMQ(JT)/SHPR | |
8634 | ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT))) | |
8635 | ZMAX=MIN(1.-XH,ZMAX) | |
8636 | Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU(0) | |
8637 | IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT. | |
8638 | & (1.-XH)**2/(4.*XH)*RLU(0)) GOTO 300 | |
8639 | SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP) | |
8640 | IF(SQC1.LT.1.E-8) GOTO 300 | |
8641 | C1=SQRT(SQC1) | |
8642 | C2=1.+2.*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP) | |
8643 | CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1 | |
8644 | CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT))) | |
8645 | Z(3-JT)=1.-XH/(1.-Z(JT)) | |
8646 | SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP) | |
8647 | IF(SQC1.LT.1.E-8) GOTO 300 | |
8648 | C1=SQRT(SQC1) | |
8649 | C2=1.+2.*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP) | |
8650 | CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1 | |
8651 | CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT))) | |
8652 | PHIR=PARU(2)*RLU(0) | |
8653 | CPHI=COS(PHIR) | |
8654 | ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI | |
8655 | Z1=2.-Z(JT) | |
8656 | Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP) | |
8657 | Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP | |
8658 | Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)* | |
8659 | & PMQ(3-JT)**2/SHP)) | |
8660 | ZMIN=2.*PMQ(3-JT)/SHPR | |
8661 | ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT))) | |
8662 | ZMAX=MIN(1.-XH,ZMAX) | |
8663 | IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 300 | |
8664 | KCC=22 | |
8665 | ||
8666 | ELSEIF(ISUB.EQ.74) THEN | |
8667 | C...Z0 + H0 -> Z0 + H0. | |
8668 | ||
8669 | ELSEIF(ISUB.EQ.75) THEN | |
8670 | C...W+ + W- -> gamma + gamma. | |
8671 | ||
8672 | ELSEIF(ISUB.EQ.76.OR.ISUB.EQ.77) THEN | |
8673 | C...W+ + W- -> Z0 + Z0; W+ + W- -> W+ + W-. | |
8674 | XH=SH/SHP | |
8675 | 340 DO 370 JT=1,2 | |
8676 | I=MINT(14+JT) | |
8677 | IA=IABS(I) | |
8678 | IF(IA.LE.10) THEN | |
8679 | RVCKM=VINT(180+I)*RLU(0) | |
8680 | DO 360 J=1,MSTP(1) | |
8681 | IB=2*J-1+MOD(IA,2) | |
8682 | IPM=(5-ISIGN(1,I))/2 | |
8683 | IDC=J+MDCY(IA,2)+2 | |
8684 | IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 360 | |
8685 | MINT(20+JT)=ISIGN(IB,I) | |
8686 | RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2) | |
8687 | IF(RVCKM.LE.0.) GOTO 370 | |
8688 | 360 CONTINUE | |
8689 | ELSE | |
8690 | IB=2*((IA+1)/2)-1+MOD(IA,2) | |
8691 | MINT(20+JT)=ISIGN(IB,I) | |
8692 | ENDIF | |
8693 | 370 PMQ(JT)=ULMASS(MINT(20+JT)) | |
8694 | JT=INT(1.5+RLU(0)) | |
8695 | ZMIN=2.*PMQ(JT)/SHPR | |
8696 | ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT))) | |
8697 | ZMAX=MIN(1.-XH,ZMAX) | |
8698 | Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU(0) | |
8699 | IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT. | |
8700 | & (1.-XH)**2/(4.*XH)*RLU(0)) GOTO 340 | |
8701 | SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP) | |
8702 | IF(SQC1.LT.1.E-8) GOTO 340 | |
8703 | C1=SQRT(SQC1) | |
8704 | C2=1.+2.*(PMAS(24,1)**2-PMQ(JT)**2)/(Z(JT)*SHP) | |
8705 | CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1 | |
8706 | CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT))) | |
8707 | Z(3-JT)=1.-XH/(1.-Z(JT)) | |
8708 | SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP) | |
8709 | IF(SQC1.LT.1.E-8) GOTO 340 | |
8710 | C1=SQRT(SQC1) | |
8711 | C2=1.+2.*(PMAS(24,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP) | |
8712 | CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1 | |
8713 | CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT))) | |
8714 | PHIR=PARU(2)*RLU(0) | |
8715 | CPHI=COS(PHIR) | |
8716 | ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI | |
8717 | Z1=2.-Z(JT) | |
8718 | Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP) | |
8719 | Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP | |
8720 | Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)* | |
8721 | & PMQ(3-JT)**2/SHP)) | |
8722 | ZMIN=2.*PMQ(3-JT)/SHPR | |
8723 | ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT))) | |
8724 | ZMAX=MIN(1.-XH,ZMAX) | |
8725 | IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 340 | |
8726 | KCC=22 | |
8727 | ||
8728 | ELSEIF(ISUB.EQ.78) THEN | |
8729 | C...W+/- + H0 -> W+/- + H0. | |
8730 | ||
8731 | ELSEIF(ISUB.EQ.79) THEN | |
8732 | C...H0 + H0 -> H0 + H0. | |
8733 | ENDIF | |
8734 | ||
8735 | ELSEIF(ISUB.LE.90) THEN | |
8736 | IF(ISUB.EQ.81) THEN | |
8737 | C...q + qb -> Q' + Qb'; th = (p(q)-p(q'))**2. | |
8738 | MINT(21)=ISIGN(MINT(46),MINT(15)) | |
8739 | MINT(22)=-MINT(21) | |
8740 | KCC=4 | |
8741 | ||
8742 | ELSEIF(ISUB.EQ.82) THEN | |
8743 | C...g + g -> Q + Qb; th arbitrary. | |
8744 | KCS=(-1)**INT(1.5+RLU(0)) | |
8745 | MINT(21)=ISIGN(MINT(46),KCS) | |
8746 | MINT(22)=-MINT(21) | |
8747 | KCC=MINT(2)+10 | |
8748 | ENDIF | |
8749 | ||
8750 | ELSEIF(ISUB.LE.100) THEN | |
8751 | IF(ISUB.EQ.95) THEN | |
8752 | C...Low-pT ( = energyless g + g -> g + g). | |
8753 | KCC=MINT(2)+12 | |
8754 | KCS=(-1)**INT(1.5+RLU(0)) | |
8755 | ||
8756 | ELSEIF(ISUB.EQ.96) THEN | |
8757 | C...Multiple interactions (should be reassigned to QCD process). | |
8758 | ENDIF | |
8759 | ||
8760 | ELSEIF(ISUB.LE.110) THEN | |
8761 | IF(ISUB.EQ.101) THEN | |
8762 | C...g + g -> gamma*/Z0. | |
8763 | KCC=21 | |
8764 | KFRES=22 | |
8765 | ||
8766 | ELSEIF(ISUB.EQ.102) THEN | |
8767 | C...g + g -> H0. | |
8768 | KCC=21 | |
8769 | KFRES=25 | |
8770 | ENDIF | |
8771 | ||
8772 | ELSEIF(ISUB.LE.120) THEN | |
8773 | IF(ISUB.EQ.111) THEN | |
8774 | C...f + fb -> g + H0; th arbitrary. | |
8775 | IF(RLU(0).GT.0.5) JS=2 | |
8776 | MINT(20+JS)=21 | |
8777 | MINT(23-JS)=25 | |
8778 | KCC=17+JS | |
8779 | ||
8780 | ELSEIF(ISUB.EQ.112) THEN | |
8781 | C...f + g -> f + H0; th = (p(f) - p(f))**2. | |
8782 | IF(MINT(15).EQ.21) JS=2 | |
8783 | MINT(23-JS)=25 | |
8784 | KCC=15+JS | |
8785 | KCS=ISIGN(1,MINT(14+JS)) | |
8786 | ||
8787 | ELSEIF(ISUB.EQ.113) THEN | |
8788 | C...g + g -> g + H0; th arbitrary. | |
8789 | IF(RLU(0).GT.0.5) JS=2 | |
8790 | MINT(23-JS)=25 | |
8791 | KCC=22+JS | |
8792 | KCS=(-1)**INT(1.5+RLU(0)) | |
8793 | ||
8794 | ELSEIF(ISUB.EQ.114) THEN | |
8795 | C...g + g -> gamma + gamma; th arbitrary. | |
8796 | IF(RLU(0).GT.0.5) JS=2 | |
8797 | MINT(21)=22 | |
8798 | MINT(22)=22 | |
8799 | KCC=21 | |
8800 | ||
8801 | ELSEIF(ISUB.EQ.115) THEN | |
8802 | C...g + g -> gamma + Z0. | |
8803 | ||
8804 | ELSEIF(ISUB.EQ.116) THEN | |
8805 | C...g + g -> Z0 + Z0. | |
8806 | ||
8807 | ELSEIF(ISUB.EQ.117) THEN | |
8808 | C...g + g -> W+ + W-. | |
8809 | ENDIF | |
8810 | ||
8811 | ELSEIF(ISUB.LE.140) THEN | |
8812 | IF(ISUB.EQ.121) THEN | |
8813 | C...g + g -> f + fb + H0. | |
8814 | ENDIF | |
8815 | ||
8816 | ELSEIF(ISUB.LE.160) THEN | |
8817 | IF(ISUB.EQ.141) THEN | |
8818 | C...f + fb -> gamma*/Z0/Z'0. | |
8819 | KFRES=32 | |
8820 | ||
8821 | ELSEIF(ISUB.EQ.142) THEN | |
8822 | C...f + fb' -> H+/-. | |
8823 | KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15)) | |
8824 | KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16)) | |
8825 | KFRES=ISIGN(37,KCH1+KCH2) | |
8826 | ||
8827 | ELSEIF(ISUB.EQ.143) THEN | |
8828 | C...f + fb' -> R. | |
8829 | KFRES=ISIGN(40,MINT(15)+MINT(16)) | |
8830 | ENDIF | |
8831 | ||
8832 | ELSE | |
8833 | IF(ISUB.EQ.161) THEN | |
8834 | C...g + f -> H+/- + f'; th = (p(f)-p(f))**2. | |
8835 | IF(MINT(16).EQ.21) JS=2 | |
8836 | IA=IABS(MINT(17-JS)) | |
8837 | MINT(20+JS)=ISIGN(37,KCHG(IA,1)*MINT(17-JS)) | |
8838 | JA=IA+MOD(IA,2)-MOD(IA+1,2) | |
8839 | MINT(23-JS)=ISIGN(JA,MINT(17-JS)) | |
8840 | KCC=18-JS | |
8841 | IF(MINT(15).NE.21) KCS=ISIGN(1,MINT(15)) | |
8842 | IF(MINT(16).NE.21) KCS=ISIGN(1,MINT(16)) | |
8843 | ENDIF | |
8844 | ENDIF | |
8845 | ||
8846 | IF(IDOC.EQ.7) THEN | |
8847 | C...Resonance not decaying: store colour connection indices. | |
8848 | I=MINT(83)+7 | |
8849 | K(IPU3,1)=1 | |
8850 | K(IPU3,2)=KFRES | |
8851 | K(IPU3,3)=I | |
8852 | P(IPU3,4)=SHUSER | |
8853 | P(IPU3,5)=SHUSER | |
8854 | K(IPU1,4)=IPU2 | |
8855 | K(IPU1,5)=IPU2 | |
8856 | K(IPU2,4)=IPU1 | |
8857 | K(IPU2,5)=IPU1 | |
8858 | K(I,1)=21 | |
8859 | K(I,2)=KFRES | |
8860 | P(I,4)=SHUSER | |
8861 | P(I,5)=SHUSER | |
8862 | N=IPU3 | |
8863 | MINT(21)=KFRES | |
8864 | MINT(22)=0 | |
8865 | ||
8866 | ELSEIF(IDOC.EQ.8) THEN | |
8867 | C...2 -> 2 processes: store outgoing partons in their CM-frame. | |
8868 | DO 390 JT=1,2 | |
8869 | I=MINT(84)+2+JT | |
8870 | K(I,1)=1 | |
8871 | IF(IABS(MINT(20+JT)).LE.10.OR.MINT(20+JT).EQ.21) K(I,1)=3 | |
8872 | K(I,2)=MINT(20+JT) | |
8873 | K(I,3)=MINT(83)+IDOC+JT-2 | |
8874 | IF(IABS(K(I,2)).LE.10.OR.K(I,2).EQ.21) THEN | |
8875 | P(I,5)=ULMASS(K(I,2)) | |
8876 | ELSE | |
8877 | P(I,5)=SQRT(VINT(63+MOD(JS+JT,2))) | |
8878 | ENDIF | |
8879 | 390 CONTINUE | |
8880 | IF(P(IPU3,5)+P(IPU4,5).GE.SHR) THEN | |
8881 | KFA1=IABS(MINT(21)) | |
8882 | KFA2=IABS(MINT(22)) | |
8883 | IF((KFA1.GT.3.AND.KFA1.NE.21).OR.(KFA2.GT.3.AND.KFA2.NE.21)) | |
8884 | & THEN | |
8885 | MINT(51)=1 | |
8886 | RETURN | |
8887 | ENDIF | |
8888 | P(IPU3,5)=0. | |
8889 | P(IPU4,5)=0. | |
8890 | ENDIF | |
8891 | P(IPU3,4)=0.5*(SHR+(P(IPU3,5)**2-P(IPU4,5)**2)/SHR) | |
8892 | P(IPU3,3)=SQRT(MAX(0.,P(IPU3,4)**2-P(IPU3,5)**2)) | |
8893 | P(IPU4,4)=SHR-P(IPU3,4) | |
8894 | P(IPU4,3)=-P(IPU3,3) | |
8895 | N=IPU4 | |
8896 | MINT(7)=MINT(83)+7 | |
8897 | MINT(8)=MINT(83)+8 | |
8898 | ||
8899 | C...Rotate outgoing partons using cos(theta)=(th-uh)/lam(sh,sqm3,sqm4). | |
8900 | CALL LUDBRB(IPU3,IPU4,ACOS(VINT(23)),VINT(24),0D0,0D0,0D0) | |
8901 | ||
8902 | ELSEIF(IDOC.EQ.9) THEN | |
8903 | C'''2 -> 3 processes: | |
8904 | ||
8905 | ELSEIF(IDOC.EQ.11) THEN | |
8906 | C...Z0 + Z0 -> H0, W+ + W- -> H0: store Higgs and outgoing partons. | |
8907 | PHI(1)=PARU(2)*RLU(0) | |
8908 | PHI(2)=PHI(1)-PHIR | |
8909 | DO 400 JT=1,2 | |
8910 | I=MINT(84)+2+JT | |
8911 | K(I,1)=1 | |
8912 | IF(IABS(MINT(20+JT)).LE.10.OR.MINT(20+JT).EQ.21) K(I,1)=3 | |
8913 | K(I,2)=MINT(20+JT) | |
8914 | K(I,3)=MINT(83)+IDOC+JT-2 | |
8915 | P(I,5)=ULMASS(K(I,2)) | |
8916 | IF(0.5*SHPR*Z(JT).LE.P(I,5)) P(I,5)=0. | |
8917 | PABS=SQRT(MAX(0.,(0.5*SHPR*Z(JT))**2-P(I,5)**2)) | |
8918 | PTABS=PABS*SQRT(MAX(0.,1.-CTHE(JT)**2)) | |
8919 | P(I,1)=PTABS*COS(PHI(JT)) | |
8920 | P(I,2)=PTABS*SIN(PHI(JT)) | |
8921 | P(I,3)=PABS*CTHE(JT)*(-1)**(JT+1) | |
8922 | P(I,4)=0.5*SHPR*Z(JT) | |
8923 | IZW=MINT(83)+6+JT | |
8924 | K(IZW,1)=21 | |
8925 | K(IZW,2)=23 | |
8926 | IF(ISUB.EQ.8) K(IZW,2)=ISIGN(24,LUCHGE(MINT(14+JT))) | |
8927 | K(IZW,3)=IZW-2 | |
8928 | P(IZW,1)=-P(I,1) | |
8929 | P(IZW,2)=-P(I,2) | |
8930 | P(IZW,3)=(0.5*SHPR-PABS*CTHE(JT))*(-1)**(JT+1) | |
8931 | P(IZW,4)=0.5*SHPR*(1.-Z(JT)) | |
8932 | 400 P(IZW,5)=-SQRT(MAX(0.,P(IZW,3)**2+PTABS**2-P(IZW,4)**2)) | |
8933 | I=MINT(83)+9 | |
8934 | K(IPU5,1)=1 | |
8935 | K(IPU5,2)=KFRES | |
8936 | K(IPU5,3)=I | |
8937 | P(IPU5,5)=SHR | |
8938 | P(IPU5,1)=-P(IPU3,1)-P(IPU4,1) | |
8939 | P(IPU5,2)=-P(IPU3,2)-P(IPU4,2) | |
8940 | P(IPU5,3)=-P(IPU3,3)-P(IPU4,3) | |
8941 | P(IPU5,4)=SHPR-P(IPU3,4)-P(IPU4,4) | |
8942 | K(I,1)=21 | |
8943 | K(I,2)=KFRES | |
8944 | DO 410 J=1,5 | |
8945 | 410 P(I,J)=P(IPU5,J) | |
8946 | N=IPU5 | |
8947 | MINT(23)=KFRES | |
8948 | ||
8949 | ELSEIF(IDOC.EQ.12) THEN | |
8950 | C...Z0 and W+/- scattering: store bosons and outgoing partons. | |
8951 | PHI(1)=PARU(2)*RLU(0) | |
8952 | PHI(2)=PHI(1)-PHIR | |
8953 | DO 420 JT=1,2 | |
8954 | I=MINT(84)+2+JT | |
8955 | K(I,1)=1 | |
8956 | IF(IABS(MINT(20+JT)).LE.10.OR.MINT(20+JT).EQ.21) K(I,1)=3 | |
8957 | K(I,2)=MINT(20+JT) | |
8958 | K(I,3)=MINT(83)+IDOC+JT-2 | |
8959 | P(I,5)=ULMASS(K(I,2)) | |
8960 | IF(0.5*SHPR*Z(JT).LE.P(I,5)) P(I,5)=0. | |
8961 | PABS=SQRT(MAX(0.,(0.5*SHPR*Z(JT))**2-P(I,5)**2)) | |
8962 | PTABS=PABS*SQRT(MAX(0.,1.-CTHE(JT)**2)) | |
8963 | P(I,1)=PTABS*COS(PHI(JT)) | |
8964 | P(I,2)=PTABS*SIN(PHI(JT)) | |
8965 | P(I,3)=PABS*CTHE(JT)*(-1)**(JT+1) | |
8966 | P(I,4)=0.5*SHPR*Z(JT) | |
8967 | IZW=MINT(83)+6+JT | |
8968 | K(IZW,1)=21 | |
8969 | IF(MINT(14+JT).EQ.MINT(20+JT)) THEN | |
8970 | K(IZW,2)=23 | |
8971 | ELSE | |
8972 | K(IZW,2)=ISIGN(24,LUCHGE(MINT(14+JT))-LUCHGE(MINT(20+JT))) | |
8973 | ENDIF | |
8974 | K(IZW,3)=IZW-2 | |
8975 | P(IZW,1)=-P(I,1) | |
8976 | P(IZW,2)=-P(I,2) | |
8977 | P(IZW,3)=(0.5*SHPR-PABS*CTHE(JT))*(-1)**(JT+1) | |
8978 | P(IZW,4)=0.5*SHPR*(1.-Z(JT)) | |
8979 | P(IZW,5)=-SQRT(MAX(0.,P(IZW,3)**2+PTABS**2-P(IZW,4)**2)) | |
8980 | IPU=MINT(84)+4+JT | |
8981 | K(IPU,1)=3 | |
8982 | K(IPU,2)=KFPR(ISUB,JT) | |
8983 | K(IPU,3)=MINT(83)+8+JT | |
8984 | IF(IABS(K(IPU,2)).LE.10.OR.K(IPU,2).EQ.21) THEN | |
8985 | P(IPU,5)=ULMASS(K(IPU,2)) | |
8986 | ELSE | |
8987 | P(IPU,5)=SQRT(VINT(63+MOD(JS+JT,2))) | |
8988 | ENDIF | |
8989 | MINT(22+JT)=K(IZW,2) | |
8990 | 420 CONTINUE | |
8991 | IF(ISUB.EQ.72) K(MINT(84)+4+INT(1.5+RLU(0)),2)=-24 | |
8992 | C...Find rotation and boost for hard scattering subsystem. | |
8993 | I1=MINT(83)+7 | |
8994 | I2=MINT(83)+8 | |
8995 | BEXCM=(P(I1,1)+P(I2,1))/(P(I1,4)+P(I2,4)) | |
8996 | BEYCM=(P(I1,2)+P(I2,2))/(P(I1,4)+P(I2,4)) | |
8997 | BEZCM=(P(I1,3)+P(I2,3))/(P(I1,4)+P(I2,4)) | |
8998 | GAMCM=(P(I1,4)+P(I2,4))/SHR | |
8999 | BEPCM=BEXCM*P(I1,1)+BEYCM*P(I1,2)+BEZCM*P(I1,3) | |
9000 | PX=P(I1,1)+GAMCM*(GAMCM/(1.+GAMCM)*BEPCM-P(I1,4))*BEXCM | |
9001 | PY=P(I1,2)+GAMCM*(GAMCM/(1.+GAMCM)*BEPCM-P(I1,4))*BEYCM | |
9002 | PZ=P(I1,3)+GAMCM*(GAMCM/(1.+GAMCM)*BEPCM-P(I1,4))*BEZCM | |
9003 | THECM=ULANGL(PZ,SQRT(PX**2+PY**2)) | |
9004 | PHICM=ULANGL(PX,PY) | |
9005 | C...Store hard scattering subsystem. Rotate and boost it. | |
9006 | SQLAM=(SH-P(IPU5,5)**2-P(IPU6,5)**2)**2-4.*P(IPU5,5)**2* | |
9007 | & P(IPU6,5)**2 | |
9008 | PABS=SQRT(MAX(0.,SQLAM/(4.*SH))) | |
9009 | CTHWZ=VINT(23) | |
9010 | STHWZ=SQRT(MAX(0.,1.-CTHWZ**2)) | |
9011 | PHIWZ=VINT(24)-PHICM | |
9012 | P(IPU5,1)=PABS*STHWZ*COS(PHIWZ) | |
9013 | P(IPU5,2)=PABS*STHWZ*SIN(PHIWZ) | |
9014 | P(IPU5,3)=PABS*CTHWZ | |
9015 | P(IPU5,4)=SQRT(PABS**2+P(IPU5,5)**2) | |
9016 | P(IPU6,1)=-P(IPU5,1) | |
9017 | P(IPU6,2)=-P(IPU5,2) | |
9018 | P(IPU6,3)=-P(IPU5,3) | |
9019 | P(IPU6,4)=SQRT(PABS**2+P(IPU6,5)**2) | |
9020 | CALL LUDBRB(IPU5,IPU6,THECM,PHICM,DBLE(BEXCM),DBLE(BEYCM), | |
9021 | & DBLE(BEZCM)) | |
9022 | DO 430 JT=1,2 | |
9023 | I1=MINT(83)+8+JT | |
9024 | I2=MINT(84)+4+JT | |
9025 | K(I1,1)=21 | |
9026 | K(I1,2)=K(I2,2) | |
9027 | DO 430 J=1,5 | |
9028 | 430 P(I1,J)=P(I2,J) | |
9029 | N=IPU6 | |
9030 | MINT(7)=MINT(83)+9 | |
9031 | MINT(8)=MINT(83)+10 | |
9032 | ENDIF | |
9033 | ||
9034 | IF(IDOC.GE.8) THEN | |
9035 | C...Store colour connection indices. | |
9036 | DO 440 J=1,2 | |
9037 | JC=J | |
9038 | IF(KCS.EQ.-1) JC=3-J | |
9039 | IF(ICOL(KCC,1,JC).NE.0.AND.K(IPU1,1).EQ.14) K(IPU1,J+3)= | |
9040 | & K(IPU1,J+3)+MINT(84)+ICOL(KCC,1,JC) | |
9041 | IF(ICOL(KCC,2,JC).NE.0.AND.K(IPU2,1).EQ.14) K(IPU2,J+3)= | |
9042 | & K(IPU2,J+3)+MINT(84)+ICOL(KCC,2,JC) | |
9043 | IF(ICOL(KCC,3,JC).NE.0.AND.K(IPU3,1).EQ.3) K(IPU3,J+3)= | |
9044 | & MSTU(5)*(MINT(84)+ICOL(KCC,3,JC)) | |
9045 | 440 IF(ICOL(KCC,4,JC).NE.0.AND.K(IPU4,1).EQ.3) K(IPU4,J+3)= | |
9046 | & MSTU(5)*(MINT(84)+ICOL(KCC,4,JC)) | |
9047 | ||
9048 | C...Copy outgoing partons to documentation lines. | |
9049 | DO 450 I=1,2 | |
9050 | I1=MINT(83)+IDOC-2+I | |
9051 | I2=MINT(84)+2+I | |
9052 | K(I1,1)=21 | |
9053 | K(I1,2)=K(I2,2) | |
9054 | IF(IDOC.LE.9) K(I1,3)=0 | |
9055 | IF(IDOC.GE.11) K(I1,3)=MINT(83)+2+I | |
9056 | DO 450 J=1,5 | |
9057 | 450 P(I1,J)=P(I2,J) | |
9058 | ENDIF | |
9059 | MINT(52)=N | |
9060 | ||
9061 | C...Low-pT events: remove gluons used for string drawing purposes. | |
9062 | IF(ISUB.EQ.95) THEN | |
9063 | K(IPU3,1)=K(IPU3,1)+10 | |
9064 | K(IPU4,1)=K(IPU4,1)+10 | |
9065 | DO 460 J=41,66 | |
9066 | 460 VINT(J)=0. | |
9067 | DO 470 I=MINT(83)+5,MINT(83)+8 | |
9068 | DO 470 J=1,5 | |
9069 | 470 P(I,J)=0. | |
9070 | ENDIF | |
9071 | ||
9072 | RETURN | |
9073 | END | |
9074 | ||
9075 | C********************************************************************* | |
9076 | ||
ce320da8 | 9077 | SUBROUTINE PYSSPAA(IPU1,IPU2) |
0119ef9a | 9078 | |
9079 | C...Generates spacelike parton showers. | |
9080 | IMPLICIT DOUBLE PRECISION(D) | |
9081 | COMMON/LUJETSA/N,K(9000,5),P(9000,5),V(9000,5) | |
9082 | SAVE /LUJETSA/ | |
9083 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
9084 | SAVE /LUDAT1A/ | |
9085 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
9086 | SAVE /LUDAT2A/ | |
9087 | COMMON/PYSUBSA/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200) | |
9088 | SAVE /PYSUBSA/ | |
9089 | COMMON/PYPARSA/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
9090 | SAVE /PYPARSA/ | |
9091 | COMMON/PYINT1A/MINT(400),VINT(400) | |
9092 | SAVE /PYINT1A/ | |
9093 | COMMON/PYINT2A/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2) | |
9094 | SAVE /PYINT2A/ | |
9095 | COMMON/PYINT3A/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) | |
9096 | SAVE /PYINT3A/ | |
9097 | DIMENSION KFLS(4),IS(2),XS(2),ZS(2),Q2S(2),TEVS(2),ROBO(5), | |
9098 | &XFS(2,-6:6),XFA(-6:6),XFB(-6:6),XFN(-6:6),WTAP(-6:6),WTSF(-6:6), | |
9099 | &THE2(2),ALAM(2),DQ2(3),DPC(3),DPD(4),DPB(4) | |
9100 | ||
9101 | tevb=0. | |
9102 | kfla=0 | |
9103 | z=0. | |
9104 | the2t=0. | |
9105 | ipo=0 | |
9106 | dmsma=0. | |
9107 | dpt2=0. | |
9108 | ||
9109 | C...Calculate maximum virtuality and check that evolution possible. | |
9110 | IPUS1=IPU1 | |
9111 | IPUS2=IPU2 | |
9112 | ISUB=MINT(1) | |
9113 | Q2E=VINT(52) | |
9114 | IF(ISET(ISUB).EQ.1) THEN | |
9115 | Q2E=Q2E/PARP(67) | |
9116 | ELSEIF(ISET(ISUB).EQ.3.OR.ISET(ISUB).EQ.4) THEN | |
9117 | Q2E=PMAS(23,1)**2 | |
9118 | IF(ISUB.EQ.8.OR.ISUB.EQ.76.OR.ISUB.EQ.77) Q2E=PMAS(24,1)**2 | |
9119 | ENDIF | |
9120 | TMAX=LOG(PARP(67)*PARP(63)*Q2E/PARP(61)**2) | |
9121 | IF(PARP(67)*Q2E.LT.MAX(PARP(62)**2,2.*PARP(61)**2).OR. | |
9122 | &TMAX.LT.0.2) RETURN | |
9123 | ||
9124 | C...Common constants and initial values. Save normal Lambda value. | |
9125 | XE0=2.*PARP(65)/VINT(1) | |
9126 | ALAMS=PARU(111) | |
9127 | PARU(111)=PARP(61) | |
9128 | NS=N | |
9129 | 100 N=NS | |
9130 | DO 110 JT=1,2 | |
9131 | KFLS(JT)=MINT(14+JT) | |
9132 | KFLS(JT+2)=KFLS(JT) | |
9133 | XS(JT)=VINT(40+JT) | |
9134 | ZS(JT)=1. | |
9135 | Q2S(JT)=PARP(67)*Q2E | |
9136 | TEVS(JT)=TMAX | |
9137 | ALAM(JT)=PARP(61) | |
9138 | THE2(JT)=100. | |
9139 | DO 110 KFL=-6,6 | |
9140 | 110 XFS(JT,KFL)=XSFX(JT,KFL) | |
9141 | DSH=dble(VINT(44)) | |
9142 | IF(ISET(ISUB).EQ.3.OR.ISET(ISUB).EQ.4) DSH=dble(VINT(26)*VINT(2)) | |
9143 | ||
9144 | C...Pick up leg with highest virtuality. | |
9145 | 120 N=N+1 | |
9146 | JT=1 | |
9147 | IF(N.GT.NS+1.AND.Q2S(2).GT.Q2S(1)) JT=2 | |
9148 | KFLB=KFLS(JT) | |
9149 | XB=XS(JT) | |
9150 | DO 130 KFL=-6,6 | |
9151 | 130 XFB(KFL)=XFS(JT,KFL) | |
9152 | DSHR=2D0*SQRT(DSH) | |
9153 | DSHZ=DSH/DBLE(ZS(JT)) | |
9154 | XE=MAX(XE0,XB*(1./(1.-PARP(66))-1.)) | |
9155 | IF(XB+XE.GE.0.999) THEN | |
9156 | Q2B=0. | |
9157 | GOTO 220 | |
9158 | ENDIF | |
9159 | ||
9160 | C...Maximum Q2 without or with Q2 ordering. Effective Lambda and n_f. | |
9161 | IF(MSTP(62).LE.1) THEN | |
9162 | Q2B=0.5*(1./ZS(JT)+1.)*Q2S(JT)+0.5*(1./ZS(JT)-1.)*(Q2S(3-JT)- | |
9163 | & SNGL(DSH)+SQRT((SNGL(DSH)+Q2S(1)+Q2S(2))**2+8.*Q2S(1)*Q2S(2)* | |
9164 | & ZS(JT)/(1.-ZS(JT)))) | |
9165 | TEVB=LOG(PARP(63)*Q2B/ALAM(JT)**2) | |
9166 | ELSE | |
9167 | Q2B=Q2S(JT) | |
9168 | TEVB=TEVS(JT) | |
9169 | ENDIF | |
9170 | ALSDUM=ULALPS(PARP(63)*Q2B) | |
9171 | TEVB=TEVB+2.*LOG(ALAM(JT)/PARU(117)) | |
9172 | TEVBSV=TEVB | |
9173 | ALAM(JT)=PARU(117) | |
9174 | B0=(33.-2.*MSTU(118))/6. | |
9175 | ||
9176 | C...Calculate Altarelli-Parisi and structure function weights. | |
9177 | DO 140 KFL=-6,6 | |
9178 | WTAP(KFL)=0. | |
9179 | 140 WTSF(KFL)=0. | |
9180 | IF(KFLB.EQ.21) THEN | |
9181 | WTAPQ=16.*(1.-SQRT(XB+XE))/(3.*SQRT(XB)) | |
9182 | DO 150 KFL=-MSTP(54),MSTP(54) | |
9183 | IF(KFL.EQ.0) WTAP(KFL)=6.*LOG((1.-XB)/XE) | |
9184 | 150 IF(KFL.NE.0) WTAP(KFL)=WTAPQ | |
9185 | ELSE | |
9186 | WTAP(0)=0.5*XB*(1./(XB+XE)-1.) | |
9187 | WTAP(KFLB)=8.*LOG((1.-XB)*(XB+XE)/XE)/3. | |
9188 | ENDIF | |
9189 | 160 WTSUM=0. | |
9190 | IF(KFLB.NE.21) XFBO=XFB(KFLB) | |
9191 | IF(KFLB.EQ.21) XFBO=XFB(0) | |
9192 | C*************************************************************** | |
9193 | C**********ERROR HAS OCCURED HERE | |
9194 | IF(XFBO.EQ.0.0) THEN | |
9195 | WRITE(MSTU(11),1000) | |
9196 | WRITE(MSTU(11),1001) KFLB,XFB(KFLB) | |
9197 | XFBO=0.00001 | |
9198 | ENDIF | |
9199 | C**************************************************************** | |
9200 | DO 170 KFL=-MSTP(54),MSTP(54) | |
9201 | WTSF(KFL)=XFB(KFL)/XFBO | |
9202 | 170 WTSUM=WTSUM+WTAP(KFL)*WTSF(KFL) | |
9203 | WTSUM=MAX(0.0001,WTSUM) | |
9204 | ||
9205 | C...Choose new t: fix alpha_s, alpha_s(Q2), alpha_s(k_T2). | |
9206 | 180 IF(MSTP(64).LE.0) THEN | |
9207 | TEVB=TEVB+LOG(RLU(0))*PARU(2)/(PARU(111)*WTSUM) | |
9208 | ELSEIF(MSTP(64).EQ.1) THEN | |
9209 | TEVB=TEVB*EXP(MAX(-100.,LOG(RLU(0))*B0/WTSUM)) | |
9210 | ELSE | |
9211 | TEVB=TEVB*EXP(MAX(-100.,LOG(RLU(0))*B0/(5.*WTSUM))) | |
9212 | ENDIF | |
9213 | 190 Q2REF=ALAM(JT)**2*EXP(TEVB) | |
9214 | Q2B=Q2REF/PARP(63) | |
9215 | ||
9216 | C...Evolution ended or select flavour for branching parton. | |
9217 | IF(Q2B.LT.PARP(62)**2) THEN | |
9218 | Q2B=0. | |
9219 | ELSE | |
9220 | WTRAN=RLU(0)*WTSUM | |
9221 | KFLA=-MSTP(54)-1 | |
9222 | 200 KFLA=KFLA+1 | |
9223 | WTRAN=WTRAN-WTAP(KFLA)*WTSF(KFLA) | |
9224 | IF(KFLA.LT.MSTP(54).AND.WTRAN.GT.0.) GOTO 200 | |
9225 | IF(KFLA.EQ.0) KFLA=21 | |
9226 | ||
9227 | C...Choose z value and corrective weight. | |
9228 | IF(KFLB.EQ.21.AND.KFLA.EQ.21) THEN | |
9229 | Z=1./(1.+((1.-XB)/XB)*(XE/(1.-XB))**RLU(0)) | |
9230 | WTZ=(1.-Z*(1.-Z))**2 | |
9231 | ELSEIF(KFLB.EQ.21) THEN | |
9232 | Z=XB/(1.-RLU(0)*(1.-SQRT(XB+XE)))**2 | |
9233 | WTZ=0.5*(1.+(1.-Z)**2)*SQRT(Z) | |
9234 | ELSEIF(KFLA.EQ.21) THEN | |
9235 | Z=XB*(1.+RLU(0)*(1./(XB+XE)-1.)) | |
9236 | WTZ=1.-2.*Z*(1.-Z) | |
9237 | ELSE | |
9238 | Z=1.-(1.-XB)*(XE/((XB+XE)*(1.-XB)))**RLU(0) | |
9239 | WTZ=0.5*(1.+Z**2) | |
9240 | ENDIF | |
9241 | ||
9242 | C...Option with resummation of soft gluon emission as effective z shift. | |
9243 | IF(MSTP(65).GE.1) THEN | |
9244 | RSOFT=6. | |
9245 | IF(KFLB.NE.21) RSOFT=8./3. | |
9246 | Z=Z*(TEVB/TEVS(JT))**(RSOFT*XE/((XB+XE)*B0)) | |
9247 | IF(Z.LE.XB) GOTO 180 | |
9248 | ENDIF | |
9249 | ||
9250 | C...Option with alpha_s(k_T2)Q2): demand k_T2 > cutoff, reweight. | |
9251 | IF(MSTP(64).GE.2) THEN | |
9252 | IF((1.-Z)*Q2B.LT.PARP(62)**2) GOTO 180 | |
9253 | ALPRAT=TEVB/(TEVB+LOG(1.-Z)) | |
9254 | IF(ALPRAT.LT.5.*RLU(0)) GOTO 180 | |
9255 | IF(ALPRAT.GT.5.) WTZ=WTZ*ALPRAT/5. | |
9256 | ENDIF | |
9257 | ||
9258 | C...Option with angular ordering requirement. | |
9259 | IF(MSTP(62).GE.3) THEN | |
9260 | THE2T=(4.*Z**2*Q2B)/(VINT(2)*(1.-Z)*XB**2) | |
9261 | IF(THE2T.GT.THE2(JT)) GOTO 180 | |
9262 | ENDIF | |
9263 | ||
9264 | C...Weighting with new structure functions. | |
9265 | CALL PYSTFU(MINT(10+JT),XB,Q2REF,XFN,JT) | |
9266 | IF(KFLB.NE.21) XFBN=XFN(KFLB) | |
9267 | IF(KFLB.EQ.21) XFBN=XFN(0) | |
9268 | IF(XFBN.LT.1E-20) THEN | |
9269 | IF(KFLA.EQ.KFLB) THEN | |
9270 | TEVB=TEVBSV | |
9271 | WTAP(KFLB)=0. | |
9272 | GOTO 160 | |
9273 | ELSEIF(TEVBSV-TEVB.GT.0.2) THEN | |
9274 | TEVB=0.5*(TEVBSV+TEVB) | |
9275 | GOTO 190 | |
9276 | ELSE | |
9277 | XFBN=1E-10 | |
9278 | ENDIF | |
9279 | ENDIF | |
9280 | DO 210 KFL=-MSTP(54),MSTP(54) | |
9281 | 210 XFB(KFL)=XFN(KFL) | |
9282 | XA=XB/Z | |
9283 | CALL PYSTFU(MINT(10+JT),XA,Q2REF,XFA,JT) | |
9284 | IF(KFLA.NE.21) XFAN=XFA(KFLA) | |
9285 | IF(KFLA.EQ.21) XFAN=XFA(0) | |
9286 | IF(XFAN.LT.1E-20) GOTO 160 | |
9287 | IF(KFLA.NE.21) WTSFA=WTSF(KFLA) | |
9288 | IF(KFLA.EQ.21) WTSFA=WTSF(0) | |
9289 | IF(WTZ*XFAN/XFBN.LT.RLU(0)*WTSFA) GOTO 160 | |
9290 | ENDIF | |
9291 | ||
9292 | C...Define two hard scatterers in their CM-frame. | |
9293 | 220 IF(N.EQ.NS+2) THEN | |
9294 | DQ2(JT)=dble(Q2B) | |
9295 | DPLCM=DSQRT((DSH+DQ2(1)+DQ2(2))**2-4D0*DQ2(1)*DQ2(2))/DSHR | |
9296 | DO 240 JR=1,2 | |
9297 | I=NS+JR | |
9298 | IF(JR.EQ.1) IPO=IPUS1 | |
9299 | IF(JR.EQ.2) IPO=IPUS2 | |
9300 | DO 230 J=1,5 | |
9301 | K(I,J)=0 | |
9302 | P(I,J)=0. | |
9303 | 230 V(I,J)=0. | |
9304 | K(I,1)=14 | |
9305 | K(I,2)=KFLS(JR+2) | |
9306 | K(I,4)=IPO | |
9307 | K(I,5)=IPO | |
9308 | P(I,3)=sngl(DPLCM)*(-1)**(JR+1) | |
9309 | P(I,4)=sngl((DSH+DQ2(3-JR)-DQ2(JR))/DSHR) | |
9310 | P(I,5)=-SQRT(SNGL(DQ2(JR))) | |
9311 | K(IPO,1)=14 | |
9312 | K(IPO,3)=I | |
9313 | K(IPO,4)=MOD(K(IPO,4),MSTU(5))+MSTU(5)*I | |
9314 | 240 K(IPO,5)=MOD(K(IPO,5),MSTU(5))+MSTU(5)*I | |
9315 | ||
9316 | C...Find maximum allowed mass of timelike parton. | |
9317 | ELSEIF(N.GT.NS+2) THEN | |
9318 | JR=3-JT | |
9319 | DQ2(3)=dble(Q2B) | |
9320 | DPC(1)=dble(P(IS(1),4)) | |
9321 | DPC(2)=dble(P(IS(2),4)) | |
9322 | DPC(3)=dble(0.5*(ABS(P(IS(1),3))+ABS(P(IS(2),3)))) | |
9323 | DPD(1)=DSH+DQ2(JR)+DQ2(JT) | |
9324 | DPD(2)=DSHZ+DQ2(JR)+DQ2(3) | |
9325 | DPD(3)=SQRT(DPD(1)**2-4D0*DQ2(JR)*DQ2(JT)) | |
9326 | DPD(4)=SQRT(DPD(2)**2-4D0*DQ2(JR)*DQ2(3)) | |
9327 | IKIN=0 | |
9328 | IF(Q2S(JR).GE.(0.5*PARP(62))**2.AND.DPD(1)-DPD(3).GE. | |
9329 | & 1D-10*DPD(1)) IKIN=1 | |
9330 | IF(IKIN.EQ.0) DMSMA=(DQ2(JT)/DBLE(ZS(JT))-DQ2(3))*(DSH/ | |
9331 | & (DSH+DQ2(JT))-DSH/(DSHZ+DQ2(3))) | |
9332 | IF(IKIN.EQ.1) DMSMA=(DPD(1)*DPD(2)-DPD(3)*DPD(4))/(2.d0* | |
9333 | & DQ2(JR))-DQ2(JT)-DQ2(3) | |
9334 | ||
9335 | C...Generate timelike parton shower (if required). | |
9336 | IT=N | |
9337 | DO 250 J=1,5 | |
9338 | K(IT,J)=0 | |
9339 | P(IT,J)=0. | |
9340 | 250 V(IT,J)=0. | |
9341 | K(IT,1)=3 | |
9342 | K(IT,2)=21 | |
9343 | IF(KFLB.EQ.21.AND.KFLS(JT+2).NE.21) K(IT,2)=-KFLS(JT+2) | |
9344 | IF(KFLB.NE.21.AND.KFLS(JT+2).EQ.21) K(IT,2)=KFLB | |
9345 | P(IT,5)=ULMASS(K(IT,2)) | |
9346 | IF(SNGL(DMSMA).LE.P(IT,5)**2) GOTO 100 | |
9347 | IF(MSTP(63).GE.1) THEN | |
9348 | P(IT,4)=sngl((DSHZ-DSH-dble(P(IT,5))**2)/DSHR) | |
9349 | P(IT,3)=SQRT(P(IT,4)**2-P(IT,5)**2) | |
9350 | IF(MSTP(63).EQ.1) THEN | |
9351 | Q2TIM=sngl(DMSMA) | |
9352 | ELSEIF(MSTP(63).EQ.2) THEN | |
9353 | Q2TIM=MIN(SNGL(DMSMA),PARP(71)*Q2S(JT)) | |
9354 | ELSE | |
9355 | C'''Here remains to introduce angular ordering in first branching. | |
9356 | Q2TIM=sngl(DMSMA) | |
9357 | ENDIF | |
9358 | CALL LUSHOW(IT,0,SQRT(Q2TIM)) | |
9359 | IF(N.GE.IT+1) P(IT,5)=P(IT+1,5) | |
9360 | ENDIF | |
9361 | ||
9362 | C...Reconstruct kinematics of branching: timelike parton shower. | |
9363 | DMS=dble(P(IT,5)**2) | |
9364 | IF(IKIN.EQ.0) DPT2=(DMSMA-DMS)*(DSHZ+DQ2(3))/(DSH+DQ2(JT)) | |
9365 | IF(IKIN.EQ.1) DPT2=(DMSMA-DMS)*(0.5d0*DPD(1)*DPD(2) | |
9366 | & +0.5d0*DPD(3)* | |
9367 | & DPD(4)-DQ2(JR)*(DQ2(JT)+DQ2(3)+DMS))/(4.d0*DSH*DPC(3)**2) | |
9368 | IF(DPT2.LT.0.d0) GOTO 100 | |
9369 | DPB(1)=(0.5d0*DPD(2)-DPC(JR)*(DSHZ+DQ2(JR)-DQ2(JT)-DMS)/ | |
9370 | & DSHR)/DPC(3)-DPC(3) | |
9371 | P(IT,1)=SQRT(SNGL(DPT2)) | |
9372 | P(IT,3)=sngl(DPB(1))*(-1)**(JT+1) | |
9373 | P(IT,4)=sngl((DSHZ-DSH-DMS)/DSHR) | |
9374 | IF(N.GE.IT+1) THEN | |
9375 | DPB(1)=SQRT(DPB(1)**2+DPT2) | |
9376 | DPB(2)=SQRT(DPB(1)**2+DMS) | |
9377 | DPB(3)=dble(P(IT+1,3)) | |
9378 | DPB(4)=SQRT(DPB(3)**2+DMS) | |
9379 | DBEZ=(DPB(4)*DPB(1)-DPB(3)*DPB(2))/(DPB(4)*DPB(2)-DPB(3)* | |
9380 | & DPB(1)) | |
9381 | CALL LUDBRB(IT+1,N,0.,0.,0D0,0D0,DBEZ) | |
9382 | THE=ULANGL(P(IT,3),P(IT,1)) | |
9383 | CALL LUDBRB(IT+1,N,THE,0.,0D0,0D0,0D0) | |
9384 | ENDIF | |
9385 | ||
9386 | C...Reconstruct kinematics of branching: spacelike parton. | |
9387 | DO 260 J=1,5 | |
9388 | K(N+1,J)=0 | |
9389 | P(N+1,J)=0. | |
9390 | 260 V(N+1,J)=0. | |
9391 | K(N+1,1)=14 | |
9392 | K(N+1,2)=KFLB | |
9393 | P(N+1,1)=P(IT,1) | |
9394 | P(N+1,3)=P(IT,3)+P(IS(JT),3) | |
9395 | P(N+1,4)=P(IT,4)+P(IS(JT),4) | |
9396 | P(N+1,5)=-SQRT(SNGL(DQ2(3))) | |
9397 | ||
9398 | C...Define colour flow of branching. | |
9399 | K(IS(JT),3)=N+1 | |
9400 | K(IT,3)=N+1 | |
9401 | ID1=IT | |
9402 | IF((K(N+1,2).GT.0.AND.K(N+1,2).NE.21.AND.K(ID1,2).GT.0.AND. | |
9403 | & K(ID1,2).NE.21).OR.(K(N+1,2).LT.0.AND.K(ID1,2).EQ.21).OR. | |
9404 | & (K(N+1,2).EQ.21.AND.K(ID1,2).EQ.21.AND.RLU(0).GT.0.5).OR. | |
9405 | & (K(N+1,2).EQ.21.AND.K(ID1,2).LT.0)) ID1=IS(JT) | |
9406 | ID2=IT+IS(JT)-ID1 | |
9407 | K(N+1,4)=K(N+1,4)+ID1 | |
9408 | K(N+1,5)=K(N+1,5)+ID2 | |
9409 | K(ID1,4)=K(ID1,4)+MSTU(5)*(N+1) | |
9410 | K(ID1,5)=K(ID1,5)+MSTU(5)*ID2 | |
9411 | K(ID2,4)=K(ID2,4)+MSTU(5)*ID1 | |
9412 | K(ID2,5)=K(ID2,5)+MSTU(5)*(N+1) | |
9413 | N=N+1 | |
9414 | ||
9415 | C...Boost to new CM-frame. | |
9416 | CALL LUDBRB(NS+1,N,0.,0.,-DBLE((P(N,1)+P(IS(JR),1))/(P(N,4)+ | |
9417 | & P(IS(JR),4))),0D0,-DBLE((P(N,3)+P(IS(JR),3))/(P(N,4)+ | |
9418 | & P(IS(JR),4)))) | |
9419 | IR=N+(JT-1)*(IS(1)-N) | |
9420 | CALL LUDBRB(NS+1,N,-ULANGL(P(IR,3),P(IR,1)),PARU(2)*RLU(0), | |
9421 | & 0D0,0D0,0D0) | |
9422 | ENDIF | |
9423 | ||
9424 | C...Save quantities, loop back. | |
9425 | IS(JT)=N | |
9426 | Q2S(JT)=Q2B | |
9427 | DQ2(JT)=dble(Q2B) | |
9428 | IF(MSTP(62).GE.3) THE2(JT)=THE2T | |
9429 | DSH=DSHZ | |
9430 | IF(Q2B.GE.(0.5*PARP(62))**2) THEN | |
9431 | KFLS(JT+2)=KFLS(JT) | |
9432 | KFLS(JT)=KFLA | |
9433 | XS(JT)=XA | |
9434 | ZS(JT)=Z | |
9435 | DO 270 KFL=-6,6 | |
9436 | 270 XFS(JT,KFL)=XFA(KFL) | |
9437 | TEVS(JT)=TEVB | |
9438 | ELSE | |
9439 | IF(JT.EQ.1) IPU1=N | |
9440 | IF(JT.EQ.2) IPU2=N | |
9441 | ENDIF | |
9442 | IF(N.GT.MSTU(4)-MSTU(32)-10) THEN | |
ce320da8 | 9443 | CALL LUERRM(11,'(PYSSPAS:) no more memory left in LUJETSA') |
0119ef9a | 9444 | IF(MSTU(21).GE.1) N=NS |
9445 | IF(MSTU(21).GE.1) RETURN | |
9446 | ENDIF | |
9447 | IF(MAX(Q2S(1),Q2S(2)).GE.(0.5*PARP(62))**2.OR.N.LE.NS+1) GOTO 120 | |
9448 | ||
9449 | C...Boost hard scattering partons to frame of shower initiators. | |
9450 | DO 280 J=1,3 | |
9451 | 280 ROBO(J+2)=(P(NS+1,J)+P(NS+2,J))/(P(NS+1,4)+P(NS+2,4)) | |
9452 | DO 290 J=1,5 | |
9453 | 290 P(N+2,J)=P(NS+1,J) | |
9454 | ROBOT=ROBO(3)**2+ROBO(4)**2+ROBO(5)**2 | |
9455 | IF(ROBOT.GE.0.999999) THEN | |
9456 | ROBOT=1.00001*SQRT(ROBOT) | |
9457 | ROBO(3)=ROBO(3)/ROBOT | |
9458 | ROBO(4)=ROBO(4)/ROBOT | |
9459 | ROBO(5)=ROBO(5)/ROBOT | |
9460 | ENDIF | |
9461 | CALL LUDBRB(N+2,N+2,0.,0.,-DBLE(ROBO(3)),-DBLE(ROBO(4)), | |
9462 | &-DBLE(ROBO(5))) | |
9463 | ROBO(2)=ULANGL(P(N+2,1),P(N+2,2)) | |
9464 | ROBO(1)=ULANGL(P(N+2,3),SQRT(P(N+2,1)**2+P(N+2,2)**2)) | |
9465 | CALL LUDBRB(MINT(83)+5,NS,ROBO(1),ROBO(2),DBLE(ROBO(3)), | |
9466 | &DBLE(ROBO(4)),DBLE(ROBO(5))) | |
9467 | ||
9468 | C...Store user information. Reset Lambda value. | |
9469 | K(IPU1,3)=MINT(83)+3 | |
9470 | K(IPU2,3)=MINT(83)+4 | |
9471 | DO 300 JT=1,2 | |
9472 | MINT(12+JT)=KFLS(JT) | |
9473 | 300 VINT(140+JT)=XS(JT) | |
9474 | PARU(111)=ALAMS | |
9475 | 1000 FORMAT(5X,'structure function has a zero point here') | |
9476 | 1001 FORMAT(5X,'xf(x,i=',I5,')=',F10.5) | |
9477 | ||
9478 | RETURN | |
9479 | END | |
9480 | ||
9481 | C********************************************************************* | |
9482 | ||
ce320da8 | 9483 | SUBROUTINE PYMULTA(MMUL) |
0119ef9a | 9484 | |
9485 | C...Initializes treatment of multiple interactions, selects kinematics | |
9486 | C...of hardest interaction if low-pT physics included in run, and | |
9487 | C...generates all non-hardest interactions. | |
9488 | COMMON/LUJETSA/N,K(9000,5),P(9000,5),V(9000,5) | |
9489 | SAVE /LUJETSA/ | |
9490 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
9491 | SAVE /LUDAT1A/ | |
9492 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
9493 | SAVE /LUDAT2A/ | |
9494 | COMMON/PYSUBSA/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200) | |
9495 | SAVE /PYSUBSA/ | |
9496 | COMMON/PYPARSA/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
9497 | SAVE /PYPARSA/ | |
9498 | COMMON/PYINT1A/MINT(400),VINT(400) | |
9499 | SAVE /PYINT1A/ | |
9500 | COMMON/PYINT2A/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2) | |
9501 | SAVE /PYINT2A/ | |
9502 | COMMON/PYINT3A/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) | |
9503 | SAVE /PYINT3A/ | |
9504 | COMMON/PYINT5A/NGEN(0:200,3),XSEC(0:200,3) | |
9505 | SAVE /PYINT5A/ | |
9506 | DIMENSION NMUL(20),SIGM(20),KSTR(500,2) | |
9507 | SAVE XT2,XT2FAC,XC2,XTS,IRBIN,RBIN,NMUL,SIGM | |
9508 | ||
9509 | xf=0. | |
9510 | yf=0. | |
9511 | deltab=0. | |
9512 | ist1=0 | |
9513 | ist2=0 | |
9514 | istm=0 | |
9515 | ||
9516 | C...Initialization of multiple interaction treatment. | |
9517 | IF(MMUL.EQ.1) THEN | |
9518 | IF(MSTP(122).GE.1) WRITE(MSTU(11),1000) MSTP(82) | |
9519 | ISUB=96 | |
9520 | MINT(1)=96 | |
9521 | VINT(63)=0. | |
9522 | VINT(64)=0. | |
9523 | VINT(143)=1. | |
9524 | VINT(144)=1. | |
9525 | ||
9526 | C...Loop over phase space points: xT2 choice in 20 bins. | |
9527 | 100 SIGSUM=0. | |
9528 | DO 120 IXT2=1,20 | |
9529 | NMUL(IXT2)=MSTP(83) | |
9530 | SIGM(IXT2)=0. | |
9531 | DO 110 ITRY=1,MSTP(83) | |
9532 | RSCA=0.05*((21-IXT2)-RLU(0)) | |
9533 | XT2=VINT(149)*(1.+VINT(149))/(VINT(149)+RSCA)-VINT(149) | |
9534 | XT2=MAX(0.01*VINT(149),XT2) | |
9535 | VINT(25)=XT2 | |
9536 | ||
9537 | C...Choose tau and y*. Calculate cos(theta-hat). | |
9538 | IF(RLU(0).LE.COEF(ISUB,1)) THEN | |
9539 | TAUP=(2.*(1.+SQRT(1.-XT2))/XT2-1.)**RLU(0) | |
9540 | TAU=XT2*(1.+TAUP)**2/(4.*TAUP) | |
9541 | ELSE | |
9542 | TAU=XT2*(1.+TAN(RLU(0)*ATAN(SQRT(1./XT2-1.)))**2) | |
9543 | ENDIF | |
9544 | VINT(21)=TAU | |
ce320da8 | 9545 | CALL PYKLIMA(2) |
0119ef9a | 9546 | RYST=RLU(0) |
9547 | MYST=1 | |
9548 | IF(RYST.GT.COEF(ISUB,7)) MYST=2 | |
9549 | IF(RYST.GT.COEF(ISUB,7)+COEF(ISUB,8)) MYST=3 | |
ce320da8 | 9550 | CALL PYKMAPA(2,MYST,RLU(0)) |
0119ef9a | 9551 | VINT(23)=SQRT(MAX(0.,1.-XT2/TAU))*(-1)**INT(1.5+RLU(0)) |
9552 | ||
9553 | C...Calculate differential cross-section. | |
9554 | VINT(71)=0.5*VINT(1)*SQRT(XT2) | |
ce320da8 | 9555 | CALL PYSIGHA(NCHN,SIGS) |
0119ef9a | 9556 | 110 SIGM(IXT2)=SIGM(IXT2)+SIGS |
9557 | 120 SIGSUM=SIGSUM+SIGM(IXT2) | |
9558 | SIGSUM=SIGSUM/(20.*MSTP(83)) | |
9559 | ||
9560 | C...Reject result if sigma(parton-parton) is smaller than hadronic one. | |
9561 | IF(SIGSUM.LT.1.1*VINT(106)) THEN | |
9562 | IF(MSTP(122).GE.1) WRITE(MSTU(11),1100) PARP(82),SIGSUM | |
9563 | PARP(82)=0.9*PARP(82) | |
9564 | VINT(149)=4.*PARP(82)**2/VINT(2) | |
9565 | GOTO 100 | |
9566 | ENDIF | |
9567 | IF(MSTP(122).GE.1) WRITE(MSTU(11),1200) PARP(82), SIGSUM | |
9568 | ||
9569 | C...Start iteration to find k factor. | |
9570 | YKE=SIGSUM/VINT(106) | |
9571 | SO=0.5 | |
9572 | XI=0. | |
9573 | YI=0. | |
9574 | XK=0.5 | |
9575 | IIT=0 | |
9576 | 130 IF(IIT.EQ.0) THEN | |
9577 | XK=2.*XK | |
9578 | ELSEIF(IIT.EQ.1) THEN | |
9579 | XK=0.5*XK | |
9580 | ELSE | |
9581 | XK=XI+(YKE-YI)*(XF-XI)/(YF-YI) | |
9582 | ENDIF | |
9583 | ||
9584 | C...Evaluate overlap integrals. | |
9585 | IF(MSTP(82).EQ.2) THEN | |
9586 | SP=0.5*PARU(1)*(1.-EXP(-XK)) | |
9587 | SOP=SP/PARU(1) | |
9588 | ELSE | |
9589 | IF(MSTP(82).EQ.3) DELTAB=0.02 | |
9590 | IF(MSTP(82).EQ.4) DELTAB=MIN(0.01,0.05*PARP(84)) | |
9591 | SP=0. | |
9592 | SOP=0. | |
9593 | B=-0.5*DELTAB | |
9594 | 140 B=B+DELTAB | |
9595 | IF(MSTP(82).EQ.3) THEN | |
9596 | OV=EXP(-B**2)/PARU(2) | |
9597 | ELSE | |
9598 | CQ2=PARP(84)**2 | |
9599 | OV=((1.-PARP(83))**2*EXP(-MIN(100.,B**2))+2.*PARP(83)* | |
9600 | & (1.-PARP(83))*2./(1.+CQ2)*EXP(-MIN(100.,B**2*2./(1.+CQ2)))+ | |
9601 | & PARP(83)**2/CQ2*EXP(-MIN(100.,B**2/CQ2)))/PARU(2) | |
9602 | ENDIF | |
9603 | PACC=1.-EXP(-MIN(100.,PARU(1)*XK*OV)) | |
9604 | SP=SP+PARU(2)*B*DELTAB*PACC | |
9605 | SOP=SOP+PARU(2)*B*DELTAB*OV*PACC | |
9606 | IF(B.LT.1..OR.B*PACC.GT.1E-6) GOTO 140 | |
9607 | ENDIF | |
9608 | YK=PARU(1)*XK*SO/SP | |
9609 | ||
9610 | C...Continue iteration until convergence. | |
9611 | IF(YK.LT.YKE) THEN | |
9612 | XI=XK | |
9613 | YI=YK | |
9614 | IF(IIT.EQ.1) IIT=2 | |
9615 | ELSE | |
9616 | XF=XK | |
9617 | YF=YK | |
9618 | IF(IIT.EQ.0) IIT=1 | |
9619 | ENDIF | |
9620 | IF(ABS(YK-YKE).GE.1E-5*YKE) GOTO 130 | |
9621 | ||
9622 | C...Store some results for subsequent use. | |
9623 | VINT(145)=SIGSUM | |
9624 | VINT(146)=SOP/SO | |
9625 | VINT(147)=SOP/SP | |
9626 | ||
9627 | C...Initialize iteration in xT2 for hardest interaction. | |
9628 | ELSEIF(MMUL.EQ.2) THEN | |
9629 | IF(MSTP(82).LE.0) THEN | |
9630 | ELSEIF(MSTP(82).EQ.1) THEN | |
9631 | XT2=1. | |
9632 | XT2FAC=XSEC(96,1)/VINT(106)*VINT(149)/(1.-VINT(149)) | |
9633 | ELSEIF(MSTP(82).EQ.2) THEN | |
9634 | XT2=1. | |
9635 | XT2FAC=VINT(146)*XSEC(96,1)/VINT(106)*VINT(149)*(1.+VINT(149)) | |
9636 | ELSE | |
9637 | XC2=4.*CKIN(3)**2/VINT(2) | |
9638 | IF(CKIN(3).LE.CKIN(5).OR.MINT(82).GE.2) XC2=0. | |
9639 | ENDIF | |
9640 | ||
9641 | ELSEIF(MMUL.EQ.3) THEN | |
9642 | C...Low-pT or multiple interactions (first semihard interaction): | |
9643 | C...choose xT2 according to dpT2/pT2**2*exp(-(sigma above pT2)/norm) | |
9644 | C...or (MSTP(82)>=2) dpT2/(pT2+pT0**2)**2*exp(-....). | |
9645 | ISUB=MINT(1) | |
9646 | IF(MSTP(82).LE.0) THEN | |
9647 | XT2=0. | |
9648 | ELSEIF(MSTP(82).EQ.1) THEN | |
9649 | XT2=XT2FAC*XT2/(XT2FAC-XT2*LOG(RLU(0))) | |
9650 | ELSEIF(MSTP(82).EQ.2) THEN | |
9651 | IF(XT2.LT.1..AND.EXP(-XT2FAC*XT2/(VINT(149)*(XT2+ | |
9652 | & VINT(149)))).GT.RLU(0)) XT2=1. | |
9653 | IF(XT2.GE.1.) THEN | |
9654 | XT2=(1.+VINT(149))*XT2FAC/(XT2FAC-(1.+VINT(149))*LOG(1.- | |
9655 | & RLU(0)*(1.-EXP(-XT2FAC/(VINT(149)*(1.+VINT(149)))))))- | |
9656 | & VINT(149) | |
9657 | ELSE | |
9658 | XT2=-XT2FAC/LOG(EXP(-XT2FAC/(XT2+VINT(149)))+RLU(0)* | |
9659 | & (EXP(-XT2FAC/VINT(149))-EXP(-XT2FAC/(XT2+VINT(149)))))- | |
9660 | & VINT(149) | |
9661 | ENDIF | |
9662 | XT2=MAX(0.01*VINT(149),XT2) | |
9663 | ELSE | |
9664 | XT2=(XC2+VINT(149))*(1.+VINT(149))/(1.+VINT(149)- | |
9665 | & RLU(0)*(1.-XC2))-VINT(149) | |
9666 | XT2=MAX(0.01*VINT(149),XT2) | |
9667 | ENDIF | |
9668 | VINT(25)=XT2 | |
9669 | ||
9670 | C...Low-pT: choose xT2, tau, y* and cos(theta-hat) fixed. | |
9671 | IF(MSTP(82).LE.1.AND.XT2.LT.VINT(149)) THEN | |
9672 | IF(MINT(82).EQ.1) NGEN(0,1)=NGEN(0,1)-1 | |
9673 | IF(MINT(82).EQ.1) NGEN(ISUB,1)=NGEN(ISUB,1)-1 | |
9674 | ISUB=95 | |
9675 | MINT(1)=ISUB | |
9676 | VINT(21)=0.01*VINT(149) | |
9677 | VINT(22)=0. | |
9678 | VINT(23)=0. | |
9679 | VINT(25)=0.01*VINT(149) | |
9680 | ||
9681 | ELSE | |
9682 | C...Multiple interactions (first semihard interaction). | |
9683 | C...Choose tau and y*. Calculate cos(theta-hat). | |
9684 | IF(RLU(0).LE.COEF(ISUB,1)) THEN | |
9685 | TAUP=(2.*(1.+SQRT(1.-XT2))/XT2-1.)**RLU(0) | |
9686 | TAU=XT2*(1.+TAUP)**2/(4.*TAUP) | |
9687 | ELSE | |
9688 | TAU=XT2*(1.+TAN(RLU(0)*ATAN(SQRT(1./XT2-1.)))**2) | |
9689 | ENDIF | |
9690 | VINT(21)=TAU | |
ce320da8 | 9691 | CALL PYKLIMA(2) |
0119ef9a | 9692 | RYST=RLU(0) |
9693 | MYST=1 | |
9694 | IF(RYST.GT.COEF(ISUB,7)) MYST=2 | |
9695 | IF(RYST.GT.COEF(ISUB,7)+COEF(ISUB,8)) MYST=3 | |
ce320da8 | 9696 | CALL PYKMAPA(2,MYST,RLU(0)) |
0119ef9a | 9697 | VINT(23)=SQRT(MAX(0.,1.-XT2/TAU))*(-1)**INT(1.5+RLU(0)) |
9698 | ENDIF | |
9699 | VINT(71)=0.5*VINT(1)*SQRT(VINT(25)) | |
9700 | ||
9701 | C...Store results of cross-section calculation. | |
9702 | ELSEIF(MMUL.EQ.4) THEN | |
9703 | ISUB=MINT(1) | |
9704 | XTS=VINT(25) | |
9705 | IF(ISET(ISUB).EQ.1) XTS=VINT(21) | |
9706 | IF(ISET(ISUB).EQ.2) XTS=(4.*VINT(48)+2.*VINT(63)+2.*VINT(64))/ | |
9707 | & VINT(2) | |
9708 | IF(ISET(ISUB).EQ.3.OR.ISET(ISUB).EQ.4) XTS=VINT(26) | |
9709 | RBIN=MAX(0.000001,MIN(0.999999,XTS*(1.+VINT(149))/ | |
9710 | & (XTS+VINT(149)))) | |
9711 | IRBIN=INT(1.+20.*RBIN) | |
9712 | IF(ISUB.EQ.96) NMUL(IRBIN)=NMUL(IRBIN)+1 | |
9713 | IF(ISUB.EQ.96) SIGM(IRBIN)=SIGM(IRBIN)+VINT(153) | |
9714 | ||
9715 | C...Choose impact parameter. | |
9716 | ELSEIF(MMUL.EQ.5) THEN | |
9717 | IF(MSTP(82).EQ.3) THEN | |
9718 | VINT(148)=RLU(0)/(PARU(2)*VINT(147)) | |
9719 | ELSE | |
9720 | RTYPE=RLU(0) | |
9721 | CQ2=PARP(84)**2 | |
9722 | IF(RTYPE.LT.(1.-PARP(83))**2) THEN | |
9723 | B2=-LOG(RLU(0)) | |
9724 | ELSEIF(RTYPE.LT.1.-PARP(83)**2) THEN | |
9725 | B2=-0.5*(1.+CQ2)*LOG(RLU(0)) | |
9726 | ELSE | |
9727 | B2=-CQ2*LOG(RLU(0)) | |
9728 | ENDIF | |
9729 | VINT(148)=((1.-PARP(83))**2*EXP(-MIN(100.,B2))+2.*PARP(83)* | |
9730 | & (1.-PARP(83))*2./(1.+CQ2)*EXP(-MIN(100.,B2*2./(1.+CQ2)))+ | |
9731 | & PARP(83)**2/CQ2*EXP(-MIN(100.,B2/CQ2)))/(PARU(2)*VINT(147)) | |
9732 | ENDIF | |
9733 | ||
9734 | C...Multiple interactions (variable impact parameter) : reject with | |
9735 | C...probability exp(-overlap*cross-section above pT/normalization). | |
9736 | RNCOR=(IRBIN-20.*RBIN)*NMUL(IRBIN) | |
9737 | SIGCOR=(IRBIN-20.*RBIN)*SIGM(IRBIN) | |
9738 | DO 150 IBIN=IRBIN+1,20 | |
9739 | RNCOR=RNCOR+NMUL(IBIN) | |
9740 | 150 SIGCOR=SIGCOR+SIGM(IBIN) | |
9741 | SIGABV=(SIGCOR/RNCOR)*VINT(149)*(1.-XTS)/(XTS+VINT(149)) | |
9742 | VINT(150)=EXP(-MIN(100.,VINT(146)*VINT(148)*SIGABV/VINT(106))) | |
9743 | ||
9744 | C...Generate additional multiple semihard interactions. | |
9745 | ELSEIF(MMUL.EQ.6) THEN | |
9746 | ||
9747 | C...Reconstruct strings in hard scattering. | |
9748 | ISUB=MINT(1) | |
9749 | NMAX=MINT(84)+4 | |
9750 | IF(ISET(ISUB).EQ.1) NMAX=MINT(84)+2 | |
9751 | NSTR=0 | |
9752 | DO 170 I=MINT(84)+1,NMAX | |
9753 | KCS=KCHG(LUCOMP(K(I,2)),2)*ISIGN(1,K(I,2)) | |
9754 | IF(KCS.EQ.0) GOTO 170 | |
9755 | DO 160 J=1,4 | |
9756 | IF(KCS.EQ.1.AND.(J.EQ.2.OR.J.EQ.4)) GOTO 160 | |
9757 | IF(KCS.EQ.-1.AND.(J.EQ.1.OR.J.EQ.3)) GOTO 160 | |
9758 | IF(J.LE.2) THEN | |
9759 | IST=MOD(K(I,J+3)/MSTU(5),MSTU(5)) | |
9760 | ELSE | |
9761 | IST=MOD(K(I,J+1),MSTU(5)) | |
9762 | ENDIF | |
9763 | IF(IST.LT.MINT(84).OR.IST.GT.I) GOTO 160 | |
9764 | IF(KCHG(LUCOMP(K(IST,2)),2).EQ.0) GOTO 160 | |
9765 | NSTR=NSTR+1 | |
9766 | IF(J.EQ.1.OR.J.EQ.4) THEN | |
9767 | KSTR(NSTR,1)=I | |
9768 | KSTR(NSTR,2)=IST | |
9769 | ELSE | |
9770 | KSTR(NSTR,1)=IST | |
9771 | KSTR(NSTR,2)=I | |
9772 | ENDIF | |
9773 | 160 CONTINUE | |
9774 | 170 CONTINUE | |
9775 | ||
9776 | C...Set up starting values for iteration in xT2. | |
9777 | XT2=VINT(25) | |
9778 | IF(ISET(ISUB).EQ.1) XT2=VINT(21) | |
9779 | IF(ISET(ISUB).EQ.2) XT2=(4.*VINT(48)+2.*VINT(63)+2.*VINT(64))/ | |
9780 | & VINT(2) | |
9781 | IF(ISET(ISUB).EQ.3.OR.ISET(ISUB).EQ.4) XT2=VINT(26) | |
9782 | ISUB=96 | |
9783 | MINT(1)=96 | |
9784 | IF(MSTP(82).LE.1) THEN | |
9785 | XT2FAC=XSEC(ISUB,1)*VINT(149)/((1.-VINT(149))*VINT(106)) | |
9786 | ELSE | |
9787 | XT2FAC=VINT(146)*VINT(148)*XSEC(ISUB,1)/VINT(106)* | |
9788 | & VINT(149)*(1.+VINT(149)) | |
9789 | ENDIF | |
9790 | VINT(63)=0. | |
9791 | VINT(64)=0. | |
9792 | VINT(151)=0. | |
9793 | VINT(152)=0. | |
9794 | VINT(143)=1.-VINT(141) | |
9795 | VINT(144)=1.-VINT(142) | |
9796 | ||
9797 | C...Iterate downwards in xT2. | |
9798 | 180 IF(MSTP(82).LE.1) THEN | |
9799 | XT2=XT2FAC*XT2/(XT2FAC-XT2*LOG(RLU(0))) | |
9800 | IF(XT2.LT.VINT(149)) GOTO 220 | |
9801 | ELSE | |
9802 | IF(XT2.LE.0.01*VINT(149)) GOTO 220 | |
9803 | XT2=XT2FAC*(XT2+VINT(149))/(XT2FAC-(XT2+VINT(149))* | |
9804 | & LOG(RLU(0)))-VINT(149) | |
9805 | IF(XT2.LE.0.) GOTO 220 | |
9806 | XT2=MAX(0.01*VINT(149),XT2) | |
9807 | ENDIF | |
9808 | VINT(25)=XT2 | |
9809 | ||
9810 | C...Choose tau and y*. Calculate cos(theta-hat). | |
9811 | IF(RLU(0).LE.COEF(ISUB,1)) THEN | |
9812 | TAUP=(2.*(1.+SQRT(1.-XT2))/XT2-1.)**RLU(0) | |
9813 | TAU=XT2*(1.+TAUP)**2/(4.*TAUP) | |
9814 | ELSE | |
9815 | TAU=XT2*(1.+TAN(RLU(0)*ATAN(SQRT(1./XT2-1.)))**2) | |
9816 | ENDIF | |
9817 | VINT(21)=TAU | |
ce320da8 | 9818 | CALL PYKLIMA(2) |
0119ef9a | 9819 | RYST=RLU(0) |
9820 | MYST=1 | |
9821 | IF(RYST.GT.COEF(ISUB,7)) MYST=2 | |
9822 | IF(RYST.GT.COEF(ISUB,7)+COEF(ISUB,8)) MYST=3 | |
ce320da8 | 9823 | CALL PYKMAPA(2,MYST,RLU(0)) |
0119ef9a | 9824 | VINT(23)=SQRT(MAX(0.,1.-XT2/TAU))*(-1)**INT(1.5+RLU(0)) |
9825 | ||
9826 | C...Check that x not used up. Accept or reject kinematical variables. | |
9827 | X1M=SQRT(TAU)*EXP(VINT(22)) | |
9828 | X2M=SQRT(TAU)*EXP(-VINT(22)) | |
9829 | IF(VINT(143)-X1M.LT.0.01.OR.VINT(144)-X2M.LT.0.01) GOTO 180 | |
9830 | VINT(71)=0.5*VINT(1)*SQRT(XT2) | |
ce320da8 | 9831 | CALL PYSIGHA(NCHN,SIGS) |
0119ef9a | 9832 | IF(SIGS.LT.XSEC(ISUB,1)*RLU(0)) GOTO 180 |
9833 | ||
9834 | C...Reset K, P and V vectors. Select some variables. | |
9835 | DO 190 I=N+1,N+2 | |
9836 | DO 190 J=1,5 | |
9837 | K(I,J)=0 | |
9838 | P(I,J)=0. | |
9839 | 190 V(I,J)=0. | |
9840 | RFLAV=RLU(0) | |
9841 | PT=0.5*VINT(1)*SQRT(XT2) | |
9842 | PHI=PARU(2)*RLU(0) | |
9843 | CTH=VINT(23) | |
9844 | ||
9845 | C...Add first parton to event record. | |
9846 | K(N+1,1)=3 | |
9847 | K(N+1,2)=21 | |
9848 | IF(RFLAV.GE.MAX(PARP(85),PARP(86))) K(N+1,2)= | |
9849 | & 1+INT((2.+PARJ(2))*RLU(0)) | |
9850 | P(N+1,1)=PT*COS(PHI) | |
9851 | P(N+1,2)=PT*SIN(PHI) | |
9852 | P(N+1,3)=0.25*VINT(1)*(VINT(41)*(1.+CTH)-VINT(42)*(1.-CTH)) | |
9853 | P(N+1,4)=0.25*VINT(1)*(VINT(41)*(1.+CTH)+VINT(42)*(1.-CTH)) | |
9854 | P(N+1,5)=0. | |
9855 | ||
9856 | C...Add second parton to event record. | |
9857 | K(N+2,1)=3 | |
9858 | K(N+2,2)=21 | |
9859 | IF(K(N+1,2).NE.21) K(N+2,2)=-K(N+1,2) | |
9860 | P(N+2,1)=-P(N+1,1) | |
9861 | P(N+2,2)=-P(N+1,2) | |
9862 | P(N+2,3)=0.25*VINT(1)*(VINT(41)*(1.-CTH)-VINT(42)*(1.+CTH)) | |
9863 | P(N+2,4)=0.25*VINT(1)*(VINT(41)*(1.-CTH)+VINT(42)*(1.+CTH)) | |
9864 | P(N+2,5)=0. | |
9865 | ||
9866 | IF(RFLAV.LT.PARP(85).AND.NSTR.GE.1) THEN | |
9867 | C....Choose relevant string pieces to place gluons on. | |
9868 | DO 210 I=N+1,N+2 | |
9869 | DMIN=1E8 | |
9870 | DO 200 ISTR=1,NSTR | |
9871 | I1=KSTR(ISTR,1) | |
9872 | I2=KSTR(ISTR,2) | |
9873 | DIST=(P(I,4)*P(I1,4)-P(I,1)*P(I1,1)-P(I,2)*P(I1,2)- | |
9874 | & P(I,3)*P(I1,3))*(P(I,4)*P(I2,4)-P(I,1)*P(I2,1)- | |
9875 | & P(I,2)*P(I2,2)-P(I,3)*P(I2,3))/MAX(1.,P(I1,4)*P(I2,4)- | |
9876 | & P(I1,1)*P(I2,1)-P(I1,2)*P(I2,2)-P(I1,3)*P(I2,3)) | |
9877 | IF(ISTR.EQ.1.OR.DIST.LT.DMIN) THEN | |
9878 | DMIN=DIST | |
9879 | IST1=I1 | |
9880 | IST2=I2 | |
9881 | ISTM=ISTR | |
9882 | ENDIF | |
9883 | 200 CONTINUE | |
9884 | ||
9885 | C....Colour flow adjustments, new string pieces. | |
9886 | IF(K(IST1,4)/MSTU(5).EQ.IST2) K(IST1,4)=MSTU(5)*I+ | |
9887 | & MOD(K(IST1,4),MSTU(5)) | |
9888 | IF(MOD(K(IST1,5),MSTU(5)).EQ.IST2) K(IST1,5)= | |
9889 | & MSTU(5)*(K(IST1,5)/MSTU(5))+I | |
9890 | K(I,5)=MSTU(5)*IST1 | |
9891 | K(I,4)=MSTU(5)*IST2 | |
9892 | IF(K(IST2,5)/MSTU(5).EQ.IST1) K(IST2,5)=MSTU(5)*I+ | |
9893 | & MOD(K(IST2,5),MSTU(5)) | |
9894 | IF(MOD(K(IST2,4),MSTU(5)).EQ.IST1) K(IST2,4)= | |
9895 | & MSTU(5)*(K(IST2,4)/MSTU(5))+I | |
9896 | KSTR(ISTM,2)=I | |
9897 | KSTR(NSTR+1,1)=I | |
9898 | KSTR(NSTR+1,2)=IST2 | |
9899 | 210 NSTR=NSTR+1 | |
9900 | ||
9901 | C...String drawing and colour flow for gluon loop. | |
9902 | ELSEIF(K(N+1,2).EQ.21) THEN | |
9903 | K(N+1,4)=MSTU(5)*(N+2) | |
9904 | K(N+1,5)=MSTU(5)*(N+2) | |
9905 | K(N+2,4)=MSTU(5)*(N+1) | |
9906 | K(N+2,5)=MSTU(5)*(N+1) | |
9907 | KSTR(NSTR+1,1)=N+1 | |
9908 | KSTR(NSTR+1,2)=N+2 | |
9909 | KSTR(NSTR+2,1)=N+2 | |
9910 | KSTR(NSTR+2,2)=N+1 | |
9911 | NSTR=NSTR+2 | |
9912 | ||
9913 | C...String drawing and colour flow for q-qbar pair. | |
9914 | ELSE | |
9915 | K(N+1,4)=MSTU(5)*(N+2) | |
9916 | K(N+2,5)=MSTU(5)*(N+1) | |
9917 | KSTR(NSTR+1,1)=N+1 | |
9918 | KSTR(NSTR+1,2)=N+2 | |
9919 | NSTR=NSTR+1 | |
9920 | ENDIF | |
9921 | ||
9922 | C...Update remaining energy; iterate. | |
9923 | N=N+2 | |
9924 | IF(N.GT.MSTU(4)-MSTU(32)-10) THEN | |
ce320da8 | 9925 | CALL LUERRM(11,'(PYMULTA:) no more memory left in LUJETSA') |
0119ef9a | 9926 | IF(MSTU(21).GE.1) RETURN |
9927 | ENDIF | |
9928 | MINT(31)=MINT(31)+1 | |
9929 | VINT(151)=VINT(151)+VINT(41) | |
9930 | VINT(152)=VINT(152)+VINT(42) | |
9931 | VINT(143)=VINT(143)-VINT(41) | |
9932 | VINT(144)=VINT(144)-VINT(42) | |
9933 | IF(MINT(31).LT.240) GOTO 180 | |
9934 | 220 CONTINUE | |
9935 | ENDIF | |
9936 | ||
9937 | C...Format statements for printout. | |
ce320da8 | 9938 | 1000 FORMAT(/1X,'****** PYMULTA: initialization of multiple inter', |
0119ef9a | 9939 | &'actions for MSTP(82) =',I2,' ******') |
9940 | 1100 FORMAT(8X,'pT0 =',F5.2,' GeV gives sigma(parton-parton) =',1P, | |
9941 | &E9.2,' mb: rejected') | |
9942 | 1200 FORMAT(8X,'pT0 =',F5.2,' GeV gives sigma(parton-parton) =',1P, | |
9943 | &E9.2,' mb: accepted') | |
9944 | ||
9945 | RETURN | |
9946 | END | |
9947 | ||
9948 | C********************************************************************* | |
9949 | ||
ce320da8 | 9950 | SUBROUTINE PYREMNA(IPU1,IPU2) |
0119ef9a | 9951 | |
9952 | C...Adds on target remnants (one or two from each side) and | |
9953 | C...includes primordial kT. | |
9954 | COMMON/HPARNT/HIPR1(100),IHPR2(50),HINT1(100),IHNT2(50) | |
9955 | SAVE /HPARNT/ | |
9956 | COMMON/HSTRNG/NFP(300,15),PPHI(300,15),NFT(300,15),PTHI(300,15) | |
9957 | SAVE /HSTRNG/ | |
9958 | C...COMMON BLOCK FROM HIJING | |
9959 | COMMON/LUJETSA/N,K(9000,5),P(9000,5),V(9000,5) | |
9960 | SAVE /LUJETSA/ | |
9961 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
9962 | SAVE /LUDAT1A/ | |
9963 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
9964 | SAVE /LUDAT2A/ | |
9965 | COMMON/PYPARSA/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
9966 | SAVE /PYPARSA/ | |
9967 | COMMON/PYINT1A/MINT(400),VINT(400) | |
9968 | SAVE /PYINT1A/ | |
9969 | DIMENSION KFLCH(2),KFLSP(2),CHI(2),PMS(6),IS(2),ROBO(5) | |
9970 | ||
9971 | iq=0 | |
9972 | ipu=0 | |
9973 | shs=0. | |
9974 | jpt=0 | |
9975 | peh=0. | |
9976 | pzh=0. | |
9977 | pei=0. | |
9978 | pzi=0. | |
9979 | pz=0. | |
9980 | ||
9981 | C...Special case for lepton-lepton interaction. | |
9982 | IF(MINT(43).EQ.1) THEN | |
9983 | DO 100 JT=1,2 | |
9984 | I=MINT(83)+JT+2 | |
9985 | K(I,1)=21 | |
9986 | K(I,2)=K(I-2,2) | |
9987 | K(I,3)=I-2 | |
9988 | DO 100 J=1,5 | |
9989 | 100 P(I,J)=P(I-2,J) | |
9990 | ENDIF | |
9991 | ||
9992 | C...Find event type, set pointers. | |
9993 | IF(IPU1.EQ.0.AND.IPU2.EQ.0) RETURN | |
9994 | ISUB=MINT(1) | |
9995 | ILEP=0 | |
9996 | IF(IPU1.EQ.0) ILEP=1 | |
9997 | IF(IPU2.EQ.0) ILEP=2 | |
9998 | IF(ISUB.EQ.95) ILEP=-1 | |
9999 | IF(ILEP.EQ.1) IQ=MINT(84)+1 | |
10000 | IF(ILEP.EQ.2) IQ=MINT(84)+2 | |
10001 | IP=MAX(IPU1,IPU2) | |
10002 | ILEPR=MINT(83)+5-ILEP | |
10003 | NS=N | |
10004 | ||
10005 | C...Define initial partons, including primordial kT. | |
10006 | 110 DO 130 JT=1,2 | |
10007 | I=MINT(83)+JT+2 | |
10008 | IF(JT.EQ.1) IPU=IPU1 | |
10009 | IF(JT.EQ.2) IPU=IPU2 | |
10010 | K(I,1)=21 | |
10011 | K(I,3)=I-2 | |
10012 | IF(ISUB.EQ.95) THEN | |
10013 | K(I,2)=21 | |
10014 | SHS=0. | |
10015 | ELSEIF(MINT(40+JT).EQ.1.AND.IPU.NE.0) THEN | |
10016 | K(I,2)=K(IPU,2) | |
10017 | P(I,5)=P(IPU,5) | |
10018 | P(I,1)=0. | |
10019 | P(I,2)=0. | |
10020 | PMS(JT)=P(I,5)**2 | |
10021 | ELSEIF(IPU.NE.0) THEN | |
10022 | K(I,2)=K(IPU,2) | |
10023 | P(I,5)=P(IPU,5) | |
10024 | C...No primordial kT or chosen according to truncated Gaussian or | |
10025 | C...exponential. | |
10026 | C | |
10027 | c X.N. Wang (7.22.97) | |
10028 | c | |
10029 | RPT1=0.0 | |
10030 | RPT2=0.0 | |
10031 | ssw2=(PPHI(IHNT2(11),4)+PTHI(IHNT2(12),4))**2 | |
10032 | & -(PPHI(IHNT2(11),1)+PTHI(IHNT2(12),1))**2 | |
10033 | & -(PPHI(IHNT2(11),2)+PTHI(IHNT2(12),2))**2 | |
10034 | & -(PPHI(IHNT2(11),3)+PTHI(IHNT2(12),3))**2 | |
10035 | C | |
10036 | C********this is s of the current NN collision | |
10037 | IF(ssw2.LE.4.0*PARP(93)**2) GOTO 1211 | |
10038 | c | |
10039 | IF(IHPR2(5).LE.0) THEN | |
10040 | 120 IF(MSTP(91).LE.0) THEN | |
10041 | PT=0. | |
10042 | ELSEIF(MSTP(91).EQ.1) THEN | |
10043 | PT=PARP(91)*SQRT(-LOG(RLU(0))) | |
10044 | ELSE | |
10045 | RPT1=RLU(0) | |
10046 | RPT2=RLU(0) | |
10047 | PT=-PARP(92)*LOG(RPT1*RPT2) | |
10048 | ENDIF | |
10049 | IF(PT.GT.PARP(93)) GOTO 120 | |
10050 | PHI=PARU(2)*RLU(0) | |
10051 | RPT1=PT*COS(PHI) | |
10052 | RPT2=PT*SIN(PHI) | |
10053 | ELSE IF(IHPR2(5).EQ.1) THEN | |
10054 | IF(JT.EQ.1) JPT=NFP(IHNT2(11),11) | |
10055 | IF(JT.EQ.2) JPT=NFT(IHNT2(12),11) | |
10056 | 1205 PTGS=PARP(91)*SQRT(-LOG(RLU(0))) | |
10057 | IF(PTGS.GT.PARP(93)) GO TO 1205 | |
10058 | PHI=2.0*HIPR1(40)*RLU(0) | |
10059 | RPT1=PTGS*COS(PHI) | |
10060 | RPT2=PTGS*SIN(PHI) | |
10061 | DO 1210 iint=1,JPT-1 | |
10062 | PKCSQ=PARP(91)*SQRT(-LOG(RLU(0))) | |
10063 | PHI=2.0*HIPR1(40)*RLU(0) | |
10064 | RPT1=RPT1+PKCSQ*COS(PHI) | |
10065 | RPT2=RPT2+PKCSQ*SIN(PHI) | |
10066 | 1210 CONTINUE | |
10067 | IF(RPT1**2+RPT2**2.GE.ssw2/4.0) GO TO 1205 | |
10068 | ENDIF | |
10069 | C X.N. Wang | |
10070 | C ********When initial interaction among soft partons is | |
10071 | C assumed the primordial pt comes from the sum of | |
10072 | C pt of JPT-1 number of initial interaction, JPT | |
10073 | C is the number of interaction including present | |
10074 | C one that nucleon hassuffered | |
10075 | 1211 P(I,1)=RPT1 | |
10076 | P(I,2)=RPT2 | |
10077 | PMS(JT)=P(I,5)**2+P(I,1)**2+P(I,2)**2 | |
10078 | ELSE | |
10079 | K(I,2)=K(IQ,2) | |
10080 | Q2=VINT(52) | |
10081 | P(I,5)=-SQRT(Q2) | |
10082 | PMS(JT)=-Q2 | |
10083 | SHS=(1.-VINT(43-JT))*Q2/VINT(43-JT)+VINT(5-JT)**2 | |
10084 | ENDIF | |
10085 | 130 CONTINUE | |
10086 | ||
10087 | C...Kinematics construction for initial partons. | |
10088 | I1=MINT(83)+3 | |
10089 | I2=MINT(83)+4 | |
10090 | IF(ILEP.EQ.0) SHS=VINT(141)*VINT(142)*VINT(2)+ | |
10091 | &(P(I1,1)+P(I2,1))**2+(P(I1,2)+P(I2,2))**2 | |
10092 | SHR=SQRT(MAX(0.,SHS)) | |
10093 | IF(ILEP.EQ.0) THEN | |
10094 | IF((SHS-PMS(1)-PMS(2))**2-4.*PMS(1)*PMS(2).LE.0.) GOTO 110 | |
10095 | P(I1,4)=0.5*(SHR+(PMS(1)-PMS(2))/SHR) | |
10096 | P(I1,3)=SQRT(MAX(0.,P(I1,4)**2-PMS(1))) | |
10097 | P(I2,4)=SHR-P(I1,4) | |
10098 | P(I2,3)=-P(I1,3) | |
10099 | ELSEIF(ILEP.EQ.1) THEN | |
10100 | P(I1,4)=P(IQ,4) | |
10101 | P(I1,3)=P(IQ,3) | |
10102 | P(I2,4)=P(IP,4) | |
10103 | P(I2,3)=P(IP,3) | |
10104 | ELSEIF(ILEP.EQ.2) THEN | |
10105 | P(I1,4)=P(IP,4) | |
10106 | P(I1,3)=P(IP,3) | |
10107 | P(I2,4)=P(IQ,4) | |
10108 | P(I2,3)=P(IQ,3) | |
10109 | ENDIF | |
10110 | IF(MINT(43).EQ.1) RETURN | |
10111 | ||
10112 | C...Transform partons to overall CM-frame (not for leptoproduction). | |
10113 | IF(ILEP.EQ.0) THEN | |
10114 | ROBO(3)=(P(I1,1)+P(I2,1))/SHR | |
10115 | ROBO(4)=(P(I1,2)+P(I2,2))/SHR | |
10116 | CALL LUDBRB(I1,I2,0.,0.,-DBLE(ROBO(3)),-DBLE(ROBO(4)),0D0) | |
10117 | ROBO(2)=ULANGL(P(I1,1),P(I1,2)) | |
10118 | CALL LUDBRB(I1,I2,0.,-ROBO(2),0D0,0D0,0D0) | |
10119 | ROBO(1)=ULANGL(P(I1,3),P(I1,1)) | |
10120 | CALL LUDBRB(I1,I2,-ROBO(1),0.,0D0,0D0,0D0) | |
10121 | NMAX=MAX(MINT(52),IPU1,IPU2) | |
10122 | CALL LUDBRB(I1,NMAX,ROBO(1),ROBO(2),DBLE(ROBO(3)),DBLE(ROBO(4)), | |
10123 | & 0D0) | |
10124 | ROBO(5)=MAX(-0.999999,MIN(0.999999,(VINT(141)-VINT(142))/ | |
10125 | & (VINT(141)+VINT(142)))) | |
10126 | CALL LUDBRB(I1,NMAX,0.,0.,0D0,0D0,DBLE(ROBO(5))) | |
10127 | ENDIF | |
10128 | ||
10129 | C...Check invariant mass of remnant system: | |
10130 | C...hadronic events or leptoproduction. | |
10131 | IF(ILEP.LE.0) THEN | |
10132 | IF(MSTP(81).LE.0.OR.MSTP(82).LE.0.OR.ISUB.EQ.95) THEN | |
10133 | VINT(151)=0. | |
10134 | VINT(152)=0. | |
10135 | ENDIF | |
10136 | PEH=P(I1,4)+P(I2,4)+0.5*VINT(1)*(VINT(151)+VINT(152)) | |
10137 | PZH=P(I1,3)+P(I2,3)+0.5*VINT(1)*(VINT(151)-VINT(152)) | |
10138 | SHH=(VINT(1)-PEH)**2-(P(I1,1)+P(I2,1))**2-(P(I1,2)+P(I2,2))**2- | |
10139 | & PZH**2 | |
10140 | PMMIN=P(MINT(83)+1,5)+P(MINT(83)+2,5)+ULMASS(K(I1,2))+ | |
10141 | & ULMASS(K(I2,2)) | |
10142 | IF(SHR.GE.VINT(1).OR.SHH.LE.(PMMIN+PARP(111))**2) THEN | |
10143 | MINT(51)=1 | |
10144 | RETURN | |
10145 | ENDIF | |
10146 | SHR=SQRT(SHH+(P(I1,1)+P(I2,1))**2+(P(I1,2)+P(I2,2))**2) | |
10147 | ELSE | |
10148 | PEI=P(IQ,4)+P(IP,4) | |
10149 | PZI=P(IQ,3)+P(IP,3) | |
10150 | PMS(ILEP)=MAX(0.,PEI**2-PZI**2) | |
10151 | PMMIN=P(ILEPR-2,5)+ULMASS(K(ILEPR,2))+SQRT(PMS(ILEP)) | |
10152 | IF(SHR.LE.PMMIN+PARP(111)) THEN | |
10153 | MINT(51)=1 | |
10154 | RETURN | |
10155 | ENDIF | |
10156 | ENDIF | |
10157 | ||
10158 | C...Subdivide remnant if necessary, store first parton. | |
10159 | 140 I=NS | |
10160 | DO 190 JT=1,2 | |
10161 | IF(JT.EQ.ILEP) GOTO 190 | |
10162 | IF(JT.EQ.1) IPU=IPU1 | |
10163 | IF(JT.EQ.2) IPU=IPU2 | |
ce320da8 | 10164 | CALL PYSPLIA(MINT(10+JT),MINT(12+JT),KFLCH(JT),KFLSP(JT)) |
0119ef9a | 10165 | I=I+1 |
10166 | IS(JT)=I | |
10167 | DO 150 J=1,5 | |
10168 | K(I,J)=0 | |
10169 | P(I,J)=0. | |
10170 | 150 V(I,J)=0. | |
10171 | K(I,1)=3 | |
10172 | K(I,2)=KFLSP(JT) | |
10173 | K(I,3)=MINT(83)+JT | |
10174 | P(I,5)=ULMASS(K(I,2)) | |
10175 | ||
10176 | C...First parton colour connections and transverse mass. | |
10177 | KFLS=(3-KCHG(LUCOMP(KFLSP(JT)),2)*ISIGN(1,KFLSP(JT)))/2 | |
10178 | K(I,KFLS+3)=IPU | |
10179 | K(IPU,6-KFLS)=MOD(K(IPU,6-KFLS),MSTU(5))+MSTU(5)*I | |
10180 | IF(KFLCH(JT).EQ.0) THEN | |
10181 | P(I,1)=-P(MINT(83)+JT+2,1) | |
10182 | P(I,2)=-P(MINT(83)+JT+2,2) | |
10183 | PMS(JT)=P(I,5)**2+P(I,1)**2+P(I,2)**2 | |
10184 | ||
10185 | C...When extra remnant parton or hadron: find relative pT, store. | |
10186 | ELSE | |
10187 | CALL LUPTDI(1,P(I,1),P(I,2)) | |
10188 | PMS(JT+2)=P(I,5)**2+P(I,1)**2+P(I,2)**2 | |
10189 | I=I+1 | |
10190 | DO 160 J=1,5 | |
10191 | K(I,J)=0 | |
10192 | P(I,J)=0. | |
10193 | 160 V(I,J)=0. | |
10194 | K(I,1)=1 | |
10195 | K(I,2)=KFLCH(JT) | |
10196 | K(I,3)=MINT(83)+JT | |
10197 | P(I,5)=ULMASS(K(I,2)) | |
10198 | P(I,1)=-P(MINT(83)+JT+2,1)-P(I-1,1) | |
10199 | P(I,2)=-P(MINT(83)+JT+2,2)-P(I-1,2) | |
10200 | PMS(JT+4)=P(I,5)**2+P(I,1)**2+P(I,2)**2 | |
10201 | C...Relative distribution of energy for particle into two jets. | |
10202 | IMB=1 | |
10203 | IF(MOD(MINT(10+JT)/1000,10).NE.0) IMB=2 | |
10204 | IF(IABS(KFLCH(JT)).LE.10.OR.KFLCH(JT).EQ.21) THEN | |
10205 | CHIK=PARP(92+2*IMB) | |
10206 | IF(MSTP(92).LE.1) THEN | |
10207 | IF(IMB.EQ.1) CHI(JT)=RLU(0) | |
10208 | IF(IMB.EQ.2) CHI(JT)=1.-SQRT(RLU(0)) | |
10209 | ELSEIF(MSTP(92).EQ.2) THEN | |
10210 | CHI(JT)=1.-RLU(0)**(1./(1.+CHIK)) | |
10211 | ELSEIF(MSTP(92).EQ.3) THEN | |
10212 | CUT=2.*0.3/VINT(1) | |
10213 | 170 CHI(JT)=RLU(0)**2 | |
10214 | IF((CHI(JT)**2/(CHI(JT)**2+CUT**2))**0.25*(1.-CHI(JT))**CHIK | |
10215 | & .LT.RLU(0)) GOTO 170 | |
10216 | ELSE | |
10217 | CUT=2.*0.3/VINT(1) | |
10218 | CUTR=(1.+SQRT(1.+CUT**2))/CUT | |
10219 | 180 CHIR=CUT*CUTR**RLU(0) | |
10220 | CHI(JT)=(CHIR**2-CUT**2)/(2.*CHIR) | |
10221 | IF((1.-CHI(JT))**CHIK.LT.RLU(0)) GOTO 180 | |
10222 | ENDIF | |
10223 | C...Relative distribution of energy for particle into jet plus particle. | |
10224 | ELSE | |
10225 | IF(MSTP(92).LE.1) THEN | |
10226 | IF(IMB.EQ.1) CHI(JT)=RLU(0) | |
10227 | IF(IMB.EQ.2) CHI(JT)=1.-SQRT(RLU(0)) | |
10228 | ELSE | |
10229 | CHI(JT)=1.-RLU(0)**(1./(1.+PARP(93+2*IMB))) | |
10230 | ENDIF | |
10231 | IF(MOD(KFLCH(JT)/1000,10).NE.0) CHI(JT)=1.-CHI(JT) | |
10232 | ENDIF | |
10233 | PMS(JT)=PMS(JT+4)/CHI(JT)+PMS(JT+2)/(1.-CHI(JT)) | |
10234 | KFLS=KCHG(LUCOMP(KFLCH(JT)),2)*ISIGN(1,KFLCH(JT)) | |
10235 | IF(KFLS.NE.0) THEN | |
10236 | K(I,1)=3 | |
10237 | KFLS=(3-KFLS)/2 | |
10238 | K(I,KFLS+3)=IPU | |
10239 | K(IPU,6-KFLS)=MOD(K(IPU,6-KFLS),MSTU(5))+MSTU(5)*I | |
10240 | ENDIF | |
10241 | ENDIF | |
10242 | 190 CONTINUE | |
10243 | IF(SHR.LE.SQRT(PMS(1))+SQRT(PMS(2))) GOTO 140 | |
10244 | N=I | |
10245 | ||
10246 | C...Reconstruct kinematics of remnants. | |
10247 | DO 200 JT=1,2 | |
10248 | IF(JT.EQ.ILEP) GOTO 200 | |
10249 | PE=0.5*(SHR+(PMS(JT)-PMS(3-JT))/SHR) | |
10250 | PZ=SQRT(PE**2-PMS(JT)) | |
10251 | IF(KFLCH(JT).EQ.0) THEN | |
10252 | P(IS(JT),4)=PE | |
10253 | P(IS(JT),3)=PZ*(-1)**(JT-1) | |
10254 | ELSE | |
10255 | PW1=CHI(JT)*(PE+PZ) | |
10256 | P(IS(JT)+1,4)=0.5*(PW1+PMS(JT+4)/PW1) | |
10257 | P(IS(JT)+1,3)=0.5*(PW1-PMS(JT+4)/PW1)*(-1)**(JT-1) | |
10258 | P(IS(JT),4)=PE-P(IS(JT)+1,4) | |
10259 | P(IS(JT),3)=PZ*(-1)**(JT-1)-P(IS(JT)+1,3) | |
10260 | ENDIF | |
10261 | 200 CONTINUE | |
10262 | ||
10263 | C...Hadronic events: boost remnants to correct longitudinal frame. | |
10264 | IF(ILEP.LE.0) THEN | |
10265 | CALL LUDBRB(NS+1,N,0.,0.,0D0,0D0,-DBLE(PZH/(VINT(1)-PEH))) | |
10266 | C...Leptoproduction events: boost colliding subsystem. | |
10267 | ELSE | |
10268 | NMAX=MAX(IP,MINT(52)) | |
10269 | PEF=SHR-PE | |
10270 | PZF=PZ*(-1)**(ILEP-1) | |
10271 | PT2=P(ILEPR,1)**2+P(ILEPR,2)**2 | |
10272 | PHIPT=ULANGL(P(ILEPR,1),P(ILEPR,2)) | |
10273 | CALL LUDBRB(MINT(84)+1,NMAX,0.,-PHIPT,0D0,0D0,0D0) | |
10274 | RQP=P(IQ,3)*(PT2+PEI**2)-P(IQ,4)*PEI*PZI | |
10275 | SINTH=P(IQ,4)*SQRT(PT2*(PT2+PEI**2)/(RQP**2+PT2* | |
10276 | & P(IQ,4)**2*PZI**2))*SIGN(1.,-RQP) | |
10277 | CALL LUDBRB(MINT(84)+1,NMAX,ASIN(SINTH),0.,0D0,0D0,0D0) | |
10278 | BETAX=(-PEI*PZI*SINTH+SQRT(PT2*(PT2+PEI**2-(PZI*SINTH)**2)))/ | |
10279 | & (PT2+PEI**2) | |
10280 | CALL LUDBRB(MINT(84)+1,NMAX,0.,0.,DBLE(BETAX),0D0,0D0) | |
10281 | CALL LUDBRB(MINT(84)+1,NMAX,0.,PHIPT,0D0,0D0,0D0) | |
10282 | PEM=P(IQ,4)+P(IP,4) | |
10283 | PZM=P(IQ,3)+P(IP,3) | |
10284 | BETAZ=(-PEM*PZM+PZF*SQRT(PZF**2+PEM**2-PZM**2))/(PZF**2+PEM**2) | |
10285 | CALL LUDBRB(MINT(84)+1,NMAX,0.,0.,0D0,0D0,DBLE(BETAZ)) | |
10286 | CALL LUDBRB(I1,I2,ASIN(SINTH),0.,DBLE(BETAX),0D0,0D0) | |
10287 | CALL LUDBRB(I1,I2,0.,PHIPT,0D0,0D0,DBLE(BETAZ)) | |
10288 | ENDIF | |
10289 | ||
10290 | RETURN | |
10291 | END | |
10292 | ||
10293 | C********************************************************************* | |
10294 | ||
ce320da8 | 10295 | SUBROUTINE PYRESDA |
0119ef9a | 10296 | |
10297 | C...Allows resonances to decay (including parton showers for hadronic | |
10298 | C...channels). | |
10299 | IMPLICIT DOUBLE PRECISION(D) | |
10300 | COMMON/LUJETSA/N,K(9000,5),P(9000,5),V(9000,5) | |
10301 | SAVE /LUJETSA/ | |
10302 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
10303 | SAVE /LUDAT1A/ | |
10304 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
10305 | SAVE /LUDAT2A/ | |
10306 | COMMON/LUDAT3A/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) | |
10307 | SAVE /LUDAT3A/ | |
10308 | COMMON/PYSUBSA/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200) | |
10309 | SAVE /PYSUBSA/ | |
10310 | COMMON/PYPARSA/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
10311 | SAVE /PYPARSA/ | |
10312 | COMMON/PYINT1A/MINT(400),VINT(400) | |
10313 | SAVE /PYINT1A/ | |
10314 | COMMON/PYINT2A/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2) | |
10315 | SAVE /PYINT2A/ | |
10316 | COMMON/PYINT4AA/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3) | |
10317 | SAVE /PYINT4AA/ | |
10318 | DIMENSION IREF(10,6),KDCY(2),KFL1(2),KFL2(2),NSD(2),ILIN(6), | |
10319 | &COUP(6,4),PK(6,4),PKK(6,6),CTHE(2),PHI(2),WDTP(0:40), | |
10320 | &WDTE(0:40,0:5) | |
10321 | COMPLEX FGK,HA(6,6),HC(6,6) | |
10322 | ||
10323 | C...The F, Xi and Xj functions of Gunion and Kunszt | |
10324 | C...(Phys. Rev. D33, 665, plus errata from the authors). | |
10325 | FGK(I1,I2,I3,I4,I5,I6)=4.*HA(I1,I3)*HC(I2,I6)*(HA(I1,I5)* | |
10326 | &HC(I1,I4)+HA(I3,I5)*HC(I3,I4)) | |
10327 | DIGK(DT,DU)=-4.d0*D34*D56+DT*(3.d0*DT+4.d0*DU) | |
10328 | & +DT**2*(DT*DU/(D34*D56)- | |
10329 | &2.d0*(1.d0/D34+1.d0/D56)*(DT+DU)+2.d0*(D34/D56+D56/D34)) | |
10330 | DJGK(DT,DU)=8.d0*(D34+D56)**2-8.d0*(D34+D56)*(DT+DU)-6.d0*DT*DU- | |
10331 | &2.d0*DT*DU*(DT*DU/(D34*D56)-2.d0*(1.d0/D34+1.d0/D56)*(DT+DU)+ | |
10332 | &2.d0*(D34/D56+D56/D34)) | |
10333 | ||
10334 | i12=0 | |
10335 | wt=0. | |
10336 | wtmax=0. | |
10337 | ||
10338 | C...Define initial two objects, initialize loop. | |
10339 | ISUB=MINT(1) | |
10340 | SH=VINT(44) | |
10341 | IREF(1,5)=0 | |
10342 | IREF(1,6)=0 | |
10343 | IF(ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.3) THEN | |
10344 | IREF(1,1)=MINT(84)+2+ISET(ISUB) | |
10345 | IREF(1,2)=0 | |
10346 | IREF(1,3)=MINT(83)+6+ISET(ISUB) | |
10347 | IREF(1,4)=0 | |
10348 | ELSEIF(ISET(ISUB).EQ.2.OR.ISET(ISUB).EQ.4) THEN | |
10349 | IREF(1,1)=MINT(84)+1+ISET(ISUB) | |
10350 | IREF(1,2)=MINT(84)+2+ISET(ISUB) | |
10351 | IREF(1,3)=MINT(83)+5+ISET(ISUB) | |
10352 | IREF(1,4)=MINT(83)+6+ISET(ISUB) | |
10353 | ENDIF | |
10354 | NP=1 | |
10355 | IP=0 | |
10356 | 100 IP=IP+1 | |
10357 | NINH=0 | |
10358 | ||
10359 | C...Loop over one/two resonances; reset decay rates. | |
10360 | JTMAX=2 | |
10361 | IF(IP.EQ.1.AND.(ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.3)) JTMAX=1 | |
10362 | DO 140 JT=1,JTMAX | |
10363 | KDCY(JT)=0 | |
10364 | KFL1(JT)=0 | |
10365 | KFL2(JT)=0 | |
10366 | NSD(JT)=IREF(IP,JT) | |
10367 | ID=IREF(IP,JT) | |
10368 | IF(ID.EQ.0) GOTO 140 | |
10369 | KFA=IABS(K(ID,2)) | |
10370 | IF(KFA.LT.23.OR.KFA.GT.40) GOTO 140 | |
10371 | IF(MDCY(KFA,1).NE.0) THEN | |
10372 | IF(ISUB.EQ.1.OR.ISUB.EQ.141) MINT(61)=1 | |
ce320da8 | 10373 | CALL PYWIDTA(KFA,P(ID,5),WDTP,WDTE) |
0119ef9a | 10374 | IF(KCHG(KFA,3).EQ.0) THEN |
10375 | IPM=2 | |
10376 | ELSE | |
10377 | IPM=(5+ISIGN(1,K(ID,2)))/2 | |
10378 | ENDIF | |
10379 | IF(JTMAX.EQ.1.OR.IABS(K(IREF(IP,1),2)).NE.IABS(K(IREF(IP,2),2))) | |
10380 | & THEN | |
10381 | I12=4 | |
10382 | ELSE | |
10383 | IF(JT.EQ.1) I12=INT(4.5+RLU(0)) | |
10384 | I12=9-I12 | |
10385 | ENDIF | |
10386 | RKFL=(WDTE(0,1)+WDTE(0,IPM)+WDTE(0,I12))*RLU(0) | |
10387 | DO 120 I=1,MDCY(KFA,3) | |
10388 | IDC=I+MDCY(KFA,2)-1 | |
10389 | KFL1(JT)=KFDP(IDC,1)*ISIGN(1,K(ID,2)) | |
10390 | KFL2(JT)=KFDP(IDC,2)*ISIGN(1,K(ID,2)) | |
10391 | RKFL=RKFL-(WDTE(I,1)+WDTE(I,IPM)+WDTE(I,I12)) | |
10392 | IF(RKFL.LE.0.) GOTO 130 | |
10393 | 120 CONTINUE | |
10394 | 130 CONTINUE | |
10395 | ENDIF | |
10396 | ||
10397 | C...Summarize result on decay channel chosen. | |
10398 | IF((KFA.EQ.23.OR.KFA.EQ.24).AND.KFL1(JT).EQ.0) NINH=NINH+1 | |
10399 | IF(KFL1(JT).EQ.0) GOTO 140 | |
10400 | KDCY(JT)=2 | |
10401 | IF(IABS(KFL1(JT)).LE.10.OR.KFL1(JT).EQ.21) KDCY(JT)=1 | |
10402 | IF((IABS(KFL1(JT)).GE.23.AND.IABS(KFL1(JT)).LE.25).OR. | |
10403 | &(IABS(KFL1(JT)).EQ.37)) KDCY(JT)=3 | |
10404 | NSD(JT)=N | |
10405 | ||
10406 | C...Fill decay products, prepared for parton showers for quarks. | |
10407 | clin-8/19/02 avoid actual argument in common blocks of LU2ENT: | |
10408 | pid5=P(ID,5) | |
10409 | IF(KDCY(JT).EQ.1) THEN | |
10410 | c CALL LU2ENT(-(N+1),KFL1(JT),KFL2(JT),P(ID,5)) | |
10411 | CALL LU2ENT(-(N+1),KFL1(JT),KFL2(JT),pid5) | |
10412 | ELSE | |
10413 | c CALL LU2ENT(N+1,KFL1(JT),KFL2(JT),P(ID,5)) | |
10414 | CALL LU2ENT(N+1,KFL1(JT),KFL2(JT),pid5) | |
10415 | ENDIF | |
10416 | ||
10417 | IF(JTMAX.EQ.1) THEN | |
10418 | CTHE(JT)=VINT(13)+(VINT(33)-VINT(13)+VINT(34)-VINT(14))*RLU(0) | |
10419 | IF(CTHE(JT).GT.VINT(33)) CTHE(JT)=CTHE(JT)+VINT(14)-VINT(33) | |
10420 | PHI(JT)=VINT(24) | |
10421 | ELSE | |
10422 | CTHE(JT)=2.*RLU(0)-1. | |
10423 | PHI(JT)=PARU(2)*RLU(0) | |
10424 | ENDIF | |
10425 | 140 CONTINUE | |
10426 | IF(MINT(3).EQ.1.AND.IP.EQ.1) THEN | |
10427 | MINT(25)=KFL1(1) | |
10428 | MINT(26)=KFL2(1) | |
10429 | ENDIF | |
10430 | IF(JTMAX.EQ.1.AND.KDCY(1).EQ.0) GOTO 530 | |
10431 | IF(JTMAX.EQ.2.AND.KDCY(1).EQ.0.AND.KDCY(2).EQ.0) GOTO 530 | |
10432 | IF(MSTP(45).LE.0.OR.IREF(IP,2).EQ.0.OR.NINH.GE.1) GOTO 500 | |
10433 | IF(K(IREF(1,1),2).EQ.25.AND.IP.EQ.1) GOTO 500 | |
10434 | IF(K(IREF(1,1),2).EQ.25.AND.KDCY(1)*KDCY(2).EQ.0) GOTO 500 | |
10435 | ||
10436 | C...Order incoming partons and outgoing resonances. | |
10437 | ILIN(1)=MINT(84)+1 | |
10438 | IF(K(MINT(84)+1,2).GT.0) ILIN(1)=MINT(84)+2 | |
10439 | IF(K(ILIN(1),2).EQ.21) ILIN(1)=2*MINT(84)+3-ILIN(1) | |
10440 | ILIN(2)=2*MINT(84)+3-ILIN(1) | |
10441 | IMIN=1 | |
10442 | IF(IREF(IP,5).EQ.25) IMIN=3 | |
10443 | IMAX=2 | |
10444 | IORD=1 | |
10445 | IF(K(IREF(IP,1),2).EQ.23) IORD=2 | |
10446 | IF(K(IREF(IP,1),2).EQ.24.AND.K(IREF(IP,2),2).EQ.-24) IORD=2 | |
10447 | IF(IABS(K(IREF(IP,IORD),2)).EQ.25) IORD=3-IORD | |
10448 | IF(KDCY(IORD).EQ.0) IORD=3-IORD | |
10449 | ||
10450 | C...Order decay products of resonances. | |
10451 | DO 390 JT=IORD,3-IORD,3-2*IORD | |
10452 | IF(KDCY(JT).EQ.0) THEN | |
10453 | ILIN(IMAX+1)=NSD(JT) | |
10454 | IMAX=IMAX+1 | |
10455 | ELSEIF(K(NSD(JT)+1,2).GT.0) THEN | |
10456 | ILIN(IMAX+1)=N+2*JT-1 | |
10457 | ILIN(IMAX+2)=N+2*JT | |
10458 | IMAX=IMAX+2 | |
10459 | K(N+2*JT-1,2)=K(NSD(JT)+1,2) | |
10460 | K(N+2*JT,2)=K(NSD(JT)+2,2) | |
10461 | ELSE | |
10462 | ILIN(IMAX+1)=N+2*JT | |
10463 | ILIN(IMAX+2)=N+2*JT-1 | |
10464 | IMAX=IMAX+2 | |
10465 | K(N+2*JT-1,2)=K(NSD(JT)+1,2) | |
10466 | K(N+2*JT,2)=K(NSD(JT)+2,2) | |
10467 | ENDIF | |
10468 | 390 CONTINUE | |
10469 | ||
10470 | C...Find charge, isospin, left- and righthanded couplings. | |
10471 | XW=PARU(102) | |
10472 | DO 410 I=IMIN,IMAX | |
10473 | DO 400 J=1,4 | |
10474 | 400 COUP(I,J)=0. | |
10475 | KFA=IABS(K(ILIN(I),2)) | |
10476 | IF(KFA.GT.20) GOTO 410 | |
10477 | COUP(I,1)=LUCHGE(KFA)/3. | |
10478 | COUP(I,2)=(-1)**MOD(KFA,2) | |
10479 | COUP(I,4)=-2.*COUP(I,1)*XW | |
10480 | COUP(I,3)=COUP(I,2)+COUP(I,4) | |
10481 | 410 CONTINUE | |
10482 | SQMZ=PMAS(23,1)**2 | |
10483 | GZMZ=PMAS(23,1)*PMAS(23,2) | |
10484 | SQMW=PMAS(24,1)**2 | |
10485 | GZMW=PMAS(24,1)*PMAS(24,2) | |
10486 | SQMZP=PMAS(32,1)**2 | |
10487 | GZMZP=PMAS(32,1)*PMAS(32,2) | |
10488 | ||
10489 | C...Select random angles; construct massless four-vectors. | |
10490 | 420 DO 430 I=N+1,N+4 | |
10491 | K(I,1)=1 | |
10492 | DO 430 J=1,5 | |
10493 | 430 P(I,J)=0. | |
10494 | DO 440 JT=1,JTMAX | |
10495 | IF(KDCY(JT).EQ.0) GOTO 440 | |
10496 | ID=IREF(IP,JT) | |
10497 | P(N+2*JT-1,3)=0.5*P(ID,5) | |
10498 | P(N+2*JT-1,4)=0.5*P(ID,5) | |
10499 | P(N+2*JT,3)=-0.5*P(ID,5) | |
10500 | P(N+2*JT,4)=0.5*P(ID,5) | |
10501 | CTHE(JT)=2.*RLU(0)-1. | |
10502 | PHI(JT)=PARU(2)*RLU(0) | |
10503 | CALL LUDBRB(N+2*JT-1,N+2*JT,ACOS(CTHE(JT)),PHI(JT), | |
10504 | &DBLE(P(ID,1)/P(ID,4)),DBLE(P(ID,2)/P(ID,4)),DBLE(P(ID,3)/P(ID,4))) | |
10505 | 440 CONTINUE | |
10506 | ||
10507 | C...Store incoming and outgoing momenta, with random rotation to | |
10508 | C...avoid accidental zeroes in HA expressions. | |
10509 | DO 450 I=1,IMAX | |
10510 | K(N+4+I,1)=1 | |
10511 | P(N+4+I,4)=SQRT(P(ILIN(I),1)**2+P(ILIN(I),2)**2+P(ILIN(I),3)**2+ | |
10512 | &P(ILIN(I),5)**2) | |
10513 | P(N+4+I,5)=P(ILIN(I),5) | |
10514 | DO 450 J=1,3 | |
10515 | 450 P(N+4+I,J)=P(ILIN(I),J) | |
10516 | THERR=ACOS(2.*RLU(0)-1.) | |
10517 | PHIRR=PARU(2)*RLU(0) | |
10518 | CALL LUDBRB(N+5,N+4+IMAX,THERR,PHIRR,0D0,0D0,0D0) | |
10519 | DO 460 I=1,IMAX | |
10520 | DO 460 J=1,4 | |
10521 | 460 PK(I,J)=P(N+4+I,J) | |
10522 | ||
10523 | C...Calculate internal products. | |
10524 | IF(ISUB.EQ.22.OR.ISUB.EQ.23.OR.ISUB.EQ.25) THEN | |
10525 | DO 470 I1=IMIN,IMAX-1 | |
10526 | DO 470 I2=I1+1,IMAX | |
10527 | HA(I1,I2)=SQRT((PK(I1,4)-PK(I1,3))*(PK(I2,4)+PK(I2,3))/ | |
10528 | & (1E-20+PK(I1,1)**2+PK(I1,2)**2))*CMPLX(PK(I1,1),PK(I1,2))- | |
10529 | & SQRT((PK(I1,4)+PK(I1,3))*(PK(I2,4)-PK(I2,3))/ | |
10530 | & (1E-20+PK(I2,1)**2+PK(I2,2)**2))*CMPLX(PK(I2,1),PK(I2,2)) | |
10531 | HC(I1,I2)=CONJG(HA(I1,I2)) | |
10532 | IF(I1.LE.2) HA(I1,I2)=CMPLX(0.,1.)*HA(I1,I2) | |
10533 | IF(I1.LE.2) HC(I1,I2)=CMPLX(0.,1.)*HC(I1,I2) | |
10534 | HA(I2,I1)=-HA(I1,I2) | |
10535 | 470 HC(I2,I1)=-HC(I1,I2) | |
10536 | ENDIF | |
10537 | DO 480 I=1,2 | |
10538 | DO 480 J=1,4 | |
10539 | 480 PK(I,J)=-PK(I,J) | |
10540 | DO 490 I1=IMIN,IMAX-1 | |
10541 | DO 490 I2=I1+1,IMAX | |
10542 | PKK(I1,I2)=2.*(PK(I1,4)*PK(I2,4)-PK(I1,1)*PK(I2,1)- | |
10543 | &PK(I1,2)*PK(I2,2)-PK(I1,3)*PK(I2,3)) | |
10544 | 490 PKK(I2,I1)=PKK(I1,I2) | |
10545 | ||
10546 | IF(IREF(IP,5).EQ.25) THEN | |
10547 | C...Angular weight for H0 -> Z0 + Z0 or W+ + W- -> 4 quarks/leptons | |
10548 | WT=16.*PKK(3,5)*PKK(4,6) | |
10549 | IF(IP.EQ.1) WTMAX=SH**2 | |
10550 | IF(IP.GE.2) WTMAX=P(IREF(IP,6),5)**4 | |
10551 | ||
10552 | ELSEIF(ISUB.EQ.1) THEN | |
10553 | IF(KFA.NE.37) THEN | |
10554 | C...Angular weight for gamma*/Z0 -> 2 quarks/leptons | |
10555 | EI=KCHG(IABS(MINT(15)),1)/3. | |
10556 | AI=SIGN(1.,EI+0.1) | |
10557 | VI=AI-4.*EI*XW | |
10558 | EF=KCHG(KFA,1)/3. | |
10559 | AF=SIGN(1.,EF+0.1) | |
10560 | VF=AF-4.*EF*XW | |
10561 | GG=1. | |
10562 | GZ=1./(8.*XW*(1.-XW))*SH*(SH-SQMZ)/((SH-SQMZ)**2+GZMZ**2) | |
10563 | ZZ=1./(16.*XW*(1.-XW))**2*SH**2/((SH-SQMZ)**2+GZMZ**2) | |
10564 | IF(MSTP(43).EQ.1) THEN | |
10565 | C...Only gamma* production included | |
10566 | GZ=0. | |
10567 | ZZ=0. | |
10568 | ELSEIF(MSTP(43).EQ.2) THEN | |
10569 | C...Only Z0 production included | |
10570 | GG=0. | |
10571 | GZ=0. | |
10572 | ENDIF | |
10573 | ASYM=2.*(EI*AI*GZ*EF*AF+4.*VI*AI*ZZ*VF*AF)/(EI**2*GG*EF**2+ | |
10574 | & EI*VI*GZ*EF*VF+(VI**2+AI**2)*ZZ*(VF**2+AF**2)) | |
10575 | WT=1.+ASYM*CTHE(JT)+CTHE(JT)**2 | |
10576 | WTMAX=2.+ABS(ASYM) | |
10577 | ELSE | |
10578 | C...Angular weight for gamma*/Z0 -> H+ + H- | |
10579 | WT=1.-CTHE(JT)**2 | |
10580 | WTMAX=1. | |
10581 | ENDIF | |
10582 | ||
10583 | ELSEIF(ISUB.EQ.2) THEN | |
10584 | C...Angular weight for W+/- -> 2 quarks/leptons | |
10585 | WT=(1.+CTHE(JT))**2 | |
10586 | WTMAX=4. | |
10587 | ||
10588 | ELSEIF(ISUB.EQ.15.OR.ISUB.EQ.19) THEN | |
10589 | C...Angular weight for f + fb -> gluon/gamma + Z0 -> | |
10590 | C...-> gluon/gamma + 2 quarks/leptons | |
10591 | WT=((COUP(1,3)*COUP(3,3))**2+(COUP(1,4)*COUP(3,4))**2)* | |
10592 | & (PKK(1,3)**2+PKK(2,4)**2)+((COUP(1,3)*COUP(3,4))**2+ | |
10593 | & (COUP(1,4)*COUP(3,3))**2)*(PKK(1,4)**2+PKK(2,3)**2) | |
10594 | WTMAX=(COUP(1,3)**2+COUP(1,4)**2)*(COUP(3,3)**2+COUP(3,4)**2)* | |
10595 | & ((PKK(1,3)+PKK(1,4))**2+(PKK(2,3)+PKK(2,4))**2) | |
10596 | ||
10597 | ELSEIF(ISUB.EQ.16.OR.ISUB.EQ.20) THEN | |
10598 | C...Angular weight for f + fb' -> gluon/gamma + W+/- -> | |
10599 | C...-> gluon/gamma + 2 quarks/leptons | |
10600 | WT=PKK(1,3)**2+PKK(2,4)**2 | |
10601 | WTMAX=(PKK(1,3)+PKK(1,4))**2+(PKK(2,3)+PKK(2,4))**2 | |
10602 | ||
10603 | ELSEIF(ISUB.EQ.22) THEN | |
10604 | C...Angular weight for f + fb -> Z0 + Z0 -> 4 quarks/leptons | |
10605 | S34=P(IREF(IP,IORD),5)**2 | |
10606 | S56=P(IREF(IP,3-IORD),5)**2 | |
10607 | TI=PKK(1,3)+PKK(1,4)+S34 | |
10608 | UI=PKK(1,5)+PKK(1,6)+S56 | |
10609 | WT=COUP(1,3)**4*((COUP(3,3)*COUP(5,3)*ABS(FGK(1,2,3,4,5,6)/ | |
10610 | & TI+FGK(1,2,5,6,3,4)/UI))**2+(COUP(3,4)*COUP(5,3)*ABS( | |
10611 | & FGK(1,2,4,3,5,6)/TI+FGK(1,2,5,6,4,3)/UI))**2+(COUP(3,3)* | |
10612 | & COUP(5,4)*ABS(FGK(1,2,3,4,6,5)/TI+FGK(1,2,6,5,3,4)/UI))**2+ | |
10613 | & (COUP(3,4)*COUP(5,4)*ABS(FGK(1,2,4,3,6,5)/TI+FGK(1,2,6,5,4,3)/ | |
10614 | & UI))**2)+COUP(1,4)**4*((COUP(3,3)*COUP(5,3)*ABS( | |
10615 | & FGK(2,1,5,6,3,4)/TI+FGK(2,1,3,4,5,6)/UI))**2+(COUP(3,4)* | |
10616 | & COUP(5,3)*ABS(FGK(2,1,6,5,3,4)/TI+FGK(2,1,3,4,6,5)/UI))**2+ | |
10617 | & (COUP(3,3)*COUP(5,4)*ABS(FGK(2,1,5,6,4,3)/TI+FGK(2,1,4,3,5,6)/ | |
10618 | & UI))**2+(COUP(3,4)*COUP(5,4)*ABS(FGK(2,1,6,5,4,3)/TI+ | |
10619 | & FGK(2,1,4,3,6,5)/UI))**2) | |
10620 | WTMAX=4.*S34*S56*(COUP(1,3)**4+COUP(1,4)**4)*(COUP(3,3)**2+ | |
10621 | & COUP(3,4)**2)*(COUP(5,3)**2+COUP(5,4)**2)*4.*(TI/UI+UI/TI+ | |
10622 | & 2.*SH*(S34+S56)/(TI*UI)-S34*S56*(1./TI**2+1./UI**2)) | |
10623 | ||
10624 | ELSEIF(ISUB.EQ.23) THEN | |
10625 | C...Angular weight for f + fb' -> Z0 + W +/- -> 4 quarks/leptons | |
10626 | D34=dble(P(IREF(IP,IORD),5)**2) | |
10627 | D56=dble(P(IREF(IP,3-IORD),5)**2) | |
10628 | DT=dble(PKK(1,3)+PKK(1,4))+D34 | |
10629 | DU=dble(PKK(1,5)+PKK(1,6))+D56 | |
10630 | CAWZ=COUP(2,3)/SNGL(DT)-2.*(1.-XW)*COUP(1,2)/(SH-SQMW) | |
10631 | CBWZ=COUP(1,3)/SNGL(DU)+2.*(1.-XW)*COUP(1,2)/(SH-SQMW) | |
10632 | WT=COUP(5,3)**2*ABS(CAWZ*FGK(1,2,3,4,5,6)+CBWZ* | |
10633 | & FGK(1,2,5,6,3,4))**2+COUP(5,4)**2*ABS(CAWZ* | |
10634 | & FGK(1,2,3,4,6,5)+CBWZ*FGK(1,2,6,5,3,4))**2 | |
10635 | WTMAX=4.*sngl(D34*D56)*(COUP(5,3)**2+COUP(5,4)**2)*(CAWZ**2* | |
10636 | & sngl(DIGK(DT,DU))+CBWZ**2*sngl(DIGK(DU,DT)) | |
10637 | & +CAWZ*CBWZ*sngl(DJGK(DT,DU))) | |
10638 | ||
10639 | ELSEIF(ISUB.EQ.24) THEN | |
10640 | C...Angular weight for f + fb -> Z0 + H0 -> 2 quarks/leptons + H0 | |
10641 | WT=((COUP(1,3)*COUP(3,3))**2+(COUP(1,4)*COUP(3,4))**2)* | |
10642 | & PKK(1,3)*PKK(2,4)+((COUP(1,3)*COUP(3,4))**2+(COUP(1,4)* | |
10643 | & COUP(3,3))**2)*PKK(1,4)*PKK(2,3) | |
10644 | WTMAX=(COUP(1,3)**2+COUP(1,4)**2)*(COUP(3,3)**2+COUP(3,4)**2)* | |
10645 | & (PKK(1,3)+PKK(1,4))*(PKK(2,3)+PKK(2,4)) | |
10646 | ||
10647 | ELSEIF(ISUB.EQ.25) THEN | |
10648 | C...Angular weight for f + fb -> W+ + W- -> 4 quarks/leptons | |
10649 | D34=dble(P(IREF(IP,IORD),5)**2) | |
10650 | D56=dble(P(IREF(IP,3-IORD),5)**2) | |
10651 | DT=dble(PKK(1,3)+PKK(1,4))+D34 | |
10652 | DU=dble(PKK(1,5)+PKK(1,6))+D56 | |
10653 | CDWW=(COUP(1,3)*SQMZ/(SH-SQMZ)+COUP(1,2))/SH | |
10654 | CAWW=CDWW+0.5*(COUP(1,2)+1.)/SNGL(DT) | |
10655 | CBWW=CDWW+0.5*(COUP(1,2)-1.)/SNGL(DU) | |
10656 | CCWW=COUP(1,4)*SQMZ/(SH-SQMZ)/SH | |
10657 | WT=ABS(CAWW*FGK(1,2,3,4,5,6)-CBWW*FGK(1,2,5,6,3,4))**2+ | |
10658 | & CCWW**2*ABS(FGK(2,1,5,6,3,4)-FGK(2,1,3,4,5,6))**2 | |
10659 | WTMAX=4.*sngl(D34*D56)*(CAWW**2*sngl(DIGK(DT,DU)) | |
10660 | & +CBWW**2*sngl(DIGK(DU,DT))-CAWW*CBWW*sngl(DJGK(DT,DU)) | |
10661 | & +CCWW**2*sngl(DIGK(DT,DU)+DIGK(DU,DT)-DJGK(DT,DU))) | |
10662 | ||
10663 | ELSEIF(ISUB.EQ.26) THEN | |
10664 | C...Angular weight for f + fb' -> W+/- + H0 -> 2 quarks/leptons + H0 | |
10665 | WT=PKK(1,3)*PKK(2,4) | |
10666 | WTMAX=(PKK(1,3)+PKK(1,4))*(PKK(2,3)+PKK(2,4)) | |
10667 | ||
10668 | ELSEIF(ISUB.EQ.30) THEN | |
10669 | C...Angular weight for f + g -> f + Z0 -> f + 2 quarks/leptons | |
10670 | IF(K(ILIN(1),2).GT.0) WT=((COUP(1,3)*COUP(3,3))**2+ | |
10671 | & (COUP(1,4)*COUP(3,4))**2)*(PKK(1,4)**2+PKK(3,5)**2)+ | |
10672 | & ((COUP(1,3)*COUP(3,4))**2+(COUP(1,4)*COUP(3,3))**2)* | |
10673 | & (PKK(1,3)**2+PKK(4,5)**2) | |
10674 | IF(K(ILIN(1),2).LT.0) WT=((COUP(1,3)*COUP(3,3))**2+ | |
10675 | & (COUP(1,4)*COUP(3,4))**2)*(PKK(1,3)**2+PKK(4,5)**2)+ | |
10676 | & ((COUP(1,3)*COUP(3,4))**2+(COUP(1,4)*COUP(3,3))**2)* | |
10677 | & (PKK(1,4)**2+PKK(3,5)**2) | |
10678 | WTMAX=(COUP(1,3)**2+COUP(1,4)**2)*(COUP(3,3)**2+COUP(3,4)**2)* | |
10679 | & ((PKK(1,3)+PKK(1,4))**2+(PKK(3,5)+PKK(4,5))**2) | |
10680 | ||
10681 | ELSEIF(ISUB.EQ.31) THEN | |
10682 | C...Angular weight for f + g -> f' + W+/- -> f' + 2 quarks/leptons | |
10683 | IF(K(ILIN(1),2).GT.0) WT=PKK(1,4)**2+PKK(3,5)**2 | |
10684 | IF(K(ILIN(1),2).LT.0) WT=PKK(1,3)**2+PKK(4,5)**2 | |
10685 | WTMAX=(PKK(1,3)+PKK(1,4))**2+(PKK(3,5)+PKK(4,5))**2 | |
10686 | ||
10687 | ELSEIF(ISUB.EQ.141) THEN | |
10688 | C...Angular weight for gamma*/Z0/Z'0 -> 2 quarks/leptons | |
10689 | EI=KCHG(IABS(MINT(15)),1)/3. | |
10690 | AI=SIGN(1.,EI+0.1) | |
10691 | VI=AI-4.*EI*XW | |
10692 | API=SIGN(1.,EI+0.1) | |
10693 | VPI=API-4.*EI*XW | |
10694 | EF=KCHG(KFA,1)/3. | |
10695 | AF=SIGN(1.,EF+0.1) | |
10696 | VF=AF-4.*EF*XW | |
10697 | APF=SIGN(1.,EF+0.1) | |
10698 | VPF=APF-4.*EF*XW | |
10699 | GG=1. | |
10700 | GZ=1./(8.*XW*(1.-XW))*SH*(SH-SQMZ)/((SH-SQMZ)**2+GZMZ**2) | |
10701 | GZP=1./(8.*XW*(1.-XW))*SH*(SH-SQMZP)/((SH-SQMZP)**2+GZMZP**2) | |
10702 | ZZ=1./(16.*XW*(1.-XW))**2*SH**2/((SH-SQMZ)**2+GZMZ**2) | |
10703 | ZZP=2./(16.*XW*(1.-XW))**2* | |
10704 | & SH**2*((SH-SQMZ)*(SH-SQMZP)+GZMZ*GZMZP)/ | |
10705 | & (((SH-SQMZ)**2+GZMZ**2)*((SH-SQMZP)**2+GZMZP**2)) | |
10706 | ZPZP=1./(16.*XW*(1.-XW))**2*SH**2/((SH-SQMZP)**2+GZMZP**2) | |
10707 | IF(MSTP(44).EQ.1) THEN | |
10708 | C...Only gamma* production included | |
10709 | GZ=0. | |
10710 | GZP=0. | |
10711 | ZZ=0. | |
10712 | ZZP=0. | |
10713 | ZPZP=0. | |
10714 | ELSEIF(MSTP(44).EQ.2) THEN | |
10715 | C...Only Z0 production included | |
10716 | GG=0. | |
10717 | GZ=0. | |
10718 | GZP=0. | |
10719 | ZZP=0. | |
10720 | ZPZP=0. | |
10721 | ELSEIF(MSTP(44).EQ.3) THEN | |
10722 | C...Only Z'0 production included | |
10723 | GG=0. | |
10724 | GZ=0. | |
10725 | GZP=0. | |
10726 | ZZ=0. | |
10727 | ZZP=0. | |
10728 | ELSEIF(MSTP(44).EQ.4) THEN | |
10729 | C...Only gamma*/Z0 production included | |
10730 | GZP=0. | |
10731 | ZZP=0. | |
10732 | ZPZP=0. | |
10733 | ELSEIF(MSTP(44).EQ.5) THEN | |
10734 | C...Only gamma*/Z'0 production included | |
10735 | GZ=0. | |
10736 | ZZ=0. | |
10737 | ZZP=0. | |
10738 | ELSEIF(MSTP(44).EQ.6) THEN | |
10739 | C...Only Z0/Z'0 production included | |
10740 | GG=0. | |
10741 | GZ=0. | |
10742 | GZP=0. | |
10743 | ENDIF | |
10744 | ASYM=2.*(EI*AI*GZ*EF*AF+EI*API*GZP*EF*APF+4.*VI*AI*ZZ*VF*AF+ | |
10745 | & (VI*API+VPI*AI)*ZZP*(VF*APF+VPF*AF)+4.*VPI*API*ZPZP*VPF*APF)/ | |
10746 | & (EI**2*GG*EF**2+EI*VI*GZ*EF*VF+EI*VPI*GZP*EF*VPF+ | |
10747 | & (VI**2+AI**2)*ZZ*(VF**2+AF**2)+(VI*VPI+AI*API)*ZZP* | |
10748 | & (VF*VPF+AF*APF)+(VPI**2+API**2)*ZPZP*(VPF**2+APF**2)) | |
10749 | WT=1.+ASYM*CTHE(JT)+CTHE(JT)**2 | |
10750 | WTMAX=2.+ABS(ASYM) | |
10751 | ||
10752 | ELSE | |
10753 | WT=1. | |
10754 | WTMAX=1. | |
10755 | ENDIF | |
10756 | C...Obtain correct angular distribution by rejection techniques. | |
10757 | IF(WT.LT.RLU(0)*WTMAX) GOTO 420 | |
10758 | ||
10759 | C...Construct massive four-vectors using angles chosen. Mark decayed | |
10760 | C...resonances, add documentation lines. Shower evolution. | |
10761 | 500 DO 520 JT=1,JTMAX | |
10762 | IF(KDCY(JT).EQ.0) GOTO 520 | |
10763 | ID=IREF(IP,JT) | |
10764 | CALL LUDBRB(NSD(JT)+1,NSD(JT)+2,ACOS(CTHE(JT)),PHI(JT), | |
10765 | &DBLE(P(ID,1)/P(ID,4)),DBLE(P(ID,2)/P(ID,4)),DBLE(P(ID,3)/P(ID,4))) | |
10766 | K(ID,1)=K(ID,1)+10 | |
10767 | K(ID,4)=NSD(JT)+1 | |
10768 | K(ID,5)=NSD(JT)+2 | |
10769 | IDOC=MINT(83)+MINT(4) | |
10770 | DO 510 I=NSD(JT)+1,NSD(JT)+2 | |
10771 | MINT(4)=MINT(4)+1 | |
10772 | I1=MINT(83)+MINT(4) | |
10773 | K(I,3)=I1 | |
10774 | K(I1,1)=21 | |
10775 | K(I1,2)=K(I,2) | |
10776 | K(I1,3)=IREF(IP,JT+2) | |
10777 | DO 510 J=1,5 | |
10778 | 510 P(I1,J)=P(I,J) | |
10779 | IF(JTMAX.EQ.1) THEN | |
10780 | MINT(7)=MINT(83)+6+2*ISET(ISUB) | |
10781 | MINT(8)=MINT(83)+7+2*ISET(ISUB) | |
10782 | ENDIF | |
10783 | clin-8/19/02 avoid actual argument in common blocks of LUSHOW: | |
10784 | c IF(MSTP(71).GE.1.AND.KDCY(JT).EQ.1) CALL LUSHOW(NSD(JT)+1, | |
10785 | c &NSD(JT)+2,P(ID,5)) | |
10786 | pid5=P(ID,5) | |
10787 | IF(MSTP(71).GE.1.AND.KDCY(JT).EQ.1) CALL LUSHOW(NSD(JT)+1, | |
10788 | &NSD(JT)+2,pid5) | |
10789 | ||
10790 | C...Check if new resonances were produced, loop back if needed. | |
10791 | IF(KDCY(JT).NE.3) GOTO 520 | |
10792 | NP=NP+1 | |
10793 | IREF(NP,1)=NSD(JT)+1 | |
10794 | IREF(NP,2)=NSD(JT)+2 | |
10795 | IREF(NP,3)=IDOC+1 | |
10796 | IREF(NP,4)=IDOC+2 | |
10797 | IREF(NP,5)=K(IREF(IP,JT),2) | |
10798 | IREF(NP,6)=IREF(IP,JT) | |
10799 | 520 CONTINUE | |
10800 | 530 IF(IP.LT.NP) GOTO 100 | |
10801 | ||
10802 | RETURN | |
10803 | END | |
10804 | ||
10805 | C********************************************************************* | |
10806 | ||
ce320da8 | 10807 | SUBROUTINE PYDIFFA |
0119ef9a | 10808 | |
10809 | C...Handles diffractive and elastic scattering. | |
10810 | COMMON/LUJETSA/N,K(9000,5),P(9000,5),V(9000,5) | |
10811 | SAVE /LUJETSA/ | |
10812 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
10813 | SAVE /LUDAT1A/ | |
10814 | COMMON/PYPARSA/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
10815 | SAVE /PYPARSA/ | |
10816 | COMMON/PYINT1A/MINT(400),VINT(400) | |
10817 | SAVE /PYINT1A/ | |
10818 | ||
10819 | chi=0. | |
10820 | ||
10821 | C...Reset K, P and V vectors. Store incoming particles. | |
10822 | DO 100 JT=1,MSTP(126)+10 | |
10823 | I=MINT(83)+JT | |
10824 | DO 100 J=1,5 | |
10825 | K(I,J)=0 | |
10826 | P(I,J)=0. | |
10827 | 100 V(I,J)=0. | |
10828 | N=MINT(84) | |
10829 | MINT(3)=0 | |
10830 | MINT(21)=0 | |
10831 | MINT(22)=0 | |
10832 | MINT(23)=0 | |
10833 | MINT(24)=0 | |
10834 | MINT(4)=4 | |
10835 | DO 110 JT=1,2 | |
10836 | I=MINT(83)+JT | |
10837 | K(I,1)=21 | |
10838 | K(I,2)=MINT(10+JT) | |
10839 | P(I,5)=VINT(2+JT) | |
10840 | P(I,3)=VINT(5)*(-1)**(JT+1) | |
10841 | 110 P(I,4)=SQRT(P(I,3)**2+P(I,5)**2) | |
10842 | MINT(6)=2 | |
10843 | ||
10844 | C...Subprocess; kinematics. | |
10845 | ISUB=MINT(1) | |
10846 | SQLAM=(VINT(2)-VINT(63)-VINT(64))**2-4.*VINT(63)*VINT(64) | |
10847 | PZ=SQRT(SQLAM)/(2.*VINT(1)) | |
10848 | DO 150 JT=1,2 | |
10849 | I=MINT(83)+JT | |
10850 | PE=(VINT(2)+VINT(62+JT)-VINT(65-JT))/(2.*VINT(1)) | |
10851 | ||
10852 | C...Elastically scattered particle. | |
10853 | IF(MINT(16+JT).LE.0) THEN | |
10854 | N=N+1 | |
10855 | K(N,1)=1 | |
10856 | K(N,2)=K(I,2) | |
10857 | K(N,3)=I+2 | |
10858 | P(N,3)=PZ*(-1)**(JT+1) | |
10859 | P(N,4)=PE | |
10860 | P(N,5)=P(I,5) | |
10861 | ||
10862 | C...Diffracted particle: valence quark kicked out. | |
10863 | ELSEIF(MSTP(101).EQ.1) THEN | |
10864 | N=N+2 | |
10865 | K(N-1,1)=2 | |
10866 | K(N,1)=1 | |
10867 | K(N-1,3)=I+2 | |
10868 | K(N,3)=I+2 | |
ce320da8 | 10869 | CALL PYSPLIA(K(I,2),21,K(N,2),K(N-1,2)) |
0119ef9a | 10870 | P(N-1,5)=ULMASS(K(N-1,2)) |
10871 | P(N,5)=ULMASS(K(N,2)) | |
10872 | SQLAM=(VINT(62+JT)-P(N-1,5)**2-P(N,5)**2)**2- | |
10873 | & 4.*P(N-1,5)**2*P(N,5)**2 | |
10874 | P(N-1,3)=(PE*SQRT(SQLAM)+PZ*(VINT(62+JT)+P(N-1,5)**2- | |
10875 | & P(N,5)**2))/(2.*VINT(62+JT))*(-1)**(JT+1) | |
10876 | P(N-1,4)=SQRT(P(N-1,3)**2+P(N-1,5)**2) | |
10877 | P(N,3)=PZ*(-1)**(JT+1)-P(N-1,3) | |
10878 | P(N,4)=SQRT(P(N,3)**2+P(N,5)**2) | |
10879 | ||
10880 | C...Diffracted particle: gluon kicked out. | |
10881 | ELSE | |
10882 | N=N+3 | |
10883 | K(N-2,1)=2 | |
10884 | K(N-1,1)=2 | |
10885 | K(N,1)=1 | |
10886 | K(N-2,3)=I+2 | |
10887 | K(N-1,3)=I+2 | |
10888 | K(N,3)=I+2 | |
ce320da8 | 10889 | CALL PYSPLIA(K(I,2),21,K(N,2),K(N-2,2)) |
0119ef9a | 10890 | K(N-1,2)=21 |
10891 | P(N-2,5)=ULMASS(K(N-2,2)) | |
10892 | P(N-1,5)=0. | |
10893 | P(N,5)=ULMASS(K(N,2)) | |
10894 | C...Energy distribution for particle into two jets. | |
10895 | 120 IMB=1 | |
10896 | IF(MOD(K(I,2)/1000,10).NE.0) IMB=2 | |
10897 | CHIK=PARP(92+2*IMB) | |
10898 | IF(MSTP(92).LE.1) THEN | |
10899 | IF(IMB.EQ.1) CHI=RLU(0) | |
10900 | IF(IMB.EQ.2) CHI=1.-SQRT(RLU(0)) | |
10901 | ELSEIF(MSTP(92).EQ.2) THEN | |
10902 | CHI=1.-RLU(0)**(1./(1.+CHIK)) | |
10903 | ELSEIF(MSTP(92).EQ.3) THEN | |
10904 | CUT=2.*0.3/VINT(1) | |
10905 | 130 CHI=RLU(0)**2 | |
10906 | IF((CHI**2/(CHI**2+CUT**2))**0.25*(1.-CHI)**CHIK.LT. | |
10907 | & RLU(0)) GOTO 130 | |
10908 | ELSE | |
10909 | CUT=2.*0.3/VINT(1) | |
10910 | CUTR=(1.+SQRT(1.+CUT**2))/CUT | |
10911 | 140 CHIR=CUT*CUTR**RLU(0) | |
10912 | CHI=(CHIR**2-CUT**2)/(2.*CHIR) | |
10913 | IF((1.-CHI)**CHIK.LT.RLU(0)) GOTO 140 | |
10914 | ENDIF | |
10915 | IF(CHI.LT.P(N,5)**2/VINT(62+JT).OR.CHI.GT.1.-P(N-2,5)**2/ | |
10916 | & VINT(62+JT)) GOTO 120 | |
10917 | SQM=P(N-2,5)**2/(1.-CHI)+P(N,5)**2/CHI | |
10918 | IF((SQRT(SQM)+PARJ(32))**2.GE.VINT(62+JT)) GOTO 120 | |
10919 | PZI=(PE*(VINT(62+JT)-SQM)+PZ*(VINT(62+JT)+SQM))/ | |
10920 | & (2.*VINT(62+JT)) | |
10921 | PEI=SQRT(PZI**2+SQM) | |
10922 | PQQP=(1.-CHI)*(PEI+PZI) | |
10923 | P(N-2,3)=0.5*(PQQP-P(N-2,5)**2/PQQP)*(-1)**(JT+1) | |
10924 | P(N-2,4)=SQRT(P(N-2,3)**2+P(N-2,5)**2) | |
10925 | P(N-1,3)=(PZ-PZI)*(-1)**(JT+1) | |
10926 | P(N-1,4)=ABS(P(N-1,3)) | |
10927 | P(N,3)=PZI*(-1)**(JT+1)-P(N-2,3) | |
10928 | P(N,4)=SQRT(P(N,3)**2+P(N,5)**2) | |
10929 | ENDIF | |
10930 | ||
10931 | C...Documentation lines. | |
10932 | K(I+2,1)=21 | |
10933 | IF(MINT(16+JT).EQ.0) K(I+2,2)=MINT(10+JT) | |
10934 | IF(MINT(16+JT).NE.0) K(I+2,2)=10*(MINT(10+JT)/10) | |
10935 | K(I+2,3)=I | |
10936 | P(I+2,3)=PZ*(-1)**(JT+1) | |
10937 | P(I+2,4)=PE | |
10938 | P(I+2,5)=SQRT(VINT(62+JT)) | |
10939 | 150 CONTINUE | |
10940 | ||
10941 | C...Rotate outgoing partons/particles using cos(theta). | |
10942 | CALL LUDBRB(MINT(83)+3,N,ACOS(VINT(23)),VINT(24),0D0,0D0,0D0) | |
10943 | ||
10944 | RETURN | |
10945 | END | |
10946 | ||
10947 | C********************************************************************* | |
10948 | ||
ce320da8 | 10949 | SUBROUTINE PYFRAMA(IFRAME) |
0119ef9a | 10950 | |
10951 | C...Performs transformations between different coordinate frames. | |
10952 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
10953 | SAVE /LUDAT1A/ | |
10954 | COMMON/PYPARSA/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
10955 | SAVE /PYPARSA/ | |
10956 | COMMON/PYINT1A/MINT(400),VINT(400) | |
10957 | SAVE /PYINT1A/ | |
10958 | ||
10959 | IF(IFRAME.LT.1.OR.IFRAME.GT.2) THEN | |
10960 | WRITE(MSTU(11),1000) IFRAME,MINT(6) | |
10961 | RETURN | |
10962 | ENDIF | |
10963 | IF(IFRAME.EQ.MINT(6)) RETURN | |
10964 | ||
10965 | IF(MINT(6).EQ.1) THEN | |
10966 | C...Transform from fixed target or user specified frame to | |
10967 | C...CM-frame of incoming particles. | |
10968 | CALL LUROBO(0.,0.,-VINT(8),-VINT(9),-VINT(10)) | |
10969 | CALL LUROBO(0.,-VINT(7),0.,0.,0.) | |
10970 | CALL LUROBO(-VINT(6),0.,0.,0.,0.) | |
10971 | MINT(6)=2 | |
10972 | ||
10973 | ELSE | |
10974 | C...Transform from particle CM-frame to fixed target or user specified | |
10975 | C...frame. | |
10976 | CALL LUROBO(VINT(6),VINT(7),VINT(8),VINT(9),VINT(10)) | |
10977 | MINT(6)=1 | |
10978 | ENDIF | |
10979 | MSTI(6)=MINT(6) | |
10980 | ||
ce320da8 | 10981 | 1000 FORMAT(1X,'Error: illegal values in subroutine PYFRAMA.',1X, |
0119ef9a | 10982 | &'No transformation performed.'/1X,'IFRAME =',1X,I5,'; MINT(6) =', |
10983 | &1X,I5) | |
10984 | ||
10985 | RETURN | |
10986 | END | |
10987 | ||
10988 | C********************************************************************* | |
10989 | ||
ce320da8 | 10990 | SUBROUTINE PYWIDTA(KFLR,RMAS,WDTP,WDTE) |
0119ef9a | 10991 | |
10992 | C...Calculates full and partial widths of resonances. | |
10993 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
10994 | SAVE /LUDAT1A/ | |
10995 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
10996 | SAVE /LUDAT2A/ | |
10997 | COMMON/LUDAT3A/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) | |
10998 | SAVE /LUDAT3A/ | |
10999 | COMMON/PYPARSA/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
11000 | SAVE /PYPARSA/ | |
11001 | COMMON/PYINT1A/MINT(400),VINT(400) | |
11002 | SAVE /PYINT1A/ | |
11003 | COMMON/PYINT4AA/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3) | |
11004 | SAVE /PYINT4AA/ | |
11005 | DIMENSION WDTP(0:40),WDTE(0:40,0:5) | |
11006 | ||
11007 | wid2=0. | |
11008 | ai=0. | |
11009 | ggi=0. | |
11010 | gzi=0. | |
11011 | zzi=0. | |
11012 | ggf=0. | |
11013 | gzf=0. | |
11014 | zzf=0. | |
11015 | ej=0. | |
11016 | vj=0. | |
11017 | gzpi=0. | |
11018 | zzpi=0. | |
11019 | zpzpi=0. | |
11020 | gzpf=0. | |
11021 | zzpf=0. | |
11022 | zpzpf=0. | |
11023 | ||
11024 | C...Some common constants. | |
11025 | KFLA=IABS(KFLR) | |
11026 | SQM=RMAS**2 | |
11027 | AS=ULALPS(SQM) | |
11028 | AEM=PARU(101) | |
11029 | XW=PARU(102) | |
11030 | RADC=1.+AS/PARU(1) | |
11031 | ||
11032 | C...Reset width information. | |
11033 | DO 100 I=0,40 | |
11034 | WDTP(I)=0. | |
11035 | DO 100 J=0,5 | |
11036 | 100 WDTE(I,J)=0. | |
11037 | ||
11038 | IF(KFLA.EQ.21) THEN | |
11039 | C...QCD: | |
11040 | DO 110 I=1,MDCY(21,3) | |
11041 | IDC=I+MDCY(21,2)-1 | |
11042 | RM1=(PMAS(IABS(KFDP(IDC,1)),1)/RMAS)**2 | |
11043 | RM2=(PMAS(IABS(KFDP(IDC,2)),1)/RMAS)**2 | |
11044 | IF(SQRT(RM1)+SQRT(RM2).GT.1..OR.MDME(IDC,1).LT.0) GOTO 110 | |
11045 | IF(I.LE.8) THEN | |
11046 | C...QCD -> q + qb | |
11047 | WDTP(I)=(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1)) | |
11048 | WID2=1. | |
11049 | ENDIF | |
11050 | WDTP(0)=WDTP(0)+WDTP(I) | |
11051 | IF(MDME(IDC,1).GT.0) THEN | |
11052 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
11053 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
11054 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
11055 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
11056 | ENDIF | |
11057 | 110 CONTINUE | |
11058 | ||
11059 | ELSEIF(KFLA.EQ.23) THEN | |
11060 | C...Z0: | |
11061 | IF(MINT(61).EQ.1) THEN | |
11062 | EI=KCHG(IABS(MINT(15)),1)/3. | |
11063 | AI=SIGN(1.,EI) | |
11064 | VI=AI-4.*EI*XW | |
11065 | SQMZ=PMAS(23,1)**2 | |
11066 | GZMZ=PMAS(23,2)*PMAS(23,1) | |
11067 | GGI=EI**2 | |
11068 | GZI=EI*VI/(8.*XW*(1.-XW))*SQM*(SQM-SQMZ)/ | |
11069 | & ((SQM-SQMZ)**2+GZMZ**2) | |
11070 | ZZI=(VI**2+AI**2)/(16.*XW*(1.-XW))**2*SQM**2/ | |
11071 | & ((SQM-SQMZ)**2+GZMZ**2) | |
11072 | IF(MSTP(43).EQ.1) THEN | |
11073 | C...Only gamma* production included | |
11074 | GZI=0. | |
11075 | ZZI=0. | |
11076 | ELSEIF(MSTP(43).EQ.2) THEN | |
11077 | C...Only Z0 production included | |
11078 | GGI=0. | |
11079 | GZI=0. | |
11080 | ENDIF | |
11081 | ELSEIF(MINT(61).EQ.2) THEN | |
11082 | VINT(111)=0. | |
11083 | VINT(112)=0. | |
11084 | VINT(114)=0. | |
11085 | ENDIF | |
11086 | DO 120 I=1,MDCY(23,3) | |
11087 | IDC=I+MDCY(23,2)-1 | |
11088 | RM1=(PMAS(IABS(KFDP(IDC,1)),1)/RMAS)**2 | |
11089 | RM2=(PMAS(IABS(KFDP(IDC,2)),1)/RMAS)**2 | |
11090 | IF(SQRT(RM1)+SQRT(RM2).GT.1..OR.MDME(IDC,1).LT.0) GOTO 120 | |
11091 | IF(I.LE.8) THEN | |
11092 | C...Z0 -> q + qb | |
11093 | EF=KCHG(I,1)/3. | |
11094 | AF=SIGN(1.,EF+0.1) | |
11095 | VF=AF-4.*EF*XW | |
11096 | IF(MINT(61).EQ.0) THEN | |
11097 | WDTP(I)=3.*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))* | |
11098 | & SQRT(MAX(0.,1.-4.*RM1))*RADC | |
11099 | ELSEIF(MINT(61).EQ.1) THEN | |
11100 | WDTP(I)=3.*((GGI*EF**2+GZI*EF*VF+ZZI*VF**2)* | |
11101 | & (1.+2.*RM1)+ZZI*AF**2*(1.-4.*RM1))* | |
11102 | & SQRT(MAX(0.,1.-4.*RM1))*RADC | |
11103 | ELSEIF(MINT(61).EQ.2) THEN | |
11104 | GGF=3.*EF**2*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))*RADC | |
11105 | GZF=3.*EF*VF*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))*RADC | |
11106 | ZZF=3.*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))* | |
11107 | & SQRT(MAX(0.,1.-4.*RM1))*RADC | |
11108 | ENDIF | |
11109 | WID2=1. | |
11110 | ELSEIF(I.LE.16) THEN | |
11111 | C...Z0 -> l+ + l-, nu + nub | |
11112 | EF=KCHG(I+2,1)/3. | |
11113 | AF=SIGN(1.,EF+0.1) | |
11114 | VF=AF-4.*EF*XW | |
11115 | WDTP(I)=(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))* | |
11116 | & SQRT(MAX(0.,1.-4.*RM1)) | |
11117 | IF(MINT(61).EQ.0) THEN | |
11118 | WDTP(I)=(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))* | |
11119 | & SQRT(MAX(0.,1.-4.*RM1)) | |
11120 | ELSEIF(MINT(61).EQ.1) THEN | |
11121 | WDTP(I)=((GGI*EF**2+GZI*EF*VF+ZZI*VF**2)* | |
11122 | & (1.+2.*RM1)+ZZI*AF**2*(1.-4.*RM1))* | |
11123 | & SQRT(MAX(0.,1.-4.*RM1)) | |
11124 | ELSEIF(MINT(61).EQ.2) THEN | |
11125 | GGF=EF**2*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1)) | |
11126 | GZF=EF*VF*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1)) | |
11127 | ZZF=(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))* | |
11128 | & SQRT(MAX(0.,1.-4.*RM1)) | |
11129 | ENDIF | |
11130 | WID2=1. | |
11131 | ELSE | |
11132 | C...Z0 -> H+ + H- | |
11133 | CF=2.*(1.-2.*XW) | |
11134 | IF(MINT(61).EQ.0) THEN | |
11135 | WDTP(I)=0.25*CF**2*(1.-4.*RM1)*SQRT(MAX(0.,1.-4.*RM1)) | |
11136 | ELSEIF(MINT(61).EQ.1) THEN | |
11137 | WDTP(I)=0.25*(GGI+GZI*CF+ZZI*CF**2)*(1.-4.*RM1)* | |
11138 | & SQRT(MAX(0.,1.-4.*RM1)) | |
11139 | ELSEIF(MINT(61).EQ.2) THEN | |
11140 | GGF=0.25*(1.-4.*RM1)*SQRT(MAX(0.,1.-4.*RM1)) | |
11141 | GZF=0.25*CF*(1.-4.*RM1)*SQRT(MAX(0.,1.-4.*RM1)) | |
11142 | ZZF=0.25*CF**2*(1.-4.*RM1)*SQRT(MAX(0.,1.-4.*RM1)) | |
11143 | ENDIF | |
11144 | WID2=WIDS(37,1) | |
11145 | ENDIF | |
11146 | WDTP(0)=WDTP(0)+WDTP(I) | |
11147 | IF(MDME(IDC,1).GT.0) THEN | |
11148 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
11149 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
11150 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
11151 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
11152 | clin-4/2008 modified a la pythia6115.f to avoid undefined values (GGF,GZF,ZZF): | |
11153 | c VINT(111)=VINT(111)+GGF*WID2 | |
11154 | c VINT(112)=VINT(112)+GZF*WID2 | |
11155 | c VINT(114)=VINT(114)+ZZF*WID2 | |
11156 | IF(MINT(61).EQ.2) THEN | |
11157 | VINT(111)=VINT(111)+GGF*WID2 | |
11158 | VINT(112)=VINT(112)+GZF*WID2 | |
11159 | VINT(114)=VINT(114)+ZZF*WID2 | |
11160 | ENDIF | |
11161 | clin-4/2008-end | |
11162 | ENDIF | |
11163 | 120 CONTINUE | |
11164 | IF(MSTP(43).EQ.1) THEN | |
11165 | C...Only gamma* production included | |
11166 | VINT(112)=0. | |
11167 | VINT(114)=0. | |
11168 | ELSEIF(MSTP(43).EQ.2) THEN | |
11169 | C...Only Z0 production included | |
11170 | VINT(111)=0. | |
11171 | VINT(112)=0. | |
11172 | ENDIF | |
11173 | ||
11174 | ELSEIF(KFLA.EQ.24) THEN | |
11175 | C...W+/-: | |
11176 | DO 130 I=1,MDCY(24,3) | |
11177 | IDC=I+MDCY(24,2)-1 | |
11178 | RM1=(PMAS(IABS(KFDP(IDC,1)),1)/RMAS)**2 | |
11179 | RM2=(PMAS(IABS(KFDP(IDC,2)),1)/RMAS)**2 | |
11180 | IF(SQRT(RM1)+SQRT(RM2).GT.1..OR.MDME(IDC,1).LT.0) GOTO 130 | |
11181 | IF(I.LE.16) THEN | |
11182 | C...W+/- -> q + qb' | |
11183 | WDTP(I)=3.*(2.-RM1-RM2-(RM1-RM2)**2)* | |
11184 | & SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))* | |
11185 | & VCKM((I-1)/4+1,MOD(I-1,4)+1)*RADC | |
11186 | WID2=1. | |
11187 | ELSE | |
11188 | C...W+/- -> l+/- + nu | |
11189 | WDTP(I)=(2.-RM1-RM2-(RM1-RM2)**2)* | |
11190 | & SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2)) | |
11191 | WID2=1. | |
11192 | ENDIF | |
11193 | WDTP(0)=WDTP(0)+WDTP(I) | |
11194 | IF(MDME(IDC,1).GT.0) THEN | |
11195 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
11196 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
11197 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
11198 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
11199 | ENDIF | |
11200 | 130 CONTINUE | |
11201 | ||
11202 | ELSEIF(KFLA.EQ.25) THEN | |
11203 | C...H0: | |
11204 | DO 170 I=1,MDCY(25,3) | |
11205 | IDC=I+MDCY(25,2)-1 | |
11206 | RM1=(PMAS(IABS(KFDP(IDC,1)),1)/RMAS)**2 | |
11207 | RM2=(PMAS(IABS(KFDP(IDC,2)),1)/RMAS)**2 | |
11208 | IF(SQRT(RM1)+SQRT(RM2).GT.1..OR.MDME(IDC,1).LT.0) GOTO 170 | |
11209 | IF(I.LE.8) THEN | |
11210 | C...H0 -> q + qb | |
11211 | WDTP(I)=3.*RM1*(1.-4.*RM1)*SQRT(MAX(0.,1.-4.*RM1))*RADC | |
11212 | WID2=1. | |
11213 | ELSEIF(I.LE.12) THEN | |
11214 | C...H0 -> l+ + l- | |
11215 | WDTP(I)=RM1*(1.-4.*RM1)*SQRT(MAX(0.,1.-4.*RM1)) | |
11216 | WID2=1. | |
11217 | ELSEIF(I.EQ.13) THEN | |
11218 | C...H0 -> g + g; quark loop contribution only | |
11219 | ETARE=0. | |
11220 | ETAIM=0. | |
11221 | DO 140 J=1,2*MSTP(1) | |
11222 | EPS=(2.*PMAS(J,1)/RMAS)**2 | |
11223 | IF(EPS.LE.1.) THEN | |
11224 | IF(EPS.GT.1.E-4) THEN | |
11225 | ROOT=SQRT(1.-EPS) | |
11226 | RLN=LOG((1.+ROOT)/(1.-ROOT)) | |
11227 | ELSE | |
11228 | RLN=LOG(4./EPS-2.) | |
11229 | ENDIF | |
11230 | PHIRE=0.25*(RLN**2-PARU(1)**2) | |
11231 | PHIIM=0.5*PARU(1)*RLN | |
11232 | ELSE | |
11233 | PHIRE=-(ASIN(1./SQRT(EPS)))**2 | |
11234 | PHIIM=0. | |
11235 | ENDIF | |
11236 | ETARE=ETARE+0.5*EPS*(1.+(EPS-1.)*PHIRE) | |
11237 | ETAIM=ETAIM+0.5*EPS*(EPS-1.)*PHIIM | |
11238 | 140 CONTINUE | |
11239 | ETA2=ETARE**2+ETAIM**2 | |
11240 | WDTP(I)=(AS/PARU(1))**2*ETA2 | |
11241 | WID2=1. | |
11242 | ELSEIF(I.EQ.14) THEN | |
11243 | C...H0 -> gamma + gamma; quark, charged lepton and W loop contributions | |
11244 | ETARE=0. | |
11245 | ETAIM=0. | |
11246 | DO 150 J=1,3*MSTP(1)+1 | |
11247 | IF(J.LE.2*MSTP(1)) THEN | |
11248 | EJ=KCHG(J,1)/3. | |
11249 | EPS=(2.*PMAS(J,1)/RMAS)**2 | |
11250 | ELSEIF(J.LE.3*MSTP(1)) THEN | |
11251 | JL=2*(J-2*MSTP(1))-1 | |
11252 | EJ=KCHG(10+JL,1)/3. | |
11253 | EPS=(2.*PMAS(10+JL,1)/RMAS)**2 | |
11254 | ELSE | |
11255 | EPS=(2.*PMAS(24,1)/RMAS)**2 | |
11256 | ENDIF | |
11257 | IF(EPS.LE.1.) THEN | |
11258 | IF(EPS.GT.1.E-4) THEN | |
11259 | ROOT=SQRT(1.-EPS) | |
11260 | RLN=LOG((1.+ROOT)/(1.-ROOT)) | |
11261 | ELSE | |
11262 | RLN=LOG(4./EPS-2.) | |
11263 | ENDIF | |
11264 | PHIRE=0.25*(RLN**2-PARU(1)**2) | |
11265 | PHIIM=0.5*PARU(1)*RLN | |
11266 | ELSE | |
11267 | PHIRE=-(ASIN(1./SQRT(EPS)))**2 | |
11268 | PHIIM=0. | |
11269 | ENDIF | |
11270 | IF(J.LE.2*MSTP(1)) THEN | |
11271 | ETARE=ETARE+0.5*3.*EJ**2*EPS*(1.+(EPS-1.)*PHIRE) | |
11272 | ETAIM=ETAIM+0.5*3.*EJ**2*EPS*(EPS-1.)*PHIIM | |
11273 | ELSEIF(J.LE.3*MSTP(1)) THEN | |
11274 | ETARE=ETARE+0.5*EJ**2*EPS*(1.+(EPS-1.)*PHIRE) | |
11275 | ETAIM=ETAIM+0.5*EJ**2*EPS*(EPS-1.)*PHIIM | |
11276 | ELSE | |
11277 | ETARE=ETARE-0.5-0.75*EPS*(1.+(EPS-2.)*PHIRE) | |
11278 | ETAIM=ETAIM+0.75*EPS*(EPS-2.)*PHIIM | |
11279 | ENDIF | |
11280 | 150 CONTINUE | |
11281 | ETA2=ETARE**2+ETAIM**2 | |
11282 | WDTP(I)=(AEM/PARU(1))**2*0.5*ETA2 | |
11283 | WID2=1. | |
11284 | ELSEIF(I.EQ.15) THEN | |
11285 | C...H0 -> gamma + Z0; quark, charged lepton and W loop contributions | |
11286 | ETARE=0. | |
11287 | ETAIM=0. | |
11288 | DO 160 J=1,3*MSTP(1)+1 | |
11289 | IF(J.LE.2*MSTP(1)) THEN | |
11290 | EJ=KCHG(J,1)/3. | |
11291 | AJ=SIGN(1.,EJ+0.1) | |
11292 | VJ=AJ-4.*EJ*XW | |
11293 | EPS=(2.*PMAS(J,1)/RMAS)**2 | |
11294 | EPSP=(2.*PMAS(J,1)/PMAS(23,1))**2 | |
11295 | ELSEIF(J.LE.3*MSTP(1)) THEN | |
11296 | JL=2*(J-2*MSTP(1))-1 | |
11297 | EJ=KCHG(10+JL,1)/3. | |
11298 | AJ=SIGN(1.,EJ+0.1) | |
11299 | VJ=AI-4.*EJ*XW | |
11300 | EPS=(2.*PMAS(10+JL,1)/RMAS)**2 | |
11301 | EPSP=(2.*PMAS(10+JL,1)/PMAS(23,1))**2 | |
11302 | ELSE | |
11303 | EPS=(2.*PMAS(24,1)/RMAS)**2 | |
11304 | EPSP=(2.*PMAS(24,1)/PMAS(23,1))**2 | |
11305 | ENDIF | |
11306 | IF(EPS.LE.1.) THEN | |
11307 | ROOT=SQRT(1.-EPS) | |
11308 | IF(EPS.GT.1.E-4) THEN | |
11309 | RLN=LOG((1.+ROOT)/(1.-ROOT)) | |
11310 | ELSE | |
11311 | RLN=LOG(4./EPS-2.) | |
11312 | ENDIF | |
11313 | PHIRE=0.25*(RLN**2-PARU(1)**2) | |
11314 | PHIIM=0.5*PARU(1)*RLN | |
11315 | PSIRE=-(1.+0.5*ROOT*RLN) | |
11316 | PSIIM=0.5*PARU(1)*ROOT | |
11317 | ELSE | |
11318 | PHIRE=-(ASIN(1./SQRT(EPS)))**2 | |
11319 | PHIIM=0. | |
11320 | PSIRE=-(1.+SQRT(EPS-1.)*ASIN(1./SQRT(EPS))) | |
11321 | PSIIM=0. | |
11322 | ENDIF | |
11323 | IF(EPSP.LE.1.) THEN | |
11324 | ROOT=SQRT(1.-EPSP) | |
11325 | IF(EPSP.GT.1.E-4) THEN | |
11326 | RLN=LOG((1.+ROOT)/(1.-ROOT)) | |
11327 | ELSE | |
11328 | RLN=LOG(4./EPSP-2.) | |
11329 | ENDIF | |
11330 | PHIREP=0.25*(RLN**2-PARU(1)**2) | |
11331 | PHIIMP=0.5*PARU(1)*RLN | |
11332 | PSIREP=-(1.+0.5*ROOT*RLN) | |
11333 | PSIIMP=0.5*PARU(1)*ROOT | |
11334 | ELSE | |
11335 | PHIREP=-(ASIN(1./SQRT(EPSP)))**2 | |
11336 | PHIIMP=0. | |
11337 | PSIREP=-(1.+SQRT(EPSP-1.)*ASIN(1./SQRT(EPSP))) | |
11338 | PSIIMP=0. | |
11339 | ENDIF | |
11340 | FXYRE=EPS*EPSP/(8.*(EPS-EPSP))*(1.-EPS*EPSP/(EPS-EPSP)*(PHIRE- | |
11341 | & PHIREP)+2.*EPS/(EPS-EPSP)*(PSIRE-PSIREP)) | |
11342 | FXYIM=EPS*EPSP/(8.*(EPS-EPSP))*(-EPS*EPSP/(EPS-EPSP)*(PHIIM- | |
11343 | & PHIIMP)+2.*EPS/(EPS-EPSP)*(PSIIM-PSIIMP)) | |
11344 | F1RE=EPS*EPSP/(2.*(EPS-EPSP))*(PHIRE-PHIREP) | |
11345 | F1IM=EPS*EPSP/(2.*(EPS-EPSP))*(PHIIM-PHIIMP) | |
11346 | IF(J.LE.2*MSTP(1)) THEN | |
11347 | ETARE=ETARE-3.*EJ*VJ*(FXYRE-0.25*F1RE) | |
11348 | ETAIM=ETAIM-3.*EJ*VJ*(FXYIM-0.25*F1IM) | |
11349 | ELSEIF(J.LE.3*MSTP(1)) THEN | |
11350 | ETARE=ETARE-EJ*VJ*(FXYRE-0.25*F1RE) | |
11351 | ETAIM=ETAIM-EJ*VJ*(FXYIM-0.25*F1IM) | |
11352 | ELSE | |
11353 | ETARE=ETARE-SQRT(1.-XW)*(((1.+2./EPS)*XW/SQRT(1.-XW)- | |
11354 | & (5.+2./EPS))*FXYRE+(3.-XW/SQRT(1.-XW))*F1RE) | |
11355 | ETAIM=ETAIM-SQRT(1.-XW)*(((1.+2./EPS)*XW/SQRT(1.-XW)- | |
11356 | & (5.+2./EPS))*FXYIM+(3.-XW/SQRT(1.-XW))*F1IM) | |
11357 | ENDIF | |
11358 | 160 CONTINUE | |
11359 | ETA2=ETARE**2+ETAIM**2 | |
11360 | WDTP(I)=(AEM/PARU(1))**2*(1.-(PMAS(23,1)/RMAS)**2)**3/XW*ETA2 | |
11361 | WID2=WIDS(23,2) | |
11362 | ELSE | |
11363 | C...H0 -> Z0 + Z0, W+ + W- | |
11364 | WDTP(I)=(1.-4.*RM1+12.*RM1**2)*SQRT(MAX(0.,1.-4.*RM1))/ | |
11365 | & (2.*(18-I)) | |
11366 | WID2=WIDS(7+I,1) | |
11367 | ENDIF | |
11368 | WDTP(0)=WDTP(0)+WDTP(I) | |
11369 | IF(MDME(IDC,1).GT.0) THEN | |
11370 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
11371 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
11372 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
11373 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
11374 | ENDIF | |
11375 | 170 CONTINUE | |
11376 | ||
11377 | ELSEIF(KFLA.EQ.32) THEN | |
11378 | C...Z'0: | |
11379 | IF(MINT(61).EQ.1) THEN | |
11380 | EI=KCHG(IABS(MINT(15)),1)/3. | |
11381 | AI=SIGN(1.,EI) | |
11382 | VI=AI-4.*EI*XW | |
11383 | SQMZ=PMAS(23,1)**2 | |
11384 | GZMZ=PMAS(23,2)*PMAS(23,1) | |
11385 | API=SIGN(1.,EI) | |
11386 | VPI=API-4.*EI*XW | |
11387 | SQMZP=PMAS(32,1)**2 | |
11388 | GZPMZP=PMAS(32,2)*PMAS(32,1) | |
11389 | GGI=EI**2 | |
11390 | GZI=EI*VI/(8.*XW*(1.-XW))*SQM*(SQM-SQMZ)/ | |
11391 | & ((SQM-SQMZ)**2+GZMZ**2) | |
11392 | GZPI=EI*VPI/(8.*XW*(1.-XW))*SQM*(SQM-SQMZP)/ | |
11393 | & ((SQM-SQMZP)**2+GZPMZP**2) | |
11394 | ZZI=(VI**2+AI**2)/(16.*XW*(1.-XW))**2*SQM**2/ | |
11395 | & ((SQM-SQMZ)**2+GZMZ**2) | |
11396 | ZZPI=2.*(VI*VPI+AI*API)/(16.*XW*(1.-XW))**2* | |
11397 | & SQM**2*((SQM-SQMZ)*(SQM-SQMZP)+GZMZ*GZPMZP)/ | |
11398 | & (((SQM-SQMZ)**2+GZMZ**2)*((SQM-SQMZP)**2+GZPMZP**2)) | |
11399 | ZPZPI=(VPI**2+API**2)/(16.*XW*(1.-XW))**2*SQM**2/ | |
11400 | & ((SQM-SQMZP)**2+GZPMZP**2) | |
11401 | IF(MSTP(44).EQ.1) THEN | |
11402 | C...Only gamma* production included | |
11403 | GZI=0. | |
11404 | GZPI=0. | |
11405 | ZZI=0. | |
11406 | ZZPI=0. | |
11407 | ZPZPI=0. | |
11408 | ELSEIF(MSTP(44).EQ.2) THEN | |
11409 | C...Only Z0 production included | |
11410 | GGI=0. | |
11411 | GZI=0. | |
11412 | GZPI=0. | |
11413 | ZZPI=0. | |
11414 | ZPZPI=0. | |
11415 | ELSEIF(MSTP(44).EQ.3) THEN | |
11416 | C...Only Z'0 production included | |
11417 | GGI=0. | |
11418 | GZI=0. | |
11419 | GZPI=0. | |
11420 | ZZI=0. | |
11421 | ZZPI=0. | |
11422 | ELSEIF(MSTP(44).EQ.4) THEN | |
11423 | C...Only gamma*/Z0 production included | |
11424 | GZPI=0. | |
11425 | ZZPI=0. | |
11426 | ZPZPI=0. | |
11427 | ELSEIF(MSTP(44).EQ.5) THEN | |
11428 | C...Only gamma*/Z'0 production included | |
11429 | GZI=0. | |
11430 | ZZI=0. | |
11431 | ZZPI=0. | |
11432 | ELSEIF(MSTP(44).EQ.6) THEN | |
11433 | C...Only Z0/Z'0 production included | |
11434 | GGI=0. | |
11435 | GZI=0. | |
11436 | GZPI=0. | |
11437 | ENDIF | |
11438 | ELSEIF(MINT(61).EQ.2) THEN | |
11439 | VINT(111)=0. | |
11440 | VINT(112)=0. | |
11441 | VINT(113)=0. | |
11442 | VINT(114)=0. | |
11443 | VINT(115)=0. | |
11444 | VINT(116)=0. | |
11445 | ENDIF | |
11446 | DO 180 I=1,MDCY(32,3) | |
11447 | IDC=I+MDCY(32,2)-1 | |
11448 | RM1=(PMAS(IABS(KFDP(IDC,1)),1)/RMAS)**2 | |
11449 | RM2=(PMAS(IABS(KFDP(IDC,2)),1)/RMAS)**2 | |
11450 | IF(SQRT(RM1)+SQRT(RM2).GT.1..OR.MDME(IDC,1).LT.0) GOTO 180 | |
11451 | IF(I.LE.8) THEN | |
11452 | C...Z'0 -> q + qb | |
11453 | EF=KCHG(I,1)/3. | |
11454 | AF=SIGN(1.,EF+0.1) | |
11455 | VF=AF-4.*EF*XW | |
11456 | APF=SIGN(1.,EF+0.1) | |
11457 | VPF=APF-4.*EF*XW | |
11458 | IF(MINT(61).EQ.0) THEN | |
11459 | WDTP(I)=3.*(VPF**2*(1.+2.*RM1)+APF**2*(1.-4.*RM1))* | |
11460 | & SQRT(MAX(0.,1.-4.*RM1))*RADC | |
11461 | ELSEIF(MINT(61).EQ.1) THEN | |
11462 | WDTP(I)=3.*((GGI*EF**2+GZI*EF*VF+GZPI*EF*VPF+ZZI*VF**2+ | |
11463 | & ZZPI*VF*VPF+ZPZPI*VPF**2)*(1.+2.*RM1)+(ZZI*AF**2+ | |
11464 | & ZZPI*AF*APF+ZPZPI*APF**2)*(1.-4.*RM1))* | |
11465 | & SQRT(MAX(0.,1.-4.*RM1))*RADC | |
11466 | ELSEIF(MINT(61).EQ.2) THEN | |
11467 | GGF=3.*EF**2*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))*RADC | |
11468 | GZF=3.*EF*VF*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))*RADC | |
11469 | GZPF=3.*EF*VPF*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))*RADC | |
11470 | ZZF=3.*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))* | |
11471 | & SQRT(MAX(0.,1.-4.*RM1))*RADC | |
11472 | ZZPF=3.*(VF*VPF*(1.+2.*RM1)+AF*APF*(1.-4.*RM1))* | |
11473 | & SQRT(MAX(0.,1.-4.*RM1))*RADC | |
11474 | ZPZPF=3.*(VPF**2*(1.+2.*RM1)+APF**2*(1.-4.*RM1))* | |
11475 | & SQRT(MAX(0.,1.-4.*RM1))*RADC | |
11476 | ENDIF | |
11477 | WID2=1. | |
11478 | ELSE | |
11479 | C...Z'0 -> l+ + l-, nu + nub | |
11480 | EF=KCHG(I+2,1)/3. | |
11481 | AF=SIGN(1.,EF+0.1) | |
11482 | VF=AF-4.*EF*XW | |
11483 | clin-4/2008 modified above a la pythia6115.f to avoid undefined variable API: | |
11484 | c APF=SIGN(1.,EF+0.1) | |
11485 | c VPF=API-4.*EF*XW | |
11486 | IF(I.LE.10) THEN | |
11487 | VPF=PARU(127-2*MOD(I,2)) | |
11488 | APF=PARU(128-2*MOD(I,2)) | |
11489 | ELSEIF(I.LE.12) THEN | |
11490 | VPF=PARJ(186-2*MOD(I,2)) | |
11491 | APF=PARJ(187-2*MOD(I,2)) | |
11492 | ELSE | |
11493 | VPF=PARJ(194-2*MOD(I,2)) | |
11494 | APF=PARJ(195-2*MOD(I,2)) | |
11495 | ENDIF | |
11496 | clin-4/2008-end | |
11497 | IF(MINT(61).EQ.0) THEN | |
11498 | WDTP(I)=(VPF**2*(1.+2.*RM1)+APF**2*(1.-4.*RM1))* | |
11499 | & SQRT(MAX(0.,1.-4.*RM1)) | |
11500 | ELSEIF(MINT(61).EQ.1) THEN | |
11501 | WDTP(I)=((GGI*EF**2+GZI*EF*VF+GZPI*EF*VPF+ZZI*VF**2+ | |
11502 | & ZZPI*VF*VPF+ZPZPI*VPF**2)*(1.+2.*RM1)+(ZZI*AF**2+ | |
11503 | & ZZPI*AF*APF+ZPZPI*APF**2)*(1.-4.*RM1))* | |
11504 | & SQRT(MAX(0.,1.-4.*RM1)) | |
11505 | ELSEIF(MINT(61).EQ.2) THEN | |
11506 | GGF=EF**2*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1)) | |
11507 | GZF=EF*VF*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1)) | |
11508 | GZPF=EF*VPF*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1)) | |
11509 | ZZF=(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))* | |
11510 | & SQRT(MAX(0.,1.-4.*RM1)) | |
11511 | ZZPF=(VF*VPF*(1.+2.*RM1)+AF*APF*(1.-4.*RM1))* | |
11512 | & SQRT(MAX(0.,1.-4.*RM1)) | |
11513 | ZPZPF=(VPF**2*(1.+2.*RM1)+APF**2*(1.-4.*RM1))* | |
11514 | & SQRT(MAX(0.,1.-4.*RM1)) | |
11515 | ENDIF | |
11516 | WID2=1. | |
11517 | ENDIF | |
11518 | WDTP(0)=WDTP(0)+WDTP(I) | |
11519 | IF(MDME(IDC,1).GT.0) THEN | |
11520 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
11521 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
11522 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
11523 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
11524 | clin-4/2008: | |
11525 | c VINT(111)=VINT(111)+GGF | |
11526 | c VINT(112)=VINT(112)+GZF | |
11527 | c VINT(113)=VINT(113)+GZPF | |
11528 | c VINT(114)=VINT(114)+ZZF | |
11529 | c VINT(115)=VINT(115)+ZZPF | |
11530 | c VINT(116)=VINT(116)+ZPZPF | |
11531 | IF(MINT(61).EQ.2) THEN | |
11532 | VINT(111)=VINT(111)+GGF | |
11533 | VINT(112)=VINT(112)+GZF | |
11534 | VINT(113)=VINT(113)+GZPF | |
11535 | VINT(114)=VINT(114)+ZZF | |
11536 | VINT(115)=VINT(115)+ZZPF | |
11537 | VINT(116)=VINT(116)+ZPZPF | |
11538 | ENDIF | |
11539 | clin-4/2008-end | |
11540 | ENDIF | |
11541 | 180 CONTINUE | |
11542 | IF(MSTP(44).EQ.1) THEN | |
11543 | C...Only gamma* production included | |
11544 | VINT(112)=0. | |
11545 | VINT(113)=0. | |
11546 | VINT(114)=0. | |
11547 | VINT(115)=0. | |
11548 | VINT(116)=0. | |
11549 | ELSEIF(MSTP(44).EQ.2) THEN | |
11550 | C...Only Z0 production included | |
11551 | VINT(111)=0. | |
11552 | VINT(112)=0. | |
11553 | VINT(113)=0. | |
11554 | VINT(115)=0. | |
11555 | VINT(116)=0. | |
11556 | ELSEIF(MSTP(44).EQ.3) THEN | |
11557 | C...Only Z'0 production included | |
11558 | VINT(111)=0. | |
11559 | VINT(112)=0. | |
11560 | VINT(113)=0. | |
11561 | VINT(114)=0. | |
11562 | VINT(115)=0. | |
11563 | ELSEIF(MSTP(44).EQ.4) THEN | |
11564 | C...Only gamma*/Z0 production included | |
11565 | VINT(113)=0. | |
11566 | VINT(115)=0. | |
11567 | VINT(116)=0. | |
11568 | ELSEIF(MSTP(44).EQ.5) THEN | |
11569 | C...Only gamma*/Z'0 production included | |
11570 | VINT(112)=0. | |
11571 | VINT(114)=0. | |
11572 | VINT(115)=0. | |
11573 | ELSEIF(MSTP(44).EQ.6) THEN | |
11574 | C...Only Z0/Z'0 production included | |
11575 | VINT(111)=0. | |
11576 | VINT(112)=0. | |
11577 | VINT(113)=0. | |
11578 | ENDIF | |
11579 | ||
11580 | ELSEIF(KFLA.EQ.37) THEN | |
11581 | C...H+/-: | |
11582 | DO 190 I=1,MDCY(37,3) | |
11583 | IDC=I+MDCY(37,2)-1 | |
11584 | RM1=(PMAS(IABS(KFDP(IDC,1)),1)/RMAS)**2 | |
11585 | RM2=(PMAS(IABS(KFDP(IDC,2)),1)/RMAS)**2 | |
11586 | IF(SQRT(RM1)+SQRT(RM2).GT.1..OR.MDME(IDC,1).LT.0) GOTO 190 | |
11587 | IF(I.LE.4) THEN | |
11588 | C...H+/- -> q + qb' | |
11589 | WDTP(I)=3.*((RM1*PARU(121)+RM2/PARU(121))* | |
11590 | & (1.-RM1-RM2)-4.*RM1*RM2)* | |
11591 | & SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))*RADC | |
11592 | WID2=1. | |
11593 | ELSE | |
11594 | C...H+/- -> l+/- + nu | |
11595 | WDTP(I)=((RM1*PARU(121)+RM2/PARU(121))* | |
11596 | & (1.-RM1-RM2)-4.*RM1*RM2)* | |
11597 | & SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2)) | |
11598 | WID2=1. | |
11599 | ENDIF | |
11600 | WDTP(0)=WDTP(0)+WDTP(I) | |
11601 | IF(MDME(IDC,1).GT.0) THEN | |
11602 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
11603 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
11604 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
11605 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
11606 | ENDIF | |
11607 | 190 CONTINUE | |
11608 | ||
11609 | ELSEIF(KFLA.EQ.40) THEN | |
11610 | C...R: | |
11611 | DO 200 I=1,MDCY(40,3) | |
11612 | IDC=I+MDCY(40,2)-1 | |
11613 | RM1=(PMAS(IABS(KFDP(IDC,1)),1)/RMAS)**2 | |
11614 | RM2=(PMAS(IABS(KFDP(IDC,2)),1)/RMAS)**2 | |
11615 | IF(SQRT(RM1)+SQRT(RM2).GT.1..OR.MDME(IDC,1).LT.0) GOTO 200 | |
11616 | IF(I.LE.4) THEN | |
11617 | C...R -> q + qb' | |
11618 | WDTP(I)=3.*RADC | |
11619 | WID2=1. | |
11620 | ELSE | |
11621 | C...R -> l+ + l'- | |
11622 | WDTP(I)=1. | |
11623 | WID2=1. | |
11624 | ENDIF | |
11625 | WDTP(0)=WDTP(0)+WDTP(I) | |
11626 | IF(MDME(IDC,1).GT.0) THEN | |
11627 | WDTE(I,MDME(IDC,1))=WDTP(I)*WID2 | |
11628 | WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1)) | |
11629 | WDTE(I,0)=WDTE(I,MDME(IDC,1)) | |
11630 | WDTE(0,0)=WDTE(0,0)+WDTE(I,0) | |
11631 | ENDIF | |
11632 | 200 CONTINUE | |
11633 | ||
11634 | ENDIF | |
11635 | MINT(61)=0 | |
11636 | ||
11637 | RETURN | |
11638 | END | |
11639 | ||
11640 | C*********************************************************************** | |
11641 | ||
ce320da8 | 11642 | SUBROUTINE PYKLIMA(ILIM) |
0119ef9a | 11643 | |
11644 | C...Checks generated variables against pre-set kinematical limits; | |
11645 | C...also calculates limits on variables used in generation. | |
11646 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
11647 | SAVE /LUDAT1A/ | |
11648 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
11649 | SAVE /LUDAT2A/ | |
11650 | COMMON/LUDAT3A/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) | |
11651 | SAVE /LUDAT3A/ | |
11652 | COMMON/PYPARSA/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
11653 | SAVE /PYPARSA/ | |
11654 | COMMON/PYSUBSA/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200) | |
11655 | SAVE /PYSUBSA/ | |
11656 | COMMON/PYINT1A/MINT(400),VINT(400) | |
11657 | SAVE /PYINT1A/ | |
11658 | COMMON/PYINT2A/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2) | |
11659 | SAVE /PYINT2A/ | |
11660 | ||
11661 | tau=0. | |
11662 | rm3=0. | |
11663 | rm4=0. | |
11664 | be34=0. | |
11665 | st2eff=0. | |
11666 | ||
11667 | C...Common kinematical expressions. | |
11668 | ISUB=MINT(1) | |
11669 | IF(ISUB.EQ.96) GOTO 110 | |
11670 | SQM3=VINT(63) | |
11671 | SQM4=VINT(64) | |
11672 | IF(ILIM.NE.1) THEN | |
11673 | TAU=VINT(21) | |
11674 | RM3=SQM3/(TAU*VINT(2)) | |
11675 | RM4=SQM4/(TAU*VINT(2)) | |
11676 | BE34=SQRT((1.-RM3-RM4)**2-4.*RM3*RM4) | |
11677 | ENDIF | |
11678 | PTHMIN=CKIN(3) | |
11679 | IF(MIN(SQM3,SQM4).LT.CKIN(6)**2) PTHMIN=MAX(CKIN(3),CKIN(5)) | |
11680 | IF(ILIM.EQ.0) THEN | |
11681 | C...Check generated values of tau, y*, cos(theta-hat), and tau' against | |
11682 | C...pre-set kinematical limits. | |
11683 | YST=VINT(22) | |
11684 | CTH=VINT(23) | |
11685 | TAUP=VINT(26) | |
11686 | IF(ISET(ISUB).LE.2) THEN | |
11687 | X1=SQRT(TAU)*EXP(YST) | |
11688 | X2=SQRT(TAU)*EXP(-YST) | |
11689 | ELSE | |
11690 | X1=SQRT(TAUP)*EXP(YST) | |
11691 | X2=SQRT(TAUP)*EXP(-YST) | |
11692 | ENDIF | |
11693 | XF=X1-X2 | |
11694 | IF(TAU*VINT(2).LT.CKIN(1)**2) MINT(51)=1 | |
11695 | IF(CKIN(2).GE.0..AND.TAU*VINT(2).GT.CKIN(2)**2) MINT(51)=1 | |
11696 | IF(X1.LT.CKIN(21).OR.X1.GT.CKIN(22)) MINT(51)=1 | |
11697 | IF(X2.LT.CKIN(23).OR.X2.GT.CKIN(24)) MINT(51)=1 | |
11698 | IF(XF.LT.CKIN(25).OR.XF.GT.CKIN(26)) MINT(51)=1 | |
11699 | IF(YST.LT.CKIN(7).OR.YST.GT.CKIN(8)) MINT(51)=1 | |
11700 | IF(ISET(ISUB).EQ.2.OR.ISET(ISUB).EQ.4) THEN | |
11701 | PTH=0.5*BE34*SQRT(TAU*VINT(2)*(1.-CTH**2)) | |
11702 | Y3=YST+0.5*LOG((1.+RM3-RM4+BE34*CTH)/(1.+RM3-RM4-BE34*CTH)) | |
11703 | Y4=YST+0.5*LOG((1.+RM4-RM3-BE34*CTH)/(1.+RM4-RM3+BE34*CTH)) | |
11704 | YLARGE=MAX(Y3,Y4) | |
11705 | YSMALL=MIN(Y3,Y4) | |
11706 | ETALAR=10. | |
11707 | ETASMA=-10. | |
11708 | STH=SQRT(1.-CTH**2) | |
11709 | IF(STH.LT.1.E-6) GOTO 100 | |
11710 | EXPET3=((1.+RM3-RM4)*SINH(YST)+BE34*COSH(YST)*CTH+ | |
11711 | & SQRT(((1.+RM3-RM4)*COSH(YST)+BE34*SINH(YST)*CTH)**2-4.*RM3))/ | |
11712 | & (BE34*STH) | |
11713 | EXPET4=((1.-RM3+RM4)*SINH(YST)-BE34*COSH(YST)*CTH+ | |
11714 | & SQRT(((1.-RM3+RM4)*COSH(YST)-BE34*SINH(YST)*CTH)**2-4.*RM4))/ | |
11715 | & (BE34*STH) | |
11716 | ETA3=LOG(MIN(1.E10,MAX(1.E-10,EXPET3))) | |
11717 | ETA4=LOG(MIN(1.E10,MAX(1.E-10,EXPET4))) | |
11718 | ETALAR=MAX(ETA3,ETA4) | |
11719 | ETASMA=MIN(ETA3,ETA4) | |
11720 | 100 CTS3=((1.+RM3-RM4)*SINH(YST)+BE34*COSH(YST)*CTH)/ | |
11721 | & SQRT(((1.+RM3-RM4)*COSH(YST)+BE34*SINH(YST)*CTH)**2-4.*RM3) | |
11722 | CTS4=((1.-RM3+RM4)*SINH(YST)-BE34*COSH(YST)*CTH)/ | |
11723 | & SQRT(((1.-RM3+RM4)*COSH(YST)-BE34*SINH(YST)*CTH)**2-4.*RM4) | |
11724 | CTSLAR=MAX(CTS3,CTS4) | |
11725 | CTSSMA=MIN(CTS3,CTS4) | |
11726 | IF(PTH.LT.PTHMIN) MINT(51)=1 | |
11727 | IF(CKIN(4).GE.0..AND.PTH.GT.CKIN(4)) MINT(51)=1 | |
11728 | IF(YLARGE.LT.CKIN(9).OR.YLARGE.GT.CKIN(10)) MINT(51)=1 | |
11729 | IF(YSMALL.LT.CKIN(11).OR.YSMALL.GT.CKIN(12)) MINT(51)=1 | |
11730 | IF(ETALAR.LT.CKIN(13).OR.ETALAR.GT.CKIN(14)) MINT(51)=1 | |
11731 | IF(ETASMA.LT.CKIN(15).OR.ETASMA.GT.CKIN(16)) MINT(51)=1 | |
11732 | IF(CTSLAR.LT.CKIN(17).OR.CTSLAR.GT.CKIN(18)) MINT(51)=1 | |
11733 | IF(CTSSMA.LT.CKIN(19).OR.CTSSMA.GT.CKIN(20)) MINT(51)=1 | |
11734 | IF(CTH.LT.CKIN(27).OR.CTH.GT.CKIN(28)) MINT(51)=1 | |
11735 | ENDIF | |
11736 | IF(ISET(ISUB).EQ.3.OR.ISET(ISUB).EQ.4) THEN | |
11737 | IF(TAUP*VINT(2).LT.CKIN(31)**2) MINT(51)=1 | |
11738 | IF(CKIN(32).GE.0..AND.TAUP*VINT(2).GT.CKIN(32)**2) MINT(51)=1 | |
11739 | ENDIF | |
11740 | ||
11741 | ELSEIF(ILIM.EQ.1) THEN | |
11742 | C...Calculate limits on tau | |
11743 | C...0) due to definition | |
11744 | TAUMN0=0. | |
11745 | TAUMX0=1. | |
11746 | C...1) due to limits on subsystem mass | |
11747 | TAUMN1=CKIN(1)**2/VINT(2) | |
11748 | TAUMX1=1. | |
11749 | IF(CKIN(2).GE.0.) TAUMX1=CKIN(2)**2/VINT(2) | |
11750 | C...2) due to limits on pT-hat (and non-overlapping rapidity intervals) | |
11751 | TM3=SQRT(SQM3+PTHMIN**2) | |
11752 | TM4=SQRT(SQM4+PTHMIN**2) | |
11753 | YDCOSH=1. | |
11754 | IF(CKIN(9).GT.CKIN(12)) YDCOSH=COSH(CKIN(9)-CKIN(12)) | |
11755 | TAUMN2=(TM3**2+2.*TM3*TM4*YDCOSH+TM4**2)/VINT(2) | |
11756 | TAUMX2=1. | |
11757 | C...3) due to limits on pT-hat and cos(theta-hat) | |
11758 | CTH2MN=MIN(CKIN(27)**2,CKIN(28)**2) | |
11759 | CTH2MX=MAX(CKIN(27)**2,CKIN(28)**2) | |
11760 | TAUMN3=0. | |
11761 | IF(CKIN(27)*CKIN(28).GT.0.) TAUMN3= | |
11762 | & (SQRT(SQM3+PTHMIN**2/(1.-CTH2MN))+ | |
11763 | & SQRT(SQM4+PTHMIN**2/(1.-CTH2MN)))**2/VINT(2) | |
11764 | TAUMX3=1. | |
11765 | IF(CKIN(4).GE.0..AND.CTH2MX.LT.1.) TAUMX3= | |
11766 | & (SQRT(SQM3+CKIN(4)**2/(1.-CTH2MX))+ | |
11767 | & SQRT(SQM4+CKIN(4)**2/(1.-CTH2MX)))**2/VINT(2) | |
11768 | C...4) due to limits on x1 and x2 | |
11769 | TAUMN4=CKIN(21)*CKIN(23) | |
11770 | TAUMX4=CKIN(22)*CKIN(24) | |
11771 | C...5) due to limits on xF | |
11772 | TAUMN5=0. | |
11773 | TAUMX5=MAX(1.-CKIN(25),1.+CKIN(26)) | |
11774 | VINT(11)=MAX(TAUMN0,TAUMN1,TAUMN2,TAUMN3,TAUMN4,TAUMN5) | |
11775 | VINT(31)=MIN(TAUMX0,TAUMX1,TAUMX2,TAUMX3,TAUMX4,TAUMX5) | |
11776 | IF(MINT(43).EQ.1.AND.(ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.2)) THEN | |
11777 | VINT(11)=0.99999 | |
11778 | VINT(31)=1.00001 | |
11779 | ENDIF | |
11780 | IF(VINT(31).LE.VINT(11)) MINT(51)=1 | |
11781 | ||
11782 | ELSEIF(ILIM.EQ.2) THEN | |
11783 | C...Calculate limits on y* | |
11784 | IF(ISET(ISUB).EQ.3.OR.ISET(ISUB).EQ.4) TAU=VINT(26) | |
11785 | TAURT=SQRT(TAU) | |
11786 | C...0) due to kinematics | |
11787 | YSTMN0=LOG(TAURT) | |
11788 | YSTMX0=-YSTMN0 | |
11789 | C...1) due to explicit limits | |
11790 | YSTMN1=CKIN(7) | |
11791 | YSTMX1=CKIN(8) | |
11792 | C...2) due to limits on x1 | |
11793 | YSTMN2=LOG(MAX(TAU,CKIN(21))/TAURT) | |
11794 | YSTMX2=LOG(MAX(TAU,CKIN(22))/TAURT) | |
11795 | C...3) due to limits on x2 | |
11796 | YSTMN3=-LOG(MAX(TAU,CKIN(24))/TAURT) | |
11797 | YSTMX3=-LOG(MAX(TAU,CKIN(23))/TAURT) | |
11798 | C...4) due to limits on xF | |
11799 | YEPMN4=0.5*ABS(CKIN(25))/TAURT | |
11800 | YSTMN4=SIGN(LOG(SQRT(1.+YEPMN4**2)+YEPMN4),CKIN(25)) | |
11801 | YEPMX4=0.5*ABS(CKIN(26))/TAURT | |
11802 | YSTMX4=SIGN(LOG(SQRT(1.+YEPMX4**2)+YEPMX4),CKIN(26)) | |
11803 | C...5) due to simultaneous limits on y-large and y-small | |
11804 | YEPSMN=(RM3-RM4)*SINH(CKIN(9)-CKIN(11)) | |
11805 | YEPSMX=(RM3-RM4)*SINH(CKIN(10)-CKIN(12)) | |
11806 | YDIFMN=ABS(LOG(SQRT(1.+YEPSMN**2)-YEPSMN)) | |
11807 | YDIFMX=ABS(LOG(SQRT(1.+YEPSMX**2)-YEPSMX)) | |
11808 | YSTMN5=0.5*(CKIN(9)+CKIN(11)-YDIFMN) | |
11809 | YSTMX5=0.5*(CKIN(10)+CKIN(12)+YDIFMX) | |
11810 | C...6) due to simultaneous limits on cos(theta-hat) and y-large or | |
11811 | C... y-small | |
11812 | CTHLIM=SQRT(1.-4.*PTHMIN**2/(BE34*TAU*VINT(2))) | |
11813 | RZMN=BE34*MAX(CKIN(27),-CTHLIM) | |
11814 | RZMX=BE34*MIN(CKIN(28),CTHLIM) | |
11815 | YEX3MX=(1.+RM3-RM4+RZMX)/MAX(1E-10,1.+RM3-RM4-RZMX) | |
11816 | YEX4MX=(1.+RM4-RM3-RZMN)/MAX(1E-10,1.+RM4-RM3+RZMN) | |
11817 | YEX3MN=MAX(1E-10,1.+RM3-RM4+RZMN)/(1.+RM3-RM4-RZMN) | |
11818 | YEX4MN=MAX(1E-10,1.+RM4-RM3-RZMX)/(1.+RM4-RM3+RZMX) | |
11819 | YSTMN6=CKIN(9)-0.5*LOG(MAX(YEX3MX,YEX4MX)) | |
11820 | YSTMX6=CKIN(12)-0.5*LOG(MIN(YEX3MN,YEX4MN)) | |
11821 | VINT(12)=MAX(YSTMN0,YSTMN1,YSTMN2,YSTMN3,YSTMN4,YSTMN5,YSTMN6) | |
11822 | VINT(32)=MIN(YSTMX0,YSTMX1,YSTMX2,YSTMX3,YSTMX4,YSTMX5,YSTMX6) | |
11823 | IF(MINT(43).EQ.1) THEN | |
11824 | VINT(12)=-0.00001 | |
11825 | VINT(32)=0.00001 | |
11826 | ELSEIF(MINT(43).EQ.2) THEN | |
11827 | VINT(12)=0.99999*YSTMX0 | |
11828 | VINT(32)=1.00001*YSTMX0 | |
11829 | ELSEIF(MINT(43).EQ.3) THEN | |
11830 | VINT(12)=-1.00001*YSTMX0 | |
11831 | VINT(32)=-0.99999*YSTMX0 | |
11832 | ENDIF | |
11833 | IF(VINT(32).LE.VINT(12)) MINT(51)=1 | |
11834 | ||
11835 | ELSEIF(ILIM.EQ.3) THEN | |
11836 | C...Calculate limits on cos(theta-hat) | |
11837 | YST=VINT(22) | |
11838 | C...0) due to definition | |
11839 | CTNMN0=-1. | |
11840 | CTNMX0=0. | |
11841 | CTPMN0=0. | |
11842 | CTPMX0=1. | |
11843 | C...1) due to explicit limits | |
11844 | CTNMN1=MIN(0.,CKIN(27)) | |
11845 | CTNMX1=MIN(0.,CKIN(28)) | |
11846 | CTPMN1=MAX(0.,CKIN(27)) | |
11847 | CTPMX1=MAX(0.,CKIN(28)) | |
11848 | C...2) due to limits on pT-hat | |
11849 | CTNMN2=-SQRT(1.-4.*PTHMIN**2/(BE34**2*TAU*VINT(2))) | |
11850 | CTPMX2=-CTNMN2 | |
11851 | CTNMX2=0. | |
11852 | CTPMN2=0. | |
11853 | IF(CKIN(4).GE.0.) THEN | |
11854 | CTNMX2=-SQRT(MAX(0.,1.-4.*CKIN(4)**2/(BE34**2*TAU*VINT(2)))) | |
11855 | CTPMN2=-CTNMX2 | |
11856 | ENDIF | |
11857 | C...3) due to limits on y-large and y-small | |
11858 | CTNMN3=MIN(0.,MAX((1.+RM3-RM4)/BE34*TANH(CKIN(11)-YST), | |
11859 | & -(1.-RM3+RM4)/BE34*TANH(CKIN(10)-YST))) | |
11860 | CTNMX3=MIN(0.,(1.+RM3-RM4)/BE34*TANH(CKIN(12)-YST), | |
11861 | & -(1.-RM3+RM4)/BE34*TANH(CKIN(9)-YST)) | |
11862 | CTPMN3=MAX(0.,(1.+RM3-RM4)/BE34*TANH(CKIN(9)-YST), | |
11863 | & -(1.-RM3+RM4)/BE34*TANH(CKIN(12)-YST)) | |
11864 | CTPMX3=MAX(0.,MIN((1.+RM3-RM4)/BE34*TANH(CKIN(10)-YST), | |
11865 | & -(1.-RM3+RM4)/BE34*TANH(CKIN(11)-YST))) | |
11866 | VINT(13)=MAX(CTNMN0,CTNMN1,CTNMN2,CTNMN3) | |
11867 | VINT(33)=MIN(CTNMX0,CTNMX1,CTNMX2,CTNMX3) | |
11868 | VINT(14)=MAX(CTPMN0,CTPMN1,CTPMN2,CTPMN3) | |
11869 | VINT(34)=MIN(CTPMX0,CTPMX1,CTPMX2,CTPMX3) | |
11870 | IF(VINT(33).LE.VINT(13).AND.VINT(34).LE.VINT(14)) MINT(51)=1 | |
11871 | ||
11872 | ELSEIF(ILIM.EQ.4) THEN | |
11873 | C...Calculate limits on tau' | |
11874 | C...0) due to kinematics | |
11875 | TAPMN0=TAU | |
11876 | TAPMX0=1. | |
11877 | C...1) due to explicit limits | |
11878 | TAPMN1=CKIN(31)**2/VINT(2) | |
11879 | TAPMX1=1. | |
11880 | IF(CKIN(32).GE.0.) TAPMX1=CKIN(32)**2/VINT(2) | |
11881 | VINT(16)=MAX(TAPMN0,TAPMN1) | |
11882 | VINT(36)=MIN(TAPMX0,TAPMX1) | |
11883 | IF(MINT(43).EQ.1) THEN | |
11884 | VINT(16)=0.99999 | |
11885 | VINT(36)=1.00001 | |
11886 | ENDIF | |
11887 | IF(VINT(36).LE.VINT(16)) MINT(51)=1 | |
11888 | ||
11889 | ENDIF | |
11890 | RETURN | |
11891 | ||
11892 | C...Special case for low-pT and multiple interactions: | |
11893 | C...effective kinematical limits for tau, y*, cos(theta-hat). | |
11894 | 110 IF(ILIM.EQ.0) THEN | |
11895 | ELSEIF(ILIM.EQ.1) THEN | |
11896 | IF(MSTP(82).LE.1) VINT(11)=4.*PARP(81)**2/VINT(2) | |
11897 | IF(MSTP(82).GE.2) VINT(11)=PARP(82)**2/VINT(2) | |
11898 | VINT(31)=1. | |
11899 | ELSEIF(ILIM.EQ.2) THEN | |
11900 | VINT(12)=0.5*LOG(VINT(21)) | |
11901 | VINT(32)=-VINT(12) | |
11902 | ELSEIF(ILIM.EQ.3) THEN | |
11903 | IF(MSTP(82).LE.1) ST2EFF=4.*PARP(81)**2/(VINT(21)*VINT(2)) | |
11904 | IF(MSTP(82).GE.2) ST2EFF=0.01*PARP(82)**2/(VINT(21)*VINT(2)) | |
11905 | VINT(13)=-SQRT(MAX(0.,1.-ST2EFF)) | |
11906 | VINT(33)=0. | |
11907 | VINT(14)=0. | |
11908 | VINT(34)=-VINT(13) | |
11909 | ENDIF | |
11910 | ||
11911 | RETURN | |
11912 | END | |
11913 | ||
11914 | C********************************************************************* | |
11915 | ||
ce320da8 | 11916 | SUBROUTINE PYKMAPA(IVAR,MVAR,VVAR) |
0119ef9a | 11917 | |
11918 | C...Maps a uniform distribution into a distribution of a kinematical | |
11919 | C...variable according to one of the possibilities allowed. It is | |
11920 | C...assumed that kinematical limits have been set by a PYKLIM call. | |
11921 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
11922 | SAVE /LUDAT2A/ | |
11923 | COMMON/PYINT1A/MINT(400),VINT(400) | |
11924 | SAVE /PYINT1A/ | |
11925 | COMMON/PYINT2A/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2) | |
11926 | SAVE /PYINT2A/ | |
11927 | ||
11928 | taure=0. | |
11929 | gamre=0. | |
11930 | cth=0. | |
11931 | ||
11932 | C...Convert VVAR to tau variable. | |
11933 | ISUB=MINT(1) | |
11934 | IF(IVAR.EQ.1) THEN | |
11935 | TAUMIN=VINT(11) | |
11936 | TAUMAX=VINT(31) | |
11937 | IF(MVAR.EQ.3.OR.MVAR.EQ.4) THEN | |
11938 | TAURE=VINT(73) | |
11939 | GAMRE=VINT(74) | |
11940 | ELSEIF(MVAR.EQ.5.OR.MVAR.EQ.6) THEN | |
11941 | TAURE=VINT(75) | |
11942 | GAMRE=VINT(76) | |
11943 | ENDIF | |
11944 | IF(MINT(43).EQ.1.AND.(ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.2)) THEN | |
11945 | TAU=1. | |
11946 | ELSEIF(MVAR.EQ.1) THEN | |
11947 | TAU=TAUMIN*(TAUMAX/TAUMIN)**VVAR | |
11948 | ELSEIF(MVAR.EQ.2) THEN | |
11949 | TAU=TAUMAX*TAUMIN/(TAUMIN+(TAUMAX-TAUMIN)*VVAR) | |
11950 | ELSEIF(MVAR.EQ.3.OR.MVAR.EQ.5) THEN | |
11951 | RATGEN=(TAURE+TAUMAX)/(TAURE+TAUMIN)*TAUMIN/TAUMAX | |
11952 | TAU=TAURE*TAUMIN/((TAURE+TAUMIN)*RATGEN**VVAR-TAUMIN) | |
11953 | ELSE | |
11954 | AUPP=ATAN((TAUMAX-TAURE)/GAMRE) | |
11955 | ALOW=ATAN((TAUMIN-TAURE)/GAMRE) | |
11956 | TAU=TAURE+GAMRE*TAN(ALOW+(AUPP-ALOW)*VVAR) | |
11957 | ENDIF | |
11958 | VINT(21)=MIN(TAUMAX,MAX(TAUMIN,TAU)) | |
11959 | ||
11960 | C...Convert VVAR to y* variable. | |
11961 | ELSEIF(IVAR.EQ.2) THEN | |
11962 | YSTMIN=VINT(12) | |
11963 | YSTMAX=VINT(32) | |
11964 | IF(MINT(43).EQ.1) THEN | |
11965 | YST=0. | |
11966 | ELSEIF(MINT(43).EQ.2) THEN | |
11967 | IF(ISET(ISUB).LE.2) YST=-0.5*LOG(VINT(21)) | |
11968 | IF(ISET(ISUB).GE.3) YST=-0.5*LOG(VINT(26)) | |
11969 | ELSEIF(MINT(43).EQ.3) THEN | |
11970 | IF(ISET(ISUB).LE.2) YST=0.5*LOG(VINT(21)) | |
11971 | IF(ISET(ISUB).GE.3) YST=0.5*LOG(VINT(26)) | |
11972 | ELSEIF(MVAR.EQ.1) THEN | |
11973 | YST=YSTMIN+(YSTMAX-YSTMIN)*SQRT(VVAR) | |
11974 | ELSEIF(MVAR.EQ.2) THEN | |
11975 | YST=YSTMAX-(YSTMAX-YSTMIN)*SQRT(1.-VVAR) | |
11976 | ELSE | |
11977 | AUPP=ATAN(EXP(YSTMAX)) | |
11978 | ALOW=ATAN(EXP(YSTMIN)) | |
11979 | YST=LOG(TAN(ALOW+(AUPP-ALOW)*VVAR)) | |
11980 | ENDIF | |
11981 | VINT(22)=MIN(YSTMAX,MAX(YSTMIN,YST)) | |
11982 | ||
11983 | C...Convert VVAR to cos(theta-hat) variable. | |
11984 | ELSEIF(IVAR.EQ.3) THEN | |
11985 | RM34=2.*VINT(63)*VINT(64)/(VINT(21)*VINT(2))**2 | |
11986 | RSQM=1.+RM34 | |
11987 | IF(2.*VINT(71)**2/(VINT(21)*VINT(2)).LT.0.0001) RM34=MAX(RM34, | |
11988 | & 2.*VINT(71)**2/(VINT(21)*VINT(2))) | |
11989 | CTNMIN=VINT(13) | |
11990 | CTNMAX=VINT(33) | |
11991 | CTPMIN=VINT(14) | |
11992 | CTPMAX=VINT(34) | |
11993 | IF(MVAR.EQ.1) THEN | |
11994 | ANEG=CTNMAX-CTNMIN | |
11995 | APOS=CTPMAX-CTPMIN | |
11996 | IF(ANEG.GT.0..AND.VVAR*(ANEG+APOS).LE.ANEG) THEN | |
11997 | VCTN=VVAR*(ANEG+APOS)/ANEG | |
11998 | CTH=CTNMIN+(CTNMAX-CTNMIN)*VCTN | |
11999 | ELSE | |
12000 | VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS | |
12001 | CTH=CTPMIN+(CTPMAX-CTPMIN)*VCTP | |
12002 | ENDIF | |
12003 | ELSEIF(MVAR.EQ.2) THEN | |
12004 | RMNMIN=MAX(RM34,RSQM-CTNMIN) | |
12005 | RMNMAX=MAX(RM34,RSQM-CTNMAX) | |
12006 | RMPMIN=MAX(RM34,RSQM-CTPMIN) | |
12007 | RMPMAX=MAX(RM34,RSQM-CTPMAX) | |
12008 | ANEG=LOG(RMNMIN/RMNMAX) | |
12009 | APOS=LOG(RMPMIN/RMPMAX) | |
12010 | IF(ANEG.GT.0..AND.VVAR*(ANEG+APOS).LE.ANEG) THEN | |
12011 | VCTN=VVAR*(ANEG+APOS)/ANEG | |
12012 | CTH=RSQM-RMNMIN*(RMNMAX/RMNMIN)**VCTN | |
12013 | ELSE | |
12014 | VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS | |
12015 | CTH=RSQM-RMPMIN*(RMPMAX/RMPMIN)**VCTP | |
12016 | ENDIF | |
12017 | ELSEIF(MVAR.EQ.3) THEN | |
12018 | RMNMIN=MAX(RM34,RSQM+CTNMIN) | |
12019 | RMNMAX=MAX(RM34,RSQM+CTNMAX) | |
12020 | RMPMIN=MAX(RM34,RSQM+CTPMIN) | |
12021 | RMPMAX=MAX(RM34,RSQM+CTPMAX) | |
12022 | ANEG=LOG(RMNMAX/RMNMIN) | |
12023 | APOS=LOG(RMPMAX/RMPMIN) | |
12024 | IF(ANEG.GT.0..AND.VVAR*(ANEG+APOS).LE.ANEG) THEN | |
12025 | VCTN=VVAR*(ANEG+APOS)/ANEG | |
12026 | CTH=RMNMIN*(RMNMAX/RMNMIN)**VCTN-RSQM | |
12027 | ELSE | |
12028 | VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS | |
12029 | CTH=RMPMIN*(RMPMAX/RMPMIN)**VCTP-RSQM | |
12030 | ENDIF | |
12031 | ELSEIF(MVAR.EQ.4) THEN | |
12032 | RMNMIN=MAX(RM34,RSQM-CTNMIN) | |
12033 | RMNMAX=MAX(RM34,RSQM-CTNMAX) | |
12034 | RMPMIN=MAX(RM34,RSQM-CTPMIN) | |
12035 | RMPMAX=MAX(RM34,RSQM-CTPMAX) | |
12036 | ANEG=1./RMNMAX-1./RMNMIN | |
12037 | APOS=1./RMPMAX-1./RMPMIN | |
12038 | IF(ANEG.GT.0..AND.VVAR*(ANEG+APOS).LE.ANEG) THEN | |
12039 | VCTN=VVAR*(ANEG+APOS)/ANEG | |
12040 | CTH=RSQM-1./(1./RMNMIN+ANEG*VCTN) | |
12041 | ELSE | |
12042 | VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS | |
12043 | CTH=RSQM-1./(1./RMPMIN+APOS*VCTP) | |
12044 | ENDIF | |
12045 | ELSEIF(MVAR.EQ.5) THEN | |
12046 | RMNMIN=MAX(RM34,RSQM+CTNMIN) | |
12047 | RMNMAX=MAX(RM34,RSQM+CTNMAX) | |
12048 | RMPMIN=MAX(RM34,RSQM+CTPMIN) | |
12049 | RMPMAX=MAX(RM34,RSQM+CTPMAX) | |
12050 | ANEG=1./RMNMIN-1./RMNMAX | |
12051 | APOS=1./RMPMIN-1./RMPMAX | |
12052 | IF(ANEG.GT.0..AND.VVAR*(ANEG+APOS).LE.ANEG) THEN | |
12053 | VCTN=VVAR*(ANEG+APOS)/ANEG | |
12054 | CTH=1./(1./RMNMIN-ANEG*VCTN)-RSQM | |
12055 | ELSE | |
12056 | VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS | |
12057 | CTH=1./(1./RMPMIN-APOS*VCTP)-RSQM | |
12058 | ENDIF | |
12059 | ENDIF | |
12060 | IF(CTH.LT.0.) CTH=MIN(CTNMAX,MAX(CTNMIN,CTH)) | |
12061 | IF(CTH.GT.0.) CTH=MIN(CTPMAX,MAX(CTPMIN,CTH)) | |
12062 | VINT(23)=CTH | |
12063 | ||
12064 | C...Convert VVAR to tau' variable. | |
12065 | ELSEIF(IVAR.EQ.4) THEN | |
12066 | TAU=VINT(11) | |
12067 | TAUPMN=VINT(16) | |
12068 | TAUPMX=VINT(36) | |
12069 | IF(MINT(43).EQ.1) THEN | |
12070 | TAUP=1. | |
12071 | ELSEIF(MVAR.EQ.1) THEN | |
12072 | TAUP=TAUPMN*(TAUPMX/TAUPMN)**VVAR | |
12073 | ELSE | |
12074 | AUPP=(1.-TAU/TAUPMX)**4 | |
12075 | ALOW=(1.-TAU/TAUPMN)**4 | |
12076 | TAUP=TAU/(1.-(ALOW+(AUPP-ALOW)*VVAR)**0.25) | |
12077 | ENDIF | |
12078 | VINT(26)=MIN(TAUPMX,MAX(TAUPMN,TAUP)) | |
12079 | ENDIF | |
12080 | ||
12081 | RETURN | |
12082 | END | |
12083 | ||
12084 | C*********************************************************************** | |
12085 | ||
ce320da8 | 12086 | SUBROUTINE PYSIGHA(NCHN,SIGS) |
0119ef9a | 12087 | |
12088 | C...Differential matrix elements for all included subprocesses. | |
12089 | C...Note that what is coded is (disregarding the COMFAC factor) | |
12090 | C...1) for 2 -> 1 processes: s-hat/pi*d(sigma-hat), where, | |
12091 | C...when d(sigma-hat) is given in the zero-width limit, the delta | |
12092 | C...function in tau is replaced by a Breit-Wigner: | |
12093 | C...1/pi*(s*m_res*Gamma_res)/((s*tau-m_res^2)^2+(m_res*Gamma_res)^2); | |
12094 | C...2) for 2 -> 2 processes: (s-hat)**2/pi*d(sigma-hat)/d(t-hat); | |
12095 | C...i.e., dimensionless quantities. COMFAC contains the factor | |
12096 | C...pi/s and the conversion factor from GeV^-2 to mb. | |
12097 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
12098 | SAVE /LUDAT1A/ | |
12099 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
12100 | SAVE /LUDAT2A/ | |
12101 | COMMON/LUDAT3A/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) | |
12102 | SAVE /LUDAT3A/ | |
12103 | COMMON/PYSUBSA/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200) | |
12104 | SAVE /PYSUBSA/ | |
12105 | COMMON/PYPARSA/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
12106 | SAVE /PYPARSA/ | |
12107 | COMMON/PYINT1A/MINT(400),VINT(400) | |
12108 | SAVE /PYINT1A/ | |
12109 | COMMON/PYINT2A/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2) | |
12110 | SAVE /PYINT2A/ | |
12111 | COMMON/PYINT3A/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) | |
12112 | SAVE /PYINT3A/ | |
12113 | COMMON/PYINT4AA/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3) | |
12114 | SAVE /PYINT4AA/ | |
12115 | COMMON/PYINT5A/NGEN(0:200,3),XSEC(0:200,3) | |
12116 | SAVE /PYINT5A/ | |
12117 | DIMENSION X(2),XPQ(-6:6),KFAC(2,-40:40),WDTP(0:40),WDTE(0:40,0:5) | |
12118 | ||
12119 | as=0. | |
12120 | faca=0. | |
12121 | min1=0. | |
12122 | max1=0. | |
12123 | min2=0. | |
12124 | max2=0. | |
12125 | mina=0. | |
12126 | maxa=0. | |
12127 | sqmz=0. | |
12128 | gmmz=0. | |
12129 | sqmw=0. | |
12130 | gmmw=0. | |
12131 | sqmh=0. | |
12132 | gmmh=0. | |
12133 | sqmzp=0. | |
12134 | gmmzp=0. | |
12135 | sqmhc=0. | |
12136 | gmmhc=0. | |
12137 | sqmr=0. | |
12138 | gmmr=0. | |
12139 | aem=0. | |
12140 | xw=0. | |
12141 | comfac=0. | |
12142 | ||
12143 | C...Reset number of channels and cross-section. | |
12144 | NCHN=0 | |
12145 | SIGS=0. | |
12146 | ||
12147 | C...Read kinematical variables and limits. | |
12148 | ISUB=MINT(1) | |
12149 | TAUMIN=VINT(11) | |
12150 | YSTMIN=VINT(12) | |
12151 | CTNMIN=VINT(13) | |
12152 | CTPMIN=VINT(14) | |
12153 | XT2MIN=VINT(15) | |
12154 | TAUPMN=VINT(16) | |
12155 | TAU=VINT(21) | |
12156 | YST=VINT(22) | |
12157 | CTH=VINT(23) | |
12158 | XT2=VINT(25) | |
12159 | TAUP=VINT(26) | |
12160 | TAUMAX=VINT(31) | |
12161 | YSTMAX=VINT(32) | |
12162 | CTNMAX=VINT(33) | |
12163 | CTPMAX=VINT(34) | |
12164 | XT2MAX=VINT(35) | |
12165 | TAUPMX=VINT(36) | |
12166 | ||
12167 | C...Derive kinematical quantities. | |
12168 | IF(ISET(ISUB).LE.2.OR.ISET(ISUB).EQ.5) THEN | |
12169 | X(1)=SQRT(TAU)*EXP(YST) | |
12170 | X(2)=SQRT(TAU)*EXP(-YST) | |
12171 | ELSE | |
12172 | X(1)=SQRT(TAUP)*EXP(YST) | |
12173 | X(2)=SQRT(TAUP)*EXP(-YST) | |
12174 | ENDIF | |
12175 | IF(MINT(43).EQ.4.AND.ISET(ISUB).GE.1.AND. | |
12176 | &(X(1).GT.0.999.OR.X(2).GT.0.999)) RETURN | |
12177 | SH=TAU*VINT(2) | |
12178 | SQM3=VINT(63) | |
12179 | SQM4=VINT(64) | |
12180 | RM3=SQM3/SH | |
12181 | RM4=SQM4/SH | |
12182 | BE34=SQRT((1.-RM3-RM4)**2-4.*RM3*RM4) | |
12183 | RPTS=4.*VINT(71)**2/SH | |
12184 | BE34L=SQRT(MAX(0.,(1.-RM3-RM4)**2-4.*RM3*RM4-RPTS)) | |
12185 | RM34=2.*RM3*RM4 | |
12186 | RSQM=1.+RM34 | |
12187 | RTHM=(4.*RM3*RM4+RPTS)/(1.-RM3-RM4+BE34L) | |
12188 | TH=-0.5*SH*MAX(RTHM,1.-RM3-RM4-BE34*CTH) | |
12189 | UH=-0.5*SH*MAX(RTHM,1.-RM3-RM4+BE34*CTH) | |
12190 | SQPTH=0.25*SH*BE34**2*(1.-CTH**2) | |
12191 | SH2=SH**2 | |
12192 | TH2=TH**2 | |
12193 | UH2=UH**2 | |
12194 | ||
12195 | C...Choice of Q2 scale. | |
12196 | IF(ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.3) THEN | |
12197 | Q2=SH | |
12198 | ELSEIF(MOD(ISET(ISUB),2).EQ.0.OR.ISET(ISUB).EQ.5) THEN | |
12199 | IF(MSTP(32).EQ.1) THEN | |
12200 | Q2=2.*SH*TH*UH/(SH**2+TH**2+UH**2) | |
12201 | ELSEIF(MSTP(32).EQ.2) THEN | |
12202 | Q2=SQPTH+0.5*(SQM3+SQM4) | |
12203 | ELSEIF(MSTP(32).EQ.3) THEN | |
12204 | Q2=MIN(-TH,-UH) | |
12205 | ELSEIF(MSTP(32).EQ.4) THEN | |
12206 | Q2=SH | |
12207 | ENDIF | |
12208 | IF(ISET(ISUB).EQ.5.AND.MSTP(82).GE.2) Q2=Q2+PARP(82)**2 | |
12209 | ENDIF | |
12210 | ||
12211 | C...Store derived kinematical quantities. | |
12212 | VINT(41)=X(1) | |
12213 | VINT(42)=X(2) | |
12214 | VINT(44)=SH | |
12215 | VINT(43)=SQRT(SH) | |
12216 | VINT(45)=TH | |
12217 | VINT(46)=UH | |
12218 | VINT(48)=SQPTH | |
12219 | VINT(47)=SQRT(SQPTH) | |
12220 | VINT(50)=TAUP*VINT(2) | |
12221 | VINT(49)=SQRT(MAX(0.,VINT(50))) | |
12222 | VINT(52)=Q2 | |
12223 | VINT(51)=SQRT(Q2) | |
12224 | ||
12225 | C...Calculate parton structure functions. | |
12226 | IF(ISET(ISUB).LE.0) GOTO 145 | |
12227 | IF(MINT(43).GE.2) THEN | |
12228 | Q2SF=Q2 | |
12229 | IF(ISET(ISUB).EQ.3.OR.ISET(ISUB).EQ.4) THEN | |
12230 | Q2SF=PMAS(23,1)**2 | |
12231 | IF(ISUB.EQ.8.OR.ISUB.EQ.76.OR.ISUB.EQ.77) Q2SF=PMAS(24,1)**2 | |
12232 | ENDIF | |
12233 | DO 100 I=3-MINT(41),MINT(42) | |
12234 | XSF=X(I) | |
12235 | IF(ISET(ISUB).EQ.5) XSF=X(I)/VINT(142+I) | |
12236 | CALL PYSTFU(MINT(10+I),XSF,Q2SF,XPQ,I) | |
12237 | DO 100 KFL=-6,6 | |
12238 | 100 XSFX(I,KFL)=XPQ(KFL) | |
12239 | ENDIF | |
12240 | ||
12241 | C...Calculate alpha_strong and K-factor. | |
12242 | IF(MSTP(33).NE.3) AS=ULALPS(Q2) | |
12243 | FACK=1. | |
12244 | FACA=1. | |
12245 | IF(MSTP(33).EQ.1) THEN | |
12246 | FACK=PARP(31) | |
12247 | ELSEIF(MSTP(33).EQ.2) THEN | |
12248 | FACK=PARP(31) | |
12249 | FACA=PARP(32)/PARP(31) | |
12250 | ELSEIF(MSTP(33).EQ.3) THEN | |
12251 | Q2AS=PARP(33)*Q2 | |
12252 | IF(ISET(ISUB).EQ.5.AND.MSTP(82).GE.2) Q2AS=Q2AS+ | |
12253 | & PARU(112)*PARP(82) | |
12254 | AS=ULALPS(Q2AS) | |
12255 | ENDIF | |
12256 | RADC=1.+AS/PARU(1) | |
12257 | ||
12258 | C...Set flags for allowed reacting partons/leptons. | |
12259 | DO 130 I=1,2 | |
12260 | DO 110 J=-40,40 | |
12261 | 110 KFAC(I,J)=0 | |
12262 | IF(MINT(40+I).EQ.1) THEN | |
12263 | KFAC(I,MINT(10+I))=1 | |
12264 | ELSE | |
12265 | DO 120 J=-40,40 | |
12266 | KFAC(I,J)=KFIN(I,J) | |
12267 | IF(ABS(J).GT.MSTP(54).AND.J.NE.21) KFAC(I,J)=0 | |
12268 | IF(ABS(J).LE.6) THEN | |
12269 | IF(XSFX(I,J).LT.1.E-10) KFAC(I,J)=0 | |
12270 | ELSEIF(J.EQ.21) THEN | |
12271 | IF(XSFX(I,0).LT.1.E-10) KFAC(I,21)=0 | |
12272 | ENDIF | |
12273 | 120 CONTINUE | |
12274 | ENDIF | |
12275 | 130 CONTINUE | |
12276 | ||
12277 | C...Lower and upper limit for flavour loops. | |
12278 | MIN1=0 | |
12279 | MAX1=0 | |
12280 | MIN2=0 | |
12281 | MAX2=0 | |
12282 | DO 140 J=-20,20 | |
12283 | IF(KFAC(1,-J).EQ.1) MIN1=-J | |
12284 | IF(KFAC(1,J).EQ.1) MAX1=J | |
12285 | IF(KFAC(2,-J).EQ.1) MIN2=-J | |
12286 | IF(KFAC(2,J).EQ.1) MAX2=J | |
12287 | 140 CONTINUE | |
12288 | MINA=MIN(MIN1,MIN2) | |
12289 | MAXA=MAX(MAX1,MAX2) | |
12290 | ||
12291 | C...Common conversion factors (including Jacobian) for subprocesses. | |
12292 | SQMZ=PMAS(23,1)**2 | |
12293 | GMMZ=PMAS(23,1)*PMAS(23,2) | |
12294 | SQMW=PMAS(24,1)**2 | |
12295 | GMMW=PMAS(24,1)*PMAS(24,2) | |
12296 | SQMH=PMAS(25,1)**2 | |
12297 | GMMH=PMAS(25,1)*PMAS(25,2) | |
12298 | SQMZP=PMAS(32,1)**2 | |
12299 | GMMZP=PMAS(32,1)*PMAS(32,2) | |
12300 | SQMHC=PMAS(37,1)**2 | |
12301 | GMMHC=PMAS(37,1)*PMAS(37,2) | |
12302 | SQMR=PMAS(40,1)**2 | |
12303 | GMMR=PMAS(40,1)*PMAS(40,2) | |
12304 | AEM=PARU(101) | |
12305 | XW=PARU(102) | |
12306 | ||
12307 | C...Phase space integral in tau and y*. | |
12308 | COMFAC=PARU(1)*PARU(5)/VINT(2) | |
12309 | IF(MINT(43).EQ.4) COMFAC=COMFAC*FACK | |
12310 | IF((MINT(43).GE.2.OR.ISET(ISUB).EQ.3.OR.ISET(ISUB).EQ.4).AND. | |
12311 | &ISET(ISUB).NE.5) THEN | |
12312 | ATAU0=LOG(TAUMAX/TAUMIN) | |
12313 | ATAU1=(TAUMAX-TAUMIN)/(TAUMAX*TAUMIN) | |
12314 | H1=COEF(ISUB,1)+(ATAU0/ATAU1)*COEF(ISUB,2)/TAU | |
12315 | IF(MINT(72).GE.1) THEN | |
12316 | TAUR1=VINT(73) | |
12317 | GAMR1=VINT(74) | |
12318 | ATAU2=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR1)/(TAUMAX+TAUR1))/TAUR1 | |
12319 | ATAU3=(ATAN((TAUMAX-TAUR1)/GAMR1)-ATAN((TAUMIN-TAUR1)/GAMR1))/ | |
12320 | & GAMR1 | |
12321 | H1=H1+(ATAU0/ATAU2)*COEF(ISUB,3)/(TAU+TAUR1)+ | |
12322 | & (ATAU0/ATAU3)*COEF(ISUB,4)*TAU/((TAU-TAUR1)**2+GAMR1**2) | |
12323 | ENDIF | |
12324 | IF(MINT(72).EQ.2) THEN | |
12325 | TAUR2=VINT(75) | |
12326 | GAMR2=VINT(76) | |
12327 | ATAU4=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR2)/(TAUMAX+TAUR2))/TAUR2 | |
12328 | ATAU5=(ATAN((TAUMAX-TAUR2)/GAMR2)-ATAN((TAUMIN-TAUR2)/GAMR2))/ | |
12329 | & GAMR2 | |
12330 | H1=H1+(ATAU0/ATAU4)*COEF(ISUB,5)/(TAU+TAUR2)+ | |
12331 | & (ATAU0/ATAU5)*COEF(ISUB,6)*TAU/((TAU-TAUR2)**2+GAMR2**2) | |
12332 | ENDIF | |
12333 | COMFAC=COMFAC*ATAU0/(TAU*H1) | |
12334 | ENDIF | |
12335 | IF(MINT(43).EQ.4.AND.ISET(ISUB).NE.5) THEN | |
12336 | AYST0=YSTMAX-YSTMIN | |
12337 | AYST1=0.5*(YSTMAX-YSTMIN)**2 | |
12338 | AYST2=AYST1 | |
12339 | AYST3=2.*(ATAN(EXP(YSTMAX))-ATAN(EXP(YSTMIN))) | |
12340 | H2=(AYST0/AYST1)*COEF(ISUB,7)*(YST-YSTMIN)+(AYST0/AYST2)* | |
12341 | & COEF(ISUB,8)*(YSTMAX-YST)+(AYST0/AYST3)*COEF(ISUB,9)/COSH(YST) | |
12342 | COMFAC=COMFAC*AYST0/H2 | |
12343 | ENDIF | |
12344 | ||
12345 | C...2 -> 1 processes: reduction in angular part of phase space integral | |
12346 | C...for case of decaying resonance. | |
12347 | ACTH0=CTNMAX-CTNMIN+CTPMAX-CTPMIN | |
12348 | clin-4/2008 modified a la pythia6115.f to avoid invalid MDCY subcript#1, | |
12349 | c also break up compound IF statements: | |
12350 | c IF((ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.3).AND. | |
12351 | c &MDCY(KFPR(ISUB,1),1).EQ.1) THEN | |
12352 | c IF(KFPR(ISUB,1).EQ.25.OR.KFPR(ISUB,1).EQ.37) THEN | |
12353 | c COMFAC=COMFAC*0.5*ACTH0 | |
12354 | c ELSE | |
12355 | c COMFAC=COMFAC*0.125*(3.*ACTH0+CTNMAX**3-CTNMIN**3+ | |
12356 | c & CTPMAX**3-CTPMIN**3) | |
12357 | c ENDIF | |
12358 | IF(ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.3) THEN | |
12359 | if(MDCY(LUCOMP(KFPR(ISUB,1)),1).EQ.1) then | |
12360 | IF(KFPR(ISUB,1).EQ.25.OR.KFPR(ISUB,1).EQ.37) THEN | |
12361 | COMFAC=COMFAC*0.5*ACTH0 | |
12362 | ELSE | |
12363 | COMFAC=COMFAC*0.125*(3.*ACTH0+CTNMAX**3-CTNMIN**3+ | |
12364 | & CTPMAX**3-CTPMIN**3) | |
12365 | ENDIF | |
12366 | endif | |
12367 | c | |
12368 | C...2 -> 2 processes: angular part of phase space integral. | |
12369 | ELSEIF(ISET(ISUB).EQ.2.OR.ISET(ISUB).EQ.4) THEN | |
12370 | ACTH1=LOG((MAX(RM34,RSQM-CTNMIN)*MAX(RM34,RSQM-CTPMIN))/ | |
12371 | & (MAX(RM34,RSQM-CTNMAX)*MAX(RM34,RSQM-CTPMAX))) | |
12372 | ACTH2=LOG((MAX(RM34,RSQM+CTNMAX)*MAX(RM34,RSQM+CTPMAX))/ | |
12373 | & (MAX(RM34,RSQM+CTNMIN)*MAX(RM34,RSQM+CTPMIN))) | |
12374 | ACTH3=1./MAX(RM34,RSQM-CTNMAX)-1./MAX(RM34,RSQM-CTNMIN)+ | |
12375 | & 1./MAX(RM34,RSQM-CTPMAX)-1./MAX(RM34,RSQM-CTPMIN) | |
12376 | ACTH4=1./MAX(RM34,RSQM+CTNMIN)-1./MAX(RM34,RSQM+CTNMAX)+ | |
12377 | & 1./MAX(RM34,RSQM+CTPMIN)-1./MAX(RM34,RSQM+CTPMAX) | |
12378 | H3=COEF(ISUB,10)+ | |
12379 | & (ACTH0/ACTH1)*COEF(ISUB,11)/MAX(RM34,RSQM-CTH)+ | |
12380 | & (ACTH0/ACTH2)*COEF(ISUB,12)/MAX(RM34,RSQM+CTH)+ | |
12381 | & (ACTH0/ACTH3)*COEF(ISUB,13)/MAX(RM34,RSQM-CTH)**2+ | |
12382 | & (ACTH0/ACTH4)*COEF(ISUB,14)/MAX(RM34,RSQM+CTH)**2 | |
12383 | COMFAC=COMFAC*ACTH0*0.5*BE34/H3 | |
12384 | ENDIF | |
12385 | ||
12386 | C...2 -> 3, 4 processes: phace space integral in tau'. | |
12387 | IF(MINT(43).GE.2.AND.(ISET(ISUB).EQ.3.OR.ISET(ISUB).EQ.4)) THEN | |
12388 | ATAUP0=LOG(TAUPMX/TAUPMN) | |
12389 | ATAUP1=((1.-TAU/TAUPMX)**4-(1.-TAU/TAUPMN)**4)/(4.*TAU) | |
12390 | H4=COEF(ISUB,15)+ | |
12391 | & ATAUP0/ATAUP1*COEF(ISUB,16)/TAUP*(1.-TAU/TAUP)**3 | |
12392 | IF(1.-TAU/TAUP.GT.1.E-4) THEN | |
12393 | FZW=(1.+TAU/TAUP)*LOG(TAUP/TAU)-2.*(1.-TAU/TAUP) | |
12394 | ELSE | |
12395 | FZW=1./6.*(1.-TAU/TAUP)**3*TAU/TAUP | |
12396 | ENDIF | |
12397 | COMFAC=COMFAC*ATAUP0*FZW/H4 | |
12398 | ENDIF | |
12399 | ||
12400 | C...Phase space integral for low-pT and multiple interactions. | |
12401 | IF(ISET(ISUB).EQ.5) THEN | |
12402 | COMFAC=PARU(1)*PARU(5)*FACK*0.5*VINT(2)/SH2 | |
12403 | ATAU0=LOG(2.*(1.+SQRT(1.-XT2))/XT2-1.) | |
12404 | ATAU1=2.*ATAN(1./XT2-1.)/SQRT(XT2) | |
12405 | H1=COEF(ISUB,1)+(ATAU0/ATAU1)*COEF(ISUB,2)/SQRT(TAU) | |
12406 | COMFAC=COMFAC*ATAU0/H1 | |
12407 | AYST0=YSTMAX-YSTMIN | |
12408 | AYST1=0.5*(YSTMAX-YSTMIN)**2 | |
12409 | AYST3=2.*(ATAN(EXP(YSTMAX))-ATAN(EXP(YSTMIN))) | |
12410 | H2=(AYST0/AYST1)*COEF(ISUB,7)*(YST-YSTMIN)+(AYST0/AYST1)* | |
12411 | & COEF(ISUB,8)*(YSTMAX-YST)+(AYST0/AYST3)*COEF(ISUB,9)/COSH(YST) | |
12412 | COMFAC=COMFAC*AYST0/H2 | |
12413 | IF(MSTP(82).LE.1) COMFAC=COMFAC*XT2**2*(1./VINT(149)-1.) | |
12414 | C...For MSTP(82)>=2 an additional factor (xT2/(xT2+VINT(149))**2 is | |
12415 | C...introduced to make cross-section finite for xT2 -> 0. | |
12416 | IF(MSTP(82).GE.2) COMFAC=COMFAC*XT2**2/(VINT(149)* | |
12417 | & (1.+VINT(149))) | |
12418 | ENDIF | |
12419 | ||
12420 | C...A: 2 -> 1, tree diagrams. | |
12421 | ||
12422 | 145 IF(ISUB.LE.10) THEN | |
12423 | IF(ISUB.EQ.1) THEN | |
12424 | C...f + fb -> gamma*/Z0. | |
12425 | MINT(61)=2 | |
ce320da8 | 12426 | CALL PYWIDTA(23,SQRT(SH),WDTP,WDTE) |
0119ef9a | 12427 | FACZ=COMFAC*AEM**2*4./3. |
12428 | DO 150 I=MINA,MAXA | |
12429 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 150 | |
12430 | EI=KCHG(IABS(I),1)/3. | |
12431 | AI=SIGN(1.,EI) | |
12432 | VI=AI-4.*EI*XW | |
12433 | FACF=1. | |
12434 | IF(IABS(I).LE.10) FACF=FACA/3. | |
12435 | NCHN=NCHN+1 | |
12436 | ISIG(NCHN,1)=I | |
12437 | ISIG(NCHN,2)=-I | |
12438 | ISIG(NCHN,3)=1 | |
12439 | SIGH(NCHN)=FACF*FACZ*(EI**2*VINT(111)+EI*VI/(8.*XW*(1.-XW))* | |
12440 | & SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2)*VINT(112)+(VI**2+AI**2)/ | |
12441 | & (16.*XW*(1.-XW))**2*SH2/((SH-SQMZ)**2+GMMZ**2)*VINT(114)) | |
12442 | 150 CONTINUE | |
12443 | ||
12444 | ELSEIF(ISUB.EQ.2) THEN | |
12445 | C...f + fb' -> W+/-. | |
ce320da8 | 12446 | CALL PYWIDTA(24,SQRT(SH),WDTP,WDTE) |
0119ef9a | 12447 | FACW=COMFAC*(AEM/XW)**2*1./24*SH2/((SH-SQMW)**2+GMMW**2) |
12448 | DO 170 I=MIN1,MAX1 | |
12449 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 170 | |
12450 | IA=IABS(I) | |
12451 | DO 160 J=MIN2,MAX2 | |
12452 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 160 | |
12453 | JA=IABS(J) | |
12454 | IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 160 | |
12455 | IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) GOTO 160 | |
12456 | KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 | |
12457 | FACF=1. | |
12458 | IF(IA.LE.10) FACF=VCKM((IA+1)/2,(JA+1)/2)*FACA/3. | |
12459 | NCHN=NCHN+1 | |
12460 | ISIG(NCHN,1)=I | |
12461 | ISIG(NCHN,2)=J | |
12462 | ISIG(NCHN,3)=1 | |
12463 | SIGH(NCHN)=FACF*FACW*(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4)) | |
12464 | 160 CONTINUE | |
12465 | 170 CONTINUE | |
12466 | ||
12467 | ELSEIF(ISUB.EQ.3) THEN | |
12468 | C...f + fb -> H0. | |
ce320da8 | 12469 | CALL PYWIDTA(25,SQRT(SH),WDTP,WDTE) |
0119ef9a | 12470 | FACH=COMFAC*(AEM/XW)**2*1./48.*(SH/SQMW)**2* |
12471 | & SH2/((SH-SQMH)**2+GMMH**2)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) | |
12472 | DO 180 I=MINA,MAXA | |
12473 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 180 | |
12474 | RMQ=PMAS(IABS(I),1)**2/SH | |
12475 | NCHN=NCHN+1 | |
12476 | ISIG(NCHN,1)=I | |
12477 | ISIG(NCHN,2)=-I | |
12478 | ISIG(NCHN,3)=1 | |
12479 | SIGH(NCHN)=FACH*RMQ*SQRT(MAX(0.,1.-4.*RMQ)) | |
12480 | 180 CONTINUE | |
12481 | ||
12482 | ELSEIF(ISUB.EQ.4) THEN | |
12483 | C...gamma + W+/- -> W+/-. | |
12484 | ||
12485 | ELSEIF(ISUB.EQ.5) THEN | |
12486 | C...Z0 + Z0 -> H0. | |
ce320da8 | 12487 | CALL PYWIDTA(25,SQRT(SH),WDTP,WDTE) |
0119ef9a | 12488 | FACH=COMFAC*1./(128.*PARU(1)**2*16.*(1.-XW)**3)*(AEM/XW)**4* |
12489 | & (SH/SQMW)**2*SH2/((SH-SQMH)**2+GMMH**2)* | |
12490 | & (WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) | |
12491 | DO 200 I=MIN1,MAX1 | |
12492 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 200 | |
12493 | DO 190 J=MIN2,MAX2 | |
12494 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 190 | |
12495 | EI=KCHG(IABS(I),1)/3. | |
12496 | AI=SIGN(1.,EI) | |
12497 | VI=AI-4.*EI*XW | |
12498 | EJ=KCHG(IABS(J),1)/3. | |
12499 | AJ=SIGN(1.,EJ) | |
12500 | VJ=AJ-4.*EJ*XW | |
12501 | NCHN=NCHN+1 | |
12502 | ISIG(NCHN,1)=I | |
12503 | ISIG(NCHN,2)=J | |
12504 | ISIG(NCHN,3)=1 | |
12505 | SIGH(NCHN)=FACH*(VI**2+AI**2)*(VJ**2+AJ**2) | |
12506 | 190 CONTINUE | |
12507 | 200 CONTINUE | |
12508 | ||
12509 | ELSEIF(ISUB.EQ.6) THEN | |
12510 | C...Z0 + W+/- -> W+/-. | |
12511 | ||
12512 | ELSEIF(ISUB.EQ.7) THEN | |
12513 | C...W+ + W- -> Z0. | |
12514 | ||
12515 | ELSEIF(ISUB.EQ.8) THEN | |
12516 | C...W+ + W- -> H0. | |
ce320da8 | 12517 | CALL PYWIDTA(25,SQRT(SH),WDTP,WDTE) |
0119ef9a | 12518 | FACH=COMFAC*1./(128*PARU(1)**2)*(AEM/XW)**4*(SH/SQMW)**2* |
12519 | & SH2/((SH-SQMH)**2+GMMH**2)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) | |
12520 | DO 220 I=MIN1,MAX1 | |
12521 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 220 | |
12522 | EI=SIGN(1.,FLOAT(I))*KCHG(IABS(I),1) | |
12523 | DO 210 J=MIN2,MAX2 | |
12524 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 210 | |
12525 | EJ=SIGN(1.,FLOAT(J))*KCHG(IABS(J),1) | |
12526 | IF(EI*EJ.GT.0.) GOTO 210 | |
12527 | NCHN=NCHN+1 | |
12528 | ISIG(NCHN,1)=I | |
12529 | ISIG(NCHN,2)=J | |
12530 | ISIG(NCHN,3)=1 | |
12531 | SIGH(NCHN)=FACH*VINT(180+I)*VINT(180+J) | |
12532 | 210 CONTINUE | |
12533 | 220 CONTINUE | |
12534 | ENDIF | |
12535 | ||
12536 | C...B: 2 -> 2, tree diagrams. | |
12537 | ||
12538 | ELSEIF(ISUB.LE.20) THEN | |
12539 | IF(ISUB.EQ.11) THEN | |
12540 | C...f + f' -> f + f'. | |
12541 | FACQQ1=COMFAC*AS**2*4./9.*(SH2+UH2)/TH2 | |
12542 | FACQQB=COMFAC*AS**2*4./9.*((SH2+UH2)/TH2*FACA- | |
12543 | & MSTP(34)*2./3.*UH2/(SH*TH)) | |
12544 | FACQQ2=COMFAC*AS**2*4./9.*((SH2+TH2)/UH2- | |
12545 | & MSTP(34)*2./3.*SH2/(TH*UH)) | |
12546 | DO 240 I=MIN1,MAX1 | |
12547 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 240 | |
12548 | DO 230 J=MIN2,MAX2 | |
12549 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 230 | |
12550 | NCHN=NCHN+1 | |
12551 | ISIG(NCHN,1)=I | |
12552 | ISIG(NCHN,2)=J | |
12553 | ISIG(NCHN,3)=1 | |
12554 | SIGH(NCHN)=FACQQ1 | |
12555 | IF(I.EQ.-J) SIGH(NCHN)=FACQQB | |
12556 | IF(I.EQ.J) THEN | |
12557 | SIGH(NCHN)=0.5*SIGH(NCHN) | |
12558 | NCHN=NCHN+1 | |
12559 | ISIG(NCHN,1)=I | |
12560 | ISIG(NCHN,2)=J | |
12561 | ISIG(NCHN,3)=2 | |
12562 | SIGH(NCHN)=0.5*FACQQ2 | |
12563 | ENDIF | |
12564 | 230 CONTINUE | |
12565 | 240 CONTINUE | |
12566 | ||
12567 | ELSEIF(ISUB.EQ.12) THEN | |
12568 | C...f + fb -> f' + fb' (q + qb -> q' + qb' only). | |
ce320da8 | 12569 | CALL PYWIDTA(21,SQRT(SH),WDTP,WDTE) |
0119ef9a | 12570 | FACQQB=COMFAC*AS**2*4./9.*(TH2+UH2)/SH2*(WDTE(0,1)+WDTE(0,2)+ |
12571 | & WDTE(0,3)+WDTE(0,4)) | |
12572 | DO 250 I=MINA,MAXA | |
12573 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 250 | |
12574 | NCHN=NCHN+1 | |
12575 | ISIG(NCHN,1)=I | |
12576 | ISIG(NCHN,2)=-I | |
12577 | ISIG(NCHN,3)=1 | |
12578 | SIGH(NCHN)=FACQQB | |
12579 | 250 CONTINUE | |
12580 | ||
12581 | ELSEIF(ISUB.EQ.13) THEN | |
12582 | C...f + fb -> g + g (q + qb -> g + g only). | |
12583 | FACGG1=COMFAC*AS**2*32./27.*(UH/TH-(2.+MSTP(34)*1./4.)*UH2/SH2) | |
12584 | FACGG2=COMFAC*AS**2*32./27.*(TH/UH-(2.+MSTP(34)*1./4.)*TH2/SH2) | |
12585 | DO 260 I=MINA,MAXA | |
12586 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 260 | |
12587 | NCHN=NCHN+1 | |
12588 | ISIG(NCHN,1)=I | |
12589 | ISIG(NCHN,2)=-I | |
12590 | ISIG(NCHN,3)=1 | |
12591 | SIGH(NCHN)=0.5*FACGG1 | |
12592 | NCHN=NCHN+1 | |
12593 | ISIG(NCHN,1)=I | |
12594 | ISIG(NCHN,2)=-I | |
12595 | ISIG(NCHN,3)=2 | |
12596 | SIGH(NCHN)=0.5*FACGG2 | |
12597 | 260 CONTINUE | |
12598 | ||
12599 | ELSEIF(ISUB.EQ.14) THEN | |
12600 | C...f + fb -> g + gamma (q + qb -> g + gamma only). | |
12601 | FACGG=COMFAC*AS*AEM*8./9.*(TH2+UH2)/(TH*UH) | |
12602 | DO 270 I=MINA,MAXA | |
12603 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 270 | |
12604 | EI=KCHG(IABS(I),1)/3. | |
12605 | NCHN=NCHN+1 | |
12606 | ISIG(NCHN,1)=I | |
12607 | ISIG(NCHN,2)=-I | |
12608 | ISIG(NCHN,3)=1 | |
12609 | SIGH(NCHN)=FACGG*EI**2 | |
12610 | 270 CONTINUE | |
12611 | ||
12612 | ELSEIF(ISUB.EQ.15) THEN | |
12613 | C...f + fb -> g + Z0 (q + qb -> g + Z0 only). | |
12614 | FACZG=COMFAC*AS*AEM/(XW*(1.-XW))*1./18.* | |
12615 | & (TH2+UH2+2.*SQM4*SH)/(TH*UH) | |
12616 | FACZG=FACZG*WIDS(23,2) | |
12617 | DO 280 I=MINA,MAXA | |
12618 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 280 | |
12619 | EI=KCHG(IABS(I),1)/3. | |
12620 | AI=SIGN(1.,EI) | |
12621 | VI=AI-4.*EI*XW | |
12622 | NCHN=NCHN+1 | |
12623 | ISIG(NCHN,1)=I | |
12624 | ISIG(NCHN,2)=-I | |
12625 | ISIG(NCHN,3)=1 | |
12626 | SIGH(NCHN)=FACZG*(VI**2+AI**2) | |
12627 | 280 CONTINUE | |
12628 | ||
12629 | ELSEIF(ISUB.EQ.16) THEN | |
12630 | C...f + fb' -> g + W+/- (q + qb' -> g + W+/- only). | |
12631 | FACWG=COMFAC*AS*AEM/XW*2./9.*(TH2+UH2+2.*SQM4*SH)/(TH*UH) | |
12632 | DO 300 I=MIN1,MAX1 | |
12633 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 300 | |
12634 | IA=IABS(I) | |
12635 | DO 290 J=MIN2,MAX2 | |
12636 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 290 | |
12637 | JA=IABS(J) | |
12638 | IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 290 | |
12639 | KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 | |
12640 | FCKM=1. | |
12641 | IF(MINT(43).EQ.4) FCKM=VCKM((IA+1)/2,(JA+1)/2) | |
12642 | NCHN=NCHN+1 | |
12643 | ISIG(NCHN,1)=I | |
12644 | ISIG(NCHN,2)=J | |
12645 | ISIG(NCHN,3)=1 | |
12646 | SIGH(NCHN)=FACWG*FCKM*WIDS(24,(5-KCHW)/2) | |
12647 | 290 CONTINUE | |
12648 | 300 CONTINUE | |
12649 | ||
12650 | ELSEIF(ISUB.EQ.17) THEN | |
12651 | C...f + fb -> g + H0 (q + qb -> g + H0 only). | |
12652 | ||
12653 | ELSEIF(ISUB.EQ.18) THEN | |
12654 | C...f + fb -> gamma + gamma. | |
12655 | FACGG=COMFAC*FACA*AEM**2*1./3.*(TH2+UH2)/(TH*UH) | |
12656 | DO 310 I=MINA,MAXA | |
12657 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 310 | |
12658 | EI=KCHG(IABS(I),1)/3. | |
12659 | NCHN=NCHN+1 | |
12660 | ISIG(NCHN,1)=I | |
12661 | ISIG(NCHN,2)=-I | |
12662 | ISIG(NCHN,3)=1 | |
12663 | SIGH(NCHN)=FACGG*EI**4 | |
12664 | 310 CONTINUE | |
12665 | ||
12666 | ELSEIF(ISUB.EQ.19) THEN | |
12667 | C...f + fb -> gamma + Z0. | |
12668 | FACGZ=COMFAC*FACA*AEM**2/(XW*(1.-XW))*1./24.* | |
12669 | & (TH2+UH2+2.*SQM4*SH)/(TH*UH) | |
12670 | FACGZ=FACGZ*WIDS(23,2) | |
12671 | DO 320 I=MINA,MAXA | |
12672 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 320 | |
12673 | EI=KCHG(IABS(I),1)/3. | |
12674 | AI=SIGN(1.,EI) | |
12675 | VI=AI-4.*EI*XW | |
12676 | NCHN=NCHN+1 | |
12677 | ISIG(NCHN,1)=I | |
12678 | ISIG(NCHN,2)=-I | |
12679 | ISIG(NCHN,3)=1 | |
12680 | SIGH(NCHN)=FACGZ*EI**2*(VI**2+AI**2) | |
12681 | 320 CONTINUE | |
12682 | ||
12683 | ELSEIF(ISUB.EQ.20) THEN | |
12684 | C...f + fb' -> gamma + W+/-. | |
12685 | FACGW=COMFAC*FACA*AEM**2/XW*1./6.* | |
12686 | & ((2.*UH-TH)/(3.*(SH-SQM4)))**2*(TH2+UH2+2.*SQM4*SH)/(TH*UH) | |
12687 | DO 340 I=MIN1,MAX1 | |
12688 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 340 | |
12689 | IA=IABS(I) | |
12690 | DO 330 J=MIN2,MAX2 | |
12691 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 330 | |
12692 | JA=IABS(J) | |
12693 | IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 330 | |
12694 | KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 | |
12695 | FCKM=1. | |
12696 | IF(MINT(43).EQ.4) FCKM=VCKM((IA+1)/2,(JA+1)/2) | |
12697 | NCHN=NCHN+1 | |
12698 | ISIG(NCHN,1)=I | |
12699 | ISIG(NCHN,2)=J | |
12700 | ISIG(NCHN,3)=1 | |
12701 | SIGH(NCHN)=FACGW*FCKM*WIDS(24,(5-KCHW)/2) | |
12702 | 330 CONTINUE | |
12703 | 340 CONTINUE | |
12704 | ENDIF | |
12705 | ||
12706 | ELSEIF(ISUB.LE.30) THEN | |
12707 | IF(ISUB.EQ.21) THEN | |
12708 | C...f + fb -> gamma + H0. | |
12709 | ||
12710 | ELSEIF(ISUB.EQ.22) THEN | |
12711 | C...f + fb -> Z0 + Z0. | |
12712 | FACZZ=COMFAC*FACA*(AEM/(XW*(1.-XW)))**2*1./768.* | |
12713 | & (UH/TH+TH/UH+2.*(SQM3+SQM4)*SH/(TH*UH)- | |
12714 | & SQM3*SQM4*(1./TH2+1./UH2)) | |
12715 | FACZZ=FACZZ*WIDS(23,1) | |
12716 | DO 350 I=MINA,MAXA | |
12717 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 350 | |
12718 | EI=KCHG(IABS(I),1)/3. | |
12719 | AI=SIGN(1.,EI) | |
12720 | VI=AI-4.*EI*XW | |
12721 | NCHN=NCHN+1 | |
12722 | ISIG(NCHN,1)=I | |
12723 | ISIG(NCHN,2)=-I | |
12724 | ISIG(NCHN,3)=1 | |
12725 | SIGH(NCHN)=FACZZ*(VI**4+6.*VI**2*AI**2+AI**4) | |
12726 | 350 CONTINUE | |
12727 | ||
12728 | ELSEIF(ISUB.EQ.23) THEN | |
12729 | C...f + fb' -> Z0 + W+/-. | |
12730 | FACZW=COMFAC*FACA*(AEM/XW)**2*1./6. | |
12731 | FACZW=FACZW*WIDS(23,2) | |
12732 | THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2) | |
12733 | DO 370 I=MIN1,MAX1 | |
12734 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 370 | |
12735 | IA=IABS(I) | |
12736 | DO 360 J=MIN2,MAX2 | |
12737 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 360 | |
12738 | JA=IABS(J) | |
12739 | IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 360 | |
12740 | KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 | |
12741 | EI=KCHG(IA,1)/3. | |
12742 | AI=SIGN(1.,EI) | |
12743 | VI=AI-4.*EI*XW | |
12744 | EJ=KCHG(JA,1)/3. | |
12745 | AJ=SIGN(1.,EJ) | |
12746 | VJ=AJ-4.*EJ*XW | |
12747 | IF(VI+AI.GT.0) THEN | |
12748 | VISAV=VI | |
12749 | AISAV=AI | |
12750 | VI=VJ | |
12751 | AI=AJ | |
12752 | VJ=VISAV | |
12753 | AJ=AISAV | |
12754 | ENDIF | |
12755 | FCKM=1. | |
12756 | IF(MINT(43).EQ.4) FCKM=VCKM((IA+1)/2,(JA+1)/2) | |
12757 | NCHN=NCHN+1 | |
12758 | ISIG(NCHN,1)=I | |
12759 | ISIG(NCHN,2)=J | |
12760 | ISIG(NCHN,3)=1 | |
12761 | SIGH(NCHN)=FACZW*FCKM*(1./(SH-SQMW)**2* | |
12762 | & ((9.-8.*XW)/4.*THUH+(8.*XW-6.)/4.*SH*(SQM3+SQM4))+ | |
12763 | & (THUH-SH*(SQM3+SQM4))/(2.*(SH-SQMW))*((VJ+AJ)/TH-(VI+AI)/UH)+ | |
12764 | & THUH/(16.*(1.-XW))*((VJ+AJ)**2/TH2+(VI+AI)**2/UH2)+ | |
12765 | & SH*(SQM3+SQM4)/(8.*(1.-XW))*(VI+AI)*(VJ+AJ)/(TH*UH))* | |
12766 | & WIDS(24,(5-KCHW)/2) | |
12767 | 360 CONTINUE | |
12768 | 370 CONTINUE | |
12769 | ||
12770 | ELSEIF(ISUB.EQ.24) THEN | |
12771 | C...f + fb -> Z0 + H0. | |
12772 | THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2) | |
12773 | FACHZ=COMFAC*FACA*(AEM/(XW*(1.-XW)))**2*1./96.* | |
12774 | & (THUH+2.*SH*SQMZ)/(SH-SQMZ)**2 | |
12775 | FACHZ=FACHZ*WIDS(23,2)*WIDS(25,2) | |
12776 | DO 380 I=MINA,MAXA | |
12777 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 380 | |
12778 | EI=KCHG(IABS(I),1)/3. | |
12779 | AI=SIGN(1.,EI) | |
12780 | VI=AI-4.*EI*XW | |
12781 | NCHN=NCHN+1 | |
12782 | ISIG(NCHN,1)=I | |
12783 | ISIG(NCHN,2)=-I | |
12784 | ISIG(NCHN,3)=1 | |
12785 | SIGH(NCHN)=FACHZ*(VI**2+AI**2) | |
12786 | 380 CONTINUE | |
12787 | ||
12788 | ELSEIF(ISUB.EQ.25) THEN | |
12789 | C...f + fb -> W+ + W-. | |
12790 | FACWW=COMFAC*FACA*(AEM/XW)**2*1./12. | |
12791 | FACWW=FACWW*WIDS(24,1) | |
12792 | THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2) | |
12793 | DO 390 I=MINA,MAXA | |
12794 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 390 | |
12795 | EI=KCHG(IABS(I),1)/3. | |
12796 | AI=SIGN(1.,EI) | |
12797 | VI=AI-4.*EI*XW | |
12798 | DSIGWW=THUH/SH2*(3.-(SH-3.*(SQM3+SQM4))/(SH-SQMZ)* | |
12799 | & (VI+AI)/(2.*AI*(1.-XW))+(SH/(SH-SQMZ))**2* | |
12800 | & (1.-2.*(SQM3+SQM4)/SH+12.*SQM3*SQM4/SH2)*(VI**2+AI**2)/ | |
12801 | & (8.*(1.-XW)**2))-2.*SQMZ/(SH-SQMZ)*(VI+AI)/AI+ | |
12802 | & SQMZ*SH/(SH-SQMZ)**2*(1.-2.*(SQM3+SQM4)/SH)*(VI**2+AI**2)/ | |
12803 | & (2.*(1.-XW)) | |
12804 | IF(KCHG(IABS(I),1).LT.0) THEN | |
12805 | DSIGWW=DSIGWW+2.*(1.+SQMZ/(SH-SQMZ)*(VI+AI)/(2.*AI))* | |
12806 | & (THUH/(SH*TH)-(SQM3+SQM4)/TH)+THUH/TH2 | |
12807 | ELSE | |
12808 | DSIGWW=DSIGWW+2.*(1.+SQMZ/(SH-SQMZ)*(VI+AI)/(2.*AI))* | |
12809 | & (THUH/(SH*UH)-(SQM3+SQM4)/UH)+THUH/UH2 | |
12810 | ENDIF | |
12811 | NCHN=NCHN+1 | |
12812 | ISIG(NCHN,1)=I | |
12813 | ISIG(NCHN,2)=-I | |
12814 | ISIG(NCHN,3)=1 | |
12815 | SIGH(NCHN)=FACWW*DSIGWW | |
12816 | 390 CONTINUE | |
12817 | ||
12818 | ELSEIF(ISUB.EQ.26) THEN | |
12819 | C...f + fb' -> W+/- + H0. | |
12820 | THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2) | |
12821 | FACHW=COMFAC*FACA*(AEM/XW)**2*1./24.*(THUH+2.*SH*SQMW)/ | |
12822 | & (SH-SQMW)**2 | |
12823 | FACHW=FACHW*WIDS(25,2) | |
12824 | DO 410 I=MIN1,MAX1 | |
12825 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 410 | |
12826 | IA=IABS(I) | |
12827 | DO 400 J=MIN2,MAX2 | |
12828 | IF(J.EQ.0.OR.KFAC(1,J).EQ.0) GOTO 400 | |
12829 | JA=IABS(J) | |
12830 | IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 400 | |
12831 | KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3 | |
12832 | FCKM=1. | |
12833 | IF(MINT(43).EQ.4) FCKM=VCKM((IA+1)/2,(JA+1)/2) | |
12834 | NCHN=NCHN+1 | |
12835 | ISIG(NCHN,1)=I | |
12836 | ISIG(NCHN,2)=J | |
12837 | ISIG(NCHN,3)=1 | |
12838 | SIGH(NCHN)=FACHW*FCKM*WIDS(24,(5-KCHW)/2) | |
12839 | 400 CONTINUE | |
12840 | 410 CONTINUE | |
12841 | ||
12842 | ELSEIF(ISUB.EQ.27) THEN | |
12843 | C...f + fb -> H0 + H0. | |
12844 | ||
12845 | ELSEIF(ISUB.EQ.28) THEN | |
12846 | C...f + g -> f + g (q + g -> q + g only). | |
12847 | FACQG1=COMFAC*AS**2*4./9.*((2.+MSTP(34)*1./4.)*UH2/TH2-UH/SH)* | |
12848 | & FACA | |
12849 | FACQG2=COMFAC*AS**2*4./9.*((2.+MSTP(34)*1./4.)*SH2/TH2-SH/UH) | |
12850 | DO 430 I=MINA,MAXA | |
12851 | IF(I.EQ.0) GOTO 430 | |
12852 | DO 420 ISDE=1,2 | |
12853 | IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 420 | |
12854 | IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 420 | |
12855 | NCHN=NCHN+1 | |
12856 | ISIG(NCHN,ISDE)=I | |
12857 | ISIG(NCHN,3-ISDE)=21 | |
12858 | ISIG(NCHN,3)=1 | |
12859 | SIGH(NCHN)=FACQG1 | |
12860 | NCHN=NCHN+1 | |
12861 | ISIG(NCHN,ISDE)=I | |
12862 | ISIG(NCHN,3-ISDE)=21 | |
12863 | ISIG(NCHN,3)=2 | |
12864 | SIGH(NCHN)=FACQG2 | |
12865 | 420 CONTINUE | |
12866 | 430 CONTINUE | |
12867 | ||
12868 | ELSEIF(ISUB.EQ.29) THEN | |
12869 | C...f + g -> f + gamma (q + g -> q + gamma only). | |
12870 | FGQ=COMFAC*FACA*AS*AEM*1./3.*(SH2+UH2)/(-SH*UH) | |
12871 | DO 450 I=MINA,MAXA | |
12872 | IF(I.EQ.0) GOTO 450 | |
12873 | EI=KCHG(IABS(I),1)/3. | |
12874 | FACGQ=FGQ*EI**2 | |
12875 | DO 440 ISDE=1,2 | |
12876 | IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 440 | |
12877 | IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 440 | |
12878 | NCHN=NCHN+1 | |
12879 | ISIG(NCHN,ISDE)=I | |
12880 | ISIG(NCHN,3-ISDE)=21 | |
12881 | ISIG(NCHN,3)=1 | |
12882 | SIGH(NCHN)=FACGQ | |
12883 | 440 CONTINUE | |
12884 | 450 CONTINUE | |
12885 | ||
12886 | ELSEIF(ISUB.EQ.30) THEN | |
12887 | C...f + g -> f + Z0 (q + g -> q + Z0 only). | |
12888 | FZQ=COMFAC*FACA*AS*AEM/(XW*(1.-XW))*1./48.* | |
12889 | & (SH2+UH2+2.*SQM4*TH)/(-SH*UH) | |
12890 | FZQ=FZQ*WIDS(23,2) | |
12891 | DO 470 I=MINA,MAXA | |
12892 | IF(I.EQ.0) GOTO 470 | |
12893 | EI=KCHG(IABS(I),1)/3. | |
12894 | AI=SIGN(1.,EI) | |
12895 | VI=AI-4.*EI*XW | |
12896 | FACZQ=FZQ*(VI**2+AI**2) | |
12897 | DO 460 ISDE=1,2 | |
12898 | IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 460 | |
12899 | IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 460 | |
12900 | NCHN=NCHN+1 | |
12901 | ISIG(NCHN,ISDE)=I | |
12902 | ISIG(NCHN,3-ISDE)=21 | |
12903 | ISIG(NCHN,3)=1 | |
12904 | SIGH(NCHN)=FACZQ | |
12905 | 460 CONTINUE | |
12906 | 470 CONTINUE | |
12907 | ENDIF | |
12908 | ||
12909 | ELSEIF(ISUB.LE.40) THEN | |
12910 | IF(ISUB.EQ.31) THEN | |
12911 | C...f + g -> f' + W+/- (q + g -> q' + W+/- only). | |
12912 | FACWQ=COMFAC*FACA*AS*AEM/XW*1./12.* | |
12913 | & (SH2+UH2+2.*SQM4*TH)/(-SH*UH) | |
12914 | DO 490 I=MINA,MAXA | |
12915 | IF(I.EQ.0) GOTO 490 | |
12916 | IA=IABS(I) | |
12917 | KCHW=ISIGN(1,KCHG(IA,1)*ISIGN(1,I)) | |
12918 | DO 480 ISDE=1,2 | |
12919 | IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 480 | |
12920 | IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 480 | |
12921 | NCHN=NCHN+1 | |
12922 | ISIG(NCHN,ISDE)=I | |
12923 | ISIG(NCHN,3-ISDE)=21 | |
12924 | ISIG(NCHN,3)=1 | |
12925 | SIGH(NCHN)=FACWQ*VINT(180+I)*WIDS(24,(5-KCHW)/2) | |
12926 | 480 CONTINUE | |
12927 | 490 CONTINUE | |
12928 | ||
12929 | ELSEIF(ISUB.EQ.32) THEN | |
12930 | C...f + g -> f + H0 (q + g -> q + H0 only). | |
12931 | ||
12932 | ELSEIF(ISUB.EQ.33) THEN | |
12933 | C...f + gamma -> f + g (q + gamma -> q + g only). | |
12934 | ||
12935 | ELSEIF(ISUB.EQ.34) THEN | |
12936 | C...f + gamma -> f + gamma. | |
12937 | ||
12938 | ELSEIF(ISUB.EQ.35) THEN | |
12939 | C...f + gamma -> f + Z0. | |
12940 | ||
12941 | ELSEIF(ISUB.EQ.36) THEN | |
12942 | C...f + gamma -> f' + W+/-. | |
12943 | ||
12944 | ELSEIF(ISUB.EQ.37) THEN | |
12945 | C...f + gamma -> f + H0. | |
12946 | ||
12947 | ELSEIF(ISUB.EQ.38) THEN | |
12948 | C...f + Z0 -> f + g (q + Z0 -> q + g only). | |
12949 | ||
12950 | ELSEIF(ISUB.EQ.39) THEN | |
12951 | C...f + Z0 -> f + gamma. | |
12952 | ||
12953 | ELSEIF(ISUB.EQ.40) THEN | |
12954 | C...f + Z0 -> f + Z0. | |
12955 | ENDIF | |
12956 | ||
12957 | ELSEIF(ISUB.LE.50) THEN | |
12958 | IF(ISUB.EQ.41) THEN | |
12959 | C...f + Z0 -> f' + W+/-. | |
12960 | ||
12961 | ELSEIF(ISUB.EQ.42) THEN | |
12962 | C...f + Z0 -> f + H0. | |
12963 | ||
12964 | ELSEIF(ISUB.EQ.43) THEN | |
12965 | C...f + W+/- -> f' + g (q + W+/- -> q' + g only). | |
12966 | ||
12967 | ELSEIF(ISUB.EQ.44) THEN | |
12968 | C...f + W+/- -> f' + gamma. | |
12969 | ||
12970 | ELSEIF(ISUB.EQ.45) THEN | |
12971 | C...f + W+/- -> f' + Z0. | |
12972 | ||
12973 | ELSEIF(ISUB.EQ.46) THEN | |
12974 | C...f + W+/- -> f' + W+/-. | |
12975 | ||
12976 | ELSEIF(ISUB.EQ.47) THEN | |
12977 | C...f + W+/- -> f' + H0. | |
12978 | ||
12979 | ELSEIF(ISUB.EQ.48) THEN | |
12980 | C...f + H0 -> f + g (q + H0 -> q + g only). | |
12981 | ||
12982 | ELSEIF(ISUB.EQ.49) THEN | |
12983 | C...f + H0 -> f + gamma. | |
12984 | ||
12985 | ELSEIF(ISUB.EQ.50) THEN | |
12986 | C...f + H0 -> f + Z0. | |
12987 | ENDIF | |
12988 | ||
12989 | ELSEIF(ISUB.LE.60) THEN | |
12990 | IF(ISUB.EQ.51) THEN | |
12991 | C...f + H0 -> f' + W+/-. | |
12992 | ||
12993 | ELSEIF(ISUB.EQ.52) THEN | |
12994 | C...f + H0 -> f + H0. | |
12995 | ||
12996 | ELSEIF(ISUB.EQ.53) THEN | |
12997 | C...g + g -> f + fb (g + g -> q + qb only). | |
ce320da8 | 12998 | CALL PYWIDTA(21,SQRT(SH),WDTP,WDTE) |
0119ef9a | 12999 | FACQQ1=COMFAC*AS**2*1./6.*(UH/TH-(2.+MSTP(34)*1./4.)*UH2/SH2)* |
13000 | & (WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))*FACA | |
13001 | FACQQ2=COMFAC*AS**2*1./6.*(TH/UH-(2.+MSTP(34)*1./4.)*TH2/SH2)* | |
13002 | & (WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))*FACA | |
13003 | IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 500 | |
13004 | NCHN=NCHN+1 | |
13005 | ISIG(NCHN,1)=21 | |
13006 | ISIG(NCHN,2)=21 | |
13007 | ISIG(NCHN,3)=1 | |
13008 | SIGH(NCHN)=FACQQ1 | |
13009 | NCHN=NCHN+1 | |
13010 | ISIG(NCHN,1)=21 | |
13011 | ISIG(NCHN,2)=21 | |
13012 | ISIG(NCHN,3)=2 | |
13013 | SIGH(NCHN)=FACQQ2 | |
13014 | 500 CONTINUE | |
13015 | ||
13016 | ELSEIF(ISUB.EQ.54) THEN | |
13017 | C...g + gamma -> f + fb (g + gamma -> q + qb only). | |
13018 | ||
13019 | ELSEIF(ISUB.EQ.55) THEN | |
13020 | C...g + gamma -> f + fb (g + gamma -> q + qb only). | |
13021 | ||
13022 | ELSEIF(ISUB.EQ.56) THEN | |
13023 | C...g + gamma -> f + fb (g + gamma -> q + qb only). | |
13024 | ||
13025 | ELSEIF(ISUB.EQ.57) THEN | |
13026 | C...g + gamma -> f + fb (g + gamma -> q + qb only). | |
13027 | ||
13028 | ELSEIF(ISUB.EQ.58) THEN | |
13029 | C...gamma + gamma -> f + fb. | |
13030 | ||
13031 | ELSEIF(ISUB.EQ.59) THEN | |
13032 | C...gamma + Z0 -> f + fb. | |
13033 | ||
13034 | ELSEIF(ISUB.EQ.60) THEN | |
13035 | C...gamma + W+/- -> f + fb'. | |
13036 | ENDIF | |
13037 | ||
13038 | ELSEIF(ISUB.LE.70) THEN | |
13039 | IF(ISUB.EQ.61) THEN | |
13040 | C...gamma + H0 -> f + fb. | |
13041 | ||
13042 | ELSEIF(ISUB.EQ.62) THEN | |
13043 | C...Z0 + Z0 -> f + fb. | |
13044 | ||
13045 | ELSEIF(ISUB.EQ.63) THEN | |
13046 | C...Z0 + W+/- -> f + fb'. | |
13047 | ||
13048 | ELSEIF(ISUB.EQ.64) THEN | |
13049 | C...Z0 + H0 -> f + fb. | |
13050 | ||
13051 | ELSEIF(ISUB.EQ.65) THEN | |
13052 | C...W+ + W- -> f + fb. | |
13053 | ||
13054 | ELSEIF(ISUB.EQ.66) THEN | |
13055 | C...W+/- + H0 -> f + fb'. | |
13056 | ||
13057 | ELSEIF(ISUB.EQ.67) THEN | |
13058 | C...H0 + H0 -> f + fb. | |
13059 | ||
13060 | ELSEIF(ISUB.EQ.68) THEN | |
13061 | C...g + g -> g + g. | |
13062 | FACGG1=COMFAC*AS**2*9./4.*(SH2/TH2+2.*SH/TH+3.+2.*TH/SH+ | |
13063 | & TH2/SH2)*FACA | |
13064 | FACGG2=COMFAC*AS**2*9./4.*(UH2/SH2+2.*UH/SH+3.+2.*SH/UH+ | |
13065 | & SH2/UH2)*FACA | |
13066 | FACGG3=COMFAC*AS**2*9./4.*(TH2/UH2+2.*TH/UH+3+2.*UH/TH+UH2/TH2) | |
13067 | IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 510 | |
13068 | NCHN=NCHN+1 | |
13069 | ISIG(NCHN,1)=21 | |
13070 | ISIG(NCHN,2)=21 | |
13071 | ISIG(NCHN,3)=1 | |
13072 | SIGH(NCHN)=0.5*FACGG1 | |
13073 | NCHN=NCHN+1 | |
13074 | ISIG(NCHN,1)=21 | |
13075 | ISIG(NCHN,2)=21 | |
13076 | ISIG(NCHN,3)=2 | |
13077 | SIGH(NCHN)=0.5*FACGG2 | |
13078 | NCHN=NCHN+1 | |
13079 | ISIG(NCHN,1)=21 | |
13080 | ISIG(NCHN,2)=21 | |
13081 | ISIG(NCHN,3)=3 | |
13082 | SIGH(NCHN)=0.5*FACGG3 | |
13083 | 510 CONTINUE | |
13084 | ||
13085 | ELSEIF(ISUB.EQ.69) THEN | |
13086 | C...gamma + gamma -> W+ + W-. | |
13087 | ||
13088 | ELSEIF(ISUB.EQ.70) THEN | |
13089 | C...gamma + W+/- -> gamma + W+/-. | |
13090 | ENDIF | |
13091 | ||
13092 | ELSEIF(ISUB.LE.80) THEN | |
13093 | IF(ISUB.EQ.71) THEN | |
13094 | C...Z0 + Z0 -> Z0 + Z0. | |
13095 | BE2=1.-4.*SQMZ/SH | |
13096 | TH=-0.5*SH*BE2*(1.-CTH) | |
13097 | UH=-0.5*SH*BE2*(1.+CTH) | |
13098 | SHANG=1./(1.-XW)*SQMW/SQMZ*(1.+BE2)**2 | |
13099 | ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG | |
13100 | ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG | |
13101 | THANG=1./(1.-XW)*SQMW/SQMZ*(BE2-CTH)**2 | |
13102 | ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG | |
13103 | ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG | |
13104 | UHANG=1./(1.-XW)*SQMW/SQMZ*(BE2+CTH)**2 | |
13105 | AUHRE=(UH-SQMH)/((UH-SQMH)**2+GMMH**2)*UHANG | |
13106 | AUHIM=-GMMH/((UH-SQMH)**2+GMMH**2)*UHANG | |
13107 | FACH=0.5*COMFAC*1./(4096.*PARU(1)**2*16.*(1.-XW)**2)* | |
13108 | & (AEM/XW)**4*(SH/SQMW)**2*((ASHRE+ATHRE+AUHRE)**2+ | |
13109 | & (ASHIM+ATHIM+AUHIM)**2)*SQMZ/SQMW | |
13110 | DO 530 I=MIN1,MAX1 | |
13111 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 530 | |
13112 | EI=KCHG(IABS(I),1)/3. | |
13113 | AI=SIGN(1.,EI) | |
13114 | VI=AI-4.*EI*XW | |
13115 | AVI=AI**2+VI**2 | |
13116 | DO 520 J=MIN2,MAX2 | |
13117 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 520 | |
13118 | EJ=KCHG(IABS(J),1)/3. | |
13119 | AJ=SIGN(1.,EJ) | |
13120 | VJ=AJ-4.*EJ*XW | |
13121 | AVJ=AJ**2+VJ**2 | |
13122 | NCHN=NCHN+1 | |
13123 | ISIG(NCHN,1)=I | |
13124 | ISIG(NCHN,2)=J | |
13125 | ISIG(NCHN,3)=1 | |
13126 | SIGH(NCHN)=FACH*AVI*AVJ | |
13127 | 520 CONTINUE | |
13128 | 530 CONTINUE | |
13129 | ||
13130 | ELSEIF(ISUB.EQ.72) THEN | |
13131 | C...Z0 + Z0 -> W+ + W-. | |
13132 | BE2=SQRT((1.-4.*SQMW/SH)*(1.-4.*SQMZ/SH)) | |
13133 | CTH2=CTH**2 | |
13134 | TH=-0.5*SH*(1.-2.*(SQMW+SQMZ)/SH-BE2*CTH) | |
13135 | UH=-0.5*SH*(1.-2.*(SQMW+SQMZ)/SH+BE2*CTH) | |
13136 | SHANG=4.*SQRT(SQMW/(SQMZ*(1.-XW)))*(1.-2.*SQMW/SH)* | |
13137 | & (1.-2.*SQMZ/SH) | |
13138 | ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG | |
13139 | ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG | |
13140 | ATWRE=(1.-XW)/SQMZ*SH/(TH-SQMW)*((CTH-BE2)**2*(3./2.+BE2/2.*CTH- | |
13141 | & (SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4.*((SQMW+SQMZ)/SH* | |
13142 | & (1.-3.*CTH2)+8.*SQMW*SQMZ/SH2*(2.*CTH2-1.)+ | |
13143 | & 4.*(SQMW**2+SQMZ**2)/SH2*CTH2+2.*(SQMW+SQMZ)/SH*BE2*CTH)) | |
13144 | ATWIM=0. | |
13145 | AUWRE=(1.-XW)/SQMZ*SH/(UH-SQMW)*((CTH+BE2)**2*(3./2.-BE2/2.*CTH- | |
13146 | & (SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4.*((SQMW+SQMZ)/SH* | |
13147 | & (1.-3.*CTH2)+8.*SQMW*SQMZ/SH2*(2.*CTH2-1.)+ | |
13148 | & 4.*(SQMW**2+SQMZ**2)/SH2*CTH2-2.*(SQMW+SQMZ)/SH*BE2*CTH)) | |
13149 | AUWIM=0. | |
13150 | A4RE=2.*(1.-XW)/SQMZ*(3.-CTH2-4.*(SQMW+SQMZ)/SH) | |
13151 | A4IM=0. | |
13152 | FACH=COMFAC*1./(4096.*PARU(1)**2*16.*(1.-XW)**2)*(AEM/XW)**4* | |
13153 | & (SH/SQMW)**2*((ASHRE+ATWRE+AUWRE+A4RE)**2+ | |
13154 | & (ASHIM+ATWIM+AUWIM+A4IM)**2)*SQMZ/SQMW | |
13155 | DO 550 I=MIN1,MAX1 | |
13156 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 550 | |
13157 | EI=KCHG(IABS(I),1)/3. | |
13158 | AI=SIGN(1.,EI) | |
13159 | VI=AI-4.*EI*XW | |
13160 | AVI=AI**2+VI**2 | |
13161 | DO 540 J=MIN2,MAX2 | |
13162 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 540 | |
13163 | EJ=KCHG(IABS(J),1)/3. | |
13164 | AJ=SIGN(1.,EJ) | |
13165 | VJ=AJ-4.*EJ*XW | |
13166 | AVJ=AJ**2+VJ**2 | |
13167 | NCHN=NCHN+1 | |
13168 | ISIG(NCHN,1)=I | |
13169 | ISIG(NCHN,2)=J | |
13170 | ISIG(NCHN,3)=1 | |
13171 | SIGH(NCHN)=FACH*AVI*AVJ | |
13172 | 540 CONTINUE | |
13173 | 550 CONTINUE | |
13174 | ||
13175 | ELSEIF(ISUB.EQ.73) THEN | |
13176 | C...Z0 + W+/- -> Z0 + W+/-. | |
13177 | BE2=1.-2.*(SQMZ+SQMW)/SH+((SQMZ-SQMW)/SH)**2 | |
13178 | EP1=1.+(SQMZ-SQMW)/SH | |
13179 | EP2=1.-(SQMZ-SQMW)/SH | |
13180 | TH=-0.5*SH*BE2*(1.-CTH) | |
13181 | UH=(SQMZ-SQMW)**2/SH-0.5*SH*BE2*(1.+CTH) | |
13182 | THANG=SQRT(SQMW/(SQMZ*(1.-XW)))*(BE2-EP1*CTH)*(BE2-EP2*CTH) | |
13183 | ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG | |
13184 | ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG | |
13185 | ASWRE=(1.-XW)/SQMZ*SH/(SH-SQMW)*(-BE2*(EP1+EP2)**4*CTH+ | |
13186 | & 1./4.*(BE2+EP1*EP2)**2*((EP1-EP2)**2-4.*BE2*CTH)+ | |
13187 | & 2.*BE2*(BE2+EP1*EP2)*(EP1+EP2)**2*CTH- | |
13188 | & 1./16.*SH/SQMW*(EP1**2-EP2**2)**2*(BE2+EP1*EP2)**2) | |
13189 | ASWIM=0. | |
13190 | AUWRE=(1.-XW)/SQMZ*SH/(UH-SQMW)*(-BE2*(EP2+EP1*CTH)* | |
13191 | & (EP1+EP2*CTH)*(BE2+EP1*EP2)+BE2*(EP2+EP1*CTH)* | |
13192 | & (BE2+EP1*EP2*CTH)*(2.*EP2-EP2*CTH+EP1)-BE2*(EP2+EP1*CTH)**2* | |
13193 | & (BE2-EP2**2*CTH)-1./8.*(BE2+EP1*EP2*CTH)**2*((EP1+EP2)**2+ | |
13194 | & 2.*BE2*(1.-CTH))+1./32.*SH/SQMW*(BE2+EP1*EP2*CTH)**2* | |
13195 | & (EP1**2-EP2**2)**2-BE2*(EP1+EP2*CTH)*(EP2+EP1*CTH)* | |
13196 | & (BE2+EP1*EP2)+BE2*(EP1+EP2*CTH)*(BE2+EP1*EP2*CTH)* | |
13197 | & (2.*EP1-EP1*CTH+EP2)-BE2*(EP1+EP2*CTH)**2*(BE2-EP1**2*CTH)- | |
13198 | & 1./8.*(BE2+EP1*EP2*CTH)**2*((EP1+EP2)**2+2.*BE2*(1.-CTH))+ | |
13199 | & 1./32.*SH/SQMW*(BE2+EP1*EP2*CTH)**2*(EP1**2-EP2**2)**2) | |
13200 | AUWIM=0. | |
13201 | A4RE=(1.-XW)/SQMZ*(EP1**2*EP2**2*(CTH**2-1.)- | |
13202 | & 2.*BE2*(EP1**2+EP2**2+EP1*EP2)*CTH-2.*BE2*EP1*EP2) | |
13203 | A4IM=0. | |
13204 | FACH=COMFAC*1./(4096.*PARU(1)**2*4.*(1.-XW))*(AEM/XW)**4* | |
13205 | & (SH/SQMW)**2*((ATHRE+ASWRE+AUWRE+A4RE)**2+ | |
13206 | & (ATHIM+ASWIM+AUWIM+A4IM)**2)*SQRT(SQMZ/SQMW) | |
13207 | DO 570 I=MIN1,MAX1 | |
13208 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 570 | |
13209 | EI=KCHG(IABS(I),1)/3. | |
13210 | AI=SIGN(1.,EI) | |
13211 | VI=AI-4.*EI*XW | |
13212 | AVI=AI**2+VI**2 | |
13213 | DO 560 J=MIN2,MAX2 | |
13214 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 560 | |
13215 | EJ=KCHG(IABS(J),1)/3. | |
13216 | AJ=SIGN(1.,EJ) | |
13217 | VJ=AI-4.*EJ*XW | |
13218 | AVJ=AJ**2+VJ**2 | |
13219 | NCHN=NCHN+1 | |
13220 | ISIG(NCHN,1)=I | |
13221 | ISIG(NCHN,2)=J | |
13222 | ISIG(NCHN,3)=1 | |
13223 | SIGH(NCHN)=FACH*(AVI*VINT(180+J)+VINT(180+I)*AVJ) | |
13224 | 560 CONTINUE | |
13225 | 570 CONTINUE | |
13226 | ||
13227 | ELSEIF(ISUB.EQ.75) THEN | |
13228 | C...W+ + W- -> gamma + gamma. | |
13229 | ||
13230 | ELSEIF(ISUB.EQ.76) THEN | |
13231 | C...W+ + W- -> Z0 + Z0. | |
13232 | BE2=SQRT((1.-4.*SQMW/SH)*(1.-4.*SQMZ/SH)) | |
13233 | CTH2=CTH**2 | |
13234 | TH=-0.5*SH*(1.-2.*(SQMW+SQMZ)/SH-BE2*CTH) | |
13235 | UH=-0.5*SH*(1.-2.*(SQMW+SQMZ)/SH+BE2*CTH) | |
13236 | SHANG=4.*SQRT(SQMW/(SQMZ*(1.-XW)))*(1.-2.*SQMW/SH)* | |
13237 | & (1.-2.*SQMZ/SH) | |
13238 | ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG | |
13239 | ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG | |
13240 | ATWRE=(1.-XW)/SQMZ*SH/(TH-SQMW)*((CTH-BE2)**2*(3./2.+BE2/2.*CTH- | |
13241 | & (SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4.*((SQMW+SQMZ)/SH* | |
13242 | & (1.-3.*CTH2)+8.*SQMW*SQMZ/SH2*(2.*CTH2-1.)+ | |
13243 | & 4.*(SQMW**2+SQMZ**2)/SH2*CTH2+2.*(SQMW+SQMZ)/SH*BE2*CTH)) | |
13244 | ATWIM=0. | |
13245 | AUWRE=(1.-XW)/SQMZ*SH/(UH-SQMW)*((CTH+BE2)**2*(3./2.-BE2/2.*CTH- | |
13246 | & (SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4.*((SQMW+SQMZ)/SH* | |
13247 | & (1.-3.*CTH2)+8.*SQMW*SQMZ/SH2*(2.*CTH2-1.)+ | |
13248 | & 4.*(SQMW**2+SQMZ**2)/SH2*CTH2-2.*(SQMW+SQMZ)/SH*BE2*CTH)) | |
13249 | AUWIM=0. | |
13250 | A4RE=2.*(1.-XW)/SQMZ*(3.-CTH2-4.*(SQMW+SQMZ)/SH) | |
13251 | A4IM=0. | |
13252 | FACH=0.5*COMFAC*1./(4096.*PARU(1)**2)*(AEM/XW)**4*(SH/SQMW)**2* | |
13253 | & ((ASHRE+ATWRE+AUWRE+A4RE)**2+(ASHIM+ATWIM+AUWIM+A4IM)**2) | |
13254 | DO 590 I=MIN1,MAX1 | |
13255 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 590 | |
13256 | EI=SIGN(1.,FLOAT(I))*KCHG(IABS(I),1) | |
13257 | DO 580 J=MIN2,MAX2 | |
13258 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 580 | |
13259 | EJ=SIGN(1.,FLOAT(J))*KCHG(IABS(J),1) | |
13260 | IF(EI*EJ.GT.0.) GOTO 580 | |
13261 | NCHN=NCHN+1 | |
13262 | ISIG(NCHN,1)=I | |
13263 | ISIG(NCHN,2)=J | |
13264 | ISIG(NCHN,3)=1 | |
13265 | SIGH(NCHN)=FACH*VINT(180+I)*VINT(180+J) | |
13266 | 580 CONTINUE | |
13267 | 590 CONTINUE | |
13268 | ||
13269 | ELSEIF(ISUB.EQ.77) THEN | |
13270 | C...W+/- + W+/- -> W+/- + W+/-. | |
13271 | BE2=1.-4.*SQMW/SH | |
13272 | BE4=BE2**2 | |
13273 | CTH2=CTH**2 | |
13274 | CTH3=CTH**3 | |
13275 | TH=-0.5*SH*BE2*(1.-CTH) | |
13276 | UH=-0.5*SH*BE2*(1.+CTH) | |
13277 | SHANG=(1.+BE2)**2 | |
13278 | ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG | |
13279 | ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG | |
13280 | THANG=(BE2-CTH)**2 | |
13281 | ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG | |
13282 | ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG | |
13283 | SGZANG=1./SQMW*BE2*(3.-BE2)**2*CTH | |
13284 | ASGRE=XW*SGZANG | |
13285 | ASGIM=0. | |
13286 | ASZRE=(1.-XW)*SH/(SH-SQMZ)*SGZANG | |
13287 | ASZIM=0. | |
13288 | TGZANG=1./SQMW*(BE2*(4.-2.*BE2+BE4)+BE2*(4.-10.*BE2+BE4)*CTH+ | |
13289 | & (2.-11.*BE2+10.*BE4)*CTH2+BE2*CTH3) | |
13290 | ATGRE=0.5*XW*SH/TH*TGZANG | |
13291 | ATGIM=0. | |
13292 | ATZRE=0.5*(1.-XW)*SH/(TH-SQMZ)*TGZANG | |
13293 | ATZIM=0. | |
13294 | A4RE=1./SQMW*(1.+2.*BE2-6.*BE2*CTH-CTH2) | |
13295 | A4IM=0. | |
13296 | FACH=COMFAC*1./(4096.*PARU(1)**2)*(AEM/XW)**4*(SH/SQMW)**2* | |
13297 | & ((ASHRE+ATHRE+ASGRE+ASZRE+ATGRE+ATZRE+A4RE)**2+ | |
13298 | & (ASHIM+ATHIM+ASGIM+ASZIM+ATGIM+ATZIM+A4IM)**2) | |
13299 | DO 610 I=MIN1,MAX1 | |
13300 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 610 | |
13301 | EI=SIGN(1.,FLOAT(I))*KCHG(IABS(I),1) | |
13302 | DO 600 J=MIN2,MAX2 | |
13303 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 600 | |
13304 | EJ=SIGN(1.,FLOAT(J))*KCHG(IABS(J),1) | |
13305 | IF(EI*EJ.GT.0.) GOTO 600 | |
13306 | NCHN=NCHN+1 | |
13307 | ISIG(NCHN,1)=I | |
13308 | ISIG(NCHN,2)=J | |
13309 | ISIG(NCHN,3)=1 | |
13310 | SIGH(NCHN)=FACH*VINT(180+I)*VINT(180+J) | |
13311 | 600 CONTINUE | |
13312 | 610 CONTINUE | |
13313 | ||
13314 | ELSEIF(ISUB.EQ.78) THEN | |
13315 | C...W+/- + H0 -> W+/- + H0. | |
13316 | ||
13317 | ELSEIF(ISUB.EQ.79) THEN | |
13318 | C...H0 + H0 -> H0 + H0. | |
13319 | ||
13320 | ENDIF | |
13321 | ||
13322 | C...C: 2 -> 2, tree diagrams with masses. | |
13323 | ||
13324 | ELSEIF(ISUB.LE.90) THEN | |
13325 | IF(ISUB.EQ.81) THEN | |
13326 | C...q + qb -> Q + QB. | |
13327 | FACQQB=COMFAC*AS**2*4./9.*(((TH-SQM3)**2+ | |
13328 | & (UH-SQM3)**2)/SH2+2.*SQM3/SH) | |
13329 | IF(MSTP(35).GE.1) THEN | |
13330 | IF(MSTP(35).EQ.1) THEN | |
13331 | ALSSG=PARP(35) | |
13332 | ELSE | |
13333 | MST115=MSTU(115) | |
13334 | MSTU(115)=MSTP(36) | |
13335 | Q2BN=SQRT(SQM3*((SQRT(SH)-2.*SQRT(SQM3))**2+PARP(36)**2)) | |
13336 | ALSSG=ULALPS(Q2BN) | |
13337 | MSTU(115)=MST115 | |
13338 | ENDIF | |
13339 | XREPU=PARU(1)*ALSSG/(6.*SQRT(MAX(1E-20,1.-4.*SQM3/SH))) | |
13340 | FREPU=XREPU/(EXP(MIN(100.,XREPU))-1.) | |
13341 | PARI(81)=FREPU | |
13342 | FACQQB=FACQQB*FREPU | |
13343 | ENDIF | |
13344 | DO 620 I=MINA,MAXA | |
13345 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 620 | |
13346 | NCHN=NCHN+1 | |
13347 | ISIG(NCHN,1)=I | |
13348 | ISIG(NCHN,2)=-I | |
13349 | ISIG(NCHN,3)=1 | |
13350 | SIGH(NCHN)=FACQQB | |
13351 | 620 CONTINUE | |
13352 | ||
13353 | ELSEIF(ISUB.EQ.82) THEN | |
13354 | C...g + g -> Q + QB. | |
13355 | FACQQ1=COMFAC*FACA*AS**2*1./6.*((UH-SQM3)/(TH-SQM3)- | |
13356 | & 2.*(UH-SQM3)**2/SH2+4.*SQM3/SH*(TH*UH-SQM3**2)/(TH-SQM3)**2) | |
13357 | FACQQ2=COMFAC*FACA*AS**2*1./6.*((TH-SQM3)/(UH-SQM3)- | |
13358 | & 2.*(TH-SQM3)**2/SH2+4.*SQM3/SH*(TH*UH-SQM3**2)/(UH-SQM3)**2) | |
13359 | IF(MSTP(35).GE.1) THEN | |
13360 | IF(MSTP(35).EQ.1) THEN | |
13361 | ALSSG=PARP(35) | |
13362 | ELSE | |
13363 | MST115=MSTU(115) | |
13364 | MSTU(115)=MSTP(36) | |
13365 | Q2BN=SQRT(SQM3*((SQRT(SH)-2.*SQRT(SQM3))**2+PARP(36)**2)) | |
13366 | ALSSG=ULALPS(Q2BN) | |
13367 | MSTU(115)=MST115 | |
13368 | ENDIF | |
13369 | XATTR=4.*PARU(1)*ALSSG/(3.*SQRT(MAX(1E-20,1.-4.*SQM3/SH))) | |
13370 | FATTR=XATTR/(1.-EXP(-MIN(100.,XATTR))) | |
13371 | XREPU=PARU(1)*ALSSG/(6.*SQRT(MAX(1E-20,1.-4.*SQM3/SH))) | |
13372 | FREPU=XREPU/(EXP(MIN(100.,XREPU))-1.) | |
13373 | FATRE=(2.*FATTR+5.*FREPU)/7. | |
13374 | PARI(81)=FATRE | |
13375 | FACQQ1=FACQQ1*FATRE | |
13376 | FACQQ2=FACQQ2*FATRE | |
13377 | ENDIF | |
13378 | IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 630 | |
13379 | NCHN=NCHN+1 | |
13380 | ISIG(NCHN,1)=21 | |
13381 | ISIG(NCHN,2)=21 | |
13382 | ISIG(NCHN,3)=1 | |
13383 | SIGH(NCHN)=FACQQ1 | |
13384 | NCHN=NCHN+1 | |
13385 | ISIG(NCHN,1)=21 | |
13386 | ISIG(NCHN,2)=21 | |
13387 | ISIG(NCHN,3)=2 | |
13388 | SIGH(NCHN)=FACQQ2 | |
13389 | 630 CONTINUE | |
13390 | ||
13391 | ENDIF | |
13392 | ||
13393 | C...D: Mimimum bias processes. | |
13394 | ||
13395 | ELSEIF(ISUB.LE.100) THEN | |
13396 | IF(ISUB.EQ.91) THEN | |
13397 | C...Elastic scattering. | |
13398 | SIGS=XSEC(ISUB,1) | |
13399 | ||
13400 | ELSEIF(ISUB.EQ.92) THEN | |
13401 | C...Single diffractive scattering. | |
13402 | SIGS=XSEC(ISUB,1) | |
13403 | ||
13404 | ELSEIF(ISUB.EQ.93) THEN | |
13405 | C...Double diffractive scattering. | |
13406 | SIGS=XSEC(ISUB,1) | |
13407 | ||
13408 | ELSEIF(ISUB.EQ.94) THEN | |
13409 | C...Central diffractive scattering. | |
13410 | SIGS=XSEC(ISUB,1) | |
13411 | ||
13412 | ELSEIF(ISUB.EQ.95) THEN | |
13413 | C...Low-pT scattering. | |
13414 | SIGS=XSEC(ISUB,1) | |
13415 | ||
13416 | ELSEIF(ISUB.EQ.96) THEN | |
13417 | C...Multiple interactions: sum of QCD processes. | |
ce320da8 | 13418 | CALL PYWIDTA(21,SQRT(SH),WDTP,WDTE) |
0119ef9a | 13419 | |
13420 | C...q + q' -> q + q'. | |
13421 | FACQQ1=COMFAC*AS**2*4./9.*(SH2+UH2)/TH2 | |
13422 | FACQQB=COMFAC*AS**2*4./9.*((SH2+UH2)/TH2*FACA- | |
13423 | & MSTP(34)*2./3.*UH2/(SH*TH)) | |
13424 | FACQQ2=COMFAC*AS**2*4./9.*((SH2+TH2)/UH2- | |
13425 | & MSTP(34)*2./3.*SH2/(TH*UH)) | |
13426 | DO 650 I=-3,3 | |
13427 | IF(I.EQ.0) GOTO 650 | |
13428 | DO 640 J=-3,3 | |
13429 | IF(J.EQ.0) GOTO 640 | |
13430 | NCHN=NCHN+1 | |
13431 | ISIG(NCHN,1)=I | |
13432 | ISIG(NCHN,2)=J | |
13433 | ISIG(NCHN,3)=111 | |
13434 | SIGH(NCHN)=FACQQ1 | |
13435 | IF(I.EQ.-J) SIGH(NCHN)=FACQQB | |
13436 | IF(I.EQ.J) THEN | |
13437 | SIGH(NCHN)=0.5*SIGH(NCHN) | |
13438 | NCHN=NCHN+1 | |
13439 | ISIG(NCHN,1)=I | |
13440 | ISIG(NCHN,2)=J | |
13441 | ISIG(NCHN,3)=112 | |
13442 | SIGH(NCHN)=0.5*FACQQ2 | |
13443 | ENDIF | |
13444 | 640 CONTINUE | |
13445 | 650 CONTINUE | |
13446 | ||
13447 | C...q + qb -> q' + qb' or g + g. | |
13448 | FACQQB=COMFAC*AS**2*4./9.*(TH2+UH2)/SH2*(WDTE(0,1)+WDTE(0,2)+ | |
13449 | & WDTE(0,3)+WDTE(0,4)) | |
13450 | FACGG1=COMFAC*AS**2*32./27.*(UH/TH-(2.+MSTP(34)*1./4.)*UH2/SH2) | |
13451 | FACGG2=COMFAC*AS**2*32./27.*(TH/UH-(2.+MSTP(34)*1./4.)*TH2/SH2) | |
13452 | DO 660 I=-3,3 | |
13453 | IF(I.EQ.0) GOTO 660 | |
13454 | NCHN=NCHN+1 | |
13455 | ISIG(NCHN,1)=I | |
13456 | ISIG(NCHN,2)=-I | |
13457 | ISIG(NCHN,3)=121 | |
13458 | SIGH(NCHN)=FACQQB | |
13459 | NCHN=NCHN+1 | |
13460 | ISIG(NCHN,1)=I | |
13461 | ISIG(NCHN,2)=-I | |
13462 | ISIG(NCHN,3)=131 | |
13463 | SIGH(NCHN)=0.5*FACGG1 | |
13464 | NCHN=NCHN+1 | |
13465 | ISIG(NCHN,1)=I | |
13466 | ISIG(NCHN,2)=-I | |
13467 | ISIG(NCHN,3)=132 | |
13468 | SIGH(NCHN)=0.5*FACGG2 | |
13469 | 660 CONTINUE | |
13470 | ||
13471 | C...q + g -> q + g. | |
13472 | FACQG1=COMFAC*AS**2*4./9.*((2.+MSTP(34)*1./4.)*UH2/TH2-UH/SH)* | |
13473 | & FACA | |
13474 | FACQG2=COMFAC*AS**2*4./9.*((2.+MSTP(34)*1./4.)*SH2/TH2-SH/UH) | |
13475 | DO 680 I=-3,3 | |
13476 | IF(I.EQ.0) GOTO 680 | |
13477 | DO 670 ISDE=1,2 | |
13478 | NCHN=NCHN+1 | |
13479 | ISIG(NCHN,ISDE)=I | |
13480 | ISIG(NCHN,3-ISDE)=21 | |
13481 | ISIG(NCHN,3)=281 | |
13482 | SIGH(NCHN)=FACQG1 | |
13483 | NCHN=NCHN+1 | |
13484 | ISIG(NCHN,ISDE)=I | |
13485 | ISIG(NCHN,3-ISDE)=21 | |
13486 | ISIG(NCHN,3)=282 | |
13487 | SIGH(NCHN)=FACQG2 | |
13488 | 670 CONTINUE | |
13489 | 680 CONTINUE | |
13490 | ||
13491 | C...g + g -> q + qb or g + g. | |
13492 | FACQQ1=COMFAC*AS**2*1./6.*(UH/TH-(2.+MSTP(34)*1./4.)*UH2/SH2)* | |
13493 | & (WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))*FACA | |
13494 | FACQQ2=COMFAC*AS**2*1./6.*(TH/UH-(2.+MSTP(34)*1./4.)*TH2/SH2)* | |
13495 | & (WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))*FACA | |
13496 | FACGG1=COMFAC*AS**2*9./4.*(SH2/TH2+2.*SH/TH+3.+2.*TH/SH+ | |
13497 | & TH2/SH2)*FACA | |
13498 | FACGG2=COMFAC*AS**2*9./4.*(UH2/SH2+2.*UH/SH+3.+2.*SH/UH+ | |
13499 | & SH2/UH2)*FACA | |
13500 | FACGG3=COMFAC*AS**2*9./4.*(TH2/UH2+2.*TH/UH+3+2.*UH/TH+UH2/TH2) | |
13501 | NCHN=NCHN+1 | |
13502 | ISIG(NCHN,1)=21 | |
13503 | ISIG(NCHN,2)=21 | |
13504 | ISIG(NCHN,3)=531 | |
13505 | SIGH(NCHN)=FACQQ1 | |
13506 | NCHN=NCHN+1 | |
13507 | ISIG(NCHN,1)=21 | |
13508 | ISIG(NCHN,2)=21 | |
13509 | ISIG(NCHN,3)=532 | |
13510 | SIGH(NCHN)=FACQQ2 | |
13511 | NCHN=NCHN+1 | |
13512 | ISIG(NCHN,1)=21 | |
13513 | ISIG(NCHN,2)=21 | |
13514 | ISIG(NCHN,3)=681 | |
13515 | SIGH(NCHN)=0.5*FACGG1 | |
13516 | NCHN=NCHN+1 | |
13517 | ISIG(NCHN,1)=21 | |
13518 | ISIG(NCHN,2)=21 | |
13519 | ISIG(NCHN,3)=682 | |
13520 | SIGH(NCHN)=0.5*FACGG2 | |
13521 | NCHN=NCHN+1 | |
13522 | ISIG(NCHN,1)=21 | |
13523 | ISIG(NCHN,2)=21 | |
13524 | ISIG(NCHN,3)=683 | |
13525 | SIGH(NCHN)=0.5*FACGG3 | |
13526 | ENDIF | |
13527 | ||
13528 | C...E: 2 -> 1, loop diagrams. | |
13529 | ||
13530 | ELSEIF(ISUB.LE.110) THEN | |
13531 | IF(ISUB.EQ.101) THEN | |
13532 | C...g + g -> gamma*/Z0. | |
13533 | ||
13534 | ELSEIF(ISUB.EQ.102) THEN | |
13535 | C...g + g -> H0. | |
ce320da8 | 13536 | CALL PYWIDTA(25,SQRT(SH),WDTP,WDTE) |
0119ef9a | 13537 | ETARE=0. |
13538 | ETAIM=0. | |
13539 | DO 690 I=1,2*MSTP(1) | |
13540 | EPS=4.*PMAS(I,1)**2/SH | |
13541 | IF(EPS.LE.1.) THEN | |
13542 | IF(EPS.GT.1.E-4) THEN | |
13543 | ROOT=SQRT(1.-EPS) | |
13544 | RLN=LOG((1.+ROOT)/(1.-ROOT)) | |
13545 | ELSE | |
13546 | RLN=LOG(4./EPS-2.) | |
13547 | ENDIF | |
13548 | PHIRE=0.25*(RLN**2-PARU(1)**2) | |
13549 | PHIIM=0.5*PARU(1)*RLN | |
13550 | ELSE | |
13551 | PHIRE=-(ASIN(1./SQRT(EPS)))**2 | |
13552 | PHIIM=0. | |
13553 | ENDIF | |
13554 | ETARE=ETARE+0.5*EPS*(1.+(EPS-1.)*PHIRE) | |
13555 | ETAIM=ETAIM+0.5*EPS*(EPS-1.)*PHIIM | |
13556 | 690 CONTINUE | |
13557 | ETA2=ETARE**2+ETAIM**2 | |
13558 | FACH=COMFAC*FACA*(AS/PARU(1)*AEM/XW)**2*1./512.* | |
13559 | & (SH/SQMW)**2*ETA2*SH2/((SH-SQMH)**2+GMMH**2)* | |
13560 | & (WDTE(0,1)+WDTE(0,2)+WDTE(0,4)) | |
13561 | IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 700 | |
13562 | NCHN=NCHN+1 | |
13563 | ISIG(NCHN,1)=21 | |
13564 | ISIG(NCHN,2)=21 | |
13565 | ISIG(NCHN,3)=1 | |
13566 | SIGH(NCHN)=FACH | |
13567 | 700 CONTINUE | |
13568 | ||
13569 | ENDIF | |
13570 | ||
13571 | C...F: 2 -> 2, box diagrams. | |
13572 | ||
13573 | ELSEIF(ISUB.LE.120) THEN | |
13574 | IF(ISUB.EQ.111) THEN | |
13575 | C...f + fb -> g + H0 (q + qb -> g + H0 only). | |
13576 | A5STUR=0. | |
13577 | A5STUI=0. | |
13578 | DO 710 I=1,2*MSTP(1) | |
13579 | SQMQ=PMAS(I,1)**2 | |
13580 | EPSS=4.*SQMQ/SH | |
13581 | EPSH=4.*SQMQ/SQMH | |
13582 | A5STUR=A5STUR+SQMQ/SQMH*(4.+4.*SH/(TH+UH)*(PYW1AU(EPSS,1)- | |
13583 | & PYW1AU(EPSH,1))+(1.-4.*SQMQ/(TH+UH))*(PYW2AU(EPSS,1)- | |
13584 | & PYW2AU(EPSH,1))) | |
13585 | A5STUI=A5STUI+SQMQ/SQMH*(4.*SH/(TH+UH)*(PYW1AU(EPSS,2)- | |
13586 | & PYW1AU(EPSH,2))+(1.-4.*SQMQ/(TH+UH))*(PYW2AU(EPSS,2)- | |
13587 | & PYW2AU(EPSH,2))) | |
13588 | 710 CONTINUE | |
13589 | FACGH=COMFAC*FACA/(144.*PARU(1)**2)*AEM/XW*AS**3*SQMH/SQMW* | |
13590 | & SQMH/SH*(UH**2+TH**2)/(UH+TH)**2*(A5STUR**2+A5STUI**2) | |
13591 | FACGH=FACGH*WIDS(25,2) | |
13592 | DO 720 I=MINA,MAXA | |
13593 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 720 | |
13594 | NCHN=NCHN+1 | |
13595 | ISIG(NCHN,1)=I | |
13596 | ISIG(NCHN,2)=-I | |
13597 | ISIG(NCHN,3)=1 | |
13598 | SIGH(NCHN)=FACGH | |
13599 | 720 CONTINUE | |
13600 | ||
13601 | ELSEIF(ISUB.EQ.112) THEN | |
13602 | C...f + g -> f + H0 (q + g -> q + H0 only). | |
13603 | A5TSUR=0. | |
13604 | A5TSUI=0. | |
13605 | DO 730 I=1,2*MSTP(1) | |
13606 | SQMQ=PMAS(I,1)**2 | |
13607 | EPST=4.*SQMQ/TH | |
13608 | EPSH=4.*SQMQ/SQMH | |
13609 | A5TSUR=A5TSUR+SQMQ/SQMH*(4.+4.*TH/(SH+UH)*(PYW1AU(EPST,1)- | |
13610 | & PYW1AU(EPSH,1))+(1.-4.*SQMQ/(SH+UH))*(PYW2AU(EPST,1)- | |
13611 | & PYW2AU(EPSH,1))) | |
13612 | A5TSUI=A5TSUI+SQMQ/SQMH*(4.*TH/(SH+UH)*(PYW1AU(EPST,2)- | |
13613 | & PYW1AU(EPSH,2))+(1.-4.*SQMQ/(SH+UH))*(PYW2AU(EPST,2)- | |
13614 | & PYW2AU(EPSH,2))) | |
13615 | 730 CONTINUE | |
13616 | FACQH=COMFAC*FACA/(384.*PARU(1)**2)*AEM/XW*AS**3*SQMH/SQMW* | |
13617 | & SQMH/(-TH)*(UH**2+SH**2)/(UH+SH)**2*(A5TSUR**2+A5TSUI**2) | |
13618 | FACQH=FACQH*WIDS(25,2) | |
13619 | DO 750 I=MINA,MAXA | |
13620 | IF(I.EQ.0) GOTO 750 | |
13621 | DO 740 ISDE=1,2 | |
13622 | IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 740 | |
13623 | IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 740 | |
13624 | NCHN=NCHN+1 | |
13625 | ISIG(NCHN,ISDE)=I | |
13626 | ISIG(NCHN,3-ISDE)=21 | |
13627 | ISIG(NCHN,3)=1 | |
13628 | SIGH(NCHN)=FACQH | |
13629 | 740 CONTINUE | |
13630 | 750 CONTINUE | |
13631 | ||
13632 | ELSEIF(ISUB.EQ.113) THEN | |
13633 | C...g + g -> g + H0. | |
13634 | A2STUR=0. | |
13635 | A2STUI=0. | |
13636 | A2USTR=0. | |
13637 | A2USTI=0. | |
13638 | A2TUSR=0. | |
13639 | A2TUSI=0. | |
13640 | A4STUR=0. | |
13641 | A4STUI=0. | |
13642 | DO 760 I=6,2*MSTP(1) | |
13643 | C'''Only t-quarks yet included | |
13644 | SQMQ=PMAS(I,1)**2 | |
13645 | EPSS=4.*SQMQ/SH | |
13646 | EPST=4.*SQMQ/TH | |
13647 | EPSU=4.*SQMQ/UH | |
13648 | EPSH=4.*SQMQ/SQMH | |
13649 | IF(EPSH.LT.1.E-6) GOTO 760 | |
13650 | BESTU=0.5*(1.+SQRT(1.+EPSS*TH/UH)) | |
13651 | BEUST=0.5*(1.+SQRT(1.+EPSU*SH/TH)) | |
13652 | BETUS=0.5*(1.+SQRT(1.+EPST*UH/SH)) | |
13653 | BEUTS=BESTU | |
13654 | BETSU=BEUST | |
13655 | BESUT=BETUS | |
ce320da8 | 13656 | W3STUR=PYI3AA(BESTU,EPSH,1)-PYI3AA(BESTU,EPSS,1)- |
13657 | & PYI3AA(BESTU,EPSU,1) | |
13658 | W3STUI=PYI3AA(BESTU,EPSH,2)-PYI3AA(BESTU,EPSS,2)- | |
13659 | & PYI3AA(BESTU,EPSU,2) | |
13660 | W3SUTR=PYI3AA(BESUT,EPSH,1)-PYI3AA(BESUT,EPSS,1)- | |
13661 | & PYI3AA(BESUT,EPST,1) | |
13662 | W3SUTI=PYI3AA(BESUT,EPSH,2)-PYI3AA(BESUT,EPSS,2)- | |
13663 | & PYI3AA(BESUT,EPST,2) | |
13664 | W3TSUR=PYI3AA(BETSU,EPSH,1)-PYI3AA(BETSU,EPST,1)- | |
13665 | & PYI3AA(BETSU,EPSU,1) | |
13666 | W3TSUI=PYI3AA(BETSU,EPSH,2)-PYI3AA(BETSU,EPST,2)- | |
13667 | & PYI3AA(BETSU,EPSU,2) | |
13668 | W3TUSR=PYI3AA(BETUS,EPSH,1)-PYI3AA(BETUS,EPST,1)- | |
13669 | & PYI3AA(BETUS,EPSS,1) | |
13670 | W3TUSI=PYI3AA(BETUS,EPSH,2)-PYI3AA(BETUS,EPST,2)- | |
13671 | & PYI3AA(BETUS,EPSS,2) | |
13672 | W3USTR=PYI3AA(BEUST,EPSH,1)-PYI3AA(BEUST,EPSU,1)- | |
13673 | & PYI3AA(BEUST,EPST,1) | |
13674 | W3USTI=PYI3AA(BEUST,EPSH,2)-PYI3AA(BEUST,EPSU,2)- | |
13675 | & PYI3AA(BEUST,EPST,2) | |
13676 | W3UTSR=PYI3AA(BEUTS,EPSH,1)-PYI3AA(BEUTS,EPSU,1)- | |
13677 | & PYI3AA(BEUTS,EPSS,1) | |
13678 | W3UTSI=PYI3AA(BEUTS,EPSH,2)-PYI3AA(BEUTS,EPSU,2)- | |
13679 | & PYI3AA(BEUTS,EPSS,2) | |
0119ef9a | 13680 | B2STUR=SQMQ/SQMH**2*(SH*(UH-SH)/(SH+UH)+2.*TH*UH*(UH+2.*SH)/ |
13681 | & (SH+UH)**2*(PYW1AU(EPST,1)-PYW1AU(EPSH,1))+(SQMQ-SH/4.)* | |
13682 | & (0.5*PYW2AU(EPSS,1)+0.5*PYW2AU(EPSH,1)-PYW2AU(EPST,1)+W3STUR)+ | |
13683 | & SH**2*(2.*SQMQ/(SH+UH)**2-0.5/(SH+UH))*(PYW2AU(EPST,1)- | |
13684 | & PYW2AU(EPSH,1))+0.5*TH*UH/SH*(PYW2AU(EPSH,1)-2.*PYW2AU(EPST,1))+ | |
13685 | & 0.125*(SH-12.*SQMQ-4.*TH*UH/SH)*W3TSUR) | |
13686 | B2STUI=SQMQ/SQMH**2*(2.*TH*UH*(UH+2.*SH)/(SH+UH)**2* | |
13687 | & (PYW1AU(EPST,2)-PYW1AU(EPSH,2))+(SQMQ-SH/4.)* | |
13688 | & (0.5*PYW2AU(EPSS,2)+0.5*PYW2AU(EPSH,2)-PYW2AU(EPST,2)+W3STUI)+ | |
13689 | & SH**2*(2.*SQMQ/(SH+UH)**2-0.5/(SH+UH))*(PYW2AU(EPST,2)- | |
13690 | & PYW2AU(EPSH,2))+0.5*TH*UH/SH*(PYW2AU(EPSH,2)-2.*PYW2AU(EPST,2))+ | |
13691 | & 0.125*(SH-12.*SQMQ-4.*TH*UH/SH)*W3TSUI) | |
13692 | B2SUTR=SQMQ/SQMH**2*(SH*(TH-SH)/(SH+TH)+2.*UH*TH*(TH+2.*SH)/ | |
13693 | & (SH+TH)**2*(PYW1AU(EPSU,1)-PYW1AU(EPSH,1))+(SQMQ-SH/4.)* | |
13694 | & (0.5*PYW2AU(EPSS,1)+0.5*PYW2AU(EPSH,1)-PYW2AU(EPSU,1)+W3SUTR)+ | |
13695 | & SH**2*(2.*SQMQ/(SH+TH)**2-0.5/(SH+TH))*(PYW2AU(EPSU,1)- | |
13696 | & PYW2AU(EPSH,1))+0.5*UH*TH/SH*(PYW2AU(EPSH,1)-2.*PYW2AU(EPSU,1))+ | |
13697 | & 0.125*(SH-12.*SQMQ-4.*UH*TH/SH)*W3USTR) | |
13698 | B2SUTI=SQMQ/SQMH**2*(2.*UH*TH*(TH+2.*SH)/(SH+TH)**2* | |
13699 | & (PYW1AU(EPSU,2)-PYW1AU(EPSH,2))+(SQMQ-SH/4.)* | |
13700 | & (0.5*PYW2AU(EPSS,2)+0.5*PYW2AU(EPSH,2)-PYW2AU(EPSU,2)+W3SUTI)+ | |
13701 | & SH**2*(2.*SQMQ/(SH+TH)**2-0.5/(SH+TH))*(PYW2AU(EPSU,2)- | |
13702 | & PYW2AU(EPSH,2))+0.5*UH*TH/SH*(PYW2AU(EPSH,2)-2.*PYW2AU(EPSU,2))+ | |
13703 | & 0.125*(SH-12.*SQMQ-4.*UH*TH/SH)*W3USTI) | |
13704 | B2TSUR=SQMQ/SQMH**2*(TH*(UH-TH)/(TH+UH)+2.*SH*UH*(UH+2.*TH)/ | |
13705 | & (TH+UH)**2*(PYW1AU(EPSS,1)-PYW1AU(EPSH,1))+(SQMQ-TH/4.)* | |
13706 | & (0.5*PYW2AU(EPST,1)+0.5*PYW2AU(EPSH,1)-PYW2AU(EPSS,1)+W3TSUR)+ | |
13707 | & TH**2*(2.*SQMQ/(TH+UH)**2-0.5/(TH+UH))*(PYW2AU(EPSS,1)- | |
13708 | & PYW2AU(EPSH,1))+0.5*SH*UH/TH*(PYW2AU(EPSH,1)-2.*PYW2AU(EPSS,1))+ | |
13709 | & 0.125*(TH-12.*SQMQ-4.*SH*UH/TH)*W3STUR) | |
13710 | B2TSUI=SQMQ/SQMH**2*(2.*SH*UH*(UH+2.*TH)/(TH+UH)**2* | |
13711 | & (PYW1AU(EPSS,2)-PYW1AU(EPSH,2))+(SQMQ-TH/4.)* | |
13712 | & (0.5*PYW2AU(EPST,2)+0.5*PYW2AU(EPSH,2)-PYW2AU(EPSS,2)+W3TSUI)+ | |
13713 | & TH**2*(2.*SQMQ/(TH+UH)**2-0.5/(TH+UH))*(PYW2AU(EPSS,2)- | |
13714 | & PYW2AU(EPSH,2))+0.5*SH*UH/TH*(PYW2AU(EPSH,2)-2.*PYW2AU(EPSS,2))+ | |
13715 | & 0.125*(TH-12.*SQMQ-4.*SH*UH/TH)*W3STUI) | |
13716 | B2TUSR=SQMQ/SQMH**2*(TH*(SH-TH)/(TH+SH)+2.*UH*SH*(SH+2.*TH)/ | |
13717 | & (TH+SH)**2*(PYW1AU(EPSU,1)-PYW1AU(EPSH,1))+(SQMQ-TH/4.)* | |
13718 | & (0.5*PYW2AU(EPST,1)+0.5*PYW2AU(EPSH,1)-PYW2AU(EPSU,1)+W3TUSR)+ | |
13719 | & TH**2*(2.*SQMQ/(TH+SH)**2-0.5/(TH+SH))*(PYW2AU(EPSU,1)- | |
13720 | & PYW2AU(EPSH,1))+0.5*UH*SH/TH*(PYW2AU(EPSH,1)-2.*PYW2AU(EPSU,1))+ | |
13721 | & 0.125*(TH-12.*SQMQ-4.*UH*SH/TH)*W3UTSR) | |
13722 | B2TUSI=SQMQ/SQMH**2*(2.*UH*SH*(SH+2.*TH)/(TH+SH)**2* | |
13723 | & (PYW1AU(EPSU,2)-PYW1AU(EPSH,2))+(SQMQ-TH/4.)* | |
13724 | & (0.5*PYW2AU(EPST,2)+0.5*PYW2AU(EPSH,2)-PYW2AU(EPSU,2)+W3TUSI)+ | |
13725 | & TH**2*(2.*SQMQ/(TH+SH)**2-0.5/(TH+SH))*(PYW2AU(EPSU,2)- | |
13726 | & PYW2AU(EPSH,2))+0.5*UH*SH/TH*(PYW2AU(EPSH,2)-2.*PYW2AU(EPSU,2))+ | |
13727 | & 0.125*(TH-12.*SQMQ-4.*UH*SH/TH)*W3UTSI) | |
13728 | B2USTR=SQMQ/SQMH**2*(UH*(TH-UH)/(UH+TH)+2.*SH*TH*(TH+2.*UH)/ | |
13729 | & (UH+TH)**2*(PYW1AU(EPSS,1)-PYW1AU(EPSH,1))+(SQMQ-UH/4.)* | |
13730 | & (0.5*PYW2AU(EPSU,1)+0.5*PYW2AU(EPSH,1)-PYW2AU(EPSS,1)+W3USTR)+ | |
13731 | & UH**2*(2.*SQMQ/(UH+TH)**2-0.5/(UH+TH))*(PYW2AU(EPSS,1)- | |
13732 | & PYW2AU(EPSH,1))+0.5*SH*TH/UH*(PYW2AU(EPSH,1)-2.*PYW2AU(EPSS,1))+ | |
13733 | & 0.125*(UH-12.*SQMQ-4.*SH*TH/UH)*W3SUTR) | |
13734 | B2USTI=SQMQ/SQMH**2*(2.*SH*TH*(TH+2.*UH)/(UH+TH)**2* | |
13735 | & (PYW1AU(EPSS,2)-PYW1AU(EPSH,2))+(SQMQ-UH/4.)* | |
13736 | & (0.5*PYW2AU(EPSU,2)+0.5*PYW2AU(EPSH,2)-PYW2AU(EPSS,2)+W3USTI)+ | |
13737 | & UH**2*(2.*SQMQ/(UH+TH)**2-0.5/(UH+TH))*(PYW2AU(EPSS,2)- | |
13738 | & PYW2AU(EPSH,2))+0.5*SH*TH/UH*(PYW2AU(EPSH,2)-2.*PYW2AU(EPSS,2))+ | |
13739 | & 0.125*(UH-12.*SQMQ-4.*SH*TH/UH)*W3SUTI) | |
13740 | B2UTSR=SQMQ/SQMH**2*(UH*(SH-UH)/(UH+SH)+2.*TH*SH*(SH+2.*UH)/ | |
13741 | & (UH+SH)**2*(PYW1AU(EPST,1)-PYW1AU(EPSH,1))+(SQMQ-UH/4.)* | |
13742 | & (0.5*PYW2AU(EPSU,1)+0.5*PYW2AU(EPSH,1)-PYW2AU(EPST,1)+W3UTSR)+ | |
13743 | & UH**2*(2.*SQMQ/(UH+SH)**2-0.5/(UH+SH))*(PYW2AU(EPST,1)- | |
13744 | & PYW2AU(EPSH,1))+0.5*TH*SH/UH*(PYW2AU(EPSH,1)-2.*PYW2AU(EPST,1))+ | |
13745 | & 0.125*(UH-12.*SQMQ-4.*TH*SH/UH)*W3TUSR) | |
13746 | B2UTSI=SQMQ/SQMH**2*(2.*TH*SH*(SH+2.*UH)/(UH+SH)**2* | |
13747 | & (PYW1AU(EPST,2)-PYW1AU(EPSH,2))+(SQMQ-UH/4.)* | |
13748 | & (0.5*PYW2AU(EPSU,2)+0.5*PYW2AU(EPSH,2)-PYW2AU(EPST,2)+W3UTSI)+ | |
13749 | & UH**2*(2.*SQMQ/(UH+SH)**2-0.5/(UH+SH))*(PYW2AU(EPST,2)- | |
13750 | & PYW2AU(EPSH,2))+0.5*TH*SH/UH*(PYW2AU(EPSH,2)-2.*PYW2AU(EPST,2))+ | |
13751 | & 0.125*(UH-12.*SQMQ-4.*TH*SH/UH)*W3TUSI) | |
13752 | B4STUR=SQMQ/SQMH*(-2./3.+(SQMQ/SQMH-1./4.)*(PYW2AU(EPSS,1)- | |
13753 | & PYW2AU(EPSH,1)+W3STUR)) | |
13754 | B4STUI=SQMQ/SQMH*(SQMQ/SQMH-1./4.)*(PYW2AU(EPSS,2)- | |
13755 | & PYW2AU(EPSH,2)+W3STUI) | |
13756 | B4TUSR=SQMQ/SQMH*(-2./3.+(SQMQ/SQMH-1./4.)*(PYW2AU(EPST,1)- | |
13757 | & PYW2AU(EPSH,1)+W3TUSR)) | |
13758 | B4TUSI=SQMQ/SQMH*(SQMQ/SQMH-1./4.)*(PYW2AU(EPST,2)- | |
13759 | & PYW2AU(EPSH,2)+W3TUSI) | |
13760 | B4USTR=SQMQ/SQMH*(-2./3.+(SQMQ/SQMH-1./4.)*(PYW2AU(EPSU,1)- | |
13761 | & PYW2AU(EPSH,1)+W3USTR)) | |
13762 | B4USTI=SQMQ/SQMH*(SQMQ/SQMH-1./4.)*(PYW2AU(EPSU,2)- | |
13763 | & PYW2AU(EPSH,2)+W3USTI) | |
13764 | A2STUR=A2STUR+B2STUR+B2SUTR | |
13765 | A2STUI=A2STUI+B2STUI+B2SUTI | |
13766 | A2USTR=A2USTR+B2USTR+B2UTSR | |
13767 | A2USTI=A2USTI+B2USTI+B2UTSI | |
13768 | A2TUSR=A2TUSR+B2TUSR+B2TSUR | |
13769 | A2TUSI=A2TUSI+B2TUSI+B2TSUI | |
13770 | A4STUR=A4STUR+B4STUR+B4USTR+B4TUSR | |
13771 | A4STUI=A4STUI+B4STUI+B4USTI+B4TUSI | |
13772 | 760 CONTINUE | |
13773 | FACGH=COMFAC*FACA*3./(128.*PARU(1)**2)*AEM/XW*AS**3* | |
13774 | & SQMH/SQMW*SQMH**3/(SH*TH*UH)*(A2STUR**2+A2STUI**2+A2USTR**2+ | |
13775 | & A2USTI**2+A2TUSR**2+A2TUSI**2+A4STUR**2+A4STUI**2) | |
13776 | FACGH=FACGH*WIDS(25,2) | |
13777 | IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 770 | |
13778 | NCHN=NCHN+1 | |
13779 | ISIG(NCHN,1)=21 | |
13780 | ISIG(NCHN,2)=21 | |
13781 | ISIG(NCHN,3)=1 | |
13782 | SIGH(NCHN)=FACGH | |
13783 | 770 CONTINUE | |
13784 | ||
13785 | ELSEIF(ISUB.EQ.114) THEN | |
13786 | C...g + g -> gamma + gamma. | |
13787 | ASRE=0. | |
13788 | ASIM=0. | |
13789 | DO 780 I=1,2*MSTP(1) | |
13790 | EI=KCHG(IABS(I),1)/3. | |
13791 | SQMQ=PMAS(I,1)**2 | |
13792 | EPSS=4.*SQMQ/SH | |
13793 | EPST=4.*SQMQ/TH | |
13794 | EPSU=4.*SQMQ/UH | |
13795 | IF(EPSS+ABS(EPST)+ABS(EPSU).LT.3.E-6) THEN | |
13796 | A0STUR=1.+(TH-UH)/SH*LOG(TH/UH)+0.5*(TH2+UH2)/SH2* | |
13797 | & (LOG(TH/UH)**2+PARU(1)**2) | |
13798 | A0STUI=0. | |
13799 | A0TSUR=1.+(SH-UH)/TH*LOG(-SH/UH)+0.5*(SH2+UH2)/TH2* | |
13800 | & LOG(-SH/UH)**2 | |
13801 | A0TSUI=-PARU(1)*((SH-UH)/TH+(SH2+UH2)/TH2*LOG(-SH/UH)) | |
13802 | A0UTSR=1.+(TH-SH)/UH*LOG(-TH/SH)+0.5*(TH2+SH2)/UH2* | |
13803 | & LOG(-TH/SH)**2 | |
13804 | A0UTSI=PARU(1)*((TH-SH)/UH+(TH2+SH2)/UH2*LOG(-TH/SH)) | |
13805 | A1STUR=-1. | |
13806 | A1STUI=0. | |
13807 | A2STUR=-1. | |
13808 | A2STUI=0. | |
13809 | ELSE | |
13810 | BESTU=0.5*(1.+SQRT(1.+EPSS*TH/UH)) | |
13811 | BEUST=0.5*(1.+SQRT(1.+EPSU*SH/TH)) | |
13812 | BETUS=0.5*(1.+SQRT(1.+EPST*UH/SH)) | |
13813 | BEUTS=BESTU | |
13814 | BETSU=BEUST | |
13815 | BESUT=BETUS | |
13816 | A0STUR=1.+(1.+2.*TH/SH)*PYW1AU(EPST,1)+(1.+2.*UH/SH)* | |
13817 | & PYW1AU(EPSU,1)+0.5*((TH2+UH2)/SH2-EPSS)*(PYW2AU(EPST,1)+ | |
ce320da8 | 13818 | & PYW2AU(EPSU,1))-0.25*EPST*(1.-0.5*EPSS)*(PYI3AA(BESUT,EPSS,1)+ |
13819 | & PYI3AA(BESUT,EPST,1))-0.25*EPSU*(1.-0.5*EPSS)* | |
13820 | & (PYI3AA(BESTU,EPSS,1)+PYI3AA(BESTU,EPSU,1))+ | |
0119ef9a | 13821 | & 0.25*(-2.*(TH2+UH2)/SH2+4.*EPSS+EPST+EPSU+0.5*EPST*EPSU)* |
ce320da8 | 13822 | & (PYI3AA(BETSU,EPST,1)+PYI3AA(BETSU,EPSU,1)) |
0119ef9a | 13823 | A0STUI=(1.+2.*TH/SH)*PYW1AU(EPST,2)+(1.+2.*UH/SH)* |
13824 | & PYW1AU(EPSU,2)+0.5*((TH2+UH2)/SH2-EPSS)*(PYW2AU(EPST,2)+ | |
ce320da8 | 13825 | & PYW2AU(EPSU,2))-0.25*EPST*(1.-0.5*EPSS)*(PYI3AA(BESUT,EPSS,2)+ |
13826 | & PYI3AA(BESUT,EPST,2))-0.25*EPSU*(1.-0.5*EPSS)* | |
13827 | & (PYI3AA(BESTU,EPSS,2)+PYI3AA(BESTU,EPSU,2))+ | |
0119ef9a | 13828 | & 0.25*(-2.*(TH2+UH2)/SH2+4.*EPSS+EPST+EPSU+0.5*EPST*EPSU)* |
ce320da8 | 13829 | & (PYI3AA(BETSU,EPST,2)+PYI3AA(BETSU,EPSU,2)) |
0119ef9a | 13830 | A0TSUR=1.+(1.+2.*SH/TH)*PYW1AU(EPSS,1)+(1.+2.*UH/TH)* |
13831 | & PYW1AU(EPSU,1)+0.5*((SH2+UH2)/TH2-EPST)*(PYW2AU(EPSS,1)+ | |
ce320da8 | 13832 | & PYW2AU(EPSU,1))-0.25*EPSS*(1.-0.5*EPST)*(PYI3AA(BETUS,EPST,1)+ |
13833 | & PYI3AA(BETUS,EPSS,1))-0.25*EPSU*(1.-0.5*EPST)* | |
13834 | & (PYI3AA(BETSU,EPST,1)+PYI3AA(BETSU,EPSU,1))+ | |
0119ef9a | 13835 | & 0.25*(-2.*(SH2+UH2)/TH2+4.*EPST+EPSS+EPSU+0.5*EPSS*EPSU)* |
ce320da8 | 13836 | & (PYI3AA(BESTU,EPSS,1)+PYI3AA(BESTU,EPSU,1)) |
0119ef9a | 13837 | A0TSUI=(1.+2.*SH/TH)*PYW1AU(EPSS,2)+(1.+2.*UH/TH)* |
13838 | & PYW1AU(EPSU,2)+0.5*((SH2+UH2)/TH2-EPST)*(PYW2AU(EPSS,2)+ | |
ce320da8 | 13839 | & PYW2AU(EPSU,2))-0.25*EPSS*(1.-0.5*EPST)*(PYI3AA(BETUS,EPST,2)+ |
13840 | & PYI3AA(BETUS,EPSS,2))-0.25*EPSU*(1.-0.5*EPST)* | |
13841 | & (PYI3AA(BETSU,EPST,2)+PYI3AA(BETSU,EPSU,2))+ | |
0119ef9a | 13842 | & 0.25*(-2.*(SH2+UH2)/TH2+4.*EPST+EPSS+EPSU+0.5*EPSS*EPSU)* |
ce320da8 | 13843 | & (PYI3AA(BESTU,EPSS,2)+PYI3AA(BESTU,EPSU,2)) |
0119ef9a | 13844 | A0UTSR=1.+(1.+2.*TH/UH)*PYW1AU(EPST,1)+(1.+2.*SH/UH)* |
13845 | & PYW1AU(EPSS,1)+0.5*((TH2+SH2)/UH2-EPSU)*(PYW2AU(EPST,1)+ | |
ce320da8 | 13846 | & PYW2AU(EPSS,1))-0.25*EPST*(1.-0.5*EPSU)*(PYI3AA(BEUST,EPSU,1)+ |
13847 | & PYI3AA(BEUST,EPST,1))-0.25*EPSS*(1.-0.5*EPSU)* | |
13848 | & (PYI3AA(BEUTS,EPSU,1)+PYI3AA(BEUTS,EPSS,1))+ | |
0119ef9a | 13849 | & 0.25*(-2.*(TH2+SH2)/UH2+4.*EPSU+EPST+EPSS+0.5*EPST*EPSS)* |
ce320da8 | 13850 | & (PYI3AA(BETUS,EPST,1)+PYI3AA(BETUS,EPSS,1)) |
0119ef9a | 13851 | A0UTSI=(1.+2.*TH/UH)*PYW1AU(EPST,2)+(1.+2.*SH/UH)* |
13852 | & PYW1AU(EPSS,2)+0.5*((TH2+SH2)/UH2-EPSU)*(PYW2AU(EPST,2)+ | |
ce320da8 | 13853 | & PYW2AU(EPSS,2))-0.25*EPST*(1.-0.5*EPSU)*(PYI3AA(BEUST,EPSU,2)+ |
13854 | & PYI3AA(BEUST,EPST,2))-0.25*EPSS*(1.-0.5*EPSU)* | |
13855 | & (PYI3AA(BEUTS,EPSU,2)+PYI3AA(BEUTS,EPSS,2))+ | |
0119ef9a | 13856 | & 0.25*(-2.*(TH2+SH2)/UH2+4.*EPSU+EPST+EPSS+0.5*EPST*EPSS)* |
ce320da8 | 13857 | & (PYI3AA(BETUS,EPST,2)+PYI3AA(BETUS,EPSS,2)) |
0119ef9a | 13858 | A1STUR=-1.-0.25*(EPSS+EPST+EPSU)*(PYW2AU(EPSS,1)+ |
13859 | & PYW2AU(EPST,1)+PYW2AU(EPSU,1))+0.25*(EPSU+0.5*EPSS*EPST)* | |
ce320da8 | 13860 | & (PYI3AA(BESUT,EPSS,1)+PYI3AA(BESUT,EPST,1))+ |
13861 | & 0.25*(EPST+0.5*EPSS*EPSU)*(PYI3AA(BESTU,EPSS,1)+ | |
13862 | & PYI3AA(BESTU,EPSU,1))+0.25*(EPSS+0.5*EPST*EPSU)* | |
13863 | & (PYI3AA(BETSU,EPST,1)+PYI3AA(BETSU,EPSU,1)) | |
0119ef9a | 13864 | A1STUI=-0.25*(EPSS+EPST+EPSU)*(PYW2AU(EPSS,2)+PYW2AU(EPST,2)+ |
13865 | & PYW2AU(EPSU,2))+0.25*(EPSU+0.5*EPSS*EPST)* | |
ce320da8 | 13866 | & (PYI3AA(BESUT,EPSS,2)+PYI3AA(BESUT,EPST,2))+ |
13867 | & 0.25*(EPST+0.5*EPSS*EPSU)*(PYI3AA(BESTU,EPSS,2)+ | |
13868 | & PYI3AA(BESTU,EPSU,2))+0.25*(EPSS+0.5*EPST*EPSU)* | |
13869 | & (PYI3AA(BETSU,EPST,2)+PYI3AA(BETSU,EPSU,2)) | |
13870 | A2STUR=-1.+0.125*EPSS*EPST*(PYI3AA(BESUT,EPSS,1)+ | |
13871 | & PYI3AA(BESUT,EPST,1))+0.125*EPSS*EPSU*(PYI3AA(BESTU,EPSS,1)+ | |
13872 | & PYI3AA(BESTU,EPSU,1))+0.125*EPST*EPSU*(PYI3AA(BETSU,EPST,1)+ | |
13873 | & PYI3AA(BETSU,EPSU,1)) | |
13874 | A2STUI=0.125*EPSS*EPST*(PYI3AA(BESUT,EPSS,2)+ | |
13875 | & PYI3AA(BESUT,EPST,2))+0.125*EPSS*EPSU*(PYI3AA(BESTU,EPSS,2)+ | |
13876 | & PYI3AA(BESTU,EPSU,2))+0.125*EPST*EPSU*(PYI3AA(BETSU,EPST,2)+ | |
13877 | & PYI3AA(BETSU,EPSU,2)) | |
0119ef9a | 13878 | ENDIF |
13879 | ASRE=ASRE+EI**2*(A0STUR+A0TSUR+A0UTSR+4.*A1STUR+A2STUR) | |
13880 | ASIM=ASIM+EI**2*(A0STUI+A0TSUI+A0UTSI+4.*A1STUI+A2STUI) | |
13881 | 780 CONTINUE | |
13882 | FACGG=COMFAC*FACA/(8.*PARU(1)**2)*AS**2*AEM**2*(ASRE**2+ASIM**2) | |
13883 | IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 790 | |
13884 | NCHN=NCHN+1 | |
13885 | ISIG(NCHN,1)=21 | |
13886 | ISIG(NCHN,2)=21 | |
13887 | ISIG(NCHN,3)=1 | |
13888 | SIGH(NCHN)=FACGG | |
13889 | 790 CONTINUE | |
13890 | ||
13891 | ELSEIF(ISUB.EQ.115) THEN | |
13892 | C...g + g -> gamma + Z0. | |
13893 | ||
13894 | ELSEIF(ISUB.EQ.116) THEN | |
13895 | C...g + g -> Z0 + Z0. | |
13896 | ||
13897 | ELSEIF(ISUB.EQ.117) THEN | |
13898 | C...g + g -> W+ + W-. | |
13899 | ||
13900 | ENDIF | |
13901 | ||
13902 | C...G: 2 -> 3, tree diagrams. | |
13903 | ||
13904 | ELSEIF(ISUB.LE.140) THEN | |
13905 | IF(ISUB.EQ.121) THEN | |
13906 | C...g + g -> f + fb + H0. | |
13907 | ||
13908 | ENDIF | |
13909 | ||
13910 | C...H: 2 -> 1, tree diagrams, non-standard model processes. | |
13911 | ||
13912 | ELSEIF(ISUB.LE.160) THEN | |
13913 | IF(ISUB.EQ.141) THEN | |
13914 | C...f + fb -> gamma*/Z0/Z'0. | |
13915 | MINT(61)=2 | |
ce320da8 | 13916 | CALL PYWIDTA(32,SQRT(SH),WDTP,WDTE) |
0119ef9a | 13917 | FACZP=COMFAC*AEM**2*4./9. |
13918 | DO 800 I=MINA,MAXA | |
13919 | IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 800 | |
13920 | EI=KCHG(IABS(I),1)/3. | |
13921 | AI=SIGN(1.,EI) | |
13922 | VI=AI-4.*EI*XW | |
13923 | API=SIGN(1.,EI) | |
13924 | VPI=API-4.*EI*XW | |
13925 | NCHN=NCHN+1 | |
13926 | ISIG(NCHN,1)=I | |
13927 | ISIG(NCHN,2)=-I | |
13928 | ISIG(NCHN,3)=1 | |
13929 | SIGH(NCHN)=FACZP*(EI**2*VINT(111)+EI*VI/(8.*XW*(1.-XW))* | |
13930 | & SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2)*VINT(112)+EI*VPI/(8.*XW* | |
13931 | & (1.-XW))*SH*(SH-SQMZP)/((SH-SQMZP)**2+GMMZP**2)*VINT(113)+ | |
13932 | & (VI**2+AI**2)/(16.*XW*(1.-XW))**2*SH2/((SH-SQMZ)**2+GMMZ**2)* | |
13933 | & VINT(114)+2.*(VI*VPI+AI*API)/(16.*XW*(1.-XW))**2*SH2* | |
13934 | & ((SH-SQMZ)*(SH-SQMZP)+GMMZ*GMMZP)/(((SH-SQMZ)**2+GMMZ**2)* | |
13935 | & ((SH-SQMZP)**2+GMMZP**2))*VINT(115)+(VPI**2+API**2)/ | |
13936 | & (16.*XW*(1.-XW))**2*SH2/((SH-SQMZP)**2+GMMZP**2)*VINT(116)) | |
13937 | 800 CONTINUE | |
13938 | ||
13939 | ELSEIF(ISUB.EQ.142) THEN | |
13940 | C...f + fb' -> H+/-. | |
ce320da8 | 13941 | CALL PYWIDTA(37,SQRT(SH),WDTP,WDTE) |
0119ef9a | 13942 | FHC=COMFAC*(AEM/XW)**2*1./48.*(SH/SQMW)**2*SH2/ |
13943 | & ((SH-SQMHC)**2+GMMHC**2) | |
13944 | C'''No construction yet for leptons | |
13945 | DO 840 I=1,MSTP(54)/2 | |
13946 | IL=2*I-1 | |
13947 | IU=2*I | |
13948 | RMQL=PMAS(IL,1)**2/SH | |
13949 | RMQU=PMAS(IU,1)**2/SH | |
13950 | FACHC=FHC*((RMQL*PARU(121)+RMQU/PARU(121))*(1.-RMQL-RMQU)- | |
13951 | & 4.*RMQL*RMQU)/SQRT(MAX(0.,(1.-RMQL-RMQU)**2-4.*RMQL*RMQU)) | |
13952 | IF(KFAC(1,IL)*KFAC(2,-IU).EQ.0) GOTO 810 | |
13953 | KCHHC=(KCHG(IL,1)-KCHG(IU,1))/3 | |
13954 | NCHN=NCHN+1 | |
13955 | ISIG(NCHN,1)=IL | |
13956 | ISIG(NCHN,2)=-IU | |
13957 | ISIG(NCHN,3)=1 | |
13958 | SIGH(NCHN)=FACHC*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4)) | |
13959 | 810 IF(KFAC(1,-IL)*KFAC(2,IU).EQ.0) GOTO 820 | |
13960 | KCHHC=(-KCHG(IL,1)+KCHG(IU,1))/3 | |
13961 | NCHN=NCHN+1 | |
13962 | ISIG(NCHN,1)=-IL | |
13963 | ISIG(NCHN,2)=IU | |
13964 | ISIG(NCHN,3)=1 | |
13965 | SIGH(NCHN)=FACHC*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4)) | |
13966 | 820 IF(KFAC(1,IU)*KFAC(2,-IL).EQ.0) GOTO 830 | |
13967 | KCHHC=(KCHG(IU,1)-KCHG(IL,1))/3 | |
13968 | NCHN=NCHN+1 | |
13969 | ISIG(NCHN,1)=IU | |
13970 | ISIG(NCHN,2)=-IL | |
13971 | ISIG(NCHN,3)=1 | |
13972 | SIGH(NCHN)=FACHC*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4)) | |
13973 | 830 IF(KFAC(1,-IU)*KFAC(2,IL).EQ.0) GOTO 840 | |
13974 | KCHHC=(-KCHG(IU,1)+KCHG(IL,1))/3 | |
13975 | NCHN=NCHN+1 | |
13976 | ISIG(NCHN,1)=-IU | |
13977 | ISIG(NCHN,2)=IL | |
13978 | ISIG(NCHN,3)=1 | |
13979 | SIGH(NCHN)=FACHC*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4)) | |
13980 | 840 CONTINUE | |
13981 | ||
13982 | ELSEIF(ISUB.EQ.143) THEN | |
13983 | C...f + fb -> R. | |
ce320da8 | 13984 | CALL PYWIDTA(40,SQRT(SH),WDTP,WDTE) |
0119ef9a | 13985 | FACR=COMFAC*(AEM/XW)**2*1./9.*SH2/((SH-SQMR)**2+GMMR**2) |
13986 | DO 860 I=MIN1,MAX1 | |
13987 | IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 860 | |
13988 | IA=IABS(I) | |
13989 | DO 850 J=MIN2,MAX2 | |
13990 | IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 850 | |
13991 | JA=IABS(J) | |
13992 | IF(I*J.GT.0.OR.IABS(IA-JA).NE.2) GOTO 850 | |
13993 | NCHN=NCHN+1 | |
13994 | ISIG(NCHN,1)=I | |
13995 | ISIG(NCHN,2)=J | |
13996 | ISIG(NCHN,3)=1 | |
13997 | SIGH(NCHN)=FACR*(WDTE(0,1)+WDTE(0,(10-(I+J))/4)+WDTE(0,4)) | |
13998 | 850 CONTINUE | |
13999 | 860 CONTINUE | |
14000 | ||
14001 | ENDIF | |
14002 | ||
14003 | C...I: 2 -> 2, tree diagrams, non-standard model processes. | |
14004 | ||
14005 | ELSE | |
14006 | IF(ISUB.EQ.161) THEN | |
14007 | C...f + g -> f' + H+/- (q + g -> q' + H+/- only). | |
14008 | FHCQ=COMFAC*FACA*AS*AEM/XW*1./24 | |
14009 | DO 900 I=1,MSTP(54) | |
14010 | IU=I+MOD(I,2) | |
14011 | SQMQ=PMAS(IU,1)**2 | |
14012 | FACHCQ=FHCQ/PARU(121)*SQMQ/SQMW*(SH/(SQMQ-UH)+ | |
14013 | & 2.*SQMQ*(SQMHC-UH)/(SQMQ-UH)**2+(SQMQ-UH)/SH+ | |
14014 | & 2.*SQMQ/(SQMQ-UH)+2.*(SQMHC-UH)/(SQMQ-UH)*(SQMHC-SQMQ-SH)/SH) | |
14015 | IF(KFAC(1,-I)*KFAC(2,21).EQ.0) GOTO 870 | |
14016 | KCHHC=ISIGN(1,-KCHG(I,1)) | |
14017 | NCHN=NCHN+1 | |
14018 | ISIG(NCHN,1)=-I | |
14019 | ISIG(NCHN,2)=21 | |
14020 | ISIG(NCHN,3)=1 | |
14021 | SIGH(NCHN)=FACHCQ*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4)) | |
14022 | 870 IF(KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 880 | |
14023 | KCHHC=ISIGN(1,KCHG(I,1)) | |
14024 | NCHN=NCHN+1 | |
14025 | ISIG(NCHN,1)=I | |
14026 | ISIG(NCHN,2)=21 | |
14027 | ISIG(NCHN,3)=1 | |
14028 | SIGH(NCHN)=FACHCQ*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4)) | |
14029 | 880 IF(KFAC(1,21)*KFAC(2,-I).EQ.0) GOTO 890 | |
14030 | KCHHC=ISIGN(1,-KCHG(I,1)) | |
14031 | NCHN=NCHN+1 | |
14032 | ISIG(NCHN,1)=21 | |
14033 | ISIG(NCHN,2)=-I | |
14034 | ISIG(NCHN,3)=1 | |
14035 | SIGH(NCHN)=FACHCQ*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4)) | |
14036 | 890 IF(KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 900 | |
14037 | KCHHC=ISIGN(1,KCHG(I,1)) | |
14038 | NCHN=NCHN+1 | |
14039 | ISIG(NCHN,1)=21 | |
14040 | ISIG(NCHN,2)=I | |
14041 | ISIG(NCHN,3)=1 | |
14042 | SIGH(NCHN)=FACHCQ*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4)) | |
14043 | 900 CONTINUE | |
14044 | ||
14045 | ENDIF | |
14046 | ENDIF | |
14047 | ||
14048 | C...Multiply with structure functions. | |
14049 | IF(ISUB.LE.90.OR.ISUB.GE.96) THEN | |
14050 | DO 910 ICHN=1,NCHN | |
14051 | IF(MINT(41).EQ.2) THEN | |
14052 | KFL1=ISIG(ICHN,1) | |
14053 | IF(KFL1.EQ.21) KFL1=0 | |
14054 | SIGH(ICHN)=SIGH(ICHN)*XSFX(1,KFL1) | |
14055 | ENDIF | |
14056 | IF(MINT(42).EQ.2) THEN | |
14057 | KFL2=ISIG(ICHN,2) | |
14058 | IF(KFL2.EQ.21) KFL2=0 | |
14059 | SIGH(ICHN)=SIGH(ICHN)*XSFX(2,KFL2) | |
14060 | ENDIF | |
14061 | 910 SIGS=SIGS+SIGH(ICHN) | |
14062 | ENDIF | |
14063 | ||
14064 | RETURN | |
14065 | END | |
14066 | ||
14067 | C********************************************************************* | |
14068 | ||
14069 | SUBROUTINE PYSTFU(KF,X,Q2,XPQ,JBT) | |
14070 | ||
14071 | C *******JBT specifies beam or target of the particle | |
14072 | C...Gives proton and pi+ parton structure functions according to a few | |
14073 | C...different parametrizations. Note that what is coded is x times the | |
14074 | C...probability distribution, i.e. xq(x,Q2) etc. | |
14075 | COMMON/HPARNT/HIPR1(100),IHPR2(50),HINT1(100),IHNT2(50) | |
14076 | SAVE /HPARNT/ | |
14077 | COMMON/hjcrdn/YP(3,300),YT(3,300) | |
14078 | SAVE /hjcrdn/ | |
14079 | C ********COMMON BLOCK FROM HIJING | |
14080 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
14081 | SAVE /LUDAT1A/ | |
14082 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
14083 | SAVE /LUDAT2A/ | |
14084 | COMMON/PYPARSA/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
14085 | SAVE /PYPARSA/ | |
14086 | COMMON/PYINT1A/MINT(400),VINT(400) | |
14087 | SAVE /PYINT1A/ | |
14088 | DIMENSION XPQ(-6:6),XQ(6),TX(6),TT(6),TS(6),NEHLQ(8,2), | |
14089 | &CEHLQ(6,6,2,8,2),CDO(3,6,5,2),COW(3,5,4,2) | |
14090 | ||
14091 | C...The following data lines are coefficients needed in the | |
14092 | C...Eichten, Hinchliffe, Lane, Quigg proton structure function | |
14093 | C...parametrizations, see below. | |
14094 | C...Powers of 1-x in different cases. | |
14095 | DATA NEHLQ/3,4,7,5,7,7,7,7,3,4,7,6,7,7,7,7/ | |
14096 | C...Expansion coefficients for up valence quark distribution. | |
14097 | DATA (((CEHLQ(IX,IT,NX,1,1),IX=1,6),IT=1,6),NX=1,2)/ | |
14098 | 1 7.677E-01,-2.087E-01,-3.303E-01,-2.517E-02,-1.570E-02,-1.000E-04, | |
14099 | 2-5.326E-01,-2.661E-01, 3.201E-01, 1.192E-01, 2.434E-02, 7.620E-03, | |
14100 | 3 2.162E-01, 1.881E-01,-8.375E-02,-6.515E-02,-1.743E-02,-5.040E-03, | |
14101 | 4-9.211E-02,-9.952E-02, 1.373E-02, 2.506E-02, 8.770E-03, 2.550E-03, | |
14102 | 5 3.670E-02, 4.409E-02, 9.600E-04,-7.960E-03,-3.420E-03,-1.050E-03, | |
14103 | 6-1.549E-02,-2.026E-02,-3.060E-03, 2.220E-03, 1.240E-03, 4.100E-04, | |
14104 | 1 2.395E-01, 2.905E-01, 9.778E-02, 2.149E-02, 3.440E-03, 5.000E-04, | |
14105 | 2 1.751E-02,-6.090E-03,-2.687E-02,-1.916E-02,-7.970E-03,-2.750E-03, | |
14106 | 3-5.760E-03,-5.040E-03, 1.080E-03, 2.490E-03, 1.530E-03, 7.500E-04, | |
14107 | 4 1.740E-03, 1.960E-03, 3.000E-04,-3.400E-04,-2.900E-04,-1.800E-04, | |
14108 | 5-5.300E-04,-6.400E-04,-1.700E-04, 4.000E-05, 6.000E-05, 4.000E-05, | |
14109 | 6 1.700E-04, 2.200E-04, 8.000E-05, 1.000E-05,-1.000E-05,-1.000E-05/ | |
14110 | DATA (((CEHLQ(IX,IT,NX,1,2),IX=1,6),IT=1,6),NX=1,2)/ | |
14111 | 1 7.237E-01,-2.189E-01,-2.995E-01,-1.909E-02,-1.477E-02, 2.500E-04, | |
14112 | 2-5.314E-01,-2.425E-01, 3.283E-01, 1.119E-01, 2.223E-02, 7.070E-03, | |
14113 | 3 2.289E-01, 1.890E-01,-9.859E-02,-6.900E-02,-1.747E-02,-5.080E-03, | |
14114 | 4-1.041E-01,-1.084E-01, 2.108E-02, 2.975E-02, 9.830E-03, 2.830E-03, | |
14115 | 5 4.394E-02, 5.116E-02,-1.410E-03,-1.055E-02,-4.230E-03,-1.270E-03, | |
14116 | 6-1.991E-02,-2.539E-02,-2.780E-03, 3.430E-03, 1.720E-03, 5.500E-04, | |
14117 | 1 2.410E-01, 2.884E-01, 9.369E-02, 1.900E-02, 2.530E-03, 2.400E-04, | |
14118 | 2 1.765E-02,-9.220E-03,-3.037E-02,-2.085E-02,-8.440E-03,-2.810E-03, | |
14119 | 3-6.450E-03,-5.260E-03, 1.720E-03, 3.110E-03, 1.830E-03, 8.700E-04, | |
14120 | 4 2.120E-03, 2.320E-03, 2.600E-04,-4.900E-04,-3.900E-04,-2.300E-04, | |
14121 | 5-6.900E-04,-8.200E-04,-2.000E-04, 7.000E-05, 9.000E-05, 6.000E-05, | |
14122 | 6 2.400E-04, 3.100E-04, 1.100E-04, 0.000E+00,-2.000E-05,-2.000E-05/ | |
14123 | C...Expansion coefficients for down valence quark distribution. | |
14124 | DATA (((CEHLQ(IX,IT,NX,2,1),IX=1,6),IT=1,6),NX=1,2)/ | |
14125 | 1 3.813E-01,-8.090E-02,-1.634E-01,-2.185E-02,-8.430E-03,-6.200E-04, | |
14126 | 2-2.948E-01,-1.435E-01, 1.665E-01, 6.638E-02, 1.473E-02, 4.080E-03, | |
14127 | 3 1.252E-01, 1.042E-01,-4.722E-02,-3.683E-02,-1.038E-02,-2.860E-03, | |
14128 | 4-5.478E-02,-5.678E-02, 8.900E-03, 1.484E-02, 5.340E-03, 1.520E-03, | |
14129 | 5 2.220E-02, 2.567E-02,-3.000E-05,-4.970E-03,-2.160E-03,-6.500E-04, | |
14130 | 6-9.530E-03,-1.204E-02,-1.510E-03, 1.510E-03, 8.300E-04, 2.700E-04, | |
14131 | 1 1.261E-01, 1.354E-01, 3.958E-02, 8.240E-03, 1.660E-03, 4.500E-04, | |
14132 | 2 3.890E-03,-1.159E-02,-1.625E-02,-9.610E-03,-3.710E-03,-1.260E-03, | |
14133 | 3-1.910E-03,-5.600E-04, 1.590E-03, 1.590E-03, 8.400E-04, 3.900E-04, | |
14134 | 4 6.400E-04, 4.900E-04,-1.500E-04,-2.900E-04,-1.800E-04,-1.000E-04, | |
14135 | 5-2.000E-04,-1.900E-04, 0.000E+00, 6.000E-05, 4.000E-05, 3.000E-05, | |
14136 | 6 7.000E-05, 8.000E-05, 2.000E-05,-1.000E-05,-1.000E-05,-1.000E-05/ | |
14137 | DATA (((CEHLQ(IX,IT,NX,2,2),IX=1,6),IT=1,6),NX=1,2)/ | |
14138 | 1 3.578E-01,-8.622E-02,-1.480E-01,-1.840E-02,-7.820E-03,-4.500E-04, | |
14139 | 2-2.925E-01,-1.304E-01, 1.696E-01, 6.243E-02, 1.353E-02, 3.750E-03, | |
14140 | 3 1.318E-01, 1.041E-01,-5.486E-02,-3.872E-02,-1.038E-02,-2.850E-03, | |
14141 | 4-6.162E-02,-6.143E-02, 1.303E-02, 1.740E-02, 5.940E-03, 1.670E-03, | |
14142 | 5 2.643E-02, 2.957E-02,-1.490E-03,-6.450E-03,-2.630E-03,-7.700E-04, | |
14143 | 6-1.218E-02,-1.497E-02,-1.260E-03, 2.240E-03, 1.120E-03, 3.500E-04, | |
14144 | 1 1.263E-01, 1.334E-01, 3.732E-02, 7.070E-03, 1.260E-03, 3.400E-04, | |
14145 | 2 3.660E-03,-1.357E-02,-1.795E-02,-1.031E-02,-3.880E-03,-1.280E-03, | |
14146 | 3-2.100E-03,-3.600E-04, 2.050E-03, 1.920E-03, 9.800E-04, 4.400E-04, | |
14147 | 4 7.700E-04, 5.400E-04,-2.400E-04,-3.900E-04,-2.400E-04,-1.300E-04, | |
14148 | 5-2.600E-04,-2.300E-04, 2.000E-05, 9.000E-05, 6.000E-05, 4.000E-05, | |
14149 | 6 9.000E-05, 1.000E-04, 2.000E-05,-2.000E-05,-2.000E-05,-1.000E-05/ | |
14150 | C...Expansion coefficients for up and down sea quark distributions. | |
14151 | DATA (((CEHLQ(IX,IT,NX,3,1),IX=1,6),IT=1,6),NX=1,2)/ | |
14152 | 1 6.870E-02,-6.861E-02, 2.973E-02,-5.400E-03, 3.780E-03,-9.700E-04, | |
14153 | 2-1.802E-02, 1.400E-04, 6.490E-03,-8.540E-03, 1.220E-03,-1.750E-03, | |
14154 | 3-4.650E-03, 1.480E-03,-5.930E-03, 6.000E-04,-1.030E-03,-8.000E-05, | |
14155 | 4 6.440E-03, 2.570E-03, 2.830E-03, 1.150E-03, 7.100E-04, 3.300E-04, | |
14156 | 5-3.930E-03,-2.540E-03,-1.160E-03,-7.700E-04,-3.600E-04,-1.900E-04, | |
14157 | 6 2.340E-03, 1.930E-03, 5.300E-04, 3.700E-04, 1.600E-04, 9.000E-05, | |
14158 | 1 1.014E+00,-1.106E+00, 3.374E-01,-7.444E-02, 8.850E-03,-8.700E-04, | |
14159 | 2 9.233E-01,-1.285E+00, 4.475E-01,-9.786E-02, 1.419E-02,-1.120E-03, | |
14160 | 3 4.888E-02,-1.271E-01, 8.606E-02,-2.608E-02, 4.780E-03,-6.000E-04, | |
14161 | 4-2.691E-02, 4.887E-02,-1.771E-02, 1.620E-03, 2.500E-04,-6.000E-05, | |
14162 | 5 7.040E-03,-1.113E-02, 1.590E-03, 7.000E-04,-2.000E-04, 0.000E+00, | |
14163 | 6-1.710E-03, 2.290E-03, 3.800E-04,-3.500E-04, 4.000E-05, 1.000E-05/ | |
14164 | DATA (((CEHLQ(IX,IT,NX,3,2),IX=1,6),IT=1,6),NX=1,2)/ | |
14165 | 1 1.008E-01,-7.100E-02, 1.973E-02,-5.710E-03, 2.930E-03,-9.900E-04, | |
14166 | 2-5.271E-02,-1.823E-02, 1.792E-02,-6.580E-03, 1.750E-03,-1.550E-03, | |
14167 | 3 1.220E-02, 1.763E-02,-8.690E-03,-8.800E-04,-1.160E-03,-2.100E-04, | |
14168 | 4-1.190E-03,-7.180E-03, 2.360E-03, 1.890E-03, 7.700E-04, 4.100E-04, | |
14169 | 5-9.100E-04, 2.040E-03,-3.100E-04,-1.050E-03,-4.000E-04,-2.400E-04, | |
14170 | 6 1.190E-03,-1.700E-04,-2.000E-04, 4.200E-04, 1.700E-04, 1.000E-04, | |
14171 | 1 1.081E+00,-1.189E+00, 3.868E-01,-8.617E-02, 1.115E-02,-1.180E-03, | |
14172 | 2 9.917E-01,-1.396E+00, 4.998E-01,-1.159E-01, 1.674E-02,-1.720E-03, | |
14173 | 3 5.099E-02,-1.338E-01, 9.173E-02,-2.885E-02, 5.890E-03,-6.500E-04, | |
14174 | 4-3.178E-02, 5.703E-02,-2.070E-02, 2.440E-03, 1.100E-04,-9.000E-05, | |
14175 | 5 8.970E-03,-1.392E-02, 2.050E-03, 6.500E-04,-2.300E-04, 2.000E-05, | |
14176 | 6-2.340E-03, 3.010E-03, 5.000E-04,-3.900E-04, 6.000E-05, 1.000E-05/ | |
14177 | C...Expansion coefficients for gluon distribution. | |
14178 | DATA (((CEHLQ(IX,IT,NX,4,1),IX=1,6),IT=1,6),NX=1,2)/ | |
14179 | 1 9.482E-01,-9.578E-01, 1.009E-01,-1.051E-01, 3.456E-02,-3.054E-02, | |
14180 | 2-9.627E-01, 5.379E-01, 3.368E-01,-9.525E-02, 1.488E-02,-2.051E-02, | |
14181 | 3 4.300E-01,-8.306E-02,-3.372E-01, 4.902E-02,-9.160E-03, 1.041E-02, | |
14182 | 4-1.925E-01,-1.790E-02, 2.183E-01, 7.490E-03, 4.140E-03,-1.860E-03, | |
14183 | 5 8.183E-02, 1.926E-02,-1.072E-01,-1.944E-02,-2.770E-03,-5.200E-04, | |
14184 | 6-3.884E-02,-1.234E-02, 5.410E-02, 1.879E-02, 3.350E-03, 1.040E-03, | |
14185 | 1 2.948E+01,-3.902E+01, 1.464E+01,-3.335E+00, 5.054E-01,-5.915E-02, | |
14186 | 2 2.559E+01,-3.955E+01, 1.661E+01,-4.299E+00, 6.904E-01,-8.243E-02, | |
14187 | 3-1.663E+00, 1.176E+00, 1.118E+00,-7.099E-01, 1.948E-01,-2.404E-02, | |
14188 | 4-2.168E-01, 8.170E-01,-7.169E-01, 1.851E-01,-1.924E-02,-3.250E-03, | |
14189 | 5 2.088E-01,-4.355E-01, 2.239E-01,-2.446E-02,-3.620E-03, 1.910E-03, | |
14190 | 6-9.097E-02, 1.601E-01,-5.681E-02,-2.500E-03, 2.580E-03,-4.700E-04/ | |
14191 | DATA (((CEHLQ(IX,IT,NX,4,2),IX=1,6),IT=1,6),NX=1,2)/ | |
14192 | 1 2.367E+00, 4.453E-01, 3.660E-01, 9.467E-02, 1.341E-01, 1.661E-02, | |
14193 | 2-3.170E+00,-1.795E+00, 3.313E-02,-2.874E-01,-9.827E-02,-7.119E-02, | |
14194 | 3 1.823E+00, 1.457E+00,-2.465E-01, 3.739E-02, 6.090E-03, 1.814E-02, | |
14195 | 4-1.033E+00,-9.827E-01, 2.136E-01, 1.169E-01, 5.001E-02, 1.684E-02, | |
14196 | 5 5.133E-01, 5.259E-01,-1.173E-01,-1.139E-01,-4.988E-02,-2.021E-02, | |
14197 | 6-2.881E-01,-3.145E-01, 5.667E-02, 9.161E-02, 4.568E-02, 1.951E-02, | |
14198 | 1 3.036E+01,-4.062E+01, 1.578E+01,-3.699E+00, 6.020E-01,-7.031E-02, | |
14199 | 2 2.700E+01,-4.167E+01, 1.770E+01,-4.804E+00, 7.862E-01,-1.060E-01, | |
14200 | 3-1.909E+00, 1.357E+00, 1.127E+00,-7.181E-01, 2.232E-01,-2.481E-02, | |
14201 | 4-2.488E-01, 9.781E-01,-8.127E-01, 2.094E-01,-2.997E-02,-4.710E-03, | |
14202 | 5 2.506E-01,-5.427E-01, 2.672E-01,-3.103E-02,-1.800E-03, 2.870E-03, | |
14203 | 6-1.128E-01, 2.087E-01,-6.972E-02,-2.480E-03, 2.630E-03,-8.400E-04/ | |
14204 | C...Expansion coefficients for strange sea quark distribution. | |
14205 | DATA (((CEHLQ(IX,IT,NX,5,1),IX=1,6),IT=1,6),NX=1,2)/ | |
14206 | 1 4.968E-02,-4.173E-02, 2.102E-02,-3.270E-03, 3.240E-03,-6.700E-04, | |
14207 | 2-6.150E-03,-1.294E-02, 6.740E-03,-6.890E-03, 9.000E-04,-1.510E-03, | |
14208 | 3-8.580E-03, 5.050E-03,-4.900E-03,-1.600E-04,-9.400E-04,-1.500E-04, | |
14209 | 4 7.840E-03, 1.510E-03, 2.220E-03, 1.400E-03, 7.000E-04, 3.500E-04, | |
14210 | 5-4.410E-03,-2.220E-03,-8.900E-04,-8.500E-04,-3.600E-04,-2.000E-04, | |
14211 | 6 2.520E-03, 1.840E-03, 4.100E-04, 3.900E-04, 1.600E-04, 9.000E-05, | |
14212 | 1 9.235E-01,-1.085E+00, 3.464E-01,-7.210E-02, 9.140E-03,-9.100E-04, | |
14213 | 2 9.315E-01,-1.274E+00, 4.512E-01,-9.775E-02, 1.380E-02,-1.310E-03, | |
14214 | 3 4.739E-02,-1.296E-01, 8.482E-02,-2.642E-02, 4.760E-03,-5.700E-04, | |
14215 | 4-2.653E-02, 4.953E-02,-1.735E-02, 1.750E-03, 2.800E-04,-6.000E-05, | |
14216 | 5 6.940E-03,-1.132E-02, 1.480E-03, 6.500E-04,-2.100E-04, 0.000E+00, | |
14217 | 6-1.680E-03, 2.340E-03, 4.200E-04,-3.400E-04, 5.000E-05, 1.000E-05/ | |
14218 | DATA (((CEHLQ(IX,IT,NX,5,2),IX=1,6),IT=1,6),NX=1,2)/ | |
14219 | 1 6.478E-02,-4.537E-02, 1.643E-02,-3.490E-03, 2.710E-03,-6.700E-04, | |
14220 | 2-2.223E-02,-2.126E-02, 1.247E-02,-6.290E-03, 1.120E-03,-1.440E-03, | |
14221 | 3-1.340E-03, 1.362E-02,-6.130E-03,-7.900E-04,-9.000E-04,-2.000E-04, | |
14222 | 4 5.080E-03,-3.610E-03, 1.700E-03, 1.830E-03, 6.800E-04, 4.000E-04, | |
14223 | 5-3.580E-03, 6.000E-05,-2.600E-04,-1.050E-03,-3.800E-04,-2.300E-04, | |
14224 | 6 2.420E-03, 9.300E-04,-1.000E-04, 4.500E-04, 1.700E-04, 1.100E-04, | |
14225 | 1 9.868E-01,-1.171E+00, 3.940E-01,-8.459E-02, 1.124E-02,-1.250E-03, | |
14226 | 2 1.001E+00,-1.383E+00, 5.044E-01,-1.152E-01, 1.658E-02,-1.830E-03, | |
14227 | 3 4.928E-02,-1.368E-01, 9.021E-02,-2.935E-02, 5.800E-03,-6.600E-04, | |
14228 | 4-3.133E-02, 5.785E-02,-2.023E-02, 2.630E-03, 1.600E-04,-8.000E-05, | |
14229 | 5 8.840E-03,-1.416E-02, 1.900E-03, 5.800E-04,-2.500E-04, 1.000E-05, | |
14230 | 6-2.300E-03, 3.080E-03, 5.500E-04,-3.700E-04, 7.000E-05, 1.000E-05/ | |
14231 | C...Expansion coefficients for charm sea quark distribution. | |
14232 | DATA (((CEHLQ(IX,IT,NX,6,1),IX=1,6),IT=1,6),NX=1,2)/ | |
14233 | 1 9.270E-03,-1.817E-02, 9.590E-03,-6.390E-03, 1.690E-03,-1.540E-03, | |
14234 | 2 5.710E-03,-1.188E-02, 6.090E-03,-4.650E-03, 1.240E-03,-1.310E-03, | |
14235 | 3-3.960E-03, 7.100E-03,-3.590E-03, 1.840E-03,-3.900E-04, 3.400E-04, | |
14236 | 4 1.120E-03,-1.960E-03, 1.120E-03,-4.800E-04, 1.000E-04,-4.000E-05, | |
14237 | 5 4.000E-05,-3.000E-05,-1.800E-04, 9.000E-05,-5.000E-05,-2.000E-05, | |
14238 | 6-4.200E-04, 7.300E-04,-1.600E-04, 5.000E-05, 5.000E-05, 5.000E-05, | |
14239 | 1 8.098E-01,-1.042E+00, 3.398E-01,-6.824E-02, 8.760E-03,-9.000E-04, | |
14240 | 2 8.961E-01,-1.217E+00, 4.339E-01,-9.287E-02, 1.304E-02,-1.290E-03, | |
14241 | 3 3.058E-02,-1.040E-01, 7.604E-02,-2.415E-02, 4.600E-03,-5.000E-04, | |
14242 | 4-2.451E-02, 4.432E-02,-1.651E-02, 1.430E-03, 1.200E-04,-1.000E-04, | |
14243 | 5 1.122E-02,-1.457E-02, 2.680E-03, 5.800E-04,-1.200E-04, 3.000E-05, | |
14244 | 6-7.730E-03, 7.330E-03,-7.600E-04,-2.400E-04, 1.000E-05, 0.000E+00/ | |
14245 | DATA (((CEHLQ(IX,IT,NX,6,2),IX=1,6),IT=1,6),NX=1,2)/ | |
14246 | 1 9.980E-03,-1.945E-02, 1.055E-02,-6.870E-03, 1.860E-03,-1.560E-03, | |
14247 | 2 5.700E-03,-1.203E-02, 6.250E-03,-4.860E-03, 1.310E-03,-1.370E-03, | |
14248 | 3-4.490E-03, 7.990E-03,-4.170E-03, 2.050E-03,-4.400E-04, 3.300E-04, | |
14249 | 4 1.470E-03,-2.480E-03, 1.460E-03,-5.700E-04, 1.200E-04,-1.000E-05, | |
14250 | 5-9.000E-05, 1.500E-04,-3.200E-04, 1.200E-04,-6.000E-05,-4.000E-05, | |
14251 | 6-4.200E-04, 7.600E-04,-1.400E-04, 4.000E-05, 7.000E-05, 5.000E-05, | |
14252 | 1 8.698E-01,-1.131E+00, 3.836E-01,-8.111E-02, 1.048E-02,-1.300E-03, | |
14253 | 2 9.626E-01,-1.321E+00, 4.854E-01,-1.091E-01, 1.583E-02,-1.700E-03, | |
14254 | 3 3.057E-02,-1.088E-01, 8.022E-02,-2.676E-02, 5.590E-03,-5.600E-04, | |
14255 | 4-2.845E-02, 5.164E-02,-1.918E-02, 2.210E-03,-4.000E-05,-1.500E-04, | |
14256 | 5 1.311E-02,-1.751E-02, 3.310E-03, 5.100E-04,-1.200E-04, 5.000E-05, | |
14257 | 6-8.590E-03, 8.380E-03,-9.200E-04,-2.600E-04, 1.000E-05,-1.000E-05/ | |
14258 | C...Expansion coefficients for bottom sea quark distribution. | |
14259 | DATA (((CEHLQ(IX,IT,NX,7,1),IX=1,6),IT=1,6),NX=1,2)/ | |
14260 | 1 9.010E-03,-1.401E-02, 7.150E-03,-4.130E-03, 1.260E-03,-1.040E-03, | |
14261 | 2 6.280E-03,-9.320E-03, 4.780E-03,-2.890E-03, 9.100E-04,-8.200E-04, | |
14262 | 3-2.930E-03, 4.090E-03,-1.890E-03, 7.600E-04,-2.300E-04, 1.400E-04, | |
14263 | 4 3.900E-04,-1.200E-03, 4.400E-04,-2.500E-04, 2.000E-05,-2.000E-05, | |
14264 | 5 2.600E-04, 1.400E-04,-8.000E-05, 1.000E-04, 1.000E-05, 1.000E-05, | |
14265 | 6-2.600E-04, 3.200E-04, 1.000E-05,-1.000E-05, 1.000E-05,-1.000E-05, | |
14266 | 1 8.029E-01,-1.075E+00, 3.792E-01,-7.843E-02, 1.007E-02,-1.090E-03, | |
14267 | 2 7.903E-01,-1.099E+00, 4.153E-01,-9.301E-02, 1.317E-02,-1.410E-03, | |
14268 | 3-1.704E-02,-1.130E-02, 2.882E-02,-1.341E-02, 3.040E-03,-3.600E-04, | |
14269 | 4-7.200E-04, 7.230E-03,-5.160E-03, 1.080E-03,-5.000E-05,-4.000E-05, | |
14270 | 5 3.050E-03,-4.610E-03, 1.660E-03,-1.300E-04,-1.000E-05, 1.000E-05, | |
14271 | 6-4.360E-03, 5.230E-03,-1.610E-03, 2.000E-04,-2.000E-05, 0.000E+00/ | |
14272 | DATA (((CEHLQ(IX,IT,NX,7,2),IX=1,6),IT=1,6),NX=1,2)/ | |
14273 | 1 8.980E-03,-1.459E-02, 7.510E-03,-4.410E-03, 1.310E-03,-1.070E-03, | |
14274 | 2 5.970E-03,-9.440E-03, 4.800E-03,-3.020E-03, 9.100E-04,-8.500E-04, | |
14275 | 3-3.050E-03, 4.440E-03,-2.100E-03, 8.500E-04,-2.400E-04, 1.400E-04, | |
14276 | 4 5.300E-04,-1.300E-03, 5.600E-04,-2.700E-04, 3.000E-05,-2.000E-05, | |
14277 | 5 2.000E-04, 1.400E-04,-1.100E-04, 1.000E-04, 0.000E+00, 0.000E+00, | |
14278 | 6-2.600E-04, 3.200E-04, 0.000E+00,-3.000E-05, 1.000E-05,-1.000E-05, | |
14279 | 1 8.672E-01,-1.174E+00, 4.265E-01,-9.252E-02, 1.244E-02,-1.460E-03, | |
14280 | 2 8.500E-01,-1.194E+00, 4.630E-01,-1.083E-01, 1.614E-02,-1.830E-03, | |
14281 | 3-2.241E-02,-5.630E-03, 2.815E-02,-1.425E-02, 3.520E-03,-4.300E-04, | |
14282 | 4-7.300E-04, 8.030E-03,-5.780E-03, 1.380E-03,-1.300E-04,-4.000E-05, | |
14283 | 5 3.460E-03,-5.380E-03, 1.960E-03,-2.100E-04, 1.000E-05, 1.000E-05, | |
14284 | 6-4.850E-03, 5.950E-03,-1.890E-03, 2.600E-04,-3.000E-05, 0.000E+00/ | |
14285 | C...Expansion coefficients for top sea quark distribution. | |
14286 | DATA (((CEHLQ(IX,IT,NX,8,1),IX=1,6),IT=1,6),NX=1,2)/ | |
14287 | 1 4.410E-03,-7.480E-03, 3.770E-03,-2.580E-03, 7.300E-04,-7.100E-04, | |
14288 | 2 3.840E-03,-6.050E-03, 3.030E-03,-2.030E-03, 5.800E-04,-5.900E-04, | |
14289 | 3-8.800E-04, 1.660E-03,-7.500E-04, 4.700E-04,-1.000E-04, 1.000E-04, | |
14290 | 4-8.000E-05,-1.500E-04, 1.200E-04,-9.000E-05, 3.000E-05, 0.000E+00, | |
14291 | 5 1.300E-04,-2.200E-04,-2.000E-05,-2.000E-05,-2.000E-05,-2.000E-05, | |
14292 | 6-7.000E-05, 1.900E-04,-4.000E-05, 2.000E-05, 0.000E+00, 0.000E+00, | |
14293 | 1 6.623E-01,-9.248E-01, 3.519E-01,-7.930E-02, 1.110E-02,-1.180E-03, | |
14294 | 2 6.380E-01,-9.062E-01, 3.582E-01,-8.479E-02, 1.265E-02,-1.390E-03, | |
14295 | 3-2.581E-02, 2.125E-02, 4.190E-03,-4.980E-03, 1.490E-03,-2.100E-04, | |
14296 | 4 7.100E-04, 5.300E-04,-1.270E-03, 3.900E-04,-5.000E-05,-1.000E-05, | |
14297 | 5 3.850E-03,-5.060E-03, 1.860E-03,-3.500E-04, 4.000E-05, 0.000E+00, | |
14298 | 6-3.530E-03, 4.460E-03,-1.500E-03, 2.700E-04,-3.000E-05, 0.000E+00/ | |
14299 | DATA (((CEHLQ(IX,IT,NX,8,2),IX=1,6),IT=1,6),NX=1,2)/ | |
14300 | 1 4.260E-03,-7.530E-03, 3.830E-03,-2.680E-03, 7.600E-04,-7.300E-04, | |
14301 | 2 3.640E-03,-6.050E-03, 3.030E-03,-2.090E-03, 5.900E-04,-6.000E-04, | |
14302 | 3-9.200E-04, 1.710E-03,-8.200E-04, 5.000E-04,-1.200E-04, 1.000E-04, | |
14303 | 4-5.000E-05,-1.600E-04, 1.300E-04,-9.000E-05, 3.000E-05, 0.000E+00, | |
14304 | 5 1.300E-04,-2.100E-04,-1.000E-05,-2.000E-05,-2.000E-05,-1.000E-05, | |
14305 | 6-8.000E-05, 1.800E-04,-5.000E-05, 2.000E-05, 0.000E+00, 0.000E+00, | |
14306 | 1 7.146E-01,-1.007E+00, 3.932E-01,-9.246E-02, 1.366E-02,-1.540E-03, | |
14307 | 2 6.856E-01,-9.828E-01, 3.977E-01,-9.795E-02, 1.540E-02,-1.790E-03, | |
14308 | 3-3.053E-02, 2.758E-02, 2.150E-03,-4.880E-03, 1.640E-03,-2.500E-04, | |
14309 | 4 9.200E-04, 4.200E-04,-1.340E-03, 4.600E-04,-8.000E-05,-1.000E-05, | |
14310 | 5 4.230E-03,-5.660E-03, 2.140E-03,-4.300E-04, 6.000E-05, 0.000E+00, | |
14311 | 6-3.890E-03, 5.000E-03,-1.740E-03, 3.300E-04,-4.000E-05, 0.000E+00/ | |
14312 | ||
14313 | C...The following data lines are coefficients needed in the | |
14314 | C...Duke, Owens proton structure function parametrizations, see below. | |
14315 | C...Expansion coefficients for (up+down) valence quark distribution. | |
14316 | DATA ((CDO(IP,IS,1,1),IS=1,6),IP=1,3)/ | |
14317 | 1 4.190E-01, 3.460E+00, 4.400E+00, 0.000E+00, 0.000E+00, 0.000E+00, | |
14318 | 2 4.000E-03, 7.240E-01,-4.860E+00, 0.000E+00, 0.000E+00, 0.000E+00, | |
14319 | 3-7.000E-03,-6.600E-02, 1.330E+00, 0.000E+00, 0.000E+00, 0.000E+00/ | |
14320 | DATA ((CDO(IP,IS,1,2),IS=1,6),IP=1,3)/ | |
14321 | 1 3.740E-01, 3.330E+00, 6.030E+00, 0.000E+00, 0.000E+00, 0.000E+00, | |
14322 | 2 1.400E-02, 7.530E-01,-6.220E+00, 0.000E+00, 0.000E+00, 0.000E+00, | |
14323 | 3 0.000E+00,-7.600E-02, 1.560E+00, 0.000E+00, 0.000E+00, 0.000E+00/ | |
14324 | C...Expansion coefficients for down valence quark distribution. | |
14325 | DATA ((CDO(IP,IS,2,1),IS=1,6),IP=1,3)/ | |
14326 | 1 7.630E-01, 4.000E+00, 0.000E+00, 0.000E+00, 0.000E+00, 0.000E+00, | |
14327 | 2-2.370E-01, 6.270E-01,-4.210E-01, 0.000E+00, 0.000E+00, 0.000E+00, | |
14328 | 3 2.600E-02,-1.900E-02, 3.300E-02, 0.000E+00, 0.000E+00, 0.000E+00/ | |
14329 | DATA ((CDO(IP,IS,2,2),IS=1,6),IP=1,3)/ | |
14330 | 1 7.610E-01, 3.830E+00, 0.000E+00, 0.000E+00, 0.000E+00, 0.000E+00, | |
14331 | 2-2.320E-01, 6.270E-01,-4.180E-01, 0.000E+00, 0.000E+00, 0.000E+00, | |
14332 | 3 2.300E-02,-1.900E-02, 3.600E-02, 0.000E+00, 0.000E+00, 0.000E+00/ | |
14333 | C...Expansion coefficients for (up+down+strange) sea quark distribution. | |
14334 | DATA ((CDO(IP,IS,3,1),IS=1,6),IP=1,3)/ | |
14335 | 1 1.265E+00, 0.000E+00, 8.050E+00, 0.000E+00, 0.000E+00, 0.000E+00, | |
14336 | 2-1.132E+00,-3.720E-01, 1.590E+00, 6.310E+00,-1.050E+01, 1.470E+01, | |
14337 | 3 2.930E-01,-2.900E-02,-1.530E-01,-2.730E-01,-3.170E+00, 9.800E+00/ | |
14338 | DATA ((CDO(IP,IS,3,2),IS=1,6),IP=1,3)/ | |
14339 | 1 1.670E+00, 0.000E+00, 9.150E+00, 0.000E+00, 0.000E+00, 0.000E+00, | |
14340 | 2-1.920E+00,-2.730E-01, 5.300E-01, 1.570E+01,-1.010E+02, 2.230E+02, | |
14341 | 3 5.820E-01,-1.640E-01,-7.630E-01,-2.830E+00, 4.470E+01,-1.170E+02/ | |
14342 | C...Expansion coefficients for charm sea quark distribution. | |
14343 | DATA ((CDO(IP,IS,4,1),IS=1,6),IP=1,3)/ | |
14344 | 1 0.000E+00,-3.600E-02, 6.350E+00, 0.000E+00, 0.000E+00, 0.000E+00, | |
14345 | 2 1.350E-01,-2.220E-01, 3.260E+00,-3.030E+00, 1.740E+01,-1.790E+01, | |
14346 | 3-7.500E-02,-5.800E-02,-9.090E-01, 1.500E+00,-1.130E+01, 1.560E+01/ | |
14347 | DATA ((CDO(IP,IS,4,2),IS=1,6),IP=1,3)/ | |
14348 | 1 0.000E+00,-1.200E-01, 3.510E+00, 0.000E+00, 0.000E+00, 0.000E+00, | |
14349 | 2 6.700E-02,-2.330E-01, 3.660E+00,-4.740E-01, 9.500E+00,-1.660E+01, | |
14350 | 3-3.100E-02,-2.300E-02,-4.530E-01, 3.580E-01,-5.430E+00, 1.550E+01/ | |
14351 | C...Expansion coefficients for gluon distribution. | |
14352 | DATA ((CDO(IP,IS,5,1),IS=1,6),IP=1,3)/ | |
14353 | 1 1.560E+00, 0.000E+00, 6.000E+00, 9.000E+00, 0.000E+00, 0.000E+00, | |
14354 | 2-1.710E+00,-9.490E-01, 1.440E+00,-7.190E+00,-1.650E+01, 1.530E+01, | |
14355 | 3 6.380E-01, 3.250E-01,-1.050E+00, 2.550E-01, 1.090E+01,-1.010E+01/ | |
14356 | DATA ((CDO(IP,IS,5,2),IS=1,6),IP=1,3)/ | |
14357 | 1 8.790E-01, 0.000E+00, 4.000E+00, 9.000E+00, 0.000E+00, 0.000E+00, | |
14358 | 2-9.710E-01,-1.160E+00, 1.230E+00,-5.640E+00,-7.540E+00,-5.960E-01, | |
14359 | 3 4.340E-01, 4.760E-01,-2.540E-01,-8.170E-01, 5.500E+00, 1.260E-01/ | |
14360 | ||
14361 | C...The following data lines are coefficients needed in the | |
14362 | C...Owens pion structure function parametrizations, see below. | |
14363 | C...Expansion coefficients for up and down valence quark distributions. | |
14364 | DATA ((COW(IP,IS,1,1),IS=1,5),IP=1,3)/ | |
14365 | 1 4.0000E-01, 7.0000E-01, 0.0000E+00, 0.0000E+00, 0.0000E+00, | |
14366 | 2 -6.2120E-02, 6.4780E-01, 0.0000E+00, 0.0000E+00, 0.0000E+00, | |
14367 | 3 -7.1090E-03, 1.3350E-02, 0.0000E+00, 0.0000E+00, 0.0000E+00/ | |
14368 | DATA ((COW(IP,IS,1,2),IS=1,5),IP=1,3)/ | |
14369 | 1 4.0000E-01, 6.2800E-01, 0.0000E+00, 0.0000E+00, 0.0000E+00, | |
14370 | 2 -5.9090E-02, 6.4360E-01, 0.0000E+00, 0.0000E+00, 0.0000E+00, | |
14371 | 3 -6.5240E-03, 1.4510E-02, 0.0000E+00, 0.0000E+00, 0.0000E+00/ | |
14372 | C...Expansion coefficients for gluon distribution. | |
14373 | DATA ((COW(IP,IS,2,1),IS=1,5),IP=1,3)/ | |
14374 | 1 8.8800E-01, 0.0000E+00, 3.1100E+00, 6.0000E+00, 0.0000E+00, | |
14375 | 2 -1.8020E+00, -1.5760E+00, -1.3170E-01, 2.8010E+00, -1.7280E+01, | |
14376 | 3 1.8120E+00, 1.2000E+00, 5.0680E-01, -1.2160E+01, 2.0490E+01/ | |
14377 | DATA ((COW(IP,IS,2,2),IS=1,5),IP=1,3)/ | |
14378 | 1 7.9400E-01, 0.0000E+00, 2.8900E+00, 6.0000E+00, 0.0000E+00, | |
14379 | 2 -9.1440E-01, -1.2370E+00, 5.9660E-01, -3.6710E+00, -8.1910E+00, | |
14380 | 3 5.9660E-01, 6.5820E-01, -2.5500E-01, -2.3040E+00, 7.7580E+00/ | |
14381 | C...Expansion coefficients for (up+down+strange) quark sea distribution. | |
14382 | DATA ((COW(IP,IS,3,1),IS=1,5),IP=1,3)/ | |
14383 | 1 9.0000E-01, 0.0000E+00, 5.0000E+00, 0.0000E+00, 0.0000E+00, | |
14384 | 2 -2.4280E-01, -2.1200E-01, 8.6730E-01, 1.2660E+00, 2.3820E+00, | |
14385 | 3 1.3860E-01, 3.6710E-03, 4.7470E-02, -2.2150E+00, 3.4820E-01/ | |
14386 | DATA ((COW(IP,IS,3,2),IS=1,5),IP=1,3)/ | |
14387 | 1 9.0000E-01, 0.0000E+00, 5.0000E+00, 0.0000E+00, 0.0000E+00, | |
14388 | 2 -1.4170E-01, -1.6970E-01, -2.4740E+00, -2.5340E+00, 5.6210E-01, | |
14389 | 3 -1.7400E-01, -9.6230E-02, 1.5750E+00, 1.3780E+00, -2.7010E-01/ | |
14390 | C...Expansion coefficients for charm quark sea distribution. | |
14391 | DATA ((COW(IP,IS,4,1),IS=1,5),IP=1,3)/ | |
14392 | 1 0.0000E+00, -2.2120E-02, 2.8940E+00, 0.0000E+00, 0.0000E+00, | |
14393 | 2 7.9280E-02, -3.7850E-01, 9.4330E+00, 5.2480E+00, 8.3880E+00, | |
14394 | 3 -6.1340E-02, -1.0880E-01, -1.0852E+01, -7.1870E+00, -1.1610E+01/ | |
14395 | DATA ((COW(IP,IS,4,2),IS=1,5),IP=1,3)/ | |
14396 | 1 0.0000E+00, -8.8200E-02, 1.9240E+00, 0.0000E+00, 0.0000E+00, | |
14397 | 2 6.2290E-02, -2.8920E-01, 2.4240E-01, -4.4630E+00, -8.3670E-01, | |
14398 | 3 -4.0990E-02, -1.0820E-01, 2.0360E+00, 5.2090E+00, -4.8400E-02/ | |
14399 | ||
14400 | C...Euler's beta function, requires ordinary Gamma function | |
ce320da8 | 14401 | clin-10/25/02 get rid of argument usage mismatch in PYGAMMA(): |
14402 | c EULBT(X,Y)=PYGAMMA(X)*PYGAMMA(Y)/PYGAMMA(X+Y) | |
0119ef9a | 14403 | |
14404 | vx=0. | |
14405 | bbr2=0. | |
14406 | ||
14407 | C...Reset structure functions, check x and hadron flavour. | |
14408 | ALAM=0. | |
14409 | DO 100 KFL=-6,6 | |
14410 | 100 XPQ(KFL)=0. | |
14411 | IF(X.LT.0..OR.X.GT.1.) THEN | |
14412 | WRITE(MSTU(11),1000) X | |
14413 | RETURN | |
14414 | ENDIF | |
14415 | KFA=IABS(KF) | |
14416 | IF(KFA.NE.211.AND.KFA.NE.2212.AND.KFA.NE.2112) THEN | |
14417 | WRITE(MSTU(11),1100) KF | |
14418 | RETURN | |
14419 | ENDIF | |
14420 | ||
14421 | C...Call user-supplied structure function. Select proton/neutron/pion. | |
14422 | IF(MSTP(51).EQ.0.OR.MSTP(52).GE.2) THEN | |
14423 | KFE=KFA | |
14424 | IF(KFA.EQ.2112) KFE=2212 | |
14425 | CALL PYSTFE(KFE,X,Q2,XPQ) | |
14426 | GOTO 230 | |
14427 | ENDIF | |
14428 | IF(KFA.EQ.211) GOTO 200 | |
14429 | ||
14430 | IF(MSTP(51).EQ.1.OR.MSTP(51).EQ.2) THEN | |
14431 | C...Proton structure functions from Eichten, Hinchliffe, Lane, Quigg. | |
14432 | C...Allowed variable range: 5 GeV2 < Q2 < 1E8 GeV2; 1E-4 < x < 1 | |
14433 | ||
14434 | C...Determine set, Lamdba and x and t expansion variables. | |
14435 | NSET=MSTP(51) | |
14436 | IF(NSET.EQ.1) ALAM=0.2 | |
14437 | IF(NSET.EQ.2) ALAM=0.29 | |
14438 | TMIN=LOG(5./ALAM**2) | |
14439 | TMAX=LOG(1E8/ALAM**2) | |
14440 | IF(MSTP(52).EQ.0) THEN | |
14441 | T=TMIN | |
14442 | ELSE | |
14443 | T=LOG(Q2/ALAM**2) | |
14444 | ENDIF | |
14445 | VT=MAX(-1.,MIN(1.,(2.*T-TMAX-TMIN)/(TMAX-TMIN))) | |
14446 | NX=1 | |
14447 | IF(X.LE.0.1) NX=2 | |
14448 | IF(NX.EQ.1) VX=(2.*X-1.1)/0.9 | |
14449 | IF(NX.EQ.2) VX=MAX(-1.,(2.*LOG(X)+11.51293)/6.90776) | |
14450 | CXS=1. | |
14451 | IF(X.LT.1E-4.AND.ABS(PARP(51)-1.).GT.0.01) CXS= | |
14452 | & (1E-4/X)**(PARP(51)-1.) | |
14453 | ||
14454 | C...Chebyshev polynomials for x and t expansion. | |
14455 | TX(1)=1. | |
14456 | TX(2)=VX | |
14457 | TX(3)=2.*VX**2-1. | |
14458 | TX(4)=4.*VX**3-3.*VX | |
14459 | TX(5)=8.*VX**4-8.*VX**2+1. | |
14460 | TX(6)=16.*VX**5-20.*VX**3+5.*VX | |
14461 | TT(1)=1. | |
14462 | TT(2)=VT | |
14463 | TT(3)=2.*VT**2-1. | |
14464 | TT(4)=4.*VT**3-3.*VT | |
14465 | TT(5)=8.*VT**4-8.*VT**2+1. | |
14466 | TT(6)=16.*VT**5-20.*VT**3+5.*VT | |
14467 | ||
14468 | C...Calculate structure functions. | |
14469 | DO 120 KFL=1,6 | |
14470 | XQSUM=0. | |
14471 | DO 110 IT=1,6 | |
14472 | DO 110 IX=1,6 | |
14473 | 110 XQSUM=XQSUM+CEHLQ(IX,IT,NX,KFL,NSET)*TX(IX)*TT(IT) | |
14474 | 120 XQ(KFL)=XQSUM*(1.-X)**NEHLQ(KFL,NSET)*CXS | |
14475 | ||
14476 | C...Put into output array. | |
14477 | XPQ(0)=XQ(4) | |
14478 | XPQ(1)=XQ(2)+XQ(3) | |
14479 | XPQ(2)=XQ(1)+XQ(3) | |
14480 | XPQ(3)=XQ(5) | |
14481 | XPQ(4)=XQ(6) | |
14482 | XPQ(-1)=XQ(3) | |
14483 | XPQ(-2)=XQ(3) | |
14484 | XPQ(-3)=XQ(5) | |
14485 | XPQ(-4)=XQ(6) | |
14486 | ||
14487 | C...Special expansion for bottom (thresh effects). | |
14488 | IF(MSTP(54).GE.5) THEN | |
14489 | IF(NSET.EQ.1) TMIN=8.1905 | |
14490 | IF(NSET.EQ.2) TMIN=7.4474 | |
14491 | IF(T.LE.TMIN) GOTO 140 | |
14492 | VT=MAX(-1.,MIN(1.,(2.*T-TMAX-TMIN)/(TMAX-TMIN))) | |
14493 | TT(1)=1. | |
14494 | TT(2)=VT | |
14495 | TT(3)=2.*VT**2-1. | |
14496 | TT(4)=4.*VT**3-3.*VT | |
14497 | TT(5)=8.*VT**4-8.*VT**2+1. | |
14498 | TT(6)=16.*VT**5-20.*VT**3+5.*VT | |
14499 | XQSUM=0. | |
14500 | DO 130 IT=1,6 | |
14501 | DO 130 IX=1,6 | |
14502 | 130 XQSUM=XQSUM+CEHLQ(IX,IT,NX,7,NSET)*TX(IX)*TT(IT) | |
14503 | XPQ(5)=XQSUM*(1.-X)**NEHLQ(7,NSET) | |
14504 | XPQ(-5)=XPQ(5) | |
14505 | 140 CONTINUE | |
14506 | ENDIF | |
14507 | ||
14508 | C...Special expansion for top (thresh effects). | |
14509 | IF(MSTP(54).GE.6) THEN | |
14510 | IF(NSET.EQ.1) TMIN=11.5528 | |
14511 | IF(NSET.EQ.2) TMIN=10.8097 | |
14512 | TMIN=TMIN+2.*LOG(PMAS(6,1)/30.) | |
14513 | TMAX=TMAX+2.*LOG(PMAS(6,1)/30.) | |
14514 | IF(T.LE.TMIN) GOTO 160 | |
14515 | VT=MAX(-1.,MIN(1.,(2.*T-TMAX-TMIN)/(TMAX-TMIN))) | |
14516 | TT(1)=1. | |
14517 | TT(2)=VT | |
14518 | TT(3)=2.*VT**2-1. | |
14519 | TT(4)=4.*VT**3-3.*VT | |
14520 | TT(5)=8.*VT**4-8.*VT**2+1. | |
14521 | TT(6)=16.*VT**5-20.*VT**3+5.*VT | |
14522 | XQSUM=0. | |
14523 | DO 150 IT=1,6 | |
14524 | DO 150 IX=1,6 | |
14525 | 150 XQSUM=XQSUM+CEHLQ(IX,IT,NX,8,NSET)*TX(IX)*TT(IT) | |
14526 | XPQ(6)=XQSUM*(1.-X)**NEHLQ(8,NSET) | |
14527 | XPQ(-6)=XPQ(6) | |
14528 | 160 CONTINUE | |
14529 | ENDIF | |
14530 | ||
14531 | ELSEIF(MSTP(51).EQ.3.OR.MSTP(51).EQ.4) THEN | |
14532 | C...Proton structure functions from Duke, Owens. | |
14533 | C...Allowed variable range: 4 GeV2 < Q2 < approx 1E6 GeV2. | |
14534 | ||
14535 | C...Determine set, Lambda and s expansion parameter. | |
14536 | NSET=MSTP(51)-2 | |
14537 | IF(NSET.EQ.1) ALAM=0.2 | |
14538 | IF(NSET.EQ.2) ALAM=0.4 | |
14539 | IF(MSTP(52).LE.0) THEN | |
14540 | SD=0. | |
14541 | ELSE | |
14542 | SD=LOG(LOG(MAX(Q2,4.)/ALAM**2)/LOG(4./ALAM**2)) | |
14543 | ENDIF | |
14544 | ||
14545 | C...Calculate structure functions. | |
14546 | DO 180 KFL=1,5 | |
14547 | DO 170 IS=1,6 | |
14548 | 170 TS(IS)=CDO(1,IS,KFL,NSET)+CDO(2,IS,KFL,NSET)*SD+ | |
14549 | & CDO(3,IS,KFL,NSET)*SD**2 | |
14550 | IF(KFL.LE.2) THEN | |
14551 | ||
14552 | clin-10/25/02 evaluate EULBT(TS(1),TS(2)+1.): | |
14553 | c XQ(KFL)=X**TS(1)*(1.-X)**TS(2)*(1.+TS(3)*X)/(EULBT(TS(1), | |
14554 | c & TS(2)+1.)*(1.+TS(3)*TS(1)/(TS(1)+TS(2)+1.))) | |
ce320da8 | 14555 | eulbt1=PYGAMMA(TS(1))*PYGAMMA(TS(2)+1.)/ |
14556 | & PYGAMMA(TS(1)+TS(2)+1.) | |
0119ef9a | 14557 | XQ(KFL)=X**TS(1)*(1.-X)**TS(2)*(1.+TS(3)*X)/(EULBT1 |
14558 | & *(1.+TS(3)*TS(1)/(TS(1)+TS(2)+1.))) | |
14559 | ELSE | |
14560 | XQ(KFL)=TS(1)*X**TS(2)*(1.-X)**TS(3)*(1.+TS(4)*X+TS(5)*X**2+ | |
14561 | & TS(6)*X**3) | |
14562 | ENDIF | |
14563 | ||
14564 | ||
14565 | 180 CONTINUE | |
14566 | ||
14567 | C...Put into output arrays. | |
14568 | XPQ(0)=XQ(5) | |
14569 | XPQ(1)=XQ(2)+XQ(3)/6. | |
14570 | XPQ(2)=3.*XQ(1)-XQ(2)+XQ(3)/6. | |
14571 | XPQ(3)=XQ(3)/6. | |
14572 | XPQ(4)=XQ(4) | |
14573 | XPQ(-1)=XQ(3)/6. | |
14574 | XPQ(-2)=XQ(3)/6. | |
14575 | XPQ(-3)=XQ(3)/6. | |
14576 | XPQ(-4)=XQ(4) | |
14577 | ||
14578 | C...Proton structure functions from Diemoz, Ferroni, Longo, Martinelli. | |
14579 | C...These are accessed via PYSTFE since the files needed may not always | |
14580 | C...available. | |
14581 | ELSEIF(MSTP(51).GE.11.AND.MSTP(51).LE.13) THEN | |
14582 | CALL PYSTFE(2212,X,Q2,XPQ) | |
14583 | ||
14584 | C...Unknown proton parametrization. | |
14585 | ELSE | |
14586 | WRITE(MSTU(11),1200) MSTP(51) | |
14587 | ENDIF | |
14588 | GOTO 230 | |
14589 | ||
14590 | 200 IF((MSTP(51).GE.1.AND.MSTP(51).LE.4).OR. | |
14591 | &(MSTP(51).GE.11.AND.MSTP(51).LE.13)) THEN | |
14592 | C...Pion structure functions from Owens. | |
14593 | C...Allowed variable range: 4 GeV2 < Q2 < approx 2000 GeV2. | |
14594 | ||
14595 | C...Determine set, Lambda and s expansion variable. | |
14596 | NSET=1 | |
14597 | IF(MSTP(51).EQ.2.OR.MSTP(51).EQ.4.OR.MSTP(51).EQ.13) NSET=2 | |
14598 | IF(NSET.EQ.1) ALAM=0.2 | |
14599 | IF(NSET.EQ.2) ALAM=0.4 | |
14600 | IF(MSTP(52).LE.0) THEN | |
14601 | SD=0. | |
14602 | ELSE | |
14603 | SD=LOG(LOG(MAX(Q2,4.)/ALAM**2)/LOG(4./ALAM**2)) | |
14604 | ENDIF | |
14605 | ||
14606 | C...Calculate structure functions. | |
14607 | DO 220 KFL=1,4 | |
14608 | DO 210 IS=1,5 | |
14609 | 210 TS(IS)=COW(1,IS,KFL,NSET)+COW(2,IS,KFL,NSET)*SD+ | |
14610 | & COW(3,IS,KFL,NSET)*SD**2 | |
14611 | IF(KFL.EQ.1) THEN | |
14612 | ||
ce320da8 | 14613 | clin-10/25/02 get rid of argument usage mismatch in PYGAMMA(): |
0119ef9a | 14614 | c XQ(KFL)=X**TS(1)*(1.-X)**TS(2)/EULBT(TS(1),TS(2)+1.) |
ce320da8 | 14615 | eulbt2=PYGAMMA(TS(1)) |
14616 | & *PYGAMMA(TS(2)+1.)/PYGAMMA(TS(1)+TS(2)+1.) | |
0119ef9a | 14617 | XQ(KFL)=X**TS(1)*(1.-X)**TS(2)/EULBT2 |
14618 | ELSE | |
14619 | XQ(KFL)=TS(1)*X**TS(2)*(1.-X)**TS(3)*(1.+TS(4)*X+TS(5)*X**2) | |
14620 | ENDIF | |
14621 | 220 CONTINUE | |
14622 | ||
14623 | C...Put into output arrays. | |
14624 | XPQ(0)=XQ(2) | |
14625 | XPQ(1)=XQ(3)/6. | |
14626 | XPQ(2)=XQ(1)+XQ(3)/6. | |
14627 | XPQ(3)=XQ(3)/6. | |
14628 | XPQ(4)=XQ(4) | |
14629 | XPQ(-1)=XQ(1)+XQ(3)/6. | |
14630 | XPQ(-2)=XQ(3)/6. | |
14631 | XPQ(-3)=XQ(3)/6. | |
14632 | XPQ(-4)=XQ(4) | |
14633 | ||
14634 | C...Unknown pion parametrization. | |
14635 | ELSE | |
14636 | WRITE(MSTU(11),1200) MSTP(51) | |
14637 | ENDIF | |
14638 | ||
14639 | C...Isospin conjugation for neutron, charge conjugation for antipart. | |
14640 | 230 IF(KFA.EQ.2112) THEN | |
14641 | XPS=XPQ(1) | |
14642 | XPQ(1)=XPQ(2) | |
14643 | XPQ(2)=XPS | |
14644 | XPS=XPQ(-1) | |
14645 | XPQ(-1)=XPQ(-2) | |
14646 | XPQ(-2)=XPS | |
14647 | ENDIF | |
14648 | IF(KF.LT.0) THEN | |
14649 | DO 240 KFL=1,4 | |
14650 | XPS=XPQ(KFL) | |
14651 | XPQ(KFL)=XPQ(-KFL) | |
14652 | 240 XPQ(-KFL)=XPS | |
14653 | ENDIF | |
14654 | ||
14655 | C...Check positivity and reset above maximum allowed flavour. | |
14656 | DO 250 KFL=-6,6 | |
14657 | XPQ(KFL)=MAX(0.,XPQ(KFL)) | |
14658 | 250 IF(IABS(KFL).GT.MSTP(54)) XPQ(KFL)=0. | |
14659 | ||
14660 | C...consider nuclear effect on the structure function | |
14661 | IF((JBT.NE.1.AND.JBT.NE.2).OR.IHPR2(6).EQ.0 | |
14662 | & .OR.IHNT2(16).EQ.1) GO TO 400 | |
14663 | ATNM=IHNT2(2*JBT-1) | |
14664 | IF(ATNM.LE.1.0) GO TO 400 | |
14665 | IF(JBT.EQ.1) THEN | |
14666 | BBR2=(YP(1,IHNT2(11))**2+YP(2,IHNT2(11))**2)/1.44/ | |
14667 | 1 ATNM**0.66666 | |
14668 | ELSEIF(JBT.EQ.2) THEN | |
14669 | BBR2=(YT(1,IHNT2(12))**2+YT(2,IHNT2(12))**2)/1.44/ | |
14670 | 1 ATNM**0.66666 | |
14671 | ENDIF | |
14672 | BBR2=MIN(1.0,BBR2) | |
14673 | ABX=(ATNM**0.33333333-1.0) | |
14674 | APX=HIPR1(6)*4.0/3.0*ABX*SQRT(1.0-BBR2) | |
14675 | AAX=1.192*ALOG(ATNM)**0.1666666 | |
14676 | RRX=AAX*(X**3-1.2*X**2+0.21*X)+1.0 | |
14677 | & -(APX-1.079*ABX*SQRT(X)/ALOG(ATNM+1.0)) | |
14678 | 1 *EXP(-X**2.0/0.01) | |
14679 | DO 300 KFL=-6,6 | |
14680 | XPQ(KFL)=XPQ(KFL)*RRX | |
14681 | 300 CONTINUE | |
14682 | C ********consider the nuclear effect on the structure | |
14683 | C function which also depends on the impact | |
14684 | C parameter of the nuclear reaction | |
14685 | ||
14686 | 400 CONTINUE | |
14687 | C...Formats for error printouts. | |
14688 | 1000 FORMAT(' Error: x value outside physical range, x =',1P,E12.3) | |
14689 | 1100 FORMAT(' Error: illegal particle code for structure function,', | |
14690 | &' KF =',I5) | |
14691 | 1200 FORMAT(' Error: bad value of parameter MSTP(51) in PYSTFU,', | |
14692 | &' MSTP(51) =',I5) | |
14693 | ||
14694 | RETURN | |
14695 | END | |
14696 | ||
14697 | C********************************************************************* | |
14698 | ||
ce320da8 | 14699 | SUBROUTINE PYSPLIA(KF,KFLIN,KFLCH,KFLSP) |
0119ef9a | 14700 | |
14701 | C...In case of a hadron remnant which is more complicated than just a | |
14702 | C...quark or a diquark, split it into two (partons or hadron + parton). | |
14703 | DIMENSION KFL(3) | |
14704 | ||
14705 | C...Preliminaries. Parton composition. | |
14706 | KFA=IABS(KF) | |
14707 | KFS=ISIGN(1,KF) | |
14708 | KFL(1)=MOD(KFA/1000,10) | |
14709 | KFL(2)=MOD(KFA/100,10) | |
14710 | KFL(3)=MOD(KFA/10,10) | |
14711 | KFLR=KFLIN*KFS | |
14712 | KFLCH=0 | |
14713 | ||
14714 | C...Subdivide meson. | |
14715 | IF(KFL(1).EQ.0) THEN | |
14716 | KFL(2)=KFL(2)*(-1)**KFL(2) | |
14717 | KFL(3)=-KFL(3)*(-1)**IABS(KFL(2)) | |
14718 | IF(KFLR.EQ.KFL(2)) THEN | |
14719 | KFLSP=KFL(3) | |
14720 | ELSEIF(KFLR.EQ.KFL(3)) THEN | |
14721 | KFLSP=KFL(2) | |
14722 | ELSEIF(IABS(KFLR).EQ.21.AND.RLU(0).GT.0.5) THEN | |
14723 | KFLSP=KFL(2) | |
14724 | KFLCH=KFL(3) | |
14725 | ELSEIF(IABS(KFLR).EQ.21) THEN | |
14726 | KFLSP=KFL(3) | |
14727 | KFLCH=KFL(2) | |
14728 | ELSEIF(KFLR*KFL(2).GT.0) THEN | |
14729 | CALL LUKFDI(-KFLR,KFL(2),KFDUMP,KFLCH) | |
14730 | KFLSP=KFL(3) | |
14731 | ELSE | |
14732 | CALL LUKFDI(-KFLR,KFL(3),KFDUMP,KFLCH) | |
14733 | KFLSP=KFL(2) | |
14734 | ENDIF | |
14735 | ||
14736 | C...Subdivide baryon. | |
14737 | ELSE | |
14738 | NAGR=0 | |
14739 | DO 100 J=1,3 | |
14740 | 100 IF(KFLR.EQ.KFL(J)) NAGR=NAGR+1 | |
14741 | IF(NAGR.GE.1) THEN | |
14742 | RAGR=0.00001+(NAGR-0.00002)*RLU(0) | |
14743 | IAGR=0 | |
14744 | DO 110 J=1,3 | |
14745 | IF(KFLR.EQ.KFL(J)) RAGR=RAGR-1. | |
14746 | 110 IF(IAGR.EQ.0.AND.RAGR.LE.0.) IAGR=J | |
14747 | ELSE | |
14748 | IAGR=int(1.00001+2.99998*RLU(0)) | |
14749 | ENDIF | |
14750 | ID1=1 | |
14751 | IF(IAGR.EQ.1) ID1=2 | |
14752 | IF(IAGR.EQ.1.AND.KFL(3).GT.KFL(2)) ID1=3 | |
14753 | ID2=6-IAGR-ID1 | |
14754 | KSP=3 | |
14755 | IF(MOD(KFA,10).EQ.2.AND.KFL(1).EQ.KFL(2)) THEN | |
14756 | IF(IAGR.NE.3.AND.RLU(0).GT.0.25) KSP=1 | |
14757 | ELSEIF(MOD(KFA,10).EQ.2.AND.KFL(2).GE.KFL(3)) THEN | |
14758 | IF(IAGR.NE.1.AND.RLU(0).GT.0.25) KSP=1 | |
14759 | ELSEIF(MOD(KFA,10).EQ.2) THEN | |
14760 | IF(IAGR.EQ.1) KSP=1 | |
14761 | IF(IAGR.NE.1.AND.RLU(0).GT.0.75) KSP=1 | |
14762 | ENDIF | |
14763 | KFLSP=1000*KFL(ID1)+100*KFL(ID2)+KSP | |
14764 | IF(KFLIN.EQ.21) THEN | |
14765 | KFLCH=KFL(IAGR) | |
14766 | ELSEIF(NAGR.EQ.0.AND.KFLR.GT.0) THEN | |
14767 | CALL LUKFDI(-KFLR,KFL(IAGR),KFDUMP,KFLCH) | |
14768 | ELSEIF(NAGR.EQ.0) THEN | |
14769 | CALL LUKFDI(10000+KFLSP,-KFLR,KFDUMP,KFLCH) | |
14770 | KFLSP=KFL(IAGR) | |
14771 | ENDIF | |
14772 | ENDIF | |
14773 | ||
14774 | C...Add on correct sign for result. | |
14775 | KFLCH=KFLCH*KFS | |
14776 | KFLSP=KFLSP*KFS | |
14777 | ||
14778 | RETURN | |
14779 | END | |
14780 | ||
14781 | C********************************************************************* | |
14782 | ||
ce320da8 | 14783 | FUNCTION PYGAMMA(X) |
0119ef9a | 14784 | |
14785 | C...Gives ordinary Gamma function Gamma(x) for positive, real arguments; | |
14786 | C...see M. Abramowitz, I. A. Stegun: Handbook of Mathematical Functions | |
14787 | C...(Dover, 1965) 6.1.36. | |
14788 | DIMENSION B(8) | |
14789 | clin DATA B/-0.577191652,0.988205891,-0.897056937,0.918206857, | |
14790 | clin &-0.756704078,0.482199394,-0.193527818,0.035868343/ | |
14791 | DATA B/-0.57719165,0.98820589,-0.89705694,0.91820686, | |
14792 | &-0.75670408,0.48219939,-0.19352782,0.03586834/ | |
14793 | ||
14794 | NX=INT(X) | |
14795 | DX=X-NX | |
14796 | ||
ce320da8 | 14797 | PYGAMMA=1. |
0119ef9a | 14798 | DO 100 I=1,8 |
ce320da8 | 14799 | 100 PYGAMMA=PYGAMMA+B(I)*DX**I |
0119ef9a | 14800 | IF(X.LT.1.) THEN |
ce320da8 | 14801 | PYGAMMA=PYGAMMA/X |
0119ef9a | 14802 | ELSE |
14803 | DO 110 IX=1,NX-1 | |
ce320da8 | 14804 | 110 PYGAMMA=(X-IX)*PYGAMMA |
0119ef9a | 14805 | ENDIF |
14806 | ||
14807 | RETURN | |
14808 | END | |
14809 | ||
14810 | C*********************************************************************** | |
14811 | ||
14812 | FUNCTION PYW1AU(EPS,IREIM) | |
14813 | ||
14814 | C...Calculates real and imaginary parts of the auxiliary function W1; | |
14815 | C...see R. K. Ellis, I. Hinchliffe, M. Soldate and J. J. van der Bij, | |
14816 | C...FERMILAB-Pub-87/100-T, LBL-23504, June, 1987 | |
14817 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
14818 | SAVE /LUDAT1A/ | |
14819 | ||
14820 | ASINH(X)=LOG(X+SQRT(X**2+1.)) | |
14821 | ACOSH(X)=LOG(X+SQRT(X**2-1.)) | |
14822 | ||
14823 | pyw1au=0. | |
14824 | ||
14825 | IF(EPS.LT.0.) THEN | |
14826 | W1RE=2.*SQRT(1.-EPS)*ASINH(SQRT(-1./EPS)) | |
14827 | W1IM=0. | |
14828 | ELSEIF(EPS.LT.1.) THEN | |
14829 | W1RE=2.*SQRT(1.-EPS)*ACOSH(SQRT(1./EPS)) | |
14830 | W1IM=-PARU(1)*SQRT(1.-EPS) | |
14831 | ELSE | |
14832 | W1RE=2.*SQRT(EPS-1.)*ASIN(SQRT(1./EPS)) | |
14833 | W1IM=0. | |
14834 | ENDIF | |
14835 | ||
14836 | IF(IREIM.EQ.1) PYW1AU=W1RE | |
14837 | IF(IREIM.EQ.2) PYW1AU=W1IM | |
14838 | ||
14839 | RETURN | |
14840 | END | |
14841 | ||
14842 | C*********************************************************************** | |
14843 | ||
14844 | FUNCTION PYW2AU(EPS,IREIM) | |
14845 | ||
14846 | C...Calculates real and imaginary parts of the auxiliary function W2; | |
14847 | C...see R. K. Ellis, I. Hinchliffe, M. Soldate and J. J. van der Bij, | |
14848 | C...FERMILAB-Pub-87/100-T, LBL-23504, June, 1987 | |
14849 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
14850 | SAVE /LUDAT1A/ | |
14851 | ||
14852 | ASINH(X)=LOG(X+SQRT(X**2+1.)) | |
14853 | ACOSH(X)=LOG(X+SQRT(X**2-1.)) | |
14854 | ||
14855 | pyw2au=0. | |
14856 | ||
14857 | IF(EPS.LT.0.) THEN | |
14858 | W2RE=4.*(ASINH(SQRT(-1./EPS)))**2 | |
14859 | W2IM=0. | |
14860 | ELSEIF(EPS.LT.1.) THEN | |
14861 | W2RE=4.*(ACOSH(SQRT(1./EPS)))**2-PARU(1)**2 | |
14862 | W2IM=-4.*PARU(1)*ACOSH(SQRT(1./EPS)) | |
14863 | ELSE | |
14864 | W2RE=-4.*(ASIN(SQRT(1./EPS)))**2 | |
14865 | W2IM=0. | |
14866 | ENDIF | |
14867 | ||
14868 | IF(IREIM.EQ.1) PYW2AU=W2RE | |
14869 | IF(IREIM.EQ.2) PYW2AU=W2IM | |
14870 | ||
14871 | RETURN | |
14872 | END | |
14873 | ||
14874 | C*********************************************************************** | |
14875 | ||
ce320da8 | 14876 | FUNCTION PYI3AA(BE,EPS,IREIM) |
0119ef9a | 14877 | |
14878 | C...Calculates real and imaginary parts of the auxiliary function I3; | |
14879 | C...see R. K. Ellis, I. Hinchliffe, M. Soldate and J. J. van der Bij, | |
14880 | C...FERMILAB-Pub-87/100-T, LBL-23504, June, 1987 | |
14881 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
14882 | SAVE /LUDAT1A/ | |
14883 | ||
14884 | pyi3au=0. | |
14885 | ga=0. | |
14886 | ||
14887 | IF(EPS.LT.1.) GA=0.5*(1.+SQRT(1.-EPS)) | |
14888 | ||
14889 | IF(EPS.LT.0.) THEN | |
ce320da8 | 14890 | F3RE=PYSPEA((GA-1.)/(GA+BE-1.),0.,1)-PYSPEA(GA/(GA+BE-1.),0.,1)+ |
14891 | & PYSPEA((BE-GA)/BE,0.,1)-PYSPEA((BE-GA)/(BE-1.),0.,1)+ | |
0119ef9a | 14892 | & (LOG(BE)**2-LOG(BE-1.)**2)/2.+LOG(GA)*LOG((GA+BE-1.)/BE)+ |
14893 | & LOG(GA-1.)*LOG((BE-1.)/(GA+BE-1.)) | |
14894 | F3IM=0. | |
14895 | ELSEIF(EPS.LT.1.) THEN | |
ce320da8 | 14896 | F3RE=PYSPEA((GA-1.)/(GA+BE-1.),0.,1)-PYSPEA(GA/(GA+BE-1.),0.,1)+ |
14897 | & PYSPEA(GA/(GA-BE),0.,1)-PYSPEA((GA-1.)/(GA-BE),0.,1)+ | |
0119ef9a | 14898 | & LOG(GA/(1.-GA))*LOG((GA+BE-1.)/(BE-GA)) |
14899 | F3IM=-PARU(1)*LOG((GA+BE-1.)/(BE-GA)) | |
14900 | ELSE | |
14901 | RSQ=EPS/(EPS-1.+(2.*BE-1.)**2) | |
14902 | RCTHE=RSQ*(1.-2.*BE/EPS) | |
14903 | RSTHE=SQRT(RSQ-RCTHE**2) | |
14904 | RCPHI=RSQ*(1.+2.*(BE-1.)/EPS) | |
14905 | RSPHI=SQRT(RSQ-RCPHI**2) | |
14906 | R=SQRT(RSQ) | |
14907 | THE=ACOS(RCTHE/R) | |
14908 | PHI=ACOS(RCPHI/R) | |
ce320da8 | 14909 | F3RE=PYSPEA(RCTHE,RSTHE,1)+PYSPEA(RCTHE,-RSTHE,1)- |
14910 | & PYSPEA(RCPHI,RSPHI,1)-PYSPEA(RCPHI,-RSPHI,1)+ | |
0119ef9a | 14911 | & (PHI-THE)*(PHI+THE-PARU(1)) |
ce320da8 | 14912 | F3IM=PYSPEA(RCTHE,RSTHE,2)+PYSPEA(RCTHE,-RSTHE,2)- |
14913 | & PYSPEA(RCPHI,RSPHI,2)-PYSPEA(RCPHI,-RSPHI,2) | |
0119ef9a | 14914 | ENDIF |
14915 | ||
ce320da8 | 14916 | IF(IREIM.EQ.1) PYI3AA=2./(2.*BE-1.)*F3RE |
14917 | IF(IREIM.EQ.2) PYI3AA=2./(2.*BE-1.)*F3IM | |
0119ef9a | 14918 | |
14919 | RETURN | |
14920 | END | |
14921 | ||
14922 | C*********************************************************************** | |
14923 | ||
ce320da8 | 14924 | FUNCTION PYSPEA(XREIN,XIMIN,IREIM) |
0119ef9a | 14925 | |
14926 | C...Calculates real and imaginary part of Spence function; see | |
14927 | C...G. 't Hooft and M. Veltman, Nucl. Phys. B153 (1979) 365. | |
14928 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
14929 | SAVE /LUDAT1A/ | |
14930 | DIMENSION B(0:14) | |
14931 | ||
14932 | DATA B/ | |
14933 | & 1.000000E+00, -5.000000E-01, 1.666667E-01, | |
14934 | & 0.000000E+00, -3.333333E-02, 0.000000E+00, | |
14935 | & 2.380952E-02, 0.000000E+00, -3.333333E-02, | |
14936 | & 0.000000E+00, 7.575757E-02, 0.000000E+00, | |
14937 | &-2.531135E-01, 0.000000E+00, 1.166667E+00/ | |
14938 | ||
ce320da8 | 14939 | pyspea=0. |
0119ef9a | 14940 | |
14941 | XRE=XREIN | |
14942 | XIM=XIMIN | |
14943 | IF(ABS(1.-XRE).LT.1.E-6.AND.ABS(XIM).LT.1.E-6) THEN | |
ce320da8 | 14944 | IF(IREIM.EQ.1) PYSPEA=PARU(1)**2/6. |
14945 | IF(IREIM.EQ.2) PYSPEA=0. | |
0119ef9a | 14946 | RETURN |
14947 | ENDIF | |
14948 | ||
14949 | XMOD=SQRT(XRE**2+XIM**2) | |
14950 | IF(XMOD.LT.1.E-6) THEN | |
ce320da8 | 14951 | IF(IREIM.EQ.1) PYSPEA=0. |
14952 | IF(IREIM.EQ.2) PYSPEA=0. | |
0119ef9a | 14953 | RETURN |
14954 | ENDIF | |
14955 | ||
14956 | XARG=SIGN(ACOS(XRE/XMOD),XIM) | |
14957 | SP0RE=0. | |
14958 | SP0IM=0. | |
14959 | SGN=1. | |
14960 | IF(XMOD.GT.1.) THEN | |
14961 | ALGXRE=LOG(XMOD) | |
14962 | ALGXIM=XARG-SIGN(PARU(1),XARG) | |
14963 | SP0RE=-PARU(1)**2/6.-(ALGXRE**2-ALGXIM**2)/2. | |
14964 | SP0IM=-ALGXRE*ALGXIM | |
14965 | SGN=-1. | |
14966 | XMOD=1./XMOD | |
14967 | XARG=-XARG | |
14968 | XRE=XMOD*COS(XARG) | |
14969 | XIM=XMOD*SIN(XARG) | |
14970 | ENDIF | |
14971 | IF(XRE.GT.0.5) THEN | |
14972 | ALGXRE=LOG(XMOD) | |
14973 | ALGXIM=XARG | |
14974 | XRE=1.-XRE | |
14975 | XIM=-XIM | |
14976 | XMOD=SQRT(XRE**2+XIM**2) | |
14977 | XARG=SIGN(ACOS(XRE/XMOD),XIM) | |
14978 | ALGYRE=LOG(XMOD) | |
14979 | ALGYIM=XARG | |
14980 | SP0RE=SP0RE+SGN*(PARU(1)**2/6.-(ALGXRE*ALGYRE-ALGXIM*ALGYIM)) | |
14981 | SP0IM=SP0IM-SGN*(ALGXRE*ALGYIM+ALGXIM*ALGYRE) | |
14982 | SGN=-SGN | |
14983 | ENDIF | |
14984 | ||
14985 | XRE=1.-XRE | |
14986 | XIM=-XIM | |
14987 | XMOD=SQRT(XRE**2+XIM**2) | |
14988 | XARG=SIGN(ACOS(XRE/XMOD),XIM) | |
14989 | ZRE=-LOG(XMOD) | |
14990 | ZIM=-XARG | |
14991 | ||
14992 | SPRE=0. | |
14993 | SPIM=0. | |
14994 | SAVERE=1. | |
14995 | SAVEIM=0. | |
14996 | DO 100 I=0,14 | |
14997 | TERMRE=(SAVERE*ZRE-SAVEIM*ZIM)/FLOAT(I+1) | |
14998 | TERMIM=(SAVERE*ZIM+SAVEIM*ZRE)/FLOAT(I+1) | |
14999 | SAVERE=TERMRE | |
15000 | SAVEIM=TERMIM | |
15001 | SPRE=SPRE+B(I)*TERMRE | |
15002 | 100 SPIM=SPIM+B(I)*TERMIM | |
15003 | ||
ce320da8 | 15004 | IF(IREIM.EQ.1) PYSPEA=SP0RE+SGN*SPRE |
15005 | IF(IREIM.EQ.2) PYSPEA=SP0IM+SGN*SPIM | |
0119ef9a | 15006 | |
15007 | RETURN | |
15008 | END | |
15009 | ||
15010 | C********************************************************************* | |
15011 | ||
15012 | BLOCK DATA PYDATA | |
15013 | ||
15014 | C...Give sensible default values to all status codes and parameters. | |
15015 | COMMON/PYSUBSA/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200) | |
15016 | SAVE /PYSUBSA/ | |
15017 | COMMON/PYPARSA/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
15018 | SAVE /PYPARSA/ | |
15019 | COMMON/PYINT1A/MINT(400),VINT(400) | |
15020 | SAVE /PYINT1A/ | |
15021 | COMMON/PYINT2A/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2) | |
15022 | SAVE /PYINT2A/ | |
15023 | COMMON/PYINT3A/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) | |
15024 | SAVE /PYINT3A/ | |
15025 | COMMON/PYINT4AA/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3) | |
15026 | SAVE /PYINT4AA/ | |
15027 | COMMON/PYINT5A/NGEN(0:200,3),XSEC(0:200,3) | |
15028 | SAVE /PYINT5A/ | |
15029 | COMMON/PYINT6A/PROC(0:200) | |
15030 | CHARACTER PROC*28 | |
15031 | SAVE /PYINT6A/ | |
15032 | ||
15033 | C...Default values for allowed processes and kinematics constraints. | |
15034 | DATA MSEL/1/ | |
15035 | DATA MSUB/200*0/ | |
15036 | DATA ((KFIN(I,J),J=-40,40),I=1,2)/40*1,0,80*1,0,40*1/ | |
15037 | DATA CKIN/ | |
15038 | & 2.0, -1.0, 0.0, -1.0, 1.0, 1.0, -10., 10., -10., 10., | |
15039 | 1 -10., 10., -10., 10., -10., 10., -1.0, 1.0, -1.0, 1.0, | |
15040 | 2 0.0, 1.0, 0.0, 1.0, -1.0, 1.0, -1.0, 1.0, 0., 0., | |
15041 | 3 2.0, -1.0, 0., 0., 0., 0., 0., 0., 0., 0., | |
15042 | 4 160*0./ | |
15043 | ||
15044 | C...Default values for main switches and parameters. Reset information. | |
15045 | DATA (MSTP(I),I=1,100)/ | |
15046 | & 3, 1, 2, 0, 0, 0, 0, 0, 0, 0, | |
15047 | 1 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
15048 | 2 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
15049 | 3 1, 2, 0, 0, 0, 2, 0, 0, 0, 0, | |
15050 | 4 1, 0, 3, 7, 1, 0, 0, 0, 0, 0, | |
15051 | 5 1, 1, 20, 6, 0, 0, 0, 0, 0, 0, | |
15052 | 6 1, 2, 2, 2, 1, 0, 0, 0, 0, 0, | |
15053 | 7 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
15054 | 8 1, 1, 100, 0, 0, 0, 0, 0, 0, 0, | |
15055 | 9 1, 4, 0, 0, 0, 0, 0, 0, 0, 0/ | |
15056 | DATA (MSTP(I),I=101,200)/ | |
15057 | & 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
15058 | 1 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, | |
15059 | 2 0, 1, 2, 1, 1, 20, 0, 0, 0, 0, | |
15060 | 3 0, 4, 0, 1, 0, 0, 0, 0, 0, 0, | |
15061 | 4 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
15062 | 5 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
15063 | 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
15064 | 7 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
15065 | 8 5, 3, 1989, 11, 24, 0, 0, 0, 0, 0, | |
15066 | 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ | |
15067 | DATA (PARP(I),I=1,100)/ | |
15068 | & 0.25, 10., 0., 0., 0., 0., 0., 0., 0., 0., | |
15069 | 1 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., | |
15070 | 2 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., | |
15071 | 3 1.5, 2.0, 0.075, 0., 0.2, 0., 0., 0., 0., 0., | |
15072 | 4 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., | |
15073 | 5 1.0, 2.26, 1.E4, 1.E-4, 0., 0., 0., 0., 0., 0., | |
15074 | 6 0.25, 1.0, 0.25, 1.0, 2.0, 1.E-3, 4.0, 0., 0., 0., | |
15075 | 7 4.0, 0., 0., 0., 0., 0., 0., 0., 0., 0., | |
15076 | 8 1.6, 1.85, 0.5, 0.2, 0.33, 0.66, 0.7, 0.5, 0., 0., | |
15077 | 9 0.44, 0.44, 2.0, 1.0, 0., 3.0, 1.0, 0.75, 0., 0./ | |
15078 | DATA (PARP(I),I=101,200)/ | |
15079 | & -0.02, 0., 0., 0., 0., 0., 0., 0., 0., 0., | |
15080 | 1 2.0, 0., 0., 0., 0., 0., 0., 0., 0., 0., | |
15081 | 2 0.4, 0., 0., 0., 0., 0., 0., 0., 0., 0., | |
15082 | 3 0.01, 0., 0., 0., 0., 0., 0., 0., 0., 0., | |
15083 | 4 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., | |
15084 | 5 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., | |
15085 | 6 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., | |
15086 | 7 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., | |
15087 | 8 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., | |
15088 | 9 0., 0., 0., 0., 0., 0., 0., 0., 0., 0./ | |
15089 | DATA MSTI/200*0/ | |
15090 | DATA PARI/200*0./ | |
15091 | DATA MINT/400*0/ | |
15092 | DATA VINT/400*0./ | |
15093 | ||
15094 | C...Constants for the generation of the various processes. | |
15095 | DATA (ISET(I),I=1,100)/ | |
15096 | & 1, 1, 1, -1, 3, -1, -1, 3, -2, -2, | |
15097 | 1 2, 2, 2, 2, 2, 2, -1, 2, 2, 2, | |
15098 | 2 -1, 2, 2, 2, 2, 2, -1, 2, 2, 2, | |
15099 | 3 2, -1, -1, -1, -1, -1, -1, -1, -1, -1, | |
15100 | 4 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, | |
15101 | 5 -1, -1, 2, -1, -1, -1, -1, -1, -1, -1, | |
15102 | 6 -1, -1, -1, -1, -1, -1, -1, 2, -1, -1, | |
15103 | 7 4, 4, 4, -1, -1, 4, 4, -1, -1, -2, | |
15104 | 8 2, 2, -2, -2, -2, -2, -2, -2, -2, -2, | |
15105 | 9 0, 0, 0, -1, 0, 5, -2, -2, -2, -2/ | |
15106 | DATA (ISET(I),I=101,200)/ | |
15107 | & -1, 1, -2, -2, -2, -2, -2, -2, -2, -2, | |
15108 | 1 2, 2, 2, 2, -1, -1, -1, -2, -2, -2, | |
15109 | 2 -1, -2, -2, -2, -2, -2, -2, -2, -2, -2, | |
15110 | 3 -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, | |
15111 | 4 1, 1, 1, -2, -2, -2, -2, -2, -2, -2, | |
15112 | 5 -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, | |
15113 | 6 2, -2, -2, -2, -2, -2, -2, -2, -2, -2, | |
15114 | 7 -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, | |
15115 | 8 -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, | |
15116 | 9 -2, -2, -2, -2, -2, -2, -2, -2, -2, -2/ | |
15117 | DATA ((KFPR(I,J),J=1,2),I=1,50)/ | |
15118 | & 23, 0, 24, 0, 25, 0, 24, 0, 25, 0, | |
15119 | & 24, 0, 23, 0, 25, 0, 0, 0, 0, 0, | |
15120 | 1 0, 0, 0, 0, 21, 21, 21, 22, 21, 23, | |
15121 | 1 21, 24, 21, 25, 22, 22, 22, 23, 22, 24, | |
15122 | 2 22, 25, 23, 23, 23, 24, 23, 25, 24, 24, | |
15123 | 2 24, 25, 25, 25, 0, 21, 0, 22, 0, 23, | |
15124 | 3 0, 24, 0, 25, 0, 21, 0, 22, 0, 23, | |
15125 | 3 0, 24, 0, 25, 0, 21, 0, 22, 0, 23, | |
15126 | 4 0, 24, 0, 25, 0, 21, 0, 22, 0, 23, | |
15127 | 4 0, 24, 0, 25, 0, 21, 0, 22, 0, 23/ | |
15128 | DATA ((KFPR(I,J),J=1,2),I=51,100)/ | |
15129 | 5 0, 24, 0, 25, 0, 0, 0, 0, 0, 0, | |
15130 | 5 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
15131 | 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
15132 | 6 0, 0, 0, 0, 21, 21, 24, 24, 22, 24, | |
15133 | 7 23, 23, 24, 24, 23, 24, 23, 25, 22, 22, | |
15134 | 7 23, 23, 24, 24, 24, 25, 25, 25, 0, 0, | |
15135 | 8 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
15136 | 8 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
15137 | 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
15138 | 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ | |
15139 | DATA ((KFPR(I,J),J=1,2),I=101,150)/ | |
15140 | & 23, 0, 25, 0, 0, 0, 0, 0, 0, 0, | |
15141 | & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
15142 | 1 21, 25, 0, 25, 21, 25, 22, 22, 22, 23, | |
15143 | 1 23, 23, 24, 24, 0, 0, 0, 0, 0, 0, | |
15144 | 2 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
15145 | 2 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
15146 | 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
15147 | 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
15148 | 4 32, 0, 37, 0, 40, 0, 0, 0, 0, 0, | |
15149 | 4 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ | |
15150 | DATA ((KFPR(I,J),J=1,2),I=151,200)/ | |
15151 | 5 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
15152 | 5 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
15153 | 6 0, 37, 0, 0, 0, 0, 0, 0, 0, 0, | |
15154 | 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
15155 | 7 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
15156 | 7 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
15157 | 8 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
15158 | 8 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
15159 | 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, | |
15160 | 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ | |
15161 | DATA COEF/4000*0./ | |
15162 | DATA (((ICOL(I,J,K),K=1,2),J=1,4),I=1,40)/ | |
15163 | 1 4,0,3,0,2,0,1,0,3,0,4,0,1,0,2,0,2,0,0,1,4,0,0,3,3,0,0,4,1,0,0,2, | |
15164 | 2 3,0,0,4,1,4,3,2,4,0,0,3,4,2,1,3,2,0,4,1,4,0,2,3,4,0,3,4,2,0,1,2, | |
15165 | 3 3,2,1,0,1,4,3,0,4,3,3,0,2,1,1,0,3,2,1,4,1,0,0,2,2,4,3,1,2,0,0,1, | |
15166 | 4 3,2,1,4,1,4,3,2,4,2,1,3,4,2,1,3,3,4,4,3,1,2,2,1,2,0,3,1,2,0,0,0, | |
15167 | 5 4,2,1,0,0,0,1,0,3,0,0,3,1,2,0,0,4,0,0,4,0,0,1,2,2,0,0,1,4,4,3,3, | |
15168 | 6 2,2,1,1,4,4,3,3,3,3,4,4,1,1,2,2,3,2,1,3,1,2,0,0,4,2,1,4,0,0,1,2, | |
15169 | 7 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, | |
15170 | 8 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, | |
15171 | 9 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, | |
15172 | & 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0/ | |
15173 | ||
15174 | C...Character constants: name of processes. | |
15175 | DATA PROC(0)/ 'All included subprocesses '/ | |
15176 | DATA (PROC(I),I=1,20)/ | |
15177 | 1'f + fb -> gamma*/Z0 ', 'f + fb'' -> W+/- ', | |
15178 | 2'f + fb -> H0 ', 'gamma + W+/- -> W+/- ', | |
15179 | 3'Z0 + Z0 -> H0 ', 'Z0 + W+/- -> W+/- ', | |
15180 | 4' ', 'W+ + W- -> H0 ', | |
15181 | 5' ', ' ', | |
15182 | 6'f + f'' -> f + f'' ','f + fb -> f'' + fb'' ', | |
15183 | 7'f + fb -> g + g ', 'f + fb -> g + gamma ', | |
15184 | 8'f + fb -> g + Z0 ', 'f + fb'' -> g + W+/- ', | |
15185 | 9'f + fb -> g + H0 ', 'f + fb -> gamma + gamma ', | |
15186 | &'f + fb -> gamma + Z0 ', 'f + fb'' -> gamma + W+/- '/ | |
15187 | DATA (PROC(I),I=21,40)/ | |
15188 | 1'f + fb -> gamma + H0 ', 'f + fb -> Z0 + Z0 ', | |
15189 | 2'f + fb'' -> Z0 + W+/- ', 'f + fb -> Z0 + H0 ', | |
15190 | 3'f + fb -> W+ + W- ', 'f + fb'' -> W+/- + H0 ', | |
15191 | 4'f + fb -> H0 + H0 ', 'f + g -> f + g ', | |
15192 | 5'f + g -> f + gamma ', 'f + g -> f + Z0 ', | |
15193 | 6'f + g -> f'' + W+/- ', 'f + g -> f + H0 ', | |
15194 | 7'f + gamma -> f + g ', 'f + gamma -> f + gamma ', | |
15195 | 8'f + gamma -> f + Z0 ', 'f + gamma -> f'' + W+/- ', | |
15196 | 9'f + gamma -> f + H0 ', 'f + Z0 -> f + g ', | |
15197 | &'f + Z0 -> f + gamma ', 'f + Z0 -> f + Z0 '/ | |
15198 | DATA (PROC(I),I=41,60)/ | |
15199 | 1'f + Z0 -> f'' + W+/- ', 'f + Z0 -> f + H0 ', | |
15200 | 2'f + W+/- -> f'' + g ', 'f + W+/- -> f'' + gamma ', | |
15201 | 3'f + W+/- -> f'' + Z0 ', 'f + W+/- -> f'' + W+/- ', | |
15202 | 4'f + W+/- -> f'' + H0 ', 'f + H0 -> f + g ', | |
15203 | 5'f + H0 -> f + gamma ', 'f + H0 -> f + Z0 ', | |
15204 | 6'f + H0 -> f'' + W+/- ', 'f + H0 -> f + H0 ', | |
15205 | 7'g + g -> f + fb ', 'g + gamma -> f + fb ', | |
15206 | 8'g + Z0 -> f + fb ', 'g + W+/- -> f + fb'' ', | |
15207 | 9'g + H0 -> f + fb ', 'gamma + gamma -> f + fb ', | |
15208 | &'gamma + Z0 -> f + fb ', 'gamma + W+/- -> f + fb'' '/ | |
15209 | DATA (PROC(I),I=61,80)/ | |
15210 | 1'gamma + H0 -> f + fb ', 'Z0 + Z0 -> f + fb ', | |
15211 | 2'Z0 + W+/- -> f + fb'' ', 'Z0 + H0 -> f + fb ', | |
15212 | 3'W+ + W- -> f + fb ', 'W+/- + H0 -> f + fb'' ', | |
15213 | 4'H0 + H0 -> f + fb ', 'g + g -> g + g ', | |
15214 | 5'gamma + gamma -> W+ + W- ', 'gamma + W+/- -> gamma + W+/-', | |
15215 | 6'Z0 + Z0 -> Z0 + Z0 ', 'Z0 + Z0 -> W+ + W- ', | |
15216 | 7'Z0 + W+/- -> Z0 + W+/- ', 'Z0 + Z0 -> Z0 + H0 ', | |
15217 | 8'W+ + W- -> gamma + gamma ', 'W+ + W- -> Z0 + Z0 ', | |
15218 | 9'W+/- + W+/- -> W+/- + W+/- ', 'W+/- + H0 -> W+/- + H0 ', | |
15219 | &'H0 + H0 -> H0 + H0 ', ' '/ | |
15220 | DATA (PROC(I),I=81,100)/ | |
15221 | 1'q + qb -> Q + QB, massive ', 'g + g -> Q + QB, massive ', | |
15222 | 2' ', ' ', | |
15223 | 3' ', ' ', | |
15224 | 4' ', ' ', | |
15225 | 5' ', ' ', | |
15226 | 6'Elastic scattering ', 'Single diffractive ', | |
15227 | 7'Double diffractive ', 'Central diffractive ', | |
15228 | 8'Low-pT scattering ', 'Semihard QCD 2 -> 2 ', | |
15229 | 9' ', ' ', | |
15230 | &' ', ' '/ | |
15231 | DATA (PROC(I),I=101,120)/ | |
15232 | 1'g + g -> gamma*/Z0 ', 'g + g -> H0 ', | |
15233 | 2' ', ' ', | |
15234 | 3' ', ' ', | |
15235 | 4' ', ' ', | |
15236 | 5' ', ' ', | |
15237 | 6'f + fb -> g + H0 ', 'q + g -> q + H0 ', | |
15238 | 7'g + g -> g + H0 ', 'g + g -> gamma + gamma ', | |
15239 | 8'g + g -> gamma + Z0 ', 'g + g -> Z0 + Z0 ', | |
15240 | 9'g + g -> W+ + W- ', ' ', | |
15241 | &' ', ' '/ | |
15242 | DATA (PROC(I),I=121,140)/ | |
15243 | 1'g + g -> f + fb + H0 ', ' ', | |
15244 | 2' ', ' ', | |
15245 | 3' ', ' ', | |
15246 | 4' ', ' ', | |
15247 | 5' ', ' ', | |
15248 | 6' ', ' ', | |
15249 | 7' ', ' ', | |
15250 | 8' ', ' ', | |
15251 | 9' ', ' ', | |
15252 | &' ', ' '/ | |
15253 | DATA (PROC(I),I=141,160)/ | |
15254 | 1'f + fb -> gamma*/Z0/Z''0 ', 'f + fb'' -> H+/- ', | |
15255 | 2'f + fb -> R ', ' ', | |
15256 | 3' ', ' ', | |
15257 | 4' ', ' ', | |
15258 | 5' ', ' ', | |
15259 | 6' ', ' ', | |
15260 | 7' ', ' ', | |
15261 | 8' ', ' ', | |
15262 | 9' ', ' ', | |
15263 | &' ', ' '/ | |
15264 | DATA (PROC(I),I=161,180)/ | |
15265 | 1'f + g -> f'' + H+/- ', ' ', | |
15266 | 2' ', ' ', | |
15267 | 3' ', ' ', | |
15268 | 4' ', ' ', | |
15269 | 5' ', ' ', | |
15270 | 6' ', ' ', | |
15271 | 7' ', ' ', | |
15272 | 8' ', ' ', | |
15273 | 9' ', ' ', | |
15274 | &' ', ' '/ | |
15275 | DATA (PROC(I),I=181,200)/ 20*' '/ | |
15276 | ||
15277 | END | |
15278 | ||
15279 | C********************************************************************* | |
15280 | ||
ce320da8 | 15281 | SUBROUTINE PYKCUTA(MCUT) |
0119ef9a | 15282 | |
15283 | C...Dummy routine, which the user can replace in order to make cuts on | |
15284 | C...the kinematics on the parton level before the matrix elements are | |
15285 | C...evaluated and the event is generated. The cross-section estimates | |
15286 | C...will automatically take these cuts into account, so the given | |
15287 | C...values are for the allowed phase space region only. MCUT=0 means | |
15288 | C...that the event has passed the cuts, MCUT=1 that it has failed. | |
15289 | COMMON/PYPARSA/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
15290 | SAVE /PYPARSA/ | |
15291 | ||
15292 | MCUT=0 | |
15293 | ||
15294 | RETURN | |
15295 | END | |
15296 | ||
15297 | C********************************************************************* | |
15298 | ||
15299 | SUBROUTINE PYSTFE(KF,X,Q2,XPQ) | |
15300 | ||
15301 | C...This is a dummy routine, where the user can introduce an interface | |
15302 | C...to his own external structure function parametrization. | |
15303 | C...Arguments in: | |
15304 | C...KF : 2212 for p, 211 for pi+; isospin conjugation for n and charge | |
15305 | C... conjugation for pbar, nbar or pi- is performed by PYSTFU. | |
15306 | C...X : x value. | |
15307 | C...Q2 : Q^2 value. | |
15308 | C...Arguments out: | |
15309 | C...XPQ(-6:6) : x * f(x,Q2), with index according to KF code, | |
15310 | C... except that gluon is placed in 0. Thus XPQ(0) = xg, | |
15311 | C... XPQ(1) = xd, XPQ(-1) = xdbar, XPQ(2) = xu, XPQ(-2) = xubar, | |
15312 | C... XPQ(3) = xs, XPQ(-3) = xsbar, XPQ(4) = xc, XPQ(-4) = xcbar, | |
15313 | C... XPQ(5) = xb, XPQ(-5) = xbbar, XPQ(6) = xt, XPQ(-6) = xtbar. | |
15314 | C... | |
15315 | C...One such interface, to the Diemos, Ferroni, Longo, Martinelli | |
15316 | C...proton structure functions, already comes with the package. What | |
15317 | C...the user needs here is external files with the three routines | |
15318 | C...FXG160, FXG260 and FXG360 of the authors above, plus the | |
15319 | C...interpolation routine FINT, which is part of the CERN library | |
15320 | C...KERNLIB package. To avoid problems with unresolved external | |
15321 | C...references, the external calls are commented in the current | |
15322 | C...version. To enable this option, remove the C* at the beginning | |
15323 | C...of the relevant lines. | |
15324 | C... | |
15325 | C...Alternatively, the routine can be used as an interface to the | |
15326 | C...structure function evolution program of Tung. This can be achieved | |
15327 | C...by removing C* at the beginning of some of the lines below. | |
15328 | COMMON/LUDAT1A/MSTU(200),PARU(200),MSTJ(200),PARJ(200) | |
15329 | SAVE /LUDAT1A/ | |
15330 | COMMON/LUDAT2A/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) | |
15331 | SAVE /LUDAT2A/ | |
15332 | COMMON/PYPARSA/MSTP(200),PARP(200),MSTI(200),PARI(200) | |
15333 | SAVE /PYPARSA/ | |
15334 | DIMENSION XPQ(-6:6),XFDFLM(9) | |
15335 | CHARACTER CHDFLM(9)*5,HEADER*40 | |
15336 | DATA CHDFLM/'UPVAL','DOVAL','GLUON','QBAR ','UBAR ','SBAR ', | |
15337 | &'CBAR ','BBAR ','TBAR '/ | |
15338 | DATA HEADER/'Tung evolution package has been invoked'/ | |
15339 | DATA INIT/0/ | |
15340 | ||
15341 | KF=KF | |
15342 | HEADER=HEADER | |
15343 | CHDFLM(1)=CHDFLM(1) | |
15344 | C...Proton structure functions from Diemoz, Ferroni, Longo, Martinelli. | |
15345 | C...Allowed variable range 10 GeV2 < Q2 < 1E8 GeV2, 5E-5 < x < .95. | |
15346 | IF(MSTP(51).GE.11.AND.MSTP(51).LE.13.AND.MSTP(52).LE.1) THEN | |
15347 | XDFLM=MAX(0.51E-4,X) | |
15348 | Q2DFLM=MAX(10.,MIN(1E8,Q2)) | |
15349 | IF(MSTP(52).EQ.0) Q2DFLM=10. | |
15350 | DO 100 J=1,9 | |
15351 | IF(MSTP(52).EQ.1.AND.J.EQ.9) THEN | |
15352 | Q2DFLM=Q2DFLM*(40./PMAS(6,1))**2 | |
15353 | Q2DFLM=MAX(10.,MIN(1E8,Q2)) | |
15354 | ENDIF | |
15355 | XFDFLM(J)=0. | |
15356 | C...Remove C* on following three lines to enable the DFLM options. | |
15357 | C* IF(MSTP(51).EQ.11) CALL FXG160(XDFLM,Q2DFLM,CHDFLM(J),XFDFLM(J)) | |
15358 | C* IF(MSTP(51).EQ.12) CALL FXG260(XDFLM,Q2DFLM,CHDFLM(J),XFDFLM(J)) | |
15359 | C* IF(MSTP(51).EQ.13) CALL FXG360(XDFLM,Q2DFLM,CHDFLM(J),XFDFLM(J)) | |
15360 | 100 CONTINUE | |
15361 | IF(X.LT.0.51E-4.AND.ABS(PARP(51)-1.).GT.0.01) THEN | |
15362 | CXS=(0.51E-4/X)**(PARP(51)-1.) | |
15363 | DO 110 J=1,7 | |
15364 | 110 XFDFLM(J)=XFDFLM(J)*CXS | |
15365 | ENDIF | |
15366 | XPQ(0)=XFDFLM(3) | |
15367 | XPQ(1)=XFDFLM(2)+XFDFLM(5) | |
15368 | XPQ(2)=XFDFLM(1)+XFDFLM(5) | |
15369 | XPQ(3)=XFDFLM(6) | |
15370 | XPQ(4)=XFDFLM(7) | |
15371 | XPQ(5)=XFDFLM(8) | |
15372 | XPQ(6)=XFDFLM(9) | |
15373 | XPQ(-1)=XFDFLM(5) | |
15374 | XPQ(-2)=XFDFLM(5) | |
15375 | XPQ(-3)=XFDFLM(6) | |
15376 | XPQ(-4)=XFDFLM(7) | |
15377 | XPQ(-5)=XFDFLM(8) | |
15378 | XPQ(-6)=XFDFLM(9) | |
15379 | ||
15380 | C...Proton structure function evolution from Wu-Ki Tung: parton | |
15381 | C...distribution functions incorporating heavy quark mass effects. | |
15382 | C...Allowed variable range: PARP(52) < Q < PARP(53); PARP(54) < x < 1. | |
15383 | ELSE | |
15384 | IF(INIT.EQ.0) THEN | |
15385 | I1=0 | |
15386 | IF(MSTP(52).EQ.4) I1=1 | |
15387 | IHDRN=1 | |
15388 | NU=MSTP(53) | |
15389 | I2=MSTP(51) | |
15390 | IF(MSTP(51).GE.11) I2=MSTP(51)-3 | |
15391 | I3=0 | |
15392 | IF(MSTP(52).EQ.3) I3=1 | |
15393 | ||
15394 | C...Convert to Lambda in CWZ scheme (approximately linear relation). | |
15395 | ALAM=0.75*PARP(1) | |
15396 | TPMS=PMAS(6,1) | |
15397 | QINI=PARP(52) | |
15398 | QMAX=PARP(53) | |
15399 | XMIN=PARP(54) | |
15400 | ||
15401 | C...Initialize evolution (perform calculation or read results from | |
15402 | C...file). | |
15403 | C...Remove C* on following two lines to enable Tung initialization. | |
15404 | C* CALL PDFSET(I1,IHDRN,ALAM,TPMS,QINI,QMAX,XMIN,NU,HEADER, | |
15405 | C* & I2,I3,IRET,IRR) | |
15406 | INIT=1 | |
15407 | ENDIF | |
15408 | ||
15409 | C...Put into output array. | |
15410 | Q=SQRT(Q2) | |
15411 | DO 200 I=-6,6 | |
15412 | FIXQ=0. | |
15413 | C...Remove C* on following line to enable structure function call. | |
15414 | C* FIXQ=MAX(0.,PDF(10,1,I,X,Q,IR)) | |
15415 | 200 XPQ(I)=X*FIXQ | |
15416 | ||
15417 | C...Change order of u and d quarks from Tung to PYTHIA convention. | |
15418 | XPS=XPQ(1) | |
15419 | XPQ(1)=XPQ(2) | |
15420 | XPQ(2)=XPS | |
15421 | XPS=XPQ(-1) | |
15422 | XPQ(-1)=XPQ(-2) | |
15423 | XPQ(-2)=XPS | |
15424 | ENDIF | |
15425 | ||
15426 | RETURN | |
15427 | END | |
15428 |