| b1c2e580 |
1 | C********************************************************************* |
| 2 | CCPH This file has enlarged event record, LUJETS size=30000 |
| 3 | C********************************************************************* |
| 4 | C********************************************************************* |
| 5 | C********************************************************************* |
| 6 | C* ** |
| 7 | C* June 1991 ** |
| 8 | C* ** |
| 9 | C* The Lund Monte Carlo for Jet Fragmentation and e+e- Physics ** |
| 10 | C* ** |
| 11 | C* JETSET version 7.3 ** |
| 12 | C* ** |
| 13 | C* Torbjorn Sjostrand ** |
| 14 | C* ** |
| 15 | C* CERN/TH, CH-1211 Geneva 23 ** |
| 16 | C* BITNET/EARN address TORSJO@CERNVM ** |
| 17 | C* Tel. +22 - 767 28 20 ** |
| 18 | C* ** |
| 19 | C* LUSHOW is written together with Mats Bengtsson ** |
| 20 | C* ** |
| 21 | C* A complete manual exists on a separate file ** |
| 22 | C* Please report any program errors to the author! ** |
| 23 | C* ** |
| 24 | C* Copyright Torbjorn Sjostrand ** |
| 25 | C* ** |
| 26 | C********************************************************************* |
| 27 | C********************************************************************* |
| 28 | C * |
| 29 | C List of subprograms in order of appearance, with main purpose * |
| 30 | C (S = subroutine, F = function, B = block data) * |
| 31 | C * |
| 32 | C S LU1ENT to fill one entry (= parton or particle) * |
| 33 | C S LU2ENT to fill two entries * |
| 34 | C S LU3ENT to fill three entries * |
| 35 | C S LU4ENT to fill four entries * |
| 36 | C S LUJOIN to connect entries with colour flow information * |
| 37 | C S LUGIVE to fill (or query) commonblock variables * |
| 38 | C S LUEXEC to administrate fragmentation and decay chain * |
| 39 | C S LUPREP to rearrange showered partons along strings * |
| 40 | C S LUSTRF to do string fragmentation of jet system * |
| 41 | C S LUINDF to do independent fragmentation of one or many jets * |
| 42 | C S LUDECY to do the decay of a particle * |
| 43 | C S LUKFDI to select parton and hadron flavours in fragm * |
| 44 | C S LUPTDI to select transverse momenta in fragm * |
| 45 | C S LUZDIS to select longitudinal scaling variable in fragm * |
| 46 | C S LUSHOW to do timelike parton shower evolution * |
| 47 | C S LUBOEI to include Bose-Einstein effects (crudely) * |
| 48 | C F ULMASS to give the mass of a particle or parton * |
| 49 | C S LUNAME to give the name of a particle or parton * |
| 50 | C F LUCHGE to give three times the electric charge * |
| 51 | C F LUCOMP to compress standard KF flavour code to internal KC * |
| 52 | C S LUERRM to write error messages and abort faulty run * |
| 53 | C F ULALEM to give the alpha_electromagnetic value * |
| 54 | C F ULALPS to give the alpha_strong value * |
| 55 | C F ULANGL to give the angle from known x and y components * |
| 56 | C F RLU to provide a random number generator * |
| 57 | C S RLUGET to save the state of the random number generator * |
| 58 | C S RLUSET to set the state of the random number generator * |
| 59 | C S LUROBO to rotate and/or boost an event * |
| 60 | C S LUEDIT to remove unwanted entries from record * |
| 61 | C S LULIST to list event record or particle data * |
| 62 | C S LUUPDA to update particle data * |
| 63 | C F KLU to provide integer-valued event information * |
| 64 | C F PLU to provide real-valued event information * |
| 65 | C S LUSPHE to perform sphericity analysis * |
| 66 | C S LUTHRU to perform thrust analysis * |
| 67 | C S LUCLUS to perform three-dimensional cluster analysis * |
| 68 | C S LUCELL to perform cluster analysis in (eta, phi, E_T) * |
| 69 | C S LUJMAS to give high and low jet mass of event * |
| 70 | C S LUFOWO to give Fox-Wolfram moments * |
| 71 | C S LUTABU to analyze events, with tabular output * |
| 72 | C * |
| 73 | C S LUEEVT to administrate the generation of an e+e- event * |
| 74 | C S LUXTOT to give the total cross-section at given CM energy * |
| 75 | C S LURADK to generate initial state photon radiation * |
| 76 | C S LUXKFL to select flavour of primary qqbar pair * |
| 77 | C S LUXJET to select (matrix element) jet multiplicity * |
| 78 | C S LUX3JT to select kinematics of three-jet event * |
| 79 | C S LUX4JT to select kinematics of four-jet event * |
| 80 | C S LUXDIF to select angular orientation of event * |
| 81 | C S LUONIA to perform generation of onium decay to gluons * |
| 82 | C * |
| 83 | C S LUHEPC to convert between /LUJETS/ and /HEPEVT/ records * |
| 84 | C S LUTEST to test the proper functioning of the package * |
| 85 | C B LUDATA to contain default values and particle data * |
| 86 | C * |
| 87 | C********************************************************************* |
| 88 | |
| 89 | SUBROUTINE LU1ENT(IP,KF,PE,THE,PHI) |
| 90 | |
| 91 | C...Purpose: to store one parton/particle in commonblock LUJETS. |
| 92 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 93 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 94 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 95 | SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ |
| 96 | |
| 97 | C...Standard checks. |
| 98 | MSTU(28)=0 |
| 99 | IF(MSTU(12).GE.1) CALL LULIST(0) |
| 100 | IPA=MAX(1,IABS(IP)) |
| 101 | IF(IPA.GT.MSTU(4)) CALL LUERRM(21, |
| 102 | &'(LU1ENT:) writing outside LUJETS memory') |
| 103 | KC=LUCOMP(KF) |
| 104 | IF(KC.EQ.0) CALL LUERRM(12,'(LU1ENT:) unknown flavour code') |
| 105 | |
| 106 | C...Find mass. Reset K, P and V vectors. |
| 107 | PM=0. |
| 108 | IF(MSTU(10).EQ.1) PM=P(IPA,5) |
| 109 | IF(MSTU(10).GE.2) PM=ULMASS(KF) |
| 110 | DO 100 J=1,5 |
| 111 | K(IPA,J)=0 |
| 112 | P(IPA,J)=0. |
| 113 | 100 V(IPA,J)=0. |
| 114 | |
| 115 | C...Store parton/particle in K and P vectors. |
| 116 | K(IPA,1)=1 |
| 117 | IF(IP.LT.0) K(IPA,1)=2 |
| 118 | K(IPA,2)=KF |
| 119 | P(IPA,5)=PM |
| 120 | P(IPA,4)=MAX(PE,PM) |
| 121 | PA=SQRT(P(IPA,4)**2-P(IPA,5)**2) |
| 122 | P(IPA,1)=PA*SIN(THE)*COS(PHI) |
| 123 | P(IPA,2)=PA*SIN(THE)*SIN(PHI) |
| 124 | P(IPA,3)=PA*COS(THE) |
| 125 | |
| 126 | C...Set N. Optionally fragment/decay. |
| 127 | N=IPA |
| 128 | IF(IP.EQ.0) CALL LUEXEC |
| 129 | |
| 130 | RETURN |
| 131 | END |
| 132 | |
| 133 | C********************************************************************* |
| 134 | |
| 135 | SUBROUTINE LU2ENT(IP,KF1,KF2,PECM) |
| 136 | |
| 137 | C...Purpose: to store two partons/particles in their CM frame, |
| 138 | C...with the first along the +z axis. |
| 139 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 140 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 141 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 142 | SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ |
| 143 | |
| 144 | C...Standard checks. |
| 145 | MSTU(28)=0 |
| 146 | IF(MSTU(12).GE.1) CALL LULIST(0) |
| 147 | IPA=MAX(1,IABS(IP)) |
| 148 | IF(IPA.GT.MSTU(4)-1) CALL LUERRM(21, |
| 149 | &'(LU2ENT:) writing outside LUJETS memory') |
| 150 | KC1=LUCOMP(KF1) |
| 151 | KC2=LUCOMP(KF2) |
| 152 | IF(KC1.EQ.0.OR.KC2.EQ.0) CALL LUERRM(12, |
| 153 | &'(LU2ENT:) unknown flavour code') |
| 154 | |
| 155 | C...Find masses. Reset K, P and V vectors. |
| 156 | PM1=0. |
| 157 | IF(MSTU(10).EQ.1) PM1=P(IPA,5) |
| 158 | IF(MSTU(10).GE.2) PM1=ULMASS(KF1) |
| 159 | PM2=0. |
| 160 | IF(MSTU(10).EQ.1) PM2=P(IPA+1,5) |
| 161 | IF(MSTU(10).GE.2) PM2=ULMASS(KF2) |
| 162 | DO 100 I=IPA,IPA+1 |
| 163 | DO 100 J=1,5 |
| 164 | K(I,J)=0 |
| 165 | P(I,J)=0. |
| 166 | 100 V(I,J)=0. |
| 167 | |
| 168 | C...Check flavours. |
| 169 | KQ1=KCHG(KC1,2)*ISIGN(1,KF1) |
| 170 | KQ2=KCHG(KC2,2)*ISIGN(1,KF2) |
| 171 | IF(MSTU(19).EQ.1) THEN |
| 172 | MSTU(19)=0 |
| 173 | ELSE |
| 174 | IF(KQ1+KQ2.NE.0.AND.KQ1+KQ2.NE.4) CALL LUERRM(2, |
| 175 | & '(LU2ENT:) unphysical flavour combination') |
| 176 | ENDIF |
| 177 | K(IPA,2)=KF1 |
| 178 | K(IPA+1,2)=KF2 |
| 179 | |
| 180 | C...Store partons/particles in K vectors for normal case. |
| 181 | IF(IP.GE.0) THEN |
| 182 | K(IPA,1)=1 |
| 183 | IF(KQ1.NE.0.AND.KQ2.NE.0) K(IPA,1)=2 |
| 184 | K(IPA+1,1)=1 |
| 185 | |
| 186 | C...Store partons in K vectors for parton shower evolution. |
| 187 | ELSE |
| 188 | K(IPA,1)=3 |
| 189 | K(IPA+1,1)=3 |
| 190 | K(IPA,4)=MSTU(5)*(IPA+1) |
| 191 | K(IPA,5)=K(IPA,4) |
| 192 | K(IPA+1,4)=MSTU(5)*IPA |
| 193 | K(IPA+1,5)=K(IPA+1,4) |
| 194 | ENDIF |
| 195 | |
| 196 | C...Check kinematics and store partons/particles in P vectors. |
| 197 | IF(PECM.LE.PM1+PM2) CALL LUERRM(13, |
| 198 | &'(LU2ENT:) energy smaller than sum of masses') |
| 199 | PA=SQRT(MAX(0.,(PECM**2-PM1**2-PM2**2)**2-(2.*PM1*PM2)**2))/ |
| 200 | &(2.*PECM) |
| 201 | P(IPA,3)=PA |
| 202 | P(IPA,4)=SQRT(PM1**2+PA**2) |
| 203 | P(IPA,5)=PM1 |
| 204 | P(IPA+1,3)=-PA |
| 205 | P(IPA+1,4)=SQRT(PM2**2+PA**2) |
| 206 | P(IPA+1,5)=PM2 |
| 207 | |
| 208 | C...Set N. Optionally fragment/decay. |
| 209 | N=IPA+1 |
| 210 | IF(IP.EQ.0) CALL LUEXEC |
| 211 | |
| 212 | RETURN |
| 213 | END |
| 214 | |
| 215 | C********************************************************************* |
| 216 | |
| 217 | SUBROUTINE LU3ENT(IP,KF1,KF2,KF3,PECM,X1,X3) |
| 218 | |
| 219 | C...Purpose: to store three partons or particles in their CM frame, |
| 220 | C...with the first along the +z axis and the third in the (x,z) |
| 221 | C...plane with x > 0. |
| 222 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 223 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 224 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 225 | SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ |
| 226 | |
| 227 | C...Standard checks. |
| 228 | MSTU(28)=0 |
| 229 | IF(MSTU(12).GE.1) CALL LULIST(0) |
| 230 | IPA=MAX(1,IABS(IP)) |
| 231 | IF(IPA.GT.MSTU(4)-2) CALL LUERRM(21, |
| 232 | &'(LU3ENT:) writing outside LUJETS memory') |
| 233 | KC1=LUCOMP(KF1) |
| 234 | KC2=LUCOMP(KF2) |
| 235 | KC3=LUCOMP(KF3) |
| 236 | IF(KC1.EQ.0.OR.KC2.EQ.0.OR.KC3.EQ.0) CALL LUERRM(12, |
| 237 | &'(LU3ENT:) unknown flavour code') |
| 238 | |
| 239 | C...Find masses. Reset K, P and V vectors. |
| 240 | PM1=0. |
| 241 | IF(MSTU(10).EQ.1) PM1=P(IPA,5) |
| 242 | IF(MSTU(10).GE.2) PM1=ULMASS(KF1) |
| 243 | PM2=0. |
| 244 | IF(MSTU(10).EQ.1) PM2=P(IPA+1,5) |
| 245 | IF(MSTU(10).GE.2) PM2=ULMASS(KF2) |
| 246 | PM3=0. |
| 247 | IF(MSTU(10).EQ.1) PM3=P(IPA+2,5) |
| 248 | IF(MSTU(10).GE.2) PM3=ULMASS(KF3) |
| 249 | DO 100 I=IPA,IPA+2 |
| 250 | DO 100 J=1,5 |
| 251 | K(I,J)=0 |
| 252 | P(I,J)=0. |
| 253 | 100 V(I,J)=0. |
| 254 | |
| 255 | C...Check flavours. |
| 256 | KQ1=KCHG(KC1,2)*ISIGN(1,KF1) |
| 257 | KQ2=KCHG(KC2,2)*ISIGN(1,KF2) |
| 258 | KQ3=KCHG(KC3,2)*ISIGN(1,KF3) |
| 259 | IF(MSTU(19).EQ.1) THEN |
| 260 | MSTU(19)=0 |
| 261 | ELSEIF(KQ1.EQ.0.AND.KQ2.EQ.0.AND.KQ3.EQ.0) THEN |
| 262 | ELSEIF(KQ1.NE.0.AND.KQ2.EQ.2.AND.(KQ1+KQ3.EQ.0.OR. |
| 263 | &KQ1+KQ3.EQ.4)) THEN |
| 264 | ELSE |
| 265 | CALL LUERRM(2,'(LU3ENT:) unphysical flavour combination') |
| 266 | ENDIF |
| 267 | K(IPA,2)=KF1 |
| 268 | K(IPA+1,2)=KF2 |
| 269 | K(IPA+2,2)=KF3 |
| 270 | |
| 271 | C...Store partons/particles in K vectors for normal case. |
| 272 | IF(IP.GE.0) THEN |
| 273 | K(IPA,1)=1 |
| 274 | IF(KQ1.NE.0.AND.(KQ2.NE.0.OR.KQ3.NE.0)) K(IPA,1)=2 |
| 275 | K(IPA+1,1)=1 |
| 276 | IF(KQ2.NE.0.AND.KQ3.NE.0) K(IPA+1,1)=2 |
| 277 | K(IPA+2,1)=1 |
| 278 | |
| 279 | C...Store partons in K vectors for parton shower evolution. |
| 280 | ELSE |
| 281 | K(IPA,1)=3 |
| 282 | K(IPA+1,1)=3 |
| 283 | K(IPA+2,1)=3 |
| 284 | KCS=4 |
| 285 | IF(KQ1.EQ.-1) KCS=5 |
| 286 | K(IPA,KCS)=MSTU(5)*(IPA+1) |
| 287 | K(IPA,9-KCS)=MSTU(5)*(IPA+2) |
| 288 | K(IPA+1,KCS)=MSTU(5)*(IPA+2) |
| 289 | K(IPA+1,9-KCS)=MSTU(5)*IPA |
| 290 | K(IPA+2,KCS)=MSTU(5)*IPA |
| 291 | K(IPA+2,9-KCS)=MSTU(5)*(IPA+1) |
| 292 | ENDIF |
| 293 | |
| 294 | C...Check kinematics. |
| 295 | MKERR=0 |
| 296 | IF(0.5*X1*PECM.LE.PM1.OR.0.5*(2.-X1-X3)*PECM.LE.PM2.OR. |
| 297 | &0.5*X3*PECM.LE.PM3) MKERR=1 |
| 298 | PA1=SQRT(MAX(1E-10,(0.5*X1*PECM)**2-PM1**2)) |
| 299 | PA2=SQRT(MAX(1E-10,(0.5*(2.-X1-X3)*PECM)**2-PM2**2)) |
| 300 | PA3=SQRT(MAX(1E-10,(0.5*X3*PECM)**2-PM3**2)) |
| 301 | CTHE2=(PA3**2-PA1**2-PA2**2)/(2.*PA1*PA2) |
| 302 | CTHE3=(PA2**2-PA1**2-PA3**2)/(2.*PA1*PA3) |
| 303 | IF(ABS(CTHE2).GE.1.001.OR.ABS(CTHE3).GE.1.001) MKERR=1 |
| 304 | CTHE3=MAX(-1.,MIN(1.,CTHE3)) |
| 305 | IF(MKERR.NE.0) CALL LUERRM(13, |
| 306 | &'(LU3ENT:) unphysical kinematical variable setup') |
| 307 | |
| 308 | C...Store partons/particles in P vectors. |
| 309 | P(IPA,3)=PA1 |
| 310 | P(IPA,4)=SQRT(PA1**2+PM1**2) |
| 311 | P(IPA,5)=PM1 |
| 312 | P(IPA+2,1)=PA3*SQRT(1.-CTHE3**2) |
| 313 | P(IPA+2,3)=PA3*CTHE3 |
| 314 | P(IPA+2,4)=SQRT(PA3**2+PM3**2) |
| 315 | P(IPA+2,5)=PM3 |
| 316 | P(IPA+1,1)=-P(IPA+2,1) |
| 317 | P(IPA+1,3)=-P(IPA,3)-P(IPA+2,3) |
| 318 | P(IPA+1,4)=SQRT(P(IPA+1,1)**2+P(IPA+1,3)**2+PM2**2) |
| 319 | P(IPA+1,5)=PM2 |
| 320 | |
| 321 | C...Set N. Optionally fragment/decay. |
| 322 | N=IPA+2 |
| 323 | IF(IP.EQ.0) CALL LUEXEC |
| 324 | |
| 325 | RETURN |
| 326 | END |
| 327 | |
| 328 | C********************************************************************* |
| 329 | |
| 330 | SUBROUTINE LU4ENT(IP,KF1,KF2,KF3,KF4,PECM,X1,X2,X4,X12,X14) |
| 331 | |
| 332 | C...Purpose: to store four partons or particles in their CM frame, with |
| 333 | C...the first along the +z axis, the last in the xz plane with x > 0 |
| 334 | C...and the second having y < 0 and y > 0 with equal probability. |
| 335 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 336 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 337 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 338 | SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ |
| 339 | |
| 340 | C...Standard checks. |
| 341 | MSTU(28)=0 |
| 342 | IF(MSTU(12).GE.1) CALL LULIST(0) |
| 343 | IPA=MAX(1,IABS(IP)) |
| 344 | IF(IPA.GT.MSTU(4)-3) CALL LUERRM(21, |
| 345 | &'(LU4ENT:) writing outside LUJETS momory') |
| 346 | KC1=LUCOMP(KF1) |
| 347 | KC2=LUCOMP(KF2) |
| 348 | KC3=LUCOMP(KF3) |
| 349 | KC4=LUCOMP(KF4) |
| 350 | IF(KC1.EQ.0.OR.KC2.EQ.0.OR.KC3.EQ.0.OR.KC4.EQ.0) CALL LUERRM(12, |
| 351 | &'(LU4ENT:) unknown flavour code') |
| 352 | |
| 353 | C...Find masses. Reset K, P and V vectors. |
| 354 | PM1=0. |
| 355 | IF(MSTU(10).EQ.1) PM1=P(IPA,5) |
| 356 | IF(MSTU(10).GE.2) PM1=ULMASS(KF1) |
| 357 | PM2=0. |
| 358 | IF(MSTU(10).EQ.1) PM2=P(IPA+1,5) |
| 359 | IF(MSTU(10).GE.2) PM2=ULMASS(KF2) |
| 360 | PM3=0. |
| 361 | IF(MSTU(10).EQ.1) PM3=P(IPA+2,5) |
| 362 | IF(MSTU(10).GE.2) PM3=ULMASS(KF3) |
| 363 | PM4=0. |
| 364 | IF(MSTU(10).EQ.1) PM4=P(IPA+3,5) |
| 365 | IF(MSTU(10).GE.2) PM4=ULMASS(KF4) |
| 366 | DO 100 I=IPA,IPA+3 |
| 367 | DO 100 J=1,5 |
| 368 | K(I,J)=0 |
| 369 | P(I,J)=0. |
| 370 | 100 V(I,J)=0. |
| 371 | |
| 372 | C...Check flavours. |
| 373 | KQ1=KCHG(KC1,2)*ISIGN(1,KF1) |
| 374 | KQ2=KCHG(KC2,2)*ISIGN(1,KF2) |
| 375 | KQ3=KCHG(KC3,2)*ISIGN(1,KF3) |
| 376 | KQ4=KCHG(KC4,2)*ISIGN(1,KF4) |
| 377 | IF(MSTU(19).EQ.1) THEN |
| 378 | MSTU(19)=0 |
| 379 | ELSEIF(KQ1.EQ.0.AND.KQ2.EQ.0.AND.KQ3.EQ.0.AND.KQ4.EQ.0) THEN |
| 380 | ELSEIF(KQ1.NE.0.AND.KQ2.EQ.2.AND.KQ3.EQ.2.AND.(KQ1+KQ4.EQ.0.OR. |
| 381 | &KQ1+KQ4.EQ.4)) THEN |
| 382 | ELSEIF(KQ1.NE.0.AND.KQ1+KQ2.EQ.0.AND.KQ3.NE.0.AND.KQ3+KQ4.EQ.0.) |
| 383 | &THEN |
| 384 | ELSE |
| 385 | CALL LUERRM(2,'(LU4ENT:) unphysical flavour combination') |
| 386 | ENDIF |
| 387 | K(IPA,2)=KF1 |
| 388 | K(IPA+1,2)=KF2 |
| 389 | K(IPA+2,2)=KF3 |
| 390 | K(IPA+3,2)=KF4 |
| 391 | |
| 392 | C...Store partons/particles in K vectors for normal case. |
| 393 | IF(IP.GE.0) THEN |
| 394 | K(IPA,1)=1 |
| 395 | IF(KQ1.NE.0.AND.(KQ2.NE.0.OR.KQ3.NE.0.OR.KQ4.NE.0)) K(IPA,1)=2 |
| 396 | K(IPA+1,1)=1 |
| 397 | IF(KQ2.NE.0.AND.KQ1+KQ2.NE.0.AND.(KQ3.NE.0.OR.KQ4.NE.0)) |
| 398 | & K(IPA+1,1)=2 |
| 399 | K(IPA+2,1)=1 |
| 400 | IF(KQ3.NE.0.AND.KQ4.NE.0) K(IPA+2,1)=2 |
| 401 | K(IPA+3,1)=1 |
| 402 | |
| 403 | C...Store partons for parton shower evolution from q-g-g-qbar or |
| 404 | C...g-g-g-g event. |
| 405 | ELSEIF(KQ1+KQ2.NE.0) THEN |
| 406 | K(IPA,1)=3 |
| 407 | K(IPA+1,1)=3 |
| 408 | K(IPA+2,1)=3 |
| 409 | K(IPA+3,1)=3 |
| 410 | KCS=4 |
| 411 | IF(KQ1.EQ.-1) KCS=5 |
| 412 | K(IPA,KCS)=MSTU(5)*(IPA+1) |
| 413 | K(IPA,9-KCS)=MSTU(5)*(IPA+3) |
| 414 | K(IPA+1,KCS)=MSTU(5)*(IPA+2) |
| 415 | K(IPA+1,9-KCS)=MSTU(5)*IPA |
| 416 | K(IPA+2,KCS)=MSTU(5)*(IPA+3) |
| 417 | K(IPA+2,9-KCS)=MSTU(5)*(IPA+1) |
| 418 | K(IPA+3,KCS)=MSTU(5)*IPA |
| 419 | K(IPA+3,9-KCS)=MSTU(5)*(IPA+2) |
| 420 | |
| 421 | C...Store partons for parton shower evolution from q-qbar-q-qbar event. |
| 422 | ELSE |
| 423 | K(IPA,1)=3 |
| 424 | K(IPA+1,1)=3 |
| 425 | K(IPA+2,1)=3 |
| 426 | K(IPA+3,1)=3 |
| 427 | K(IPA,4)=MSTU(5)*(IPA+1) |
| 428 | K(IPA,5)=K(IPA,4) |
| 429 | K(IPA+1,4)=MSTU(5)*IPA |
| 430 | K(IPA+1,5)=K(IPA+1,4) |
| 431 | K(IPA+2,4)=MSTU(5)*(IPA+3) |
| 432 | K(IPA+2,5)=K(IPA+2,4) |
| 433 | K(IPA+3,4)=MSTU(5)*(IPA+2) |
| 434 | K(IPA+3,5)=K(IPA+3,4) |
| 435 | ENDIF |
| 436 | |
| 437 | C...Check kinematics. |
| 438 | MKERR=0 |
| 439 | IF(0.5*X1*PECM.LE.PM1.OR.0.5*X2*PECM.LE.PM2.OR.0.5*(2.-X1-X2-X4)* |
| 440 | &PECM.LE.PM3.OR.0.5*X4*PECM.LE.PM4) MKERR=1 |
| 441 | PA1=SQRT(MAX(1E-10,(0.5*X1*PECM)**2-PM1**2)) |
| 442 | PA2=SQRT(MAX(1E-10,(0.5*X2*PECM)**2-PM2**2)) |
| 443 | PA4=SQRT(MAX(1E-10,(0.5*X4*PECM)**2-PM4**2)) |
| 444 | X24=X1+X2+X4-1.-X12-X14+(PM3**2-PM1**2-PM2**2-PM4**2)/PECM**2 |
| 445 | CTHE4=(X1*X4-2.*X14)*PECM**2/(4.*PA1*PA4) |
| 446 | IF(ABS(CTHE4).GE.1.002) MKERR=1 |
| 447 | CTHE4=MAX(-1.,MIN(1.,CTHE4)) |
| 448 | STHE4=SQRT(1.-CTHE4**2) |
| 449 | CTHE2=(X1*X2-2.*X12)*PECM**2/(4.*PA1*PA2) |
| 450 | IF(ABS(CTHE2).GE.1.002) MKERR=1 |
| 451 | CTHE2=MAX(-1.,MIN(1.,CTHE2)) |
| 452 | STHE2=SQRT(1.-CTHE2**2) |
| 453 | CPHI2=((X2*X4-2.*X24)*PECM**2-4.*PA2*CTHE2*PA4*CTHE4)/ |
| 454 | &MAX(1E-8*PECM**2,4.*PA2*STHE2*PA4*STHE4) |
| 455 | IF(ABS(CPHI2).GE.1.05) MKERR=1 |
| 456 | CPHI2=MAX(-1.,MIN(1.,CPHI2)) |
| 457 | IF(MKERR.EQ.1) CALL LUERRM(13, |
| 458 | &'(LU4ENT:) unphysical kinematical variable setup') |
| 459 | |
| 460 | C...Store partons/particles in P vectors. |
| 461 | P(IPA,3)=PA1 |
| 462 | P(IPA,4)=SQRT(PA1**2+PM1**2) |
| 463 | P(IPA,5)=PM1 |
| 464 | P(IPA+3,1)=PA4*STHE4 |
| 465 | P(IPA+3,3)=PA4*CTHE4 |
| 466 | P(IPA+3,4)=SQRT(PA4**2+PM4**2) |
| 467 | P(IPA+3,5)=PM4 |
| 468 | P(IPA+1,1)=PA2*STHE2*CPHI2 |
| 469 | P(IPA+1,2)=PA2*STHE2*SQRT(1.-CPHI2**2)*(-1.)**INT(RLU(0)+0.5) |
| 470 | P(IPA+1,3)=PA2*CTHE2 |
| 471 | P(IPA+1,4)=SQRT(PA2**2+PM2**2) |
| 472 | P(IPA+1,5)=PM2 |
| 473 | P(IPA+2,1)=-P(IPA+1,1)-P(IPA+3,1) |
| 474 | P(IPA+2,2)=-P(IPA+1,2) |
| 475 | P(IPA+2,3)=-P(IPA,3)-P(IPA+1,3)-P(IPA+3,3) |
| 476 | P(IPA+2,4)=SQRT(P(IPA+2,1)**2+P(IPA+2,2)**2+P(IPA+2,3)**2+PM3**2) |
| 477 | P(IPA+2,5)=PM3 |
| 478 | |
| 479 | C...Set N. Optionally fragment/decay. |
| 480 | N=IPA+3 |
| 481 | IF(IP.EQ.0) CALL LUEXEC |
| 482 | |
| 483 | RETURN |
| 484 | END |
| 485 | |
| 486 | C********************************************************************* |
| 487 | |
| 488 | SUBROUTINE LUJOIN(NJOIN,IJOIN) |
| 489 | |
| 490 | C...Purpose: to connect a sequence of partons with colour flow indices, |
| 491 | C...as required for subsequent shower evolution (or other operations). |
| 492 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 493 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 494 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 495 | SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ |
| 496 | DIMENSION IJOIN(*) |
| 497 | |
| 498 | C...Check that partons are of right types to be connected. |
| 499 | IF(NJOIN.LT.2) GOTO 120 |
| 500 | KQSUM=0 |
| 501 | DO 100 IJN=1,NJOIN |
| 502 | I=IJOIN(IJN) |
| 503 | IF(I.LE.0.OR.I.GT.N) GOTO 120 |
| 504 | IF(K(I,1).LT.1.OR.K(I,1).GT.3) GOTO 120 |
| 505 | KC=LUCOMP(K(I,2)) |
| 506 | IF(KC.EQ.0) GOTO 120 |
| 507 | KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) |
| 508 | IF(KQ.EQ.0) GOTO 120 |
| 509 | IF(IJN.NE.1.AND.IJN.NE.NJOIN.AND.KQ.NE.2) GOTO 120 |
| 510 | IF(KQ.NE.2) KQSUM=KQSUM+KQ |
| 511 | 100 IF(IJN.EQ.1) KQS=KQ |
| 512 | IF(KQSUM.NE.0) GOTO 120 |
| 513 | |
| 514 | C...Connect the partons sequentially (closing for gluon loop). |
| 515 | KCS=(9-KQS)/2 |
| 516 | IF(KQS.EQ.2) KCS=INT(4.5+RLU(0)) |
| 517 | DO 110 IJN=1,NJOIN |
| 518 | I=IJOIN(IJN) |
| 519 | K(I,1)=3 |
| 520 | IF(IJN.NE.1) IP=IJOIN(IJN-1) |
| 521 | IF(IJN.EQ.1) IP=IJOIN(NJOIN) |
| 522 | IF(IJN.NE.NJOIN) IN=IJOIN(IJN+1) |
| 523 | IF(IJN.EQ.NJOIN) IN=IJOIN(1) |
| 524 | K(I,KCS)=MSTU(5)*IN |
| 525 | K(I,9-KCS)=MSTU(5)*IP |
| 526 | IF(IJN.EQ.1.AND.KQS.NE.2) K(I,9-KCS)=0 |
| 527 | 110 IF(IJN.EQ.NJOIN.AND.KQS.NE.2) K(I,KCS)=0 |
| 528 | |
| 529 | C...Error exit: no action taken. |
| 530 | RETURN |
| 531 | 120 CALL LUERRM(12, |
| 532 | &'(LUJOIN:) given entries can not be joined by one string') |
| 533 | |
| 534 | RETURN |
| 535 | END |
| 536 | |
| 537 | C********************************************************************* |
| 538 | |
| 539 | SUBROUTINE LUGIVE(CHIN) |
| 540 | |
| 541 | C...Purpose: to set values of commonblock variables (also in PYTHIA!). |
| 542 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 543 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 544 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 545 | COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) |
| 546 | COMMON/LUDAT4/CHAF(500) |
| 547 | CHARACTER CHAF*8 |
| 548 | COMMON/LUDATR/MRLU(6),RRLU(100) |
| 549 | COMMON/PYSUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200) |
| 550 | COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200) |
| 551 | COMMON/PYINT1/MINT(400),VINT(400) |
| 552 | COMMON/PYINT2/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2) |
| 553 | COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000) |
| 554 | COMMON/PYINT4/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3) |
| 555 | COMMON/PYINT5/NGEN(0:200,3),XSEC(0:200,3) |
| 556 | COMMON/PYINT6/PROC(0:200) |
| 557 | CHARACTER PROC*28 |
| 558 | SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/,/LUDAT4/,/LUDATR/ |
| 559 | SAVE /PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/, |
| 560 | &/PYINT5/,/PYINT6/ |
| 561 | CHARACTER CHIN*(*),CHFIX*104,CHBIT*104,CHOLD*8,CHNEW*8,CHOLD2*28, |
| 562 | &CHNEW2*28,CHNAM*4,CHVAR(42)*4,CHALP(2)*26,CHIND*8,CHINI*10, |
| 563 | &CHINR*16 |
| 564 | DIMENSION MSVAR(42,8) |
| 565 | |
| 566 | C...For each variable to be translated give: name, |
| 567 | C...integer/real/character, no. of indices, lower&upper index bounds. |
| 568 | DATA CHVAR/'N','K','P','V','MSTU','PARU','MSTJ','PARJ','KCHG', |
| 569 | &'PMAS','PARF','VCKM','MDCY','MDME','BRAT','KFDP','CHAF','MRLU', |
| 570 | &'RRLU','MSEL','MSUB','KFIN','CKIN','MSTP','PARP','MSTI','PARI', |
| 571 | &'MINT','VINT','ISET','KFPR','COEF','ICOL','XSFX','ISIG','SIGH', |
| 572 | &'WIDP','WIDE','WIDS','NGEN','XSEC','PROC'/ |
| 573 | DATA ((MSVAR(I,J),J=1,8),I=1,42)/ 1,7*0, 1,2,1,4000,1,5,2*0, |
| 574 | & 2,2,1,4000,1,5,2*0, 2,2,1,4000,1,5,2*0, 1,1,1,200,4*0, |
| 575 | & 2,1,1,200,4*0, 1,1,1,200,4*0, 2,1,1,200,4*0, |
| 576 | & 1,2,1,500,1,3,2*0, 2,2,1,500,1,4,2*0, 2,1,1,2000,4*0, |
| 577 | & 2,2,1,4,1,4,2*0, 1,2,1,500,1,3,2*0, 1,2,1,2000,1,2,2*0, |
| 578 | & 2,1,1,2000,4*0, 1,2,1,2000,1,5,2*0, 3,1,1,500,4*0, |
| 579 | & 1,1,1,6,4*0, 2,1,1,100,4*0, |
| 580 | & 1,7*0, 1,1,1,200,4*0, 1,2,1,2,-40,40,2*0, 2,1,1,200,4*0, |
| 581 | & 1,1,1,200,4*0, 2,1,1,200,4*0, 1,1,1,200,4*0, 2,1,1,200,4*0, |
| 582 | & 1,1,1,400,4*0, 2,1,1,400,4*0, 1,1,1,200,4*0, |
| 583 | & 1,2,1,200,1,2,2*0, 2,2,1,200,1,20,2*0, 1,3,1,40,1,4,1,2, |
| 584 | & 2,2,1,2,-40,40,2*0, 1,2,1,1000,1,3,2*0, 2,1,1,1000,4*0, |
| 585 | & 2,2,21,40,0,40,2*0, 2,2,21,40,0,40,2*0, 2,2,21,40,1,3,2*0, |
| 586 | & 1,2,0,200,1,3,2*0, 2,2,0,200,1,3,2*0, 4,1,0,200,4*0/ |
| 587 | DATA CHALP/'abcdefghijklmnopqrstuvwxyz', |
| 588 | &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/ |
| 589 | |
| 590 | C...Length of character variable. Subdivide it into instructions. |
| 591 | IF(MSTU(12).GE.1) CALL LULIST(0) |
| 592 | CHBIT=CHIN//' ' |
| 593 | LBIT=101 |
| 594 | 100 LBIT=LBIT-1 |
| 595 | IF(CHBIT(LBIT:LBIT).EQ.' ') GOTO 100 |
| 596 | LTOT=0 |
| 597 | DO 110 LCOM=1,LBIT |
| 598 | IF(CHBIT(LCOM:LCOM).EQ.' ') GOTO 110 |
| 599 | LTOT=LTOT+1 |
| 600 | CHFIX(LTOT:LTOT)=CHBIT(LCOM:LCOM) |
| 601 | 110 CONTINUE |
| 602 | LLOW=0 |
| 603 | 120 LHIG=LLOW+1 |
| 604 | 130 LHIG=LHIG+1 |
| 605 | IF(LHIG.LE.LTOT.AND.CHFIX(LHIG:LHIG).NE.';') GOTO 130 |
| 606 | LBIT=LHIG-LLOW-1 |
| 607 | CHBIT(1:LBIT)=CHFIX(LLOW+1:LHIG-1) |
| 608 | |
| 609 | C...Identify commonblock variable. |
| 610 | LNAM=1 |
| 611 | 140 LNAM=LNAM+1 |
| 612 | IF(CHBIT(LNAM:LNAM).NE.'('.AND.CHBIT(LNAM:LNAM).NE.'='.AND. |
| 613 | &LNAM.LE.4) GOTO 140 |
| 614 | CHNAM=CHBIT(1:LNAM-1)//' ' |
| 615 | DO 150 LCOM=1,LNAM-1 |
| 616 | DO 150 LALP=1,26 |
| 617 | 150 IF(CHNAM(LCOM:LCOM).EQ.CHALP(1)(LALP:LALP)) CHNAM(LCOM:LCOM)= |
| 618 | &CHALP(2)(LALP:LALP) |
| 619 | IVAR=0 |
| 620 | DO 160 IV=1,42 |
| 621 | 160 IF(CHNAM.EQ.CHVAR(IV)) IVAR=IV |
| 622 | IF(IVAR.EQ.0) THEN |
| 623 | CALL LUERRM(18,'(LUGIVE:) do not recognize variable '//CHNAM) |
| 624 | LLOW=LHIG |
| 625 | IF(LLOW.LT.LTOT) GOTO 120 |
| 626 | RETURN |
| 627 | ENDIF |
| 628 | |
| 629 | C...Identify any indices. |
| 630 | I1=0 |
| 631 | I2=0 |
| 632 | I3=0 |
| 633 | NINDX=0 |
| 634 | IF(CHBIT(LNAM:LNAM).EQ.'(') THEN |
| 635 | LIND=LNAM |
| 636 | 170 LIND=LIND+1 |
| 637 | IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 170 |
| 638 | CHIND=' ' |
| 639 | IF((CHBIT(LNAM+1:LNAM+1).EQ.'C'.OR.CHBIT(LNAM+1:LNAM+1).EQ.'c'). |
| 640 | & AND.(IVAR.EQ.9.OR.IVAR.EQ.10.OR.IVAR.EQ.13.OR.IVAR.EQ.17)) THEN |
| 641 | CHIND(LNAM-LIND+11:8)=CHBIT(LNAM+2:LIND-1) |
| 642 | READ(CHIND,'(I8)') KF |
| 643 | I1=LUCOMP(KF) |
| 644 | ELSEIF(CHBIT(LNAM+1:LNAM+1).EQ.'C'.OR.CHBIT(LNAM+1:LNAM+1).EQ. |
| 645 | & 'c') THEN |
| 646 | CALL LUERRM(18,'(LUGIVE:) not allowed to use C index for '// |
| 647 | & CHNAM) |
| 648 | LLOW=LHIG |
| 649 | IF(LLOW.LT.LTOT) GOTO 120 |
| 650 | RETURN |
| 651 | ELSE |
| 652 | CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1) |
| 653 | READ(CHIND,'(I8)') I1 |
| 654 | ENDIF |
| 655 | LNAM=LIND |
| 656 | IF(CHBIT(LNAM:LNAM).EQ.')') LNAM=LNAM+1 |
| 657 | NINDX=1 |
| 658 | ENDIF |
| 659 | IF(CHBIT(LNAM:LNAM).EQ.',') THEN |
| 660 | LIND=LNAM |
| 661 | 180 LIND=LIND+1 |
| 662 | IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 180 |
| 663 | CHIND=' ' |
| 664 | CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1) |
| 665 | READ(CHIND,'(I8)') I2 |
| 666 | LNAM=LIND |
| 667 | IF(CHBIT(LNAM:LNAM).EQ.')') LNAM=LNAM+1 |
| 668 | NINDX=2 |
| 669 | ENDIF |
| 670 | IF(CHBIT(LNAM:LNAM).EQ.',') THEN |
| 671 | LIND=LNAM |
| 672 | 190 LIND=LIND+1 |
| 673 | IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 190 |
| 674 | CHIND=' ' |
| 675 | CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1) |
| 676 | READ(CHIND,'(I8)') I3 |
| 677 | LNAM=LIND+1 |
| 678 | NINDX=3 |
| 679 | ENDIF |
| 680 | |
| 681 | C...Check that indices allowed. |
| 682 | IERR=0 |
| 683 | IF(NINDX.NE.MSVAR(IVAR,2)) IERR=1 |
| 684 | IF(NINDX.GE.1.AND.(I1.LT.MSVAR(IVAR,3).OR.I1.GT.MSVAR(IVAR,4))) |
| 685 | &IERR=2 |
| 686 | IF(NINDX.GE.2.AND.(I2.LT.MSVAR(IVAR,5).OR.I2.GT.MSVAR(IVAR,6))) |
| 687 | &IERR=3 |
| 688 | IF(NINDX.EQ.3.AND.(I3.LT.MSVAR(IVAR,7).OR.I3.GT.MSVAR(IVAR,8))) |
| 689 | &IERR=4 |
| 690 | IF(CHBIT(LNAM:LNAM).NE.'=') IERR=5 |
| 691 | IF(IERR.GE.1) THEN |
| 692 | CALL LUERRM(18,'(LUGIVE:) unallowed indices for '// |
| 693 | & CHBIT(1:LNAM-1)) |
| 694 | LLOW=LHIG |
| 695 | IF(LLOW.LT.LTOT) GOTO 120 |
| 696 | RETURN |
| 697 | ENDIF |
| 698 | |
| 699 | C...Save old value of variable. |
| 700 | IF(IVAR.EQ.1) THEN |
| 701 | IOLD=N |
| 702 | ELSEIF(IVAR.EQ.2) THEN |
| 703 | IOLD=K(I1,I2) |
| 704 | ELSEIF(IVAR.EQ.3) THEN |
| 705 | ROLD=P(I1,I2) |
| 706 | ELSEIF(IVAR.EQ.4) THEN |
| 707 | ROLD=V(I1,I2) |
| 708 | ELSEIF(IVAR.EQ.5) THEN |
| 709 | IOLD=MSTU(I1) |
| 710 | ELSEIF(IVAR.EQ.6) THEN |
| 711 | ROLD=PARU(I1) |
| 712 | ELSEIF(IVAR.EQ.7) THEN |
| 713 | IOLD=MSTJ(I1) |
| 714 | ELSEIF(IVAR.EQ.8) THEN |
| 715 | ROLD=PARJ(I1) |
| 716 | ELSEIF(IVAR.EQ.9) THEN |
| 717 | IOLD=KCHG(I1,I2) |
| 718 | ELSEIF(IVAR.EQ.10) THEN |
| 719 | ROLD=PMAS(I1,I2) |
| 720 | ELSEIF(IVAR.EQ.11) THEN |
| 721 | ROLD=PARF(I1) |
| 722 | ELSEIF(IVAR.EQ.12) THEN |
| 723 | ROLD=VCKM(I1,I2) |
| 724 | ELSEIF(IVAR.EQ.13) THEN |
| 725 | IOLD=MDCY(I1,I2) |
| 726 | ELSEIF(IVAR.EQ.14) THEN |
| 727 | IOLD=MDME(I1,I2) |
| 728 | ELSEIF(IVAR.EQ.15) THEN |
| 729 | ROLD=BRAT(I1) |
| 730 | ELSEIF(IVAR.EQ.16) THEN |
| 731 | IOLD=KFDP(I1,I2) |
| 732 | ELSEIF(IVAR.EQ.17) THEN |
| 733 | CHOLD=CHAF(I1) |
| 734 | ELSEIF(IVAR.EQ.18) THEN |
| 735 | IOLD=MRLU(I1) |
| 736 | ELSEIF(IVAR.EQ.19) THEN |
| 737 | ROLD=RRLU(I1) |
| 738 | ELSEIF(IVAR.EQ.20) THEN |
| 739 | IOLD=MSEL |
| 740 | ELSEIF(IVAR.EQ.21) THEN |
| 741 | IOLD=MSUB(I1) |
| 742 | ELSEIF(IVAR.EQ.22) THEN |
| 743 | IOLD=KFIN(I1,I2) |
| 744 | ELSEIF(IVAR.EQ.23) THEN |
| 745 | ROLD=CKIN(I1) |
| 746 | ELSEIF(IVAR.EQ.24) THEN |
| 747 | IOLD=MSTP(I1) |
| 748 | ELSEIF(IVAR.EQ.25) THEN |
| 749 | ROLD=PARP(I1) |
| 750 | ELSEIF(IVAR.EQ.26) THEN |
| 751 | IOLD=MSTI(I1) |
| 752 | ELSEIF(IVAR.EQ.27) THEN |
| 753 | ROLD=PARI(I1) |
| 754 | ELSEIF(IVAR.EQ.28) THEN |
| 755 | IOLD=MINT(I1) |
| 756 | ELSEIF(IVAR.EQ.29) THEN |
| 757 | ROLD=VINT(I1) |
| 758 | ELSEIF(IVAR.EQ.30) THEN |
| 759 | IOLD=ISET(I1) |
| 760 | ELSEIF(IVAR.EQ.31) THEN |
| 761 | IOLD=KFPR(I1,I2) |
| 762 | ELSEIF(IVAR.EQ.32) THEN |
| 763 | ROLD=COEF(I1,I2) |
| 764 | ELSEIF(IVAR.EQ.33) THEN |
| 765 | IOLD=ICOL(I1,I2,I3) |
| 766 | ELSEIF(IVAR.EQ.34) THEN |
| 767 | ROLD=XSFX(I1,I2) |
| 768 | ELSEIF(IVAR.EQ.35) THEN |
| 769 | IOLD=ISIG(I1,I2) |
| 770 | ELSEIF(IVAR.EQ.36) THEN |
| 771 | ROLD=SIGH(I1) |
| 772 | ELSEIF(IVAR.EQ.37) THEN |
| 773 | ROLD=WIDP(I1,I2) |
| 774 | ELSEIF(IVAR.EQ.38) THEN |
| 775 | ROLD=WIDE(I1,I2) |
| 776 | ELSEIF(IVAR.EQ.39) THEN |
| 777 | ROLD=WIDS(I1,I2) |
| 778 | ELSEIF(IVAR.EQ.40) THEN |
| 779 | IOLD=NGEN(I1,I2) |
| 780 | ELSEIF(IVAR.EQ.41) THEN |
| 781 | ROLD=XSEC(I1,I2) |
| 782 | ELSEIF(IVAR.EQ.42) THEN |
| 783 | CHOLD2=PROC(I1) |
| 784 | ENDIF |
| 785 | |
| 786 | C...Print current value of variable. Loop back. |
| 787 | IF(LNAM.GE.LBIT) THEN |
| 788 | CHBIT(LNAM:14)=' ' |
| 789 | CHBIT(15:60)=' has the value ' |
| 790 | IF(MSVAR(IVAR,1).EQ.1) THEN |
| 791 | WRITE(CHBIT(51:60),'(I10)') IOLD |
| 792 | ELSEIF(MSVAR(IVAR,1).EQ.2) THEN |
| 793 | WRITE(CHBIT(47:60),'(F14.5)') ROLD |
| 794 | ELSEIF(MSVAR(IVAR,1).EQ.3) THEN |
| 795 | CHBIT(53:60)=CHOLD |
| 796 | ELSE |
| 797 | CHBIT(33:60)=CHOLD |
| 798 | ENDIF |
| 799 | IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60) |
| 800 | LLOW=LHIG |
| 801 | IF(LLOW.LT.LTOT) GOTO 120 |
| 802 | RETURN |
| 803 | ENDIF |
| 804 | |
| 805 | C...Read in new variable value. |
| 806 | IF(MSVAR(IVAR,1).EQ.1) THEN |
| 807 | CHINI=' ' |
| 808 | CHINI(LNAM-LBIT+11:10)=CHBIT(LNAM+1:LBIT) |
| 809 | READ(CHINI,'(I10)') INEW |
| 810 | ELSEIF(MSVAR(IVAR,1).EQ.2) THEN |
| 811 | CHINR=' ' |
| 812 | CHINR(LNAM-LBIT+17:16)=CHBIT(LNAM+1:LBIT) |
| 813 | READ(CHINR,'(F16.2)') RNEW |
| 814 | ELSEIF(MSVAR(IVAR,1).EQ.3) THEN |
| 815 | CHNEW=CHBIT(LNAM+1:LBIT)//' ' |
| 816 | ELSE |
| 817 | CHNEW2=CHBIT(LNAM+1:LBIT)//' ' |
| 818 | ENDIF |
| 819 | |
| 820 | C...Store new variable value. |
| 821 | IF(IVAR.EQ.1) THEN |
| 822 | N=INEW |
| 823 | ELSEIF(IVAR.EQ.2) THEN |
| 824 | K(I1,I2)=INEW |
| 825 | ELSEIF(IVAR.EQ.3) THEN |
| 826 | P(I1,I2)=RNEW |
| 827 | ELSEIF(IVAR.EQ.4) THEN |
| 828 | V(I1,I2)=RNEW |
| 829 | ELSEIF(IVAR.EQ.5) THEN |
| 830 | MSTU(I1)=INEW |
| 831 | ELSEIF(IVAR.EQ.6) THEN |
| 832 | PARU(I1)=RNEW |
| 833 | ELSEIF(IVAR.EQ.7) THEN |
| 834 | MSTJ(I1)=INEW |
| 835 | ELSEIF(IVAR.EQ.8) THEN |
| 836 | PARJ(I1)=RNEW |
| 837 | ELSEIF(IVAR.EQ.9) THEN |
| 838 | KCHG(I1,I2)=INEW |
| 839 | ELSEIF(IVAR.EQ.10) THEN |
| 840 | PMAS(I1,I2)=RNEW |
| 841 | ELSEIF(IVAR.EQ.11) THEN |
| 842 | PARF(I1)=RNEW |
| 843 | ELSEIF(IVAR.EQ.12) THEN |
| 844 | VCKM(I1,I2)=RNEW |
| 845 | ELSEIF(IVAR.EQ.13) THEN |
| 846 | MDCY(I1,I2)=INEW |
| 847 | ELSEIF(IVAR.EQ.14) THEN |
| 848 | MDME(I1,I2)=INEW |
| 849 | ELSEIF(IVAR.EQ.15) THEN |
| 850 | BRAT(I1)=RNEW |
| 851 | ELSEIF(IVAR.EQ.16) THEN |
| 852 | KFDP(I1,I2)=INEW |
| 853 | ELSEIF(IVAR.EQ.17) THEN |
| 854 | CHAF(I1)=CHNEW |
| 855 | ELSEIF(IVAR.EQ.18) THEN |
| 856 | MRLU(I1)=INEW |
| 857 | ELSEIF(IVAR.EQ.19) THEN |
| 858 | RRLU(I1)=RNEW |
| 859 | ELSEIF(IVAR.EQ.20) THEN |
| 860 | MSEL=INEW |
| 861 | ELSEIF(IVAR.EQ.21) THEN |
| 862 | MSUB(I1)=INEW |
| 863 | ELSEIF(IVAR.EQ.22) THEN |
| 864 | KFIN(I1,I2)=INEW |
| 865 | ELSEIF(IVAR.EQ.23) THEN |
| 866 | CKIN(I1)=RNEW |
| 867 | ELSEIF(IVAR.EQ.24) THEN |
| 868 | MSTP(I1)=INEW |
| 869 | ELSEIF(IVAR.EQ.25) THEN |
| 870 | PARP(I1)=RNEW |
| 871 | ELSEIF(IVAR.EQ.26) THEN |
| 872 | MSTI(I1)=INEW |
| 873 | ELSEIF(IVAR.EQ.27) THEN |
| 874 | PARI(I1)=RNEW |
| 875 | ELSEIF(IVAR.EQ.28) THEN |
| 876 | MINT(I1)=INEW |
| 877 | ELSEIF(IVAR.EQ.29) THEN |
| 878 | VINT(I1)=RNEW |
| 879 | ELSEIF(IVAR.EQ.30) THEN |
| 880 | ISET(I1)=INEW |
| 881 | ELSEIF(IVAR.EQ.31) THEN |
| 882 | KFPR(I1,I2)=INEW |
| 883 | ELSEIF(IVAR.EQ.32) THEN |
| 884 | COEF(I1,I2)=RNEW |
| 885 | ELSEIF(IVAR.EQ.33) THEN |
| 886 | ICOL(I1,I2,I3)=INEW |
| 887 | ELSEIF(IVAR.EQ.34) THEN |
| 888 | XSFX(I1,I2)=RNEW |
| 889 | ELSEIF(IVAR.EQ.35) THEN |
| 890 | ISIG(I1,I2)=INEW |
| 891 | ELSEIF(IVAR.EQ.36) THEN |
| 892 | SIGH(I1)=RNEW |
| 893 | ELSEIF(IVAR.EQ.37) THEN |
| 894 | WIDP(I1,I2)=RNEW |
| 895 | ELSEIF(IVAR.EQ.38) THEN |
| 896 | WIDE(I1,I2)=RNEW |
| 897 | ELSEIF(IVAR.EQ.39) THEN |
| 898 | WIDS(I1,I2)=RNEW |
| 899 | ELSEIF(IVAR.EQ.40) THEN |
| 900 | NGEN(I1,I2)=INEW |
| 901 | ELSEIF(IVAR.EQ.41) THEN |
| 902 | XSEC(I1,I2)=RNEW |
| 903 | ELSEIF(IVAR.EQ.42) THEN |
| 904 | PROC(I1)=CHNEW2 |
| 905 | ENDIF |
| 906 | |
| 907 | C...Write old and new value. Loop back. |
| 908 | CHBIT(LNAM:14)=' ' |
| 909 | CHBIT(15:60)=' changed from to ' |
| 910 | IF(MSVAR(IVAR,1).EQ.1) THEN |
| 911 | WRITE(CHBIT(33:42),'(I10)') IOLD |
| 912 | WRITE(CHBIT(51:60),'(I10)') INEW |
| 913 | IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60) |
| 914 | ELSEIF(MSVAR(IVAR,1).EQ.2) THEN |
| 915 | WRITE(CHBIT(29:42),'(F14.5)') ROLD |
| 916 | WRITE(CHBIT(47:60),'(F14.5)') RNEW |
| 917 | IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60) |
| 918 | ELSEIF(MSVAR(IVAR,1).EQ.3) THEN |
| 919 | CHBIT(35:42)=CHOLD |
| 920 | CHBIT(53:60)=CHNEW |
| 921 | IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60) |
| 922 | ELSE |
| 923 | CHBIT(15:88)=' changed from '//CHOLD2//' to '//CHNEW2 |
| 924 | IF(MSTU(13).GE.1) WRITE(MSTU(11),5100) CHBIT(1:88) |
| 925 | ENDIF |
| 926 | LLOW=LHIG |
| 927 | IF(LLOW.LT.LTOT) GOTO 120 |
| 928 | |
| 929 | C...Format statement for output on unit MSTU(11) (by default 6). |
| 930 | 5000 FORMAT(5X,A60) |
| 931 | 5100 FORMAT(5X,A88) |
| 932 | |
| 933 | RETURN |
| 934 | END |
| 935 | |
| 936 | C********************************************************************* |
| 937 | |
| 938 | SUBROUTINE LUEXEC |
| 939 | |
| 940 | C...Purpose: to administrate the fragmentation and decay chain. |
| 941 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 942 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 943 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 944 | COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) |
| 945 | SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/ |
| 946 | DIMENSION PS(2,6) |
| 947 | |
| 948 | C...Initialize and reset. |
| 949 | MSTU(24)=0 |
| 950 | IF(MSTU(12).GE.1) CALL LULIST(0) |
| 951 | MSTU(31)=MSTU(31)+1 |
| 952 | MSTU(1)=0 |
| 953 | MSTU(2)=0 |
| 954 | MSTU(3)=0 |
| 955 | IF(MSTU(17).LE.0) MSTU(90)=0 |
| 956 | MCONS=1 |
| 957 | |
| 958 | C...Sum up momentum, energy and charge for starting entries. |
| 959 | NSAV=N |
| 960 | DO 100 I=1,2 |
| 961 | DO 100 J=1,6 |
| 962 | 100 PS(I,J)=0. |
| 963 | DO 120 I=1,N |
| 964 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 120 |
| 965 | DO 110 J=1,4 |
| 966 | 110 PS(1,J)=PS(1,J)+P(I,J) |
| 967 | PS(1,6)=PS(1,6)+LUCHGE(K(I,2)) |
| 968 | 120 CONTINUE |
| 969 | PARU(21)=PS(1,4) |
| 970 | |
| 971 | C...Prepare system for subsequent fragmentation/decay. |
| 972 | CALL LUPREP(0) |
| 973 | |
| 974 | C...Loop through jet fragmentation and particle decays. |
| 975 | MBE=0 |
| 976 | 130 MBE=MBE+1 |
| 977 | IP=0 |
| 978 | 140 IP=IP+1 |
| 979 | KC=0 |
| 980 | IF(K(IP,1).GT.0.AND.K(IP,1).LE.10) KC=LUCOMP(K(IP,2)) |
| 981 | IF(KC.EQ.0) THEN |
| 982 | |
| 983 | C...Particle decay if unstable and allowed. Save long-lived particle |
| 984 | C...decays until second pass after Bose-Einstein effects. |
| 985 | ELSEIF(KCHG(KC,2).EQ.0) THEN |
| 986 | IF(MSTJ(21).GE.1.AND.MDCY(KC,1).GE.1.AND.(MSTJ(51).LE.0.OR.MBE. |
| 987 | & EQ.2.OR.PMAS(KC,2).GE.PARJ(91).OR.IABS(K(IP,2)).EQ.311)) |
| 988 | & CALL LUDECY(IP) |
| 989 | |
| 990 | C...Decay products may develop a shower. |
| 991 | IF(MSTJ(92).GT.0) THEN |
| 992 | IP1=MSTJ(92) |
| 993 | QMAX=SQRT(MAX(0.,(P(IP1,4)+P(IP1+1,4))**2-(P(IP1,1)+P(IP1+1, |
| 994 | & 1))**2-(P(IP1,2)+P(IP1+1,2))**2-(P(IP1,3)+P(IP1+1,3))**2)) |
| 995 | CALL LUSHOW(IP1,IP1+1,QMAX) |
| 996 | CALL LUPREP(IP1) |
| 997 | MSTJ(92)=0 |
| 998 | ELSEIF(MSTJ(92).LT.0) THEN |
| 999 | IP1=-MSTJ(92) |
| 1000 | CALL LUSHOW(IP1,-3,P(IP,5)) |
| 1001 | CALL LUPREP(IP1) |
| 1002 | MSTJ(92)=0 |
| 1003 | ENDIF |
| 1004 | |
| 1005 | C...Jet fragmentation: string or independent fragmentation. |
| 1006 | ELSEIF(K(IP,1).EQ.1.OR.K(IP,1).EQ.2) THEN |
| 1007 | MFRAG=MSTJ(1) |
| 1008 | IF(MFRAG.GE.1.AND.K(IP,1).EQ.1) MFRAG=2 |
| 1009 | IF(MSTJ(21).GE.2.AND.K(IP,1).EQ.2.AND.N.GT.IP) THEN |
| 1010 | IF(K(IP+1,1).EQ.1.AND.K(IP+1,3).EQ.K(IP,3).AND. |
| 1011 | & K(IP,3).GT.0.AND.K(IP,3).LT.IP) THEN |
| 1012 | IF(KCHG(LUCOMP(K(K(IP,3),2)),2).EQ.0) MFRAG=MIN(1,MFRAG) |
| 1013 | ENDIF |
| 1014 | ENDIF |
| 1015 | IF(MFRAG.EQ.1) CALL LUSTRF(IP) |
| 1016 | IF(MFRAG.EQ.2) CALL LUINDF(IP) |
| 1017 | IF(MFRAG.EQ.2.AND.K(IP,1).EQ.1) MCONS=0 |
| 1018 | IF(MFRAG.EQ.2.AND.(MSTJ(3).LE.0.OR.MOD(MSTJ(3),5).EQ.0)) MCONS=0 |
| 1019 | ENDIF |
| 1020 | |
| 1021 | C...Loop back if enough space left in LUJETS and no error abort. |
| 1022 | IF(MSTU(24).NE.0.AND.MSTU(21).GE.2) THEN |
| 1023 | ELSEIF(IP.LT.N.AND.N.LT.MSTU(4)-20-MSTU(32)) THEN |
| 1024 | GOTO 140 |
| 1025 | ELSEIF(IP.LT.N) THEN |
| 1026 | CALL LUERRM(11,'(LUEXEC:) no more memory left in LUJETS') |
| 1027 | ENDIF |
| 1028 | |
| 1029 | C...Include simple Bose-Einstein effect parametrization if desired. |
| 1030 | IF(MBE.EQ.1.AND.MSTJ(51).GE.1) THEN |
| 1031 | CALL LUBOEI(NSAV) |
| 1032 | GOTO 130 |
| 1033 | ENDIF |
| 1034 | |
| 1035 | C...Check that momentum, energy and charge were conserved. |
| 1036 | DO 160 I=1,N |
| 1037 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 160 |
| 1038 | DO 150 J=1,4 |
| 1039 | 150 PS(2,J)=PS(2,J)+P(I,J) |
| 1040 | PS(2,6)=PS(2,6)+LUCHGE(K(I,2)) |
| 1041 | 160 CONTINUE |
| 1042 | PDEV=(ABS(PS(2,1)-PS(1,1))+ABS(PS(2,2)-PS(1,2))+ABS(PS(2,3)- |
| 1043 | &PS(1,3))+ABS(PS(2,4)-PS(1,4)))/(1.+ABS(PS(2,4))+ABS(PS(1,4))) |
| 1044 | IF(MCONS.EQ.1.AND.PDEV.GT.PARU(11)) CALL LUERRM(15, |
| 1045 | &'(LUEXEC:) four-momentum was not conserved') |
| 1046 | IF(MCONS.EQ.1.AND.ABS(PS(2,6)-PS(1,6)).GT.0.1) CALL LUERRM(15, |
| 1047 | &'(LUEXEC:) charge was not conserved') |
| 1048 | |
| 1049 | RETURN |
| 1050 | END |
| 1051 | |
| 1052 | C********************************************************************* |
| 1053 | |
| 1054 | SUBROUTINE LUPREP(IP) |
| 1055 | |
| 1056 | C...Purpose: to rearrange partons along strings, to allow small systems |
| 1057 | C...to collapse into one or two particles and to check flavours. |
| 1058 | IMPLICIT DOUBLE PRECISION(D) |
| 1059 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 1060 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 1061 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 1062 | COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) |
| 1063 | SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/ |
| 1064 | DIMENSION DPS(5),DPC(5),UE(3) |
| 1065 | |
| 1066 | C...Rearrange parton shower product listing along strings: begin loop. |
| 1067 | I1=N |
| 1068 | DO 130 MQGST=1,2 |
| 1069 | DO 120 I=MAX(1,IP),N |
| 1070 | IF(K(I,1).NE.3) GOTO 120 |
| 1071 | KC=LUCOMP(K(I,2)) |
| 1072 | IF(KC.EQ.0) GOTO 120 |
| 1073 | KQ=KCHG(KC,2) |
| 1074 | IF(KQ.EQ.0.OR.(MQGST.EQ.1.AND.KQ.EQ.2)) GOTO 120 |
| 1075 | |
| 1076 | C...Pick up loose string end. |
| 1077 | KCS=4 |
| 1078 | IF(KQ*ISIGN(1,K(I,2)).LT.0) KCS=5 |
| 1079 | IA=I |
| 1080 | NSTP=0 |
| 1081 | 100 NSTP=NSTP+1 |
| 1082 | IF(NSTP.GT.4*N) THEN |
| 1083 | CALL LUERRM(14,'(LUPREP:) caught in infinite loop') |
| 1084 | RETURN |
| 1085 | ENDIF |
| 1086 | |
| 1087 | C...Copy undecayed parton. |
| 1088 | IF(K(IA,1).EQ.3) THEN |
| 1089 | IF(I1.GE.MSTU(4)-MSTU(32)-5) THEN |
| 1090 | CALL LUERRM(11,'(LUPREP:) no more memory left in LUJETS') |
| 1091 | RETURN |
| 1092 | ENDIF |
| 1093 | I1=I1+1 |
| 1094 | K(I1,1)=2 |
| 1095 | IF(NSTP.GE.2.AND.IABS(K(IA,2)).NE.21) K(I1,1)=1 |
| 1096 | K(I1,2)=K(IA,2) |
| 1097 | K(I1,3)=IA |
| 1098 | K(I1,4)=0 |
| 1099 | K(I1,5)=0 |
| 1100 | DO 110 J=1,5 |
| 1101 | P(I1,J)=P(IA,J) |
| 1102 | 110 V(I1,J)=V(IA,J) |
| 1103 | K(IA,1)=K(IA,1)+10 |
| 1104 | IF(K(I1,1).EQ.1) GOTO 120 |
| 1105 | ENDIF |
| 1106 | |
| 1107 | C...Go to next parton in colour space. |
| 1108 | IB=IA |
| 1109 | IF(MOD(K(IB,KCS)/MSTU(5)**2,2).EQ.0.AND.MOD(K(IB,KCS),MSTU(5)). |
| 1110 | &NE.0) THEN |
| 1111 | IA=MOD(K(IB,KCS),MSTU(5)) |
| 1112 | K(IB,KCS)=K(IB,KCS)+MSTU(5)**2 |
| 1113 | MREV=0 |
| 1114 | ELSE |
| 1115 | IF(K(IB,KCS).GE.2*MSTU(5)**2.OR.MOD(K(IB,KCS)/MSTU(5),MSTU(5)). |
| 1116 | & EQ.0) KCS=9-KCS |
| 1117 | IA=MOD(K(IB,KCS)/MSTU(5),MSTU(5)) |
| 1118 | K(IB,KCS)=K(IB,KCS)+2*MSTU(5)**2 |
| 1119 | MREV=1 |
| 1120 | ENDIF |
| 1121 | IF(IA.LE.0.OR.IA.GT.N) THEN |
| 1122 | CALL LUERRM(12,'(LUPREP:) colour rearrangement failed') |
| 1123 | RETURN |
| 1124 | ENDIF |
| 1125 | IF(MOD(K(IA,4)/MSTU(5),MSTU(5)).EQ.IB.OR.MOD(K(IA,5)/MSTU(5), |
| 1126 | &MSTU(5)).EQ.IB) THEN |
| 1127 | IF(MREV.EQ.1) KCS=9-KCS |
| 1128 | IF(MOD(K(IA,KCS)/MSTU(5),MSTU(5)).NE.IB) KCS=9-KCS |
| 1129 | K(IA,KCS)=K(IA,KCS)+2*MSTU(5)**2 |
| 1130 | ELSE |
| 1131 | IF(MREV.EQ.0) KCS=9-KCS |
| 1132 | IF(MOD(K(IA,KCS),MSTU(5)).NE.IB) KCS=9-KCS |
| 1133 | K(IA,KCS)=K(IA,KCS)+MSTU(5)**2 |
| 1134 | ENDIF |
| 1135 | IF(IA.NE.I) GOTO 100 |
| 1136 | K(I1,1)=1 |
| 1137 | 120 CONTINUE |
| 1138 | 130 CONTINUE |
| 1139 | N=I1 |
| 1140 | IF(MSTJ(14).LT.0) RETURN |
| 1141 | |
| 1142 | C...Find lowest-mass colour singlet jet system, OK if above threshold. |
| 1143 | IF(MSTJ(14).EQ.0) GOTO 320 |
| 1144 | NS=N |
| 1145 | 140 NSIN=N-NS |
| 1146 | PDM=1.+PARJ(32) |
| 1147 | IC=0 |
| 1148 | DO 190 I=MAX(1,IP),NS |
| 1149 | IF(K(I,1).NE.1.AND.K(I,1).NE.2) THEN |
| 1150 | ELSEIF(K(I,1).EQ.2.AND.IC.EQ.0) THEN |
| 1151 | NSIN=NSIN+1 |
| 1152 | IC=I |
| 1153 | DO 150 J=1,4 |
| 1154 | 150 DPS(J)=P(I,J) |
| 1155 | MSTJ(93)=1 |
| 1156 | DPS(5)=ULMASS(K(I,2)) |
| 1157 | ELSEIF(K(I,1).EQ.2) THEN |
| 1158 | DO 160 J=1,4 |
| 1159 | 160 DPS(J)=DPS(J)+P(I,J) |
| 1160 | ELSEIF(IC.NE.0.AND.KCHG(LUCOMP(K(I,2)),2).NE.0) THEN |
| 1161 | DO 170 J=1,4 |
| 1162 | 170 DPS(J)=DPS(J)+P(I,J) |
| 1163 | MSTJ(93)=1 |
| 1164 | DPS(5)=DPS(5)+ULMASS(K(I,2)) |
| 1165 | PD=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2))-DPS(5) |
| 1166 | IF(PD.LT.PDM) THEN |
| 1167 | PDM=PD |
| 1168 | DO 180 J=1,5 |
| 1169 | 180 DPC(J)=DPS(J) |
| 1170 | IC1=IC |
| 1171 | IC2=I |
| 1172 | ENDIF |
| 1173 | IC=0 |
| 1174 | ELSE |
| 1175 | NSIN=NSIN+1 |
| 1176 | ENDIF |
| 1177 | 190 CONTINUE |
| 1178 | IF(PDM.GE.PARJ(32)) GOTO 320 |
| 1179 | |
| 1180 | C...Fill small-mass system as cluster. |
| 1181 | NSAV=N |
| 1182 | PECM=SQRT(MAX(0D0,DPC(4)**2-DPC(1)**2-DPC(2)**2-DPC(3)**2)) |
| 1183 | K(N+1,1)=11 |
| 1184 | K(N+1,2)=91 |
| 1185 | K(N+1,3)=IC1 |
| 1186 | K(N+1,4)=N+2 |
| 1187 | K(N+1,5)=N+3 |
| 1188 | P(N+1,1)=DPC(1) |
| 1189 | P(N+1,2)=DPC(2) |
| 1190 | P(N+1,3)=DPC(3) |
| 1191 | P(N+1,4)=DPC(4) |
| 1192 | P(N+1,5)=PECM |
| 1193 | |
| 1194 | C...Form two particles from flavours of lowest-mass system, if feasible. |
| 1195 | K(N+2,1)=1 |
| 1196 | K(N+3,1)=1 |
| 1197 | IF(MSTU(16).NE.2) THEN |
| 1198 | K(N+2,3)=N+1 |
| 1199 | K(N+3,3)=N+1 |
| 1200 | ELSE |
| 1201 | K(N+2,3)=IC1 |
| 1202 | K(N+3,3)=IC2 |
| 1203 | ENDIF |
| 1204 | K(N+2,4)=0 |
| 1205 | K(N+3,4)=0 |
| 1206 | K(N+2,5)=0 |
| 1207 | K(N+3,5)=0 |
| 1208 | IF(IABS(K(IC1,2)).NE.21) THEN |
| 1209 | KC1=LUCOMP(K(IC1,2)) |
| 1210 | KC2=LUCOMP(K(IC2,2)) |
| 1211 | IF(KC1.EQ.0.OR.KC2.EQ.0) GOTO 320 |
| 1212 | KQ1=KCHG(KC1,2)*ISIGN(1,K(IC1,2)) |
| 1213 | KQ2=KCHG(KC2,2)*ISIGN(1,K(IC2,2)) |
| 1214 | IF(KQ1+KQ2.NE.0) GOTO 320 |
| 1215 | 200 CALL LUKFDI(K(IC1,2),0,KFLN,K(N+2,2)) |
| 1216 | CALL LUKFDI(K(IC2,2),-KFLN,KFLDMP,K(N+3,2)) |
| 1217 | IF(K(N+2,2).EQ.0.OR.K(N+3,2).EQ.0) GOTO 200 |
| 1218 | ELSE |
| 1219 | IF(IABS(K(IC2,2)).NE.21) GOTO 320 |
| 1220 | 210 CALL LUKFDI(1+INT((2.+PARJ(2))*RLU(0)),0,KFLN,KFDMP) |
| 1221 | CALL LUKFDI(KFLN,0,KFLM,K(N+2,2)) |
| 1222 | CALL LUKFDI(-KFLN,-KFLM,KFLDMP,K(N+3,2)) |
| 1223 | IF(K(N+2,2).EQ.0.OR.K(N+3,2).EQ.0) GOTO 210 |
| 1224 | ENDIF |
| 1225 | P(N+2,5)=ULMASS(K(N+2,2)) |
| 1226 | P(N+3,5)=ULMASS(K(N+3,2)) |
| 1227 | IF(P(N+2,5)+P(N+3,5)+PARJ(64).GE.PECM.AND.NSIN.EQ.1) GOTO 320 |
| 1228 | IF(P(N+2,5)+P(N+3,5)+PARJ(64).GE.PECM) GOTO 260 |
| 1229 | |
| 1230 | C...Perform two-particle decay of jet system, if possible. |
| 1231 | IF(PECM.GE.0.02*DPC(4)) THEN |
| 1232 | PA=SQRT((PECM**2-(P(N+2,5)+P(N+3,5))**2)*(PECM**2- |
| 1233 | & (P(N+2,5)-P(N+3,5))**2))/(2.*PECM) |
| 1234 | UE(3)=2.*RLU(0)-1. |
| 1235 | PHI=PARU(2)*RLU(0) |
| 1236 | UE(1)=SQRT(1.-UE(3)**2)*COS(PHI) |
| 1237 | UE(2)=SQRT(1.-UE(3)**2)*SIN(PHI) |
| 1238 | DO 220 J=1,3 |
| 1239 | P(N+2,J)=PA*UE(J) |
| 1240 | 220 P(N+3,J)=-PA*UE(J) |
| 1241 | P(N+2,4)=SQRT(PA**2+P(N+2,5)**2) |
| 1242 | P(N+3,4)=SQRT(PA**2+P(N+3,5)**2) |
| 1243 | MSTU(33)=1 |
| 1244 | CALL LUDBRB(N+2,N+3,0.,0.,DPC(1)/DPC(4),DPC(2)/DPC(4), |
| 1245 | & DPC(3)/DPC(4)) |
| 1246 | ELSE |
| 1247 | NP=0 |
| 1248 | DO 230 I=IC1,IC2 |
| 1249 | 230 IF(K(I,1).EQ.1.OR.K(I,1).EQ.2) NP=NP+1 |
| 1250 | HA=P(IC1,4)*P(IC2,4)-P(IC1,1)*P(IC2,1)-P(IC1,2)*P(IC2,2)- |
| 1251 | & P(IC1,3)*P(IC2,3) |
| 1252 | IF(NP.GE.3.OR.HA.LE.1.25*P(IC1,5)*P(IC2,5)) GOTO 260 |
| 1253 | HD1=0.5*(P(N+2,5)**2-P(IC1,5)**2) |
| 1254 | HD2=0.5*(P(N+3,5)**2-P(IC2,5)**2) |
| 1255 | HR=SQRT(MAX(0.,((HA-HD1-HD2)**2-(P(N+2,5)*P(N+3,5))**2)/ |
| 1256 | & (HA**2-(P(IC1,5)*P(IC2,5))**2)))-1. |
| 1257 | HC=P(IC1,5)**2+2.*HA+P(IC2,5)**2 |
| 1258 | HK1=((P(IC2,5)**2+HA)*HR+HD1-HD2)/HC |
| 1259 | HK2=((P(IC1,5)**2+HA)*HR+HD2-HD1)/HC |
| 1260 | DO 240 J=1,4 |
| 1261 | P(N+2,J)=(1.+HK1)*P(IC1,J)-HK2*P(IC2,J) |
| 1262 | 240 P(N+3,J)=(1.+HK2)*P(IC2,J)-HK1*P(IC1,J) |
| 1263 | ENDIF |
| 1264 | DO 250 J=1,4 |
| 1265 | V(N+1,J)=V(IC1,J) |
| 1266 | V(N+2,J)=V(IC1,J) |
| 1267 | 250 V(N+3,J)=V(IC2,J) |
| 1268 | V(N+1,5)=0. |
| 1269 | V(N+2,5)=0. |
| 1270 | V(N+3,5)=0. |
| 1271 | N=N+3 |
| 1272 | GOTO 300 |
| 1273 | |
| 1274 | C...Else form one particle from the flavours available, if possible. |
| 1275 | 260 K(N+1,5)=N+2 |
| 1276 | IF(IABS(K(IC1,2)).GT.100.AND.IABS(K(IC2,2)).GT.100) THEN |
| 1277 | GOTO 320 |
| 1278 | ELSEIF(IABS(K(IC1,2)).NE.21) THEN |
| 1279 | CALL LUKFDI(K(IC1,2),K(IC2,2),KFLDMP,K(N+2,2)) |
| 1280 | ELSE |
| 1281 | KFLN=1+INT((2.+PARJ(2))*RLU(0)) |
| 1282 | CALL LUKFDI(KFLN,-KFLN,KFLDMP,K(N+2,2)) |
| 1283 | ENDIF |
| 1284 | IF(K(N+2,2).EQ.0) GOTO 260 |
| 1285 | P(N+2,5)=ULMASS(K(N+2,2)) |
| 1286 | |
| 1287 | C...Find parton/particle which combines to largest extra mass. |
| 1288 | IR=0 |
| 1289 | HA=0. |
| 1290 | HSM=0. |
| 1291 | DO 280 MCOMB=1,3 |
| 1292 | IF(IR.NE.0) GOTO 280 |
| 1293 | DO 270 I=MAX(1,IP),N |
| 1294 | IF(K(I,1).LE.0.OR.K(I,1).GT.10.OR.(I.GE.IC1.AND.I.LE.IC2. |
| 1295 | &AND.K(I,1).GE.1.AND.K(I,1).LE.2)) GOTO 270 |
| 1296 | IF(MCOMB.EQ.1) KCI=LUCOMP(K(I,2)) |
| 1297 | IF(MCOMB.EQ.1.AND.KCI.EQ.0) GOTO 270 |
| 1298 | IF(MCOMB.EQ.1.AND.KCHG(KCI,2).EQ.0.AND.I.LE.NS) GOTO 270 |
| 1299 | IF(MCOMB.EQ.2.AND.IABS(K(I,2)).GT.10.AND.IABS(K(I,2)).LE.100) |
| 1300 | &GOTO 270 |
| 1301 | HCR=DPC(4)*P(I,4)-DPC(1)*P(I,1)-DPC(2)*P(I,2)-DPC(3)*P(I,3) |
| 1302 | HSR=2.*HCR+PECM**2-P(N+2,5)**2-2.*P(N+2,5)*P(I,5) |
| 1303 | IF(HSR.GT.HSM) THEN |
| 1304 | IR=I |
| 1305 | HA=HCR |
| 1306 | HSM=HSR |
| 1307 | ENDIF |
| 1308 | 270 CONTINUE |
| 1309 | 280 CONTINUE |
| 1310 | |
| 1311 | C...Shuffle energy and momentum to put new particle on mass shell. |
| 1312 | IF(IR.NE.0) THEN |
| 1313 | HB=PECM**2+HA |
| 1314 | HC=P(N+2,5)**2+HA |
| 1315 | HD=P(IR,5)**2+HA |
| 1316 | HK2=0.5*(HB*SQRT(MAX(0.,((HB+HC)**2-4.*(HB+HD)*P(N+2,5)**2)/ |
| 1317 | & (HA**2-(PECM*P(IR,5))**2)))-(HB+HC))/(HB+HD) |
| 1318 | HK1=(0.5*(P(N+2,5)**2-PECM**2)+HD*HK2)/HB |
| 1319 | DO 290 J=1,4 |
| 1320 | P(N+2,J)=(1.+HK1)*DPC(J)-HK2*P(IR,J) |
| 1321 | P(IR,J)=(1.+HK2)*P(IR,J)-HK1*DPC(J) |
| 1322 | V(N+1,J)=V(IC1,J) |
| 1323 | 290 V(N+2,J)=V(IC1,J) |
| 1324 | V(N+1,5)=0. |
| 1325 | V(N+2,5)=0. |
| 1326 | N=N+2 |
| 1327 | ELSE |
| 1328 | CALL LUERRM(3,'(LUPREP:) no match for collapsing cluster') |
| 1329 | RETURN |
| 1330 | ENDIF |
| 1331 | |
| 1332 | C...Mark collapsed system and store daughter pointers. Iterate. |
| 1333 | 300 DO 310 I=IC1,IC2 |
| 1334 | IF((K(I,1).EQ.1.OR.K(I,1).EQ.2).AND.KCHG(LUCOMP(K(I,2)),2).NE.0) |
| 1335 | &THEN |
| 1336 | K(I,1)=K(I,1)+10 |
| 1337 | IF(MSTU(16).NE.2) THEN |
| 1338 | K(I,4)=NSAV+1 |
| 1339 | K(I,5)=NSAV+1 |
| 1340 | ELSE |
| 1341 | K(I,4)=NSAV+2 |
| 1342 | K(I,5)=N |
| 1343 | ENDIF |
| 1344 | ENDIF |
| 1345 | 310 CONTINUE |
| 1346 | IF(N.LT.MSTU(4)-MSTU(32)-5) GOTO 140 |
| 1347 | |
| 1348 | C...Check flavours and invariant masses in parton systems. |
| 1349 | 320 NP=0 |
| 1350 | KFN=0 |
| 1351 | KQS=0 |
| 1352 | DO 330 J=1,5 |
| 1353 | 330 DPS(J)=0. |
| 1354 | DO 360 I=MAX(1,IP),N |
| 1355 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 360 |
| 1356 | KC=LUCOMP(K(I,2)) |
| 1357 | IF(KC.EQ.0) GOTO 360 |
| 1358 | KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) |
| 1359 | IF(KQ.EQ.0) GOTO 360 |
| 1360 | NP=NP+1 |
| 1361 | IF(KQ.NE.2) THEN |
| 1362 | KFN=KFN+1 |
| 1363 | KQS=KQS+KQ |
| 1364 | MSTJ(93)=1 |
| 1365 | DPS(5)=DPS(5)+ULMASS(K(I,2)) |
| 1366 | ENDIF |
| 1367 | DO 340 J=1,4 |
| 1368 | 340 DPS(J)=DPS(J)+P(I,J) |
| 1369 | IF(K(I,1).EQ.1) THEN |
| 1370 | IF(NP.NE.1.AND.(KFN.EQ.1.OR.KFN.GE.3.OR.KQS.NE.0)) CALL |
| 1371 | & LUERRM(2,'(LUPREP:) unphysical flavour combination') |
| 1372 | IF(NP.NE.1.AND.DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2.LT. |
| 1373 | & (0.9*PARJ(32)+DPS(5))**2) CALL LUERRM(3, |
| 1374 | & '(LUPREP:) too small mass in jet system') |
| 1375 | NP=0 |
| 1376 | KFN=0 |
| 1377 | KQS=0 |
| 1378 | DO 350 J=1,5 |
| 1379 | 350 DPS(J)=0. |
| 1380 | ENDIF |
| 1381 | 360 CONTINUE |
| 1382 | |
| 1383 | RETURN |
| 1384 | END |
| 1385 | |
| 1386 | C********************************************************************* |
| 1387 | |
| 1388 | SUBROUTINE LUSTRF(IP) |
| 1389 | C...Purpose: to handle the fragmentation of an arbitrary colour singlet |
| 1390 | C...jet system according to the Lund string fragmentation model. |
| 1391 | IMPLICIT DOUBLE PRECISION(D) |
| 1392 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 1393 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 1394 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 1395 | SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ |
| 1396 | DIMENSION DPS(5),KFL(3),PMQ(3),PX(3),PY(3),GAM(3),IE(2),PR(2), |
| 1397 | &IN(9),DHM(4),DHG(4),DP(5,5),IRANK(2),MJU(4),IJU(3),PJU(5,5), |
| 1398 | &TJU(5),KFJH(2),NJS(2),KFJS(2),PJS(4,5),MSTU9T(8),PARU9T(8) |
| 1399 | |
| 1400 | C...Function: four-product of two vectors. |
| 1401 | 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) |
| 1402 | DFOUR(I,J)=DP(I,4)*DP(J,4)-DP(I,1)*DP(J,1)-DP(I,2)*DP(J,2)- |
| 1403 | &DP(I,3)*DP(J,3) |
| 1404 | |
| 1405 | C...Reset counters. Identify parton system. |
| 1406 | MSTJ(91)=0 |
| 1407 | NSAV=N |
| 1408 | MSTU90=MSTU(90) |
| 1409 | NP=0 |
| 1410 | KQSUM=0 |
| 1411 | DO 100 J=1,5 |
| 1412 | 100 DPS(J)=0D0 |
| 1413 | MJU(1)=0 |
| 1414 | MJU(2)=0 |
| 1415 | I=IP-1 |
| 1416 | 110 I=I+1 |
| 1417 | IF(I.GT.MIN(N,MSTU(4)-MSTU(32))) THEN |
| 1418 | CALL LUERRM(12,'(LUSTRF:) failed to reconstruct jet system') |
| 1419 | IF(MSTU(21).GE.1) RETURN |
| 1420 | ENDIF |
| 1421 | IF(K(I,1).NE.1.AND.K(I,1).NE.2.AND.K(I,1).NE.41) GOTO 110 |
| 1422 | KC=LUCOMP(K(I,2)) |
| 1423 | IF(KC.EQ.0) GOTO 110 |
| 1424 | KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) |
| 1425 | IF(KQ.EQ.0) GOTO 110 |
| 1426 | IF(N+5*NP+11.GT.MSTU(4)-MSTU(32)-5) THEN |
| 1427 | CALL LUERRM(11,'(LUSTRF:) no more memory left in LUJETS') |
| 1428 | IF(MSTU(21).GE.1) RETURN |
| 1429 | ENDIF |
| 1430 | |
| 1431 | C...Take copy of partons to be considered. Check flavour sum. |
| 1432 | NP=NP+1 |
| 1433 | DO 120 J=1,5 |
| 1434 | K(N+NP,J)=K(I,J) |
| 1435 | P(N+NP,J)=P(I,J) |
| 1436 | 120 IF(J.NE.4) DPS(J)=DPS(J)+P(I,J) |
| 1437 | DPS(4)=DPS(4)+SQRT(DBLE(P(I,1))**2+DBLE(P(I,2))**2+ |
| 1438 | &DBLE(P(I,3))**2+DBLE(P(I,5))**2) |
| 1439 | K(N+NP,3)=I |
| 1440 | IF(KQ.NE.2) KQSUM=KQSUM+KQ |
| 1441 | IF(K(I,1).EQ.41) THEN |
| 1442 | KQSUM=KQSUM+2*KQ |
| 1443 | IF(KQSUM.EQ.KQ) MJU(1)=N+NP |
| 1444 | IF(KQSUM.NE.KQ) MJU(2)=N+NP |
| 1445 | ENDIF |
| 1446 | IF(K(I,1).EQ.2.OR.K(I,1).EQ.41) GOTO 110 |
| 1447 | IF(KQSUM.NE.0) THEN |
| 1448 | CALL LUERRM(12,'(LUSTRF:) unphysical flavour combination') |
| 1449 | IF(MSTU(21).GE.1) RETURN |
| 1450 | ENDIF |
| 1451 | |
| 1452 | C...Boost copied system to CM frame (for better numerical precision). |
| 1453 | IF(ABS(DPS(3)).LT.0.99D0*DPS(4)) THEN |
| 1454 | MBST=0 |
| 1455 | MSTU(33)=1 |
| 1456 | CALL LUDBRB(N+1,N+NP,0.,0.,-DPS(1)/DPS(4),-DPS(2)/DPS(4), |
| 1457 | & -DPS(3)/DPS(4)) |
| 1458 | ELSE |
| 1459 | MBST=1 |
| 1460 | HHBZ=SQRT(MAX(1D-6,DPS(4)+DPS(3))/MAX(1D-6,DPS(4)-DPS(3))) |
| 1461 | DO 130 I=N+1,N+NP |
| 1462 | HHPMT=P(I,1)**2+P(I,2)**2+P(I,5)**2 |
| 1463 | IF(P(I,3).GT.0.) THEN |
| 1464 | HHPEZ=(P(I,4)+P(I,3))/HHBZ |
| 1465 | P(I,3)=0.5*(HHPEZ-HHPMT/HHPEZ) |
| 1466 | P(I,4)=0.5*(HHPEZ+HHPMT/HHPEZ) |
| 1467 | ELSE |
| 1468 | HHPEZ=(P(I,4)-P(I,3))*HHBZ |
| 1469 | P(I,3)=-0.5*(HHPEZ-HHPMT/HHPEZ) |
| 1470 | P(I,4)=0.5*(HHPEZ+HHPMT/HHPEZ) |
| 1471 | ENDIF |
| 1472 | 130 CONTINUE |
| 1473 | ENDIF |
| 1474 | |
| 1475 | C...Search for very nearby partons that may be recombined. |
| 1476 | NTRYR=0 |
| 1477 | PARU12=PARU(12) |
| 1478 | PARU13=PARU(13) |
| 1479 | MJU(3)=MJU(1) |
| 1480 | MJU(4)=MJU(2) |
| 1481 | NR=NP |
| 1482 | 140 IF(NR.GE.3) THEN |
| 1483 | PDRMIN=2.*PARU12 |
| 1484 | DO 150 I=N+1,N+NR |
| 1485 | IF(I.EQ.N+NR.AND.IABS(K(N+1,2)).NE.21) GOTO 150 |
| 1486 | I1=I+1 |
| 1487 | IF(I.EQ.N+NR) I1=N+1 |
| 1488 | IF(K(I,1).EQ.41.OR.K(I1,1).EQ.41) GOTO 150 |
| 1489 | IF(MJU(1).NE.0.AND.I1.LT.MJU(1).AND.IABS(K(I1,2)).NE.21) |
| 1490 | & GOTO 150 |
| 1491 | IF(MJU(2).NE.0.AND.I.GT.MJU(2).AND.IABS(K(I,2)).NE.21) GOTO 150 |
| 1492 | PAP=SQRT((P(I,1)**2+P(I,2)**2+P(I,3)**2)*(P(I1,1)**2+ |
| 1493 | & P(I1,2)**2+P(I1,3)**2)) |
| 1494 | PVP=P(I,1)*P(I1,1)+P(I,2)*P(I1,2)+P(I,3)*P(I1,3) |
| 1495 | PDR=4.*(PAP-PVP)**2/MAX(1E-6,PARU13**2*PAP+2.*(PAP-PVP)) |
| 1496 | IF(PDR.LT.PDRMIN) THEN |
| 1497 | IR=I |
| 1498 | PDRMIN=PDR |
| 1499 | ENDIF |
| 1500 | 150 CONTINUE |
| 1501 | |
| 1502 | C...Recombine very nearby partons to avoid machine precision problems. |
| 1503 | IF(PDRMIN.LT.PARU12.AND.IR.EQ.N+NR) THEN |
| 1504 | DO 160 J=1,4 |
| 1505 | 160 P(N+1,J)=P(N+1,J)+P(N+NR,J) |
| 1506 | P(N+1,5)=SQRT(MAX(0.,P(N+1,4)**2-P(N+1,1)**2-P(N+1,2)**2- |
| 1507 | & P(N+1,3)**2)) |
| 1508 | NR=NR-1 |
| 1509 | GOTO 140 |
| 1510 | ELSEIF(PDRMIN.LT.PARU12) THEN |
| 1511 | DO 170 J=1,4 |
| 1512 | 170 P(IR,J)=P(IR,J)+P(IR+1,J) |
| 1513 | P(IR,5)=SQRT(MAX(0.,P(IR,4)**2-P(IR,1)**2-P(IR,2)**2- |
| 1514 | & P(IR,3)**2)) |
| 1515 | DO 180 I=IR+1,N+NR-1 |
| 1516 | K(I,2)=K(I+1,2) |
| 1517 | DO 180 J=1,5 |
| 1518 | 180 P(I,J)=P(I+1,J) |
| 1519 | IF(IR.EQ.N+NR-1) K(IR,2)=K(N+NR,2) |
| 1520 | NR=NR-1 |
| 1521 | IF(MJU(1).GT.IR) MJU(1)=MJU(1)-1 |
| 1522 | IF(MJU(2).GT.IR) MJU(2)=MJU(2)-1 |
| 1523 | GOTO 140 |
| 1524 | ENDIF |
| 1525 | ENDIF |
| 1526 | NTRYR=NTRYR+1 |
| 1527 | |
| 1528 | C...Reset particle counter. Skip ahead if no junctions are present; |
| 1529 | C...this is usually the case! |
| 1530 | NRS=MAX(5*NR+11,NP) |
| 1531 | NTRY=0 |
| 1532 | 190 NTRY=NTRY+1 |
| 1533 | IF(NTRY.GT.100.AND.NTRYR.LE.4) THEN |
| 1534 | PARU12=4.*PARU12 |
| 1535 | PARU13=2.*PARU13 |
| 1536 | GOTO 140 |
| 1537 | ELSEIF(NTRY.GT.100) THEN |
| 1538 | CALL LUERRM(14,'(LUSTRF:) caught in infinite loop') |
| 1539 | IF(MSTU(21).GE.1) RETURN |
| 1540 | ENDIF |
| 1541 | I=N+NRS |
| 1542 | MSTU(90)=MSTU90 |
| 1543 | IF(MJU(1).EQ.0.AND.MJU(2).EQ.0) GOTO 510 |
| 1544 | DO 500 JT=1,2 |
| 1545 | NJS(JT)=0 |
| 1546 | IF(MJU(JT).EQ.0) GOTO 500 |
| 1547 | JS=3-2*JT |
| 1548 | |
| 1549 | C...Find and sum up momentum on three sides of junction. Check flavours. |
| 1550 | DO 200 IU=1,3 |
| 1551 | IJU(IU)=0 |
| 1552 | DO 200 J=1,5 |
| 1553 | 200 PJU(IU,J)=0. |
| 1554 | IU=0 |
| 1555 | DO 210 I1=N+1+(JT-1)*(NR-1),N+NR+(JT-1)*(1-NR),JS |
| 1556 | IF(K(I1,2).NE.21.AND.IU.LE.2) THEN |
| 1557 | IU=IU+1 |
| 1558 | IJU(IU)=I1 |
| 1559 | ENDIF |
| 1560 | DO 210 J=1,4 |
| 1561 | 210 PJU(IU,J)=PJU(IU,J)+P(I1,J) |
| 1562 | DO 220 IU=1,3 |
| 1563 | 220 PJU(IU,5)=SQRT(PJU(IU,1)**2+PJU(IU,2)**2+PJU(IU,3)**2) |
| 1564 | IF(K(IJU(3),2)/100.NE.10*K(IJU(1),2)+K(IJU(2),2).AND. |
| 1565 | &K(IJU(3),2)/100.NE.10*K(IJU(2),2)+K(IJU(1),2)) THEN |
| 1566 | CALL LUERRM(12,'(LUSTRF:) unphysical flavour combination') |
| 1567 | IF(MSTU(21).GE.1) RETURN |
| 1568 | ENDIF |
| 1569 | |
| 1570 | C...Calculate (approximate) boost to rest frame of junction. |
| 1571 | T12=(PJU(1,1)*PJU(2,1)+PJU(1,2)*PJU(2,2)+PJU(1,3)*PJU(2,3))/ |
| 1572 | &(PJU(1,5)*PJU(2,5)) |
| 1573 | T13=(PJU(1,1)*PJU(3,1)+PJU(1,2)*PJU(3,2)+PJU(1,3)*PJU(3,3))/ |
| 1574 | &(PJU(1,5)*PJU(3,5)) |
| 1575 | T23=(PJU(2,1)*PJU(3,1)+PJU(2,2)*PJU(3,2)+PJU(2,3)*PJU(3,3))/ |
| 1576 | &(PJU(2,5)*PJU(3,5)) |
| 1577 | T11=SQRT((2./3.)*(1.-T12)*(1.-T13)/(1.-T23)) |
| 1578 | T22=SQRT((2./3.)*(1.-T12)*(1.-T23)/(1.-T13)) |
| 1579 | TSQ=SQRT((2.*T11*T22+T12-1.)*(1.+T12)) |
| 1580 | T1F=(TSQ-T22*(1.+T12))/(1.-T12**2) |
| 1581 | T2F=(TSQ-T11*(1.+T12))/(1.-T12**2) |
| 1582 | DO 230 J=1,3 |
| 1583 | 230 TJU(J)=-(T1F*PJU(1,J)/PJU(1,5)+T2F*PJU(2,J)/PJU(2,5)) |
| 1584 | TJU(4)=SQRT(1.+TJU(1)**2+TJU(2)**2+TJU(3)**2) |
| 1585 | DO 240 IU=1,3 |
| 1586 | 240 PJU(IU,5)=TJU(4)*PJU(IU,4)-TJU(1)*PJU(IU,1)-TJU(2)*PJU(IU,2)- |
| 1587 | &TJU(3)*PJU(IU,3) |
| 1588 | |
| 1589 | C...Put junction at rest if motion could give inconsistencies. |
| 1590 | IF(PJU(1,5)+PJU(2,5).GT.PJU(1,4)+PJU(2,4)) THEN |
| 1591 | DO 250 J=1,3 |
| 1592 | 250 TJU(J)=0. |
| 1593 | TJU(4)=1. |
| 1594 | PJU(1,5)=PJU(1,4) |
| 1595 | PJU(2,5)=PJU(2,4) |
| 1596 | PJU(3,5)=PJU(3,4) |
| 1597 | ENDIF |
| 1598 | |
| 1599 | C...Start preparing for fragmentation of two strings from junction. |
| 1600 | ISTA=I |
| 1601 | DO 480 IU=1,2 |
| 1602 | NS=IJU(IU+1)-IJU(IU) |
| 1603 | |
| 1604 | C...Junction strings: find longitudinal string directions. |
| 1605 | DO 270 IS=1,NS |
| 1606 | IS1=IJU(IU)+IS-1 |
| 1607 | IS2=IJU(IU)+IS |
| 1608 | DO 260 J=1,5 |
| 1609 | DP(1,J)=0.5*P(IS1,J) |
| 1610 | IF(IS.EQ.1) DP(1,J)=P(IS1,J) |
| 1611 | DP(2,J)=0.5*P(IS2,J) |
| 1612 | 260 IF(IS.EQ.NS) DP(2,J)=-PJU(IU,J) |
| 1613 | IF(IS.EQ.NS) DP(2,4)=SQRT(PJU(IU,1)**2+PJU(IU,2)**2+PJU(IU,3)**2) |
| 1614 | IF(IS.EQ.NS) DP(2,5)=0. |
| 1615 | DP(3,5)=DFOUR(1,1) |
| 1616 | DP(4,5)=DFOUR(2,2) |
| 1617 | DHKC=DFOUR(1,2) |
| 1618 | IF(DP(3,5)+2.*DHKC+DP(4,5).LE.0.) THEN |
| 1619 | DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) |
| 1620 | DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) |
| 1621 | DP(3,5)=0D0 |
| 1622 | DP(4,5)=0D0 |
| 1623 | DHKC=DFOUR(1,2) |
| 1624 | ENDIF |
| 1625 | DHKS=SQRT(DHKC**2-DP(3,5)*DP(4,5)) |
| 1626 | DHK1=0.5*((DP(4,5)+DHKC)/DHKS-1.) |
| 1627 | DHK2=0.5*((DP(3,5)+DHKC)/DHKS-1.) |
| 1628 | IN1=N+NR+4*IS-3 |
| 1629 | P(IN1,5)=SQRT(DP(3,5)+2.*DHKC+DP(4,5)) |
| 1630 | DO 270 J=1,4 |
| 1631 | P(IN1,J)=(1.+DHK1)*DP(1,J)-DHK2*DP(2,J) |
| 1632 | 270 P(IN1+1,J)=(1.+DHK2)*DP(2,J)-DHK1*DP(1,J) |
| 1633 | |
| 1634 | C...Junction strings: initialize flavour, momentum and starting pos. |
| 1635 | ISAV=I |
| 1636 | MSTU91=MSTU(90) |
| 1637 | 280 NTRY=NTRY+1 |
| 1638 | IF(NTRY.GT.100.AND.NTRYR.LE.4) THEN |
| 1639 | PARU12=4.*PARU12 |
| 1640 | PARU13=2.*PARU13 |
| 1641 | GOTO 140 |
| 1642 | ELSEIF(NTRY.GT.100) THEN |
| 1643 | CALL LUERRM(14,'(LUSTRF:) caught in infinite loop') |
| 1644 | IF(MSTU(21).GE.1) RETURN |
| 1645 | ENDIF |
| 1646 | I=ISAV |
| 1647 | MSTU(90)=MSTU91 |
| 1648 | IRANKJ=0 |
| 1649 | IE(1)=K(N+1+(JT/2)*(NP-1),3) |
| 1650 | IN(4)=N+NR+1 |
| 1651 | IN(5)=IN(4)+1 |
| 1652 | IN(6)=N+NR+4*NS+1 |
| 1653 | DO 290 JQ=1,2 |
| 1654 | DO 290 IN1=N+NR+2+JQ,N+NR+4*NS-2+JQ,4 |
| 1655 | P(IN1,1)=2-JQ |
| 1656 | P(IN1,2)=JQ-1 |
| 1657 | 290 P(IN1,3)=1. |
| 1658 | KFL(1)=K(IJU(IU),2) |
| 1659 | PX(1)=0. |
| 1660 | PY(1)=0. |
| 1661 | GAM(1)=0. |
| 1662 | DO 300 J=1,5 |
| 1663 | 300 PJU(IU+3,J)=0. |
| 1664 | |
| 1665 | C...Junction strings: find initial transverse directions. |
| 1666 | DO 310 J=1,4 |
| 1667 | DP(1,J)=P(IN(4),J) |
| 1668 | DP(2,J)=P(IN(4)+1,J) |
| 1669 | DP(3,J)=0. |
| 1670 | 310 DP(4,J)=0. |
| 1671 | DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) |
| 1672 | DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) |
| 1673 | DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4) |
| 1674 | DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4) |
| 1675 | DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4) |
| 1676 | IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1. |
| 1677 | IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1. |
| 1678 | IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1. |
| 1679 | IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1. |
| 1680 | DHC12=DFOUR(1,2) |
| 1681 | DHCX1=DFOUR(3,1)/DHC12 |
| 1682 | DHCX2=DFOUR(3,2)/DHC12 |
| 1683 | DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12) |
| 1684 | DHCY1=DFOUR(4,1)/DHC12 |
| 1685 | DHCY2=DFOUR(4,2)/DHC12 |
| 1686 | DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12 |
| 1687 | DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2) |
| 1688 | DO 320 J=1,4 |
| 1689 | DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J)) |
| 1690 | P(IN(6),J)=DP(3,J) |
| 1691 | 320 P(IN(6)+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)- |
| 1692 | &DHCYX*DP(3,J)) |
| 1693 | |
| 1694 | C...Junction strings: produce new particle, origin. |
| 1695 | 330 I=I+1 |
| 1696 | IF(2*I-NSAV.GE.MSTU(4)-MSTU(32)-5) THEN |
| 1697 | CALL LUERRM(11,'(LUSTRF:) no more memory left in LUJETS') |
| 1698 | IF(MSTU(21).GE.1) RETURN |
| 1699 | ENDIF |
| 1700 | IRANKJ=IRANKJ+1 |
| 1701 | K(I,1)=1 |
| 1702 | K(I,3)=IE(1) |
| 1703 | K(I,4)=0 |
| 1704 | K(I,5)=0 |
| 1705 | |
| 1706 | C...Junction strings: generate flavour, hadron, pT, z and Gamma. |
| 1707 | 340 CALL LUKFDI(KFL(1),0,KFL(3),K(I,2)) |
| 1708 | IF(K(I,2).EQ.0) GOTO 280 |
| 1709 | IF(MSTJ(12).GE.3.AND.IRANKJ.EQ.1.AND.IABS(KFL(1)).LE.10.AND. |
| 1710 | &IABS(KFL(3)).GT.10) THEN |
| 1711 | IF(RLU(0).GT.PARJ(19)) GOTO 340 |
| 1712 | ENDIF |
| 1713 | P(I,5)=ULMASS(K(I,2)) |
| 1714 | CALL LUPTDI(KFL(1),PX(3),PY(3)) |
| 1715 | PR(1)=P(I,5)**2+(PX(1)+PX(3))**2+(PY(1)+PY(3))**2 |
| 1716 | CALL LUZDIS(KFL(1),KFL(3),PR(1),Z) |
| 1717 | IF(IABS(KFL(1)).GE.4.AND.IABS(KFL(1)).LE.8.AND. |
| 1718 | &MSTU(90).LT.8) THEN |
| 1719 | MSTU(90)=MSTU(90)+1 |
| 1720 | MSTU(90+MSTU(90))=I |
| 1721 | PARU(90+MSTU(90))=Z |
| 1722 | ENDIF |
| 1723 | GAM(3)=(1.-Z)*(GAM(1)+PR(1)/Z) |
| 1724 | DO 350 J=1,3 |
| 1725 | 350 IN(J)=IN(3+J) |
| 1726 | |
| 1727 | C...Junction strings: stepping within or from 'low' string region easy. |
| 1728 | IF(IN(1)+1.EQ.IN(2).AND.Z*P(IN(1)+2,3)*P(IN(2)+2,3)* |
| 1729 | &P(IN(1),5)**2.GE.PR(1)) THEN |
| 1730 | P(IN(1)+2,4)=Z*P(IN(1)+2,3) |
| 1731 | P(IN(2)+2,4)=PR(1)/(P(IN(1)+2,4)*P(IN(1),5)**2) |
| 1732 | DO 360 J=1,4 |
| 1733 | 360 P(I,J)=(PX(1)+PX(3))*P(IN(3),J)+(PY(1)+PY(3))*P(IN(3)+1,J) |
| 1734 | GOTO 430 |
| 1735 | ELSEIF(IN(1)+1.EQ.IN(2)) THEN |
| 1736 | P(IN(2)+2,4)=P(IN(2)+2,3) |
| 1737 | P(IN(2)+2,1)=1. |
| 1738 | IN(2)=IN(2)+4 |
| 1739 | IF(IN(2).GT.N+NR+4*NS) GOTO 280 |
| 1740 | IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN |
| 1741 | P(IN(1)+2,4)=P(IN(1)+2,3) |
| 1742 | P(IN(1)+2,1)=0. |
| 1743 | IN(1)=IN(1)+4 |
| 1744 | ENDIF |
| 1745 | ENDIF |
| 1746 | |
| 1747 | C...Junction strings: find new transverse directions. |
| 1748 | 370 IF(IN(1).GT.N+NR+4*NS.OR.IN(2).GT.N+NR+4*NS.OR. |
| 1749 | &IN(1).GT.IN(2)) GOTO 280 |
| 1750 | IF(IN(1).NE.IN(4).OR.IN(2).NE.IN(5)) THEN |
| 1751 | DO 380 J=1,4 |
| 1752 | DP(1,J)=P(IN(1),J) |
| 1753 | DP(2,J)=P(IN(2),J) |
| 1754 | DP(3,J)=0. |
| 1755 | 380 DP(4,J)=0. |
| 1756 | DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) |
| 1757 | DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) |
| 1758 | DHC12=DFOUR(1,2) |
| 1759 | IF(DHC12.LE.1E-2) THEN |
| 1760 | P(IN(1)+2,4)=P(IN(1)+2,3) |
| 1761 | P(IN(1)+2,1)=0. |
| 1762 | IN(1)=IN(1)+4 |
| 1763 | GOTO 370 |
| 1764 | ENDIF |
| 1765 | IN(3)=N+NR+4*NS+5 |
| 1766 | DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4) |
| 1767 | DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4) |
| 1768 | DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4) |
| 1769 | IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1. |
| 1770 | IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1. |
| 1771 | IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1. |
| 1772 | IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1. |
| 1773 | DHCX1=DFOUR(3,1)/DHC12 |
| 1774 | DHCX2=DFOUR(3,2)/DHC12 |
| 1775 | DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12) |
| 1776 | DHCY1=DFOUR(4,1)/DHC12 |
| 1777 | DHCY2=DFOUR(4,2)/DHC12 |
| 1778 | DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12 |
| 1779 | DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2) |
| 1780 | DO 390 J=1,4 |
| 1781 | DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J)) |
| 1782 | P(IN(3),J)=DP(3,J) |
| 1783 | 390 P(IN(3)+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)- |
| 1784 | & DHCYX*DP(3,J)) |
| 1785 | C...Express pT with respect to new axes, if sensible. |
| 1786 | PXP=-(PX(3)*FOUR(IN(6),IN(3))+PY(3)*FOUR(IN(6)+1,IN(3))) |
| 1787 | PYP=-(PX(3)*FOUR(IN(6),IN(3)+1)+PY(3)*FOUR(IN(6)+1,IN(3)+1)) |
| 1788 | IF(ABS(PXP**2+PYP**2-PX(3)**2-PY(3)**2).LT.0.01) THEN |
| 1789 | PX(3)=PXP |
| 1790 | PY(3)=PYP |
| 1791 | ENDIF |
| 1792 | ENDIF |
| 1793 | |
| 1794 | C...Junction strings: sum up known four-momentum, coefficients for m2. |
| 1795 | DO 410 J=1,4 |
| 1796 | DHG(J)=0. |
| 1797 | P(I,J)=PX(1)*P(IN(6),J)+PY(1)*P(IN(6)+1,J)+PX(3)*P(IN(3),J)+ |
| 1798 | &PY(3)*P(IN(3)+1,J) |
| 1799 | DO 400 IN1=IN(4),IN(1)-4,4 |
| 1800 | 400 P(I,J)=P(I,J)+P(IN1+2,3)*P(IN1,J) |
| 1801 | DO 410 IN2=IN(5),IN(2)-4,4 |
| 1802 | 410 P(I,J)=P(I,J)+P(IN2+2,3)*P(IN2,J) |
| 1803 | DHM(1)=FOUR(I,I) |
| 1804 | DHM(2)=2.*FOUR(I,IN(1)) |
| 1805 | DHM(3)=2.*FOUR(I,IN(2)) |
| 1806 | DHM(4)=2.*FOUR(IN(1),IN(2)) |
| 1807 | |
| 1808 | C...Junction strings: find coefficients for Gamma expression. |
| 1809 | DO 420 IN2=IN(1)+1,IN(2),4 |
| 1810 | DO 420 IN1=IN(1),IN2-1,4 |
| 1811 | DHC=2.*FOUR(IN1,IN2) |
| 1812 | DHG(1)=DHG(1)+P(IN1+2,1)*P(IN2+2,1)*DHC |
| 1813 | IF(IN1.EQ.IN(1)) DHG(2)=DHG(2)-P(IN2+2,1)*DHC |
| 1814 | IF(IN2.EQ.IN(2)) DHG(3)=DHG(3)+P(IN1+2,1)*DHC |
| 1815 | 420 IF(IN1.EQ.IN(1).AND.IN2.EQ.IN(2)) DHG(4)=DHG(4)-DHC |
| 1816 | |
| 1817 | C...Junction strings: solve (m2, Gamma) equation system for energies. |
| 1818 | DHS1=DHM(3)*DHG(4)-DHM(4)*DHG(3) |
| 1819 | IF(ABS(DHS1).LT.1E-4) GOTO 280 |
| 1820 | DHS2=DHM(4)*(GAM(3)-DHG(1))-DHM(2)*DHG(3)-DHG(4)* |
| 1821 | &(P(I,5)**2-DHM(1))+DHG(2)*DHM(3) |
| 1822 | DHS3=DHM(2)*(GAM(3)-DHG(1))-DHG(2)*(P(I,5)**2-DHM(1)) |
| 1823 | P(IN(2)+2,4)=0.5*(SQRT(MAX(0D0,DHS2**2-4.*DHS1*DHS3))/ABS(DHS1)- |
| 1824 | &DHS2/DHS1) |
| 1825 | IF(DHM(2)+DHM(4)*P(IN(2)+2,4).LE.0.) GOTO 280 |
| 1826 | P(IN(1)+2,4)=(P(I,5)**2-DHM(1)-DHM(3)*P(IN(2)+2,4))/ |
| 1827 | &(DHM(2)+DHM(4)*P(IN(2)+2,4)) |
| 1828 | |
| 1829 | C...Junction strings: step to new region if necessary. |
| 1830 | IF(P(IN(2)+2,4).GT.P(IN(2)+2,3)) THEN |
| 1831 | P(IN(2)+2,4)=P(IN(2)+2,3) |
| 1832 | P(IN(2)+2,1)=1. |
| 1833 | IN(2)=IN(2)+4 |
| 1834 | IF(IN(2).GT.N+NR+4*NS) GOTO 280 |
| 1835 | IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN |
| 1836 | P(IN(1)+2,4)=P(IN(1)+2,3) |
| 1837 | P(IN(1)+2,1)=0. |
| 1838 | IN(1)=IN(1)+4 |
| 1839 | ENDIF |
| 1840 | GOTO 370 |
| 1841 | ELSEIF(P(IN(1)+2,4).GT.P(IN(1)+2,3)) THEN |
| 1842 | P(IN(1)+2,4)=P(IN(1)+2,3) |
| 1843 | P(IN(1)+2,1)=0. |
| 1844 | IN(1)=IN(1)+JS |
| 1845 | GOTO 720 |
| 1846 | ENDIF |
| 1847 | |
| 1848 | C...Junction strings: particle four-momentum, remainder, loop back. |
| 1849 | 430 DO 440 J=1,4 |
| 1850 | P(I,J)=P(I,J)+P(IN(1)+2,4)*P(IN(1),J)+P(IN(2)+2,4)*P(IN(2),J) |
| 1851 | 440 PJU(IU+3,J)=PJU(IU+3,J)+P(I,J) |
| 1852 | IF(P(I,4).LT.P(I,5)) GOTO 280 |
| 1853 | PJU(IU+3,5)=TJU(4)*PJU(IU+3,4)-TJU(1)*PJU(IU+3,1)- |
| 1854 | &TJU(2)*PJU(IU+3,2)-TJU(3)*PJU(IU+3,3) |
| 1855 | IF(PJU(IU+3,5).LT.PJU(IU,5)) THEN |
| 1856 | KFL(1)=-KFL(3) |
| 1857 | PX(1)=-PX(3) |
| 1858 | PY(1)=-PY(3) |
| 1859 | GAM(1)=GAM(3) |
| 1860 | IF(IN(3).NE.IN(6)) THEN |
| 1861 | DO 450 J=1,4 |
| 1862 | P(IN(6),J)=P(IN(3),J) |
| 1863 | 450 P(IN(6)+1,J)=P(IN(3)+1,J) |
| 1864 | ENDIF |
| 1865 | DO 460 JQ=1,2 |
| 1866 | IN(3+JQ)=IN(JQ) |
| 1867 | P(IN(JQ)+2,3)=P(IN(JQ)+2,3)-P(IN(JQ)+2,4) |
| 1868 | 460 P(IN(JQ)+2,1)=P(IN(JQ)+2,1)-(3-2*JQ)*P(IN(JQ)+2,4) |
| 1869 | GOTO 330 |
| 1870 | ENDIF |
| 1871 | |
| 1872 | C...Junction strings: save quantities left after each string. |
| 1873 | IF(IABS(KFL(1)).GT.10) GOTO 280 |
| 1874 | I=I-1 |
| 1875 | KFJH(IU)=KFL(1) |
| 1876 | DO 470 J=1,4 |
| 1877 | 470 PJU(IU+3,J)=PJU(IU+3,J)-P(I+1,J) |
| 1878 | 480 CONTINUE |
| 1879 | |
| 1880 | C...Junction strings: put together to new effective string endpoint. |
| 1881 | NJS(JT)=I-ISTA |
| 1882 | KFJS(JT)=K(K(MJU(JT+2),3),2) |
| 1883 | KFLS=2*INT(RLU(0)+3.*PARJ(4)/(1.+3.*PARJ(4)))+1 |
| 1884 | IF(KFJH(1).EQ.KFJH(2)) KFLS=3 |
| 1885 | IF(ISTA.NE.I) KFJS(JT)=ISIGN(1000*MAX(IABS(KFJH(1)), |
| 1886 | &IABS(KFJH(2)))+100*MIN(IABS(KFJH(1)),IABS(KFJH(2)))+ |
| 1887 | &KFLS,KFJH(1)) |
| 1888 | DO 490 J=1,4 |
| 1889 | PJS(JT,J)=PJU(1,J)+PJU(2,J)+P(MJU(JT),J) |
| 1890 | 490 PJS(JT+2,J)=PJU(4,J)+PJU(5,J) |
| 1891 | PJS(JT,5)=SQRT(MAX(0.,PJS(JT,4)**2-PJS(JT,1)**2-PJS(JT,2)**2- |
| 1892 | &PJS(JT,3)**2)) |
| 1893 | 500 CONTINUE |
| 1894 | |
| 1895 | C...Open versus closed strings. Choose breakup region for latter. |
| 1896 | 510 IF(MJU(1).NE.0.AND.MJU(2).NE.0) THEN |
| 1897 | NS=MJU(2)-MJU(1) |
| 1898 | NB=MJU(1)-N |
| 1899 | ELSEIF(MJU(1).NE.0) THEN |
| 1900 | NS=N+NR-MJU(1) |
| 1901 | NB=MJU(1)-N |
| 1902 | ELSEIF(MJU(2).NE.0) THEN |
| 1903 | NS=MJU(2)-N |
| 1904 | NB=1 |
| 1905 | ELSEIF(IABS(K(N+1,2)).NE.21) THEN |
| 1906 | NS=NR-1 |
| 1907 | NB=1 |
| 1908 | ELSE |
| 1909 | NS=NR+1 |
| 1910 | W2SUM=0. |
| 1911 | DO 520 IS=1,NR |
| 1912 | P(N+NR+IS,1)=0.5*FOUR(N+IS,N+IS+1-NR*(IS/NR)) |
| 1913 | 520 W2SUM=W2SUM+P(N+NR+IS,1) |
| 1914 | W2RAN=RLU(0)*W2SUM |
| 1915 | NB=0 |
| 1916 | 530 NB=NB+1 |
| 1917 | W2SUM=W2SUM-P(N+NR+NB,1) |
| 1918 | IF(W2SUM.GT.W2RAN.AND.NB.LT.NR) GOTO 530 |
| 1919 | ENDIF |
| 1920 | |
| 1921 | C...Find longitudinal string directions (i.e. lightlike four-vectors). |
| 1922 | DO 550 IS=1,NS |
| 1923 | IS1=N+IS+NB-1-NR*((IS+NB-2)/NR) |
| 1924 | IS2=N+IS+NB-NR*((IS+NB-1)/NR) |
| 1925 | DO 540 J=1,5 |
| 1926 | DP(1,J)=P(IS1,J) |
| 1927 | IF(IABS(K(IS1,2)).EQ.21) DP(1,J)=0.5*DP(1,J) |
| 1928 | IF(IS1.EQ.MJU(1)) DP(1,J)=PJS(1,J)-PJS(3,J) |
| 1929 | DP(2,J)=P(IS2,J) |
| 1930 | IF(IABS(K(IS2,2)).EQ.21) DP(2,J)=0.5*DP(2,J) |
| 1931 | 540 IF(IS2.EQ.MJU(2)) DP(2,J)=PJS(2,J)-PJS(4,J) |
| 1932 | DP(3,5)=DFOUR(1,1) |
| 1933 | DP(4,5)=DFOUR(2,2) |
| 1934 | DHKC=DFOUR(1,2) |
| 1935 | IF(DP(3,5)+2.*DHKC+DP(4,5).LE.0.) THEN |
| 1936 | DP(3,5)=DP(1,5)**2 |
| 1937 | DP(4,5)=DP(2,5)**2 |
| 1938 | DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2+DP(1,5)**2) |
| 1939 | DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2+DP(2,5)**2) |
| 1940 | DHKC=DFOUR(1,2) |
| 1941 | ENDIF |
| 1942 | DHKS=SQRT(DHKC**2-DP(3,5)*DP(4,5)) |
| 1943 | DHK1=0.5*((DP(4,5)+DHKC)/DHKS-1.) |
| 1944 | DHK2=0.5*((DP(3,5)+DHKC)/DHKS-1.) |
| 1945 | IN1=N+NR+4*IS-3 |
| 1946 | P(IN1,5)=SQRT(DP(3,5)+2.*DHKC+DP(4,5)) |
| 1947 | DO 550 J=1,4 |
| 1948 | P(IN1,J)=(1.+DHK1)*DP(1,J)-DHK2*DP(2,J) |
| 1949 | 550 P(IN1+1,J)=(1.+DHK2)*DP(2,J)-DHK1*DP(1,J) |
| 1950 | |
| 1951 | C...Begin initialization: sum up energy, set starting position. |
| 1952 | ISAV=I |
| 1953 | MSTU91=MSTU(90) |
| 1954 | 560 NTRY=NTRY+1 |
| 1955 | IF(NTRY.GT.100.AND.NTRYR.LE.4) THEN |
| 1956 | PARU12=4.*PARU12 |
| 1957 | PARU13=2.*PARU13 |
| 1958 | GOTO 140 |
| 1959 | ELSEIF(NTRY.GT.100) THEN |
| 1960 | CALL LUERRM(14,'(LUSTRF:) caught in infinite loop') |
| 1961 | IF(MSTU(21).GE.1) RETURN |
| 1962 | ENDIF |
| 1963 | I=ISAV |
| 1964 | MSTU(90)=MSTU91 |
| 1965 | DO 570 J=1,4 |
| 1966 | P(N+NRS,J)=0. |
| 1967 | DO 570 IS=1,NR |
| 1968 | 570 P(N+NRS,J)=P(N+NRS,J)+P(N+IS,J) |
| 1969 | DO 580 JT=1,2 |
| 1970 | IRANK(JT)=0 |
| 1971 | IF(MJU(JT).NE.0) IRANK(JT)=NJS(JT) |
| 1972 | IF(NS.GT.NR) IRANK(JT)=1 |
| 1973 | IE(JT)=K(N+1+(JT/2)*(NP-1),3) |
| 1974 | IN(3*JT+1)=N+NR+1+4*(JT/2)*(NS-1) |
| 1975 | IN(3*JT+2)=IN(3*JT+1)+1 |
| 1976 | IN(3*JT+3)=N+NR+4*NS+2*JT-1 |
| 1977 | DO 580 IN1=N+NR+2+JT,N+NR+4*NS-2+JT,4 |
| 1978 | P(IN1,1)=2-JT |
| 1979 | P(IN1,2)=JT-1 |
| 1980 | 580 P(IN1,3)=1. |
| 1981 | |
| 1982 | C...Initialize flavour and pT variables for open string. |
| 1983 | IF(NS.LT.NR) THEN |
| 1984 | PX(1)=0. |
| 1985 | PY(1)=0. |
| 1986 | IF(NS.EQ.1.AND.MJU(1)+MJU(2).EQ.0) CALL LUPTDI(0,PX(1),PY(1)) |
| 1987 | PX(2)=-PX(1) |
| 1988 | PY(2)=-PY(1) |
| 1989 | DO 590 JT=1,2 |
| 1990 | KFL(JT)=K(IE(JT),2) |
| 1991 | IF(MJU(JT).NE.0) KFL(JT)=KFJS(JT) |
| 1992 | MSTJ(93)=1 |
| 1993 | PMQ(JT)=ULMASS(KFL(JT)) |
| 1994 | 590 GAM(JT)=0. |
| 1995 | |
| 1996 | C...Closed string: random initial breakup flavour, pT and vertex. |
| 1997 | ELSE |
| 1998 | KFL(3)=INT(1.+(2.+PARJ(2))*RLU(0))*(-1)**INT(RLU(0)+0.5) |
| 1999 | CALL LUKFDI(KFL(3),0,KFL(1),KDUMP) |
| 2000 | KFL(2)=-KFL(1) |
| 2001 | IF(IABS(KFL(1)).GT.10.AND.RLU(0).GT.0.5) THEN |
| 2002 | KFL(2)=-(KFL(1)+ISIGN(10000,KFL(1))) |
| 2003 | ELSEIF(IABS(KFL(1)).GT.10) THEN |
| 2004 | KFL(1)=-(KFL(2)+ISIGN(10000,KFL(2))) |
| 2005 | ENDIF |
| 2006 | CALL LUPTDI(KFL(1),PX(1),PY(1)) |
| 2007 | PX(2)=-PX(1) |
| 2008 | PY(2)=-PY(1) |
| 2009 | PR3=MIN(25.,0.1*P(N+NR+1,5)**2) |
| 2010 | 600 CALL LUZDIS(KFL(1),KFL(2),PR3,Z) |
| 2011 | ZR=PR3/(Z*P(N+NR+1,5)**2) |
| 2012 | IF(ZR.GE.1.) GOTO 600 |
| 2013 | DO 610 JT=1,2 |
| 2014 | MSTJ(93)=1 |
| 2015 | PMQ(JT)=ULMASS(KFL(JT)) |
| 2016 | GAM(JT)=PR3*(1.-Z)/Z |
| 2017 | IN1=N+NR+3+4*(JT/2)*(NS-1) |
| 2018 | P(IN1,JT)=1.-Z |
| 2019 | P(IN1,3-JT)=JT-1 |
| 2020 | P(IN1,3)=(2-JT)*(1.-Z)+(JT-1)*Z |
| 2021 | P(IN1+1,JT)=ZR |
| 2022 | P(IN1+1,3-JT)=2-JT |
| 2023 | 610 P(IN1+1,3)=(2-JT)*(1.-ZR)+(JT-1)*ZR |
| 2024 | ENDIF |
| 2025 | |
| 2026 | C...Find initial transverse directions (i.e. spacelike four-vectors). |
| 2027 | DO 650 JT=1,2 |
| 2028 | IF(JT.EQ.1.OR.NS.EQ.NR-1) THEN |
| 2029 | IN1=IN(3*JT+1) |
| 2030 | IN3=IN(3*JT+3) |
| 2031 | DO 620 J=1,4 |
| 2032 | DP(1,J)=P(IN1,J) |
| 2033 | DP(2,J)=P(IN1+1,J) |
| 2034 | DP(3,J)=0. |
| 2035 | 620 DP(4,J)=0. |
| 2036 | DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) |
| 2037 | DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) |
| 2038 | DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4) |
| 2039 | DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4) |
| 2040 | DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4) |
| 2041 | IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1. |
| 2042 | IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1. |
| 2043 | IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1. |
| 2044 | IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1. |
| 2045 | DHC12=DFOUR(1,2) |
| 2046 | DHCX1=DFOUR(3,1)/DHC12 |
| 2047 | DHCX2=DFOUR(3,2)/DHC12 |
| 2048 | DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12) |
| 2049 | DHCY1=DFOUR(4,1)/DHC12 |
| 2050 | DHCY2=DFOUR(4,2)/DHC12 |
| 2051 | DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12 |
| 2052 | DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2) |
| 2053 | DO 630 J=1,4 |
| 2054 | DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J)) |
| 2055 | P(IN3,J)=DP(3,J) |
| 2056 | 630 P(IN3+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)- |
| 2057 | & DHCYX*DP(3,J)) |
| 2058 | ELSE |
| 2059 | DO 640 J=1,4 |
| 2060 | P(IN3+2,J)=P(IN3,J) |
| 2061 | 640 P(IN3+3,J)=P(IN3+1,J) |
| 2062 | ENDIF |
| 2063 | 650 CONTINUE |
| 2064 | |
| 2065 | C...Remove energy used up in junction string fragmentation. |
| 2066 | IF(MJU(1)+MJU(2).GT.0) THEN |
| 2067 | DO 670 JT=1,2 |
| 2068 | IF(NJS(JT).EQ.0) GOTO 670 |
| 2069 | DO 660 J=1,4 |
| 2070 | 660 P(N+NRS,J)=P(N+NRS,J)-PJS(JT+2,J) |
| 2071 | 670 CONTINUE |
| 2072 | ENDIF |
| 2073 | |
| 2074 | C...Produce new particle: side, origin. |
| 2075 | 680 I=I+1 |
| 2076 | IF(2*I-NSAV.GE.MSTU(4)-MSTU(32)-5) THEN |
| 2077 | CALL LUERRM(11,'(LUSTRF:) no more memory left in LUJETS') |
| 2078 | IF(MSTU(21).GE.1) RETURN |
| 2079 | ENDIF |
| 2080 | JT=1.5+RLU(0) |
| 2081 | IF(IABS(KFL(3-JT)).GT.10) JT=3-JT |
| 2082 | IF(IABS(KFL(3-JT)).GE.4.AND.IABS(KFL(3-JT)).LE.8) JT=3-JT |
| 2083 | JR=3-JT |
| 2084 | JS=3-2*JT |
| 2085 | IRANK(JT)=IRANK(JT)+1 |
| 2086 | K(I,1)=1 |
| 2087 | K(I,3)=IE(JT) |
| 2088 | K(I,4)=0 |
| 2089 | K(I,5)=0 |
| 2090 | |
| 2091 | C...Generate flavour, hadron and pT. |
| 2092 | 690 CALL LUKFDI(KFL(JT),0,KFL(3),K(I,2)) |
| 2093 | IF(K(I,2).EQ.0) GOTO 560 |
| 2094 | IF(MSTJ(12).GE.3.AND.IRANK(JT).EQ.1.AND.IABS(KFL(JT)).LE.10.AND. |
| 2095 | &IABS(KFL(3)).GT.10) THEN |
| 2096 | IF(RLU(0).GT.PARJ(19)) GOTO 690 |
| 2097 | ENDIF |
| 2098 | P(I,5)=ULMASS(K(I,2)) |
| 2099 | CALL LUPTDI(KFL(JT),PX(3),PY(3)) |
| 2100 | PR(JT)=P(I,5)**2+(PX(JT)+PX(3))**2+(PY(JT)+PY(3))**2 |
| 2101 | |
| 2102 | C...Final hadrons for small invariant mass. |
| 2103 | MSTJ(93)=1 |
| 2104 | PMQ(3)=ULMASS(KFL(3)) |
| 2105 | PARJST=PARJ(33) |
| 2106 | IF(MSTJ(11).EQ.2) PARJST=PARJ(34) |
| 2107 | WMIN=PARJST+PMQ(1)+PMQ(2)+PARJ(36)*PMQ(3) |
| 2108 | IF(IABS(KFL(JT)).GT.10.AND.IABS(KFL(3)).GT.10) WMIN= |
| 2109 | &WMIN-0.5*PARJ(36)*PMQ(3) |
| 2110 | WREM2=FOUR(N+NRS,N+NRS) |
| 2111 | IF(WREM2.LT.0.10) GOTO 560 |
| 2112 | IF(WREM2.LT.MAX(WMIN*(1.+(2.*RLU(0)-1.)*PARJ(37)), |
| 2113 | &PARJ(32)+PMQ(1)+PMQ(2))**2) GOTO 820 |
| 2114 | |
| 2115 | C...Choose z, which gives Gamma. Shift z for heavy flavours. |
| 2116 | CALL LUZDIS(KFL(JT),KFL(3),PR(JT),Z) |
| 2117 | IF(IABS(KFL(JT)).GE.4.AND.IABS(KFL(JT)).LE.8.AND. |
| 2118 | &MSTU(90).LT.8) THEN |
| 2119 | MSTU(90)=MSTU(90)+1 |
| 2120 | MSTU(90+MSTU(90))=I |
| 2121 | PARU(90+MSTU(90))=Z |
| 2122 | ENDIF |
| 2123 | KFL1A=IABS(KFL(1)) |
| 2124 | KFL2A=IABS(KFL(2)) |
| 2125 | IF(MAX(MOD(KFL1A,10),MOD(KFL1A/1000,10),MOD(KFL2A,10), |
| 2126 | &MOD(KFL2A/1000,10)).GE.4) THEN |
| 2127 | PR(JR)=(PMQ(JR)+PMQ(3))**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2 |
| 2128 | PW12=SQRT(MAX(0.,(WREM2-PR(1)-PR(2))**2-4.*PR(1)*PR(2))) |
| 2129 | Z=(WREM2+PR(JT)-PR(JR)+PW12*(2.*Z-1.))/(2.*WREM2) |
| 2130 | PR(JR)=(PMQ(JR)+PARJST)**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2 |
| 2131 | IF((1.-Z)*(WREM2-PR(JT)/Z).LT.PR(JR)) GOTO 820 |
| 2132 | ENDIF |
| 2133 | GAM(3)=(1.-Z)*(GAM(JT)+PR(JT)/Z) |
| 2134 | DO 700 J=1,3 |
| 2135 | 700 IN(J)=IN(3*JT+J) |
| 2136 | |
| 2137 | C...Stepping within or from 'low' string region easy. |
| 2138 | IF(IN(1)+1.EQ.IN(2).AND.Z*P(IN(1)+2,3)*P(IN(2)+2,3)* |
| 2139 | &P(IN(1),5)**2.GE.PR(JT)) THEN |
| 2140 | P(IN(JT)+2,4)=Z*P(IN(JT)+2,3) |
| 2141 | P(IN(JR)+2,4)=PR(JT)/(P(IN(JT)+2,4)*P(IN(1),5)**2) |
| 2142 | DO 710 J=1,4 |
| 2143 | 710 P(I,J)=(PX(JT)+PX(3))*P(IN(3),J)+(PY(JT)+PY(3))*P(IN(3)+1,J) |
| 2144 | GOTO 780 |
| 2145 | ELSEIF(IN(1)+1.EQ.IN(2)) THEN |
| 2146 | P(IN(JR)+2,4)=P(IN(JR)+2,3) |
| 2147 | P(IN(JR)+2,JT)=1. |
| 2148 | IN(JR)=IN(JR)+4*JS |
| 2149 | IF(JS*IN(JR).GT.JS*IN(4*JR)) GOTO 560 |
| 2150 | IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN |
| 2151 | P(IN(JT)+2,4)=P(IN(JT)+2,3) |
| 2152 | P(IN(JT)+2,JT)=0. |
| 2153 | IN(JT)=IN(JT)+4*JS |
| 2154 | ENDIF |
| 2155 | ENDIF |
| 2156 | |
| 2157 | C...Find new transverse directions (i.e. spacelike string vectors). |
| 2158 | 720 IF(JS*IN(1).GT.JS*IN(3*JR+1).OR.JS*IN(2).GT.JS*IN(3*JR+2).OR. |
| 2159 | &IN(1).GT.IN(2)) GOTO 560 |
| 2160 | IF(IN(1).NE.IN(3*JT+1).OR.IN(2).NE.IN(3*JT+2)) THEN |
| 2161 | DO 730 J=1,4 |
| 2162 | DP(1,J)=P(IN(1),J) |
| 2163 | DP(2,J)=P(IN(2),J) |
| 2164 | DP(3,J)=0. |
| 2165 | 730 DP(4,J)=0. |
| 2166 | DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2) |
| 2167 | DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2) |
| 2168 | DHC12=DFOUR(1,2) |
| 2169 | IF(DHC12.LE.1E-2) THEN |
| 2170 | P(IN(JT)+2,4)=P(IN(JT)+2,3) |
| 2171 | P(IN(JT)+2,JT)=0. |
| 2172 | IN(JT)=IN(JT)+4*JS |
| 2173 | GOTO 720 |
| 2174 | ENDIF |
| 2175 | IN(3)=N+NR+4*NS+5 |
| 2176 | DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4) |
| 2177 | DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4) |
| 2178 | DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4) |
| 2179 | IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1. |
| 2180 | IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1. |
| 2181 | IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1. |
| 2182 | IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1. |
| 2183 | DHCX1=DFOUR(3,1)/DHC12 |
| 2184 | DHCX2=DFOUR(3,2)/DHC12 |
| 2185 | DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12) |
| 2186 | DHCY1=DFOUR(4,1)/DHC12 |
| 2187 | DHCY2=DFOUR(4,2)/DHC12 |
| 2188 | DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12 |
| 2189 | DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2) |
| 2190 | DO 740 J=1,4 |
| 2191 | DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J)) |
| 2192 | P(IN(3),J)=DP(3,J) |
| 2193 | 740 P(IN(3)+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)- |
| 2194 | & DHCYX*DP(3,J)) |
| 2195 | C...Express pT with respect to new axes, if sensible. |
| 2196 | PXP=-(PX(3)*FOUR(IN(3*JT+3),IN(3))+PY(3)* |
| 2197 | & FOUR(IN(3*JT+3)+1,IN(3))) |
| 2198 | PYP=-(PX(3)*FOUR(IN(3*JT+3),IN(3)+1)+PY(3)* |
| 2199 | & FOUR(IN(3*JT+3)+1,IN(3)+1)) |
| 2200 | IF(ABS(PXP**2+PYP**2-PX(3)**2-PY(3)**2).LT.0.01) THEN |
| 2201 | PX(3)=PXP |
| 2202 | PY(3)=PYP |
| 2203 | ENDIF |
| 2204 | ENDIF |
| 2205 | |
| 2206 | C...Sum up known four-momentum. Gives coefficients for m2 expression. |
| 2207 | DO 760 J=1,4 |
| 2208 | DHG(J)=0. |
| 2209 | P(I,J)=PX(JT)*P(IN(3*JT+3),J)+PY(JT)*P(IN(3*JT+3)+1,J)+ |
| 2210 | &PX(3)*P(IN(3),J)+PY(3)*P(IN(3)+1,J) |
| 2211 | DO 750 IN1=IN(3*JT+1),IN(1)-4*JS,4*JS |
| 2212 | 750 P(I,J)=P(I,J)+P(IN1+2,3)*P(IN1,J) |
| 2213 | DO 760 IN2=IN(3*JT+2),IN(2)-4*JS,4*JS |
| 2214 | 760 P(I,J)=P(I,J)+P(IN2+2,3)*P(IN2,J) |
| 2215 | DHM(1)=FOUR(I,I) |
| 2216 | DHM(2)=2.*FOUR(I,IN(1)) |
| 2217 | DHM(3)=2.*FOUR(I,IN(2)) |
| 2218 | DHM(4)=2.*FOUR(IN(1),IN(2)) |
| 2219 | |
| 2220 | C...Find coefficients for Gamma expression. |
| 2221 | DO 770 IN2=IN(1)+1,IN(2),4 |
| 2222 | DO 770 IN1=IN(1),IN2-1,4 |
| 2223 | DHC=2.*FOUR(IN1,IN2) |
| 2224 | DHG(1)=DHG(1)+P(IN1+2,JT)*P(IN2+2,JT)*DHC |
| 2225 | IF(IN1.EQ.IN(1)) DHG(2)=DHG(2)-JS*P(IN2+2,JT)*DHC |
| 2226 | IF(IN2.EQ.IN(2)) DHG(3)=DHG(3)+JS*P(IN1+2,JT)*DHC |
| 2227 | 770 IF(IN1.EQ.IN(1).AND.IN2.EQ.IN(2)) DHG(4)=DHG(4)-DHC |
| 2228 | |
| 2229 | C...Solve (m2, Gamma) equation system for energies taken. |
| 2230 | DHS1=DHM(JR+1)*DHG(4)-DHM(4)*DHG(JR+1) |
| 2231 | IF(ABS(DHS1).LT.1E-4) GOTO 560 |
| 2232 | DHS2=DHM(4)*(GAM(3)-DHG(1))-DHM(JT+1)*DHG(JR+1)-DHG(4)* |
| 2233 | &(P(I,5)**2-DHM(1))+DHG(JT+1)*DHM(JR+1) |
| 2234 | DHS3=DHM(JT+1)*(GAM(3)-DHG(1))-DHG(JT+1)*(P(I,5)**2-DHM(1)) |
| 2235 | P(IN(JR)+2,4)=0.5*(SQRT(MAX(0D0,DHS2**2-4.*DHS1*DHS3))/ABS(DHS1)- |
| 2236 | &DHS2/DHS1) |
| 2237 | IF(DHM(JT+1)+DHM(4)*P(IN(JR)+2,4).LE.0.) GOTO 560 |
| 2238 | P(IN(JT)+2,4)=(P(I,5)**2-DHM(1)-DHM(JR+1)*P(IN(JR)+2,4))/ |
| 2239 | &(DHM(JT+1)+DHM(4)*P(IN(JR)+2,4)) |
| 2240 | |
| 2241 | C...Step to new region if necessary. |
| 2242 | IF(P(IN(JR)+2,4).GT.P(IN(JR)+2,3)) THEN |
| 2243 | P(IN(JR)+2,4)=P(IN(JR)+2,3) |
| 2244 | P(IN(JR)+2,JT)=1. |
| 2245 | IN(JR)=IN(JR)+4*JS |
| 2246 | IF(JS*IN(JR).GT.JS*IN(4*JR)) GOTO 560 |
| 2247 | IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN |
| 2248 | P(IN(JT)+2,4)=P(IN(JT)+2,3) |
| 2249 | P(IN(JT)+2,JT)=0. |
| 2250 | IN(JT)=IN(JT)+4*JS |
| 2251 | ENDIF |
| 2252 | GOTO 720 |
| 2253 | ELSEIF(P(IN(JT)+2,4).GT.P(IN(JT)+2,3)) THEN |
| 2254 | P(IN(JT)+2,4)=P(IN(JT)+2,3) |
| 2255 | P(IN(JT)+2,JT)=0. |
| 2256 | IN(JT)=IN(JT)+4*JS |
| 2257 | GOTO 720 |
| 2258 | ENDIF |
| 2259 | |
| 2260 | C...Four-momentum of particle. Remaining quantities. Loop back. |
| 2261 | 780 DO 790 J=1,4 |
| 2262 | P(I,J)=P(I,J)+P(IN(1)+2,4)*P(IN(1),J)+P(IN(2)+2,4)*P(IN(2),J) |
| 2263 | 790 P(N+NRS,J)=P(N+NRS,J)-P(I,J) |
| 2264 | IF(P(I,4).LT.P(I,5)) GOTO 560 |
| 2265 | KFL(JT)=-KFL(3) |
| 2266 | PMQ(JT)=PMQ(3) |
| 2267 | PX(JT)=-PX(3) |
| 2268 | PY(JT)=-PY(3) |
| 2269 | GAM(JT)=GAM(3) |
| 2270 | IF(IN(3).NE.IN(3*JT+3)) THEN |
| 2271 | DO 800 J=1,4 |
| 2272 | P(IN(3*JT+3),J)=P(IN(3),J) |
| 2273 | 800 P(IN(3*JT+3)+1,J)=P(IN(3)+1,J) |
| 2274 | ENDIF |
| 2275 | DO 810 JQ=1,2 |
| 2276 | IN(3*JT+JQ)=IN(JQ) |
| 2277 | P(IN(JQ)+2,3)=P(IN(JQ)+2,3)-P(IN(JQ)+2,4) |
| 2278 | 810 P(IN(JQ)+2,JT)=P(IN(JQ)+2,JT)-JS*(3-2*JQ)*P(IN(JQ)+2,4) |
| 2279 | GOTO 680 |
| 2280 | |
| 2281 | C...Final hadron: side, flavour, hadron, mass. |
| 2282 | 820 I=I+1 |
| 2283 | K(I,1)=1 |
| 2284 | K(I,3)=IE(JR) |
| 2285 | K(I,4)=0 |
| 2286 | K(I,5)=0 |
| 2287 | CALL LUKFDI(KFL(JR),-KFL(3),KFLDMP,K(I,2)) |
| 2288 | IF(K(I,2).EQ.0) GOTO 560 |
| 2289 | P(I,5)=ULMASS(K(I,2)) |
| 2290 | PR(JR)=P(I,5)**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2 |
| 2291 | |
| 2292 | C...Final two hadrons: find common setup of four-vectors. |
| 2293 | JQ=1 |
| 2294 | IF(P(IN(4)+2,3)*P(IN(5)+2,3)*FOUR(IN(4),IN(5)).LT.P(IN(7),3)* |
| 2295 | &P(IN(8),3)*FOUR(IN(7),IN(8))) JQ=2 |
| 2296 | DHC12=FOUR(IN(3*JQ+1),IN(3*JQ+2)) |
| 2297 | DHR1=FOUR(N+NRS,IN(3*JQ+2))/DHC12 |
| 2298 | DHR2=FOUR(N+NRS,IN(3*JQ+1))/DHC12 |
| 2299 | IF(IN(4).NE.IN(7).OR.IN(5).NE.IN(8)) THEN |
| 2300 | PX(3-JQ)=-FOUR(N+NRS,IN(3*JQ+3))-PX(JQ) |
| 2301 | PY(3-JQ)=-FOUR(N+NRS,IN(3*JQ+3)+1)-PY(JQ) |
| 2302 | PR(3-JQ)=P(I+(JT+JQ-3)**2-1,5)**2+(PX(3-JQ)+(2*JQ-3)*JS* |
| 2303 | & PX(3))**2+(PY(3-JQ)+(2*JQ-3)*JS*PY(3))**2 |
| 2304 | ENDIF |
| 2305 | |
| 2306 | C...Solve kinematics for final two hadrons, if possible. |
| 2307 | WREM2=WREM2+(PX(1)+PX(2))**2+(PY(1)+PY(2))**2 |
| 2308 | FD=(SQRT(PR(1))+SQRT(PR(2)))/SQRT(WREM2) |
| 2309 | IF(MJU(1)+MJU(2).NE.0.AND.I.EQ.ISAV+2.AND.FD.GE.1.) GOTO 190 |
| 2310 | IF(FD.GE.1.) GOTO 560 |
| 2311 | FA=WREM2+PR(JT)-PR(JR) |
| 2312 | IF(MSTJ(11).NE.2) PREV=0.5*EXP(MAX(-80.,LOG(FD)*PARJ(38)* |
| 2313 | &(PR(1)+PR(2))**2)) |
| 2314 | IF(MSTJ(11).EQ.2) PREV=0.5*FD**PARJ(39) |
| 2315 | FB=SIGN(SQRT(MAX(0.,FA**2-4.*WREM2*PR(JT))),JS*(RLU(0)-PREV)) |
| 2316 | KFL1A=IABS(KFL(1)) |
| 2317 | KFL2A=IABS(KFL(2)) |
| 2318 | IF(MAX(MOD(KFL1A,10),MOD(KFL1A/1000,10),MOD(KFL2A,10), |
| 2319 | &MOD(KFL2A/1000,10)).GE.6) FB=SIGN(SQRT(MAX(0.,FA**2- |
| 2320 | &4.*WREM2*PR(JT))),FLOAT(JS)) |
| 2321 | DO 830 J=1,4 |
| 2322 | P(I-1,J)=(PX(JT)+PX(3))*P(IN(3*JQ+3),J)+(PY(JT)+PY(3))* |
| 2323 | &P(IN(3*JQ+3)+1,J)+0.5*(DHR1*(FA+FB)*P(IN(3*JQ+1),J)+ |
| 2324 | &DHR2*(FA-FB)*P(IN(3*JQ+2),J))/WREM2 |
| 2325 | 830 P(I,J)=P(N+NRS,J)-P(I-1,J) |
| 2326 | IF(P(I-1,4).LT.P(I-1,5).OR.P(I,4).LT.P(I,5)) GOTO 560 |
| 2327 | C...Mark jets as fragmented and give daughter pointers. |
| 2328 | N=I-NRS+1 |
| 2329 | DO 840 I=NSAV+1,NSAV+NP |
| 2330 | IM=K(I,3) |
| 2331 | K(IM,1)=K(IM,1)+10 |
| 2332 | IF(MSTU(16).NE.2) THEN |
| 2333 | K(IM,4)=NSAV+1 |
| 2334 | K(IM,5)=NSAV+1 |
| 2335 | ELSE |
| 2336 | K(IM,4)=NSAV+2 |
| 2337 | K(IM,5)=N |
| 2338 | ENDIF |
| 2339 | 840 CONTINUE |
| 2340 | |
| 2341 | C...Document string system. Move up particles. |
| 2342 | NSAV=NSAV+1 |
| 2343 | K(NSAV,1)=11 |
| 2344 | K(NSAV,2)=92 |
| 2345 | K(NSAV,3)=IP |
| 2346 | K(NSAV,4)=NSAV+1 |
| 2347 | K(NSAV,5)=N |
| 2348 | DO 850 J=1,4 |
| 2349 | P(NSAV,J)=DPS(J) |
| 2350 | 850 V(NSAV,J)=V(IP,J) |
| 2351 | P(NSAV,5)=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2)) |
| 2352 | V(NSAV,5)=0. |
| 2353 | DO 860 I=NSAV+1,N |
| 2354 | DO 860 J=1,5 |
| 2355 | K(I,J)=K(I+NRS-1,J) |
| 2356 | P(I,J)=P(I+NRS-1,J) |
| 2357 | 860 V(I,J)=0. |
| 2358 | MSTU91=MSTU(90) |
| 2359 | DO 870 IZ=MSTU90+1,MSTU91 |
| 2360 | MSTU9T(IZ)=MSTU(90+IZ)-NRS+1-NSAV+N |
| 2361 | 870 PARU9T(IZ)=PARU(90+IZ) |
| 2362 | MSTU(90)=MSTU90 |
| 2363 | |
| 2364 | C...Order particles in rank along the chain. Update mother pointer. |
| 2365 | DO 880 I=NSAV+1,N |
| 2366 | DO 880 J=1,5 |
| 2367 | K(I-NSAV+N,J)=K(I,J) |
| 2368 | 880 P(I-NSAV+N,J)=P(I,J) |
| 2369 | I1=NSAV |
| 2370 | DO 910 I=N+1,2*N-NSAV |
| 2371 | IF(K(I,3).NE.IE(1)) GOTO 910 |
| 2372 | I1=I1+1 |
| 2373 | DO 890 J=1,5 |
| 2374 | K(I1,J)=K(I,J) |
| 2375 | 890 P(I1,J)=P(I,J) |
| 2376 | IF(MSTU(16).NE.2) K(I1,3)=NSAV |
| 2377 | DO 900 IZ=MSTU90+1,MSTU91 |
| 2378 | IF(MSTU9T(IZ).EQ.I) THEN |
| 2379 | MSTU(90)=MSTU(90)+1 |
| 2380 | MSTU(90+MSTU(90))=I1 |
| 2381 | PARU(90+MSTU(90))=PARU9T(IZ) |
| 2382 | ENDIF |
| 2383 | 900 CONTINUE |
| 2384 | 910 CONTINUE |
| 2385 | DO 940 I=2*N-NSAV,N+1,-1 |
| 2386 | IF(K(I,3).EQ.IE(1)) GOTO 940 |
| 2387 | I1=I1+1 |
| 2388 | DO 920 J=1,5 |
| 2389 | K(I1,J)=K(I,J) |
| 2390 | 920 P(I1,J)=P(I,J) |
| 2391 | IF(MSTU(16).NE.2) K(I1,3)=NSAV |
| 2392 | DO 930 IZ=MSTU90+1,MSTU91 |
| 2393 | IF(MSTU9T(IZ).EQ.I) THEN |
| 2394 | MSTU(90)=MSTU(90)+1 |
| 2395 | MSTU(90+MSTU(90))=I1 |
| 2396 | PARU(90+MSTU(90))=PARU9T(IZ) |
| 2397 | ENDIF |
| 2398 | 930 CONTINUE |
| 2399 | 940 CONTINUE |
| 2400 | |
| 2401 | C...Boost back particle system. Set production vertices. |
| 2402 | IF(MBST.EQ.0) THEN |
| 2403 | MSTU(33)=1 |
| 2404 | CALL LUDBRB(NSAV+1,N,0.,0.,DPS(1)/DPS(4),DPS(2)/DPS(4), |
| 2405 | & DPS(3)/DPS(4)) |
| 2406 | ELSE |
| 2407 | DO 950 I=NSAV+1,N |
| 2408 | HHPMT=P(I,1)**2+P(I,2)**2+P(I,5)**2 |
| 2409 | IF(P(I,3).GT.0.) THEN |
| 2410 | HHPEZ=(P(I,4)+P(I,3))*HHBZ |
| 2411 | P(I,3)=0.5*(HHPEZ-HHPMT/HHPEZ) |
| 2412 | P(I,4)=0.5*(HHPEZ+HHPMT/HHPEZ) |
| 2413 | ELSE |
| 2414 | HHPEZ=(P(I,4)-P(I,3))/HHBZ |
| 2415 | P(I,3)=-0.5*(HHPEZ-HHPMT/HHPEZ) |
| 2416 | P(I,4)=0.5*(HHPEZ+HHPMT/HHPEZ) |
| 2417 | ENDIF |
| 2418 | 950 CONTINUE |
| 2419 | ENDIF |
| 2420 | DO 960 I=NSAV+1,N |
| 2421 | DO 960 J=1,4 |
| 2422 | 960 V(I,J)=V(IP,J) |
| 2423 | |
| 2424 | RETURN |
| 2425 | END |
| 2426 | |
| 2427 | C********************************************************************* |
| 2428 | |
| 2429 | SUBROUTINE LUINDF(IP) |
| 2430 | |
| 2431 | C...Purpose: to handle the fragmentation of a jet system (or a single |
| 2432 | C...jet) according to independent fragmentation models. |
| 2433 | IMPLICIT DOUBLE PRECISION(D) |
| 2434 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 2435 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 2436 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 2437 | SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ |
| 2438 | DIMENSION DPS(5),PSI(4),NFI(3),NFL(3),IFET(3),KFLF(3), |
| 2439 | &KFLO(2),PXO(2),PYO(2),WO(2) |
| 2440 | |
| 2441 | C...Reset counters. Identify parton system and take copy. Check flavour. |
| 2442 | NSAV=N |
| 2443 | MSTU90=MSTU(90) |
| 2444 | NJET=0 |
| 2445 | KQSUM=0 |
| 2446 | DO 100 J=1,5 |
| 2447 | 100 DPS(J)=0. |
| 2448 | I=IP-1 |
| 2449 | 110 I=I+1 |
| 2450 | IF(I.GT.MIN(N,MSTU(4)-MSTU(32))) THEN |
| 2451 | CALL LUERRM(12,'(LUINDF:) failed to reconstruct jet system') |
| 2452 | IF(MSTU(21).GE.1) RETURN |
| 2453 | ENDIF |
| 2454 | IF(K(I,1).NE.1.AND.K(I,1).NE.2) GOTO 110 |
| 2455 | KC=LUCOMP(K(I,2)) |
| 2456 | IF(KC.EQ.0) GOTO 110 |
| 2457 | KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) |
| 2458 | IF(KQ.EQ.0) GOTO 110 |
| 2459 | NJET=NJET+1 |
| 2460 | IF(KQ.NE.2) KQSUM=KQSUM+KQ |
| 2461 | DO 120 J=1,5 |
| 2462 | K(NSAV+NJET,J)=K(I,J) |
| 2463 | P(NSAV+NJET,J)=P(I,J) |
| 2464 | 120 DPS(J)=DPS(J)+P(I,J) |
| 2465 | K(NSAV+NJET,3)=I |
| 2466 | IF(K(I,1).EQ.2.OR.(MSTJ(3).LE.5.AND.N.GT.I.AND. |
| 2467 | &K(I+1,1).EQ.2)) GOTO 110 |
| 2468 | IF(NJET.NE.1.AND.KQSUM.NE.0) THEN |
| 2469 | CALL LUERRM(12,'(LUINDF:) unphysical flavour combination') |
| 2470 | IF(MSTU(21).GE.1) RETURN |
| 2471 | ENDIF |
| 2472 | |
| 2473 | C...Boost copied system to CM frame. Find CM energy and sum flavours. |
| 2474 | IF(NJET.NE.1) THEN |
| 2475 | MSTU(33)=1 |
| 2476 | CALL LUDBRB(NSAV+1,NSAV+NJET,0.,0.,-DPS(1)/DPS(4), |
| 2477 | & -DPS(2)/DPS(4),-DPS(3)/DPS(4)) |
| 2478 | ENDIF |
| 2479 | PECM=0. |
| 2480 | DO 130 J=1,3 |
| 2481 | 130 NFI(J)=0 |
| 2482 | DO 140 I=NSAV+1,NSAV+NJET |
| 2483 | PECM=PECM+P(I,4) |
| 2484 | KFA=IABS(K(I,2)) |
| 2485 | IF(KFA.LE.3) THEN |
| 2486 | NFI(KFA)=NFI(KFA)+ISIGN(1,K(I,2)) |
| 2487 | ELSEIF(KFA.GT.1000) THEN |
| 2488 | KFLA=MOD(KFA/1000,10) |
| 2489 | KFLB=MOD(KFA/100,10) |
| 2490 | IF(KFLA.LE.3) NFI(KFLA)=NFI(KFLA)+ISIGN(1,K(I,2)) |
| 2491 | IF(KFLB.LE.3) NFI(KFLB)=NFI(KFLB)+ISIGN(1,K(I,2)) |
| 2492 | ENDIF |
| 2493 | 140 CONTINUE |
| 2494 | |
| 2495 | C...Loop over attempts made. Reset counters. |
| 2496 | NTRY=0 |
| 2497 | 150 NTRY=NTRY+1 |
| 2498 | IF(NTRY.GT.200) THEN |
| 2499 | CALL LUERRM(14,'(LUINDF:) caught in infinite loop') |
| 2500 | IF(MSTU(21).GE.1) RETURN |
| 2501 | ENDIF |
| 2502 | N=NSAV+NJET |
| 2503 | MSTU(90)=MSTU90 |
| 2504 | DO 160 J=1,3 |
| 2505 | NFL(J)=NFI(J) |
| 2506 | IFET(J)=0 |
| 2507 | 160 KFLF(J)=0 |
| 2508 | |
| 2509 | C...Loop over jets to be fragmented. |
| 2510 | DO 230 IP1=NSAV+1,NSAV+NJET |
| 2511 | MSTJ(91)=0 |
| 2512 | NSAV1=N |
| 2513 | MSTU91=MSTU(90) |
| 2514 | |
| 2515 | C...Initial flavour and momentum values. Jet along +z axis. |
| 2516 | KFLH=IABS(K(IP1,2)) |
| 2517 | IF(KFLH.GT.10) KFLH=MOD(KFLH/1000,10) |
| 2518 | KFLO(2)=0 |
| 2519 | WF=P(IP1,4)+SQRT(P(IP1,1)**2+P(IP1,2)**2+P(IP1,3)**2) |
| 2520 | |
| 2521 | C...Initial values for quark or diquark jet. |
| 2522 | 170 IF(IABS(K(IP1,2)).NE.21) THEN |
| 2523 | NSTR=1 |
| 2524 | KFLO(1)=K(IP1,2) |
| 2525 | CALL LUPTDI(0,PXO(1),PYO(1)) |
| 2526 | WO(1)=WF |
| 2527 | |
| 2528 | C...Initial values for gluon treated like random quark jet. |
| 2529 | ELSEIF(MSTJ(2).LE.2) THEN |
| 2530 | NSTR=1 |
| 2531 | IF(MSTJ(2).EQ.2) MSTJ(91)=1 |
| 2532 | KFLO(1)=INT(1.+(2.+PARJ(2))*RLU(0))*(-1)**INT(RLU(0)+0.5) |
| 2533 | CALL LUPTDI(0,PXO(1),PYO(1)) |
| 2534 | WO(1)=WF |
| 2535 | |
| 2536 | C...Initial values for gluon treated like quark-antiquark jet pair, |
| 2537 | C...sharing energy according to Altarelli-Parisi splitting function. |
| 2538 | ELSE |
| 2539 | NSTR=2 |
| 2540 | IF(MSTJ(2).EQ.4) MSTJ(91)=1 |
| 2541 | KFLO(1)=INT(1.+(2.+PARJ(2))*RLU(0))*(-1)**INT(RLU(0)+0.5) |
| 2542 | KFLO(2)=-KFLO(1) |
| 2543 | CALL LUPTDI(0,PXO(1),PYO(1)) |
| 2544 | PXO(2)=-PXO(1) |
| 2545 | PYO(2)=-PYO(1) |
| 2546 | WO(1)=WF*RLU(0)**(1./3.) |
| 2547 | WO(2)=WF-WO(1) |
| 2548 | ENDIF |
| 2549 | |
| 2550 | C...Initial values for rank, flavour, pT and W+. |
| 2551 | DO 220 ISTR=1,NSTR |
| 2552 | 180 I=N |
| 2553 | MSTU(90)=MSTU91 |
| 2554 | IRANK=0 |
| 2555 | KFL1=KFLO(ISTR) |
| 2556 | PX1=PXO(ISTR) |
| 2557 | PY1=PYO(ISTR) |
| 2558 | W=WO(ISTR) |
| 2559 | |
| 2560 | C...New hadron. Generate flavour and hadron species. |
| 2561 | 190 I=I+1 |
| 2562 | IF(I.GE.MSTU(4)-MSTU(32)-NJET-5) THEN |
| 2563 | CALL LUERRM(11,'(LUINDF:) no more memory left in LUJETS') |
| 2564 | IF(MSTU(21).GE.1) RETURN |
| 2565 | ENDIF |
| 2566 | IRANK=IRANK+1 |
| 2567 | K(I,1)=1 |
| 2568 | K(I,3)=IP1 |
| 2569 | K(I,4)=0 |
| 2570 | K(I,5)=0 |
| 2571 | 200 CALL LUKFDI(KFL1,0,KFL2,K(I,2)) |
| 2572 | IF(K(I,2).EQ.0) GOTO 180 |
| 2573 | IF(MSTJ(12).GE.3.AND.IRANK.EQ.1.AND.IABS(KFL1).LE.10.AND. |
| 2574 | &IABS(KFL2).GT.10) THEN |
| 2575 | IF(RLU(0).GT.PARJ(19)) GOTO 200 |
| 2576 | ENDIF |
| 2577 | |
| 2578 | C...Find hadron mass. Generate four-momentum. |
| 2579 | P(I,5)=ULMASS(K(I,2)) |
| 2580 | CALL LUPTDI(KFL1,PX2,PY2) |
| 2581 | P(I,1)=PX1+PX2 |
| 2582 | P(I,2)=PY1+PY2 |
| 2583 | PR=P(I,5)**2+P(I,1)**2+P(I,2)**2 |
| 2584 | CALL LUZDIS(KFL1,KFL2,PR,Z) |
| 2585 | MZSAV=0 |
| 2586 | IF(IABS(KFL1).GE.4.AND.IABS(KFL1).LE.8.AND.MSTU(90).LT.8) THEN |
| 2587 | MZSAV=1 |
| 2588 | MSTU(90)=MSTU(90)+1 |
| 2589 | MSTU(90+MSTU(90))=I |
| 2590 | PARU(90+MSTU(90))=Z |
| 2591 | ENDIF |
| 2592 | P(I,3)=0.5*(Z*W-PR/(Z*W)) |
| 2593 | P(I,4)=0.5*(Z*W+PR/(Z*W)) |
| 2594 | IF(MSTJ(3).GE.1.AND.IRANK.EQ.1.AND.KFLH.GE.4.AND. |
| 2595 | &P(I,3).LE.0.001) THEN |
| 2596 | IF(W.GE.P(I,5)+0.5*PARJ(32)) GOTO 180 |
| 2597 | P(I,3)=0.0001 |
| 2598 | P(I,4)=SQRT(PR) |
| 2599 | Z=P(I,4)/W |
| 2600 | ENDIF |
| 2601 | |
| 2602 | C...Remaining flavour and momentum. |
| 2603 | KFL1=-KFL2 |
| 2604 | PX1=-PX2 |
| 2605 | PY1=-PY2 |
| 2606 | W=(1.-Z)*W |
| 2607 | DO 210 J=1,5 |
| 2608 | 210 V(I,J)=0. |
| 2609 | |
| 2610 | C...Check if pL acceptable. Go back for new hadron if enough energy. |
| 2611 | IF(MSTJ(3).GE.0.AND.P(I,3).LT.0.) THEN |
| 2612 | I=I-1 |
| 2613 | IF(MZSAV.EQ.1) MSTU(90)=MSTU(90)-1 |
| 2614 | ENDIF |
| 2615 | IF(W.GT.PARJ(31)) GOTO 190 |
| 2616 | 220 N=I |
| 2617 | IF(MOD(MSTJ(3),5).EQ.4.AND.N.EQ.NSAV1) WF=WF+0.1*PARJ(32) |
| 2618 | IF(MOD(MSTJ(3),5).EQ.4.AND.N.EQ.NSAV1) GOTO 170 |
| 2619 | |
| 2620 | C...Rotate jet to new direction. |
| 2621 | THE=ULANGL(P(IP1,3),SQRT(P(IP1,1)**2+P(IP1,2)**2)) |
| 2622 | PHI=ULANGL(P(IP1,1),P(IP1,2)) |
| 2623 | MSTU(33)=1 |
| 2624 | CALL LUDBRB(NSAV1+1,N,THE,PHI,0D0,0D0,0D0) |
| 2625 | K(K(IP1,3),4)=NSAV1+1 |
| 2626 | K(K(IP1,3),5)=N |
| 2627 | |
| 2628 | C...End of jet generation loop. Skip conservation in some cases. |
| 2629 | 230 CONTINUE |
| 2630 | IF(NJET.EQ.1.OR.MSTJ(3).LE.0) GOTO 470 |
| 2631 | IF(MOD(MSTJ(3),5).NE.0.AND.N-NSAV-NJET.LT.2) GOTO 150 |
| 2632 | |
| 2633 | C...Subtract off produced hadron flavours, finished if zero. |
| 2634 | DO 240 I=NSAV+NJET+1,N |
| 2635 | KFA=IABS(K(I,2)) |
| 2636 | KFLA=MOD(KFA/1000,10) |
| 2637 | KFLB=MOD(KFA/100,10) |
| 2638 | KFLC=MOD(KFA/10,10) |
| 2639 | IF(KFLA.EQ.0) THEN |
| 2640 | IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)-ISIGN(1,K(I,2))*(-1)**KFLB |
| 2641 | IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)+ISIGN(1,K(I,2))*(-1)**KFLB |
| 2642 | ELSE |
| 2643 | IF(KFLA.LE.3) NFL(KFLA)=NFL(KFLA)-ISIGN(1,K(I,2)) |
| 2644 | IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)-ISIGN(1,K(I,2)) |
| 2645 | IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)-ISIGN(1,K(I,2)) |
| 2646 | ENDIF |
| 2647 | 240 CONTINUE |
| 2648 | NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+ |
| 2649 | &NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3 |
| 2650 | IF(NREQ.EQ.0) GOTO 320 |
| 2651 | |
| 2652 | C...Take away flavour of low-momentum particles until enough freedom. |
| 2653 | NREM=0 |
| 2654 | 250 IREM=0 |
| 2655 | P2MIN=PECM**2 |
| 2656 | DO 260 I=NSAV+NJET+1,N |
| 2657 | P2=P(I,1)**2+P(I,2)**2+P(I,3)**2 |
| 2658 | IF(K(I,1).EQ.1.AND.P2.LT.P2MIN) IREM=I |
| 2659 | 260 IF(K(I,1).EQ.1.AND.P2.LT.P2MIN) P2MIN=P2 |
| 2660 | IF(IREM.EQ.0) GOTO 150 |
| 2661 | K(IREM,1)=7 |
| 2662 | KFA=IABS(K(IREM,2)) |
| 2663 | KFLA=MOD(KFA/1000,10) |
| 2664 | KFLB=MOD(KFA/100,10) |
| 2665 | KFLC=MOD(KFA/10,10) |
| 2666 | IF(KFLA.GE.4.OR.KFLB.GE.4) K(IREM,1)=8 |
| 2667 | IF(K(IREM,1).EQ.8) GOTO 250 |
| 2668 | IF(KFLA.EQ.0) THEN |
| 2669 | ISGN=ISIGN(1,K(IREM,2))*(-1)**KFLB |
| 2670 | IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)+ISGN |
| 2671 | IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)-ISGN |
| 2672 | ELSE |
| 2673 | IF(KFLA.LE.3) NFL(KFLA)=NFL(KFLA)+ISIGN(1,K(IREM,2)) |
| 2674 | IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)+ISIGN(1,K(IREM,2)) |
| 2675 | IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)+ISIGN(1,K(IREM,2)) |
| 2676 | ENDIF |
| 2677 | NREM=NREM+1 |
| 2678 | NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+ |
| 2679 | &NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3 |
| 2680 | IF(NREQ.GT.NREM) GOTO 250 |
| 2681 | DO 270 I=NSAV+NJET+1,N |
| 2682 | 270 IF(K(I,1).EQ.8) K(I,1)=1 |
| 2683 | |
| 2684 | C...Find combination of existing and new flavours for hadron. |
| 2685 | 280 NFET=2 |
| 2686 | IF(NFL(1)+NFL(2)+NFL(3).NE.0) NFET=3 |
| 2687 | IF(NREQ.LT.NREM) NFET=1 |
| 2688 | IF(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3)).EQ.0) NFET=0 |
| 2689 | DO 290 J=1,NFET |
| 2690 | IFET(J)=1+(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3)))*RLU(0) |
| 2691 | KFLF(J)=ISIGN(1,NFL(1)) |
| 2692 | IF(IFET(J).GT.IABS(NFL(1))) KFLF(J)=ISIGN(2,NFL(2)) |
| 2693 | 290 IF(IFET(J).GT.IABS(NFL(1))+IABS(NFL(2))) KFLF(J)=ISIGN(3,NFL(3)) |
| 2694 | IF(NFET.EQ.2.AND.(IFET(1).EQ.IFET(2).OR.KFLF(1)*KFLF(2).GT.0)) |
| 2695 | &GOTO 280 |
| 2696 | IF(NFET.EQ.3.AND.(IFET(1).EQ.IFET(2).OR.IFET(1).EQ.IFET(3).OR. |
| 2697 | &IFET(2).EQ.IFET(3).OR.KFLF(1)*KFLF(2).LT.0.OR.KFLF(1)*KFLF(3). |
| 2698 | <.0.OR.KFLF(1)*(NFL(1)+NFL(2)+NFL(3)).LT.0)) GOTO 280 |
| 2699 | IF(NFET.EQ.0) KFLF(1)=1+INT((2.+PARJ(2))*RLU(0)) |
| 2700 | IF(NFET.EQ.0) KFLF(2)=-KFLF(1) |
| 2701 | IF(NFET.EQ.1) KFLF(2)=ISIGN(1+INT((2.+PARJ(2))*RLU(0)),-KFLF(1)) |
| 2702 | IF(NFET.LE.2) KFLF(3)=0 |
| 2703 | IF(KFLF(3).NE.0) THEN |
| 2704 | KFLFC=ISIGN(1000*MAX(IABS(KFLF(1)),IABS(KFLF(3)))+ |
| 2705 | & 100*MIN(IABS(KFLF(1)),IABS(KFLF(3)))+1,KFLF(1)) |
| 2706 | IF(KFLF(1).EQ.KFLF(3).OR.(1.+3.*PARJ(4))*RLU(0).GT.1.) |
| 2707 | & KFLFC=KFLFC+ISIGN(2,KFLFC) |
| 2708 | ELSE |
| 2709 | KFLFC=KFLF(1) |
| 2710 | ENDIF |
| 2711 | CALL LUKFDI(KFLFC,KFLF(2),KFLDMP,KF) |
| 2712 | IF(KF.EQ.0) GOTO 280 |
| 2713 | DO 300 J=1,MAX(2,NFET) |
| 2714 | 300 NFL(IABS(KFLF(J)))=NFL(IABS(KFLF(J)))-ISIGN(1,KFLF(J)) |
| 2715 | |
| 2716 | C...Store hadron at random among free positions. |
| 2717 | NPOS=MIN(1+INT(RLU(0)*NREM),NREM) |
| 2718 | DO 310 I=NSAV+NJET+1,N |
| 2719 | IF(K(I,1).EQ.7) NPOS=NPOS-1 |
| 2720 | IF(K(I,1).EQ.1.OR.NPOS.NE.0) GOTO 310 |
| 2721 | K(I,1)=1 |
| 2722 | K(I,2)=KF |
| 2723 | P(I,5)=ULMASS(K(I,2)) |
| 2724 | P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2) |
| 2725 | 310 CONTINUE |
| 2726 | NREM=NREM-1 |
| 2727 | NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+ |
| 2728 | &NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3 |
| 2729 | IF(NREM.GT.0) GOTO 280 |
| 2730 | |
| 2731 | C...Compensate for missing momentum in global scheme (3 options). |
| 2732 | 320 IF(MOD(MSTJ(3),5).NE.0.AND.MOD(MSTJ(3),5).NE.4) THEN |
| 2733 | DO 330 J=1,3 |
| 2734 | PSI(J)=0. |
| 2735 | DO 330 I=NSAV+NJET+1,N |
| 2736 | 330 PSI(J)=PSI(J)+P(I,J) |
| 2737 | PSI(4)=PSI(1)**2+PSI(2)**2+PSI(3)**2 |
| 2738 | PWS=0. |
| 2739 | DO 340 I=NSAV+NJET+1,N |
| 2740 | IF(MOD(MSTJ(3),5).EQ.1) PWS=PWS+P(I,4) |
| 2741 | IF(MOD(MSTJ(3),5).EQ.2) PWS=PWS+SQRT(P(I,5)**2+(PSI(1)*P(I,1)+ |
| 2742 | & PSI(2)*P(I,2)+PSI(3)*P(I,3))**2/PSI(4)) |
| 2743 | 340 IF(MOD(MSTJ(3),5).EQ.3) PWS=PWS+1. |
| 2744 | DO 360 I=NSAV+NJET+1,N |
| 2745 | IF(MOD(MSTJ(3),5).EQ.1) PW=P(I,4) |
| 2746 | IF(MOD(MSTJ(3),5).EQ.2) PW=SQRT(P(I,5)**2+(PSI(1)*P(I,1)+ |
| 2747 | & PSI(2)*P(I,2)+PSI(3)*P(I,3))**2/PSI(4)) |
| 2748 | IF(MOD(MSTJ(3),5).EQ.3) PW=1. |
| 2749 | DO 350 J=1,3 |
| 2750 | 350 P(I,J)=P(I,J)-PSI(J)*PW/PWS |
| 2751 | 360 P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2) |
| 2752 | |
| 2753 | C...Compensate for missing momentum withing each jet separately. |
| 2754 | ELSEIF(MOD(MSTJ(3),5).EQ.4) THEN |
| 2755 | DO 370 I=N+1,N+NJET |
| 2756 | K(I,1)=0 |
| 2757 | DO 370 J=1,5 |
| 2758 | 370 P(I,J)=0. |
| 2759 | DO 390 I=NSAV+NJET+1,N |
| 2760 | IR1=K(I,3) |
| 2761 | IR2=N+IR1-NSAV |
| 2762 | K(IR2,1)=K(IR2,1)+1 |
| 2763 | PLS=(P(I,1)*P(IR1,1)+P(I,2)*P(IR1,2)+P(I,3)*P(IR1,3))/ |
| 2764 | & (P(IR1,1)**2+P(IR1,2)**2+P(IR1,3)**2) |
| 2765 | DO 380 J=1,3 |
| 2766 | 380 P(IR2,J)=P(IR2,J)+P(I,J)-PLS*P(IR1,J) |
| 2767 | P(IR2,4)=P(IR2,4)+P(I,4) |
| 2768 | 390 P(IR2,5)=P(IR2,5)+PLS |
| 2769 | PSS=0. |
| 2770 | DO 400 I=N+1,N+NJET |
| 2771 | 400 IF(K(I,1).NE.0) PSS=PSS+P(I,4)/(PECM*(0.8*P(I,5)+0.2)) |
| 2772 | DO 420 I=NSAV+NJET+1,N |
| 2773 | IR1=K(I,3) |
| 2774 | IR2=N+IR1-NSAV |
| 2775 | PLS=(P(I,1)*P(IR1,1)+P(I,2)*P(IR1,2)+P(I,3)*P(IR1,3))/ |
| 2776 | & (P(IR1,1)**2+P(IR1,2)**2+P(IR1,3)**2) |
| 2777 | DO 410 J=1,3 |
| 2778 | 410 P(I,J)=P(I,J)-P(IR2,J)/K(IR2,1)+(1./(P(IR2,5)*PSS)-1.)*PLS* |
| 2779 | & P(IR1,J) |
| 2780 | 420 P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2) |
| 2781 | ENDIF |
| 2782 | |
| 2783 | C...Scale momenta for energy conservation. |
| 2784 | IF(MOD(MSTJ(3),5).NE.0) THEN |
| 2785 | PMS=0. |
| 2786 | PES=0. |
| 2787 | PQS=0. |
| 2788 | DO 430 I=NSAV+NJET+1,N |
| 2789 | PMS=PMS+P(I,5) |
| 2790 | PES=PES+P(I,4) |
| 2791 | 430 PQS=PQS+P(I,5)**2/P(I,4) |
| 2792 | IF(PMS.GE.PECM) GOTO 150 |
| 2793 | NECO=0 |
| 2794 | 440 NECO=NECO+1 |
| 2795 | PFAC=(PECM-PQS)/(PES-PQS) |
| 2796 | PES=0. |
| 2797 | PQS=0. |
| 2798 | DO 460 I=NSAV+NJET+1,N |
| 2799 | DO 450 J=1,3 |
| 2800 | 450 P(I,J)=PFAC*P(I,J) |
| 2801 | P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2) |
| 2802 | PES=PES+P(I,4) |
| 2803 | 460 PQS=PQS+P(I,5)**2/P(I,4) |
| 2804 | IF(NECO.LT.10.AND.ABS(PECM-PES).GT.2E-6*PECM) GOTO 440 |
| 2805 | ENDIF |
| 2806 | |
| 2807 | C...Origin of produced particles and parton daughter pointers. |
| 2808 | 470 DO 480 I=NSAV+NJET+1,N |
| 2809 | IF(MSTU(16).NE.2) K(I,3)=NSAV+1 |
| 2810 | 480 IF(MSTU(16).EQ.2) K(I,3)=K(K(I,3),3) |
| 2811 | DO 490 I=NSAV+1,NSAV+NJET |
| 2812 | I1=K(I,3) |
| 2813 | K(I1,1)=K(I1,1)+10 |
| 2814 | IF(MSTU(16).NE.2) THEN |
| 2815 | K(I1,4)=NSAV+1 |
| 2816 | K(I1,5)=NSAV+1 |
| 2817 | ELSE |
| 2818 | K(I1,4)=K(I1,4)-NJET+1 |
| 2819 | K(I1,5)=K(I1,5)-NJET+1 |
| 2820 | IF(K(I1,5).LT.K(I1,4)) THEN |
| 2821 | K(I1,4)=0 |
| 2822 | K(I1,5)=0 |
| 2823 | ENDIF |
| 2824 | ENDIF |
| 2825 | 490 CONTINUE |
| 2826 | |
| 2827 | C...Document independent fragmentation system. Remove copy of jets. |
| 2828 | NSAV=NSAV+1 |
| 2829 | K(NSAV,1)=11 |
| 2830 | K(NSAV,2)=93 |
| 2831 | K(NSAV,3)=IP |
| 2832 | K(NSAV,4)=NSAV+1 |
| 2833 | K(NSAV,5)=N-NJET+1 |
| 2834 | DO 500 J=1,4 |
| 2835 | P(NSAV,J)=DPS(J) |
| 2836 | 500 V(NSAV,J)=V(IP,J) |
| 2837 | P(NSAV,5)=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2)) |
| 2838 | V(NSAV,5)=0. |
| 2839 | DO 510 I=NSAV+NJET,N |
| 2840 | DO 510 J=1,5 |
| 2841 | K(I-NJET+1,J)=K(I,J) |
| 2842 | P(I-NJET+1,J)=P(I,J) |
| 2843 | 510 V(I-NJET+1,J)=V(I,J) |
| 2844 | N=N-NJET+1 |
| 2845 | DO 520 IZ=MSTU90+1,MSTU(90) |
| 2846 | 520 MSTU(90+IZ)=MSTU(90+IZ)-NJET+1 |
| 2847 | |
| 2848 | C...Boost back particle system. Set production vertices. |
| 2849 | IF(NJET.NE.1) CALL LUDBRB(NSAV+1,N,0.,0.,DPS(1)/DPS(4), |
| 2850 | &DPS(2)/DPS(4),DPS(3)/DPS(4)) |
| 2851 | DO 530 I=NSAV+1,N |
| 2852 | DO 530 J=1,4 |
| 2853 | 530 V(I,J)=V(IP,J) |
| 2854 | |
| 2855 | RETURN |
| 2856 | END |
| 2857 | |
| 2858 | C********************************************************************* |
| 2859 | |
| 2860 | SUBROUTINE LUDECY(IP) |
| 2861 | |
| 2862 | C...Purpose: to handle the decay of unstable particles. |
| 2863 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 2864 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 2865 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 2866 | COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) |
| 2867 | SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/ |
| 2868 | DIMENSION VDCY(4),KFLO(4),KFL1(4),PV(10,5),RORD(10),UE(3),BE(3), |
| 2869 | &WTCOR(10) |
| 2870 | DATA WTCOR/2.,5.,15.,60.,250.,1500.,1.2E4,1.2E5,150.,16./ |
| 2871 | |
| 2872 | C...Functions: momentum in two-particle decays, four-product and |
| 2873 | C...matrix element times phase space in weak decays. |
| 2874 | PAWT(A,B,C)=SQRT((A**2-(B+C)**2)*(A**2-(B-C)**2))/(2.*A) |
| 2875 | 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) |
| 2876 | HMEPS(HA)=((1.-HRQ-HA)**2+3.*HA*(1.+HRQ-HA))* |
| 2877 | &SQRT((1.-HRQ-HA)**2-4.*HRQ*HA) |
| 2878 | |
| 2879 | C...Initial values. |
| 2880 | NTRY=0 |
| 2881 | NSAV=N |
| 2882 | KFA=IABS(K(IP,2)) |
| 2883 | KFS=ISIGN(1,K(IP,2)) |
| 2884 | KC=LUCOMP(KFA) |
| 2885 | MSTJ(92)=0 |
| 2886 | |
| 2887 | C...Choose lifetime and determine decay vertex. |
| 2888 | IF(K(IP,1).EQ.5) THEN |
| 2889 | V(IP,5)=0. |
| 2890 | ELSEIF(K(IP,1).NE.4) THEN |
| 2891 | V(IP,5)=-PMAS(KC,4)*LOG(RLU(0)) |
| 2892 | ENDIF |
| 2893 | DO 100 J=1,4 |
| 2894 | 100 VDCY(J)=V(IP,J)+V(IP,5)*P(IP,J)/P(IP,5) |
| 2895 | |
| 2896 | C...Determine whether decay allowed or not. |
| 2897 | MOUT=0 |
| 2898 | IF(MSTJ(22).EQ.2) THEN |
| 2899 | IF(PMAS(KC,4).GT.PARJ(71)) MOUT=1 |
| 2900 | ELSEIF(MSTJ(22).EQ.3) THEN |
| 2901 | IF(VDCY(1)**2+VDCY(2)**2+VDCY(3)**2.GT.PARJ(72)**2) MOUT=1 |
| 2902 | ELSEIF(MSTJ(22).EQ.4) THEN |
| 2903 | IF(VDCY(1)**2+VDCY(2)**2.GT.PARJ(73)**2) MOUT=1 |
| 2904 | IF(ABS(VDCY(3)).GT.PARJ(74)) MOUT=1 |
| 2905 | ENDIF |
| 2906 | IF(MOUT.EQ.1.AND.K(IP,1).NE.5) THEN |
| 2907 | K(IP,1)=4 |
| 2908 | RETURN |
| 2909 | ENDIF |
| 2910 | |
| 2911 | C...B-B~ mixing: flip sign of meson appropriately. |
| 2912 | MMIX=0 |
| 2913 | IF((KFA.EQ.511.OR.KFA.EQ.531).AND.MSTJ(26).GE.1) THEN |
| 2914 | XBBMIX=PARJ(76) |
| 2915 | IF(KFA.EQ.531) XBBMIX=PARJ(77) |
| 2916 | IF(SIN(0.5*XBBMIX*V(IP,5)/PMAS(KC,4))**2.GT.RLU(0)) MMIX=1 |
| 2917 | IF(MMIX.EQ.1) KFS=-KFS |
| 2918 | ENDIF |
| 2919 | |
| 2920 | C...Check existence of decay channels. Particle/antiparticle rules. |
| 2921 | KCA=KC |
| 2922 | IF(MDCY(KC,2).GT.0) THEN |
| 2923 | MDMDCY=MDME(MDCY(KC,2),2) |
| 2924 | IF(MDMDCY.GT.80.AND.MDMDCY.LE.90) KCA=MDMDCY |
| 2925 | ENDIF |
| 2926 | IF(MDCY(KCA,2).LE.0.OR.MDCY(KCA,3).LE.0) THEN |
| 2927 | CALL LUERRM(9,'(LUDECY:) no decay channel defined') |
| 2928 | RETURN |
| 2929 | ENDIF |
| 2930 | IF(MOD(KFA/1000,10).EQ.0.AND.(KCA.EQ.85.OR.KCA.EQ.87)) KFS=-KFS |
| 2931 | IF(KCHG(KC,3).EQ.0) THEN |
| 2932 | KFSP=1 |
| 2933 | KFSN=0 |
| 2934 | IF(RLU(0).GT.0.5) KFS=-KFS |
| 2935 | ELSEIF(KFS.GT.0) THEN |
| 2936 | KFSP=1 |
| 2937 | KFSN=0 |
| 2938 | ELSE |
| 2939 | KFSP=0 |
| 2940 | KFSN=1 |
| 2941 | ENDIF |
| 2942 | |
| 2943 | C...Sum branching ratios of allowed decay channels. |
| 2944 | 110 NOPE=0 |
| 2945 | BRSU=0. |
| 2946 | DO 120 IDL=MDCY(KCA,2),MDCY(KCA,2)+MDCY(KCA,3)-1 |
| 2947 | IF(MDME(IDL,1).NE.1.AND.KFSP*MDME(IDL,1).NE.2.AND. |
| 2948 | &KFSN*MDME(IDL,1).NE.3) GOTO 120 |
| 2949 | IF(MDME(IDL,2).GT.100) GOTO 120 |
| 2950 | NOPE=NOPE+1 |
| 2951 | BRSU=BRSU+BRAT(IDL) |
| 2952 | 120 CONTINUE |
| 2953 | IF(NOPE.EQ.0) THEN |
| 2954 | CALL LUERRM(2,'(LUDECY:) all decay channels closed by user') |
| 2955 | RETURN |
| 2956 | ENDIF |
| 2957 | |
| 2958 | C...Select decay channel among allowed ones. |
| 2959 | 130 RBR=BRSU*RLU(0) |
| 2960 | IDL=MDCY(KCA,2)-1 |
| 2961 | 140 IDL=IDL+1 |
| 2962 | IF(MDME(IDL,1).NE.1.AND.KFSP*MDME(IDL,1).NE.2.AND. |
| 2963 | &KFSN*MDME(IDL,1).NE.3) THEN |
| 2964 | IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1) GOTO 140 |
| 2965 | ELSEIF(MDME(IDL,2).GT.100) THEN |
| 2966 | IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1) GOTO 140 |
| 2967 | ELSE |
| 2968 | IDC=IDL |
| 2969 | RBR=RBR-BRAT(IDL) |
| 2970 | IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1.AND.RBR.GT.0.) GOTO 140 |
| 2971 | ENDIF |
| 2972 | |
| 2973 | C...Start readout of decay channel: matrix element, reset counters. |
| 2974 | MMAT=MDME(IDC,2) |
| 2975 | 150 NTRY=NTRY+1 |
| 2976 | IF(NTRY.GT.1000) THEN |
| 2977 | CALL LUERRM(14,'(LUDECY:) caught in infinite loop') |
| 2978 | IF(MSTU(21).GE.1) RETURN |
| 2979 | ENDIF |
| 2980 | I=N |
| 2981 | NP=0 |
| 2982 | NQ=0 |
| 2983 | MBST=0 |
| 2984 | IF(MMAT.GE.11.AND.MMAT.NE.46.AND.P(IP,4).GT.20.*P(IP,5)) MBST=1 |
| 2985 | DO 160 J=1,4 |
| 2986 | PV(1,J)=0. |
| 2987 | 160 IF(MBST.EQ.0) PV(1,J)=P(IP,J) |
| 2988 | IF(MBST.EQ.1) PV(1,4)=P(IP,5) |
| 2989 | PV(1,5)=P(IP,5) |
| 2990 | PS=0. |
| 2991 | PSQ=0. |
| 2992 | MREM=0 |
| 2993 | |
| 2994 | C...Read out decay products. Convert to standard flavour code. |
| 2995 | JTMAX=5 |
| 2996 | IF(MDME(IDC+1,2).EQ.101) JTMAX=10 |
| 2997 | DO 170 JT=1,JTMAX |
| 2998 | IF(JT.LE.5) KP=KFDP(IDC,JT) |
| 2999 | IF(JT.GE.6) KP=KFDP(IDC+1,JT-5) |
| 3000 | IF(KP.EQ.0) GOTO 170 |
| 3001 | KPA=IABS(KP) |
| 3002 | KCP=LUCOMP(KPA) |
| 3003 | IF(KCHG(KCP,3).EQ.0.AND.KPA.NE.81.AND.KPA.NE.82) THEN |
| 3004 | KFP=KP |
| 3005 | ELSEIF(KPA.NE.81.AND.KPA.NE.82) THEN |
| 3006 | KFP=KFS*KP |
| 3007 | ELSEIF(KPA.EQ.81.AND.MOD(KFA/1000,10).EQ.0) THEN |
| 3008 | KFP=-KFS*MOD(KFA/10,10) |
| 3009 | ELSEIF(KPA.EQ.81.AND.MOD(KFA/100,10).GE.MOD(KFA/10,10)) THEN |
| 3010 | KFP=KFS*(100*MOD(KFA/10,100)+3) |
| 3011 | ELSEIF(KPA.EQ.81) THEN |
| 3012 | KFP=KFS*(1000*MOD(KFA/10,10)+100*MOD(KFA/100,10)+1) |
| 3013 | ELSEIF(KP.EQ.82) THEN |
| 3014 | CALL LUKFDI(-KFS*INT(1.+(2.+PARJ(2))*RLU(0)),0,KFP,KDUMP) |
| 3015 | IF(KFP.EQ.0) GOTO 150 |
| 3016 | MSTJ(93)=1 |
| 3017 | IF(PV(1,5).LT.PARJ(32)+2.*ULMASS(KFP)) GOTO 150 |
| 3018 | ELSEIF(KP.EQ.-82) THEN |
| 3019 | KFP=-KFP |
| 3020 | IF(IABS(KFP).GT.10) KFP=KFP+ISIGN(10000,KFP) |
| 3021 | ENDIF |
| 3022 | IF(KPA.EQ.81.OR.KPA.EQ.82) KCP=LUCOMP(KFP) |
| 3023 | |
| 3024 | C...Add decay product to event record or to quark flavour list. |
| 3025 | KFPA=IABS(KFP) |
| 3026 | KQP=KCHG(KCP,2) |
| 3027 | IF(MMAT.GE.11.AND.MMAT.LE.30.AND.KQP.NE.0) THEN |
| 3028 | NQ=NQ+1 |
| 3029 | KFLO(NQ)=KFP |
| 3030 | MSTJ(93)=2 |
| 3031 | PSQ=PSQ+ULMASS(KFLO(NQ)) |
| 3032 | ELSEIF(MMAT.GE.42.AND.MMAT.LE.43.AND.NP.EQ.3.AND.MOD(NQ,2).EQ.1) |
| 3033 | &THEN |
| 3034 | NQ=NQ-1 |
| 3035 | PS=PS-P(I,5) |
| 3036 | K(I,1)=1 |
| 3037 | KFI=K(I,2) |
| 3038 | CALL LUKFDI(KFP,KFI,KFLDMP,K(I,2)) |
| 3039 | IF(K(I,2).EQ.0) GOTO 150 |
| 3040 | MSTJ(93)=1 |
| 3041 | P(I,5)=ULMASS(K(I,2)) |
| 3042 | PS=PS+P(I,5) |
| 3043 | ELSE |
| 3044 | I=I+1 |
| 3045 | NP=NP+1 |
| 3046 | IF(MMAT.NE.33.AND.KQP.NE.0) NQ=NQ+1 |
| 3047 | IF(MMAT.EQ.33.AND.KQP.NE.0.AND.KQP.NE.2) NQ=NQ+1 |
| 3048 | K(I,1)=1+MOD(NQ,2) |
| 3049 | IF(MMAT.EQ.4.AND.JT.LE.2.AND.KFP.EQ.21) K(I,1)=2 |
| 3050 | IF(MMAT.EQ.4.AND.JT.EQ.3) K(I,1)=1 |
| 3051 | K(I,2)=KFP |
| 3052 | K(I,3)=IP |
| 3053 | K(I,4)=0 |
| 3054 | K(I,5)=0 |
| 3055 | P(I,5)=ULMASS(KFP) |
| 3056 | IF(MMAT.EQ.45.AND.KFPA.EQ.89) P(I,5)=PARJ(32) |
| 3057 | PS=PS+P(I,5) |
| 3058 | ENDIF |
| 3059 | 170 CONTINUE |
| 3060 | |
| 3061 | C...Choose decay multiplicity in phase space model. |
| 3062 | 180 IF(MMAT.GE.11.AND.MMAT.LE.30) THEN |
| 3063 | PSP=PS |
| 3064 | CNDE=PARJ(61)*LOG(MAX((PV(1,5)-PS-PSQ)/PARJ(62),1.1)) |
| 3065 | IF(MMAT.EQ.12) CNDE=CNDE+PARJ(63) |
| 3066 | 190 NTRY=NTRY+1 |
| 3067 | IF(NTRY.GT.1000) THEN |
| 3068 | CALL LUERRM(14,'(LUDECY:) caught in infinite loop') |
| 3069 | IF(MSTU(21).GE.1) RETURN |
| 3070 | ENDIF |
| 3071 | IF(MMAT.LE.20) THEN |
| 3072 | GAUSS=SQRT(-2.*CNDE*LOG(MAX(1E-10,RLU(0))))* |
| 3073 | & SIN(PARU(2)*RLU(0)) |
| 3074 | ND=0.5+0.5*NP+0.25*NQ+CNDE+GAUSS |
| 3075 | IF(ND.LT.NP+NQ/2.OR.ND.LT.2.OR.ND.GT.10) GOTO 190 |
| 3076 | IF(MMAT.EQ.13.AND.ND.EQ.2) GOTO 190 |
| 3077 | IF(MMAT.EQ.14.AND.ND.LE.3) GOTO 190 |
| 3078 | IF(MMAT.EQ.15.AND.ND.LE.4) GOTO 190 |
| 3079 | ELSE |
| 3080 | ND=MMAT-20 |
| 3081 | ENDIF |
| 3082 | |
| 3083 | C...Form hadrons from flavour content. |
| 3084 | DO 200 JT=1,4 |
| 3085 | 200 KFL1(JT)=KFLO(JT) |
| 3086 | IF(ND.EQ.NP+NQ/2) GOTO 220 |
| 3087 | DO 210 I=N+NP+1,N+ND-NQ/2 |
| 3088 | JT=1+INT((NQ-1)*RLU(0)) |
| 3089 | CALL LUKFDI(KFL1(JT),0,KFL2,K(I,2)) |
| 3090 | IF(K(I,2).EQ.0) GOTO 190 |
| 3091 | 210 KFL1(JT)=-KFL2 |
| 3092 | 220 JT=2 |
| 3093 | JT2=3 |
| 3094 | JT3=4 |
| 3095 | IF(NQ.EQ.4.AND.RLU(0).LT.PARJ(66)) JT=4 |
| 3096 | IF(JT.EQ.4.AND.ISIGN(1,KFL1(1)*(10-IABS(KFL1(1))))* |
| 3097 | & ISIGN(1,KFL1(JT)*(10-IABS(KFL1(JT)))).GT.0) JT=3 |
| 3098 | IF(JT.EQ.3) JT2=2 |
| 3099 | IF(JT.EQ.4) JT3=2 |
| 3100 | CALL LUKFDI(KFL1(1),KFL1(JT),KFLDMP,K(N+ND-NQ/2+1,2)) |
| 3101 | IF(K(N+ND-NQ/2+1,2).EQ.0) GOTO 190 |
| 3102 | IF(NQ.EQ.4) CALL LUKFDI(KFL1(JT2),KFL1(JT3),KFLDMP,K(N+ND,2)) |
| 3103 | IF(NQ.EQ.4.AND.K(N+ND,2).EQ.0) GOTO 190 |
| 3104 | |
| 3105 | C...Check that sum of decay product masses not too large. |
| 3106 | PS=PSP |
| 3107 | DO 230 I=N+NP+1,N+ND |
| 3108 | K(I,1)=1 |
| 3109 | K(I,3)=IP |
| 3110 | K(I,4)=0 |
| 3111 | K(I,5)=0 |
| 3112 | P(I,5)=ULMASS(K(I,2)) |
| 3113 | 230 PS=PS+P(I,5) |
| 3114 | IF(PS+PARJ(64).GT.PV(1,5)) GOTO 190 |
| 3115 | |
| 3116 | C...Rescale energy to subtract off spectator quark mass. |
| 3117 | ELSEIF((MMAT.EQ.31.OR.MMAT.EQ.33.OR.MMAT.EQ.44.OR.MMAT.EQ.45). |
| 3118 | &AND.NP.GE.3) THEN |
| 3119 | PS=PS-P(N+NP,5) |
| 3120 | PQT=(P(N+NP,5)+PARJ(65))/PV(1,5) |
| 3121 | DO 240 J=1,5 |
| 3122 | P(N+NP,J)=PQT*PV(1,J) |
| 3123 | 240 PV(1,J)=(1.-PQT)*PV(1,J) |
| 3124 | IF(PS+PARJ(64).GT.PV(1,5)) GOTO 150 |
| 3125 | ND=NP-1 |
| 3126 | MREM=1 |
| 3127 | |
| 3128 | C...Phase space factors imposed in W decay. |
| 3129 | ELSEIF(MMAT.EQ.46) THEN |
| 3130 | MSTJ(93)=1 |
| 3131 | PSMC=ULMASS(K(N+1,2)) |
| 3132 | MSTJ(93)=1 |
| 3133 | PSMC=PSMC+ULMASS(K(N+2,2)) |
| 3134 | IF(MAX(PS,PSMC)+PARJ(32).GT.PV(1,5)) GOTO 130 |
| 3135 | HR1=(P(N+1,5)/PV(1,5))**2 |
| 3136 | HR2=(P(N+2,5)/PV(1,5))**2 |
| 3137 | IF((1.-HR1-HR2)*(2.+HR1+HR2)*SQRT((1.-HR1-HR2)**2-4.*HR1*HR2). |
| 3138 | & LT.2.*RLU(0)) GOTO 130 |
| 3139 | ND=NP |
| 3140 | |
| 3141 | C...Fully specified final state: check mass broadening effects. |
| 3142 | ELSE |
| 3143 | IF(NP.GE.2.AND.PS+PARJ(64).GT.PV(1,5)) GOTO 150 |
| 3144 | ND=NP |
| 3145 | ENDIF |
| 3146 | |
| 3147 | C...Select W mass in decay Q -> W + q, without W propagator. |
| 3148 | IF(MMAT.EQ.45.AND.MSTJ(25).LE.0) THEN |
| 3149 | HLQ=(PARJ(32)/PV(1,5))**2 |
| 3150 | HUQ=(1.-(P(N+2,5)+PARJ(64))/PV(1,5))**2 |
| 3151 | HRQ=(P(N+2,5)/PV(1,5))**2 |
| 3152 | 250 HW=HLQ+RLU(0)*(HUQ-HLQ) |
| 3153 | IF(HMEPS(HW).LT.RLU(0)) GOTO 250 |
| 3154 | P(N+1,5)=PV(1,5)*SQRT(HW) |
| 3155 | |
| 3156 | C...Ditto, including W propagator. Divide mass range into three regions. |
| 3157 | ELSEIF(MMAT.EQ.45) THEN |
| 3158 | HQW=(PV(1,5)/PMAS(24,1))**2 |
| 3159 | HLW=(PARJ(32)/PMAS(24,1))**2 |
| 3160 | HUW=((PV(1,5)-P(N+2,5)-PARJ(64))/PMAS(24,1))**2 |
| 3161 | HRQ=(P(N+2,5)/PV(1,5))**2 |
| 3162 | HG=PMAS(24,2)/PMAS(24,1) |
| 3163 | HATL=ATAN((HLW-1.)/HG) |
| 3164 | HM=MIN(1.,HUW-0.001) |
| 3165 | HMV1=HMEPS(HM/HQW)/((HM-1.)**2+HG**2) |
| 3166 | 260 HM=HM-HG |
| 3167 | HMV2=HMEPS(HM/HQW)/((HM-1.)**2+HG**2) |
| 3168 | IF(HMV2.GT.HMV1.AND.HM-HG.GT.HLW) THEN |
| 3169 | HMV1=HMV2 |
| 3170 | GOTO 260 |
| 3171 | ENDIF |
| 3172 | HMV=MIN(2.*HMV1,HMEPS(HM/HQW)/HG**2) |
| 3173 | HM1=1.-SQRT(1./HMV-HG**2) |
| 3174 | IF(HM1.GT.HLW.AND.HM1.LT.HM) THEN |
| 3175 | HM=HM1 |
| 3176 | ELSEIF(HMV2.LE.HMV1) THEN |
| 3177 | HM=MAX(HLW,HM-MIN(0.1,1.-HM)) |
| 3178 | ENDIF |
| 3179 | HATM=ATAN((HM-1.)/HG) |
| 3180 | HWT1=(HATM-HATL)/HG |
| 3181 | HWT2=HMV*(MIN(1.,HUW)-HM) |
| 3182 | HWT3=0. |
| 3183 | IF(HUW.GT.1.) THEN |
| 3184 | HATU=ATAN((HUW-1.)/HG) |
| 3185 | HMP1=HMEPS(1./HQW) |
| 3186 | HWT3=HMP1*HATU/HG |
| 3187 | ENDIF |
| 3188 | |
| 3189 | C...Select mass region and W mass there. Accept according to weight. |
| 3190 | 270 HREG=RLU(0)*(HWT1+HWT2+HWT3) |
| 3191 | IF(HREG.LE.HWT1) THEN |
| 3192 | HW=1.+HG*TAN(HATL+RLU(0)*(HATM-HATL)) |
| 3193 | HACC=HMEPS(HW/HQW) |
| 3194 | ELSEIF(HREG.LE.HWT1+HWT2) THEN |
| 3195 | HW=HM+RLU(0)*(MIN(1.,HUW)-HM) |
| 3196 | HACC=HMEPS(HW/HQW)/((HW-1.)**2+HG**2)/HMV |
| 3197 | ELSE |
| 3198 | HW=1.+HG*TAN(RLU(0)*HATU) |
| 3199 | HACC=HMEPS(HW/HQW)/HMP1 |
| 3200 | ENDIF |
| 3201 | IF(HACC.LT.RLU(0)) GOTO 270 |
| 3202 | P(N+1,5)=PMAS(24,1)*SQRT(HW) |
| 3203 | ENDIF |
| 3204 | |
| 3205 | C...Determine position of grandmother, number of sisters, Q -> W sign. |
| 3206 | NM=0 |
| 3207 | KFAS=0 |
| 3208 | MSGN=0 |
| 3209 | IF(MMAT.EQ.3.OR.MMAT.EQ.46) THEN |
| 3210 | IM=K(IP,3) |
| 3211 | IF(IM.LT.0.OR.IM.GE.IP) IM=0 |
| 3212 | IF(IM.NE.0) KFAM=IABS(K(IM,2)) |
| 3213 | IF(IM.NE.0.AND.MMAT.EQ.3) THEN |
| 3214 | DO 280 IL=MAX(IP-2,IM+1),MIN(IP+2,N) |
| 3215 | IF(K(IL,3).EQ.IM) NM=NM+1 |
| 3216 | 280 IF(K(IL,3).EQ.IM.AND.IL.NE.IP) ISIS=IL |
| 3217 | IF(NM.NE.2.OR.KFAM.LE.100.OR.MOD(KFAM,10).NE.1.OR. |
| 3218 | & MOD(KFAM/1000,10).NE.0) NM=0 |
| 3219 | IF(NM.EQ.2) THEN |
| 3220 | KFAS=IABS(K(ISIS,2)) |
| 3221 | IF((KFAS.LE.100.OR.MOD(KFAS,10).NE.1.OR. |
| 3222 | & MOD(KFAS/1000,10).NE.0).AND.KFAS.NE.22) NM=0 |
| 3223 | ENDIF |
| 3224 | ELSEIF(IM.NE.0.AND.MMAT.EQ.46) THEN |
| 3225 | MSGN=ISIGN(1,K(IM,2)*K(IP,2)) |
| 3226 | IF(KFAM.GT.100.AND.MOD(KFAM/1000,10).EQ.0) MSGN= |
| 3227 | & MSGN*(-1)**MOD(KFAM/100,10) |
| 3228 | ENDIF |
| 3229 | ENDIF |
| 3230 | |
| 3231 | C...Kinematics of one-particle decays. |
| 3232 | IF(ND.EQ.1) THEN |
| 3233 | DO 290 J=1,4 |
| 3234 | 290 P(N+1,J)=P(IP,J) |
| 3235 | GOTO 520 |
| 3236 | ENDIF |
| 3237 | |
| 3238 | C...Calculate maximum weight ND-particle decay. |
| 3239 | PV(ND,5)=P(N+ND,5) |
| 3240 | IF(ND.GE.3) THEN |
| 3241 | WTMAX=1./WTCOR(ND-2) |
| 3242 | PMAX=PV(1,5)-PS+P(N+ND,5) |
| 3243 | PMIN=0. |
| 3244 | DO 300 IL=ND-1,1,-1 |
| 3245 | PMAX=PMAX+P(N+IL,5) |
| 3246 | PMIN=PMIN+P(N+IL+1,5) |
| 3247 | 300 WTMAX=WTMAX*PAWT(PMAX,PMIN,P(N+IL,5)) |
| 3248 | ENDIF |
| 3249 | |
| 3250 | C...Find virtual gamma mass in Dalitz decay. |
| 3251 | 310 IF(ND.EQ.2) THEN |
| 3252 | ELSEIF(MMAT.EQ.2) THEN |
| 3253 | PMES=4.*PMAS(11,1)**2 |
| 3254 | PMRHO2=PMAS(131,1)**2 |
| 3255 | PGRHO2=PMAS(131,2)**2 |
| 3256 | 320 PMST=PMES*(P(IP,5)**2/PMES)**RLU(0) |
| 3257 | WT=(1+0.5*PMES/PMST)*SQRT(MAX(0.,1.-PMES/PMST))* |
| 3258 | & (1.-PMST/P(IP,5)**2)**3*(1.+PGRHO2/PMRHO2)/ |
| 3259 | & ((1.-PMST/PMRHO2)**2+PGRHO2/PMRHO2) |
| 3260 | IF(WT.LT.RLU(0)) GOTO 320 |
| 3261 | PV(2,5)=MAX(2.00001*PMAS(11,1),SQRT(PMST)) |
| 3262 | |
| 3263 | C...M-generator gives weight. If rejected, try again. |
| 3264 | ELSE |
| 3265 | 330 RORD(1)=1. |
| 3266 | DO 350 IL1=2,ND-1 |
| 3267 | RSAV=RLU(0) |
| 3268 | DO 340 IL2=IL1-1,1,-1 |
| 3269 | IF(RSAV.LE.RORD(IL2)) GOTO 350 |
| 3270 | 340 RORD(IL2+1)=RORD(IL2) |
| 3271 | 350 RORD(IL2+1)=RSAV |
| 3272 | RORD(ND)=0. |
| 3273 | WT=1. |
| 3274 | DO 360 IL=ND-1,1,-1 |
| 3275 | PV(IL,5)=PV(IL+1,5)+P(N+IL,5)+(RORD(IL)-RORD(IL+1))*(PV(1,5)-PS) |
| 3276 | 360 WT=WT*PAWT(PV(IL,5),PV(IL+1,5),P(N+IL,5)) |
| 3277 | IF(WT.LT.RLU(0)*WTMAX) GOTO 330 |
| 3278 | ENDIF |
| 3279 | |
| 3280 | C...Perform two-particle decays in respective CM frame. |
| 3281 | 370 DO 390 IL=1,ND-1 |
| 3282 | PA=PAWT(PV(IL,5),PV(IL+1,5),P(N+IL,5)) |
| 3283 | UE(3)=2.*RLU(0)-1. |
| 3284 | PHI=PARU(2)*RLU(0) |
| 3285 | UE(1)=SQRT(1.-UE(3)**2)*COS(PHI) |
| 3286 | UE(2)=SQRT(1.-UE(3)**2)*SIN(PHI) |
| 3287 | DO 380 J=1,3 |
| 3288 | P(N+IL,J)=PA*UE(J) |
| 3289 | 380 PV(IL+1,J)=-PA*UE(J) |
| 3290 | P(N+IL,4)=SQRT(PA**2+P(N+IL,5)**2) |
| 3291 | 390 PV(IL+1,4)=SQRT(PA**2+PV(IL+1,5)**2) |
| 3292 | |
| 3293 | C...Lorentz transform decay products to lab frame. |
| 3294 | DO 400 J=1,4 |
| 3295 | 400 P(N+ND,J)=PV(ND,J) |
| 3296 | DO 430 IL=ND-1,1,-1 |
| 3297 | DO 410 J=1,3 |
| 3298 | 410 BE(J)=PV(IL,J)/PV(IL,4) |
| 3299 | GA=PV(IL,4)/PV(IL,5) |
| 3300 | DO 430 I=N+IL,N+ND |
| 3301 | BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3) |
| 3302 | DO 420 J=1,3 |
| 3303 | 420 P(I,J)=P(I,J)+GA*(GA*BEP/(1.+GA)+P(I,4))*BE(J) |
| 3304 | 430 P(I,4)=GA*(P(I,4)+BEP) |
| 3305 | |
| 3306 | C...Check that no infinite loop in matrix element weight. |
| 3307 | NTRY=NTRY+1 |
| 3308 | IF(NTRY.GT.800) GOTO 450 |
| 3309 | |
| 3310 | C...Matrix elements for omega and phi decays. |
| 3311 | IF(MMAT.EQ.1) THEN |
| 3312 | WT=(P(N+1,5)*P(N+2,5)*P(N+3,5))**2-(P(N+1,5)*FOUR(N+2,N+3))**2 |
| 3313 | & -(P(N+2,5)*FOUR(N+1,N+3))**2-(P(N+3,5)*FOUR(N+1,N+2))**2 |
| 3314 | & +2.*FOUR(N+1,N+2)*FOUR(N+1,N+3)*FOUR(N+2,N+3) |
| 3315 | IF(MAX(WT*WTCOR(9)/P(IP,5)**6,0.001).LT.RLU(0)) GOTO 310 |
| 3316 | |
| 3317 | C...Matrix elements for pi0 or eta Dalitz decay to gamma e+ e-. |
| 3318 | ELSEIF(MMAT.EQ.2) THEN |
| 3319 | FOUR12=FOUR(N+1,N+2) |
| 3320 | FOUR13=FOUR(N+1,N+3) |
| 3321 | WT=(PMST-0.5*PMES)*(FOUR12**2+FOUR13**2)+ |
| 3322 | & PMES*(FOUR12*FOUR13+FOUR12**2+FOUR13**2) |
| 3323 | IF(WT.LT.RLU(0)*0.25*PMST*(P(IP,5)**2-PMST)**2) GOTO 370 |
| 3324 | |
| 3325 | C...Matrix element for S0 -> S1 + V1 -> S1 + S2 + S3 (S scalar, |
| 3326 | C...V vector), of form cos**2(theta02) in V1 rest frame, and for |
| 3327 | C...S0 -> gamma + V1 -> gamma + S2 + S3, of form sin**2(theta02). |
| 3328 | ELSEIF(MMAT.EQ.3.AND.NM.EQ.2) THEN |
| 3329 | FOUR10=FOUR(IP,IM) |
| 3330 | FOUR12=FOUR(IP,N+1) |
| 3331 | FOUR02=FOUR(IM,N+1) |
| 3332 | PMS1=P(IP,5)**2 |
| 3333 | PMS0=P(IM,5)**2 |
| 3334 | PMS2=P(N+1,5)**2 |
| 3335 | IF(KFAS.NE.22) HNUM=(FOUR10*FOUR12-PMS1*FOUR02)**2 |
| 3336 | IF(KFAS.EQ.22) HNUM=PMS1*(2.*FOUR10*FOUR12*FOUR02- |
| 3337 | & PMS1*FOUR02**2-PMS0*FOUR12**2-PMS2*FOUR10**2+PMS1*PMS0*PMS2) |
| 3338 | HNUM=MAX(1E-6*PMS1**2*PMS0*PMS2,HNUM) |
| 3339 | HDEN=(FOUR10**2-PMS1*PMS0)*(FOUR12**2-PMS1*PMS2) |
| 3340 | IF(HNUM.LT.RLU(0)*HDEN) GOTO 370 |
| 3341 | |
| 3342 | C...Matrix element for "onium" -> g + g + g or gamma + g + g. |
| 3343 | ELSEIF(MMAT.EQ.4) THEN |
| 3344 | HX1=2.*FOUR(IP,N+1)/P(IP,5)**2 |
| 3345 | HX2=2.*FOUR(IP,N+2)/P(IP,5)**2 |
| 3346 | HX3=2.*FOUR(IP,N+3)/P(IP,5)**2 |
| 3347 | WT=((1.-HX1)/(HX2*HX3))**2+((1.-HX2)/(HX1*HX3))**2+ |
| 3348 | & ((1.-HX3)/(HX1*HX2))**2 |
| 3349 | IF(WT.LT.2.*RLU(0)) GOTO 310 |
| 3350 | IF(K(IP+1,2).EQ.22.AND.(1.-HX1)*P(IP,5)**2.LT.4.*PARJ(32)**2) |
| 3351 | & GOTO 310 |
| 3352 | |
| 3353 | C...Effective matrix element for nu spectrum in tau -> nu + hadrons. |
| 3354 | ELSEIF(MMAT.EQ.41) THEN |
| 3355 | HX1=2.*FOUR(IP,N+1)/P(IP,5)**2 |
| 3356 | IF(8.*HX1*(3.-2.*HX1)/9..LT.RLU(0)) GOTO 310 |
| 3357 | |
| 3358 | C...Matrix elements for weak decays (only semileptonic for c and b) |
| 3359 | ELSEIF(MMAT.GE.42.AND.MMAT.LE.44.AND.ND.EQ.3) THEN |
| 3360 | IF(MBST.EQ.0) WT=FOUR(IP,N+1)*FOUR(N+2,N+3) |
| 3361 | IF(MBST.EQ.1) WT=P(IP,5)*P(N+1,4)*FOUR(N+2,N+3) |
| 3362 | IF(WT.LT.RLU(0)*P(IP,5)*PV(1,5)**3/WTCOR(10)) GOTO 310 |
| 3363 | ELSEIF(MMAT.GE.42.AND.MMAT.LE.44) THEN |
| 3364 | DO 440 J=1,4 |
| 3365 | P(N+NP+1,J)=0. |
| 3366 | DO 440 IS=N+3,N+NP |
| 3367 | 440 P(N+NP+1,J)=P(N+NP+1,J)+P(IS,J) |
| 3368 | IF(MBST.EQ.0) WT=FOUR(IP,N+1)*FOUR(N+2,N+NP+1) |
| 3369 | IF(MBST.EQ.1) WT=P(IP,5)*P(N+1,4)*FOUR(N+2,N+NP+1) |
| 3370 | IF(WT.LT.RLU(0)*P(IP,5)*PV(1,5)**3/WTCOR(10)) GOTO 310 |
| 3371 | |
| 3372 | C...Angular distribution in W decay. |
| 3373 | ELSEIF(MMAT.EQ.46.AND.MSGN.NE.0) THEN |
| 3374 | IF(MSGN.GT.0) WT=FOUR(IM,N+1)*FOUR(N+2,IP+1) |
| 3375 | IF(MSGN.LT.0) WT=FOUR(IM,N+2)*FOUR(N+1,IP+1) |
| 3376 | IF(WT.LT.RLU(0)*P(IM,5)**4/WTCOR(10)) GOTO 370 |
| 3377 | ENDIF |
| 3378 | |
| 3379 | C...Scale back energy and reattach spectator. |
| 3380 | 450 IF(MREM.EQ.1) THEN |
| 3381 | DO 460 J=1,5 |
| 3382 | 460 PV(1,J)=PV(1,J)/(1.-PQT) |
| 3383 | ND=ND+1 |
| 3384 | MREM=0 |
| 3385 | ENDIF |
| 3386 | |
| 3387 | C...Low invariant mass for system with spectator quark gives particle, |
| 3388 | C...not two jets. Readjust momenta accordingly. |
| 3389 | IF((MMAT.EQ.31.OR.MMAT.EQ.45).AND.ND.EQ.3) THEN |
| 3390 | MSTJ(93)=1 |
| 3391 | PM2=ULMASS(K(N+2,2)) |
| 3392 | MSTJ(93)=1 |
| 3393 | PM3=ULMASS(K(N+3,2)) |
| 3394 | IF(P(N+2,5)**2+P(N+3,5)**2+2.*FOUR(N+2,N+3).GE. |
| 3395 | & (PARJ(32)+PM2+PM3)**2) GOTO 520 |
| 3396 | K(N+2,1)=1 |
| 3397 | KFTEMP=K(N+2,2) |
| 3398 | CALL LUKFDI(KFTEMP,K(N+3,2),KFLDMP,K(N+2,2)) |
| 3399 | IF(K(N+2,2).EQ.0) GOTO 150 |
| 3400 | P(N+2,5)=ULMASS(K(N+2,2)) |
| 3401 | PS=P(N+1,5)+P(N+2,5) |
| 3402 | PV(2,5)=P(N+2,5) |
| 3403 | MMAT=0 |
| 3404 | ND=2 |
| 3405 | GOTO 370 |
| 3406 | ELSEIF(MMAT.EQ.44) THEN |
| 3407 | MSTJ(93)=1 |
| 3408 | PM3=ULMASS(K(N+3,2)) |
| 3409 | MSTJ(93)=1 |
| 3410 | PM4=ULMASS(K(N+4,2)) |
| 3411 | IF(P(N+3,5)**2+P(N+4,5)**2+2.*FOUR(N+3,N+4).GE. |
| 3412 | & (PARJ(32)+PM3+PM4)**2) GOTO 490 |
| 3413 | K(N+3,1)=1 |
| 3414 | KFTEMP=K(N+3,2) |
| 3415 | CALL LUKFDI(KFTEMP,K(N+4,2),KFLDMP,K(N+3,2)) |
| 3416 | IF(K(N+3,2).EQ.0) GOTO 150 |
| 3417 | P(N+3,5)=ULMASS(K(N+3,2)) |
| 3418 | DO 470 J=1,3 |
| 3419 | 470 P(N+3,J)=P(N+3,J)+P(N+4,J) |
| 3420 | 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) |
| 3421 | HA=P(N+1,4)**2-P(N+2,4)**2 |
| 3422 | HB=HA-(P(N+1,5)**2-P(N+2,5)**2) |
| 3423 | HC=(P(N+1,1)-P(N+2,1))**2+(P(N+1,2)-P(N+2,2))**2+ |
| 3424 | & (P(N+1,3)-P(N+2,3))**2 |
| 3425 | HD=(PV(1,4)-P(N+3,4))**2 |
| 3426 | HE=HA**2-2.*HD*(P(N+1,4)**2+P(N+2,4)**2)+HD**2 |
| 3427 | HF=HD*HC-HB**2 |
| 3428 | HG=HD*HC-HA*HB |
| 3429 | HH=(SQRT(HG**2+HE*HF)-HG)/(2.*HF) |
| 3430 | DO 480 J=1,3 |
| 3431 | PCOR=HH*(P(N+1,J)-P(N+2,J)) |
| 3432 | P(N+1,J)=P(N+1,J)+PCOR |
| 3433 | 480 P(N+2,J)=P(N+2,J)-PCOR |
| 3434 | 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) |
| 3435 | 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) |
| 3436 | ND=ND-1 |
| 3437 | ENDIF |
| 3438 | |
| 3439 | C...Check invariant mass of W jets. May give one particle or start over. |
| 3440 | 490 IF(MMAT.GE.42.AND.MMAT.LE.44.AND.IABS(K(N+1,2)).LT.10) THEN |
| 3441 | PMR=SQRT(MAX(0.,P(N+1,5)**2+P(N+2,5)**2+2.*FOUR(N+1,N+2))) |
| 3442 | MSTJ(93)=1 |
| 3443 | PM1=ULMASS(K(N+1,2)) |
| 3444 | MSTJ(93)=1 |
| 3445 | PM2=ULMASS(K(N+2,2)) |
| 3446 | IF(PMR.GT.PARJ(32)+PM1+PM2) GOTO 500 |
| 3447 | KFLDUM=INT(1.5+RLU(0)) |
| 3448 | CALL LUKFDI(K(N+1,2),-ISIGN(KFLDUM,K(N+1,2)),KFLDMP,KF1) |
| 3449 | CALL LUKFDI(K(N+2,2),-ISIGN(KFLDUM,K(N+2,2)),KFLDMP,KF2) |
| 3450 | IF(KF1.EQ.0.OR.KF2.EQ.0) GOTO 150 |
| 3451 | PSM=ULMASS(KF1)+ULMASS(KF2) |
| 3452 | IF(MMAT.EQ.42.AND.PMR.GT.PARJ(64)+PSM) GOTO 500 |
| 3453 | IF(MMAT.GE.43.AND.PMR.GT.0.2*PARJ(32)+PSM) GOTO 500 |
| 3454 | IF(ND.EQ.4.OR.KFA.EQ.15) GOTO 150 |
| 3455 | K(N+1,1)=1 |
| 3456 | KFTEMP=K(N+1,2) |
| 3457 | CALL LUKFDI(KFTEMP,K(N+2,2),KFLDMP,K(N+1,2)) |
| 3458 | IF(K(N+1,2).EQ.0) GOTO 150 |
| 3459 | P(N+1,5)=ULMASS(K(N+1,2)) |
| 3460 | K(N+2,2)=K(N+3,2) |
| 3461 | P(N+2,5)=P(N+3,5) |
| 3462 | PS=P(N+1,5)+P(N+2,5) |
| 3463 | PV(2,5)=P(N+3,5) |
| 3464 | MMAT=0 |
| 3465 | ND=2 |
| 3466 | GOTO 370 |
| 3467 | ENDIF |
| 3468 | |
| 3469 | C...Phase space decay of partons from W decay. |
| 3470 | 500 IF(MMAT.EQ.42.AND.IABS(K(N+1,2)).LT.10) THEN |
| 3471 | KFLO(1)=K(N+1,2) |
| 3472 | KFLO(2)=K(N+2,2) |
| 3473 | K(N+1,1)=K(N+3,1) |
| 3474 | K(N+1,2)=K(N+3,2) |
| 3475 | DO 510 J=1,5 |
| 3476 | PV(1,J)=P(N+1,J)+P(N+2,J) |
| 3477 | 510 P(N+1,J)=P(N+3,J) |
| 3478 | PV(1,5)=PMR |
| 3479 | N=N+1 |
| 3480 | NP=0 |
| 3481 | NQ=2 |
| 3482 | PS=0. |
| 3483 | MSTJ(93)=2 |
| 3484 | PSQ=ULMASS(KFLO(1)) |
| 3485 | MSTJ(93)=2 |
| 3486 | PSQ=PSQ+ULMASS(KFLO(2)) |
| 3487 | MMAT=11 |
| 3488 | GOTO 180 |
| 3489 | ENDIF |
| 3490 | |
| 3491 | C...Boost back for rapidly moving particle. |
| 3492 | 520 N=N+ND |
| 3493 | IF(MBST.EQ.1) THEN |
| 3494 | DO 530 J=1,3 |
| 3495 | 530 BE(J)=P(IP,J)/P(IP,4) |
| 3496 | GA=P(IP,4)/P(IP,5) |
| 3497 | DO 550 I=NSAV+1,N |
| 3498 | BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3) |
| 3499 | DO 540 J=1,3 |
| 3500 | 540 P(I,J)=P(I,J)+GA*(GA*BEP/(1.+GA)+P(I,4))*BE(J) |
| 3501 | 550 P(I,4)=GA*(P(I,4)+BEP) |
| 3502 | ENDIF |
| 3503 | |
| 3504 | C...Fill in position of decay vertex. |
| 3505 | DO 570 I=NSAV+1,N |
| 3506 | DO 560 J=1,4 |
| 3507 | 560 V(I,J)=VDCY(J) |
| 3508 | 570 V(I,5)=0. |
| 3509 | |
| 3510 | C...Set up for parton shower evolution from jets. |
| 3511 | IF(MSTJ(23).GE.1.AND.MMAT.EQ.4.AND.K(NSAV+1,2).EQ.21) THEN |
| 3512 | K(NSAV+1,1)=3 |
| 3513 | K(NSAV+2,1)=3 |
| 3514 | K(NSAV+3,1)=3 |
| 3515 | K(NSAV+1,4)=MSTU(5)*(NSAV+2) |
| 3516 | K(NSAV+1,5)=MSTU(5)*(NSAV+3) |
| 3517 | K(NSAV+2,4)=MSTU(5)*(NSAV+3) |
| 3518 | K(NSAV+2,5)=MSTU(5)*(NSAV+1) |
| 3519 | K(NSAV+3,4)=MSTU(5)*(NSAV+1) |
| 3520 | K(NSAV+3,5)=MSTU(5)*(NSAV+2) |
| 3521 | MSTJ(92)=-(NSAV+1) |
| 3522 | ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.4) THEN |
| 3523 | K(NSAV+2,1)=3 |
| 3524 | K(NSAV+3,1)=3 |
| 3525 | K(NSAV+2,4)=MSTU(5)*(NSAV+3) |
| 3526 | K(NSAV+2,5)=MSTU(5)*(NSAV+3) |
| 3527 | K(NSAV+3,4)=MSTU(5)*(NSAV+2) |
| 3528 | K(NSAV+3,5)=MSTU(5)*(NSAV+2) |
| 3529 | MSTJ(92)=NSAV+2 |
| 3530 | ELSEIF(MSTJ(23).GE.1.AND.(MMAT.EQ.32.OR.MMAT.EQ.44.OR.MMAT.EQ.46). |
| 3531 | &AND.IABS(K(NSAV+1,2)).LE.10.AND.IABS(K(NSAV+2,2)).LE.10) THEN |
| 3532 | K(NSAV+1,1)=3 |
| 3533 | K(NSAV+2,1)=3 |
| 3534 | K(NSAV+1,4)=MSTU(5)*(NSAV+2) |
| 3535 | K(NSAV+1,5)=MSTU(5)*(NSAV+2) |
| 3536 | K(NSAV+2,4)=MSTU(5)*(NSAV+1) |
| 3537 | K(NSAV+2,5)=MSTU(5)*(NSAV+1) |
| 3538 | MSTJ(92)=NSAV+1 |
| 3539 | ELSEIF(MSTJ(23).GE.1.AND.(MMAT.EQ.32.OR.MMAT.EQ.44.OR.MMAT.EQ.46). |
| 3540 | &AND.IABS(K(NSAV+1,2)).LE.20.AND.IABS(K(NSAV+2,2)).LE.20) THEN |
| 3541 | MSTJ(92)=NSAV+1 |
| 3542 | ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.33.AND.IABS(K(NSAV+2,2)).EQ.21) |
| 3543 | &THEN |
| 3544 | K(NSAV+1,1)=3 |
| 3545 | K(NSAV+2,1)=3 |
| 3546 | K(NSAV+3,1)=3 |
| 3547 | KCP=LUCOMP(K(NSAV+1,2)) |
| 3548 | KQP=KCHG(KCP,2)*ISIGN(1,K(NSAV+1,2)) |
| 3549 | JCON=4 |
| 3550 | IF(KQP.LT.0) JCON=5 |
| 3551 | K(NSAV+1,JCON)=MSTU(5)*(NSAV+2) |
| 3552 | K(NSAV+2,9-JCON)=MSTU(5)*(NSAV+1) |
| 3553 | K(NSAV+2,JCON)=MSTU(5)*(NSAV+3) |
| 3554 | K(NSAV+3,9-JCON)=MSTU(5)*(NSAV+2) |
| 3555 | MSTJ(92)=NSAV+1 |
| 3556 | ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.33) THEN |
| 3557 | K(NSAV+1,1)=3 |
| 3558 | K(NSAV+3,1)=3 |
| 3559 | K(NSAV+1,4)=MSTU(5)*(NSAV+3) |
| 3560 | K(NSAV+1,5)=MSTU(5)*(NSAV+3) |
| 3561 | K(NSAV+3,4)=MSTU(5)*(NSAV+1) |
| 3562 | K(NSAV+3,5)=MSTU(5)*(NSAV+1) |
| 3563 | MSTJ(92)=NSAV+1 |
| 3564 | ENDIF |
| 3565 | |
| 3566 | C...Mark decayed particle; special option for B-B~ mixing. |
| 3567 | IF(K(IP,1).EQ.5) K(IP,1)=15 |
| 3568 | IF(K(IP,1).LE.10) K(IP,1)=11 |
| 3569 | IF(MMIX.EQ.1.AND.MSTJ(26).EQ.2.AND.K(IP,1).EQ.11) K(IP,1)=12 |
| 3570 | K(IP,4)=NSAV+1 |
| 3571 | K(IP,5)=N |
| 3572 | |
| 3573 | RETURN |
| 3574 | END |
| 3575 | |
| 3576 | C********************************************************************* |
| 3577 | |
| 3578 | SUBROUTINE LUKFDI(KFL1,KFL2,KFL3,KF) |
| 3579 | |
| 3580 | C...Purpose: to generate a new flavour pair and combine off a hadron. |
| 3581 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 3582 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 3583 | SAVE /LUDAT1/,/LUDAT2/ |
| 3584 | |
| 3585 | C...Default flavour values. Input consistency checks. |
| 3586 | KF1A=IABS(KFL1) |
| 3587 | KF2A=IABS(KFL2) |
| 3588 | KFL3=0 |
| 3589 | KF=0 |
| 3590 | IF(KF1A.EQ.0) RETURN |
| 3591 | IF(KF2A.NE.0) THEN |
| 3592 | IF(KF1A.LE.10.AND.KF2A.LE.10.AND.KFL1*KFL2.GT.0) RETURN |
| 3593 | IF(KF1A.GT.10.AND.KF2A.GT.10) RETURN |
| 3594 | IF((KF1A.GT.10.OR.KF2A.GT.10).AND.KFL1*KFL2.LT.0) RETURN |
| 3595 | ENDIF |
| 3596 | |
| 3597 | C...Check if tabulated flavour probabilities are to be used. |
| 3598 | IF(MSTJ(15).EQ.1) THEN |
| 3599 | KTAB1=-1 |
| 3600 | IF(KF1A.GE.1.AND.KF1A.LE.6) KTAB1=KF1A |
| 3601 | KFL1A=MOD(KF1A/1000,10) |
| 3602 | KFL1B=MOD(KF1A/100,10) |
| 3603 | KFL1S=MOD(KF1A,10) |
| 3604 | IF(KFL1A.GE.1.AND.KFL1A.LE.4.AND.KFL1B.GE.1.AND.KFL1B.LE.4) |
| 3605 | & KTAB1=6+KFL1A*(KFL1A-2)+2*KFL1B+(KFL1S-1)/2 |
| 3606 | IF(KFL1A.GE.1.AND.KFL1A.LE.4.AND.KFL1A.EQ.KFL1B) KTAB1=KTAB1-1 |
| 3607 | IF(KF1A.GE.1.AND.KF1A.LE.6) KFL1A=KF1A |
| 3608 | KTAB2=0 |
| 3609 | IF(KF2A.NE.0) THEN |
| 3610 | KTAB2=-1 |
| 3611 | IF(KF2A.GE.1.AND.KF2A.LE.6) KTAB2=KF2A |
| 3612 | KFL2A=MOD(KF2A/1000,10) |
| 3613 | KFL2B=MOD(KF2A/100,10) |
| 3614 | KFL2S=MOD(KF2A,10) |
| 3615 | IF(KFL2A.GE.1.AND.KFL2A.LE.4.AND.KFL2B.GE.1.AND.KFL2B.LE.4) |
| 3616 | & KTAB2=6+KFL2A*(KFL2A-2)+2*KFL2B+(KFL2S-1)/2 |
| 3617 | IF(KFL2A.GE.1.AND.KFL2A.LE.4.AND.KFL2A.EQ.KFL2B) KTAB2=KTAB2-1 |
| 3618 | ENDIF |
| 3619 | IF(KTAB1.GE.0.AND.KTAB2.GE.0) GOTO 140 |
| 3620 | ENDIF |
| 3621 | |
| 3622 | C...Parameters and breaking diquark parameter combinations. |
| 3623 | 100 PAR2=PARJ(2) |
| 3624 | PAR3=PARJ(3) |
| 3625 | PAR4=3.*PARJ(4) |
| 3626 | IF(MSTJ(12).GE.2) THEN |
| 3627 | PAR3M=SQRT(PARJ(3)) |
| 3628 | PAR4M=1./(3.*SQRT(PARJ(4))) |
| 3629 | PARDM=PARJ(7)/(PARJ(7)+PAR3M*PARJ(6)) |
| 3630 | PARS0=PARJ(5)*(2.+(1.+PAR2*PAR3M*PARJ(7))*(1.+PAR4M)) |
| 3631 | PARS1=PARJ(7)*PARS0/(2.*PAR3M)+PARJ(5)*(PARJ(6)*(1.+PAR4M)+ |
| 3632 | & PAR2*PAR3M*PARJ(6)*PARJ(7)) |
| 3633 | PARS2=PARJ(5)*2.*PARJ(6)*PARJ(7)*(PAR2*PARJ(7)+(1.+PAR4M)/PAR3M) |
| 3634 | PARSM=MAX(PARS0,PARS1,PARS2) |
| 3635 | PAR4=PAR4*(1.+PARSM)/(1.+PARSM/(3.*PAR4M)) |
| 3636 | ENDIF |
| 3637 | |
| 3638 | C...Choice of whether to generate meson or baryon. |
| 3639 | MBARY=0 |
| 3640 | KFDA=0 |
| 3641 | IF(KF1A.LE.10) THEN |
| 3642 | IF(KF2A.EQ.0.AND.MSTJ(12).GE.1.AND.(1.+PARJ(1))*RLU(0).GT.1.) |
| 3643 | & MBARY=1 |
| 3644 | IF(KF2A.GT.10) MBARY=2 |
| 3645 | IF(KF2A.GT.10.AND.KF2A.LE.10000) KFDA=KF2A |
| 3646 | ELSE |
| 3647 | MBARY=2 |
| 3648 | IF(KF1A.LE.10000) KFDA=KF1A |
| 3649 | ENDIF |
| 3650 | |
| 3651 | C...Possibility of process diquark -> meson + new diquark. |
| 3652 | IF(KFDA.NE.0.AND.MSTJ(12).GE.2) THEN |
| 3653 | KFLDA=MOD(KFDA/1000,10) |
| 3654 | KFLDB=MOD(KFDA/100,10) |
| 3655 | KFLDS=MOD(KFDA,10) |
| 3656 | WTDQ=PARS0 |
| 3657 | IF(MAX(KFLDA,KFLDB).EQ.3) WTDQ=PARS1 |
| 3658 | IF(MIN(KFLDA,KFLDB).EQ.3) WTDQ=PARS2 |
| 3659 | IF(KFLDS.EQ.1) WTDQ=WTDQ/(3.*PAR4M) |
| 3660 | IF((1.+WTDQ)*RLU(0).GT.1.) MBARY=-1 |
| 3661 | IF(MBARY.EQ.-1.AND.KF2A.NE.0) RETURN |
| 3662 | ENDIF |
| 3663 | |
| 3664 | C...Flavour for meson, possibly with new flavour. |
| 3665 | IF(MBARY.LE.0) THEN |
| 3666 | KFS=ISIGN(1,KFL1) |
| 3667 | IF(MBARY.EQ.0) THEN |
| 3668 | IF(KF2A.EQ.0) KFL3=ISIGN(1+INT((2.+PAR2)*RLU(0)),-KFL1) |
| 3669 | KFLA=MAX(KF1A,KF2A+IABS(KFL3)) |
| 3670 | KFLB=MIN(KF1A,KF2A+IABS(KFL3)) |
| 3671 | IF(KFLA.NE.KF1A) KFS=-KFS |
| 3672 | |
| 3673 | C...Splitting of diquark into meson plus new diquark. |
| 3674 | ELSE |
| 3675 | KFL1A=MOD(KF1A/1000,10) |
| 3676 | KFL1B=MOD(KF1A/100,10) |
| 3677 | 110 KFL1D=KFL1A+INT(RLU(0)+0.5)*(KFL1B-KFL1A) |
| 3678 | KFL1E=KFL1A+KFL1B-KFL1D |
| 3679 | IF((KFL1D.EQ.3.AND.RLU(0).GT.PARDM).OR.(KFL1E.EQ.3.AND. |
| 3680 | & RLU(0).LT.PARDM)) THEN |
| 3681 | KFL1D=KFL1A+KFL1B-KFL1D |
| 3682 | KFL1E=KFL1A+KFL1B-KFL1E |
| 3683 | ENDIF |
| 3684 | KFL3A=1+INT((2.+PAR2*PAR3M*PARJ(7))*RLU(0)) |
| 3685 | IF((KFL1E.NE.KFL3A.AND.RLU(0).GT.(1.+PAR4M)/MAX(2.,1.+PAR4M)). |
| 3686 | & OR.(KFL1E.EQ.KFL3A.AND.RLU(0).GT.2./MAX(2.,1.+PAR4M))) |
| 3687 | & GOTO 110 |
| 3688 | KFLDS=3 |
| 3689 | IF(KFL1E.NE.KFL3A) KFLDS=2*INT(RLU(0)+1./(1.+PAR4M))+1 |
| 3690 | KFL3=ISIGN(10000+1000*MAX(KFL1E,KFL3A)+100*MIN(KFL1E,KFL3A)+ |
| 3691 | & KFLDS,-KFL1) |
| 3692 | KFLA=MAX(KFL1D,KFL3A) |
| 3693 | KFLB=MIN(KFL1D,KFL3A) |
| 3694 | IF(KFLA.NE.KFL1D) KFS=-KFS |
| 3695 | ENDIF |
| 3696 | |
| 3697 | C...Form meson, with spin and flavour mixing for diagonal states. |
| 3698 | IF(KFLA.LE.2) KMUL=INT(PARJ(11)+RLU(0)) |
| 3699 | IF(KFLA.EQ.3) KMUL=INT(PARJ(12)+RLU(0)) |
| 3700 | IF(KFLA.GE.4) KMUL=INT(PARJ(13)+RLU(0)) |
| 3701 | IF(KMUL.EQ.0.AND.PARJ(14).GT.0.) THEN |
| 3702 | IF(RLU(0).LT.PARJ(14)) KMUL=2 |
| 3703 | ELSEIF(KMUL.EQ.1.AND.PARJ(15)+PARJ(16)+PARJ(17).GT.0.) THEN |
| 3704 | RMUL=RLU(0) |
| 3705 | IF(RMUL.LT.PARJ(15)) KMUL=3 |
| 3706 | IF(KMUL.EQ.1.AND.RMUL.LT.PARJ(15)+PARJ(16)) KMUL=4 |
| 3707 | IF(KMUL.EQ.1.AND.RMUL.LT.PARJ(15)+PARJ(16)+PARJ(17)) KMUL=5 |
| 3708 | ENDIF |
| 3709 | KFLS=3 |
| 3710 | IF(KMUL.EQ.0.OR.KMUL.EQ.3) KFLS=1 |
| 3711 | IF(KMUL.EQ.5) KFLS=5 |
| 3712 | IF(KFLA.NE.KFLB) THEN |
| 3713 | KF=(100*KFLA+10*KFLB+KFLS)*KFS*(-1)**KFLA |
| 3714 | ELSE |
| 3715 | RMIX=RLU(0) |
| 3716 | IMIX=2*KFLA+10*KMUL |
| 3717 | IF(KFLA.LE.3) KF=110*(1+INT(RMIX+PARF(IMIX-1))+ |
| 3718 | & INT(RMIX+PARF(IMIX)))+KFLS |
| 3719 | IF(KFLA.GE.4) KF=110*KFLA+KFLS |
| 3720 | ENDIF |
| 3721 | IF(KMUL.EQ.2.OR.KMUL.EQ.3) KF=KF+ISIGN(10000,KF) |
| 3722 | IF(KMUL.EQ.4) KF=KF+ISIGN(20000,KF) |
| 3723 | |
| 3724 | C...Generate diquark flavour. |
| 3725 | ELSE |
| 3726 | 120 IF(KF1A.LE.10.AND.KF2A.EQ.0) THEN |
| 3727 | KFLA=KF1A |
| 3728 | 130 KFLB=1+INT((2.+PAR2*PAR3)*RLU(0)) |
| 3729 | KFLC=1+INT((2.+PAR2*PAR3)*RLU(0)) |
| 3730 | KFLDS=1 |
| 3731 | IF(KFLB.GE.KFLC) KFLDS=3 |
| 3732 | IF(KFLDS.EQ.1.AND.PAR4*RLU(0).GT.1.) GOTO 130 |
| 3733 | IF(KFLDS.EQ.3.AND.PAR4.LT.RLU(0)) GOTO 130 |
| 3734 | KFL3=ISIGN(1000*MAX(KFLB,KFLC)+100*MIN(KFLB,KFLC)+KFLDS,KFL1) |
| 3735 | |
| 3736 | C...Take diquark flavour from input. |
| 3737 | ELSEIF(KF1A.LE.10) THEN |
| 3738 | KFLA=KF1A |
| 3739 | KFLB=MOD(KF2A/1000,10) |
| 3740 | KFLC=MOD(KF2A/100,10) |
| 3741 | KFLDS=MOD(KF2A,10) |
| 3742 | |
| 3743 | C...Generate (or take from input) quark to go with diquark. |
| 3744 | ELSE |
| 3745 | IF(KF2A.EQ.0) KFL3=ISIGN(1+INT((2.+PAR2)*RLU(0)),KFL1) |
| 3746 | KFLA=KF2A+IABS(KFL3) |
| 3747 | KFLB=MOD(KF1A/1000,10) |
| 3748 | KFLC=MOD(KF1A/100,10) |
| 3749 | KFLDS=MOD(KF1A,10) |
| 3750 | ENDIF |
| 3751 | |
| 3752 | C...SU(6) factors for formation of baryon. Try again if fails. |
| 3753 | KBARY=KFLDS |
| 3754 | IF(KFLDS.EQ.3.AND.KFLB.NE.KFLC) KBARY=5 |
| 3755 | IF(KFLA.NE.KFLB.AND.KFLA.NE.KFLC) KBARY=KBARY+1 |
| 3756 | WT=PARF(60+KBARY)+PARJ(18)*PARF(70+KBARY) |
| 3757 | IF(MBARY.EQ.1.AND.MSTJ(12).GE.2) THEN |
| 3758 | WTDQ=PARS0 |
| 3759 | IF(MAX(KFLB,KFLC).EQ.3) WTDQ=PARS1 |
| 3760 | IF(MIN(KFLB,KFLC).EQ.3) WTDQ=PARS2 |
| 3761 | IF(KFLDS.EQ.1) WTDQ=WTDQ/(3.*PAR4M) |
| 3762 | IF(KFLDS.EQ.1) WT=WT*(1.+WTDQ)/(1.+PARSM/(3.*PAR4M)) |
| 3763 | IF(KFLDS.EQ.3) WT=WT*(1.+WTDQ)/(1.+PARSM) |
| 3764 | ENDIF |
| 3765 | IF(KF2A.EQ.0.AND.WT.LT.RLU(0)) GOTO 120 |
| 3766 | |
| 3767 | C...Form baryon. Distinguish Lambda- and Sigmalike baryons. |
| 3768 | KFLD=MAX(KFLA,KFLB,KFLC) |
| 3769 | KFLF=MIN(KFLA,KFLB,KFLC) |
| 3770 | KFLE=KFLA+KFLB+KFLC-KFLD-KFLF |
| 3771 | KFLS=2 |
| 3772 | IF((PARF(60+KBARY)+PARJ(18)*PARF(70+KBARY))*RLU(0).GT. |
| 3773 | & PARF(60+KBARY)) KFLS=4 |
| 3774 | KFLL=0 |
| 3775 | IF(KFLS.EQ.2.AND.KFLD.GT.KFLE.AND.KFLE.GT.KFLF) THEN |
| 3776 | IF(KFLDS.EQ.1.AND.KFLA.EQ.KFLD) KFLL=1 |
| 3777 | IF(KFLDS.EQ.1.AND.KFLA.NE.KFLD) KFLL=INT(0.25+RLU(0)) |
| 3778 | IF(KFLDS.EQ.3.AND.KFLA.NE.KFLD) KFLL=INT(0.75+RLU(0)) |
| 3779 | ENDIF |
| 3780 | IF(KFLL.EQ.0) KF=ISIGN(1000*KFLD+100*KFLE+10*KFLF+KFLS,KFL1) |
| 3781 | IF(KFLL.EQ.1) KF=ISIGN(1000*KFLD+100*KFLF+10*KFLE+KFLS,KFL1) |
| 3782 | ENDIF |
| 3783 | RETURN |
| 3784 | |
| 3785 | C...Use tabulated probabilities to select new flavour and hadron. |
| 3786 | 140 IF(KTAB2.EQ.0.AND.MSTJ(12).LE.0) THEN |
| 3787 | KT3L=1 |
| 3788 | KT3U=6 |
| 3789 | ELSEIF(KTAB2.EQ.0.AND.KTAB1.GE.7.AND.MSTJ(12).LE.1) THEN |
| 3790 | KT3L=1 |
| 3791 | KT3U=6 |
| 3792 | ELSEIF(KTAB2.EQ.0) THEN |
| 3793 | KT3L=1 |
| 3794 | KT3U=22 |
| 3795 | ELSE |
| 3796 | KT3L=KTAB2 |
| 3797 | KT3U=KTAB2 |
| 3798 | ENDIF |
| 3799 | RFL=0. |
| 3800 | DO 150 KTS=0,2 |
| 3801 | DO 150 KT3=KT3L,KT3U |
| 3802 | RFL=RFL+PARF(120+80*KTAB1+25*KTS+KT3) |
| 3803 | 150 CONTINUE |
| 3804 | RFL=RLU(0)*RFL |
| 3805 | DO 160 KTS=0,2 |
| 3806 | KTABS=KTS |
| 3807 | DO 160 KT3=KT3L,KT3U |
| 3808 | KTAB3=KT3 |
| 3809 | RFL=RFL-PARF(120+80*KTAB1+25*KTS+KT3) |
| 3810 | 160 IF(RFL.LE.0.) GOTO 170 |
| 3811 | 170 CONTINUE |
| 3812 | |
| 3813 | C...Reconstruct flavour of produced quark/diquark. |
| 3814 | IF(KTAB3.LE.6) THEN |
| 3815 | KFL3A=KTAB3 |
| 3816 | KFL3B=0 |
| 3817 | KFL3=ISIGN(KFL3A,KFL1*(2*KTAB1-13)) |
| 3818 | ELSE |
| 3819 | KFL3A=1 |
| 3820 | IF(KTAB3.GE.8) KFL3A=2 |
| 3821 | IF(KTAB3.GE.11) KFL3A=3 |
| 3822 | IF(KTAB3.GE.16) KFL3A=4 |
| 3823 | KFL3B=(KTAB3-6-KFL3A*(KFL3A-2))/2 |
| 3824 | KFL3=1000*KFL3A+100*KFL3B+1 |
| 3825 | IF(KFL3A.EQ.KFL3B.OR.KTAB3.NE.6+KFL3A*(KFL3A-2)+2*KFL3B) KFL3= |
| 3826 | & KFL3+2 |
| 3827 | KFL3=ISIGN(KFL3,KFL1*(13-2*KTAB1)) |
| 3828 | ENDIF |
| 3829 | |
| 3830 | C...Reconstruct meson code. |
| 3831 | IF(KFL3A.EQ.KFL1A.AND.KFL3B.EQ.KFL1B.AND.(KFL3A.LE.3.OR. |
| 3832 | &KFL3B.NE.0)) THEN |
| 3833 | RFL=RLU(0)*(PARF(143+80*KTAB1+25*KTABS)+PARF(144+80*KTAB1+ |
| 3834 | & 25*KTABS)+PARF(145+80*KTAB1+25*KTABS)) |
| 3835 | KF=110+2*KTABS+1 |
| 3836 | IF(RFL.GT.PARF(143+80*KTAB1+25*KTABS)) KF=220+2*KTABS+1 |
| 3837 | IF(RFL.GT.PARF(143+80*KTAB1+25*KTABS)+PARF(144+80*KTAB1+ |
| 3838 | & 25*KTABS)) KF=330+2*KTABS+1 |
| 3839 | ELSEIF(KTAB1.LE.6.AND.KTAB3.LE.6) THEN |
| 3840 | KFLA=MAX(KTAB1,KTAB3) |
| 3841 | KFLB=MIN(KTAB1,KTAB3) |
| 3842 | KFS=ISIGN(1,KFL1) |
| 3843 | IF(KFLA.NE.KF1A) KFS=-KFS |
| 3844 | KF=(100*KFLA+10*KFLB+2*KTABS+1)*KFS*(-1)**KFLA |
| 3845 | ELSEIF(KTAB1.GE.7.AND.KTAB3.GE.7) THEN |
| 3846 | KFS=ISIGN(1,KFL1) |
| 3847 | IF(KFL1A.EQ.KFL3A) THEN |
| 3848 | KFLA=MAX(KFL1B,KFL3B) |
| 3849 | KFLB=MIN(KFL1B,KFL3B) |
| 3850 | IF(KFLA.NE.KFL1B) KFS=-KFS |
| 3851 | ELSEIF(KFL1A.EQ.KFL3B) THEN |
| 3852 | KFLA=KFL3A |
| 3853 | KFLB=KFL1B |
| 3854 | KFS=-KFS |
| 3855 | ELSEIF(KFL1B.EQ.KFL3A) THEN |
| 3856 | KFLA=KFL1A |
| 3857 | KFLB=KFL3B |
| 3858 | ELSEIF(KFL1B.EQ.KFL3B) THEN |
| 3859 | KFLA=MAX(KFL1A,KFL3A) |
| 3860 | KFLB=MIN(KFL1A,KFL3A) |
| 3861 | IF(KFLA.NE.KFL1A) KFS=-KFS |
| 3862 | ELSE |
| 3863 | CALL LUERRM(2,'(LUKFDI:) no matching flavours for qq -> qq') |
| 3864 | GOTO 100 |
| 3865 | ENDIF |
| 3866 | KF=(100*KFLA+10*KFLB+2*KTABS+1)*KFS*(-1)**KFLA |
| 3867 | |
| 3868 | C...Reconstruct baryon code. |
| 3869 | ELSE |
| 3870 | IF(KTAB1.GE.7) THEN |
| 3871 | KFLA=KFL3A |
| 3872 | KFLB=KFL1A |
| 3873 | KFLC=KFL1B |
| 3874 | ELSE |
| 3875 | KFLA=KFL1A |
| 3876 | KFLB=KFL3A |
| 3877 | KFLC=KFL3B |
| 3878 | ENDIF |
| 3879 | KFLD=MAX(KFLA,KFLB,KFLC) |
| 3880 | KFLF=MIN(KFLA,KFLB,KFLC) |
| 3881 | KFLE=KFLA+KFLB+KFLC-KFLD-KFLF |
| 3882 | IF(KTABS.EQ.0) KF=ISIGN(1000*KFLD+100*KFLF+10*KFLE+2,KFL1) |
| 3883 | IF(KTABS.GE.1) KF=ISIGN(1000*KFLD+100*KFLE+10*KFLF+2*KTABS,KFL1) |
| 3884 | ENDIF |
| 3885 | |
| 3886 | C...Check that constructed flavour code is an allowed one. |
| 3887 | IF(KFL2.NE.0) KFL3=0 |
| 3888 | KC=LUCOMP(KF) |
| 3889 | IF(KC.EQ.0) THEN |
| 3890 | CALL LUERRM(2,'(LUKFDI:) user-defined flavour probabilities '// |
| 3891 | & 'failed') |
| 3892 | GOTO 100 |
| 3893 | ENDIF |
| 3894 | |
| 3895 | RETURN |
| 3896 | END |
| 3897 | |
| 3898 | C********************************************************************* |
| 3899 | |
| 3900 | SUBROUTINE LUPTDI(KFL,PX,PY) |
| 3901 | |
| 3902 | C...Purpose: to generate transverse momentum according to a Gaussian. |
| 3903 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 3904 | SAVE /LUDAT1/ |
| 3905 | |
| 3906 | C...Generate p_T and azimuthal angle, gives p_x and p_y. |
| 3907 | KFLA=IABS(KFL) |
| 3908 | PT=PARJ(21)*SQRT(-LOG(MAX(1E-10,RLU(0)))) |
| 3909 | IF(MSTJ(91).EQ.1) PT=PARJ(22)*PT |
| 3910 | IF(KFLA.EQ.0.AND.MSTJ(13).LE.0) PT=0. |
| 3911 | PHI=PARU(2)*RLU(0) |
| 3912 | PX=PT*COS(PHI) |
| 3913 | PY=PT*SIN(PHI) |
| 3914 | |
| 3915 | RETURN |
| 3916 | END |
| 3917 | |
| 3918 | C********************************************************************* |
| 3919 | |
| 3920 | SUBROUTINE LUZDIS(KFL1,KFL2,PR,Z) |
| 3921 | |
| 3922 | C...Purpose: to generate the longitudinal splitting variable z. |
| 3923 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 3924 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 3925 | SAVE /LUDAT1/,/LUDAT2/ |
| 3926 | |
| 3927 | C...Check if heavy flavour fragmentation. |
| 3928 | KFLA=IABS(KFL1) |
| 3929 | KFLB=IABS(KFL2) |
| 3930 | KFLH=KFLA |
| 3931 | IF(KFLA.GE.10) KFLH=MOD(KFLA/1000,10) |
| 3932 | |
| 3933 | C...Lund symmetric scaling function: determine parameters of shape. |
| 3934 | IF(MSTJ(11).EQ.1.OR.(MSTJ(11).EQ.3.AND.KFLH.LE.3).OR. |
| 3935 | &MSTJ(11).GE.4) THEN |
| 3936 | FA=PARJ(41) |
| 3937 | IF(MSTJ(91).EQ.1) FA=PARJ(43) |
| 3938 | IF(KFLB.GE.10) FA=FA+PARJ(45) |
| 3939 | FBB=PARJ(42) |
| 3940 | IF(MSTJ(91).EQ.1) FBB=PARJ(44) |
| 3941 | FB=FBB*PR |
| 3942 | FC=1. |
| 3943 | IF(KFLA.GE.10) FC=FC-PARJ(45) |
| 3944 | IF(KFLB.GE.10) FC=FC+PARJ(45) |
| 3945 | IF(MSTJ(11).GE.4.AND.KFLH.GE.4.AND.KFLH.LE.5) THEN |
| 3946 | FRED=PARJ(46) |
| 3947 | IF(MSTJ(11).EQ.5.AND.KFLH.EQ.5) FRED=PARJ(47) |
| 3948 | FC=FC+FRED*FBB*PARF(100+KFLH)**2 |
| 3949 | ELSEIF(MSTJ(11).GE.4.AND.KFLH.GE.6.AND.KFLH.LE.8) THEN |
| 3950 | FRED=PARJ(46) |
| 3951 | IF(MSTJ(11).EQ.5) FRED=PARJ(48) |
| 3952 | FC=FC+FRED*FBB*PMAS(KFLH,1)**2 |
| 3953 | ENDIF |
| 3954 | MC=1 |
| 3955 | IF(ABS(FC-1.).GT.0.01) MC=2 |
| 3956 | |
| 3957 | C...Determine position of maximum. Special cases for a = 0 or a = c. |
| 3958 | IF(FA.LT.0.02) THEN |
| 3959 | MA=1 |
| 3960 | ZMAX=1. |
| 3961 | IF(FC.GT.FB) ZMAX=FB/FC |
| 3962 | ELSEIF(ABS(FC-FA).LT.0.01) THEN |
| 3963 | MA=2 |
| 3964 | ZMAX=FB/(FB+FC) |
| 3965 | ELSE |
| 3966 | MA=3 |
| 3967 | ZMAX=0.5*(FB+FC-SQRT((FB-FC)**2+4.*FA*FB))/(FC-FA) |
| 3968 | IF(ZMAX.GT.0.9999.AND.FB.GT.100.) ZMAX=MIN(ZMAX,1.-FA/FB) |
| 3969 | ENDIF |
| 3970 | |
| 3971 | C...Subdivide z range if distribution very peaked near endpoint. |
| 3972 | MMAX=2 |
| 3973 | IF(ZMAX.LT.0.1) THEN |
| 3974 | MMAX=1 |
| 3975 | ZDIV=2.75*ZMAX |
| 3976 | IF(MC.EQ.1) THEN |
| 3977 | FINT=1.-LOG(ZDIV) |
| 3978 | ELSE |
| 3979 | ZDIVC=ZDIV**(1.-FC) |
| 3980 | FINT=1.+(1.-1./ZDIVC)/(FC-1.) |
| 3981 | ENDIF |
| 3982 | ELSEIF(ZMAX.GT.0.85.AND.FB.GT.1.) THEN |
| 3983 | MMAX=3 |
| 3984 | FSCB=SQRT(4.+(FC/FB)**2) |
| 3985 | ZDIV=FSCB-1./ZMAX-(FC/FB)*LOG(ZMAX*0.5*(FSCB+FC/FB)) |
| 3986 | IF(MA.GE.2) ZDIV=ZDIV+(FA/FB)*LOG(1.-ZMAX) |
| 3987 | ZDIV=MIN(ZMAX,MAX(0.,ZDIV)) |
| 3988 | FINT=1.+FB*(1.-ZDIV) |
| 3989 | ENDIF |
| 3990 | |
| 3991 | C...Choice of z, preweighted for peaks at low or high z. |
| 3992 | 100 Z=RLU(0) |
| 3993 | FPRE=1. |
| 3994 | IF(MMAX.EQ.1) THEN |
| 3995 | IF(FINT*RLU(0).LE.1.) THEN |
| 3996 | Z=ZDIV*Z |
| 3997 | ELSEIF(MC.EQ.1) THEN |
| 3998 | Z=ZDIV**Z |
| 3999 | FPRE=ZDIV/Z |
| 4000 | ELSE |
| 4001 | Z=1./(ZDIVC+Z*(1.-ZDIVC))**(1./(1.-FC)) |
| 4002 | FPRE=(ZDIV/Z)**FC |
| 4003 | ENDIF |
| 4004 | ELSEIF(MMAX.EQ.3) THEN |
| 4005 | IF(FINT*RLU(0).LE.1.) THEN |
| 4006 | Z=ZDIV+LOG(Z)/FB |
| 4007 | FPRE=EXP(FB*(Z-ZDIV)) |
| 4008 | ELSE |
| 4009 | Z=ZDIV+Z*(1.-ZDIV) |
| 4010 | ENDIF |
| 4011 | ENDIF |
| 4012 | |
| 4013 | C...Weighting according to correct formula. |
| 4014 | IF(Z.LE.0..OR.Z.GE.1.) GOTO 100 |
| 4015 | FEXP=FC*LOG(ZMAX/Z)+FB*(1./ZMAX-1./Z) |
| 4016 | IF(MA.GE.2) FEXP=FEXP+FA*LOG((1.-Z)/(1.-ZMAX)) |
| 4017 | FVAL=EXP(MAX(-50.,FEXP)) |
| 4018 | IF(FVAL.LT.RLU(0)*FPRE) GOTO 100 |
| 4019 | |
| 4020 | C...Generate z according to Field-Feynman, SLAC, (1-z)**c OR z**c. |
| 4021 | ELSE |
| 4022 | FC=PARJ(50+MAX(1,KFLH)) |
| 4023 | IF(MSTJ(91).EQ.1) FC=PARJ(59) |
| 4024 | 110 Z=RLU(0) |
| 4025 | IF(FC.GE.0..AND.FC.LE.1.) THEN |
| 4026 | IF(FC.GT.RLU(0)) Z=1.-Z**(1./3.) |
| 4027 | ELSEIF(FC.GT.-1.) THEN |
| 4028 | IF(-4.*FC*Z*(1.-Z)**2.LT.RLU(0)*((1.-Z)**2-FC*Z)**2) GOTO 110 |
| 4029 | ELSE |
| 4030 | IF(FC.GT.0.) Z=1.-Z**(1./FC) |
| 4031 | IF(FC.LT.0.) Z=Z**(-1./FC) |
| 4032 | ENDIF |
| 4033 | ENDIF |
| 4034 | |
| 4035 | RETURN |
| 4036 | END |
| 4037 | |
| 4038 | C********************************************************************* |
| 4039 | |
| 4040 | SUBROUTINE LUSHOW(IP1,IP2,QMAX) |
| 4041 | |
| 4042 | C...Purpose: to generate timelike parton showers from given partons. |
| 4043 | IMPLICIT DOUBLE PRECISION(D) |
| 4044 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 4045 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 4046 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 4047 | SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ |
| 4048 | DIMENSION PMTH(5,40),PS(5),PMA(4),PMSD(4),IEP(4),IPA(4), |
| 4049 | &KFLA(4),KFLD(4),KFL(4),ITRY(4),ISI(4),ISL(4),DP(4),DPT(5,4), |
| 4050 | &KSH(0:40) |
| 4051 | |
| 4052 | C...Initialization of cutoff masses etc. |
| 4053 | IF(MSTJ(41).LE.0.OR.(MSTJ(41).EQ.1.AND.QMAX.LE.PARJ(82)).OR. |
| 4054 | &QMAX.LE.MIN(PARJ(82),PARJ(83)).OR.MSTJ(41).GE.3) RETURN |
| 4055 | DO 101 IF=0,40 |
| 4056 | 101 KSH(IF)=0 |
| 4057 | KSH(21)=1 |
| 4058 | PMTH(1,21)=ULMASS(21) |
| 4059 | PMTH(2,21)=SQRT(PMTH(1,21)**2+0.25*PARJ(82)**2) |
| 4060 | PMTH(3,21)=2.*PMTH(2,21) |
| 4061 | PMTH(4,21)=PMTH(3,21) |
| 4062 | PMTH(5,21)=PMTH(3,21) |
| 4063 | PMTH(1,22)=ULMASS(22) |
| 4064 | PMTH(2,22)=SQRT(PMTH(1,22)**2+0.25*PARJ(83)**2) |
| 4065 | PMTH(3,22)=2.*PMTH(2,22) |
| 4066 | PMTH(4,22)=PMTH(3,22) |
| 4067 | PMTH(5,22)=PMTH(3,22) |
| 4068 | PMQTH1=PARJ(82) |
| 4069 | IF(MSTJ(41).EQ.2) PMQTH1=MIN(PARJ(82),PARJ(83)) |
| 4070 | PMQTH2=PMTH(2,21) |
| 4071 | IF(MSTJ(41).EQ.2) PMQTH2=MIN(PMTH(2,21),PMTH(2,22)) |
| 4072 | DO 100 IF=1,8 |
| 4073 | KSH(IF)=1 |
| 4074 | PMTH(1,IF)=ULMASS(IF) |
| 4075 | PMTH(2,IF)=SQRT(PMTH(1,IF)**2+0.25*PMQTH1**2) |
| 4076 | PMTH(3,IF)=PMTH(2,IF)+PMQTH2 |
| 4077 | PMTH(4,IF)=SQRT(PMTH(1,IF)**2+0.25*PARJ(82)**2)+PMTH(2,21) |
| 4078 | 100 PMTH(5,IF)=SQRT(PMTH(1,IF)**2+0.25*PARJ(83)**2)+PMTH(2,22) |
| 4079 | DO 105 IF=11,17,2 |
| 4080 | IF(MSTJ(41).EQ.2) KSH(IF)=1 |
| 4081 | PMTH(1,IF)=ULMASS(IF) |
| 4082 | PMTH(2,IF)=SQRT(PMTH(1,IF)**2+0.25*PARJ(83)**2) |
| 4083 | PMTH(3,IF)=PMTH(2,IF)+PMTH(2,22) |
| 4084 | PMTH(4,IF)=PMTH(3,IF) |
| 4085 | 105 PMTH(5,IF)=PMTH(3,IF) |
| 4086 | PT2MIN=MAX(0.5*PARJ(82),1.1*PARJ(81))**2 |
| 4087 | ALAMS=PARJ(81)**2 |
| 4088 | ALFM=LOG(PT2MIN/ALAMS) |
| 4089 | |
| 4090 | C...Store positions of shower initiating partons. |
| 4091 | M3JC=0 |
| 4092 | IF(IP1.GT.0.AND.IP1.LE.MIN(N,MSTU(4)-MSTU(32)).AND.IP2.EQ.0) THEN |
| 4093 | NPA=1 |
| 4094 | IPA(1)=IP1 |
| 4095 | ELSEIF(MIN(IP1,IP2).GT.0.AND.MAX(IP1,IP2).LE.MIN(N,MSTU(4)- |
| 4096 | &MSTU(32))) THEN |
| 4097 | NPA=2 |
| 4098 | IPA(1)=IP1 |
| 4099 | IPA(2)=IP2 |
| 4100 | ELSEIF(IP1.GT.0.AND.IP1.LE.MIN(N,MSTU(4)-MSTU(32)).AND.IP2.LT.0. |
| 4101 | &AND.IP2.GE.-3) THEN |
| 4102 | NPA=IABS(IP2) |
| 4103 | DO 110 I=1,NPA |
| 4104 | 110 IPA(I)=IP1+I-1 |
| 4105 | ELSE |
| 4106 | CALL LUERRM(12, |
| 4107 | & '(LUSHOW:) failed to reconstruct showering system') |
| 4108 | IF(MSTU(21).GE.1) RETURN |
| 4109 | ENDIF |
| 4110 | |
| 4111 | C...Check on phase space available for emission. |
| 4112 | IREJ=0 |
| 4113 | DO 120 J=1,5 |
| 4114 | 120 PS(J)=0. |
| 4115 | PM=0. |
| 4116 | DO 130 I=1,NPA |
| 4117 | KFLA(I)=IABS(K(IPA(I),2)) |
| 4118 | PMA(I)=P(IPA(I),5) |
| 4119 | IF(KFLA(I).LE.40) THEN |
| 4120 | IF(KSH(KFLA(I)).EQ.1) PMA(I)=PMTH(3,KFLA(I)) |
| 4121 | ENDIF |
| 4122 | PM=PM+PMA(I) |
| 4123 | IF(KFLA(I).GT.40) THEN |
| 4124 | IREJ=IREJ+1 |
| 4125 | ELSE |
| 4126 | IF(KSH(KFLA(I)).EQ.0.OR.PMA(I).GT.QMAX) IREJ=IREJ+1 |
| 4127 | ENDIF |
| 4128 | DO 130 J=1,4 |
| 4129 | 130 PS(J)=PS(J)+P(IPA(I),J) |
| 4130 | IF(IREJ.EQ.NPA) RETURN |
| 4131 | PS(5)=SQRT(MAX(0.,PS(4)**2-PS(1)**2-PS(2)**2-PS(3)**2)) |
| 4132 | IF(NPA.EQ.1) PS(5)=PS(4) |
| 4133 | IF(PS(5).LE.PM+PMQTH1) RETURN |
| 4134 | IF(NPA.EQ.2.AND.MSTJ(47).GE.1) THEN |
| 4135 | IF(KFLA(1).GE.1.AND.KFLA(1).LE.8.AND.KFLA(2).GE.1.AND. |
| 4136 | & KFLA(2).LE.8) M3JC=1 |
| 4137 | IF((KFLA(1).EQ.11.OR.KFLA(1).EQ.13.OR.KFLA(1).EQ.15.OR. |
| 4138 | & KFLA(1).EQ.17).AND.KFLA(2).EQ.KFLA(1)) M3JC=1 |
| 4139 | IF((KFLA(1).EQ.11.OR.KFLA(1).EQ.13.OR.KFLA(1).EQ.15.OR. |
| 4140 | & KFLA(1).EQ.17).AND.KFLA(2).EQ.KFLA(1)+1) M3JC=1 |
| 4141 | IF((KFLA(1).EQ.12.OR.KFLA(1).EQ.14.OR.KFLA(1).EQ.16.OR. |
| 4142 | & KFLA(1).EQ.18).AND.KFLA(2).EQ.KFLA(1)-1) M3JC=1 |
| 4143 | IF(MSTJ(47).GE.2) M3JC=1 |
| 4144 | ENDIF |
| 4145 | |
| 4146 | C...Define imagined single initiator of shower for parton system. |
| 4147 | NS=N |
| 4148 | IF(N.GT.MSTU(4)-MSTU(32)-5) THEN |
| 4149 | CALL LUERRM(11,'(LUSHOW:) no more memory left in LUJETS') |
| 4150 | IF(MSTU(21).GE.1) RETURN |
| 4151 | ENDIF |
| 4152 | IF(NPA.GE.2) THEN |
| 4153 | K(N+1,1)=11 |
| 4154 | K(N+1,2)=21 |
| 4155 | K(N+1,3)=0 |
| 4156 | K(N+1,4)=0 |
| 4157 | K(N+1,5)=0 |
| 4158 | P(N+1,1)=0. |
| 4159 | P(N+1,2)=0. |
| 4160 | P(N+1,3)=0. |
| 4161 | P(N+1,4)=PS(5) |
| 4162 | P(N+1,5)=PS(5) |
| 4163 | V(N+1,5)=PS(5)**2 |
| 4164 | N=N+1 |
| 4165 | ENDIF |
| 4166 | |
| 4167 | C...Loop over partons that may branch. |
| 4168 | NEP=NPA |
| 4169 | IM=NS |
| 4170 | IF(NPA.EQ.1) IM=NS-1 |
| 4171 | 140 IM=IM+1 |
| 4172 | IF(N.GT.NS) THEN |
| 4173 | IF(IM.GT.N) GOTO 380 |
| 4174 | KFLM=IABS(K(IM,2)) |
| 4175 | IF(KFLM.GT.40) GOTO 140 |
| 4176 | IF(KSH(KFLM).EQ.0) GOTO 140 |
| 4177 | IF(P(IM,5).LT.PMTH(2,KFLM)) GOTO 140 |
| 4178 | IGM=K(IM,3) |
| 4179 | ELSE |
| 4180 | IGM=-1 |
| 4181 | ENDIF |
| 4182 | IF(N+NEP.GT.MSTU(4)-MSTU(32)-5) THEN |
| 4183 | CALL LUERRM(11,'(LUSHOW:) no more memory left in LUJETS') |
| 4184 | IF(MSTU(21).GE.1) RETURN |
| 4185 | ENDIF |
| 4186 | |
| 4187 | C...Position of aunt (sister to branching parton). |
| 4188 | C...Origin and flavour of daughters. |
| 4189 | IAU=0 |
| 4190 | IF(IGM.GT.0) THEN |
| 4191 | IF(K(IM-1,3).EQ.IGM) IAU=IM-1 |
| 4192 | IF(N.GE.IM+1.AND.K(IM+1,3).EQ.IGM) IAU=IM+1 |
| 4193 | ENDIF |
| 4194 | IF(IGM.GE.0) THEN |
| 4195 | K(IM,4)=N+1 |
| 4196 | DO 150 I=1,NEP |
| 4197 | 150 K(N+I,3)=IM |
| 4198 | ELSE |
| 4199 | K(N+1,3)=IPA(1) |
| 4200 | ENDIF |
| 4201 | IF(IGM.LE.0) THEN |
| 4202 | DO 160 I=1,NEP |
| 4203 | 160 K(N+I,2)=K(IPA(I),2) |
| 4204 | ELSEIF(KFLM.NE.21) THEN |
| 4205 | K(N+1,2)=K(IM,2) |
| 4206 | K(N+2,2)=K(IM,5) |
| 4207 | ELSEIF(K(IM,5).EQ.21) THEN |
| 4208 | K(N+1,2)=21 |
| 4209 | K(N+2,2)=21 |
| 4210 | ELSE |
| 4211 | K(N+1,2)=K(IM,5) |
| 4212 | K(N+2,2)=-K(IM,5) |
| 4213 | ENDIF |
| 4214 | |
| 4215 | C...Reset flags on daughers and tries made. |
| 4216 | DO 170 IP=1,NEP |
| 4217 | K(N+IP,1)=3 |
| 4218 | K(N+IP,4)=0 |
| 4219 | K(N+IP,5)=0 |
| 4220 | KFLD(IP)=IABS(K(N+IP,2)) |
| 4221 | IF(KCHG(LUCOMP(KFLD(IP)),2).EQ.0) K(N+IP,1)=1 |
| 4222 | ITRY(IP)=0 |
| 4223 | ISL(IP)=0 |
| 4224 | ISI(IP)=0 |
| 4225 | IF(KFLD(IP).LE.40) THEN |
| 4226 | IF(KSH(KFLD(IP)).EQ.1) ISI(IP)=1 |
| 4227 | ENDIF |
| 4228 | 170 CONTINUE |
| 4229 | ISLM=0 |
| 4230 | |
| 4231 | C...Maximum virtuality of daughters. |
| 4232 | IF(IGM.LE.0) THEN |
| 4233 | DO 180 I=1,NPA |
| 4234 | IF(NPA.GE.3) P(N+I,4)=(PS(4)*P(IPA(I),4)-PS(1)*P(IPA(I),1)- |
| 4235 | & PS(2)*P(IPA(I),2)-PS(3)*P(IPA(I),3))/PS(5) |
| 4236 | P(N+I,5)=MIN(QMAX,PS(5)) |
| 4237 | IF(NPA.GE.3) P(N+I,5)=MIN(P(N+I,5),P(N+I,4)) |
| 4238 | 180 IF(ISI(I).EQ.0) P(N+I,5)=P(IPA(I),5) |
| 4239 | ELSE |
| 4240 | IF(MSTJ(43).LE.2) PEM=V(IM,2) |
| 4241 | IF(MSTJ(43).GE.3) PEM=P(IM,4) |
| 4242 | P(N+1,5)=MIN(P(IM,5),V(IM,1)*PEM) |
| 4243 | P(N+2,5)=MIN(P(IM,5),(1.-V(IM,1))*PEM) |
| 4244 | IF(K(N+2,2).EQ.22) P(N+2,5)=PMTH(1,22) |
| 4245 | ENDIF |
| 4246 | DO 190 I=1,NEP |
| 4247 | PMSD(I)=P(N+I,5) |
| 4248 | IF(ISI(I).EQ.1) THEN |
| 4249 | IF(P(N+I,5).LE.PMTH(3,KFLD(I))) P(N+I,5)=PMTH(1,KFLD(I)) |
| 4250 | ENDIF |
| 4251 | 190 V(N+I,5)=P(N+I,5)**2 |
| 4252 | |
| 4253 | C...Choose one of the daughters for evolution. |
| 4254 | 200 INUM=0 |
| 4255 | IF(NEP.EQ.1) INUM=1 |
| 4256 | DO 210 I=1,NEP |
| 4257 | 210 IF(INUM.EQ.0.AND.ISL(I).EQ.1) INUM=I |
| 4258 | DO 220 I=1,NEP |
| 4259 | IF(INUM.EQ.0.AND.ITRY(I).EQ.0.AND.ISI(I).EQ.1) THEN |
| 4260 | IF(P(N+I,5).GE.PMTH(2,KFLD(I))) INUM=I |
| 4261 | ENDIF |
| 4262 | 220 CONTINUE |
| 4263 | IF(INUM.EQ.0) THEN |
| 4264 | RMAX=0. |
| 4265 | DO 230 I=1,NEP |
| 4266 | IF(ISI(I).EQ.1.AND.PMSD(I).GE.PMQTH2) THEN |
| 4267 | RPM=P(N+I,5)/PMSD(I) |
| 4268 | IF(RPM.GT.RMAX.AND.P(N+I,5).GE.PMTH(2,KFLD(I))) THEN |
| 4269 | RMAX=RPM |
| 4270 | INUM=I |
| 4271 | ENDIF |
| 4272 | ENDIF |
| 4273 | 230 CONTINUE |
| 4274 | ENDIF |
| 4275 | |
| 4276 | C...Store information on choice of evolving daughter. |
| 4277 | INUM=MAX(1,INUM) |
| 4278 | IEP(1)=N+INUM |
| 4279 | DO 240 I=2,NEP |
| 4280 | IEP(I)=IEP(I-1)+1 |
| 4281 | 240 IF(IEP(I).GT.N+NEP) IEP(I)=N+1 |
| 4282 | DO 250 I=1,NEP |
| 4283 | 250 KFL(I)=IABS(K(IEP(I),2)) |
| 4284 | ITRY(INUM)=ITRY(INUM)+1 |
| 4285 | IF(ITRY(INUM).GT.200) THEN |
| 4286 | CALL LUERRM(14,'(LUSHOW:) caught in infinite loop') |
| 4287 | IF(MSTU(21).GE.1) RETURN |
| 4288 | ENDIF |
| 4289 | Z=0.5 |
| 4290 | IF(KFL(1).GT.40) GOTO 300 |
| 4291 | IF(KSH(KFL(1)).EQ.0) GOTO 300 |
| 4292 | IF(P(IEP(1),5).LT.PMTH(2,KFL(1))) GOTO 300 |
| 4293 | |
| 4294 | C...Calculate allowed z range. |
| 4295 | IF(NEP.EQ.1) THEN |
| 4296 | PMED=PS(4) |
| 4297 | ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN |
| 4298 | PMED=P(IM,5) |
| 4299 | ELSE |
| 4300 | IF(INUM.EQ.1) PMED=V(IM,1)*PEM |
| 4301 | IF(INUM.EQ.2) PMED=(1.-V(IM,1))*PEM |
| 4302 | ENDIF |
| 4303 | IF(MOD(MSTJ(43),2).EQ.1) THEN |
| 4304 | ZC=PMTH(2,21)/PMED |
| 4305 | ZCE=PMTH(2,22)/PMED |
| 4306 | ELSE |
| 4307 | ZC=0.5*(1.-SQRT(MAX(0.,1.-(2.*PMTH(2,21)/PMED)**2))) |
| 4308 | IF(ZC.LT.1E-4) ZC=(PMTH(2,21)/PMED)**2 |
| 4309 | ZCE=0.5*(1.-SQRT(MAX(0.,1.-(2.*PMTH(2,22)/PMED)**2))) |
| 4310 | IF(ZCE.LT.1E-4) ZCE=(PMTH(2,22)/PMED)**2 |
| 4311 | ENDIF |
| 4312 | ZC=MIN(ZC,0.491) |
| 4313 | ZCE=MIN(ZCE,0.491) |
| 4314 | IF((MSTJ(41).EQ.1.AND.ZC.GT.0.49).OR.(MSTJ(41).EQ.2.AND. |
| 4315 | &MIN(ZC,ZCE).GT.0.49)) THEN |
| 4316 | P(IEP(1),5)=PMTH(1,KFL(1)) |
| 4317 | V(IEP(1),5)=P(IEP(1),5)**2 |
| 4318 | GOTO 300 |
| 4319 | ENDIF |
| 4320 | |
| 4321 | C...Integral of Altarelli-Parisi z kernel for QCD. |
| 4322 | IF(MSTJ(49).EQ.0.AND.KFL(1).EQ.21) THEN |
| 4323 | FBR=6.*LOG((1.-ZC)/ZC)+MSTJ(45)*(0.5-ZC) |
| 4324 | ELSEIF(MSTJ(49).EQ.0) THEN |
| 4325 | FBR=(8./3.)*LOG((1.-ZC)/ZC) |
| 4326 | |
| 4327 | C...Integral of Altarelli-Parisi z kernel for scalar gluon. |
| 4328 | ELSEIF(MSTJ(49).EQ.1.AND.KFL(1).EQ.21) THEN |
| 4329 | FBR=(PARJ(87)+MSTJ(45)*PARJ(88))*(1.-2.*ZC) |
| 4330 | ELSEIF(MSTJ(49).EQ.1) THEN |
| 4331 | FBR=(1.-2.*ZC)/3. |
| 4332 | IF(IGM.EQ.0.AND.M3JC.EQ.1) FBR=4.*FBR |
| 4333 | |
| 4334 | C...Integral of Altarelli-Parisi z kernel for Abelian vector gluon. |
| 4335 | ELSEIF(KFL(1).EQ.21) THEN |
| 4336 | FBR=6.*MSTJ(45)*(0.5-ZC) |
| 4337 | ELSE |
| 4338 | FBR=2.*LOG((1.-ZC)/ZC) |
| 4339 | ENDIF |
| 4340 | |
| 4341 | C...Reset QCD probability for lepton. |
| 4342 | IF(KFL(1).GE.11.AND.KFL(1).LE.18) FBR=0. |
| 4343 | |
| 4344 | C...Integral of Altarelli-Parisi kernel for photon emission. |
| 4345 | IF(MSTJ(41).EQ.2.AND.KFL(1).GE.1.AND.KFL(1).LE.18) |
| 4346 | &FBRE=(KCHG(KFL(1),1)/3.)**2*2.*LOG((1.-ZCE)/ZCE) |
| 4347 | |
| 4348 | C...Inner veto algorithm starts. Find maximum mass for evolution. |
| 4349 | 260 PMS=V(IEP(1),5) |
| 4350 | IF(IGM.GE.0) THEN |
| 4351 | PM2=0. |
| 4352 | DO 270 I=2,NEP |
| 4353 | PM=P(IEP(I),5) |
| 4354 | IF(KFL(I).LE.40) THEN |
| 4355 | IF(KSH(KFL(I)).EQ.1) PM=PMTH(2,KFL(I)) |
| 4356 | ENDIF |
| 4357 | 270 PM2=PM2+PM |
| 4358 | PMS=MIN(PMS,(P(IM,5)-PM2)**2) |
| 4359 | ENDIF |
| 4360 | |
| 4361 | C...Select mass for daughter in QCD evolution. |
| 4362 | B0=27./6. |
| 4363 | DO 280 IF=4,MSTJ(45) |
| 4364 | 280 IF(PMS.GT.4.*PMTH(2,IF)**2) B0=(33.-2.*IF)/6. |
| 4365 | IF(FBR.LT.1E-3) THEN |
| 4366 | PMSQCD=0. |
| 4367 | ELSEIF(MSTJ(44).LE.0) THEN |
| 4368 | PMSQCD=PMS*EXP(MAX(-50.,LOG(RLU(0))*PARU(2)/(PARU(111)*FBR))) |
| 4369 | ELSEIF(MSTJ(44).EQ.1) THEN |
| 4370 | PMSQCD=4.*ALAMS*(0.25*PMS/ALAMS)**(RLU(0)**(B0/FBR)) |
| 4371 | ELSE |
| 4372 | PMSQCD=PMS*EXP(MAX(-50.,ALFM*B0*LOG(RLU(0))/FBR)) |
| 4373 | ENDIF |
| 4374 | IF(ZC.GT.0.49.OR.PMSQCD.LE.PMTH(4,KFL(1))**2) PMSQCD= |
| 4375 | &PMTH(2,KFL(1))**2 |
| 4376 | V(IEP(1),5)=PMSQCD |
| 4377 | MCE=1 |
| 4378 | |
| 4379 | C...Select mass for daughter in QED evolution. |
| 4380 | IF(MSTJ(41).EQ.2.AND.KFL(1).GE.1.AND.KFL(1).LE.18) THEN |
| 4381 | PMSQED=PMS*EXP(MAX(-80.,LOG(RLU(0))*PARU(2)/(PARU(101)*FBRE))) |
| 4382 | IF(ZCE.GT.0.49.OR.PMSQED.LE.PMTH(5,KFL(1))**2) PMSQED= |
| 4383 | & PMTH(2,KFL(1))**2 |
| 4384 | IF(PMSQED.GT.PMSQCD) THEN |
| 4385 | V(IEP(1),5)=PMSQED |
| 4386 | MCE=2 |
| 4387 | ENDIF |
| 4388 | ENDIF |
| 4389 | |
| 4390 | C...Check whether daughter mass below cutoff. |
| 4391 | P(IEP(1),5)=SQRT(V(IEP(1),5)) |
| 4392 | IF(P(IEP(1),5).LE.PMTH(3,KFL(1))) THEN |
| 4393 | P(IEP(1),5)=PMTH(1,KFL(1)) |
| 4394 | V(IEP(1),5)=P(IEP(1),5)**2 |
| 4395 | GOTO 300 |
| 4396 | ENDIF |
| 4397 | |
| 4398 | C...Select z value of branching: q -> qgamma. |
| 4399 | IF(MCE.EQ.2) THEN |
| 4400 | Z=1.-(1.-ZCE)*(ZCE/(1.-ZCE))**RLU(0) |
| 4401 | IF(1.+Z**2.LT.2.*RLU(0)) GOTO 260 |
| 4402 | K(IEP(1),5)=22 |
| 4403 | |
| 4404 | C...Select z value of branching: q -> qg, g -> gg, g -> qqbar. |
| 4405 | ELSEIF(MSTJ(49).NE.1.AND.KFL(1).NE.21) THEN |
| 4406 | Z=1.-(1.-ZC)*(ZC/(1.-ZC))**RLU(0) |
| 4407 | IF(1.+Z**2.LT.2.*RLU(0)) GOTO 260 |
| 4408 | K(IEP(1),5)=21 |
| 4409 | ELSEIF(MSTJ(49).EQ.0.AND.MSTJ(45)*(0.5-ZC).LT.RLU(0)*FBR) THEN |
| 4410 | Z=(1.-ZC)*(ZC/(1.-ZC))**RLU(0) |
| 4411 | IF(RLU(0).GT.0.5) Z=1.-Z |
| 4412 | IF((1.-Z*(1.-Z))**2.LT.RLU(0)) GOTO 260 |
| 4413 | K(IEP(1),5)=21 |
| 4414 | ELSEIF(MSTJ(49).NE.1) THEN |
| 4415 | Z=ZC+(1.-2.*ZC)*RLU(0) |
| 4416 | IF(Z**2+(1.-Z)**2.LT.RLU(0)) GOTO 260 |
| 4417 | KFLB=1+INT(MSTJ(45)*RLU(0)) |
| 4418 | PMQ=4.*PMTH(2,KFLB)**2/V(IEP(1),5) |
| 4419 | IF(PMQ.GE.1.) GOTO 260 |
| 4420 | PMQ0=4.*PMTH(2,21)**2/V(IEP(1),5) |
| 4421 | IF(MOD(MSTJ(43),2).EQ.0.AND.(1.+0.5*PMQ)*SQRT(1.-PMQ).LT. |
| 4422 | & RLU(0)*(1.+0.5*PMQ0)*SQRT(1.-PMQ0)) GOTO 260 |
| 4423 | K(IEP(1),5)=KFLB |
| 4424 | |
| 4425 | C...Ditto for scalar gluon model. |
| 4426 | ELSEIF(KFL(1).NE.21) THEN |
| 4427 | Z=1.-SQRT(ZC**2+RLU(0)*(1.-2.*ZC)) |
| 4428 | K(IEP(1),5)=21 |
| 4429 | ELSEIF(RLU(0)*(PARJ(87)+MSTJ(45)*PARJ(88)).LE.PARJ(87)) THEN |
| 4430 | Z=ZC+(1.-2.*ZC)*RLU(0) |
| 4431 | K(IEP(1),5)=21 |
| 4432 | ELSE |
| 4433 | Z=ZC+(1.-2.*ZC)*RLU(0) |
| 4434 | KFLB=1+INT(MSTJ(45)*RLU(0)) |
| 4435 | PMQ=4.*PMTH(2,KFLB)**2/V(IEP(1),5) |
| 4436 | IF(PMQ.GE.1.) GOTO 260 |
| 4437 | K(IEP(1),5)=KFLB |
| 4438 | ENDIF |
| 4439 | IF(MCE.EQ.1.AND.MSTJ(44).GE.2) THEN |
| 4440 | IF(Z*(1.-Z)*V(IEP(1),5).LT.PT2MIN) GOTO 260 |
| 4441 | IF(ALFM/LOG(V(IEP(1),5)*Z*(1.-Z)/ALAMS).LT.RLU(0)) GOTO 260 |
| 4442 | ENDIF |
| 4443 | |
| 4444 | C...Check if z consistent with chosen m. |
| 4445 | IF(KFL(1).EQ.21) THEN |
| 4446 | KFLGD1=IABS(K(IEP(1),5)) |
| 4447 | KFLGD2=KFLGD1 |
| 4448 | ELSE |
| 4449 | KFLGD1=KFL(1) |
| 4450 | KFLGD2=IABS(K(IEP(1),5)) |
| 4451 | ENDIF |
| 4452 | IF(NEP.EQ.1) THEN |
| 4453 | PED=PS(4) |
| 4454 | ELSEIF(NEP.GE.3) THEN |
| 4455 | PED=P(IEP(1),4) |
| 4456 | ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN |
| 4457 | PED=0.5*(V(IM,5)+V(IEP(1),5)-PM2**2)/P(IM,5) |
| 4458 | ELSE |
| 4459 | IF(IEP(1).EQ.N+1) PED=V(IM,1)*PEM |
| 4460 | IF(IEP(1).EQ.N+2) PED=(1.-V(IM,1))*PEM |
| 4461 | ENDIF |
| 4462 | IF(MOD(MSTJ(43),2).EQ.1) THEN |
| 4463 | PMQTH3=0.5*PARJ(82) |
| 4464 | IF(KFLGD2.EQ.22) PMQTH3=0.5*PARJ(83) |
| 4465 | PMQ1=(PMTH(1,KFLGD1)**2+PMQTH3**2)/V(IEP(1),5) |
| 4466 | PMQ2=(PMTH(1,KFLGD2)**2+PMQTH3**2)/V(IEP(1),5) |
| 4467 | ZD=SQRT(MAX(0.,(1.-V(IEP(1),5)/PED**2)*((1.-PMQ1-PMQ2)**2- |
| 4468 | & 4.*PMQ1*PMQ2))) |
| 4469 | ZH=1.+PMQ1-PMQ2 |
| 4470 | ELSE |
| 4471 | ZD=SQRT(MAX(0.,1.-V(IEP(1),5)/PED**2)) |
| 4472 | ZH=1. |
| 4473 | ENDIF |
| 4474 | ZL=0.5*(ZH-ZD) |
| 4475 | ZU=0.5*(ZH+ZD) |
| 4476 | IF(Z.LT.ZL.OR.Z.GT.ZU) GOTO 260 |
| 4477 | IF(KFL(1).EQ.21) V(IEP(1),3)=LOG(ZU*(1.-ZL)/MAX(1E-20,ZL* |
| 4478 | &(1.-ZU))) |
| 4479 | IF(KFL(1).NE.21) V(IEP(1),3)=LOG((1.-ZL)/MAX(1E-10,1.-ZU)) |
| 4480 | |
| 4481 | C...Three-jet matrix element correction. |
| 4482 | IF(IGM.EQ.0.AND.M3JC.EQ.1) THEN |
| 4483 | X1=Z*(1.+V(IEP(1),5)/V(NS+1,5)) |
| 4484 | X2=1.-V(IEP(1),5)/V(NS+1,5) |
| 4485 | X3=(1.-X1)+(1.-X2) |
| 4486 | IF(MCE.EQ.2) THEN |
| 4487 | KI1=K(IPA(INUM),2) |
| 4488 | KI2=K(IPA(3-INUM),2) |
| 4489 | QF1=KCHG(IABS(KI1),1)*ISIGN(1,KI1)/3. |
| 4490 | QF2=KCHG(IABS(KI2),1)*ISIGN(1,KI2)/3. |
| 4491 | WSHOW=QF1**2*(1.-X1)/X3*(1.+(X1/(2.-X2))**2)+ |
| 4492 | & QF2**2*(1.-X2)/X3*(1.+(X2/(2.-X1))**2) |
| 4493 | WME=(QF1*(1.-X1)/X3-QF2*(1.-X2)/X3)**2*(X1**2+X2**2) |
| 4494 | ELSEIF(MSTJ(49).NE.1) THEN |
| 4495 | WSHOW=1.+(1.-X1)/X3*(X1/(2.-X2))**2+ |
| 4496 | & (1.-X2)/X3*(X2/(2.-X1))**2 |
| 4497 | WME=X1**2+X2**2 |
| 4498 | ELSE |
| 4499 | WSHOW=4.*X3*((1.-X1)/(2.-X2)**2+(1.-X2)/(2.-X1)**2) |
| 4500 | WME=X3**2 |
| 4501 | IF(MSTJ(102).GE.2) WME=X3**2-2.*(1.+X3)*(1.-X1)*(1.-X2)* |
| 4502 | & PARJ(171) |
| 4503 | ENDIF |
| 4504 | IF(WME.LT.RLU(0)*WSHOW) GOTO 260 |
| 4505 | |
| 4506 | C...Impose angular ordering by rejection of nonordered emission. |
| 4507 | ELSEIF(MCE.EQ.1.AND.IGM.GT.0.AND.MSTJ(42).GE.2) THEN |
| 4508 | MAOM=1 |
| 4509 | ZM=V(IM,1) |
| 4510 | IF(IEP(1).EQ.N+2) ZM=1.-V(IM,1) |
| 4511 | THE2ID=Z*(1.-Z)*(ZM*P(IM,4))**2/V(IEP(1),5) |
| 4512 | IAOM=IM |
| 4513 | 290 IF(K(IAOM,5).EQ.22) THEN |
| 4514 | IAOM=K(IAOM,3) |
| 4515 | IF(K(IAOM,3).LE.NS) MAOM=0 |
| 4516 | IF(MAOM.EQ.1) GOTO 290 |
| 4517 | ENDIF |
| 4518 | IF(MAOM.EQ.1) THEN |
| 4519 | THE2IM=V(IAOM,1)*(1.-V(IAOM,1))*P(IAOM,4)**2/V(IAOM,5) |
| 4520 | IF(THE2ID.LT.THE2IM) GOTO 260 |
| 4521 | ENDIF |
| 4522 | ENDIF |
| 4523 | |
| 4524 | C...Impose user-defined maximum angle at first branching. |
| 4525 | IF(MSTJ(48).EQ.1) THEN |
| 4526 | IF(NEP.EQ.1.AND.IM.EQ.NS) THEN |
| 4527 | THE2ID=Z*(1.-Z)*PS(4)**2/V(IEP(1),5) |
| 4528 | IF(THE2ID.LT.1./PARJ(85)**2) GOTO 260 |
| 4529 | ELSEIF(NEP.EQ.2.AND.IEP(1).EQ.NS+2) THEN |
| 4530 | THE2ID=Z*(1.-Z)*(0.5*P(IM,4))**2/V(IEP(1),5) |
| 4531 | IF(THE2ID.LT.1./PARJ(85)**2) GOTO 260 |
| 4532 | ELSEIF(NEP.EQ.2.AND.IEP(1).EQ.NS+3) THEN |
| 4533 | THE2ID=Z*(1.-Z)*(0.5*P(IM,4))**2/V(IEP(1),5) |
| 4534 | IF(THE2ID.LT.1./PARJ(86)**2) GOTO 260 |
| 4535 | ENDIF |
| 4536 | ENDIF |
| 4537 | |
| 4538 | C...End of inner veto algorithm. Check if only one leg evolved so far. |
| 4539 | 300 V(IEP(1),1)=Z |
| 4540 | ISL(1)=0 |
| 4541 | ISL(2)=0 |
| 4542 | IF(NEP.EQ.1) GOTO 330 |
| 4543 | IF(NEP.EQ.2.AND.P(IEP(1),5)+P(IEP(2),5).GE.P(IM,5)) GOTO 200 |
| 4544 | DO 310 I=1,NEP |
| 4545 | IF(ITRY(I).EQ.0.AND.KFLD(I).LE.40) THEN |
| 4546 | IF(KSH(KFLD(I)).EQ.1) THEN |
| 4547 | IF(P(N+I,5).GE.PMTH(2,KFLD(I))) GOTO 200 |
| 4548 | ENDIF |
| 4549 | ENDIF |
| 4550 | 310 CONTINUE |
| 4551 | |
| 4552 | C...Check if chosen multiplet m1,m2,z1,z2 is physical. |
| 4553 | IF(NEP.EQ.3) THEN |
| 4554 | PA1S=(P(N+1,4)+P(N+1,5))*(P(N+1,4)-P(N+1,5)) |
| 4555 | PA2S=(P(N+2,4)+P(N+2,5))*(P(N+2,4)-P(N+2,5)) |
| 4556 | PA3S=(P(N+3,4)+P(N+3,5))*(P(N+3,4)-P(N+3,5)) |
| 4557 | PTS=0.25*(2.*PA1S*PA2S+2.*PA1S*PA3S+2.*PA2S*PA3S- |
| 4558 | & PA1S**2-PA2S**2-PA3S**2)/PA1S |
| 4559 | IF(PTS.LE.0.) GOTO 200 |
| 4560 | ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2.OR.MOD(MSTJ(43),2).EQ.0) THEN |
| 4561 | DO 320 I1=N+1,N+2 |
| 4562 | KFLDA=IABS(K(I1,2)) |
| 4563 | IF(KFLDA.GT.40) GOTO 320 |
| 4564 | IF(KSH(KFLDA).EQ.0) GOTO 320 |
| 4565 | IF(P(I1,5).LT.PMTH(2,KFLDA)) GOTO 320 |
| 4566 | IF(KFLDA.EQ.21) THEN |
| 4567 | KFLGD1=IABS(K(I1,5)) |
| 4568 | KFLGD2=KFLGD1 |
| 4569 | ELSE |
| 4570 | KFLGD1=KFLDA |
| 4571 | KFLGD2=IABS(K(I1,5)) |
| 4572 | ENDIF |
| 4573 | I2=2*N+3-I1 |
| 4574 | IF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN |
| 4575 | PED=0.5*(V(IM,5)+V(I1,5)-V(I2,5))/P(IM,5) |
| 4576 | ELSE |
| 4577 | IF(I1.EQ.N+1) ZM=V(IM,1) |
| 4578 | IF(I1.EQ.N+2) ZM=1.-V(IM,1) |
| 4579 | PML=SQRT((V(IM,5)-V(N+1,5)-V(N+2,5))**2- |
| 4580 | & 4.*V(N+1,5)*V(N+2,5)) |
| 4581 | PED=PEM*(0.5*(V(IM,5)-PML+V(I1,5)-V(I2,5))+PML*ZM)/V(IM,5) |
| 4582 | ENDIF |
| 4583 | IF(MOD(MSTJ(43),2).EQ.1) THEN |
| 4584 | PMQTH3=0.5*PARJ(82) |
| 4585 | IF(KFLGD2.EQ.22) PMQTH3=0.5*PARJ(83) |
| 4586 | PMQ1=(PMTH(1,KFLGD1)**2+PMQTH3**2)/V(I1,5) |
| 4587 | PMQ2=(PMTH(1,KFLGD2)**2+PMQTH3**2)/V(I1,5) |
| 4588 | ZD=SQRT(MAX(0.,(1.-V(I1,5)/PED**2)*((1.-PMQ1-PMQ2)**2- |
| 4589 | & 4.*PMQ1*PMQ2))) |
| 4590 | ZH=1.+PMQ1-PMQ2 |
| 4591 | ELSE |
| 4592 | ZD=SQRT(MAX(0.,1.-V(I1,5)/PED**2)) |
| 4593 | ZH=1. |
| 4594 | ENDIF |
| 4595 | ZL=0.5*(ZH-ZD) |
| 4596 | ZU=0.5*(ZH+ZD) |
| 4597 | IF(I1.EQ.N+1.AND.(V(I1,1).LT.ZL.OR.V(I1,1).GT.ZU)) ISL(1)=1 |
| 4598 | IF(I1.EQ.N+2.AND.(V(I1,1).LT.ZL.OR.V(I1,1).GT.ZU)) ISL(2)=1 |
| 4599 | IF(KFLDA.EQ.21) V(I1,4)=LOG(ZU*(1.-ZL)/MAX(1E-20,ZL*(1.-ZU))) |
| 4600 | IF(KFLDA.NE.21) V(I1,4)=LOG((1.-ZL)/MAX(1E-10,1.-ZU)) |
| 4601 | 320 CONTINUE |
| 4602 | IF(ISL(1).EQ.1.AND.ISL(2).EQ.1.AND.ISLM.NE.0) THEN |
| 4603 | ISL(3-ISLM)=0 |
| 4604 | ISLM=3-ISLM |
| 4605 | ELSEIF(ISL(1).EQ.1.AND.ISL(2).EQ.1) THEN |
| 4606 | ZDR1=MAX(0.,V(N+1,3)/MAX(1E-6,V(N+1,4))-1.) |
| 4607 | ZDR2=MAX(0.,V(N+2,3)/MAX(1E-6,V(N+2,4))-1.) |
| 4608 | IF(ZDR2.GT.RLU(0)*(ZDR1+ZDR2)) ISL(1)=0 |
| 4609 | IF(ISL(1).EQ.1) ISL(2)=0 |
| 4610 | IF(ISL(1).EQ.0) ISLM=1 |
| 4611 | IF(ISL(2).EQ.0) ISLM=2 |
| 4612 | ENDIF |
| 4613 | IF(ISL(1).EQ.1.OR.ISL(2).EQ.1) GOTO 200 |
| 4614 | ENDIF |
| 4615 | IF(IGM.GT.0.AND.MOD(MSTJ(43),2).EQ.1.AND.(P(N+1,5).GE. |
| 4616 | &PMTH(2,KFLD(1)).OR.P(N+2,5).GE.PMTH(2,KFLD(2)))) THEN |
| 4617 | PMQ1=V(N+1,5)/V(IM,5) |
| 4618 | PMQ2=V(N+2,5)/V(IM,5) |
| 4619 | ZD=SQRT(MAX(0.,(1.-V(IM,5)/PEM**2)*((1.-PMQ1-PMQ2)**2- |
| 4620 | & 4.*PMQ1*PMQ2))) |
| 4621 | ZH=1.+PMQ1-PMQ2 |
| 4622 | ZL=0.5*(ZH-ZD) |
| 4623 | ZU=0.5*(ZH+ZD) |
| 4624 | IF(V(IM,1).LT.ZL.OR.V(IM,1).GT.ZU) GOTO 200 |
| 4625 | ENDIF |
| 4626 | |
| 4627 | C...Accepted branch. Construct four-momentum for initial partons. |
| 4628 | 330 MAZIP=0 |
| 4629 | MAZIC=0 |
| 4630 | IF(NEP.EQ.1) THEN |
| 4631 | P(N+1,1)=0. |
| 4632 | P(N+1,2)=0. |
| 4633 | P(N+1,3)=SQRT(MAX(0.,(P(IPA(1),4)+P(N+1,5))*(P(IPA(1),4)- |
| 4634 | & P(N+1,5)))) |
| 4635 | P(N+1,4)=P(IPA(1),4) |
| 4636 | V(N+1,2)=P(N+1,4) |
| 4637 | ELSEIF(IGM.EQ.0.AND.NEP.EQ.2) THEN |
| 4638 | PED1=0.5*(V(IM,5)+V(N+1,5)-V(N+2,5))/P(IM,5) |
| 4639 | P(N+1,1)=0. |
| 4640 | P(N+1,2)=0. |
| 4641 | P(N+1,3)=SQRT(MAX(0.,(PED1+P(N+1,5))*(PED1-P(N+1,5)))) |
| 4642 | P(N+1,4)=PED1 |
| 4643 | P(N+2,1)=0. |
| 4644 | P(N+2,2)=0. |
| 4645 | P(N+2,3)=-P(N+1,3) |
| 4646 | P(N+2,4)=P(IM,5)-PED1 |
| 4647 | V(N+1,2)=P(N+1,4) |
| 4648 | V(N+2,2)=P(N+2,4) |
| 4649 | ELSEIF(NEP.EQ.3) THEN |
| 4650 | P(N+1,1)=0. |
| 4651 | P(N+1,2)=0. |
| 4652 | P(N+1,3)=SQRT(MAX(0.,PA1S)) |
| 4653 | P(N+2,1)=SQRT(PTS) |
| 4654 | P(N+2,2)=0. |
| 4655 | P(N+2,3)=0.5*(PA3S-PA2S-PA1S)/P(N+1,3) |
| 4656 | P(N+3,1)=-P(N+2,1) |
| 4657 | P(N+3,2)=0. |
| 4658 | P(N+3,3)=-(P(N+1,3)+P(N+2,3)) |
| 4659 | V(N+1,2)=P(N+1,4) |
| 4660 | V(N+2,2)=P(N+2,4) |
| 4661 | V(N+3,2)=P(N+3,4) |
| 4662 | |
| 4663 | C...Construct transverse momentum for ordinary branching in shower. |
| 4664 | ELSE |
| 4665 | ZM=V(IM,1) |
| 4666 | PZM=SQRT(MAX(0.,(PEM+P(IM,5))*(PEM-P(IM,5)))) |
| 4667 | PMLS=(V(IM,5)-V(N+1,5)-V(N+2,5))**2-4.*V(N+1,5)*V(N+2,5) |
| 4668 | IF(PZM.LE.0.) THEN |
| 4669 | PTS=0. |
| 4670 | ELSEIF(MOD(MSTJ(43),2).EQ.1) THEN |
| 4671 | PTS=(PEM**2*(ZM*(1.-ZM)*V(IM,5)-(1.-ZM)*V(N+1,5)- |
| 4672 | & ZM*V(N+2,5))-0.25*PMLS)/PZM**2 |
| 4673 | ELSE |
| 4674 | PTS=PMLS*(ZM*(1.-ZM)*PEM**2/V(IM,5)-0.25)/PZM**2 |
| 4675 | ENDIF |
| 4676 | PT=SQRT(MAX(0.,PTS)) |
| 4677 | |
| 4678 | C...Find coefficient of azimuthal asymmetry due to gluon polarization. |
| 4679 | HAZIP=0. |
| 4680 | IF(MSTJ(49).NE.1.AND.MOD(MSTJ(46),2).EQ.1.AND.K(IM,2).EQ.21. |
| 4681 | & AND.IAU.NE.0) THEN |
| 4682 | IF(K(IGM,3).NE.0) MAZIP=1 |
| 4683 | ZAU=V(IGM,1) |
| 4684 | IF(IAU.EQ.IM+1) ZAU=1.-V(IGM,1) |
| 4685 | IF(MAZIP.EQ.0) ZAU=0. |
| 4686 | IF(K(IGM,2).NE.21) THEN |
| 4687 | HAZIP=2.*ZAU/(1.+ZAU**2) |
| 4688 | ELSE |
| 4689 | HAZIP=(ZAU/(1.-ZAU*(1.-ZAU)))**2 |
| 4690 | ENDIF |
| 4691 | IF(K(N+1,2).NE.21) THEN |
| 4692 | HAZIP=HAZIP*(-2.*ZM*(1.-ZM))/(1.-2.*ZM*(1.-ZM)) |
| 4693 | ELSE |
| 4694 | HAZIP=HAZIP*(ZM*(1.-ZM)/(1.-ZM*(1.-ZM)))**2 |
| 4695 | ENDIF |
| 4696 | ENDIF |
| 4697 | |
| 4698 | C...Find coefficient of azimuthal asymmetry due to soft gluon |
| 4699 | C...interference. |
| 4700 | HAZIC=0. |
| 4701 | IF(MSTJ(49).NE.2.AND.MSTJ(46).GE.2.AND.(K(N+1,2).EQ.21.OR. |
| 4702 | & K(N+2,2).EQ.21).AND.IAU.NE.0) THEN |
| 4703 | IF(K(IGM,3).NE.0) MAZIC=N+1 |
| 4704 | IF(K(IGM,3).NE.0.AND.K(N+1,2).NE.21) MAZIC=N+2 |
| 4705 | IF(K(IGM,3).NE.0.AND.K(N+1,2).EQ.21.AND.K(N+2,2).EQ.21.AND. |
| 4706 | & ZM.GT.0.5) MAZIC=N+2 |
| 4707 | IF(K(IAU,2).EQ.22) MAZIC=0 |
| 4708 | ZS=ZM |
| 4709 | IF(MAZIC.EQ.N+2) ZS=1.-ZM |
| 4710 | ZGM=V(IGM,1) |
| 4711 | IF(IAU.EQ.IM-1) ZGM=1.-V(IGM,1) |
| 4712 | IF(MAZIC.EQ.0) ZGM=1. |
| 4713 | HAZIC=(P(IM,5)/P(IGM,5))*SQRT((1.-ZS)*(1.-ZGM)/(ZS*ZGM)) |
| 4714 | HAZIC=MIN(0.95,HAZIC) |
| 4715 | ENDIF |
| 4716 | ENDIF |
| 4717 | |
| 4718 | C...Construct kinematics for ordinary branching in shower. |
| 4719 | 340 IF(NEP.EQ.2.AND.IGM.GT.0) THEN |
| 4720 | IF(MOD(MSTJ(43),2).EQ.1) THEN |
| 4721 | P(N+1,4)=PEM*V(IM,1) |
| 4722 | ELSE |
| 4723 | P(N+1,4)=PEM*(0.5*(V(IM,5)-SQRT(PMLS)+V(N+1,5)-V(N+2,5))+ |
| 4724 | & SQRT(PMLS)*ZM)/V(IM,5) |
| 4725 | ENDIF |
| 4726 | PHI=PARU(2)*RLU(0) |
| 4727 | P(N+1,1)=PT*COS(PHI) |
| 4728 | P(N+1,2)=PT*SIN(PHI) |
| 4729 | IF(PZM.GT.0.) THEN |
| 4730 | P(N+1,3)=0.5*(V(N+2,5)-V(N+1,5)-V(IM,5)+2.*PEM*P(N+1,4))/PZM |
| 4731 | ELSE |
| 4732 | P(N+1,3)=0. |
| 4733 | ENDIF |
| 4734 | P(N+2,1)=-P(N+1,1) |
| 4735 | P(N+2,2)=-P(N+1,2) |
| 4736 | P(N+2,3)=PZM-P(N+1,3) |
| 4737 | P(N+2,4)=PEM-P(N+1,4) |
| 4738 | IF(MSTJ(43).LE.2) THEN |
| 4739 | V(N+1,2)=(PEM*P(N+1,4)-PZM*P(N+1,3))/P(IM,5) |
| 4740 | V(N+2,2)=(PEM*P(N+2,4)-PZM*P(N+2,3))/P(IM,5) |
| 4741 | ENDIF |
| 4742 | ENDIF |
| 4743 | |
| 4744 | C...Rotate and boost daughters. |
| 4745 | IF(IGM.GT.0) THEN |
| 4746 | IF(MSTJ(43).LE.2) THEN |
| 4747 | BEX=P(IGM,1)/P(IGM,4) |
| 4748 | BEY=P(IGM,2)/P(IGM,4) |
| 4749 | BEZ=P(IGM,3)/P(IGM,4) |
| 4750 | GA=P(IGM,4)/P(IGM,5) |
| 4751 | GABEP=GA*(GA*(BEX*P(IM,1)+BEY*P(IM,2)+BEZ*P(IM,3))/(1.+GA)- |
| 4752 | & P(IM,4)) |
| 4753 | ELSE |
| 4754 | BEX=0. |
| 4755 | BEY=0. |
| 4756 | BEZ=0. |
| 4757 | GA=1. |
| 4758 | GABEP=0. |
| 4759 | ENDIF |
| 4760 | THE=ULANGL(P(IM,3)+GABEP*BEZ,SQRT((P(IM,1)+GABEP*BEX)**2+ |
| 4761 | & (P(IM,2)+GABEP*BEY)**2)) |
| 4762 | PHI=ULANGL(P(IM,1)+GABEP*BEX,P(IM,2)+GABEP*BEY) |
| 4763 | DO 350 I=N+1,N+2 |
| 4764 | DP(1)=COS(THE)*COS(PHI)*P(I,1)-SIN(PHI)*P(I,2)+ |
| 4765 | & SIN(THE)*COS(PHI)*P(I,3) |
| 4766 | DP(2)=COS(THE)*SIN(PHI)*P(I,1)+COS(PHI)*P(I,2)+ |
| 4767 | & SIN(THE)*SIN(PHI)*P(I,3) |
| 4768 | DP(3)=-SIN(THE)*P(I,1)+COS(THE)*P(I,3) |
| 4769 | DP(4)=P(I,4) |
| 4770 | DBP=BEX*DP(1)+BEY*DP(2)+BEZ*DP(3) |
| 4771 | DGABP=GA*(GA*DBP/(1D0+GA)+DP(4)) |
| 4772 | P(I,1)=DP(1)+DGABP*BEX |
| 4773 | P(I,2)=DP(2)+DGABP*BEY |
| 4774 | P(I,3)=DP(3)+DGABP*BEZ |
| 4775 | 350 P(I,4)=GA*(DP(4)+DBP) |
| 4776 | ENDIF |
| 4777 | |
| 4778 | C...Weight with azimuthal distribution, if required. |
| 4779 | IF(MAZIP.NE.0.OR.MAZIC.NE.0) THEN |
| 4780 | DO 360 J=1,3 |
| 4781 | DPT(1,J)=P(IM,J) |
| 4782 | DPT(2,J)=P(IAU,J) |
| 4783 | 360 DPT(3,J)=P(N+1,J) |
| 4784 | DPMA=DPT(1,1)*DPT(2,1)+DPT(1,2)*DPT(2,2)+DPT(1,3)*DPT(2,3) |
| 4785 | DPMD=DPT(1,1)*DPT(3,1)+DPT(1,2)*DPT(3,2)+DPT(1,3)*DPT(3,3) |
| 4786 | DPMM=DPT(1,1)**2+DPT(1,2)**2+DPT(1,3)**2 |
| 4787 | DO 370 J=1,3 |
| 4788 | DPT(4,J)=DPT(2,J)-DPMA*DPT(1,J)/DPMM |
| 4789 | 370 DPT(5,J)=DPT(3,J)-DPMD*DPT(1,J)/DPMM |
| 4790 | DPT(4,4)=SQRT(DPT(4,1)**2+DPT(4,2)**2+DPT(4,3)**2) |
| 4791 | DPT(5,4)=SQRT(DPT(5,1)**2+DPT(5,2)**2+DPT(5,3)**2) |
| 4792 | IF(MIN(DPT(4,4),DPT(5,4)).GT.0.1*PARJ(82)) THEN |
| 4793 | CAD=(DPT(4,1)*DPT(5,1)+DPT(4,2)*DPT(5,2)+ |
| 4794 | & DPT(4,3)*DPT(5,3))/(DPT(4,4)*DPT(5,4)) |
| 4795 | IF(MAZIP.NE.0) THEN |
| 4796 | IF(1.+HAZIP*(2.*CAD**2-1.).LT.RLU(0)*(1.+ABS(HAZIP))) |
| 4797 | & GOTO 340 |
| 4798 | ENDIF |
| 4799 | IF(MAZIC.NE.0) THEN |
| 4800 | IF(MAZIC.EQ.N+2) CAD=-CAD |
| 4801 | IF((1.-HAZIC)*(1.-HAZIC*CAD)/(1.+HAZIC**2-2.*HAZIC*CAD). |
| 4802 | & LT.RLU(0)) GOTO 340 |
| 4803 | ENDIF |
| 4804 | ENDIF |
| 4805 | ENDIF |
| 4806 | |
| 4807 | C...Continue loop over partons that may branch, until none left. |
| 4808 | IF(IGM.GE.0) K(IM,1)=14 |
| 4809 | N=N+NEP |
| 4810 | NEP=2 |
| 4811 | IF(N.GT.MSTU(4)-MSTU(32)-5) THEN |
| 4812 | CALL LUERRM(11,'(LUSHOW:) no more memory left in LUJETS') |
| 4813 | IF(MSTU(21).GE.1) N=NS |
| 4814 | IF(MSTU(21).GE.1) RETURN |
| 4815 | ENDIF |
| 4816 | GOTO 140 |
| 4817 | |
| 4818 | C...Set information on imagined shower initiator. |
| 4819 | 380 IF(NPA.GE.2) THEN |
| 4820 | K(NS+1,1)=11 |
| 4821 | K(NS+1,2)=94 |
| 4822 | K(NS+1,3)=IP1 |
| 4823 | IF(IP2.GT.0.AND.IP2.LT.IP1) K(NS+1,3)=IP2 |
| 4824 | K(NS+1,4)=NS+2 |
| 4825 | K(NS+1,5)=NS+1+NPA |
| 4826 | IIM=1 |
| 4827 | ELSE |
| 4828 | IIM=0 |
| 4829 | ENDIF |
| 4830 | |
| 4831 | C...Reconstruct string drawing information. |
| 4832 | DO 390 I=NS+1+IIM,N |
| 4833 | IF(K(I,1).LE.10.AND.K(I,2).EQ.22) THEN |
| 4834 | K(I,1)=1 |
| 4835 | ELSEIF(K(I,1).LE.10.AND.IABS(K(I,2)).GE.11.AND. |
| 4836 | &IABS(K(I,2)).LE.18) THEN |
| 4837 | K(I,1)=1 |
| 4838 | ELSEIF(K(I,1).LE.10) THEN |
| 4839 | K(I,4)=MSTU(5)*(K(I,4)/MSTU(5)) |
| 4840 | K(I,5)=MSTU(5)*(K(I,5)/MSTU(5)) |
| 4841 | ELSEIF(K(MOD(K(I,4),MSTU(5))+1,2).NE.22) THEN |
| 4842 | ID1=MOD(K(I,4),MSTU(5)) |
| 4843 | IF(K(I,2).GE.1.AND.K(I,2).LE.8) ID1=MOD(K(I,4),MSTU(5))+1 |
| 4844 | ID2=2*MOD(K(I,4),MSTU(5))+1-ID1 |
| 4845 | K(I,4)=MSTU(5)*(K(I,4)/MSTU(5))+ID1 |
| 4846 | K(I,5)=MSTU(5)*(K(I,5)/MSTU(5))+ID2 |
| 4847 | K(ID1,4)=K(ID1,4)+MSTU(5)*I |
| 4848 | K(ID1,5)=K(ID1,5)+MSTU(5)*ID2 |
| 4849 | K(ID2,4)=K(ID2,4)+MSTU(5)*ID1 |
| 4850 | K(ID2,5)=K(ID2,5)+MSTU(5)*I |
| 4851 | ELSE |
| 4852 | ID1=MOD(K(I,4),MSTU(5)) |
| 4853 | ID2=ID1+1 |
| 4854 | K(I,4)=MSTU(5)*(K(I,4)/MSTU(5))+ID1 |
| 4855 | K(I,5)=MSTU(5)*(K(I,5)/MSTU(5))+ID1 |
| 4856 | K(ID1,4)=K(ID1,4)+MSTU(5)*I |
| 4857 | K(ID1,5)=K(ID1,5)+MSTU(5)*I |
| 4858 | K(ID2,4)=0 |
| 4859 | K(ID2,5)=0 |
| 4860 | ENDIF |
| 4861 | 390 CONTINUE |
| 4862 | |
| 4863 | C...Transformation from CM frame. |
| 4864 | IF(NPA.GE.2) THEN |
| 4865 | BEX=PS(1)/PS(4) |
| 4866 | BEY=PS(2)/PS(4) |
| 4867 | BEZ=PS(3)/PS(4) |
| 4868 | GA=PS(4)/PS(5) |
| 4869 | GABEP=GA*(GA*(BEX*P(IPA(1),1)+BEY*P(IPA(1),2)+BEZ*P(IPA(1),3)) |
| 4870 | & /(1.+GA)-P(IPA(1),4)) |
| 4871 | ELSE |
| 4872 | BEX=0. |
| 4873 | BEY=0. |
| 4874 | BEZ=0. |
| 4875 | GABEP=0. |
| 4876 | ENDIF |
| 4877 | THE=ULANGL(P(IPA(1),3)+GABEP*BEZ,SQRT((P(IPA(1),1) |
| 4878 | &+GABEP*BEX)**2+(P(IPA(1),2)+GABEP*BEY)**2)) |
| 4879 | PHI=ULANGL(P(IPA(1),1)+GABEP*BEX,P(IPA(1),2)+GABEP*BEY) |
| 4880 | IF(NPA.EQ.3) THEN |
| 4881 | CHI=ULANGL(COS(THE)*COS(PHI)*(P(IPA(2),1)+GABEP*BEX)+COS(THE)* |
| 4882 | & SIN(PHI)*(P(IPA(2),2)+GABEP*BEY)-SIN(THE)*(P(IPA(2),3)+GABEP* |
| 4883 | & BEZ),-SIN(PHI)*(P(IPA(2),1)+GABEP*BEX)+COS(PHI)*(P(IPA(2),2)+ |
| 4884 | & GABEP*BEY)) |
| 4885 | MSTU(33)=1 |
| 4886 | CALL LUDBRB(NS+1,N,0.,CHI,0D0,0D0,0D0) |
| 4887 | ENDIF |
| 4888 | DBEX=DBLE(BEX) |
| 4889 | DBEY=DBLE(BEY) |
| 4890 | DBEZ=DBLE(BEZ) |
| 4891 | MSTU(33)=1 |
| 4892 | CALL LUDBRB(NS+1,N,THE,PHI,DBEX,DBEY,DBEZ) |
| 4893 | |
| 4894 | C...Decay vertex of shower. |
| 4895 | DO 400 I=NS+1,N |
| 4896 | DO 400 J=1,5 |
| 4897 | 400 V(I,J)=V(IP1,J) |
| 4898 | |
| 4899 | C...Delete trivial shower, else connect initiators. |
| 4900 | IF(N.EQ.NS+NPA+IIM) THEN |
| 4901 | N=NS |
| 4902 | ELSE |
| 4903 | DO 410 IP=1,NPA |
| 4904 | K(IPA(IP),1)=14 |
| 4905 | K(IPA(IP),4)=K(IPA(IP),4)+NS+IIM+IP |
| 4906 | K(IPA(IP),5)=K(IPA(IP),5)+NS+IIM+IP |
| 4907 | K(NS+IIM+IP,3)=IPA(IP) |
| 4908 | IF(IIM.EQ.1.AND.MSTU(16).NE.2) K(NS+IIM+IP,3)=NS+1 |
| 4909 | K(NS+IIM+IP,4)=MSTU(5)*IPA(IP)+K(NS+IIM+IP,4) |
| 4910 | 410 K(NS+IIM+IP,5)=MSTU(5)*IPA(IP)+K(NS+IIM+IP,5) |
| 4911 | ENDIF |
| 4912 | |
| 4913 | RETURN |
| 4914 | END |
| 4915 | |
| 4916 | C********************************************************************* |
| 4917 | |
| 4918 | SUBROUTINE LUBOEI(NSAV) |
| 4919 | |
| 4920 | C...Purpose: to modify event so as to approximately take into account |
| 4921 | C...Bose-Einstein effects according to a simple phenomenological |
| 4922 | C...parametrization. |
| 4923 | IMPLICIT DOUBLE PRECISION(D) |
| 4924 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 4925 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 4926 | SAVE /LUJETS/,/LUDAT1/ |
| 4927 | DIMENSION DPS(4),KFBE(9),NBE(0:9),BEI(100) |
| 4928 | DATA KFBE/211,-211,111,321,-321,130,310,221,331/ |
| 4929 | |
| 4930 | C...Boost event to overall CM frame. Calculate CM energy. |
| 4931 | IF((MSTJ(51).NE.1.AND.MSTJ(51).NE.2).OR.N-NSAV.LE.1) RETURN |
| 4932 | DO 100 J=1,4 |
| 4933 | 100 DPS(J)=0. |
| 4934 | DO 120 I=1,N |
| 4935 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 120 |
| 4936 | DO 110 J=1,4 |
| 4937 | 110 DPS(J)=DPS(J)+P(I,J) |
| 4938 | 120 CONTINUE |
| 4939 | CALL LUDBRB(0,0,0.,0.,-DPS(1)/DPS(4),-DPS(2)/DPS(4), |
| 4940 | &-DPS(3)/DPS(4)) |
| 4941 | PECM=0. |
| 4942 | DO 130 I=1,N |
| 4943 | 130 IF(K(I,1).GE.1.AND.K(I,1).LE.10) PECM=PECM+P(I,4) |
| 4944 | |
| 4945 | C...Reserve copy of particles by species at end of record. |
| 4946 | NBE(0)=N+MSTU(3) |
| 4947 | DO 160 IBE=1,MIN(9,MSTJ(52)) |
| 4948 | NBE(IBE)=NBE(IBE-1) |
| 4949 | DO 150 I=NSAV+1,N |
| 4950 | IF(K(I,2).NE.KFBE(IBE)) GOTO 150 |
| 4951 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 150 |
| 4952 | IF(NBE(IBE).GE.MSTU(4)-MSTU(32)-5) THEN |
| 4953 | CALL LUERRM(11,'(LUBOEI:) no more memory left in LUJETS') |
| 4954 | RETURN |
| 4955 | ENDIF |
| 4956 | NBE(IBE)=NBE(IBE)+1 |
| 4957 | K(NBE(IBE),1)=I |
| 4958 | DO 140 J=1,3 |
| 4959 | 140 P(NBE(IBE),J)=0. |
| 4960 | 150 CONTINUE |
| 4961 | 160 CONTINUE |
| 4962 | |
| 4963 | C...Tabulate integral for subsequent momentum shift. |
| 4964 | DO 210 IBE=1,MIN(9,MSTJ(52)) |
| 4965 | IF(IBE.NE.1.AND.IBE.NE.4.AND.IBE.LE.7) GOTO 180 |
| 4966 | IF(IBE.EQ.1.AND.MAX(NBE(1)-NBE(0),NBE(2)-NBE(1),NBE(3)-NBE(2)). |
| 4967 | &LE.1) GOTO 180 |
| 4968 | IF(IBE.EQ.4.AND.MAX(NBE(4)-NBE(3),NBE(5)-NBE(4),NBE(6)-NBE(5), |
| 4969 | &NBE(7)-NBE(6)).LE.1) GOTO 180 |
| 4970 | IF(IBE.GE.8.AND.NBE(IBE)-NBE(IBE-1).LE.1) GOTO 180 |
| 4971 | IF(IBE.EQ.1) PMHQ=2.*ULMASS(211) |
| 4972 | IF(IBE.EQ.4) PMHQ=2.*ULMASS(321) |
| 4973 | IF(IBE.EQ.8) PMHQ=2.*ULMASS(221) |
| 4974 | IF(IBE.EQ.9) PMHQ=2.*ULMASS(331) |
| 4975 | QDEL=0.1*MIN(PMHQ,PARJ(93)) |
| 4976 | IF(MSTJ(51).EQ.1) THEN |
| 4977 | NBIN=MIN(100,NINT(9.*PARJ(93)/QDEL)) |
| 4978 | BEEX=EXP(0.5*QDEL/PARJ(93)) |
| 4979 | BERT=EXP(-QDEL/PARJ(93)) |
| 4980 | ELSE |
| 4981 | NBIN=MIN(100,NINT(3.*PARJ(93)/QDEL)) |
| 4982 | ENDIF |
| 4983 | DO 170 IBIN=1,NBIN |
| 4984 | QBIN=QDEL*(IBIN-0.5) |
| 4985 | BEI(IBIN)=QDEL*(QBIN**2+QDEL**2/12.)/SQRT(QBIN**2+PMHQ**2) |
| 4986 | IF(MSTJ(51).EQ.1) THEN |
| 4987 | BEEX=BEEX*BERT |
| 4988 | BEI(IBIN)=BEI(IBIN)*BEEX |
| 4989 | ELSE |
| 4990 | BEI(IBIN)=BEI(IBIN)*EXP(-(QBIN/PARJ(93))**2) |
| 4991 | ENDIF |
| 4992 | 170 IF(IBIN.GE.2) BEI(IBIN)=BEI(IBIN)+BEI(IBIN-1) |
| 4993 | |
| 4994 | C...Loop through particle pairs and find old relative momentum. |
| 4995 | 180 DO 200 I1M=NBE(IBE-1)+1,NBE(IBE)-1 |
| 4996 | I1=K(I1M,1) |
| 4997 | DO 200 I2M=I1M+1,NBE(IBE) |
| 4998 | I2=K(I2M,1) |
| 4999 | Q2OLD=MAX(0.,(P(I1,4)+P(I2,4))**2-(P(I1,1)+P(I2,1))**2-(P(I1,2)+ |
| 5000 | &P(I2,2))**2-(P(I1,3)+P(I2,3))**2-(P(I1,5)+P(I2,5))**2) |
| 5001 | QOLD=SQRT(Q2OLD) |
| 5002 | |
| 5003 | C...Calculate new relative momentum. |
| 5004 | IF(QOLD.LT.0.5*QDEL) THEN |
| 5005 | QMOV=QOLD/3. |
| 5006 | ELSEIF(QOLD.LT.(NBIN-0.1)*QDEL) THEN |
| 5007 | RBIN=QOLD/QDEL |
| 5008 | IBIN=RBIN |
| 5009 | RINP=(RBIN**3-IBIN**3)/(3*IBIN*(IBIN+1)+1) |
| 5010 | QMOV=(BEI(IBIN)+RINP*(BEI(IBIN+1)-BEI(IBIN)))* |
| 5011 | & SQRT(Q2OLD+PMHQ**2)/Q2OLD |
| 5012 | ELSE |
| 5013 | QMOV=BEI(NBIN)*SQRT(Q2OLD+PMHQ**2)/Q2OLD |
| 5014 | ENDIF |
| 5015 | Q2NEW=Q2OLD*(QOLD/(QOLD+3.*PARJ(92)*QMOV))**(2./3.) |
| 5016 | |
| 5017 | C...Calculate and save shift to be performed on three-momenta. |
| 5018 | HC1=(P(I1,4)+P(I2,4))**2-(Q2OLD-Q2NEW) |
| 5019 | HC2=(Q2OLD-Q2NEW)*(P(I1,4)-P(I2,4))**2 |
| 5020 | HA=0.5*(1.-SQRT(HC1*Q2NEW/(HC1*Q2OLD-HC2))) |
| 5021 | DO 190 J=1,3 |
| 5022 | PD=HA*(P(I2,J)-P(I1,J)) |
| 5023 | P(I1M,J)=P(I1M,J)+PD |
| 5024 | 190 P(I2M,J)=P(I2M,J)-PD |
| 5025 | 200 CONTINUE |
| 5026 | 210 CONTINUE |
| 5027 | |
| 5028 | C...Shift momenta and recalculate energies. |
| 5029 | DO 230 IM=NBE(0)+1,NBE(MIN(9,MSTJ(52))) |
| 5030 | I=K(IM,1) |
| 5031 | DO 220 J=1,3 |
| 5032 | 220 P(I,J)=P(I,J)+P(IM,J) |
| 5033 | 230 P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) |
| 5034 | |
| 5035 | C...Rescale all momenta for energy conservation. |
| 5036 | PES=0. |
| 5037 | PQS=0. |
| 5038 | DO 240 I=1,N |
| 5039 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 240 |
| 5040 | PES=PES+P(I,4) |
| 5041 | PQS=PQS+P(I,5)**2/P(I,4) |
| 5042 | 240 CONTINUE |
| 5043 | FAC=(PECM-PQS)/(PES-PQS) |
| 5044 | DO 260 I=1,N |
| 5045 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 260 |
| 5046 | DO 250 J=1,3 |
| 5047 | 250 P(I,J)=FAC*P(I,J) |
| 5048 | P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) |
| 5049 | 260 CONTINUE |
| 5050 | |
| 5051 | C...Boost back to correct reference frame. |
| 5052 | CALL LUDBRB(0,0,0.,0.,DPS(1)/DPS(4),DPS(2)/DPS(4),DPS(3)/DPS(4)) |
| 5053 | |
| 5054 | RETURN |
| 5055 | END |
| 5056 | |
| 5057 | C********************************************************************* |
| 5058 | |
| 5059 | FUNCTION ULMASS(KF) |
| 5060 | |
| 5061 | C...Purpose: to give the mass of a particle/parton. |
| 5062 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 5063 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 5064 | SAVE /LUDAT1/,/LUDAT2/ |
| 5065 | |
| 5066 | C...Reset variables. Compressed code. |
| 5067 | ULMASS=0. |
| 5068 | KFA=IABS(KF) |
| 5069 | KC=LUCOMP(KF) |
| 5070 | IF(KC.EQ.0) RETURN |
| 5071 | PARF(106)=PMAS(6,1) |
| 5072 | PARF(107)=PMAS(7,1) |
| 5073 | PARF(108)=PMAS(8,1) |
| 5074 | |
| 5075 | C...Guarantee use of constituent masses for internal checks. |
| 5076 | IF((MSTJ(93).EQ.1.OR.MSTJ(93).EQ.2).AND.KFA.LE.10) THEN |
| 5077 | ULMASS=PARF(100+KFA) |
| 5078 | IF(MSTJ(93).EQ.2) ULMASS=MAX(0.,ULMASS-PARF(121)) |
| 5079 | |
| 5080 | C...Masses that can be read directly off table. |
| 5081 | ELSEIF(KFA.LE.100.OR.KC.LE.80.OR.KC.GT.100) THEN |
| 5082 | ULMASS=PMAS(KC,1) |
| 5083 | |
| 5084 | C...Find constituent partons and their masses. |
| 5085 | ELSE |
| 5086 | KFLA=MOD(KFA/1000,10) |
| 5087 | KFLB=MOD(KFA/100,10) |
| 5088 | KFLC=MOD(KFA/10,10) |
| 5089 | KFLS=MOD(KFA,10) |
| 5090 | KFLR=MOD(KFA/10000,10) |
| 5091 | PMA=PARF(100+KFLA) |
| 5092 | PMB=PARF(100+KFLB) |
| 5093 | PMC=PARF(100+KFLC) |
| 5094 | |
| 5095 | C...Construct masses for various meson, diquark and baryon cases. |
| 5096 | IF(KFLA.EQ.0.AND.KFLR.EQ.0.AND.KFLS.LE.3) THEN |
| 5097 | IF(KFLS.EQ.1) PMSPL=-3./(PMB*PMC) |
| 5098 | IF(KFLS.GE.3) PMSPL=1./(PMB*PMC) |
| 5099 | ULMASS=PARF(111)+PMB+PMC+PARF(113)*PARF(101)**2*PMSPL |
| 5100 | ELSEIF(KFLA.EQ.0) THEN |
| 5101 | KMUL=2 |
| 5102 | IF(KFLS.EQ.1) KMUL=3 |
| 5103 | IF(KFLR.EQ.2) KMUL=4 |
| 5104 | IF(KFLS.EQ.5) KMUL=5 |
| 5105 | ULMASS=PARF(113+KMUL)+PMB+PMC |
| 5106 | ELSEIF(KFLC.EQ.0) THEN |
| 5107 | IF(KFLS.EQ.1) PMSPL=-3./(PMA*PMB) |
| 5108 | IF(KFLS.EQ.3) PMSPL=1./(PMA*PMB) |
| 5109 | ULMASS=2.*PARF(112)/3.+PMA+PMB+PARF(114)*PARF(101)**2*PMSPL |
| 5110 | IF(MSTJ(93).EQ.1) ULMASS=PMA+PMB |
| 5111 | IF(MSTJ(93).EQ.2) ULMASS=MAX(0.,ULMASS-PARF(122)- |
| 5112 | & 2.*PARF(112)/3.) |
| 5113 | ELSE |
| 5114 | IF(KFLS.EQ.2.AND.KFLA.EQ.KFLB) THEN |
| 5115 | PMSPL=1./(PMA*PMB)-2./(PMA*PMC)-2./(PMB*PMC) |
| 5116 | ELSEIF(KFLS.EQ.2.AND.KFLB.GE.KFLC) THEN |
| 5117 | PMSPL=-2./(PMA*PMB)-2./(PMA*PMC)+1./(PMB*PMC) |
| 5118 | ELSEIF(KFLS.EQ.2) THEN |
| 5119 | PMSPL=-3./(PMB*PMC) |
| 5120 | ELSE |
| 5121 | PMSPL=1./(PMA*PMB)+1./(PMA*PMC)+1./(PMB*PMC) |
| 5122 | ENDIF |
| 5123 | ULMASS=PARF(112)+PMA+PMB+PMC+PARF(114)*PARF(101)**2*PMSPL |
| 5124 | ENDIF |
| 5125 | ENDIF |
| 5126 | |
| 5127 | C...Optional mass broadening according to truncated Breit-Wigner |
| 5128 | C...(either in m or in m^2). |
| 5129 | IF(MSTJ(24).GE.1.AND.PMAS(KC,2).GT.1E-4) THEN |
| 5130 | IF(MSTJ(24).EQ.1.OR.(MSTJ(24).EQ.2.AND.KFA.GT.100)) THEN |
| 5131 | ULMASS=ULMASS+0.5*PMAS(KC,2)*TAN((2.*RLU(0)-1.)* |
| 5132 | & ATAN(2.*PMAS(KC,3)/PMAS(KC,2))) |
| 5133 | ELSE |
| 5134 | PM0=ULMASS |
| 5135 | PMLOW=ATAN((MAX(0.,PM0-PMAS(KC,3))**2-PM0**2)/ |
| 5136 | & (PM0*PMAS(KC,2))) |
| 5137 | PMUPP=ATAN(((PM0+PMAS(KC,3))**2-PM0**2)/(PM0*PMAS(KC,2))) |
| 5138 | ULMASS=SQRT(MAX(0.,PM0**2+PM0*PMAS(KC,2)*TAN(PMLOW+ |
| 5139 | & (PMUPP-PMLOW)*RLU(0)))) |
| 5140 | ENDIF |
| 5141 | ENDIF |
| 5142 | MSTJ(93)=0 |
| 5143 | |
| 5144 | RETURN |
| 5145 | END |
| 5146 | |
| 5147 | C********************************************************************* |
| 5148 | |
| 5149 | SUBROUTINE LUNAME(KF,CHAU) |
| 5150 | |
| 5151 | C...Purpose: to give the particle/parton name as a character string. |
| 5152 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 5153 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 5154 | COMMON/LUDAT4/CHAF(500) |
| 5155 | CHARACTER CHAF*8 |
| 5156 | SAVE /LUDAT1/,/LUDAT2/,/LUDAT4/ |
| 5157 | CHARACTER CHAU*16 |
| 5158 | |
| 5159 | C...Initial values. Charge. Subdivide code. |
| 5160 | CHAU=' ' |
| 5161 | KFA=IABS(KF) |
| 5162 | KC=LUCOMP(KF) |
| 5163 | IF(KC.EQ.0) RETURN |
| 5164 | KQ=LUCHGE(KF) |
| 5165 | KFLA=MOD(KFA/1000,10) |
| 5166 | KFLB=MOD(KFA/100,10) |
| 5167 | KFLC=MOD(KFA/10,10) |
| 5168 | KFLS=MOD(KFA,10) |
| 5169 | KFLR=MOD(KFA/10000,10) |
| 5170 | |
| 5171 | C...Read out root name and spin for simple particle. |
| 5172 | IF(KFA.LE.100.OR.(KFA.GT.100.AND.KC.GT.100)) THEN |
| 5173 | CHAU=CHAF(KC) |
| 5174 | LEN=0 |
| 5175 | DO 100 LEM=1,8 |
| 5176 | 100 IF(CHAU(LEM:LEM).NE.' ') LEN=LEM |
| 5177 | |
| 5178 | C...Construct root name for diquark. Add on spin. |
| 5179 | ELSEIF(KFLC.EQ.0) THEN |
| 5180 | CHAU(1:2)=CHAF(KFLA)(1:1)//CHAF(KFLB)(1:1) |
| 5181 | IF(KFLS.EQ.1) CHAU(3:4)='_0' |
| 5182 | IF(KFLS.EQ.3) CHAU(3:4)='_1' |
| 5183 | LEN=4 |
| 5184 | |
| 5185 | C...Construct root name for heavy meson. Add on spin and heavy flavour. |
| 5186 | ELSEIF(KFLA.EQ.0) THEN |
| 5187 | IF(KFLB.EQ.5) CHAU(1:1)='B' |
| 5188 | IF(KFLB.EQ.6) CHAU(1:1)='T' |
| 5189 | IF(KFLB.EQ.7) CHAU(1:1)='L' |
| 5190 | IF(KFLB.EQ.8) CHAU(1:1)='H' |
| 5191 | LEN=1 |
| 5192 | IF(KFLR.EQ.0.AND.KFLS.EQ.1) THEN |
| 5193 | ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.3) THEN |
| 5194 | CHAU(2:2)='*' |
| 5195 | LEN=2 |
| 5196 | ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.3) THEN |
| 5197 | CHAU(2:3)='_1' |
| 5198 | LEN=3 |
| 5199 | ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.1) THEN |
| 5200 | CHAU(2:4)='*_0' |
| 5201 | LEN=4 |
| 5202 | ELSEIF(KFLR.EQ.2) THEN |
| 5203 | CHAU(2:4)='*_1' |
| 5204 | LEN=4 |
| 5205 | ELSEIF(KFLS.EQ.5) THEN |
| 5206 | CHAU(2:4)='*_2' |
| 5207 | LEN=4 |
| 5208 | ENDIF |
| 5209 | IF(KFLC.GE.3.AND.KFLR.EQ.0.AND.KFLS.LE.3) THEN |
| 5210 | CHAU(LEN+1:LEN+2)='_'//CHAF(KFLC)(1:1) |
| 5211 | LEN=LEN+2 |
| 5212 | ELSEIF(KFLC.GE.3) THEN |
| 5213 | CHAU(LEN+1:LEN+1)=CHAF(KFLC)(1:1) |
| 5214 | LEN=LEN+1 |
| 5215 | ENDIF |
| 5216 | |
| 5217 | C...Construct root name and spin for heavy baryon. |
| 5218 | ELSE |
| 5219 | IF(KFLB.LE.2.AND.KFLC.LE.2) THEN |
| 5220 | CHAU='Sigma ' |
| 5221 | IF(KFLC.GT.KFLB) CHAU='Lambda' |
| 5222 | IF(KFLS.EQ.4) CHAU='Sigma*' |
| 5223 | LEN=5 |
| 5224 | IF(CHAU(6:6).NE.' ') LEN=6 |
| 5225 | ELSEIF(KFLB.LE.2.OR.KFLC.LE.2) THEN |
| 5226 | CHAU='Xi ' |
| 5227 | IF(KFLA.GT.KFLB.AND.KFLB.GT.KFLC) CHAU='Xi''' |
| 5228 | IF(KFLS.EQ.4) CHAU='Xi*' |
| 5229 | LEN=2 |
| 5230 | IF(CHAU(3:3).NE.' ') LEN=3 |
| 5231 | ELSE |
| 5232 | CHAU='Omega ' |
| 5233 | IF(KFLA.GT.KFLB.AND.KFLB.GT.KFLC) CHAU='Omega''' |
| 5234 | IF(KFLS.EQ.4) CHAU='Omega*' |
| 5235 | LEN=5 |
| 5236 | IF(CHAU(6:6).NE.' ') LEN=6 |
| 5237 | ENDIF |
| 5238 | |
| 5239 | C...Add on heavy flavour content for heavy baryon. |
| 5240 | CHAU(LEN+1:LEN+2)='_'//CHAF(KFLA)(1:1) |
| 5241 | LEN=LEN+2 |
| 5242 | IF(KFLB.GE.KFLC.AND.KFLC.GE.4) THEN |
| 5243 | CHAU(LEN+1:LEN+2)=CHAF(KFLB)(1:1)//CHAF(KFLC)(1:1) |
| 5244 | LEN=LEN+2 |
| 5245 | ELSEIF(KFLB.GE.KFLC.AND.KFLB.GE.4) THEN |
| 5246 | CHAU(LEN+1:LEN+1)=CHAF(KFLB)(1:1) |
| 5247 | LEN=LEN+1 |
| 5248 | ELSEIF(KFLC.GT.KFLB.AND.KFLB.GE.4) THEN |
| 5249 | CHAU(LEN+1:LEN+2)=CHAF(KFLC)(1:1)//CHAF(KFLB)(1:1) |
| 5250 | LEN=LEN+2 |
| 5251 | ELSEIF(KFLC.GT.KFLB.AND.KFLC.GE.4) THEN |
| 5252 | CHAU(LEN+1:LEN+1)=CHAF(KFLC)(1:1) |
| 5253 | LEN=LEN+1 |
| 5254 | ENDIF |
| 5255 | ENDIF |
| 5256 | |
| 5257 | C...Add on bar sign for antiparticle (where necessary). |
| 5258 | IF(KF.GT.0.OR.LEN.EQ.0) THEN |
| 5259 | ELSEIF(KFA.GT.10.AND.KFA.LE.40.AND.KQ.NE.0.AND.MOD(KQ,3).EQ.0) |
| 5260 | &THEN |
| 5261 | ELSEIF(KFA.EQ.89.OR.(KFA.GE.91.AND.KFA.LE.99)) THEN |
| 5262 | ELSEIF(KFA.GT.100.AND.KFLA.EQ.0.AND.KQ.NE.0) THEN |
| 5263 | ELSEIF(MSTU(15).LE.1) THEN |
| 5264 | CHAU(LEN+1:LEN+1)='~' |
| 5265 | LEN=LEN+1 |
| 5266 | ELSE |
| 5267 | CHAU(LEN+1:LEN+3)='bar' |
| 5268 | LEN=LEN+3 |
| 5269 | ENDIF |
| 5270 | |
| 5271 | C...Add on charge where applicable (conventional cases skipped). |
| 5272 | IF(KQ.EQ.6) CHAU(LEN+1:LEN+2)='++' |
| 5273 | IF(KQ.EQ.-6) CHAU(LEN+1:LEN+2)='--' |
| 5274 | IF(KQ.EQ.3) CHAU(LEN+1:LEN+1)='+' |
| 5275 | IF(KQ.EQ.-3) CHAU(LEN+1:LEN+1)='-' |
| 5276 | IF(KQ.EQ.0.AND.(KFA.LE.22.OR.LEN.EQ.0)) THEN |
| 5277 | ELSEIF(KQ.EQ.0.AND.(KFA.GE.81.AND.KFA.LE.100)) THEN |
| 5278 | ELSEIF(KFA.GT.100.AND.KFLA.EQ.0.AND.KFLB.EQ.KFLC.AND. |
| 5279 | &KFLB.NE.1) THEN |
| 5280 | ELSEIF(KQ.EQ.0) THEN |
| 5281 | CHAU(LEN+1:LEN+1)='0' |
| 5282 | ENDIF |
| 5283 | |
| 5284 | RETURN |
| 5285 | END |
| 5286 | |
| 5287 | C********************************************************************* |
| 5288 | |
| 5289 | FUNCTION LUCHGE(KF) |
| 5290 | |
| 5291 | C...Purpose: to give three times the charge for a particle/parton. |
| 5292 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 5293 | SAVE /LUDAT2/ |
| 5294 | |
| 5295 | C...Initial values. Simple case of direct readout. |
| 5296 | LUCHGE=0 |
| 5297 | KFA=IABS(KF) |
| 5298 | KC=LUCOMP(KFA) |
| 5299 | IF(KC.EQ.0) THEN |
| 5300 | ELSEIF(KFA.LE.100.OR.KC.LE.80.OR.KC.GT.100) THEN |
| 5301 | LUCHGE=KCHG(KC,1) |
| 5302 | |
| 5303 | C...Construction from quark content for heavy meson, diquark, baryon. |
| 5304 | ELSEIF(MOD(KFA/1000,10).EQ.0) THEN |
| 5305 | LUCHGE=(KCHG(MOD(KFA/100,10),1)-KCHG(MOD(KFA/10,10),1))* |
| 5306 | & (-1)**MOD(KFA/100,10) |
| 5307 | ELSEIF(MOD(KFA/10,10).EQ.0) THEN |
| 5308 | LUCHGE=KCHG(MOD(KFA/1000,10),1)+KCHG(MOD(KFA/100,10),1) |
| 5309 | ELSE |
| 5310 | LUCHGE=KCHG(MOD(KFA/1000,10),1)+KCHG(MOD(KFA/100,10),1)+ |
| 5311 | & KCHG(MOD(KFA/10,10),1) |
| 5312 | ENDIF |
| 5313 | |
| 5314 | C...Add on correct sign. |
| 5315 | LUCHGE=LUCHGE*ISIGN(1,KF) |
| 5316 | |
| 5317 | RETURN |
| 5318 | END |
| 5319 | |
| 5320 | C********************************************************************* |
| 5321 | |
| 5322 | FUNCTION LUCOMP(KF) |
| 5323 | |
| 5324 | C...Purpose: to compress the standard KF codes for use in mass and decay |
| 5325 | C...arrays; also to check whether a given code actually is defined. |
| 5326 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 5327 | SAVE /LUDAT2/ |
| 5328 | |
| 5329 | C...Subdivide KF code into constituent pieces. |
| 5330 | LUCOMP=0 |
| 5331 | KFA=IABS(KF) |
| 5332 | KFLA=MOD(KFA/1000,10) |
| 5333 | KFLB=MOD(KFA/100,10) |
| 5334 | KFLC=MOD(KFA/10,10) |
| 5335 | KFLS=MOD(KFA,10) |
| 5336 | KFLR=MOD(KFA/10000,10) |
| 5337 | |
| 5338 | C...Simple cases: direct translation or special codes. |
| 5339 | IF(KFA.EQ.0.OR.KFA.GE.100000) THEN |
| 5340 | ELSEIF(KFA.LE.100) THEN |
| 5341 | LUCOMP=KFA |
| 5342 | IF(KF.LT.0.AND.KCHG(KFA,3).EQ.0) LUCOMP=0 |
| 5343 | ELSEIF(KFLS.EQ.0) THEN |
| 5344 | IF(KF.EQ.130) LUCOMP=221 |
| 5345 | IF(KF.EQ.310) LUCOMP=222 |
| 5346 | IF(KFA.EQ.210) LUCOMP=281 |
| 5347 | IF(KFA.EQ.2110) LUCOMP=282 |
| 5348 | IF(KFA.EQ.2210) LUCOMP=283 |
| 5349 | |
| 5350 | C...Mesons. |
| 5351 | ELSEIF(KFA-10000*KFLR.LT.1000) THEN |
| 5352 | IF(KFLB.EQ.0.OR.KFLB.EQ.9.OR.KFLC.EQ.0.OR.KFLC.EQ.9) THEN |
| 5353 | ELSEIF(KFLB.LT.KFLC) THEN |
| 5354 | ELSEIF(KF.LT.0.AND.KFLB.EQ.KFLC) THEN |
| 5355 | ELSEIF(KFLB.EQ.KFLC) THEN |
| 5356 | IF(KFLR.EQ.0.AND.KFLS.EQ.1) THEN |
| 5357 | LUCOMP=110+KFLB |
| 5358 | ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.3) THEN |
| 5359 | LUCOMP=130+KFLB |
| 5360 | ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.3) THEN |
| 5361 | LUCOMP=150+KFLB |
| 5362 | ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.1) THEN |
| 5363 | LUCOMP=170+KFLB |
| 5364 | ELSEIF(KFLR.EQ.2.AND.KFLS.EQ.3) THEN |
| 5365 | LUCOMP=190+KFLB |
| 5366 | ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.5) THEN |
| 5367 | LUCOMP=210+KFLB |
| 5368 | ENDIF |
| 5369 | ELSEIF(KFLB.LE.5.AND.KFLC.LE.3) THEN |
| 5370 | IF(KFLR.EQ.0.AND.KFLS.EQ.1) THEN |
| 5371 | LUCOMP=100+((KFLB-1)*(KFLB-2))/2+KFLC |
| 5372 | ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.3) THEN |
| 5373 | LUCOMP=120+((KFLB-1)*(KFLB-2))/2+KFLC |
| 5374 | ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.3) THEN |
| 5375 | LUCOMP=140+((KFLB-1)*(KFLB-2))/2+KFLC |
| 5376 | ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.1) THEN |
| 5377 | LUCOMP=160+((KFLB-1)*(KFLB-2))/2+KFLC |
| 5378 | ELSEIF(KFLR.EQ.2.AND.KFLS.EQ.3) THEN |
| 5379 | LUCOMP=180+((KFLB-1)*(KFLB-2))/2+KFLC |
| 5380 | ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.5) THEN |
| 5381 | LUCOMP=200+((KFLB-1)*(KFLB-2))/2+KFLC |
| 5382 | ENDIF |
| 5383 | ELSEIF((KFLS.EQ.1.AND.KFLR.LE.1).OR.(KFLS.EQ.3.AND.KFLR.LE.2). |
| 5384 | & OR.(KFLS.EQ.5.AND.KFLR.EQ.0)) THEN |
| 5385 | LUCOMP=80+KFLB |
| 5386 | ENDIF |
| 5387 | |
| 5388 | C...Diquarks. |
| 5389 | ELSEIF((KFLR.EQ.0.OR.KFLR.EQ.1).AND.KFLC.EQ.0) THEN |
| 5390 | IF(KFLS.NE.1.AND.KFLS.NE.3) THEN |
| 5391 | ELSEIF(KFLA.EQ.9.OR.KFLB.EQ.0.OR.KFLB.EQ.9) THEN |
| 5392 | ELSEIF(KFLA.LT.KFLB) THEN |
| 5393 | ELSEIF(KFLS.EQ.1.AND.KFLA.EQ.KFLB) THEN |
| 5394 | ELSE |
| 5395 | LUCOMP=90 |
| 5396 | ENDIF |
| 5397 | |
| 5398 | C...Spin 1/2 baryons. |
| 5399 | ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.2) THEN |
| 5400 | IF(KFLA.EQ.9.OR.KFLB.EQ.0.OR.KFLB.EQ.9.OR.KFLC.EQ.9) THEN |
| 5401 | ELSEIF(KFLA.LE.KFLC.OR.KFLA.LT.KFLB) THEN |
| 5402 | ELSEIF(KFLA.GE.6.OR.KFLB.GE.4.OR.KFLC.GE.4) THEN |
| 5403 | LUCOMP=80+KFLA |
| 5404 | ELSEIF(KFLB.LT.KFLC) THEN |
| 5405 | LUCOMP=300+((KFLA+1)*KFLA*(KFLA-1))/6+(KFLC*(KFLC-1))/2+KFLB |
| 5406 | ELSE |
| 5407 | LUCOMP=330+((KFLA+1)*KFLA*(KFLA-1))/6+(KFLB*(KFLB-1))/2+KFLC |
| 5408 | ENDIF |
| 5409 | |
| 5410 | C...Spin 3/2 baryons. |
| 5411 | ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.4) THEN |
| 5412 | IF(KFLA.EQ.9.OR.KFLB.EQ.0.OR.KFLB.EQ.9.OR.KFLC.EQ.9) THEN |
| 5413 | ELSEIF(KFLA.LT.KFLB.OR.KFLB.LT.KFLC) THEN |
| 5414 | ELSEIF(KFLA.GE.6.OR.KFLB.GE.4) THEN |
| 5415 | LUCOMP=80+KFLA |
| 5416 | ELSE |
| 5417 | LUCOMP=360+((KFLA+1)*KFLA*(KFLA-1))/6+(KFLB*(KFLB-1))/2+KFLC |
| 5418 | ENDIF |
| 5419 | ENDIF |
| 5420 | |
| 5421 | RETURN |
| 5422 | END |
| 5423 | |
| 5424 | C********************************************************************* |
| 5425 | |
| 5426 | SUBROUTINE LUERRM(MERR,CHMESS) |
| 5427 | |
| 5428 | C...Purpose: to inform user of errors in program execution. |
| 5429 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 5430 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 5431 | SAVE /LUJETS/,/LUDAT1/ |
| 5432 | CHARACTER CHMESS*(*) |
| 5433 | |
| 5434 | C...Write first few warnings, then be silent. |
| 5435 | IF(MERR.LE.10) THEN |
| 5436 | MSTU(27)=MSTU(27)+1 |
| 5437 | MSTU(28)=MERR |
| 5438 | IF(MSTU(25).EQ.1.AND.MSTU(27).LE.MSTU(26)) WRITE(MSTU(11),5000) |
| 5439 | & MERR,MSTU(31),CHMESS |
| 5440 | |
| 5441 | C...Write first few errors, then be silent or stop program. |
| 5442 | ELSEIF(MERR.LE.20) THEN |
| 5443 | MSTU(23)=MSTU(23)+1 |
| 5444 | MSTU(24)=MERR-10 |
| 5445 | IF(MSTU(21).GE.1.AND.MSTU(23).LE.MSTU(22)) WRITE(MSTU(11),5100) |
| 5446 | & MERR-10,MSTU(31),CHMESS |
| 5447 | IF(MSTU(21).GE.2.AND.MSTU(23).GT.MSTU(22)) THEN |
| 5448 | WRITE(MSTU(11),5100) MERR-10,MSTU(31),CHMESS |
| 5449 | WRITE(MSTU(11),5200) |
| 5450 | IF(MERR.NE.17) CALL LULIST(2) |
| 5451 | STOP |
| 5452 | ENDIF |
| 5453 | |
| 5454 | C...Stop program in case of irreparable error. |
| 5455 | ELSE |
| 5456 | WRITE(MSTU(11),5300) MERR-20,MSTU(31),CHMESS |
| 5457 | STOP |
| 5458 | ENDIF |
| 5459 | |
| 5460 | C...Formats for output. |
| 5461 | 5000 FORMAT(/5X,'Advisory warning type',I2,' given after',I6, |
| 5462 | &' LUEXEC calls:'/5X,A) |
| 5463 | 5100 FORMAT(/5X,'Error type',I2,' has occured after',I6, |
| 5464 | &' LUEXEC calls:'/5X,A) |
| 5465 | 5200 FORMAT(5X,'Execution will be stopped after listing of last ', |
| 5466 | &'event!') |
| 5467 | 5300 FORMAT(/5X,'Fatal error type',I2,' has occured after',I6, |
| 5468 | &' LUEXEC calls:'/5X,A/5X,'Execution will now be stopped!') |
| 5469 | |
| 5470 | RETURN |
| 5471 | END |
| 5472 | |
| 5473 | C********************************************************************* |
| 5474 | |
| 5475 | FUNCTION ULALEM(Q2) |
| 5476 | |
| 5477 | C...Purpose: to calculate the running alpha_electromagnetic. |
| 5478 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 5479 | SAVE /LUDAT1/ |
| 5480 | |
| 5481 | C...Calculate real part of photon vacuum polarization. |
| 5482 | C...For leptons simplify by using asymptotic (Q^2 >> m^2) expressions. |
| 5483 | C...For hadrons use parametrization of H. Burkhardt et al. |
| 5484 | C...See R. Kleiss et al, CERN 89-08, vol. 3, pp. 129-131. |
| 5485 | AEMPI=PARU(101)/(3.*PARU(1)) |
| 5486 | IF(MSTU(101).LE.0.OR.Q2.LT.2E-6) THEN |
| 5487 | RPIGG=0. |
| 5488 | ELSEIF(Q2.LT.0.09) THEN |
| 5489 | RPIGG=AEMPI*(13.4916+LOG(Q2))+0.00835*LOG(1.+Q2) |
| 5490 | ELSEIF(Q2.LT.9.) THEN |
| 5491 | RPIGG=AEMPI*(16.3200+2.*LOG(Q2))+0.00238*LOG(1.+3.927*Q2) |
| 5492 | ELSEIF(Q2.LT.1E4) THEN |
| 5493 | RPIGG=AEMPI*(13.4955+3.*LOG(Q2))+0.00165+0.00299*LOG(1.+Q2) |
| 5494 | ELSE |
| 5495 | RPIGG=AEMPI*(13.4955+3.*LOG(Q2))+0.00221+0.00293*LOG(1.+Q2) |
| 5496 | ENDIF |
| 5497 | |
| 5498 | C...Calculate running alpha_em. |
| 5499 | ULALEM=PARU(101)/(1.-RPIGG) |
| 5500 | PARU(108)=ULALEM |
| 5501 | |
| 5502 | RETURN |
| 5503 | END |
| 5504 | |
| 5505 | C********************************************************************* |
| 5506 | |
| 5507 | FUNCTION ULALPS(Q2) |
| 5508 | |
| 5509 | C...Purpose: to give the value of alpha_strong. |
| 5510 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 5511 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 5512 | SAVE /LUDAT1/,/LUDAT2/ |
| 5513 | |
| 5514 | C...Constant alpha_strong trivial. |
| 5515 | IF(MSTU(111).LE.0) THEN |
| 5516 | ULALPS=PARU(111) |
| 5517 | MSTU(118)=MSTU(112) |
| 5518 | PARU(117)=0. |
| 5519 | PARU(118)=PARU(111) |
| 5520 | RETURN |
| 5521 | ENDIF |
| 5522 | |
| 5523 | C...Find effective Q2, number of flavours and Lambda. |
| 5524 | Q2EFF=Q2 |
| 5525 | IF(MSTU(115).GE.2) Q2EFF=MAX(Q2,PARU(114)) |
| 5526 | NF=MSTU(112) |
| 5527 | ALAM2=PARU(112)**2 |
| 5528 | 100 IF(NF.GT.MAX(2,MSTU(113))) THEN |
| 5529 | Q2THR=PARU(113)*PMAS(NF,1)**2 |
| 5530 | IF(Q2EFF.LT.Q2THR) THEN |
| 5531 | NF=NF-1 |
| 5532 | ALAM2=ALAM2*(Q2THR/ALAM2)**(2./(33.-2.*NF)) |
| 5533 | GOTO 100 |
| 5534 | ENDIF |
| 5535 | ENDIF |
| 5536 | 110 IF(NF.LT.MIN(8,MSTU(114))) THEN |
| 5537 | Q2THR=PARU(113)*PMAS(NF+1,1)**2 |
| 5538 | IF(Q2EFF.GT.Q2THR) THEN |
| 5539 | NF=NF+1 |
| 5540 | ALAM2=ALAM2*(ALAM2/Q2THR)**(2./(33.-2.*NF)) |
| 5541 | GOTO 110 |
| 5542 | ENDIF |
| 5543 | ENDIF |
| 5544 | IF(MSTU(115).EQ.1) Q2EFF=Q2EFF+ALAM2 |
| 5545 | PARU(117)=SQRT(ALAM2) |
| 5546 | |
| 5547 | C...Evaluate first or second order alpha_strong. |
| 5548 | B0=(33.-2.*NF)/6. |
| 5549 | ALGQ=LOG(MAX(1.0001,Q2EFF/ALAM2)) |
| 5550 | IF(MSTU(111).EQ.1) THEN |
| 5551 | ULALPS=MIN(PARU(115),PARU(2)/(B0*ALGQ)) |
| 5552 | ELSE |
| 5553 | B1=(153.-19.*NF)/6. |
| 5554 | ULALPS=MIN(PARU(115),PARU(2)/(B0*ALGQ)*(1.-B1*LOG(ALGQ)/ |
| 5555 | & (B0**2*ALGQ))) |
| 5556 | ENDIF |
| 5557 | MSTU(118)=NF |
| 5558 | PARU(118)=ULALPS |
| 5559 | |
| 5560 | RETURN |
| 5561 | END |
| 5562 | |
| 5563 | C********************************************************************* |
| 5564 | |
| 5565 | FUNCTION ULANGL(X,Y) |
| 5566 | |
| 5567 | C...Purpose: to reconstruct an angle from given x and y coordinates. |
| 5568 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 5569 | SAVE /LUDAT1/ |
| 5570 | |
| 5571 | ULANGL=0. |
| 5572 | R=SQRT(X**2+Y**2) |
| 5573 | IF(R.LT.1E-20) RETURN |
| 5574 | IF(ABS(X)/R.LT.0.8) THEN |
| 5575 | ULANGL=SIGN(ACOS(X/R),Y) |
| 5576 | ELSE |
| 5577 | ULANGL=ASIN(Y/R) |
| 5578 | IF(X.LT.0..AND.ULANGL.GE.0.) THEN |
| 5579 | ULANGL=PARU(1)-ULANGL |
| 5580 | ELSEIF(X.LT.0.) THEN |
| 5581 | ULANGL=-PARU(1)-ULANGL |
| 5582 | ENDIF |
| 5583 | ENDIF |
| 5584 | |
| 5585 | RETURN |
| 5586 | END |
| 5587 | |
| 5588 | C********************************************************************* |
| 5589 | |
| 5590 | FUNCTION RLU(IDUM) |
| 5591 | |
| 5592 | C...Purpose: to generate random numbers uniformly distributed between |
| 5593 | C...0 and 1, excluding the endpoints. |
| 5594 | COMMON/LUDATR/MRLU(6),RRLU(100) |
| 5595 | SAVE /LUDATR/ |
| 5596 | EQUIVALENCE (MRLU1,MRLU(1)),(MRLU2,MRLU(2)),(MRLU3,MRLU(3)), |
| 5597 | &(MRLU4,MRLU(4)),(MRLU5,MRLU(5)),(MRLU6,MRLU(6)), |
| 5598 | &(RRLU98,RRLU(98)),(RRLU99,RRLU(99)),(RRLU00,RRLU(100)) |
| 5599 | |
| 5600 | C...Initialize generation from given seed. |
| 5601 | IF(MRLU2.EQ.0) THEN |
| 5602 | IJ=MOD(MRLU1/30082,31329) |
| 5603 | KL=MOD(MRLU1,30082) |
| 5604 | I=MOD(IJ/177,177)+2 |
| 5605 | J=MOD(IJ,177)+2 |
| 5606 | K=MOD(KL/169,178)+1 |
| 5607 | L=MOD(KL,169) |
| 5608 | DO 110 II=1,97 |
| 5609 | S=0. |
| 5610 | T=0.5 |
| 5611 | DO 100 JJ=1,24 |
| 5612 | M=MOD(MOD(I*J,179)*K,179) |
| 5613 | I=J |
| 5614 | J=K |
| 5615 | K=M |
| 5616 | L=MOD(53*L+1,169) |
| 5617 | IF(MOD(L*M,64).GE.32) S=S+T |
| 5618 | 100 T=0.5*T |
| 5619 | 110 RRLU(II)=S |
| 5620 | TWOM24=1. |
| 5621 | DO 120 I24=1,24 |
| 5622 | 120 TWOM24=0.5*TWOM24 |
| 5623 | RRLU98=362436.*TWOM24 |
| 5624 | RRLU99=7654321.*TWOM24 |
| 5625 | RRLU00=16777213.*TWOM24 |
| 5626 | MRLU2=1 |
| 5627 | MRLU3=0 |
| 5628 | MRLU4=97 |
| 5629 | MRLU5=33 |
| 5630 | ENDIF |
| 5631 | |
| 5632 | C...Generate next random number. |
| 5633 | 130 RUNI=RRLU(MRLU4)-RRLU(MRLU5) |
| 5634 | IF(RUNI.LT.0.) RUNI=RUNI+1. |
| 5635 | RRLU(MRLU4)=RUNI |
| 5636 | MRLU4=MRLU4-1 |
| 5637 | IF(MRLU4.EQ.0) MRLU4=97 |
| 5638 | MRLU5=MRLU5-1 |
| 5639 | IF(MRLU5.EQ.0) MRLU5=97 |
| 5640 | RRLU98=RRLU98-RRLU99 |
| 5641 | IF(RRLU98.LT.0.) RRLU98=RRLU98+RRLU00 |
| 5642 | RUNI=RUNI-RRLU98 |
| 5643 | IF(RUNI.LT.0.) RUNI=RUNI+1. |
| 5644 | IF(RUNI.LE.0.OR.RUNI.GE.1.) GOTO 130 |
| 5645 | |
| 5646 | C...Update counters. Random number to output. |
| 5647 | MRLU3=MRLU3+1 |
| 5648 | IF(MRLU3.EQ.1000000000) THEN |
| 5649 | MRLU2=MRLU2+1 |
| 5650 | MRLU3=0 |
| 5651 | ENDIF |
| 5652 | RLU=RUNI |
| 5653 | |
| 5654 | RETURN |
| 5655 | END |
| 5656 | |
| 5657 | C********************************************************************* |
| 5658 | |
| 5659 | SUBROUTINE RLUGET(LFN,MOVE) |
| 5660 | |
| 5661 | C...Purpose: to dump the state of the random number generator on a file |
| 5662 | C...for subsequent startup from this state onwards. |
| 5663 | COMMON/LUDATR/MRLU(6),RRLU(100) |
| 5664 | SAVE /LUDATR/ |
| 5665 | CHARACTER CHERR*8 |
| 5666 | |
| 5667 | C...Backspace required number of records (or as many as there are). |
| 5668 | IF(MOVE.LT.0) THEN |
| 5669 | NBCK=MIN(MRLU(6),-MOVE) |
| 5670 | DO 100 IBCK=1,NBCK |
| 5671 | 100 BACKSPACE(LFN,ERR=110,IOSTAT=IERR) |
| 5672 | MRLU(6)=MRLU(6)-NBCK |
| 5673 | ENDIF |
| 5674 | |
| 5675 | C...Unformatted write on unit LFN. |
| 5676 | WRITE(LFN,ERR=110,IOSTAT=IERR) (MRLU(I1),I1=1,5), |
| 5677 | &(RRLU(I2),I2=1,100) |
| 5678 | MRLU(6)=MRLU(6)+1 |
| 5679 | RETURN |
| 5680 | |
| 5681 | C...Write error. |
| 5682 | 110 WRITE(CHERR,'(I8)') IERR |
| 5683 | CALL LUERRM(18,'(RLUGET:) error when accessing file, IOSTAT ='// |
| 5684 | &CHERR) |
| 5685 | |
| 5686 | RETURN |
| 5687 | END |
| 5688 | |
| 5689 | C********************************************************************* |
| 5690 | |
| 5691 | SUBROUTINE RLUSET(LFN,MOVE) |
| 5692 | |
| 5693 | C...Purpose: to read a state of the random number generator from a file |
| 5694 | C...for subsequent generation from this state onwards. |
| 5695 | COMMON/LUDATR/MRLU(6),RRLU(100) |
| 5696 | SAVE /LUDATR/ |
| 5697 | CHARACTER CHERR*8 |
| 5698 | |
| 5699 | C...Backspace required number of records (or as many as there are). |
| 5700 | IF(MOVE.LT.0) THEN |
| 5701 | NBCK=MIN(MRLU(6),-MOVE) |
| 5702 | DO 100 IBCK=1,NBCK |
| 5703 | 100 BACKSPACE(LFN,ERR=120,IOSTAT=IERR) |
| 5704 | MRLU(6)=MRLU(6)-NBCK |
| 5705 | ENDIF |
| 5706 | |
| 5707 | C...Unformatted read from unit LFN. |
| 5708 | NFOR=1+MAX(0,MOVE) |
| 5709 | DO 110 IFOR=1,NFOR |
| 5710 | 110 READ(LFN,ERR=120,IOSTAT=IERR) (MRLU(I1),I1=1,5), |
| 5711 | &(RRLU(I2),I2=1,100) |
| 5712 | MRLU(6)=MRLU(6)+NFOR |
| 5713 | RETURN |
| 5714 | |
| 5715 | C...Write error. |
| 5716 | 120 WRITE(CHERR,'(I8)') IERR |
| 5717 | CALL LUERRM(18,'(RLUSET:) error when accessing file, IOSTAT ='// |
| 5718 | &CHERR) |
| 5719 | |
| 5720 | RETURN |
| 5721 | END |
| 5722 | |
| 5723 | C********************************************************************* |
| 5724 | |
| 5725 | SUBROUTINE LUROBO(THE,PHI,BEX,BEY,BEZ) |
| 5726 | |
| 5727 | C...Purpose: to perform rotations and boosts. |
| 5728 | IMPLICIT DOUBLE PRECISION(D) |
| 5729 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 5730 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 5731 | SAVE /LUJETS/,/LUDAT1/ |
| 5732 | DIMENSION ROT(3,3),PR(3),VR(3),DP(4),DV(4) |
| 5733 | |
| 5734 | C...Find range of rotation/boost. Convert boost to double precision. |
| 5735 | IMIN=1 |
| 5736 | IF(MSTU(1).GT.0) IMIN=MSTU(1) |
| 5737 | IMAX=N |
| 5738 | IF(MSTU(2).GT.0) IMAX=MSTU(2) |
| 5739 | DBX=BEX |
| 5740 | DBY=BEY |
| 5741 | DBZ=BEZ |
| 5742 | GOTO 110 |
| 5743 | |
| 5744 | C...Entry for specific range and double precision boost. |
| 5745 | ENTRY LUDBRB(IMI,IMA,THE,PHI,DBEX,DBEY,DBEZ) |
| 5746 | IMIN=IMI |
| 5747 | IF(IMIN.LE.0) IMIN=1 |
| 5748 | IMAX=IMA |
| 5749 | IF(IMAX.LE.0) IMAX=N |
| 5750 | DBX=DBEX |
| 5751 | DBY=DBEY |
| 5752 | DBZ=DBEZ |
| 5753 | |
| 5754 | C...Optional resetting of V (when not set before.) |
| 5755 | IF(MSTU(33).NE.0) THEN |
| 5756 | DO 100 I=MIN(IMIN,MSTU(4)),MIN(IMAX,MSTU(4)) |
| 5757 | DO 100 J=1,5 |
| 5758 | 100 V(I,J)=0. |
| 5759 | MSTU(33)=0 |
| 5760 | ENDIF |
| 5761 | |
| 5762 | C...Check range of rotation/boost. |
| 5763 | 110 IF(IMIN.GT.MSTU(4).OR.IMAX.GT.MSTU(4)) THEN |
| 5764 | CALL LUERRM(11,'(LUROBO:) range outside LUJETS memory') |
| 5765 | RETURN |
| 5766 | ENDIF |
| 5767 | |
| 5768 | C...Rotate, typically from z axis to direction (theta,phi). |
| 5769 | IF(THE**2+PHI**2.GT.1E-20) THEN |
| 5770 | ROT(1,1)=COS(THE)*COS(PHI) |
| 5771 | ROT(1,2)=-SIN(PHI) |
| 5772 | ROT(1,3)=SIN(THE)*COS(PHI) |
| 5773 | ROT(2,1)=COS(THE)*SIN(PHI) |
| 5774 | ROT(2,2)=COS(PHI) |
| 5775 | ROT(2,3)=SIN(THE)*SIN(PHI) |
| 5776 | ROT(3,1)=-SIN(THE) |
| 5777 | ROT(3,2)=0. |
| 5778 | ROT(3,3)=COS(THE) |
| 5779 | DO 140 I=IMIN,IMAX |
| 5780 | IF(K(I,1).LE.0) GOTO 140 |
| 5781 | DO 120 J=1,3 |
| 5782 | PR(J)=P(I,J) |
| 5783 | 120 VR(J)=V(I,J) |
| 5784 | DO 130 J=1,3 |
| 5785 | P(I,J)=ROT(J,1)*PR(1)+ROT(J,2)*PR(2)+ROT(J,3)*PR(3) |
| 5786 | 130 V(I,J)=ROT(J,1)*VR(1)+ROT(J,2)*VR(2)+ROT(J,3)*VR(3) |
| 5787 | 140 CONTINUE |
| 5788 | ENDIF |
| 5789 | |
| 5790 | C...Boost, typically from rest to momentum/energy=beta. |
| 5791 | IF(DBX**2+DBY**2+DBZ**2.GT.1E-20) THEN |
| 5792 | DB=SQRT(DBX**2+DBY**2+DBZ**2) |
| 5793 | IF(DB.GT.0.99999999D0) THEN |
| 5794 | C...Rescale boost vector if too close to unity. |
| 5795 | CALL LUERRM(3,'(LUROBO:) boost vector too large') |
| 5796 | DBX=DBX*(0.99999999D0/DB) |
| 5797 | DBY=DBY*(0.99999999D0/DB) |
| 5798 | DBZ=DBZ*(0.99999999D0/DB) |
| 5799 | DB=0.99999999D0 |
| 5800 | ENDIF |
| 5801 | DGA=1D0/SQRT(1D0-DB**2) |
| 5802 | DO 160 I=IMIN,IMAX |
| 5803 | IF(K(I,1).LE.0) GOTO 160 |
| 5804 | DO 150 J=1,4 |
| 5805 | DP(J)=P(I,J) |
| 5806 | 150 DV(J)=V(I,J) |
| 5807 | DBP=DBX*DP(1)+DBY*DP(2)+DBZ*DP(3) |
| 5808 | DGABP=DGA*(DGA*DBP/(1D0+DGA)+DP(4)) |
| 5809 | P(I,1)=DP(1)+DGABP*DBX |
| 5810 | P(I,2)=DP(2)+DGABP*DBY |
| 5811 | P(I,3)=DP(3)+DGABP*DBZ |
| 5812 | P(I,4)=DGA*(DP(4)+DBP) |
| 5813 | DBV=DBX*DV(1)+DBY*DV(2)+DBZ*DV(3) |
| 5814 | DGABV=DGA*(DGA*DBV/(1D0+DGA)+DV(4)) |
| 5815 | V(I,1)=DV(1)+DGABV*DBX |
| 5816 | V(I,2)=DV(2)+DGABV*DBY |
| 5817 | V(I,3)=DV(3)+DGABV*DBZ |
| 5818 | V(I,4)=DGA*(DV(4)+DBV) |
| 5819 | 160 CONTINUE |
| 5820 | ENDIF |
| 5821 | |
| 5822 | RETURN |
| 5823 | END |
| 5824 | |
| 5825 | C********************************************************************* |
| 5826 | |
| 5827 | SUBROUTINE LUEDIT(MEDIT) |
| 5828 | |
| 5829 | C...Purpose: to perform global manipulations on the event record, |
| 5830 | C...in particular to exclude unstable or undetectable partons/particles. |
| 5831 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 5832 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 5833 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 5834 | SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ |
| 5835 | DIMENSION NS(2),PTS(2),PLS(2) |
| 5836 | |
| 5837 | C...Remove unwanted partons/particles. |
| 5838 | IF((MEDIT.GE.0.AND.MEDIT.LE.3).OR.MEDIT.EQ.5) THEN |
| 5839 | IMAX=N |
| 5840 | IF(MSTU(2).GT.0) IMAX=MSTU(2) |
| 5841 | I1=MAX(1,MSTU(1))-1 |
| 5842 | DO 110 I=MAX(1,MSTU(1)),IMAX |
| 5843 | IF(K(I,1).EQ.0.OR.K(I,1).GT.20) GOTO 110 |
| 5844 | IF(MEDIT.EQ.1) THEN |
| 5845 | IF(K(I,1).GT.10) GOTO 110 |
| 5846 | ELSEIF(MEDIT.EQ.2) THEN |
| 5847 | IF(K(I,1).GT.10) GOTO 110 |
| 5848 | KC=LUCOMP(K(I,2)) |
| 5849 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.KC.EQ.18) |
| 5850 | & GOTO 110 |
| 5851 | ELSEIF(MEDIT.EQ.3) THEN |
| 5852 | IF(K(I,1).GT.10) GOTO 110 |
| 5853 | KC=LUCOMP(K(I,2)) |
| 5854 | IF(KC.EQ.0) GOTO 110 |
| 5855 | IF(KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) GOTO 110 |
| 5856 | ELSEIF(MEDIT.EQ.5) THEN |
| 5857 | IF(K(I,1).EQ.13.OR.K(I,1).EQ.14) GOTO 110 |
| 5858 | KC=LUCOMP(K(I,2)) |
| 5859 | IF(KC.EQ.0) GOTO 110 |
| 5860 | IF(K(I,1).GE.11.AND.KCHG(KC,2).EQ.0) GOTO 110 |
| 5861 | ENDIF |
| 5862 | |
| 5863 | C...Pack remaining partons/particles. Origin no longer known. |
| 5864 | I1=I1+1 |
| 5865 | DO 100 J=1,5 |
| 5866 | K(I1,J)=K(I,J) |
| 5867 | P(I1,J)=P(I,J) |
| 5868 | 100 V(I1,J)=V(I,J) |
| 5869 | K(I1,3)=0 |
| 5870 | 110 CONTINUE |
| 5871 | IF(I1.LT.N) MSTU(3)=0 |
| 5872 | IF(I1.LT.N) MSTU(70)=0 |
| 5873 | N=I1 |
| 5874 | |
| 5875 | C...Selective removal of class of entries. New position of retained. |
| 5876 | ELSEIF(MEDIT.GE.11.AND.MEDIT.LE.15) THEN |
| 5877 | I1=0 |
| 5878 | DO 120 I=1,N |
| 5879 | K(I,3)=MOD(K(I,3),MSTU(5)) |
| 5880 | IF(MEDIT.EQ.11.AND.K(I,1).LT.0) GOTO 120 |
| 5881 | IF(MEDIT.EQ.12.AND.K(I,1).EQ.0) GOTO 120 |
| 5882 | IF(MEDIT.EQ.13.AND.(K(I,1).EQ.11.OR.K(I,1).EQ.12.OR. |
| 5883 | & K(I,1).EQ.15).AND.K(I,2).NE.94) GOTO 120 |
| 5884 | IF(MEDIT.EQ.14.AND.(K(I,1).EQ.13.OR.K(I,1).EQ.14.OR. |
| 5885 | & K(I,2).EQ.94)) GOTO 120 |
| 5886 | IF(MEDIT.EQ.15.AND.K(I,1).GE.21) GOTO 120 |
| 5887 | I1=I1+1 |
| 5888 | K(I,3)=K(I,3)+MSTU(5)*I1 |
| 5889 | 120 CONTINUE |
| 5890 | |
| 5891 | C...Find new event history information and replace old. |
| 5892 | DO 140 I=1,N |
| 5893 | IF(K(I,1).LE.0.OR.K(I,1).GT.20.OR.K(I,3)/MSTU(5).EQ.0) GOTO 140 |
| 5894 | ID=I |
| 5895 | 130 IM=MOD(K(ID,3),MSTU(5)) |
| 5896 | IF(MEDIT.EQ.13.AND.IM.GT.0.AND.IM.LE.N) THEN |
| 5897 | IF((K(IM,1).EQ.11.OR.K(IM,1).EQ.12.OR.K(IM,1).EQ.15).AND. |
| 5898 | & K(IM,2).NE.94) THEN |
| 5899 | ID=IM |
| 5900 | GOTO 130 |
| 5901 | ENDIF |
| 5902 | ELSEIF(MEDIT.EQ.14.AND.IM.GT.0.AND.IM.LE.N) THEN |
| 5903 | IF(K(IM,1).EQ.13.OR.K(IM,1).EQ.14.OR.K(IM,2).EQ.94) THEN |
| 5904 | ID=IM |
| 5905 | GOTO 130 |
| 5906 | ENDIF |
| 5907 | ENDIF |
| 5908 | K(I,3)=MSTU(5)*(K(I,3)/MSTU(5)) |
| 5909 | IF(IM.NE.0) K(I,3)=K(I,3)+K(IM,3)/MSTU(5) |
| 5910 | IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) THEN |
| 5911 | IF(K(I,4).GT.0.AND.K(I,4).LE.MSTU(4)) K(I,4)= |
| 5912 | & K(K(I,4),3)/MSTU(5) |
| 5913 | IF(K(I,5).GT.0.AND.K(I,5).LE.MSTU(4)) K(I,5)= |
| 5914 | & K(K(I,5),3)/MSTU(5) |
| 5915 | ELSE |
| 5916 | KCM=MOD(K(I,4)/MSTU(5),MSTU(5)) |
| 5917 | IF(KCM.GT.0.AND.KCM.LE.MSTU(4)) KCM=K(KCM,3)/MSTU(5) |
| 5918 | KCD=MOD(K(I,4),MSTU(5)) |
| 5919 | IF(KCD.GT.0.AND.KCD.LE.MSTU(4)) KCD=K(KCD,3)/MSTU(5) |
| 5920 | K(I,4)=MSTU(5)**2*(K(I,4)/MSTU(5)**2)+MSTU(5)*KCM+KCD |
| 5921 | KCM=MOD(K(I,5)/MSTU(5),MSTU(5)) |
| 5922 | IF(KCM.GT.0.AND.KCM.LE.MSTU(4)) KCM=K(KCM,3)/MSTU(5) |
| 5923 | KCD=MOD(K(I,5),MSTU(5)) |
| 5924 | IF(KCD.GT.0.AND.KCD.LE.MSTU(4)) KCD=K(KCD,3)/MSTU(5) |
| 5925 | K(I,5)=MSTU(5)**2*(K(I,5)/MSTU(5)**2)+MSTU(5)*KCM+KCD |
| 5926 | ENDIF |
| 5927 | 140 CONTINUE |
| 5928 | |
| 5929 | C...Pack remaining entries. |
| 5930 | I1=0 |
| 5931 | MSTU90=MSTU(90) |
| 5932 | MSTU(90)=0 |
| 5933 | DO 170 I=1,N |
| 5934 | IF(K(I,3)/MSTU(5).EQ.0) GOTO 170 |
| 5935 | I1=I1+1 |
| 5936 | DO 150 J=1,5 |
| 5937 | K(I1,J)=K(I,J) |
| 5938 | P(I1,J)=P(I,J) |
| 5939 | 150 V(I1,J)=V(I,J) |
| 5940 | K(I1,3)=MOD(K(I1,3),MSTU(5)) |
| 5941 | DO 160 IZ=1,MSTU90 |
| 5942 | IF(I.EQ.MSTU(90+IZ)) THEN |
| 5943 | MSTU(90)=MSTU(90)+1 |
| 5944 | MSTU(90+MSTU(90))=I1 |
| 5945 | PARU(90+MSTU(90))=PARU(90+IZ) |
| 5946 | ENDIF |
| 5947 | 160 CONTINUE |
| 5948 | 170 CONTINUE |
| 5949 | IF(I1.LT.N) MSTU(3)=0 |
| 5950 | IF(I1.LT.N) MSTU(70)=0 |
| 5951 | N=I1 |
| 5952 | |
| 5953 | C...Save top entries at bottom of LUJETS commonblock. |
| 5954 | ELSEIF(MEDIT.EQ.21) THEN |
| 5955 | IF(2*N.GE.MSTU(4)) THEN |
| 5956 | CALL LUERRM(11,'(LUEDIT:) no more memory left in LUJETS') |
| 5957 | RETURN |
| 5958 | ENDIF |
| 5959 | DO 180 I=1,N |
| 5960 | DO 180 J=1,5 |
| 5961 | K(MSTU(4)-I,J)=K(I,J) |
| 5962 | P(MSTU(4)-I,J)=P(I,J) |
| 5963 | 180 V(MSTU(4)-I,J)=V(I,J) |
| 5964 | MSTU(32)=N |
| 5965 | |
| 5966 | C...Restore bottom entries of commonblock LUJETS to top. |
| 5967 | ELSEIF(MEDIT.EQ.22) THEN |
| 5968 | DO 190 I=1,MSTU(32) |
| 5969 | DO 190 J=1,5 |
| 5970 | K(I,J)=K(MSTU(4)-I,J) |
| 5971 | P(I,J)=P(MSTU(4)-I,J) |
| 5972 | 190 V(I,J)=V(MSTU(4)-I,J) |
| 5973 | N=MSTU(32) |
| 5974 | |
| 5975 | C...Mark primary entries at top of commonblock LUJETS as untreated. |
| 5976 | ELSEIF(MEDIT.EQ.23) THEN |
| 5977 | I1=0 |
| 5978 | DO 200 I=1,N |
| 5979 | KH=K(I,3) |
| 5980 | IF(KH.GE.1) THEN |
| 5981 | IF(K(KH,1).GT.20) KH=0 |
| 5982 | ENDIF |
| 5983 | IF(KH.NE.0) GOTO 210 |
| 5984 | I1=I1+1 |
| 5985 | 200 IF(K(I,1).GT.10.AND.K(I,1).LE.20) K(I,1)=K(I,1)-10 |
| 5986 | 210 N=I1 |
| 5987 | |
| 5988 | C...Place largest axis along z axis and second largest in xy plane. |
| 5989 | ELSEIF(MEDIT.EQ.31.OR.MEDIT.EQ.32) THEN |
| 5990 | CALL LUDBRB(1,N+MSTU(3),0.,-ULANGL(P(MSTU(61),1), |
| 5991 | & P(MSTU(61),2)),0D0,0D0,0D0) |
| 5992 | CALL LUDBRB(1,N+MSTU(3),-ULANGL(P(MSTU(61),3), |
| 5993 | & P(MSTU(61),1)),0.,0D0,0D0,0D0) |
| 5994 | CALL LUDBRB(1,N+MSTU(3),0.,-ULANGL(P(MSTU(61)+1,1), |
| 5995 | & P(MSTU(61)+1,2)),0D0,0D0,0D0) |
| 5996 | IF(MEDIT.EQ.31) RETURN |
| 5997 | |
| 5998 | C...Rotate to put slim jet along +z axis. |
| 5999 | DO 220 IS=1,2 |
| 6000 | NS(IS)=0 |
| 6001 | PTS(IS)=0. |
| 6002 | 220 PLS(IS)=0. |
| 6003 | DO 230 I=1,N |
| 6004 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 230 |
| 6005 | IF(MSTU(41).GE.2) THEN |
| 6006 | KC=LUCOMP(K(I,2)) |
| 6007 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. |
| 6008 | & KC.EQ.18) GOTO 230 |
| 6009 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) |
| 6010 | & GOTO 230 |
| 6011 | ENDIF |
| 6012 | IS=2.-SIGN(0.5,P(I,3)) |
| 6013 | NS(IS)=NS(IS)+1 |
| 6014 | PTS(IS)=PTS(IS)+SQRT(P(I,1)**2+P(I,2)**2) |
| 6015 | 230 CONTINUE |
| 6016 | IF(NS(1)*PTS(2)**2.LT.NS(2)*PTS(1)**2) |
| 6017 | & CALL LUDBRB(1,N+MSTU(3),PARU(1),0.,0D0,0D0,0D0) |
| 6018 | |
| 6019 | C...Rotate to put second largest jet into -z,+x quadrant. |
| 6020 | DO 240 I=1,N |
| 6021 | IF(P(I,3).GE.0.) GOTO 240 |
| 6022 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 240 |
| 6023 | IF(MSTU(41).GE.2) THEN |
| 6024 | KC=LUCOMP(K(I,2)) |
| 6025 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. |
| 6026 | & KC.EQ.18) GOTO 240 |
| 6027 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) |
| 6028 | & GOTO 240 |
| 6029 | ENDIF |
| 6030 | IS=2.-SIGN(0.5,P(I,1)) |
| 6031 | PLS(IS)=PLS(IS)-P(I,3) |
| 6032 | 240 CONTINUE |
| 6033 | IF(PLS(2).GT.PLS(1)) CALL LUDBRB(1,N+MSTU(3),0.,PARU(1), |
| 6034 | & 0D0,0D0,0D0) |
| 6035 | ENDIF |
| 6036 | |
| 6037 | RETURN |
| 6038 | END |
| 6039 | |
| 6040 | C********************************************************************* |
| 6041 | |
| 6042 | SUBROUTINE LULIST(MLIST) |
| 6043 | |
| 6044 | C...Purpose: to give program heading, or list an event, or particle |
| 6045 | C...data, or current parameter values. |
| 6046 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 6047 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 6048 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 6049 | COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) |
| 6050 | SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/ |
| 6051 | CHARACTER CHAP*16,CHAC*16,CHAN*16,CHAD(5)*16,CHMO(12)*3,CHDL(7)*4 |
| 6052 | DIMENSION PS(6) |
| 6053 | DATA CHMO/'Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep', |
| 6054 | &'Oct','Nov','Dec'/,CHDL/'(())',' ','()','!!','<>','==','(==)'/ |
| 6055 | |
| 6056 | C...Initialization printout: version number and date of last change. |
| 6057 | IF(MLIST.EQ.0.OR.MSTU(12).EQ.1) THEN |
| 6058 | WRITE(MSTU(11),5000) MSTU(181),MSTU(182),MSTU(185), |
| 6059 | & CHMO(MSTU(184)),MSTU(183) |
| 6060 | MSTU(12)=0 |
| 6061 | IF(MLIST.EQ.0) RETURN |
| 6062 | ENDIF |
| 6063 | |
| 6064 | C...List event data, including additional lines after N. |
| 6065 | IF(MLIST.GE.1.AND.MLIST.LE.3) THEN |
| 6066 | IF(MLIST.EQ.1) WRITE(MSTU(11),5100) |
| 6067 | IF(MLIST.EQ.2) WRITE(MSTU(11),5200) |
| 6068 | IF(MLIST.EQ.3) WRITE(MSTU(11),5300) |
| 6069 | LMX=12 |
| 6070 | IF(MLIST.GE.2) LMX=16 |
| 6071 | ISTR=0 |
| 6072 | IMAX=N |
| 6073 | IF(MSTU(2).GT.0) IMAX=MSTU(2) |
| 6074 | DO 120 I=MAX(1,MSTU(1)),MAX(IMAX,N+MAX(0,MSTU(3))) |
| 6075 | IF((I.GT.IMAX.AND.I.LE.N).OR.K(I,1).LT.0) GOTO 120 |
| 6076 | |
| 6077 | C...Get particle name, pad it and check it is not too long. |
| 6078 | CALL LUNAME(K(I,2),CHAP) |
| 6079 | LEN=0 |
| 6080 | DO 100 LEM=1,16 |
| 6081 | 100 IF(CHAP(LEM:LEM).NE.' ') LEN=LEM |
| 6082 | MDL=(K(I,1)+19)/10 |
| 6083 | LDL=0 |
| 6084 | IF(MDL.EQ.2.OR.MDL.GE.8) THEN |
| 6085 | CHAC=CHAP |
| 6086 | IF(LEN.GT.LMX) CHAC(LMX:LMX)='?' |
| 6087 | ELSE |
| 6088 | LDL=1 |
| 6089 | IF(MDL.EQ.1.OR.MDL.EQ.7) LDL=2 |
| 6090 | IF(LEN.EQ.0) THEN |
| 6091 | CHAC=CHDL(MDL)(1:2*LDL)//' ' |
| 6092 | ELSE |
| 6093 | CHAC=CHDL(MDL)(1:LDL)//CHAP(1:MIN(LEN,LMX-2*LDL))// |
| 6094 | & CHDL(MDL)(LDL+1:2*LDL)//' ' |
| 6095 | IF(LEN+2*LDL.GT.LMX) CHAC(LMX:LMX)='?' |
| 6096 | ENDIF |
| 6097 | ENDIF |
| 6098 | |
| 6099 | C...Add information on string connection. |
| 6100 | IF(K(I,1).EQ.1.OR.K(I,1).EQ.2.OR.K(I,1).EQ.11.OR.K(I,1).EQ.12) |
| 6101 | & THEN |
| 6102 | KC=LUCOMP(K(I,2)) |
| 6103 | KCC=0 |
| 6104 | IF(KC.NE.0) KCC=KCHG(KC,2) |
| 6105 | IF(IABS(K(I,2)).EQ.39) THEN |
| 6106 | IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='X' |
| 6107 | ELSEIF(KCC.NE.0.AND.ISTR.EQ.0) THEN |
| 6108 | ISTR=1 |
| 6109 | IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='A' |
| 6110 | ELSEIF(KCC.NE.0.AND.(K(I,1).EQ.2.OR.K(I,1).EQ.12)) THEN |
| 6111 | IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='I' |
| 6112 | ELSEIF(KCC.NE.0) THEN |
| 6113 | ISTR=0 |
| 6114 | IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='V' |
| 6115 | ENDIF |
| 6116 | ENDIF |
| 6117 | |
| 6118 | C...Write data for particle/jet. |
| 6119 | IF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.9999.) THEN |
| 6120 | WRITE(MSTU(11),5400) I,CHAC(1:12),(K(I,J1),J1=1,3), |
| 6121 | & (P(I,J2),J2=1,5) |
| 6122 | ELSEIF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.99999.) THEN |
| 6123 | WRITE(MSTU(11),5500) I,CHAC(1:12),(K(I,J1),J1=1,3), |
| 6124 | & (P(I,J2),J2=1,5) |
| 6125 | ELSEIF(MLIST.EQ.1) THEN |
| 6126 | WRITE(MSTU(11),5600) I,CHAC(1:12),(K(I,J1),J1=1,3), |
| 6127 | & (P(I,J2),J2=1,5) |
| 6128 | ELSEIF(MSTU(5).EQ.10000.AND.(K(I,1).EQ.3.OR.K(I,1).EQ.13.OR. |
| 6129 | & K(I,1).EQ.14)) THEN |
| 6130 | WRITE(MSTU(11),5700) I,CHAC,(K(I,J1),J1=1,3), |
| 6131 | & K(I,4)/100000000,MOD(K(I,4)/10000,10000),MOD(K(I,4),10000), |
| 6132 | & K(I,5)/100000000,MOD(K(I,5)/10000,10000),MOD(K(I,5),10000), |
| 6133 | & (P(I,J2),J2=1,5) |
| 6134 | ELSE |
| 6135 | WRITE(MSTU(11),5800) I,CHAC,(K(I,J1),J1=1,5),(P(I,J2),J2=1,5) |
| 6136 | ENDIF |
| 6137 | IF(MLIST.EQ.3) WRITE(MSTU(11),5900) (V(I,J),J=1,5) |
| 6138 | |
| 6139 | C...Insert extra separator lines specified by user. |
| 6140 | IF(MSTU(70).GE.1) THEN |
| 6141 | ISEP=0 |
| 6142 | DO 110 J=1,MIN(10,MSTU(70)) |
| 6143 | 110 IF(I.EQ.MSTU(70+J)) ISEP=1 |
| 6144 | IF(ISEP.EQ.1.AND.MLIST.EQ.1) WRITE(MSTU(11),6000) |
| 6145 | IF(ISEP.EQ.1.AND.MLIST.GE.2) WRITE(MSTU(11),6100) |
| 6146 | ENDIF |
| 6147 | 120 CONTINUE |
| 6148 | |
| 6149 | C...Sum of charges and momenta. |
| 6150 | DO 130 J=1,6 |
| 6151 | 130 PS(J)=PLU(0,J) |
| 6152 | IF(MLIST.EQ.1.AND.ABS(PS(4)).LT.9999.) THEN |
| 6153 | WRITE(MSTU(11),6200) PS(6),(PS(J),J=1,5) |
| 6154 | ELSEIF(MLIST.EQ.1.AND.ABS(PS(4)).LT.99999.) THEN |
| 6155 | WRITE(MSTU(11),6300) PS(6),(PS(J),J=1,5) |
| 6156 | ELSEIF(MLIST.EQ.1) THEN |
| 6157 | WRITE(MSTU(11),6400) PS(6),(PS(J),J=1,5) |
| 6158 | ELSE |
| 6159 | WRITE(MSTU(11),6500) PS(6),(PS(J),J=1,5) |
| 6160 | ENDIF |
| 6161 | |
| 6162 | C...Give simple list of KF codes defined in program. |
| 6163 | ELSEIF(MLIST.EQ.11) THEN |
| 6164 | WRITE(MSTU(11),6600) |
| 6165 | DO 140 KF=1,40 |
| 6166 | CALL LUNAME(KF,CHAP) |
| 6167 | CALL LUNAME(-KF,CHAN) |
| 6168 | IF(CHAP.NE.' '.AND.CHAN.EQ.' ') WRITE(MSTU(11),6700) KF,CHAP |
| 6169 | 140 IF(CHAN.NE.' ') WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN |
| 6170 | DO 150 KFLS=1,3,2 |
| 6171 | DO 150 KFLA=1,8 |
| 6172 | DO 150 KFLB=1,KFLA-(3-KFLS)/2 |
| 6173 | KF=1000*KFLA+100*KFLB+KFLS |
| 6174 | CALL LUNAME(KF,CHAP) |
| 6175 | CALL LUNAME(-KF,CHAN) |
| 6176 | 150 WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN |
| 6177 | KF=130 |
| 6178 | CALL LUNAME(KF,CHAP) |
| 6179 | WRITE(MSTU(11),6700) KF,CHAP |
| 6180 | KF=310 |
| 6181 | CALL LUNAME(KF,CHAP) |
| 6182 | WRITE(MSTU(11),6700) KF,CHAP |
| 6183 | DO 170 KMUL=0,5 |
| 6184 | KFLS=3 |
| 6185 | IF(KMUL.EQ.0.OR.KMUL.EQ.3) KFLS=1 |
| 6186 | IF(KMUL.EQ.5) KFLS=5 |
| 6187 | KFLR=0 |
| 6188 | IF(KMUL.EQ.2.OR.KMUL.EQ.3) KFLR=1 |
| 6189 | IF(KMUL.EQ.4) KFLR=2 |
| 6190 | DO 170 KFLB=1,8 |
| 6191 | DO 160 KFLC=1,KFLB-1 |
| 6192 | KF=10000*KFLR+100*KFLB+10*KFLC+KFLS |
| 6193 | CALL LUNAME(KF,CHAP) |
| 6194 | CALL LUNAME(-KF,CHAN) |
| 6195 | 160 WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN |
| 6196 | KF=10000*KFLR+110*KFLB+KFLS |
| 6197 | CALL LUNAME(KF,CHAP) |
| 6198 | 170 WRITE(MSTU(11),6700) KF,CHAP |
| 6199 | DO 190 KFLSP=1,3 |
| 6200 | KFLS=2+2*(KFLSP/3) |
| 6201 | DO 190 KFLA=1,8 |
| 6202 | DO 190 KFLB=1,KFLA |
| 6203 | DO 180 KFLC=1,KFLB |
| 6204 | IF(KFLSP.EQ.1.AND.(KFLA.EQ.KFLB.OR.KFLB.EQ.KFLC)) GOTO 180 |
| 6205 | IF(KFLSP.EQ.2.AND.KFLA.EQ.KFLC) GOTO 180 |
| 6206 | IF(KFLSP.EQ.1) KF=1000*KFLA+100*KFLC+10*KFLB+KFLS |
| 6207 | IF(KFLSP.GE.2) KF=1000*KFLA+100*KFLB+10*KFLC+KFLS |
| 6208 | CALL LUNAME(KF,CHAP) |
| 6209 | CALL LUNAME(-KF,CHAN) |
| 6210 | WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN |
| 6211 | 180 CONTINUE |
| 6212 | 190 CONTINUE |
| 6213 | |
| 6214 | C...List parton/particle data table. Check whether to be listed. |
| 6215 | ELSEIF(MLIST.EQ.12) THEN |
| 6216 | WRITE(MSTU(11),6800) |
| 6217 | MSTJ24=MSTJ(24) |
| 6218 | MSTJ(24)=0 |
| 6219 | KFMAX=20883 |
| 6220 | IF(MSTU(2).NE.0) KFMAX=MSTU(2) |
| 6221 | DO 220 KF=MAX(1,MSTU(1)),KFMAX |
| 6222 | KC=LUCOMP(KF) |
| 6223 | IF(KC.EQ.0) GOTO 220 |
| 6224 | IF(MSTU(14).EQ.0.AND.KF.GT.100.AND.KC.LE.100) GOTO 220 |
| 6225 | IF(MSTU(14).GT.0.AND.KF.GT.100.AND.MAX(MOD(KF/1000,10), |
| 6226 | & MOD(KF/100,10)).GT.MSTU(14)) GOTO 220 |
| 6227 | |
| 6228 | C...Find particle name and mass. Print information. |
| 6229 | CALL LUNAME(KF,CHAP) |
| 6230 | IF(KF.LE.100.AND.CHAP.EQ.' '.AND.MDCY(KC,2).EQ.0) GOTO 220 |
| 6231 | CALL LUNAME(-KF,CHAN) |
| 6232 | PM=ULMASS(KF) |
| 6233 | WRITE(MSTU(11),6900) KF,KC,CHAP,CHAN,KCHG(KC,1),KCHG(KC,2), |
| 6234 | & KCHG(KC,3),PM,PMAS(KC,2),PMAS(KC,3),PMAS(KC,4),MDCY(KC,1) |
| 6235 | |
| 6236 | C...Particle decay: channel number, branching ration, matrix element, |
| 6237 | C...decay products. |
| 6238 | IF(KF.GT.100.AND.KC.LE.100) GOTO 220 |
| 6239 | DO 210 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1 |
| 6240 | DO 200 J=1,5 |
| 6241 | 200 CALL LUNAME(KFDP(IDC,J),CHAD(J)) |
| 6242 | 210 WRITE(MSTU(11),7000) IDC,MDME(IDC,1),MDME(IDC,2),BRAT(IDC), |
| 6243 | & (CHAD(J),J=1,5) |
| 6244 | 220 CONTINUE |
| 6245 | MSTJ(24)=MSTJ24 |
| 6246 | |
| 6247 | C...List parameter value table. |
| 6248 | ELSEIF(MLIST.EQ.13) THEN |
| 6249 | WRITE(MSTU(11),7100) |
| 6250 | DO 230 I=1,200 |
| 6251 | 230 WRITE(MSTU(11),7200) I,MSTU(I),PARU(I),MSTJ(I),PARJ(I),PARF(I) |
| 6252 | ENDIF |
| 6253 | |
| 6254 | C...Format statements for output on unit MSTU(11) (by default 6). |
| 6255 | 5000 FORMAT(///20X,'The Lund Monte Carlo - JETSET version ',I1,'.',I1/ |
| 6256 | &20X,'** Last date of change: ',I2,1X,A3,1X,I4,' **'/) |
| 6257 | 5100 FORMAT(///28X,'Event listing (summary)'//4X,'I particle/jet KS', |
| 6258 | &5X,'KF orig p_x p_y p_z E m'/) |
| 6259 | 5200 FORMAT(///28X,'Event listing (standard)'//4X,'I particle/jet', |
| 6260 | &' K(I,1) K(I,2) K(I,3) K(I,4) K(I,5) P(I,1)', |
| 6261 | &' P(I,2) P(I,3) P(I,4) P(I,5)'/) |
| 6262 | 5300 FORMAT(///28X,'Event listing (with vertices)'//4X,'I particle/j', |
| 6263 | &'et K(I,1) K(I,2) K(I,3) K(I,4) K(I,5) P(I,1)', |
| 6264 | &' P(I,2) P(I,3) P(I,4) P(I,5)'/73X, |
| 6265 | &'V(I,1) V(I,2) V(I,3) V(I,4) V(I,5)'/) |
| 6266 | 5400 FORMAT(1X,I5,2X,A12,1X,I2,1X,I6,1X,I4,5F9.3) |
| 6267 | 5500 FORMAT(1X,I5,2X,A12,1X,I2,1X,I6,1X,I4,5F9.2) |
| 6268 | 5600 FORMAT(1X,I5,2X,A12,1X,I2,1X,I6,1X,I4,5F9.1) |
| 6269 | 5700 FORMAT(1X,I4,2X,A16,1X,I3,1X,I8,2X,I4,2(3X,I1,2I4),5F13.5) |
| 6270 | 5800 FORMAT(1X,I4,2X,A16,1X,I3,1X,I8,2X,I4,2(3X,I9),5F13.5) |
| 6271 | 5900 FORMAT(66X,5(1X,F12.3)) |
| 6272 | 6000 FORMAT(1X,78('=')) |
| 6273 | 6100 FORMAT(1X,130('=')) |
| 6274 | 6200 FORMAT(19X,'sum:',F6.2,5X,5F9.3) |
| 6275 | 6300 FORMAT(19X,'sum:',F6.2,5X,5F9.2) |
| 6276 | 6400 FORMAT(19X,'sum:',F6.2,5X,5F9.1) |
| 6277 | 6500 FORMAT(19X,'sum charge:',F6.2,3X,'sum momentum and inv. mass:', |
| 6278 | &5F13.5) |
| 6279 | 6600 FORMAT(///20X,'List of KF codes in program'/) |
| 6280 | 6700 FORMAT(4X,I6,4X,A16,6X,I6,4X,A16) |
| 6281 | 6800 FORMAT(///30X,'Particle/parton data table'//5X,'KF',5X,'KC',4X, |
| 6282 | &'particle',8X,'antiparticle',6X,'chg col anti',8X,'mass',7X, |
| 6283 | &'width',7X,'w-cut',5X,'lifetime',1X,'decay'/11X,'IDC',1X,'on/off', |
| 6284 | &1X,'ME',3X,'Br.rat.',4X,'decay products') |
| 6285 | 6900 FORMAT(/1X,I6,3X,I4,4X,A16,A16,3I5,1X,F12.5,2(1X,F11.5), |
| 6286 | &2X,F12.5,3X,I2) |
| 6287 | 7000 FORMAT(10X,I4,2X,I3,2X,I3,2X,F8.5,4X,5A16) |
| 6288 | 7100 FORMAT(///20X,'Parameter value table'//4X,'I',3X,'MSTU(I)', |
| 6289 | &8X,'PARU(I)',3X,'MSTJ(I)',8X,'PARJ(I)',8X,'PARF(I)') |
| 6290 | 7200 FORMAT(1X,I4,1X,I9,1X,F14.5,1X,I9,1X,F14.5,1X,F14.5) |
| 6291 | |
| 6292 | RETURN |
| 6293 | END |
| 6294 | |
| 6295 | C********************************************************************* |
| 6296 | |
| 6297 | SUBROUTINE LUUPDA(MUPDA,LFN) |
| 6298 | |
| 6299 | C...Purpose: to facilitate the updating of particle and decay data. |
| 6300 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 6301 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 6302 | COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) |
| 6303 | COMMON/LUDAT4/CHAF(500) |
| 6304 | CHARACTER CHAF*8 |
| 6305 | SAVE /LUDAT1/,/LUDAT2/,/LUDAT3/,/LUDAT4/ |
| 6306 | CHARACTER CHINL*80,CHKC*4,CHVAR(19)*9,CHLIN*72, |
| 6307 | &CHBLK(20)*72,CHOLD*12,CHTMP*12,CHNEW*12,CHCOM*12 |
| 6308 | DATA CHVAR/ 'KCHG(I,1)','KCHG(I,2)','KCHG(I,3)','PMAS(I,1)', |
| 6309 | &'PMAS(I,2)','PMAS(I,3)','PMAS(I,4)','MDCY(I,1)','MDCY(I,2)', |
| 6310 | &'MDCY(I,3)','MDME(I,1)','MDME(I,2)','BRAT(I) ','KFDP(I,1)', |
| 6311 | &'KFDP(I,2)','KFDP(I,3)','KFDP(I,4)','KFDP(I,5)','CHAF(I) '/ |
| 6312 | |
| 6313 | C...Write information on file for editing. |
| 6314 | IF(MSTU(12).GE.1) CALL LULIST(0) |
| 6315 | IF(MUPDA.EQ.1) THEN |
| 6316 | DO 110 KC=1,MSTU(6) |
| 6317 | WRITE(LFN,5000) KC,CHAF(KC),(KCHG(KC,J1),J1=1,3), |
| 6318 | & (PMAS(KC,J2),J2=1,4),MDCY(KC,1) |
| 6319 | DO 100 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1 |
| 6320 | 100 WRITE(LFN,5100) MDME(IDC,1),MDME(IDC,2),BRAT(IDC), |
| 6321 | & (KFDP(IDC,J),J=1,5) |
| 6322 | 110 CONTINUE |
| 6323 | |
| 6324 | C...Reset variables and read information from edited file. |
| 6325 | ELSEIF(MUPDA.EQ.2) THEN |
| 6326 | DO 120 I=1,MSTU(7) |
| 6327 | MDME(I,1)=1 |
| 6328 | MDME(I,2)=0 |
| 6329 | BRAT(I)=0. |
| 6330 | DO 120 J=1,5 |
| 6331 | 120 KFDP(I,J)=0 |
| 6332 | KC=0 |
| 6333 | IDC=0 |
| 6334 | NDC=0 |
| 6335 | 130 READ(LFN,5200,END=140) CHINL |
| 6336 | IF(CHINL(2:5).NE.' ') THEN |
| 6337 | CHKC=CHINL(2:5) |
| 6338 | IF(KC.NE.0) THEN |
| 6339 | MDCY(KC,2)=0 |
| 6340 | IF(NDC.NE.0) MDCY(KC,2)=IDC+1-NDC |
| 6341 | MDCY(KC,3)=NDC |
| 6342 | ENDIF |
| 6343 | READ(CHKC,5300) KC |
| 6344 | IF(KC.LE.0.OR.KC.GT.MSTU(6)) CALL LUERRM(27, |
| 6345 | & '(LUUPDA:) Read KC code illegal, KC ='//CHKC) |
| 6346 | READ(CHINL,5000) KCR,CHAF(KC),(KCHG(KC,J1),J1=1,3), |
| 6347 | & (PMAS(KC,J2),J2=1,4),MDCY(KC,1) |
| 6348 | NDC=0 |
| 6349 | ELSE |
| 6350 | IDC=IDC+1 |
| 6351 | NDC=NDC+1 |
| 6352 | IF(IDC.GE.MSTU(7)) CALL LUERRM(27, |
| 6353 | & '(LUUPDA:) Decay data arrays full by KC ='//CHKC) |
| 6354 | READ(CHINL,5100) MDME(IDC,1),MDME(IDC,2),BRAT(IDC), |
| 6355 | & (KFDP(IDC,J),J=1,5) |
| 6356 | ENDIF |
| 6357 | GOTO 130 |
| 6358 | 140 MDCY(KC,2)=0 |
| 6359 | IF(NDC.NE.0) MDCY(KC,2)=IDC+1-NDC |
| 6360 | MDCY(KC,3)=NDC |
| 6361 | |
| 6362 | C...Perform possible tests that new information is consistent. |
| 6363 | MSTJ24=MSTJ(24) |
| 6364 | MSTJ(24)=0 |
| 6365 | DO 170 KC=1,MSTU(6) |
| 6366 | WRITE(CHKC,5300) KC |
| 6367 | IF(MIN(PMAS(KC,1),PMAS(KC,2),PMAS(KC,3),PMAS(KC,1)-PMAS(KC,3), |
| 6368 | & PMAS(KC,4)).LT.0..OR.MDCY(KC,3).LT.0) CALL LUERRM(17, |
| 6369 | & '(LUUPDA:) Mass/width/life/(# channels) wrong for KC ='//CHKC) |
| 6370 | BRSUM=0. |
| 6371 | DO 160 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1 |
| 6372 | IF(MDME(IDC,2).GT.80) GOTO 160 |
| 6373 | KQ=KCHG(KC,1) |
| 6374 | PMS=PMAS(KC,1)-PMAS(KC,3)-PARJ(64) |
| 6375 | MERR=0 |
| 6376 | DO 150 J=1,5 |
| 6377 | KP=KFDP(IDC,J) |
| 6378 | IF(KP.EQ.0.OR.KP.EQ.81.OR.IABS(KP).EQ.82) THEN |
| 6379 | ELSEIF(LUCOMP(KP).EQ.0) THEN |
| 6380 | MERR=3 |
| 6381 | ELSE |
| 6382 | KQ=KQ-LUCHGE(KP) |
| 6383 | PMS=PMS-ULMASS(KP) |
| 6384 | ENDIF |
| 6385 | 150 CONTINUE |
| 6386 | IF(KQ.NE.0) MERR=MAX(2,MERR) |
| 6387 | IF(KFDP(IDC,2).NE.0.AND.(KC.LE.20.OR.KC.GT.40).AND. |
| 6388 | & (KC.LE.80.OR.KC.GT.100).AND.MDME(IDC,2).NE.34.AND. |
| 6389 | & MDME(IDC,2).NE.61.AND.PMS.LT.0.) MERR=MAX(1,MERR) |
| 6390 | IF(MERR.EQ.3) CALL LUERRM(17, |
| 6391 | & '(LUUPDA:) Unknown particle code in decay of KC ='//CHKC) |
| 6392 | IF(MERR.EQ.2) CALL LUERRM(17, |
| 6393 | & '(LUUPDA:) Charge not conserved in decay of KC ='//CHKC) |
| 6394 | IF(MERR.EQ.1) CALL LUERRM(7, |
| 6395 | & '(LUUPDA:) Kinematically unallowed decay of KC ='//CHKC) |
| 6396 | BRSUM=BRSUM+BRAT(IDC) |
| 6397 | 160 CONTINUE |
| 6398 | WRITE(CHTMP,5500) BRSUM |
| 6399 | IF(ABS(BRSUM).GT.0.0005.AND.ABS(BRSUM-1.).GT.0.0005) CALL |
| 6400 | & LUERRM(7,'(LUUPDA:) Sum of branching ratios is '//CHTMP(5:12)// |
| 6401 | & ' for KC ='//CHKC) |
| 6402 | 170 CONTINUE |
| 6403 | MSTJ(24)=MSTJ24 |
| 6404 | |
| 6405 | C...Initialize writing of DATA statements for inclusion in program. |
| 6406 | ELSEIF(MUPDA.EQ.3) THEN |
| 6407 | DO 240 IVAR=1,19 |
| 6408 | NDIM=MSTU(6) |
| 6409 | IF(IVAR.GE.11.AND.IVAR.LE.18) NDIM=MSTU(7) |
| 6410 | NLIN=1 |
| 6411 | CHLIN=' ' |
| 6412 | CHLIN(7:35)='DATA ('//CHVAR(IVAR)//',I= 1, )/' |
| 6413 | LLIN=35 |
| 6414 | CHOLD='START' |
| 6415 | |
| 6416 | C...Loop through variables for conversion to characters. |
| 6417 | DO 220 IDIM=1,NDIM |
| 6418 | IF(IVAR.EQ.1) WRITE(CHTMP,5400) KCHG(IDIM,1) |
| 6419 | IF(IVAR.EQ.2) WRITE(CHTMP,5400) KCHG(IDIM,2) |
| 6420 | IF(IVAR.EQ.3) WRITE(CHTMP,5400) KCHG(IDIM,3) |
| 6421 | IF(IVAR.EQ.4) WRITE(CHTMP,5500) PMAS(IDIM,1) |
| 6422 | IF(IVAR.EQ.5) WRITE(CHTMP,5500) PMAS(IDIM,2) |
| 6423 | IF(IVAR.EQ.6) WRITE(CHTMP,5500) PMAS(IDIM,3) |
| 6424 | IF(IVAR.EQ.7) WRITE(CHTMP,5500) PMAS(IDIM,4) |
| 6425 | IF(IVAR.EQ.8) WRITE(CHTMP,5400) MDCY(IDIM,1) |
| 6426 | IF(IVAR.EQ.9) WRITE(CHTMP,5400) MDCY(IDIM,2) |
| 6427 | IF(IVAR.EQ.10) WRITE(CHTMP,5400) MDCY(IDIM,3) |
| 6428 | IF(IVAR.EQ.11) WRITE(CHTMP,5400) MDME(IDIM,1) |
| 6429 | IF(IVAR.EQ.12) WRITE(CHTMP,5400) MDME(IDIM,2) |
| 6430 | IF(IVAR.EQ.13) WRITE(CHTMP,5500) BRAT(IDIM) |
| 6431 | IF(IVAR.EQ.14) WRITE(CHTMP,5400) KFDP(IDIM,1) |
| 6432 | IF(IVAR.EQ.15) WRITE(CHTMP,5400) KFDP(IDIM,2) |
| 6433 | IF(IVAR.EQ.16) WRITE(CHTMP,5400) KFDP(IDIM,3) |
| 6434 | IF(IVAR.EQ.17) WRITE(CHTMP,5400) KFDP(IDIM,4) |
| 6435 | IF(IVAR.EQ.18) WRITE(CHTMP,5400) KFDP(IDIM,5) |
| 6436 | IF(IVAR.EQ.19) CHTMP=CHAF(IDIM) |
| 6437 | |
| 6438 | C...Length of variable, trailing decimal zeros, quotation marks. |
| 6439 | LLOW=1 |
| 6440 | LHIG=1 |
| 6441 | DO 180 LL=1,12 |
| 6442 | IF(CHTMP(13-LL:13-LL).NE.' ') LLOW=13-LL |
| 6443 | 180 IF(CHTMP(LL:LL).NE.' ') LHIG=LL |
| 6444 | CHNEW=CHTMP(LLOW:LHIG)//' ' |
| 6445 | LNEW=1+LHIG-LLOW |
| 6446 | IF((IVAR.GE.4.AND.IVAR.LE.7).OR.IVAR.EQ.13) THEN |
| 6447 | LNEW=LNEW+1 |
| 6448 | 190 LNEW=LNEW-1 |
| 6449 | IF(CHNEW(LNEW:LNEW).EQ.'0') GOTO 190 |
| 6450 | IF(LNEW.EQ.1) CHNEW(1:2)='0.' |
| 6451 | IF(LNEW.EQ.1) LNEW=2 |
| 6452 | ELSEIF(IVAR.EQ.19) THEN |
| 6453 | DO 200 LL=LNEW,1,-1 |
| 6454 | IF(CHNEW(LL:LL).EQ.'''') THEN |
| 6455 | CHTMP=CHNEW |
| 6456 | CHNEW=CHTMP(1:LL)//''''//CHTMP(LL+1:11) |
| 6457 | LNEW=LNEW+1 |
| 6458 | ENDIF |
| 6459 | 200 CONTINUE |
| 6460 | CHTMP=CHNEW |
| 6461 | CHNEW(1:LNEW+2)=''''//CHTMP(1:LNEW)//'''' |
| 6462 | LNEW=LNEW+2 |
| 6463 | ENDIF |
| 6464 | |
| 6465 | C...Form composite character string, often including repetition counter. |
| 6466 | IF(CHNEW.NE.CHOLD) THEN |
| 6467 | NRPT=1 |
| 6468 | CHOLD=CHNEW |
| 6469 | CHCOM=CHNEW |
| 6470 | LCOM=LNEW |
| 6471 | ELSE |
| 6472 | LRPT=LNEW+1 |
| 6473 | IF(NRPT.GE.2) LRPT=LNEW+3 |
| 6474 | IF(NRPT.GE.10) LRPT=LNEW+4 |
| 6475 | IF(NRPT.GE.100) LRPT=LNEW+5 |
| 6476 | IF(NRPT.GE.1000) LRPT=LNEW+6 |
| 6477 | LLIN=LLIN-LRPT |
| 6478 | NRPT=NRPT+1 |
| 6479 | WRITE(CHTMP,5400) NRPT |
| 6480 | LRPT=1 |
| 6481 | IF(NRPT.GE.10) LRPT=2 |
| 6482 | IF(NRPT.GE.100) LRPT=3 |
| 6483 | IF(NRPT.GE.1000) LRPT=4 |
| 6484 | CHCOM(1:LRPT+1+LNEW)=CHTMP(13-LRPT:12)//'*'//CHNEW(1:LNEW) |
| 6485 | LCOM=LRPT+1+LNEW |
| 6486 | ENDIF |
| 6487 | |
| 6488 | C...Add characters to end of line, to new line (after storing old line), |
| 6489 | C...or to new block of lines (after writing old block). |
| 6490 | IF(LLIN+LCOM.LE.70) THEN |
| 6491 | CHLIN(LLIN+1:LLIN+LCOM+1)=CHCOM(1:LCOM)//',' |
| 6492 | LLIN=LLIN+LCOM+1 |
| 6493 | ELSEIF(NLIN.LE.19) THEN |
| 6494 | CHLIN(LLIN+1:72)=' ' |
| 6495 | CHBLK(NLIN)=CHLIN |
| 6496 | NLIN=NLIN+1 |
| 6497 | CHLIN(6:6+LCOM+1)='&'//CHCOM(1:LCOM)//',' |
| 6498 | LLIN=6+LCOM+1 |
| 6499 | ELSE |
| 6500 | CHLIN(LLIN:72)='/'//' ' |
| 6501 | CHBLK(NLIN)=CHLIN |
| 6502 | WRITE(CHTMP,5400) IDIM-NRPT |
| 6503 | CHBLK(1)(30:33)=CHTMP(9:12) |
| 6504 | DO 210 ILIN=1,NLIN |
| 6505 | 210 WRITE(LFN,5600) CHBLK(ILIN) |
| 6506 | NLIN=1 |
| 6507 | CHLIN=' ' |
| 6508 | CHLIN(7:35+LCOM+1)='DATA ('//CHVAR(IVAR)//',I= , )/'// |
| 6509 | & CHCOM(1:LCOM)//',' |
| 6510 | WRITE(CHTMP,5400) IDIM-NRPT+1 |
| 6511 | CHLIN(25:28)=CHTMP(9:12) |
| 6512 | LLIN=35+LCOM+1 |
| 6513 | ENDIF |
| 6514 | 220 CONTINUE |
| 6515 | |
| 6516 | C...Write final block of lines. |
| 6517 | CHLIN(LLIN:72)='/'//' ' |
| 6518 | CHBLK(NLIN)=CHLIN |
| 6519 | WRITE(CHTMP,5400) NDIM |
| 6520 | CHBLK(1)(30:33)=CHTMP(9:12) |
| 6521 | DO 230 ILIN=1,NLIN |
| 6522 | 230 WRITE(LFN,5600) CHBLK(ILIN) |
| 6523 | 240 CONTINUE |
| 6524 | ENDIF |
| 6525 | |
| 6526 | C...Formats for reading and writing particle data. |
| 6527 | 5000 FORMAT(1X,I4,2X,A8,3I3,3F12.5,2X,F12.5,I3) |
| 6528 | 5100 FORMAT(5X,2I5,F12.5,5I8) |
| 6529 | 5200 FORMAT(A80) |
| 6530 | 5300 FORMAT(I4) |
| 6531 | 5400 FORMAT(I12) |
| 6532 | 5500 FORMAT(F12.5) |
| 6533 | 5600 FORMAT(A72) |
| 6534 | |
| 6535 | RETURN |
| 6536 | END |
| 6537 | |
| 6538 | C********************************************************************* |
| 6539 | |
| 6540 | FUNCTION KLU(I,J) |
| 6541 | |
| 6542 | C...Purpose: to provide various integer-valued event related data. |
| 6543 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 6544 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 6545 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 6546 | SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ |
| 6547 | |
| 6548 | C...Default value. For I=0 number of entries, number of stable entries |
| 6549 | C...or 3 times total charge. |
| 6550 | KLU=0 |
| 6551 | IF(I.LT.0.OR.I.GT.MSTU(4).OR.J.LE.0) THEN |
| 6552 | ELSEIF(I.EQ.0.AND.J.EQ.1) THEN |
| 6553 | KLU=N |
| 6554 | ELSEIF(I.EQ.0.AND.(J.EQ.2.OR.J.EQ.6)) THEN |
| 6555 | DO 100 I1=1,N |
| 6556 | IF(J.EQ.2.AND.K(I1,1).GE.1.AND.K(I1,1).LE.10) KLU=KLU+1 |
| 6557 | IF(J.EQ.6.AND.K(I1,1).GE.1.AND.K(I1,1).LE.10) KLU=KLU+ |
| 6558 | & LUCHGE(K(I1,2)) |
| 6559 | 100 CONTINUE |
| 6560 | ELSEIF(I.EQ.0) THEN |
| 6561 | |
| 6562 | C...For I > 0 direct readout of K matrix or charge. |
| 6563 | ELSEIF(J.LE.5) THEN |
| 6564 | KLU=K(I,J) |
| 6565 | ELSEIF(J.EQ.6) THEN |
| 6566 | KLU=LUCHGE(K(I,2)) |
| 6567 | |
| 6568 | C...Status (existing/fragmented/decayed), parton/hadron separation. |
| 6569 | ELSEIF(J.LE.8) THEN |
| 6570 | IF(K(I,1).GE.1.AND.K(I,1).LE.10) KLU=1 |
| 6571 | IF(J.EQ.8) KLU=KLU*K(I,2) |
| 6572 | ELSEIF(J.LE.12) THEN |
| 6573 | KFA=IABS(K(I,2)) |
| 6574 | KC=LUCOMP(KFA) |
| 6575 | KQ=0 |
| 6576 | IF(KC.NE.0) KQ=KCHG(KC,2) |
| 6577 | IF(J.EQ.9.AND.KC.NE.0.AND.KQ.NE.0) KLU=K(I,2) |
| 6578 | IF(J.EQ.10.AND.KC.NE.0.AND.KQ.EQ.0) KLU=K(I,2) |
| 6579 | IF(J.EQ.11) KLU=KC |
| 6580 | IF(J.EQ.12) KLU=KQ*ISIGN(1,K(I,2)) |
| 6581 | |
| 6582 | C...Heaviest flavour in hadron/diquark. |
| 6583 | ELSEIF(J.EQ.13) THEN |
| 6584 | KFA=IABS(K(I,2)) |
| 6585 | KLU=MOD(KFA/100,10)*(-1)**MOD(KFA/100,10) |
| 6586 | IF(KFA.LT.10) KLU=KFA |
| 6587 | IF(MOD(KFA/1000,10).NE.0) KLU=MOD(KFA/1000,10) |
| 6588 | KLU=KLU*ISIGN(1,K(I,2)) |
| 6589 | |
| 6590 | C...Particle history: generation, ancestor, rank. |
| 6591 | ELSEIF(J.LE.16) THEN |
| 6592 | I2=I |
| 6593 | I1=I |
| 6594 | 110 KLU=KLU+1 |
| 6595 | I3=I2 |
| 6596 | I2=I1 |
| 6597 | I1=K(I1,3) |
| 6598 | IF(I1.GT.0.AND.K(I1,1).GT.0.AND.K(I1,1).LE.20) GOTO 110 |
| 6599 | IF(J.EQ.15) KLU=I2 |
| 6600 | IF(J.EQ.16) THEN |
| 6601 | KLU=0 |
| 6602 | DO 120 I1=I2+1,I3 |
| 6603 | 120 IF(K(I1,3).EQ.I2.AND.K(I1,1).GT.0.AND.K(I1,1).LE.20) KLU=KLU+1 |
| 6604 | ENDIF |
| 6605 | |
| 6606 | C...Particle coming from collapsing jet system or not. |
| 6607 | ELSEIF(J.EQ.17) THEN |
| 6608 | I1=I |
| 6609 | 130 KLU=KLU+1 |
| 6610 | I3=I1 |
| 6611 | I1=K(I1,3) |
| 6612 | I0=MAX(1,I1) |
| 6613 | KC=LUCOMP(K(I0,2)) |
| 6614 | IF(I1.EQ.0.OR.K(I0,1).LE.0.OR.K(I0,1).GT.20.OR.KC.EQ.0) THEN |
| 6615 | IF(KLU.EQ.1) KLU=-1 |
| 6616 | IF(KLU.GT.1) KLU=0 |
| 6617 | RETURN |
| 6618 | ENDIF |
| 6619 | IF(KCHG(KC,2).EQ.0) GOTO 130 |
| 6620 | IF(K(I1,1).NE.12) KLU=0 |
| 6621 | IF(K(I1,1).NE.12) RETURN |
| 6622 | I2=I1 |
| 6623 | 140 I2=I2+1 |
| 6624 | IF(I2.LT.N.AND.K(I2,1).NE.11) GOTO 140 |
| 6625 | K3M=K(I3-1,3) |
| 6626 | IF(K3M.GE.I1.AND.K3M.LE.I2) KLU=0 |
| 6627 | K3P=K(I3+1,3) |
| 6628 | IF(I3.LT.N.AND.K3P.GE.I1.AND.K3P.LE.I2) KLU=0 |
| 6629 | |
| 6630 | C...Number of decay products. Colour flow. |
| 6631 | ELSEIF(J.EQ.18) THEN |
| 6632 | IF(K(I,1).EQ.11.OR.K(I,1).EQ.12) KLU=MAX(0,K(I,5)-K(I,4)+1) |
| 6633 | IF(K(I,4).EQ.0.OR.K(I,5).EQ.0) KLU=0 |
| 6634 | ELSEIF(J.LE.22) THEN |
| 6635 | IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) RETURN |
| 6636 | IF(J.EQ.19) KLU=MOD(K(I,4)/MSTU(5),MSTU(5)) |
| 6637 | IF(J.EQ.20) KLU=MOD(K(I,5)/MSTU(5),MSTU(5)) |
| 6638 | IF(J.EQ.21) KLU=MOD(K(I,4),MSTU(5)) |
| 6639 | IF(J.EQ.22) KLU=MOD(K(I,5),MSTU(5)) |
| 6640 | ELSE |
| 6641 | ENDIF |
| 6642 | |
| 6643 | RETURN |
| 6644 | END |
| 6645 | |
| 6646 | C********************************************************************* |
| 6647 | |
| 6648 | FUNCTION PLU(I,J) |
| 6649 | |
| 6650 | C...Purpose: to provide various real-valued event related data. |
| 6651 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 6652 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 6653 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 6654 | SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ |
| 6655 | DIMENSION PSUM(4) |
| 6656 | |
| 6657 | C...Set default value. For I = 0 sum of momenta or charges, |
| 6658 | C...or invariant mass of system. |
| 6659 | PLU=0. |
| 6660 | IF(I.LT.0.OR.I.GT.MSTU(4).OR.J.LE.0) THEN |
| 6661 | ELSEIF(I.EQ.0.AND.J.LE.4) THEN |
| 6662 | DO 100 I1=1,N |
| 6663 | 100 IF(K(I1,1).GT.0.AND.K(I1,1).LE.10) PLU=PLU+P(I1,J) |
| 6664 | ELSEIF(I.EQ.0.AND.J.EQ.5) THEN |
| 6665 | DO 110 J1=1,4 |
| 6666 | PSUM(J1)=0. |
| 6667 | DO 110 I1=1,N |
| 6668 | 110 IF(K(I1,1).GT.0.AND.K(I1,1).LE.10) PSUM(J1)=PSUM(J1)+P(I1,J1) |
| 6669 | PLU=SQRT(MAX(0.,PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-PSUM(3)**2)) |
| 6670 | ELSEIF(I.EQ.0.AND.J.EQ.6) THEN |
| 6671 | DO 120 I1=1,N |
| 6672 | 120 IF(K(I1,1).GT.0.AND.K(I1,1).LE.10) PLU=PLU+LUCHGE(K(I1,2))/3. |
| 6673 | ELSEIF(I.EQ.0) THEN |
| 6674 | |
| 6675 | C...Direct readout of P matrix. |
| 6676 | ELSEIF(J.LE.5) THEN |
| 6677 | PLU=P(I,J) |
| 6678 | |
| 6679 | C...Charge, total momentum, transverse momentum, transverse mass. |
| 6680 | ELSEIF(J.LE.12) THEN |
| 6681 | IF(J.EQ.6) PLU=LUCHGE(K(I,2))/3. |
| 6682 | IF(J.EQ.7.OR.J.EQ.8) PLU=P(I,1)**2+P(I,2)**2+P(I,3)**2 |
| 6683 | IF(J.EQ.9.OR.J.EQ.10) PLU=P(I,1)**2+P(I,2)**2 |
| 6684 | IF(J.EQ.11.OR.J.EQ.12) PLU=P(I,5)**2+P(I,1)**2+P(I,2)**2 |
| 6685 | IF(J.EQ.8.OR.J.EQ.10.OR.J.EQ.12) PLU=SQRT(PLU) |
| 6686 | |
| 6687 | C...Theta and phi angle in radians or degrees. |
| 6688 | ELSEIF(J.LE.16) THEN |
| 6689 | IF(J.LE.14) PLU=ULANGL(P(I,3),SQRT(P(I,1)**2+P(I,2)**2)) |
| 6690 | IF(J.GE.15) PLU=ULANGL(P(I,1),P(I,2)) |
| 6691 | IF(J.EQ.14.OR.J.EQ.16) PLU=PLU*180./PARU(1) |
| 6692 | |
| 6693 | C...True rapidity, rapidity with pion mass, pseudorapidity. |
| 6694 | ELSEIF(J.LE.19) THEN |
| 6695 | PMR=0. |
| 6696 | IF(J.EQ.17) PMR=P(I,5) |
| 6697 | IF(J.EQ.18) PMR=ULMASS(211) |
| 6698 | PR=MAX(1E-20,PMR**2+P(I,1)**2+P(I,2)**2) |
| 6699 | PLU=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/SQRT(PR), |
| 6700 | & 1E20)),P(I,3)) |
| 6701 | |
| 6702 | C...Energy and momentum fractions (only to be used in CM frame). |
| 6703 | ELSEIF(J.LE.25) THEN |
| 6704 | IF(J.EQ.20) PLU=2.*SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)/PARU(21) |
| 6705 | IF(J.EQ.21) PLU=2.*P(I,3)/PARU(21) |
| 6706 | IF(J.EQ.22) PLU=2.*SQRT(P(I,1)**2+P(I,2)**2)/PARU(21) |
| 6707 | IF(J.EQ.23) PLU=2.*P(I,4)/PARU(21) |
| 6708 | IF(J.EQ.24) PLU=(P(I,4)+P(I,3))/PARU(21) |
| 6709 | IF(J.EQ.25) PLU=(P(I,4)-P(I,3))/PARU(21) |
| 6710 | ENDIF |
| 6711 | |
| 6712 | RETURN |
| 6713 | END |
| 6714 | |
| 6715 | C********************************************************************* |
| 6716 | |
| 6717 | SUBROUTINE LUSPHE(SPH,APL) |
| 6718 | |
| 6719 | C...Purpose: to perform sphericity tensor analysis to give sphericity, |
| 6720 | C...aplanarity and the related event axes. |
| 6721 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 6722 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 6723 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 6724 | SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ |
| 6725 | DIMENSION SM(3,3),SV(3,3) |
| 6726 | |
| 6727 | C...Calculate matrix to be diagonalized. |
| 6728 | NP=0 |
| 6729 | DO 100 J1=1,3 |
| 6730 | DO 100 J2=J1,3 |
| 6731 | 100 SM(J1,J2)=0. |
| 6732 | PS=0. |
| 6733 | DO 120 I=1,N |
| 6734 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 120 |
| 6735 | IF(MSTU(41).GE.2) THEN |
| 6736 | KC=LUCOMP(K(I,2)) |
| 6737 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. |
| 6738 | & KC.EQ.18) GOTO 120 |
| 6739 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) |
| 6740 | & GOTO 120 |
| 6741 | ENDIF |
| 6742 | NP=NP+1 |
| 6743 | PA=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2) |
| 6744 | PWT=1. |
| 6745 | IF(ABS(PARU(41)-2.).GT.0.001) PWT=MAX(1E-10,PA)**(PARU(41)-2.) |
| 6746 | DO 110 J1=1,3 |
| 6747 | DO 110 J2=J1,3 |
| 6748 | 110 SM(J1,J2)=SM(J1,J2)+PWT*P(I,J1)*P(I,J2) |
| 6749 | PS=PS+PWT*PA**2 |
| 6750 | 120 CONTINUE |
| 6751 | |
| 6752 | C...Very low multiplicities (0 or 1) not considered. |
| 6753 | IF(NP.LE.1) THEN |
| 6754 | CALL LUERRM(8,'(LUSPHE:) too few particles for analysis') |
| 6755 | SPH=-1. |
| 6756 | APL=-1. |
| 6757 | RETURN |
| 6758 | ENDIF |
| 6759 | DO 130 J1=1,3 |
| 6760 | DO 130 J2=J1,3 |
| 6761 | 130 SM(J1,J2)=SM(J1,J2)/PS |
| 6762 | |
| 6763 | C...Find eigenvalues to matrix (third degree equation). |
| 6764 | SQ=(SM(1,1)*SM(2,2)+SM(1,1)*SM(3,3)+SM(2,2)*SM(3,3)-SM(1,2)**2- |
| 6765 | &SM(1,3)**2-SM(2,3)**2)/3.-1./9. |
| 6766 | SR=-0.5*(SQ+1./9.+SM(1,1)*SM(2,3)**2+SM(2,2)*SM(1,3)**2+SM(3,3)* |
| 6767 | &SM(1,2)**2-SM(1,1)*SM(2,2)*SM(3,3))+SM(1,2)*SM(1,3)*SM(2,3)+1./27. |
| 6768 | SP=COS(ACOS(MAX(MIN(SR/SQRT(-SQ**3),1.),-1.))/3.) |
| 6769 | P(N+1,4)=1./3.+SQRT(-SQ)*MAX(2.*SP,SQRT(3.*(1.-SP**2))-SP) |
| 6770 | P(N+3,4)=1./3.+SQRT(-SQ)*MIN(2.*SP,-SQRT(3.*(1.-SP**2))-SP) |
| 6771 | P(N+2,4)=1.-P(N+1,4)-P(N+3,4) |
| 6772 | IF(P(N+2,4).LT.1E-5) THEN |
| 6773 | CALL LUERRM(8,'(LUSPHE:) all particles back-to-back') |
| 6774 | SPH=-1. |
| 6775 | APL=-1. |
| 6776 | RETURN |
| 6777 | ENDIF |
| 6778 | |
| 6779 | C...Find first and last eigenvector by solving equation system. |
| 6780 | DO 170 I=1,3,2 |
| 6781 | DO 140 J1=1,3 |
| 6782 | SV(J1,J1)=SM(J1,J1)-P(N+I,4) |
| 6783 | DO 140 J2=J1+1,3 |
| 6784 | SV(J1,J2)=SM(J1,J2) |
| 6785 | 140 SV(J2,J1)=SM(J1,J2) |
| 6786 | SMAX=0. |
| 6787 | DO 150 J1=1,3 |
| 6788 | DO 150 J2=1,3 |
| 6789 | IF(ABS(SV(J1,J2)).LE.SMAX) GOTO 150 |
| 6790 | JA=J1 |
| 6791 | JB=J2 |
| 6792 | SMAX=ABS(SV(J1,J2)) |
| 6793 | 150 CONTINUE |
| 6794 | SMAX=0. |
| 6795 | DO 160 J3=JA+1,JA+2 |
| 6796 | J1=J3-3*((J3-1)/3) |
| 6797 | RL=SV(J1,JB)/SV(JA,JB) |
| 6798 | DO 160 J2=1,3 |
| 6799 | SV(J1,J2)=SV(J1,J2)-RL*SV(JA,J2) |
| 6800 | IF(ABS(SV(J1,J2)).LE.SMAX) GOTO 160 |
| 6801 | JC=J1 |
| 6802 | SMAX=ABS(SV(J1,J2)) |
| 6803 | 160 CONTINUE |
| 6804 | JB1=JB+1-3*(JB/3) |
| 6805 | JB2=JB+2-3*((JB+1)/3) |
| 6806 | P(N+I,JB1)=-SV(JC,JB2) |
| 6807 | P(N+I,JB2)=SV(JC,JB1) |
| 6808 | P(N+I,JB)=-(SV(JA,JB1)*P(N+I,JB1)+SV(JA,JB2)*P(N+I,JB2))/ |
| 6809 | &SV(JA,JB) |
| 6810 | PA=SQRT(P(N+I,1)**2+P(N+I,2)**2+P(N+I,3)**2) |
| 6811 | SGN=(-1.)**INT(RLU(0)+0.5) |
| 6812 | DO 170 J=1,3 |
| 6813 | 170 P(N+I,J)=SGN*P(N+I,J)/PA |
| 6814 | |
| 6815 | C...Middle axis orthogonal to other two. Fill other codes. |
| 6816 | SGN=(-1.)**INT(RLU(0)+0.5) |
| 6817 | P(N+2,1)=SGN*(P(N+1,2)*P(N+3,3)-P(N+1,3)*P(N+3,2)) |
| 6818 | P(N+2,2)=SGN*(P(N+1,3)*P(N+3,1)-P(N+1,1)*P(N+3,3)) |
| 6819 | P(N+2,3)=SGN*(P(N+1,1)*P(N+3,2)-P(N+1,2)*P(N+3,1)) |
| 6820 | DO 180 I=1,3 |
| 6821 | K(N+I,1)=31 |
| 6822 | K(N+I,2)=95 |
| 6823 | K(N+I,3)=I |
| 6824 | K(N+I,4)=0 |
| 6825 | K(N+I,5)=0 |
| 6826 | P(N+I,5)=0. |
| 6827 | DO 180 J=1,5 |
| 6828 | 180 V(I,J)=0. |
| 6829 | |
| 6830 | C...Calculate sphericity and aplanarity. Select storing option. |
| 6831 | SPH=1.5*(P(N+2,4)+P(N+3,4)) |
| 6832 | APL=1.5*P(N+3,4) |
| 6833 | MSTU(61)=N+1 |
| 6834 | MSTU(62)=NP |
| 6835 | IF(MSTU(43).LE.1) MSTU(3)=3 |
| 6836 | IF(MSTU(43).GE.2) N=N+3 |
| 6837 | |
| 6838 | RETURN |
| 6839 | END |
| 6840 | |
| 6841 | C********************************************************************* |
| 6842 | |
| 6843 | SUBROUTINE LUTHRU(THR,OBL) |
| 6844 | |
| 6845 | C...Purpose: to perform thrust analysis to give thrust, oblateness |
| 6846 | C...and the related event axes. |
| 6847 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 6848 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 6849 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 6850 | SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ |
| 6851 | DIMENSION TDI(3),TPR(3) |
| 6852 | |
| 6853 | C...Take copy of particles that are to be considered in thrust analysis. |
| 6854 | NP=0 |
| 6855 | PS=0. |
| 6856 | DO 100 I=1,N |
| 6857 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 100 |
| 6858 | IF(MSTU(41).GE.2) THEN |
| 6859 | KC=LUCOMP(K(I,2)) |
| 6860 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. |
| 6861 | & KC.EQ.18) GOTO 100 |
| 6862 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) |
| 6863 | & GOTO 100 |
| 6864 | ENDIF |
| 6865 | IF(N+NP+MSTU(44)+15.GE.MSTU(4)-MSTU(32)-5) THEN |
| 6866 | CALL LUERRM(11,'(LUTHRU:) no more memory left in LUJETS') |
| 6867 | THR=-2. |
| 6868 | OBL=-2. |
| 6869 | RETURN |
| 6870 | ENDIF |
| 6871 | NP=NP+1 |
| 6872 | K(N+NP,1)=23 |
| 6873 | P(N+NP,1)=P(I,1) |
| 6874 | P(N+NP,2)=P(I,2) |
| 6875 | P(N+NP,3)=P(I,3) |
| 6876 | P(N+NP,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2) |
| 6877 | P(N+NP,5)=1. |
| 6878 | IF(ABS(PARU(42)-1.).GT.0.001) P(N+NP,5)=P(N+NP,4)**(PARU(42)-1.) |
| 6879 | PS=PS+P(N+NP,4)*P(N+NP,5) |
| 6880 | 100 CONTINUE |
| 6881 | |
| 6882 | C...Very low multiplicities (0 or 1) not considered. |
| 6883 | IF(NP.LE.1) THEN |
| 6884 | CALL LUERRM(8,'(LUTHRU:) too few particles for analysis') |
| 6885 | THR=-1. |
| 6886 | OBL=-1. |
| 6887 | RETURN |
| 6888 | ENDIF |
| 6889 | |
| 6890 | C...Loop over thrust and major. T axis along z direction in latter case. |
| 6891 | DO 280 ILD=1,2 |
| 6892 | IF(ILD.EQ.2) THEN |
| 6893 | K(N+NP+1,1)=31 |
| 6894 | PHI=ULANGL(P(N+NP+1,1),P(N+NP+1,2)) |
| 6895 | MSTU(33)=1 |
| 6896 | CALL LUDBRB(N+1,N+NP+1,0.,-PHI,0D0,0D0,0D0) |
| 6897 | THE=ULANGL(P(N+NP+1,3),P(N+NP+1,1)) |
| 6898 | CALL LUDBRB(N+1,N+NP+1,-THE,0.,0D0,0D0,0D0) |
| 6899 | ENDIF |
| 6900 | |
| 6901 | C...Find and order particles with highest p (pT for major). |
| 6902 | DO 110 ILF=N+NP+4,N+NP+MSTU(44)+4 |
| 6903 | 110 P(ILF,4)=0. |
| 6904 | DO 150 I=N+1,N+NP |
| 6905 | IF(ILD.EQ.2) P(I,4)=SQRT(P(I,1)**2+P(I,2)**2) |
| 6906 | DO 120 ILF=N+NP+MSTU(44)+3,N+NP+4,-1 |
| 6907 | IF(P(I,4).LE.P(ILF,4)) GOTO 130 |
| 6908 | DO 120 J=1,5 |
| 6909 | 120 P(ILF+1,J)=P(ILF,J) |
| 6910 | ILF=N+NP+3 |
| 6911 | 130 DO 140 J=1,5 |
| 6912 | 140 P(ILF+1,J)=P(I,J) |
| 6913 | 150 CONTINUE |
| 6914 | |
| 6915 | C...Find and order initial axes with highest thrust (major). |
| 6916 | DO 160 ILG=N+NP+MSTU(44)+5,N+NP+MSTU(44)+15 |
| 6917 | 160 P(ILG,4)=0. |
| 6918 | NC=2**(MIN(MSTU(44),NP)-1) |
| 6919 | DO 220 ILC=1,NC |
| 6920 | DO 170 J=1,3 |
| 6921 | 170 TDI(J)=0. |
| 6922 | DO 180 ILF=1,MIN(MSTU(44),NP) |
| 6923 | SGN=P(N+NP+ILF+3,5) |
| 6924 | IF(2**ILF*((ILC+2**(ILF-1)-1)/2**ILF).GE.ILC) SGN=-SGN |
| 6925 | DO 180 J=1,4-ILD |
| 6926 | 180 TDI(J)=TDI(J)+SGN*P(N+NP+ILF+3,J) |
| 6927 | TDS=TDI(1)**2+TDI(2)**2+TDI(3)**2 |
| 6928 | DO 190 ILG=N+NP+MSTU(44)+MIN(ILC,10)+4,N+NP+MSTU(44)+5,-1 |
| 6929 | IF(TDS.LE.P(ILG,4)) GOTO 200 |
| 6930 | DO 190 J=1,4 |
| 6931 | 190 P(ILG+1,J)=P(ILG,J) |
| 6932 | ILG=N+NP+MSTU(44)+4 |
| 6933 | 200 DO 210 J=1,3 |
| 6934 | 210 P(ILG+1,J)=TDI(J) |
| 6935 | P(ILG+1,4)=TDS |
| 6936 | 220 CONTINUE |
| 6937 | |
| 6938 | C...Iterate direction of axis until stable maximum. |
| 6939 | P(N+NP+ILD,4)=0. |
| 6940 | ILG=0 |
| 6941 | 230 ILG=ILG+1 |
| 6942 | THP=0. |
| 6943 | 240 THPS=THP |
| 6944 | DO 250 J=1,3 |
| 6945 | IF(THP.LE.1E-10) TDI(J)=P(N+NP+MSTU(44)+4+ILG,J) |
| 6946 | IF(THP.GT.1E-10) TDI(J)=TPR(J) |
| 6947 | 250 TPR(J)=0. |
| 6948 | DO 260 I=N+1,N+NP |
| 6949 | SGN=SIGN(P(I,5),TDI(1)*P(I,1)+TDI(2)*P(I,2)+TDI(3)*P(I,3)) |
| 6950 | DO 260 J=1,4-ILD |
| 6951 | 260 TPR(J)=TPR(J)+SGN*P(I,J) |
| 6952 | THP=SQRT(TPR(1)**2+TPR(2)**2+TPR(3)**2)/PS |
| 6953 | IF(THP.GE.THPS+PARU(48)) GOTO 240 |
| 6954 | |
| 6955 | C...Save good axis. Try new initial axis until a number of tries agree. |
| 6956 | IF(THP.LT.P(N+NP+ILD,4)-PARU(48).AND.ILG.LT.MIN(10,NC)) GOTO 230 |
| 6957 | IF(THP.GT.P(N+NP+ILD,4)+PARU(48)) THEN |
| 6958 | IAGR=0 |
| 6959 | SGN=(-1.)**INT(RLU(0)+0.5) |
| 6960 | DO 270 J=1,3 |
| 6961 | 270 P(N+NP+ILD,J)=SGN*TPR(J)/(PS*THP) |
| 6962 | P(N+NP+ILD,4)=THP |
| 6963 | P(N+NP+ILD,5)=0. |
| 6964 | ENDIF |
| 6965 | IAGR=IAGR+1 |
| 6966 | 280 IF(IAGR.LT.MSTU(45).AND.ILG.LT.MIN(10,NC)) GOTO 230 |
| 6967 | |
| 6968 | C...Find minor axis and value by orthogonality. |
| 6969 | SGN=(-1.)**INT(RLU(0)+0.5) |
| 6970 | P(N+NP+3,1)=-SGN*P(N+NP+2,2) |
| 6971 | P(N+NP+3,2)=SGN*P(N+NP+2,1) |
| 6972 | P(N+NP+3,3)=0. |
| 6973 | THP=0. |
| 6974 | DO 290 I=N+1,N+NP |
| 6975 | 290 THP=THP+P(I,5)*ABS(P(N+NP+3,1)*P(I,1)+P(N+NP+3,2)*P(I,2)) |
| 6976 | P(N+NP+3,4)=THP/PS |
| 6977 | P(N+NP+3,5)=0. |
| 6978 | |
| 6979 | C...Fill axis information. Rotate back to original coordinate system. |
| 6980 | DO 300 ILD=1,3 |
| 6981 | K(N+ILD,1)=31 |
| 6982 | K(N+ILD,2)=96 |
| 6983 | K(N+ILD,3)=ILD |
| 6984 | K(N+ILD,4)=0 |
| 6985 | K(N+ILD,5)=0 |
| 6986 | DO 300 J=1,5 |
| 6987 | P(N+ILD,J)=P(N+NP+ILD,J) |
| 6988 | 300 V(N+ILD,J)=0. |
| 6989 | CALL LUDBRB(N+1,N+3,THE,PHI,0D0,0D0,0D0) |
| 6990 | |
| 6991 | C...Calculate thrust and oblateness. Select storing option. |
| 6992 | THR=P(N+1,4) |
| 6993 | OBL=P(N+2,4)-P(N+3,4) |
| 6994 | MSTU(61)=N+1 |
| 6995 | MSTU(62)=NP |
| 6996 | IF(MSTU(43).LE.1) MSTU(3)=3 |
| 6997 | IF(MSTU(43).GE.2) N=N+3 |
| 6998 | |
| 6999 | RETURN |
| 7000 | END |
| 7001 | |
| 7002 | C********************************************************************* |
| 7003 | |
| 7004 | SUBROUTINE LUCLUS(NJET) |
| 7005 | |
| 7006 | C...Purpose: to subdivide the particle content of an event into |
| 7007 | C...jets/clusters. |
| 7008 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 7009 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 7010 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 7011 | SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ |
| 7012 | DIMENSION PS(5) |
| 7013 | SAVE NSAV,NP,PS,PSS,RINIT,NPRE,NREM |
| 7014 | |
| 7015 | C...Functions: distance measure in pT or (pseudo)mass. |
| 7016 | R2T(I1,I2)=(P(I1,5)*P(I2,5)-P(I1,1)*P(I2,1)-P(I1,2)*P(I2,2)- |
| 7017 | &P(I1,3)*P(I2,3))*2.*P(I1,5)*P(I2,5)/(0.0001+P(I1,5)+P(I2,5))**2 |
| 7018 | R2M(I1,I2)=2.*P(I1,4)*P(I2,4)*(1.-(P(I1,1)*P(I2,1)+P(I1,2)* |
| 7019 | &P(I2,2)+P(I1,3)*P(I2,3))/(P(I1,5)*P(I2,5))) |
| 7020 | |
| 7021 | C...If first time, reset. If reentering, skip preliminaries. |
| 7022 | IF(MSTU(48).LE.0) THEN |
| 7023 | NP=0 |
| 7024 | DO 100 J=1,5 |
| 7025 | 100 PS(J)=0. |
| 7026 | PSS=0. |
| 7027 | ELSE |
| 7028 | NJET=NSAV |
| 7029 | IF(MSTU(43).GE.2) N=N-NJET |
| 7030 | DO 110 I=N+1,N+NJET |
| 7031 | 110 P(I,5)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2) |
| 7032 | IF(MSTU(46).LE.3) R2ACC=PARU(44)**2 |
| 7033 | IF(MSTU(46).GE.4) R2ACC=PARU(45)*PS(5)**2 |
| 7034 | NLOOP=0 |
| 7035 | GOTO 290 |
| 7036 | ENDIF |
| 7037 | |
| 7038 | C...Find which particles are to be considered in cluster search. |
| 7039 | DO 140 I=1,N |
| 7040 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 140 |
| 7041 | IF(MSTU(41).GE.2) THEN |
| 7042 | KC=LUCOMP(K(I,2)) |
| 7043 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. |
| 7044 | & KC.EQ.18) GOTO 140 |
| 7045 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) |
| 7046 | & GOTO 140 |
| 7047 | ENDIF |
| 7048 | IF(N+2*NP.GE.MSTU(4)-MSTU(32)-5) THEN |
| 7049 | CALL LUERRM(11,'(LUCLUS:) no more memory left in LUJETS') |
| 7050 | NJET=-1 |
| 7051 | RETURN |
| 7052 | ENDIF |
| 7053 | |
| 7054 | C...Take copy of these particles, with space left for jets later on. |
| 7055 | NP=NP+1 |
| 7056 | K(N+NP,3)=I |
| 7057 | DO 120 J=1,5 |
| 7058 | 120 P(N+NP,J)=P(I,J) |
| 7059 | IF(MSTU(42).EQ.0) P(N+NP,5)=0. |
| 7060 | IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) P(N+NP,5)=PMAS(101,1) |
| 7061 | P(N+NP,4)=SQRT(P(N+NP,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) |
| 7062 | P(N+NP,5)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2) |
| 7063 | DO 130 J=1,4 |
| 7064 | 130 PS(J)=PS(J)+P(N+NP,J) |
| 7065 | PSS=PSS+P(N+NP,5) |
| 7066 | 140 CONTINUE |
| 7067 | DO 150 I=N+1,N+NP |
| 7068 | K(I+NP,3)=K(I,3) |
| 7069 | DO 150 J=1,5 |
| 7070 | 150 P(I+NP,J)=P(I,J) |
| 7071 | PS(5)=SQRT(MAX(0.,PS(4)**2-PS(1)**2-PS(2)**2-PS(3)**2)) |
| 7072 | |
| 7073 | C...Very low multiplicities not considered. |
| 7074 | IF(NP.LT.MSTU(47)) THEN |
| 7075 | CALL LUERRM(8,'(LUCLUS:) too few particles for analysis') |
| 7076 | NJET=-1 |
| 7077 | RETURN |
| 7078 | ENDIF |
| 7079 | |
| 7080 | C...Find precluster configuration. If too few jets, make harder cuts. |
| 7081 | NLOOP=0 |
| 7082 | IF(MSTU(46).LE.3) R2ACC=PARU(44)**2 |
| 7083 | IF(MSTU(46).GE.4) R2ACC=PARU(45)*PS(5)**2 |
| 7084 | RINIT=1.25*PARU(43) |
| 7085 | IF(NP.LE.MSTU(47)+2) RINIT=0. |
| 7086 | 160 RINIT=0.8*RINIT |
| 7087 | NPRE=0 |
| 7088 | NREM=NP |
| 7089 | DO 170 I=N+NP+1,N+2*NP |
| 7090 | 170 K(I,4)=0 |
| 7091 | |
| 7092 | C...Sum up small momentum region. Jet if enough absolute momentum. |
| 7093 | IF(MSTU(46).LE.2) THEN |
| 7094 | DO 180 J=1,4 |
| 7095 | 180 P(N+1,J)=0. |
| 7096 | DO 200 I=N+NP+1,N+2*NP |
| 7097 | IF(P(I,5).GT.2.*RINIT) GOTO 200 |
| 7098 | NREM=NREM-1 |
| 7099 | K(I,4)=1 |
| 7100 | DO 190 J=1,4 |
| 7101 | 190 P(N+1,J)=P(N+1,J)+P(I,J) |
| 7102 | 200 CONTINUE |
| 7103 | P(N+1,5)=SQRT(P(N+1,1)**2+P(N+1,2)**2+P(N+1,3)**2) |
| 7104 | IF(P(N+1,5).GT.2.*RINIT) NPRE=1 |
| 7105 | IF(RINIT.GE.0.2*PARU(43).AND.NPRE+NREM.LT.MSTU(47)) GOTO 160 |
| 7106 | IF(NREM.EQ.0) GOTO 160 |
| 7107 | ENDIF |
| 7108 | |
| 7109 | C...Find fastest remaining particle. |
| 7110 | 210 NPRE=NPRE+1 |
| 7111 | PMAX=0. |
| 7112 | DO 220 I=N+NP+1,N+2*NP |
| 7113 | IF(K(I,4).NE.0.OR.P(I,5).LE.PMAX) GOTO 220 |
| 7114 | IMAX=I |
| 7115 | PMAX=P(I,5) |
| 7116 | 220 CONTINUE |
| 7117 | DO 230 J=1,5 |
| 7118 | 230 P(N+NPRE,J)=P(IMAX,J) |
| 7119 | NREM=NREM-1 |
| 7120 | K(IMAX,4)=NPRE |
| 7121 | |
| 7122 | C...Sum up precluster around it according to pT separation. |
| 7123 | IF(MSTU(46).LE.2) THEN |
| 7124 | DO 250 I=N+NP+1,N+2*NP |
| 7125 | IF(K(I,4).NE.0) GOTO 250 |
| 7126 | R2=R2T(I,IMAX) |
| 7127 | IF(R2.GT.RINIT**2) GOTO 250 |
| 7128 | NREM=NREM-1 |
| 7129 | K(I,4)=NPRE |
| 7130 | DO 240 J=1,4 |
| 7131 | 240 P(N+NPRE,J)=P(N+NPRE,J)+P(I,J) |
| 7132 | 250 CONTINUE |
| 7133 | P(N+NPRE,5)=SQRT(P(N+NPRE,1)**2+P(N+NPRE,2)**2+P(N+NPRE,3)**2) |
| 7134 | |
| 7135 | C...Sum up precluster around it according to mass separation. |
| 7136 | ELSE |
| 7137 | 260 IMIN=0 |
| 7138 | R2MIN=RINIT**2 |
| 7139 | DO 270 I=N+NP+1,N+2*NP |
| 7140 | IF(K(I,4).NE.0) GOTO 270 |
| 7141 | R2=R2M(I,N+NPRE) |
| 7142 | IF(R2.GE.R2MIN) GOTO 270 |
| 7143 | IMIN=I |
| 7144 | R2MIN=R2 |
| 7145 | 270 CONTINUE |
| 7146 | IF(IMIN.NE.0) THEN |
| 7147 | DO 280 J=1,4 |
| 7148 | 280 P(N+NPRE,J)=P(N+NPRE,J)+P(IMIN,J) |
| 7149 | P(N+NPRE,5)=SQRT(P(N+NPRE,1)**2+P(N+NPRE,2)**2+P(N+NPRE,3)**2) |
| 7150 | NREM=NREM-1 |
| 7151 | K(IMIN,4)=NPRE |
| 7152 | GOTO 260 |
| 7153 | ENDIF |
| 7154 | ENDIF |
| 7155 | |
| 7156 | C...Check if more preclusters to be found. Start over if too few. |
| 7157 | IF(RINIT.GE.0.2*PARU(43).AND.NPRE+NREM.LT.MSTU(47)) GOTO 160 |
| 7158 | IF(NREM.GT.0) GOTO 210 |
| 7159 | NJET=NPRE |
| 7160 | |
| 7161 | C...Reassign all particles to nearest jet. Sum up new jet momenta. |
| 7162 | 290 TSAV=0. |
| 7163 | PSJT=0. |
| 7164 | 300 IF(MSTU(46).LE.1) THEN |
| 7165 | DO 310 I=N+1,N+NJET |
| 7166 | DO 310 J=1,4 |
| 7167 | 310 V(I,J)=0. |
| 7168 | DO 340 I=N+NP+1,N+2*NP |
| 7169 | R2MIN=PSS**2 |
| 7170 | DO 320 IJET=N+1,N+NJET |
| 7171 | IF(P(IJET,5).LT.RINIT) GOTO 320 |
| 7172 | R2=R2T(I,IJET) |
| 7173 | IF(R2.GE.R2MIN) GOTO 320 |
| 7174 | IMIN=IJET |
| 7175 | R2MIN=R2 |
| 7176 | 320 CONTINUE |
| 7177 | K(I,4)=IMIN-N |
| 7178 | DO 330 J=1,4 |
| 7179 | 330 V(IMIN,J)=V(IMIN,J)+P(I,J) |
| 7180 | 340 CONTINUE |
| 7181 | PSJT=0. |
| 7182 | DO 360 I=N+1,N+NJET |
| 7183 | DO 350 J=1,4 |
| 7184 | 350 P(I,J)=V(I,J) |
| 7185 | P(I,5)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2) |
| 7186 | 360 PSJT=PSJT+P(I,5) |
| 7187 | ENDIF |
| 7188 | |
| 7189 | C...Find two closest jets. |
| 7190 | R2MIN=2.*R2ACC |
| 7191 | DO 370 ITRY1=N+1,N+NJET-1 |
| 7192 | DO 370 ITRY2=ITRY1+1,N+NJET |
| 7193 | IF(MSTU(46).LE.2) R2=R2T(ITRY1,ITRY2) |
| 7194 | IF(MSTU(46).GE.3) R2=R2M(ITRY1,ITRY2) |
| 7195 | IF(R2.GE.R2MIN) GOTO 370 |
| 7196 | IMIN1=ITRY1 |
| 7197 | IMIN2=ITRY2 |
| 7198 | R2MIN=R2 |
| 7199 | 370 CONTINUE |
| 7200 | |
| 7201 | C...If allowed, join two closest jets and start over. |
| 7202 | IF(NJET.GT.MSTU(47).AND.R2MIN.LT.R2ACC) THEN |
| 7203 | IREC=MIN(IMIN1,IMIN2) |
| 7204 | IDEL=MAX(IMIN1,IMIN2) |
| 7205 | DO 380 J=1,4 |
| 7206 | 380 P(IREC,J)=P(IMIN1,J)+P(IMIN2,J) |
| 7207 | P(IREC,5)=SQRT(P(IREC,1)**2+P(IREC,2)**2+P(IREC,3)**2) |
| 7208 | DO 390 I=IDEL+1,N+NJET |
| 7209 | DO 390 J=1,5 |
| 7210 | 390 P(I-1,J)=P(I,J) |
| 7211 | IF(MSTU(46).GE.2) THEN |
| 7212 | DO 400 I=N+NP+1,N+2*NP |
| 7213 | IORI=N+K(I,4) |
| 7214 | IF(IORI.EQ.IDEL) K(I,4)=IREC-N |
| 7215 | 400 IF(IORI.GT.IDEL) K(I,4)=K(I,4)-1 |
| 7216 | ENDIF |
| 7217 | NJET=NJET-1 |
| 7218 | GOTO 290 |
| 7219 | |
| 7220 | C...Divide up broad jet if empty cluster in list of final ones. |
| 7221 | ELSEIF(NJET.EQ.MSTU(47).AND.MSTU(46).LE.1.AND.NLOOP.LE.2) THEN |
| 7222 | DO 410 I=N+1,N+NJET |
| 7223 | 410 K(I,5)=0 |
| 7224 | DO 420 I=N+NP+1,N+2*NP |
| 7225 | 420 K(N+K(I,4),5)=K(N+K(I,4),5)+1 |
| 7226 | IEMP=0 |
| 7227 | DO 430 I=N+1,N+NJET |
| 7228 | 430 IF(K(I,5).EQ.0) IEMP=I |
| 7229 | IF(IEMP.NE.0) THEN |
| 7230 | NLOOP=NLOOP+1 |
| 7231 | ISPL=0 |
| 7232 | R2MAX=0. |
| 7233 | DO 440 I=N+NP+1,N+2*NP |
| 7234 | IF(K(N+K(I,4),5).LE.1.OR.P(I,5).LT.RINIT) GOTO 440 |
| 7235 | IJET=N+K(I,4) |
| 7236 | R2=R2T(I,IJET) |
| 7237 | IF(R2.LE.R2MAX) GOTO 440 |
| 7238 | ISPL=I |
| 7239 | R2MAX=R2 |
| 7240 | 440 CONTINUE |
| 7241 | IF(ISPL.NE.0) THEN |
| 7242 | IJET=N+K(ISPL,4) |
| 7243 | DO 450 J=1,4 |
| 7244 | P(IEMP,J)=P(ISPL,J) |
| 7245 | 450 P(IJET,J)=P(IJET,J)-P(ISPL,J) |
| 7246 | P(IEMP,5)=P(ISPL,5) |
| 7247 | P(IJET,5)=SQRT(P(IJET,1)**2+P(IJET,2)**2+P(IJET,3)**2) |
| 7248 | IF(NLOOP.LE.2) GOTO 290 |
| 7249 | ENDIF |
| 7250 | ENDIF |
| 7251 | ENDIF |
| 7252 | |
| 7253 | C...If generalized thrust has not yet converged, continue iteration. |
| 7254 | IF(MSTU(46).LE.1.AND.NLOOP.LE.2.AND.PSJT/PSS.GT.TSAV+PARU(48)) |
| 7255 | &THEN |
| 7256 | TSAV=PSJT/PSS |
| 7257 | GOTO 300 |
| 7258 | ENDIF |
| 7259 | |
| 7260 | C...Reorder jets according to energy. |
| 7261 | DO 460 I=N+1,N+NJET |
| 7262 | DO 460 J=1,5 |
| 7263 | 460 V(I,J)=P(I,J) |
| 7264 | DO 490 INEW=N+1,N+NJET |
| 7265 | PEMAX=0. |
| 7266 | DO 470 ITRY=N+1,N+NJET |
| 7267 | IF(V(ITRY,4).LE.PEMAX) GOTO 470 |
| 7268 | IMAX=ITRY |
| 7269 | PEMAX=V(ITRY,4) |
| 7270 | 470 CONTINUE |
| 7271 | K(INEW,1)=31 |
| 7272 | K(INEW,2)=97 |
| 7273 | K(INEW,3)=INEW-N |
| 7274 | K(INEW,4)=0 |
| 7275 | DO 480 J=1,5 |
| 7276 | 480 P(INEW,J)=V(IMAX,J) |
| 7277 | V(IMAX,4)=-1. |
| 7278 | 490 K(IMAX,5)=INEW |
| 7279 | |
| 7280 | C...Clean up particle-jet assignments and jet information. |
| 7281 | DO 500 I=N+NP+1,N+2*NP |
| 7282 | IORI=K(N+K(I,4),5) |
| 7283 | K(I,4)=IORI-N |
| 7284 | IF(K(K(I,3),1).NE.3) K(K(I,3),4)=IORI-N |
| 7285 | K(IORI,4)=K(IORI,4)+1 |
| 7286 | 500 CONTINUE |
| 7287 | IEMP=0 |
| 7288 | PSJT=0. |
| 7289 | DO 520 I=N+1,N+NJET |
| 7290 | K(I,5)=0 |
| 7291 | PSJT=PSJT+P(I,5) |
| 7292 | P(I,5)=SQRT(MAX(P(I,4)**2-P(I,5)**2,0.)) |
| 7293 | DO 510 J=1,5 |
| 7294 | 510 V(I,J)=0. |
| 7295 | 520 IF(K(I,4).EQ.0) IEMP=I |
| 7296 | |
| 7297 | C...Select storing option. Output variables. Check for failure. |
| 7298 | MSTU(61)=N+1 |
| 7299 | MSTU(62)=NP |
| 7300 | MSTU(63)=NPRE |
| 7301 | PARU(61)=PS(5) |
| 7302 | PARU(62)=PSJT/PSS |
| 7303 | PARU(63)=SQRT(R2MIN) |
| 7304 | IF(NJET.LE.1) PARU(63)=0. |
| 7305 | IF(IEMP.NE.0) THEN |
| 7306 | CALL LUERRM(8,'(LUCLUS:) failed to reconstruct as requested') |
| 7307 | NJET=-1 |
| 7308 | ENDIF |
| 7309 | IF(MSTU(43).LE.1) MSTU(3)=NJET |
| 7310 | IF(MSTU(43).GE.2) N=N+NJET |
| 7311 | NSAV=NJET |
| 7312 | |
| 7313 | RETURN |
| 7314 | END |
| 7315 | |
| 7316 | C********************************************************************* |
| 7317 | |
| 7318 | SUBROUTINE LUCELL(NJET) |
| 7319 | |
| 7320 | C...Purpose: to provide a simple way of jet finding in an eta-phi-ET |
| 7321 | C...coordinate frame, as used for calorimeters at hadron colliders. |
| 7322 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 7323 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 7324 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 7325 | SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ |
| 7326 | |
| 7327 | C...Loop over all particles. Find cell that was hit by given particle. |
| 7328 | PTLRAT=1./SINH(PARU(51))**2 |
| 7329 | NP=0 |
| 7330 | NC=N |
| 7331 | DO 110 I=1,N |
| 7332 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 110 |
| 7333 | IF(P(I,1)**2+P(I,2)**2.LE.PTLRAT*P(I,3)**2) GOTO 110 |
| 7334 | IF(MSTU(41).GE.2) THEN |
| 7335 | KC=LUCOMP(K(I,2)) |
| 7336 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. |
| 7337 | & KC.EQ.18) GOTO 110 |
| 7338 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) |
| 7339 | & GOTO 110 |
| 7340 | ENDIF |
| 7341 | NP=NP+1 |
| 7342 | PT=SQRT(P(I,1)**2+P(I,2)**2) |
| 7343 | ETA=SIGN(LOG((SQRT(PT**2+P(I,3)**2)+ABS(P(I,3)))/PT),P(I,3)) |
| 7344 | IETA=MAX(1,MIN(MSTU(51),1+INT(MSTU(51)*0.5*(ETA/PARU(51)+1.)))) |
| 7345 | PHI=ULANGL(P(I,1),P(I,2)) |
| 7346 | IPHI=MAX(1,MIN(MSTU(52),1+INT(MSTU(52)*0.5*(PHI/PARU(1)+1.)))) |
| 7347 | IETPH=MSTU(52)*IETA+IPHI |
| 7348 | |
| 7349 | C...Add to cell already hit, or book new cell. |
| 7350 | DO 100 IC=N+1,NC |
| 7351 | IF(IETPH.EQ.K(IC,3)) THEN |
| 7352 | K(IC,4)=K(IC,4)+1 |
| 7353 | P(IC,5)=P(IC,5)+PT |
| 7354 | GOTO 110 |
| 7355 | ENDIF |
| 7356 | 100 CONTINUE |
| 7357 | IF(NC.GE.MSTU(4)-MSTU(32)-5) THEN |
| 7358 | CALL LUERRM(11,'(LUCELL:) no more memory left in LUJETS') |
| 7359 | NJET=-2 |
| 7360 | RETURN |
| 7361 | ENDIF |
| 7362 | NC=NC+1 |
| 7363 | K(NC,3)=IETPH |
| 7364 | K(NC,4)=1 |
| 7365 | K(NC,5)=2 |
| 7366 | P(NC,1)=(PARU(51)/MSTU(51))*(2*IETA-1-MSTU(51)) |
| 7367 | P(NC,2)=(PARU(1)/MSTU(52))*(2*IPHI-1-MSTU(52)) |
| 7368 | P(NC,5)=PT |
| 7369 | 110 CONTINUE |
| 7370 | |
| 7371 | C...Smear true bin content by calorimeter resolution. |
| 7372 | IF(MSTU(53).GE.1) THEN |
| 7373 | DO 130 IC=N+1,NC |
| 7374 | PEI=P(IC,5) |
| 7375 | IF(MSTU(53).EQ.2) PEI=P(IC,5)/COSH(P(IC,1)) |
| 7376 | 120 PEF=PEI+PARU(55)*SQRT(-2.*LOG(MAX(1E-10,RLU(0)))*PEI)* |
| 7377 | & COS(PARU(2)*RLU(0)) |
| 7378 | IF(PEF.LT.0..OR.PEF.GT.PARU(56)*PEI) GOTO 120 |
| 7379 | P(IC,5)=PEF |
| 7380 | 130 IF(MSTU(53).EQ.2) P(IC,5)=PEF*COSH(P(IC,1)) |
| 7381 | ENDIF |
| 7382 | |
| 7383 | C...Find initiator cell: the one with highest pT of not yet used ones. |
| 7384 | NJ=NC |
| 7385 | 140 ETMAX=0. |
| 7386 | DO 150 IC=N+1,NC |
| 7387 | IF(K(IC,5).NE.2) GOTO 150 |
| 7388 | IF(P(IC,5).LE.ETMAX) GOTO 150 |
| 7389 | ICMAX=IC |
| 7390 | ETA=P(IC,1) |
| 7391 | PHI=P(IC,2) |
| 7392 | ETMAX=P(IC,5) |
| 7393 | 150 CONTINUE |
| 7394 | IF(ETMAX.LT.PARU(52)) GOTO 210 |
| 7395 | IF(NJ.GE.MSTU(4)-MSTU(32)-5) THEN |
| 7396 | CALL LUERRM(11,'(LUCELL:) no more memory left in LUJETS') |
| 7397 | NJET=-2 |
| 7398 | RETURN |
| 7399 | ENDIF |
| 7400 | K(ICMAX,5)=1 |
| 7401 | NJ=NJ+1 |
| 7402 | K(NJ,4)=0 |
| 7403 | K(NJ,5)=1 |
| 7404 | P(NJ,1)=ETA |
| 7405 | P(NJ,2)=PHI |
| 7406 | P(NJ,3)=0. |
| 7407 | P(NJ,4)=0. |
| 7408 | P(NJ,5)=0. |
| 7409 | |
| 7410 | C...Sum up unused cells within required distance of initiator. |
| 7411 | DO 160 IC=N+1,NC |
| 7412 | IF(K(IC,5).EQ.0) GOTO 160 |
| 7413 | IF(ABS(P(IC,1)-ETA).GT.PARU(54)) GOTO 160 |
| 7414 | DPHIA=ABS(P(IC,2)-PHI) |
| 7415 | IF(DPHIA.GT.PARU(54).AND.DPHIA.LT.PARU(2)-PARU(54)) GOTO 160 |
| 7416 | PHIC=P(IC,2) |
| 7417 | IF(DPHIA.GT.PARU(1)) PHIC=PHIC+SIGN(PARU(2),PHI) |
| 7418 | IF((P(IC,1)-ETA)**2+(PHIC-PHI)**2.GT.PARU(54)**2) GOTO 160 |
| 7419 | K(IC,5)=-K(IC,5) |
| 7420 | K(NJ,4)=K(NJ,4)+K(IC,4) |
| 7421 | P(NJ,3)=P(NJ,3)+P(IC,5)*P(IC,1) |
| 7422 | P(NJ,4)=P(NJ,4)+P(IC,5)*PHIC |
| 7423 | P(NJ,5)=P(NJ,5)+P(IC,5) |
| 7424 | 160 CONTINUE |
| 7425 | |
| 7426 | C...Reject cluster below minimum ET, else accept. |
| 7427 | IF(P(NJ,5).LT.PARU(53)) THEN |
| 7428 | NJ=NJ-1 |
| 7429 | DO 170 IC=N+1,NC |
| 7430 | 170 IF(K(IC,5).LT.0) K(IC,5)=-K(IC,5) |
| 7431 | ELSEIF(MSTU(54).LE.2) THEN |
| 7432 | P(NJ,3)=P(NJ,3)/P(NJ,5) |
| 7433 | P(NJ,4)=P(NJ,4)/P(NJ,5) |
| 7434 | IF(ABS(P(NJ,4)).GT.PARU(1)) P(NJ,4)=P(NJ,4)-SIGN(PARU(2), |
| 7435 | & P(NJ,4)) |
| 7436 | DO 180 IC=N+1,NC |
| 7437 | 180 IF(K(IC,5).LT.0) K(IC,5)=0 |
| 7438 | ELSE |
| 7439 | DO 190 J=1,4 |
| 7440 | 190 P(NJ,J)=0. |
| 7441 | DO 200 IC=N+1,NC |
| 7442 | IF(K(IC,5).GE.0) GOTO 200 |
| 7443 | P(NJ,1)=P(NJ,1)+P(IC,5)*COS(P(IC,2)) |
| 7444 | P(NJ,2)=P(NJ,2)+P(IC,5)*SIN(P(IC,2)) |
| 7445 | P(NJ,3)=P(NJ,3)+P(IC,5)*SINH(P(IC,1)) |
| 7446 | P(NJ,4)=P(NJ,4)+P(IC,5)*COSH(P(IC,1)) |
| 7447 | K(IC,5)=0 |
| 7448 | 200 CONTINUE |
| 7449 | ENDIF |
| 7450 | GOTO 140 |
| 7451 | |
| 7452 | C...Arrange clusters in falling ET sequence. |
| 7453 | 210 DO 230 I=1,NJ-NC |
| 7454 | ETMAX=0. |
| 7455 | DO 220 IJ=NC+1,NJ |
| 7456 | IF(K(IJ,5).EQ.0) GOTO 220 |
| 7457 | IF(P(IJ,5).LT.ETMAX) GOTO 220 |
| 7458 | IJMAX=IJ |
| 7459 | ETMAX=P(IJ,5) |
| 7460 | 220 CONTINUE |
| 7461 | K(IJMAX,5)=0 |
| 7462 | K(N+I,1)=31 |
| 7463 | K(N+I,2)=98 |
| 7464 | K(N+I,3)=I |
| 7465 | K(N+I,4)=K(IJMAX,4) |
| 7466 | K(N+I,5)=0 |
| 7467 | DO 230 J=1,5 |
| 7468 | P(N+I,J)=P(IJMAX,J) |
| 7469 | 230 V(N+I,J)=0. |
| 7470 | NJET=NJ-NC |
| 7471 | |
| 7472 | C...Convert to massless or massive four-vectors. |
| 7473 | IF(MSTU(54).EQ.2) THEN |
| 7474 | DO 240 I=N+1,N+NJET |
| 7475 | ETA=P(I,3) |
| 7476 | P(I,1)=P(I,5)*COS(P(I,4)) |
| 7477 | P(I,2)=P(I,5)*SIN(P(I,4)) |
| 7478 | P(I,3)=P(I,5)*SINH(ETA) |
| 7479 | P(I,4)=P(I,5)*COSH(ETA) |
| 7480 | 240 P(I,5)=0. |
| 7481 | ELSEIF(MSTU(54).GE.3) THEN |
| 7482 | DO 250 I=N+1,N+NJET |
| 7483 | 250 P(I,5)=SQRT(MAX(0.,P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2)) |
| 7484 | ENDIF |
| 7485 | |
| 7486 | C...Information about storage. |
| 7487 | MSTU(61)=N+1 |
| 7488 | MSTU(62)=NP |
| 7489 | MSTU(63)=NC-N |
| 7490 | IF(MSTU(43).LE.1) MSTU(3)=NJET |
| 7491 | IF(MSTU(43).GE.2) N=N+NJET |
| 7492 | |
| 7493 | RETURN |
| 7494 | END |
| 7495 | |
| 7496 | C********************************************************************* |
| 7497 | |
| 7498 | SUBROUTINE LUJMAS(PMH,PML) |
| 7499 | |
| 7500 | C...Purpose: to determine, approximately, the two jet masses that |
| 7501 | C...minimize the sum m_H^2 + m_L^2, a la Clavelli and Wyler. |
| 7502 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 7503 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 7504 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 7505 | SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ |
| 7506 | DIMENSION SM(3,3),SAX(3),PS(3,5) |
| 7507 | |
| 7508 | C...Reset. |
| 7509 | NP=0 |
| 7510 | DO 110 J1=1,3 |
| 7511 | DO 100 J2=J1,3 |
| 7512 | 100 SM(J1,J2)=0. |
| 7513 | DO 110 J2=1,4 |
| 7514 | 110 PS(J1,J2)=0. |
| 7515 | PSS=0. |
| 7516 | |
| 7517 | C...Take copy of particles that are to be considered in mass analysis. |
| 7518 | DO 150 I=1,N |
| 7519 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 150 |
| 7520 | IF(MSTU(41).GE.2) THEN |
| 7521 | KC=LUCOMP(K(I,2)) |
| 7522 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. |
| 7523 | & KC.EQ.18) GOTO 150 |
| 7524 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) |
| 7525 | & GOTO 150 |
| 7526 | ENDIF |
| 7527 | IF(N+NP+1.GE.MSTU(4)-MSTU(32)-5) THEN |
| 7528 | CALL LUERRM(11,'(LUJMAS:) no more memory left in LUJETS') |
| 7529 | PMH=-2. |
| 7530 | PML=-2. |
| 7531 | RETURN |
| 7532 | ENDIF |
| 7533 | NP=NP+1 |
| 7534 | DO 120 J=1,5 |
| 7535 | 120 P(N+NP,J)=P(I,J) |
| 7536 | IF(MSTU(42).EQ.0) P(N+NP,5)=0. |
| 7537 | IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) P(N+NP,5)=PMAS(101,1) |
| 7538 | P(N+NP,4)=SQRT(P(N+NP,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) |
| 7539 | |
| 7540 | C...Fill information in sphericity tensor and total momentum vector. |
| 7541 | DO 130 J1=1,3 |
| 7542 | DO 130 J2=J1,3 |
| 7543 | 130 SM(J1,J2)=SM(J1,J2)+P(I,J1)*P(I,J2) |
| 7544 | PSS=PSS+(P(I,1)**2+P(I,2)**2+P(I,3)**2) |
| 7545 | DO 140 J=1,4 |
| 7546 | 140 PS(3,J)=PS(3,J)+P(N+NP,J) |
| 7547 | 150 CONTINUE |
| 7548 | |
| 7549 | C...Very low multiplicities (0 or 1) not considered. |
| 7550 | IF(NP.LE.1) THEN |
| 7551 | CALL LUERRM(8,'(LUJMAS:) too few particles for analysis') |
| 7552 | PMH=-1. |
| 7553 | PML=-1. |
| 7554 | RETURN |
| 7555 | ENDIF |
| 7556 | PARU(61)=SQRT(MAX(0.,PS(3,4)**2-PS(3,1)**2-PS(3,2)**2-PS(3,3)**2)) |
| 7557 | |
| 7558 | C...Find largest eigenvalue to matrix (third degree equation). |
| 7559 | DO 160 J1=1,3 |
| 7560 | DO 160 J2=J1,3 |
| 7561 | 160 SM(J1,J2)=SM(J1,J2)/PSS |
| 7562 | SQ=(SM(1,1)*SM(2,2)+SM(1,1)*SM(3,3)+SM(2,2)*SM(3,3)-SM(1,2)**2- |
| 7563 | &SM(1,3)**2-SM(2,3)**2)/3.-1./9. |
| 7564 | SR=-0.5*(SQ+1./9.+SM(1,1)*SM(2,3)**2+SM(2,2)*SM(1,3)**2+SM(3,3)* |
| 7565 | &SM(1,2)**2-SM(1,1)*SM(2,2)*SM(3,3))+SM(1,2)*SM(1,3)*SM(2,3)+1./27. |
| 7566 | SP=COS(ACOS(MAX(MIN(SR/SQRT(-SQ**3),1.),-1.))/3.) |
| 7567 | SMA=1./3.+SQRT(-SQ)*MAX(2.*SP,SQRT(3.*(1.-SP**2))-SP) |
| 7568 | |
| 7569 | C...Find largest eigenvector by solving equation system. |
| 7570 | DO 170 J1=1,3 |
| 7571 | SM(J1,J1)=SM(J1,J1)-SMA |
| 7572 | DO 170 J2=J1+1,3 |
| 7573 | 170 SM(J2,J1)=SM(J1,J2) |
| 7574 | SMAX=0. |
| 7575 | DO 180 J1=1,3 |
| 7576 | DO 180 J2=1,3 |
| 7577 | IF(ABS(SM(J1,J2)).LE.SMAX) GOTO 180 |
| 7578 | JA=J1 |
| 7579 | JB=J2 |
| 7580 | SMAX=ABS(SM(J1,J2)) |
| 7581 | 180 CONTINUE |
| 7582 | SMAX=0. |
| 7583 | DO 190 J3=JA+1,JA+2 |
| 7584 | J1=J3-3*((J3-1)/3) |
| 7585 | RL=SM(J1,JB)/SM(JA,JB) |
| 7586 | DO 190 J2=1,3 |
| 7587 | SM(J1,J2)=SM(J1,J2)-RL*SM(JA,J2) |
| 7588 | IF(ABS(SM(J1,J2)).LE.SMAX) GOTO 190 |
| 7589 | JC=J1 |
| 7590 | SMAX=ABS(SM(J1,J2)) |
| 7591 | 190 CONTINUE |
| 7592 | JB1=JB+1-3*(JB/3) |
| 7593 | JB2=JB+2-3*((JB+1)/3) |
| 7594 | SAX(JB1)=-SM(JC,JB2) |
| 7595 | SAX(JB2)=SM(JC,JB1) |
| 7596 | SAX(JB)=-(SM(JA,JB1)*SAX(JB1)+SM(JA,JB2)*SAX(JB2))/SM(JA,JB) |
| 7597 | |
| 7598 | C...Divide particles into two initial clusters by hemisphere. |
| 7599 | DO 200 I=N+1,N+NP |
| 7600 | PSAX=P(I,1)*SAX(1)+P(I,2)*SAX(2)+P(I,3)*SAX(3) |
| 7601 | IS=1 |
| 7602 | IF(PSAX.LT.0.) IS=2 |
| 7603 | K(I,3)=IS |
| 7604 | DO 200 J=1,4 |
| 7605 | 200 PS(IS,J)=PS(IS,J)+P(I,J) |
| 7606 | PMS=MAX(1E-10,PS(1,4)**2-PS(1,1)**2-PS(1,2)**2-PS(1,3)**2)+ |
| 7607 | &MAX(1E-10,PS(2,4)**2-PS(2,1)**2-PS(2,2)**2-PS(2,3)**2) |
| 7608 | |
| 7609 | C...Reassign one particle at a time; find maximum decrease of m^2 sum. |
| 7610 | 210 PMD=0. |
| 7611 | IM=0 |
| 7612 | DO 220 J=1,4 |
| 7613 | 220 PS(3,J)=PS(1,J)-PS(2,J) |
| 7614 | DO 230 I=N+1,N+NP |
| 7615 | PPS=P(I,4)*PS(3,4)-P(I,1)*PS(3,1)-P(I,2)*PS(3,2)-P(I,3)*PS(3,3) |
| 7616 | IF(K(I,3).EQ.1) PMDI=2.*(P(I,5)**2-PPS) |
| 7617 | IF(K(I,3).EQ.2) PMDI=2.*(P(I,5)**2+PPS) |
| 7618 | IF(PMDI.LT.PMD) THEN |
| 7619 | PMD=PMDI |
| 7620 | IM=I |
| 7621 | ENDIF |
| 7622 | 230 CONTINUE |
| 7623 | |
| 7624 | C...Loop back if significant reduction in sum of m^2. |
| 7625 | IF(PMD.LT.-PARU(48)*PMS) THEN |
| 7626 | PMS=PMS+PMD |
| 7627 | IS=K(IM,3) |
| 7628 | DO 240 J=1,4 |
| 7629 | PS(IS,J)=PS(IS,J)-P(IM,J) |
| 7630 | 240 PS(3-IS,J)=PS(3-IS,J)+P(IM,J) |
| 7631 | K(IM,3)=3-IS |
| 7632 | GOTO 210 |
| 7633 | ENDIF |
| 7634 | |
| 7635 | C...Final masses and output. |
| 7636 | MSTU(61)=N+1 |
| 7637 | MSTU(62)=NP |
| 7638 | PS(1,5)=SQRT(MAX(0.,PS(1,4)**2-PS(1,1)**2-PS(1,2)**2-PS(1,3)**2)) |
| 7639 | PS(2,5)=SQRT(MAX(0.,PS(2,4)**2-PS(2,1)**2-PS(2,2)**2-PS(2,3)**2)) |
| 7640 | PMH=MAX(PS(1,5),PS(2,5)) |
| 7641 | PML=MIN(PS(1,5),PS(2,5)) |
| 7642 | |
| 7643 | RETURN |
| 7644 | END |
| 7645 | |
| 7646 | C********************************************************************* |
| 7647 | |
| 7648 | SUBROUTINE LUFOWO(H10,H20,H30,H40) |
| 7649 | |
| 7650 | C...Purpose: to calculate the first few Fox-Wolfram moments. |
| 7651 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 7652 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 7653 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 7654 | SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ |
| 7655 | |
| 7656 | C...Copy momenta for particles and calculate H0. |
| 7657 | NP=0 |
| 7658 | H0=0. |
| 7659 | HD=0. |
| 7660 | DO 110 I=1,N |
| 7661 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 110 |
| 7662 | IF(MSTU(41).GE.2) THEN |
| 7663 | KC=LUCOMP(K(I,2)) |
| 7664 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. |
| 7665 | & KC.EQ.18) GOTO 110 |
| 7666 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) |
| 7667 | & GOTO 110 |
| 7668 | ENDIF |
| 7669 | IF(N+NP.GE.MSTU(4)-MSTU(32)-5) THEN |
| 7670 | CALL LUERRM(11,'(LUFOWO:) no more memory left in LUJETS') |
| 7671 | H10=-1. |
| 7672 | H20=-1. |
| 7673 | H30=-1. |
| 7674 | H40=-1. |
| 7675 | RETURN |
| 7676 | ENDIF |
| 7677 | NP=NP+1 |
| 7678 | DO 100 J=1,3 |
| 7679 | 100 P(N+NP,J)=P(I,J) |
| 7680 | P(N+NP,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2) |
| 7681 | H0=H0+P(N+NP,4) |
| 7682 | HD=HD+P(N+NP,4)**2 |
| 7683 | 110 CONTINUE |
| 7684 | H0=H0**2 |
| 7685 | |
| 7686 | C...Very low multiplicities (0 or 1) not considered. |
| 7687 | IF(NP.LE.1) THEN |
| 7688 | CALL LUERRM(8,'(LUFOWO:) too few particles for analysis') |
| 7689 | H10=-1. |
| 7690 | H20=-1. |
| 7691 | H30=-1. |
| 7692 | H40=-1. |
| 7693 | RETURN |
| 7694 | ENDIF |
| 7695 | |
| 7696 | C...Calculate H1 - H4. |
| 7697 | H10=0. |
| 7698 | H20=0. |
| 7699 | H30=0. |
| 7700 | H40=0. |
| 7701 | DO 120 I1=N+1,N+NP |
| 7702 | DO 120 I2=I1+1,N+NP |
| 7703 | CTHE=(P(I1,1)*P(I2,1)+P(I1,2)*P(I2,2)+P(I1,3)*P(I2,3))/ |
| 7704 | &(P(I1,4)*P(I2,4)) |
| 7705 | H10=H10+P(I1,4)*P(I2,4)*CTHE |
| 7706 | H20=H20+P(I1,4)*P(I2,4)*(1.5*CTHE**2-0.5) |
| 7707 | H30=H30+P(I1,4)*P(I2,4)*(2.5*CTHE**3-1.5*CTHE) |
| 7708 | H40=H40+P(I1,4)*P(I2,4)*(4.375*CTHE**4-3.75*CTHE**2+0.375) |
| 7709 | 120 CONTINUE |
| 7710 | |
| 7711 | C...Calculate H1/H0 - H4/H0. Output. |
| 7712 | MSTU(61)=N+1 |
| 7713 | MSTU(62)=NP |
| 7714 | H10=(HD+2.*H10)/H0 |
| 7715 | H20=(HD+2.*H20)/H0 |
| 7716 | H30=(HD+2.*H30)/H0 |
| 7717 | H40=(HD+2.*H40)/H0 |
| 7718 | |
| 7719 | RETURN |
| 7720 | END |
| 7721 | |
| 7722 | C********************************************************************* |
| 7723 | |
| 7724 | SUBROUTINE LUTABU(MTABU) |
| 7725 | |
| 7726 | C...Purpose: to evaluate various properties of an event, with |
| 7727 | C...statistics accumulated during the course of the run and |
| 7728 | C...printed at the end. |
| 7729 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 7730 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 7731 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 7732 | COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) |
| 7733 | SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/ |
| 7734 | DIMENSION KFIS(100,2),NPIS(100,0:10),KFFS(400),NPFS(400,4), |
| 7735 | &FEVFM(10,4),FM1FM(3,10,4),FM2FM(3,10,4),FMOMA(4),FMOMS(4), |
| 7736 | &FEVEE(50),FE1EC(50),FE2EC(50),FE1EA(25),FE2EA(25), |
| 7737 | &KFDM(8),KFDC(200,0:8),NPDC(200) |
| 7738 | SAVE NEVIS,NKFIS,KFIS,NPIS,NEVFS,NPRFS,NFIFS,NCHFS,NKFFS, |
| 7739 | &KFFS,NPFS,NEVFM,NMUFM,FM1FM,FM2FM,NEVEE,FE1EC,FE2EC,FE1EA, |
| 7740 | &FE2EA,NEVDC,NKFDC,NREDC,KFDC,NPDC |
| 7741 | CHARACTER CHAU*16,CHIS(2)*12,CHDC(8)*12 |
| 7742 | DATA NEVIS/0/,NKFIS/0/,NEVFS/0/,NPRFS/0/,NFIFS/0/,NCHFS/0/, |
| 7743 | &NKFFS/0/,NEVFM/0/,NMUFM/0/,FM1FM/120*0./,FM2FM/120*0./, |
| 7744 | &NEVEE/0/,FE1EC/50*0./,FE2EC/50*0./,FE1EA/25*0./,FE2EA/25*0./, |
| 7745 | &NEVDC/0/,NKFDC/0/,NREDC/0/ |
| 7746 | |
| 7747 | C...Reset statistics on initial parton state. |
| 7748 | IF(MTABU.EQ.10) THEN |
| 7749 | NEVIS=0 |
| 7750 | NKFIS=0 |
| 7751 | |
| 7752 | C...Identify and order flavour content of initial state. |
| 7753 | ELSEIF(MTABU.EQ.11) THEN |
| 7754 | NEVIS=NEVIS+1 |
| 7755 | KFM1=2*IABS(MSTU(161)) |
| 7756 | IF(MSTU(161).GT.0) KFM1=KFM1-1 |
| 7757 | KFM2=2*IABS(MSTU(162)) |
| 7758 | IF(MSTU(162).GT.0) KFM2=KFM2-1 |
| 7759 | KFMN=MIN(KFM1,KFM2) |
| 7760 | KFMX=MAX(KFM1,KFM2) |
| 7761 | DO 100 I=1,NKFIS |
| 7762 | IF(KFMN.EQ.KFIS(I,1).AND.KFMX.EQ.KFIS(I,2)) THEN |
| 7763 | IKFIS=-I |
| 7764 | GOTO 110 |
| 7765 | ELSEIF(KFMN.LT.KFIS(I,1).OR.(KFMN.EQ.KFIS(I,1).AND. |
| 7766 | & KFMX.LT.KFIS(I,2))) THEN |
| 7767 | IKFIS=I |
| 7768 | GOTO 110 |
| 7769 | ENDIF |
| 7770 | 100 CONTINUE |
| 7771 | IKFIS=NKFIS+1 |
| 7772 | 110 IF(IKFIS.LT.0) THEN |
| 7773 | IKFIS=-IKFIS |
| 7774 | ELSE |
| 7775 | IF(NKFIS.GE.100) RETURN |
| 7776 | DO 120 I=NKFIS,IKFIS,-1 |
| 7777 | KFIS(I+1,1)=KFIS(I,1) |
| 7778 | KFIS(I+1,2)=KFIS(I,2) |
| 7779 | DO 120 J=0,10 |
| 7780 | 120 NPIS(I+1,J)=NPIS(I,J) |
| 7781 | NKFIS=NKFIS+1 |
| 7782 | KFIS(IKFIS,1)=KFMN |
| 7783 | KFIS(IKFIS,2)=KFMX |
| 7784 | DO 130 J=0,10 |
| 7785 | 130 NPIS(IKFIS,J)=0 |
| 7786 | ENDIF |
| 7787 | NPIS(IKFIS,0)=NPIS(IKFIS,0)+1 |
| 7788 | |
| 7789 | C...Count number of partons in initial state. |
| 7790 | NP=0 |
| 7791 | DO 150 I=1,N |
| 7792 | IF(K(I,1).LE.0.OR.K(I,1).GT.12) THEN |
| 7793 | ELSEIF(IABS(K(I,2)).GT.80.AND.IABS(K(I,2)).LE.100) THEN |
| 7794 | ELSEIF(IABS(K(I,2)).GT.100.AND.MOD(IABS(K(I,2))/10,10).NE.0) |
| 7795 | & THEN |
| 7796 | ELSE |
| 7797 | IM=I |
| 7798 | 140 IM=K(IM,3) |
| 7799 | IF(IM.LE.0.OR.IM.GT.N) THEN |
| 7800 | NP=NP+1 |
| 7801 | ELSEIF(K(IM,1).LE.0.OR.K(IM,1).GT.20) THEN |
| 7802 | NP=NP+1 |
| 7803 | ELSEIF(IABS(K(IM,2)).GT.80.AND.IABS(K(IM,2)).LE.100) THEN |
| 7804 | ELSEIF(IABS(K(IM,2)).GT.100.AND.MOD(IABS(K(IM,2))/10,10).NE.0) |
| 7805 | & THEN |
| 7806 | ELSE |
| 7807 | GOTO 140 |
| 7808 | ENDIF |
| 7809 | ENDIF |
| 7810 | 150 CONTINUE |
| 7811 | NPCO=MAX(NP,1) |
| 7812 | IF(NP.GE.6) NPCO=6 |
| 7813 | IF(NP.GE.8) NPCO=7 |
| 7814 | IF(NP.GE.11) NPCO=8 |
| 7815 | IF(NP.GE.16) NPCO=9 |
| 7816 | IF(NP.GE.26) NPCO=10 |
| 7817 | NPIS(IKFIS,NPCO)=NPIS(IKFIS,NPCO)+1 |
| 7818 | MSTU(62)=NP |
| 7819 | |
| 7820 | C...Write statistics on initial parton state. |
| 7821 | ELSEIF(MTABU.EQ.12) THEN |
| 7822 | FAC=1./MAX(1,NEVIS) |
| 7823 | WRITE(MSTU(11),5000) NEVIS |
| 7824 | DO 160 I=1,NKFIS |
| 7825 | KFMN=KFIS(I,1) |
| 7826 | IF(KFMN.EQ.0) KFMN=KFIS(I,2) |
| 7827 | KFM1=(KFMN+1)/2 |
| 7828 | IF(2*KFM1.EQ.KFMN) KFM1=-KFM1 |
| 7829 | CALL LUNAME(KFM1,CHAU) |
| 7830 | CHIS(1)=CHAU(1:12) |
| 7831 | IF(CHAU(13:13).NE.' ') CHIS(1)(12:12)='?' |
| 7832 | KFMX=KFIS(I,2) |
| 7833 | IF(KFIS(I,1).EQ.0) KFMX=0 |
| 7834 | KFM2=(KFMX+1)/2 |
| 7835 | IF(2*KFM2.EQ.KFMX) KFM2=-KFM2 |
| 7836 | CALL LUNAME(KFM2,CHAU) |
| 7837 | CHIS(2)=CHAU(1:12) |
| 7838 | IF(CHAU(13:13).NE.' ') CHIS(2)(12:12)='?' |
| 7839 | 160 WRITE(MSTU(11),5100) CHIS(1),CHIS(2),FAC*NPIS(I,0), |
| 7840 | & (NPIS(I,J)/FLOAT(NPIS(I,0)),J=1,10) |
| 7841 | |
| 7842 | C...Copy statistics on initial parton state into /LUJETS/. |
| 7843 | ELSEIF(MTABU.EQ.13) THEN |
| 7844 | FAC=1./MAX(1,NEVIS) |
| 7845 | DO 170 I=1,NKFIS |
| 7846 | KFMN=KFIS(I,1) |
| 7847 | IF(KFMN.EQ.0) KFMN=KFIS(I,2) |
| 7848 | KFM1=(KFMN+1)/2 |
| 7849 | IF(2*KFM1.EQ.KFMN) KFM1=-KFM1 |
| 7850 | KFMX=KFIS(I,2) |
| 7851 | IF(KFIS(I,1).EQ.0) KFMX=0 |
| 7852 | KFM2=(KFMX+1)/2 |
| 7853 | IF(2*KFM2.EQ.KFMX) KFM2=-KFM2 |
| 7854 | K(I,1)=32 |
| 7855 | K(I,2)=99 |
| 7856 | K(I,3)=KFM1 |
| 7857 | K(I,4)=KFM2 |
| 7858 | K(I,5)=NPIS(I,0) |
| 7859 | DO 170 J=1,5 |
| 7860 | P(I,J)=FAC*NPIS(I,J) |
| 7861 | 170 V(I,J)=FAC*NPIS(I,J+5) |
| 7862 | N=NKFIS |
| 7863 | DO 180 J=1,5 |
| 7864 | K(N+1,J)=0 |
| 7865 | P(N+1,J)=0. |
| 7866 | 180 V(N+1,J)=0. |
| 7867 | K(N+1,1)=32 |
| 7868 | K(N+1,2)=99 |
| 7869 | K(N+1,5)=NEVIS |
| 7870 | MSTU(3)=1 |
| 7871 | |
| 7872 | C...Reset statistics on number of particles/partons. |
| 7873 | ELSEIF(MTABU.EQ.20) THEN |
| 7874 | NEVFS=0 |
| 7875 | NPRFS=0 |
| 7876 | NFIFS=0 |
| 7877 | NCHFS=0 |
| 7878 | NKFFS=0 |
| 7879 | |
| 7880 | C...Identify whether particle/parton is primary or not. |
| 7881 | ELSEIF(MTABU.EQ.21) THEN |
| 7882 | NEVFS=NEVFS+1 |
| 7883 | MSTU(62)=0 |
| 7884 | DO 230 I=1,N |
| 7885 | IF(K(I,1).LE.0.OR.K(I,1).GT.20.OR.K(I,1).EQ.13) GOTO 230 |
| 7886 | MSTU(62)=MSTU(62)+1 |
| 7887 | KC=LUCOMP(K(I,2)) |
| 7888 | MPRI=0 |
| 7889 | IF(K(I,3).LE.0.OR.K(I,3).GT.N) THEN |
| 7890 | MPRI=1 |
| 7891 | ELSEIF(K(K(I,3),1).LE.0.OR.K(K(I,3),1).GT.20) THEN |
| 7892 | MPRI=1 |
| 7893 | ELSEIF(K(K(I,3),2).GE.91.AND.K(K(I,3),2).LE.93) THEN |
| 7894 | MPRI=1 |
| 7895 | ELSEIF(KC.EQ.0) THEN |
| 7896 | ELSEIF(K(K(I,3),1).EQ.13) THEN |
| 7897 | IM=K(K(I,3),3) |
| 7898 | IF(IM.LE.0.OR.IM.GT.N) THEN |
| 7899 | MPRI=1 |
| 7900 | ELSEIF(K(IM,1).LE.0.OR.K(IM,1).GT.20) THEN |
| 7901 | MPRI=1 |
| 7902 | ENDIF |
| 7903 | ELSEIF(KCHG(KC,2).EQ.0) THEN |
| 7904 | KCM=LUCOMP(K(K(I,3),2)) |
| 7905 | IF(KCM.NE.0) THEN |
| 7906 | IF(KCHG(KCM,2).NE.0) MPRI=1 |
| 7907 | ENDIF |
| 7908 | ENDIF |
| 7909 | IF(KC.NE.0.AND.MPRI.EQ.1) THEN |
| 7910 | IF(KCHG(KC,2).EQ.0) NPRFS=NPRFS+1 |
| 7911 | ENDIF |
| 7912 | IF(K(I,1).LE.10) THEN |
| 7913 | NFIFS=NFIFS+1 |
| 7914 | IF(LUCHGE(K(I,2)).NE.0) NCHFS=NCHFS+1 |
| 7915 | ENDIF |
| 7916 | |
| 7917 | C...Fill statistics on number of particles/partons in event. |
| 7918 | KFA=IABS(K(I,2)) |
| 7919 | KFS=3-ISIGN(1,K(I,2))-MPRI |
| 7920 | DO 190 IP=1,NKFFS |
| 7921 | IF(KFA.EQ.KFFS(IP)) THEN |
| 7922 | IKFFS=-IP |
| 7923 | GOTO 200 |
| 7924 | ELSEIF(KFA.LT.KFFS(IP)) THEN |
| 7925 | IKFFS=IP |
| 7926 | GOTO 200 |
| 7927 | ENDIF |
| 7928 | 190 CONTINUE |
| 7929 | IKFFS=NKFFS+1 |
| 7930 | 200 IF(IKFFS.LT.0) THEN |
| 7931 | IKFFS=-IKFFS |
| 7932 | ELSE |
| 7933 | IF(NKFFS.GE.400) RETURN |
| 7934 | DO 210 IP=NKFFS,IKFFS,-1 |
| 7935 | KFFS(IP+1)=KFFS(IP) |
| 7936 | DO 210 J=1,4 |
| 7937 | 210 NPFS(IP+1,J)=NPFS(IP,J) |
| 7938 | NKFFS=NKFFS+1 |
| 7939 | KFFS(IKFFS)=KFA |
| 7940 | DO 220 J=1,4 |
| 7941 | 220 NPFS(IKFFS,J)=0 |
| 7942 | ENDIF |
| 7943 | NPFS(IKFFS,KFS)=NPFS(IKFFS,KFS)+1 |
| 7944 | 230 CONTINUE |
| 7945 | |
| 7946 | C...Write statistics on particle/parton composition of events. |
| 7947 | ELSEIF(MTABU.EQ.22) THEN |
| 7948 | FAC=1./MAX(1,NEVFS) |
| 7949 | WRITE(MSTU(11),5200) NEVFS,FAC*NPRFS,FAC*NFIFS,FAC*NCHFS |
| 7950 | DO 240 I=1,NKFFS |
| 7951 | CALL LUNAME(KFFS(I),CHAU) |
| 7952 | KC=LUCOMP(KFFS(I)) |
| 7953 | MDCYF=0 |
| 7954 | IF(KC.NE.0) MDCYF=MDCY(KC,1) |
| 7955 | 240 WRITE(MSTU(11),5300) KFFS(I),CHAU,MDCYF,(FAC*NPFS(I,J),J=1,4), |
| 7956 | & FAC*(NPFS(I,1)+NPFS(I,2)+NPFS(I,3)+NPFS(I,4)) |
| 7957 | |
| 7958 | C...Copy particle/parton composition information into /LUJETS/. |
| 7959 | ELSEIF(MTABU.EQ.23) THEN |
| 7960 | FAC=1./MAX(1,NEVFS) |
| 7961 | DO 260 I=1,NKFFS |
| 7962 | K(I,1)=32 |
| 7963 | K(I,2)=99 |
| 7964 | K(I,3)=KFFS(I) |
| 7965 | K(I,4)=0 |
| 7966 | K(I,5)=NPFS(I,1)+NPFS(I,2)+NPFS(I,3)+NPFS(I,4) |
| 7967 | DO 250 J=1,4 |
| 7968 | P(I,J)=FAC*NPFS(I,J) |
| 7969 | 250 V(I,J)=0. |
| 7970 | P(I,5)=FAC*K(I,5) |
| 7971 | 260 V(I,5)=0. |
| 7972 | N=NKFFS |
| 7973 | DO 270 J=1,5 |
| 7974 | K(N+1,J)=0 |
| 7975 | P(N+1,J)=0. |
| 7976 | 270 V(N+1,J)=0. |
| 7977 | K(N+1,1)=32 |
| 7978 | K(N+1,2)=99 |
| 7979 | K(N+1,5)=NEVFS |
| 7980 | P(N+1,1)=FAC*NPRFS |
| 7981 | P(N+1,2)=FAC*NFIFS |
| 7982 | P(N+1,3)=FAC*NCHFS |
| 7983 | MSTU(3)=1 |
| 7984 | |
| 7985 | C...Reset factorial moments statistics. |
| 7986 | ELSEIF(MTABU.EQ.30) THEN |
| 7987 | NEVFM=0 |
| 7988 | NMUFM=0 |
| 7989 | DO 280 IM=1,3 |
| 7990 | DO 280 IB=1,10 |
| 7991 | DO 280 IP=1,4 |
| 7992 | FM1FM(IM,IB,IP)=0. |
| 7993 | 280 FM2FM(IM,IB,IP)=0. |
| 7994 | |
| 7995 | C...Find particles to include, with (pion,pseudo)rapidity and azimuth. |
| 7996 | ELSEIF(MTABU.EQ.31) THEN |
| 7997 | NEVFM=NEVFM+1 |
| 7998 | NLOW=N+MSTU(3) |
| 7999 | NUPP=NLOW |
| 8000 | DO 360 I=1,N |
| 8001 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 360 |
| 8002 | IF(MSTU(41).GE.2) THEN |
| 8003 | KC=LUCOMP(K(I,2)) |
| 8004 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. |
| 8005 | & KC.EQ.18) GOTO 360 |
| 8006 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) |
| 8007 | & GOTO 360 |
| 8008 | ENDIF |
| 8009 | PMR=0. |
| 8010 | IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) PMR=ULMASS(211) |
| 8011 | IF(MSTU(42).GE.2) PMR=P(I,5) |
| 8012 | PR=MAX(1E-20,PMR**2+P(I,1)**2+P(I,2)**2) |
| 8013 | YETA=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/SQRT(PR), |
| 8014 | & 1E20)),P(I,3)) |
| 8015 | IF(ABS(YETA).GT.PARU(57)) GOTO 360 |
| 8016 | PHI=ULANGL(P(I,1),P(I,2)) |
| 8017 | IYETA=512.*(YETA+PARU(57))/(2.*PARU(57)) |
| 8018 | IYETA=MAX(0,MIN(511,IYETA)) |
| 8019 | IPHI=512.*(PHI+PARU(1))/PARU(2) |
| 8020 | IPHI=MAX(0,MIN(511,IPHI)) |
| 8021 | IYEP=0 |
| 8022 | DO 290 IB=0,9 |
| 8023 | 290 IYEP=IYEP+4**IB*(2*MOD(IYETA/2**IB,2)+MOD(IPHI/2**IB,2)) |
| 8024 | |
| 8025 | C...Order particles in (pseudo)rapidity and/or azimuth. |
| 8026 | IF(NUPP.GT.MSTU(4)-5-MSTU(32)) THEN |
| 8027 | CALL LUERRM(11,'(LUTABU:) no more memory left in LUJETS') |
| 8028 | RETURN |
| 8029 | ENDIF |
| 8030 | NUPP=NUPP+1 |
| 8031 | IF(NUPP.EQ.NLOW+1) THEN |
| 8032 | K(NUPP,1)=IYETA |
| 8033 | K(NUPP,2)=IPHI |
| 8034 | K(NUPP,3)=IYEP |
| 8035 | ELSE |
| 8036 | DO 300 I1=NUPP-1,NLOW+1,-1 |
| 8037 | IF(IYETA.GE.K(I1,1)) GOTO 310 |
| 8038 | 300 K(I1+1,1)=K(I1,1) |
| 8039 | 310 K(I1+1,1)=IYETA |
| 8040 | DO 320 I1=NUPP-1,NLOW+1,-1 |
| 8041 | IF(IPHI.GE.K(I1,2)) GOTO 330 |
| 8042 | 320 K(I1+1,2)=K(I1,2) |
| 8043 | 330 K(I1+1,2)=IPHI |
| 8044 | DO 340 I1=NUPP-1,NLOW+1,-1 |
| 8045 | IF(IYEP.GE.K(I1,3)) GOTO 350 |
| 8046 | 340 K(I1+1,3)=K(I1,3) |
| 8047 | 350 K(I1+1,3)=IYEP |
| 8048 | ENDIF |
| 8049 | 360 CONTINUE |
| 8050 | K(NUPP+1,1)=2**10 |
| 8051 | K(NUPP+1,2)=2**10 |
| 8052 | K(NUPP+1,3)=4**10 |
| 8053 | |
| 8054 | C...Calculate sum of factorial moments in event. |
| 8055 | DO 400 IM=1,3 |
| 8056 | DO 370 IB=1,10 |
| 8057 | DO 370 IP=1,4 |
| 8058 | 370 FEVFM(IB,IP)=0. |
| 8059 | DO 380 IB=1,10 |
| 8060 | IF(IM.LE.2) IBIN=2**(10-IB) |
| 8061 | IF(IM.EQ.3) IBIN=4**(10-IB) |
| 8062 | IAGR=K(NLOW+1,IM)/IBIN |
| 8063 | NAGR=1 |
| 8064 | DO 380 I=NLOW+2,NUPP+1 |
| 8065 | ICUT=K(I,IM)/IBIN |
| 8066 | IF(ICUT.EQ.IAGR) THEN |
| 8067 | NAGR=NAGR+1 |
| 8068 | ELSE |
| 8069 | IF(NAGR.EQ.1) THEN |
| 8070 | ELSEIF(NAGR.EQ.2) THEN |
| 8071 | FEVFM(IB,1)=FEVFM(IB,1)+2. |
| 8072 | ELSEIF(NAGR.EQ.3) THEN |
| 8073 | FEVFM(IB,1)=FEVFM(IB,1)+6. |
| 8074 | FEVFM(IB,2)=FEVFM(IB,2)+6. |
| 8075 | ELSEIF(NAGR.EQ.4) THEN |
| 8076 | FEVFM(IB,1)=FEVFM(IB,1)+12. |
| 8077 | FEVFM(IB,2)=FEVFM(IB,2)+24. |
| 8078 | FEVFM(IB,3)=FEVFM(IB,3)+24. |
| 8079 | ELSE |
| 8080 | FEVFM(IB,1)=FEVFM(IB,1)+NAGR*(NAGR-1.) |
| 8081 | FEVFM(IB,2)=FEVFM(IB,2)+NAGR*(NAGR-1.)*(NAGR-2.) |
| 8082 | FEVFM(IB,3)=FEVFM(IB,3)+NAGR*(NAGR-1.)*(NAGR-2.)*(NAGR-3.) |
| 8083 | FEVFM(IB,4)=FEVFM(IB,4)+NAGR*(NAGR-1.)*(NAGR-2.)*(NAGR-3.)* |
| 8084 | & (NAGR-4.) |
| 8085 | ENDIF |
| 8086 | IAGR=ICUT |
| 8087 | NAGR=1 |
| 8088 | ENDIF |
| 8089 | 380 CONTINUE |
| 8090 | |
| 8091 | C...Add results to total statistics. |
| 8092 | DO 390 IB=10,1,-1 |
| 8093 | DO 390 IP=1,4 |
| 8094 | IF(FEVFM(1,IP).LT.0.5) THEN |
| 8095 | FEVFM(IB,IP)=0. |
| 8096 | ELSEIF(IM.LE.2) THEN |
| 8097 | FEVFM(IB,IP)=2**((IB-1)*IP)*FEVFM(IB,IP)/FEVFM(1,IP) |
| 8098 | ELSE |
| 8099 | FEVFM(IB,IP)=4**((IB-1)*IP)*FEVFM(IB,IP)/FEVFM(1,IP) |
| 8100 | ENDIF |
| 8101 | FM1FM(IM,IB,IP)=FM1FM(IM,IB,IP)+FEVFM(IB,IP) |
| 8102 | 390 FM2FM(IM,IB,IP)=FM2FM(IM,IB,IP)+FEVFM(IB,IP)**2 |
| 8103 | 400 CONTINUE |
| 8104 | NMUFM=NMUFM+(NUPP-NLOW) |
| 8105 | MSTU(62)=NUPP-NLOW |
| 8106 | |
| 8107 | C...Write accumulated statistics on factorial moments. |
| 8108 | ELSEIF(MTABU.EQ.32) THEN |
| 8109 | FAC=1./MAX(1,NEVFM) |
| 8110 | IF(MSTU(42).LE.0) WRITE(MSTU(11),5400) NEVFM,'eta' |
| 8111 | IF(MSTU(42).EQ.1) WRITE(MSTU(11),5400) NEVFM,'ypi' |
| 8112 | IF(MSTU(42).GE.2) WRITE(MSTU(11),5400) NEVFM,'y ' |
| 8113 | DO 420 IM=1,3 |
| 8114 | WRITE(MSTU(11),5500) |
| 8115 | DO 420 IB=1,10 |
| 8116 | BYETA=2.*PARU(57) |
| 8117 | IF(IM.NE.2) BYETA=BYETA/2**(IB-1) |
| 8118 | BPHI=PARU(2) |
| 8119 | IF(IM.NE.1) BPHI=BPHI/2**(IB-1) |
| 8120 | IF(IM.LE.2) BNAVE=FAC*NMUFM/FLOAT(2**(IB-1)) |
| 8121 | IF(IM.EQ.3) BNAVE=FAC*NMUFM/FLOAT(4**(IB-1)) |
| 8122 | DO 410 IP=1,4 |
| 8123 | FMOMA(IP)=FAC*FM1FM(IM,IB,IP) |
| 8124 | 410 FMOMS(IP)=SQRT(MAX(0.,FAC*(FAC*FM2FM(IM,IB,IP)-FMOMA(IP)**2))) |
| 8125 | 420 WRITE(MSTU(11),5600) BYETA,BPHI,BNAVE,(FMOMA(IP),FMOMS(IP), |
| 8126 | & IP=1,4) |
| 8127 | |
| 8128 | C...Copy statistics on factorial moments into /LUJETS/. |
| 8129 | ELSEIF(MTABU.EQ.33) THEN |
| 8130 | FAC=1./MAX(1,NEVFM) |
| 8131 | DO 430 IM=1,3 |
| 8132 | DO 430 IB=1,10 |
| 8133 | I=10*(IM-1)+IB |
| 8134 | K(I,1)=32 |
| 8135 | K(I,2)=99 |
| 8136 | K(I,3)=1 |
| 8137 | IF(IM.NE.2) K(I,3)=2**(IB-1) |
| 8138 | K(I,4)=1 |
| 8139 | IF(IM.NE.1) K(I,4)=2**(IB-1) |
| 8140 | K(I,5)=0 |
| 8141 | P(I,1)=2.*PARU(57)/K(I,3) |
| 8142 | V(I,1)=PARU(2)/K(I,4) |
| 8143 | DO 430 IP=1,4 |
| 8144 | P(I,IP+1)=FAC*FM1FM(IM,IB,IP) |
| 8145 | 430 V(I,IP+1)=SQRT(MAX(0.,FAC*(FAC*FM2FM(IM,IB,IP)-P(I,IP+1)**2))) |
| 8146 | N=30 |
| 8147 | DO 440 J=1,5 |
| 8148 | K(N+1,J)=0 |
| 8149 | P(N+1,J)=0. |
| 8150 | 440 V(N+1,J)=0. |
| 8151 | K(N+1,1)=32 |
| 8152 | K(N+1,2)=99 |
| 8153 | K(N+1,5)=NEVFM |
| 8154 | MSTU(3)=1 |
| 8155 | |
| 8156 | C...Reset statistics on Energy-Energy Correlation. |
| 8157 | ELSEIF(MTABU.EQ.40) THEN |
| 8158 | NEVEE=0 |
| 8159 | DO 450 J=1,25 |
| 8160 | FE1EC(J)=0. |
| 8161 | FE2EC(J)=0. |
| 8162 | FE1EC(51-J)=0. |
| 8163 | FE2EC(51-J)=0. |
| 8164 | FE1EA(J)=0. |
| 8165 | 450 FE2EA(J)=0. |
| 8166 | |
| 8167 | C...Find particles to include, with proper assumed mass. |
| 8168 | ELSEIF(MTABU.EQ.41) THEN |
| 8169 | NEVEE=NEVEE+1 |
| 8170 | NLOW=N+MSTU(3) |
| 8171 | NUPP=NLOW |
| 8172 | ECM=0. |
| 8173 | DO 460 I=1,N |
| 8174 | IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 460 |
| 8175 | IF(MSTU(41).GE.2) THEN |
| 8176 | KC=LUCOMP(K(I,2)) |
| 8177 | IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR. |
| 8178 | & KC.EQ.18) GOTO 460 |
| 8179 | IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) |
| 8180 | & GOTO 460 |
| 8181 | ENDIF |
| 8182 | PMR=0. |
| 8183 | IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) PMR=ULMASS(211) |
| 8184 | IF(MSTU(42).GE.2) PMR=P(I,5) |
| 8185 | IF(NUPP.GT.MSTU(4)-5-MSTU(32)) THEN |
| 8186 | CALL LUERRM(11,'(LUTABU:) no more memory left in LUJETS') |
| 8187 | RETURN |
| 8188 | ENDIF |
| 8189 | NUPP=NUPP+1 |
| 8190 | P(NUPP,1)=P(I,1) |
| 8191 | P(NUPP,2)=P(I,2) |
| 8192 | P(NUPP,3)=P(I,3) |
| 8193 | P(NUPP,4)=SQRT(PMR**2+P(I,1)**2+P(I,2)**2+P(I,3)**2) |
| 8194 | P(NUPP,5)=MAX(1E-10,SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)) |
| 8195 | ECM=ECM+P(NUPP,4) |
| 8196 | 460 CONTINUE |
| 8197 | IF(NUPP.EQ.NLOW) RETURN |
| 8198 | |
| 8199 | C...Analyze Energy-Energy Correlation in event. |
| 8200 | FAC=(2./ECM**2)*50./PARU(1) |
| 8201 | DO 470 J=1,50 |
| 8202 | 470 FEVEE(J)=0. |
| 8203 | DO 480 I1=NLOW+2,NUPP |
| 8204 | DO 480 I2=NLOW+1,I1-1 |
| 8205 | CTHE=(P(I1,1)*P(I2,1)+P(I1,2)*P(I2,2)+P(I1,3)*P(I2,3))/ |
| 8206 | & (P(I1,5)*P(I2,5)) |
| 8207 | THE=ACOS(MAX(-1.,MIN(1.,CTHE))) |
| 8208 | ITHE=MAX(1,MIN(50,1+INT(50.*THE/PARU(1)))) |
| 8209 | 480 FEVEE(ITHE)=FEVEE(ITHE)+FAC*P(I1,4)*P(I2,4) |
| 8210 | DO 490 J=1,25 |
| 8211 | FE1EC(J)=FE1EC(J)+FEVEE(J) |
| 8212 | FE2EC(J)=FE2EC(J)+FEVEE(J)**2 |
| 8213 | FE1EC(51-J)=FE1EC(51-J)+FEVEE(51-J) |
| 8214 | FE2EC(51-J)=FE2EC(51-J)+FEVEE(51-J)**2 |
| 8215 | FE1EA(J)=FE1EA(J)+(FEVEE(51-J)-FEVEE(J)) |
| 8216 | 490 FE2EA(J)=FE2EA(J)+(FEVEE(51-J)-FEVEE(J))**2 |
| 8217 | MSTU(62)=NUPP-NLOW |
| 8218 | |
| 8219 | C...Write statistics on Energy-Energy Correlation. |
| 8220 | ELSEIF(MTABU.EQ.42) THEN |
| 8221 | FAC=1./MAX(1,NEVEE) |
| 8222 | WRITE(MSTU(11),5700) NEVEE |
| 8223 | DO 500 J=1,25 |
| 8224 | FEEC1=FAC*FE1EC(J) |
| 8225 | FEES1=SQRT(MAX(0.,FAC*(FAC*FE2EC(J)-FEEC1**2))) |
| 8226 | FEEC2=FAC*FE1EC(51-J) |
| 8227 | FEES2=SQRT(MAX(0.,FAC*(FAC*FE2EC(51-J)-FEEC2**2))) |
| 8228 | FEECA=FAC*FE1EA(J) |
| 8229 | FEESA=SQRT(MAX(0.,FAC*(FAC*FE2EA(J)-FEECA**2))) |
| 8230 | 500 WRITE(MSTU(11),5800) 3.6*(J-1),3.6*J,FEEC1,FEES1,FEEC2,FEES2, |
| 8231 | & FEECA,FEESA |
| 8232 | |
| 8233 | C...Copy statistics on Energy-Energy Correlation into /LUJETS/. |
| 8234 | ELSEIF(MTABU.EQ.43) THEN |
| 8235 | FAC=1./MAX(1,NEVEE) |
| 8236 | DO 510 I=1,25 |
| 8237 | K(I,1)=32 |
| 8238 | K(I,2)=99 |
| 8239 | K(I,3)=0 |
| 8240 | K(I,4)=0 |
| 8241 | K(I,5)=0 |
| 8242 | P(I,1)=FAC*FE1EC(I) |
| 8243 | V(I,1)=SQRT(MAX(0.,FAC*(FAC*FE2EC(I)-P(I,1)**2))) |
| 8244 | P(I,2)=FAC*FE1EC(51-I) |
| 8245 | V(I,2)=SQRT(MAX(0.,FAC*(FAC*FE2EC(51-I)-P(I,2)**2))) |
| 8246 | P(I,3)=FAC*FE1EA(I) |
| 8247 | V(I,3)=SQRT(MAX(0.,FAC*(FAC*FE2EA(I)-P(I,3)**2))) |
| 8248 | P(I,4)=PARU(1)*(I-1)/50. |
| 8249 | P(I,5)=PARU(1)*I/50. |
| 8250 | V(I,4)=3.6*(I-1) |
| 8251 | 510 V(I,5)=3.6*I |
| 8252 | N=25 |
| 8253 | DO 520 J=1,5 |
| 8254 | K(N+1,J)=0 |
| 8255 | P(N+1,J)=0. |
| 8256 | 520 V(N+1,J)=0. |
| 8257 | K(N+1,1)=32 |
| 8258 | K(N+1,2)=99 |
| 8259 | K(N+1,5)=NEVEE |
| 8260 | MSTU(3)=1 |
| 8261 | |
| 8262 | C...Reset statistics on decay channels. |
| 8263 | ELSEIF(MTABU.EQ.50) THEN |
| 8264 | NEVDC=0 |
| 8265 | NKFDC=0 |
| 8266 | NREDC=0 |
| 8267 | |
| 8268 | C...Identify and order flavour content of final state. |
| 8269 | ELSEIF(MTABU.EQ.51) THEN |
| 8270 | NEVDC=NEVDC+1 |
| 8271 | NDS=0 |
| 8272 | DO 550 I=1,N |
| 8273 | IF(K(I,1).LE.0.OR.K(I,1).GE.6) GOTO 550 |
| 8274 | NDS=NDS+1 |
| 8275 | IF(NDS.GT.8) THEN |
| 8276 | NREDC=NREDC+1 |
| 8277 | RETURN |
| 8278 | ENDIF |
| 8279 | KFM=2*IABS(K(I,2)) |
| 8280 | IF(K(I,2).LT.0) KFM=KFM-1 |
| 8281 | DO 530 IDS=NDS-1,1,-1 |
| 8282 | IIN=IDS+1 |
| 8283 | IF(KFM.LT.KFDM(IDS)) GOTO 540 |
| 8284 | 530 KFDM(IDS+1)=KFDM(IDS) |
| 8285 | IIN=1 |
| 8286 | 540 KFDM(IIN)=KFM |
| 8287 | 550 CONTINUE |
| 8288 | |
| 8289 | C...Find whether old or new final state. |
| 8290 | DO 570 IDC=1,NKFDC |
| 8291 | IF(NDS.LT.KFDC(IDC,0)) THEN |
| 8292 | IKFDC=IDC |
| 8293 | GOTO 580 |
| 8294 | ELSEIF(NDS.EQ.KFDC(IDC,0)) THEN |
| 8295 | DO 560 I=1,NDS |
| 8296 | IF(KFDM(I).LT.KFDC(IDC,I)) THEN |
| 8297 | IKFDC=IDC |
| 8298 | GOTO 580 |
| 8299 | ELSEIF(KFDM(I).GT.KFDC(IDC,I)) THEN |
| 8300 | GOTO 570 |
| 8301 | ENDIF |
| 8302 | 560 CONTINUE |
| 8303 | IKFDC=-IDC |
| 8304 | GOTO 580 |
| 8305 | ENDIF |
| 8306 | 570 CONTINUE |
| 8307 | IKFDC=NKFDC+1 |
| 8308 | 580 IF(IKFDC.LT.0) THEN |
| 8309 | IKFDC=-IKFDC |
| 8310 | ELSEIF(NKFDC.GE.200) THEN |
| 8311 | NREDC=NREDC+1 |
| 8312 | RETURN |
| 8313 | ELSE |
| 8314 | DO 590 IDC=NKFDC,IKFDC,-1 |
| 8315 | NPDC(IDC+1)=NPDC(IDC) |
| 8316 | DO 590 I=0,8 |
| 8317 | 590 KFDC(IDC+1,I)=KFDC(IDC,I) |
| 8318 | NKFDC=NKFDC+1 |
| 8319 | KFDC(IKFDC,0)=NDS |
| 8320 | DO 600 I=1,NDS |
| 8321 | 600 KFDC(IKFDC,I)=KFDM(I) |
| 8322 | NPDC(IKFDC)=0 |
| 8323 | ENDIF |
| 8324 | NPDC(IKFDC)=NPDC(IKFDC)+1 |
| 8325 | |
| 8326 | C...Write statistics on decay channels. |
| 8327 | ELSEIF(MTABU.EQ.52) THEN |
| 8328 | FAC=1./MAX(1,NEVDC) |
| 8329 | WRITE(MSTU(11),5900) NEVDC |
| 8330 | DO 620 IDC=1,NKFDC |
| 8331 | DO 610 I=1,KFDC(IDC,0) |
| 8332 | KFM=KFDC(IDC,I) |
| 8333 | KF=(KFM+1)/2 |
| 8334 | IF(2*KF.NE.KFM) KF=-KF |
| 8335 | CALL LUNAME(KF,CHAU) |
| 8336 | CHDC(I)=CHAU(1:12) |
| 8337 | 610 IF(CHAU(13:13).NE.' ') CHDC(I)(12:12)='?' |
| 8338 | 620 WRITE(MSTU(11),6000) FAC*NPDC(IDC),(CHDC(I),I=1,KFDC(IDC,0)) |
| 8339 | IF(NREDC.NE.0) WRITE(MSTU(11),6100) FAC*NREDC |
| 8340 | |
| 8341 | C...Copy statistics on decay channels into /LUJETS/. |
| 8342 | ELSEIF(MTABU.EQ.53) THEN |
| 8343 | FAC=1./MAX(1,NEVDC) |
| 8344 | DO 650 IDC=1,NKFDC |
| 8345 | K(IDC,1)=32 |
| 8346 | K(IDC,2)=99 |
| 8347 | K(IDC,3)=0 |
| 8348 | K(IDC,4)=0 |
| 8349 | K(IDC,5)=KFDC(IDC,0) |
| 8350 | DO 630 J=1,5 |
| 8351 | P(IDC,J)=0. |
| 8352 | 630 V(IDC,J)=0. |
| 8353 | DO 640 I=1,KFDC(IDC,0) |
| 8354 | KFM=KFDC(IDC,I) |
| 8355 | KF=(KFM+1)/2 |
| 8356 | IF(2*KF.NE.KFM) KF=-KF |
| 8357 | IF(I.LE.5) P(IDC,I)=KF |
| 8358 | 640 IF(I.GE.6) V(IDC,I-5)=KF |
| 8359 | 650 V(IDC,5)=FAC*NPDC(IDC) |
| 8360 | N=NKFDC |
| 8361 | DO 660 J=1,5 |
| 8362 | K(N+1,J)=0 |
| 8363 | P(N+1,J)=0. |
| 8364 | 660 V(N+1,J)=0. |
| 8365 | K(N+1,1)=32 |
| 8366 | K(N+1,2)=99 |
| 8367 | K(N+1,5)=NEVDC |
| 8368 | V(N+1,5)=FAC*NREDC |
| 8369 | MSTU(3)=1 |
| 8370 | ENDIF |
| 8371 | |
| 8372 | C...Format statements for output on unit MSTU(11) (default 6). |
| 8373 | 5000 FORMAT(///20X,'Event statistics - initial state'/ |
| 8374 | &20X,'based on an analysis of ',I6,' events'// |
| 8375 | &3X,'Main flavours after',8X,'Fraction',4X,'Subfractions ', |
| 8376 | &'according to fragmenting system multiplicity'/ |
| 8377 | &4X,'hard interaction',24X,'1',7X,'2',7X,'3',7X,'4',7X,'5', |
| 8378 | &6X,'6-7',5X,'8-10',3X,'11-15',3X,'16-25',4X,'>25'/) |
| 8379 | 5100 FORMAT(3X,A12,1X,A12,F10.5,1X,10F8.4) |
| 8380 | 5200 FORMAT(///20X,'Event statistics - final state'/ |
| 8381 | &20X,'based on an analysis of ',I6,' events'// |
| 8382 | &5X,'Mean primary multiplicity =',F8.3/ |
| 8383 | &5X,'Mean final multiplicity =',F8.3/ |
| 8384 | &5X,'Mean charged multiplicity =',F8.3// |
| 8385 | &5X,'Number of particles produced per event (directly and via ', |
| 8386 | &'decays/branchings)'/ |
| 8387 | &5X,'KF Particle/jet MDCY',8X,'Particles',9X,'Antiparticles', |
| 8388 | &5X,'Total'/34X,'prim seco prim seco'/) |
| 8389 | 5300 FORMAT(1X,I6,4X,A16,I2,5(1X,F9.4)) |
| 8390 | 5400 FORMAT(///20X,'Factorial moments analysis of multiplicity'/ |
| 8391 | &20X,'based on an analysis of ',I6,' events'// |
| 8392 | &3X,'delta-',A3,' delta-phi <n>/bin',10X,'<F2>',18X,'<F3>', |
| 8393 | &18X,'<F4>',18X,'<F5>'/35X,4(' value error ')) |
| 8394 | 5500 FORMAT(10X) |
| 8395 | 5600 FORMAT(2X,2F10.4,F12.4,4(F12.4,F10.4)) |
| 8396 | 5700 FORMAT(///20X,'Energy-Energy Correlation and Asymmetry'/ |
| 8397 | &20X,'based on an analysis of ',I6,' events'// |
| 8398 | &2X,'theta range',8X,'EEC(theta)',8X,'EEC(180-theta)',7X, |
| 8399 | &'EECA(theta)'/2X,'in degrees ',3(' value error')/) |
| 8400 | 5800 FORMAT(2X,F4.1,' - ',F4.1,3(F11.4,F9.4)) |
| 8401 | 5900 FORMAT(///20X,'Decay channel analysis - final state'/ |
| 8402 | &20X,'based on an analysis of ',I6,' events'// |
| 8403 | &2X,'Probability',10X,'Complete final state'/) |
| 8404 | 6000 FORMAT(2X,F9.5,5X,8(A12,1X)) |
| 8405 | 6100 FORMAT(2X,F9.5,5X,'into other channels (more than 8 particles ', |
| 8406 | &'or table overflow)') |
| 8407 | |
| 8408 | RETURN |
| 8409 | END |
| 8410 | |
| 8411 | C********************************************************************* |
| 8412 | |
| 8413 | SUBROUTINE LUEEVT(KFL,ECM) |
| 8414 | |
| 8415 | C...Purpose: to handle the generation of an e+e- annihilation jet event. |
| 8416 | IMPLICIT DOUBLE PRECISION(D) |
| 8417 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 8418 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 8419 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 8420 | SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ |
| 8421 | |
| 8422 | C...Check input parameters. |
| 8423 | IF(MSTU(12).GE.1) CALL LULIST(0) |
| 8424 | IF(KFL.LT.0.OR.KFL.GT.8) THEN |
| 8425 | CALL LUERRM(16,'(LUEEVT:) called with unknown flavour code') |
| 8426 | IF(MSTU(21).GE.1) RETURN |
| 8427 | ENDIF |
| 8428 | IF(KFL.LE.5) ECMMIN=PARJ(127)+2.02*PARF(100+MAX(1,KFL)) |
| 8429 | IF(KFL.GE.6) ECMMIN=PARJ(127)+2.02*PMAS(KFL,1) |
| 8430 | IF(ECM.LT.ECMMIN) THEN |
| 8431 | CALL LUERRM(16,'(LUEEVT:) called with too small CM energy') |
| 8432 | IF(MSTU(21).GE.1) RETURN |
| 8433 | ENDIF |
| 8434 | |
| 8435 | C...Check consistency of MSTJ options set. |
| 8436 | IF(MSTJ(109).EQ.2.AND.MSTJ(110).NE.1) THEN |
| 8437 | CALL LUERRM(6, |
| 8438 | & '(LUEEVT:) MSTJ(109) value requires MSTJ(110) = 1') |
| 8439 | MSTJ(110)=1 |
| 8440 | ENDIF |
| 8441 | IF(MSTJ(109).EQ.2.AND.MSTJ(111).NE.0) THEN |
| 8442 | CALL LUERRM(6, |
| 8443 | & '(LUEEVT:) MSTJ(109) value requires MSTJ(111) = 0') |
| 8444 | MSTJ(111)=0 |
| 8445 | ENDIF |
| 8446 | |
| 8447 | C...Initialize alpha_strong and total cross-section. |
| 8448 | MSTU(111)=MSTJ(108) |
| 8449 | IF(MSTJ(108).EQ.2.AND.(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.1)) |
| 8450 | &MSTU(111)=1 |
| 8451 | PARU(112)=PARJ(121) |
| 8452 | IF(MSTU(111).EQ.2) PARU(112)=PARJ(122) |
| 8453 | IF(MSTJ(116).GT.0.AND.(MSTJ(116).GE.2.OR.ABS(ECM-PARJ(151)).GE. |
| 8454 | &PARJ(139).OR.10*MSTJ(102)+KFL.NE.MSTJ(119))) CALL LUXTOT(KFL,ECM, |
| 8455 | &XTOT) |
| 8456 | IF(MSTJ(116).GE.3) MSTJ(116)=1 |
| 8457 | PARJ(171)=0. |
| 8458 | |
| 8459 | C...Add initial e+e- to event record (documentation only). |
| 8460 | NTRY=0 |
| 8461 | 100 NTRY=NTRY+1 |
| 8462 | IF(NTRY.GT.100) THEN |
| 8463 | CALL LUERRM(14,'(LUEEVT:) caught in an infinite loop') |
| 8464 | RETURN |
| 8465 | ENDIF |
| 8466 | MSTU(24)=0 |
| 8467 | NC=0 |
| 8468 | IF(MSTJ(115).GE.2) THEN |
| 8469 | NC=NC+2 |
| 8470 | CALL LU1ENT(NC-1,11,0.5*ECM,0.,0.) |
| 8471 | K(NC-1,1)=21 |
| 8472 | CALL LU1ENT(NC,-11,0.5*ECM,PARU(1),0.) |
| 8473 | K(NC,1)=21 |
| 8474 | ENDIF |
| 8475 | |
| 8476 | C...Radiative photon (in initial state). |
| 8477 | MK=0 |
| 8478 | ECMC=ECM |
| 8479 | IF(MSTJ(107).GE.1.AND.MSTJ(116).GE.1) CALL LURADK(ECM,MK,PAK, |
| 8480 | &THEK,PHIK,ALPK) |
| 8481 | IF(MK.EQ.1) ECMC=SQRT(ECM*(ECM-2.*PAK)) |
| 8482 | IF(MSTJ(115).GE.1.AND.MK.EQ.1) THEN |
| 8483 | NC=NC+1 |
| 8484 | CALL LU1ENT(NC,22,PAK,THEK,PHIK) |
| 8485 | K(NC,3)=MIN(MSTJ(115)/2,1) |
| 8486 | ENDIF |
| 8487 | |
| 8488 | C...Virtual exchange boson (gamma or Z0). |
| 8489 | IF(MSTJ(115).GE.3) THEN |
| 8490 | NC=NC+1 |
| 8491 | KF=22 |
| 8492 | IF(MSTJ(102).EQ.2) KF=23 |
| 8493 | MSTU10=MSTU(10) |
| 8494 | MSTU(10)=1 |
| 8495 | P(NC,5)=ECMC |
| 8496 | CALL LU1ENT(NC,KF,ECMC,0.,0.) |
| 8497 | K(NC,1)=21 |
| 8498 | K(NC,3)=1 |
| 8499 | MSTU(10)=MSTU10 |
| 8500 | ENDIF |
| 8501 | |
| 8502 | C...Choice of flavour and jet configuration. |
| 8503 | CALL LUXKFL(KFL,ECM,ECMC,KFLC) |
| 8504 | IF(KFLC.EQ.0) GOTO 100 |
| 8505 | CALL LUXJET(ECMC,NJET,CUT) |
| 8506 | KFLN=21 |
| 8507 | IF(NJET.EQ.4) CALL LUX4JT(NJET,CUT,KFLC,ECMC,KFLN,X1,X2,X4, |
| 8508 | &X12,X14) |
| 8509 | IF(NJET.EQ.3) CALL LUX3JT(NJET,CUT,KFLC,ECMC,X1,X3) |
| 8510 | IF(NJET.EQ.2) MSTJ(120)=1 |
| 8511 | |
| 8512 | C...Fill jet configuration and origin. |
| 8513 | IF(NJET.EQ.2.AND.MSTJ(101).NE.5) CALL LU2ENT(NC+1,KFLC,-KFLC,ECMC) |
| 8514 | IF(NJET.EQ.2.AND.MSTJ(101).EQ.5) CALL LU2ENT(-(NC+1),KFLC,-KFLC, |
| 8515 | &ECMC) |
| 8516 | IF(NJET.EQ.3) CALL LU3ENT(NC+1,KFLC,21,-KFLC,ECMC,X1,X3) |
| 8517 | IF(NJET.EQ.4.AND.KFLN.EQ.21) CALL LU4ENT(NC+1,KFLC,KFLN,KFLN, |
| 8518 | &-KFLC,ECMC,X1,X2,X4,X12,X14) |
| 8519 | IF(NJET.EQ.4.AND.KFLN.NE.21) CALL LU4ENT(NC+1,KFLC,-KFLN,KFLN, |
| 8520 | &-KFLC,ECMC,X1,X2,X4,X12,X14) |
| 8521 | IF(MSTU(24).NE.0) GOTO 100 |
| 8522 | DO 110 IP=NC+1,N |
| 8523 | 110 K(IP,3)=K(IP,3)+MIN(MSTJ(115)/2,1)+(MSTJ(115)/3)*(NC-1) |
| 8524 | |
| 8525 | C...Angular orientation according to matrix element. |
| 8526 | IF(MSTJ(106).EQ.1) THEN |
| 8527 | CALL LUXDIF(NC,NJET,KFLC,ECMC,CHI,THE,PHI) |
| 8528 | CALL LUDBRB(NC+1,N,0.,CHI,0D0,0D0,0D0) |
| 8529 | CALL LUDBRB(NC+1,N,THE,PHI,0D0,0D0,0D0) |
| 8530 | ENDIF |
| 8531 | |
| 8532 | C...Rotation and boost from radiative photon. |
| 8533 | IF(MK.EQ.1) THEN |
| 8534 | DBEK=-PAK/(ECM-PAK) |
| 8535 | NMIN=NC+1-MSTJ(115)/3 |
| 8536 | CALL LUDBRB(NMIN,N,0.,-PHIK,0D0,0D0,0D0) |
| 8537 | CALL LUDBRB(NMIN,N,ALPK,0.,DBEK*SIN(THEK),0D0,DBEK*COS(THEK)) |
| 8538 | CALL LUDBRB(NMIN,N,0.,PHIK,0D0,0D0,0D0) |
| 8539 | ENDIF |
| 8540 | |
| 8541 | C...Generate parton shower. Rearrange along strings and check. |
| 8542 | IF(MSTJ(101).EQ.5) THEN |
| 8543 | CALL LUSHOW(N-1,N,ECMC) |
| 8544 | MSTJ14=MSTJ(14) |
| 8545 | IF(MSTJ(105).EQ.-1) MSTJ(14)=-1 |
| 8546 | IF(MSTJ(105).GE.0) MSTU(28)=0 |
| 8547 | CALL LUPREP(0) |
| 8548 | MSTJ(14)=MSTJ14 |
| 8549 | IF(MSTJ(105).GE.0.AND.MSTU(28).NE.0) GOTO 100 |
| 8550 | ENDIF |
| 8551 | |
| 8552 | C...Fragmentation/decay generation. Information for LUTABU. |
| 8553 | IF(MSTJ(105).EQ.1) CALL LUEXEC |
| 8554 | MSTU(161)=KFLC |
| 8555 | MSTU(162)=-KFLC |
| 8556 | |
| 8557 | RETURN |
| 8558 | END |
| 8559 | |
| 8560 | C********************************************************************* |
| 8561 | |
| 8562 | SUBROUTINE LUXTOT(KFL,ECM,XTOT) |
| 8563 | |
| 8564 | C...Purpose: to calculate total cross-section, including initial |
| 8565 | C...state radiation effects. |
| 8566 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 8567 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 8568 | SAVE /LUDAT1/,/LUDAT2/ |
| 8569 | |
| 8570 | C...Status, (optimized) Q^2 scale, alpha_strong. |
| 8571 | PARJ(151)=ECM |
| 8572 | MSTJ(119)=10*MSTJ(102)+KFL |
| 8573 | IF(MSTJ(111).EQ.0) THEN |
| 8574 | Q2R=ECM**2 |
| 8575 | ELSEIF(MSTU(111).EQ.0) THEN |
| 8576 | PARJ(168)=MIN(1.,MAX(PARJ(128),EXP(-12.*PARU(1)/ |
| 8577 | & ((33.-2.*MSTU(112))*PARU(111))))) |
| 8578 | Q2R=PARJ(168)*ECM**2 |
| 8579 | ELSE |
| 8580 | PARJ(168)=MIN(1.,MAX(PARJ(128),PARU(112)/ECM, |
| 8581 | & (2.*PARU(112)/ECM)**2)) |
| 8582 | Q2R=PARJ(168)*ECM**2 |
| 8583 | ENDIF |
| 8584 | ALSPI=ULALPS(Q2R)/PARU(1) |
| 8585 | |
| 8586 | C...QCD corrections factor in R. |
| 8587 | IF(MSTJ(101).EQ.0.OR.MSTJ(109).EQ.1) THEN |
| 8588 | RQCD=1. |
| 8589 | ELSEIF(IABS(MSTJ(101)).EQ.1.AND.MSTJ(109).EQ.0) THEN |
| 8590 | RQCD=1.+ALSPI |
| 8591 | ELSEIF(MSTJ(109).EQ.0) THEN |
| 8592 | RQCD=1.+ALSPI+(1.986-0.115*MSTU(118))*ALSPI**2 |
| 8593 | IF(MSTJ(111).EQ.1) RQCD=MAX(1.,RQCD+(33.-2.*MSTU(112))/12.* |
| 8594 | & LOG(PARJ(168))*ALSPI**2) |
| 8595 | ELSEIF(IABS(MSTJ(101)).EQ.1) THEN |
| 8596 | RQCD=1.+(3./4.)*ALSPI |
| 8597 | ELSE |
| 8598 | RQCD=1.+(3./4.)*ALSPI-(3./32.+0.519*MSTU(118))*ALSPI**2 |
| 8599 | ENDIF |
| 8600 | |
| 8601 | C...Calculate Z0 width if default value not acceptable. |
| 8602 | IF(MSTJ(102).GE.3) THEN |
| 8603 | RVA=3.*(3.+(4.*PARU(102)-1.)**2)+6.*RQCD*(2.+(1.-8.*PARU(102)/ |
| 8604 | & 3.)**2+(4.*PARU(102)/3.-1.)**2) |
| 8605 | DO 100 KFLC=5,6 |
| 8606 | VQ=1. |
| 8607 | IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(MAX(0.,1.-(2.*ULMASS(KFLC)/ |
| 8608 | & ECM)**2)) |
| 8609 | IF(KFLC.EQ.5) VF=4.*PARU(102)/3.-1. |
| 8610 | IF(KFLC.EQ.6) VF=1.-8.*PARU(102)/3. |
| 8611 | 100 RVA=RVA+3.*RQCD*(0.5*VQ*(3.-VQ**2)*VF**2+VQ**3) |
| 8612 | PARJ(124)=PARU(101)*PARJ(123)*RVA/(48.*PARU(102)*(1.-PARU(102))) |
| 8613 | ENDIF |
| 8614 | |
| 8615 | C...Calculate propagator and related constants for QFD case. |
| 8616 | POLL=1.-PARJ(131)*PARJ(132) |
| 8617 | IF(MSTJ(102).GE.2) THEN |
| 8618 | SFF=1./(16.*PARU(102)*(1.-PARU(102))) |
| 8619 | SFW=ECM**4/((ECM**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2) |
| 8620 | SFI=SFW*(1.-(PARJ(123)/ECM)**2) |
| 8621 | VE=4.*PARU(102)-1. |
| 8622 | SF1I=SFF*(VE*POLL+PARJ(132)-PARJ(131)) |
| 8623 | SF1W=SFF**2*((VE**2+1.)*POLL+2.*VE*(PARJ(132)-PARJ(131))) |
| 8624 | HF1I=SFI*SF1I |
| 8625 | HF1W=SFW*SF1W |
| 8626 | ENDIF |
| 8627 | |
| 8628 | C...Loop over different flavours: charge, velocity. |
| 8629 | RTOT=0. |
| 8630 | RQQ=0. |
| 8631 | RQV=0. |
| 8632 | RVA=0. |
| 8633 | DO 110 KFLC=1,MAX(MSTJ(104),KFL) |
| 8634 | IF(KFL.GT.0.AND.KFLC.NE.KFL) GOTO 110 |
| 8635 | MSTJ(93)=1 |
| 8636 | PMQ=ULMASS(KFLC) |
| 8637 | IF(ECM.LT.2.*PMQ+PARJ(127)) GOTO 110 |
| 8638 | QF=KCHG(KFLC,1)/3. |
| 8639 | VQ=1. |
| 8640 | IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(1.-(2.*PMQ/ECM)**2) |
| 8641 | |
| 8642 | C...Calculate R and sum of charges for QED or QFD case. |
| 8643 | RQQ=RQQ+3.*QF**2*POLL |
| 8644 | IF(MSTJ(102).LE.1) THEN |
| 8645 | RTOT=RTOT+3.*0.5*VQ*(3.-VQ**2)*QF**2*POLL |
| 8646 | ELSE |
| 8647 | VF=SIGN(1.,QF)-4.*QF*PARU(102) |
| 8648 | RQV=RQV-6.*QF*VF*SF1I |
| 8649 | RVA=RVA+3.*(VF**2+1.)*SF1W |
| 8650 | RTOT=RTOT+3.*(0.5*VQ*(3.-VQ**2)*(QF**2*POLL-2.*QF*VF*HF1I+ |
| 8651 | & VF**2*HF1W)+VQ**3*HF1W) |
| 8652 | ENDIF |
| 8653 | 110 CONTINUE |
| 8654 | RSUM=RQQ |
| 8655 | IF(MSTJ(102).GE.2) RSUM=RQQ+SFI*RQV+SFW*RVA |
| 8656 | |
| 8657 | C...Calculate cross-section, including QCD corrections. |
| 8658 | PARJ(141)=RQQ |
| 8659 | PARJ(142)=RTOT |
| 8660 | PARJ(143)=RTOT*RQCD |
| 8661 | PARJ(144)=PARJ(143) |
| 8662 | PARJ(145)=PARJ(141)*86.8/ECM**2 |
| 8663 | PARJ(146)=PARJ(142)*86.8/ECM**2 |
| 8664 | PARJ(147)=PARJ(143)*86.8/ECM**2 |
| 8665 | PARJ(148)=PARJ(147) |
| 8666 | PARJ(157)=RSUM*RQCD |
| 8667 | PARJ(158)=0. |
| 8668 | PARJ(159)=0. |
| 8669 | XTOT=PARJ(147) |
| 8670 | IF(MSTJ(107).LE.0) RETURN |
| 8671 | |
| 8672 | C...Virtual cross-section. |
| 8673 | XKL=PARJ(135) |
| 8674 | XKU=MIN(PARJ(136),1.-(2.*PARJ(127)/ECM)**2) |
| 8675 | ALE=2.*LOG(ECM/ULMASS(11))-1. |
| 8676 | SIGV=ALE/3.+2.*LOG(ECM**2/(ULMASS(13)*ULMASS(15)))/3.-4./3.+ |
| 8677 | &1.526*LOG(ECM**2/0.932) |
| 8678 | |
| 8679 | C...Soft and hard radiative cross-section in QED case. |
| 8680 | IF(MSTJ(102).LE.1) THEN |
| 8681 | SIGV=1.5*ALE-0.5+PARU(1)**2/3.+2.*SIGV |
| 8682 | SIGS=ALE*(2.*LOG(XKL)-LOG(1.-XKL)-XKL) |
| 8683 | SIGH=ALE*(2.*LOG(XKU/XKL)-LOG((1.-XKU)/(1.-XKL))-(XKU-XKL)) |
| 8684 | |
| 8685 | C...Soft and hard radiative cross-section in QFD case. |
| 8686 | ELSE |
| 8687 | SZM=1.-(PARJ(123)/ECM)**2 |
| 8688 | SZW=PARJ(123)*PARJ(124)/ECM**2 |
| 8689 | PARJ(161)=-RQQ/RSUM |
| 8690 | PARJ(162)=-(RQQ+RQV+RVA)/RSUM |
| 8691 | PARJ(163)=(RQV*(1.-0.5*SZM-SFI)+RVA*(1.5-SZM-SFW))/RSUM |
| 8692 | PARJ(164)=(RQV*SZW**2*(1.-2.*SFW)+RVA*(2.*SFI+SZW**2-4.+3.*SZM- |
| 8693 | & SZM**2))/(SZW*RSUM) |
| 8694 | SIGV=1.5*ALE-0.5+PARU(1)**2/3.+((2.*RQQ+SFI*RQV)/RSUM)*SIGV+ |
| 8695 | & (SZW*SFW*RQV/RSUM)*PARU(1)*20./9. |
| 8696 | SIGS=ALE*(2.*LOG(XKL)+PARJ(161)*LOG(1.-XKL)+PARJ(162)*XKL+ |
| 8697 | & PARJ(163)*LOG(((XKL-SZM)**2+SZW**2)/(SZM**2+SZW**2))+ |
| 8698 | & PARJ(164)*(ATAN((XKL-SZM)/SZW)-ATAN(-SZM/SZW))) |
| 8699 | SIGH=ALE*(2.*LOG(XKU/XKL)+PARJ(161)*LOG((1.-XKU)/(1.-XKL))+ |
| 8700 | & PARJ(162)*(XKU-XKL)+PARJ(163)*LOG(((XKU-SZM)**2+SZW**2)/ |
| 8701 | & ((XKL-SZM)**2+SZW**2))+PARJ(164)*(ATAN((XKU-SZM)/SZW)- |
| 8702 | & ATAN((XKL-SZM)/SZW))) |
| 8703 | ENDIF |
| 8704 | |
| 8705 | C...Total cross-section and fraction of hard photon events. |
| 8706 | PARJ(160)=SIGH/(PARU(1)/PARU(101)+SIGV+SIGS+SIGH) |
| 8707 | PARJ(157)=RSUM*(1.+(PARU(101)/PARU(1))*(SIGV+SIGS+SIGH))*RQCD |
| 8708 | PARJ(144)=PARJ(157) |
| 8709 | PARJ(148)=PARJ(144)*86.8/ECM**2 |
| 8710 | XTOT=PARJ(148) |
| 8711 | |
| 8712 | RETURN |
| 8713 | END |
| 8714 | |
| 8715 | C********************************************************************* |
| 8716 | |
| 8717 | SUBROUTINE LURADK(ECM,MK,PAK,THEK,PHIK,ALPK) |
| 8718 | |
| 8719 | C...Purpose: to generate initial state photon radiation. |
| 8720 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 8721 | SAVE /LUDAT1/ |
| 8722 | |
| 8723 | C...Function: cumulative hard photon spectrum in QFD case. |
| 8724 | FXK(XX)=2.*LOG(XX)+PARJ(161)*LOG(1.-XX)+PARJ(162)*XX+ |
| 8725 | &PARJ(163)*LOG((XX-SZM)**2+SZW**2)+PARJ(164)*ATAN((XX-SZM)/SZW) |
| 8726 | |
| 8727 | C...Determine whether radiative photon or not. |
| 8728 | MK=0 |
| 8729 | PAK=0. |
| 8730 | IF(PARJ(160).LT.RLU(0)) RETURN |
| 8731 | MK=1 |
| 8732 | |
| 8733 | C...Photon energy range. Find photon momentum in QED case. |
| 8734 | XKL=PARJ(135) |
| 8735 | XKU=MIN(PARJ(136),1.-(2.*PARJ(127)/ECM)**2) |
| 8736 | IF(MSTJ(102).LE.1) THEN |
| 8737 | 100 XK=1./(1.+(1./XKL-1.)*((1./XKU-1.)/(1./XKL-1.))**RLU(0)) |
| 8738 | IF(1.+(1.-XK)**2.LT.2.*RLU(0)) GOTO 100 |
| 8739 | |
| 8740 | C...Ditto in QFD case, by numerical inversion of integrated spectrum. |
| 8741 | ELSE |
| 8742 | SZM=1.-(PARJ(123)/ECM)**2 |
| 8743 | SZW=PARJ(123)*PARJ(124)/ECM**2 |
| 8744 | FXKL=FXK(XKL) |
| 8745 | FXKU=FXK(XKU) |
| 8746 | FXKD=1E-4*(FXKU-FXKL) |
| 8747 | FXKR=FXKL+RLU(0)*(FXKU-FXKL) |
| 8748 | NXK=0 |
| 8749 | 110 NXK=NXK+1 |
| 8750 | XK=0.5*(XKL+XKU) |
| 8751 | FXKV=FXK(XK) |
| 8752 | IF(FXKV.GT.FXKR) THEN |
| 8753 | XKU=XK |
| 8754 | FXKU=FXKV |
| 8755 | ELSE |
| 8756 | XKL=XK |
| 8757 | FXKL=FXKV |
| 8758 | ENDIF |
| 8759 | IF(NXK.LT.15.AND.FXKU-FXKL.GT.FXKD) GOTO 110 |
| 8760 | XK=XKL+(XKU-XKL)*(FXKR-FXKL)/(FXKU-FXKL) |
| 8761 | ENDIF |
| 8762 | PAK=0.5*ECM*XK |
| 8763 | |
| 8764 | C...Photon polar and azimuthal angle. |
| 8765 | PME=2.*(ULMASS(11)/ECM)**2 |
| 8766 | 120 CTHM=PME*(2./PME)**RLU(0) |
| 8767 | IF(1.-(XK**2*CTHM*(1.-0.5*CTHM)+2.*(1.-XK)*PME/MAX(PME, |
| 8768 | &CTHM*(1.-0.5*CTHM)))/(1.+(1.-XK)**2).LT.RLU(0)) GOTO 120 |
| 8769 | CTHE=1.-CTHM |
| 8770 | IF(RLU(0).GT.0.5) CTHE=-CTHE |
| 8771 | STHE=SQRT(MAX(0.,(CTHM-PME)*(2.-CTHM))) |
| 8772 | THEK=ULANGL(CTHE,STHE) |
| 8773 | PHIK=PARU(2)*RLU(0) |
| 8774 | |
| 8775 | C...Rotation angle for hadronic system. |
| 8776 | SGN=1. |
| 8777 | IF(0.5*(2.-XK*(1.-CTHE))**2/((2.-XK)**2+(XK*CTHE)**2).GT. |
| 8778 | &RLU(0)) SGN=-1. |
| 8779 | ALPK=ASIN(SGN*STHE*(XK-SGN*(2.*SQRT(1.-XK)-2.+XK)*CTHE)/ |
| 8780 | &(2.-XK*(1.-SGN*CTHE))) |
| 8781 | |
| 8782 | RETURN |
| 8783 | END |
| 8784 | |
| 8785 | C********************************************************************* |
| 8786 | |
| 8787 | SUBROUTINE LUXKFL(KFL,ECM,ECMC,KFLC) |
| 8788 | |
| 8789 | C...Purpose: to select flavour for produced qqbar pair. |
| 8790 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 8791 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 8792 | SAVE /LUDAT1/,/LUDAT2/ |
| 8793 | |
| 8794 | C...Calculate maximum weight in QED or QFD case. |
| 8795 | IF(MSTJ(102).LE.1) THEN |
| 8796 | RFMAX=4./9. |
| 8797 | ELSE |
| 8798 | POLL=1.-PARJ(131)*PARJ(132) |
| 8799 | SFF=1./(16.*PARU(102)*(1.-PARU(102))) |
| 8800 | SFW=ECMC**4/((ECMC**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2) |
| 8801 | SFI=SFW*(1.-(PARJ(123)/ECMC)**2) |
| 8802 | VE=4.*PARU(102)-1. |
| 8803 | HF1I=SFI*SFF*(VE*POLL+PARJ(132)-PARJ(131)) |
| 8804 | HF1W=SFW*SFF**2*((VE**2+1.)*POLL+2.*VE*(PARJ(132)-PARJ(131))) |
| 8805 | RFMAX=MAX(4./9.*POLL-4./3.*(1.-8.*PARU(102)/3.)*HF1I+ |
| 8806 | & ((1.-8.*PARU(102)/3.)**2+1.)*HF1W,1./9.*POLL+2./3.* |
| 8807 | & (-1.+4.*PARU(102)/3.)*HF1I+((-1.+4.*PARU(102)/3.)**2+1.)*HF1W) |
| 8808 | ENDIF |
| 8809 | |
| 8810 | C...Choose flavour. Gives charge and velocity. |
| 8811 | NTRY=0 |
| 8812 | 100 NTRY=NTRY+1 |
| 8813 | IF(NTRY.GT.100) THEN |
| 8814 | CALL LUERRM(14,'(LUXKFL:) caught in an infinite loop') |
| 8815 | KFLC=0 |
| 8816 | RETURN |
| 8817 | ENDIF |
| 8818 | KFLC=KFL |
| 8819 | IF(KFL.LE.0) KFLC=1+INT(MSTJ(104)*RLU(0)) |
| 8820 | MSTJ(93)=1 |
| 8821 | PMQ=ULMASS(KFLC) |
| 8822 | IF(ECM.LT.2.*PMQ+PARJ(127)) GOTO 100 |
| 8823 | QF=KCHG(KFLC,1)/3. |
| 8824 | VQ=1. |
| 8825 | IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(MAX(0.,1.-(2.*PMQ/ECMC)**2)) |
| 8826 | |
| 8827 | C...Calculate weight in QED or QFD case. |
| 8828 | IF(MSTJ(102).LE.1) THEN |
| 8829 | RF=QF**2 |
| 8830 | RFV=0.5*VQ*(3.-VQ**2)*QF**2 |
| 8831 | ELSE |
| 8832 | VF=SIGN(1.,QF)-4.*QF*PARU(102) |
| 8833 | RF=QF**2*POLL-2.*QF*VF*HF1I+(VF**2+1.)*HF1W |
| 8834 | RFV=0.5*VQ*(3.-VQ**2)*(QF**2*POLL-2.*QF*VF*HF1I+VF**2*HF1W)+ |
| 8835 | & VQ**3*HF1W |
| 8836 | IF(RFV.GT.0.) PARJ(171)=MIN(1.,VQ**3*HF1W/RFV) |
| 8837 | ENDIF |
| 8838 | |
| 8839 | C...Weighting or new event (radiative photon). Cross-section update. |
| 8840 | IF(KFL.LE.0.AND.RF.LT.RLU(0)*RFMAX) GOTO 100 |
| 8841 | PARJ(158)=PARJ(158)+1. |
| 8842 | IF(ECMC.LT.2.*PMQ+PARJ(127).OR.RFV.LT.RLU(0)*RF) KFLC=0 |
| 8843 | IF(MSTJ(107).LE.0.AND.KFLC.EQ.0) GOTO 100 |
| 8844 | IF(KFLC.NE.0) PARJ(159)=PARJ(159)+1. |
| 8845 | PARJ(144)=PARJ(157)*PARJ(159)/PARJ(158) |
| 8846 | PARJ(148)=PARJ(144)*86.8/ECM**2 |
| 8847 | |
| 8848 | RETURN |
| 8849 | END |
| 8850 | |
| 8851 | C********************************************************************* |
| 8852 | |
| 8853 | SUBROUTINE LUXJET(ECM,NJET,CUT) |
| 8854 | |
| 8855 | C...Purpose: to select number of jets in matrix element approach. |
| 8856 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 8857 | SAVE /LUDAT1/ |
| 8858 | DIMENSION ZHUT(5) |
| 8859 | |
| 8860 | C...Relative three-jet rate in Zhu second order parametrization. |
| 8861 | DATA ZHUT/3.0922, 6.2291, 7.4782, 7.8440, 8.2560/ |
| 8862 | |
| 8863 | C...Trivial result for two-jets only, including parton shower. |
| 8864 | IF(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.5) THEN |
| 8865 | CUT=0. |
| 8866 | |
| 8867 | C...QCD and Abelian vector gluon theory: Q^2 for jet rate and R. |
| 8868 | ELSEIF(MSTJ(109).EQ.0.OR.MSTJ(109).EQ.2) THEN |
| 8869 | CF=4./3. |
| 8870 | IF(MSTJ(109).EQ.2) CF=1. |
| 8871 | IF(MSTJ(111).EQ.0) THEN |
| 8872 | Q2=ECM**2 |
| 8873 | Q2R=ECM**2 |
| 8874 | ELSEIF(MSTU(111).EQ.0) THEN |
| 8875 | PARJ(169)=MIN(1.,PARJ(129)) |
| 8876 | Q2=PARJ(169)*ECM**2 |
| 8877 | PARJ(168)=MIN(1.,MAX(PARJ(128),EXP(-12.*PARU(1)/ |
| 8878 | & ((33.-2.*MSTU(112))*PARU(111))))) |
| 8879 | Q2R=PARJ(168)*ECM**2 |
| 8880 | ELSE |
| 8881 | PARJ(169)=MIN(1.,MAX(PARJ(129),(2.*PARU(112)/ECM)**2)) |
| 8882 | Q2=PARJ(169)*ECM**2 |
| 8883 | PARJ(168)=MIN(1.,MAX(PARJ(128),PARU(112)/ECM, |
| 8884 | & (2.*PARU(112)/ECM)**2)) |
| 8885 | Q2R=PARJ(168)*ECM**2 |
| 8886 | ENDIF |
| 8887 | |
| 8888 | C...alpha_strong for R and R itself. |
| 8889 | ALSPI=(3./4.)*CF*ULALPS(Q2R)/PARU(1) |
| 8890 | IF(IABS(MSTJ(101)).EQ.1) THEN |
| 8891 | RQCD=1.+ALSPI |
| 8892 | ELSEIF(MSTJ(109).EQ.0) THEN |
| 8893 | RQCD=1.+ALSPI+(1.986-0.115*MSTU(118))*ALSPI**2 |
| 8894 | IF(MSTJ(111).EQ.1) RQCD=MAX(1.,RQCD+(33.-2.*MSTU(112))/12.* |
| 8895 | & LOG(PARJ(168))*ALSPI**2) |
| 8896 | ELSE |
| 8897 | RQCD=1.+ALSPI-(3./32.+0.519*MSTU(118))*(4.*ALSPI/3.)**2 |
| 8898 | ENDIF |
| 8899 | |
| 8900 | C...alpha_strong for jet rate. Initial value for y cut. |
| 8901 | ALSPI=(3./4.)*CF*ULALPS(Q2)/PARU(1) |
| 8902 | CUT=MAX(0.001,PARJ(125),(PARJ(126)/ECM)**2) |
| 8903 | IF(IABS(MSTJ(101)).LE.1.OR.(MSTJ(109).EQ.0.AND.MSTJ(111).EQ.0)) |
| 8904 | & CUT=MAX(CUT,EXP(-SQRT(0.75/ALSPI))/2.) |
| 8905 | IF(MSTJ(110).EQ.2) CUT=MAX(0.01,MIN(0.05,CUT)) |
| 8906 | |
| 8907 | C...Parametrization of first order three-jet cross-section. |
| 8908 | 100 IF(MSTJ(101).EQ.0.OR.CUT.GE.0.25) THEN |
| 8909 | PARJ(152)=0. |
| 8910 | ELSE |
| 8911 | PARJ(152)=(2.*ALSPI/3.)*((3.-6.*CUT+2.*LOG(CUT))* |
| 8912 | & LOG(CUT/(1.-2.*CUT))+(2.5+1.5*CUT-6.571)*(1.-3.*CUT)+ |
| 8913 | & 5.833*(1.-3.*CUT)**2-3.894*(1.-3.*CUT)**3+ |
| 8914 | & 1.342*(1.-3.*CUT)**4)/RQCD |
| 8915 | IF(MSTJ(109).EQ.2.AND.(MSTJ(101).EQ.2.OR.MSTJ(101).LE.-2)) |
| 8916 | & PARJ(152)=0. |
| 8917 | ENDIF |
| 8918 | |
| 8919 | C...Parametrization of second order three-jet cross-section. |
| 8920 | IF(IABS(MSTJ(101)).LE.1.OR.MSTJ(101).EQ.3.OR.MSTJ(109).EQ.2.OR. |
| 8921 | & CUT.GE.0.25) THEN |
| 8922 | PARJ(153)=0. |
| 8923 | ELSEIF(MSTJ(110).LE.1) THEN |
| 8924 | CT=LOG(1./CUT-2.) |
| 8925 | PARJ(153)=ALSPI**2*CT**2*(2.419+0.5989*CT+0.6782*CT**2- |
| 8926 | & 0.2661*CT**3+0.01159*CT**4)/RQCD |
| 8927 | |
| 8928 | C...Interpolation in second/first order ratio for Zhu parametrization. |
| 8929 | ELSEIF(MSTJ(110).EQ.2) THEN |
| 8930 | IZA=0 |
| 8931 | DO 110 IY=1,5 |
| 8932 | 110 IF(ABS(CUT-0.01*IY).LT.0.0001) IZA=IY |
| 8933 | IF(IZA.NE.0) THEN |
| 8934 | ZHURAT=ZHUT(IZA) |
| 8935 | ELSE |
| 8936 | IZ=100.*CUT |
| 8937 | ZHURAT=ZHUT(IZ)+(100.*CUT-IZ)*(ZHUT(IZ+1)-ZHUT(IZ)) |
| 8938 | ENDIF |
| 8939 | PARJ(153)=ALSPI*PARJ(152)*ZHURAT |
| 8940 | ENDIF |
| 8941 | |
| 8942 | C...Shift in second order three-jet cross-section with optimized Q^2. |
| 8943 | IF(MSTJ(111).EQ.1.AND.IABS(MSTJ(101)).GE.2.AND.MSTJ(101).NE.3. |
| 8944 | & AND.CUT.LT.0.25) PARJ(153)=PARJ(153)+(33.-2.*MSTU(112))/12.* |
| 8945 | & LOG(PARJ(169))*ALSPI*PARJ(152) |
| 8946 | |
| 8947 | C...Parametrization of second order four-jet cross-section. |
| 8948 | IF(IABS(MSTJ(101)).LE.1.OR.CUT.GE.0.125) THEN |
| 8949 | PARJ(154)=0. |
| 8950 | ELSE |
| 8951 | CT=LOG(1./CUT-5.) |
| 8952 | IF(CUT.LE.0.018) THEN |
| 8953 | XQQGG=6.349-4.330*CT+0.8304*CT**2 |
| 8954 | IF(MSTJ(109).EQ.2) XQQGG=(4./3.)**2*(3.035-2.091*CT+ |
| 8955 | & 0.4059*CT**2) |
| 8956 | XQQQQ=1.25*(-0.1080+0.01486*CT+0.009364*CT**2) |
| 8957 | IF(MSTJ(109).EQ.2) XQQQQ=8.*XQQQQ |
| 8958 | ELSE |
| 8959 | XQQGG=-0.09773+0.2959*CT-0.2764*CT**2+0.08832*CT**3 |
| 8960 | IF(MSTJ(109).EQ.2) XQQGG=(4./3.)**2*(-0.04079+0.1340*CT- |
| 8961 | & 0.1326*CT**2+0.04365*CT**3) |
| 8962 | XQQQQ=1.25*(0.003661-0.004888*CT-0.001081*CT**2+0.002093* |
| 8963 | & CT**3) |
| 8964 | IF(MSTJ(109).EQ.2) XQQQQ=8.*XQQQQ |
| 8965 | ENDIF |
| 8966 | PARJ(154)=ALSPI**2*CT**2*(XQQGG+XQQQQ)/RQCD |
| 8967 | PARJ(155)=XQQQQ/(XQQGG+XQQQQ) |
| 8968 | ENDIF |
| 8969 | |
| 8970 | C...If negative three-jet rate, change y' optimization parameter. |
| 8971 | IF(MSTJ(111).EQ.1.AND.PARJ(152)+PARJ(153).LT.0..AND. |
| 8972 | & PARJ(169).LT.0.99) THEN |
| 8973 | PARJ(169)=MIN(1.,1.2*PARJ(169)) |
| 8974 | Q2=PARJ(169)*ECM**2 |
| 8975 | ALSPI=(3./4.)*CF*ULALPS(Q2)/PARU(1) |
| 8976 | GOTO 100 |
| 8977 | ENDIF |
| 8978 | |
| 8979 | C...If too high cross-section, use harder cuts, or fail. |
| 8980 | IF(PARJ(152)+PARJ(153)+PARJ(154).GE.1) THEN |
| 8981 | IF(MSTJ(110).EQ.2.AND.CUT.GT.0.0499.AND.MSTJ(111).EQ.1.AND. |
| 8982 | & PARJ(169).LT.0.99) THEN |
| 8983 | PARJ(169)=MIN(1.,1.2*PARJ(169)) |
| 8984 | Q2=PARJ(169)*ECM**2 |
| 8985 | ALSPI=(3./4.)*CF*ULALPS(Q2)/PARU(1) |
| 8986 | GOTO 100 |
| 8987 | ELSEIF(MSTJ(110).EQ.2.AND.CUT.GT.0.0499) THEN |
| 8988 | CALL LUERRM(26, |
| 8989 | & '(LUXJET:) no allowed y cut value for Zhu parametrization') |
| 8990 | ENDIF |
| 8991 | CUT=0.26*(4.*CUT)**(PARJ(152)+PARJ(153)+PARJ(154))**(-1./3.) |
| 8992 | IF(MSTJ(110).EQ.2) CUT=MAX(0.01,MIN(0.05,CUT)) |
| 8993 | GOTO 100 |
| 8994 | ENDIF |
| 8995 | |
| 8996 | C...Scalar gluon (first order only). |
| 8997 | ELSE |
| 8998 | ALSPI=ULALPS(ECM**2)/PARU(1) |
| 8999 | CUT=MAX(0.001,PARJ(125),(PARJ(126)/ECM)**2,EXP(-3./ALSPI)) |
| 9000 | PARJ(152)=0. |
| 9001 | IF(CUT.LT.0.25) PARJ(152)=(ALSPI/3.)*((1.-2.*CUT)* |
| 9002 | & LOG((1.-2.*CUT)/CUT)+0.5*(9.*CUT**2-1.)) |
| 9003 | PARJ(153)=0. |
| 9004 | PARJ(154)=0. |
| 9005 | ENDIF |
| 9006 | |
| 9007 | C...Select number of jets. |
| 9008 | PARJ(150)=CUT |
| 9009 | IF(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.5) THEN |
| 9010 | NJET=2 |
| 9011 | ELSEIF(MSTJ(101).LE.0) THEN |
| 9012 | NJET=MIN(4,2-MSTJ(101)) |
| 9013 | ELSE |
| 9014 | RNJ=RLU(0) |
| 9015 | NJET=2 |
| 9016 | IF(PARJ(152)+PARJ(153)+PARJ(154).GT.RNJ) NJET=3 |
| 9017 | IF(PARJ(154).GT.RNJ) NJET=4 |
| 9018 | ENDIF |
| 9019 | |
| 9020 | RETURN |
| 9021 | END |
| 9022 | |
| 9023 | C********************************************************************* |
| 9024 | |
| 9025 | SUBROUTINE LUX3JT(NJET,CUT,KFL,ECM,X1,X2) |
| 9026 | |
| 9027 | C...Purpose: to select the kinematical variables of three-jet events. |
| 9028 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 9029 | SAVE /LUDAT1/ |
| 9030 | DIMENSION ZHUP(5,12) |
| 9031 | |
| 9032 | C...Coefficients of Zhu second order parametrization. |
| 9033 | DATA ((ZHUP(IC1,IC2),IC2=1,12),IC1=1,5)/ |
| 9034 | & 18.29, 89.56, 4.541, -52.09, -109.8, 24.90, |
| 9035 | & 11.63, 3.683, 17.50, 0.002440, -1.362, -0.3537, |
| 9036 | & 11.42, 6.299, -22.55, -8.915, 59.25, -5.855, |
| 9037 | & -32.85, -1.054, -16.90, 0.006489, -0.8156, 0.01095, |
| 9038 | & 7.847, -3.964, -35.83, 1.178, 29.39, 0.2806, |
| 9039 | & 47.82, -12.36, -56.72, 0.04054, -0.4365, 0.6062, |
| 9040 | & 5.441, -56.89, -50.27, 15.13, 114.3, -18.19, |
| 9041 | & 97.05, -1.890, -139.9, 0.08153, -0.4984, 0.9439, |
| 9042 | & -17.65, 51.44, -58.32, 70.95, -255.7, -78.99, |
| 9043 | & 476.9, 29.65, -239.3, 0.4745, -1.174, 6.081/ |
| 9044 | |
| 9045 | C...Dilogarithm of x for x<0.5 (x>0.5 obtained by analytic trick). |
| 9046 | DILOG(X)=X+X**2/4.+X**3/9.+X**4/16.+X**5/25.+X**6/36.+X**7/49. |
| 9047 | |
| 9048 | C...Event type. Mass effect factors and other common constants. |
| 9049 | MSTJ(120)=2 |
| 9050 | MSTJ(121)=0 |
| 9051 | PMQ=ULMASS(KFL) |
| 9052 | QME=(2.*PMQ/ECM)**2 |
| 9053 | IF(MSTJ(109).NE.1) THEN |
| 9054 | CUTL=LOG(CUT) |
| 9055 | CUTD=LOG(1./CUT-2.) |
| 9056 | IF(MSTJ(109).EQ.0) THEN |
| 9057 | CF=4./3. |
| 9058 | CN=3. |
| 9059 | TR=2. |
| 9060 | WTMX=MIN(20.,37.-6.*CUTD) |
| 9061 | IF(MSTJ(110).EQ.2) WTMX=2.*(7.5+80.*CUT) |
| 9062 | ELSE |
| 9063 | CF=1. |
| 9064 | CN=0. |
| 9065 | TR=12. |
| 9066 | WTMX=0. |
| 9067 | ENDIF |
| 9068 | |
| 9069 | C...Alpha_strong and effects of optimized Q^2 scale. Maximum weight. |
| 9070 | ALS2PI=PARU(118)/PARU(2) |
| 9071 | WTOPT=0. |
| 9072 | IF(MSTJ(111).EQ.1) WTOPT=(33.-2.*MSTU(112))/6.*LOG(PARJ(169))* |
| 9073 | & ALS2PI |
| 9074 | WTMAX=MAX(0.,1.+WTOPT+ALS2PI*WTMX) |
| 9075 | |
| 9076 | C...Choose three-jet events in allowed region. |
| 9077 | 100 NJET=3 |
| 9078 | 110 Y13L=CUTL+CUTD*RLU(0) |
| 9079 | Y23L=CUTL+CUTD*RLU(0) |
| 9080 | Y13=EXP(Y13L) |
| 9081 | Y23=EXP(Y23L) |
| 9082 | Y12=1.-Y13-Y23 |
| 9083 | IF(Y12.LE.CUT) GOTO 110 |
| 9084 | IF(Y13**2+Y23**2+2.*Y12.LE.2.*RLU(0)) GOTO 110 |
| 9085 | |
| 9086 | C...Second order corrections. |
| 9087 | IF(MSTJ(101).EQ.2.AND.MSTJ(110).LE.1) THEN |
| 9088 | Y12L=LOG(Y12) |
| 9089 | Y13M=LOG(1.-Y13) |
| 9090 | Y23M=LOG(1.-Y23) |
| 9091 | Y12M=LOG(1.-Y12) |
| 9092 | IF(Y13.LE.0.5) Y13I=DILOG(Y13) |
| 9093 | IF(Y13.GE.0.5) Y13I=1.644934-Y13L*Y13M-DILOG(1.-Y13) |
| 9094 | IF(Y23.LE.0.5) Y23I=DILOG(Y23) |
| 9095 | IF(Y23.GE.0.5) Y23I=1.644934-Y23L*Y23M-DILOG(1.-Y23) |
| 9096 | IF(Y12.LE.0.5) Y12I=DILOG(Y12) |
| 9097 | IF(Y12.GE.0.5) Y12I=1.644934-Y12L*Y12M-DILOG(1.-Y12) |
| 9098 | WT1=(Y13**2+Y23**2+2.*Y12)/(Y13*Y23) |
| 9099 | WT2=CF*(-2.*(CUTL-Y12L)**2-3.*CUTL-1.+3.289868+ |
| 9100 | & 2.*(2.*CUTL-Y12L)*CUT/Y12)+ |
| 9101 | & CN*((CUTL-Y12L)**2-(CUTL-Y13L)**2-(CUTL-Y23L)**2-11.*CUTL/6.+ |
| 9102 | & 67./18.+1.644934-(2.*CUTL-Y12L)*CUT/Y12+(2.*CUTL-Y13L)* |
| 9103 | & CUT/Y13+(2.*CUTL-Y23L)*CUT/Y23)+ |
| 9104 | & TR*(2.*CUTL/3.-10./9.)+ |
| 9105 | & CF*(Y12/(Y12+Y13)+Y12/(Y12+Y23)+(Y12+Y23)/Y13+(Y12+Y13)/Y23+ |
| 9106 | & Y13L*(4.*Y12**2+2.*Y12*Y13+4.*Y12*Y23+Y13*Y23)/(Y12+Y23)**2+ |
| 9107 | & Y23L*(4.*Y12**2+2.*Y12*Y23+4.*Y12*Y13+Y13*Y23)/(Y12+Y13)**2)/ |
| 9108 | & WT1+ |
| 9109 | & CN*(Y13L*Y13/(Y12+Y23)+Y23L*Y23/(Y12+Y13))/WT1+ |
| 9110 | & (CN-2.*CF)*((Y12**2+(Y12+Y13)**2)*(Y12L*Y23L-Y12L*Y12M-Y23L* |
| 9111 | & Y23M+1.644934-Y12I-Y23I)/(Y13*Y23)+(Y12**2+(Y12+Y23)**2)* |
| 9112 | & (Y12L*Y13L-Y12L*Y12M-Y13L*Y13M+1.644934-Y12I-Y13I)/ |
| 9113 | & (Y13*Y23)+(Y13**2+Y23**2)/(Y13*Y23*(Y13+Y23))- |
| 9114 | & 2.*Y12L*Y12**2/(Y13+Y23)**2-4.*Y12L*Y12/(Y13+Y23))/WT1- |
| 9115 | & CN*(Y13L*Y23L-Y13L*Y13M-Y23L*Y23M+1.644934-Y13I-Y23I) |
| 9116 | IF(1.+WTOPT+ALS2PI*WT2.LE.0.) MSTJ(121)=1 |
| 9117 | IF(1.+WTOPT+ALS2PI*WT2.LE.WTMAX*RLU(0)) GOTO 110 |
| 9118 | PARJ(156)=(WTOPT+ALS2PI*WT2)/(1.+WTOPT+ALS2PI*WT2) |
| 9119 | |
| 9120 | ELSEIF(MSTJ(101).EQ.2.AND.MSTJ(110).EQ.2) THEN |
| 9121 | C...Second order corrections; Zhu parametrization of ERT. |
| 9122 | ZX=(Y23-Y13)**2 |
| 9123 | ZY=1.-Y12 |
| 9124 | IZA=0 |
| 9125 | DO 120 IY=1,5 |
| 9126 | 120 IF(ABS(CUT-0.01*IY).LT.0.0001) IZA=IY |
| 9127 | IF(IZA.NE.0) THEN |
| 9128 | IZ=IZA |
| 9129 | WT2=ZHUP(IZ,1)+ZHUP(IZ,2)*ZX+ZHUP(IZ,3)*ZX**2+(ZHUP(IZ,4)+ |
| 9130 | & ZHUP(IZ,5)*ZX)*ZY+(ZHUP(IZ,6)+ZHUP(IZ,7)*ZX)*ZY**2+ |
| 9131 | & (ZHUP(IZ,8)+ZHUP(IZ,9)*ZX)*ZY**3+ZHUP(IZ,10)/(ZX-ZY**2)+ |
| 9132 | & ZHUP(IZ,11)/(1.-ZY)+ZHUP(IZ,12)/ZY |
| 9133 | ELSE |
| 9134 | IZ=100.*CUT |
| 9135 | WTL=ZHUP(IZ,1)+ZHUP(IZ,2)*ZX+ZHUP(IZ,3)*ZX**2+(ZHUP(IZ,4)+ |
| 9136 | & ZHUP(IZ,5)*ZX)*ZY+(ZHUP(IZ,6)+ZHUP(IZ,7)*ZX)*ZY**2+ |
| 9137 | & (ZHUP(IZ,8)+ZHUP(IZ,9)*ZX)*ZY**3+ZHUP(IZ,10)/(ZX-ZY**2)+ |
| 9138 | & ZHUP(IZ,11)/(1.-ZY)+ZHUP(IZ,12)/ZY |
| 9139 | IZ=IZ+1 |
| 9140 | WTU=ZHUP(IZ,1)+ZHUP(IZ,2)*ZX+ZHUP(IZ,3)*ZX**2+(ZHUP(IZ,4)+ |
| 9141 | & ZHUP(IZ,5)*ZX)*ZY+(ZHUP(IZ,6)+ZHUP(IZ,7)*ZX)*ZY**2+ |
| 9142 | & (ZHUP(IZ,8)+ZHUP(IZ,9)*ZX)*ZY**3+ZHUP(IZ,10)/(ZX-ZY**2)+ |
| 9143 | & ZHUP(IZ,11)/(1.-ZY)+ZHUP(IZ,12)/ZY |
| 9144 | WT2=WTL+(WTU-WTL)*(100.*CUT+1.-IZ) |
| 9145 | ENDIF |
| 9146 | IF(1.+WTOPT+2.*ALS2PI*WT2.LE.0.) MSTJ(121)=1 |
| 9147 | IF(1.+WTOPT+2.*ALS2PI*WT2.LE.WTMAX*RLU(0)) GOTO 110 |
| 9148 | PARJ(156)=(WTOPT+2.*ALS2PI*WT2)/(1.+WTOPT+2.*ALS2PI*WT2) |
| 9149 | ENDIF |
| 9150 | |
| 9151 | C...Impose mass cuts (gives two jets). For fixed jet number new try. |
| 9152 | X1=1.-Y23 |
| 9153 | X2=1.-Y13 |
| 9154 | X3=1.-Y12 |
| 9155 | IF(4.*Y23*Y13*Y12/X3**2.LE.QME) NJET=2 |
| 9156 | IF(MOD(MSTJ(103),4).GE.2.AND.IABS(MSTJ(101)).LE.1.AND.QME*X3+ |
| 9157 | & 0.5*QME**2+(0.5*QME+0.25*QME**2)*((1.-X2)/(1.-X1)+ |
| 9158 | & (1.-X1)/(1.-X2)).GT.(X1**2+X2**2)*RLU(0)) NJET=2 |
| 9159 | IF(MSTJ(101).EQ.-1.AND.NJET.EQ.2) GOTO 100 |
| 9160 | |
| 9161 | C...Scalar gluon model (first order only, no mass effects). |
| 9162 | ELSE |
| 9163 | 130 NJET=3 |
| 9164 | 140 X3=SQRT(4.*CUT**2+RLU(0)*((1.-CUT)**2-4.*CUT**2)) |
| 9165 | IF(LOG((X3-CUT)/CUT).LE.RLU(0)*LOG((1.-2.*CUT)/CUT)) GOTO 140 |
| 9166 | YD=SIGN(2.*CUT*((X3-CUT)/CUT)**RLU(0)-X3,RLU(0)-0.5) |
| 9167 | X1=1.-0.5*(X3+YD) |
| 9168 | X2=1.-0.5*(X3-YD) |
| 9169 | IF(4.*(1.-X1)*(1.-X2)*(1.-X3)/X3**2.LE.QME) NJET=2 |
| 9170 | IF(MSTJ(102).GE.2) THEN |
| 9171 | IF(X3**2-2.*(1.+X3)*(1.-X1)*(1.-X2)*PARJ(171).LT. |
| 9172 | & X3**2*RLU(0)) NJET=2 |
| 9173 | ENDIF |
| 9174 | IF(MSTJ(101).EQ.-1.AND.NJET.EQ.2) GOTO 130 |
| 9175 | ENDIF |
| 9176 | |
| 9177 | RETURN |
| 9178 | END |
| 9179 | |
| 9180 | C********************************************************************* |
| 9181 | |
| 9182 | SUBROUTINE LUX4JT(NJET,CUT,KFL,ECM,KFLN,X1,X2,X4,X12,X14) |
| 9183 | |
| 9184 | C...Purpose: to select the kinematical variables of four-jet events. |
| 9185 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 9186 | SAVE /LUDAT1/ |
| 9187 | DIMENSION WTA(4),WTB(4),WTC(4),WTD(4),WTE(4) |
| 9188 | |
| 9189 | C...Common constants. Colour factors for QCD and Abelian gluon theory. |
| 9190 | PMQ=ULMASS(KFL) |
| 9191 | QME=(2.*PMQ/ECM)**2 |
| 9192 | CT=LOG(1./CUT-5.) |
| 9193 | IF(MSTJ(109).EQ.0) THEN |
| 9194 | CF=4./3. |
| 9195 | CN=3. |
| 9196 | TR=2.5 |
| 9197 | ELSE |
| 9198 | CF=1. |
| 9199 | CN=0. |
| 9200 | TR=15. |
| 9201 | ENDIF |
| 9202 | |
| 9203 | C...Choice of process (qqbargg or qqbarqqbar). |
| 9204 | 100 NJET=4 |
| 9205 | IT=1 |
| 9206 | IF(PARJ(155).GT.RLU(0)) IT=2 |
| 9207 | IF(MSTJ(101).LE.-3) IT=-MSTJ(101)-2 |
| 9208 | IF(IT.EQ.1) WTMX=0.7/CUT**2 |
| 9209 | IF(IT.EQ.1.AND.MSTJ(109).EQ.2) WTMX=0.6/CUT**2 |
| 9210 | IF(IT.EQ.2) WTMX=0.1125*CF*TR/CUT**2 |
| 9211 | ID=1 |
| 9212 | |
| 9213 | C...Sample the five kinematical variables (for qqgg preweighted in y34). |
| 9214 | 110 Y134=3.*CUT+(1.-6.*CUT)*RLU(0) |
| 9215 | Y234=3.*CUT+(1.-6.*CUT)*RLU(0) |
| 9216 | IF(IT.EQ.1) Y34=(1.-5.*CUT)*EXP(-CT*RLU(0)) |
| 9217 | IF(IT.EQ.2) Y34=CUT+(1.-6.*CUT)*RLU(0) |
| 9218 | IF(Y34.LE.Y134+Y234-1..OR.Y34.GE.Y134*Y234) GOTO 110 |
| 9219 | VT=RLU(0) |
| 9220 | CP=COS(PARU(1)*RLU(0)) |
| 9221 | Y14=(Y134-Y34)*VT |
| 9222 | Y13=Y134-Y14-Y34 |
| 9223 | VB=Y34*(1.-Y134-Y234+Y34)/((Y134-Y34)*(Y234-Y34)) |
| 9224 | Y24=0.5*(Y234-Y34)*(1.-4.*SQRT(MAX(0.,VT*(1.-VT)*VB*(1.-VB)))* |
| 9225 | &CP-(1.-2.*VT)*(1.-2.*VB)) |
| 9226 | Y23=Y234-Y34-Y24 |
| 9227 | Y12=1.-Y134-Y23-Y24 |
| 9228 | IF(MIN(Y12,Y13,Y14,Y23,Y24).LE.CUT) GOTO 110 |
| 9229 | Y123=Y12+Y13+Y23 |
| 9230 | Y124=Y12+Y14+Y24 |
| 9231 | |
| 9232 | C...Calculate matrix elements for qqgg or qqqq process. |
| 9233 | IC=0 |
| 9234 | WTTOT=0. |
| 9235 | 120 IC=IC+1 |
| 9236 | IF(IT.EQ.1) THEN |
| 9237 | WTA(IC)=(Y12*Y34**2-Y13*Y24*Y34+Y14*Y23*Y34+3.*Y12*Y23*Y34+ |
| 9238 | & 3.*Y12*Y14*Y34+4.*Y12**2*Y34-Y13*Y23*Y24+2.*Y12*Y23*Y24- |
| 9239 | & Y13*Y14*Y24-2.*Y12*Y13*Y24+2.*Y12**2*Y24+Y14*Y23**2+2.*Y12* |
| 9240 | & Y23**2+Y14**2*Y23+4.*Y12*Y14*Y23+4.*Y12**2*Y23+2.*Y12*Y14**2+ |
| 9241 | & 2.*Y12*Y13*Y14+4.*Y12**2*Y14+2.*Y12**2*Y13+2.*Y12**3)/(2.*Y13* |
| 9242 | & Y134*Y234*Y24)+(Y24*Y34+Y12*Y34+Y13*Y24-Y14*Y23+Y12*Y13)/(Y13* |
| 9243 | & Y134**2)+2.*Y23*(1.-Y13)/(Y13*Y134*Y24)+Y34/(2.*Y13*Y24) |
| 9244 | WTB(IC)=(Y12*Y24*Y34+Y12*Y14*Y34-Y13*Y24**2+Y13*Y14*Y24+2.*Y12* |
| 9245 | & Y14*Y24)/(Y13*Y134*Y23*Y14)+Y12*(1.+Y34)*Y124/(Y134*Y234*Y14* |
| 9246 | & Y24)-(2.*Y13*Y24+Y14**2+Y13*Y23+2.*Y12*Y13)/(Y13*Y134*Y14)+ |
| 9247 | & Y12*Y123*Y124/(2.*Y13*Y14*Y23*Y24) |
| 9248 | WTC(IC)=-(5.*Y12*Y34**2+2.*Y12*Y24*Y34+2.*Y12*Y23*Y34+2.*Y12* |
| 9249 | & Y14*Y34+2.*Y12*Y13*Y34+4.*Y12**2*Y34-Y13*Y24**2+Y14*Y23*Y24+ |
| 9250 | & Y13*Y23*Y24+Y13*Y14*Y24-Y12*Y14*Y24-Y13**2*Y24-3.*Y12*Y13*Y24- |
| 9251 | & Y14*Y23**2-Y14**2*Y23+Y13*Y14*Y23-3.*Y12*Y14*Y23-Y12*Y13*Y23)/ |
| 9252 | & (4.*Y134*Y234*Y34**2)+(3.*Y12*Y34**2-3.*Y13*Y24*Y34+3.*Y12*Y24* |
| 9253 | & Y34+3.*Y14*Y23*Y34-Y13*Y24**2-Y12*Y23*Y34+6.*Y12*Y14*Y34+2.*Y12* |
| 9254 | & Y13*Y34-2.*Y12**2*Y34+Y14*Y23*Y24-3.*Y13*Y23*Y24-2.*Y13*Y14* |
| 9255 | & Y24+4.*Y12*Y14*Y24+2.*Y12*Y13*Y24+3.*Y14*Y23**2+2.*Y14**2*Y23+ |
| 9256 | & 2.*Y14**2*Y12+2.*Y12**2*Y14+6.*Y12*Y14*Y23-2.*Y12*Y13**2- |
| 9257 | & 2.*Y12**2*Y13)/(4.*Y13*Y134*Y234*Y34) |
| 9258 | WTC(IC)=WTC(IC)+(2.*Y12*Y34**2-2.*Y13*Y24*Y34+Y12*Y24*Y34+ |
| 9259 | & 4.*Y13*Y23*Y34+4.*Y12*Y14*Y34+2.*Y12*Y13*Y34+2.*Y12**2*Y34- |
| 9260 | & Y13*Y24**2+3.*Y14*Y23*Y24+4.*Y13*Y23*Y24-2.*Y13*Y14*Y24+ |
| 9261 | & 4.*Y12*Y14*Y24+2.*Y12*Y13*Y24+2.*Y14*Y23**2+4.*Y13*Y23**2+ |
| 9262 | & 2.*Y13*Y14*Y23+2.*Y12*Y14*Y23+4.*Y12*Y13*Y23+2.*Y12*Y14**2+4.* |
| 9263 | & Y12**2*Y13+4.*Y12*Y13*Y14+2.*Y12**2*Y14)/(4.*Y13*Y134*Y24*Y34)- |
| 9264 | & (Y12*Y34**2-2.*Y14*Y24*Y34-2.*Y13*Y24*Y34-Y14*Y23*Y34+Y13*Y23* |
| 9265 | & Y34+Y12*Y14*Y34+2.*Y12*Y13*Y34-2.*Y14**2*Y24-4.*Y13*Y14*Y24- |
| 9266 | & 4.*Y13**2*Y24-Y14**2*Y23-Y13**2*Y23+Y12*Y13*Y14-Y12*Y13**2)/ |
| 9267 | & (2.*Y13*Y34*Y134**2)+(Y12*Y34**2-4.*Y14*Y24*Y34-2.*Y13*Y24*Y34- |
| 9268 | & 2.*Y14*Y23*Y34-4.*Y13*Y23*Y34-4.*Y12*Y14*Y34-4.*Y12*Y13*Y34- |
| 9269 | & 2.*Y13*Y14*Y24+2.*Y13**2*Y24+2.*Y14**2*Y23-2.*Y13*Y14*Y23- |
| 9270 | & Y12*Y14**2-6.*Y12*Y13*Y14-Y12*Y13**2)/(4.*Y34**2*Y134**2) |
| 9271 | WTTOT=WTTOT+Y34*CF*(CF*WTA(IC)+(CF-0.5*CN)*WTB(IC)+CN*WTC(IC))/ |
| 9272 | & 8. |
| 9273 | ELSE |
| 9274 | WTD(IC)=(Y13*Y23*Y34+Y12*Y23*Y34-Y12**2*Y34+Y13*Y23*Y24+2.*Y12* |
| 9275 | & Y23*Y24-Y14*Y23**2+Y12*Y13*Y24+Y12*Y14*Y23+Y12*Y13*Y14)/(Y13**2* |
| 9276 | & Y123**2)-(Y12*Y34**2-Y13*Y24*Y34+Y12*Y24*Y34-Y14*Y23*Y34-Y12* |
| 9277 | & Y23*Y34-Y13*Y24**2+Y14*Y23*Y24-Y13*Y23*Y24-Y13**2*Y24+Y14* |
| 9278 | & Y23**2)/(Y13**2*Y123*Y134)+(Y13*Y14*Y12+Y34*Y14*Y12-Y34**2*Y12+ |
| 9279 | & Y13*Y14*Y24+2.*Y34*Y14*Y24-Y23*Y14**2+Y34*Y13*Y24+Y34*Y23*Y14+ |
| 9280 | & Y34*Y13*Y23)/(Y13**2*Y134**2)-(Y34*Y12**2-Y13*Y24*Y12+Y34*Y24* |
| 9281 | & Y12-Y23*Y14*Y12-Y34*Y14*Y12-Y13*Y24**2+Y23*Y14*Y24-Y13*Y14*Y24- |
| 9282 | & Y13**2*Y24+Y23*Y14**2)/(Y13**2*Y134*Y123) |
| 9283 | WTE(IC)=(Y12*Y34*(Y23-Y24+Y14+Y13)+Y13*Y24**2-Y14*Y23*Y24+Y13* |
| 9284 | & Y23*Y24+Y13*Y14*Y24+Y13**2*Y24-Y14*Y23*(Y14+Y23+Y13))/(Y13*Y23* |
| 9285 | & Y123*Y134)-Y12*(Y12*Y34-Y23*Y24-Y13*Y24-Y14*Y23-Y14*Y13)/(Y13* |
| 9286 | & Y23*Y123**2)-(Y14+Y13)*(Y24+Y23)*Y34/(Y13*Y23*Y134*Y234)+ |
| 9287 | & (Y12*Y34*(Y14-Y24+Y23+Y13)+Y13*Y24**2-Y23*Y14*Y24+Y13*Y14*Y24+ |
| 9288 | & Y13*Y23*Y24+Y13**2*Y24-Y23*Y14*(Y14+Y23+Y13))/(Y13*Y14*Y134* |
| 9289 | & Y123)-Y34*(Y34*Y12-Y14*Y24-Y13*Y24-Y23*Y14-Y23*Y13)/(Y13*Y14* |
| 9290 | & Y134**2)-(Y23+Y13)*(Y24+Y14)*Y12/(Y13*Y14*Y123*Y124) |
| 9291 | WTTOT=WTTOT+CF*(TR*WTD(IC)+(CF-0.5*CN)*WTE(IC))/16. |
| 9292 | ENDIF |
| 9293 | |
| 9294 | C...Permutations of momenta in matrix element. Weighting. |
| 9295 | 130 IF(IC.EQ.1.OR.IC.EQ.3.OR.ID.EQ.2.OR.ID.EQ.3) THEN |
| 9296 | YSAV=Y13 |
| 9297 | Y13=Y14 |
| 9298 | Y14=YSAV |
| 9299 | YSAV=Y23 |
| 9300 | Y23=Y24 |
| 9301 | Y24=YSAV |
| 9302 | YSAV=Y123 |
| 9303 | Y123=Y124 |
| 9304 | Y124=YSAV |
| 9305 | ENDIF |
| 9306 | IF(IC.EQ.2.OR.IC.EQ.4.OR.ID.EQ.3.OR.ID.EQ.4) THEN |
| 9307 | YSAV=Y13 |
| 9308 | Y13=Y23 |
| 9309 | Y23=YSAV |
| 9310 | YSAV=Y14 |
| 9311 | Y14=Y24 |
| 9312 | Y24=YSAV |
| 9313 | YSAV=Y134 |
| 9314 | Y134=Y234 |
| 9315 | Y234=YSAV |
| 9316 | ENDIF |
| 9317 | IF(IC.LE.3) GOTO 120 |
| 9318 | IF(ID.EQ.1.AND.WTTOT.LT.RLU(0)*WTMX) GOTO 110 |
| 9319 | IC=5 |
| 9320 | |
| 9321 | C...qqgg events: string configuration and event type. |
| 9322 | IF(IT.EQ.1) THEN |
| 9323 | IF(MSTJ(109).EQ.0.AND.ID.EQ.1) THEN |
| 9324 | PARJ(156)=Y34*(2.*(WTA(1)+WTA(2)+WTA(3)+WTA(4))+4.*(WTC(1)+ |
| 9325 | & WTC(2)+WTC(3)+WTC(4)))/(9.*WTTOT) |
| 9326 | IF(WTA(2)+WTA(4)+2.*(WTC(2)+WTC(4)).GT.RLU(0)*(WTA(1)+WTA(2)+ |
| 9327 | & WTA(3)+WTA(4)+2.*(WTC(1)+WTC(2)+WTC(3)+WTC(4)))) ID=2 |
| 9328 | IF(ID.EQ.2) GOTO 130 |
| 9329 | ELSEIF(MSTJ(109).EQ.2.AND.ID.EQ.1) THEN |
| 9330 | PARJ(156)=Y34*(WTA(1)+WTA(2)+WTA(3)+WTA(4))/(8.*WTTOT) |
| 9331 | IF(WTA(2)+WTA(4).GT.RLU(0)*(WTA(1)+WTA(2)+WTA(3)+WTA(4))) ID=2 |
| 9332 | IF(ID.EQ.2) GOTO 130 |
| 9333 | ENDIF |
| 9334 | MSTJ(120)=3 |
| 9335 | IF(MSTJ(109).EQ.0.AND.0.5*Y34*(WTC(1)+WTC(2)+WTC(3)+WTC(4)).GT. |
| 9336 | & RLU(0)*WTTOT) MSTJ(120)=4 |
| 9337 | KFLN=21 |
| 9338 | |
| 9339 | C...Mass cuts. Kinematical variables out. |
| 9340 | IF(Y12.LE.CUT+QME) NJET=2 |
| 9341 | IF(NJET.EQ.2) GOTO 150 |
| 9342 | Q12=0.5*(1.-SQRT(1.-QME/Y12)) |
| 9343 | X1=1.-(1.-Q12)*Y234-Q12*Y134 |
| 9344 | X4=1.-(1.-Q12)*Y134-Q12*Y234 |
| 9345 | X2=1.-Y124 |
| 9346 | X12=(1.-Q12)*Y13+Q12*Y23 |
| 9347 | X14=Y12-0.5*QME |
| 9348 | IF(Y134*Y234/((1.-X1)*(1.-X4)).LE.RLU(0)) NJET=2 |
| 9349 | |
| 9350 | C...qqbarqqbar events: string configuration, choose new flavour. |
| 9351 | ELSE |
| 9352 | IF(ID.EQ.1) THEN |
| 9353 | WTR=RLU(0)*(WTD(1)+WTD(2)+WTD(3)+WTD(4)) |
| 9354 | IF(WTR.LT.WTD(2)+WTD(3)+WTD(4)) ID=2 |
| 9355 | IF(WTR.LT.WTD(3)+WTD(4)) ID=3 |
| 9356 | IF(WTR.LT.WTD(4)) ID=4 |
| 9357 | IF(ID.GE.2) GOTO 130 |
| 9358 | ENDIF |
| 9359 | MSTJ(120)=5 |
| 9360 | PARJ(156)=CF*TR*(WTD(1)+WTD(2)+WTD(3)+WTD(4))/(16.*WTTOT) |
| 9361 | 140 KFLN=1+INT(5.*RLU(0)) |
| 9362 | IF(KFLN.NE.KFL.AND.0.2*PARJ(156).LE.RLU(0)) GOTO 140 |
| 9363 | IF(KFLN.EQ.KFL.AND.1.-0.8*PARJ(156).LE.RLU(0)) GOTO 140 |
| 9364 | IF(KFLN.GT.MSTJ(104)) NJET=2 |
| 9365 | PMQN=ULMASS(KFLN) |
| 9366 | QMEN=(2.*PMQN/ECM)**2 |
| 9367 | |
| 9368 | C...Mass cuts. Kinematical variables out. |
| 9369 | IF(Y24.LE.CUT+QME.OR.Y13.LE.1.1*QMEN) NJET=2 |
| 9370 | IF(NJET.EQ.2) GOTO 150 |
| 9371 | Q24=0.5*(1.-SQRT(1.-QME/Y24)) |
| 9372 | Q13=0.5*(1.-SQRT(1.-QMEN/Y13)) |
| 9373 | X1=1.-(1.-Q24)*Y123-Q24*Y134 |
| 9374 | X4=1.-(1.-Q24)*Y134-Q24*Y123 |
| 9375 | X2=1.-(1.-Q13)*Y234-Q13*Y124 |
| 9376 | X12=(1.-Q24)*((1.-Q13)*Y14+Q13*Y34)+Q24*((1.-Q13)*Y12+Q13*Y23) |
| 9377 | X14=Y24-0.5*QME |
| 9378 | X34=(1.-Q24)*((1.-Q13)*Y23+Q13*Y12)+Q24*((1.-Q13)*Y34+Q13*Y14) |
| 9379 | IF(PMQ**2+PMQN**2+MIN(X12,X34)*ECM**2.LE. |
| 9380 | & (PARJ(127)+PMQ+PMQN)**2) NJET=2 |
| 9381 | IF(Y123*Y134/((1.-X1)*(1.-X4)).LE.RLU(0)) NJET=2 |
| 9382 | ENDIF |
| 9383 | 150 IF(MSTJ(101).LE.-2.AND.NJET.EQ.2) GOTO 100 |
| 9384 | |
| 9385 | RETURN |
| 9386 | END |
| 9387 | |
| 9388 | C********************************************************************* |
| 9389 | |
| 9390 | SUBROUTINE LUXDIF(NC,NJET,KFL,ECM,CHI,THE,PHI) |
| 9391 | |
| 9392 | C...Purpose: to give the angular orientation of events. |
| 9393 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 9394 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 9395 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 9396 | SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ |
| 9397 | |
| 9398 | C...Charge. Factors depending on polarization for QED case. |
| 9399 | QF=KCHG(KFL,1)/3. |
| 9400 | POLL=1.-PARJ(131)*PARJ(132) |
| 9401 | POLD=PARJ(132)-PARJ(131) |
| 9402 | IF(MSTJ(102).LE.1.OR.MSTJ(109).EQ.1) THEN |
| 9403 | HF1=POLL |
| 9404 | HF2=0. |
| 9405 | HF3=PARJ(133)**2 |
| 9406 | HF4=0. |
| 9407 | |
| 9408 | C...Factors depending on flavour, energy and polarization for QFD case. |
| 9409 | ELSE |
| 9410 | SFF=1./(16.*PARU(102)*(1.-PARU(102))) |
| 9411 | SFW=ECM**4/((ECM**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2) |
| 9412 | SFI=SFW*(1.-(PARJ(123)/ECM)**2) |
| 9413 | AE=-1. |
| 9414 | VE=4.*PARU(102)-1. |
| 9415 | AF=SIGN(1.,QF) |
| 9416 | VF=AF-4.*QF*PARU(102) |
| 9417 | HF1=QF**2*POLL-2.*QF*VF*SFI*SFF*(VE*POLL-AE*POLD)+ |
| 9418 | & (VF**2+AF**2)*SFW*SFF**2*((VE**2+AE**2)*POLL-2.*VE*AE*POLD) |
| 9419 | HF2=-2.*QF*AF*SFI*SFF*(AE*POLL-VE*POLD)+2.*VF*AF*SFW*SFF**2* |
| 9420 | & (2.*VE*AE*POLL-(VE**2+AE**2)*POLD) |
| 9421 | HF3=PARJ(133)**2*(QF**2-2.*QF*VF*SFI*SFF*VE+(VF**2+AF**2)* |
| 9422 | & SFW*SFF**2*(VE**2-AE**2)) |
| 9423 | HF4=-PARJ(133)**2*2.*QF*VF*SFW*(PARJ(123)*PARJ(124)/ECM**2)* |
| 9424 | & SFF*AE |
| 9425 | ENDIF |
| 9426 | |
| 9427 | C...Mass factor. Differential cross-sections for two-jet events. |
| 9428 | SQ2=SQRT(2.) |
| 9429 | QME=0. |
| 9430 | IF(MSTJ(103).GE.4.AND.IABS(MSTJ(101)).LE.1.AND.MSTJ(102).LE.1.AND. |
| 9431 | &MSTJ(109).NE.1) QME=(2.*ULMASS(KFL)/ECM)**2 |
| 9432 | IF(NJET.EQ.2) THEN |
| 9433 | SIGU=4.*SQRT(1.-QME) |
| 9434 | SIGL=2.*QME*SQRT(1.-QME) |
| 9435 | SIGT=0. |
| 9436 | SIGI=0. |
| 9437 | SIGA=0. |
| 9438 | SIGP=4. |
| 9439 | |
| 9440 | C...Kinematical variables. Reduce four-jet event to three-jet one. |
| 9441 | ELSE |
| 9442 | IF(NJET.EQ.3) THEN |
| 9443 | X1=2.*P(NC+1,4)/ECM |
| 9444 | X2=2.*P(NC+3,4)/ECM |
| 9445 | ELSE |
| 9446 | ECMR=P(NC+1,4)+P(NC+4,4)+SQRT((P(NC+2,1)+P(NC+3,1))**2+ |
| 9447 | & (P(NC+2,2)+P(NC+3,2))**2+(P(NC+2,3)+P(NC+3,3))**2) |
| 9448 | X1=2.*P(NC+1,4)/ECMR |
| 9449 | X2=2.*P(NC+4,4)/ECMR |
| 9450 | ENDIF |
| 9451 | |
| 9452 | C...Differential cross-sections for three-jet (or reduced four-jet). |
| 9453 | XQ=(1.-X1)/(1.-X2) |
| 9454 | CT12=(X1*X2-2.*X1-2.*X2+2.+QME)/SQRT((X1**2-QME)*(X2**2-QME)) |
| 9455 | ST12=SQRT(1.-CT12**2) |
| 9456 | IF(MSTJ(109).NE.1) THEN |
| 9457 | SIGU=2.*X1**2+X2**2*(1.+CT12**2)-QME*(3.+CT12**2-X1-X2)- |
| 9458 | & QME*X1/XQ+0.5*QME*((X2**2-QME)*ST12**2-2.*X2)*XQ |
| 9459 | SIGL=(X2*ST12)**2-QME*(3.-CT12**2-2.5*(X1+X2)+X1*X2+QME)+ |
| 9460 | & 0.5*QME*(X1**2-X1-QME)/XQ+0.5*QME*((X2**2-QME)*CT12**2-X2)*XQ |
| 9461 | SIGT=0.5*(X2**2-QME-0.5*QME*(X2**2-QME)/XQ)*ST12**2 |
| 9462 | SIGI=((1.-0.5*QME*XQ)*(X2**2-QME)*ST12*CT12+QME*(1.-X1-X2+ |
| 9463 | & 0.5*X1*X2+0.5*QME)*ST12/CT12)/SQ2 |
| 9464 | SIGA=X2**2*ST12/SQ2 |
| 9465 | SIGP=2.*(X1**2-X2**2*CT12) |
| 9466 | |
| 9467 | C...Differential cross-sect for scalar gluons (no mass or QFD effects). |
| 9468 | ELSE |
| 9469 | SIGU=2.*(2.-X1-X2)**2-(X2*ST12)**2 |
| 9470 | SIGL=(X2*ST12)**2 |
| 9471 | SIGT=0.5*SIGL |
| 9472 | SIGI=-(2.-X1-X2)*X2*ST12/SQ2 |
| 9473 | SIGA=0. |
| 9474 | SIGP=0. |
| 9475 | ENDIF |
| 9476 | ENDIF |
| 9477 | |
| 9478 | C...Upper bounds for differential cross-section. |
| 9479 | HF1A=ABS(HF1) |
| 9480 | HF2A=ABS(HF2) |
| 9481 | HF3A=ABS(HF3) |
| 9482 | HF4A=ABS(HF4) |
| 9483 | SIGMAX=(2.*HF1A+HF3A+HF4A)*ABS(SIGU)+2.*(HF1A+HF3A+HF4A)* |
| 9484 | &ABS(SIGL)+2.*(HF1A+2.*HF3A+2.*HF4A)*ABS(SIGT)+2.*SQ2* |
| 9485 | &(HF1A+2.*HF3A+2.*HF4A)*ABS(SIGI)+4.*SQ2*HF2A*ABS(SIGA)+ |
| 9486 | &2.*HF2A*ABS(SIGP) |
| 9487 | |
| 9488 | C...Generate angular orientation according to differential cross-sect. |
| 9489 | 100 CHI=PARU(2)*RLU(0) |
| 9490 | CTHE=2.*RLU(0)-1. |
| 9491 | PHI=PARU(2)*RLU(0) |
| 9492 | CCHI=COS(CHI) |
| 9493 | SCHI=SIN(CHI) |
| 9494 | C2CHI=COS(2.*CHI) |
| 9495 | S2CHI=SIN(2.*CHI) |
| 9496 | THE=ACOS(CTHE) |
| 9497 | STHE=SIN(THE) |
| 9498 | C2PHI=COS(2.*(PHI-PARJ(134))) |
| 9499 | S2PHI=SIN(2.*(PHI-PARJ(134))) |
| 9500 | SIG=((1.+CTHE**2)*HF1+STHE**2*(C2PHI*HF3-S2PHI*HF4))*SIGU+ |
| 9501 | &2.*(STHE**2*HF1-STHE**2*(C2PHI*HF3-S2PHI*HF4))*SIGL+ |
| 9502 | &2.*(STHE**2*C2CHI*HF1+((1.+CTHE**2)*C2CHI*C2PHI-2.*CTHE*S2CHI* |
| 9503 | &S2PHI)*HF3-((1.+CTHE**2)*C2CHI*S2PHI+2.*CTHE*S2CHI*C2PHI)*HF4)* |
| 9504 | &SIGT-2.*SQ2*(2.*STHE*CTHE*CCHI*HF1-2.*STHE*(CTHE*CCHI*C2PHI- |
| 9505 | &SCHI*S2PHI)*HF3+2.*STHE*(CTHE*CCHI*S2PHI+SCHI*C2PHI)*HF4)*SIGI+ |
| 9506 | &4.*SQ2*STHE*CCHI*HF2*SIGA+2.*CTHE*HF2*SIGP |
| 9507 | IF(SIG.LT.SIGMAX*RLU(0)) GOTO 100 |
| 9508 | |
| 9509 | RETURN |
| 9510 | END |
| 9511 | |
| 9512 | C********************************************************************* |
| 9513 | |
| 9514 | SUBROUTINE LUONIA(KFL,ECM) |
| 9515 | |
| 9516 | C...Purpose: to generate Upsilon and toponium decays into three |
| 9517 | C...gluons or two gluons and a photon. |
| 9518 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 9519 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 9520 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 9521 | SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ |
| 9522 | |
| 9523 | C...Printout. Check input parameters. |
| 9524 | IF(MSTU(12).GE.1) CALL LULIST(0) |
| 9525 | IF(KFL.LT.0.OR.KFL.GT.8) THEN |
| 9526 | CALL LUERRM(16,'(LUONIA:) called with unknown flavour code') |
| 9527 | IF(MSTU(21).GE.1) RETURN |
| 9528 | ENDIF |
| 9529 | IF(ECM.LT.PARJ(127)+2.02*PARF(101)) THEN |
| 9530 | CALL LUERRM(16,'(LUONIA:) called with too small CM energy') |
| 9531 | IF(MSTU(21).GE.1) RETURN |
| 9532 | ENDIF |
| 9533 | |
| 9534 | C...Initial e+e- and onium state (optional). |
| 9535 | NC=0 |
| 9536 | IF(MSTJ(115).GE.2) THEN |
| 9537 | NC=NC+2 |
| 9538 | CALL LU1ENT(NC-1,11,0.5*ECM,0.,0.) |
| 9539 | K(NC-1,1)=21 |
| 9540 | CALL LU1ENT(NC,-11,0.5*ECM,PARU(1),0.) |
| 9541 | K(NC,1)=21 |
| 9542 | ENDIF |
| 9543 | KFLC=IABS(KFL) |
| 9544 | IF(MSTJ(115).GE.3.AND.KFLC.GE.5) THEN |
| 9545 | NC=NC+1 |
| 9546 | KF=110*KFLC+3 |
| 9547 | MSTU10=MSTU(10) |
| 9548 | MSTU(10)=1 |
| 9549 | P(NC,5)=ECM |
| 9550 | CALL LU1ENT(NC,KF,ECM,0.,0.) |
| 9551 | K(NC,1)=21 |
| 9552 | K(NC,3)=1 |
| 9553 | MSTU(10)=MSTU10 |
| 9554 | ENDIF |
| 9555 | |
| 9556 | C...Choose x1 and x2 according to matrix element. |
| 9557 | NTRY=0 |
| 9558 | 100 X1=RLU(0) |
| 9559 | X2=RLU(0) |
| 9560 | X3=2.-X1-X2 |
| 9561 | IF(X3.GE.1..OR.((1.-X1)/(X2*X3))**2+((1.-X2)/(X1*X3))**2+ |
| 9562 | &((1.-X3)/(X1*X2))**2.LE.2.*RLU(0)) GOTO 100 |
| 9563 | NTRY=NTRY+1 |
| 9564 | NJET=3 |
| 9565 | IF(MSTJ(101).LE.4) CALL LU3ENT(NC+1,21,21,21,ECM,X1,X3) |
| 9566 | IF(MSTJ(101).GE.5) CALL LU3ENT(-(NC+1),21,21,21,ECM,X1,X3) |
| 9567 | |
| 9568 | C...Photon-gluon-gluon events. Small system modifications. Jet origin. |
| 9569 | MSTU(111)=MSTJ(108) |
| 9570 | IF(MSTJ(108).EQ.2.AND.(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.1)) |
| 9571 | &MSTU(111)=1 |
| 9572 | PARU(112)=PARJ(121) |
| 9573 | IF(MSTU(111).EQ.2) PARU(112)=PARJ(122) |
| 9574 | QF=0. |
| 9575 | IF(KFLC.NE.0) QF=KCHG(KFLC,1)/3. |
| 9576 | RGAM=7.2*QF**2*PARU(101)/ULALPS(ECM**2) |
| 9577 | MK=0 |
| 9578 | ECMC=ECM |
| 9579 | IF(RLU(0).GT.RGAM/(1.+RGAM)) THEN |
| 9580 | IF(1.-MAX(X1,X2,X3).LE.MAX((PARJ(126)/ECM)**2,PARJ(125))) |
| 9581 | & NJET=2 |
| 9582 | IF(NJET.EQ.2.AND.MSTJ(101).LE.4) CALL LU2ENT(NC+1,21,21,ECM) |
| 9583 | IF(NJET.EQ.2.AND.MSTJ(101).GE.5) CALL LU2ENT(-(NC+1),21,21,ECM) |
| 9584 | ELSE |
| 9585 | MK=1 |
| 9586 | ECMC=SQRT(1.-X1)*ECM |
| 9587 | IF(ECMC.LT.2.*PARJ(127)) GOTO 100 |
| 9588 | K(NC+1,1)=1 |
| 9589 | K(NC+1,2)=22 |
| 9590 | K(NC+1,4)=0 |
| 9591 | K(NC+1,5)=0 |
| 9592 | IF(MSTJ(101).GE.5) K(NC+2,4)=MSTU(5)*(NC+3) |
| 9593 | IF(MSTJ(101).GE.5) K(NC+2,5)=MSTU(5)*(NC+3) |
| 9594 | IF(MSTJ(101).GE.5) K(NC+3,4)=MSTU(5)*(NC+2) |
| 9595 | IF(MSTJ(101).GE.5) K(NC+3,5)=MSTU(5)*(NC+2) |
| 9596 | NJET=2 |
| 9597 | IF(ECMC.LT.4.*PARJ(127)) THEN |
| 9598 | MSTU10=MSTU(10) |
| 9599 | MSTU(10)=1 |
| 9600 | P(NC+2,5)=ECMC |
| 9601 | CALL LU1ENT(NC+2,83,0.5*(X2+X3)*ECM,PARU(1),0.) |
| 9602 | MSTU(10)=MSTU10 |
| 9603 | NJET=0 |
| 9604 | ENDIF |
| 9605 | ENDIF |
| 9606 | DO 110 IP=NC+1,N |
| 9607 | 110 K(IP,3)=K(IP,3)+(MSTJ(115)/2)+(KFLC/5)*(MSTJ(115)/3)*(NC-1) |
| 9608 | |
| 9609 | C...Differential cross-sections. Upper limit for cross-section. |
| 9610 | IF(MSTJ(106).EQ.1) THEN |
| 9611 | SQ2=SQRT(2.) |
| 9612 | HF1=1.-PARJ(131)*PARJ(132) |
| 9613 | HF3=PARJ(133)**2 |
| 9614 | CT13=(X1*X3-2.*X1-2.*X3+2.)/(X1*X3) |
| 9615 | ST13=SQRT(1.-CT13**2) |
| 9616 | SIGL=0.5*X3**2*((1.-X2)**2+(1.-X3)**2)*ST13**2 |
| 9617 | SIGU=(X1*(1.-X1))**2+(X2*(1.-X2))**2+(X3*(1.-X3))**2-SIGL |
| 9618 | SIGT=0.5*SIGL |
| 9619 | SIGI=(SIGL*CT13/ST13+0.5*X1*X3*(1.-X2)**2*ST13)/SQ2 |
| 9620 | SIGMAX=(2.*HF1+HF3)*ABS(SIGU)+2.*(HF1+HF3)*ABS(SIGL)+2.*(HF1+ |
| 9621 | & 2.*HF3)*ABS(SIGT)+2.*SQ2*(HF1+2.*HF3)*ABS(SIGI) |
| 9622 | |
| 9623 | C...Angular orientation of event. |
| 9624 | 120 CHI=PARU(2)*RLU(0) |
| 9625 | CTHE=2.*RLU(0)-1. |
| 9626 | PHI=PARU(2)*RLU(0) |
| 9627 | CCHI=COS(CHI) |
| 9628 | SCHI=SIN(CHI) |
| 9629 | C2CHI=COS(2.*CHI) |
| 9630 | S2CHI=SIN(2.*CHI) |
| 9631 | THE=ACOS(CTHE) |
| 9632 | STHE=SIN(THE) |
| 9633 | C2PHI=COS(2.*(PHI-PARJ(134))) |
| 9634 | S2PHI=SIN(2.*(PHI-PARJ(134))) |
| 9635 | SIG=((1.+CTHE**2)*HF1+STHE**2*C2PHI*HF3)*SIGU+2.*(STHE**2*HF1- |
| 9636 | & STHE**2*C2PHI*HF3)*SIGL+2.*(STHE**2*C2CHI*HF1+((1.+CTHE**2)* |
| 9637 | & C2CHI*C2PHI-2.*CTHE*S2CHI*S2PHI)*HF3)*SIGT-2.*SQ2*(2.*STHE*CTHE* |
| 9638 | & CCHI*HF1-2.*STHE*(CTHE*CCHI*C2PHI-SCHI*S2PHI)*HF3)*SIGI |
| 9639 | IF(SIG.LT.SIGMAX*RLU(0)) GOTO 120 |
| 9640 | CALL LUDBRB(NC+1,N,0.,CHI,0D0,0D0,0D0) |
| 9641 | CALL LUDBRB(NC+1,N,THE,PHI,0D0,0D0,0D0) |
| 9642 | ENDIF |
| 9643 | |
| 9644 | C...Generate parton shower. Rearrange along strings and check. |
| 9645 | IF(MSTJ(101).GE.5.AND.NJET.GE.2) THEN |
| 9646 | CALL LUSHOW(NC+MK+1,-NJET,ECMC) |
| 9647 | MSTJ14=MSTJ(14) |
| 9648 | IF(MSTJ(105).EQ.-1) MSTJ(14)=-1 |
| 9649 | IF(MSTJ(105).GE.0) MSTU(28)=0 |
| 9650 | CALL LUPREP(0) |
| 9651 | MSTJ(14)=MSTJ14 |
| 9652 | IF(MSTJ(105).GE.0.AND.MSTU(28).NE.0) GOTO 100 |
| 9653 | ENDIF |
| 9654 | |
| 9655 | C...Generate fragmentation. Information for LUTABU: |
| 9656 | IF(MSTJ(105).EQ.1) CALL LUEXEC |
| 9657 | MSTU(161)=110*KFLC+3 |
| 9658 | MSTU(162)=0 |
| 9659 | |
| 9660 | RETURN |
| 9661 | END |
| 9662 | |
| 9663 | C********************************************************************* |
| 9664 | |
| 9665 | SUBROUTINE LUHEPC(MCONV) |
| 9666 | |
| 9667 | C...Purpose: to convert JETSET event record contents to or from |
| 9668 | C...the standard event record commonblock. |
| 9669 | PARAMETER (NMXHEP=2000) |
| 9670 | COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), |
| 9671 | &JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP) |
| 9672 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 9673 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 9674 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 9675 | SAVE /HEPEVT/ |
| 9676 | SAVE /LUJETS/,/LUDAT1/,/LUDAT2/ |
| 9677 | |
| 9678 | C...Conversion from JETSET to standard, the easy part. |
| 9679 | IF(MCONV.EQ.1) THEN |
| 9680 | NEVHEP=0 |
| 9681 | IF(N.GT.NMXHEP) CALL LUERRM(8, |
| 9682 | & '(LUHEPC:) no more space in /HEPEVT/') |
| 9683 | NHEP=MIN(N,NMXHEP) |
| 9684 | DO 140 I=1,NHEP |
| 9685 | ISTHEP(I)=0 |
| 9686 | IF(K(I,1).GE.1.AND.K(I,1).LE.10) ISTHEP(I)=1 |
| 9687 | IF(K(I,1).GE.11.AND.K(I,1).LE.20) ISTHEP(I)=2 |
| 9688 | IF(K(I,1).GE.21.AND.K(I,1).LE.30) ISTHEP(I)=3 |
| 9689 | IF(K(I,1).GE.31.AND.K(I,1).LE.100) ISTHEP(I)=K(I,1) |
| 9690 | IDHEP(I)=K(I,2) |
| 9691 | JMOHEP(1,I)=K(I,3) |
| 9692 | JMOHEP(2,I)=0 |
| 9693 | IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) THEN |
| 9694 | JDAHEP(1,I)=K(I,4) |
| 9695 | JDAHEP(2,I)=K(I,5) |
| 9696 | ELSE |
| 9697 | JDAHEP(1,I)=0 |
| 9698 | JDAHEP(2,I)=0 |
| 9699 | ENDIF |
| 9700 | DO 100 J=1,5 |
| 9701 | 100 PHEP(J,I)=P(I,J) |
| 9702 | DO 110 J=1,4 |
| 9703 | 110 VHEP(J,I)=V(I,J) |
| 9704 | |
| 9705 | C...Fill in missing mother information. |
| 9706 | IF(I.GE.3.AND.K(I,1).EQ.21.AND.K(I,3).EQ.0) THEN |
| 9707 | IMO1=I-2 |
| 9708 | IF(I.GE.4.AND.K(I-1,1).EQ.21.AND.K(I-1,3).EQ.0) IMO1=IMO1-1 |
| 9709 | JMOHEP(1,I)=IMO1 |
| 9710 | JMOHEP(2,I)=IMO1+1 |
| 9711 | ELSEIF(K(I,2).GE.91.AND.K(I,2).LE.93) THEN |
| 9712 | I1=K(I,3)-1 |
| 9713 | 120 I1=I1+1 |
| 9714 | IF(I1.GE.I) CALL LUERRM(8, |
| 9715 | & '(LUHEPC:) translation of inconsistent event history') |
| 9716 | IF(I1.LT.I.AND.K(I1,1).NE.1.AND.K(I1,1).NE.11) GOTO 120 |
| 9717 | KC=LUCOMP(K(I1,2)) |
| 9718 | IF(I1.LT.I.AND.KC.EQ.0) GOTO 120 |
| 9719 | IF(I1.LT.I.AND.KCHG(KC,2).EQ.0) GOTO 120 |
| 9720 | JMOHEP(2,I)=I1 |
| 9721 | ELSEIF(K(I,2).EQ.94) THEN |
| 9722 | NJET=2 |
| 9723 | IF(NHEP.GE.I+3.AND.K(I+3,3).LE.I) NJET=3 |
| 9724 | IF(NHEP.GE.I+4.AND.K(I+4,3).LE.I) NJET=4 |
| 9725 | JMOHEP(2,I)=MOD(K(I+NJET,4)/MSTU(5),MSTU(5)) |
| 9726 | IF(JMOHEP(2,I).EQ.JMOHEP(1,I)) JMOHEP(2,I)= |
| 9727 | & MOD(K(I+1,4)/MSTU(5),MSTU(5)) |
| 9728 | ENDIF |
| 9729 | |
| 9730 | C...Fill in missing daughter information. |
| 9731 | IF(K(I,2).EQ.94.AND.MSTU(16).NE.2) THEN |
| 9732 | DO 130 I1=JDAHEP(1,I),JDAHEP(2,I) |
| 9733 | I2=MOD(K(I1,4)/MSTU(5),MSTU(5)) |
| 9734 | 130 JDAHEP(1,I2)=I |
| 9735 | ENDIF |
| 9736 | IF(K(I,2).GE.91.AND.K(I,2).LE.94) GOTO 140 |
| 9737 | I1=JMOHEP(1,I) |
| 9738 | IF(I1.LE.0.OR.I1.GT.NHEP) GOTO 140 |
| 9739 | IF(K(I1,1).NE.13.AND.K(I1,1).NE.14) GOTO 140 |
| 9740 | IF(JDAHEP(1,I1).EQ.0) THEN |
| 9741 | JDAHEP(1,I1)=I |
| 9742 | ELSE |
| 9743 | JDAHEP(2,I1)=I |
| 9744 | ENDIF |
| 9745 | 140 CONTINUE |
| 9746 | DO 150 I=1,NHEP |
| 9747 | IF(K(I,1).NE.13.AND.K(I,1).NE.14) GOTO 150 |
| 9748 | IF(JDAHEP(2,I).EQ.0) JDAHEP(2,I)=JDAHEP(1,I) |
| 9749 | 150 CONTINUE |
| 9750 | |
| 9751 | C...Conversion from standard to JETSET, the easy part. |
| 9752 | ELSE |
| 9753 | IF(NHEP.GT.MSTU(4)) CALL LUERRM(8, |
| 9754 | & '(LUHEPC:) no more space in /LUJETS/') |
| 9755 | N=MIN(NHEP,MSTU(4)) |
| 9756 | NKQ=0 |
| 9757 | KQSUM=0 |
| 9758 | DO 180 I=1,N |
| 9759 | K(I,1)=0 |
| 9760 | IF(ISTHEP(I).EQ.1) K(I,1)=1 |
| 9761 | IF(ISTHEP(I).EQ.2) K(I,1)=11 |
| 9762 | IF(ISTHEP(I).EQ.3) K(I,1)=21 |
| 9763 | K(I,2)=IDHEP(I) |
| 9764 | K(I,3)=JMOHEP(1,I) |
| 9765 | K(I,4)=JDAHEP(1,I) |
| 9766 | K(I,5)=JDAHEP(2,I) |
| 9767 | DO 160 J=1,5 |
| 9768 | 160 P(I,J)=PHEP(J,I) |
| 9769 | DO 170 J=1,4 |
| 9770 | 170 V(I,J)=VHEP(J,I) |
| 9771 | V(I,5)=0. |
| 9772 | IF(ISTHEP(I).EQ.2.AND.PHEP(4,I).GT.PHEP(5,I)) THEN |
| 9773 | I1=JDAHEP(1,I) |
| 9774 | IF(I1.GT.0.AND.I1.LE.NHEP) V(I,5)=(VHEP(4,I1)-VHEP(4,I))* |
| 9775 | & PHEP(5,I)/PHEP(4,I) |
| 9776 | ENDIF |
| 9777 | |
| 9778 | C...Fill in missing information on colour connection in jet systems. |
| 9779 | IF(ISTHEP(I).EQ.1) THEN |
| 9780 | KC=LUCOMP(K(I,2)) |
| 9781 | KQ=0 |
| 9782 | IF(KC.NE.0) KQ=KCHG(KC,2)*ISIGN(1,K(I,2)) |
| 9783 | IF(KQ.NE.0) NKQ=NKQ+1 |
| 9784 | IF(KQ.NE.2) KQSUM=KQSUM+KQ |
| 9785 | IF(KQ.NE.0.AND.KQSUM.NE.0) THEN |
| 9786 | K(I,1)=2 |
| 9787 | ELSEIF(KQ.EQ.2.AND.I.LT.N) THEN |
| 9788 | IF(K(I+1,2).EQ.21) K(I,1)=2 |
| 9789 | ENDIF |
| 9790 | ENDIF |
| 9791 | 180 CONTINUE |
| 9792 | IF(NKQ.EQ.1.OR.KQSUM.NE.0) CALL LUERRM(8, |
| 9793 | & '(LUHEPC:) input parton configuration not colour singlet') |
| 9794 | ENDIF |
| 9795 | |
| 9796 | END |
| 9797 | |
| 9798 | C********************************************************************* |
| 9799 | |
| 9800 | SUBROUTINE LUTEST(MTEST) |
| 9801 | |
| 9802 | C...Purpose: to provide a simple program (disguised as subroutine) to |
| 9803 | C...run at installation as a check that the program works as intended. |
| 9804 | COMMON/LUJETS/N,K(150000,5),P(150000,5),V(150000,5) |
| 9805 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 9806 | SAVE /LUJETS/,/LUDAT1/ |
| 9807 | DIMENSION PSUM(5),PINI(6),PFIN(6) |
| 9808 | |
| 9809 | C...Loop over events to be generated. |
| 9810 | IF(MTEST.GE.1) CALL LUTABU(20) |
| 9811 | NERR=0 |
| 9812 | DO 170 IEV=1,600 |
| 9813 | |
| 9814 | C...Reset parameter values. Switch on some nonstandard features. |
| 9815 | MSTJ(1)=1 |
| 9816 | MSTJ(3)=0 |
| 9817 | MSTJ(11)=1 |
| 9818 | MSTJ(42)=2 |
| 9819 | MSTJ(43)=4 |
| 9820 | MSTJ(44)=2 |
| 9821 | PARJ(17)=0.1 |
| 9822 | PARJ(22)=1.5 |
| 9823 | PARJ(43)=1. |
| 9824 | PARJ(54)=-0.05 |
| 9825 | MSTJ(101)=5 |
| 9826 | MSTJ(104)=5 |
| 9827 | MSTJ(105)=0 |
| 9828 | MSTJ(107)=1 |
| 9829 | IF(IEV.EQ.301.OR.IEV.EQ.351.OR.IEV.EQ.401) MSTJ(116)=3 |
| 9830 | |
| 9831 | C...Ten events each for some single jets configurations. |
| 9832 | IF(IEV.LE.50) THEN |
| 9833 | ITY=(IEV+9)/10 |
| 9834 | MSTJ(3)=-1 |
| 9835 | IF(ITY.EQ.3.OR.ITY.EQ.4) MSTJ(11)=2 |
| 9836 | IF(ITY.EQ.1) CALL LU1ENT(1,1,15.,0.,0.) |
| 9837 | IF(ITY.EQ.2) CALL LU1ENT(1,3101,15.,0.,0.) |
| 9838 | IF(ITY.EQ.3) CALL LU1ENT(1,-2203,15.,0.,0.) |
| 9839 | IF(ITY.EQ.4) CALL LU1ENT(1,-4,30.,0.,0.) |
| 9840 | IF(ITY.EQ.5) CALL LU1ENT(1,21,15.,0.,0.) |
| 9841 | |
| 9842 | C...Ten events each for some simple jet systems; string fragmentation. |
| 9843 | ELSEIF(IEV.LE.130) THEN |
| 9844 | ITY=(IEV-41)/10 |
| 9845 | IF(ITY.EQ.1) CALL LU2ENT(1,1,-1,40.) |
| 9846 | IF(ITY.EQ.2) CALL LU2ENT(1,4,-4,30.) |
| 9847 | IF(ITY.EQ.3) CALL LU2ENT(1,2,2103,100.) |
| 9848 | IF(ITY.EQ.4) CALL LU2ENT(1,21,21,40.) |
| 9849 | IF(ITY.EQ.5) CALL LU3ENT(1,2101,21,-3203,30.,0.6,0.8) |
| 9850 | IF(ITY.EQ.6) CALL LU3ENT(1,5,21,-5,40.,0.9,0.8) |
| 9851 | IF(ITY.EQ.7) CALL LU3ENT(1,21,21,21,60.,0.7,0.5) |
| 9852 | IF(ITY.EQ.8) CALL LU4ENT(1,2,21,21,-2,40.,0.4,0.64,0.6,0.12,0.2) |
| 9853 | |
| 9854 | C...Seventy events with independent fragmentation and momentum cons. |
| 9855 | ELSEIF(IEV.LE.200) THEN |
| 9856 | ITY=1+(IEV-131)/16 |
| 9857 | MSTJ(2)=1+MOD(IEV-131,4) |
| 9858 | MSTJ(3)=1+MOD((IEV-131)/4,4) |
| 9859 | IF(ITY.EQ.1) CALL LU2ENT(1,4,-5,40.) |
| 9860 | IF(ITY.EQ.2) CALL LU3ENT(1,3,21,-3,40.,0.9,0.4) |
| 9861 | IF(ITY.EQ.3) CALL LU4ENT(1,2,21,21,-2,40.,0.4,0.64,0.6,0.12,0.2) |
| 9862 | IF(ITY.GE.4) CALL LU4ENT(1,2,-3,3,-2,40.,0.4,0.64,0.6,0.12,0.2) |
| 9863 | |
| 9864 | C...A hundred events with random jets (check invariant mass). |
| 9865 | ELSEIF(IEV.LE.300) THEN |
| 9866 | 100 DO 110 J=1,5 |
| 9867 | 110 PSUM(J)=0. |
| 9868 | NJET=2.+6.*RLU(0) |
| 9869 | DO 120 I=1,NJET |
| 9870 | KFL=21 |
| 9871 | IF(I.EQ.1) KFL=INT(1.+4.*RLU(0)) |
| 9872 | IF(I.EQ.NJET) KFL=-INT(1.+4.*RLU(0)) |
| 9873 | EJET=5.+20.*RLU(0) |
| 9874 | THETA=ACOS(2.*RLU(0)-1.) |
| 9875 | PHI=6.2832*RLU(0) |
| 9876 | IF(I.LT.NJET) CALL LU1ENT(-I,KFL,EJET,THETA,PHI) |
| 9877 | IF(I.EQ.NJET) CALL LU1ENT(I,KFL,EJET,THETA,PHI) |
| 9878 | IF(I.EQ.1.OR.I.EQ.NJET) PSUM(5)=PSUM(5)+ULMASS(KFL) |
| 9879 | DO 120 J=1,4 |
| 9880 | 120 PSUM(J)=PSUM(J)+P(I,J) |
| 9881 | IF(PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-PSUM(3)**2.LT. |
| 9882 | & (PSUM(5)+PARJ(32))**2) GOTO 100 |
| 9883 | |
| 9884 | C...Fifty e+e- continuum events with matrix elements. |
| 9885 | ELSEIF(IEV.LE.350) THEN |
| 9886 | MSTJ(101)=2 |
| 9887 | CALL LUEEVT(0,40.) |
| 9888 | |
| 9889 | C...Fifty e+e- continuum event with varying shower options. |
| 9890 | ELSEIF(IEV.LE.400) THEN |
| 9891 | MSTJ(42)=1+MOD(IEV,2) |
| 9892 | MSTJ(43)=1+MOD(IEV/2,4) |
| 9893 | MSTJ(44)=MOD(IEV/8,3) |
| 9894 | CALL LUEEVT(0,90.) |
| 9895 | |
| 9896 | C...Fifty e+e- continuum events with coherent shower, including top. |
| 9897 | ELSEIF(IEV.LE.450) THEN |
| 9898 | MSTJ(104)=6 |
| 9899 | CALL LUEEVT(0,500.) |
| 9900 | |
| 9901 | C...Fifty Upsilon decays to ggg or gammagg with coherent shower. |
| 9902 | ELSEIF(IEV.LE.500) THEN |
| 9903 | CALL LUONIA(5,9.46) |
| 9904 | |
| 9905 | C...One decay each for some heavy mesons. |
| 9906 | ELSEIF(IEV.LE.560) THEN |
| 9907 | ITY=IEV-501 |
| 9908 | KFLS=2*(ITY/20)+1 |
| 9909 | KFLB=8-MOD(ITY/5,4) |
| 9910 | KFLC=KFLB-MOD(ITY,5) |
| 9911 | CALL LU1ENT(1,100*KFLB+10*KFLC+KFLS,0.,0.,0.) |
| 9912 | |
| 9913 | C...One decay each for some heavy baryons. |
| 9914 | ELSEIF(IEV.LE.600) THEN |
| 9915 | ITY=IEV-561 |
| 9916 | KFLS=2*(ITY/20)+2 |
| 9917 | KFLA=8-MOD(ITY/5,4) |
| 9918 | KFLB=KFLA-MOD(ITY,5) |
| 9919 | KFLC=MAX(1,KFLB-1) |
| 9920 | CALL LU1ENT(1,1000*KFLA+100*KFLB+10*KFLC+KFLS,0.,0.,0.) |
| 9921 | ENDIF |
| 9922 | |
| 9923 | C...Generate event. Find total momentum, energy and charge. |
| 9924 | DO 130 J=1,4 |
| 9925 | 130 PINI(J)=PLU(0,J) |
| 9926 | PINI(6)=PLU(0,6) |
| 9927 | CALL LUEXEC |
| 9928 | DO 140 J=1,4 |
| 9929 | 140 PFIN(J)=PLU(0,J) |
| 9930 | PFIN(6)=PLU(0,6) |
| 9931 | |
| 9932 | C...Check conservation of energy, momentum and charge; |
| 9933 | C...usually exact, but only approximate for single jets. |
| 9934 | MERR=0 |
| 9935 | IF(IEV.LE.50) THEN |
| 9936 | IF((PFIN(1)-PINI(1))**2+(PFIN(2)-PINI(2))**2.GE.4.) MERR=MERR+1 |
| 9937 | EPZREM=PINI(4)+PINI(3)-PFIN(4)-PFIN(3) |
| 9938 | IF(EPZREM.LT.0..OR.EPZREM.GT.2.*PARJ(31)) MERR=MERR+1 |
| 9939 | IF(ABS(PFIN(6)-PINI(6)).GT.2.1) MERR=MERR+1 |
| 9940 | ELSE |
| 9941 | DO 150 J=1,4 |
| 9942 | 150 IF(ABS(PFIN(J)-PINI(J)).GT.0001*PINI(4)) MERR=MERR+1 |
| 9943 | IF(ABS(PFIN(6)-PINI(6)).GT.0.1) MERR=MERR+1 |
| 9944 | ENDIF |
| 9945 | IF(MERR.NE.0) WRITE(MSTU(11),5000) (PINI(J),J=1,4),PINI(6), |
| 9946 | &(PFIN(J),J=1,4),PFIN(6) |
| 9947 | |
| 9948 | C...Check that all KF codes are known ones, and that partons/particles |
| 9949 | C...satisfy energy-momentum-mass relation. Store particle statistics. |
| 9950 | DO 160 I=1,N |
| 9951 | IF(K(I,1).GT.20) GOTO 160 |
| 9952 | IF(LUCOMP(K(I,2)).EQ.0) THEN |
| 9953 | WRITE(MSTU(11),5100) I |
| 9954 | MERR=MERR+1 |
| 9955 | ENDIF |
| 9956 | PD=P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2-P(I,5)**2 |
| 9957 | IF(ABS(PD).GT.MAX(0.1,0.001*P(I,4)**2).OR.P(I,4).LT.0.) THEN |
| 9958 | WRITE(MSTU(11),5200) I |
| 9959 | MERR=MERR+1 |
| 9960 | ENDIF |
| 9961 | 160 CONTINUE |
| 9962 | IF(MTEST.GE.1) CALL LUTABU(21) |
| 9963 | |
| 9964 | C...List all erroneous events and some normal ones. |
| 9965 | IF(MERR.NE.0.OR.MSTU(24).NE.0.OR.MSTU(28).NE.0) THEN |
| 9966 | CALL LULIST(2) |
| 9967 | ELSEIF(MTEST.GE.1.AND.MOD(IEV-5,100).EQ.0) THEN |
| 9968 | CALL LULIST(1) |
| 9969 | ENDIF |
| 9970 | |
| 9971 | C...Stop execution if too many errors. Endresult of run. |
| 9972 | IF(MERR.NE.0) NERR=NERR+1 |
| 9973 | IF(NERR.GE.10) THEN |
| 9974 | WRITE(MSTU(11),5300) IEV |
| 9975 | STOP |
| 9976 | ENDIF |
| 9977 | 170 CONTINUE |
| 9978 | IF(MTEST.GE.1) CALL LUTABU(22) |
| 9979 | WRITE(MSTU(11),5400) NERR |
| 9980 | |
| 9981 | C...Reset commonblock variables changed during run. |
| 9982 | MSTJ(2)=3 |
| 9983 | PARJ(17)=0. |
| 9984 | PARJ(22)=1. |
| 9985 | PARJ(43)=0.5 |
| 9986 | PARJ(54)=0. |
| 9987 | MSTJ(105)=1 |
| 9988 | MSTJ(107)=0 |
| 9989 | |
| 9990 | C...Format statements for output. |
| 9991 | 5000 FORMAT(/' Momentum, energy and/or charge were not conserved ', |
| 9992 | &'in following event'/' sum of',9X,'px',11X,'py',11X,'pz',11X, |
| 9993 | &'E',8X,'charge'/' before',2X,4(1X,F12.5),1X,F8.2/' after',3X, |
| 9994 | &4(1X,F12.5),1X,F8.2) |
| 9995 | 5100 FORMAT(/5X,'Entry no.',I4,' in following event not known code') |
| 9996 | 5200 FORMAT(/5X,'Entry no.',I4,' in following event has faulty ', |
| 9997 | &'kinematics') |
| 9998 | 5300 FORMAT(/5X,'Ten errors experienced by event ',I3/ |
| 9999 | &5X,'Something is seriously wrong! Execution stopped now!') |
| 10000 | 5400 FORMAT(/5X,'Number of erroneous or suspect events in run:',I3/ |
| 10001 | &5X,'(0 fine, 1 acceptable if a single jet, ', |
| 10002 | &'>=2 something is wrong)') |
| 10003 | |
| 10004 | RETURN |
| 10005 | END |
| 10006 | |
| 10007 | C********************************************************************* |
| 10008 | |
| 10009 | BLOCK DATA LUDATA |
| 10010 | |
| 10011 | C...Purpose: to give default values to parameters and particle and |
| 10012 | C...decay data. |
| 10013 | COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) |
| 10014 | COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4) |
| 10015 | COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5) |
| 10016 | COMMON/LUDAT4/CHAF(500) |
| 10017 | CHARACTER CHAF*8 |
| 10018 | COMMON/LUDATR/MRLU(6),RRLU(100) |
| 10019 | SAVE /LUDAT1/,/LUDAT2/,/LUDAT3/,/LUDAT4/,/LUDATR/ |
| 10020 | |
| 10021 | C...LUDAT1, containing status codes and most parameters. |
| 10022 | DATA MSTU/ |
| 10023 | & 0, 0, 0, 150000,20000, 500, 2000, 0, 0, 2, |
| 10024 | 1 6, 1, 1, 0, 1, 1, 0, 0, 0, 0, |
| 10025 | 2 2, 10, 0, 0, 1, 10, 0, 0, 0, 0, |
| 10026 | 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, |
| 10027 | 4 2, 2, 1, 4, 2, 1, 1, 0, 0, 0, |
| 10028 | 5 25, 24, 0, 1, 0, 0, 0, 0, 0, 0, |
| 10029 | 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, |
| 10030 | 7 30*0, |
| 10031 | & 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, |
| 10032 | 1 1, 5, 3, 23, 0, 0, 0, 0, 0, 0, |
| 10033 | 2 60*0, |
| 10034 | 8 7, 3, 1992, 2, 21, 0, 0, 0, 0, 0, |
| 10035 | 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/ |
| 10036 | DATA PARU/ |
| 10037 | & 3.1415927, 6.2831854, 0.1973, 5.068, 0.3894, 2.568, 4*0., |
| 10038 | 1 0.001, 0.09, 0.01, 0., 0., 0., 0., 0., 0., 0., |
| 10039 | 2 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., |
| 10040 | 3 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., |
| 10041 | 4 2.0, 1.0, 0.25, 2.5, 0.05, 0., 0., 0.0001, 0., 0., |
| 10042 | 5 2.5, 1.5, 7.0, 1.0, 0.5, 2.0, 3.2, 0., 0., 0., |
| 10043 | 6 40*0., |
| 10044 | & 0.00729735, 0.230, 0., 0., 0., 0., 0., 0., 0., 0., |
| 10045 | 1 0.20, 0.25, 1.0, 4.0, 10., 0., 0., 0., 0., 0., |
| 10046 | 2 -0.693, -1.0, 0.387, 1.0, -0.08, -1.0, 1.0, 1.0, 1.0, 0., |
| 10047 | 3 1.0, -1.0, 1.0, -1.0, 1.0, 0., 0., 0., 0., 0., |
| 10048 | 4 5.0, 1.0, 1.0, 0., 1.0, 1.0, 0., 0., 0., 0., |
| 10049 | 5 1.0, 0., 0., 0., 1000., 1.0, 1.0, 1.0, 1.0, 0., |
| 10050 | 6 1.0, 1.0, 1.0, 1.0, 1.0, 0., 0., 0., 0., 0., |
| 10051 | 7 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 0., 0., 0., |
| 10052 | 8 1.0, 1.0, 1.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0, 0., |
| 10053 | 9 0., 0., 0., 0., 1.0, 0., 0., 0., 0., 0./ |
| 10054 | DATA MSTJ/ |
| 10055 | & 1, 3, 0, 0, 0, 0, 0, 0, 0, 0, |
| 10056 | 1 1, 2, 0, 1, 0, 0, 0, 0, 0, 0, |
| 10057 | 2 2, 1, 1, 2, 1, 0, 0, 0, 0, 0, |
| 10058 | 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, |
| 10059 | 4 1, 2, 4, 2, 5, 0, 1, 0, 0, 0, |
| 10060 | 5 0, 3, 0, 0, 0, 0, 0, 0, 0, 0, |
| 10061 | 6 40*0, |
| 10062 | & 5, 2, 7, 5, 1, 1, 0, 2, 0, 1, |
| 10063 | 1 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, |
| 10064 | 2 80*0/ |
| 10065 | DATA PARJ/ |
| 10066 | & 0.10, 0.30, 0.40, 0.05, 0.50, 0.50, 0.50, 0., 0., 0., |
| 10067 | 1 0.50, 0.60, 0.75, 0., 0., 0., 0., 1.0, 1.0, 0., |
| 10068 | 2 0.35, 1.0, 0., 0., 0., 0., 0., 0., 0., 0., |
| 10069 | 3 0.10, 1.0, 0.8, 1.5, 0., 2.0, 0.2, 2.5, 0.6, 0., |
| 10070 | 4 0.5, 0.9, 0.5, 0.9, 0.5, 1.0, 1.0, 1.0, 0., 0., |
| 10071 | 5 0.77, 0.77, 0.77, 0., 0., 0., 0., 0., 1.0, 0., |
| 10072 | 6 4.5, 0.7, 0., 0.003, 0.5, 0.5, 0., 0., 0., 0., |
| 10073 | 7 10., 1000., 100., 1000., 0., 0.7, 10., 0., 0., 0., |
| 10074 | 8 0.4, 1.0, 1.0, 0., 10., 10., 0., 0., 0., 0., |
| 10075 | 9 0.02, 1.0, 0.2, 0., 0., 0., 0., 0., 0., 0., |
| 10076 | & 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., |
| 10077 | 1 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., |
| 10078 | 2 1.5, 0.5, 91.2, 2.40, 0.02, 2.0, 1.0, 0.25,0.002, 0., |
| 10079 | 3 0., 0., 0., 0., 0.01, 0.99, 0., 0., 0.2, 0., |
| 10080 | 4 60*0./ |
| 10081 | |
| 10082 | C...LUDAT2, with particle data and flavour treatment parameters. |
| 10083 | DATA (KCHG(I,1),I= 1, 500)/-1,2,-1,2,-1,2,-1,2,2*0,-3,0,-3,0, |
| 10084 | &-3,0,-3,6*0,3,9*0,3,2*0,3,0,-1,44*0,2,-1,2,-1,2,3,11*0,3,0,2*3,0, |
| 10085 | &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,3, |
| 10086 | &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,3, |
| 10087 | &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, |
| 10088 | &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/ |
| 10089 | DATA (KCHG(I,2),I= 1, 500)/8*1,12*0,2,17*0,1,50*0,-1,410*0/ |
| 10090 | DATA (KCHG(I,3),I= 1, 500)/8*1,2*0,8*1,5*0,1,9*0,1,2*0,1,0,2*1, |
| 10091 | &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,11*0, |
| 10092 | &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,0,6*1, |
| 10093 | &4*0,6*1,4*0,16*1,4*0,6*1,114*0/ |
| 10094 | DATA (PMAS(I,1),I= 1, 500)/0.0099,0.0056,0.199,1.35,5.,2*120., |
| 10095 | &200.,2*0.,0.00051,0.,0.1057,0.,1.7841,0.,100.,5*0.,91.2,80.,50., |
| 10096 | &6*0.,500.,900.,500.,3*300.,0.,200.,5000.,60*0.,0.1396,0.4977, |
| 10097 | &0.4936,1.8693,1.8645,1.9693,5.2794,5.2776,5.47972,0.,0.135, |
| 10098 | &0.5488,0.9575,2.9796,9.4,2*238.,397.,2*0.,0.7669,0.8962,0.8921, |
| 10099 | &2.0101,2.0071,2.1127,2*5.3354,5.5068,0.,0.77,0.782,1.0194,3.0969, |
| 10100 | &9.4603,2*238.,397.,2*0.,1.233,2*1.3,2*2.322,2.51,2*5.73,5.97,0., |
| 10101 | &1.233,1.17,1.41,3.46,9.875,2*238.42,397.41992,2*0.,0.983,2*1.429, |
| 10102 | &2*2.272,2.46,2*5.68,5.92,0.,0.983,1.,1.4,3.4151,9.8598, |
| 10103 | &2*238.39999,397.3999,2*0.,1.26,2*1.401,2*2.372,2.56,2*5.78,6.02, |
| 10104 | &0.,1.26,1.283,1.422,3.5106,9.8919,2*238.5,397.5,2*0.,1.318, |
| 10105 | &2*1.426,2*2.422,2.61,2*5.83,6.07,0.,1.318,1.274,1.525,3.5563, |
| 10106 | &9.9132,2*238.45,397.44995,2*0.,2*0.4977,83*0.,1.1156,5*0.,2.2849, |
| 10107 | &0.,2*2.46,6*0.,5.62,0.,2*5.84,6*0.,0.9396,0.9383,0.,1.1974, |
| 10108 | &1.1926,1.1894,1.3213,1.3149,0.,2.454,2.4529,2.4522,2*2.55,2.73, |
| 10109 | &4*0.,3*5.8,2*5.96,6.12,4*0.,1.234,1.233,1.232,1.231,1.3872, |
| 10110 | &1.3837,1.3828,1.535,1.5318,1.6724,3*2.5,2*2.63,2.8,4*0.,3*5.81, |
| 10111 | &2*5.97,6.13,114*0./ |
| 10112 | DATA (PMAS(I,2),I= 1, 500)/22*0.,2.5,2.1,88*0.,0.0002,0.001, |
| 10113 | &6*0.,0.149,0.0505,0.0513,7*0.,0.153,0.0085,0.0044,7*0.,0.15, |
| 10114 | &2*0.09,2*0.06,0.04,3*0.1,0.,0.15,0.335,0.08,2*0.01,5*0.,0.057, |
| 10115 | &2*0.287,2*0.06,0.04,3*0.1,0.,0.057,0.,0.25,0.0135,6*0.,0.4, |
| 10116 | &2*0.184,2*0.06,0.04,3*0.1,0.,0.4,0.025,0.055,0.00135,6*0.,0.11, |
| 10117 | &0.115,0.099,2*0.06,4*0.1,0.,0.11,0.185,0.076,0.0026,146*0., |
| 10118 | &4*0.115,0.039,2*0.036,0.0099,0.0091,131*0./ |
| 10119 | DATA (PMAS(I,3),I= 1, 500)/22*0.,2*20.,88*0.,0.002,0.005,6*0., |
| 10120 | &0.4,2*0.2,7*0.,0.4,0.1,0.015,7*0.,0.25,2*0.01,3*0.08,2*0.2,0.12, |
| 10121 | &0.,0.25,0.2,0.001,2*0.02,5*0.,0.05,2*0.4,3*0.08,2*0.2,0.12,0., |
| 10122 | &0.05,0.,0.35,0.05,6*0.,3*0.3,2*0.08,0.06,2*0.2,0.12,0.,0.3,0.05, |
| 10123 | &0.025,0.001,6*0.,0.25,4*0.12,4*0.2,0.,0.25,0.17,0.2,0.01,146*0., |
| 10124 | &4*0.14,0.04,2*0.035,2*0.05,131*0./ |
| 10125 | DATA (PMAS(I,4),I= 1, 500)/12*0.,658650.,0.,0.091,68*0.,0.1, |
| 10126 | &0.43,15*0.,7803.,0.,3709.,0.32,0.128,0.131,3*0.393,84*0.,0., |
| 10127 | &26*0.,15540.,26.75,83*0.,78.88,5*0.,0.054,0.,2*0.13,6*0.,0.393, |
| 10128 | &0.,2*0.393,9*0.,44.3,0.,24.,49.10001,86.89999,6*0.,0.13,9*0., |
| 10129 | &0.393,13*0.,24.60001,130*0./ |
| 10130 | DATA PARF/ |
| 10131 | & 0.5, 0.25, 0.5, 0.25, 1., 0.5, 0., 0., 0., 0., |
| 10132 | 1 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0., |
| 10133 | 2 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0., |
| 10134 | 3 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0., |
| 10135 | 4 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0., |
| 10136 | 5 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0., |
| 10137 | 6 0.75, 0.5, 0., 0.1667, 0.0833, 0.1667, 0., 0., 0., 0., |
| 10138 | 7 0., 0., 1., 0.3333, 0.6667, 0.3333, 0., 0., 0., 0., |
| 10139 | 8 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., |
| 10140 | 9 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., |
| 10141 | & 0.325, 0.325, 0.5, 1.6, 5.0, 0., 0., 0., 0., 0., |
| 10142 | 1 0., 0.11, 0.16, 0.048, 0.50, 0.45, 0.55, 0.60, 0., 0., |
| 10143 | 2 0.2, 0.1, 0., 0., 0., 0., 0., 0., 0., 0., |
| 10144 | 3 1870*0./ |
| 10145 | DATA ((VCKM(I,J),J=1,4),I=1,4)/ |
| 10146 | 1 0.95150, 0.04847, 0.00003, 0.00000, |
| 10147 | 2 0.04847, 0.94936, 0.00217, 0.00000, |
| 10148 | 3 0.00003, 0.00217, 0.99780, 0.00000, |
| 10149 | 4 0.00000, 0.00000, 0.00000, 1.00000/ |
| 10150 | |
| 10151 | C...LUDAT3, with particle decay parameters and data. |
| 10152 | DATA (MDCY(I,1),I= 1, 500)/14*0,1,0,1,5*0,3*1,6*0,1,0,1,2*0,1, |
| 10153 | &0,2*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, |
| 10154 | &2*0,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, |
| 10155 | &2*1,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/ |
| 10156 | DATA (MDCY(I,2),I= 1, 500)/1,9,17,25,33,41,49,57,2*0,65,69,71, |
| 10157 | &76,78,118,120,125,2*0,127,136,148,164,184,6*0,201,0,223,246,266, |
| 10158 | &284,0,293,294,42*0,303,304,308,317,320,325,327,11*0,347,348,350, |
| 10159 | &356,477,645,677,678,679,0,680,682,688,694,695,696,697,698,2*0, |
| 10160 | &699,700,703,706,709,711,712,713,714,0,715,716,721,729,732,741, |
| 10161 | &756,757,2*0,758,759,764,769,771,773,774,776,778,0,780,781,784, |
| 10162 | &788,789,790,792,793,2*0,794,797,799,801,805,809,811,815,819,0, |
| 10163 | &823,826,830,834,836,838,840,841,2*0,842,844,846,848,850,852,855, |
| 10164 | &857,859,0,862,864,877,881,883,885,887,888,2*0,889,895,906,917, |
| 10165 | &925,933,938,946,954,0,959,966,974,976,978,980,982,983,2*0,984, |
| 10166 | &992,83*0,994,5*0,998,0,1072,1073,6*0,1074,0,1075,1076,9*0,1077, |
| 10167 | &1079,1080,1083,1084,0,1086,1087,1088,1089,1090,1091,4*0,1092, |
| 10168 | &1093,1094,1095,1096,1097,4*0,1098,1099,1102,1105,1106,1109,1112, |
| 10169 | &1115,1117,1119,1123,1124,1125,1126,1128,1130,4*0,1131,1132,1133, |
| 10170 | &1134,1135,1136,114*0/ |
| 10171 | DATA (MDCY(I,3),I= 1, 500)/8*8,2*0,4,2,5,2,40,2,5,2,2*0,9,12, |
| 10172 | &16,20,17,6*0,22,0,23,20,18,9,0,1,9,42*0,1,4,9,3,5,2,20,11*0,1,2, |
| 10173 | &6,121,168,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, |
| 10174 | &2*0,1,2*5,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, |
| 10175 | &2*4,3*2,2*1,2*0,5*2,3,2*2,3,0,2,13,4,3*2,2*1,2*0,6,2*11,2*8,5, |
| 10176 | &2*8,5,0,7,8,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, |
| 10177 | &2,1,3,1,2,0,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, |
| 10178 | &114*0/ |
| 10179 | DATA (MDME(I,1),I= 1,2000)/6*1,-1,7*1,-1,7*1,-1,7*1,-1,7*1,-1, |
| 10180 | &7*1,-1,85*1,2*-1,7*1,2*-1,3*1,-1,6*1,2*-1,6*1,2*-1,3*1,-1,3*1,-1, |
| 10181 | &3*1,5*-1,3*1,-1,6*1,2*-1,3*1,-1,11*1,2*-1,6*1,8*-1,3*1,-1,3*1,-1, |
| 10182 | &3*1,5*-1,3*1,4*-1,6*1,2*-1,3*1,-1,5*1,-1,8*1,2*-1,3*1,-1,9*1,-1, |
| 10183 | &3*1,-1,6*1,2*-1,2*1,-1,16*1,-1,2*1,3*-1,470*1,2*0,1204*1/ |
| 10184 | DATA (MDME(I,2),I= 1,2000)/70*102,42,6*102,2*42,2*0,7*41,2*0, |
| 10185 | &23*41,6*102,45,27*102,8*32,8*0,16*32,4*0,8*32,4*0,32,4*0,8*32, |
| 10186 | &14*0,16*32,7*0,8*32,4*0,32,7*0,8*32,4*0,32,5*0,4*32,6*0,6*32,3*0, |
| 10187 | &12,2*42,2*11,9*42,2*45,31,2*45,2*33,31,2*45,20*46,7*0,34*42,86*0, |
| 10188 | &2*25,26,24*42,142*0,25,26,0,10*42,19*0,2*13,3*85,0,2,4*0,2,8*0, |
| 10189 | &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,12, |
| 10190 | &3*0,4*32,2*4,2*45,6*0,5*32,2*4,87,88,30*0,12,32,0,32,87,88,41*0, |
| 10191 | &12,0,32,0,32,87,88,40*0,12,0,32,0,32,87,88,88*0,12,0,32,0,32,87, |
| 10192 | &88,2*0,4*42,8*0,14*42,50*0,10*13,2*84,3*85,14*0,84,5*0,85,903*0/ |
| 10193 | DATA (BRAT(I) ,I= 1, 501)/70*0.,1.,6*0.,2*0.177,0.108,0.225, |
| 10194 | &0.003,0.06,0.02,0.025,0.013,2*0.004,0.007,0.014,2*0.002,2*0.001, |
| 10195 | &0.054,0.014,0.016,0.005,2*0.012,5*0.006,0.002,2*0.001,5*0.002, |
| 10196 | &6*0.,1.,27*0.,0.143,0.111,0.143,0.111,0.143,0.085,2*0.,0.03, |
| 10197 | &0.058,0.03,0.058,0.03,0.058,2*0.,0.25,0.01,2*0.,0.01,0.25,4*0., |
| 10198 | &0.24,5*0.,3*0.08,3*0.,0.01,0.08,0.82,5*0.,0.09,6*0.,0.143,0.111, |
| 10199 | &0.143,0.111,0.143,0.085,2*0.,0.03,0.058,0.03,0.058,0.03,0.058, |
| 10200 | &8*0.,0.25,0.01,2*0.,0.01,0.25,4*0.,0.24,5*0.,3*0.08,6*0.,0.01, |
| 10201 | &0.08,0.82,5*0.,0.09,11*0.,0.01,0.08,0.82,5*0.,0.09,9*0.,1.,6*0., |
| 10202 | &1.,4*0.215,2*0.,2*0.07,0.,1.,2*0.08,0.76,0.08,2*0.112,0.05,0.476, |
| 10203 | &0.08,0.14,0.01,0.015,0.005,1.,3*0.,1.,3*0.,1.,0.,0.25,0.01,2*0., |
| 10204 | &0.01,0.25,4*0.,0.24,5*0.,3*0.08,0.,1.,2*0.5,0.635,0.212,0.056, |
| 10205 | &0.017,0.048,0.032,0.035,0.03,2*0.015,0.044,2*0.022,9*0.001,0.035, |
| 10206 | &0.03,2*0.015,0.044,2*0.022,9*0.001,0.028,0.017,0.066,0.02,0.008, |
| 10207 | &2*0.006,0.003,0.001,2*0.002,0.003,0.001,2*0.002,0.005,0.002, |
| 10208 | &0.005,0.006,0.004,0.012,2*0.005,0.008,2*0.005,0.037,0.004,0.067, |
| 10209 | &2*0.01,2*0.001,3*0.002,0.003,8*0.002,0.005,4*0.004,0.015,0.005, |
| 10210 | &0.027,2*0.005,0.007,0.014,0.007,0.01,0.008,0.012,0.015,11*0.002, |
| 10211 | &3*0.004,0.002,0.004,6*0.002,2*0.004,0.005,0.011,0.005,0.015,0.02, |
| 10212 | &2*0.01,3*0.004,5*0.002,0.015,0.02,2*0.01,3*0.004,5*0.002,0.038/ |
| 10213 | DATA (BRAT(I) ,I= 502, 841)/0.048,0.082,0.06,0.028,0.021, |
| 10214 | &2*0.005,2*0.002,0.005,0.018,0.005,0.01,0.008,0.005,3*0.004,0.001, |
| 10215 | &3*0.003,0.001,2*0.002,0.003,2*0.002,2*0.001,0.002,0.001,0.002, |
| 10216 | &0.001,0.005,4*0.003,0.001,2*0.002,0.003,2*0.001,0.013,0.03,0.058, |
| 10217 | &0.055,3*0.003,2*0.01,0.007,0.019,4*0.005,0.015,3*0.005,8*0.002, |
| 10218 | &3*0.001,0.002,2*0.001,0.003,16*0.001,0.019,2*0.003,0.002,0.005, |
| 10219 | &0.004,0.008,0.003,0.006,0.003,0.01,5*0.002,2*0.001,2*0.002, |
| 10220 | &11*0.001,0.002,14*0.001,0.018,0.005,0.01,2*0.015,0.017,4*0.015, |
| 10221 | &0.017,3*0.015,0.025,0.08,2*0.025,0.04,0.001,2*0.005,0.02,0.04, |
| 10222 | &2*0.06,0.04,0.01,4*0.005,0.25,0.115,3*1.,0.988,0.012,0.389,0.319, |
| 10223 | &0.237,0.049,0.005,0.001,0.441,0.205,0.301,0.03,0.022,0.001,6*1., |
| 10224 | &0.665,0.333,0.002,0.666,0.333,0.001,0.49,0.34,0.17,0.52,0.48, |
| 10225 | &5*1.,0.893,0.08,0.017,2*0.005,0.495,0.343,3*0.043,0.019,0.013, |
| 10226 | &0.001,2*0.069,0.862,3*0.027,0.015,0.045,0.015,0.045,0.77,0.029, |
| 10227 | &1.,14*0.,3*1.,0.28,0.14,0.313,0.157,0.11,0.28,0.14,0.313,0.157, |
| 10228 | &0.11,0.667,0.333,0.667,0.333,1.,0.667,0.333,0.667,0.333,2*0.5,1., |
| 10229 | &0.333,0.334,0.333,4*0.25,2*1.,0.3,0.7,2*1.,0.8,2*0.1,0.667,0.333, |
| 10230 | &0.667,0.333,0.6,0.3,0.067,0.033,0.6,0.3,0.067,0.033,2*0.5,0.6, |
| 10231 | &0.3,0.067,0.033,0.6,0.3,0.067,0.033,2*0.4,2*0.1,0.8,2*0.1,0.52, |
| 10232 | &0.26,2*0.11,0.62,0.31,2*0.035,0.007,0.993,0.02,0.98,0.3,0.7,2*1./ |
| 10233 | DATA (BRAT(I) ,I= 842,1136)/2*0.5,0.667,0.333,0.667,0.333,0.667, |
| 10234 | &0.333,0.667,0.333,2*0.35,0.3,0.667,0.333,0.667,0.333,2*0.35,0.3, |
| 10235 | &2*0.5,3*0.14,0.1,0.05,4*0.08,0.028,0.027,0.028,0.027,4*0.25, |
| 10236 | &0.273,0.727,0.35,0.65,0.3,0.7,2*1.,2*0.35,0.144,0.105,0.048, |
| 10237 | &0.003,0.332,0.166,0.168,0.084,0.086,0.043,0.059,2*0.029,2*0.002, |
| 10238 | &0.332,0.166,0.168,0.084,0.086,0.043,0.059,2*0.029,2*0.002,0.3, |
| 10239 | &0.15,0.16,0.08,0.13,0.06,0.08,0.04,0.3,0.15,0.16,0.08,0.13,0.06, |
| 10240 | &0.08,0.04,2*0.4,0.1,2*0.05,0.3,0.15,0.16,0.08,0.13,0.06,0.08, |
| 10241 | &0.04,0.3,0.15,0.16,0.08,0.13,0.06,0.08,0.04,2*0.4,0.1,2*0.05, |
| 10242 | &2*0.35,0.144,0.105,2*0.024,0.003,0.573,0.287,0.063,0.028,2*0.021, |
| 10243 | &0.004,0.003,2*0.5,0.15,0.85,0.22,0.78,0.3,0.7,2*1.,0.217,0.124, |
| 10244 | &2*0.193,2*0.135,0.002,0.001,0.686,0.314,0.641,0.357,2*0.001, |
| 10245 | &0.018,2*0.005,0.003,0.002,2*0.006,0.018,2*0.005,0.003,0.002, |
| 10246 | &2*0.006,0.005,0.025,0.015,0.006,2*0.005,0.004,0.005,5*0.004, |
| 10247 | &2*0.002,2*0.004,0.003,0.002,2*0.003,3*0.002,2*0.001,0.002, |
| 10248 | &2*0.001,2*0.002,5*0.001,4*0.003,2*0.005,2*0.002,2*0.001,2*0.002, |
| 10249 | &2*0.001,0.255,0.057,2*0.035,0.15,2*0.075,0.03,2*0.015,5*1.,0.999, |
| 10250 | &0.001,1.,0.516,0.483,0.001,1.,0.995,0.005,13*1.,0.331,0.663, |
| 10251 | &0.006,0.663,0.331,0.006,1.,0.88,2*0.06,0.88,2*0.06,0.88,2*0.06, |
| 10252 | &0.667,2*0.333,0.667,0.676,0.234,0.085,0.005,3*1.,4*0.5,7*1./ |
| 10253 | DATA (BRAT(I) ,I=1137,2000)/864*0./ |
| 10254 | DATA (KFDP(I,1),I= 1, 530)/21,22,23,4*-24,25,21,22,23,4*24,25, |
| 10255 | &21,22,23,4*-24,25,21,22,23,4*24,25,21,22,23,4*-24,25,21,22,23, |
| 10256 | &4*24,25,21,22,23,4*-24,25,21,22,23,4*24,25,22,23,-24,25,23,24, |
| 10257 | &-12,22,23,-24,25,23,24,-12,-14,34*16,22,23,-24,25,23,24,-89,22, |
| 10258 | &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,1, |
| 10259 | &2,3,4,5,6,7,8,11,12,13,14,15,16,17,18,4*-1,4*-3,4*-5,4*-7,-11, |
| 10260 | &-13,-15,-17,1,2,3,4,5,6,7,8,11,13,15,17,21,2*22,23,24,1,2,3,4,5, |
| 10261 | &6,7,8,11,12,13,14,15,16,17,18,24,37,2*23,25,35,4*-1,4*-3,4*-5, |
| 10262 | &4*-7,-11,-13,-15,-17,3*24,1,2,3,4,5,6,7,8,11,13,15,17,21,2*22,23, |
| 10263 | &24,23,25,36,1,2,3,4,5,6,7,8,11,13,15,17,21,2*22,23,24,23,-1,-3, |
| 10264 | &-5,-7,-11,-13,-15,-17,24,2,1,2,3,4,5,6,11,13,15,82,-11,-13,2*2, |
| 10265 | &-12,-14,-16,2*-2,2*-4,-2,-4,2*89,37,2*-89,2*5,-37,2*89,4*-1,4*-3, |
| 10266 | &4*-5,4*-7,-11,-13,-15,-17,-13,130,310,-13,3*211,12,14,16*-11, |
| 10267 | &16*-13,-311,-313,-311,-313,-311,-313,-311,-313,2*111,2*221,2*331, |
| 10268 | &2*113,2*223,2*333,-311,-313,2*-311,-313,3*-311,-321,-323,-321, |
| 10269 | &2*211,2*213,-213,113,3*213,3*211,2*213,2*-311,-313,-321,2*-311, |
| 10270 | &-313,-311,-313,4*-311,-321,-323,2*-321,3*211,213,2*211,213,5*211, |
| 10271 | &213,4*211,3*213,211,213,321,311,3,2*2,12*-11,12*-13,-321,-323, |
| 10272 | &-321,-323,-311,-313,-311,-313,-311,-313,-311,-313,-311,-313,-311, |
| 10273 | &-321,-323,-321,-323,211,213,211,213,111,221,331,113,223,333,221/ |
| 10274 | DATA (KFDP(I,1),I= 531, 906)/331,113,223,113,223,113,223,333,223, |
| 10275 | &333,321,323,321,323,311,313,-321,-323,3*-321,-323,2*-321,-323, |
| 10276 | &-321,-311,-313,3*-311,-313,2*-311,-313,-321,-323,3*-321,-323, |
| 10277 | &2*-321,-311,2*333,211,213,2*211,2*213,4*211,10*111,-321,-323, |
| 10278 | &5*-321,-323,2*-321,-311,-313,4*-311,-313,4*-311,-321,-323,2*-321, |
| 10279 | &-323,-321,-313,-311,-313,-311,211,213,2*211,213,4*211,111,221, |
| 10280 | &113,223,113,223,2*3,-15,5*-11,5*-13,221,331,333,221,331,333,211, |
| 10281 | &213,211,213,321,323,321,323,2212,221,331,333,221,2*2,3*0,3*22, |
| 10282 | &111,211,2*22,2*211,111,3*22,111,3*21,2*0,211,321,3*311,2*321,421, |
| 10283 | &2*411,2*421,431,511,521,531,2*211,22,211,2*111,321,130,-213,113, |
| 10284 | &213,211,22,111,11,13,82,11,13,15,1,2,3,4,21,22,2*89,11,12,13,14, |
| 10285 | &15,16,1,2,3,4,5,21,22,2*0,223,321,311,323,313,2*311,321,313,323, |
| 10286 | &321,421,2*411,421,433,521,2*511,521,523,513,223,213,113,-213,313, |
| 10287 | &-313,323,-323,82,21,663,21,2*0,221,213,113,321,2*311,321,421,411, |
| 10288 | &423,413,411,421,413,423,431,433,521,511,523,513,511,521,513,523, |
| 10289 | &521,511,531,533,221,213,-213,211,111,321,130,211,111,321,130,443, |
| 10290 | &82,553,21,663,21,2*0,113,213,323,2*313,323,423,2*413,423,421,411, |
| 10291 | &433,523,2*513,523,521,511,533,213,-213,10211,10111,-10211,2*221, |
| 10292 | &213,2*113,-213,2*321,2*311,313,-313,323,-323,443,82,553,21,663, |
| 10293 | &21,2*0,213,113,221,223,321,211,321,311,323,313,323,313,321,5*311/ |
| 10294 | DATA (KFDP(I,1),I= 907,2000)/321,313,323,313,323,311,4*321,421, |
| 10295 | &411,423,413,423,413,421,2*411,421,413,423,413,423,411,2*421,411, |
| 10296 | &433,2*431,521,511,523,513,523,513,521,2*511,521,513,523,513,523, |
| 10297 | &511,2*521,511,533,2*531,213,-213,221,223,321,130,111,211,111, |
| 10298 | &2*211,321,130,221,111,321,130,443,82,553,21,663,21,2*0,111,211, |
| 10299 | &-12,12,-14,14,211,111,211,111,2212,2*2112,-12,7*-11,7*-13,2*2224, |
| 10300 | &2*2212,2*2214,2*3122,2*3212,2*3214,5*3222,4*3224,2*3322,3324, |
| 10301 | &2*2224,5*2212,5*2214,2*2112,2*2114,2*3122,2*3212,2*3214,2*3222, |
| 10302 | &2*3224,4*2,3,2*2,1,2*2,5*0,2112,-12,3122,2212,2112,2212,3*3122, |
| 10303 | &3*4122,4132,4232,0,3*5122,5132,5232,0,2112,2212,2*2112,2212,2112, |
| 10304 | &2*2212,3122,3212,3112,3122,3222,3112,3122,3222,3212,3322,3312, |
| 10305 | &3322,3312,3122,3322,3312,-12,3*4122,2*4132,2*4232,4332,3*5122, |
| 10306 | &5132,5232,5332,864*0/ |
| 10307 | DATA (KFDP(I,2),I= 1, 467)/3*1,2,4,6,8,1,3*2,1,3,5,7,2,3*3,2,4, |
| 10308 | &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, |
| 10309 | &3*8,1,3,5,7,8,2*11,12,11,12,2*11,2*13,14,13,14,13,11,13,-211, |
| 10310 | &-213,-211,-213,-211,-213,3*-211,-321,-323,-321,-323,2*-321, |
| 10311 | &4*-211,-213,-211,-213,-211,-213,-211,-213,-211,-213,6*-211,2*15, |
| 10312 | &16,15,16,15,18,2*17,18,17,18,17,-1,-2,-3,-4,-5,-6,-7,-8,21,-1,-2, |
| 10313 | &-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,-1,-2,-3,-4,-5,-6,-7,-8,-11, |
| 10314 | &-12,-13,-14,-15,-16,-17,-18,2,4,6,8,2,4,6,8,2,4,6,8,2,4,6,8,12, |
| 10315 | &14,16,18,-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,21,22,2*23,-24, |
| 10316 | &-1,-2,-3,-4,-5,-6,-7,-8,-11,-12,-13,-14,-15,-16,-17,-18,-24,-37, |
| 10317 | &22,25,2*36,2,4,6,8,2,4,6,8,2,4,6,8,2,4,6,8,12,14,16,18,23,22,25, |
| 10318 | &-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,21,22,2*23,-24,2*25,36, |
| 10319 | &-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,21,22,2*23,-24,25,2,4,6, |
| 10320 | &8,12,14,16,18,25,11,-3,-4,-5,-6,-7,-8,-13,-15,-17,-82,12,14,-1, |
| 10321 | &-3,11,13,15,1,4,3,4,1,3,5,3,5,6,4,21,22,4,7,5,2,4,6,8,2,4,6,8,2, |
| 10322 | &4,6,8,2,4,6,8,12,14,16,18,14,2*0,14,111,211,111,-11,-13,16*12, |
| 10323 | &16*14,2*211,2*213,2*321,2*323,211,213,211,213,211,213,211,213, |
| 10324 | &211,213,211,213,2*211,213,7*211,213,211,111,211,111,2*211,-213, |
| 10325 | &213,2*113,223,113,223,221,321,2*311,321,313,4*211,213,113,213, |
| 10326 | &-213,2*211,213,113,111,221,331,111,113,223,4*113,223,6*211,213/ |
| 10327 | DATA (KFDP(I,2),I= 468, 873)/4*211,-321,-311,3*-1,12*12,12*14, |
| 10328 | &2*211,2*213,2*111,2*221,2*331,2*113,2*223,333,2*321,2*323,2*-211, |
| 10329 | &2*-213,6*111,4*221,2*331,3*113,2*223,2*-211,2*-213,113,111,2*211, |
| 10330 | &213,6*211,321,2*211,213,211,2*111,113,2*223,2*321,323,321,2*311, |
| 10331 | &313,2*311,111,211,2*-211,-213,-211,-213,-211,-213,3*-211,5*111, |
| 10332 | &2*113,223,113,223,2*211,213,5*211,213,3*211,213,2*211,2*111,221, |
| 10333 | &113,223,3*321,323,2*321,323,311,313,311,313,3*211,2*-211,-213, |
| 10334 | &3*-211,4*111,2*113,2*-1,16,5*12,5*14,3*211,3*213,2*111,2*113, |
| 10335 | &2*-311,2*-313,-2112,3*321,323,2*-1,3*0,22,11,22,111,-211,211,11, |
| 10336 | &2*-211,111,113,223,22,111,3*21,2*0,111,-211,111,22,211,111,22, |
| 10337 | &211,111,22,111,5*22,2*-211,111,-211,2*111,-321,310,211,111, |
| 10338 | &2*-211,221,22,-11,-13,-82,-11,-13,-15,-1,-2,-3,-4,2*21,5,3,-11, |
| 10339 | &-12,-13,-14,-15,-16,-1,-2,-3,-4,-5,2*21,2*0,211,-213,113,-211, |
| 10340 | &111,223,211,111,211,111,223,211,111,-211,2*111,-211,111,211,111, |
| 10341 | &-321,-311,111,-211,111,211,-311,311,-321,321,-82,21,22,21,2*0, |
| 10342 | &211,111,211,-211,111,211,111,211,111,211,111,-211,111,-211,3*111, |
| 10343 | &-211,111,-211,111,211,111,211,111,-321,-311,3*111,-211,211,-211, |
| 10344 | &111,-321,310,-211,111,-321,310,22,-82,22,21,22,21,2*0,211,111, |
| 10345 | &-211,111,211,111,211,111,-211,111,321,311,111,-211,111,211,111, |
| 10346 | &-321,-311,111,-211,211,-211,111,2*211,111,-211,211,111,211,-321/ |
| 10347 | DATA (KFDP(I,2),I= 874,2000)/2*-311,-321,-311,311,-321,321,22, |
| 10348 | &-82,22,21,22,21,2*0,111,3*211,-311,22,-211,111,-211,111,-211,211, |
| 10349 | &-213,113,223,221,22,211,111,211,111,2*211,213,113,223,221,22,211, |
| 10350 | &111,211,111,4*211,-211,111,-211,111,-211,211,-211,211,321,311, |
| 10351 | &2*111,211,-211,111,-211,111,-211,211,-211,2*211,111,211,111, |
| 10352 | &4*211,-321,-311,2*111,211,-211,211,111,211,-321,310,22,-211,111, |
| 10353 | &2*-211,-321,310,221,111,-321,310,22,-82,22,21,22,21,2*0,111,-211, |
| 10354 | &11,-11,13,-13,-211,111,-211,111,-211,111,22,11,7*12,7*14,-321, |
| 10355 | &-323,-311,-313,-311,-313,211,213,211,213,211,213,111,221,331,113, |
| 10356 | &223,111,221,113,223,321,323,321,-211,-213,111,221,331,113,223, |
| 10357 | &111,221,331,113,223,211,213,211,213,321,323,321,323,321,323,311, |
| 10358 | &313,311,313,2*-1,-3,-1,2203,3201,3203,2203,2101,2103,5*0,-211,11, |
| 10359 | &22,111,211,22,-211,111,22,-211,111,211,2*22,0,-211,111,211,2*22, |
| 10360 | &0,2*-211,111,22,111,211,22,211,2*-211,2*111,-211,2*211,111,211, |
| 10361 | &-211,2*111,211,-321,-211,111,11,-211,111,211,111,22,111,2*22, |
| 10362 | &-211,111,211,3*22,864*0/ |
| 10363 | DATA (KFDP(I,3),I= 1, 989)/70*0,14,6*0,2*16,2*0,5*111,310,130, |
| 10364 | &2*0,2*111,310,130,113,211,223,221,2*113,2*211,2*223,2*221,2*113, |
| 10365 | &221,113,2*213,-213,190*0,4*3,4*4,1,4,3,2*2,10*81,25*0,-211,3*111, |
| 10366 | &-311,-313,-311,2*-321,2*-311,111,221,331,113,223,211,111,211,111, |
| 10367 | &-311,-313,-311,2*-321,2*-311,111,221,331,113,223,211,111,211,111, |
| 10368 | &20*0,3*111,2*221,331,113,223,3*211,-211,111,-211,111,211,111,211, |
| 10369 | &-211,111,113,111,223,2*111,-311,4*211,2*111,2*211,111,7*211, |
| 10370 | &7*111,113,221,2*223,2*-211,-213,4*-211,-213,-211,-213,-211,2*211, |
| 10371 | &2,2*0,-321,-323,-311,-321,-311,2*-321,-211,-213,2*-211,211,-321, |
| 10372 | &-323,-311,-321,-311,2*-321,-211,-213,2*-211,211,46*0,3*111,113, |
| 10373 | &2*221,331,2*223,-311,3*-211,-213,8*111,113,3*211,213,2*111,-211, |
| 10374 | &3*111,113,111,2*113,221,331,223,111,221,331,113,223,113,2*223, |
| 10375 | &2*221,3*111,221,113,223,4*211,3*-211,-213,-211,5*111,-321,3*211, |
| 10376 | &3*111,2*211,2*111,2*-211,-213,3*111,221,113,223,6*111,3*0,221, |
| 10377 | &331,333,321,311,221,331,333,321,311,19*0,3,5*0,-11,0,2*111,-211, |
| 10378 | &-11,11,2*221,3*0,111,22*0,111,2*0,22,111,5*0,111,12*0,2*21,2*-6, |
| 10379 | &11*0,2*21,111*0,-211,2*111,-211,3*111,-211,111,211,15*0,111,6*0, |
| 10380 | &111,-211,9*0,111,-211,9*0,111,-211,111,-211,4*0,111,-211,111, |
| 10381 | &-211,4*0,-211,4*0,111,-211,111,-211,4*0,111,-211,111,-211,4*0, |
| 10382 | &-211,3*0,-211,5*0,111,211,3*0,111,10*0,2*111,211,-211,211,-211/ |
| 10383 | DATA (KFDP(I,3),I= 990,2000)/7*0,2212,3122,3212,3214,2112,2114, |
| 10384 | &2212,2112,3122,3212,3214,2112,2114,2212,2112,50*0,3*3,1,12*0, |
| 10385 | &2112,43*0,3322,878*0/ |
| 10386 | DATA (KFDP(I,4),I= 1,2000)/83*0,3*111,9*0,-211,3*0,111,2*-211, |
| 10387 | &0,111,0,2*111,113,221,111,-213,-211,211,190*0,13*81,41*0,111, |
| 10388 | &3*211,111,5*0,-211,111,-211,111,2*0,111,3*211,111,5*0,-211,111, |
| 10389 | &-211,111,50*0,2*111,2*-211,2*111,-211,211,3*111,211,14*111,221, |
| 10390 | &113,223,2*111,2*113,223,2*111,-1,4*0,-211,111,-211,211,111,2*0, |
| 10391 | &2*111,-211,2*0,-211,111,-211,211,111,2*0,2*111,-211,96*0,6*111, |
| 10392 | &3*-211,-213,4*111,113,6*111,3*-211,3*111,2*-211,2*111,3*-211, |
| 10393 | &12*111,6*0,-321,-311,3*0,-321,-311,19*0,-3,11*0,-11,280*0,111, |
| 10394 | &-211,3*0,111,29*0,-211,111,5*0,-211,111,50*0,2101,2103,2*2101, |
| 10395 | &935*0/ |
| 10396 | DATA (KFDP(I,5),I= 1,2000)/85*0,111,15*0,111,7*0,111,0,2*111, |
| 10397 | &246*0,111,-211,111,7*0,2*111,4*0,111,-211,111,7*0,2*111,93*0,111, |
| 10398 | &-211,111,3*0,111,-211,4*0,111,-211,111,3*0,111,-211,1500*0/ |
| 10399 | |
| 10400 | C...LUDAT4, with character strings. |
| 10401 | DATA (CHAF(I) ,I= 1, 325)/'d','u','s','c','b','t','l','h', |
| 10402 | &2*' ','e','nu_e','mu','nu_mu','tau','nu_tau','chi','nu_chi', |
| 10403 | &2*' ','g','gamma','Z','W','H',6*' ','Z''','Z"','W''','H''','A', |
| 10404 | &'H',' ','LQ_ue','R',40*' ','specflav','rndmflav','phasespa', |
| 10405 | &'c-hadron','b-hadron','t-hadron','l-hadron','h-hadron','Wvirt', |
| 10406 | &'diquark','cluster','string','indep.','CMshower','SPHEaxis', |
| 10407 | &'THRUaxis','CLUSjet','CELLjet','table',' ','pi',2*'K',2*'D', |
| 10408 | &'D_s',2*'B','B_s',' ','pi','eta','eta''','eta_c','eta_b','eta_t', |
| 10409 | &'eta_l','eta_h',2*' ','rho',2*'K*',2*'D*','D*_s',2*'B*','B*_s', |
| 10410 | &' ','rho','omega','phi','J/psi','Upsilon','Theta','Theta_l', |
| 10411 | &'Theta_h',2*' ','b_1',2*'K_1',2*'D_1','D_1s',2*'B_1','B_1s',' ', |
| 10412 | &'b_1','h_1','h''_1','h_1c','h_1b','h_1t','h_1l','h_1h',2*' ', |
| 10413 | &'a_0',2*'K*_0',2*'D*_0','D*_0s',2*'B*_0','B*_0s',' ','a_0','f_0', |
| 10414 | &'f''_0','chi_0c','chi_0b','chi_0t','chi_0l','chi_0h',2*' ','a_1', |
| 10415 | &2*'K*_1',2*'D*_1','D*_1s',2*'B*_1','B*_1s',' ','a_1','f_1', |
| 10416 | &'f''_1','chi_1c','chi_1b','chi_1t','chi_1l','chi_1h',2*' ','a_2', |
| 10417 | &2*'K*_2',2*'D*_2','D*_2s',2*'B*_2','B*_2s',' ','a_2','f_2', |
| 10418 | &'f''_2','chi_2c','chi_2b','chi_2t','chi_2l','chi_2h',2*' ','K_L', |
| 10419 | &'K_S',58*' ','pi_diffr','n_diffr','p_diffr',22*' ','Lambda', |
| 10420 | &5*' ','Lambda_c',' ',2*'Xi_c',6*' ','Lambda_b',' ',2*'Xi_b'/ |
| 10421 | DATA (CHAF(I) ,I= 326, 500)/6*' ','n','p',' ',3*'Sigma',2*'Xi', |
| 10422 | &' ',3*'Sigma_c',2*'Xi''_c','Omega_c',4*' ',3*'Sigma_b', |
| 10423 | &2*'Xi''_b','Omega_b',4*' ',4*'Delta',3*'Sigma*',2*'Xi*','Omega', |
| 10424 | &3*'Sigma*_c',2*'Xi*_c','Omega*_c',4*' ',3*'Sigma*_b',2*'Xi*_b', |
| 10425 | &'Omega*_b',114*' '/ |
| 10426 | |
| 10427 | C...LUDATR, with initial values for the random number generator. |
| 10428 | DATA MRLU/19780503,0,0,97,33,0/ |
| 10429 | |
| 10430 | END |
| 10431 | |
| 10432 | C*********** THIS IS THE END OF JETSET PACKAGE *************************** |
git://git.uio.no / u / mrichter / AliRoot.git / blame