00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081
00082
00083 SUBROUTINE LU1ENT(IP,KF,PE,THE,PHI)
00084
00085
00086 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
00087 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
00088 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
00089 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
00090
00091
00092 MSTU(28)=0
00093 IF(MSTU(12).GE.1) CALL LULIST(0)
00094 IPA=MAX(1,IABS(IP))
00095 IF(IPA.GT.MSTU(4)) CALL LUERRM(21,
00096 &'(LU1ENT:) writing outside LUJETS memory')
00097 KC=LUCOMP(KF)
00098 IF(KC.EQ.0) CALL LUERRM(12,'(LU1ENT:) unknown flavour code')
00099
00100
00101 PM=0.
00102 IF(MSTU(10).EQ.1) PM=P(IPA,5)
00103 IF(MSTU(10).GE.2) PM=ULMASS(KF)
00104 DO 100 J=1,5
00105 K(IPA,J)=0
00106 P(IPA,J)=0.
00107 V(IPA,J)=0.
00108 100 CONTINUE
00109
00110
00111 K(IPA,1)=1
00112 IF(IP.LT.0) K(IPA,1)=2
00113 K(IPA,2)=KF
00114 P(IPA,5)=PM
00115 P(IPA,4)=MAX(PE,PM)
00116 PA=SQRT(P(IPA,4)**2-P(IPA,5)**2)
00117 P(IPA,1)=PA*SIN(THE)*COS(PHI)
00118 P(IPA,2)=PA*SIN(THE)*SIN(PHI)
00119 P(IPA,3)=PA*COS(THE)
00120
00121
00122 N=IPA
00123 IF(IP.EQ.0) CALL LUEXEC
00124
00125 RETURN
00126 END
00127
00128
00129
00130 SUBROUTINE LU2ENT(IP,KF1,KF2,PECM)
00131
00132
00133
00134 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
00135 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
00136 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
00137 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
00138
00139
00140 MSTU(28)=0
00141 IF(MSTU(12).GE.1) CALL LULIST(0)
00142 IPA=MAX(1,IABS(IP))
00143 IF(IPA.GT.MSTU(4)-1) CALL LUERRM(21,
00144 &'(LU2ENT:) writing outside LUJETS memory')
00145 KC1=LUCOMP(KF1)
00146 KC2=LUCOMP(KF2)
00147 IF(KC1.EQ.0.OR.KC2.EQ.0) CALL LUERRM(12,
00148 &'(LU2ENT:) unknown flavour code')
00149
00150
00151 PM1=0.
00152 IF(MSTU(10).EQ.1) PM1=P(IPA,5)
00153 IF(MSTU(10).GE.2) PM1=ULMASS(KF1)
00154 PM2=0.
00155 IF(MSTU(10).EQ.1) PM2=P(IPA+1,5)
00156 IF(MSTU(10).GE.2) PM2=ULMASS(KF2)
00157 DO 110 I=IPA,IPA+1
00158 DO 100 J=1,5
00159 K(I,J)=0
00160 P(I,J)=0.
00161 V(I,J)=0.
00162 100 CONTINUE
00163 110 CONTINUE
00164
00165
00166 KQ1=KCHG(KC1,2)*ISIGN(1,KF1)
00167 KQ2=KCHG(KC2,2)*ISIGN(1,KF2)
00168 IF(MSTU(19).EQ.1) THEN
00169 MSTU(19)=0
00170 ELSE
00171 IF(KQ1+KQ2.NE.0.AND.KQ1+KQ2.NE.4) CALL LUERRM(2,
00172 & '(LU2ENT:) unphysical flavour combination')
00173 ENDIF
00174 K(IPA,2)=KF1
00175 K(IPA+1,2)=KF2
00176
00177
00178 IF(IP.GE.0) THEN
00179 K(IPA,1)=1
00180 IF(KQ1.NE.0.AND.KQ2.NE.0) K(IPA,1)=2
00181 K(IPA+1,1)=1
00182
00183
00184 ELSE
00185 K(IPA,1)=3
00186 K(IPA+1,1)=3
00187 K(IPA,4)=MSTU(5)*(IPA+1)
00188 K(IPA,5)=K(IPA,4)
00189 K(IPA+1,4)=MSTU(5)*IPA
00190 K(IPA+1,5)=K(IPA+1,4)
00191 ENDIF
00192
00193
00194 IF(PECM.LE.PM1+PM2) CALL LUERRM(13,
00195 &'(LU2ENT:) energy smaller than sum of masses')
00196 PA=SQRT(MAX(0.,(PECM**2-PM1**2-PM2**2)**2-(2.*PM1*PM2)**2))/
00197 &(2.*PECM)
00198 P(IPA,3)=PA
00199 P(IPA,4)=SQRT(PM1**2+PA**2)
00200 P(IPA,5)=PM1
00201 P(IPA+1,3)=-PA
00202 P(IPA+1,4)=SQRT(PM2**2+PA**2)
00203 P(IPA+1,5)=PM2
00204
00205
00206 N=IPA+1
00207 IF(IP.EQ.0) CALL LUEXEC
00208
00209 RETURN
00210 END
00211
00212
00213
00214 SUBROUTINE LU3ENT(IP,KF1,KF2,KF3,PECM,X1,X3)
00215
00216
00217
00218
00219 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
00220 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
00221 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
00222 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
00223
00224
00225 MSTU(28)=0
00226 IF(MSTU(12).GE.1) CALL LULIST(0)
00227 IPA=MAX(1,IABS(IP))
00228 IF(IPA.GT.MSTU(4)-2) CALL LUERRM(21,
00229 &'(LU3ENT:) writing outside LUJETS memory')
00230 KC1=LUCOMP(KF1)
00231 KC2=LUCOMP(KF2)
00232 KC3=LUCOMP(KF3)
00233 IF(KC1.EQ.0.OR.KC2.EQ.0.OR.KC3.EQ.0) CALL LUERRM(12,
00234 &'(LU3ENT:) unknown flavour code')
00235
00236
00237 PM1=0.
00238 IF(MSTU(10).EQ.1) PM1=P(IPA,5)
00239 IF(MSTU(10).GE.2) PM1=ULMASS(KF1)
00240 PM2=0.
00241 IF(MSTU(10).EQ.1) PM2=P(IPA+1,5)
00242 IF(MSTU(10).GE.2) PM2=ULMASS(KF2)
00243 PM3=0.
00244 IF(MSTU(10).EQ.1) PM3=P(IPA+2,5)
00245 IF(MSTU(10).GE.2) PM3=ULMASS(KF3)
00246 DO 110 I=IPA,IPA+2
00247 DO 100 J=1,5
00248 K(I,J)=0
00249 P(I,J)=0.
00250 V(I,J)=0.
00251 100 CONTINUE
00252 110 CONTINUE
00253
00254
00255 KQ1=KCHG(KC1,2)*ISIGN(1,KF1)
00256 KQ2=KCHG(KC2,2)*ISIGN(1,KF2)
00257 KQ3=KCHG(KC3,2)*ISIGN(1,KF3)
00258 IF(MSTU(19).EQ.1) THEN
00259 MSTU(19)=0
00260 ELSEIF(KQ1.EQ.0.AND.KQ2.EQ.0.AND.KQ3.EQ.0) THEN
00261 ELSEIF(KQ1.NE.0.AND.KQ2.EQ.2.AND.(KQ1+KQ3.EQ.0.OR.
00262 &KQ1+KQ3.EQ.4)) THEN
00263 ELSE
00264 CALL LUERRM(2,'(LU3ENT:) unphysical flavour combination')
00265 ENDIF
00266 K(IPA,2)=KF1
00267 K(IPA+1,2)=KF2
00268 K(IPA+2,2)=KF3
00269
00270
00271 IF(IP.GE.0) THEN
00272 K(IPA,1)=1
00273 IF(KQ1.NE.0.AND.(KQ2.NE.0.OR.KQ3.NE.0)) K(IPA,1)=2
00274 K(IPA+1,1)=1
00275 IF(KQ2.NE.0.AND.KQ3.NE.0) K(IPA+1,1)=2
00276 K(IPA+2,1)=1
00277
00278
00279 ELSE
00280 K(IPA,1)=3
00281 K(IPA+1,1)=3
00282 K(IPA+2,1)=3
00283 KCS=4
00284 IF(KQ1.EQ.-1) KCS=5
00285 K(IPA,KCS)=MSTU(5)*(IPA+1)
00286 K(IPA,9-KCS)=MSTU(5)*(IPA+2)
00287 K(IPA+1,KCS)=MSTU(5)*(IPA+2)
00288 K(IPA+1,9-KCS)=MSTU(5)*IPA
00289 K(IPA+2,KCS)=MSTU(5)*IPA
00290 K(IPA+2,9-KCS)=MSTU(5)*(IPA+1)
00291 ENDIF
00292
00293
00294 MKERR=0
00295 IF(0.5*X1*PECM.LE.PM1.OR.0.5*(2.-X1-X3)*PECM.LE.PM2.OR.
00296 &0.5*X3*PECM.LE.PM3) MKERR=1
00297 PA1=SQRT(MAX(1E-10,(0.5*X1*PECM)**2-PM1**2))
00298 PA2=SQRT(MAX(1E-10,(0.5*(2.-X1-X3)*PECM)**2-PM2**2))
00299 PA3=SQRT(MAX(1E-10,(0.5*X3*PECM)**2-PM3**2))
00300 CTHE2=(PA3**2-PA1**2-PA2**2)/(2.*PA1*PA2)
00301 CTHE3=(PA2**2-PA1**2-PA3**2)/(2.*PA1*PA3)
00302 IF(ABS(CTHE2).GE.1.001.OR.ABS(CTHE3).GE.1.001) MKERR=1
00303 CTHE3=MAX(-1.,MIN(1.,CTHE3))
00304 IF(MKERR.NE.0) CALL LUERRM(13,
00305 &'(LU3ENT:) unphysical kinematical variable setup')
00306
00307
00308 P(IPA,3)=PA1
00309 P(IPA,4)=SQRT(PA1**2+PM1**2)
00310 P(IPA,5)=PM1
00311 P(IPA+2,1)=PA3*SQRT(1.-CTHE3**2)
00312 P(IPA+2,3)=PA3*CTHE3
00313 P(IPA+2,4)=SQRT(PA3**2+PM3**2)
00314 P(IPA+2,5)=PM3
00315 P(IPA+1,1)=-P(IPA+2,1)
00316 P(IPA+1,3)=-P(IPA,3)-P(IPA+2,3)
00317 P(IPA+1,4)=SQRT(P(IPA+1,1)**2+P(IPA+1,3)**2+PM2**2)
00318 P(IPA+1,5)=PM2
00319
00320
00321 N=IPA+2
00322 IF(IP.EQ.0) CALL LUEXEC
00323
00324 RETURN
00325 END
00326
00327
00328
00329 SUBROUTINE LU4ENT(IP,KF1,KF2,KF3,KF4,PECM,X1,X2,X4,X12,X14)
00330
00331
00332
00333
00334 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
00335 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
00336 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
00337 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
00338
00339
00340 MSTU(28)=0
00341 IF(MSTU(12).GE.1) CALL LULIST(0)
00342 IPA=MAX(1,IABS(IP))
00343 IF(IPA.GT.MSTU(4)-3) CALL LUERRM(21,
00344 &'(LU4ENT:) writing outside LUJETS momory')
00345 KC1=LUCOMP(KF1)
00346 KC2=LUCOMP(KF2)
00347 KC3=LUCOMP(KF3)
00348 KC4=LUCOMP(KF4)
00349 IF(KC1.EQ.0.OR.KC2.EQ.0.OR.KC3.EQ.0.OR.KC4.EQ.0) CALL LUERRM(12,
00350 &'(LU4ENT:) unknown flavour code')
00351
00352
00353 PM1=0.
00354 IF(MSTU(10).EQ.1) PM1=P(IPA,5)
00355 IF(MSTU(10).GE.2) PM1=ULMASS(KF1)
00356 PM2=0.
00357 IF(MSTU(10).EQ.1) PM2=P(IPA+1,5)
00358 IF(MSTU(10).GE.2) PM2=ULMASS(KF2)
00359 PM3=0.
00360 IF(MSTU(10).EQ.1) PM3=P(IPA+2,5)
00361 IF(MSTU(10).GE.2) PM3=ULMASS(KF3)
00362 PM4=0.
00363 IF(MSTU(10).EQ.1) PM4=P(IPA+3,5)
00364 IF(MSTU(10).GE.2) PM4=ULMASS(KF4)
00365 DO 110 I=IPA,IPA+3
00366 DO 100 J=1,5
00367 K(I,J)=0
00368 P(I,J)=0.
00369 V(I,J)=0.
00370 100 CONTINUE
00371 110 CONTINUE
00372
00373
00374 KQ1=KCHG(KC1,2)*ISIGN(1,KF1)
00375 KQ2=KCHG(KC2,2)*ISIGN(1,KF2)
00376 KQ3=KCHG(KC3,2)*ISIGN(1,KF3)
00377 KQ4=KCHG(KC4,2)*ISIGN(1,KF4)
00378 IF(MSTU(19).EQ.1) THEN
00379 MSTU(19)=0
00380 ELSEIF(KQ1.EQ.0.AND.KQ2.EQ.0.AND.KQ3.EQ.0.AND.KQ4.EQ.0) THEN
00381 ELSEIF(KQ1.NE.0.AND.KQ2.EQ.2.AND.KQ3.EQ.2.AND.(KQ1+KQ4.EQ.0.OR.
00382 &KQ1+KQ4.EQ.4)) THEN
00383 ELSEIF(KQ1.NE.0.AND.KQ1+KQ2.EQ.0.AND.KQ3.NE.0.AND.KQ3+KQ4.EQ.0.)
00384 &THEN
00385 ELSE
00386 CALL LUERRM(2,'(LU4ENT:) unphysical flavour combination')
00387 ENDIF
00388 K(IPA,2)=KF1
00389 K(IPA+1,2)=KF2
00390 K(IPA+2,2)=KF3
00391 K(IPA+3,2)=KF4
00392
00393
00394 IF(IP.GE.0) THEN
00395 K(IPA,1)=1
00396 IF(KQ1.NE.0.AND.(KQ2.NE.0.OR.KQ3.NE.0.OR.KQ4.NE.0)) K(IPA,1)=2
00397 K(IPA+1,1)=1
00398 IF(KQ2.NE.0.AND.KQ1+KQ2.NE.0.AND.(KQ3.NE.0.OR.KQ4.NE.0))
00399 & K(IPA+1,1)=2
00400 K(IPA+2,1)=1
00401 IF(KQ3.NE.0.AND.KQ4.NE.0) K(IPA+2,1)=2
00402 K(IPA+3,1)=1
00403
00404
00405
00406 ELSEIF(KQ1+KQ2.NE.0) THEN
00407 K(IPA,1)=3
00408 K(IPA+1,1)=3
00409 K(IPA+2,1)=3
00410 K(IPA+3,1)=3
00411 KCS=4
00412 IF(KQ1.EQ.-1) KCS=5
00413 K(IPA,KCS)=MSTU(5)*(IPA+1)
00414 K(IPA,9-KCS)=MSTU(5)*(IPA+3)
00415 K(IPA+1,KCS)=MSTU(5)*(IPA+2)
00416 K(IPA+1,9-KCS)=MSTU(5)*IPA
00417 K(IPA+2,KCS)=MSTU(5)*(IPA+3)
00418 K(IPA+2,9-KCS)=MSTU(5)*(IPA+1)
00419 K(IPA+3,KCS)=MSTU(5)*IPA
00420 K(IPA+3,9-KCS)=MSTU(5)*(IPA+2)
00421
00422
00423 ELSE
00424 K(IPA,1)=3
00425 K(IPA+1,1)=3
00426 K(IPA+2,1)=3
00427 K(IPA+3,1)=3
00428 K(IPA,4)=MSTU(5)*(IPA+1)
00429 K(IPA,5)=K(IPA,4)
00430 K(IPA+1,4)=MSTU(5)*IPA
00431 K(IPA+1,5)=K(IPA+1,4)
00432 K(IPA+2,4)=MSTU(5)*(IPA+3)
00433 K(IPA+2,5)=K(IPA+2,4)
00434 K(IPA+3,4)=MSTU(5)*(IPA+2)
00435 K(IPA+3,5)=K(IPA+3,4)
00436 ENDIF
00437
00438
00439 MKERR=0
00440 IF(0.5*X1*PECM.LE.PM1.OR.0.5*X2*PECM.LE.PM2.OR.0.5*(2.-X1-X2-X4)*
00441 &PECM.LE.PM3.OR.0.5*X4*PECM.LE.PM4) MKERR=1
00442 PA1=SQRT(MAX(1E-10,(0.5*X1*PECM)**2-PM1**2))
00443 PA2=SQRT(MAX(1E-10,(0.5*X2*PECM)**2-PM2**2))
00444 PA4=SQRT(MAX(1E-10,(0.5*X4*PECM)**2-PM4**2))
00445 X24=X1+X2+X4-1.-X12-X14+(PM3**2-PM1**2-PM2**2-PM4**2)/PECM**2
00446 CTHE4=(X1*X4-2.*X14)*PECM**2/(4.*PA1*PA4)
00447 IF(ABS(CTHE4).GE.1.002) MKERR=1
00448 CTHE4=MAX(-1.,MIN(1.,CTHE4))
00449 STHE4=SQRT(1.-CTHE4**2)
00450 CTHE2=(X1*X2-2.*X12)*PECM**2/(4.*PA1*PA2)
00451 IF(ABS(CTHE2).GE.1.002) MKERR=1
00452 CTHE2=MAX(-1.,MIN(1.,CTHE2))
00453 STHE2=SQRT(1.-CTHE2**2)
00454 CPHI2=((X2*X4-2.*X24)*PECM**2-4.*PA2*CTHE2*PA4*CTHE4)/
00455 &MAX(1E-8*PECM**2,4.*PA2*STHE2*PA4*STHE4)
00456 IF(ABS(CPHI2).GE.1.05) MKERR=1
00457 CPHI2=MAX(-1.,MIN(1.,CPHI2))
00458 IF(MKERR.EQ.1) CALL LUERRM(13,
00459 &'(LU4ENT:) unphysical kinematical variable setup')
00460
00461
00462 P(IPA,3)=PA1
00463 P(IPA,4)=SQRT(PA1**2+PM1**2)
00464 P(IPA,5)=PM1
00465 P(IPA+3,1)=PA4*STHE4
00466 P(IPA+3,3)=PA4*CTHE4
00467 P(IPA+3,4)=SQRT(PA4**2+PM4**2)
00468 P(IPA+3,5)=PM4
00469 P(IPA+1,1)=PA2*STHE2*CPHI2
00470 P(IPA+1,2)=PA2*STHE2*SQRT(1.-CPHI2**2)*(-1.)**INT(RLU(0)+0.5)
00471 P(IPA+1,3)=PA2*CTHE2
00472 P(IPA+1,4)=SQRT(PA2**2+PM2**2)
00473 P(IPA+1,5)=PM2
00474 P(IPA+2,1)=-P(IPA+1,1)-P(IPA+3,1)
00475 P(IPA+2,2)=-P(IPA+1,2)
00476 P(IPA+2,3)=-P(IPA,3)-P(IPA+1,3)-P(IPA+3,3)
00477 P(IPA+2,4)=SQRT(P(IPA+2,1)**2+P(IPA+2,2)**2+P(IPA+2,3)**2+PM3**2)
00478 P(IPA+2,5)=PM3
00479
00480
00481 N=IPA+3
00482 IF(IP.EQ.0) CALL LUEXEC
00483
00484 RETURN
00485 END
00486
00487
00488
00489 SUBROUTINE LUJOIN(NJOIN,IJOIN)
00490
00491
00492
00493 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
00494 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
00495 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
00496 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
00497 DIMENSION IJOIN(*)
00498
00499
00500 IF(NJOIN.LT.2) GOTO 120
00501 KQSUM=0
00502 DO 100 IJN=1,NJOIN
00503 I=IJOIN(IJN)
00504 IF(I.LE.0.OR.I.GT.N) GOTO 120
00505 IF(K(I,1).LT.1.OR.K(I,1).GT.3) GOTO 120
00506 KC=LUCOMP(K(I,2))
00507 IF(KC.EQ.0) GOTO 120
00508 KQ=KCHG(KC,2)*ISIGN(1,K(I,2))
00509 IF(KQ.EQ.0) GOTO 120
00510 IF(IJN.NE.1.AND.IJN.NE.NJOIN.AND.KQ.NE.2) GOTO 120
00511 IF(KQ.NE.2) KQSUM=KQSUM+KQ
00512 IF(IJN.EQ.1) KQS=KQ
00513 100 CONTINUE
00514 IF(KQSUM.NE.0) GOTO 120
00515
00516
00517 KCS=(9-KQS)/2
00518 IF(KQS.EQ.2) KCS=INT(4.5+RLU(0))
00519 DO 110 IJN=1,NJOIN
00520 I=IJOIN(IJN)
00521 K(I,1)=3
00522 IF(IJN.NE.1) IP=IJOIN(IJN-1)
00523 IF(IJN.EQ.1) IP=IJOIN(NJOIN)
00524 IF(IJN.NE.NJOIN) IN=IJOIN(IJN+1)
00525 IF(IJN.EQ.NJOIN) IN=IJOIN(1)
00526 K(I,KCS)=MSTU(5)*IN
00527 K(I,9-KCS)=MSTU(5)*IP
00528 IF(IJN.EQ.1.AND.KQS.NE.2) K(I,9-KCS)=0
00529 IF(IJN.EQ.NJOIN.AND.KQS.NE.2) K(I,KCS)=0
00530 110 CONTINUE
00531
00532
00533 RETURN
00534 120 CALL LUERRM(12,
00535 &'(LUJOIN:) given entries can not be joined by one string')
00536
00537 RETURN
00538 END
00539
00540
00541
00542 SUBROUTINE LUGIVE(CHIN)
00543
00544
00545 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
00546 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
00547 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
00548 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
00549 COMMON/LUDAT4/CHAF(500)
00550 CHARACTER CHAF*8
00551 COMMON/LUDATR/MRLU(6),RRLU(100)
00552 COMMON/PYSUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
00553 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
00554 COMMON/PYINT1/MINT(400),VINT(400)
00555 COMMON/PYINT2/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2)
00556 COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000)
00557 COMMON/PYINT4/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3)
00558 COMMON/PYINT5/NGEN(0:200,3),XSEC(0:200,3)
00559 COMMON/PYINT6/PROC(0:200)
00560 COMMON/PYINT7/SIGT(0:6,0:6,0:5)
00561 CHARACTER PROC*28
00562 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/,/LUDAT4/,/LUDATR/
00563 SAVE /PYSUBS/,/PYPARS/,/PYINT1/,/PYINT2/,/PYINT3/,/PYINT4/,
00564 &/PYINT5/,/PYINT6/,/PYINT7/
00565 CHARACTER CHIN*(*),CHFIX*104,CHBIT*104,CHOLD*8,CHNEW*8,CHOLD2*28,
00566 &CHNEW2*28,CHNAM*4,CHVAR(43)*4,CHALP(2)*26,CHIND*8,CHINI*10,
00567 &CHINR*16
00568 DIMENSION MSVAR(43,8)
00569
00570
00571
00572 DATA CHVAR/'N','K','P','V','MSTU','PARU','MSTJ','PARJ','KCHG',
00573 &'PMAS','PARF','VCKM','MDCY','MDME','BRAT','KFDP','CHAF','MRLU',
00574 &'RRLU','MSEL','MSUB','KFIN','CKIN','MSTP','PARP','MSTI','PARI',
00575 &'MINT','VINT','ISET','KFPR','COEF','ICOL','XSFX','ISIG','SIGH',
00576 &'WIDP','WIDE','WIDS','NGEN','XSEC','PROC','SIGT'/
00577 DATA ((MSVAR(I,J),J=1,8),I=1,43)/ 1,7*0, 1,2,1,4000,1,5,2*0,
00578 & 2,2,1,4000,1,5,2*0, 2,2,1,4000,1,5,2*0, 1,1,1,200,4*0,
00579 & 2,1,1,200,4*0, 1,1,1,200,4*0, 2,1,1,200,4*0,
00580 & 1,2,1,500,1,3,2*0, 2,2,1,500,1,4,2*0, 2,1,1,2000,4*0,
00581 & 2,2,1,4,1,4,2*0, 1,2,1,500,1,3,2*0, 1,2,1,2000,1,2,2*0,
00582 & 2,1,1,2000,4*0, 1,2,1,2000,1,5,2*0, 3,1,1,500,4*0,
00583 & 1,1,1,6,4*0, 2,1,1,100,4*0,
00584 & 1,7*0, 1,1,1,200,4*0, 1,2,1,2,-40,40,2*0, 2,1,1,200,4*0,
00585 & 1,1,1,200,4*0, 2,1,1,200,4*0, 1,1,1,200,4*0, 2,1,1,200,4*0,
00586 & 1,1,1,400,4*0, 2,1,1,400,4*0, 1,1,1,200,4*0,
00587 & 1,2,1,200,1,2,2*0, 2,2,1,200,1,20,2*0, 1,3,1,40,1,4,1,2,
00588 & 2,2,1,2,-40,40,2*0, 1,2,1,1000,1,3,2*0, 2,1,1,1000,4*0,
00589 & 2,2,21,40,0,40,2*0, 2,2,21,40,0,40,2*0, 2,2,21,40,1,3,2*0,
00590 & 1,2,0,200,1,3,2*0, 2,2,0,200,1,3,2*0, 4,1,0,200,4*0,
00591 & 2,3,0,6,0,6,0,5/
00592 DATA CHALP/'abcdefghijklmnopqrstuvwxyz',
00593 &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
00594
00595
00596 IF(MSTU(12).GE.1) CALL LULIST(0)
00597 CHBIT=CHIN//' '
00598 LBIT=101
00599 100 LBIT=LBIT-1
00600 IF(CHBIT(LBIT:LBIT).EQ.' ') GOTO 100
00601 LTOT=0
00602 DO 110 LCOM=1,LBIT
00603 IF(CHBIT(LCOM:LCOM).EQ.' ') GOTO 110
00604 LTOT=LTOT+1
00605 CHFIX(LTOT:LTOT)=CHBIT(LCOM:LCOM)
00606 110 CONTINUE
00607 LLOW=0
00608 120 LHIG=LLOW+1
00609 130 LHIG=LHIG+1
00610 IF(LHIG.LE.LTOT.AND.CHFIX(LHIG:LHIG).NE.';') GOTO 130
00611 LBIT=LHIG-LLOW-1
00612 CHBIT(1:LBIT)=CHFIX(LLOW+1:LHIG-1)
00613
00614
00615 LNAM=1
00616 140 LNAM=LNAM+1
00617 IF(CHBIT(LNAM:LNAM).NE.'('.AND.CHBIT(LNAM:LNAM).NE.'='.AND.
00618 &LNAM.LE.4) GOTO 140
00619 CHNAM=CHBIT(1:LNAM-1)//' '
00620 DO 160 LCOM=1,LNAM-1
00621 DO 150 LALP=1,26
00622 IF(CHNAM(LCOM:LCOM).EQ.CHALP(1)(LALP:LALP)) CHNAM(LCOM:LCOM)=
00623 &CHALP(2)(LALP:LALP)
00624 150 CONTINUE
00625 160 CONTINUE
00626 IVAR=0
00627 DO 170 IV=1,43
00628 IF(CHNAM.EQ.CHVAR(IV)) IVAR=IV
00629 170 CONTINUE
00630 IF(IVAR.EQ.0) THEN
00631 CALL LUERRM(18,'(LUGIVE:) do not recognize variable '//CHNAM)
00632 LLOW=LHIG
00633 IF(LLOW.LT.LTOT) GOTO 120
00634 RETURN
00635 ENDIF
00636
00637
00638 I1=0
00639 I2=0
00640 I3=0
00641 NINDX=0
00642 IF(CHBIT(LNAM:LNAM).EQ.'(') THEN
00643 LIND=LNAM
00644 180 LIND=LIND+1
00645 IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 180
00646 CHIND=' '
00647 IF((CHBIT(LNAM+1:LNAM+1).EQ.'C'.OR.CHBIT(LNAM+1:LNAM+1).EQ.'c').
00648 & AND.(IVAR.EQ.9.OR.IVAR.EQ.10.OR.IVAR.EQ.13.OR.IVAR.EQ.17)) THEN
00649 CHIND(LNAM-LIND+11:8)=CHBIT(LNAM+2:LIND-1)
00650 READ(CHIND,'(I8)') KF
00651 I1=LUCOMP(KF)
00652 ELSEIF(CHBIT(LNAM+1:LNAM+1).EQ.'C'.OR.CHBIT(LNAM+1:LNAM+1).EQ.
00653 & 'c') THEN
00654 CALL LUERRM(18,'(LUGIVE:) not allowed to use C index for '//
00655 & CHNAM)
00656 LLOW=LHIG
00657 IF(LLOW.LT.LTOT) GOTO 120
00658 RETURN
00659 ELSE
00660 CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1)
00661 READ(CHIND,'(I8)') I1
00662 ENDIF
00663 LNAM=LIND
00664 IF(CHBIT(LNAM:LNAM).EQ.')') LNAM=LNAM+1
00665 NINDX=1
00666 ENDIF
00667 IF(CHBIT(LNAM:LNAM).EQ.',') THEN
00668 LIND=LNAM
00669 190 LIND=LIND+1
00670 IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 190
00671 CHIND=' '
00672 CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1)
00673 READ(CHIND,'(I8)') I2
00674 LNAM=LIND
00675 IF(CHBIT(LNAM:LNAM).EQ.')') LNAM=LNAM+1
00676 NINDX=2
00677 ENDIF
00678 IF(CHBIT(LNAM:LNAM).EQ.',') THEN
00679 LIND=LNAM
00680 200 LIND=LIND+1
00681 IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 200
00682 CHIND=' '
00683 CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1)
00684 READ(CHIND,'(I8)') I3
00685 LNAM=LIND+1
00686 NINDX=3
00687 ENDIF
00688
00689
00690 IERR=0
00691 IF(NINDX.NE.MSVAR(IVAR,2)) IERR=1
00692 IF(NINDX.GE.1.AND.(I1.LT.MSVAR(IVAR,3).OR.I1.GT.MSVAR(IVAR,4)))
00693 &IERR=2
00694 IF(NINDX.GE.2.AND.(I2.LT.MSVAR(IVAR,5).OR.I2.GT.MSVAR(IVAR,6)))
00695 &IERR=3
00696 IF(NINDX.EQ.3.AND.(I3.LT.MSVAR(IVAR,7).OR.I3.GT.MSVAR(IVAR,8)))
00697 &IERR=4
00698 IF(CHBIT(LNAM:LNAM).NE.'=') IERR=5
00699 IF(IERR.GE.1) THEN
00700 CALL LUERRM(18,'(LUGIVE:) unallowed indices for '//
00701 & CHBIT(1:LNAM-1))
00702 LLOW=LHIG
00703 IF(LLOW.LT.LTOT) GOTO 120
00704 RETURN
00705 ENDIF
00706
00707
00708 IF(IVAR.EQ.1) THEN
00709 IOLD=N
00710 ELSEIF(IVAR.EQ.2) THEN
00711 IOLD=K(I1,I2)
00712 ELSEIF(IVAR.EQ.3) THEN
00713 ROLD=P(I1,I2)
00714 ELSEIF(IVAR.EQ.4) THEN
00715 ROLD=V(I1,I2)
00716 ELSEIF(IVAR.EQ.5) THEN
00717 IOLD=MSTU(I1)
00718 ELSEIF(IVAR.EQ.6) THEN
00719 ROLD=PARU(I1)
00720 ELSEIF(IVAR.EQ.7) THEN
00721 IOLD=MSTJ(I1)
00722 ELSEIF(IVAR.EQ.8) THEN
00723 ROLD=PARJ(I1)
00724 ELSEIF(IVAR.EQ.9) THEN
00725 IOLD=KCHG(I1,I2)
00726 ELSEIF(IVAR.EQ.10) THEN
00727 ROLD=PMAS(I1,I2)
00728 ELSEIF(IVAR.EQ.11) THEN
00729 ROLD=PARF(I1)
00730 ELSEIF(IVAR.EQ.12) THEN
00731 ROLD=VCKM(I1,I2)
00732 ELSEIF(IVAR.EQ.13) THEN
00733 IOLD=MDCY(I1,I2)
00734 ELSEIF(IVAR.EQ.14) THEN
00735 IOLD=MDME(I1,I2)
00736 ELSEIF(IVAR.EQ.15) THEN
00737 ROLD=BRAT(I1)
00738 ELSEIF(IVAR.EQ.16) THEN
00739 IOLD=KFDP(I1,I2)
00740 ELSEIF(IVAR.EQ.17) THEN
00741 CHOLD=CHAF(I1)
00742 ELSEIF(IVAR.EQ.18) THEN
00743 IOLD=MRLU(I1)
00744 ELSEIF(IVAR.EQ.19) THEN
00745 ROLD=RRLU(I1)
00746 ELSEIF(IVAR.EQ.20) THEN
00747 IOLD=MSEL
00748 ELSEIF(IVAR.EQ.21) THEN
00749 IOLD=MSUB(I1)
00750 ELSEIF(IVAR.EQ.22) THEN
00751 IOLD=KFIN(I1,I2)
00752 ELSEIF(IVAR.EQ.23) THEN
00753 ROLD=CKIN(I1)
00754 ELSEIF(IVAR.EQ.24) THEN
00755 IOLD=MSTP(I1)
00756 ELSEIF(IVAR.EQ.25) THEN
00757 ROLD=PARP(I1)
00758 ELSEIF(IVAR.EQ.26) THEN
00759 IOLD=MSTI(I1)
00760 ELSEIF(IVAR.EQ.27) THEN
00761 ROLD=PARI(I1)
00762 ELSEIF(IVAR.EQ.28) THEN
00763 IOLD=MINT(I1)
00764 ELSEIF(IVAR.EQ.29) THEN
00765 ROLD=VINT(I1)
00766 ELSEIF(IVAR.EQ.30) THEN
00767 IOLD=ISET(I1)
00768 ELSEIF(IVAR.EQ.31) THEN
00769 IOLD=KFPR(I1,I2)
00770 ELSEIF(IVAR.EQ.32) THEN
00771 ROLD=COEF(I1,I2)
00772 ELSEIF(IVAR.EQ.33) THEN
00773 IOLD=ICOL(I1,I2,I3)
00774 ELSEIF(IVAR.EQ.34) THEN
00775 ROLD=XSFX(I1,I2)
00776 ELSEIF(IVAR.EQ.35) THEN
00777 IOLD=ISIG(I1,I2)
00778 ELSEIF(IVAR.EQ.36) THEN
00779 ROLD=SIGH(I1)
00780 ELSEIF(IVAR.EQ.37) THEN
00781 ROLD=WIDP(I1,I2)
00782 ELSEIF(IVAR.EQ.38) THEN
00783 ROLD=WIDE(I1,I2)
00784 ELSEIF(IVAR.EQ.39) THEN
00785 ROLD=WIDS(I1,I2)
00786 ELSEIF(IVAR.EQ.40) THEN
00787 IOLD=NGEN(I1,I2)
00788 ELSEIF(IVAR.EQ.41) THEN
00789 ROLD=XSEC(I1,I2)
00790 ELSEIF(IVAR.EQ.42) THEN
00791 CHOLD2=PROC(I1)
00792 ELSEIF(IVAR.EQ.43) THEN
00793 ROLD=SIGT(I1,I2,I3)
00794 ENDIF
00795
00796
00797 IF(LNAM.GE.LBIT) THEN
00798 CHBIT(LNAM:14)=' '
00799 CHBIT(15:60)=' has the value '
00800 IF(MSVAR(IVAR,1).EQ.1) THEN
00801 WRITE(CHBIT(51:60),'(I10)') IOLD
00802 ELSEIF(MSVAR(IVAR,1).EQ.2) THEN
00803 WRITE(CHBIT(47:60),'(F14.5)') ROLD
00804 ELSEIF(MSVAR(IVAR,1).EQ.3) THEN
00805 CHBIT(53:60)=CHOLD
00806 ELSE
00807 CHBIT(33:60)=CHOLD
00808 ENDIF
00809 IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60)
00810 LLOW=LHIG
00811 IF(LLOW.LT.LTOT) GOTO 120
00812 RETURN
00813 ENDIF
00814
00815
00816 IF(MSVAR(IVAR,1).EQ.1) THEN
00817 CHINI=' '
00818 CHINI(LNAM-LBIT+11:10)=CHBIT(LNAM+1:LBIT)
00819 READ(CHINI,'(I10)') INEW
00820 ELSEIF(MSVAR(IVAR,1).EQ.2) THEN
00821 CHINR=' '
00822 CHINR(LNAM-LBIT+17:16)=CHBIT(LNAM+1:LBIT)
00823 READ(CHINR,'(F16.2)') RNEW
00824 ELSEIF(MSVAR(IVAR,1).EQ.3) THEN
00825 CHNEW=CHBIT(LNAM+1:LBIT)//' '
00826 ELSE
00827 CHNEW2=CHBIT(LNAM+1:LBIT)//' '
00828 ENDIF
00829
00830
00831 IF(IVAR.EQ.1) THEN
00832 N=INEW
00833 ELSEIF(IVAR.EQ.2) THEN
00834 K(I1,I2)=INEW
00835 ELSEIF(IVAR.EQ.3) THEN
00836 P(I1,I2)=RNEW
00837 ELSEIF(IVAR.EQ.4) THEN
00838 V(I1,I2)=RNEW
00839 ELSEIF(IVAR.EQ.5) THEN
00840 MSTU(I1)=INEW
00841 ELSEIF(IVAR.EQ.6) THEN
00842 PARU(I1)=RNEW
00843 ELSEIF(IVAR.EQ.7) THEN
00844 MSTJ(I1)=INEW
00845 ELSEIF(IVAR.EQ.8) THEN
00846 PARJ(I1)=RNEW
00847 ELSEIF(IVAR.EQ.9) THEN
00848 KCHG(I1,I2)=INEW
00849 ELSEIF(IVAR.EQ.10) THEN
00850 PMAS(I1,I2)=RNEW
00851 ELSEIF(IVAR.EQ.11) THEN
00852 PARF(I1)=RNEW
00853 ELSEIF(IVAR.EQ.12) THEN
00854 VCKM(I1,I2)=RNEW
00855 ELSEIF(IVAR.EQ.13) THEN
00856 MDCY(I1,I2)=INEW
00857 ELSEIF(IVAR.EQ.14) THEN
00858 MDME(I1,I2)=INEW
00859 ELSEIF(IVAR.EQ.15) THEN
00860 BRAT(I1)=RNEW
00861 ELSEIF(IVAR.EQ.16) THEN
00862 KFDP(I1,I2)=INEW
00863 ELSEIF(IVAR.EQ.17) THEN
00864 CHAF(I1)=CHNEW
00865 ELSEIF(IVAR.EQ.18) THEN
00866 MRLU(I1)=INEW
00867 ELSEIF(IVAR.EQ.19) THEN
00868 RRLU(I1)=RNEW
00869 ELSEIF(IVAR.EQ.20) THEN
00870 MSEL=INEW
00871 ELSEIF(IVAR.EQ.21) THEN
00872 MSUB(I1)=INEW
00873 ELSEIF(IVAR.EQ.22) THEN
00874 KFIN(I1,I2)=INEW
00875 ELSEIF(IVAR.EQ.23) THEN
00876 CKIN(I1)=RNEW
00877 ELSEIF(IVAR.EQ.24) THEN
00878 MSTP(I1)=INEW
00879 ELSEIF(IVAR.EQ.25) THEN
00880 PARP(I1)=RNEW
00881 ELSEIF(IVAR.EQ.26) THEN
00882 MSTI(I1)=INEW
00883 ELSEIF(IVAR.EQ.27) THEN
00884 PARI(I1)=RNEW
00885 ELSEIF(IVAR.EQ.28) THEN
00886 MINT(I1)=INEW
00887 ELSEIF(IVAR.EQ.29) THEN
00888 VINT(I1)=RNEW
00889 ELSEIF(IVAR.EQ.30) THEN
00890 ISET(I1)=INEW
00891 ELSEIF(IVAR.EQ.31) THEN
00892 KFPR(I1,I2)=INEW
00893 ELSEIF(IVAR.EQ.32) THEN
00894 COEF(I1,I2)=RNEW
00895 ELSEIF(IVAR.EQ.33) THEN
00896 ICOL(I1,I2,I3)=INEW
00897 ELSEIF(IVAR.EQ.34) THEN
00898 XSFX(I1,I2)=RNEW
00899 ELSEIF(IVAR.EQ.35) THEN
00900 ISIG(I1,I2)=INEW
00901 ELSEIF(IVAR.EQ.36) THEN
00902 SIGH(I1)=RNEW
00903 ELSEIF(IVAR.EQ.37) THEN
00904 WIDP(I1,I2)=RNEW
00905 ELSEIF(IVAR.EQ.38) THEN
00906 WIDE(I1,I2)=RNEW
00907 ELSEIF(IVAR.EQ.39) THEN
00908 WIDS(I1,I2)=RNEW
00909 ELSEIF(IVAR.EQ.40) THEN
00910 NGEN(I1,I2)=INEW
00911 ELSEIF(IVAR.EQ.41) THEN
00912 XSEC(I1,I2)=RNEW
00913 ELSEIF(IVAR.EQ.42) THEN
00914 PROC(I1)=CHNEW2
00915 ELSEIF(IVAR.EQ.43) THEN
00916 SIGT(I1,I2,I3)=RNEW
00917 ENDIF
00918
00919
00920 CHBIT(LNAM:14)=' '
00921 CHBIT(15:60)=' changed from to '
00922 IF(MSVAR(IVAR,1).EQ.1) THEN
00923 WRITE(CHBIT(33:42),'(I10)') IOLD
00924 WRITE(CHBIT(51:60),'(I10)') INEW
00925 IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60)
00926 ELSEIF(MSVAR(IVAR,1).EQ.2) THEN
00927 WRITE(CHBIT(29:42),'(F14.5)') ROLD
00928 WRITE(CHBIT(47:60),'(F14.5)') RNEW
00929 IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60)
00930 ELSEIF(MSVAR(IVAR,1).EQ.3) THEN
00931 CHBIT(35:42)=CHOLD
00932 CHBIT(53:60)=CHNEW
00933 IF(MSTU(13).GE.1) WRITE(MSTU(11),5000) CHBIT(1:60)
00934 ELSE
00935 CHBIT(15:88)=' changed from '//CHOLD2//' to '//CHNEW2
00936 IF(MSTU(13).GE.1) WRITE(MSTU(11),5100) CHBIT(1:88)
00937 ENDIF
00938 LLOW=LHIG
00939 IF(LLOW.LT.LTOT) GOTO 120
00940
00941
00942 5000 FORMAT(5X,A60)
00943 5100 FORMAT(5X,A88)
00944
00945 RETURN
00946 END
00947
00948
00949
00950 SUBROUTINE LUEXEC
00951
00952
00953 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
00954 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
00955 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
00956 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
00957 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/
00958 DIMENSION PS(2,6)
00959
00960
00961 MSTU(24)=0
00962 IF(MSTU(12).GE.1) CALL LULIST(0)
00963 MSTU(31)=MSTU(31)+1
00964 MSTU(1)=0
00965 MSTU(2)=0
00966 MSTU(3)=0
00967 IF(MSTU(17).LE.0) MSTU(90)=0
00968 MCONS=1
00969
00970
00971 NSAV=N
00972 DO 110 I=1,2
00973 DO 100 J=1,6
00974 PS(I,J)=0.
00975 100 CONTINUE
00976 110 CONTINUE
00977 DO 130 I=1,N
00978 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 130
00979 DO 120 J=1,4
00980 PS(1,J)=PS(1,J)+P(I,J)
00981 120 CONTINUE
00982 PS(1,6)=PS(1,6)+LUCHGE(K(I,2))
00983 130 CONTINUE
00984 PARU(21)=PS(1,4)
00985
00986
00987 CALL LUPREP(0)
00988
00989
00990 MBE=0
00991 140 MBE=MBE+1
00992 IP=0
00993 150 IP=IP+1
00994 KC=0
00995 IF(K(IP,1).GT.0.AND.K(IP,1).LE.10) KC=LUCOMP(K(IP,2))
00996 IF(KC.EQ.0) THEN
00997
00998
00999
01000 ELSEIF(KCHG(KC,2).EQ.0) THEN
01001 IF(MSTJ(21).GE.1.AND.MDCY(KC,1).GE.1.AND.(MSTJ(51).LE.0.OR.MBE.
01002 & EQ.2.OR.PMAS(KC,2).GE.PARJ(91).OR.IABS(K(IP,2)).EQ.311))
01003 & CALL LUDECY(IP)
01004
01005
01006 IF(MSTJ(92).GT.0) THEN
01007 IP1=MSTJ(92)
01008 QMAX=SQRT(MAX(0.,(P(IP1,4)+P(IP1+1,4))**2-(P(IP1,1)+P(IP1+1,
01009 & 1))**2-(P(IP1,2)+P(IP1+1,2))**2-(P(IP1,3)+P(IP1+1,3))**2))
01010 CALL LUSHOW(IP1,IP1+1,QMAX)
01011 CALL LUPREP(IP1)
01012 MSTJ(92)=0
01013 ELSEIF(MSTJ(92).LT.0) THEN
01014 IP1=-MSTJ(92)
01015 CALL LUSHOW(IP1,-3,P(IP,5))
01016 CALL LUPREP(IP1)
01017 MSTJ(92)=0
01018 ENDIF
01019
01020
01021 ELSEIF(K(IP,1).EQ.1.OR.K(IP,1).EQ.2) THEN
01022 MFRAG=MSTJ(1)
01023 IF(MFRAG.GE.1.AND.K(IP,1).EQ.1) MFRAG=2
01024 IF(MSTJ(21).GE.2.AND.K(IP,1).EQ.2.AND.N.GT.IP) THEN
01025 IF(K(IP+1,1).EQ.1.AND.K(IP+1,3).EQ.K(IP,3).AND.
01026 & K(IP,3).GT.0.AND.K(IP,3).LT.IP) THEN
01027 IF(KCHG(LUCOMP(K(K(IP,3),2)),2).EQ.0) MFRAG=MIN(1,MFRAG)
01028 ENDIF
01029 ENDIF
01030 IF(MFRAG.EQ.1) CALL LUSTRF(IP)
01031 IF(MFRAG.EQ.2) CALL LUINDF(IP)
01032 IF(MFRAG.EQ.2.AND.K(IP,1).EQ.1) MCONS=0
01033 IF(MFRAG.EQ.2.AND.(MSTJ(3).LE.0.OR.MOD(MSTJ(3),5).EQ.0)) MCONS=0
01034 ENDIF
01035
01036
01037 IF(MSTU(24).NE.0.AND.MSTU(21).GE.2) THEN
01038 ELSEIF(IP.LT.N.AND.N.LT.MSTU(4)-20-MSTU(32)) THEN
01039 GOTO 150
01040 ELSEIF(IP.LT.N) THEN
01041 CALL LUERRM(11,'(LUEXEC:) no more memory left in LUJETS')
01042 ENDIF
01043
01044
01045 IF(MBE.EQ.1.AND.MSTJ(51).GE.1) THEN
01046 CALL LUBOEI(NSAV)
01047 GOTO 140
01048 ENDIF
01049
01050
01051 DO 170 I=1,N
01052 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 170
01053 DO 160 J=1,4
01054 PS(2,J)=PS(2,J)+P(I,J)
01055 160 CONTINUE
01056 PS(2,6)=PS(2,6)+LUCHGE(K(I,2))
01057 170 CONTINUE
01058 PDEV=(ABS(PS(2,1)-PS(1,1))+ABS(PS(2,2)-PS(1,2))+ABS(PS(2,3)-
01059 &PS(1,3))+ABS(PS(2,4)-PS(1,4)))/(1.+ABS(PS(2,4))+ABS(PS(1,4)))
01060 IF(MCONS.EQ.1.AND.PDEV.GT.PARU(11)) CALL LUERRM(15,
01061 &'(LUEXEC:) four-momentum was not conserved')
01062 IF(MCONS.EQ.1.AND.ABS(PS(2,6)-PS(1,6)).GT.0.1) CALL LUERRM(15,
01063 &'(LUEXEC:) charge was not conserved')
01064
01065 RETURN
01066 END
01067
01068
01069
01070 SUBROUTINE LUPREP(IP)
01071
01072
01073
01074 IMPLICIT DOUBLE PRECISION(D)
01075 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
01076 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
01077 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
01078 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
01079 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/
01080 DIMENSION DPS(5),DPC(5),UE(3)
01081
01082
01083 I1=N
01084 DO 130 MQGST=1,2
01085 DO 120 I=MAX(1,IP),N
01086 IF(K(I,1).NE.3) GOTO 120
01087 KC=LUCOMP(K(I,2))
01088 IF(KC.EQ.0) GOTO 120
01089 KQ=KCHG(KC,2)
01090 IF(KQ.EQ.0.OR.(MQGST.EQ.1.AND.KQ.EQ.2)) GOTO 120
01091
01092
01093 KCS=4
01094 IF(KQ*ISIGN(1,K(I,2)).LT.0) KCS=5
01095 IA=I
01096 NSTP=0
01097 100 NSTP=NSTP+1
01098 IF(NSTP.GT.4*N) THEN
01099 CALL LUERRM(14,'(LUPREP:) caught in infinite loop')
01100 RETURN
01101 ENDIF
01102
01103
01104 IF(K(IA,1).EQ.3) THEN
01105 IF(I1.GE.MSTU(4)-MSTU(32)-5) THEN
01106 CALL LUERRM(11,'(LUPREP:) no more memory left in LUJETS')
01107 RETURN
01108 ENDIF
01109 I1=I1+1
01110 K(I1,1)=2
01111 IF(NSTP.GE.2.AND.IABS(K(IA,2)).NE.21) K(I1,1)=1
01112 K(I1,2)=K(IA,2)
01113 K(I1,3)=IA
01114 K(I1,4)=0
01115 K(I1,5)=0
01116 DO 110 J=1,5
01117 P(I1,J)=P(IA,J)
01118 V(I1,J)=V(IA,J)
01119 110 CONTINUE
01120 K(IA,1)=K(IA,1)+10
01121 IF(K(I1,1).EQ.1) GOTO 120
01122 ENDIF
01123
01124
01125 IB=IA
01126 IF(MOD(K(IB,KCS)/MSTU(5)**2,2).EQ.0.AND.MOD(K(IB,KCS),MSTU(5)).
01127 &NE.0) THEN
01128 IA=MOD(K(IB,KCS),MSTU(5))
01129 K(IB,KCS)=K(IB,KCS)+MSTU(5)**2
01130 MREV=0
01131 ELSE
01132 IF(K(IB,KCS).GE.2*MSTU(5)**2.OR.MOD(K(IB,KCS)/MSTU(5),MSTU(5)).
01133 & EQ.0) KCS=9-KCS
01134 IA=MOD(K(IB,KCS)/MSTU(5),MSTU(5))
01135 K(IB,KCS)=K(IB,KCS)+2*MSTU(5)**2
01136 MREV=1
01137 ENDIF
01138 IF(IA.LE.0.OR.IA.GT.N) THEN
01139 CALL LUERRM(12,'(LUPREP:) colour rearrangement failed')
01140 RETURN
01141 ENDIF
01142 IF(MOD(K(IA,4)/MSTU(5),MSTU(5)).EQ.IB.OR.MOD(K(IA,5)/MSTU(5),
01143 &MSTU(5)).EQ.IB) THEN
01144 IF(MREV.EQ.1) KCS=9-KCS
01145 IF(MOD(K(IA,KCS)/MSTU(5),MSTU(5)).NE.IB) KCS=9-KCS
01146 K(IA,KCS)=K(IA,KCS)+2*MSTU(5)**2
01147 ELSE
01148 IF(MREV.EQ.0) KCS=9-KCS
01149 IF(MOD(K(IA,KCS),MSTU(5)).NE.IB) KCS=9-KCS
01150 K(IA,KCS)=K(IA,KCS)+MSTU(5)**2
01151 ENDIF
01152 IF(IA.NE.I) GOTO 100
01153 K(I1,1)=1
01154 120 CONTINUE
01155 130 CONTINUE
01156 N=I1
01157 IF(MSTJ(14).LT.0) RETURN
01158
01159
01160 IF(MSTJ(14).EQ.0) GOTO 320
01161 NS=N
01162 140 NSIN=N-NS
01163 PDM=1.+PARJ(32)
01164 IC=0
01165 DO 190 I=MAX(1,IP),NS
01166 IF(K(I,1).NE.1.AND.K(I,1).NE.2) THEN
01167 ELSEIF(K(I,1).EQ.2.AND.IC.EQ.0) THEN
01168 NSIN=NSIN+1
01169 IC=I
01170 DO 150 J=1,4
01171 DPS(J)=P(I,J)
01172 150 CONTINUE
01173 MSTJ(93)=1
01174 DPS(5)=ULMASS(K(I,2))
01175 ELSEIF(K(I,1).EQ.2) THEN
01176 DO 160 J=1,4
01177 DPS(J)=DPS(J)+P(I,J)
01178 160 CONTINUE
01179 ELSEIF(IC.NE.0.AND.KCHG(LUCOMP(K(I,2)),2).NE.0) THEN
01180 DO 170 J=1,4
01181 DPS(J)=DPS(J)+P(I,J)
01182 170 CONTINUE
01183 MSTJ(93)=1
01184 DPS(5)=DPS(5)+ULMASS(K(I,2))
01185 PD=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2))-DPS(5)
01186 IF(PD.LT.PDM) THEN
01187 PDM=PD
01188 DO 180 J=1,5
01189 DPC(J)=DPS(J)
01190 180 CONTINUE
01191 IC1=IC
01192 IC2=I
01193 ENDIF
01194 IC=0
01195 ELSE
01196 NSIN=NSIN+1
01197 ENDIF
01198 190 CONTINUE
01199 IF(PDM.GE.PARJ(32)) GOTO 320
01200
01201
01202 NSAV=N
01203 PECM=SQRT(MAX(0D0,DPC(4)**2-DPC(1)**2-DPC(2)**2-DPC(3)**2))
01204 K(N+1,1)=11
01205 K(N+1,2)=91
01206 K(N+1,3)=IC1
01207 K(N+1,4)=N+2
01208 K(N+1,5)=N+3
01209 P(N+1,1)=DPC(1)
01210 P(N+1,2)=DPC(2)
01211 P(N+1,3)=DPC(3)
01212 P(N+1,4)=DPC(4)
01213 P(N+1,5)=PECM
01214
01215
01216 K(N+2,1)=1
01217 K(N+3,1)=1
01218 IF(MSTU(16).NE.2) THEN
01219 K(N+2,3)=N+1
01220 K(N+3,3)=N+1
01221 ELSE
01222 K(N+2,3)=IC1
01223 K(N+3,3)=IC2
01224 ENDIF
01225 K(N+2,4)=0
01226 K(N+3,4)=0
01227 K(N+2,5)=0
01228 K(N+3,5)=0
01229 IF(IABS(K(IC1,2)).NE.21) THEN
01230 KC1=LUCOMP(K(IC1,2))
01231 KC2=LUCOMP(K(IC2,2))
01232 IF(KC1.EQ.0.OR.KC2.EQ.0) GOTO 320
01233 KQ1=KCHG(KC1,2)*ISIGN(1,K(IC1,2))
01234 KQ2=KCHG(KC2,2)*ISIGN(1,K(IC2,2))
01235 IF(KQ1+KQ2.NE.0) GOTO 320
01236 200 CALL LUKFDI(K(IC1,2),0,KFLN,K(N+2,2))
01237 CALL LUKFDI(K(IC2,2),-KFLN,KFLDMP,K(N+3,2))
01238 IF(K(N+2,2).EQ.0.OR.K(N+3,2).EQ.0) GOTO 200
01239 ELSE
01240 IF(IABS(K(IC2,2)).NE.21) GOTO 320
01241 210 CALL LUKFDI(1+INT((2.+PARJ(2))*RLU(0)),0,KFLN,KFDMP)
01242 CALL LUKFDI(KFLN,0,KFLM,K(N+2,2))
01243 CALL LUKFDI(-KFLN,-KFLM,KFLDMP,K(N+3,2))
01244 IF(K(N+2,2).EQ.0.OR.K(N+3,2).EQ.0) GOTO 210
01245 ENDIF
01246 P(N+2,5)=ULMASS(K(N+2,2))
01247 P(N+3,5)=ULMASS(K(N+3,2))
01248 IF(P(N+2,5)+P(N+3,5)+PARJ(64).GE.PECM.AND.NSIN.EQ.1) GOTO 320
01249 IF(P(N+2,5)+P(N+3,5)+PARJ(64).GE.PECM) GOTO 260
01250
01251
01252 IF(PECM.GE.0.02*DPC(4)) THEN
01253 PA=SQRT((PECM**2-(P(N+2,5)+P(N+3,5))**2)*(PECM**2-
01254 & (P(N+2,5)-P(N+3,5))**2))/(2.*PECM)
01255 UE(3)=2.*RLU(0)-1.
01256 PHI=PARU(2)*RLU(0)
01257 UE(1)=SQRT(1.-UE(3)**2)*COS(PHI)
01258 UE(2)=SQRT(1.-UE(3)**2)*SIN(PHI)
01259 DO 220 J=1,3
01260 P(N+2,J)=PA*UE(J)
01261 P(N+3,J)=-PA*UE(J)
01262 220 CONTINUE
01263 P(N+2,4)=SQRT(PA**2+P(N+2,5)**2)
01264 P(N+3,4)=SQRT(PA**2+P(N+3,5)**2)
01265 MSTU(33)=1
01266 CALL LUDBRB(N+2,N+3,0.,0.,DPC(1)/DPC(4),DPC(2)/DPC(4),
01267 & DPC(3)/DPC(4))
01268 ELSE
01269 NP=0
01270 DO 230 I=IC1,IC2
01271 IF(K(I,1).EQ.1.OR.K(I,1).EQ.2) NP=NP+1
01272 230 CONTINUE
01273 HA=P(IC1,4)*P(IC2,4)-P(IC1,1)*P(IC2,1)-P(IC1,2)*P(IC2,2)-
01274 & P(IC1,3)*P(IC2,3)
01275 IF(NP.GE.3.OR.HA.LE.1.25*P(IC1,5)*P(IC2,5)) GOTO 260
01276 HD1=0.5*(P(N+2,5)**2-P(IC1,5)**2)
01277 HD2=0.5*(P(N+3,5)**2-P(IC2,5)**2)
01278 HR=SQRT(MAX(0.,((HA-HD1-HD2)**2-(P(N+2,5)*P(N+3,5))**2)/
01279 & (HA**2-(P(IC1,5)*P(IC2,5))**2)))-1.
01280 HC=P(IC1,5)**2+2.*HA+P(IC2,5)**2
01281 HK1=((P(IC2,5)**2+HA)*HR+HD1-HD2)/HC
01282 HK2=((P(IC1,5)**2+HA)*HR+HD2-HD1)/HC
01283 DO 240 J=1,4
01284 P(N+2,J)=(1.+HK1)*P(IC1,J)-HK2*P(IC2,J)
01285 P(N+3,J)=(1.+HK2)*P(IC2,J)-HK1*P(IC1,J)
01286 240 CONTINUE
01287 ENDIF
01288 DO 250 J=1,4
01289 V(N+1,J)=V(IC1,J)
01290 V(N+2,J)=V(IC1,J)
01291 V(N+3,J)=V(IC2,J)
01292 250 CONTINUE
01293 V(N+1,5)=0.
01294 V(N+2,5)=0.
01295 V(N+3,5)=0.
01296 N=N+3
01297 GOTO 300
01298
01299
01300 260 K(N+1,5)=N+2
01301 IF(IABS(K(IC1,2)).GT.100.AND.IABS(K(IC2,2)).GT.100) THEN
01302 GOTO 320
01303 ELSEIF(IABS(K(IC1,2)).NE.21) THEN
01304 CALL LUKFDI(K(IC1,2),K(IC2,2),KFLDMP,K(N+2,2))
01305 ELSE
01306 KFLN=1+INT((2.+PARJ(2))*RLU(0))
01307 CALL LUKFDI(KFLN,-KFLN,KFLDMP,K(N+2,2))
01308 ENDIF
01309 IF(K(N+2,2).EQ.0) GOTO 260
01310 P(N+2,5)=ULMASS(K(N+2,2))
01311
01312
01313 IR=0
01314 HA=0.
01315 HSM=0.
01316 DO 280 MCOMB=1,3
01317 IF(IR.NE.0) GOTO 280
01318 DO 270 I=MAX(1,IP),N
01319 IF(K(I,1).LE.0.OR.K(I,1).GT.10.OR.(I.GE.IC1.AND.I.LE.IC2.
01320 &AND.K(I,1).GE.1.AND.K(I,1).LE.2)) GOTO 270
01321 IF(MCOMB.EQ.1) KCI=LUCOMP(K(I,2))
01322 IF(MCOMB.EQ.1.AND.KCI.EQ.0) GOTO 270
01323 IF(MCOMB.EQ.1.AND.KCHG(KCI,2).EQ.0.AND.I.LE.NS) GOTO 270
01324 IF(MCOMB.EQ.2.AND.IABS(K(I,2)).GT.10.AND.IABS(K(I,2)).LE.100)
01325 &GOTO 270
01326 HCR=DPC(4)*P(I,4)-DPC(1)*P(I,1)-DPC(2)*P(I,2)-DPC(3)*P(I,3)
01327 HSR=2.*HCR+PECM**2-P(N+2,5)**2-2.*P(N+2,5)*P(I,5)
01328 IF(HSR.GT.HSM) THEN
01329 IR=I
01330 HA=HCR
01331 HSM=HSR
01332 ENDIF
01333 270 CONTINUE
01334 280 CONTINUE
01335
01336
01337 IF(IR.NE.0) THEN
01338 HB=PECM**2+HA
01339 HC=P(N+2,5)**2+HA
01340 HD=P(IR,5)**2+HA
01341 HK2=0.5*(HB*SQRT(MAX(0.,((HB+HC)**2-4.*(HB+HD)*P(N+2,5)**2)/
01342 & (HA**2-(PECM*P(IR,5))**2)))-(HB+HC))/(HB+HD)
01343 HK1=(0.5*(P(N+2,5)**2-PECM**2)+HD*HK2)/HB
01344 DO 290 J=1,4
01345 P(N+2,J)=(1.+HK1)*DPC(J)-HK2*P(IR,J)
01346 P(IR,J)=(1.+HK2)*P(IR,J)-HK1*DPC(J)
01347 V(N+1,J)=V(IC1,J)
01348 V(N+2,J)=V(IC1,J)
01349 290 CONTINUE
01350 V(N+1,5)=0.
01351 V(N+2,5)=0.
01352 N=N+2
01353 ELSE
01354 CALL LUERRM(3,'(LUPREP:) no match for collapsing cluster')
01355 RETURN
01356 ENDIF
01357
01358
01359 300 DO 310 I=IC1,IC2
01360 IF((K(I,1).EQ.1.OR.K(I,1).EQ.2).AND.KCHG(LUCOMP(K(I,2)),2).NE.0)
01361 &THEN
01362 K(I,1)=K(I,1)+10
01363 IF(MSTU(16).NE.2) THEN
01364 K(I,4)=NSAV+1
01365 K(I,5)=NSAV+1
01366 ELSE
01367 K(I,4)=NSAV+2
01368 K(I,5)=N
01369 ENDIF
01370 ENDIF
01371 310 CONTINUE
01372 IF(N.LT.MSTU(4)-MSTU(32)-5) GOTO 140
01373
01374
01375 320 NP=0
01376 KFN=0
01377 KQS=0
01378 DO 330 J=1,5
01379 DPS(J)=0.
01380 330 CONTINUE
01381 DO 360 I=MAX(1,IP),N
01382 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 360
01383 KC=LUCOMP(K(I,2))
01384 IF(KC.EQ.0) GOTO 360
01385 KQ=KCHG(KC,2)*ISIGN(1,K(I,2))
01386 IF(KQ.EQ.0) GOTO 360
01387 NP=NP+1
01388 IF(KQ.NE.2) THEN
01389 KFN=KFN+1
01390 KQS=KQS+KQ
01391 MSTJ(93)=1
01392 DPS(5)=DPS(5)+ULMASS(K(I,2))
01393 ENDIF
01394 DO 340 J=1,4
01395 DPS(J)=DPS(J)+P(I,J)
01396 340 CONTINUE
01397 IF(K(I,1).EQ.1) THEN
01398 IF(NP.NE.1.AND.(KFN.EQ.1.OR.KFN.GE.3.OR.KQS.NE.0)) CALL
01399 & LUERRM(2,'(LUPREP:) unphysical flavour combination')
01400 IF(NP.NE.1.AND.DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2.LT.
01401 & (0.9*PARJ(32)+DPS(5))**2) CALL LUERRM(3,
01402 & '(LUPREP:) too small mass in jet system')
01403 NP=0
01404 KFN=0
01405 KQS=0
01406 DO 350 J=1,5
01407 DPS(J)=0.
01408 350 CONTINUE
01409 ENDIF
01410 360 CONTINUE
01411
01412 RETURN
01413 END
01414
01415
01416
01417 SUBROUTINE LUSTRF(IP)
01418
01419
01420 IMPLICIT DOUBLE PRECISION(D)
01421 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
01422 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
01423 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
01424 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
01425 DIMENSION DPS(5),KFL(3),PMQ(3),PX(3),PY(3),GAM(3),IE(2),PR(2),
01426 &IN(9),DHM(4),DHG(4),DP(5,5),IRANK(2),MJU(4),IJU(3),PJU(5,5),
01427 &TJU(5),KFJH(2),NJS(2),KFJS(2),PJS(4,5),MSTU9T(8),PARU9T(8)
01428
01429
01430 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)
01431 DFOUR(I,J)=DP(I,4)*DP(J,4)-DP(I,1)*DP(J,1)-DP(I,2)*DP(J,2)-
01432 &DP(I,3)*DP(J,3)
01433
01434
01435 MSTJ(91)=0
01436 NSAV=N
01437 MSTU90=MSTU(90)
01438 NP=0
01439 KQSUM=0
01440 DO 100 J=1,5
01441 DPS(J)=0D0
01442 100 CONTINUE
01443 MJU(1)=0
01444 MJU(2)=0
01445 I=IP-1
01446 110 I=I+1
01447 IF(I.GT.MIN(N,MSTU(4)-MSTU(32))) THEN
01448 CALL LUERRM(12,'(LUSTRF:) failed to reconstruct jet system')
01449 IF(MSTU(21).GE.1) RETURN
01450 ENDIF
01451 IF(K(I,1).NE.1.AND.K(I,1).NE.2.AND.K(I,1).NE.41) GOTO 110
01452 KC=LUCOMP(K(I,2))
01453 IF(KC.EQ.0) GOTO 110
01454 KQ=KCHG(KC,2)*ISIGN(1,K(I,2))
01455 IF(KQ.EQ.0) GOTO 110
01456 IF(N+5*NP+11.GT.MSTU(4)-MSTU(32)-5) THEN
01457 CALL LUERRM(11,'(LUSTRF:) no more memory left in LUJETS')
01458 IF(MSTU(21).GE.1) RETURN
01459 ENDIF
01460
01461
01462 NP=NP+1
01463 DO 120 J=1,5
01464 K(N+NP,J)=K(I,J)
01465 P(N+NP,J)=P(I,J)
01466 IF(J.NE.4) DPS(J)=DPS(J)+P(I,J)
01467 120 CONTINUE
01468 DPS(4)=DPS(4)+SQRT(DBLE(P(I,1))**2+DBLE(P(I,2))**2+
01469 &DBLE(P(I,3))**2+DBLE(P(I,5))**2)
01470 K(N+NP,3)=I
01471 IF(KQ.NE.2) KQSUM=KQSUM+KQ
01472 IF(K(I,1).EQ.41) THEN
01473 KQSUM=KQSUM+2*KQ
01474 IF(KQSUM.EQ.KQ) MJU(1)=N+NP
01475 IF(KQSUM.NE.KQ) MJU(2)=N+NP
01476 ENDIF
01477 IF(K(I,1).EQ.2.OR.K(I,1).EQ.41) GOTO 110
01478 IF(KQSUM.NE.0) THEN
01479 CALL LUERRM(12,'(LUSTRF:) unphysical flavour combination')
01480 IF(MSTU(21).GE.1) RETURN
01481 ENDIF
01482
01483
01484 IF(ABS(DPS(3)).LT.0.99D0*DPS(4)) THEN
01485 MBST=0
01486 MSTU(33)=1
01487 CALL LUDBRB(N+1,N+NP,0.,0.,-DPS(1)/DPS(4),-DPS(2)/DPS(4),
01488 & -DPS(3)/DPS(4))
01489 ELSE
01490 MBST=1
01491 HHBZ=SQRT(MAX(1D-6,DPS(4)+DPS(3))/MAX(1D-6,DPS(4)-DPS(3)))
01492 DO 130 I=N+1,N+NP
01493 HHPMT=P(I,1)**2+P(I,2)**2+P(I,5)**2
01494 IF(P(I,3).GT.0.) THEN
01495 HHPEZ=(P(I,4)+P(I,3))/HHBZ
01496 P(I,3)=0.5*(HHPEZ-HHPMT/HHPEZ)
01497 P(I,4)=0.5*(HHPEZ+HHPMT/HHPEZ)
01498 ELSE
01499 HHPEZ=(P(I,4)-P(I,3))*HHBZ
01500 P(I,3)=-0.5*(HHPEZ-HHPMT/HHPEZ)
01501 P(I,4)=0.5*(HHPEZ+HHPMT/HHPEZ)
01502 ENDIF
01503 130 CONTINUE
01504 ENDIF
01505
01506
01507 NTRYR=0
01508 PARU12=PARU(12)
01509 PARU13=PARU(13)
01510 MJU(3)=MJU(1)
01511 MJU(4)=MJU(2)
01512 NR=NP
01513 140 IF(NR.GE.3) THEN
01514 PDRMIN=2.*PARU12
01515 DO 150 I=N+1,N+NR
01516 IF(I.EQ.N+NR.AND.IABS(K(N+1,2)).NE.21) GOTO 150
01517 I1=I+1
01518 IF(I.EQ.N+NR) I1=N+1
01519 IF(K(I,1).EQ.41.OR.K(I1,1).EQ.41) GOTO 150
01520 IF(MJU(1).NE.0.AND.I1.LT.MJU(1).AND.IABS(K(I1,2)).NE.21)
01521 & GOTO 150
01522 IF(MJU(2).NE.0.AND.I.GT.MJU(2).AND.IABS(K(I,2)).NE.21) GOTO 150
01523 PAP=SQRT((P(I,1)**2+P(I,2)**2+P(I,3)**2)*(P(I1,1)**2+
01524 & P(I1,2)**2+P(I1,3)**2))
01525 PVP=P(I,1)*P(I1,1)+P(I,2)*P(I1,2)+P(I,3)*P(I1,3)
01526 PDR=4.*(PAP-PVP)**2/MAX(1E-6,PARU13**2*PAP+2.*(PAP-PVP))
01527 IF(PDR.LT.PDRMIN) THEN
01528 IR=I
01529 PDRMIN=PDR
01530 ENDIF
01531 150 CONTINUE
01532
01533
01534 IF(PDRMIN.LT.PARU12.AND.IR.EQ.N+NR) THEN
01535 DO 160 J=1,4
01536 P(N+1,J)=P(N+1,J)+P(N+NR,J)
01537 160 CONTINUE
01538 P(N+1,5)=SQRT(MAX(0.,P(N+1,4)**2-P(N+1,1)**2-P(N+1,2)**2-
01539 & P(N+1,3)**2))
01540 NR=NR-1
01541 GOTO 140
01542 ELSEIF(PDRMIN.LT.PARU12) THEN
01543 DO 170 J=1,4
01544 P(IR,J)=P(IR,J)+P(IR+1,J)
01545 170 CONTINUE
01546 P(IR,5)=SQRT(MAX(0.,P(IR,4)**2-P(IR,1)**2-P(IR,2)**2-
01547 & P(IR,3)**2))
01548 DO 190 I=IR+1,N+NR-1
01549 K(I,2)=K(I+1,2)
01550 DO 180 J=1,5
01551 P(I,J)=P(I+1,J)
01552 180 CONTINUE
01553 190 CONTINUE
01554 IF(IR.EQ.N+NR-1) K(IR,2)=K(N+NR,2)
01555 NR=NR-1
01556 IF(MJU(1).GT.IR) MJU(1)=MJU(1)-1
01557 IF(MJU(2).GT.IR) MJU(2)=MJU(2)-1
01558 GOTO 140
01559 ENDIF
01560 ENDIF
01561 NTRYR=NTRYR+1
01562
01563
01564
01565 NRS=MAX(5*NR+11,NP)
01566 NTRY=0
01567 200 NTRY=NTRY+1
01568 IF(NTRY.GT.100.AND.NTRYR.LE.4) THEN
01569 PARU12=4.*PARU12
01570 PARU13=2.*PARU13
01571 GOTO 140
01572 ELSEIF(NTRY.GT.100) THEN
01573 CALL LUERRM(14,'(LUSTRF:) caught in infinite loop')
01574 IF(MSTU(21).GE.1) RETURN
01575 ENDIF
01576 I=N+NRS
01577 MSTU(90)=MSTU90
01578 IF(MJU(1).EQ.0.AND.MJU(2).EQ.0) GOTO 580
01579 DO 570 JT=1,2
01580 NJS(JT)=0
01581 IF(MJU(JT).EQ.0) GOTO 570
01582 JS=3-2*JT
01583
01584
01585 DO 220 IU=1,3
01586 IJU(IU)=0
01587 DO 210 J=1,5
01588 PJU(IU,J)=0.
01589 210 CONTINUE
01590 220 CONTINUE
01591 IU=0
01592 DO 240 I1=N+1+(JT-1)*(NR-1),N+NR+(JT-1)*(1-NR),JS
01593 IF(K(I1,2).NE.21.AND.IU.LE.2) THEN
01594 IU=IU+1
01595 IJU(IU)=I1
01596 ENDIF
01597 DO 230 J=1,4
01598 PJU(IU,J)=PJU(IU,J)+P(I1,J)
01599 230 CONTINUE
01600 240 CONTINUE
01601 DO 250 IU=1,3
01602 PJU(IU,5)=SQRT(PJU(IU,1)**2+PJU(IU,2)**2+PJU(IU,3)**2)
01603 250 CONTINUE
01604 IF(K(IJU(3),2)/100.NE.10*K(IJU(1),2)+K(IJU(2),2).AND.
01605 &K(IJU(3),2)/100.NE.10*K(IJU(2),2)+K(IJU(1),2)) THEN
01606 CALL LUERRM(12,'(LUSTRF:) unphysical flavour combination')
01607 IF(MSTU(21).GE.1) RETURN
01608 ENDIF
01609
01610
01611 T12=(PJU(1,1)*PJU(2,1)+PJU(1,2)*PJU(2,2)+PJU(1,3)*PJU(2,3))/
01612 &(PJU(1,5)*PJU(2,5))
01613 T13=(PJU(1,1)*PJU(3,1)+PJU(1,2)*PJU(3,2)+PJU(1,3)*PJU(3,3))/
01614 &(PJU(1,5)*PJU(3,5))
01615 T23=(PJU(2,1)*PJU(3,1)+PJU(2,2)*PJU(3,2)+PJU(2,3)*PJU(3,3))/
01616 &(PJU(2,5)*PJU(3,5))
01617 T11=SQRT((2./3.)*(1.-T12)*(1.-T13)/(1.-T23))
01618 T22=SQRT((2./3.)*(1.-T12)*(1.-T23)/(1.-T13))
01619 TSQ=SQRT((2.*T11*T22+T12-1.)*(1.+T12))
01620 T1F=(TSQ-T22*(1.+T12))/(1.-T12**2)
01621 T2F=(TSQ-T11*(1.+T12))/(1.-T12**2)
01622 DO 260 J=1,3
01623 TJU(J)=-(T1F*PJU(1,J)/PJU(1,5)+T2F*PJU(2,J)/PJU(2,5))
01624 260 CONTINUE
01625 TJU(4)=SQRT(1.+TJU(1)**2+TJU(2)**2+TJU(3)**2)
01626 DO 270 IU=1,3
01627 PJU(IU,5)=TJU(4)*PJU(IU,4)-TJU(1)*PJU(IU,1)-TJU(2)*PJU(IU,2)-
01628 &TJU(3)*PJU(IU,3)
01629 270 CONTINUE
01630
01631
01632 IF(PJU(1,5)+PJU(2,5).GT.PJU(1,4)+PJU(2,4)) THEN
01633 DO 280 J=1,3
01634 TJU(J)=0.
01635 280 CONTINUE
01636 TJU(4)=1.
01637 PJU(1,5)=PJU(1,4)
01638 PJU(2,5)=PJU(2,4)
01639 PJU(3,5)=PJU(3,4)
01640 ENDIF
01641
01642
01643 ISTA=I
01644 DO 550 IU=1,2
01645 NS=IJU(IU+1)-IJU(IU)
01646
01647
01648 DO 310 IS=1,NS
01649 IS1=IJU(IU)+IS-1
01650 IS2=IJU(IU)+IS
01651 DO 290 J=1,5
01652 DP(1,J)=0.5*P(IS1,J)
01653 IF(IS.EQ.1) DP(1,J)=P(IS1,J)
01654 DP(2,J)=0.5*P(IS2,J)
01655 IF(IS.EQ.NS) DP(2,J)=-PJU(IU,J)
01656 290 CONTINUE
01657 IF(IS.EQ.NS) DP(2,4)=SQRT(PJU(IU,1)**2+PJU(IU,2)**2+PJU(IU,3)**2)
01658 IF(IS.EQ.NS) DP(2,5)=0.
01659 DP(3,5)=DFOUR(1,1)
01660 DP(4,5)=DFOUR(2,2)
01661 DHKC=DFOUR(1,2)
01662 IF(DP(3,5)+2.*DHKC+DP(4,5).LE.0.) THEN
01663 DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2)
01664 DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2)
01665 DP(3,5)=0D0
01666 DP(4,5)=0D0
01667 DHKC=DFOUR(1,2)
01668 ENDIF
01669 DHKS=SQRT(DHKC**2-DP(3,5)*DP(4,5))
01670 DHK1=0.5*((DP(4,5)+DHKC)/DHKS-1.)
01671 DHK2=0.5*((DP(3,5)+DHKC)/DHKS-1.)
01672 IN1=N+NR+4*IS-3
01673 P(IN1,5)=SQRT(DP(3,5)+2.*DHKC+DP(4,5))
01674 DO 300 J=1,4
01675 P(IN1,J)=(1.+DHK1)*DP(1,J)-DHK2*DP(2,J)
01676 P(IN1+1,J)=(1.+DHK2)*DP(2,J)-DHK1*DP(1,J)
01677 300 CONTINUE
01678 310 CONTINUE
01679
01680
01681 ISAV=I
01682 MSTU91=MSTU(90)
01683 320 NTRY=NTRY+1
01684 IF(NTRY.GT.100.AND.NTRYR.LE.4) THEN
01685 PARU12=4.*PARU12
01686 PARU13=2.*PARU13
01687 GOTO 140
01688 ELSEIF(NTRY.GT.100) THEN
01689 CALL LUERRM(14,'(LUSTRF:) caught in infinite loop')
01690 IF(MSTU(21).GE.1) RETURN
01691 ENDIF
01692 I=ISAV
01693 MSTU(90)=MSTU91
01694 IRANKJ=0
01695 IE(1)=K(N+1+(JT/2)*(NP-1),3)
01696 IN(4)=N+NR+1
01697 IN(5)=IN(4)+1
01698 IN(6)=N+NR+4*NS+1
01699 DO 340 JQ=1,2
01700 DO 330 IN1=N+NR+2+JQ,N+NR+4*NS-2+JQ,4
01701 P(IN1,1)=2-JQ
01702 P(IN1,2)=JQ-1
01703 P(IN1,3)=1.
01704 330 CONTINUE
01705 340 CONTINUE
01706 KFL(1)=K(IJU(IU),2)
01707 PX(1)=0.
01708 PY(1)=0.
01709 GAM(1)=0.
01710 DO 350 J=1,5
01711 PJU(IU+3,J)=0.
01712 350 CONTINUE
01713
01714
01715 DO 360 J=1,4
01716 DP(1,J)=P(IN(4),J)
01717 DP(2,J)=P(IN(4)+1,J)
01718 DP(3,J)=0.
01719 DP(4,J)=0.
01720 360 CONTINUE
01721 DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2)
01722 DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2)
01723 DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4)
01724 DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4)
01725 DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4)
01726 IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1.
01727 IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1.
01728 IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1.
01729 IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1.
01730 DHC12=DFOUR(1,2)
01731 DHCX1=DFOUR(3,1)/DHC12
01732 DHCX2=DFOUR(3,2)/DHC12
01733 DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12)
01734 DHCY1=DFOUR(4,1)/DHC12
01735 DHCY2=DFOUR(4,2)/DHC12
01736 DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12
01737 DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2)
01738 DO 370 J=1,4
01739 DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J))
01740 P(IN(6),J)=DP(3,J)
01741 P(IN(6)+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)-
01742 &DHCYX*DP(3,J))
01743 370 CONTINUE
01744
01745
01746 380 I=I+1
01747 IF(2*I-NSAV.GE.MSTU(4)-MSTU(32)-5) THEN
01748 CALL LUERRM(11,'(LUSTRF:) no more memory left in LUJETS')
01749 IF(MSTU(21).GE.1) RETURN
01750 ENDIF
01751 IRANKJ=IRANKJ+1
01752 K(I,1)=1
01753 K(I,3)=IE(1)
01754 K(I,4)=0
01755 K(I,5)=0
01756
01757
01758 390 CALL LUKFDI(KFL(1),0,KFL(3),K(I,2))
01759 IF(K(I,2).EQ.0) GOTO 320
01760 IF(MSTJ(12).GE.3.AND.IRANKJ.EQ.1.AND.IABS(KFL(1)).LE.10.AND.
01761 &IABS(KFL(3)).GT.10) THEN
01762 IF(RLU(0).GT.PARJ(19)) GOTO 390
01763 ENDIF
01764 P(I,5)=ULMASS(K(I,2))
01765 CALL LUPTDI(KFL(1),PX(3),PY(3))
01766 PR(1)=P(I,5)**2+(PX(1)+PX(3))**2+(PY(1)+PY(3))**2
01767 CALL LUZDIS(KFL(1),KFL(3),PR(1),Z)
01768 IF(IABS(KFL(1)).GE.4.AND.IABS(KFL(1)).LE.8.AND.
01769 &MSTU(90).LT.8) THEN
01770 MSTU(90)=MSTU(90)+1
01771 MSTU(90+MSTU(90))=I
01772 PARU(90+MSTU(90))=Z
01773 ENDIF
01774 GAM(3)=(1.-Z)*(GAM(1)+PR(1)/Z)
01775 DO 400 J=1,3
01776 IN(J)=IN(3+J)
01777 400 CONTINUE
01778
01779
01780 IF(IN(1)+1.EQ.IN(2).AND.Z*P(IN(1)+2,3)*P(IN(2)+2,3)*
01781 &P(IN(1),5)**2.GE.PR(1)) THEN
01782 P(IN(1)+2,4)=Z*P(IN(1)+2,3)
01783 P(IN(2)+2,4)=PR(1)/(P(IN(1)+2,4)*P(IN(1),5)**2)
01784 DO 410 J=1,4
01785 P(I,J)=(PX(1)+PX(3))*P(IN(3),J)+(PY(1)+PY(3))*P(IN(3)+1,J)
01786 410 CONTINUE
01787 GOTO 500
01788 ELSEIF(IN(1)+1.EQ.IN(2)) THEN
01789 P(IN(2)+2,4)=P(IN(2)+2,3)
01790 P(IN(2)+2,1)=1.
01791 IN(2)=IN(2)+4
01792 IF(IN(2).GT.N+NR+4*NS) GOTO 320
01793 IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN
01794 P(IN(1)+2,4)=P(IN(1)+2,3)
01795 P(IN(1)+2,1)=0.
01796 IN(1)=IN(1)+4
01797 ENDIF
01798 ENDIF
01799
01800
01801 420 IF(IN(1).GT.N+NR+4*NS.OR.IN(2).GT.N+NR+4*NS.OR.
01802 &IN(1).GT.IN(2)) GOTO 320
01803 IF(IN(1).NE.IN(4).OR.IN(2).NE.IN(5)) THEN
01804 DO 430 J=1,4
01805 DP(1,J)=P(IN(1),J)
01806 DP(2,J)=P(IN(2),J)
01807 DP(3,J)=0.
01808 DP(4,J)=0.
01809 430 CONTINUE
01810 DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2)
01811 DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2)
01812 DHC12=DFOUR(1,2)
01813 IF(DHC12.LE.1E-2) THEN
01814 P(IN(1)+2,4)=P(IN(1)+2,3)
01815 P(IN(1)+2,1)=0.
01816 IN(1)=IN(1)+4
01817 GOTO 420
01818 ENDIF
01819 IN(3)=N+NR+4*NS+5
01820 DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4)
01821 DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4)
01822 DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4)
01823 IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1.
01824 IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1.
01825 IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1.
01826 IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1.
01827 DHCX1=DFOUR(3,1)/DHC12
01828 DHCX2=DFOUR(3,2)/DHC12
01829 DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12)
01830 DHCY1=DFOUR(4,1)/DHC12
01831 DHCY2=DFOUR(4,2)/DHC12
01832 DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12
01833 DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2)
01834 DO 440 J=1,4
01835 DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J))
01836 P(IN(3),J)=DP(3,J)
01837 P(IN(3)+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)-
01838 & DHCYX*DP(3,J))
01839 440 CONTINUE
01840
01841 PXP=-(PX(3)*FOUR(IN(6),IN(3))+PY(3)*FOUR(IN(6)+1,IN(3)))
01842 PYP=-(PX(3)*FOUR(IN(6),IN(3)+1)+PY(3)*FOUR(IN(6)+1,IN(3)+1))
01843 IF(ABS(PXP**2+PYP**2-PX(3)**2-PY(3)**2).LT.0.01) THEN
01844 PX(3)=PXP
01845 PY(3)=PYP
01846 ENDIF
01847 ENDIF
01848
01849
01850 DO 470 J=1,4
01851 DHG(J)=0.
01852 P(I,J)=PX(1)*P(IN(6),J)+PY(1)*P(IN(6)+1,J)+PX(3)*P(IN(3),J)+
01853 &PY(3)*P(IN(3)+1,J)
01854 DO 450 IN1=IN(4),IN(1)-4,4
01855 P(I,J)=P(I,J)+P(IN1+2,3)*P(IN1,J)
01856 450 CONTINUE
01857 DO 460 IN2=IN(5),IN(2)-4,4
01858 P(I,J)=P(I,J)+P(IN2+2,3)*P(IN2,J)
01859 460 CONTINUE
01860 470 CONTINUE
01861 DHM(1)=FOUR(I,I)
01862 DHM(2)=2.*FOUR(I,IN(1))
01863 DHM(3)=2.*FOUR(I,IN(2))
01864 DHM(4)=2.*FOUR(IN(1),IN(2))
01865
01866
01867 DO 490 IN2=IN(1)+1,IN(2),4
01868 DO 480 IN1=IN(1),IN2-1,4
01869 DHC=2.*FOUR(IN1,IN2)
01870 DHG(1)=DHG(1)+P(IN1+2,1)*P(IN2+2,1)*DHC
01871 IF(IN1.EQ.IN(1)) DHG(2)=DHG(2)-P(IN2+2,1)*DHC
01872 IF(IN2.EQ.IN(2)) DHG(3)=DHG(3)+P(IN1+2,1)*DHC
01873 IF(IN1.EQ.IN(1).AND.IN2.EQ.IN(2)) DHG(4)=DHG(4)-DHC
01874 480 CONTINUE
01875 490 CONTINUE
01876
01877
01878 DHS1=DHM(3)*DHG(4)-DHM(4)*DHG(3)
01879 IF(ABS(DHS1).LT.1E-4) GOTO 320
01880 DHS2=DHM(4)*(GAM(3)-DHG(1))-DHM(2)*DHG(3)-DHG(4)*
01881 &(P(I,5)**2-DHM(1))+DHG(2)*DHM(3)
01882 DHS3=DHM(2)*(GAM(3)-DHG(1))-DHG(2)*(P(I,5)**2-DHM(1))
01883 P(IN(2)+2,4)=0.5*(SQRT(MAX(0D0,DHS2**2-4.*DHS1*DHS3))/ABS(DHS1)-
01884 &DHS2/DHS1)
01885 IF(DHM(2)+DHM(4)*P(IN(2)+2,4).LE.0.) GOTO 320
01886 P(IN(1)+2,4)=(P(I,5)**2-DHM(1)-DHM(3)*P(IN(2)+2,4))/
01887 &(DHM(2)+DHM(4)*P(IN(2)+2,4))
01888
01889
01890 IF(P(IN(2)+2,4).GT.P(IN(2)+2,3)) THEN
01891 P(IN(2)+2,4)=P(IN(2)+2,3)
01892 P(IN(2)+2,1)=1.
01893 IN(2)=IN(2)+4
01894 IF(IN(2).GT.N+NR+4*NS) GOTO 320
01895 IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN
01896 P(IN(1)+2,4)=P(IN(1)+2,3)
01897 P(IN(1)+2,1)=0.
01898 IN(1)=IN(1)+4
01899 ENDIF
01900 GOTO 420
01901 ELSEIF(P(IN(1)+2,4).GT.P(IN(1)+2,3)) THEN
01902 P(IN(1)+2,4)=P(IN(1)+2,3)
01903 P(IN(1)+2,1)=0.
01904 IN(1)=IN(1)+JS
01905 GOTO 820
01906 ENDIF
01907
01908
01909 500 DO 510 J=1,4
01910 P(I,J)=P(I,J)+P(IN(1)+2,4)*P(IN(1),J)+P(IN(2)+2,4)*P(IN(2),J)
01911 PJU(IU+3,J)=PJU(IU+3,J)+P(I,J)
01912 510 CONTINUE
01913 IF(P(I,4).LT.P(I,5)) GOTO 320
01914 PJU(IU+3,5)=TJU(4)*PJU(IU+3,4)-TJU(1)*PJU(IU+3,1)-
01915 &TJU(2)*PJU(IU+3,2)-TJU(3)*PJU(IU+3,3)
01916 IF(PJU(IU+3,5).LT.PJU(IU,5)) THEN
01917 KFL(1)=-KFL(3)
01918 PX(1)=-PX(3)
01919 PY(1)=-PY(3)
01920 GAM(1)=GAM(3)
01921 IF(IN(3).NE.IN(6)) THEN
01922 DO 520 J=1,4
01923 P(IN(6),J)=P(IN(3),J)
01924 P(IN(6)+1,J)=P(IN(3)+1,J)
01925 520 CONTINUE
01926 ENDIF
01927 DO 530 JQ=1,2
01928 IN(3+JQ)=IN(JQ)
01929 P(IN(JQ)+2,3)=P(IN(JQ)+2,3)-P(IN(JQ)+2,4)
01930 P(IN(JQ)+2,1)=P(IN(JQ)+2,1)-(3-2*JQ)*P(IN(JQ)+2,4)
01931 530 CONTINUE
01932 GOTO 380
01933 ENDIF
01934
01935
01936 IF(IABS(KFL(1)).GT.10) GOTO 320
01937 I=I-1
01938 KFJH(IU)=KFL(1)
01939 DO 540 J=1,4
01940 PJU(IU+3,J)=PJU(IU+3,J)-P(I+1,J)
01941 540 CONTINUE
01942 550 CONTINUE
01943
01944
01945 NJS(JT)=I-ISTA
01946 KFJS(JT)=K(K(MJU(JT+2),3),2)
01947 KFLS=2*INT(RLU(0)+3.*PARJ(4)/(1.+3.*PARJ(4)))+1
01948 IF(KFJH(1).EQ.KFJH(2)) KFLS=3
01949 IF(ISTA.NE.I) KFJS(JT)=ISIGN(1000*MAX(IABS(KFJH(1)),
01950 &IABS(KFJH(2)))+100*MIN(IABS(KFJH(1)),IABS(KFJH(2)))+
01951 &KFLS,KFJH(1))
01952 DO 560 J=1,4
01953 PJS(JT,J)=PJU(1,J)+PJU(2,J)+P(MJU(JT),J)
01954 PJS(JT+2,J)=PJU(4,J)+PJU(5,J)
01955 560 CONTINUE
01956 PJS(JT,5)=SQRT(MAX(0.,PJS(JT,4)**2-PJS(JT,1)**2-PJS(JT,2)**2-
01957 &PJS(JT,3)**2))
01958 570 CONTINUE
01959
01960
01961 580 IF(MJU(1).NE.0.AND.MJU(2).NE.0) THEN
01962 NS=MJU(2)-MJU(1)
01963 NB=MJU(1)-N
01964 ELSEIF(MJU(1).NE.0) THEN
01965 NS=N+NR-MJU(1)
01966 NB=MJU(1)-N
01967 ELSEIF(MJU(2).NE.0) THEN
01968 NS=MJU(2)-N
01969 NB=1
01970 ELSEIF(IABS(K(N+1,2)).NE.21) THEN
01971 NS=NR-1
01972 NB=1
01973 ELSE
01974 NS=NR+1
01975 W2SUM=0.
01976 DO 590 IS=1,NR
01977 P(N+NR+IS,1)=0.5*FOUR(N+IS,N+IS+1-NR*(IS/NR))
01978 W2SUM=W2SUM+P(N+NR+IS,1)
01979 590 CONTINUE
01980 W2RAN=RLU(0)*W2SUM
01981 NB=0
01982 600 NB=NB+1
01983 W2SUM=W2SUM-P(N+NR+NB,1)
01984 IF(W2SUM.GT.W2RAN.AND.NB.LT.NR) GOTO 600
01985 ENDIF
01986
01987
01988 DO 630 IS=1,NS
01989 IS1=N+IS+NB-1-NR*((IS+NB-2)/NR)
01990 IS2=N+IS+NB-NR*((IS+NB-1)/NR)
01991 DO 610 J=1,5
01992 DP(1,J)=P(IS1,J)
01993 IF(IABS(K(IS1,2)).EQ.21) DP(1,J)=0.5*DP(1,J)
01994 IF(IS1.EQ.MJU(1)) DP(1,J)=PJS(1,J)-PJS(3,J)
01995 DP(2,J)=P(IS2,J)
01996 IF(IABS(K(IS2,2)).EQ.21) DP(2,J)=0.5*DP(2,J)
01997 IF(IS2.EQ.MJU(2)) DP(2,J)=PJS(2,J)-PJS(4,J)
01998 610 CONTINUE
01999 DP(3,5)=DFOUR(1,1)
02000 DP(4,5)=DFOUR(2,2)
02001 DHKC=DFOUR(1,2)
02002 IF(DP(3,5)+2.*DHKC+DP(4,5).LE.0.) THEN
02003 DP(3,5)=DP(1,5)**2
02004 DP(4,5)=DP(2,5)**2
02005 DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2+DP(1,5)**2)
02006 DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2+DP(2,5)**2)
02007 DHKC=DFOUR(1,2)
02008 ENDIF
02009 DHKS=SQRT(DHKC**2-DP(3,5)*DP(4,5))
02010 DHK1=0.5*((DP(4,5)+DHKC)/DHKS-1.)
02011 DHK2=0.5*((DP(3,5)+DHKC)/DHKS-1.)
02012 IN1=N+NR+4*IS-3
02013 P(IN1,5)=SQRT(DP(3,5)+2.*DHKC+DP(4,5))
02014 DO 620 J=1,4
02015 P(IN1,J)=(1.+DHK1)*DP(1,J)-DHK2*DP(2,J)
02016 P(IN1+1,J)=(1.+DHK2)*DP(2,J)-DHK1*DP(1,J)
02017 620 CONTINUE
02018 630 CONTINUE
02019
02020
02021 ISAV=I
02022 MSTU91=MSTU(90)
02023 640 NTRY=NTRY+1
02024 IF(NTRY.GT.100.AND.NTRYR.LE.4) THEN
02025 PARU12=4.*PARU12
02026 PARU13=2.*PARU13
02027 GOTO 140
02028 ELSEIF(NTRY.GT.100) THEN
02029 CALL LUERRM(14,'(LUSTRF:) caught in infinite loop')
02030 IF(MSTU(21).GE.1) RETURN
02031 ENDIF
02032 I=ISAV
02033 MSTU(90)=MSTU91
02034 DO 660 J=1,4
02035 P(N+NRS,J)=0.
02036 DO 650 IS=1,NR
02037 P(N+NRS,J)=P(N+NRS,J)+P(N+IS,J)
02038 650 CONTINUE
02039 660 CONTINUE
02040 DO 680 JT=1,2
02041 IRANK(JT)=0
02042 IF(MJU(JT).NE.0) IRANK(JT)=NJS(JT)
02043 IF(NS.GT.NR) IRANK(JT)=1
02044 IE(JT)=K(N+1+(JT/2)*(NP-1),3)
02045 IN(3*JT+1)=N+NR+1+4*(JT/2)*(NS-1)
02046 IN(3*JT+2)=IN(3*JT+1)+1
02047 IN(3*JT+3)=N+NR+4*NS+2*JT-1
02048 DO 670 IN1=N+NR+2+JT,N+NR+4*NS-2+JT,4
02049 P(IN1,1)=2-JT
02050 P(IN1,2)=JT-1
02051 P(IN1,3)=1.
02052 670 CONTINUE
02053 680 CONTINUE
02054
02055
02056 IF(NS.LT.NR) THEN
02057 PX(1)=0.
02058 PY(1)=0.
02059 IF(NS.EQ.1.AND.MJU(1)+MJU(2).EQ.0) CALL LUPTDI(0,PX(1),PY(1))
02060 PX(2)=-PX(1)
02061 PY(2)=-PY(1)
02062 DO 690 JT=1,2
02063 KFL(JT)=K(IE(JT),2)
02064 IF(MJU(JT).NE.0) KFL(JT)=KFJS(JT)
02065 MSTJ(93)=1
02066 PMQ(JT)=ULMASS(KFL(JT))
02067 GAM(JT)=0.
02068 690 CONTINUE
02069
02070
02071 ELSE
02072 KFL(3)=INT(1.+(2.+PARJ(2))*RLU(0))*(-1)**INT(RLU(0)+0.5)
02073 CALL LUKFDI(KFL(3),0,KFL(1),KDUMP)
02074 KFL(2)=-KFL(1)
02075 IF(IABS(KFL(1)).GT.10.AND.RLU(0).GT.0.5) THEN
02076 KFL(2)=-(KFL(1)+ISIGN(10000,KFL(1)))
02077 ELSEIF(IABS(KFL(1)).GT.10) THEN
02078 KFL(1)=-(KFL(2)+ISIGN(10000,KFL(2)))
02079 ENDIF
02080 CALL LUPTDI(KFL(1),PX(1),PY(1))
02081 PX(2)=-PX(1)
02082 PY(2)=-PY(1)
02083 PR3=MIN(25.,0.1*P(N+NR+1,5)**2)
02084 700 CALL LUZDIS(KFL(1),KFL(2),PR3,Z)
02085 ZR=PR3/(Z*P(N+NR+1,5)**2)
02086 IF(ZR.GE.1.) GOTO 700
02087 DO 710 JT=1,2
02088 MSTJ(93)=1
02089 PMQ(JT)=ULMASS(KFL(JT))
02090 GAM(JT)=PR3*(1.-Z)/Z
02091 IN1=N+NR+3+4*(JT/2)*(NS-1)
02092 P(IN1,JT)=1.-Z
02093 P(IN1,3-JT)=JT-1
02094 P(IN1,3)=(2-JT)*(1.-Z)+(JT-1)*Z
02095 P(IN1+1,JT)=ZR
02096 P(IN1+1,3-JT)=2-JT
02097 P(IN1+1,3)=(2-JT)*(1.-ZR)+(JT-1)*ZR
02098 710 CONTINUE
02099 ENDIF
02100
02101
02102 DO 750 JT=1,2
02103 IF(JT.EQ.1.OR.NS.EQ.NR-1) THEN
02104 IN1=IN(3*JT+1)
02105 IN3=IN(3*JT+3)
02106 DO 720 J=1,4
02107 DP(1,J)=P(IN1,J)
02108 DP(2,J)=P(IN1+1,J)
02109 DP(3,J)=0.
02110 DP(4,J)=0.
02111 720 CONTINUE
02112 DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2)
02113 DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2)
02114 DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4)
02115 DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4)
02116 DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4)
02117 IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1.
02118 IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1.
02119 IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1.
02120 IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1.
02121 DHC12=DFOUR(1,2)
02122 DHCX1=DFOUR(3,1)/DHC12
02123 DHCX2=DFOUR(3,2)/DHC12
02124 DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12)
02125 DHCY1=DFOUR(4,1)/DHC12
02126 DHCY2=DFOUR(4,2)/DHC12
02127 DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12
02128 DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2)
02129 DO 730 J=1,4
02130 DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J))
02131 P(IN3,J)=DP(3,J)
02132 P(IN3+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)-
02133 & DHCYX*DP(3,J))
02134 730 CONTINUE
02135 ELSE
02136 DO 740 J=1,4
02137 P(IN3+2,J)=P(IN3,J)
02138 P(IN3+3,J)=P(IN3+1,J)
02139 740 CONTINUE
02140 ENDIF
02141 750 CONTINUE
02142
02143
02144 IF(MJU(1)+MJU(2).GT.0) THEN
02145 DO 770 JT=1,2
02146 IF(NJS(JT).EQ.0) GOTO 770
02147 DO 760 J=1,4
02148 P(N+NRS,J)=P(N+NRS,J)-PJS(JT+2,J)
02149 760 CONTINUE
02150 770 CONTINUE
02151 ENDIF
02152
02153
02154 780 I=I+1
02155 IF(2*I-NSAV.GE.MSTU(4)-MSTU(32)-5) THEN
02156 CALL LUERRM(11,'(LUSTRF:) no more memory left in LUJETS')
02157 IF(MSTU(21).GE.1) RETURN
02158 ENDIF
02159 JT=1.5+RLU(0)
02160 IF(IABS(KFL(3-JT)).GT.10) JT=3-JT
02161 IF(IABS(KFL(3-JT)).GE.4.AND.IABS(KFL(3-JT)).LE.8) JT=3-JT
02162 JR=3-JT
02163 JS=3-2*JT
02164 IRANK(JT)=IRANK(JT)+1
02165 K(I,1)=1
02166 K(I,3)=IE(JT)
02167 K(I,4)=0
02168 K(I,5)=0
02169
02170
02171 790 CALL LUKFDI(KFL(JT),0,KFL(3),K(I,2))
02172 IF(K(I,2).EQ.0) GOTO 640
02173 IF(MSTJ(12).GE.3.AND.IRANK(JT).EQ.1.AND.IABS(KFL(JT)).LE.10.AND.
02174 &IABS(KFL(3)).GT.10) THEN
02175 IF(RLU(0).GT.PARJ(19)) GOTO 790
02176 ENDIF
02177 P(I,5)=ULMASS(K(I,2))
02178 CALL LUPTDI(KFL(JT),PX(3),PY(3))
02179 PR(JT)=P(I,5)**2+(PX(JT)+PX(3))**2+(PY(JT)+PY(3))**2
02180
02181
02182 MSTJ(93)=1
02183 PMQ(3)=ULMASS(KFL(3))
02184 PARJST=PARJ(33)
02185 IF(MSTJ(11).EQ.2) PARJST=PARJ(34)
02186 WMIN=PARJST+PMQ(1)+PMQ(2)+PARJ(36)*PMQ(3)
02187 IF(IABS(KFL(JT)).GT.10.AND.IABS(KFL(3)).GT.10) WMIN=
02188 &WMIN-0.5*PARJ(36)*PMQ(3)
02189 WREM2=FOUR(N+NRS,N+NRS)
02190 IF(WREM2.LT.0.10) GOTO 640
02191 IF(WREM2.LT.MAX(WMIN*(1.+(2.*RLU(0)-1.)*PARJ(37)),
02192 &PARJ(32)+PMQ(1)+PMQ(2))**2) GOTO 940
02193
02194
02195 CALL LUZDIS(KFL(JT),KFL(3),PR(JT),Z)
02196 IF(IABS(KFL(JT)).GE.4.AND.IABS(KFL(JT)).LE.8.AND.
02197 &MSTU(90).LT.8) THEN
02198 MSTU(90)=MSTU(90)+1
02199 MSTU(90+MSTU(90))=I
02200 PARU(90+MSTU(90))=Z
02201 ENDIF
02202 KFL1A=IABS(KFL(1))
02203 KFL2A=IABS(KFL(2))
02204 IF(MAX(MOD(KFL1A,10),MOD(KFL1A/1000,10),MOD(KFL2A,10),
02205 &MOD(KFL2A/1000,10)).GE.4) THEN
02206 PR(JR)=(PMQ(JR)+PMQ(3))**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2
02207 PW12=SQRT(MAX(0.,(WREM2-PR(1)-PR(2))**2-4.*PR(1)*PR(2)))
02208 Z=(WREM2+PR(JT)-PR(JR)+PW12*(2.*Z-1.))/(2.*WREM2)
02209 PR(JR)=(PMQ(JR)+PARJST)**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2
02210 IF((1.-Z)*(WREM2-PR(JT)/Z).LT.PR(JR)) GOTO 940
02211 ENDIF
02212 GAM(3)=(1.-Z)*(GAM(JT)+PR(JT)/Z)
02213 DO 800 J=1,3
02214 IN(J)=IN(3*JT+J)
02215 800 CONTINUE
02216
02217
02218 IF(IN(1)+1.EQ.IN(2).AND.Z*P(IN(1)+2,3)*P(IN(2)+2,3)*
02219 &P(IN(1),5)**2.GE.PR(JT)) THEN
02220 P(IN(JT)+2,4)=Z*P(IN(JT)+2,3)
02221 P(IN(JR)+2,4)=PR(JT)/(P(IN(JT)+2,4)*P(IN(1),5)**2)
02222 DO 810 J=1,4
02223 P(I,J)=(PX(JT)+PX(3))*P(IN(3),J)+(PY(JT)+PY(3))*P(IN(3)+1,J)
02224 810 CONTINUE
02225 GOTO 900
02226 ELSEIF(IN(1)+1.EQ.IN(2)) THEN
02227 P(IN(JR)+2,4)=P(IN(JR)+2,3)
02228 P(IN(JR)+2,JT)=1.
02229 IN(JR)=IN(JR)+4*JS
02230 IF(JS*IN(JR).GT.JS*IN(4*JR)) GOTO 640
02231 IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN
02232 P(IN(JT)+2,4)=P(IN(JT)+2,3)
02233 P(IN(JT)+2,JT)=0.
02234 IN(JT)=IN(JT)+4*JS
02235 ENDIF
02236 ENDIF
02237
02238
02239 820 IF(JS*IN(1).GT.JS*IN(3*JR+1).OR.JS*IN(2).GT.JS*IN(3*JR+2).OR.
02240 &IN(1).GT.IN(2)) GOTO 640
02241 IF(IN(1).NE.IN(3*JT+1).OR.IN(2).NE.IN(3*JT+2)) THEN
02242 DO 830 J=1,4
02243 DP(1,J)=P(IN(1),J)
02244 DP(2,J)=P(IN(2),J)
02245 DP(3,J)=0.
02246 DP(4,J)=0.
02247 830 CONTINUE
02248 DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2)
02249 DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2)
02250 DHC12=DFOUR(1,2)
02251 IF(DHC12.LE.1E-2) THEN
02252 P(IN(JT)+2,4)=P(IN(JT)+2,3)
02253 P(IN(JT)+2,JT)=0.
02254 IN(JT)=IN(JT)+4*JS
02255 GOTO 820
02256 ENDIF
02257 IN(3)=N+NR+4*NS+5
02258 DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4)
02259 DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4)
02260 DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4)
02261 IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1.
02262 IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1.
02263 IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1.
02264 IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1.
02265 DHCX1=DFOUR(3,1)/DHC12
02266 DHCX2=DFOUR(3,2)/DHC12
02267 DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12)
02268 DHCY1=DFOUR(4,1)/DHC12
02269 DHCY2=DFOUR(4,2)/DHC12
02270 DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12
02271 DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2)
02272 DO 840 J=1,4
02273 DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J))
02274 P(IN(3),J)=DP(3,J)
02275 P(IN(3)+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)-
02276 & DHCYX*DP(3,J))
02277 840 CONTINUE
02278
02279 PXP=-(PX(3)*FOUR(IN(3*JT+3),IN(3))+PY(3)*
02280 & FOUR(IN(3*JT+3)+1,IN(3)))
02281 PYP=-(PX(3)*FOUR(IN(3*JT+3),IN(3)+1)+PY(3)*
02282 & FOUR(IN(3*JT+3)+1,IN(3)+1))
02283 IF(ABS(PXP**2+PYP**2-PX(3)**2-PY(3)**2).LT.0.01) THEN
02284 PX(3)=PXP
02285 PY(3)=PYP
02286 ENDIF
02287 ENDIF
02288
02289
02290 DO 870 J=1,4
02291 DHG(J)=0.
02292 P(I,J)=PX(JT)*P(IN(3*JT+3),J)+PY(JT)*P(IN(3*JT+3)+1,J)+
02293 &PX(3)*P(IN(3),J)+PY(3)*P(IN(3)+1,J)
02294 DO 850 IN1=IN(3*JT+1),IN(1)-4*JS,4*JS
02295 P(I,J)=P(I,J)+P(IN1+2,3)*P(IN1,J)
02296 850 CONTINUE
02297 DO 860 IN2=IN(3*JT+2),IN(2)-4*JS,4*JS
02298 P(I,J)=P(I,J)+P(IN2+2,3)*P(IN2,J)
02299 860 CONTINUE
02300 870 CONTINUE
02301 DHM(1)=FOUR(I,I)
02302 DHM(2)=2.*FOUR(I,IN(1))
02303 DHM(3)=2.*FOUR(I,IN(2))
02304 DHM(4)=2.*FOUR(IN(1),IN(2))
02305
02306
02307 DO 890 IN2=IN(1)+1,IN(2),4
02308 DO 880 IN1=IN(1),IN2-1,4
02309 DHC=2.*FOUR(IN1,IN2)
02310 DHG(1)=DHG(1)+P(IN1+2,JT)*P(IN2+2,JT)*DHC
02311 IF(IN1.EQ.IN(1)) DHG(2)=DHG(2)-JS*P(IN2+2,JT)*DHC
02312 IF(IN2.EQ.IN(2)) DHG(3)=DHG(3)+JS*P(IN1+2,JT)*DHC
02313 IF(IN1.EQ.IN(1).AND.IN2.EQ.IN(2)) DHG(4)=DHG(4)-DHC
02314 880 CONTINUE
02315 890 CONTINUE
02316
02317
02318 DHS1=DHM(JR+1)*DHG(4)-DHM(4)*DHG(JR+1)
02319 IF(ABS(DHS1).LT.1E-4) GOTO 640
02320 DHS2=DHM(4)*(GAM(3)-DHG(1))-DHM(JT+1)*DHG(JR+1)-DHG(4)*
02321 &(P(I,5)**2-DHM(1))+DHG(JT+1)*DHM(JR+1)
02322 DHS3=DHM(JT+1)*(GAM(3)-DHG(1))-DHG(JT+1)*(P(I,5)**2-DHM(1))
02323 P(IN(JR)+2,4)=0.5*(SQRT(MAX(0D0,DHS2**2-4.*DHS1*DHS3))/ABS(DHS1)-
02324 &DHS2/DHS1)
02325 IF(DHM(JT+1)+DHM(4)*P(IN(JR)+2,4).LE.0.) GOTO 640
02326 P(IN(JT)+2,4)=(P(I,5)**2-DHM(1)-DHM(JR+1)*P(IN(JR)+2,4))/
02327 &(DHM(JT+1)+DHM(4)*P(IN(JR)+2,4))
02328
02329
02330 IF(P(IN(JR)+2,4).GT.P(IN(JR)+2,3)) THEN
02331 P(IN(JR)+2,4)=P(IN(JR)+2,3)
02332 P(IN(JR)+2,JT)=1.
02333 IN(JR)=IN(JR)+4*JS
02334 IF(JS*IN(JR).GT.JS*IN(4*JR)) GOTO 640
02335 IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN
02336 P(IN(JT)+2,4)=P(IN(JT)+2,3)
02337 P(IN(JT)+2,JT)=0.
02338 IN(JT)=IN(JT)+4*JS
02339 ENDIF
02340 GOTO 820
02341 ELSEIF(P(IN(JT)+2,4).GT.P(IN(JT)+2,3)) THEN
02342 P(IN(JT)+2,4)=P(IN(JT)+2,3)
02343 P(IN(JT)+2,JT)=0.
02344 IN(JT)=IN(JT)+4*JS
02345 GOTO 820
02346 ENDIF
02347
02348
02349 900 DO 910 J=1,4
02350 P(I,J)=P(I,J)+P(IN(1)+2,4)*P(IN(1),J)+P(IN(2)+2,4)*P(IN(2),J)
02351 P(N+NRS,J)=P(N+NRS,J)-P(I,J)
02352 910 CONTINUE
02353 IF(P(I,4).LT.P(I,5)) GOTO 640
02354 KFL(JT)=-KFL(3)
02355 PMQ(JT)=PMQ(3)
02356 PX(JT)=-PX(3)
02357 PY(JT)=-PY(3)
02358 GAM(JT)=GAM(3)
02359 IF(IN(3).NE.IN(3*JT+3)) THEN
02360 DO 920 J=1,4
02361 P(IN(3*JT+3),J)=P(IN(3),J)
02362 P(IN(3*JT+3)+1,J)=P(IN(3)+1,J)
02363 920 CONTINUE
02364 ENDIF
02365 DO 930 JQ=1,2
02366 IN(3*JT+JQ)=IN(JQ)
02367 P(IN(JQ)+2,3)=P(IN(JQ)+2,3)-P(IN(JQ)+2,4)
02368 P(IN(JQ)+2,JT)=P(IN(JQ)+2,JT)-JS*(3-2*JQ)*P(IN(JQ)+2,4)
02369 930 CONTINUE
02370 GOTO 780
02371
02372
02373 940 I=I+1
02374 K(I,1)=1
02375 K(I,3)=IE(JR)
02376 K(I,4)=0
02377 K(I,5)=0
02378 CALL LUKFDI(KFL(JR),-KFL(3),KFLDMP,K(I,2))
02379 IF(K(I,2).EQ.0) GOTO 640
02380 P(I,5)=ULMASS(K(I,2))
02381 PR(JR)=P(I,5)**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2
02382
02383
02384 JQ=1
02385 IF(P(IN(4)+2,3)*P(IN(5)+2,3)*FOUR(IN(4),IN(5)).LT.P(IN(7),3)*
02386 &P(IN(8),3)*FOUR(IN(7),IN(8))) JQ=2
02387 DHC12=FOUR(IN(3*JQ+1),IN(3*JQ+2))
02388 DHR1=FOUR(N+NRS,IN(3*JQ+2))/DHC12
02389 DHR2=FOUR(N+NRS,IN(3*JQ+1))/DHC12
02390 IF(IN(4).NE.IN(7).OR.IN(5).NE.IN(8)) THEN
02391 PX(3-JQ)=-FOUR(N+NRS,IN(3*JQ+3))-PX(JQ)
02392 PY(3-JQ)=-FOUR(N+NRS,IN(3*JQ+3)+1)-PY(JQ)
02393 PR(3-JQ)=P(I+(JT+JQ-3)**2-1,5)**2+(PX(3-JQ)+(2*JQ-3)*JS*
02394 & PX(3))**2+(PY(3-JQ)+(2*JQ-3)*JS*PY(3))**2
02395 ENDIF
02396
02397
02398 WREM2=WREM2+(PX(1)+PX(2))**2+(PY(1)+PY(2))**2
02399 FD=(SQRT(PR(1))+SQRT(PR(2)))/SQRT(WREM2)
02400 IF(MJU(1)+MJU(2).NE.0.AND.I.EQ.ISAV+2.AND.FD.GE.1.) GOTO 200
02401 IF(FD.GE.1.) GOTO 640
02402 FA=WREM2+PR(JT)-PR(JR)
02403 IF(MSTJ(11).NE.2) PREV=0.5*EXP(MAX(-50.,LOG(FD)*PARJ(38)*
02404 &(PR(1)+PR(2))**2))
02405 IF(MSTJ(11).EQ.2) PREV=0.5*FD**PARJ(39)
02406 FB=SIGN(SQRT(MAX(0.,FA**2-4.*WREM2*PR(JT))),JS*(RLU(0)-PREV))
02407 KFL1A=IABS(KFL(1))
02408 KFL2A=IABS(KFL(2))
02409 IF(MAX(MOD(KFL1A,10),MOD(KFL1A/1000,10),MOD(KFL2A,10),
02410 &MOD(KFL2A/1000,10)).GE.6) FB=SIGN(SQRT(MAX(0.,FA**2-
02411 &4.*WREM2*PR(JT))),FLOAT(JS))
02412 DO 950 J=1,4
02413 P(I-1,J)=(PX(JT)+PX(3))*P(IN(3*JQ+3),J)+(PY(JT)+PY(3))*
02414 &P(IN(3*JQ+3)+1,J)+0.5*(DHR1*(FA+FB)*P(IN(3*JQ+1),J)+
02415 &DHR2*(FA-FB)*P(IN(3*JQ+2),J))/WREM2
02416 P(I,J)=P(N+NRS,J)-P(I-1,J)
02417 950 CONTINUE
02418 IF(P(I-1,4).LT.P(I-1,5).OR.P(I,4).LT.P(I,5)) GOTO 640
02419
02420
02421 N=I-NRS+1
02422 DO 960 I=NSAV+1,NSAV+NP
02423 IM=K(I,3)
02424 K(IM,1)=K(IM,1)+10
02425 IF(MSTU(16).NE.2) THEN
02426 K(IM,4)=NSAV+1
02427 K(IM,5)=NSAV+1
02428 ELSE
02429 K(IM,4)=NSAV+2
02430 K(IM,5)=N
02431 ENDIF
02432 960 CONTINUE
02433
02434
02435 NSAV=NSAV+1
02436 K(NSAV,1)=11
02437 K(NSAV,2)=92
02438 K(NSAV,3)=IP
02439 K(NSAV,4)=NSAV+1
02440 K(NSAV,5)=N
02441 DO 970 J=1,4
02442 P(NSAV,J)=DPS(J)
02443 V(NSAV,J)=V(IP,J)
02444 970 CONTINUE
02445 P(NSAV,5)=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2))
02446 V(NSAV,5)=0.
02447 DO 990 I=NSAV+1,N
02448 DO 980 J=1,5
02449 K(I,J)=K(I+NRS-1,J)
02450 P(I,J)=P(I+NRS-1,J)
02451 V(I,J)=0.
02452 980 CONTINUE
02453 990 CONTINUE
02454 MSTU91=MSTU(90)
02455 DO 1000 IZ=MSTU90+1,MSTU91
02456 MSTU9T(IZ)=MSTU(90+IZ)-NRS+1-NSAV+N
02457 PARU9T(IZ)=PARU(90+IZ)
02458 1000 CONTINUE
02459 MSTU(90)=MSTU90
02460
02461
02462 DO 1020 I=NSAV+1,N
02463 DO 1010 J=1,5
02464 K(I-NSAV+N,J)=K(I,J)
02465 P(I-NSAV+N,J)=P(I,J)
02466 1010 CONTINUE
02467 1020 CONTINUE
02468 I1=NSAV
02469 DO 1050 I=N+1,2*N-NSAV
02470 IF(K(I,3).NE.IE(1)) GOTO 1050
02471 I1=I1+1
02472 DO 1030 J=1,5
02473 K(I1,J)=K(I,J)
02474 P(I1,J)=P(I,J)
02475 1030 CONTINUE
02476 IF(MSTU(16).NE.2) K(I1,3)=NSAV
02477 DO 1040 IZ=MSTU90+1,MSTU91
02478 IF(MSTU9T(IZ).EQ.I) THEN
02479 MSTU(90)=MSTU(90)+1
02480 MSTU(90+MSTU(90))=I1
02481 PARU(90+MSTU(90))=PARU9T(IZ)
02482 ENDIF
02483 1040 CONTINUE
02484 1050 CONTINUE
02485 DO 1080 I=2*N-NSAV,N+1,-1
02486 IF(K(I,3).EQ.IE(1)) GOTO 1080
02487 I1=I1+1
02488 DO 1060 J=1,5
02489 K(I1,J)=K(I,J)
02490 P(I1,J)=P(I,J)
02491 1060 CONTINUE
02492 IF(MSTU(16).NE.2) K(I1,3)=NSAV
02493 DO 1070 IZ=MSTU90+1,MSTU91
02494 IF(MSTU9T(IZ).EQ.I) THEN
02495 MSTU(90)=MSTU(90)+1
02496 MSTU(90+MSTU(90))=I1
02497 PARU(90+MSTU(90))=PARU9T(IZ)
02498 ENDIF
02499 1070 CONTINUE
02500 1080 CONTINUE
02501
02502
02503 IF(MBST.EQ.0) THEN
02504 MSTU(33)=1
02505 CALL LUDBRB(NSAV+1,N,0.,0.,DPS(1)/DPS(4),DPS(2)/DPS(4),
02506 & DPS(3)/DPS(4))
02507 ELSE
02508 DO 1090 I=NSAV+1,N
02509 HHPMT=P(I,1)**2+P(I,2)**2+P(I,5)**2
02510 IF(P(I,3).GT.0.) THEN
02511 HHPEZ=(P(I,4)+P(I,3))*HHBZ
02512 P(I,3)=0.5*(HHPEZ-HHPMT/HHPEZ)
02513 P(I,4)=0.5*(HHPEZ+HHPMT/HHPEZ)
02514 ELSE
02515 HHPEZ=(P(I,4)-P(I,3))/HHBZ
02516 P(I,3)=-0.5*(HHPEZ-HHPMT/HHPEZ)
02517 P(I,4)=0.5*(HHPEZ+HHPMT/HHPEZ)
02518 ENDIF
02519 1090 CONTINUE
02520 ENDIF
02521 DO 1110 I=NSAV+1,N
02522 DO 1100 J=1,4
02523 V(I,J)=V(IP,J)
02524 1100 CONTINUE
02525 1110 CONTINUE
02526
02527 RETURN
02528 END
02529
02530
02531
02532 SUBROUTINE LUINDF(IP)
02533
02534
02535
02536 IMPLICIT DOUBLE PRECISION(D)
02537 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
02538 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
02539 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
02540 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
02541 DIMENSION DPS(5),PSI(4),NFI(3),NFL(3),IFET(3),KFLF(3),
02542 &KFLO(2),PXO(2),PYO(2),WO(2)
02543
02544
02545 NSAV=N
02546 MSTU90=MSTU(90)
02547 NJET=0
02548 KQSUM=0
02549 DO 100 J=1,5
02550 DPS(J)=0.
02551 100 CONTINUE
02552 I=IP-1
02553 110 I=I+1
02554 IF(I.GT.MIN(N,MSTU(4)-MSTU(32))) THEN
02555 CALL LUERRM(12,'(LUINDF:) failed to reconstruct jet system')
02556 IF(MSTU(21).GE.1) RETURN
02557 ENDIF
02558 IF(K(I,1).NE.1.AND.K(I,1).NE.2) GOTO 110
02559 KC=LUCOMP(K(I,2))
02560 IF(KC.EQ.0) GOTO 110
02561 KQ=KCHG(KC,2)*ISIGN(1,K(I,2))
02562 IF(KQ.EQ.0) GOTO 110
02563 NJET=NJET+1
02564 IF(KQ.NE.2) KQSUM=KQSUM+KQ
02565 DO 120 J=1,5
02566 K(NSAV+NJET,J)=K(I,J)
02567 P(NSAV+NJET,J)=P(I,J)
02568 DPS(J)=DPS(J)+P(I,J)
02569 120 CONTINUE
02570 K(NSAV+NJET,3)=I
02571 IF(K(I,1).EQ.2.OR.(MSTJ(3).LE.5.AND.N.GT.I.AND.
02572 &K(I+1,1).EQ.2)) GOTO 110
02573 IF(NJET.NE.1.AND.KQSUM.NE.0) THEN
02574 CALL LUERRM(12,'(LUINDF:) unphysical flavour combination')
02575 IF(MSTU(21).GE.1) RETURN
02576 ENDIF
02577
02578
02579 IF(NJET.NE.1) THEN
02580 MSTU(33)=1
02581 CALL LUDBRB(NSAV+1,NSAV+NJET,0.,0.,-DPS(1)/DPS(4),
02582 & -DPS(2)/DPS(4),-DPS(3)/DPS(4))
02583 ENDIF
02584 PECM=0.
02585 DO 130 J=1,3
02586 NFI(J)=0
02587 130 CONTINUE
02588 DO 140 I=NSAV+1,NSAV+NJET
02589 PECM=PECM+P(I,4)
02590 KFA=IABS(K(I,2))
02591 IF(KFA.LE.3) THEN
02592 NFI(KFA)=NFI(KFA)+ISIGN(1,K(I,2))
02593 ELSEIF(KFA.GT.1000) THEN
02594 KFLA=MOD(KFA/1000,10)
02595 KFLB=MOD(KFA/100,10)
02596 IF(KFLA.LE.3) NFI(KFLA)=NFI(KFLA)+ISIGN(1,K(I,2))
02597 IF(KFLB.LE.3) NFI(KFLB)=NFI(KFLB)+ISIGN(1,K(I,2))
02598 ENDIF
02599 140 CONTINUE
02600
02601
02602 NTRY=0
02603 150 NTRY=NTRY+1
02604 IF(NTRY.GT.200) THEN
02605 CALL LUERRM(14,'(LUINDF:) caught in infinite loop')
02606 IF(MSTU(21).GE.1) RETURN
02607 ENDIF
02608 N=NSAV+NJET
02609 MSTU(90)=MSTU90
02610 DO 160 J=1,3
02611 NFL(J)=NFI(J)
02612 IFET(J)=0
02613 KFLF(J)=0
02614 160 CONTINUE
02615
02616
02617 DO 230 IP1=NSAV+1,NSAV+NJET
02618 MSTJ(91)=0
02619 NSAV1=N
02620 MSTU91=MSTU(90)
02621
02622
02623 KFLH=IABS(K(IP1,2))
02624 IF(KFLH.GT.10) KFLH=MOD(KFLH/1000,10)
02625 KFLO(2)=0
02626 WF=P(IP1,4)+SQRT(P(IP1,1)**2+P(IP1,2)**2+P(IP1,3)**2)
02627
02628
02629 170 IF(IABS(K(IP1,2)).NE.21) THEN
02630 NSTR=1
02631 KFLO(1)=K(IP1,2)
02632 CALL LUPTDI(0,PXO(1),PYO(1))
02633 WO(1)=WF
02634
02635
02636 ELSEIF(MSTJ(2).LE.2) THEN
02637 NSTR=1
02638 IF(MSTJ(2).EQ.2) MSTJ(91)=1
02639 KFLO(1)=INT(1.+(2.+PARJ(2))*RLU(0))*(-1)**INT(RLU(0)+0.5)
02640 CALL LUPTDI(0,PXO(1),PYO(1))
02641 WO(1)=WF
02642
02643
02644
02645 ELSE
02646 NSTR=2
02647 IF(MSTJ(2).EQ.4) MSTJ(91)=1
02648 KFLO(1)=INT(1.+(2.+PARJ(2))*RLU(0))*(-1)**INT(RLU(0)+0.5)
02649 KFLO(2)=-KFLO(1)
02650 CALL LUPTDI(0,PXO(1),PYO(1))
02651 PXO(2)=-PXO(1)
02652 PYO(2)=-PYO(1)
02653 WO(1)=WF*RLU(0)**(1./3.)
02654 WO(2)=WF-WO(1)
02655 ENDIF
02656
02657
02658 DO 220 ISTR=1,NSTR
02659 180 I=N
02660 MSTU(90)=MSTU91
02661 IRANK=0
02662 KFL1=KFLO(ISTR)
02663 PX1=PXO(ISTR)
02664 PY1=PYO(ISTR)
02665 W=WO(ISTR)
02666
02667
02668 190 I=I+1
02669 IF(I.GE.MSTU(4)-MSTU(32)-NJET-5) THEN
02670 CALL LUERRM(11,'(LUINDF:) no more memory left in LUJETS')
02671 IF(MSTU(21).GE.1) RETURN
02672 ENDIF
02673 IRANK=IRANK+1
02674 K(I,1)=1
02675 K(I,3)=IP1
02676 K(I,4)=0
02677 K(I,5)=0
02678 200 CALL LUKFDI(KFL1,0,KFL2,K(I,2))
02679 IF(K(I,2).EQ.0) GOTO 180
02680 IF(MSTJ(12).GE.3.AND.IRANK.EQ.1.AND.IABS(KFL1).LE.10.AND.
02681 &IABS(KFL2).GT.10) THEN
02682 IF(RLU(0).GT.PARJ(19)) GOTO 200
02683 ENDIF
02684
02685
02686 P(I,5)=ULMASS(K(I,2))
02687 CALL LUPTDI(KFL1,PX2,PY2)
02688 P(I,1)=PX1+PX2
02689 P(I,2)=PY1+PY2
02690 PR=P(I,5)**2+P(I,1)**2+P(I,2)**2
02691 CALL LUZDIS(KFL1,KFL2,PR,Z)
02692 MZSAV=0
02693 IF(IABS(KFL1).GE.4.AND.IABS(KFL1).LE.8.AND.MSTU(90).LT.8) THEN
02694 MZSAV=1
02695 MSTU(90)=MSTU(90)+1
02696 MSTU(90+MSTU(90))=I
02697 PARU(90+MSTU(90))=Z
02698 ENDIF
02699 P(I,3)=0.5*(Z*W-PR/(Z*W))
02700 P(I,4)=0.5*(Z*W+PR/(Z*W))
02701 IF(MSTJ(3).GE.1.AND.IRANK.EQ.1.AND.KFLH.GE.4.AND.
02702 &P(I,3).LE.0.001) THEN
02703 IF(W.GE.P(I,5)+0.5*PARJ(32)) GOTO 180
02704 P(I,3)=0.0001
02705 P(I,4)=SQRT(PR)
02706 Z=P(I,4)/W
02707 ENDIF
02708
02709
02710 KFL1=-KFL2
02711 PX1=-PX2
02712 PY1=-PY2
02713 W=(1.-Z)*W
02714 DO 210 J=1,5
02715 V(I,J)=0.
02716 210 CONTINUE
02717
02718
02719 IF(MSTJ(3).GE.0.AND.P(I,3).LT.0.) THEN
02720 I=I-1
02721 IF(MZSAV.EQ.1) MSTU(90)=MSTU(90)-1
02722 ENDIF
02723 IF(W.GT.PARJ(31)) GOTO 190
02724 N=I
02725 220 CONTINUE
02726 IF(MOD(MSTJ(3),5).EQ.4.AND.N.EQ.NSAV1) WF=WF+0.1*PARJ(32)
02727 IF(MOD(MSTJ(3),5).EQ.4.AND.N.EQ.NSAV1) GOTO 170
02728
02729
02730 THE=ULANGL(P(IP1,3),SQRT(P(IP1,1)**2+P(IP1,2)**2))
02731 PHI=ULANGL(P(IP1,1),P(IP1,2))
02732 MSTU(33)=1
02733 CALL LUDBRB(NSAV1+1,N,THE,PHI,0D0,0D0,0D0)
02734 K(K(IP1,3),4)=NSAV1+1
02735 K(K(IP1,3),5)=N
02736
02737
02738 230 CONTINUE
02739 IF(NJET.EQ.1.OR.MSTJ(3).LE.0) GOTO 490
02740 IF(MOD(MSTJ(3),5).NE.0.AND.N-NSAV-NJET.LT.2) GOTO 150
02741
02742
02743 DO 240 I=NSAV+NJET+1,N
02744 KFA=IABS(K(I,2))
02745 KFLA=MOD(KFA/1000,10)
02746 KFLB=MOD(KFA/100,10)
02747 KFLC=MOD(KFA/10,10)
02748 IF(KFLA.EQ.0) THEN
02749 IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)-ISIGN(1,K(I,2))*(-1)**KFLB
02750 IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)+ISIGN(1,K(I,2))*(-1)**KFLB
02751 ELSE
02752 IF(KFLA.LE.3) NFL(KFLA)=NFL(KFLA)-ISIGN(1,K(I,2))
02753 IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)-ISIGN(1,K(I,2))
02754 IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)-ISIGN(1,K(I,2))
02755 ENDIF
02756 240 CONTINUE
02757 NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+
02758 &NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3
02759 IF(NREQ.EQ.0) GOTO 320
02760
02761
02762 NREM=0
02763 250 IREM=0
02764 P2MIN=PECM**2
02765 DO 260 I=NSAV+NJET+1,N
02766 P2=P(I,1)**2+P(I,2)**2+P(I,3)**2
02767 IF(K(I,1).EQ.1.AND.P2.LT.P2MIN) IREM=I
02768 IF(K(I,1).EQ.1.AND.P2.LT.P2MIN) P2MIN=P2
02769 260 CONTINUE
02770 IF(IREM.EQ.0) GOTO 150
02771 K(IREM,1)=7
02772 KFA=IABS(K(IREM,2))
02773 KFLA=MOD(KFA/1000,10)
02774 KFLB=MOD(KFA/100,10)
02775 KFLC=MOD(KFA/10,10)
02776 IF(KFLA.GE.4.OR.KFLB.GE.4) K(IREM,1)=8
02777 IF(K(IREM,1).EQ.8) GOTO 250
02778 IF(KFLA.EQ.0) THEN
02779 ISGN=ISIGN(1,K(IREM,2))*(-1)**KFLB
02780 IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)+ISGN
02781 IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)-ISGN
02782 ELSE
02783 IF(KFLA.LE.3) NFL(KFLA)=NFL(KFLA)+ISIGN(1,K(IREM,2))
02784 IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)+ISIGN(1,K(IREM,2))
02785 IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)+ISIGN(1,K(IREM,2))
02786 ENDIF
02787 NREM=NREM+1
02788 NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+
02789 &NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3
02790 IF(NREQ.GT.NREM) GOTO 250
02791 DO 270 I=NSAV+NJET+1,N
02792 IF(K(I,1).EQ.8) K(I,1)=1
02793 270 CONTINUE
02794
02795
02796 280 NFET=2
02797 IF(NFL(1)+NFL(2)+NFL(3).NE.0) NFET=3
02798 IF(NREQ.LT.NREM) NFET=1
02799 IF(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3)).EQ.0) NFET=0
02800 DO 290 J=1,NFET
02801 IFET(J)=1+(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3)))*RLU(0)
02802 KFLF(J)=ISIGN(1,NFL(1))
02803 IF(IFET(J).GT.IABS(NFL(1))) KFLF(J)=ISIGN(2,NFL(2))
02804 IF(IFET(J).GT.IABS(NFL(1))+IABS(NFL(2))) KFLF(J)=ISIGN(3,NFL(3))
02805 290 CONTINUE
02806 IF(NFET.EQ.2.AND.(IFET(1).EQ.IFET(2).OR.KFLF(1)*KFLF(2).GT.0))
02807 &GOTO 280
02808 IF(NFET.EQ.3.AND.(IFET(1).EQ.IFET(2).OR.IFET(1).EQ.IFET(3).OR.
02809 &IFET(2).EQ.IFET(3).OR.KFLF(1)*KFLF(2).LT.0.OR.KFLF(1)*KFLF(3).
02810 <.0.OR.KFLF(1)*(NFL(1)+NFL(2)+NFL(3)).LT.0)) GOTO 280
02811 IF(NFET.EQ.0) KFLF(1)=1+INT((2.+PARJ(2))*RLU(0))
02812 IF(NFET.EQ.0) KFLF(2)=-KFLF(1)
02813 IF(NFET.EQ.1) KFLF(2)=ISIGN(1+INT((2.+PARJ(2))*RLU(0)),-KFLF(1))
02814 IF(NFET.LE.2) KFLF(3)=0
02815 IF(KFLF(3).NE.0) THEN
02816 KFLFC=ISIGN(1000*MAX(IABS(KFLF(1)),IABS(KFLF(3)))+
02817 & 100*MIN(IABS(KFLF(1)),IABS(KFLF(3)))+1,KFLF(1))
02818 IF(KFLF(1).EQ.KFLF(3).OR.(1.+3.*PARJ(4))*RLU(0).GT.1.)
02819 & KFLFC=KFLFC+ISIGN(2,KFLFC)
02820 ELSE
02821 KFLFC=KFLF(1)
02822 ENDIF
02823 CALL LUKFDI(KFLFC,KFLF(2),KFLDMP,KF)
02824 IF(KF.EQ.0) GOTO 280
02825 DO 300 J=1,MAX(2,NFET)
02826 NFL(IABS(KFLF(J)))=NFL(IABS(KFLF(J)))-ISIGN(1,KFLF(J))
02827 300 CONTINUE
02828
02829
02830 NPOS=MIN(1+INT(RLU(0)*NREM),NREM)
02831 DO 310 I=NSAV+NJET+1,N
02832 IF(K(I,1).EQ.7) NPOS=NPOS-1
02833 IF(K(I,1).EQ.1.OR.NPOS.NE.0) GOTO 310
02834 K(I,1)=1
02835 K(I,2)=KF
02836 P(I,5)=ULMASS(K(I,2))
02837 P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2)
02838 310 CONTINUE
02839 NREM=NREM-1
02840 NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+
02841 &NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3
02842 IF(NREM.GT.0) GOTO 280
02843
02844
02845 320 IF(MOD(MSTJ(3),5).NE.0.AND.MOD(MSTJ(3),5).NE.4) THEN
02846 DO 340 J=1,3
02847 PSI(J)=0.
02848 DO 330 I=NSAV+NJET+1,N
02849 PSI(J)=PSI(J)+P(I,J)
02850 330 CONTINUE
02851 340 CONTINUE
02852 PSI(4)=PSI(1)**2+PSI(2)**2+PSI(3)**2
02853 PWS=0.
02854 DO 350 I=NSAV+NJET+1,N
02855 IF(MOD(MSTJ(3),5).EQ.1) PWS=PWS+P(I,4)
02856 IF(MOD(MSTJ(3),5).EQ.2) PWS=PWS+SQRT(P(I,5)**2+(PSI(1)*P(I,1)+
02857 & PSI(2)*P(I,2)+PSI(3)*P(I,3))**2/PSI(4))
02858 IF(MOD(MSTJ(3),5).EQ.3) PWS=PWS+1.
02859 350 CONTINUE
02860 DO 370 I=NSAV+NJET+1,N
02861 IF(MOD(MSTJ(3),5).EQ.1) PW=P(I,4)
02862 IF(MOD(MSTJ(3),5).EQ.2) PW=SQRT(P(I,5)**2+(PSI(1)*P(I,1)+
02863 & PSI(2)*P(I,2)+PSI(3)*P(I,3))**2/PSI(4))
02864 IF(MOD(MSTJ(3),5).EQ.3) PW=1.
02865 DO 360 J=1,3
02866 P(I,J)=P(I,J)-PSI(J)*PW/PWS
02867 360 CONTINUE
02868 P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2)
02869 370 CONTINUE
02870
02871
02872 ELSEIF(MOD(MSTJ(3),5).EQ.4) THEN
02873 DO 390 I=N+1,N+NJET
02874 K(I,1)=0
02875 DO 380 J=1,5
02876 P(I,J)=0.
02877 380 CONTINUE
02878 390 CONTINUE
02879 DO 410 I=NSAV+NJET+1,N
02880 IR1=K(I,3)
02881 IR2=N+IR1-NSAV
02882 K(IR2,1)=K(IR2,1)+1
02883 PLS=(P(I,1)*P(IR1,1)+P(I,2)*P(IR1,2)+P(I,3)*P(IR1,3))/
02884 & (P(IR1,1)**2+P(IR1,2)**2+P(IR1,3)**2)
02885 DO 400 J=1,3
02886 P(IR2,J)=P(IR2,J)+P(I,J)-PLS*P(IR1,J)
02887 400 CONTINUE
02888 P(IR2,4)=P(IR2,4)+P(I,4)
02889 P(IR2,5)=P(IR2,5)+PLS
02890 410 CONTINUE
02891 PSS=0.
02892 DO 420 I=N+1,N+NJET
02893 IF(K(I,1).NE.0) PSS=PSS+P(I,4)/(PECM*(0.8*P(I,5)+0.2))
02894 420 CONTINUE
02895 DO 440 I=NSAV+NJET+1,N
02896 IR1=K(I,3)
02897 IR2=N+IR1-NSAV
02898 PLS=(P(I,1)*P(IR1,1)+P(I,2)*P(IR1,2)+P(I,3)*P(IR1,3))/
02899 & (P(IR1,1)**2+P(IR1,2)**2+P(IR1,3)**2)
02900 DO 430 J=1,3
02901 P(I,J)=P(I,J)-P(IR2,J)/K(IR2,1)+(1./(P(IR2,5)*PSS)-1.)*PLS*
02902 & P(IR1,J)
02903 430 CONTINUE
02904 P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2)
02905 440 CONTINUE
02906 ENDIF
02907
02908
02909 IF(MOD(MSTJ(3),5).NE.0) THEN
02910 PMS=0.
02911 PES=0.
02912 PQS=0.
02913 DO 450 I=NSAV+NJET+1,N
02914 PMS=PMS+P(I,5)
02915 PES=PES+P(I,4)
02916 PQS=PQS+P(I,5)**2/P(I,4)
02917 450 CONTINUE
02918 IF(PMS.GE.PECM) GOTO 150
02919 NECO=0
02920 460 NECO=NECO+1
02921 PFAC=(PECM-PQS)/(PES-PQS)
02922 PES=0.
02923 PQS=0.
02924 DO 480 I=NSAV+NJET+1,N
02925 DO 470 J=1,3
02926 P(I,J)=PFAC*P(I,J)
02927 470 CONTINUE
02928 P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2)
02929 PES=PES+P(I,4)
02930 PQS=PQS+P(I,5)**2/P(I,4)
02931 480 CONTINUE
02932 IF(NECO.LT.10.AND.ABS(PECM-PES).GT.2E-6*PECM) GOTO 460
02933 ENDIF
02934
02935
02936 490 DO 500 I=NSAV+NJET+1,N
02937 IF(MSTU(16).NE.2) K(I,3)=NSAV+1
02938 IF(MSTU(16).EQ.2) K(I,3)=K(K(I,3),3)
02939 500 CONTINUE
02940 DO 510 I=NSAV+1,NSAV+NJET
02941 I1=K(I,3)
02942 K(I1,1)=K(I1,1)+10
02943 IF(MSTU(16).NE.2) THEN
02944 K(I1,4)=NSAV+1
02945 K(I1,5)=NSAV+1
02946 ELSE
02947 K(I1,4)=K(I1,4)-NJET+1
02948 K(I1,5)=K(I1,5)-NJET+1
02949 IF(K(I1,5).LT.K(I1,4)) THEN
02950 K(I1,4)=0
02951 K(I1,5)=0
02952 ENDIF
02953 ENDIF
02954 510 CONTINUE
02955
02956
02957 NSAV=NSAV+1
02958 K(NSAV,1)=11
02959 K(NSAV,2)=93
02960 K(NSAV,3)=IP
02961 K(NSAV,4)=NSAV+1
02962 K(NSAV,5)=N-NJET+1
02963 DO 520 J=1,4
02964 P(NSAV,J)=DPS(J)
02965 V(NSAV,J)=V(IP,J)
02966 520 CONTINUE
02967 P(NSAV,5)=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2))
02968 V(NSAV,5)=0.
02969 DO 540 I=NSAV+NJET,N
02970 DO 530 J=1,5
02971 K(I-NJET+1,J)=K(I,J)
02972 P(I-NJET+1,J)=P(I,J)
02973 V(I-NJET+1,J)=V(I,J)
02974 530 CONTINUE
02975 540 CONTINUE
02976 N=N-NJET+1
02977 DO 550 IZ=MSTU90+1,MSTU(90)
02978 MSTU(90+IZ)=MSTU(90+IZ)-NJET+1
02979 550 CONTINUE
02980
02981
02982 IF(NJET.NE.1) CALL LUDBRB(NSAV+1,N,0.,0.,DPS(1)/DPS(4),
02983 &DPS(2)/DPS(4),DPS(3)/DPS(4))
02984 DO 570 I=NSAV+1,N
02985 DO 560 J=1,4
02986 V(I,J)=V(IP,J)
02987 560 CONTINUE
02988 570 CONTINUE
02989
02990 RETURN
02991 END
02992
02993
02994
02995 SUBROUTINE LUDECY(IP)
02996
02997
02998 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
02999 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
03000 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
03001 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
03002 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/
03003 DIMENSION VDCY(4),KFLO(4),KFL1(4),PV(10,5),RORD(10),UE(3),BE(3),
03004 &WTCOR(10)
03005 DATA WTCOR/2.,5.,15.,60.,250.,1500.,1.2E4,1.2E5,150.,16./
03006
03007
03008
03009 PAWT(A,B,C)=SQRT((A**2-(B+C)**2)*(A**2-(B-C)**2))/(2.*A)
03010 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)
03011 HMEPS(HA)=((1.-HRQ-HA)**2+3.*HA*(1.+HRQ-HA))*
03012 &SQRT((1.-HRQ-HA)**2-4.*HRQ*HA)
03013
03014
03015 NTRY=0
03016 NSAV=N
03017 KFA=IABS(K(IP,2))
03018 KFS=ISIGN(1,K(IP,2))
03019 KC=LUCOMP(KFA)
03020 MSTJ(92)=0
03021
03022
03023 IF(K(IP,1).EQ.5) THEN
03024 V(IP,5)=0.
03025 ELSEIF(K(IP,1).NE.4) THEN
03026 V(IP,5)=-PMAS(KC,4)*LOG(RLU(0))
03027 ENDIF
03028 DO 100 J=1,4
03029 VDCY(J)=V(IP,J)+V(IP,5)*P(IP,J)/P(IP,5)
03030 100 CONTINUE
03031
03032
03033 MOUT=0
03034 IF(MSTJ(22).EQ.2) THEN
03035 IF(PMAS(KC,4).GT.PARJ(71)) MOUT=1
03036 ELSEIF(MSTJ(22).EQ.3) THEN
03037 IF(VDCY(1)**2+VDCY(2)**2+VDCY(3)**2.GT.PARJ(72)**2) MOUT=1
03038 ELSEIF(MSTJ(22).EQ.4) THEN
03039 IF(VDCY(1)**2+VDCY(2)**2.GT.PARJ(73)**2) MOUT=1
03040 IF(ABS(VDCY(3)).GT.PARJ(74)) MOUT=1
03041 ENDIF
03042 IF(MOUT.EQ.1.AND.K(IP,1).NE.5) THEN
03043 K(IP,1)=4
03044 RETURN
03045 ENDIF
03046
03047
03048 MMIX=0
03049 IF((KFA.EQ.511.OR.KFA.EQ.531).AND.MSTJ(26).GE.1) THEN
03050 XBBMIX=PARJ(76)
03051 IF(KFA.EQ.531) XBBMIX=PARJ(77)
03052 IF(SIN(0.5*XBBMIX*V(IP,5)/PMAS(KC,4))**2.GT.RLU(0)) MMIX=1
03053 IF(MMIX.EQ.1) KFS=-KFS
03054 ENDIF
03055
03056
03057 KCA=KC
03058 IF(MDCY(KC,2).GT.0) THEN
03059 MDMDCY=MDME(MDCY(KC,2),2)
03060 IF(MDMDCY.GT.80.AND.MDMDCY.LE.90) KCA=MDMDCY
03061 ENDIF
03062 IF(MDCY(KCA,2).LE.0.OR.MDCY(KCA,3).LE.0) THEN
03063 CALL LUERRM(9,'(LUDECY:) no decay channel defined')
03064 RETURN
03065 ENDIF
03066 IF(MOD(KFA/1000,10).EQ.0.AND.(KCA.EQ.85.OR.KCA.EQ.87)) KFS=-KFS
03067 IF(KCHG(KC,3).EQ.0) THEN
03068 KFSP=1
03069 KFSN=0
03070 IF(RLU(0).GT.0.5) KFS=-KFS
03071 ELSEIF(KFS.GT.0) THEN
03072 KFSP=1
03073 KFSN=0
03074 ELSE
03075 KFSP=0
03076 KFSN=1
03077 ENDIF
03078
03079
03080 110 NOPE=0
03081 BRSU=0.
03082 DO 120 IDL=MDCY(KCA,2),MDCY(KCA,2)+MDCY(KCA,3)-1
03083 IF(MDME(IDL,1).NE.1.AND.KFSP*MDME(IDL,1).NE.2.AND.
03084 &KFSN*MDME(IDL,1).NE.3) GOTO 120
03085 IF(MDME(IDL,2).GT.100) GOTO 120
03086 NOPE=NOPE+1
03087 BRSU=BRSU+BRAT(IDL)
03088 120 CONTINUE
03089 IF(NOPE.EQ.0) THEN
03090 CALL LUERRM(2,'(LUDECY:) all decay channels closed by user')
03091 RETURN
03092 ENDIF
03093
03094
03095 130 RBR=BRSU*RLU(0)
03096 IDL=MDCY(KCA,2)-1
03097 140 IDL=IDL+1
03098 IF(MDME(IDL,1).NE.1.AND.KFSP*MDME(IDL,1).NE.2.AND.
03099 &KFSN*MDME(IDL,1).NE.3) THEN
03100 IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1) GOTO 140
03101 ELSEIF(MDME(IDL,2).GT.100) THEN
03102 IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1) GOTO 140
03103 ELSE
03104 IDC=IDL
03105 RBR=RBR-BRAT(IDL)
03106 IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1.AND.RBR.GT.0.) GOTO 140
03107 ENDIF
03108
03109
03110 MMAT=MDME(IDC,2)
03111 150 NTRY=NTRY+1
03112 IF(NTRY.GT.1000) THEN
03113 CALL LUERRM(14,'(LUDECY:) caught in infinite loop')
03114 IF(MSTU(21).GE.1) RETURN
03115 ENDIF
03116 I=N
03117 NP=0
03118 NQ=0
03119 MBST=0
03120 IF(MMAT.GE.11.AND.MMAT.NE.46.AND.P(IP,4).GT.20.*P(IP,5)) MBST=1
03121 DO 160 J=1,4
03122 PV(1,J)=0.
03123 IF(MBST.EQ.0) PV(1,J)=P(IP,J)
03124 160 CONTINUE
03125 IF(MBST.EQ.1) PV(1,4)=P(IP,5)
03126 PV(1,5)=P(IP,5)
03127 PS=0.
03128 PSQ=0.
03129 MREM=0
03130 MHADDY=0
03131 IF(KFA.GT.80) MHADDY=1
03132
03133
03134 JTMAX=5
03135 IF(MDME(IDC+1,2).EQ.101) JTMAX=10
03136 DO 170 JT=1,JTMAX
03137 IF(JT.LE.5) KP=KFDP(IDC,JT)
03138 IF(JT.GE.6) KP=KFDP(IDC+1,JT-5)
03139 IF(KP.EQ.0) GOTO 170
03140 KPA=IABS(KP)
03141 KCP=LUCOMP(KPA)
03142 IF(KPA.GT.80) MHADDY=1
03143 IF(KCHG(KCP,3).EQ.0.AND.KPA.NE.81.AND.KPA.NE.82) THEN
03144 KFP=KP
03145 ELSEIF(KPA.NE.81.AND.KPA.NE.82) THEN
03146 KFP=KFS*KP
03147 ELSEIF(KPA.EQ.81.AND.MOD(KFA/1000,10).EQ.0) THEN
03148 KFP=-KFS*MOD(KFA/10,10)
03149 ELSEIF(KPA.EQ.81.AND.MOD(KFA/100,10).GE.MOD(KFA/10,10)) THEN
03150 KFP=KFS*(100*MOD(KFA/10,100)+3)
03151 ELSEIF(KPA.EQ.81) THEN
03152 KFP=KFS*(1000*MOD(KFA/10,10)+100*MOD(KFA/100,10)+1)
03153 ELSEIF(KP.EQ.82) THEN
03154 CALL LUKFDI(-KFS*INT(1.+(2.+PARJ(2))*RLU(0)),0,KFP,KDUMP)
03155 IF(KFP.EQ.0) GOTO 150
03156 MSTJ(93)=1
03157 IF(PV(1,5).LT.PARJ(32)+2.*ULMASS(KFP)) GOTO 150
03158 ELSEIF(KP.EQ.-82) THEN
03159 KFP=-KFP
03160 IF(IABS(KFP).GT.10) KFP=KFP+ISIGN(10000,KFP)
03161 ENDIF
03162 IF(KPA.EQ.81.OR.KPA.EQ.82) KCP=LUCOMP(KFP)
03163
03164
03165 KFPA=IABS(KFP)
03166 KQP=KCHG(KCP,2)
03167 IF(MMAT.GE.11.AND.MMAT.LE.30.AND.KQP.NE.0) THEN
03168 NQ=NQ+1
03169 KFLO(NQ)=KFP
03170 MSTJ(93)=2
03171 PSQ=PSQ+ULMASS(KFLO(NQ))
03172 ELSEIF((MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.48).AND.NP.EQ.3.AND.
03173 &MOD(NQ,2).EQ.1) THEN
03174 NQ=NQ-1
03175 PS=PS-P(I,5)
03176 K(I,1)=1
03177 KFI=K(I,2)
03178 CALL LUKFDI(KFP,KFI,KFLDMP,K(I,2))
03179 IF(K(I,2).EQ.0) GOTO 150
03180 MSTJ(93)=1
03181 P(I,5)=ULMASS(K(I,2))
03182 PS=PS+P(I,5)
03183 ELSE
03184 I=I+1
03185 NP=NP+1
03186 IF(MMAT.NE.33.AND.KQP.NE.0) NQ=NQ+1
03187 IF(MMAT.EQ.33.AND.KQP.NE.0.AND.KQP.NE.2) NQ=NQ+1
03188 K(I,1)=1+MOD(NQ,2)
03189 IF(MMAT.EQ.4.AND.JT.LE.2.AND.KFP.EQ.21) K(I,1)=2
03190 IF(MMAT.EQ.4.AND.JT.EQ.3) K(I,1)=1
03191 K(I,2)=KFP
03192 K(I,3)=IP
03193 K(I,4)=0
03194 K(I,5)=0
03195 P(I,5)=ULMASS(KFP)
03196 IF(MMAT.EQ.45.AND.KFPA.EQ.89) P(I,5)=PARJ(32)
03197 PS=PS+P(I,5)
03198 ENDIF
03199 170 CONTINUE
03200
03201
03202 IF(MHADDY.EQ.0) THEN
03203 IF(PS+PARJ(64).GT.PV(1,5)) GOTO 130
03204 ENDIF
03205
03206
03207 180 IF(MMAT.GE.11.AND.MMAT.LE.30) THEN
03208 PSP=PS
03209 CNDE=PARJ(61)*LOG(MAX((PV(1,5)-PS-PSQ)/PARJ(62),1.1))
03210 IF(MMAT.EQ.12) CNDE=CNDE+PARJ(63)
03211 190 NTRY=NTRY+1
03212 IF(NTRY.GT.1000) THEN
03213 CALL LUERRM(14,'(LUDECY:) caught in infinite loop')
03214 IF(MSTU(21).GE.1) RETURN
03215 ENDIF
03216 IF(MMAT.LE.20) THEN
03217 GAUSS=SQRT(-2.*CNDE*LOG(MAX(1E-10,RLU(0))))*
03218 & SIN(PARU(2)*RLU(0))
03219 ND=0.5+0.5*NP+0.25*NQ+CNDE+GAUSS
03220 IF(ND.LT.NP+NQ/2.OR.ND.LT.2.OR.ND.GT.10) GOTO 190
03221 IF(MMAT.EQ.13.AND.ND.EQ.2) GOTO 190
03222 IF(MMAT.EQ.14.AND.ND.LE.3) GOTO 190
03223 IF(MMAT.EQ.15.AND.ND.LE.4) GOTO 190
03224 ELSE
03225 ND=MMAT-20
03226 ENDIF
03227
03228
03229 DO 200 JT=1,4
03230 KFL1(JT)=KFLO(JT)
03231 200 CONTINUE
03232 IF(ND.EQ.NP+NQ/2) GOTO 220
03233 DO 210 I=N+NP+1,N+ND-NQ/2
03234 JT=1+INT((NQ-1)*RLU(0))
03235 CALL LUKFDI(KFL1(JT),0,KFL2,K(I,2))
03236 IF(K(I,2).EQ.0) GOTO 190
03237 KFL1(JT)=-KFL2
03238 210 CONTINUE
03239 220 JT=2
03240 JT2=3
03241 JT3=4
03242 IF(NQ.EQ.4.AND.RLU(0).LT.PARJ(66)) JT=4
03243 IF(JT.EQ.4.AND.ISIGN(1,KFL1(1)*(10-IABS(KFL1(1))))*
03244 & ISIGN(1,KFL1(JT)*(10-IABS(KFL1(JT)))).GT.0) JT=3
03245 IF(JT.EQ.3) JT2=2
03246 IF(JT.EQ.4) JT3=2
03247 CALL LUKFDI(KFL1(1),KFL1(JT),KFLDMP,K(N+ND-NQ/2+1,2))
03248 IF(K(N+ND-NQ/2+1,2).EQ.0) GOTO 190
03249 IF(NQ.EQ.4) CALL LUKFDI(KFL1(JT2),KFL1(JT3),KFLDMP,K(N+ND,2))
03250 IF(NQ.EQ.4.AND.K(N+ND,2).EQ.0) GOTO 190
03251
03252
03253 PS=PSP
03254 DO 230 I=N+NP+1,N+ND
03255 K(I,1)=1
03256 K(I,3)=IP
03257 K(I,4)=0
03258 K(I,5)=0
03259 P(I,5)=ULMASS(K(I,2))
03260 PS=PS+P(I,5)
03261 230 CONTINUE
03262 IF(PS+PARJ(64).GT.PV(1,5)) GOTO 190
03263
03264
03265 ELSEIF((MMAT.EQ.31.OR.MMAT.EQ.33.OR.MMAT.EQ.44.OR.MMAT.EQ.45).
03266 &AND.NP.GE.3) THEN
03267 PS=PS-P(N+NP,5)
03268 PQT=(P(N+NP,5)+PARJ(65))/PV(1,5)
03269 DO 240 J=1,5
03270 P(N+NP,J)=PQT*PV(1,J)
03271 PV(1,J)=(1.-PQT)*PV(1,J)
03272 240 CONTINUE
03273 IF(PS+PARJ(64).GT.PV(1,5)) GOTO 150
03274 ND=NP-1
03275 MREM=1
03276
03277
03278 ELSEIF(MMAT.EQ.46) THEN
03279 MSTJ(93)=1
03280 PSMC=ULMASS(K(N+1,2))
03281 MSTJ(93)=1
03282 PSMC=PSMC+ULMASS(K(N+2,2))
03283 IF(MAX(PS,PSMC)+PARJ(32).GT.PV(1,5)) GOTO 130
03284 HR1=(P(N+1,5)/PV(1,5))**2
03285 HR2=(P(N+2,5)/PV(1,5))**2
03286 IF((1.-HR1-HR2)*(2.+HR1+HR2)*SQRT((1.-HR1-HR2)**2-4.*HR1*HR2).
03287 & LT.2.*RLU(0)) GOTO 130
03288 ND=NP
03289
03290
03291 ELSE
03292 IF(NP.GE.2.AND.PS+PARJ(64).GT.PV(1,5)) GOTO 150
03293 ND=NP
03294 ENDIF
03295
03296
03297 IF(MMAT.EQ.45.AND.MSTJ(25).LE.0) THEN
03298 HLQ=(PARJ(32)/PV(1,5))**2
03299 HUQ=(1.-(P(N+2,5)+PARJ(64))/PV(1,5))**2
03300 HRQ=(P(N+2,5)/PV(1,5))**2
03301 250 HW=HLQ+RLU(0)*(HUQ-HLQ)
03302 IF(HMEPS(HW).LT.RLU(0)) GOTO 250
03303 P(N+1,5)=PV(1,5)*SQRT(HW)
03304
03305
03306 ELSEIF(MMAT.EQ.45) THEN
03307 HQW=(PV(1,5)/PMAS(24,1))**2
03308 HLW=(PARJ(32)/PMAS(24,1))**2
03309 HUW=((PV(1,5)-P(N+2,5)-PARJ(64))/PMAS(24,1))**2
03310 HRQ=(P(N+2,5)/PV(1,5))**2
03311 HG=PMAS(24,2)/PMAS(24,1)
03312 HATL=ATAN((HLW-1.)/HG)
03313 HM=MIN(1.,HUW-0.001)
03314 HMV1=HMEPS(HM/HQW)/((HM-1.)**2+HG**2)
03315 260 HM=HM-HG
03316 HMV2=HMEPS(HM/HQW)/((HM-1.)**2+HG**2)
03317 IF(HMV2.GT.HMV1.AND.HM-HG.GT.HLW) THEN
03318 HMV1=HMV2
03319 GOTO 260
03320 ENDIF
03321 HMV=MIN(2.*HMV1,HMEPS(HM/HQW)/HG**2)
03322 HM1=1.-SQRT(1./HMV-HG**2)
03323 IF(HM1.GT.HLW.AND.HM1.LT.HM) THEN
03324 HM=HM1
03325 ELSEIF(HMV2.LE.HMV1) THEN
03326 HM=MAX(HLW,HM-MIN(0.1,1.-HM))
03327 ENDIF
03328 HATM=ATAN((HM-1.)/HG)
03329 HWT1=(HATM-HATL)/HG
03330 HWT2=HMV*(MIN(1.,HUW)-HM)
03331 HWT3=0.
03332 IF(HUW.GT.1.) THEN
03333 HATU=ATAN((HUW-1.)/HG)
03334 HMP1=HMEPS(1./HQW)
03335 HWT3=HMP1*HATU/HG
03336 ENDIF
03337
03338
03339 270 HREG=RLU(0)*(HWT1+HWT2+HWT3)
03340 IF(HREG.LE.HWT1) THEN
03341 HW=1.+HG*TAN(HATL+RLU(0)*(HATM-HATL))
03342 HACC=HMEPS(HW/HQW)
03343 ELSEIF(HREG.LE.HWT1+HWT2) THEN
03344 HW=HM+RLU(0)*(MIN(1.,HUW)-HM)
03345 HACC=HMEPS(HW/HQW)/((HW-1.)**2+HG**2)/HMV
03346 ELSE
03347 HW=1.+HG*TAN(RLU(0)*HATU)
03348 HACC=HMEPS(HW/HQW)/HMP1
03349 ENDIF
03350 IF(HACC.LT.RLU(0)) GOTO 270
03351 P(N+1,5)=PMAS(24,1)*SQRT(HW)
03352 ENDIF
03353
03354
03355 NM=0
03356 KFAS=0
03357 MSGN=0
03358 IF(MMAT.EQ.3.OR.MMAT.EQ.46) THEN
03359 IM=K(IP,3)
03360 IF(IM.LT.0.OR.IM.GE.IP) IM=0
03361 IF(MMAT.EQ.46.AND.MSTJ(27).EQ.1) THEN
03362 IM=0
03363 ELSEIF(MMAT.EQ.46.AND.MSTJ(27).GE.2.AND.IM.NE.0) THEN
03364 IF(K(IM,2).EQ.94) THEN
03365 IM=K(K(IM,3),3)
03366 IF(IM.LT.0.OR.IM.GE.IP) IM=0
03367 ENDIF
03368 ENDIF
03369 IF(IM.NE.0) KFAM=IABS(K(IM,2))
03370 IF(IM.NE.0.AND.MMAT.EQ.3) THEN
03371 DO 280 IL=MAX(IP-2,IM+1),MIN(IP+2,N)
03372 IF(K(IL,3).EQ.IM) NM=NM+1
03373 IF(K(IL,3).EQ.IM.AND.IL.NE.IP) ISIS=IL
03374 280 CONTINUE
03375 IF(NM.NE.2.OR.KFAM.LE.100.OR.MOD(KFAM,10).NE.1.OR.
03376 & MOD(KFAM/1000,10).NE.0) NM=0
03377 IF(NM.EQ.2) THEN
03378 KFAS=IABS(K(ISIS,2))
03379 IF((KFAS.LE.100.OR.MOD(KFAS,10).NE.1.OR.
03380 & MOD(KFAS/1000,10).NE.0).AND.KFAS.NE.22) NM=0
03381 ENDIF
03382 ELSEIF(IM.NE.0.AND.MMAT.EQ.46) THEN
03383 MSGN=ISIGN(1,K(IM,2)*K(IP,2))
03384 IF(KFAM.GT.100.AND.MOD(KFAM/1000,10).EQ.0) MSGN=
03385 & MSGN*(-1)**MOD(KFAM/100,10)
03386 ENDIF
03387 ENDIF
03388
03389
03390 IF(ND.EQ.1) THEN
03391 DO 290 J=1,4
03392 P(N+1,J)=P(IP,J)
03393 290 CONTINUE
03394 GOTO 550
03395 ENDIF
03396
03397
03398 PV(ND,5)=P(N+ND,5)
03399 IF(ND.GE.3) THEN
03400 WTMAX=1./WTCOR(ND-2)
03401 PMAX=PV(1,5)-PS+P(N+ND,5)
03402 PMIN=0.
03403 DO 300 IL=ND-1,1,-1
03404 PMAX=PMAX+P(N+IL,5)
03405 PMIN=PMIN+P(N+IL+1,5)
03406 WTMAX=WTMAX*PAWT(PMAX,PMIN,P(N+IL,5))
03407 300 CONTINUE
03408 ENDIF
03409
03410
03411 310 IF(ND.EQ.2) THEN
03412 ELSEIF(MMAT.EQ.2) THEN
03413 PMES=4.*PMAS(11,1)**2
03414 PMRHO2=PMAS(131,1)**2
03415 PGRHO2=PMAS(131,2)**2
03416 320 PMST=PMES*(P(IP,5)**2/PMES)**RLU(0)
03417 WT=(1+0.5*PMES/PMST)*SQRT(MAX(0.,1.-PMES/PMST))*
03418 & (1.-PMST/P(IP,5)**2)**3*(1.+PGRHO2/PMRHO2)/
03419 & ((1.-PMST/PMRHO2)**2+PGRHO2/PMRHO2)
03420 IF(WT.LT.RLU(0)) GOTO 320
03421 PV(2,5)=MAX(2.00001*PMAS(11,1),SQRT(PMST))
03422
03423
03424 ELSE
03425 330 RORD(1)=1.
03426 DO 360 IL1=2,ND-1
03427 RSAV=RLU(0)
03428 DO 340 IL2=IL1-1,1,-1
03429 IF(RSAV.LE.RORD(IL2)) GOTO 350
03430 RORD(IL2+1)=RORD(IL2)
03431 340 CONTINUE
03432 350 RORD(IL2+1)=RSAV
03433 360 CONTINUE
03434 RORD(ND)=0.
03435 WT=1.
03436 DO 370 IL=ND-1,1,-1
03437 PV(IL,5)=PV(IL+1,5)+P(N+IL,5)+(RORD(IL)-RORD(IL+1))*(PV(1,5)-PS)
03438 WT=WT*PAWT(PV(IL,5),PV(IL+1,5),P(N+IL,5))
03439 370 CONTINUE
03440 IF(WT.LT.RLU(0)*WTMAX) GOTO 330
03441 ENDIF
03442
03443
03444 380 DO 400 IL=1,ND-1
03445 PA=PAWT(PV(IL,5),PV(IL+1,5),P(N+IL,5))
03446 UE(3)=2.*RLU(0)-1.
03447 PHI=PARU(2)*RLU(0)
03448 UE(1)=SQRT(1.-UE(3)**2)*COS(PHI)
03449 UE(2)=SQRT(1.-UE(3)**2)*SIN(PHI)
03450 DO 390 J=1,3
03451 P(N+IL,J)=PA*UE(J)
03452 PV(IL+1,J)=-PA*UE(J)
03453 390 CONTINUE
03454 P(N+IL,4)=SQRT(PA**2+P(N+IL,5)**2)
03455 PV(IL+1,4)=SQRT(PA**2+PV(IL+1,5)**2)
03456 400 CONTINUE
03457
03458
03459 DO 410 J=1,4
03460 P(N+ND,J)=PV(ND,J)
03461 410 CONTINUE
03462 DO 450 IL=ND-1,1,-1
03463 DO 420 J=1,3
03464 BE(J)=PV(IL,J)/PV(IL,4)
03465 420 CONTINUE
03466 GA=PV(IL,4)/PV(IL,5)
03467 DO 440 I=N+IL,N+ND
03468 BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3)
03469 DO 430 J=1,3
03470 P(I,J)=P(I,J)+GA*(GA*BEP/(1.+GA)+P(I,4))*BE(J)
03471 430 CONTINUE
03472 P(I,4)=GA*(P(I,4)+BEP)
03473 440 CONTINUE
03474 450 CONTINUE
03475
03476
03477 NTRY=NTRY+1
03478 IF(NTRY.GT.800) GOTO 480
03479
03480
03481 IF(MMAT.EQ.1) THEN
03482 WT=(P(N+1,5)*P(N+2,5)*P(N+3,5))**2-(P(N+1,5)*FOUR(N+2,N+3))**2
03483 & -(P(N+2,5)*FOUR(N+1,N+3))**2-(P(N+3,5)*FOUR(N+1,N+2))**2
03484 & +2.*FOUR(N+1,N+2)*FOUR(N+1,N+3)*FOUR(N+2,N+3)
03485 IF(MAX(WT*WTCOR(9)/P(IP,5)**6,0.001).LT.RLU(0)) GOTO 310
03486
03487
03488 ELSEIF(MMAT.EQ.2) THEN
03489 FOUR12=FOUR(N+1,N+2)
03490 FOUR13=FOUR(N+1,N+3)
03491 WT=(PMST-0.5*PMES)*(FOUR12**2+FOUR13**2)+
03492 & PMES*(FOUR12*FOUR13+FOUR12**2+FOUR13**2)
03493 IF(WT.LT.RLU(0)*0.25*PMST*(P(IP,5)**2-PMST)**2) GOTO 380
03494
03495
03496
03497
03498 ELSEIF(MMAT.EQ.3.AND.NM.EQ.2) THEN
03499 FOUR10=FOUR(IP,IM)
03500 FOUR12=FOUR(IP,N+1)
03501 FOUR02=FOUR(IM,N+1)
03502 PMS1=P(IP,5)**2
03503 PMS0=P(IM,5)**2
03504 PMS2=P(N+1,5)**2
03505 IF(KFAS.NE.22) HNUM=(FOUR10*FOUR12-PMS1*FOUR02)**2
03506 IF(KFAS.EQ.22) HNUM=PMS1*(2.*FOUR10*FOUR12*FOUR02-
03507 & PMS1*FOUR02**2-PMS0*FOUR12**2-PMS2*FOUR10**2+PMS1*PMS0*PMS2)
03508 HNUM=MAX(1E-6*PMS1**2*PMS0*PMS2,HNUM)
03509 HDEN=(FOUR10**2-PMS1*PMS0)*(FOUR12**2-PMS1*PMS2)
03510 IF(HNUM.LT.RLU(0)*HDEN) GOTO 380
03511
03512
03513 ELSEIF(MMAT.EQ.4) THEN
03514 HX1=2.*FOUR(IP,N+1)/P(IP,5)**2
03515 HX2=2.*FOUR(IP,N+2)/P(IP,5)**2
03516 HX3=2.*FOUR(IP,N+3)/P(IP,5)**2
03517 WT=((1.-HX1)/(HX2*HX3))**2+((1.-HX2)/(HX1*HX3))**2+
03518 & ((1.-HX3)/(HX1*HX2))**2
03519 IF(WT.LT.2.*RLU(0)) GOTO 310
03520 IF(K(IP+1,2).EQ.22.AND.(1.-HX1)*P(IP,5)**2.LT.4.*PARJ(32)**2)
03521 & GOTO 310
03522
03523
03524 ELSEIF(MMAT.EQ.41) THEN
03525 HX1=2.*FOUR(IP,N+1)/P(IP,5)**2
03526 HXM=MIN(0.75,2.*(1.-PS/P(IP,5)))
03527 IF(HX1*(3.-2.*HX1).LT.RLU(0)*HXM*(3.-2.*HXM)) GOTO 310
03528
03529
03530 ELSEIF((MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.44.OR.MMAT.EQ.48)
03531 &.AND.ND.EQ.3) THEN
03532 IF(MBST.EQ.0) WT=FOUR(IP,N+1)*FOUR(N+2,N+3)
03533 IF(MBST.EQ.1) WT=P(IP,5)*P(N+1,4)*FOUR(N+2,N+3)
03534 IF(WT.LT.RLU(0)*P(IP,5)*PV(1,5)**3/WTCOR(10)) GOTO 310
03535 ELSEIF(MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.44.OR.MMAT.EQ.48) THEN
03536 DO 470 J=1,4
03537 P(N+NP+1,J)=0.
03538 DO 460 IS=N+3,N+NP
03539 P(N+NP+1,J)=P(N+NP+1,J)+P(IS,J)
03540 460 CONTINUE
03541 470 CONTINUE
03542 IF(MBST.EQ.0) WT=FOUR(IP,N+1)*FOUR(N+2,N+NP+1)
03543 IF(MBST.EQ.1) WT=P(IP,5)*P(N+1,4)*FOUR(N+2,N+NP+1)
03544 IF(WT.LT.RLU(0)*P(IP,5)*PV(1,5)**3/WTCOR(10)) GOTO 310
03545
03546
03547 ELSEIF(MMAT.EQ.46.AND.MSGN.NE.0) THEN
03548 IF(MSGN.GT.0) WT=FOUR(IM,N+1)*FOUR(N+2,IP+1)
03549 IF(MSGN.LT.0) WT=FOUR(IM,N+2)*FOUR(N+1,IP+1)
03550 IF(WT.LT.RLU(0)*P(IM,5)**4/WTCOR(10)) GOTO 380
03551 ENDIF
03552
03553
03554 480 IF(MREM.EQ.1) THEN
03555 DO 490 J=1,5
03556 PV(1,J)=PV(1,J)/(1.-PQT)
03557 490 CONTINUE
03558 ND=ND+1
03559 MREM=0
03560 ENDIF
03561
03562
03563
03564 IF((MMAT.EQ.31.OR.MMAT.EQ.45).AND.ND.EQ.3) THEN
03565 MSTJ(93)=1
03566 PM2=ULMASS(K(N+2,2))
03567 MSTJ(93)=1
03568 PM3=ULMASS(K(N+3,2))
03569 IF(P(N+2,5)**2+P(N+3,5)**2+2.*FOUR(N+2,N+3).GE.
03570 & (PARJ(32)+PM2+PM3)**2) GOTO 550
03571 K(N+2,1)=1
03572 KFTEMP=K(N+2,2)
03573 CALL LUKFDI(KFTEMP,K(N+3,2),KFLDMP,K(N+2,2))
03574 IF(K(N+2,2).EQ.0) GOTO 150
03575 P(N+2,5)=ULMASS(K(N+2,2))
03576 PS=P(N+1,5)+P(N+2,5)
03577 PV(2,5)=P(N+2,5)
03578 MMAT=0
03579 ND=2
03580 GOTO 380
03581 ELSEIF(MMAT.EQ.44) THEN
03582 MSTJ(93)=1
03583 PM3=ULMASS(K(N+3,2))
03584 MSTJ(93)=1
03585 PM4=ULMASS(K(N+4,2))
03586 IF(P(N+3,5)**2+P(N+4,5)**2+2.*FOUR(N+3,N+4).GE.
03587 & (PARJ(32)+PM3+PM4)**2) GOTO 520
03588 K(N+3,1)=1
03589 KFTEMP=K(N+3,2)
03590 CALL LUKFDI(KFTEMP,K(N+4,2),KFLDMP,K(N+3,2))
03591 IF(K(N+3,2).EQ.0) GOTO 150
03592 P(N+3,5)=ULMASS(K(N+3,2))
03593 DO 500 J=1,3
03594 P(N+3,J)=P(N+3,J)+P(N+4,J)
03595 500 CONTINUE
03596 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)
03597 HA=P(N+1,4)**2-P(N+2,4)**2
03598 HB=HA-(P(N+1,5)**2-P(N+2,5)**2)
03599 HC=(P(N+1,1)-P(N+2,1))**2+(P(N+1,2)-P(N+2,2))**2+
03600 & (P(N+1,3)-P(N+2,3))**2
03601 HD=(PV(1,4)-P(N+3,4))**2
03602 HE=HA**2-2.*HD*(P(N+1,4)**2+P(N+2,4)**2)+HD**2
03603 HF=HD*HC-HB**2
03604 HG=HD*HC-HA*HB
03605 HH=(SQRT(HG**2+HE*HF)-HG)/(2.*HF)
03606 DO 510 J=1,3
03607 PCOR=HH*(P(N+1,J)-P(N+2,J))
03608 P(N+1,J)=P(N+1,J)+PCOR
03609 P(N+2,J)=P(N+2,J)-PCOR
03610 510 CONTINUE
03611 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)
03612 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)
03613 ND=ND-1
03614 ENDIF
03615
03616
03617 520 IF((MMAT.EQ.42.OR.MMAT.EQ.43.OR.MMAT.EQ.44.OR.MMAT.EQ.48)
03618 &.AND.IABS(K(N+1,2)).LT.10) THEN
03619 PMR=SQRT(MAX(0.,P(N+1,5)**2+P(N+2,5)**2+2.*FOUR(N+1,N+2)))
03620 MSTJ(93)=1
03621 PM1=ULMASS(K(N+1,2))
03622 MSTJ(93)=1
03623 PM2=ULMASS(K(N+2,2))
03624 IF(PMR.GT.PARJ(32)+PM1+PM2) GOTO 530
03625 KFLDUM=INT(1.5+RLU(0))
03626 CALL LUKFDI(K(N+1,2),-ISIGN(KFLDUM,K(N+1,2)),KFLDMP,KF1)
03627 CALL LUKFDI(K(N+2,2),-ISIGN(KFLDUM,K(N+2,2)),KFLDMP,KF2)
03628 IF(KF1.EQ.0.OR.KF2.EQ.0) GOTO 150
03629 PSM=ULMASS(KF1)+ULMASS(KF2)
03630 IF((MMAT.EQ.42.OR.MMAT.EQ.48).AND.PMR.GT.PARJ(64)+PSM) GOTO 530
03631 IF(MMAT.GE.43.AND.PMR.GT.0.2*PARJ(32)+PSM) GOTO 530
03632 IF(MMAT.EQ.48) GOTO 310
03633 IF(ND.EQ.4.OR.KFA.EQ.15) GOTO 150
03634 K(N+1,1)=1
03635 KFTEMP=K(N+1,2)
03636 CALL LUKFDI(KFTEMP,K(N+2,2),KFLDMP,K(N+1,2))
03637 IF(K(N+1,2).EQ.0) GOTO 150
03638 P(N+1,5)=ULMASS(K(N+1,2))
03639 K(N+2,2)=K(N+3,2)
03640 P(N+2,5)=P(N+3,5)
03641 PS=P(N+1,5)+P(N+2,5)
03642 IF(PS+PARJ(64).GT.PV(1,5)) GOTO 150
03643 PV(2,5)=P(N+3,5)
03644 MMAT=0
03645 ND=2
03646 GOTO 380
03647 ENDIF
03648
03649
03650 530 IF((MMAT.EQ.42.OR.MMAT.EQ.48).AND.IABS(K(N+1,2)).LT.10) THEN
03651 KFLO(1)=K(N+1,2)
03652 KFLO(2)=K(N+2,2)
03653 K(N+1,1)=K(N+3,1)
03654 K(N+1,2)=K(N+3,2)
03655 DO 540 J=1,5
03656 PV(1,J)=P(N+1,J)+P(N+2,J)
03657 P(N+1,J)=P(N+3,J)
03658 540 CONTINUE
03659 PV(1,5)=PMR
03660 N=N+1
03661 NP=0
03662 NQ=2
03663 PS=0.
03664 MSTJ(93)=2
03665 PSQ=ULMASS(KFLO(1))
03666 MSTJ(93)=2
03667 PSQ=PSQ+ULMASS(KFLO(2))
03668 MMAT=11
03669 GOTO 180
03670 ENDIF
03671
03672
03673 550 N=N+ND
03674 IF(MBST.EQ.1) THEN
03675 DO 560 J=1,3
03676 BE(J)=P(IP,J)/P(IP,4)
03677 560 CONTINUE
03678 GA=P(IP,4)/P(IP,5)
03679 DO 580 I=NSAV+1,N
03680 BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3)
03681 DO 570 J=1,3
03682 P(I,J)=P(I,J)+GA*(GA*BEP/(1.+GA)+P(I,4))*BE(J)
03683 570 CONTINUE
03684 P(I,4)=GA*(P(I,4)+BEP)
03685 580 CONTINUE
03686 ENDIF
03687
03688
03689 DO 600 I=NSAV+1,N
03690 DO 590 J=1,4
03691 V(I,J)=VDCY(J)
03692 590 CONTINUE
03693 V(I,5)=0.
03694 600 CONTINUE
03695
03696
03697 IF(MSTJ(23).GE.1.AND.MMAT.EQ.4.AND.K(NSAV+1,2).EQ.21) THEN
03698 K(NSAV+1,1)=3
03699 K(NSAV+2,1)=3
03700 K(NSAV+3,1)=3
03701 K(NSAV+1,4)=MSTU(5)*(NSAV+2)
03702 K(NSAV+1,5)=MSTU(5)*(NSAV+3)
03703 K(NSAV+2,4)=MSTU(5)*(NSAV+3)
03704 K(NSAV+2,5)=MSTU(5)*(NSAV+1)
03705 K(NSAV+3,4)=MSTU(5)*(NSAV+1)
03706 K(NSAV+3,5)=MSTU(5)*(NSAV+2)
03707 MSTJ(92)=-(NSAV+1)
03708 ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.4) THEN
03709 K(NSAV+2,1)=3
03710 K(NSAV+3,1)=3
03711 K(NSAV+2,4)=MSTU(5)*(NSAV+3)
03712 K(NSAV+2,5)=MSTU(5)*(NSAV+3)
03713 K(NSAV+3,4)=MSTU(5)*(NSAV+2)
03714 K(NSAV+3,5)=MSTU(5)*(NSAV+2)
03715 MSTJ(92)=NSAV+2
03716 ELSEIF(MSTJ(23).GE.1.AND.(MMAT.EQ.32.OR.MMAT.EQ.44.OR.MMAT.EQ.46).
03717 &AND.IABS(K(NSAV+1,2)).LE.10.AND.IABS(K(NSAV+2,2)).LE.10) THEN
03718 K(NSAV+1,1)=3
03719 K(NSAV+2,1)=3
03720 K(NSAV+1,4)=MSTU(5)*(NSAV+2)
03721 K(NSAV+1,5)=MSTU(5)*(NSAV+2)
03722 K(NSAV+2,4)=MSTU(5)*(NSAV+1)
03723 K(NSAV+2,5)=MSTU(5)*(NSAV+1)
03724 MSTJ(92)=NSAV+1
03725 ELSEIF(MSTJ(23).GE.1.AND.(MMAT.EQ.32.OR.MMAT.EQ.44.OR.MMAT.EQ.46).
03726 &AND.IABS(K(NSAV+1,2)).LE.20.AND.IABS(K(NSAV+2,2)).LE.20) THEN
03727 MSTJ(92)=NSAV+1
03728 ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.33.AND.IABS(K(NSAV+2,2)).EQ.21)
03729 &THEN
03730 K(NSAV+1,1)=3
03731 K(NSAV+2,1)=3
03732 K(NSAV+3,1)=3
03733 KCP=LUCOMP(K(NSAV+1,2))
03734 KQP=KCHG(KCP,2)*ISIGN(1,K(NSAV+1,2))
03735 JCON=4
03736 IF(KQP.LT.0) JCON=5
03737 K(NSAV+1,JCON)=MSTU(5)*(NSAV+2)
03738 K(NSAV+2,9-JCON)=MSTU(5)*(NSAV+1)
03739 K(NSAV+2,JCON)=MSTU(5)*(NSAV+3)
03740 K(NSAV+3,9-JCON)=MSTU(5)*(NSAV+2)
03741 MSTJ(92)=NSAV+1
03742 ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.33) THEN
03743 K(NSAV+1,1)=3
03744 K(NSAV+3,1)=3
03745 K(NSAV+1,4)=MSTU(5)*(NSAV+3)
03746 K(NSAV+1,5)=MSTU(5)*(NSAV+3)
03747 K(NSAV+3,4)=MSTU(5)*(NSAV+1)
03748 K(NSAV+3,5)=MSTU(5)*(NSAV+1)
03749 MSTJ(92)=NSAV+1
03750
03751
03752 ELSEIF(MSTJ(27).GE.1.AND.MMAT.EQ.45.AND.ND.EQ.3) THEN
03753 K(NSAV+2,1)=3
03754 K(NSAV+3,1)=3
03755 K(NSAV+2,4)=MSTU(5)*(NSAV+3)
03756 K(NSAV+2,5)=MSTU(5)*(NSAV+3)
03757 K(NSAV+3,4)=MSTU(5)*(NSAV+2)
03758 K(NSAV+3,5)=MSTU(5)*(NSAV+2)
03759 MSTJ(92)=NSAV+1
03760 ENDIF
03761
03762
03763 IF(K(IP,1).EQ.5) K(IP,1)=15
03764 IF(K(IP,1).LE.10) K(IP,1)=11
03765 IF(MMIX.EQ.1.AND.MSTJ(26).EQ.2.AND.K(IP,1).EQ.11) K(IP,1)=12
03766 K(IP,4)=NSAV+1
03767 K(IP,5)=N
03768
03769 RETURN
03770 END
03771
03772
03773
03774 SUBROUTINE LUKFDI(KFL1,KFL2,KFL3,KF)
03775
03776
03777 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
03778 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
03779 SAVE /LUDAT1/,/LUDAT2/
03780
03781
03782 KF1A=IABS(KFL1)
03783 KF2A=IABS(KFL2)
03784 KFL3=0
03785 KF=0
03786 IF(KF1A.EQ.0) RETURN
03787 IF(KF2A.NE.0) THEN
03788 IF(KF1A.LE.10.AND.KF2A.LE.10.AND.KFL1*KFL2.GT.0) RETURN
03789 IF(KF1A.GT.10.AND.KF2A.GT.10) RETURN
03790 IF((KF1A.GT.10.OR.KF2A.GT.10).AND.KFL1*KFL2.LT.0) RETURN
03791 ENDIF
03792
03793
03794 IF(MSTJ(15).EQ.1) THEN
03795 KTAB1=-1
03796 IF(KF1A.GE.1.AND.KF1A.LE.6) KTAB1=KF1A
03797 KFL1A=MOD(KF1A/1000,10)
03798 KFL1B=MOD(KF1A/100,10)
03799 KFL1S=MOD(KF1A,10)
03800 IF(KFL1A.GE.1.AND.KFL1A.LE.4.AND.KFL1B.GE.1.AND.KFL1B.LE.4)
03801 & KTAB1=6+KFL1A*(KFL1A-2)+2*KFL1B+(KFL1S-1)/2
03802 IF(KFL1A.GE.1.AND.KFL1A.LE.4.AND.KFL1A.EQ.KFL1B) KTAB1=KTAB1-1
03803 IF(KF1A.GE.1.AND.KF1A.LE.6) KFL1A=KF1A
03804 KTAB2=0
03805 IF(KF2A.NE.0) THEN
03806 KTAB2=-1
03807 IF(KF2A.GE.1.AND.KF2A.LE.6) KTAB2=KF2A
03808 KFL2A=MOD(KF2A/1000,10)
03809 KFL2B=MOD(KF2A/100,10)
03810 KFL2S=MOD(KF2A,10)
03811 IF(KFL2A.GE.1.AND.KFL2A.LE.4.AND.KFL2B.GE.1.AND.KFL2B.LE.4)
03812 & KTAB2=6+KFL2A*(KFL2A-2)+2*KFL2B+(KFL2S-1)/2
03813 IF(KFL2A.GE.1.AND.KFL2A.LE.4.AND.KFL2A.EQ.KFL2B) KTAB2=KTAB2-1
03814 ENDIF
03815 IF(KTAB1.GE.0.AND.KTAB2.GE.0) GOTO 150
03816 ENDIF
03817
03818
03819 100 PAR2=PARJ(2)
03820 PAR3=PARJ(3)
03821 PAR4=3.*PARJ(4)
03822 IF(MSTJ(12).GE.2) THEN
03823 PAR3M=SQRT(PARJ(3))
03824 PAR4M=1./(3.*SQRT(PARJ(4)))
03825 PARDM=PARJ(7)/(PARJ(7)+PAR3M*PARJ(6))
03826 PARS0=PARJ(5)*(2.+(1.+PAR2*PAR3M*PARJ(7))*(1.+PAR4M))
03827 PARS1=PARJ(7)*PARS0/(2.*PAR3M)+PARJ(5)*(PARJ(6)*(1.+PAR4M)+
03828 & PAR2*PAR3M*PARJ(6)*PARJ(7))
03829 PARS2=PARJ(5)*2.*PARJ(6)*PARJ(7)*(PAR2*PARJ(7)+(1.+PAR4M)/PAR3M)
03830 PARSM=MAX(PARS0,PARS1,PARS2)
03831 PAR4=PAR4*(1.+PARSM)/(1.+PARSM/(3.*PAR4M))
03832 ENDIF
03833
03834
03835 110 MBARY=0
03836 KFDA=0
03837 IF(KF1A.LE.10) THEN
03838 IF(KF2A.EQ.0.AND.MSTJ(12).GE.1.AND.(1.+PARJ(1))*RLU(0).GT.1.)
03839 & MBARY=1
03840 IF(KF2A.GT.10) MBARY=2
03841 IF(KF2A.GT.10.AND.KF2A.LE.10000) KFDA=KF2A
03842 ELSE
03843 MBARY=2
03844 IF(KF1A.LE.10000) KFDA=KF1A
03845 ENDIF
03846
03847
03848 IF(KFDA.NE.0.AND.MSTJ(12).GE.2) THEN
03849 KFLDA=MOD(KFDA/1000,10)
03850 KFLDB=MOD(KFDA/100,10)
03851 KFLDS=MOD(KFDA,10)
03852 WTDQ=PARS0
03853 IF(MAX(KFLDA,KFLDB).EQ.3) WTDQ=PARS1
03854 IF(MIN(KFLDA,KFLDB).EQ.3) WTDQ=PARS2
03855 IF(KFLDS.EQ.1) WTDQ=WTDQ/(3.*PAR4M)
03856 IF((1.+WTDQ)*RLU(0).GT.1.) MBARY=-1
03857 IF(MBARY.EQ.-1.AND.KF2A.NE.0) RETURN
03858 ENDIF
03859
03860
03861 IF(MBARY.LE.0) THEN
03862 KFS=ISIGN(1,KFL1)
03863 IF(MBARY.EQ.0) THEN
03864 IF(KF2A.EQ.0) KFL3=ISIGN(1+INT((2.+PAR2)*RLU(0)),-KFL1)
03865 KFLA=MAX(KF1A,KF2A+IABS(KFL3))
03866 KFLB=MIN(KF1A,KF2A+IABS(KFL3))
03867 IF(KFLA.NE.KF1A) KFS=-KFS
03868
03869
03870 ELSE
03871 KFL1A=MOD(KF1A/1000,10)
03872 KFL1B=MOD(KF1A/100,10)
03873 120 KFL1D=KFL1A+INT(RLU(0)+0.5)*(KFL1B-KFL1A)
03874 KFL1E=KFL1A+KFL1B-KFL1D
03875 IF((KFL1D.EQ.3.AND.RLU(0).GT.PARDM).OR.(KFL1E.EQ.3.AND.
03876 & RLU(0).LT.PARDM)) THEN
03877 KFL1D=KFL1A+KFL1B-KFL1D
03878 KFL1E=KFL1A+KFL1B-KFL1E
03879 ENDIF
03880 KFL3A=1+INT((2.+PAR2*PAR3M*PARJ(7))*RLU(0))
03881 IF((KFL1E.NE.KFL3A.AND.RLU(0).GT.(1.+PAR4M)/MAX(2.,1.+PAR4M)).
03882 & OR.(KFL1E.EQ.KFL3A.AND.RLU(0).GT.2./MAX(2.,1.+PAR4M)))
03883 & GOTO 120
03884 KFLDS=3
03885 IF(KFL1E.NE.KFL3A) KFLDS=2*INT(RLU(0)+1./(1.+PAR4M))+1
03886 KFL3=ISIGN(10000+1000*MAX(KFL1E,KFL3A)+100*MIN(KFL1E,KFL3A)+
03887 & KFLDS,-KFL1)
03888 KFLA=MAX(KFL1D,KFL3A)
03889 KFLB=MIN(KFL1D,KFL3A)
03890 IF(KFLA.NE.KFL1D) KFS=-KFS
03891 ENDIF
03892
03893
03894 IF(KFLA.LE.2) KMUL=INT(PARJ(11)+RLU(0))
03895 IF(KFLA.EQ.3) KMUL=INT(PARJ(12)+RLU(0))
03896 IF(KFLA.GE.4) KMUL=INT(PARJ(13)+RLU(0))
03897 IF(KMUL.EQ.0.AND.PARJ(14).GT.0.) THEN
03898 IF(RLU(0).LT.PARJ(14)) KMUL=2
03899 ELSEIF(KMUL.EQ.1.AND.PARJ(15)+PARJ(16)+PARJ(17).GT.0.) THEN
03900 RMUL=RLU(0)
03901 IF(RMUL.LT.PARJ(15)) KMUL=3
03902 IF(KMUL.EQ.1.AND.RMUL.LT.PARJ(15)+PARJ(16)) KMUL=4
03903 IF(KMUL.EQ.1.AND.RMUL.LT.PARJ(15)+PARJ(16)+PARJ(17)) KMUL=5
03904 ENDIF
03905 KFLS=3
03906 IF(KMUL.EQ.0.OR.KMUL.EQ.3) KFLS=1
03907 IF(KMUL.EQ.5) KFLS=5
03908 IF(KFLA.NE.KFLB) THEN
03909 KF=(100*KFLA+10*KFLB+KFLS)*KFS*(-1)**KFLA
03910 ELSE
03911 RMIX=RLU(0)
03912 IMIX=2*KFLA+10*KMUL
03913 IF(KFLA.LE.3) KF=110*(1+INT(RMIX+PARF(IMIX-1))+
03914 & INT(RMIX+PARF(IMIX)))+KFLS
03915 IF(KFLA.GE.4) KF=110*KFLA+KFLS
03916 ENDIF
03917 IF(KMUL.EQ.2.OR.KMUL.EQ.3) KF=KF+ISIGN(10000,KF)
03918 IF(KMUL.EQ.4) KF=KF+ISIGN(20000,KF)
03919
03920
03921 IF(KF.EQ.221) THEN
03922 IF(RLU(0).GT.PARJ(25)) GOTO 110
03923 ELSEIF(KF.EQ.331) THEN
03924 IF(RLU(0).GT.PARJ(26)) GOTO 110
03925 ENDIF
03926
03927
03928 ELSE
03929 130 IF(KF1A.LE.10.AND.KF2A.EQ.0) THEN
03930 KFLA=KF1A
03931 140 KFLB=1+INT((2.+PAR2*PAR3)*RLU(0))
03932 KFLC=1+INT((2.+PAR2*PAR3)*RLU(0))
03933 KFLDS=1
03934 IF(KFLB.GE.KFLC) KFLDS=3
03935 IF(KFLDS.EQ.1.AND.PAR4*RLU(0).GT.1.) GOTO 140
03936 IF(KFLDS.EQ.3.AND.PAR4.LT.RLU(0)) GOTO 140
03937 KFL3=ISIGN(1000*MAX(KFLB,KFLC)+100*MIN(KFLB,KFLC)+KFLDS,KFL1)
03938
03939
03940 ELSEIF(KF1A.LE.10) THEN
03941 KFLA=KF1A
03942 KFLB=MOD(KF2A/1000,10)
03943 KFLC=MOD(KF2A/100,10)
03944 KFLDS=MOD(KF2A,10)
03945
03946
03947 ELSE
03948 IF(KF2A.EQ.0) KFL3=ISIGN(1+INT((2.+PAR2)*RLU(0)),KFL1)
03949 KFLA=KF2A+IABS(KFL3)
03950 KFLB=MOD(KF1A/1000,10)
03951 KFLC=MOD(KF1A/100,10)
03952 KFLDS=MOD(KF1A,10)
03953 ENDIF
03954
03955
03956 KBARY=KFLDS
03957 IF(KFLDS.EQ.3.AND.KFLB.NE.KFLC) KBARY=5
03958 IF(KFLA.NE.KFLB.AND.KFLA.NE.KFLC) KBARY=KBARY+1
03959 WT=PARF(60+KBARY)+PARJ(18)*PARF(70+KBARY)
03960 IF(MBARY.EQ.1.AND.MSTJ(12).GE.2) THEN
03961 WTDQ=PARS0
03962 IF(MAX(KFLB,KFLC).EQ.3) WTDQ=PARS1
03963 IF(MIN(KFLB,KFLC).EQ.3) WTDQ=PARS2
03964 IF(KFLDS.EQ.1) WTDQ=WTDQ/(3.*PAR4M)
03965 IF(KFLDS.EQ.1) WT=WT*(1.+WTDQ)/(1.+PARSM/(3.*PAR4M))
03966 IF(KFLDS.EQ.3) WT=WT*(1.+WTDQ)/(1.+PARSM)
03967 ENDIF
03968 IF(KF2A.EQ.0.AND.WT.LT.RLU(0)) GOTO 130
03969
03970
03971 KFLD=MAX(KFLA,KFLB,KFLC)
03972 KFLF=MIN(KFLA,KFLB,KFLC)
03973 KFLE=KFLA+KFLB+KFLC-KFLD-KFLF
03974 KFLS=2
03975 IF((PARF(60+KBARY)+PARJ(18)*PARF(70+KBARY))*RLU(0).GT.
03976 & PARF(60+KBARY)) KFLS=4
03977 KFLL=0
03978 IF(KFLS.EQ.2.AND.KFLD.GT.KFLE.AND.KFLE.GT.KFLF) THEN
03979 IF(KFLDS.EQ.1.AND.KFLA.EQ.KFLD) KFLL=1
03980 IF(KFLDS.EQ.1.AND.KFLA.NE.KFLD) KFLL=INT(0.25+RLU(0))
03981 IF(KFLDS.EQ.3.AND.KFLA.NE.KFLD) KFLL=INT(0.75+RLU(0))
03982 ENDIF
03983 IF(KFLL.EQ.0) KF=ISIGN(1000*KFLD+100*KFLE+10*KFLF+KFLS,KFL1)
03984 IF(KFLL.EQ.1) KF=ISIGN(1000*KFLD+100*KFLF+10*KFLE+KFLS,KFL1)
03985 ENDIF
03986 RETURN
03987
03988
03989 150 IF(KTAB2.EQ.0.AND.MSTJ(12).LE.0) THEN
03990 KT3L=1
03991 KT3U=6
03992 ELSEIF(KTAB2.EQ.0.AND.KTAB1.GE.7.AND.MSTJ(12).LE.1) THEN
03993 KT3L=1
03994 KT3U=6
03995 ELSEIF(KTAB2.EQ.0) THEN
03996 KT3L=1
03997 KT3U=22
03998 ELSE
03999 KT3L=KTAB2
04000 KT3U=KTAB2
04001 ENDIF
04002 RFL=0.
04003 DO 170 KTS=0,2
04004 DO 160 KT3=KT3L,KT3U
04005 RFL=RFL+PARF(120+80*KTAB1+25*KTS+KT3)
04006 160 CONTINUE
04007 170 CONTINUE
04008 RFL=RLU(0)*RFL
04009 DO 190 KTS=0,2
04010 KTABS=KTS
04011 DO 180 KT3=KT3L,KT3U
04012 KTAB3=KT3
04013 RFL=RFL-PARF(120+80*KTAB1+25*KTS+KT3)
04014 IF(RFL.LE.0.) GOTO 200
04015 180 CONTINUE
04016 190 CONTINUE
04017 200 CONTINUE
04018
04019
04020 IF(KTAB3.LE.6) THEN
04021 KFL3A=KTAB3
04022 KFL3B=0
04023 KFL3=ISIGN(KFL3A,KFL1*(2*KTAB1-13))
04024 ELSE
04025 KFL3A=1
04026 IF(KTAB3.GE.8) KFL3A=2
04027 IF(KTAB3.GE.11) KFL3A=3
04028 IF(KTAB3.GE.16) KFL3A=4
04029 KFL3B=(KTAB3-6-KFL3A*(KFL3A-2))/2
04030 KFL3=1000*KFL3A+100*KFL3B+1
04031 IF(KFL3A.EQ.KFL3B.OR.KTAB3.NE.6+KFL3A*(KFL3A-2)+2*KFL3B) KFL3=
04032 & KFL3+2
04033 KFL3=ISIGN(KFL3,KFL1*(13-2*KTAB1))
04034 ENDIF
04035
04036
04037 IF(KFL3A.EQ.KFL1A.AND.KFL3B.EQ.KFL1B.AND.(KFL3A.LE.3.OR.
04038 &KFL3B.NE.0)) THEN
04039 RFL=RLU(0)*(PARF(143+80*KTAB1+25*KTABS)+PARF(144+80*KTAB1+
04040 & 25*KTABS)+PARF(145+80*KTAB1+25*KTABS))
04041 KF=110+2*KTABS+1
04042 IF(RFL.GT.PARF(143+80*KTAB1+25*KTABS)) KF=220+2*KTABS+1
04043 IF(RFL.GT.PARF(143+80*KTAB1+25*KTABS)+PARF(144+80*KTAB1+
04044 & 25*KTABS)) KF=330+2*KTABS+1
04045 ELSEIF(KTAB1.LE.6.AND.KTAB3.LE.6) THEN
04046 KFLA=MAX(KTAB1,KTAB3)
04047 KFLB=MIN(KTAB1,KTAB3)
04048 KFS=ISIGN(1,KFL1)
04049 IF(KFLA.NE.KF1A) KFS=-KFS
04050 KF=(100*KFLA+10*KFLB+2*KTABS+1)*KFS*(-1)**KFLA
04051 ELSEIF(KTAB1.GE.7.AND.KTAB3.GE.7) THEN
04052 KFS=ISIGN(1,KFL1)
04053 IF(KFL1A.EQ.KFL3A) THEN
04054 KFLA=MAX(KFL1B,KFL3B)
04055 KFLB=MIN(KFL1B,KFL3B)
04056 IF(KFLA.NE.KFL1B) KFS=-KFS
04057 ELSEIF(KFL1A.EQ.KFL3B) THEN
04058 KFLA=KFL3A
04059 KFLB=KFL1B
04060 KFS=-KFS
04061 ELSEIF(KFL1B.EQ.KFL3A) THEN
04062 KFLA=KFL1A
04063 KFLB=KFL3B
04064 ELSEIF(KFL1B.EQ.KFL3B) THEN
04065 KFLA=MAX(KFL1A,KFL3A)
04066 KFLB=MIN(KFL1A,KFL3A)
04067 IF(KFLA.NE.KFL1A) KFS=-KFS
04068 ELSE
04069 CALL LUERRM(2,'(LUKFDI:) no matching flavours for qq -> qq')
04070 GOTO 100
04071 ENDIF
04072 KF=(100*KFLA+10*KFLB+2*KTABS+1)*KFS*(-1)**KFLA
04073
04074
04075 ELSE
04076 IF(KTAB1.GE.7) THEN
04077 KFLA=KFL3A
04078 KFLB=KFL1A
04079 KFLC=KFL1B
04080 ELSE
04081 KFLA=KFL1A
04082 KFLB=KFL3A
04083 KFLC=KFL3B
04084 ENDIF
04085 KFLD=MAX(KFLA,KFLB,KFLC)
04086 KFLF=MIN(KFLA,KFLB,KFLC)
04087 KFLE=KFLA+KFLB+KFLC-KFLD-KFLF
04088 IF(KTABS.EQ.0) KF=ISIGN(1000*KFLD+100*KFLF+10*KFLE+2,KFL1)
04089 IF(KTABS.GE.1) KF=ISIGN(1000*KFLD+100*KFLE+10*KFLF+2*KTABS,KFL1)
04090 ENDIF
04091
04092
04093 IF(KFL2.NE.0) KFL3=0
04094 KC=LUCOMP(KF)
04095 IF(KC.EQ.0) THEN
04096 CALL LUERRM(2,'(LUKFDI:) user-defined flavour probabilities '//
04097 & 'failed')
04098 GOTO 100
04099 ENDIF
04100
04101 RETURN
04102 END
04103
04104
04105
04106 SUBROUTINE LUPTDI(KFL,PX,PY)
04107
04108
04109 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
04110 SAVE /LUDAT1/
04111
04112
04113 KFLA=IABS(KFL)
04114 PT=PARJ(21)*SQRT(-LOG(MAX(1E-10,RLU(0))))
04115 IF(PARJ(23).GT.RLU(0)) PT=PARJ(24)*PT
04116 IF(MSTJ(91).EQ.1) PT=PARJ(22)*PT
04117 IF(KFLA.EQ.0.AND.MSTJ(13).LE.0) PT=0.
04118 PHI=PARU(2)*RLU(0)
04119 PX=PT*COS(PHI)
04120 PY=PT*SIN(PHI)
04121
04122 RETURN
04123 END
04124
04125
04126
04127 SUBROUTINE LUZDIS(KFL1,KFL2,PR,Z)
04128
04129
04130 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
04131 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
04132 SAVE /LUDAT1/,/LUDAT2/
04133
04134
04135 KFLA=IABS(KFL1)
04136 KFLB=IABS(KFL2)
04137 KFLH=KFLA
04138 IF(KFLA.GE.10) KFLH=MOD(KFLA/1000,10)
04139
04140
04141 IF(MSTJ(11).EQ.1.OR.(MSTJ(11).EQ.3.AND.KFLH.LE.3).OR.
04142 &MSTJ(11).GE.4) THEN
04143 FA=PARJ(41)
04144 IF(MSTJ(91).EQ.1) FA=PARJ(43)
04145 IF(KFLB.GE.10) FA=FA+PARJ(45)
04146 FBB=PARJ(42)
04147 IF(MSTJ(91).EQ.1) FBB=PARJ(44)
04148 FB=FBB*PR
04149 FC=1.
04150 IF(KFLA.GE.10) FC=FC-PARJ(45)
04151 IF(KFLB.GE.10) FC=FC+PARJ(45)
04152 IF(MSTJ(11).GE.4.AND.KFLH.GE.4.AND.KFLH.LE.5) THEN
04153 FRED=PARJ(46)
04154 IF(MSTJ(11).EQ.5.AND.KFLH.EQ.5) FRED=PARJ(47)
04155 FC=FC+FRED*FBB*PARF(100+KFLH)**2
04156 ELSEIF(MSTJ(11).GE.4.AND.KFLH.GE.6.AND.KFLH.LE.8) THEN
04157 FRED=PARJ(46)
04158 IF(MSTJ(11).EQ.5) FRED=PARJ(48)
04159 FC=FC+FRED*FBB*PMAS(KFLH,1)**2
04160 ENDIF
04161 MC=1
04162 IF(ABS(FC-1.).GT.0.01) MC=2
04163
04164
04165 IF(FA.LT.0.02) THEN
04166 MA=1
04167 ZMAX=1.
04168 IF(FC.GT.FB) ZMAX=FB/FC
04169 ELSEIF(ABS(FC-FA).LT.0.01) THEN
04170 MA=2
04171 ZMAX=FB/(FB+FC)
04172 ELSE
04173 MA=3
04174 ZMAX=0.5*(FB+FC-SQRT((FB-FC)**2+4.*FA*FB))/(FC-FA)
04175 IF(ZMAX.GT.0.9999.AND.FB.GT.100.) ZMAX=MIN(ZMAX,1.-FA/FB)
04176 ENDIF
04177
04178
04179 MMAX=2
04180 IF(ZMAX.LT.0.1) THEN
04181 MMAX=1
04182 ZDIV=2.75*ZMAX
04183 IF(MC.EQ.1) THEN
04184 FINT=1.-LOG(ZDIV)
04185 ELSE
04186 ZDIVC=ZDIV**(1.-FC)
04187 FINT=1.+(1.-1./ZDIVC)/(FC-1.)
04188 ENDIF
04189 ELSEIF(ZMAX.GT.0.85.AND.FB.GT.1.) THEN
04190 MMAX=3
04191 FSCB=SQRT(4.+(FC/FB)**2)
04192 ZDIV=FSCB-1./ZMAX-(FC/FB)*LOG(ZMAX*0.5*(FSCB+FC/FB))
04193 IF(MA.GE.2) ZDIV=ZDIV+(FA/FB)*LOG(1.-ZMAX)
04194 ZDIV=MIN(ZMAX,MAX(0.,ZDIV))
04195 FINT=1.+FB*(1.-ZDIV)
04196 ENDIF
04197
04198
04199 100 Z=RLU(0)
04200 FPRE=1.
04201 IF(MMAX.EQ.1) THEN
04202 IF(FINT*RLU(0).LE.1.) THEN
04203 Z=ZDIV*Z
04204 ELSEIF(MC.EQ.1) THEN
04205 Z=ZDIV**Z
04206 FPRE=ZDIV/Z
04207 ELSE
04208 Z=1./(ZDIVC+Z*(1.-ZDIVC))**(1./(1.-FC))
04209 FPRE=(ZDIV/Z)**FC
04210 ENDIF
04211 ELSEIF(MMAX.EQ.3) THEN
04212 IF(FINT*RLU(0).LE.1.) THEN
04213 Z=ZDIV+LOG(Z)/FB
04214 FPRE=EXP(FB*(Z-ZDIV))
04215 ELSE
04216 Z=ZDIV+Z*(1.-ZDIV)
04217 ENDIF
04218 ENDIF
04219
04220
04221 IF(Z.LE.0..OR.Z.GE.1.) GOTO 100
04222 FEXP=FC*LOG(ZMAX/Z)+FB*(1./ZMAX-1./Z)
04223 IF(MA.GE.2) FEXP=FEXP+FA*LOG((1.-Z)/(1.-ZMAX))
04224 FVAL=EXP(MAX(-50.,MIN(50.,FEXP)))
04225 IF(FVAL.LT.RLU(0)*FPRE) GOTO 100
04226
04227
04228 ELSE
04229 FC=PARJ(50+MAX(1,KFLH))
04230 IF(MSTJ(91).EQ.1) FC=PARJ(59)
04231 110 Z=RLU(0)
04232 IF(FC.GE.0..AND.FC.LE.1.) THEN
04233 IF(FC.GT.RLU(0)) Z=1.-Z**(1./3.)
04234 ELSEIF(FC.GT.-1.AND.FC.LT.0.) THEN
04235 IF(-4.*FC*Z*(1.-Z)**2.LT.RLU(0)*((1.-Z)**2-FC*Z)**2) GOTO 110
04236 ELSE
04237 IF(FC.GT.0.) Z=1.-Z**(1./FC)
04238 IF(FC.LT.0.) Z=Z**(-1./FC)
04239 ENDIF
04240 ENDIF
04241
04242 RETURN
04243 END
04244
04245
04246
04247 SUBROUTINE LUSHOW(IP1,IP2,QMAX)
04248
04249
04250 IMPLICIT DOUBLE PRECISION(D)
04251 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
04252 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
04253 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
04254 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
04255 DIMENSION PMTH(5,40),PS(5),PMA(4),PMSD(4),IEP(4),IPA(4),
04256 &KFLA(4),KFLD(4),KFL(4),ITRY(4),ISI(4),ISL(4),DP(4),DPT(5,4),
04257 &KSH(0:40),KCII(2),NIIS(2),IIIS(2,2),THEIIS(2,2),PHIIIS(2,2),
04258 &ISII(2)
04259
04260
04261 IF(MSTJ(41).LE.0.OR.(MSTJ(41).EQ.1.AND.QMAX.LE.PARJ(82)).OR.
04262 &QMAX.LE.MIN(PARJ(82),PARJ(83))) RETURN
04263 DO 100 IF=0,40
04264 KSH(IF)=0
04265 100 CONTINUE
04266 KSH(21)=1
04267 PMTH(1,21)=ULMASS(21)
04268 PMTH(2,21)=SQRT(PMTH(1,21)**2+0.25*PARJ(82)**2)
04269 PMTH(3,21)=2.*PMTH(2,21)
04270 PMTH(4,21)=PMTH(3,21)
04271 PMTH(5,21)=PMTH(3,21)
04272 PMTH(1,22)=ULMASS(22)
04273 PMTH(2,22)=SQRT(PMTH(1,22)**2+0.25*PARJ(83)**2)
04274 PMTH(3,22)=2.*PMTH(2,22)
04275 PMTH(4,22)=PMTH(3,22)
04276 PMTH(5,22)=PMTH(3,22)
04277 PMQTH1=PARJ(82)
04278 IF(MSTJ(41).GE.2) PMQTH1=MIN(PARJ(82),PARJ(83))
04279 PMQTH2=PMTH(2,21)
04280 IF(MSTJ(41).GE.2) PMQTH2=MIN(PMTH(2,21),PMTH(2,22))
04281 DO 110 IF=1,8
04282 KSH(IF)=1
04283 PMTH(1,IF)=ULMASS(IF)
04284 PMTH(2,IF)=SQRT(PMTH(1,IF)**2+0.25*PMQTH1**2)
04285 PMTH(3,IF)=PMTH(2,IF)+PMQTH2
04286 PMTH(4,IF)=SQRT(PMTH(1,IF)**2+0.25*PARJ(82)**2)+PMTH(2,21)
04287 PMTH(5,IF)=SQRT(PMTH(1,IF)**2+0.25*PARJ(83)**2)+PMTH(2,22)
04288 110 CONTINUE
04289 DO 120 IF=11,17,2
04290 IF(MSTJ(41).GE.2) KSH(IF)=1
04291 PMTH(1,IF)=ULMASS(IF)
04292 PMTH(2,IF)=SQRT(PMTH(1,IF)**2+0.25*PARJ(83)**2)
04293 PMTH(3,IF)=PMTH(2,IF)+PMTH(2,22)
04294 PMTH(4,IF)=PMTH(3,IF)
04295 PMTH(5,IF)=PMTH(3,IF)
04296 120 CONTINUE
04297 PT2MIN=MAX(0.5*PARJ(82),1.1*PARJ(81))**2
04298 ALAMS=PARJ(81)**2
04299 ALFM=LOG(PT2MIN/ALAMS)
04300
04301
04302 IF(IP1.GT.0.AND.IP1.LE.MIN(N,MSTU(4)-MSTU(32)).AND.IP2.EQ.0) THEN
04303 NPA=1
04304 IPA(1)=IP1
04305 ELSEIF(MIN(IP1,IP2).GT.0.AND.MAX(IP1,IP2).LE.MIN(N,MSTU(4)-
04306 &MSTU(32))) THEN
04307 NPA=2
04308 IPA(1)=IP1
04309 IPA(2)=IP2
04310 ELSEIF(IP1.GT.0.AND.IP1.LE.MIN(N,MSTU(4)-MSTU(32)).AND.IP2.LT.0.
04311 &AND.IP2.GE.-3) THEN
04312 NPA=IABS(IP2)
04313 DO 130 I=1,NPA
04314 IPA(I)=IP1+I-1
04315 130 CONTINUE
04316 ELSE
04317 CALL LUERRM(12,
04318 & '(LUSHOW:) failed to reconstruct showering system')
04319 IF(MSTU(21).GE.1) RETURN
04320 ENDIF
04321
04322
04323 IREJ=0
04324 DO 140 J=1,5
04325 PS(J)=0.
04326 140 CONTINUE
04327 PM=0.
04328 DO 160 I=1,NPA
04329 KFLA(I)=IABS(K(IPA(I),2))
04330 PMA(I)=P(IPA(I),5)
04331 IF(KFLA(I).LE.40) THEN
04332 IF(KSH(KFLA(I)).EQ.1) PMA(I)=PMTH(3,KFLA(I))
04333 ENDIF
04334 PM=PM+PMA(I)
04335 IF(KFLA(I).GT.40) THEN
04336 IREJ=IREJ+1
04337 ELSE
04338 IF(KSH(KFLA(I)).EQ.0.OR.PMA(I).GT.QMAX) IREJ=IREJ+1
04339 ENDIF
04340 DO 150 J=1,4
04341 PS(J)=PS(J)+P(IPA(I),J)
04342 150 CONTINUE
04343 160 CONTINUE
04344 IF(IREJ.EQ.NPA) RETURN
04345 PS(5)=SQRT(MAX(0.,PS(4)**2-PS(1)**2-PS(2)**2-PS(3)**2))
04346 IF(NPA.EQ.1) PS(5)=PS(4)
04347 IF(PS(5).LE.PM+PMQTH1) RETURN
04348
04349
04350 M3JC=0
04351 IF(NPA.EQ.2.AND.MSTJ(47).GE.1) THEN
04352 IF(KFLA(1).GE.1.AND.KFLA(1).LE.8.AND.KFLA(2).GE.1.AND.
04353 & KFLA(2).LE.8) M3JC=1
04354 IF((KFLA(1).EQ.11.OR.KFLA(1).EQ.13.OR.KFLA(1).EQ.15.OR.
04355 & KFLA(1).EQ.17).AND.KFLA(2).EQ.KFLA(1)) M3JC=1
04356 IF((KFLA(1).EQ.11.OR.KFLA(1).EQ.13.OR.KFLA(1).EQ.15.OR.
04357 & KFLA(1).EQ.17).AND.KFLA(2).EQ.KFLA(1)+1) M3JC=1
04358 IF((KFLA(1).EQ.12.OR.KFLA(1).EQ.14.OR.KFLA(1).EQ.16.OR.
04359 & KFLA(1).EQ.18).AND.KFLA(2).EQ.KFLA(1)-1) M3JC=1
04360 IF(MSTJ(47).EQ.2.OR.MSTJ(47).EQ.4) M3JC=1
04361 M3JCM=0
04362 IF(M3JC.EQ.1.AND.MSTJ(47).GE.3.AND.KFLA(1).EQ.KFLA(2)) THEN
04363 M3JCM=1
04364 QME=(2.*PMTH(KFLA(1),1)/PS(5))**2
04365 ENDIF
04366 ENDIF
04367
04368
04369 MIIS=0
04370 IF(MSTJ(50).GE.1.AND.MSTJ(50).LE.3.AND.NPA.EQ.2) MIIS=MSTJ(50)
04371 IF(MIIS.NE.0) THEN
04372 DO 180 I=1,2
04373 KCII(I)=0
04374 KCA=LUCOMP(KFLA(I))
04375 IF(KCA.NE.0) KCII(I)=KCHG(KCA,2)*ISIGN(1,K(IPA(I),2))
04376 NIIS(I)=0
04377 IF(KCII(I).NE.0) THEN
04378 DO 170 J=1,2
04379 ICSI=MOD(K(IPA(I),3+J)/MSTU(5),MSTU(5))
04380 IF(ICSI.GT.0.AND.ICSI.NE.IPA(1).AND.ICSI.NE.IPA(2).AND.
04381 & (KCII(I).EQ.(-1)**(J+1).OR.KCII(I).EQ.2)) THEN
04382 NIIS(I)=NIIS(I)+1
04383 IIIS(I,NIIS(I))=ICSI
04384 ENDIF
04385 170 CONTINUE
04386 ENDIF
04387 180 CONTINUE
04388 IF(NIIS(1)+NIIS(2).EQ.0) MIIS=0
04389 ENDIF
04390
04391
04392
04393 IF(MIIS.NE.0) THEN
04394 DO 200 I=1,2
04395 DO 190 J=1,5
04396 K(N+I,J)=K(IPA(I),J)
04397 P(N+I,J)=P(IPA(I),J)
04398 V(N+I,J)=0.
04399 190 CONTINUE
04400 200 CONTINUE
04401 DO 220 I=3,2+NIIS(1)
04402 DO 210 J=1,5
04403 K(N+I,J)=K(IIIS(1,I-2),J)
04404 P(N+I,J)=P(IIIS(1,I-2),J)
04405 V(N+I,J)=0.
04406 210 CONTINUE
04407 220 CONTINUE
04408 DO 240 I=3+NIIS(1),2+NIIS(1)+NIIS(2)
04409 DO 230 J=1,5
04410 K(N+I,J)=K(IIIS(2,I-2-NIIS(1)),J)
04411 P(N+I,J)=P(IIIS(2,I-2-NIIS(1)),J)
04412 V(N+I,J)=0.
04413 230 CONTINUE
04414 240 CONTINUE
04415 CALL LUDBRB(N+1,N+2+NIIS(1)+NIIS(2),0.,0.,-DBLE(PS(1)/PS(4)),
04416 & -DBLE(PS(2)/PS(4)),-DBLE(PS(3)/PS(4)))
04417 PHI=ULANGL(P(N+1,1),P(N+1,2))
04418 CALL LUDBRB(N+1,N+2+NIIS(1)+NIIS(2),0.,-PHI,0D0,0D0,0D0)
04419 THE=ULANGL(P(N+1,3),P(N+1,1))
04420 CALL LUDBRB(N+1,N+2+NIIS(1)+NIIS(2),-THE,0.,0D0,0D0,0D0)
04421 DO 250 I=3,2+NIIS(1)
04422 THEIIS(1,I-2)=ULANGL(P(N+I,3),SQRT(P(N+I,1)**2+P(N+I,2)**2))
04423 PHIIIS(1,I-2)=ULANGL(P(N+I,1),P(N+I,2))
04424 250 CONTINUE
04425 DO 260 I=3+NIIS(1),2+NIIS(1)+NIIS(2)
04426 THEIIS(2,I-2-NIIS(1))=PARU(1)-ULANGL(P(N+I,3),
04427 & SQRT(P(N+I,1)**2+P(N+I,2)**2))
04428 PHIIIS(2,I-2-NIIS(1))=ULANGL(P(N+I,1),P(N+I,2))
04429 260 CONTINUE
04430 ENDIF
04431
04432
04433 NS=N
04434 IF(N.GT.MSTU(4)-MSTU(32)-5) THEN
04435 CALL LUERRM(11,'(LUSHOW:) no more memory left in LUJETS')
04436 IF(MSTU(21).GE.1) RETURN
04437 ENDIF
04438 IF(NPA.GE.2) THEN
04439 K(N+1,1)=11
04440 K(N+1,2)=21
04441 K(N+1,3)=0
04442 K(N+1,4)=0
04443 K(N+1,5)=0
04444 P(N+1,1)=0.
04445 P(N+1,2)=0.
04446 P(N+1,3)=0.
04447 P(N+1,4)=PS(5)
04448 P(N+1,5)=PS(5)
04449 V(N+1,5)=PS(5)**2
04450 N=N+1
04451 ENDIF
04452
04453
04454 NEP=NPA
04455 IM=NS
04456 IF(NPA.EQ.1) IM=NS-1
04457 270 IM=IM+1
04458 IF(N.GT.NS) THEN
04459 IF(IM.GT.N) GOTO 510
04460 KFLM=IABS(K(IM,2))
04461 IF(KFLM.GT.40) GOTO 270
04462 IF(KSH(KFLM).EQ.0) GOTO 270
04463 IF(P(IM,5).LT.PMTH(2,KFLM)) GOTO 270
04464 IGM=K(IM,3)
04465 ELSE
04466 IGM=-1
04467 ENDIF
04468 IF(N+NEP.GT.MSTU(4)-MSTU(32)-5) THEN
04469 CALL LUERRM(11,'(LUSHOW:) no more memory left in LUJETS')
04470 IF(MSTU(21).GE.1) RETURN
04471 ENDIF
04472
04473
04474
04475 IAU=0
04476 IF(IGM.GT.0) THEN
04477 IF(K(IM-1,3).EQ.IGM) IAU=IM-1
04478 IF(N.GE.IM+1.AND.K(IM+1,3).EQ.IGM) IAU=IM+1
04479 ENDIF
04480 IF(IGM.GE.0) THEN
04481 K(IM,4)=N+1
04482 DO 280 I=1,NEP
04483 K(N+I,3)=IM
04484 280 CONTINUE
04485 ELSE
04486 K(N+1,3)=IPA(1)
04487 ENDIF
04488 IF(IGM.LE.0) THEN
04489 DO 290 I=1,NEP
04490 K(N+I,2)=K(IPA(I),2)
04491 290 CONTINUE
04492 ELSEIF(KFLM.NE.21) THEN
04493 K(N+1,2)=K(IM,2)
04494 K(N+2,2)=K(IM,5)
04495 ELSEIF(K(IM,5).EQ.21) THEN
04496 K(N+1,2)=21
04497 K(N+2,2)=21
04498 ELSE
04499 K(N+1,2)=K(IM,5)
04500 K(N+2,2)=-K(IM,5)
04501 ENDIF
04502
04503
04504 DO 300 IP=1,NEP
04505 K(N+IP,1)=3
04506 K(N+IP,4)=0
04507 K(N+IP,5)=0
04508 KFLD(IP)=IABS(K(N+IP,2))
04509 IF(KCHG(LUCOMP(KFLD(IP)),2).EQ.0) K(N+IP,1)=1
04510 ITRY(IP)=0
04511 ISL(IP)=0
04512 ISI(IP)=0
04513 IF(KFLD(IP).LE.40) THEN
04514 IF(KSH(KFLD(IP)).EQ.1) ISI(IP)=1
04515 ENDIF
04516 300 CONTINUE
04517 ISLM=0
04518
04519
04520 IF(IGM.LE.0) THEN
04521 DO 310 I=1,NPA
04522 IF(NPA.GE.3) P(N+I,4)=(PS(4)*P(IPA(I),4)-PS(1)*P(IPA(I),1)-
04523 & PS(2)*P(IPA(I),2)-PS(3)*P(IPA(I),3))/PS(5)
04524 P(N+I,5)=MIN(QMAX,PS(5))
04525 IF(NPA.GE.3) P(N+I,5)=MIN(P(N+I,5),P(N+I,4))
04526 IF(ISI(I).EQ.0) P(N+I,5)=P(IPA(I),5)
04527 310 CONTINUE
04528 ELSE
04529 IF(MSTJ(43).LE.2) PEM=V(IM,2)
04530 IF(MSTJ(43).GE.3) PEM=P(IM,4)
04531 P(N+1,5)=MIN(P(IM,5),V(IM,1)*PEM)
04532 P(N+2,5)=MIN(P(IM,5),(1.-V(IM,1))*PEM)
04533 IF(K(N+2,2).EQ.22) P(N+2,5)=PMTH(1,22)
04534 ENDIF
04535 DO 320 I=1,NEP
04536 PMSD(I)=P(N+I,5)
04537 IF(ISI(I).EQ.1) THEN
04538 IF(P(N+I,5).LE.PMTH(3,KFLD(I))) P(N+I,5)=PMTH(1,KFLD(I))
04539 ENDIF
04540 V(N+I,5)=P(N+I,5)**2
04541 320 CONTINUE
04542
04543
04544 330 INUM=0
04545 IF(NEP.EQ.1) INUM=1
04546 DO 340 I=1,NEP
04547 IF(INUM.EQ.0.AND.ISL(I).EQ.1) INUM=I
04548 340 CONTINUE
04549 DO 350 I=1,NEP
04550 IF(INUM.EQ.0.AND.ITRY(I).EQ.0.AND.ISI(I).EQ.1) THEN
04551 IF(P(N+I,5).GE.PMTH(2,KFLD(I))) INUM=I
04552 ENDIF
04553 350 CONTINUE
04554 IF(INUM.EQ.0) THEN
04555 RMAX=0.
04556 DO 360 I=1,NEP
04557 IF(ISI(I).EQ.1.AND.PMSD(I).GE.PMQTH2) THEN
04558 RPM=P(N+I,5)/PMSD(I)
04559 IF(RPM.GT.RMAX.AND.P(N+I,5).GE.PMTH(2,KFLD(I))) THEN
04560 RMAX=RPM
04561 INUM=I
04562 ENDIF
04563 ENDIF
04564 360 CONTINUE
04565 ENDIF
04566
04567
04568 INUM=MAX(1,INUM)
04569 IEP(1)=N+INUM
04570 DO 370 I=2,NEP
04571 IEP(I)=IEP(I-1)+1
04572 IF(IEP(I).GT.N+NEP) IEP(I)=N+1
04573 370 CONTINUE
04574 DO 380 I=1,NEP
04575 KFL(I)=IABS(K(IEP(I),2))
04576 380 CONTINUE
04577 ITRY(INUM)=ITRY(INUM)+1
04578 IF(ITRY(INUM).GT.200) THEN
04579 CALL LUERRM(14,'(LUSHOW:) caught in infinite loop')
04580 IF(MSTU(21).GE.1) RETURN
04581 ENDIF
04582 Z=0.5
04583 IF(KFL(1).GT.40) GOTO 430
04584 IF(KSH(KFL(1)).EQ.0) GOTO 430
04585 IF(P(IEP(1),5).LT.PMTH(2,KFL(1))) GOTO 430
04586
04587
04588 IF(MIIS.GE.1.AND.IEP(1).LE.NS+3) THEN
04589 III=IEP(1)-NS-1
04590 ISII(III)=0
04591 IF(IABS(KCII(III)).EQ.1.AND.NIIS(III).EQ.1) THEN
04592 ISII(III)=1
04593 ELSEIF(KCII(III).EQ.2.AND.NIIS(III).EQ.1) THEN
04594 IF(RLU(0).GT.0.5) ISII(III)=1
04595 ELSEIF(KCII(III).EQ.2.AND.NIIS(III).EQ.2) THEN
04596 ISII(III)=1
04597 IF(RLU(0).GT.0.5) ISII(III)=2
04598 ENDIF
04599 ENDIF
04600
04601
04602 IF(NEP.EQ.1) THEN
04603 PMED=PS(4)
04604 ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN
04605 PMED=P(IM,5)
04606 ELSE
04607 IF(INUM.EQ.1) PMED=V(IM,1)*PEM
04608 IF(INUM.EQ.2) PMED=(1.-V(IM,1))*PEM
04609 ENDIF
04610 IF(MOD(MSTJ(43),2).EQ.1) THEN
04611 ZC=PMTH(2,21)/PMED
04612 ZCE=PMTH(2,22)/PMED
04613 ELSE
04614 ZC=0.5*(1.-SQRT(MAX(0.,1.-(2.*PMTH(2,21)/PMED)**2)))
04615 IF(ZC.LT.1E-4) ZC=(PMTH(2,21)/PMED)**2
04616 ZCE=0.5*(1.-SQRT(MAX(0.,1.-(2.*PMTH(2,22)/PMED)**2)))
04617 IF(ZCE.LT.1E-4) ZCE=(PMTH(2,22)/PMED)**2
04618 ENDIF
04619 ZC=MIN(ZC,0.491)
04620 ZCE=MIN(ZCE,0.491)
04621 IF((MSTJ(41).EQ.1.AND.ZC.GT.0.49).OR.(MSTJ(41).GE.2.AND.
04622 &MIN(ZC,ZCE).GT.0.49)) THEN
04623 P(IEP(1),5)=PMTH(1,KFL(1))
04624 V(IEP(1),5)=P(IEP(1),5)**2
04625 GOTO 430
04626 ENDIF
04627
04628
04629 IF(MSTJ(49).EQ.0.AND.KFL(1).EQ.21) THEN
04630 FBR=6.*LOG((1.-ZC)/ZC)+MSTJ(45)*(0.5-ZC)
04631 ELSEIF(MSTJ(49).EQ.0) THEN
04632 FBR=(8./3.)*LOG((1.-ZC)/ZC)
04633
04634
04635 ELSEIF(MSTJ(49).EQ.1.AND.KFL(1).EQ.21) THEN
04636 FBR=(PARJ(87)+MSTJ(45)*PARJ(88))*(1.-2.*ZC)
04637 ELSEIF(MSTJ(49).EQ.1) THEN
04638 FBR=(1.-2.*ZC)/3.
04639 IF(IGM.EQ.0.AND.M3JC.EQ.1) FBR=4.*FBR
04640
04641
04642 ELSEIF(KFL(1).EQ.21) THEN
04643 FBR=6.*MSTJ(45)*(0.5-ZC)
04644 ELSE
04645 FBR=2.*LOG((1.-ZC)/ZC)
04646 ENDIF
04647
04648
04649 IF(KFL(1).GE.11.AND.KFL(1).LE.18) FBR=0.
04650
04651
04652 IF(MSTJ(41).GE.2.AND.KFL(1).GE.1.AND.KFL(1).LE.18) THEN
04653 FBRE=(KCHG(KFL(1),1)/3.)**2*2.*LOG((1.-ZCE)/ZCE)
04654 IF(MSTJ(41).EQ.10) FBRE=PARJ(84)*FBRE
04655 ENDIF
04656
04657
04658 390 PMS=V(IEP(1),5)
04659 IF(IGM.GE.0) THEN
04660 PM2=0.
04661 DO 400 I=2,NEP
04662 PM=P(IEP(I),5)
04663 IF(KFL(I).LE.40) THEN
04664 IF(KSH(KFL(I)).EQ.1) PM=PMTH(2,KFL(I))
04665 ENDIF
04666 PM2=PM2+PM
04667 400 CONTINUE
04668 PMS=MIN(PMS,(P(IM,5)-PM2)**2)
04669 ENDIF
04670
04671
04672 B0=27./6.
04673 DO 410 IF=4,MSTJ(45)
04674 IF(PMS.GT.4.*PMTH(2,IF)**2) B0=(33.-2.*IF)/6.
04675 410 CONTINUE
04676 IF(FBR.LT.1E-3) THEN
04677 PMSQCD=0.
04678 ELSEIF(MSTJ(44).LE.0) THEN
04679 PMSQCD=PMS*EXP(MAX(-50.,LOG(RLU(0))*PARU(2)/(PARU(111)*FBR)))
04680 ELSEIF(MSTJ(44).EQ.1) THEN
04681 PMSQCD=4.*ALAMS*(0.25*PMS/ALAMS)**(RLU(0)**(B0/FBR))
04682 ELSE
04683 PMSQCD=PMS*EXP(MAX(-50.,ALFM*B0*LOG(RLU(0))/FBR))
04684 ENDIF
04685 IF(ZC.GT.0.49.OR.PMSQCD.LE.PMTH(4,KFL(1))**2) PMSQCD=
04686 &PMTH(2,KFL(1))**2
04687 V(IEP(1),5)=PMSQCD
04688 MCE=1
04689
04690
04691 IF(MSTJ(41).GE.2.AND.KFL(1).GE.1.AND.KFL(1).LE.18) THEN
04692 PMSQED=PMS*EXP(MAX(-50.,LOG(RLU(0))*PARU(2)/(PARU(101)*FBRE)))
04693 IF(ZCE.GT.0.49.OR.PMSQED.LE.PMTH(5,KFL(1))**2) PMSQED=
04694 & PMTH(2,KFL(1))**2
04695 IF(PMSQED.GT.PMSQCD) THEN
04696 V(IEP(1),5)=PMSQED
04697 MCE=2
04698 ENDIF
04699 ENDIF
04700
04701
04702 P(IEP(1),5)=SQRT(V(IEP(1),5))
04703 IF(P(IEP(1),5).LE.PMTH(3,KFL(1))) THEN
04704 P(IEP(1),5)=PMTH(1,KFL(1))
04705 V(IEP(1),5)=P(IEP(1),5)**2
04706 GOTO 430
04707 ENDIF
04708
04709
04710 IF(MCE.EQ.2) THEN
04711 Z=1.-(1.-ZCE)*(ZCE/(1.-ZCE))**RLU(0)
04712 IF(1.+Z**2.LT.2.*RLU(0)) GOTO 390
04713 K(IEP(1),5)=22
04714
04715
04716 ELSEIF(MSTJ(49).NE.1.AND.KFL(1).NE.21) THEN
04717 Z=1.-(1.-ZC)*(ZC/(1.-ZC))**RLU(0)
04718 IF(1.+Z**2.LT.2.*RLU(0)) GOTO 390
04719 K(IEP(1),5)=21
04720 ELSEIF(MSTJ(49).EQ.0.AND.MSTJ(45)*(0.5-ZC).LT.RLU(0)*FBR) THEN
04721 Z=(1.-ZC)*(ZC/(1.-ZC))**RLU(0)
04722 IF(RLU(0).GT.0.5) Z=1.-Z
04723 IF((1.-Z*(1.-Z))**2.LT.RLU(0)) GOTO 390
04724 K(IEP(1),5)=21
04725 ELSEIF(MSTJ(49).NE.1) THEN
04726 Z=ZC+(1.-2.*ZC)*RLU(0)
04727 IF(Z**2+(1.-Z)**2.LT.RLU(0)) GOTO 390
04728 KFLB=1+INT(MSTJ(45)*RLU(0))
04729 PMQ=4.*PMTH(2,KFLB)**2/V(IEP(1),5)
04730 IF(PMQ.GE.1.) GOTO 390
04731 PMQ0=4.*PMTH(2,21)**2/V(IEP(1),5)
04732 IF(MOD(MSTJ(43),2).EQ.0.AND.(1.+0.5*PMQ)*SQRT(1.-PMQ).LT.
04733 & RLU(0)*(1.+0.5*PMQ0)*SQRT(1.-PMQ0)) GOTO 390
04734 K(IEP(1),5)=KFLB
04735
04736
04737 ELSEIF(KFL(1).NE.21) THEN
04738 Z=1.-SQRT(ZC**2+RLU(0)*(1.-2.*ZC))
04739 K(IEP(1),5)=21
04740 ELSEIF(RLU(0)*(PARJ(87)+MSTJ(45)*PARJ(88)).LE.PARJ(87)) THEN
04741 Z=ZC+(1.-2.*ZC)*RLU(0)
04742 K(IEP(1),5)=21
04743 ELSE
04744 Z=ZC+(1.-2.*ZC)*RLU(0)
04745 KFLB=1+INT(MSTJ(45)*RLU(0))
04746 PMQ=4.*PMTH(2,KFLB)**2/V(IEP(1),5)
04747 IF(PMQ.GE.1.) GOTO 390
04748 K(IEP(1),5)=KFLB
04749 ENDIF
04750 IF(MCE.EQ.1.AND.MSTJ(44).GE.2) THEN
04751 IF(Z*(1.-Z)*V(IEP(1),5).LT.PT2MIN) GOTO 390
04752 IF(ALFM/LOG(V(IEP(1),5)*Z*(1.-Z)/ALAMS).LT.RLU(0)) GOTO 390
04753 ENDIF
04754
04755
04756 IF(KFL(1).EQ.21) THEN
04757 KFLGD1=IABS(K(IEP(1),5))
04758 KFLGD2=KFLGD1
04759 ELSE
04760 KFLGD1=KFL(1)
04761 KFLGD2=IABS(K(IEP(1),5))
04762 ENDIF
04763 IF(NEP.EQ.1) THEN
04764 PED=PS(4)
04765 ELSEIF(NEP.GE.3) THEN
04766 PED=P(IEP(1),4)
04767 ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN
04768 PED=0.5*(V(IM,5)+V(IEP(1),5)-PM2**2)/P(IM,5)
04769 ELSE
04770 IF(IEP(1).EQ.N+1) PED=V(IM,1)*PEM
04771 IF(IEP(1).EQ.N+2) PED=(1.-V(IM,1))*PEM
04772 ENDIF
04773 IF(MOD(MSTJ(43),2).EQ.1) THEN
04774 PMQTH3=0.5*PARJ(82)
04775 IF(KFLGD2.EQ.22) PMQTH3=0.5*PARJ(83)
04776 PMQ1=(PMTH(1,KFLGD1)**2+PMQTH3**2)/V(IEP(1),5)
04777 PMQ2=(PMTH(1,KFLGD2)**2+PMQTH3**2)/V(IEP(1),5)
04778 ZD=SQRT(MAX(0.,(1.-V(IEP(1),5)/PED**2)*((1.-PMQ1-PMQ2)**2-
04779 & 4.*PMQ1*PMQ2)))
04780 ZH=1.+PMQ1-PMQ2
04781 ELSE
04782 ZD=SQRT(MAX(0.,1.-V(IEP(1),5)/PED**2))
04783 ZH=1.
04784 ENDIF
04785 ZL=0.5*(ZH-ZD)
04786 ZU=0.5*(ZH+ZD)
04787 IF(Z.LT.ZL.OR.Z.GT.ZU) GOTO 390
04788 IF(KFL(1).EQ.21) V(IEP(1),3)=LOG(ZU*(1.-ZL)/MAX(1E-20,ZL*
04789 &(1.-ZU)))
04790 IF(KFL(1).NE.21) V(IEP(1),3)=LOG((1.-ZL)/MAX(1E-10,1.-ZU))
04791
04792
04793 IF(IGM.EQ.0.AND.M3JC.EQ.1) THEN
04794 X1=Z*(1.+V(IEP(1),5)/V(NS+1,5))
04795 X2=1.-V(IEP(1),5)/V(NS+1,5)
04796 X3=(1.-X1)+(1.-X2)
04797 IF(MCE.EQ.2) THEN
04798 KI1=K(IPA(INUM),2)
04799 KI2=K(IPA(3-INUM),2)
04800 QF1=KCHG(IABS(KI1),1)*ISIGN(1,KI1)/3.
04801 QF2=KCHG(IABS(KI2),1)*ISIGN(1,KI2)/3.
04802 WSHOW=QF1**2*(1.-X1)/X3*(1.+(X1/(2.-X2))**2)+
04803 & QF2**2*(1.-X2)/X3*(1.+(X2/(2.-X1))**2)
04804 WME=(QF1*(1.-X1)/X3-QF2*(1.-X2)/X3)**2*(X1**2+X2**2)
04805 ELSEIF(MSTJ(49).NE.1) THEN
04806 WSHOW=1.+(1.-X1)/X3*(X1/(2.-X2))**2+
04807 & (1.-X2)/X3*(X2/(2.-X1))**2
04808 WME=X1**2+X2**2
04809 IF(M3JCM.EQ.1) WME=WME-QME*X3-0.5*QME**2-
04810 & (0.5*QME+0.25*QME**2)*((1.-X2)/(1.-X1)+(1.-X1)/(1.-X2))
04811 ELSE
04812 WSHOW=4.*X3*((1.-X1)/(2.-X2)**2+(1.-X2)/(2.-X1)**2)
04813 WME=X3**2
04814 IF(MSTJ(102).GE.2) WME=X3**2-2.*(1.+X3)*(1.-X1)*(1.-X2)*
04815 & PARJ(171)
04816 ENDIF
04817 IF(WME.LT.RLU(0)*WSHOW) GOTO 390
04818
04819
04820 ELSEIF(MCE.EQ.1.AND.IGM.GT.0.AND.MSTJ(42).GE.2) THEN
04821 MAOM=1
04822 ZM=V(IM,1)
04823 IF(IEP(1).EQ.N+2) ZM=1.-V(IM,1)
04824 THE2ID=Z*(1.-Z)*(ZM*P(IM,4))**2/V(IEP(1),5)
04825 IAOM=IM
04826 420 IF(K(IAOM,5).EQ.22) THEN
04827 IAOM=K(IAOM,3)
04828 IF(K(IAOM,3).LE.NS) MAOM=0
04829 IF(MAOM.EQ.1) GOTO 420
04830 ENDIF
04831 IF(MAOM.EQ.1) THEN
04832 THE2IM=V(IAOM,1)*(1.-V(IAOM,1))*P(IAOM,4)**2/V(IAOM,5)
04833 IF(THE2ID.LT.THE2IM) GOTO 390
04834 ENDIF
04835 ENDIF
04836
04837
04838 IF(MSTJ(48).EQ.1) THEN
04839 IF(NEP.EQ.1.AND.IM.EQ.NS) THEN
04840 THE2ID=Z*(1.-Z)*PS(4)**2/V(IEP(1),5)
04841 IF(THE2ID.LT.1./PARJ(85)**2) GOTO 390
04842 ELSEIF(NEP.EQ.2.AND.IEP(1).EQ.NS+2) THEN
04843 THE2ID=Z*(1.-Z)*(0.5*P(IM,4))**2/V(IEP(1),5)
04844 IF(THE2ID.LT.1./PARJ(85)**2) GOTO 390
04845 ELSEIF(NEP.EQ.2.AND.IEP(1).EQ.NS+3) THEN
04846 THE2ID=Z*(1.-Z)*(0.5*P(IM,4))**2/V(IEP(1),5)
04847 IF(THE2ID.LT.1./PARJ(86)**2) GOTO 390
04848 ENDIF
04849 ENDIF
04850
04851
04852
04853 IF(MIIS.GE.2.AND.IEP(1).LE.NS+3) THEN
04854 THE2D=MAX((1.-Z)/Z,Z/(1.-Z))*V(IEP(1),5)/(0.5*P(IM,4))**2
04855 IF(IEP(1).EQ.NS+2.AND.ISII(1).GE.1) THEN
04856 IF(THE2D.GT.THEIIS(1,ISII(1))**2) GOTO 390
04857 ELSEIF(IEP(1).EQ.NS+3.AND.ISII(2).GE.1) THEN
04858 IF(THE2D.GT.THEIIS(2,ISII(2))**2) GOTO 390
04859 ENDIF
04860 ENDIF
04861
04862
04863 430 V(IEP(1),1)=Z
04864 ISL(1)=0
04865 ISL(2)=0
04866 IF(NEP.EQ.1) GOTO 460
04867 IF(NEP.EQ.2.AND.P(IEP(1),5)+P(IEP(2),5).GE.P(IM,5)) GOTO 330
04868 DO 440 I=1,NEP
04869 IF(ITRY(I).EQ.0.AND.KFLD(I).LE.40) THEN
04870 IF(KSH(KFLD(I)).EQ.1) THEN
04871 IF(P(N+I,5).GE.PMTH(2,KFLD(I))) GOTO 330
04872 ENDIF
04873 ENDIF
04874 440 CONTINUE
04875
04876
04877 IF(NEP.EQ.3) THEN
04878 PA1S=(P(N+1,4)+P(N+1,5))*(P(N+1,4)-P(N+1,5))
04879 PA2S=(P(N+2,4)+P(N+2,5))*(P(N+2,4)-P(N+2,5))
04880 PA3S=(P(N+3,4)+P(N+3,5))*(P(N+3,4)-P(N+3,5))
04881 PTS=0.25*(2.*PA1S*PA2S+2.*PA1S*PA3S+2.*PA2S*PA3S-
04882 & PA1S**2-PA2S**2-PA3S**2)/PA1S
04883 IF(PTS.LE.0.) GOTO 330
04884 ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2.OR.MOD(MSTJ(43),2).EQ.0) THEN
04885 DO 450 I1=N+1,N+2
04886 KFLDA=IABS(K(I1,2))
04887 IF(KFLDA.GT.40) GOTO 450
04888 IF(KSH(KFLDA).EQ.0) GOTO 450
04889 IF(P(I1,5).LT.PMTH(2,KFLDA)) GOTO 450
04890 IF(KFLDA.EQ.21) THEN
04891 KFLGD1=IABS(K(I1,5))
04892 KFLGD2=KFLGD1
04893 ELSE
04894 KFLGD1=KFLDA
04895 KFLGD2=IABS(K(I1,5))
04896 ENDIF
04897 I2=2*N+3-I1
04898 IF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN
04899 PED=0.5*(V(IM,5)+V(I1,5)-V(I2,5))/P(IM,5)
04900 ELSE
04901 IF(I1.EQ.N+1) ZM=V(IM,1)
04902 IF(I1.EQ.N+2) ZM=1.-V(IM,1)
04903 PML=SQRT((V(IM,5)-V(N+1,5)-V(N+2,5))**2-
04904 & 4.*V(N+1,5)*V(N+2,5))
04905 PED=PEM*(0.5*(V(IM,5)-PML+V(I1,5)-V(I2,5))+PML*ZM)/V(IM,5)
04906 ENDIF
04907 IF(MOD(MSTJ(43),2).EQ.1) THEN
04908 PMQTH3=0.5*PARJ(82)
04909 IF(KFLGD2.EQ.22) PMQTH3=0.5*PARJ(83)
04910 PMQ1=(PMTH(1,KFLGD1)**2+PMQTH3**2)/V(I1,5)
04911 PMQ2=(PMTH(1,KFLGD2)**2+PMQTH3**2)/V(I1,5)
04912 ZD=SQRT(MAX(0.,(1.-V(I1,5)/PED**2)*((1.-PMQ1-PMQ2)**2-
04913 & 4.*PMQ1*PMQ2)))
04914 ZH=1.+PMQ1-PMQ2
04915 ELSE
04916 ZD=SQRT(MAX(0.,1.-V(I1,5)/PED**2))
04917 ZH=1.
04918 ENDIF
04919 ZL=0.5*(ZH-ZD)
04920 ZU=0.5*(ZH+ZD)
04921 IF(I1.EQ.N+1.AND.(V(I1,1).LT.ZL.OR.V(I1,1).GT.ZU)) ISL(1)=1
04922 IF(I1.EQ.N+2.AND.(V(I1,1).LT.ZL.OR.V(I1,1).GT.ZU)) ISL(2)=1
04923 IF(KFLDA.EQ.21) V(I1,4)=LOG(ZU*(1.-ZL)/MAX(1E-20,ZL*(1.-ZU)))
04924 IF(KFLDA.NE.21) V(I1,4)=LOG((1.-ZL)/MAX(1E-10,1.-ZU))
04925 450 CONTINUE
04926 IF(ISL(1).EQ.1.AND.ISL(2).EQ.1.AND.ISLM.NE.0) THEN
04927 ISL(3-ISLM)=0
04928 ISLM=3-ISLM
04929 ELSEIF(ISL(1).EQ.1.AND.ISL(2).EQ.1) THEN
04930 ZDR1=MAX(0.,V(N+1,3)/MAX(1E-6,V(N+1,4))-1.)
04931 ZDR2=MAX(0.,V(N+2,3)/MAX(1E-6,V(N+2,4))-1.)
04932 IF(ZDR2.GT.RLU(0)*(ZDR1+ZDR2)) ISL(1)=0
04933 IF(ISL(1).EQ.1) ISL(2)=0
04934 IF(ISL(1).EQ.0) ISLM=1
04935 IF(ISL(2).EQ.0) ISLM=2
04936 ENDIF
04937 IF(ISL(1).EQ.1.OR.ISL(2).EQ.1) GOTO 330
04938 ENDIF
04939 IF(IGM.GT.0.AND.MOD(MSTJ(43),2).EQ.1.AND.(P(N+1,5).GE.
04940 &PMTH(2,KFLD(1)).OR.P(N+2,5).GE.PMTH(2,KFLD(2)))) THEN
04941 PMQ1=V(N+1,5)/V(IM,5)
04942 PMQ2=V(N+2,5)/V(IM,5)
04943 ZD=SQRT(MAX(0.,(1.-V(IM,5)/PEM**2)*((1.-PMQ1-PMQ2)**2-
04944 & 4.*PMQ1*PMQ2)))
04945 ZH=1.+PMQ1-PMQ2
04946 ZL=0.5*(ZH-ZD)
04947 ZU=0.5*(ZH+ZD)
04948 IF(V(IM,1).LT.ZL.OR.V(IM,1).GT.ZU) GOTO 330
04949 ENDIF
04950
04951
04952 460 MAZIP=0
04953 MAZIC=0
04954 IF(NEP.EQ.1) THEN
04955 P(N+1,1)=0.
04956 P(N+1,2)=0.
04957 P(N+1,3)=SQRT(MAX(0.,(P(IPA(1),4)+P(N+1,5))*(P(IPA(1),4)-
04958 & P(N+1,5))))
04959 P(N+1,4)=P(IPA(1),4)
04960 V(N+1,2)=P(N+1,4)
04961 ELSEIF(IGM.EQ.0.AND.NEP.EQ.2) THEN
04962 PED1=0.5*(V(IM,5)+V(N+1,5)-V(N+2,5))/P(IM,5)
04963 P(N+1,1)=0.
04964 P(N+1,2)=0.
04965 P(N+1,3)=SQRT(MAX(0.,(PED1+P(N+1,5))*(PED1-P(N+1,5))))
04966 P(N+1,4)=PED1
04967 P(N+2,1)=0.
04968 P(N+2,2)=0.
04969 P(N+2,3)=-P(N+1,3)
04970 P(N+2,4)=P(IM,5)-PED1
04971 V(N+1,2)=P(N+1,4)
04972 V(N+2,2)=P(N+2,4)
04973 ELSEIF(NEP.EQ.3) THEN
04974 P(N+1,1)=0.
04975 P(N+1,2)=0.
04976 P(N+1,3)=SQRT(MAX(0.,PA1S))
04977 P(N+2,1)=SQRT(PTS)
04978 P(N+2,2)=0.
04979 P(N+2,3)=0.5*(PA3S-PA2S-PA1S)/P(N+1,3)
04980 P(N+3,1)=-P(N+2,1)
04981 P(N+3,2)=0.
04982 P(N+3,3)=-(P(N+1,3)+P(N+2,3))
04983 V(N+1,2)=P(N+1,4)
04984 V(N+2,2)=P(N+2,4)
04985 V(N+3,2)=P(N+3,4)
04986
04987
04988 ELSE
04989 ZM=V(IM,1)
04990 PZM=SQRT(MAX(0.,(PEM+P(IM,5))*(PEM-P(IM,5))))
04991 PMLS=(V(IM,5)-V(N+1,5)-V(N+2,5))**2-4.*V(N+1,5)*V(N+2,5)
04992 IF(PZM.LE.0.) THEN
04993 PTS=0.
04994 ELSEIF(MOD(MSTJ(43),2).EQ.1) THEN
04995 PTS=(PEM**2*(ZM*(1.-ZM)*V(IM,5)-(1.-ZM)*V(N+1,5)-
04996 & ZM*V(N+2,5))-0.25*PMLS)/PZM**2
04997 ELSE
04998 PTS=PMLS*(ZM*(1.-ZM)*PEM**2/V(IM,5)-0.25)/PZM**2
04999 ENDIF
05000 PT=SQRT(MAX(0.,PTS))
05001
05002
05003 HAZIP=0.
05004 IF(MSTJ(49).NE.1.AND.MOD(MSTJ(46),2).EQ.1.AND.K(IM,2).EQ.21.
05005 & AND.IAU.NE.0) THEN
05006 IF(K(IGM,3).NE.0) MAZIP=1
05007 ZAU=V(IGM,1)
05008 IF(IAU.EQ.IM+1) ZAU=1.-V(IGM,1)
05009 IF(MAZIP.EQ.0) ZAU=0.
05010 IF(K(IGM,2).NE.21) THEN
05011 HAZIP=2.*ZAU/(1.+ZAU**2)
05012 ELSE
05013 HAZIP=(ZAU/(1.-ZAU*(1.-ZAU)))**2
05014 ENDIF
05015 IF(K(N+1,2).NE.21) THEN
05016 HAZIP=HAZIP*(-2.*ZM*(1.-ZM))/(1.-2.*ZM*(1.-ZM))
05017 ELSE
05018 HAZIP=HAZIP*(ZM*(1.-ZM)/(1.-ZM*(1.-ZM)))**2
05019 ENDIF
05020 ENDIF
05021
05022
05023
05024 HAZIC=0.
05025 IF(MSTJ(49).NE.2.AND.MSTJ(46).GE.2.AND.(K(N+1,2).EQ.21.OR.
05026 & K(N+2,2).EQ.21).AND.IAU.NE.0) THEN
05027 IF(K(IGM,3).NE.0) MAZIC=N+1
05028 IF(K(IGM,3).NE.0.AND.K(N+1,2).NE.21) MAZIC=N+2
05029 IF(K(IGM,3).NE.0.AND.K(N+1,2).EQ.21.AND.K(N+2,2).EQ.21.AND.
05030 & ZM.GT.0.5) MAZIC=N+2
05031 IF(K(IAU,2).EQ.22) MAZIC=0
05032 ZS=ZM
05033 IF(MAZIC.EQ.N+2) ZS=1.-ZM
05034 ZGM=V(IGM,1)
05035 IF(IAU.EQ.IM-1) ZGM=1.-V(IGM,1)
05036 IF(MAZIC.EQ.0) ZGM=1.
05037 HAZIC=(P(IM,5)/P(IGM,5))*SQRT((1.-ZS)*(1.-ZGM)/(ZS*ZGM))
05038 HAZIC=MIN(0.95,HAZIC)
05039 ENDIF
05040 ENDIF
05041
05042
05043 470 IF(NEP.EQ.2.AND.IGM.GT.0) THEN
05044 IF(MOD(MSTJ(43),2).EQ.1) THEN
05045 P(N+1,4)=PEM*V(IM,1)
05046 ELSE
05047 P(N+1,4)=PEM*(0.5*(V(IM,5)-SQRT(PMLS)+V(N+1,5)-V(N+2,5))+
05048 & SQRT(PMLS)*ZM)/V(IM,5)
05049 ENDIF
05050 PHI=PARU(2)*RLU(0)
05051 P(N+1,1)=PT*COS(PHI)
05052 P(N+1,2)=PT*SIN(PHI)
05053 IF(PZM.GT.0.) THEN
05054 P(N+1,3)=0.5*(V(N+2,5)-V(N+1,5)-V(IM,5)+2.*PEM*P(N+1,4))/PZM
05055 ELSE
05056 P(N+1,3)=0.
05057 ENDIF
05058 P(N+2,1)=-P(N+1,1)
05059 P(N+2,2)=-P(N+1,2)
05060 P(N+2,3)=PZM-P(N+1,3)
05061 P(N+2,4)=PEM-P(N+1,4)
05062 IF(MSTJ(43).LE.2) THEN
05063 V(N+1,2)=(PEM*P(N+1,4)-PZM*P(N+1,3))/P(IM,5)
05064 V(N+2,2)=(PEM*P(N+2,4)-PZM*P(N+2,3))/P(IM,5)
05065 ENDIF
05066 ENDIF
05067
05068
05069 IF(IGM.GT.0) THEN
05070 IF(MSTJ(43).LE.2) THEN
05071 BEX=P(IGM,1)/P(IGM,4)
05072 BEY=P(IGM,2)/P(IGM,4)
05073 BEZ=P(IGM,3)/P(IGM,4)
05074 GA=P(IGM,4)/P(IGM,5)
05075 GABEP=GA*(GA*(BEX*P(IM,1)+BEY*P(IM,2)+BEZ*P(IM,3))/(1.+GA)-
05076 & P(IM,4))
05077 ELSE
05078 BEX=0.
05079 BEY=0.
05080 BEZ=0.
05081 GA=1.
05082 GABEP=0.
05083 ENDIF
05084 THE=ULANGL(P(IM,3)+GABEP*BEZ,SQRT((P(IM,1)+GABEP*BEX)**2+
05085 & (P(IM,2)+GABEP*BEY)**2))
05086 PHI=ULANGL(P(IM,1)+GABEP*BEX,P(IM,2)+GABEP*BEY)
05087 DO 480 I=N+1,N+2
05088 DP(1)=COS(THE)*COS(PHI)*P(I,1)-SIN(PHI)*P(I,2)+
05089 & SIN(THE)*COS(PHI)*P(I,3)
05090 DP(2)=COS(THE)*SIN(PHI)*P(I,1)+COS(PHI)*P(I,2)+
05091 & SIN(THE)*SIN(PHI)*P(I,3)
05092 DP(3)=-SIN(THE)*P(I,1)+COS(THE)*P(I,3)
05093 DP(4)=P(I,4)
05094 DBP=BEX*DP(1)+BEY*DP(2)+BEZ*DP(3)
05095 DGABP=GA*(GA*DBP/(1D0+GA)+DP(4))
05096 P(I,1)=DP(1)+DGABP*BEX
05097 P(I,2)=DP(2)+DGABP*BEY
05098 P(I,3)=DP(3)+DGABP*BEZ
05099 P(I,4)=GA*(DP(4)+DBP)
05100 480 CONTINUE
05101 ENDIF
05102
05103
05104 IF(MAZIP.NE.0.OR.MAZIC.NE.0) THEN
05105 DO 490 J=1,3
05106 DPT(1,J)=P(IM,J)
05107 DPT(2,J)=P(IAU,J)
05108 DPT(3,J)=P(N+1,J)
05109 490 CONTINUE
05110 DPMA=DPT(1,1)*DPT(2,1)+DPT(1,2)*DPT(2,2)+DPT(1,3)*DPT(2,3)
05111 DPMD=DPT(1,1)*DPT(3,1)+DPT(1,2)*DPT(3,2)+DPT(1,3)*DPT(3,3)
05112 DPMM=DPT(1,1)**2+DPT(1,2)**2+DPT(1,3)**2
05113 DO 500 J=1,3
05114 DPT(4,J)=DPT(2,J)-DPMA*DPT(1,J)/DPMM
05115 DPT(5,J)=DPT(3,J)-DPMD*DPT(1,J)/DPMM
05116 500 CONTINUE
05117 DPT(4,4)=SQRT(DPT(4,1)**2+DPT(4,2)**2+DPT(4,3)**2)
05118 DPT(5,4)=SQRT(DPT(5,1)**2+DPT(5,2)**2+DPT(5,3)**2)
05119 IF(MIN(DPT(4,4),DPT(5,4)).GT.0.1*PARJ(82)) THEN
05120 CAD=(DPT(4,1)*DPT(5,1)+DPT(4,2)*DPT(5,2)+
05121 & DPT(4,3)*DPT(5,3))/(DPT(4,4)*DPT(5,4))
05122 IF(MAZIP.NE.0) THEN
05123 IF(1.+HAZIP*(2.*CAD**2-1.).LT.RLU(0)*(1.+ABS(HAZIP)))
05124 & GOTO 470
05125 ENDIF
05126 IF(MAZIC.NE.0) THEN
05127 IF(MAZIC.EQ.N+2) CAD=-CAD
05128 IF((1.-HAZIC)*(1.-HAZIC*CAD)/(1.+HAZIC**2-2.*HAZIC*CAD).
05129 & LT.RLU(0)) GOTO 470
05130 ENDIF
05131 ENDIF
05132 ENDIF
05133
05134
05135 IF(MOD(MIIS,2).EQ.1.AND.IGM.EQ.NS+1.AND.(K(N+1,2).EQ.21.OR.
05136 &K(N+2,2).EQ.21)) THEN
05137 III=IM-NS-1
05138 IF(ISII(III).GE.1) THEN
05139 IAZIID=N+1
05140 IF(K(N+1,2).NE.21) IAZIID=N+2
05141 IF(K(N+1,2).EQ.21.AND.K(N+2,2).EQ.21.AND.
05142 & P(N+1,4).GT.P(N+2,4)) IAZIID=N+2
05143 THEIID=ULANGL(P(IAZIID,3),SQRT(P(IAZIID,1)**2+P(IAZIID,2)**2))
05144 IF(III.EQ.2) THEIID=PARU(1)-THEIID
05145 PHIIID=ULANGL(P(IAZIID,1),P(IAZIID,2))
05146 HAZII=MIN(0.95,THEIID/THEIIS(III,ISII(III)))
05147 CAD=COS(PHIIID-PHIIIS(III,ISII(III)))
05148 PHIREL=ABS(PHIIID-PHIIIS(III,ISII(III)))
05149 IF(PHIREL.GT.PARU(1)) PHIREL=PARU(2)-PHIREL
05150 IF((1.-HAZII)*(1.-HAZII*CAD)/(1.+HAZII**2-2.*HAZII*CAD).
05151 & LT.RLU(0)) GOTO 470
05152 ENDIF
05153 ENDIF
05154
05155
05156 IF(IGM.GE.0) K(IM,1)=14
05157 N=N+NEP
05158 NEP=2
05159 IF(N.GT.MSTU(4)-MSTU(32)-5) THEN
05160 CALL LUERRM(11,'(LUSHOW:) no more memory left in LUJETS')
05161 IF(MSTU(21).GE.1) N=NS
05162 IF(MSTU(21).GE.1) RETURN
05163 ENDIF
05164 GOTO 270
05165
05166
05167 510 IF(NPA.GE.2) THEN
05168 K(NS+1,1)=11
05169 K(NS+1,2)=94
05170 K(NS+1,3)=IP1
05171 IF(IP2.GT.0.AND.IP2.LT.IP1) K(NS+1,3)=IP2
05172 K(NS+1,4)=NS+2
05173 K(NS+1,5)=NS+1+NPA
05174 IIM=1
05175 ELSE
05176 IIM=0
05177 ENDIF
05178
05179
05180 DO 520 I=NS+1+IIM,N
05181 IF(K(I,1).LE.10.AND.K(I,2).EQ.22) THEN
05182 K(I,1)=1
05183 ELSEIF(K(I,1).LE.10.AND.IABS(K(I,2)).GE.11.AND.
05184 &IABS(K(I,2)).LE.18) THEN
05185 K(I,1)=1
05186 ELSEIF(K(I,1).LE.10) THEN
05187 K(I,4)=MSTU(5)*(K(I,4)/MSTU(5))
05188 K(I,5)=MSTU(5)*(K(I,5)/MSTU(5))
05189 ELSEIF(K(MOD(K(I,4),MSTU(5))+1,2).NE.22) THEN
05190 ID1=MOD(K(I,4),MSTU(5))
05191 IF(K(I,2).GE.1.AND.K(I,2).LE.8) ID1=MOD(K(I,4),MSTU(5))+1
05192 ID2=2*MOD(K(I,4),MSTU(5))+1-ID1
05193 K(I,4)=MSTU(5)*(K(I,4)/MSTU(5))+ID1
05194 K(I,5)=MSTU(5)*(K(I,5)/MSTU(5))+ID2
05195 K(ID1,4)=K(ID1,4)+MSTU(5)*I
05196 K(ID1,5)=K(ID1,5)+MSTU(5)*ID2
05197 K(ID2,4)=K(ID2,4)+MSTU(5)*ID1
05198 K(ID2,5)=K(ID2,5)+MSTU(5)*I
05199 ELSE
05200 ID1=MOD(K(I,4),MSTU(5))
05201 ID2=ID1+1
05202 K(I,4)=MSTU(5)*(K(I,4)/MSTU(5))+ID1
05203 K(I,5)=MSTU(5)*(K(I,5)/MSTU(5))+ID1
05204 IF(IABS(K(I,2)).LE.10.OR.K(ID1,1).GE.11) THEN
05205 K(ID1,4)=K(ID1,4)+MSTU(5)*I
05206 K(ID1,5)=K(ID1,5)+MSTU(5)*I
05207 ELSE
05208 K(ID1,4)=0
05209 K(ID1,5)=0
05210 ENDIF
05211 K(ID2,4)=0
05212 K(ID2,5)=0
05213 ENDIF
05214 520 CONTINUE
05215
05216
05217 IF(NPA.GE.2) THEN
05218 BEX=PS(1)/PS(4)
05219 BEY=PS(2)/PS(4)
05220 BEZ=PS(3)/PS(4)
05221 GA=PS(4)/PS(5)
05222 GABEP=GA*(GA*(BEX*P(IPA(1),1)+BEY*P(IPA(1),2)+BEZ*P(IPA(1),3))
05223 & /(1.+GA)-P(IPA(1),4))
05224 ELSE
05225 BEX=0.
05226 BEY=0.
05227 BEZ=0.
05228 GABEP=0.
05229 ENDIF
05230 THE=ULANGL(P(IPA(1),3)+GABEP*BEZ,SQRT((P(IPA(1),1)
05231 &+GABEP*BEX)**2+(P(IPA(1),2)+GABEP*BEY)**2))
05232 PHI=ULANGL(P(IPA(1),1)+GABEP*BEX,P(IPA(1),2)+GABEP*BEY)
05233 IF(NPA.EQ.3) THEN
05234 CHI=ULANGL(COS(THE)*COS(PHI)*(P(IPA(2),1)+GABEP*BEX)+COS(THE)*
05235 & SIN(PHI)*(P(IPA(2),2)+GABEP*BEY)-SIN(THE)*(P(IPA(2),3)+GABEP*
05236 & BEZ),-SIN(PHI)*(P(IPA(2),1)+GABEP*BEX)+COS(PHI)*(P(IPA(2),2)+
05237 & GABEP*BEY))
05238 MSTU(33)=1
05239 CALL LUDBRB(NS+1,N,0.,CHI,0D0,0D0,0D0)
05240 ENDIF
05241 DBEX=DBLE(BEX)
05242 DBEY=DBLE(BEY)
05243 DBEZ=DBLE(BEZ)
05244 MSTU(33)=1
05245 CALL LUDBRB(NS+1,N,THE,PHI,DBEX,DBEY,DBEZ)
05246
05247
05248 DO 540 I=NS+1,N
05249 DO 530 J=1,5
05250 V(I,J)=V(IP1,J)
05251 530 CONTINUE
05252 540 CONTINUE
05253
05254
05255 IF(N.EQ.NS+NPA+IIM) THEN
05256 N=NS
05257 ELSE
05258 DO 550 IP=1,NPA
05259 K(IPA(IP),1)=14
05260 K(IPA(IP),4)=K(IPA(IP),4)+NS+IIM+IP
05261 K(IPA(IP),5)=K(IPA(IP),5)+NS+IIM+IP
05262 K(NS+IIM+IP,3)=IPA(IP)
05263 IF(IIM.EQ.1.AND.MSTU(16).NE.2) K(NS+IIM+IP,3)=NS+1
05264 IF(K(NS+IIM+IP,1).NE.1) THEN
05265 K(NS+IIM+IP,4)=MSTU(5)*IPA(IP)+K(NS+IIM+IP,4)
05266 K(NS+IIM+IP,5)=MSTU(5)*IPA(IP)+K(NS+IIM+IP,5)
05267 ENDIF
05268 550 CONTINUE
05269 ENDIF
05270
05271 RETURN
05272 END
05273
05274
05275
05276 SUBROUTINE LUBOEI(NSAV)
05277
05278
05279
05280
05281 IMPLICIT DOUBLE PRECISION(D)
05282 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
05283 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
05284 SAVE /LUJETS/,/LUDAT1/
05285 DIMENSION DPS(4),KFBE(9),NBE(0:9),BEI(100)
05286 DATA KFBE/211,-211,111,321,-321,130,310,221,331/
05287
05288
05289 IF((MSTJ(51).NE.1.AND.MSTJ(51).NE.2).OR.N-NSAV.LE.1) RETURN
05290 DO 100 J=1,4
05291 DPS(J)=0.
05292 100 CONTINUE
05293 DO 120 I=1,N
05294 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 120
05295 DO 110 J=1,4
05296 DPS(J)=DPS(J)+P(I,J)
05297 110 CONTINUE
05298 120 CONTINUE
05299 CALL LUDBRB(0,0,0.,0.,-DPS(1)/DPS(4),-DPS(2)/DPS(4),
05300 &-DPS(3)/DPS(4))
05301 PECM=0.
05302 DO 130 I=1,N
05303 IF(K(I,1).GE.1.AND.K(I,1).LE.10) PECM=PECM+P(I,4)
05304 130 CONTINUE
05305
05306
05307 NBE(0)=N+MSTU(3)
05308 DO 160 IBE=1,MIN(9,MSTJ(52))
05309 NBE(IBE)=NBE(IBE-1)
05310 DO 150 I=NSAV+1,N
05311 IF(K(I,2).NE.KFBE(IBE)) GOTO 150
05312 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 150
05313 IF(NBE(IBE).GE.MSTU(4)-MSTU(32)-5) THEN
05314 CALL LUERRM(11,'(LUBOEI:) no more memory left in LUJETS')
05315 RETURN
05316 ENDIF
05317 NBE(IBE)=NBE(IBE)+1
05318 K(NBE(IBE),1)=I
05319 DO 140 J=1,3
05320 P(NBE(IBE),J)=0.
05321 140 CONTINUE
05322 150 CONTINUE
05323 160 CONTINUE
05324
05325
05326 DO 220 IBE=1,MIN(9,MSTJ(52))
05327 IF(IBE.NE.1.AND.IBE.NE.4.AND.IBE.LE.7) GOTO 180
05328 IF(IBE.EQ.1.AND.MAX(NBE(1)-NBE(0),NBE(2)-NBE(1),NBE(3)-NBE(2)).
05329 &LE.1) GOTO 180
05330 IF(IBE.EQ.4.AND.MAX(NBE(4)-NBE(3),NBE(5)-NBE(4),NBE(6)-NBE(5),
05331 &NBE(7)-NBE(6)).LE.1) GOTO 180
05332 IF(IBE.GE.8.AND.NBE(IBE)-NBE(IBE-1).LE.1) GOTO 180
05333 IF(IBE.EQ.1) PMHQ=2.*ULMASS(211)
05334 IF(IBE.EQ.4) PMHQ=2.*ULMASS(321)
05335 IF(IBE.EQ.8) PMHQ=2.*ULMASS(221)
05336 IF(IBE.EQ.9) PMHQ=2.*ULMASS(331)
05337 QDEL=0.1*MIN(PMHQ,PARJ(93))
05338 IF(MSTJ(51).EQ.1) THEN
05339 NBIN=MIN(100,NINT(9.*PARJ(93)/QDEL))
05340 BEEX=EXP(0.5*QDEL/PARJ(93))
05341 BERT=EXP(-QDEL/PARJ(93))
05342 ELSE
05343 NBIN=MIN(100,NINT(3.*PARJ(93)/QDEL))
05344 ENDIF
05345 DO 170 IBIN=1,NBIN
05346 QBIN=QDEL*(IBIN-0.5)
05347 BEI(IBIN)=QDEL*(QBIN**2+QDEL**2/12.)/SQRT(QBIN**2+PMHQ**2)
05348 IF(MSTJ(51).EQ.1) THEN
05349 BEEX=BEEX*BERT
05350 BEI(IBIN)=BEI(IBIN)*BEEX
05351 ELSE
05352 BEI(IBIN)=BEI(IBIN)*EXP(-(QBIN/PARJ(93))**2)
05353 ENDIF
05354 IF(IBIN.GE.2) BEI(IBIN)=BEI(IBIN)+BEI(IBIN-1)
05355 170 CONTINUE
05356
05357
05358 180 DO 210 I1M=NBE(IBE-1)+1,NBE(IBE)-1
05359 I1=K(I1M,1)
05360 DO 200 I2M=I1M+1,NBE(IBE)
05361 I2=K(I2M,1)
05362 Q2OLD=MAX(0.,(P(I1,4)+P(I2,4))**2-(P(I1,1)+P(I2,1))**2-(P(I1,2)+
05363 &P(I2,2))**2-(P(I1,3)+P(I2,3))**2-(P(I1,5)+P(I2,5))**2)
05364 QOLD=SQRT(Q2OLD)
05365
05366
05367 IF(QOLD.LT.1E-3*QDEL) THEN
05368 GOTO 200
05369 ELSEIF(QOLD.LT.0.5*QDEL) THEN
05370 QMOV=QOLD/3.
05371 ELSEIF(QOLD.LT.(NBIN-0.1)*QDEL) THEN
05372 RBIN=QOLD/QDEL
05373 IBIN=RBIN
05374 RINP=(RBIN**3-IBIN**3)/(3*IBIN*(IBIN+1)+1)
05375 QMOV=(BEI(IBIN)+RINP*(BEI(IBIN+1)-BEI(IBIN)))*
05376 & SQRT(Q2OLD+PMHQ**2)/Q2OLD
05377 ELSE
05378 QMOV=BEI(NBIN)*SQRT(Q2OLD+PMHQ**2)/Q2OLD
05379 ENDIF
05380 Q2NEW=Q2OLD*(QOLD/(QOLD+3.*PARJ(92)*QMOV))**(2./3.)
05381
05382
05383 HC1=(P(I1,4)+P(I2,4))**2-(Q2OLD-Q2NEW)
05384 HC2=(Q2OLD-Q2NEW)*(P(I1,4)-P(I2,4))**2
05385 HA=0.5*(1.-SQRT(HC1*Q2NEW/(HC1*Q2OLD-HC2)))
05386 DO 190 J=1,3
05387 PD=HA*(P(I2,J)-P(I1,J))
05388 P(I1M,J)=P(I1M,J)+PD
05389 P(I2M,J)=P(I2M,J)-PD
05390 190 CONTINUE
05391 200 CONTINUE
05392 210 CONTINUE
05393 220 CONTINUE
05394
05395
05396 DO 240 IM=NBE(0)+1,NBE(MIN(9,MSTJ(52)))
05397 I=K(IM,1)
05398 DO 230 J=1,3
05399 P(I,J)=P(I,J)+P(IM,J)
05400 230 CONTINUE
05401 P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2)
05402 240 CONTINUE
05403
05404
05405 PES=0.
05406 PQS=0.
05407 DO 250 I=1,N
05408 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 250
05409 PES=PES+P(I,4)
05410 PQS=PQS+P(I,5)**2/P(I,4)
05411 250 CONTINUE
05412 FAC=(PECM-PQS)/(PES-PQS)
05413 DO 270 I=1,N
05414 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 270
05415 DO 260 J=1,3
05416 P(I,J)=FAC*P(I,J)
05417 260 CONTINUE
05418 P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2)
05419 270 CONTINUE
05420
05421
05422 CALL LUDBRB(0,0,0.,0.,DPS(1)/DPS(4),DPS(2)/DPS(4),DPS(3)/DPS(4))
05423
05424 RETURN
05425 END
05426
05427
05428
05429 FUNCTION ULMASS(KF)
05430
05431
05432 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
05433 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
05434 SAVE /LUDAT1/,/LUDAT2/
05435
05436
05437 ULMASS=0.
05438 KFA=IABS(KF)
05439 KC=LUCOMP(KF)
05440 IF(KC.EQ.0) RETURN
05441 PARF(106)=PMAS(6,1)
05442 PARF(107)=PMAS(7,1)
05443 PARF(108)=PMAS(8,1)
05444
05445
05446 IF((MSTJ(93).EQ.1.OR.MSTJ(93).EQ.2).AND.KFA.LE.10) THEN
05447 ULMASS=PARF(100+KFA)
05448 IF(MSTJ(93).EQ.2) ULMASS=MAX(0.,ULMASS-PARF(121))
05449
05450
05451 ELSEIF(KFA.LE.100.OR.KC.LE.80.OR.KC.GT.100) THEN
05452 ULMASS=PMAS(KC,1)
05453
05454
05455 ELSE
05456 KFLA=MOD(KFA/1000,10)
05457 KFLB=MOD(KFA/100,10)
05458 KFLC=MOD(KFA/10,10)
05459 KFLS=MOD(KFA,10)
05460 KFLR=MOD(KFA/10000,10)
05461 PMA=PARF(100+KFLA)
05462 PMB=PARF(100+KFLB)
05463 PMC=PARF(100+KFLC)
05464
05465
05466 IF(KFLA.EQ.0.AND.KFLR.EQ.0.AND.KFLS.LE.3) THEN
05467 IF(KFLS.EQ.1) PMSPL=-3./(PMB*PMC)
05468 IF(KFLS.GE.3) PMSPL=1./(PMB*PMC)
05469 ULMASS=PARF(111)+PMB+PMC+PARF(113)*PARF(101)**2*PMSPL
05470 ELSEIF(KFLA.EQ.0) THEN
05471 KMUL=2
05472 IF(KFLS.EQ.1) KMUL=3
05473 IF(KFLR.EQ.2) KMUL=4
05474 IF(KFLS.EQ.5) KMUL=5
05475 ULMASS=PARF(113+KMUL)+PMB+PMC
05476 ELSEIF(KFLC.EQ.0) THEN
05477 IF(KFLS.EQ.1) PMSPL=-3./(PMA*PMB)
05478 IF(KFLS.EQ.3) PMSPL=1./(PMA*PMB)
05479 ULMASS=2.*PARF(112)/3.+PMA+PMB+PARF(114)*PARF(101)**2*PMSPL
05480 IF(MSTJ(93).EQ.1) ULMASS=PMA+PMB
05481 IF(MSTJ(93).EQ.2) ULMASS=MAX(0.,ULMASS-PARF(122)-
05482 & 2.*PARF(112)/3.)
05483 ELSE
05484 IF(KFLS.EQ.2.AND.KFLA.EQ.KFLB) THEN
05485 PMSPL=1./(PMA*PMB)-2./(PMA*PMC)-2./(PMB*PMC)
05486 ELSEIF(KFLS.EQ.2.AND.KFLB.GE.KFLC) THEN
05487 PMSPL=-2./(PMA*PMB)-2./(PMA*PMC)+1./(PMB*PMC)
05488 ELSEIF(KFLS.EQ.2) THEN
05489 PMSPL=-3./(PMB*PMC)
05490 ELSE
05491 PMSPL=1./(PMA*PMB)+1./(PMA*PMC)+1./(PMB*PMC)
05492 ENDIF
05493 ULMASS=PARF(112)+PMA+PMB+PMC+PARF(114)*PARF(101)**2*PMSPL
05494 ENDIF
05495 ENDIF
05496
05497
05498
05499 IF(MSTJ(24).GE.1.AND.PMAS(KC,2).GT.1E-4) THEN
05500 IF(MSTJ(24).EQ.1.OR.(MSTJ(24).EQ.2.AND.KFA.GT.100)) THEN
05501 ULMASS=ULMASS+0.5*PMAS(KC,2)*TAN((2.*RLU(0)-1.)*
05502 & ATAN(2.*PMAS(KC,3)/PMAS(KC,2)))
05503 ELSE
05504 PM0=ULMASS
05505 PMLOW=ATAN((MAX(0.,PM0-PMAS(KC,3))**2-PM0**2)/
05506 & (PM0*PMAS(KC,2)))
05507 PMUPP=ATAN(((PM0+PMAS(KC,3))**2-PM0**2)/(PM0*PMAS(KC,2)))
05508 ULMASS=SQRT(MAX(0.,PM0**2+PM0*PMAS(KC,2)*TAN(PMLOW+
05509 & (PMUPP-PMLOW)*RLU(0))))
05510 ENDIF
05511 ENDIF
05512 MSTJ(93)=0
05513
05514 RETURN
05515 END
05516
05517
05518
05519 SUBROUTINE LUNAME(KF,CHAU)
05520
05521
05522 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
05523 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
05524 COMMON/LUDAT4/CHAF(500)
05525 CHARACTER CHAF*8
05526 SAVE /LUDAT1/,/LUDAT2/,/LUDAT4/
05527 CHARACTER CHAU*16
05528
05529
05530 CHAU=' '
05531 KFA=IABS(KF)
05532 KC=LUCOMP(KF)
05533 IF(KC.EQ.0) RETURN
05534 KQ=LUCHGE(KF)
05535 KFLA=MOD(KFA/1000,10)
05536 KFLB=MOD(KFA/100,10)
05537 KFLC=MOD(KFA/10,10)
05538 KFLS=MOD(KFA,10)
05539 KFLR=MOD(KFA/10000,10)
05540
05541
05542 IF(KFA.LE.100.OR.(KFA.GT.100.AND.KC.GT.100)) THEN
05543 CHAU=CHAF(KC)
05544 LEN=0
05545 DO 100 LEM=1,8
05546 IF(CHAU(LEM:LEM).NE.' ') LEN=LEM
05547 100 CONTINUE
05548
05549
05550 ELSEIF(KFLC.EQ.0) THEN
05551 CHAU(1:2)=CHAF(KFLA)(1:1)//CHAF(KFLB)(1:1)
05552 IF(KFLS.EQ.1) CHAU(3:4)='_0'
05553 IF(KFLS.EQ.3) CHAU(3:4)='_1'
05554 LEN=4
05555
05556
05557 ELSEIF(KFLA.EQ.0) THEN
05558 IF(KFLB.EQ.5) CHAU(1:1)='B'
05559 IF(KFLB.EQ.6) CHAU(1:1)='T'
05560 IF(KFLB.EQ.7) CHAU(1:1)='L'
05561 IF(KFLB.EQ.8) CHAU(1:1)='H'
05562 LEN=1
05563 IF(KFLR.EQ.0.AND.KFLS.EQ.1) THEN
05564 ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.3) THEN
05565 CHAU(2:2)='*'
05566 LEN=2
05567 ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.3) THEN
05568 CHAU(2:3)='_1'
05569 LEN=3
05570 ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.1) THEN
05571 CHAU(2:4)='*_0'
05572 LEN=4
05573 ELSEIF(KFLR.EQ.2) THEN
05574 CHAU(2:4)='*_1'
05575 LEN=4
05576 ELSEIF(KFLS.EQ.5) THEN
05577 CHAU(2:4)='*_2'
05578 LEN=4
05579 ENDIF
05580 IF(KFLC.GE.3.AND.KFLR.EQ.0.AND.KFLS.LE.3) THEN
05581 CHAU(LEN+1:LEN+2)='_'//CHAF(KFLC)(1:1)
05582 LEN=LEN+2
05583 ELSEIF(KFLC.GE.3) THEN
05584 CHAU(LEN+1:LEN+1)=CHAF(KFLC)(1:1)
05585 LEN=LEN+1
05586 ENDIF
05587
05588
05589 ELSE
05590 IF(KFLB.LE.2.AND.KFLC.LE.2) THEN
05591 CHAU='Sigma '
05592 IF(KFLC.GT.KFLB) CHAU='Lambda'
05593 IF(KFLS.EQ.4) CHAU='Sigma*'
05594 LEN=5
05595 IF(CHAU(6:6).NE.' ') LEN=6
05596 ELSEIF(KFLB.LE.2.OR.KFLC.LE.2) THEN
05597 CHAU='Xi '
05598 IF(KFLA.GT.KFLB.AND.KFLB.GT.KFLC) CHAU='Xi'''
05599 IF(KFLS.EQ.4) CHAU='Xi*'
05600 LEN=2
05601 IF(CHAU(3:3).NE.' ') LEN=3
05602 ELSE
05603 CHAU='Omega '
05604 IF(KFLA.GT.KFLB.AND.KFLB.GT.KFLC) CHAU='Omega'''
05605 IF(KFLS.EQ.4) CHAU='Omega*'
05606 LEN=5
05607 IF(CHAU(6:6).NE.' ') LEN=6
05608 ENDIF
05609
05610
05611 CHAU(LEN+1:LEN+2)='_'//CHAF(KFLA)(1:1)
05612 LEN=LEN+2
05613 IF(KFLB.GE.KFLC.AND.KFLC.GE.4) THEN
05614 CHAU(LEN+1:LEN+2)=CHAF(KFLB)(1:1)//CHAF(KFLC)(1:1)
05615 LEN=LEN+2
05616 ELSEIF(KFLB.GE.KFLC.AND.KFLB.GE.4) THEN
05617 CHAU(LEN+1:LEN+1)=CHAF(KFLB)(1:1)
05618 LEN=LEN+1
05619 ELSEIF(KFLC.GT.KFLB.AND.KFLB.GE.4) THEN
05620 CHAU(LEN+1:LEN+2)=CHAF(KFLC)(1:1)//CHAF(KFLB)(1:1)
05621 LEN=LEN+2
05622 ELSEIF(KFLC.GT.KFLB.AND.KFLC.GE.4) THEN
05623 CHAU(LEN+1:LEN+1)=CHAF(KFLC)(1:1)
05624 LEN=LEN+1
05625 ENDIF
05626 ENDIF
05627
05628
05629 IF(KF.GT.0.OR.LEN.EQ.0) THEN
05630 ELSEIF(KFA.GT.10.AND.KFA.LE.40.AND.KQ.NE.0.AND.MOD(KQ,3).EQ.0)
05631 &THEN
05632 ELSEIF(KFA.EQ.89.OR.(KFA.GE.91.AND.KFA.LE.99)) THEN
05633 ELSEIF(KFA.GT.100.AND.KFLA.EQ.0.AND.KQ.NE.0) THEN
05634 ELSEIF(MSTU(15).LE.1) THEN
05635 CHAU(LEN+1:LEN+1)='~'
05636 LEN=LEN+1
05637 ELSE
05638 CHAU(LEN+1:LEN+3)='bar'
05639 LEN=LEN+3
05640 ENDIF
05641
05642
05643 IF(KQ.EQ.6) CHAU(LEN+1:LEN+2)='++'
05644 IF(KQ.EQ.-6) CHAU(LEN+1:LEN+2)='--'
05645 IF(KQ.EQ.3) CHAU(LEN+1:LEN+1)='+'
05646 IF(KQ.EQ.-3) CHAU(LEN+1:LEN+1)='-'
05647 IF(KQ.EQ.0.AND.(KFA.LE.22.OR.LEN.EQ.0)) THEN
05648 ELSEIF(KQ.EQ.0.AND.(KFA.GE.81.AND.KFA.LE.100)) THEN
05649 ELSEIF(KFA.EQ.28.OR.KFA.EQ.29) THEN
05650 ELSEIF(KFA.GT.100.AND.KFLA.EQ.0.AND.KFLB.EQ.KFLC.AND.
05651 &KFLB.NE.1) THEN
05652 ELSEIF(KQ.EQ.0) THEN
05653 CHAU(LEN+1:LEN+1)='0'
05654 ENDIF
05655
05656 RETURN
05657 END
05658
05659
05660
05661 FUNCTION LUCHGE(KF)
05662
05663
05664 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
05665 SAVE /LUDAT2/
05666
05667
05668 LUCHGE=0
05669 KFA=IABS(KF)
05670 KC=LUCOMP(KFA)
05671 IF(KC.EQ.0) THEN
05672 ELSEIF(KFA.LE.100.OR.KC.LE.80.OR.KC.GT.100) THEN
05673 LUCHGE=KCHG(KC,1)
05674
05675
05676 ELSEIF(MOD(KFA/1000,10).EQ.0) THEN
05677 LUCHGE=(KCHG(MOD(KFA/100,10),1)-KCHG(MOD(KFA/10,10),1))*
05678 & (-1)**MOD(KFA/100,10)
05679 ELSEIF(MOD(KFA/10,10).EQ.0) THEN
05680 LUCHGE=KCHG(MOD(KFA/1000,10),1)+KCHG(MOD(KFA/100,10),1)
05681 ELSE
05682 LUCHGE=KCHG(MOD(KFA/1000,10),1)+KCHG(MOD(KFA/100,10),1)+
05683 & KCHG(MOD(KFA/10,10),1)
05684 ENDIF
05685
05686
05687 LUCHGE=LUCHGE*ISIGN(1,KF)
05688
05689 RETURN
05690 END
05691
05692
05693
05694 FUNCTION LUCOMP(KF)
05695
05696
05697
05698 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
05699 SAVE /LUDAT2/
05700 DIMENSION KFTAB(25),KCTAB(25)
05701 DATA KFTAB/211,111,221,311,321,130,310,213,113,223,
05702 &313,323,2112,2212,210,2110,2210,110,220,330,440,30443,30553,0,0/
05703 DATA KCTAB/101,111,112,102,103,221,222,121,131,132,
05704 &122,123,332,333,281,282,283,284,285,286,287,231,235,0,0/
05705
05706
05707 LUCOMP=0
05708 KFA=IABS(KF)
05709
05710
05711 IF(KFA.EQ.0.OR.KFA.GE.100000) THEN
05712 RETURN
05713 ELSEIF(KFA.LE.100) THEN
05714 LUCOMP=KFA
05715 IF(KF.LT.0.AND.KCHG(KFA,3).EQ.0) LUCOMP=0
05716 RETURN
05717 ELSE
05718 DO 100 IKF=1,23
05719 IF(KFA.EQ.KFTAB(IKF)) THEN
05720 LUCOMP=KCTAB(IKF)
05721 IF(KF.LT.0.AND.KCHG(LUCOMP,3).EQ.0) LUCOMP=0
05722 RETURN
05723 ENDIF
05724 100 CONTINUE
05725 ENDIF
05726
05727
05728 KFLA=MOD(KFA/1000,10)
05729 KFLB=MOD(KFA/100,10)
05730 KFLC=MOD(KFA/10,10)
05731 KFLS=MOD(KFA,10)
05732 KFLR=MOD(KFA/10000,10)
05733
05734
05735 IF(KFA-10000*KFLR.LT.1000) THEN
05736 IF(KFLB.EQ.0.OR.KFLB.EQ.9.OR.KFLC.EQ.0.OR.KFLC.EQ.9) THEN
05737 ELSEIF(KFLB.LT.KFLC) THEN
05738 ELSEIF(KF.LT.0.AND.KFLB.EQ.KFLC) THEN
05739 ELSEIF(KFLB.EQ.KFLC) THEN
05740 IF(KFLR.EQ.0.AND.KFLS.EQ.1) THEN
05741 LUCOMP=110+KFLB
05742 ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.3) THEN
05743 LUCOMP=130+KFLB
05744 ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.3) THEN
05745 LUCOMP=150+KFLB
05746 ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.1) THEN
05747 LUCOMP=170+KFLB
05748 ELSEIF(KFLR.EQ.2.AND.KFLS.EQ.3) THEN
05749 LUCOMP=190+KFLB
05750 ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.5) THEN
05751 LUCOMP=210+KFLB
05752 ENDIF
05753 ELSEIF(KFLB.LE.5) THEN
05754 IF(KFLR.EQ.0.AND.KFLS.EQ.1) THEN
05755 LUCOMP=100+((KFLB-1)*(KFLB-2))/2+KFLC
05756 ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.3) THEN
05757 LUCOMP=120+((KFLB-1)*(KFLB-2))/2+KFLC
05758 ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.3) THEN
05759 LUCOMP=140+((KFLB-1)*(KFLB-2))/2+KFLC
05760 ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.1) THEN
05761 LUCOMP=160+((KFLB-1)*(KFLB-2))/2+KFLC
05762 ELSEIF(KFLR.EQ.2.AND.KFLS.EQ.3) THEN
05763 LUCOMP=180+((KFLB-1)*(KFLB-2))/2+KFLC
05764 ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.5) THEN
05765 LUCOMP=200+((KFLB-1)*(KFLB-2))/2+KFLC
05766 ENDIF
05767 ELSEIF((KFLS.EQ.1.AND.KFLR.LE.1).OR.(KFLS.EQ.3.AND.KFLR.LE.2).
05768 & OR.(KFLS.EQ.5.AND.KFLR.EQ.0)) THEN
05769 LUCOMP=80+KFLB
05770 ENDIF
05771
05772
05773 ELSEIF((KFLR.EQ.0.OR.KFLR.EQ.1).AND.KFLC.EQ.0) THEN
05774 IF(KFLS.NE.1.AND.KFLS.NE.3) THEN
05775 ELSEIF(KFLA.EQ.9.OR.KFLB.EQ.0.OR.KFLB.EQ.9) THEN
05776 ELSEIF(KFLA.LT.KFLB) THEN
05777 ELSEIF(KFLS.EQ.1.AND.KFLA.EQ.KFLB) THEN
05778 ELSE
05779 LUCOMP=90
05780 ENDIF
05781
05782
05783 ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.2) THEN
05784 IF(KFLA.EQ.9.OR.KFLB.EQ.0.OR.KFLB.EQ.9.OR.KFLC.EQ.9) THEN
05785 ELSEIF(KFLA.LE.KFLC.OR.KFLA.LT.KFLB) THEN
05786 ELSEIF(KFLA.GE.6.OR.KFLB.GE.4.OR.KFLC.GE.4) THEN
05787 LUCOMP=80+KFLA
05788 ELSEIF(KFLB.LT.KFLC) THEN
05789 LUCOMP=300+((KFLA+1)*KFLA*(KFLA-1))/6+(KFLC*(KFLC-1))/2+KFLB
05790 ELSE
05791 LUCOMP=330+((KFLA+1)*KFLA*(KFLA-1))/6+(KFLB*(KFLB-1))/2+KFLC
05792 ENDIF
05793
05794
05795 ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.4) THEN
05796 IF(KFLA.EQ.9.OR.KFLB.EQ.0.OR.KFLB.EQ.9.OR.KFLC.EQ.9) THEN
05797 ELSEIF(KFLA.LT.KFLB.OR.KFLB.LT.KFLC) THEN
05798 ELSEIF(KFLA.GE.6.OR.KFLB.GE.4) THEN
05799 LUCOMP=80+KFLA
05800 ELSE
05801 LUCOMP=360+((KFLA+1)*KFLA*(KFLA-1))/6+(KFLB*(KFLB-1))/2+KFLC
05802 ENDIF
05803 ENDIF
05804
05805 RETURN
05806 END
05807
05808
05809
05810 SUBROUTINE LUERRM(MERR,CHMESS)
05811
05812
05813 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
05814 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
05815 SAVE /LUJETS/,/LUDAT1/
05816 CHARACTER CHMESS*(*)
05817
05818
05819 IF(MERR.LE.10) THEN
05820 MSTU(27)=MSTU(27)+1
05821 MSTU(28)=MERR
05822 IF(MSTU(25).EQ.1.AND.MSTU(27).LE.MSTU(26)) WRITE(MSTU(11),5000)
05823 & MERR,MSTU(31),CHMESS
05824
05825
05826 ELSEIF(MERR.LE.20) THEN
05827 MSTU(23)=MSTU(23)+1
05828 MSTU(24)=MERR-10
05829 IF(MSTU(21).GE.1.AND.MSTU(23).LE.MSTU(22)) WRITE(MSTU(11),5100)
05830 & MERR-10,MSTU(31),CHMESS
05831 IF(MSTU(21).GE.2.AND.MSTU(23).GT.MSTU(22)) THEN
05832 WRITE(MSTU(11),5100) MERR-10,MSTU(31),CHMESS
05833 WRITE(MSTU(11),5200)
05834 IF(MERR.NE.17) CALL LULIST(2)
05835 STOP
05836 ENDIF
05837
05838
05839 ELSE
05840 WRITE(MSTU(11),5300) MERR-20,MSTU(31),CHMESS
05841 STOP
05842 ENDIF
05843
05844
05845 5000 FORMAT(/5X,'Advisory warning type',I2,' given after',I6,
05846 &' LUEXEC calls:'/5X,A)
05847 5100 FORMAT(/5X,'Error type',I2,' has occured after',I6,
05848 &' LUEXEC calls:'/5X,A)
05849 5200 FORMAT(5X,'Execution will be stopped after listing of last ',
05850 &'event!')
05851 5300 FORMAT(/5X,'Fatal error type',I2,' has occured after',I6,
05852 &' LUEXEC calls:'/5X,A/5X,'Execution will now be stopped!')
05853
05854 RETURN
05855 END
05856
05857
05858
05859 FUNCTION ULALEM(Q2)
05860
05861
05862 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
05863 SAVE /LUDAT1/
05864
05865
05866
05867
05868
05869 AEMPI=PARU(101)/(3.*PARU(1))
05870 IF(MSTU(101).LE.0.OR.Q2.LT.2E-6) THEN
05871 RPIGG=0.
05872 ELSEIF(Q2.LT.0.09) THEN
05873 RPIGG=AEMPI*(13.4916+LOG(Q2))+0.00835*LOG(1.+Q2)
05874 ELSEIF(Q2.LT.9.) THEN
05875 RPIGG=AEMPI*(16.3200+2.*LOG(Q2))+0.00238*LOG(1.+3.927*Q2)
05876 ELSEIF(Q2.LT.1E4) THEN
05877 RPIGG=AEMPI*(13.4955+3.*LOG(Q2))+0.00165+0.00299*LOG(1.+Q2)
05878 ELSE
05879 RPIGG=AEMPI*(13.4955+3.*LOG(Q2))+0.00221+0.00293*LOG(1.+Q2)
05880 ENDIF
05881
05882
05883 ULALEM=PARU(101)/(1.-RPIGG)
05884 PARU(108)=ULALEM
05885
05886 RETURN
05887 END
05888
05889
05890
05891 FUNCTION ULALPS(Q2)
05892
05893
05894 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
05895 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
05896 SAVE /LUDAT1/,/LUDAT2/
05897
05898
05899 IF(MSTU(111).LE.0) THEN
05900 ULALPS=PARU(111)
05901 MSTU(118)=MSTU(112)
05902 PARU(117)=0.
05903 PARU(118)=PARU(111)
05904 RETURN
05905 ENDIF
05906
05907
05908 Q2EFF=Q2
05909 IF(MSTU(115).GE.2) Q2EFF=MAX(Q2,PARU(114))
05910 NF=MSTU(112)
05911 ALAM2=PARU(112)**2
05912 100 IF(NF.GT.MAX(2,MSTU(113))) THEN
05913 Q2THR=PARU(113)*PMAS(NF,1)**2
05914 IF(Q2EFF.LT.Q2THR) THEN
05915 NF=NF-1
05916 ALAM2=ALAM2*(Q2THR/ALAM2)**(2./(33.-2.*NF))
05917 GOTO 100
05918 ENDIF
05919 ENDIF
05920 110 IF(NF.LT.MIN(8,MSTU(114))) THEN
05921 Q2THR=PARU(113)*PMAS(NF+1,1)**2
05922 IF(Q2EFF.GT.Q2THR) THEN
05923 NF=NF+1
05924 ALAM2=ALAM2*(ALAM2/Q2THR)**(2./(33.-2.*NF))
05925 GOTO 110
05926 ENDIF
05927 ENDIF
05928 IF(MSTU(115).EQ.1) Q2EFF=Q2EFF+ALAM2
05929 PARU(117)=SQRT(ALAM2)
05930
05931
05932 B0=(33.-2.*NF)/6.
05933 ALGQ=LOG(MAX(1.0001,Q2EFF/ALAM2))
05934 IF(MSTU(111).EQ.1) THEN
05935 ULALPS=MIN(PARU(115),PARU(2)/(B0*ALGQ))
05936 ELSE
05937 B1=(153.-19.*NF)/6.
05938 ULALPS=MIN(PARU(115),PARU(2)/(B0*ALGQ)*(1.-B1*LOG(ALGQ)/
05939 & (B0**2*ALGQ)))
05940 ENDIF
05941 MSTU(118)=NF
05942 PARU(118)=ULALPS
05943
05944 RETURN
05945 END
05946
05947
05948
05949 FUNCTION ULANGL(X,Y)
05950
05951
05952 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
05953 SAVE /LUDAT1/
05954
05955 ULANGL=0.
05956 R=SQRT(X**2+Y**2)
05957 IF(R.LT.1E-20) RETURN
05958 IF(ABS(X)/R.LT.0.8) THEN
05959 ULANGL=SIGN(ACOS(X/R),Y)
05960 ELSE
05961 ULANGL=ASIN(Y/R)
05962 IF(X.LT.0..AND.ULANGL.GE.0.) THEN
05963 ULANGL=PARU(1)-ULANGL
05964 ELSEIF(X.LT.0.) THEN
05965 ULANGL=-PARU(1)-ULANGL
05966 ENDIF
05967 ENDIF
05968
05969 RETURN
05970 END
05971
05972
05973
05974 FUNCTION RLU(IDUMMY)
05975
05976
05977
05978 COMMON/LUDATR/MRLU(6),RRLU(100)
05979 SAVE /LUDATR/
05980 EQUIVALENCE (MRLU1,MRLU(1)),(MRLU2,MRLU(2)),(MRLU3,MRLU(3)),
05981 &(MRLU4,MRLU(4)),(MRLU5,MRLU(5)),(MRLU6,MRLU(6)),
05982 &(RRLU98,RRLU(98)),(RRLU99,RRLU(99)),(RRLU00,RRLU(100))
05983
05984
05985 IF(MRLU2.EQ.0) THEN
05986 IJ=MOD(MRLU1/30082,31329)
05987 KL=MOD(MRLU1,30082)
05988 I=MOD(IJ/177,177)+2
05989 J=MOD(IJ,177)+2
05990 K=MOD(KL/169,178)+1
05991 L=MOD(KL,169)
05992 DO 110 II=1,97
05993 S=0.
05994 T=0.5
05995 DO 100 JJ=1,24
05996 M=MOD(MOD(I*J,179)*K,179)
05997 I=J
05998 J=K
05999 K=M
06000 L=MOD(53*L+1,169)
06001 IF(MOD(L*M,64).GE.32) S=S+T
06002 T=0.5*T
06003 100 CONTINUE
06004 RRLU(II)=S
06005 110 CONTINUE
06006 TWOM24=1.
06007 DO 120 I24=1,24
06008 TWOM24=0.5*TWOM24
06009 120 CONTINUE
06010 RRLU98=362436.*TWOM24
06011 RRLU99=7654321.*TWOM24
06012 RRLU00=16777213.*TWOM24
06013 MRLU2=1
06014 MRLU3=0
06015 MRLU4=97
06016 MRLU5=33
06017 ENDIF
06018
06019
06020 130 RUNI=RRLU(MRLU4)-RRLU(MRLU5)
06021 IF(RUNI.LT.0.) RUNI=RUNI+1.
06022 RRLU(MRLU4)=RUNI
06023 MRLU4=MRLU4-1
06024 IF(MRLU4.EQ.0) MRLU4=97
06025 MRLU5=MRLU5-1
06026 IF(MRLU5.EQ.0) MRLU5=97
06027 RRLU98=RRLU98-RRLU99
06028 IF(RRLU98.LT.0.) RRLU98=RRLU98+RRLU00
06029 RUNI=RUNI-RRLU98
06030 IF(RUNI.LT.0.) RUNI=RUNI+1.
06031 IF(RUNI.LE.0.OR.RUNI.GE.1.) GOTO 130
06032
06033
06034 MRLU3=MRLU3+1
06035 IF(MRLU3.EQ.1000000000) THEN
06036 MRLU2=MRLU2+1
06037 MRLU3=0
06038 ENDIF
06039 RLU=RUNI
06040
06041 RETURN
06042 END
06043
06044
06045
06046 SUBROUTINE RLUGET(LFN,MOVE)
06047
06048
06049
06050 COMMON/LUDATR/MRLU(6),RRLU(100)
06051 SAVE /LUDATR/
06052 CHARACTER CHERR*8
06053
06054
06055 IF(MOVE.LT.0) THEN
06056 NBCK=MIN(MRLU(6),-MOVE)
06057 DO 100 IBCK=1,NBCK
06058 BACKSPACE(LFN,ERR=110,IOSTAT=IERR)
06059 100 CONTINUE
06060 MRLU(6)=MRLU(6)-NBCK
06061 ENDIF
06062
06063
06064 WRITE(LFN,ERR=110,IOSTAT=IERR) (MRLU(I1),I1=1,5),
06065 &(RRLU(I2),I2=1,100)
06066 MRLU(6)=MRLU(6)+1
06067 RETURN
06068
06069
06070 110 WRITE(CHERR,'(I8)') IERR
06071 CALL LUERRM(18,'(RLUGET:) error when accessing file, IOSTAT ='//
06072 &CHERR)
06073
06074 RETURN
06075 END
06076
06077
06078
06079 SUBROUTINE RLUSET(LFN,MOVE)
06080
06081
06082
06083 COMMON/LUDATR/MRLU(6),RRLU(100)
06084 SAVE /LUDATR/
06085 CHARACTER CHERR*8
06086
06087
06088 IF(MOVE.LT.0) THEN
06089 NBCK=MIN(MRLU(6),-MOVE)
06090 DO 100 IBCK=1,NBCK
06091 BACKSPACE(LFN,ERR=120,IOSTAT=IERR)
06092 100 CONTINUE
06093 MRLU(6)=MRLU(6)-NBCK
06094 ENDIF
06095
06096
06097 NFOR=1+MAX(0,MOVE)
06098 DO 110 IFOR=1,NFOR
06099 READ(LFN,ERR=120,IOSTAT=IERR) (MRLU(I1),I1=1,5),
06100 &(RRLU(I2),I2=1,100)
06101 110 CONTINUE
06102 MRLU(6)=MRLU(6)+NFOR
06103 RETURN
06104
06105
06106 120 WRITE(CHERR,'(I8)') IERR
06107 CALL LUERRM(18,'(RLUSET:) error when accessing file, IOSTAT ='//
06108 &CHERR)
06109
06110 RETURN
06111 END
06112
06113
06114
06115 SUBROUTINE LUROBO(THE,PHI,BEX,BEY,BEZ)
06116
06117
06118 IMPLICIT DOUBLE PRECISION(D)
06119 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
06120 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
06121 SAVE /LUJETS/,/LUDAT1/
06122 DIMENSION ROT(3,3),PR(3),VR(3),DP(4),DV(4)
06123
06124
06125 IMIN=1
06126 IF(MSTU(1).GT.0) IMIN=MSTU(1)
06127 IMAX=N
06128 IF(MSTU(2).GT.0) IMAX=MSTU(2)
06129 DBX=BEX
06130 DBY=BEY
06131 DBZ=BEZ
06132 GOTO 120
06133
06134
06135 ENTRY LUDBRB(IMI,IMA,THE,PHI,DBEX,DBEY,DBEZ)
06136 IMIN=IMI
06137 IF(IMIN.LE.0) IMIN=1
06138 IMAX=IMA
06139 IF(IMAX.LE.0) IMAX=N
06140 DBX=DBEX
06141 DBY=DBEY
06142 DBZ=DBEZ
06143
06144
06145 IF(MSTU(33).NE.0) THEN
06146 DO 110 I=MIN(IMIN,MSTU(4)),MIN(IMAX,MSTU(4))
06147 DO 100 J=1,5
06148 V(I,J)=0.
06149 100 CONTINUE
06150 110 CONTINUE
06151 MSTU(33)=0
06152 ENDIF
06153
06154
06155 120 IF(IMIN.GT.MSTU(4).OR.IMAX.GT.MSTU(4)) THEN
06156 CALL LUERRM(11,'(LUROBO:) range outside LUJETS memory')
06157 RETURN
06158 ENDIF
06159
06160
06161 IF(THE**2+PHI**2.GT.1E-20) THEN
06162 ROT(1,1)=COS(THE)*COS(PHI)
06163 ROT(1,2)=-SIN(PHI)
06164 ROT(1,3)=SIN(THE)*COS(PHI)
06165 ROT(2,1)=COS(THE)*SIN(PHI)
06166 ROT(2,2)=COS(PHI)
06167 ROT(2,3)=SIN(THE)*SIN(PHI)
06168 ROT(3,1)=-SIN(THE)
06169 ROT(3,2)=0.
06170 ROT(3,3)=COS(THE)
06171 DO 150 I=IMIN,IMAX
06172 IF(K(I,1).LE.0) GOTO 150
06173 DO 130 J=1,3
06174 PR(J)=P(I,J)
06175 VR(J)=V(I,J)
06176 130 CONTINUE
06177 DO 140 J=1,3
06178 P(I,J)=ROT(J,1)*PR(1)+ROT(J,2)*PR(2)+ROT(J,3)*PR(3)
06179 V(I,J)=ROT(J,1)*VR(1)+ROT(J,2)*VR(2)+ROT(J,3)*VR(3)
06180 140 CONTINUE
06181 150 CONTINUE
06182 ENDIF
06183
06184
06185 IF(DBX**2+DBY**2+DBZ**2.GT.1E-20) THEN
06186 DB=SQRT(DBX**2+DBY**2+DBZ**2)
06187 IF(DB.GT.0.99999999D0) THEN
06188
06189 CALL LUERRM(3,'(LUROBO:) boost vector too large')
06190 DBX=DBX*(0.99999999D0/DB)
06191 DBY=DBY*(0.99999999D0/DB)
06192 DBZ=DBZ*(0.99999999D0/DB)
06193 DB=0.99999999D0
06194 ENDIF
06195 DGA=1D0/SQRT(1D0-DB**2)
06196 DO 170 I=IMIN,IMAX
06197 IF(K(I,1).LE.0) GOTO 170
06198 DO 160 J=1,4
06199 DP(J)=P(I,J)
06200 DV(J)=V(I,J)
06201 160 CONTINUE
06202 DBP=DBX*DP(1)+DBY*DP(2)+DBZ*DP(3)
06203 DGABP=DGA*(DGA*DBP/(1D0+DGA)+DP(4))
06204 P(I,1)=DP(1)+DGABP*DBX
06205 P(I,2)=DP(2)+DGABP*DBY
06206 P(I,3)=DP(3)+DGABP*DBZ
06207 P(I,4)=DGA*(DP(4)+DBP)
06208 DBV=DBX*DV(1)+DBY*DV(2)+DBZ*DV(3)
06209 DGABV=DGA*(DGA*DBV/(1D0+DGA)+DV(4))
06210 V(I,1)=DV(1)+DGABV*DBX
06211 V(I,2)=DV(2)+DGABV*DBY
06212 V(I,3)=DV(3)+DGABV*DBZ
06213 V(I,4)=DGA*(DV(4)+DBV)
06214 170 CONTINUE
06215 ENDIF
06216
06217 RETURN
06218 END
06219
06220
06221
06222 SUBROUTINE LUEDIT(MEDIT)
06223
06224
06225
06226 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
06227 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
06228 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
06229 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
06230 DIMENSION NS(2),PTS(2),PLS(2)
06231
06232
06233 IF((MEDIT.GE.0.AND.MEDIT.LE.3).OR.MEDIT.EQ.5) THEN
06234 IMAX=N
06235 IF(MSTU(2).GT.0) IMAX=MSTU(2)
06236 I1=MAX(1,MSTU(1))-1
06237 DO 110 I=MAX(1,MSTU(1)),IMAX
06238 IF(K(I,1).EQ.0.OR.K(I,1).GT.20) GOTO 110
06239 IF(MEDIT.EQ.1) THEN
06240 IF(K(I,1).GT.10) GOTO 110
06241 ELSEIF(MEDIT.EQ.2) THEN
06242 IF(K(I,1).GT.10) GOTO 110
06243 KC=LUCOMP(K(I,2))
06244 IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.KC.EQ.18)
06245 & GOTO 110
06246 ELSEIF(MEDIT.EQ.3) THEN
06247 IF(K(I,1).GT.10) GOTO 110
06248 KC=LUCOMP(K(I,2))
06249 IF(KC.EQ.0) GOTO 110
06250 IF(KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) GOTO 110
06251 ELSEIF(MEDIT.EQ.5) THEN
06252 IF(K(I,1).EQ.13.OR.K(I,1).EQ.14) GOTO 110
06253 KC=LUCOMP(K(I,2))
06254 IF(KC.EQ.0) GOTO 110
06255 IF(K(I,1).GE.11.AND.KCHG(KC,2).EQ.0) GOTO 110
06256 ENDIF
06257
06258
06259 I1=I1+1
06260 DO 100 J=1,5
06261 K(I1,J)=K(I,J)
06262 P(I1,J)=P(I,J)
06263 V(I1,J)=V(I,J)
06264 100 CONTINUE
06265 K(I1,3)=0
06266 110 CONTINUE
06267 IF(I1.LT.N) MSTU(3)=0
06268 IF(I1.LT.N) MSTU(70)=0
06269 N=I1
06270
06271
06272 ELSEIF(MEDIT.GE.11.AND.MEDIT.LE.15) THEN
06273 I1=0
06274 DO 120 I=1,N
06275 K(I,3)=MOD(K(I,3),MSTU(5))
06276 IF(MEDIT.EQ.11.AND.K(I,1).LT.0) GOTO 120
06277 IF(MEDIT.EQ.12.AND.K(I,1).EQ.0) GOTO 120
06278 IF(MEDIT.EQ.13.AND.(K(I,1).EQ.11.OR.K(I,1).EQ.12.OR.
06279 & K(I,1).EQ.15).AND.K(I,2).NE.94) GOTO 120
06280 IF(MEDIT.EQ.14.AND.(K(I,1).EQ.13.OR.K(I,1).EQ.14.OR.
06281 & K(I,2).EQ.94)) GOTO 120
06282 IF(MEDIT.EQ.15.AND.K(I,1).GE.21) GOTO 120
06283 I1=I1+1
06284 K(I,3)=K(I,3)+MSTU(5)*I1
06285 120 CONTINUE
06286
06287
06288 DO 140 I=1,N
06289 IF(K(I,1).LE.0.OR.K(I,1).GT.20.OR.K(I,3)/MSTU(5).EQ.0) GOTO 140
06290 ID=I
06291 130 IM=MOD(K(ID,3),MSTU(5))
06292 IF(MEDIT.EQ.13.AND.IM.GT.0.AND.IM.LE.N) THEN
06293 IF((K(IM,1).EQ.11.OR.K(IM,1).EQ.12.OR.K(IM,1).EQ.15).AND.
06294 & K(IM,2).NE.94) THEN
06295 ID=IM
06296 GOTO 130
06297 ENDIF
06298 ELSEIF(MEDIT.EQ.14.AND.IM.GT.0.AND.IM.LE.N) THEN
06299 IF(K(IM,1).EQ.13.OR.K(IM,1).EQ.14.OR.K(IM,2).EQ.94) THEN
06300 ID=IM
06301 GOTO 130
06302 ENDIF
06303 ENDIF
06304 K(I,3)=MSTU(5)*(K(I,3)/MSTU(5))
06305 IF(IM.NE.0) K(I,3)=K(I,3)+K(IM,3)/MSTU(5)
06306 IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) THEN
06307 IF(K(I,4).GT.0.AND.K(I,4).LE.MSTU(4)) K(I,4)=
06308 & K(K(I,4),3)/MSTU(5)
06309 IF(K(I,5).GT.0.AND.K(I,5).LE.MSTU(4)) K(I,5)=
06310 & K(K(I,5),3)/MSTU(5)
06311 ELSE
06312 KCM=MOD(K(I,4)/MSTU(5),MSTU(5))
06313 IF(KCM.GT.0.AND.KCM.LE.MSTU(4)) KCM=K(KCM,3)/MSTU(5)
06314 KCD=MOD(K(I,4),MSTU(5))
06315 IF(KCD.GT.0.AND.KCD.LE.MSTU(4)) KCD=K(KCD,3)/MSTU(5)
06316 K(I,4)=MSTU(5)**2*(K(I,4)/MSTU(5)**2)+MSTU(5)*KCM+KCD
06317 KCM=MOD(K(I,5)/MSTU(5),MSTU(5))
06318 IF(KCM.GT.0.AND.KCM.LE.MSTU(4)) KCM=K(KCM,3)/MSTU(5)
06319 KCD=MOD(K(I,5),MSTU(5))
06320 IF(KCD.GT.0.AND.KCD.LE.MSTU(4)) KCD=K(KCD,3)/MSTU(5)
06321 K(I,5)=MSTU(5)**2*(K(I,5)/MSTU(5)**2)+MSTU(5)*KCM+KCD
06322 ENDIF
06323 140 CONTINUE
06324
06325
06326 I1=0
06327 MSTU90=MSTU(90)
06328 MSTU(90)=0
06329 DO 170 I=1,N
06330 IF(K(I,3)/MSTU(5).EQ.0) GOTO 170
06331 I1=I1+1
06332 DO 150 J=1,5
06333 K(I1,J)=K(I,J)
06334 P(I1,J)=P(I,J)
06335 V(I1,J)=V(I,J)
06336 150 CONTINUE
06337 K(I1,3)=MOD(K(I1,3),MSTU(5))
06338 DO 160 IZ=1,MSTU90
06339 IF(I.EQ.MSTU(90+IZ)) THEN
06340 MSTU(90)=MSTU(90)+1
06341 MSTU(90+MSTU(90))=I1
06342 PARU(90+MSTU(90))=PARU(90+IZ)
06343 ENDIF
06344 160 CONTINUE
06345 170 CONTINUE
06346 IF(I1.LT.N) MSTU(3)=0
06347 IF(I1.LT.N) MSTU(70)=0
06348 N=I1
06349
06350
06351 ELSEIF(MEDIT.EQ.16) THEN
06352 DO 190 I=1,N
06353 IF(K(I,1).LE.10.OR.K(I,1).GT.20) GOTO 190
06354 IF(K(I,4).NE.0.OR.K(I,5).NE.0) GOTO 190
06355 DO 180 I1=I+1,N
06356 IF(K(I1,3).NE.I) THEN
06357 ELSEIF(K(I,4).EQ.0) THEN
06358 K(I,4)=I1
06359 ELSE
06360 K(I,5)=I1
06361 ENDIF
06362 180 CONTINUE
06363 IF(K(I,5).EQ.0) K(I,5)=K(I,4)
06364 190 CONTINUE
06365
06366
06367 ELSEIF(MEDIT.EQ.21) THEN
06368 IF(2*N.GE.MSTU(4)) THEN
06369 CALL LUERRM(11,'(LUEDIT:) no more memory left in LUJETS')
06370 RETURN
06371 ENDIF
06372 DO 210 I=1,N
06373 DO 200 J=1,5
06374 K(MSTU(4)-I,J)=K(I,J)
06375 P(MSTU(4)-I,J)=P(I,J)
06376 V(MSTU(4)-I,J)=V(I,J)
06377 200 CONTINUE
06378 210 CONTINUE
06379 MSTU(32)=N
06380
06381
06382 ELSEIF(MEDIT.EQ.22) THEN
06383 DO 230 I=1,MSTU(32)
06384 DO 220 J=1,5
06385 K(I,J)=K(MSTU(4)-I,J)
06386 P(I,J)=P(MSTU(4)-I,J)
06387 V(I,J)=V(MSTU(4)-I,J)
06388 220 CONTINUE
06389 230 CONTINUE
06390 N=MSTU(32)
06391
06392
06393 ELSEIF(MEDIT.EQ.23) THEN
06394 I1=0
06395 DO 240 I=1,N
06396 KH=K(I,3)
06397 IF(KH.GE.1) THEN
06398 IF(K(KH,1).GT.20) KH=0
06399 ENDIF
06400 IF(KH.NE.0) GOTO 250
06401 I1=I1+1
06402 IF(K(I,1).GT.10.AND.K(I,1).LE.20) K(I,1)=K(I,1)-10
06403 240 CONTINUE
06404 250 N=I1
06405
06406
06407 ELSEIF(MEDIT.EQ.31.OR.MEDIT.EQ.32) THEN
06408 CALL LUDBRB(1,N+MSTU(3),0.,-ULANGL(P(MSTU(61),1),
06409 & P(MSTU(61),2)),0D0,0D0,0D0)
06410 CALL LUDBRB(1,N+MSTU(3),-ULANGL(P(MSTU(61),3),
06411 & P(MSTU(61),1)),0.,0D0,0D0,0D0)
06412 CALL LUDBRB(1,N+MSTU(3),0.,-ULANGL(P(MSTU(61)+1,1),
06413 & P(MSTU(61)+1,2)),0D0,0D0,0D0)
06414 IF(MEDIT.EQ.31) RETURN
06415
06416
06417 DO 260 IS=1,2
06418 NS(IS)=0
06419 PTS(IS)=0.
06420 PLS(IS)=0.
06421 260 CONTINUE
06422 DO 270 I=1,N
06423 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 270
06424 IF(MSTU(41).GE.2) THEN
06425 KC=LUCOMP(K(I,2))
06426 IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
06427 & KC.EQ.18) GOTO 270
06428 IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
06429 & GOTO 270
06430 ENDIF
06431 IS=2.-SIGN(0.5,P(I,3))
06432 NS(IS)=NS(IS)+1
06433 PTS(IS)=PTS(IS)+SQRT(P(I,1)**2+P(I,2)**2)
06434 270 CONTINUE
06435 IF(NS(1)*PTS(2)**2.LT.NS(2)*PTS(1)**2)
06436 & CALL LUDBRB(1,N+MSTU(3),PARU(1),0.,0D0,0D0,0D0)
06437
06438
06439 DO 280 I=1,N
06440 IF(P(I,3).GE.0.) GOTO 280
06441 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 280
06442 IF(MSTU(41).GE.2) THEN
06443 KC=LUCOMP(K(I,2))
06444 IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
06445 & KC.EQ.18) GOTO 280
06446 IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
06447 & GOTO 280
06448 ENDIF
06449 IS=2.-SIGN(0.5,P(I,1))
06450 PLS(IS)=PLS(IS)-P(I,3)
06451 280 CONTINUE
06452 IF(PLS(2).GT.PLS(1)) CALL LUDBRB(1,N+MSTU(3),0.,PARU(1),
06453 & 0D0,0D0,0D0)
06454 ENDIF
06455
06456 RETURN
06457 END
06458
06459
06460
06461 SUBROUTINE LULIST(MLIST)
06462
06463
06464
06465 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
06466 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
06467 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
06468 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
06469 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/
06470 CHARACTER CHAP*16,CHAC*16,CHAN*16,CHAD(5)*16,CHDL(7)*4
06471 DIMENSION PS(6)
06472 DATA CHDL/'(())',' ','()','!!','<>','==','(==)'/
06473
06474
06475 IF(MLIST.EQ.0.OR.MSTU(12).EQ.1) THEN
06476 CALL LULOGO
06477 MSTU(12)=0
06478 IF(MLIST.EQ.0) RETURN
06479 ENDIF
06480
06481
06482 IF(MLIST.GE.1.AND.MLIST.LE.3) THEN
06483 IF(MLIST.EQ.1) WRITE(MSTU(11),5100)
06484 IF(MLIST.EQ.2) WRITE(MSTU(11),5200)
06485 IF(MLIST.EQ.3) WRITE(MSTU(11),5300)
06486 LMX=12
06487 IF(MLIST.GE.2) LMX=16
06488 ISTR=0
06489 IMAX=N
06490 IF(MSTU(2).GT.0) IMAX=MSTU(2)
06491 DO 120 I=MAX(1,MSTU(1)),MAX(IMAX,N+MAX(0,MSTU(3)))
06492 IF((I.GT.IMAX.AND.I.LE.N).OR.K(I,1).LT.0) GOTO 120
06493
06494
06495 CALL LUNAME(K(I,2),CHAP)
06496 LEN=0
06497 DO 100 LEM=1,16
06498 IF(CHAP(LEM:LEM).NE.' ') LEN=LEM
06499 100 CONTINUE
06500 MDL=(K(I,1)+19)/10
06501 LDL=0
06502 IF(MDL.EQ.2.OR.MDL.GE.8) THEN
06503 CHAC=CHAP
06504 IF(LEN.GT.LMX) CHAC(LMX:LMX)='?'
06505 ELSE
06506 LDL=1
06507 IF(MDL.EQ.1.OR.MDL.EQ.7) LDL=2
06508 IF(LEN.EQ.0) THEN
06509 CHAC=CHDL(MDL)(1:2*LDL)//' '
06510 ELSE
06511 CHAC=CHDL(MDL)(1:LDL)//CHAP(1:MIN(LEN,LMX-2*LDL))//
06512 & CHDL(MDL)(LDL+1:2*LDL)//' '
06513 IF(LEN+2*LDL.GT.LMX) CHAC(LMX:LMX)='?'
06514 ENDIF
06515 ENDIF
06516
06517
06518 IF(K(I,1).EQ.1.OR.K(I,1).EQ.2.OR.K(I,1).EQ.11.OR.K(I,1).EQ.12)
06519 & THEN
06520 KC=LUCOMP(K(I,2))
06521 KCC=0
06522 IF(KC.NE.0) KCC=KCHG(KC,2)
06523 IF(IABS(K(I,2)).EQ.39) THEN
06524 IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='X'
06525 ELSEIF(KCC.NE.0.AND.ISTR.EQ.0) THEN
06526 ISTR=1
06527 IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='A'
06528 ELSEIF(KCC.NE.0.AND.(K(I,1).EQ.2.OR.K(I,1).EQ.12)) THEN
06529 IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='I'
06530 ELSEIF(KCC.NE.0) THEN
06531 ISTR=0
06532 IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='V'
06533 ENDIF
06534 ENDIF
06535
06536
06537 IF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.9999.) THEN
06538 WRITE(MSTU(11),5400) I,CHAC(1:12),(K(I,J1),J1=1,3),
06539 & (P(I,J2),J2=1,5)
06540 ELSEIF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.99999.) THEN
06541 WRITE(MSTU(11),5500) I,CHAC(1:12),(K(I,J1),J1=1,3),
06542 & (P(I,J2),J2=1,5)
06543 ELSEIF(MLIST.EQ.1) THEN
06544 WRITE(MSTU(11),5600) I,CHAC(1:12),(K(I,J1),J1=1,3),
06545 & (P(I,J2),J2=1,5)
06546 ELSEIF(MSTU(5).EQ.10000.AND.(K(I,1).EQ.3.OR.K(I,1).EQ.13.OR.
06547 & K(I,1).EQ.14)) THEN
06548 WRITE(MSTU(11),5700) I,CHAC,(K(I,J1),J1=1,3),
06549 & K(I,4)/100000000,MOD(K(I,4)/10000,10000),MOD(K(I,4),10000),
06550 & K(I,5)/100000000,MOD(K(I,5)/10000,10000),MOD(K(I,5),10000),
06551 & (P(I,J2),J2=1,5)
06552 ELSE
06553 WRITE(MSTU(11),5800) I,CHAC,(K(I,J1),J1=1,5),(P(I,J2),J2=1,5)
06554 ENDIF
06555 IF(MLIST.EQ.3) WRITE(MSTU(11),5900) (V(I,J),J=1,5)
06556
06557
06558 IF(MSTU(70).GE.1) THEN
06559 ISEP=0
06560 DO 110 J=1,MIN(10,MSTU(70))
06561 IF(I.EQ.MSTU(70+J)) ISEP=1
06562 110 CONTINUE
06563 IF(ISEP.EQ.1.AND.MLIST.EQ.1) WRITE(MSTU(11),6000)
06564 IF(ISEP.EQ.1.AND.MLIST.GE.2) WRITE(MSTU(11),6100)
06565 ENDIF
06566 120 CONTINUE
06567
06568
06569 DO 130 J=1,6
06570 PS(J)=PLU(0,J)
06571 130 CONTINUE
06572 IF(MLIST.EQ.1.AND.ABS(PS(4)).LT.9999.) THEN
06573 WRITE(MSTU(11),6200) PS(6),(PS(J),J=1,5)
06574 ELSEIF(MLIST.EQ.1.AND.ABS(PS(4)).LT.99999.) THEN
06575 WRITE(MSTU(11),6300) PS(6),(PS(J),J=1,5)
06576 ELSEIF(MLIST.EQ.1) THEN
06577 WRITE(MSTU(11),6400) PS(6),(PS(J),J=1,5)
06578 ELSE
06579 WRITE(MSTU(11),6500) PS(6),(PS(J),J=1,5)
06580 ENDIF
06581
06582
06583 ELSEIF(MLIST.EQ.11) THEN
06584 WRITE(MSTU(11),6600)
06585 DO 140 KF=1,40
06586 CALL LUNAME(KF,CHAP)
06587 CALL LUNAME(-KF,CHAN)
06588 IF(CHAP.NE.' '.AND.CHAN.EQ.' ') WRITE(MSTU(11),6700) KF,CHAP
06589 IF(CHAN.NE.' ') WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN
06590 140 CONTINUE
06591 DO 170 KFLS=1,3,2
06592 DO 160 KFLA=1,8
06593 DO 150 KFLB=1,KFLA-(3-KFLS)/2
06594 KF=1000*KFLA+100*KFLB+KFLS
06595 CALL LUNAME(KF,CHAP)
06596 CALL LUNAME(-KF,CHAN)
06597 WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN
06598 150 CONTINUE
06599 160 CONTINUE
06600 170 CONTINUE
06601 KF=130
06602 CALL LUNAME(KF,CHAP)
06603 WRITE(MSTU(11),6700) KF,CHAP
06604 KF=310
06605 CALL LUNAME(KF,CHAP)
06606 WRITE(MSTU(11),6700) KF,CHAP
06607 DO 200 KMUL=0,5
06608 KFLS=3
06609 IF(KMUL.EQ.0.OR.KMUL.EQ.3) KFLS=1
06610 IF(KMUL.EQ.5) KFLS=5
06611 KFLR=0
06612 IF(KMUL.EQ.2.OR.KMUL.EQ.3) KFLR=1
06613 IF(KMUL.EQ.4) KFLR=2
06614 DO 190 KFLB=1,8
06615 DO 180 KFLC=1,KFLB-1
06616 KF=10000*KFLR+100*KFLB+10*KFLC+KFLS
06617 CALL LUNAME(KF,CHAP)
06618 CALL LUNAME(-KF,CHAN)
06619 WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN
06620 180 CONTINUE
06621 KF=10000*KFLR+110*KFLB+KFLS
06622 CALL LUNAME(KF,CHAP)
06623 WRITE(MSTU(11),6700) KF,CHAP
06624 190 CONTINUE
06625 200 CONTINUE
06626 KF=30443
06627 CALL LUNAME(KF,CHAP)
06628 WRITE(MSTU(11),6700) KF,CHAP
06629 KF=30553
06630 CALL LUNAME(KF,CHAP)
06631 WRITE(MSTU(11),6700) KF,CHAP
06632 DO 240 KFLSP=1,3
06633 KFLS=2+2*(KFLSP/3)
06634 DO 230 KFLA=1,8
06635 DO 220 KFLB=1,KFLA
06636 DO 210 KFLC=1,KFLB
06637 IF(KFLSP.EQ.1.AND.(KFLA.EQ.KFLB.OR.KFLB.EQ.KFLC)) GOTO 210
06638 IF(KFLSP.EQ.2.AND.KFLA.EQ.KFLC) GOTO 210
06639 IF(KFLSP.EQ.1) KF=1000*KFLA+100*KFLC+10*KFLB+KFLS
06640 IF(KFLSP.GE.2) KF=1000*KFLA+100*KFLB+10*KFLC+KFLS
06641 CALL LUNAME(KF,CHAP)
06642 CALL LUNAME(-KF,CHAN)
06643 WRITE(MSTU(11),6700) KF,CHAP,-KF,CHAN
06644 210 CONTINUE
06645 220 CONTINUE
06646 230 CONTINUE
06647 240 CONTINUE
06648
06649
06650 ELSEIF(MLIST.EQ.12) THEN
06651 WRITE(MSTU(11),6800)
06652 MSTJ24=MSTJ(24)
06653 MSTJ(24)=0
06654 KFMAX=30553
06655 IF(MSTU(2).NE.0) KFMAX=MSTU(2)
06656 DO 270 KF=MAX(1,MSTU(1)),KFMAX
06657 KC=LUCOMP(KF)
06658 IF(KC.EQ.0) GOTO 270
06659 IF(MSTU(14).EQ.0.AND.KF.GT.100.AND.KC.LE.100) GOTO 270
06660 IF(MSTU(14).GT.0.AND.KF.GT.100.AND.MAX(MOD(KF/1000,10),
06661 & MOD(KF/100,10)).GT.MSTU(14)) GOTO 270
06662 IF(MSTU(14).GT.0.AND.KF.GT.100.AND.KC.EQ.90) GOTO 270
06663
06664
06665 CALL LUNAME(KF,CHAP)
06666 IF(KF.LE.100.AND.CHAP.EQ.' '.AND.MDCY(KC,2).EQ.0) GOTO 270
06667 CALL LUNAME(-KF,CHAN)
06668 PM=ULMASS(KF)
06669 WRITE(MSTU(11),6900) KF,KC,CHAP,CHAN,KCHG(KC,1),KCHG(KC,2),
06670 & KCHG(KC,3),PM,PMAS(KC,2),PMAS(KC,3),PMAS(KC,4),MDCY(KC,1)
06671
06672
06673
06674 IF(KF.GT.100.AND.KC.LE.100) GOTO 270
06675 DO 260 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1
06676 DO 250 J=1,5
06677 CALL LUNAME(KFDP(IDC,J),CHAD(J))
06678 250 CONTINUE
06679 WRITE(MSTU(11),7000) IDC,MDME(IDC,1),MDME(IDC,2),BRAT(IDC),
06680 & (CHAD(J),J=1,5)
06681 260 CONTINUE
06682 270 CONTINUE
06683 MSTJ(24)=MSTJ24
06684
06685
06686 ELSEIF(MLIST.EQ.13) THEN
06687 WRITE(MSTU(11),7100)
06688 DO 280 I=1,200
06689 WRITE(MSTU(11),7200) I,MSTU(I),PARU(I),MSTJ(I),PARJ(I),PARF(I)
06690 280 CONTINUE
06691 ENDIF
06692
06693
06694 5100 FORMAT(///28X,'Event listing (summary)'//4X,'I particle/jet KS',
06695 &5X,'KF orig p_x p_y p_z E m'/)
06696 5200 FORMAT(///28X,'Event listing (standard)'//4X,'I particle/jet',
06697 &' K(I,1) K(I,2) K(I,3) K(I,4) K(I,5) P(I,1)',
06698 &' P(I,2) P(I,3) P(I,4) P(I,5)'/)
06699 5300 FORMAT(///28X,'Event listing (with vertices)'//4X,'I particle/j',
06700 &'et K(I,1) K(I,2) K(I,3) K(I,4) K(I,5) P(I,1)',
06701 &' P(I,2) P(I,3) P(I,4) P(I,5)'/73X,
06702 &'V(I,1) V(I,2) V(I,3) V(I,4) V(I,5)'/)
06703 5400 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.3)
06704 5500 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.2)
06705 5600 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.1)
06706 5700 FORMAT(1X,I4,2X,A16,1X,I3,1X,I8,2X,I4,2(3X,I1,2I4),5F13.5)
06707 5800 FORMAT(1X,I4,2X,A16,1X,I3,1X,I8,2X,I4,2(3X,I9),5F13.5)
06708 5900 FORMAT(66X,5(1X,F12.3))
06709 6000 FORMAT(1X,78('='))
06710 6100 FORMAT(1X,130('='))
06711 6200 FORMAT(19X,'sum:',F6.2,5X,5F9.3)
06712 6300 FORMAT(19X,'sum:',F6.2,5X,5F9.2)
06713 6400 FORMAT(19X,'sum:',F6.2,5X,5F9.1)
06714 6500 FORMAT(19X,'sum charge:',F6.2,3X,'sum momentum and inv. mass:',
06715 &5F13.5)
06716 6600 FORMAT(///20X,'List of KF codes in program'/)
06717 6700 FORMAT(4X,I6,4X,A16,6X,I6,4X,A16)
06718 6800 FORMAT(///30X,'Particle/parton data table'//5X,'KF',5X,'KC',4X,
06719 &'particle',8X,'antiparticle',6X,'chg col anti',8X,'mass',7X,
06720 &'width',7X,'w-cut',5X,'lifetime',1X,'decay'/11X,'IDC',1X,'on/off',
06721 &1X,'ME',3X,'Br.rat.',4X,'decay products')
06722 6900 FORMAT(/1X,I6,3X,I4,4X,A16,A16,3I5,1X,F12.5,2(1X,F11.5),
06723 &2X,F12.5,3X,I2)
06724 7000 FORMAT(10X,I4,2X,I3,2X,I3,2X,F8.5,4X,5A16)
06725 7100 FORMAT(///20X,'Parameter value table'//4X,'I',3X,'MSTU(I)',
06726 &8X,'PARU(I)',3X,'MSTJ(I)',8X,'PARJ(I)',8X,'PARF(I)')
06727 7200 FORMAT(1X,I4,1X,I9,1X,F14.5,1X,I9,1X,F14.5,1X,F14.5)
06728
06729 RETURN
06730 END
06731
06732
06733
06734 SUBROUTINE LULOGO
06735
06736
06737 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
06738 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
06739 SAVE /LUDAT1/
06740 SAVE /PYPARS/
06741 CHARACTER MONTH(12)*3, LOGO(48)*32, REFER(22)*36, LINE*79,
06742 &VERS*1, SUBV*3, DATE*2, YEAR*4
06743
06744
06745 DATA MONTH/'Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep',
06746 &'Oct','Nov','Dec'/
06747 DATA (LOGO(J),J=1,10)/
06748 &'PPP Y Y TTTTT H H III A ',
06749 &'P P Y Y T H H I A A ',
06750 &'PPP Y T HHHHH I AAAAA',
06751 &'P Y T H H I A A',
06752 &'P Y T H H III A A',
06753 &'JJJJ EEEE TTTTT SSS EEEE TTTTT',
06754 &' J E T S E T ',
06755 &' J EEE T SSS EEE T ',
06756 &'J J E T S E T ',
06757 &' JJ EEEE T SSS EEEE T '/
06758 DATA (LOGO(J),J=11,29)/
06759 &' *......* ',
06760 &' *:::!!:::::::::::* ',
06761 &' *::::::!!::::::::::::::* ',
06762 &' *::::::::!!::::::::::::::::* ',
06763 &' *:::::::::!!:::::::::::::::::* ',
06764 &' *:::::::::!!:::::::::::::::::* ',
06765 &' *::::::::!!::::::::::::::::*! ',
06766 &' *::::::!!::::::::::::::* !! ',
06767 &' !! *:::!!:::::::::::* !! ',
06768 &' !! !* -><- * !! ',
06769 &' !! !! !! ',
06770 &' !! !! !! ',
06771 &' !! !! ',
06772 &' !! ep !! ',
06773 &' !! !! ',
06774 &' !! pp !! ',
06775 &' !! e+e- !! ',
06776 &' !! !! ',
06777 &' !! '/
06778 DATA (LOGO(J),J=30,48)/
06779 &'Welcome to the Lund Monte Carlo!',
06780 &' ',
06781 &' This is PYTHIA version x.xxx ',
06782 &'Last date of change: xx xxx 199x',
06783 &' ',
06784 &' This is JETSET version x.xxx ',
06785 &'Last date of change: xx xxx 199x',
06786 &' ',
06787 &' ',
06788 &' Main author: ',
06789 &' Torbjorn Sjostrand ',
06790 &' Theory Division, CERN, ',
06791 &' CH-1211 Geneva 23, ',
06792 &' Switzerland ',
06793 &' phone +41 - 22 - 767 28 20 ',
06794 &' E-mail TORSJO@CERNVM.CERN.CH ',
06795 &' ',
06796 &' Copyright Torbjorn Sjostrand ',
06797 &' and CERN, Geneva 1993 '/
06798 DATA (REFER(J),J=1,16)/
06799 &'When you cite these programs, priori',
06800 &'ty should always be given to the ',
06801 &'latest published description. ',
06802 &' ',
06803 &'Currently this is, for JETSET ',
06804 &' ',
06805 &'T. Sjostrand and M. Bengtsson, Compu',
06806 &'ter Physics Commun. 43 (1987) 367, ',
06807 &'and for PYTHIA ',
06808 &' ',
06809 &'H.-U. Bengtsson and T. Sjostrand, Co',
06810 &'mputer Physics Commun. 46 (1987) 43.',
06811 &'The most recent long description (un',
06812 &'published) is: ',
06813 &'T. Sjostrand, CERN-TH.7112/93 (1993)',
06814 &'. '/
06815 DATA (REFER(J),J=17,22)/
06816 &'Also remember that the programs, to ',
06817 &'a large extent, represent original ',
06818 &'physics research. Other publications',
06819 &' of special relevance to your ',
06820 &'studies may therefore deserve separa',
06821 &'te mention. '/
06822
06823
06824 IF(MSTP(183)/10.NE.199) THEN
06825 LOGO(32)=' Warning: PYTHIA is not loaded! '
06826 LOGO(33)='Did you remember to link PYDATA?'
06827 ELSE
06828 WRITE(VERS,'(I1)') MSTP(181)
06829 LOGO(32)(26:26)=VERS
06830 WRITE(SUBV,'(I3)') MSTP(182)
06831 LOGO(32)(28:30)=SUBV
06832 WRITE(DATE,'(I2)') MSTP(185)
06833 LOGO(33)(22:23)=DATE
06834 LOGO(33)(25:27)=MONTH(MSTP(184))
06835 WRITE(YEAR,'(I4)') MSTP(183)
06836 LOGO(33)(29:32)=YEAR
06837 ENDIF
06838
06839
06840 IF(MSTU(183)/10.NE.199) THEN
06841 LOGO(35)=' Error: JETSET is not loaded! '
06842 LOGO(36)='Did you remember to link LUDATA?'
06843 ELSE
06844 WRITE(VERS,'(I1)') MSTU(181)
06845 LOGO(35)(26:26)=VERS
06846 WRITE(SUBV,'(I3)') MSTU(182)
06847 LOGO(35)(28:30)=SUBV
06848 WRITE(DATE,'(I2)') MSTU(185)
06849 LOGO(36)(22:23)=DATE
06850 LOGO(36)(25:27)=MONTH(MSTU(184))
06851 WRITE(YEAR,'(I4)') MSTU(183)
06852 LOGO(36)(29:32)=YEAR
06853 ENDIF
06854
06855
06856 DO 100 ILIN=1,48
06857 LINE=' '
06858 IF(ILIN.EQ.1) THEN
06859 LINE(1:1)='1'
06860 ELSE
06861 LINE(2:3)='**'
06862 LINE(78:79)='**'
06863 ENDIF
06864
06865
06866 IF(ILIN.EQ.2.OR.ILIN.EQ.3.OR.ILIN.EQ.47.OR.ILIN.EQ.48) THEN
06867 LINE(4:77)='***********************************************'//
06868 & '***************************'
06869 ELSEIF(ILIN.GE.6.AND.ILIN.LE.10) THEN
06870 LINE(6:37)=LOGO(ILIN-5)
06871 LINE(44:75)=LOGO(ILIN)
06872 ELSEIF(ILIN.GE.13.AND.ILIN.LE.31) THEN
06873 LINE(6:37)=LOGO(ILIN-2)
06874 LINE(44:75)=LOGO(ILIN+17)
06875 ELSEIF(ILIN.GE.34.AND.ILIN.LE.44) THEN
06876 LINE(5:40)=REFER(2*ILIN-67)
06877 LINE(41:76)=REFER(2*ILIN-66)
06878 ENDIF
06879
06880
06881 IF(MSTU(183)/10.EQ.199) THEN
06882 WRITE(MSTU(11),'(A79)') LINE
06883 ELSE
06884 WRITE(*,'(A79)') LINE
06885 ENDIF
06886 100 CONTINUE
06887
06888
06889 IF(MSTU(183)/10.EQ.199.AND.MSTP(183)/10.EQ.199) THEN
06890 IF(MSTU(182).LT.MSTP(186)) WRITE(MSTU(11),
06891 & '(/'' Warning: JETSET subversion too old for PYTHIA''/)')
06892 IF(MSTP(182).LT.MSTU(186)) WRITE(MSTU(11),
06893 & '(/'' Warning: PYTHIA subversion too old for JETSET''/)')
06894 ENDIF
06895
06896 RETURN
06897 END
06898
06899
06900
06901 SUBROUTINE LUUPDA(MUPDA,LFN)
06902
06903
06904 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
06905 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
06906 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
06907 COMMON/LUDAT4/CHAF(500)
06908 CHARACTER CHAF*8
06909 SAVE /LUDAT1/,/LUDAT2/,/LUDAT3/,/LUDAT4/
06910 CHARACTER CHINL*80,CHKC*4,CHVAR(19)*9,CHLIN*72,
06911 &CHBLK(20)*72,CHOLD*12,CHTMP*12,CHNEW*12,CHCOM*12
06912 DATA CHVAR/ 'KCHG(I,1)','KCHG(I,2)','KCHG(I,3)','PMAS(I,1)',
06913 &'PMAS(I,2)','PMAS(I,3)','PMAS(I,4)','MDCY(I,1)','MDCY(I,2)',
06914 &'MDCY(I,3)','MDME(I,1)','MDME(I,2)','BRAT(I) ','KFDP(I,1)',
06915 &'KFDP(I,2)','KFDP(I,3)','KFDP(I,4)','KFDP(I,5)','CHAF(I) '/
06916
06917
06918 IF(MSTU(12).GE.1) CALL LULIST(0)
06919 IF(MUPDA.EQ.1) THEN
06920 DO 110 KC=1,MSTU(6)
06921 WRITE(LFN,5000) KC,CHAF(KC),(KCHG(KC,J1),J1=1,3),
06922 & (PMAS(KC,J2),J2=1,4),MDCY(KC,1)
06923 DO 100 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1
06924 WRITE(LFN,5100) MDME(IDC,1),MDME(IDC,2),BRAT(IDC),
06925 & (KFDP(IDC,J),J=1,5)
06926 100 CONTINUE
06927 110 CONTINUE
06928
06929
06930 ELSEIF(MUPDA.EQ.2) THEN
06931 DO 130 I=1,MSTU(7)
06932 MDME(I,1)=1
06933 MDME(I,2)=0
06934 BRAT(I)=0.
06935 DO 120 J=1,5
06936 KFDP(I,J)=0
06937 120 CONTINUE
06938 130 CONTINUE
06939 KC=0
06940 IDC=0
06941 NDC=0
06942 140 READ(LFN,5200,END=150) CHINL
06943 IF(CHINL(2:5).NE.' ') THEN
06944 CHKC=CHINL(2:5)
06945 IF(KC.NE.0) THEN
06946 MDCY(KC,2)=0
06947 IF(NDC.NE.0) MDCY(KC,2)=IDC+1-NDC
06948 MDCY(KC,3)=NDC
06949 ENDIF
06950 READ(CHKC,5300) KC
06951 IF(KC.LE.0.OR.KC.GT.MSTU(6)) CALL LUERRM(27,
06952 & '(LUUPDA:) Read KC code illegal, KC ='//CHKC)
06953 READ(CHINL,5000) KCR,CHAF(KC),(KCHG(KC,J1),J1=1,3),
06954 & (PMAS(KC,J2),J2=1,4),MDCY(KC,1)
06955 NDC=0
06956 ELSE
06957 IDC=IDC+1
06958 NDC=NDC+1
06959 IF(IDC.GE.MSTU(7)) CALL LUERRM(27,
06960 & '(LUUPDA:) Decay data arrays full by KC ='//CHKC)
06961 READ(CHINL,5100) MDME(IDC,1),MDME(IDC,2),BRAT(IDC),
06962 & (KFDP(IDC,J),J=1,5)
06963 ENDIF
06964 GOTO 140
06965 150 MDCY(KC,2)=0
06966 IF(NDC.NE.0) MDCY(KC,2)=IDC+1-NDC
06967 MDCY(KC,3)=NDC
06968
06969
06970 MSTJ24=MSTJ(24)
06971 MSTJ(24)=0
06972 DO 180 KC=1,MSTU(6)
06973 WRITE(CHKC,5300) KC
06974 IF(MIN(PMAS(KC,1),PMAS(KC,2),PMAS(KC,3),PMAS(KC,1)-PMAS(KC,3),
06975 & PMAS(KC,4)).LT.0..OR.MDCY(KC,3).LT.0) CALL LUERRM(17,
06976 & '(LUUPDA:) Mass/width/life/(# channels) wrong for KC ='//CHKC)
06977 BRSUM=0.
06978 DO 170 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1
06979 IF(MDME(IDC,2).GT.80) GOTO 170
06980 KQ=KCHG(KC,1)
06981 PMS=PMAS(KC,1)-PMAS(KC,3)-PARJ(64)
06982 MERR=0
06983 DO 160 J=1,5
06984 KP=KFDP(IDC,J)
06985 IF(KP.EQ.0.OR.KP.EQ.81.OR.IABS(KP).EQ.82) THEN
06986 ELSEIF(LUCOMP(KP).EQ.0) THEN
06987 MERR=3
06988 ELSE
06989 KQ=KQ-LUCHGE(KP)
06990 PMS=PMS-ULMASS(KP)
06991 ENDIF
06992 160 CONTINUE
06993 IF(KQ.NE.0) MERR=MAX(2,MERR)
06994 IF(KFDP(IDC,2).NE.0.AND.(KC.LE.20.OR.KC.GT.40).AND.
06995 & (KC.LE.80.OR.KC.GT.100).AND.MDME(IDC,2).NE.34.AND.
06996 & MDME(IDC,2).NE.61.AND.PMS.LT.0.) MERR=MAX(1,MERR)
06997 IF(MERR.EQ.3) CALL LUERRM(17,
06998 & '(LUUPDA:) Unknown particle code in decay of KC ='//CHKC)
06999 IF(MERR.EQ.2) CALL LUERRM(17,
07000 & '(LUUPDA:) Charge not conserved in decay of KC ='//CHKC)
07001 IF(MERR.EQ.1) CALL LUERRM(7,
07002 & '(LUUPDA:) Kinematically unallowed decay of KC ='//CHKC)
07003 BRSUM=BRSUM+BRAT(IDC)
07004 170 CONTINUE
07005 WRITE(CHTMP,5500) BRSUM
07006 IF(ABS(BRSUM).GT.0.0005.AND.ABS(BRSUM-1.).GT.0.0005) CALL
07007 & LUERRM(7,'(LUUPDA:) Sum of branching ratios is '//CHTMP(5:12)//
07008 & ' for KC ='//CHKC)
07009 180 CONTINUE
07010 MSTJ(24)=MSTJ24
07011
07012
07013 ELSEIF(MUPDA.EQ.3) THEN
07014 DO 250 IVAR=1,19
07015 NDIM=MSTU(6)
07016 IF(IVAR.GE.11.AND.IVAR.LE.18) NDIM=MSTU(7)
07017 NLIN=1
07018 CHLIN=' '
07019 CHLIN(7:35)='DATA ('//CHVAR(IVAR)//',I= 1, )/'
07020 LLIN=35
07021 CHOLD='START'
07022
07023
07024 DO 230 IDIM=1,NDIM
07025 IF(IVAR.EQ.1) WRITE(CHTMP,5400) KCHG(IDIM,1)
07026 IF(IVAR.EQ.2) WRITE(CHTMP,5400) KCHG(IDIM,2)
07027 IF(IVAR.EQ.3) WRITE(CHTMP,5400) KCHG(IDIM,3)
07028 IF(IVAR.EQ.4) WRITE(CHTMP,5500) PMAS(IDIM,1)
07029 IF(IVAR.EQ.5) WRITE(CHTMP,5500) PMAS(IDIM,2)
07030 IF(IVAR.EQ.6) WRITE(CHTMP,5500) PMAS(IDIM,3)
07031 IF(IVAR.EQ.7) WRITE(CHTMP,5500) PMAS(IDIM,4)
07032 IF(IVAR.EQ.8) WRITE(CHTMP,5400) MDCY(IDIM,1)
07033 IF(IVAR.EQ.9) WRITE(CHTMP,5400) MDCY(IDIM,2)
07034 IF(IVAR.EQ.10) WRITE(CHTMP,5400) MDCY(IDIM,3)
07035 IF(IVAR.EQ.11) WRITE(CHTMP,5400) MDME(IDIM,1)
07036 IF(IVAR.EQ.12) WRITE(CHTMP,5400) MDME(IDIM,2)
07037 IF(IVAR.EQ.13) WRITE(CHTMP,5500) BRAT(IDIM)
07038 IF(IVAR.EQ.14) WRITE(CHTMP,5400) KFDP(IDIM,1)
07039 IF(IVAR.EQ.15) WRITE(CHTMP,5400) KFDP(IDIM,2)
07040 IF(IVAR.EQ.16) WRITE(CHTMP,5400) KFDP(IDIM,3)
07041 IF(IVAR.EQ.17) WRITE(CHTMP,5400) KFDP(IDIM,4)
07042 IF(IVAR.EQ.18) WRITE(CHTMP,5400) KFDP(IDIM,5)
07043 IF(IVAR.EQ.19) CHTMP=CHAF(IDIM)
07044
07045
07046 LLOW=1
07047 LHIG=1
07048 DO 190 LL=1,12
07049 IF(CHTMP(13-LL:13-LL).NE.' ') LLOW=13-LL
07050 IF(CHTMP(LL:LL).NE.' ') LHIG=LL
07051 190 CONTINUE
07052 CHNEW=CHTMP(LLOW:LHIG)//' '
07053 LNEW=1+LHIG-LLOW
07054 IF((IVAR.GE.4.AND.IVAR.LE.7).OR.IVAR.EQ.13) THEN
07055 LNEW=LNEW+1
07056 200 LNEW=LNEW-1
07057 IF(CHNEW(LNEW:LNEW).EQ.'0') GOTO 200
07058 IF(LNEW.EQ.1) CHNEW(1:2)='0.'
07059 IF(LNEW.EQ.1) LNEW=2
07060 ELSEIF(IVAR.EQ.19) THEN
07061 DO 210 LL=LNEW,1,-1
07062 IF(CHNEW(LL:LL).EQ.'''') THEN
07063 CHTMP=CHNEW
07064 CHNEW=CHTMP(1:LL)//''''//CHTMP(LL+1:11)
07065 LNEW=LNEW+1
07066 ENDIF
07067 210 CONTINUE
07068 CHTMP=CHNEW
07069 CHNEW(1:LNEW+2)=''''//CHTMP(1:LNEW)//''''
07070 LNEW=LNEW+2
07071 ENDIF
07072
07073
07074 IF(CHNEW.NE.CHOLD) THEN
07075 NRPT=1
07076 CHOLD=CHNEW
07077 CHCOM=CHNEW
07078 LCOM=LNEW
07079 ELSE
07080 LRPT=LNEW+1
07081 IF(NRPT.GE.2) LRPT=LNEW+3
07082 IF(NRPT.GE.10) LRPT=LNEW+4
07083 IF(NRPT.GE.100) LRPT=LNEW+5
07084 IF(NRPT.GE.1000) LRPT=LNEW+6
07085 LLIN=LLIN-LRPT
07086 NRPT=NRPT+1
07087 WRITE(CHTMP,5400) NRPT
07088 LRPT=1
07089 IF(NRPT.GE.10) LRPT=2
07090 IF(NRPT.GE.100) LRPT=3
07091 IF(NRPT.GE.1000) LRPT=4
07092 CHCOM(1:LRPT+1+LNEW)=CHTMP(13-LRPT:12)//'*'//CHNEW(1:LNEW)
07093 LCOM=LRPT+1+LNEW
07094 ENDIF
07095
07096
07097
07098 IF(LLIN+LCOM.LE.70) THEN
07099 CHLIN(LLIN+1:LLIN+LCOM+1)=CHCOM(1:LCOM)//','
07100 LLIN=LLIN+LCOM+1
07101 ELSEIF(NLIN.LE.19) THEN
07102 CHLIN(LLIN+1:72)=' '
07103 CHBLK(NLIN)=CHLIN
07104 NLIN=NLIN+1
07105 CHLIN(6:6+LCOM+1)='&'//CHCOM(1:LCOM)//','
07106 LLIN=6+LCOM+1
07107 ELSE
07108 CHLIN(LLIN:72)='/'//' '
07109 CHBLK(NLIN)=CHLIN
07110 WRITE(CHTMP,5400) IDIM-NRPT
07111 CHBLK(1)(30:33)=CHTMP(9:12)
07112 DO 220 ILIN=1,NLIN
07113 WRITE(LFN,5600) CHBLK(ILIN)
07114 220 CONTINUE
07115 NLIN=1
07116 CHLIN=' '
07117 CHLIN(7:35+LCOM+1)='DATA ('//CHVAR(IVAR)//',I= , )/'//
07118 & CHCOM(1:LCOM)//','
07119 WRITE(CHTMP,5400) IDIM-NRPT+1
07120 CHLIN(25:28)=CHTMP(9:12)
07121 LLIN=35+LCOM+1
07122 ENDIF
07123 230 CONTINUE
07124
07125
07126 CHLIN(LLIN:72)='/'//' '
07127 CHBLK(NLIN)=CHLIN
07128 WRITE(CHTMP,5400) NDIM
07129 CHBLK(1)(30:33)=CHTMP(9:12)
07130 DO 240 ILIN=1,NLIN
07131 WRITE(LFN,5600) CHBLK(ILIN)
07132 240 CONTINUE
07133 250 CONTINUE
07134 ENDIF
07135
07136
07137 5000 FORMAT(1X,I4,2X,A8,3I3,3F12.5,2X,F12.5,I3)
07138 5100 FORMAT(5X,2I5,F12.5,5I8)
07139 5200 FORMAT(A80)
07140 5300 FORMAT(I4)
07141 5400 FORMAT(I12)
07142 5500 FORMAT(F12.5)
07143 5600 FORMAT(A72)
07144
07145 RETURN
07146 END
07147
07148
07149
07150 FUNCTION KLU(I,J)
07151
07152
07153 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
07154 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
07155 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
07156 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
07157
07158
07159
07160 KLU=0
07161 IF(I.LT.0.OR.I.GT.MSTU(4).OR.J.LE.0) THEN
07162 ELSEIF(I.EQ.0.AND.J.EQ.1) THEN
07163 KLU=N
07164 ELSEIF(I.EQ.0.AND.(J.EQ.2.OR.J.EQ.6)) THEN
07165 DO 100 I1=1,N
07166 IF(J.EQ.2.AND.K(I1,1).GE.1.AND.K(I1,1).LE.10) KLU=KLU+1
07167 IF(J.EQ.6.AND.K(I1,1).GE.1.AND.K(I1,1).LE.10) KLU=KLU+
07168 & LUCHGE(K(I1,2))
07169 100 CONTINUE
07170 ELSEIF(I.EQ.0) THEN
07171
07172
07173 ELSEIF(J.LE.5) THEN
07174 KLU=K(I,J)
07175 ELSEIF(J.EQ.6) THEN
07176 KLU=LUCHGE(K(I,2))
07177
07178
07179 ELSEIF(J.LE.8) THEN
07180 IF(K(I,1).GE.1.AND.K(I,1).LE.10) KLU=1
07181 IF(J.EQ.8) KLU=KLU*K(I,2)
07182 ELSEIF(J.LE.12) THEN
07183 KFA=IABS(K(I,2))
07184 KC=LUCOMP(KFA)
07185 KQ=0
07186 IF(KC.NE.0) KQ=KCHG(KC,2)
07187 IF(J.EQ.9.AND.KC.NE.0.AND.KQ.NE.0) KLU=K(I,2)
07188 IF(J.EQ.10.AND.KC.NE.0.AND.KQ.EQ.0) KLU=K(I,2)
07189 IF(J.EQ.11) KLU=KC
07190 IF(J.EQ.12) KLU=KQ*ISIGN(1,K(I,2))
07191
07192
07193 ELSEIF(J.EQ.13) THEN
07194 KFA=IABS(K(I,2))
07195 KLU=MOD(KFA/100,10)*(-1)**MOD(KFA/100,10)
07196 IF(KFA.LT.10) KLU=KFA
07197 IF(MOD(KFA/1000,10).NE.0) KLU=MOD(KFA/1000,10)
07198 KLU=KLU*ISIGN(1,K(I,2))
07199
07200
07201 ELSEIF(J.LE.16) THEN
07202 I2=I
07203 I1=I
07204 110 KLU=KLU+1
07205 I3=I2
07206 I2=I1
07207 I1=K(I1,3)
07208 IF(I1.GT.0.AND.K(I1,1).GT.0.AND.K(I1,1).LE.20) GOTO 110
07209 IF(J.EQ.15) KLU=I2
07210 IF(J.EQ.16) THEN
07211 KLU=0
07212 DO 120 I1=I2+1,I3
07213 IF(K(I1,3).EQ.I2.AND.K(I1,1).GT.0.AND.K(I1,1).LE.20) KLU=KLU+1
07214 120 CONTINUE
07215 ENDIF
07216
07217
07218 ELSEIF(J.EQ.17) THEN
07219 I1=I
07220 130 KLU=KLU+1
07221 I3=I1
07222 I1=K(I1,3)
07223 I0=MAX(1,I1)
07224 KC=LUCOMP(K(I0,2))
07225 IF(I1.EQ.0.OR.K(I0,1).LE.0.OR.K(I0,1).GT.20.OR.KC.EQ.0) THEN
07226 IF(KLU.EQ.1) KLU=-1
07227 IF(KLU.GT.1) KLU=0
07228 RETURN
07229 ENDIF
07230 IF(KCHG(KC,2).EQ.0) GOTO 130
07231 IF(K(I1,1).NE.12) KLU=0
07232 IF(K(I1,1).NE.12) RETURN
07233 I2=I1
07234 140 I2=I2+1
07235 IF(I2.LT.N.AND.K(I2,1).NE.11) GOTO 140
07236 K3M=K(I3-1,3)
07237 IF(K3M.GE.I1.AND.K3M.LE.I2) KLU=0
07238 K3P=K(I3+1,3)
07239 IF(I3.LT.N.AND.K3P.GE.I1.AND.K3P.LE.I2) KLU=0
07240
07241
07242 ELSEIF(J.EQ.18) THEN
07243 IF(K(I,1).EQ.11.OR.K(I,1).EQ.12) KLU=MAX(0,K(I,5)-K(I,4)+1)
07244 IF(K(I,4).EQ.0.OR.K(I,5).EQ.0) KLU=0
07245 ELSEIF(J.LE.22) THEN
07246 IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) RETURN
07247 IF(J.EQ.19) KLU=MOD(K(I,4)/MSTU(5),MSTU(5))
07248 IF(J.EQ.20) KLU=MOD(K(I,5)/MSTU(5),MSTU(5))
07249 IF(J.EQ.21) KLU=MOD(K(I,4),MSTU(5))
07250 IF(J.EQ.22) KLU=MOD(K(I,5),MSTU(5))
07251 ELSE
07252 ENDIF
07253
07254 RETURN
07255 END
07256
07257
07258
07259 FUNCTION PLU(I,J)
07260
07261
07262 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
07263 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
07264 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
07265 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
07266 DIMENSION PSUM(4)
07267
07268
07269
07270 PLU=0.
07271 IF(I.LT.0.OR.I.GT.MSTU(4).OR.J.LE.0) THEN
07272 ELSEIF(I.EQ.0.AND.J.LE.4) THEN
07273 DO 100 I1=1,N
07274 IF(K(I1,1).GT.0.AND.K(I1,1).LE.10) PLU=PLU+P(I1,J)
07275 100 CONTINUE
07276 ELSEIF(I.EQ.0.AND.J.EQ.5) THEN
07277 DO 120 J1=1,4
07278 PSUM(J1)=0.
07279 DO 110 I1=1,N
07280 IF(K(I1,1).GT.0.AND.K(I1,1).LE.10) PSUM(J1)=PSUM(J1)+P(I1,J1)
07281 110 CONTINUE
07282 120 CONTINUE
07283 PLU=SQRT(MAX(0.,PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-PSUM(3)**2))
07284 ELSEIF(I.EQ.0.AND.J.EQ.6) THEN
07285 DO 130 I1=1,N
07286 IF(K(I1,1).GT.0.AND.K(I1,1).LE.10) PLU=PLU+LUCHGE(K(I1,2))/3.
07287 130 CONTINUE
07288 ELSEIF(I.EQ.0) THEN
07289
07290
07291 ELSEIF(J.LE.5) THEN
07292 PLU=P(I,J)
07293
07294
07295 ELSEIF(J.LE.12) THEN
07296 IF(J.EQ.6) PLU=LUCHGE(K(I,2))/3.
07297 IF(J.EQ.7.OR.J.EQ.8) PLU=P(I,1)**2+P(I,2)**2+P(I,3)**2
07298 IF(J.EQ.9.OR.J.EQ.10) PLU=P(I,1)**2+P(I,2)**2
07299 IF(J.EQ.11.OR.J.EQ.12) PLU=P(I,5)**2+P(I,1)**2+P(I,2)**2
07300 IF(J.EQ.8.OR.J.EQ.10.OR.J.EQ.12) PLU=SQRT(PLU)
07301
07302
07303 ELSEIF(J.LE.16) THEN
07304 IF(J.LE.14) PLU=ULANGL(P(I,3),SQRT(P(I,1)**2+P(I,2)**2))
07305 IF(J.GE.15) PLU=ULANGL(P(I,1),P(I,2))
07306 IF(J.EQ.14.OR.J.EQ.16) PLU=PLU*180./PARU(1)
07307
07308
07309 ELSEIF(J.LE.19) THEN
07310 PMR=0.
07311 IF(J.EQ.17) PMR=P(I,5)
07312 IF(J.EQ.18) PMR=ULMASS(211)
07313 PR=MAX(1E-20,PMR**2+P(I,1)**2+P(I,2)**2)
07314 PLU=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/SQRT(PR),
07315 & 1E20)),P(I,3))
07316
07317
07318 ELSEIF(J.LE.25) THEN
07319 IF(J.EQ.20) PLU=2.*SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)/PARU(21)
07320 IF(J.EQ.21) PLU=2.*P(I,3)/PARU(21)
07321 IF(J.EQ.22) PLU=2.*SQRT(P(I,1)**2+P(I,2)**2)/PARU(21)
07322 IF(J.EQ.23) PLU=2.*P(I,4)/PARU(21)
07323 IF(J.EQ.24) PLU=(P(I,4)+P(I,3))/PARU(21)
07324 IF(J.EQ.25) PLU=(P(I,4)-P(I,3))/PARU(21)
07325 ENDIF
07326
07327 RETURN
07328 END
07329
07330
07331
07332 SUBROUTINE LUSPHE(SPH,APL)
07333
07334
07335
07336 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
07337 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
07338 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
07339 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
07340 DIMENSION SM(3,3),SV(3,3)
07341
07342
07343 NP=0
07344 DO 110 J1=1,3
07345 DO 100 J2=J1,3
07346 SM(J1,J2)=0.
07347 100 CONTINUE
07348 110 CONTINUE
07349 PS=0.
07350 DO 140 I=1,N
07351 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 140
07352 IF(MSTU(41).GE.2) THEN
07353 KC=LUCOMP(K(I,2))
07354 IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
07355 & KC.EQ.18) GOTO 140
07356 IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
07357 & GOTO 140
07358 ENDIF
07359 NP=NP+1
07360 PA=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)
07361 PWT=1.
07362 IF(ABS(PARU(41)-2.).GT.0.001) PWT=MAX(1E-10,PA)**(PARU(41)-2.)
07363 DO 130 J1=1,3
07364 DO 120 J2=J1,3
07365 SM(J1,J2)=SM(J1,J2)+PWT*P(I,J1)*P(I,J2)
07366 120 CONTINUE
07367 130 CONTINUE
07368 PS=PS+PWT*PA**2
07369 140 CONTINUE
07370
07371
07372 IF(NP.LE.1) THEN
07373 CALL LUERRM(8,'(LUSPHE:) too few particles for analysis')
07374 SPH=-1.
07375 APL=-1.
07376 RETURN
07377 ENDIF
07378 DO 160 J1=1,3
07379 DO 150 J2=J1,3
07380 SM(J1,J2)=SM(J1,J2)/PS
07381 150 CONTINUE
07382 160 CONTINUE
07383
07384
07385 SQ=(SM(1,1)*SM(2,2)+SM(1,1)*SM(3,3)+SM(2,2)*SM(3,3)-SM(1,2)**2-
07386 &SM(1,3)**2-SM(2,3)**2)/3.-1./9.
07387 SR=-0.5*(SQ+1./9.+SM(1,1)*SM(2,3)**2+SM(2,2)*SM(1,3)**2+SM(3,3)*
07388 &SM(1,2)**2-SM(1,1)*SM(2,2)*SM(3,3))+SM(1,2)*SM(1,3)*SM(2,3)+1./27.
07389 SP=COS(ACOS(MAX(MIN(SR/SQRT(-SQ**3),1.),-1.))/3.)
07390 P(N+1,4)=1./3.+SQRT(-SQ)*MAX(2.*SP,SQRT(3.*(1.-SP**2))-SP)
07391 P(N+3,4)=1./3.+SQRT(-SQ)*MIN(2.*SP,-SQRT(3.*(1.-SP**2))-SP)
07392 P(N+2,4)=1.-P(N+1,4)-P(N+3,4)
07393 IF(P(N+2,4).LT.1E-5) THEN
07394 CALL LUERRM(8,'(LUSPHE:) all particles back-to-back')
07395 SPH=-1.
07396 APL=-1.
07397 RETURN
07398 ENDIF
07399
07400
07401 DO 240 I=1,3,2
07402 DO 180 J1=1,3
07403 SV(J1,J1)=SM(J1,J1)-P(N+I,4)
07404 DO 170 J2=J1+1,3
07405 SV(J1,J2)=SM(J1,J2)
07406 SV(J2,J1)=SM(J1,J2)
07407 170 CONTINUE
07408 180 CONTINUE
07409 SMAX=0.
07410 DO 200 J1=1,3
07411 DO 190 J2=1,3
07412 IF(ABS(SV(J1,J2)).LE.SMAX) GOTO 190
07413 JA=J1
07414 JB=J2
07415 SMAX=ABS(SV(J1,J2))
07416 190 CONTINUE
07417 200 CONTINUE
07418 SMAX=0.
07419 DO 220 J3=JA+1,JA+2
07420 J1=J3-3*((J3-1)/3)
07421 RL=SV(J1,JB)/SV(JA,JB)
07422 DO 210 J2=1,3
07423 SV(J1,J2)=SV(J1,J2)-RL*SV(JA,J2)
07424 IF(ABS(SV(J1,J2)).LE.SMAX) GOTO 210
07425 JC=J1
07426 SMAX=ABS(SV(J1,J2))
07427 210 CONTINUE
07428 220 CONTINUE
07429 JB1=JB+1-3*(JB/3)
07430 JB2=JB+2-3*((JB+1)/3)
07431 P(N+I,JB1)=-SV(JC,JB2)
07432 P(N+I,JB2)=SV(JC,JB1)
07433 P(N+I,JB)=-(SV(JA,JB1)*P(N+I,JB1)+SV(JA,JB2)*P(N+I,JB2))/
07434 &SV(JA,JB)
07435 PA=SQRT(P(N+I,1)**2+P(N+I,2)**2+P(N+I,3)**2)
07436 SGN=(-1.)**INT(RLU(0)+0.5)
07437 DO 230 J=1,3
07438 P(N+I,J)=SGN*P(N+I,J)/PA
07439 230 CONTINUE
07440 240 CONTINUE
07441
07442
07443 SGN=(-1.)**INT(RLU(0)+0.5)
07444 P(N+2,1)=SGN*(P(N+1,2)*P(N+3,3)-P(N+1,3)*P(N+3,2))
07445 P(N+2,2)=SGN*(P(N+1,3)*P(N+3,1)-P(N+1,1)*P(N+3,3))
07446 P(N+2,3)=SGN*(P(N+1,1)*P(N+3,2)-P(N+1,2)*P(N+3,1))
07447 DO 260 I=1,3
07448 K(N+I,1)=31
07449 K(N+I,2)=95
07450 K(N+I,3)=I
07451 K(N+I,4)=0
07452 K(N+I,5)=0
07453 P(N+I,5)=0.
07454 DO 250 J=1,5
07455 V(I,J)=0.
07456 250 CONTINUE
07457 260 CONTINUE
07458
07459
07460 SPH=1.5*(P(N+2,4)+P(N+3,4))
07461 APL=1.5*P(N+3,4)
07462 MSTU(61)=N+1
07463 MSTU(62)=NP
07464 IF(MSTU(43).LE.1) MSTU(3)=3
07465 IF(MSTU(43).GE.2) N=N+3
07466
07467 RETURN
07468 END
07469
07470
07471
07472 SUBROUTINE LUTHRU(THR,OBL)
07473
07474
07475
07476 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
07477 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
07478 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
07479 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
07480 DIMENSION TDI(3),TPR(3)
07481
07482
07483 NP=0
07484 PS=0.
07485 DO 100 I=1,N
07486 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 100
07487 IF(MSTU(41).GE.2) THEN
07488 KC=LUCOMP(K(I,2))
07489 IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
07490 & KC.EQ.18) GOTO 100
07491 IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
07492 & GOTO 100
07493 ENDIF
07494 IF(N+NP+MSTU(44)+15.GE.MSTU(4)-MSTU(32)-5) THEN
07495 CALL LUERRM(11,'(LUTHRU:) no more memory left in LUJETS')
07496 THR=-2.
07497 OBL=-2.
07498 RETURN
07499 ENDIF
07500 NP=NP+1
07501 K(N+NP,1)=23
07502 P(N+NP,1)=P(I,1)
07503 P(N+NP,2)=P(I,2)
07504 P(N+NP,3)=P(I,3)
07505 P(N+NP,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)
07506 P(N+NP,5)=1.
07507 IF(ABS(PARU(42)-1.).GT.0.001) P(N+NP,5)=P(N+NP,4)**(PARU(42)-1.)
07508 PS=PS+P(N+NP,4)*P(N+NP,5)
07509 100 CONTINUE
07510
07511
07512 IF(NP.LE.1) THEN
07513 CALL LUERRM(8,'(LUTHRU:) too few particles for analysis')
07514 THR=-1.
07515 OBL=-1.
07516 RETURN
07517 ENDIF
07518
07519
07520 DO 320 ILD=1,2
07521 IF(ILD.EQ.2) THEN
07522 K(N+NP+1,1)=31
07523 PHI=ULANGL(P(N+NP+1,1),P(N+NP+1,2))
07524 MSTU(33)=1
07525 CALL LUDBRB(N+1,N+NP+1,0.,-PHI,0D0,0D0,0D0)
07526 THE=ULANGL(P(N+NP+1,3),P(N+NP+1,1))
07527 CALL LUDBRB(N+1,N+NP+1,-THE,0.,0D0,0D0,0D0)
07528 ENDIF
07529
07530
07531 DO 110 ILF=N+NP+4,N+NP+MSTU(44)+4
07532 P(ILF,4)=0.
07533 110 CONTINUE
07534 DO 160 I=N+1,N+NP
07535 IF(ILD.EQ.2) P(I,4)=SQRT(P(I,1)**2+P(I,2)**2)
07536 DO 130 ILF=N+NP+MSTU(44)+3,N+NP+4,-1
07537 IF(P(I,4).LE.P(ILF,4)) GOTO 140
07538 DO 120 J=1,5
07539 P(ILF+1,J)=P(ILF,J)
07540 120 CONTINUE
07541 130 CONTINUE
07542 ILF=N+NP+3
07543 140 DO 150 J=1,5
07544 P(ILF+1,J)=P(I,J)
07545 150 CONTINUE
07546 160 CONTINUE
07547
07548
07549 DO 170 ILG=N+NP+MSTU(44)+5,N+NP+MSTU(44)+15
07550 P(ILG,4)=0.
07551 170 CONTINUE
07552 NC=2**(MIN(MSTU(44),NP)-1)
07553 DO 250 ILC=1,NC
07554 DO 180 J=1,3
07555 TDI(J)=0.
07556 180 CONTINUE
07557 DO 200 ILF=1,MIN(MSTU(44),NP)
07558 SGN=P(N+NP+ILF+3,5)
07559 IF(2**ILF*((ILC+2**(ILF-1)-1)/2**ILF).GE.ILC) SGN=-SGN
07560 DO 190 J=1,4-ILD
07561 TDI(J)=TDI(J)+SGN*P(N+NP+ILF+3,J)
07562 190 CONTINUE
07563 200 CONTINUE
07564 TDS=TDI(1)**2+TDI(2)**2+TDI(3)**2
07565 DO 220 ILG=N+NP+MSTU(44)+MIN(ILC,10)+4,N+NP+MSTU(44)+5,-1
07566 IF(TDS.LE.P(ILG,4)) GOTO 230
07567 DO 210 J=1,4
07568 P(ILG+1,J)=P(ILG,J)
07569 210 CONTINUE
07570 220 CONTINUE
07571 ILG=N+NP+MSTU(44)+4
07572 230 DO 240 J=1,3
07573 P(ILG+1,J)=TDI(J)
07574 240 CONTINUE
07575 P(ILG+1,4)=TDS
07576 250 CONTINUE
07577
07578
07579 P(N+NP+ILD,4)=0.
07580 ILG=0
07581 260 ILG=ILG+1
07582 THP=0.
07583 270 THPS=THP
07584 DO 280 J=1,3
07585 IF(THP.LE.1E-10) TDI(J)=P(N+NP+MSTU(44)+4+ILG,J)
07586 IF(THP.GT.1E-10) TDI(J)=TPR(J)
07587 TPR(J)=0.
07588 280 CONTINUE
07589 DO 300 I=N+1,N+NP
07590 SGN=SIGN(P(I,5),TDI(1)*P(I,1)+TDI(2)*P(I,2)+TDI(3)*P(I,3))
07591 DO 290 J=1,4-ILD
07592 TPR(J)=TPR(J)+SGN*P(I,J)
07593 290 CONTINUE
07594 300 CONTINUE
07595 THP=SQRT(TPR(1)**2+TPR(2)**2+TPR(3)**2)/PS
07596 IF(THP.GE.THPS+PARU(48)) GOTO 270
07597
07598
07599 IF(THP.LT.P(N+NP+ILD,4)-PARU(48).AND.ILG.LT.MIN(10,NC)) GOTO 260
07600 IF(THP.GT.P(N+NP+ILD,4)+PARU(48)) THEN
07601 IAGR=0
07602 SGN=(-1.)**INT(RLU(0)+0.5)
07603 DO 310 J=1,3
07604 P(N+NP+ILD,J)=SGN*TPR(J)/(PS*THP)
07605 310 CONTINUE
07606 P(N+NP+ILD,4)=THP
07607 P(N+NP+ILD,5)=0.
07608 ENDIF
07609 IAGR=IAGR+1
07610 IF(IAGR.LT.MSTU(45).AND.ILG.LT.MIN(10,NC)) GOTO 260
07611 320 CONTINUE
07612
07613
07614 SGN=(-1.)**INT(RLU(0)+0.5)
07615 P(N+NP+3,1)=-SGN*P(N+NP+2,2)
07616 P(N+NP+3,2)=SGN*P(N+NP+2,1)
07617 P(N+NP+3,3)=0.
07618 THP=0.
07619 DO 330 I=N+1,N+NP
07620 THP=THP+P(I,5)*ABS(P(N+NP+3,1)*P(I,1)+P(N+NP+3,2)*P(I,2))
07621 330 CONTINUE
07622 P(N+NP+3,4)=THP/PS
07623 P(N+NP+3,5)=0.
07624
07625
07626 DO 350 ILD=1,3
07627 K(N+ILD,1)=31
07628 K(N+ILD,2)=96
07629 K(N+ILD,3)=ILD
07630 K(N+ILD,4)=0
07631 K(N+ILD,5)=0
07632 DO 340 J=1,5
07633 P(N+ILD,J)=P(N+NP+ILD,J)
07634 V(N+ILD,J)=0.
07635 340 CONTINUE
07636 350 CONTINUE
07637 CALL LUDBRB(N+1,N+3,THE,PHI,0D0,0D0,0D0)
07638
07639
07640 THR=P(N+1,4)
07641 OBL=P(N+2,4)-P(N+3,4)
07642 MSTU(61)=N+1
07643 MSTU(62)=NP
07644 IF(MSTU(43).LE.1) MSTU(3)=3
07645 IF(MSTU(43).GE.2) N=N+3
07646
07647 RETURN
07648 END
07649
07650
07651
07652 SUBROUTINE LUCLUS(NJET)
07653
07654
07655
07656 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
07657 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
07658 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
07659 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
07660 DIMENSION PS(5)
07661 SAVE NSAV,NP,PS,PSS,RINIT,NPRE,NREM
07662
07663
07664 R2T(I1,I2)=(P(I1,5)*P(I2,5)-P(I1,1)*P(I2,1)-P(I1,2)*P(I2,2)-
07665 &P(I1,3)*P(I2,3))*2.*P(I1,5)*P(I2,5)/(0.0001+P(I1,5)+P(I2,5))**2
07666 R2M(I1,I2)=2.*P(I1,4)*P(I2,4)*(1.-(P(I1,1)*P(I2,1)+P(I1,2)*
07667 &P(I2,2)+P(I1,3)*P(I2,3))/(P(I1,5)*P(I2,5)))
07668
07669
07670 IF(MSTU(48).LE.0) THEN
07671 NP=0
07672 DO 100 J=1,5
07673 PS(J)=0.
07674 100 CONTINUE
07675 PSS=0.
07676 ELSE
07677 NJET=NSAV
07678 IF(MSTU(43).GE.2) N=N-NJET
07679 DO 110 I=N+1,N+NJET
07680 P(I,5)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)
07681 110 CONTINUE
07682 IF(MSTU(46).LE.3) R2ACC=PARU(44)**2
07683 IF(MSTU(46).GE.4) R2ACC=PARU(45)*PS(5)**2
07684 NLOOP=0
07685 GOTO 300
07686 ENDIF
07687
07688
07689 DO 140 I=1,N
07690 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 140
07691 IF(MSTU(41).GE.2) THEN
07692 KC=LUCOMP(K(I,2))
07693 IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
07694 & KC.EQ.18) GOTO 140
07695 IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
07696 & GOTO 140
07697 ENDIF
07698 IF(N+2*NP.GE.MSTU(4)-MSTU(32)-5) THEN
07699 CALL LUERRM(11,'(LUCLUS:) no more memory left in LUJETS')
07700 NJET=-1
07701 RETURN
07702 ENDIF
07703
07704
07705 NP=NP+1
07706 K(N+NP,3)=I
07707 DO 120 J=1,5
07708 P(N+NP,J)=P(I,J)
07709 120 CONTINUE
07710 IF(MSTU(42).EQ.0) P(N+NP,5)=0.
07711 IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) P(N+NP,5)=PMAS(101,1)
07712 P(N+NP,4)=SQRT(P(N+NP,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2)
07713 P(N+NP,5)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)
07714 DO 130 J=1,4
07715 PS(J)=PS(J)+P(N+NP,J)
07716 130 CONTINUE
07717 PSS=PSS+P(N+NP,5)
07718 140 CONTINUE
07719 DO 160 I=N+1,N+NP
07720 K(I+NP,3)=K(I,3)
07721 DO 150 J=1,5
07722 P(I+NP,J)=P(I,J)
07723 150 CONTINUE
07724 160 CONTINUE
07725 PS(5)=SQRT(MAX(0.,PS(4)**2-PS(1)**2-PS(2)**2-PS(3)**2))
07726
07727
07728 IF(NP.LT.MSTU(47)) THEN
07729 CALL LUERRM(8,'(LUCLUS:) too few particles for analysis')
07730 NJET=-1
07731 RETURN
07732 ENDIF
07733
07734
07735 NLOOP=0
07736 IF(MSTU(46).LE.3) R2ACC=PARU(44)**2
07737 IF(MSTU(46).GE.4) R2ACC=PARU(45)*PS(5)**2
07738 RINIT=1.25*PARU(43)
07739 IF(NP.LE.MSTU(47)+2) RINIT=0.
07740 170 RINIT=0.8*RINIT
07741 NPRE=0
07742 NREM=NP
07743 DO 180 I=N+NP+1,N+2*NP
07744 K(I,4)=0
07745 180 CONTINUE
07746
07747
07748 IF(MSTU(46).LE.2) THEN
07749 DO 190 J=1,4
07750 P(N+1,J)=0.
07751 190 CONTINUE
07752 DO 210 I=N+NP+1,N+2*NP
07753 IF(P(I,5).GT.2.*RINIT) GOTO 210
07754 NREM=NREM-1
07755 K(I,4)=1
07756 DO 200 J=1,4
07757 P(N+1,J)=P(N+1,J)+P(I,J)
07758 200 CONTINUE
07759 210 CONTINUE
07760 P(N+1,5)=SQRT(P(N+1,1)**2+P(N+1,2)**2+P(N+1,3)**2)
07761 IF(P(N+1,5).GT.2.*RINIT) NPRE=1
07762 IF(RINIT.GE.0.2*PARU(43).AND.NPRE+NREM.LT.MSTU(47)) GOTO 170
07763 IF(NREM.EQ.0) GOTO 170
07764 ENDIF
07765
07766
07767 220 NPRE=NPRE+1
07768 PMAX=0.
07769 DO 230 I=N+NP+1,N+2*NP
07770 IF(K(I,4).NE.0.OR.P(I,5).LE.PMAX) GOTO 230
07771 IMAX=I
07772 PMAX=P(I,5)
07773 230 CONTINUE
07774 DO 240 J=1,5
07775 P(N+NPRE,J)=P(IMAX,J)
07776 240 CONTINUE
07777 NREM=NREM-1
07778 K(IMAX,4)=NPRE
07779
07780
07781 IF(MSTU(46).LE.2) THEN
07782 DO 260 I=N+NP+1,N+2*NP
07783 IF(K(I,4).NE.0) GOTO 260
07784 R2=R2T(I,IMAX)
07785 IF(R2.GT.RINIT**2) GOTO 260
07786 NREM=NREM-1
07787 K(I,4)=NPRE
07788 DO 250 J=1,4
07789 P(N+NPRE,J)=P(N+NPRE,J)+P(I,J)
07790 250 CONTINUE
07791 260 CONTINUE
07792 P(N+NPRE,5)=SQRT(P(N+NPRE,1)**2+P(N+NPRE,2)**2+P(N+NPRE,3)**2)
07793
07794
07795 ELSE
07796 270 IMIN=0
07797 R2MIN=RINIT**2
07798 DO 280 I=N+NP+1,N+2*NP
07799 IF(K(I,4).NE.0) GOTO 280
07800 R2=R2M(I,N+NPRE)
07801 IF(R2.GE.R2MIN) GOTO 280
07802 IMIN=I
07803 R2MIN=R2
07804 280 CONTINUE
07805 IF(IMIN.NE.0) THEN
07806 DO 290 J=1,4
07807 P(N+NPRE,J)=P(N+NPRE,J)+P(IMIN,J)
07808 290 CONTINUE
07809 P(N+NPRE,5)=SQRT(P(N+NPRE,1)**2+P(N+NPRE,2)**2+P(N+NPRE,3)**2)
07810 NREM=NREM-1
07811 K(IMIN,4)=NPRE
07812 GOTO 270
07813 ENDIF
07814 ENDIF
07815
07816
07817 IF(RINIT.GE.0.2*PARU(43).AND.NPRE+NREM.LT.MSTU(47)) GOTO 170
07818 IF(NREM.GT.0) GOTO 220
07819 NJET=NPRE
07820
07821
07822 300 TSAV=0.
07823 PSJT=0.
07824 310 IF(MSTU(46).LE.1) THEN
07825 DO 330 I=N+1,N+NJET
07826 DO 320 J=1,4
07827 V(I,J)=0.
07828 320 CONTINUE
07829 330 CONTINUE
07830 DO 360 I=N+NP+1,N+2*NP
07831 R2MIN=PSS**2
07832 DO 340 IJET=N+1,N+NJET
07833 IF(P(IJET,5).LT.RINIT) GOTO 340
07834 R2=R2T(I,IJET)
07835 IF(R2.GE.R2MIN) GOTO 340
07836 IMIN=IJET
07837 R2MIN=R2
07838 340 CONTINUE
07839 K(I,4)=IMIN-N
07840 DO 350 J=1,4
07841 V(IMIN,J)=V(IMIN,J)+P(I,J)
07842 350 CONTINUE
07843 360 CONTINUE
07844 PSJT=0.
07845 DO 380 I=N+1,N+NJET
07846 DO 370 J=1,4
07847 P(I,J)=V(I,J)
07848 370 CONTINUE
07849 P(I,5)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)
07850 PSJT=PSJT+P(I,5)
07851 380 CONTINUE
07852 ENDIF
07853
07854
07855 R2MIN=2.*MAX(R2ACC,PS(5)**2)
07856 DO 400 ITRY1=N+1,N+NJET-1
07857 DO 390 ITRY2=ITRY1+1,N+NJET
07858 IF(MSTU(46).LE.2) R2=R2T(ITRY1,ITRY2)
07859 IF(MSTU(46).GE.3) R2=R2M(ITRY1,ITRY2)
07860 IF(R2.GE.R2MIN) GOTO 390
07861 IMIN1=ITRY1
07862 IMIN2=ITRY2
07863 R2MIN=R2
07864 390 CONTINUE
07865 400 CONTINUE
07866
07867
07868 IF(NJET.GT.MSTU(47).AND.R2MIN.LT.R2ACC) THEN
07869 IREC=MIN(IMIN1,IMIN2)
07870 IDEL=MAX(IMIN1,IMIN2)
07871 DO 410 J=1,4
07872 P(IREC,J)=P(IMIN1,J)+P(IMIN2,J)
07873 410 CONTINUE
07874 P(IREC,5)=SQRT(P(IREC,1)**2+P(IREC,2)**2+P(IREC,3)**2)
07875 DO 430 I=IDEL+1,N+NJET
07876 DO 420 J=1,5
07877 P(I-1,J)=P(I,J)
07878 420 CONTINUE
07879 430 CONTINUE
07880 IF(MSTU(46).GE.2) THEN
07881 DO 440 I=N+NP+1,N+2*NP
07882 IORI=N+K(I,4)
07883 IF(IORI.EQ.IDEL) K(I,4)=IREC-N
07884 IF(IORI.GT.IDEL) K(I,4)=K(I,4)-1
07885 440 CONTINUE
07886 ENDIF
07887 NJET=NJET-1
07888 GOTO 300
07889
07890
07891 ELSEIF(NJET.EQ.MSTU(47).AND.MSTU(46).LE.1.AND.NLOOP.LE.2) THEN
07892 DO 450 I=N+1,N+NJET
07893 K(I,5)=0
07894 450 CONTINUE
07895 DO 460 I=N+NP+1,N+2*NP
07896 K(N+K(I,4),5)=K(N+K(I,4),5)+1
07897 460 CONTINUE
07898 IEMP=0
07899 DO 470 I=N+1,N+NJET
07900 IF(K(I,5).EQ.0) IEMP=I
07901 470 CONTINUE
07902 IF(IEMP.NE.0) THEN
07903 NLOOP=NLOOP+1
07904 ISPL=0
07905 R2MAX=0.
07906 DO 480 I=N+NP+1,N+2*NP
07907 IF(K(N+K(I,4),5).LE.1.OR.P(I,5).LT.RINIT) GOTO 480
07908 IJET=N+K(I,4)
07909 R2=R2T(I,IJET)
07910 IF(R2.LE.R2MAX) GOTO 480
07911 ISPL=I
07912 R2MAX=R2
07913 480 CONTINUE
07914 IF(ISPL.NE.0) THEN
07915 IJET=N+K(ISPL,4)
07916 DO 490 J=1,4
07917 P(IEMP,J)=P(ISPL,J)
07918 P(IJET,J)=P(IJET,J)-P(ISPL,J)
07919 490 CONTINUE
07920 P(IEMP,5)=P(ISPL,5)
07921 P(IJET,5)=SQRT(P(IJET,1)**2+P(IJET,2)**2+P(IJET,3)**2)
07922 IF(NLOOP.LE.2) GOTO 300
07923 ENDIF
07924 ENDIF
07925 ENDIF
07926
07927
07928 IF(MSTU(46).LE.1.AND.NLOOP.LE.2.AND.PSJT/PSS.GT.TSAV+PARU(48))
07929 &THEN
07930 TSAV=PSJT/PSS
07931 GOTO 310
07932 ENDIF
07933
07934
07935 DO 510 I=N+1,N+NJET
07936 DO 500 J=1,5
07937 V(I,J)=P(I,J)
07938 500 CONTINUE
07939 510 CONTINUE
07940 DO 540 INEW=N+1,N+NJET
07941 PEMAX=0.
07942 DO 520 ITRY=N+1,N+NJET
07943 IF(V(ITRY,4).LE.PEMAX) GOTO 520
07944 IMAX=ITRY
07945 PEMAX=V(ITRY,4)
07946 520 CONTINUE
07947 K(INEW,1)=31
07948 K(INEW,2)=97
07949 K(INEW,3)=INEW-N
07950 K(INEW,4)=0
07951 DO 530 J=1,5
07952 P(INEW,J)=V(IMAX,J)
07953 530 CONTINUE
07954 V(IMAX,4)=-1.
07955 K(IMAX,5)=INEW
07956 540 CONTINUE
07957
07958
07959 DO 550 I=N+NP+1,N+2*NP
07960 IORI=K(N+K(I,4),5)
07961 K(I,4)=IORI-N
07962 IF(K(K(I,3),1).NE.3) K(K(I,3),4)=IORI-N
07963 K(IORI,4)=K(IORI,4)+1
07964 550 CONTINUE
07965 IEMP=0
07966 PSJT=0.
07967 DO 570 I=N+1,N+NJET
07968 K(I,5)=0
07969 PSJT=PSJT+P(I,5)
07970 P(I,5)=SQRT(MAX(P(I,4)**2-P(I,5)**2,0.))
07971 DO 560 J=1,5
07972 V(I,J)=0.
07973 560 CONTINUE
07974 IF(K(I,4).EQ.0) IEMP=I
07975 570 CONTINUE
07976
07977
07978 MSTU(61)=N+1
07979 MSTU(62)=NP
07980 MSTU(63)=NPRE
07981 PARU(61)=PS(5)
07982 PARU(62)=PSJT/PSS
07983 PARU(63)=SQRT(R2MIN)
07984 IF(NJET.LE.1) PARU(63)=0.
07985 IF(IEMP.NE.0) THEN
07986 CALL LUERRM(8,'(LUCLUS:) failed to reconstruct as requested')
07987 NJET=-1
07988 ENDIF
07989 IF(MSTU(43).LE.1) MSTU(3)=NJET
07990 IF(MSTU(43).GE.2) N=N+NJET
07991 NSAV=NJET
07992
07993 RETURN
07994 END
07995
07996
07997
07998 SUBROUTINE LUCELL(NJET)
07999
08000
08001
08002 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
08003 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
08004 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
08005 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
08006
08007
08008 PTLRAT=1./SINH(PARU(51))**2
08009 NP=0
08010 NC=N
08011 DO 110 I=1,N
08012 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 110
08013 IF(P(I,1)**2+P(I,2)**2.LE.PTLRAT*P(I,3)**2) GOTO 110
08014 IF(MSTU(41).GE.2) THEN
08015 KC=LUCOMP(K(I,2))
08016 IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
08017 & KC.EQ.18) GOTO 110
08018 IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
08019 & GOTO 110
08020 ENDIF
08021 NP=NP+1
08022 PT=SQRT(P(I,1)**2+P(I,2)**2)
08023 ETA=SIGN(LOG((SQRT(PT**2+P(I,3)**2)+ABS(P(I,3)))/PT),P(I,3))
08024 IETA=MAX(1,MIN(MSTU(51),1+INT(MSTU(51)*0.5*(ETA/PARU(51)+1.))))
08025 PHI=ULANGL(P(I,1),P(I,2))
08026 IPHI=MAX(1,MIN(MSTU(52),1+INT(MSTU(52)*0.5*(PHI/PARU(1)+1.))))
08027 IETPH=MSTU(52)*IETA+IPHI
08028
08029
08030 DO 100 IC=N+1,NC
08031 IF(IETPH.EQ.K(IC,3)) THEN
08032 K(IC,4)=K(IC,4)+1
08033 P(IC,5)=P(IC,5)+PT
08034 GOTO 110
08035 ENDIF
08036 100 CONTINUE
08037 IF(NC.GE.MSTU(4)-MSTU(32)-5) THEN
08038 CALL LUERRM(11,'(LUCELL:) no more memory left in LUJETS')
08039 NJET=-2
08040 RETURN
08041 ENDIF
08042 NC=NC+1
08043 K(NC,3)=IETPH
08044 K(NC,4)=1
08045 K(NC,5)=2
08046 P(NC,1)=(PARU(51)/MSTU(51))*(2*IETA-1-MSTU(51))
08047 P(NC,2)=(PARU(1)/MSTU(52))*(2*IPHI-1-MSTU(52))
08048 P(NC,5)=PT
08049 110 CONTINUE
08050
08051
08052 IF(MSTU(53).GE.1) THEN
08053 DO 130 IC=N+1,NC
08054 PEI=P(IC,5)
08055 IF(MSTU(53).EQ.2) PEI=P(IC,5)/COSH(P(IC,1))
08056 120 PEF=PEI+PARU(55)*SQRT(-2.*LOG(MAX(1E-10,RLU(0)))*PEI)*
08057 & COS(PARU(2)*RLU(0))
08058 IF(PEF.LT.0..OR.PEF.GT.PARU(56)*PEI) GOTO 120
08059 P(IC,5)=PEF
08060 IF(MSTU(53).EQ.2) P(IC,5)=PEF*COSH(P(IC,1))
08061 130 CONTINUE
08062 ENDIF
08063
08064
08065 IF(PARU(58).GT.0.) THEN
08066 NCC=NC
08067 NC=N
08068 DO 140 IC=N+1,NCC
08069 IF(P(IC,5).GT.PARU(58)) THEN
08070 NC=NC+1
08071 K(NC,3)=K(IC,3)
08072 K(NC,4)=K(IC,4)
08073 K(NC,5)=K(IC,5)
08074 P(NC,1)=P(IC,1)
08075 P(NC,2)=P(IC,2)
08076 P(NC,5)=P(IC,5)
08077 ENDIF
08078 140 CONTINUE
08079 ENDIF
08080
08081
08082 NJ=NC
08083 150 ETMAX=0.
08084 DO 160 IC=N+1,NC
08085 IF(K(IC,5).NE.2) GOTO 160
08086 IF(P(IC,5).LE.ETMAX) GOTO 160
08087 ICMAX=IC
08088 ETA=P(IC,1)
08089 PHI=P(IC,2)
08090 ETMAX=P(IC,5)
08091 160 CONTINUE
08092 IF(ETMAX.LT.PARU(52)) GOTO 220
08093 IF(NJ.GE.MSTU(4)-MSTU(32)-5) THEN
08094 CALL LUERRM(11,'(LUCELL:) no more memory left in LUJETS')
08095 NJET=-2
08096 RETURN
08097 ENDIF
08098 K(ICMAX,5)=1
08099 NJ=NJ+1
08100 K(NJ,4)=0
08101 K(NJ,5)=1
08102 P(NJ,1)=ETA
08103 P(NJ,2)=PHI
08104 P(NJ,3)=0.
08105 P(NJ,4)=0.
08106 P(NJ,5)=0.
08107
08108
08109 DO 170 IC=N+1,NC
08110 IF(K(IC,5).EQ.0) GOTO 170
08111 IF(ABS(P(IC,1)-ETA).GT.PARU(54)) GOTO 170
08112 DPHIA=ABS(P(IC,2)-PHI)
08113 IF(DPHIA.GT.PARU(54).AND.DPHIA.LT.PARU(2)-PARU(54)) GOTO 170
08114 PHIC=P(IC,2)
08115 IF(DPHIA.GT.PARU(1)) PHIC=PHIC+SIGN(PARU(2),PHI)
08116 IF((P(IC,1)-ETA)**2+(PHIC-PHI)**2.GT.PARU(54)**2) GOTO 170
08117 K(IC,5)=-K(IC,5)
08118 K(NJ,4)=K(NJ,4)+K(IC,4)
08119 P(NJ,3)=P(NJ,3)+P(IC,5)*P(IC,1)
08120 P(NJ,4)=P(NJ,4)+P(IC,5)*PHIC
08121 P(NJ,5)=P(NJ,5)+P(IC,5)
08122 170 CONTINUE
08123
08124
08125 IF(P(NJ,5).LT.PARU(53)) THEN
08126 NJ=NJ-1
08127 DO 180 IC=N+1,NC
08128 IF(K(IC,5).LT.0) K(IC,5)=-K(IC,5)
08129 180 CONTINUE
08130 ELSEIF(MSTU(54).LE.2) THEN
08131 P(NJ,3)=P(NJ,3)/P(NJ,5)
08132 P(NJ,4)=P(NJ,4)/P(NJ,5)
08133 IF(ABS(P(NJ,4)).GT.PARU(1)) P(NJ,4)=P(NJ,4)-SIGN(PARU(2),
08134 & P(NJ,4))
08135 DO 190 IC=N+1,NC
08136 IF(K(IC,5).LT.0) K(IC,5)=0
08137 190 CONTINUE
08138 ELSE
08139 DO 200 J=1,4
08140 P(NJ,J)=0.
08141 200 CONTINUE
08142 DO 210 IC=N+1,NC
08143 IF(K(IC,5).GE.0) GOTO 210
08144 P(NJ,1)=P(NJ,1)+P(IC,5)*COS(P(IC,2))
08145 P(NJ,2)=P(NJ,2)+P(IC,5)*SIN(P(IC,2))
08146 P(NJ,3)=P(NJ,3)+P(IC,5)*SINH(P(IC,1))
08147 P(NJ,4)=P(NJ,4)+P(IC,5)*COSH(P(IC,1))
08148 K(IC,5)=0
08149 210 CONTINUE
08150 ENDIF
08151 GOTO 150
08152
08153
08154 220 DO 250 I=1,NJ-NC
08155 ETMAX=0.
08156 DO 230 IJ=NC+1,NJ
08157 IF(K(IJ,5).EQ.0) GOTO 230
08158 IF(P(IJ,5).LT.ETMAX) GOTO 230
08159 IJMAX=IJ
08160 ETMAX=P(IJ,5)
08161 230 CONTINUE
08162 K(IJMAX,5)=0
08163 K(N+I,1)=31
08164 K(N+I,2)=98
08165 K(N+I,3)=I
08166 K(N+I,4)=K(IJMAX,4)
08167 K(N+I,5)=0
08168 DO 240 J=1,5
08169 P(N+I,J)=P(IJMAX,J)
08170 V(N+I,J)=0.
08171 240 CONTINUE
08172 250 CONTINUE
08173 NJET=NJ-NC
08174
08175
08176 IF(MSTU(54).EQ.2) THEN
08177 DO 260 I=N+1,N+NJET
08178 ETA=P(I,3)
08179 P(I,1)=P(I,5)*COS(P(I,4))
08180 P(I,2)=P(I,5)*SIN(P(I,4))
08181 P(I,3)=P(I,5)*SINH(ETA)
08182 P(I,4)=P(I,5)*COSH(ETA)
08183 P(I,5)=0.
08184 260 CONTINUE
08185 ELSEIF(MSTU(54).GE.3) THEN
08186 DO 270 I=N+1,N+NJET
08187 P(I,5)=SQRT(MAX(0.,P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2))
08188 270 CONTINUE
08189 ENDIF
08190
08191
08192 MSTU(61)=N+1
08193 MSTU(62)=NP
08194 MSTU(63)=NC-N
08195 IF(MSTU(43).LE.1) MSTU(3)=NJET
08196 IF(MSTU(43).GE.2) N=N+NJET
08197
08198 RETURN
08199 END
08200
08201
08202
08203 SUBROUTINE LUJMAS(PMH,PML)
08204
08205
08206
08207 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
08208 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
08209 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
08210 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
08211 DIMENSION SM(3,3),SAX(3),PS(3,5)
08212
08213
08214 NP=0
08215 DO 120 J1=1,3
08216 DO 100 J2=J1,3
08217 SM(J1,J2)=0.
08218 100 CONTINUE
08219 DO 110 J2=1,4
08220 PS(J1,J2)=0.
08221 110 CONTINUE
08222 120 CONTINUE
08223 PSS=0.
08224
08225
08226 DO 170 I=1,N
08227 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 170
08228 IF(MSTU(41).GE.2) THEN
08229 KC=LUCOMP(K(I,2))
08230 IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
08231 & KC.EQ.18) GOTO 170
08232 IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
08233 & GOTO 170
08234 ENDIF
08235 IF(N+NP+1.GE.MSTU(4)-MSTU(32)-5) THEN
08236 CALL LUERRM(11,'(LUJMAS:) no more memory left in LUJETS')
08237 PMH=-2.
08238 PML=-2.
08239 RETURN
08240 ENDIF
08241 NP=NP+1
08242 DO 130 J=1,5
08243 P(N+NP,J)=P(I,J)
08244 130 CONTINUE
08245 IF(MSTU(42).EQ.0) P(N+NP,5)=0.
08246 IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) P(N+NP,5)=PMAS(101,1)
08247 P(N+NP,4)=SQRT(P(N+NP,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2)
08248
08249
08250 DO 150 J1=1,3
08251 DO 140 J2=J1,3
08252 SM(J1,J2)=SM(J1,J2)+P(I,J1)*P(I,J2)
08253 140 CONTINUE
08254 150 CONTINUE
08255 PSS=PSS+(P(I,1)**2+P(I,2)**2+P(I,3)**2)
08256 DO 160 J=1,4
08257 PS(3,J)=PS(3,J)+P(N+NP,J)
08258 160 CONTINUE
08259 170 CONTINUE
08260
08261
08262 IF(NP.LE.1) THEN
08263 CALL LUERRM(8,'(LUJMAS:) too few particles for analysis')
08264 PMH=-1.
08265 PML=-1.
08266 RETURN
08267 ENDIF
08268 PARU(61)=SQRT(MAX(0.,PS(3,4)**2-PS(3,1)**2-PS(3,2)**2-PS(3,3)**2))
08269
08270
08271 DO 190 J1=1,3
08272 DO 180 J2=J1,3
08273 SM(J1,J2)=SM(J1,J2)/PSS
08274 180 CONTINUE
08275 190 CONTINUE
08276 SQ=(SM(1,1)*SM(2,2)+SM(1,1)*SM(3,3)+SM(2,2)*SM(3,3)-SM(1,2)**2-
08277 &SM(1,3)**2-SM(2,3)**2)/3.-1./9.
08278 SR=-0.5*(SQ+1./9.+SM(1,1)*SM(2,3)**2+SM(2,2)*SM(1,3)**2+SM(3,3)*
08279 &SM(1,2)**2-SM(1,1)*SM(2,2)*SM(3,3))+SM(1,2)*SM(1,3)*SM(2,3)+1./27.
08280 SP=COS(ACOS(MAX(MIN(SR/SQRT(-SQ**3),1.),-1.))/3.)
08281 SMA=1./3.+SQRT(-SQ)*MAX(2.*SP,SQRT(3.*(1.-SP**2))-SP)
08282
08283
08284 DO 210 J1=1,3
08285 SM(J1,J1)=SM(J1,J1)-SMA
08286 DO 200 J2=J1+1,3
08287 SM(J2,J1)=SM(J1,J2)
08288 200 CONTINUE
08289 210 CONTINUE
08290 SMAX=0.
08291 DO 230 J1=1,3
08292 DO 220 J2=1,3
08293 IF(ABS(SM(J1,J2)).LE.SMAX) GOTO 220
08294 JA=J1
08295 JB=J2
08296 SMAX=ABS(SM(J1,J2))
08297 220 CONTINUE
08298 230 CONTINUE
08299 SMAX=0.
08300 DO 250 J3=JA+1,JA+2
08301 J1=J3-3*((J3-1)/3)
08302 RL=SM(J1,JB)/SM(JA,JB)
08303 DO 240 J2=1,3
08304 SM(J1,J2)=SM(J1,J2)-RL*SM(JA,J2)
08305 IF(ABS(SM(J1,J2)).LE.SMAX) GOTO 240
08306 JC=J1
08307 SMAX=ABS(SM(J1,J2))
08308 240 CONTINUE
08309 250 CONTINUE
08310 JB1=JB+1-3*(JB/3)
08311 JB2=JB+2-3*((JB+1)/3)
08312 SAX(JB1)=-SM(JC,JB2)
08313 SAX(JB2)=SM(JC,JB1)
08314 SAX(JB)=-(SM(JA,JB1)*SAX(JB1)+SM(JA,JB2)*SAX(JB2))/SM(JA,JB)
08315
08316
08317 DO 270 I=N+1,N+NP
08318 PSAX=P(I,1)*SAX(1)+P(I,2)*SAX(2)+P(I,3)*SAX(3)
08319 IS=1
08320 IF(PSAX.LT.0.) IS=2
08321 K(I,3)=IS
08322 DO 260 J=1,4
08323 PS(IS,J)=PS(IS,J)+P(I,J)
08324 260 CONTINUE
08325 270 CONTINUE
08326 PMS=MAX(1E-10,PS(1,4)**2-PS(1,1)**2-PS(1,2)**2-PS(1,3)**2)+
08327 &MAX(1E-10,PS(2,4)**2-PS(2,1)**2-PS(2,2)**2-PS(2,3)**2)
08328
08329
08330 280 PMD=0.
08331 IM=0
08332 DO 290 J=1,4
08333 PS(3,J)=PS(1,J)-PS(2,J)
08334 290 CONTINUE
08335 DO 300 I=N+1,N+NP
08336 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)
08337 IF(K(I,3).EQ.1) PMDI=2.*(P(I,5)**2-PPS)
08338 IF(K(I,3).EQ.2) PMDI=2.*(P(I,5)**2+PPS)
08339 IF(PMDI.LT.PMD) THEN
08340 PMD=PMDI
08341 IM=I
08342 ENDIF
08343 300 CONTINUE
08344
08345
08346 IF(PMD.LT.-PARU(48)*PMS) THEN
08347 PMS=PMS+PMD
08348 IS=K(IM,3)
08349 DO 310 J=1,4
08350 PS(IS,J)=PS(IS,J)-P(IM,J)
08351 PS(3-IS,J)=PS(3-IS,J)+P(IM,J)
08352 310 CONTINUE
08353 K(IM,3)=3-IS
08354 GOTO 280
08355 ENDIF
08356
08357
08358 MSTU(61)=N+1
08359 MSTU(62)=NP
08360 PS(1,5)=SQRT(MAX(0.,PS(1,4)**2-PS(1,1)**2-PS(1,2)**2-PS(1,3)**2))
08361 PS(2,5)=SQRT(MAX(0.,PS(2,4)**2-PS(2,1)**2-PS(2,2)**2-PS(2,3)**2))
08362 PMH=MAX(PS(1,5),PS(2,5))
08363 PML=MIN(PS(1,5),PS(2,5))
08364
08365 RETURN
08366 END
08367
08368
08369
08370 SUBROUTINE LUFOWO(H10,H20,H30,H40)
08371
08372
08373 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
08374 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
08375 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
08376 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
08377
08378
08379 NP=0
08380 H0=0.
08381 HD=0.
08382 DO 110 I=1,N
08383 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 110
08384 IF(MSTU(41).GE.2) THEN
08385 KC=LUCOMP(K(I,2))
08386 IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
08387 & KC.EQ.18) GOTO 110
08388 IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
08389 & GOTO 110
08390 ENDIF
08391 IF(N+NP.GE.MSTU(4)-MSTU(32)-5) THEN
08392 CALL LUERRM(11,'(LUFOWO:) no more memory left in LUJETS')
08393 H10=-1.
08394 H20=-1.
08395 H30=-1.
08396 H40=-1.
08397 RETURN
08398 ENDIF
08399 NP=NP+1
08400 DO 100 J=1,3
08401 P(N+NP,J)=P(I,J)
08402 100 CONTINUE
08403 P(N+NP,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)
08404 H0=H0+P(N+NP,4)
08405 HD=HD+P(N+NP,4)**2
08406 110 CONTINUE
08407 H0=H0**2
08408
08409
08410 IF(NP.LE.1) THEN
08411 CALL LUERRM(8,'(LUFOWO:) too few particles for analysis')
08412 H10=-1.
08413 H20=-1.
08414 H30=-1.
08415 H40=-1.
08416 RETURN
08417 ENDIF
08418
08419
08420 H10=0.
08421 H20=0.
08422 H30=0.
08423 H40=0.
08424 DO 130 I1=N+1,N+NP
08425 DO 120 I2=I1+1,N+NP
08426 CTHE=(P(I1,1)*P(I2,1)+P(I1,2)*P(I2,2)+P(I1,3)*P(I2,3))/
08427 &(P(I1,4)*P(I2,4))
08428 H10=H10+P(I1,4)*P(I2,4)*CTHE
08429 H20=H20+P(I1,4)*P(I2,4)*(1.5*CTHE**2-0.5)
08430 H30=H30+P(I1,4)*P(I2,4)*(2.5*CTHE**3-1.5*CTHE)
08431 H40=H40+P(I1,4)*P(I2,4)*(4.375*CTHE**4-3.75*CTHE**2+0.375)
08432 120 CONTINUE
08433 130 CONTINUE
08434
08435
08436 MSTU(61)=N+1
08437 MSTU(62)=NP
08438 H10=(HD+2.*H10)/H0
08439 H20=(HD+2.*H20)/H0
08440 H30=(HD+2.*H30)/H0
08441 H40=(HD+2.*H40)/H0
08442
08443 RETURN
08444 END
08445
08446
08447
08448 SUBROUTINE LUTABU(MTABU)
08449
08450
08451
08452
08453 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
08454 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
08455 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
08456 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
08457 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/,/LUDAT3/
08458 DIMENSION KFIS(100,2),NPIS(100,0:10),KFFS(400),NPFS(400,4),
08459 &FEVFM(10,4),FM1FM(3,10,4),FM2FM(3,10,4),FMOMA(4),FMOMS(4),
08460 &FEVEE(50),FE1EC(50),FE2EC(50),FE1EA(25),FE2EA(25),
08461 &KFDM(8),KFDC(200,0:8),NPDC(200)
08462 SAVE NEVIS,NKFIS,KFIS,NPIS,NEVFS,NPRFS,NFIFS,NCHFS,NKFFS,
08463 &KFFS,NPFS,NEVFM,NMUFM,FM1FM,FM2FM,NEVEE,FE1EC,FE2EC,FE1EA,
08464 &FE2EA,NEVDC,NKFDC,NREDC,KFDC,NPDC
08465 CHARACTER CHAU*16,CHIS(2)*12,CHDC(8)*12
08466 DATA NEVIS/0/,NKFIS/0/,NEVFS/0/,NPRFS/0/,NFIFS/0/,NCHFS/0/,
08467 &NKFFS/0/,NEVFM/0/,NMUFM/0/,FM1FM/120*0./,FM2FM/120*0./,
08468 &NEVEE/0/,FE1EC/50*0./,FE2EC/50*0./,FE1EA/25*0./,FE2EA/25*0./,
08469 &NEVDC/0/,NKFDC/0/,NREDC/0/
08470
08471
08472 IF(MTABU.EQ.10) THEN
08473 NEVIS=0
08474 NKFIS=0
08475
08476
08477 ELSEIF(MTABU.EQ.11) THEN
08478 NEVIS=NEVIS+1
08479 KFM1=2*IABS(MSTU(161))
08480 IF(MSTU(161).GT.0) KFM1=KFM1-1
08481 KFM2=2*IABS(MSTU(162))
08482 IF(MSTU(162).GT.0) KFM2=KFM2-1
08483 KFMN=MIN(KFM1,KFM2)
08484 KFMX=MAX(KFM1,KFM2)
08485 DO 100 I=1,NKFIS
08486 IF(KFMN.EQ.KFIS(I,1).AND.KFMX.EQ.KFIS(I,2)) THEN
08487 IKFIS=-I
08488 GOTO 110
08489 ELSEIF(KFMN.LT.KFIS(I,1).OR.(KFMN.EQ.KFIS(I,1).AND.
08490 & KFMX.LT.KFIS(I,2))) THEN
08491 IKFIS=I
08492 GOTO 110
08493 ENDIF
08494 100 CONTINUE
08495 IKFIS=NKFIS+1
08496 110 IF(IKFIS.LT.0) THEN
08497 IKFIS=-IKFIS
08498 ELSE
08499 IF(NKFIS.GE.100) RETURN
08500 DO 130 I=NKFIS,IKFIS,-1
08501 KFIS(I+1,1)=KFIS(I,1)
08502 KFIS(I+1,2)=KFIS(I,2)
08503 DO 120 J=0,10
08504 NPIS(I+1,J)=NPIS(I,J)
08505 120 CONTINUE
08506 130 CONTINUE
08507 NKFIS=NKFIS+1
08508 KFIS(IKFIS,1)=KFMN
08509 KFIS(IKFIS,2)=KFMX
08510 DO 140 J=0,10
08511 NPIS(IKFIS,J)=0
08512 140 CONTINUE
08513 ENDIF
08514 NPIS(IKFIS,0)=NPIS(IKFIS,0)+1
08515
08516
08517 NP=0
08518 DO 160 I=1,N
08519 IF(K(I,1).LE.0.OR.K(I,1).GT.12) THEN
08520 ELSEIF(IABS(K(I,2)).GT.80.AND.IABS(K(I,2)).LE.100) THEN
08521 ELSEIF(IABS(K(I,2)).GT.100.AND.MOD(IABS(K(I,2))/10,10).NE.0)
08522 & THEN
08523 ELSE
08524 IM=I
08525 150 IM=K(IM,3)
08526 IF(IM.LE.0.OR.IM.GT.N) THEN
08527 NP=NP+1
08528 ELSEIF(K(IM,1).LE.0.OR.K(IM,1).GT.20) THEN
08529 NP=NP+1
08530 ELSEIF(IABS(K(IM,2)).GT.80.AND.IABS(K(IM,2)).LE.100) THEN
08531 ELSEIF(IABS(K(IM,2)).GT.100.AND.MOD(IABS(K(IM,2))/10,10).NE.0)
08532 & THEN
08533 ELSE
08534 GOTO 150
08535 ENDIF
08536 ENDIF
08537 160 CONTINUE
08538 NPCO=MAX(NP,1)
08539 IF(NP.GE.6) NPCO=6
08540 IF(NP.GE.8) NPCO=7
08541 IF(NP.GE.11) NPCO=8
08542 IF(NP.GE.16) NPCO=9
08543 IF(NP.GE.26) NPCO=10
08544 NPIS(IKFIS,NPCO)=NPIS(IKFIS,NPCO)+1
08545 MSTU(62)=NP
08546
08547
08548 ELSEIF(MTABU.EQ.12) THEN
08549 FAC=1./MAX(1,NEVIS)
08550 WRITE(MSTU(11),5000) NEVIS
08551 DO 170 I=1,NKFIS
08552 KFMN=KFIS(I,1)
08553 IF(KFMN.EQ.0) KFMN=KFIS(I,2)
08554 KFM1=(KFMN+1)/2
08555 IF(2*KFM1.EQ.KFMN) KFM1=-KFM1
08556 CALL LUNAME(KFM1,CHAU)
08557 CHIS(1)=CHAU(1:12)
08558 IF(CHAU(13:13).NE.' ') CHIS(1)(12:12)='?'
08559 KFMX=KFIS(I,2)
08560 IF(KFIS(I,1).EQ.0) KFMX=0
08561 KFM2=(KFMX+1)/2
08562 IF(2*KFM2.EQ.KFMX) KFM2=-KFM2
08563 CALL LUNAME(KFM2,CHAU)
08564 CHIS(2)=CHAU(1:12)
08565 IF(CHAU(13:13).NE.' ') CHIS(2)(12:12)='?'
08566 WRITE(MSTU(11),5100) CHIS(1),CHIS(2),FAC*NPIS(I,0),
08567 & (NPIS(I,J)/FLOAT(NPIS(I,0)),J=1,10)
08568 170 CONTINUE
08569
08570
08571 ELSEIF(MTABU.EQ.13) THEN
08572 FAC=1./MAX(1,NEVIS)
08573 DO 190 I=1,NKFIS
08574 KFMN=KFIS(I,1)
08575 IF(KFMN.EQ.0) KFMN=KFIS(I,2)
08576 KFM1=(KFMN+1)/2
08577 IF(2*KFM1.EQ.KFMN) KFM1=-KFM1
08578 KFMX=KFIS(I,2)
08579 IF(KFIS(I,1).EQ.0) KFMX=0
08580 KFM2=(KFMX+1)/2
08581 IF(2*KFM2.EQ.KFMX) KFM2=-KFM2
08582 K(I,1)=32
08583 K(I,2)=99
08584 K(I,3)=KFM1
08585 K(I,4)=KFM2
08586 K(I,5)=NPIS(I,0)
08587 DO 180 J=1,5
08588 P(I,J)=FAC*NPIS(I,J)
08589 V(I,J)=FAC*NPIS(I,J+5)
08590 180 CONTINUE
08591 190 CONTINUE
08592 N=NKFIS
08593 DO 200 J=1,5
08594 K(N+1,J)=0
08595 P(N+1,J)=0.
08596 V(N+1,J)=0.
08597 200 CONTINUE
08598 K(N+1,1)=32
08599 K(N+1,2)=99
08600 K(N+1,5)=NEVIS
08601 MSTU(3)=1
08602
08603
08604 ELSEIF(MTABU.EQ.20) THEN
08605 NEVFS=0
08606 NPRFS=0
08607 NFIFS=0
08608 NCHFS=0
08609 NKFFS=0
08610
08611
08612 ELSEIF(MTABU.EQ.21) THEN
08613 NEVFS=NEVFS+1
08614 MSTU(62)=0
08615 DO 260 I=1,N
08616 IF(K(I,1).LE.0.OR.K(I,1).GT.20.OR.K(I,1).EQ.13) GOTO 260
08617 MSTU(62)=MSTU(62)+1
08618 KC=LUCOMP(K(I,2))
08619 MPRI=0
08620 IF(K(I,3).LE.0.OR.K(I,3).GT.N) THEN
08621 MPRI=1
08622 ELSEIF(K(K(I,3),1).LE.0.OR.K(K(I,3),1).GT.20) THEN
08623 MPRI=1
08624 ELSEIF(K(K(I,3),2).GE.91.AND.K(K(I,3),2).LE.93) THEN
08625 MPRI=1
08626 ELSEIF(KC.EQ.0) THEN
08627 ELSEIF(K(K(I,3),1).EQ.13) THEN
08628 IM=K(K(I,3),3)
08629 IF(IM.LE.0.OR.IM.GT.N) THEN
08630 MPRI=1
08631 ELSEIF(K(IM,1).LE.0.OR.K(IM,1).GT.20) THEN
08632 MPRI=1
08633 ENDIF
08634 ELSEIF(KCHG(KC,2).EQ.0) THEN
08635 KCM=LUCOMP(K(K(I,3),2))
08636 IF(KCM.NE.0) THEN
08637 IF(KCHG(KCM,2).NE.0) MPRI=1
08638 ENDIF
08639 ENDIF
08640 IF(KC.NE.0.AND.MPRI.EQ.1) THEN
08641 IF(KCHG(KC,2).EQ.0) NPRFS=NPRFS+1
08642 ENDIF
08643 IF(K(I,1).LE.10) THEN
08644 NFIFS=NFIFS+1
08645 IF(LUCHGE(K(I,2)).NE.0) NCHFS=NCHFS+1
08646 ENDIF
08647
08648
08649 KFA=IABS(K(I,2))
08650 KFS=3-ISIGN(1,K(I,2))-MPRI
08651 DO 210 IP=1,NKFFS
08652 IF(KFA.EQ.KFFS(IP)) THEN
08653 IKFFS=-IP
08654 GOTO 220
08655 ELSEIF(KFA.LT.KFFS(IP)) THEN
08656 IKFFS=IP
08657 GOTO 220
08658 ENDIF
08659 210 CONTINUE
08660 IKFFS=NKFFS+1
08661 220 IF(IKFFS.LT.0) THEN
08662 IKFFS=-IKFFS
08663 ELSE
08664 IF(NKFFS.GE.400) RETURN
08665 DO 240 IP=NKFFS,IKFFS,-1
08666 KFFS(IP+1)=KFFS(IP)
08667 DO 230 J=1,4
08668 NPFS(IP+1,J)=NPFS(IP,J)
08669 230 CONTINUE
08670 240 CONTINUE
08671 NKFFS=NKFFS+1
08672 KFFS(IKFFS)=KFA
08673 DO 250 J=1,4
08674 NPFS(IKFFS,J)=0
08675 250 CONTINUE
08676 ENDIF
08677 NPFS(IKFFS,KFS)=NPFS(IKFFS,KFS)+1
08678 260 CONTINUE
08679
08680
08681 ELSEIF(MTABU.EQ.22) THEN
08682 FAC=1./MAX(1,NEVFS)
08683 WRITE(MSTU(11),5200) NEVFS,FAC*NPRFS,FAC*NFIFS,FAC*NCHFS
08684 DO 270 I=1,NKFFS
08685 CALL LUNAME(KFFS(I),CHAU)
08686 KC=LUCOMP(KFFS(I))
08687 MDCYF=0
08688 IF(KC.NE.0) MDCYF=MDCY(KC,1)
08689 WRITE(MSTU(11),5300) KFFS(I),CHAU,MDCYF,(FAC*NPFS(I,J),J=1,4),
08690 & FAC*(NPFS(I,1)+NPFS(I,2)+NPFS(I,3)+NPFS(I,4))
08691 270 CONTINUE
08692
08693
08694 ELSEIF(MTABU.EQ.23) THEN
08695 FAC=1./MAX(1,NEVFS)
08696 DO 290 I=1,NKFFS
08697 K(I,1)=32
08698 K(I,2)=99
08699 K(I,3)=KFFS(I)
08700 K(I,4)=0
08701 K(I,5)=NPFS(I,1)+NPFS(I,2)+NPFS(I,3)+NPFS(I,4)
08702 DO 280 J=1,4
08703 P(I,J)=FAC*NPFS(I,J)
08704 V(I,J)=0.
08705 280 CONTINUE
08706 P(I,5)=FAC*K(I,5)
08707 V(I,5)=0.
08708 290 CONTINUE
08709 N=NKFFS
08710 DO 300 J=1,5
08711 K(N+1,J)=0
08712 P(N+1,J)=0.
08713 V(N+1,J)=0.
08714 300 CONTINUE
08715 K(N+1,1)=32
08716 K(N+1,2)=99
08717 K(N+1,5)=NEVFS
08718 P(N+1,1)=FAC*NPRFS
08719 P(N+1,2)=FAC*NFIFS
08720 P(N+1,3)=FAC*NCHFS
08721 MSTU(3)=1
08722
08723
08724 ELSEIF(MTABU.EQ.30) THEN
08725 NEVFM=0
08726 NMUFM=0
08727 DO 330 IM=1,3
08728 DO 320 IB=1,10
08729 DO 310 IP=1,4
08730 FM1FM(IM,IB,IP)=0.
08731 FM2FM(IM,IB,IP)=0.
08732 310 CONTINUE
08733 320 CONTINUE
08734 330 CONTINUE
08735
08736
08737 ELSEIF(MTABU.EQ.31) THEN
08738 NEVFM=NEVFM+1
08739 NLOW=N+MSTU(3)
08740 NUPP=NLOW
08741 DO 410 I=1,N
08742 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 410
08743 IF(MSTU(41).GE.2) THEN
08744 KC=LUCOMP(K(I,2))
08745 IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
08746 & KC.EQ.18) GOTO 410
08747 IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
08748 & GOTO 410
08749 ENDIF
08750 PMR=0.
08751 IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) PMR=ULMASS(211)
08752 IF(MSTU(42).GE.2) PMR=P(I,5)
08753 PR=MAX(1E-20,PMR**2+P(I,1)**2+P(I,2)**2)
08754 YETA=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/SQRT(PR),
08755 & 1E20)),P(I,3))
08756 IF(ABS(YETA).GT.PARU(57)) GOTO 410
08757 PHI=ULANGL(P(I,1),P(I,2))
08758 IYETA=512.*(YETA+PARU(57))/(2.*PARU(57))
08759 IYETA=MAX(0,MIN(511,IYETA))
08760 IPHI=512.*(PHI+PARU(1))/PARU(2)
08761 IPHI=MAX(0,MIN(511,IPHI))
08762 IYEP=0
08763 DO 340 IB=0,9
08764 IYEP=IYEP+4**IB*(2*MOD(IYETA/2**IB,2)+MOD(IPHI/2**IB,2))
08765 340 CONTINUE
08766
08767
08768 IF(NUPP.GT.MSTU(4)-5-MSTU(32)) THEN
08769 CALL LUERRM(11,'(LUTABU:) no more memory left in LUJETS')
08770 RETURN
08771 ENDIF
08772 NUPP=NUPP+1
08773 IF(NUPP.EQ.NLOW+1) THEN
08774 K(NUPP,1)=IYETA
08775 K(NUPP,2)=IPHI
08776 K(NUPP,3)=IYEP
08777 ELSE
08778 DO 350 I1=NUPP-1,NLOW+1,-1
08779 IF(IYETA.GE.K(I1,1)) GOTO 360
08780 K(I1+1,1)=K(I1,1)
08781 350 CONTINUE
08782 360 K(I1+1,1)=IYETA
08783 DO 370 I1=NUPP-1,NLOW+1,-1
08784 IF(IPHI.GE.K(I1,2)) GOTO 380
08785 K(I1+1,2)=K(I1,2)
08786 370 CONTINUE
08787 380 K(I1+1,2)=IPHI
08788 DO 390 I1=NUPP-1,NLOW+1,-1
08789 IF(IYEP.GE.K(I1,3)) GOTO 400
08790 K(I1+1,3)=K(I1,3)
08791 390 CONTINUE
08792 400 K(I1+1,3)=IYEP
08793 ENDIF
08794 410 CONTINUE
08795 K(NUPP+1,1)=2**10
08796 K(NUPP+1,2)=2**10
08797 K(NUPP+1,3)=4**10
08798
08799
08800 DO 480 IM=1,3
08801 DO 430 IB=1,10
08802 DO 420 IP=1,4
08803 FEVFM(IB,IP)=0.
08804 420 CONTINUE
08805 430 CONTINUE
08806 DO 450 IB=1,10
08807 IF(IM.LE.2) IBIN=2**(10-IB)
08808 IF(IM.EQ.3) IBIN=4**(10-IB)
08809 IAGR=K(NLOW+1,IM)/IBIN
08810 NAGR=1
08811 DO 440 I=NLOW+2,NUPP+1
08812 ICUT=K(I,IM)/IBIN
08813 IF(ICUT.EQ.IAGR) THEN
08814 NAGR=NAGR+1
08815 ELSE
08816 IF(NAGR.EQ.1) THEN
08817 ELSEIF(NAGR.EQ.2) THEN
08818 FEVFM(IB,1)=FEVFM(IB,1)+2.
08819 ELSEIF(NAGR.EQ.3) THEN
08820 FEVFM(IB,1)=FEVFM(IB,1)+6.
08821 FEVFM(IB,2)=FEVFM(IB,2)+6.
08822 ELSEIF(NAGR.EQ.4) THEN
08823 FEVFM(IB,1)=FEVFM(IB,1)+12.
08824 FEVFM(IB,2)=FEVFM(IB,2)+24.
08825 FEVFM(IB,3)=FEVFM(IB,3)+24.
08826 ELSE
08827 FEVFM(IB,1)=FEVFM(IB,1)+NAGR*(NAGR-1.)
08828 FEVFM(IB,2)=FEVFM(IB,2)+NAGR*(NAGR-1.)*(NAGR-2.)
08829 FEVFM(IB,3)=FEVFM(IB,3)+NAGR*(NAGR-1.)*(NAGR-2.)*(NAGR-3.)
08830 FEVFM(IB,4)=FEVFM(IB,4)+NAGR*(NAGR-1.)*(NAGR-2.)*(NAGR-3.)*
08831 & (NAGR-4.)
08832 ENDIF
08833 IAGR=ICUT
08834 NAGR=1
08835 ENDIF
08836 440 CONTINUE
08837 450 CONTINUE
08838
08839
08840 DO 470 IB=10,1,-1
08841 DO 460 IP=1,4
08842 IF(FEVFM(1,IP).LT.0.5) THEN
08843 FEVFM(IB,IP)=0.
08844 ELSEIF(IM.LE.2) THEN
08845 FEVFM(IB,IP)=2.**((IB-1)*IP)*FEVFM(IB,IP)/FEVFM(1,IP)
08846 ELSE
08847 FEVFM(IB,IP)=4.**((IB-1)*IP)*FEVFM(IB,IP)/FEVFM(1,IP)
08848 ENDIF
08849 FM1FM(IM,IB,IP)=FM1FM(IM,IB,IP)+FEVFM(IB,IP)
08850 FM2FM(IM,IB,IP)=FM2FM(IM,IB,IP)+FEVFM(IB,IP)**2
08851 460 CONTINUE
08852 470 CONTINUE
08853 480 CONTINUE
08854 NMUFM=NMUFM+(NUPP-NLOW)
08855 MSTU(62)=NUPP-NLOW
08856
08857
08858 ELSEIF(MTABU.EQ.32) THEN
08859 FAC=1./MAX(1,NEVFM)
08860 IF(MSTU(42).LE.0) WRITE(MSTU(11),5400) NEVFM,'eta'
08861 IF(MSTU(42).EQ.1) WRITE(MSTU(11),5400) NEVFM,'ypi'
08862 IF(MSTU(42).GE.2) WRITE(MSTU(11),5400) NEVFM,'y '
08863 DO 510 IM=1,3
08864 WRITE(MSTU(11),5500)
08865 DO 500 IB=1,10
08866 BYETA=2.*PARU(57)
08867 IF(IM.NE.2) BYETA=BYETA/2**(IB-1)
08868 BPHI=PARU(2)
08869 IF(IM.NE.1) BPHI=BPHI/2**(IB-1)
08870 IF(IM.LE.2) BNAVE=FAC*NMUFM/FLOAT(2**(IB-1))
08871 IF(IM.EQ.3) BNAVE=FAC*NMUFM/FLOAT(4**(IB-1))
08872 DO 490 IP=1,4
08873 FMOMA(IP)=FAC*FM1FM(IM,IB,IP)
08874 FMOMS(IP)=SQRT(MAX(0.,FAC*(FAC*FM2FM(IM,IB,IP)-FMOMA(IP)**2)))
08875 490 CONTINUE
08876 WRITE(MSTU(11),5600) BYETA,BPHI,BNAVE,(FMOMA(IP),FMOMS(IP),
08877 & IP=1,4)
08878 500 CONTINUE
08879 510 CONTINUE
08880
08881
08882 ELSEIF(MTABU.EQ.33) THEN
08883 FAC=1./MAX(1,NEVFM)
08884 DO 540 IM=1,3
08885 DO 530 IB=1,10
08886 I=10*(IM-1)+IB
08887 K(I,1)=32
08888 K(I,2)=99
08889 K(I,3)=1
08890 IF(IM.NE.2) K(I,3)=2**(IB-1)
08891 K(I,4)=1
08892 IF(IM.NE.1) K(I,4)=2**(IB-1)
08893 K(I,5)=0
08894 P(I,1)=2.*PARU(57)/K(I,3)
08895 V(I,1)=PARU(2)/K(I,4)
08896 DO 520 IP=1,4
08897 P(I,IP+1)=FAC*FM1FM(IM,IB,IP)
08898 V(I,IP+1)=SQRT(MAX(0.,FAC*(FAC*FM2FM(IM,IB,IP)-P(I,IP+1)**2)))
08899 520 CONTINUE
08900 530 CONTINUE
08901 540 CONTINUE
08902 N=30
08903 DO 550 J=1,5
08904 K(N+1,J)=0
08905 P(N+1,J)=0.
08906 V(N+1,J)=0.
08907 550 CONTINUE
08908 K(N+1,1)=32
08909 K(N+1,2)=99
08910 K(N+1,5)=NEVFM
08911 MSTU(3)=1
08912
08913
08914 ELSEIF(MTABU.EQ.40) THEN
08915 NEVEE=0
08916 DO 560 J=1,25
08917 FE1EC(J)=0.
08918 FE2EC(J)=0.
08919 FE1EC(51-J)=0.
08920 FE2EC(51-J)=0.
08921 FE1EA(J)=0.
08922 FE2EA(J)=0.
08923 560 CONTINUE
08924
08925
08926 ELSEIF(MTABU.EQ.41) THEN
08927 NEVEE=NEVEE+1
08928 NLOW=N+MSTU(3)
08929 NUPP=NLOW
08930 ECM=0.
08931 DO 570 I=1,N
08932 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 570
08933 IF(MSTU(41).GE.2) THEN
08934 KC=LUCOMP(K(I,2))
08935 IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
08936 & KC.EQ.18) GOTO 570
08937 IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
08938 & GOTO 570
08939 ENDIF
08940 PMR=0.
08941 IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) PMR=ULMASS(211)
08942 IF(MSTU(42).GE.2) PMR=P(I,5)
08943 IF(NUPP.GT.MSTU(4)-5-MSTU(32)) THEN
08944 CALL LUERRM(11,'(LUTABU:) no more memory left in LUJETS')
08945 RETURN
08946 ENDIF
08947 NUPP=NUPP+1
08948 P(NUPP,1)=P(I,1)
08949 P(NUPP,2)=P(I,2)
08950 P(NUPP,3)=P(I,3)
08951 P(NUPP,4)=SQRT(PMR**2+P(I,1)**2+P(I,2)**2+P(I,3)**2)
08952 P(NUPP,5)=MAX(1E-10,SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2))
08953 ECM=ECM+P(NUPP,4)
08954 570 CONTINUE
08955 IF(NUPP.EQ.NLOW) RETURN
08956
08957
08958 FAC=(2./ECM**2)*50./PARU(1)
08959 DO 580 J=1,50
08960 FEVEE(J)=0.
08961 580 CONTINUE
08962 DO 600 I1=NLOW+2,NUPP
08963 DO 590 I2=NLOW+1,I1-1
08964 CTHE=(P(I1,1)*P(I2,1)+P(I1,2)*P(I2,2)+P(I1,3)*P(I2,3))/
08965 & (P(I1,5)*P(I2,5))
08966 THE=ACOS(MAX(-1.,MIN(1.,CTHE)))
08967 ITHE=MAX(1,MIN(50,1+INT(50.*THE/PARU(1))))
08968 FEVEE(ITHE)=FEVEE(ITHE)+FAC*P(I1,4)*P(I2,4)
08969 590 CONTINUE
08970 600 CONTINUE
08971 DO 610 J=1,25
08972 FE1EC(J)=FE1EC(J)+FEVEE(J)
08973 FE2EC(J)=FE2EC(J)+FEVEE(J)**2
08974 FE1EC(51-J)=FE1EC(51-J)+FEVEE(51-J)
08975 FE2EC(51-J)=FE2EC(51-J)+FEVEE(51-J)**2
08976 FE1EA(J)=FE1EA(J)+(FEVEE(51-J)-FEVEE(J))
08977 FE2EA(J)=FE2EA(J)+(FEVEE(51-J)-FEVEE(J))**2
08978 610 CONTINUE
08979 MSTU(62)=NUPP-NLOW
08980
08981
08982 ELSEIF(MTABU.EQ.42) THEN
08983 FAC=1./MAX(1,NEVEE)
08984 WRITE(MSTU(11),5700) NEVEE
08985 DO 620 J=1,25
08986 FEEC1=FAC*FE1EC(J)
08987 FEES1=SQRT(MAX(0.,FAC*(FAC*FE2EC(J)-FEEC1**2)))
08988 FEEC2=FAC*FE1EC(51-J)
08989 FEES2=SQRT(MAX(0.,FAC*(FAC*FE2EC(51-J)-FEEC2**2)))
08990 FEECA=FAC*FE1EA(J)
08991 FEESA=SQRT(MAX(0.,FAC*(FAC*FE2EA(J)-FEECA**2)))
08992 WRITE(MSTU(11),5800) 3.6*(J-1),3.6*J,FEEC1,FEES1,FEEC2,FEES2,
08993 & FEECA,FEESA
08994 620 CONTINUE
08995
08996
08997 ELSEIF(MTABU.EQ.43) THEN
08998 FAC=1./MAX(1,NEVEE)
08999 DO 630 I=1,25
09000 K(I,1)=32
09001 K(I,2)=99
09002 K(I,3)=0
09003 K(I,4)=0
09004 K(I,5)=0
09005 P(I,1)=FAC*FE1EC(I)
09006 V(I,1)=SQRT(MAX(0.,FAC*(FAC*FE2EC(I)-P(I,1)**2)))
09007 P(I,2)=FAC*FE1EC(51-I)
09008 V(I,2)=SQRT(MAX(0.,FAC*(FAC*FE2EC(51-I)-P(I,2)**2)))
09009 P(I,3)=FAC*FE1EA(I)
09010 V(I,3)=SQRT(MAX(0.,FAC*(FAC*FE2EA(I)-P(I,3)**2)))
09011 P(I,4)=PARU(1)*(I-1)/50.
09012 P(I,5)=PARU(1)*I/50.
09013 V(I,4)=3.6*(I-1)
09014 V(I,5)=3.6*I
09015 630 CONTINUE
09016 N=25
09017 DO 640 J=1,5
09018 K(N+1,J)=0
09019 P(N+1,J)=0.
09020 V(N+1,J)=0.
09021 640 CONTINUE
09022 K(N+1,1)=32
09023 K(N+1,2)=99
09024 K(N+1,5)=NEVEE
09025 MSTU(3)=1
09026
09027
09028 ELSEIF(MTABU.EQ.50) THEN
09029 NEVDC=0
09030 NKFDC=0
09031 NREDC=0
09032
09033
09034 ELSEIF(MTABU.EQ.51) THEN
09035 NEVDC=NEVDC+1
09036 NDS=0
09037 DO 670 I=1,N
09038 IF(K(I,1).LE.0.OR.K(I,1).GE.6) GOTO 670
09039 NDS=NDS+1
09040 IF(NDS.GT.8) THEN
09041 NREDC=NREDC+1
09042 RETURN
09043 ENDIF
09044 KFM=2*IABS(K(I,2))
09045 IF(K(I,2).LT.0) KFM=KFM-1
09046 DO 650 IDS=NDS-1,1,-1
09047 IIN=IDS+1
09048 IF(KFM.LT.KFDM(IDS)) GOTO 660
09049 KFDM(IDS+1)=KFDM(IDS)
09050 650 CONTINUE
09051 IIN=1
09052 660 KFDM(IIN)=KFM
09053 670 CONTINUE
09054
09055
09056 DO 690 IDC=1,NKFDC
09057 IF(NDS.LT.KFDC(IDC,0)) THEN
09058 IKFDC=IDC
09059 GOTO 700
09060 ELSEIF(NDS.EQ.KFDC(IDC,0)) THEN
09061 DO 680 I=1,NDS
09062 IF(KFDM(I).LT.KFDC(IDC,I)) THEN
09063 IKFDC=IDC
09064 GOTO 700
09065 ELSEIF(KFDM(I).GT.KFDC(IDC,I)) THEN
09066 GOTO 690
09067 ENDIF
09068 680 CONTINUE
09069 IKFDC=-IDC
09070 GOTO 700
09071 ENDIF
09072 690 CONTINUE
09073 IKFDC=NKFDC+1
09074 700 IF(IKFDC.LT.0) THEN
09075 IKFDC=-IKFDC
09076 ELSEIF(NKFDC.GE.200) THEN
09077 NREDC=NREDC+1
09078 RETURN
09079 ELSE
09080 DO 720 IDC=NKFDC,IKFDC,-1
09081 NPDC(IDC+1)=NPDC(IDC)
09082 DO 710 I=0,8
09083 KFDC(IDC+1,I)=KFDC(IDC,I)
09084 710 CONTINUE
09085 720 CONTINUE
09086 NKFDC=NKFDC+1
09087 KFDC(IKFDC,0)=NDS
09088 DO 730 I=1,NDS
09089 KFDC(IKFDC,I)=KFDM(I)
09090 730 CONTINUE
09091 NPDC(IKFDC)=0
09092 ENDIF
09093 NPDC(IKFDC)=NPDC(IKFDC)+1
09094
09095
09096 ELSEIF(MTABU.EQ.52) THEN
09097 FAC=1./MAX(1,NEVDC)
09098 WRITE(MSTU(11),5900) NEVDC
09099 DO 750 IDC=1,NKFDC
09100 DO 740 I=1,KFDC(IDC,0)
09101 KFM=KFDC(IDC,I)
09102 KF=(KFM+1)/2
09103 IF(2*KF.NE.KFM) KF=-KF
09104 CALL LUNAME(KF,CHAU)
09105 CHDC(I)=CHAU(1:12)
09106 IF(CHAU(13:13).NE.' ') CHDC(I)(12:12)='?'
09107 740 CONTINUE
09108 WRITE(MSTU(11),6000) FAC*NPDC(IDC),(CHDC(I),I=1,KFDC(IDC,0))
09109 750 CONTINUE
09110 IF(NREDC.NE.0) WRITE(MSTU(11),6100) FAC*NREDC
09111
09112
09113 ELSEIF(MTABU.EQ.53) THEN
09114 FAC=1./MAX(1,NEVDC)
09115 DO 780 IDC=1,NKFDC
09116 K(IDC,1)=32
09117 K(IDC,2)=99
09118 K(IDC,3)=0
09119 K(IDC,4)=0
09120 K(IDC,5)=KFDC(IDC,0)
09121 DO 760 J=1,5
09122 P(IDC,J)=0.
09123 V(IDC,J)=0.
09124 760 CONTINUE
09125 DO 770 I=1,KFDC(IDC,0)
09126 KFM=KFDC(IDC,I)
09127 KF=(KFM+1)/2
09128 IF(2*KF.NE.KFM) KF=-KF
09129 IF(I.LE.5) P(IDC,I)=KF
09130 IF(I.GE.6) V(IDC,I-5)=KF
09131 770 CONTINUE
09132 V(IDC,5)=FAC*NPDC(IDC)
09133 780 CONTINUE
09134 N=NKFDC
09135 DO 790 J=1,5
09136 K(N+1,J)=0
09137 P(N+1,J)=0.
09138 V(N+1,J)=0.
09139 790 CONTINUE
09140 K(N+1,1)=32
09141 K(N+1,2)=99
09142 K(N+1,5)=NEVDC
09143 V(N+1,5)=FAC*NREDC
09144 MSTU(3)=1
09145 ENDIF
09146
09147
09148 5000 FORMAT(///20X,'Event statistics - initial state'/
09149 &20X,'based on an analysis of ',I6,' events'//
09150 &3X,'Main flavours after',8X,'Fraction',4X,'Subfractions ',
09151 &'according to fragmenting system multiplicity'/
09152 &4X,'hard interaction',24X,'1',7X,'2',7X,'3',7X,'4',7X,'5',
09153 &6X,'6-7',5X,'8-10',3X,'11-15',3X,'16-25',4X,'>25'/)
09154 5100 FORMAT(3X,A12,1X,A12,F10.5,1X,10F8.4)
09155 5200 FORMAT(///20X,'Event statistics - final state'/
09156 &20X,'based on an analysis of ',I7,' events'//
09157 &5X,'Mean primary multiplicity =',F10.4/
09158 &5X,'Mean final multiplicity =',F10.4/
09159 &5X,'Mean charged multiplicity =',F10.4//
09160 &5X,'Number of particles produced per event (directly and via ',
09161 &'decays/branchings)'/
09162 &5X,'KF Particle/jet MDCY',10X,'Particles',13X,'Antiparticles',
09163 &8X,'Total'/35X,'prim seco prim seco'/)
09164 5300 FORMAT(1X,I6,4X,A16,I2,5(1X,F11.6))
09165 5400 FORMAT(///20X,'Factorial moments analysis of multiplicity'/
09166 &20X,'based on an analysis of ',I6,' events'//
09167 &3X,'delta-',A3,' delta-phi <n>/bin',10X,'<F2>',18X,'<F3>',
09168 &18X,'<F4>',18X,'<F5>'/35X,4(' value error '))
09169 5500 FORMAT(10X)
09170 5600 FORMAT(2X,2F10.4,F12.4,4(F12.4,F10.4))
09171 5700 FORMAT(///20X,'Energy-Energy Correlation and Asymmetry'/
09172 &20X,'based on an analysis of ',I6,' events'//
09173 &2X,'theta range',8X,'EEC(theta)',8X,'EEC(180-theta)',7X,
09174 &'EECA(theta)'/2X,'in degrees ',3(' value error')/)
09175 5800 FORMAT(2X,F4.1,' - ',F4.1,3(F11.4,F9.4))
09176 5900 FORMAT(///20X,'Decay channel analysis - final state'/
09177 &20X,'based on an analysis of ',I6,' events'//
09178 &2X,'Probability',10X,'Complete final state'/)
09179 6000 FORMAT(2X,F9.5,5X,8(A12,1X))
09180 6100 FORMAT(2X,F9.5,5X,'into other channels (more than 8 particles ',
09181 &'or table overflow)')
09182
09183 RETURN
09184 END
09185
09186
09187
09188 SUBROUTINE LUEEVT(KFL,ECM)
09189
09190
09191 IMPLICIT DOUBLE PRECISION(D)
09192 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
09193 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
09194 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
09195 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
09196
09197
09198 IF(MSTU(12).GE.1) CALL LULIST(0)
09199 IF(KFL.LT.0.OR.KFL.GT.8) THEN
09200 CALL LUERRM(16,'(LUEEVT:) called with unknown flavour code')
09201 IF(MSTU(21).GE.1) RETURN
09202 ENDIF
09203 IF(KFL.LE.5) ECMMIN=PARJ(127)+2.02*PARF(100+MAX(1,KFL))
09204 IF(KFL.GE.6) ECMMIN=PARJ(127)+2.02*PMAS(KFL,1)
09205 IF(ECM.LT.ECMMIN) THEN
09206 CALL LUERRM(16,'(LUEEVT:) called with too small CM energy')
09207 IF(MSTU(21).GE.1) RETURN
09208 ENDIF
09209
09210
09211 IF(MSTJ(109).EQ.2.AND.MSTJ(110).NE.1) THEN
09212 CALL LUERRM(6,
09213 & '(LUEEVT:) MSTJ(109) value requires MSTJ(110) = 1')
09214 MSTJ(110)=1
09215 ENDIF
09216 IF(MSTJ(109).EQ.2.AND.MSTJ(111).NE.0) THEN
09217 CALL LUERRM(6,
09218 & '(LUEEVT:) MSTJ(109) value requires MSTJ(111) = 0')
09219 MSTJ(111)=0
09220 ENDIF
09221
09222
09223 MSTU(111)=MSTJ(108)
09224 IF(MSTJ(108).EQ.2.AND.(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.1))
09225 &MSTU(111)=1
09226 PARU(112)=PARJ(121)
09227 IF(MSTU(111).EQ.2) PARU(112)=PARJ(122)
09228 IF(MSTJ(116).GT.0.AND.(MSTJ(116).GE.2.OR.ABS(ECM-PARJ(151)).GE.
09229 &PARJ(139).OR.10*MSTJ(102)+KFL.NE.MSTJ(119))) CALL LUXTOT(KFL,ECM,
09230 &XTOT)
09231 IF(MSTJ(116).GE.3) MSTJ(116)=1
09232 PARJ(171)=0.
09233
09234
09235 NTRY=0
09236 100 NTRY=NTRY+1
09237 IF(NTRY.GT.100) THEN
09238 CALL LUERRM(14,'(LUEEVT:) caught in an infinite loop')
09239 RETURN
09240 ENDIF
09241 MSTU(24)=0
09242 NC=0
09243 IF(MSTJ(115).GE.2) THEN
09244 NC=NC+2
09245 CALL LU1ENT(NC-1,11,0.5*ECM,0.,0.)
09246 K(NC-1,1)=21
09247 CALL LU1ENT(NC,-11,0.5*ECM,PARU(1),0.)
09248 K(NC,1)=21
09249 ENDIF
09250
09251
09252 MK=0
09253 ECMC=ECM
09254 IF(MSTJ(107).GE.1.AND.MSTJ(116).GE.1) CALL LURADK(ECM,MK,PAK,
09255 &THEK,PHIK,ALPK)
09256 IF(MK.EQ.1) ECMC=SQRT(ECM*(ECM-2.*PAK))
09257 IF(MSTJ(115).GE.1.AND.MK.EQ.1) THEN
09258 NC=NC+1
09259 CALL LU1ENT(NC,22,PAK,THEK,PHIK)
09260 K(NC,3)=MIN(MSTJ(115)/2,1)
09261 ENDIF
09262
09263
09264 IF(MSTJ(115).GE.3) THEN
09265 NC=NC+1
09266 KF=22
09267 IF(MSTJ(102).EQ.2) KF=23
09268 MSTU10=MSTU(10)
09269 MSTU(10)=1
09270 P(NC,5)=ECMC
09271 CALL LU1ENT(NC,KF,ECMC,0.,0.)
09272 K(NC,1)=21
09273 K(NC,3)=1
09274 MSTU(10)=MSTU10
09275 ENDIF
09276
09277
09278 CALL LUXKFL(KFL,ECM,ECMC,KFLC)
09279 IF(KFLC.EQ.0) GOTO 100
09280 CALL LUXJET(ECMC,NJET,CUT)
09281 KFLN=21
09282 IF(NJET.EQ.4) CALL LUX4JT(NJET,CUT,KFLC,ECMC,KFLN,X1,X2,X4,
09283 &X12,X14)
09284 IF(NJET.EQ.3) CALL LUX3JT(NJET,CUT,KFLC,ECMC,X1,X3)
09285 IF(NJET.EQ.2) MSTJ(120)=1
09286
09287
09288 IF(NJET.EQ.2.AND.MSTJ(101).NE.5) CALL LU2ENT(NC+1,KFLC,-KFLC,ECMC)
09289 IF(NJET.EQ.2.AND.MSTJ(101).EQ.5) CALL LU2ENT(-(NC+1),KFLC,-KFLC,
09290 &ECMC)
09291 IF(NJET.EQ.3) CALL LU3ENT(NC+1,KFLC,21,-KFLC,ECMC,X1,X3)
09292 IF(NJET.EQ.4.AND.KFLN.EQ.21) CALL LU4ENT(NC+1,KFLC,KFLN,KFLN,
09293 &-KFLC,ECMC,X1,X2,X4,X12,X14)
09294 IF(NJET.EQ.4.AND.KFLN.NE.21) CALL LU4ENT(NC+1,KFLC,-KFLN,KFLN,
09295 &-KFLC,ECMC,X1,X2,X4,X12,X14)
09296 IF(MSTU(24).NE.0) GOTO 100
09297 DO 110 IP=NC+1,N
09298 K(IP,3)=K(IP,3)+MIN(MSTJ(115)/2,1)+(MSTJ(115)/3)*(NC-1)
09299 110 CONTINUE
09300
09301
09302 IF(MSTJ(106).EQ.1) THEN
09303 CALL LUXDIF(NC,NJET,KFLC,ECMC,CHI,THE,PHI)
09304 CALL LUDBRB(NC+1,N,0.,CHI,0D0,0D0,0D0)
09305 CALL LUDBRB(NC+1,N,THE,PHI,0D0,0D0,0D0)
09306 ENDIF
09307
09308
09309 IF(MK.EQ.1) THEN
09310 DBEK=-PAK/(ECM-PAK)
09311 NMIN=NC+1-MSTJ(115)/3
09312 CALL LUDBRB(NMIN,N,0.,-PHIK,0D0,0D0,0D0)
09313 CALL LUDBRB(NMIN,N,ALPK,0.,DBEK*SIN(THEK),0D0,DBEK*COS(THEK))
09314 CALL LUDBRB(NMIN,N,0.,PHIK,0D0,0D0,0D0)
09315 ENDIF
09316
09317
09318 IF(MSTJ(101).EQ.5) THEN
09319 CALL LUSHOW(N-1,N,ECMC)
09320 MSTJ14=MSTJ(14)
09321 IF(MSTJ(105).EQ.-1) MSTJ(14)=-1
09322 IF(MSTJ(105).GE.0) MSTU(28)=0
09323 CALL LUPREP(0)
09324 MSTJ(14)=MSTJ14
09325 IF(MSTJ(105).GE.0.AND.MSTU(28).NE.0) GOTO 100
09326 ENDIF
09327
09328
09329 IF(MSTJ(105).EQ.1) CALL LUEXEC
09330 MSTU(161)=KFLC
09331 MSTU(162)=-KFLC
09332
09333 RETURN
09334 END
09335
09336
09337
09338 SUBROUTINE LUXTOT(KFL,ECM,XTOT)
09339
09340
09341
09342 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
09343 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
09344 SAVE /LUDAT1/,/LUDAT2/
09345
09346
09347 PARJ(151)=ECM
09348 MSTJ(119)=10*MSTJ(102)+KFL
09349 IF(MSTJ(111).EQ.0) THEN
09350 Q2R=ECM**2
09351 ELSEIF(MSTU(111).EQ.0) THEN
09352 PARJ(168)=MIN(1.,MAX(PARJ(128),EXP(-12.*PARU(1)/
09353 & ((33.-2.*MSTU(112))*PARU(111)))))
09354 Q2R=PARJ(168)*ECM**2
09355 ELSE
09356 PARJ(168)=MIN(1.,MAX(PARJ(128),PARU(112)/ECM,
09357 & (2.*PARU(112)/ECM)**2))
09358 Q2R=PARJ(168)*ECM**2
09359 ENDIF
09360 ALSPI=ULALPS(Q2R)/PARU(1)
09361
09362
09363 IF(MSTJ(101).EQ.0.OR.MSTJ(109).EQ.1) THEN
09364 RQCD=1.
09365 ELSEIF(IABS(MSTJ(101)).EQ.1.AND.MSTJ(109).EQ.0) THEN
09366 RQCD=1.+ALSPI
09367 ELSEIF(MSTJ(109).EQ.0) THEN
09368 RQCD=1.+ALSPI+(1.986-0.115*MSTU(118))*ALSPI**2
09369 IF(MSTJ(111).EQ.1) RQCD=MAX(1.,RQCD+(33.-2.*MSTU(112))/12.*
09370 & LOG(PARJ(168))*ALSPI**2)
09371 ELSEIF(IABS(MSTJ(101)).EQ.1) THEN
09372 RQCD=1.+(3./4.)*ALSPI
09373 ELSE
09374 RQCD=1.+(3./4.)*ALSPI-(3./32.+0.519*MSTU(118))*ALSPI**2
09375 ENDIF
09376
09377
09378 IF(MSTJ(102).GE.3) THEN
09379 RVA=3.*(3.+(4.*PARU(102)-1.)**2)+6.*RQCD*(2.+(1.-8.*PARU(102)/
09380 & 3.)**2+(4.*PARU(102)/3.-1.)**2)
09381 DO 100 KFLC=5,6
09382 VQ=1.
09383 IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(MAX(0.,1.-(2.*ULMASS(KFLC)/
09384 & ECM)**2))
09385 IF(KFLC.EQ.5) VF=4.*PARU(102)/3.-1.
09386 IF(KFLC.EQ.6) VF=1.-8.*PARU(102)/3.
09387 RVA=RVA+3.*RQCD*(0.5*VQ*(3.-VQ**2)*VF**2+VQ**3)
09388 100 CONTINUE
09389 PARJ(124)=PARU(101)*PARJ(123)*RVA/(48.*PARU(102)*(1.-PARU(102)))
09390 ENDIF
09391
09392
09393 POLL=1.-PARJ(131)*PARJ(132)
09394 IF(MSTJ(102).GE.2) THEN
09395 SFF=1./(16.*PARU(102)*(1.-PARU(102)))
09396 SFW=ECM**4/((ECM**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2)
09397 SFI=SFW*(1.-(PARJ(123)/ECM)**2)
09398 VE=4.*PARU(102)-1.
09399 SF1I=SFF*(VE*POLL+PARJ(132)-PARJ(131))
09400 SF1W=SFF**2*((VE**2+1.)*POLL+2.*VE*(PARJ(132)-PARJ(131)))
09401 HF1I=SFI*SF1I
09402 HF1W=SFW*SF1W
09403 ENDIF
09404
09405
09406 RTOT=0.
09407 RQQ=0.
09408 RQV=0.
09409 RVA=0.
09410 DO 110 KFLC=1,MAX(MSTJ(104),KFL)
09411 IF(KFL.GT.0.AND.KFLC.NE.KFL) GOTO 110
09412 MSTJ(93)=1
09413 PMQ=ULMASS(KFLC)
09414 IF(ECM.LT.2.*PMQ+PARJ(127)) GOTO 110
09415 QF=KCHG(KFLC,1)/3.
09416 VQ=1.
09417 IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(1.-(2.*PMQ/ECM)**2)
09418
09419
09420 RQQ=RQQ+3.*QF**2*POLL
09421 IF(MSTJ(102).LE.1) THEN
09422 RTOT=RTOT+3.*0.5*VQ*(3.-VQ**2)*QF**2*POLL
09423 ELSE
09424 VF=SIGN(1.,QF)-4.*QF*PARU(102)
09425 RQV=RQV-6.*QF*VF*SF1I
09426 RVA=RVA+3.*(VF**2+1.)*SF1W
09427 RTOT=RTOT+3.*(0.5*VQ*(3.-VQ**2)*(QF**2*POLL-2.*QF*VF*HF1I+
09428 & VF**2*HF1W)+VQ**3*HF1W)
09429 ENDIF
09430 110 CONTINUE
09431 RSUM=RQQ
09432 IF(MSTJ(102).GE.2) RSUM=RQQ+SFI*RQV+SFW*RVA
09433
09434
09435 PARJ(141)=RQQ
09436 PARJ(142)=RTOT
09437 PARJ(143)=RTOT*RQCD
09438 PARJ(144)=PARJ(143)
09439 PARJ(145)=PARJ(141)*86.8/ECM**2
09440 PARJ(146)=PARJ(142)*86.8/ECM**2
09441 PARJ(147)=PARJ(143)*86.8/ECM**2
09442 PARJ(148)=PARJ(147)
09443 PARJ(157)=RSUM*RQCD
09444 PARJ(158)=0.
09445 PARJ(159)=0.
09446 XTOT=PARJ(147)
09447 IF(MSTJ(107).LE.0) RETURN
09448
09449
09450 XKL=PARJ(135)
09451 XKU=MIN(PARJ(136),1.-(2.*PARJ(127)/ECM)**2)
09452 ALE=2.*LOG(ECM/ULMASS(11))-1.
09453 SIGV=ALE/3.+2.*LOG(ECM**2/(ULMASS(13)*ULMASS(15)))/3.-4./3.+
09454 &1.526*LOG(ECM**2/0.932)
09455
09456
09457 IF(MSTJ(102).LE.1) THEN
09458 SIGV=1.5*ALE-0.5+PARU(1)**2/3.+2.*SIGV
09459 SIGS=ALE*(2.*LOG(XKL)-LOG(1.-XKL)-XKL)
09460 SIGH=ALE*(2.*LOG(XKU/XKL)-LOG((1.-XKU)/(1.-XKL))-(XKU-XKL))
09461
09462
09463 ELSE
09464 SZM=1.-(PARJ(123)/ECM)**2
09465 SZW=PARJ(123)*PARJ(124)/ECM**2
09466 PARJ(161)=-RQQ/RSUM
09467 PARJ(162)=-(RQQ+RQV+RVA)/RSUM
09468 PARJ(163)=(RQV*(1.-0.5*SZM-SFI)+RVA*(1.5-SZM-SFW))/RSUM
09469 PARJ(164)=(RQV*SZW**2*(1.-2.*SFW)+RVA*(2.*SFI+SZW**2-4.+3.*SZM-
09470 & SZM**2))/(SZW*RSUM)
09471 SIGV=1.5*ALE-0.5+PARU(1)**2/3.+((2.*RQQ+SFI*RQV)/RSUM)*SIGV+
09472 & (SZW*SFW*RQV/RSUM)*PARU(1)*20./9.
09473 SIGS=ALE*(2.*LOG(XKL)+PARJ(161)*LOG(1.-XKL)+PARJ(162)*XKL+
09474 & PARJ(163)*LOG(((XKL-SZM)**2+SZW**2)/(SZM**2+SZW**2))+
09475 & PARJ(164)*(ATAN((XKL-SZM)/SZW)-ATAN(-SZM/SZW)))
09476 SIGH=ALE*(2.*LOG(XKU/XKL)+PARJ(161)*LOG((1.-XKU)/(1.-XKL))+
09477 & PARJ(162)*(XKU-XKL)+PARJ(163)*LOG(((XKU-SZM)**2+SZW**2)/
09478 & ((XKL-SZM)**2+SZW**2))+PARJ(164)*(ATAN((XKU-SZM)/SZW)-
09479 & ATAN((XKL-SZM)/SZW)))
09480 ENDIF
09481
09482
09483 PARJ(160)=SIGH/(PARU(1)/PARU(101)+SIGV+SIGS+SIGH)
09484 PARJ(157)=RSUM*(1.+(PARU(101)/PARU(1))*(SIGV+SIGS+SIGH))*RQCD
09485 PARJ(144)=PARJ(157)
09486 PARJ(148)=PARJ(144)*86.8/ECM**2
09487 XTOT=PARJ(148)
09488
09489 RETURN
09490 END
09491
09492
09493
09494 SUBROUTINE LURADK(ECM,MK,PAK,THEK,PHIK,ALPK)
09495
09496
09497 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
09498 SAVE /LUDAT1/
09499
09500
09501 FXK(XX)=2.*LOG(XX)+PARJ(161)*LOG(1.-XX)+PARJ(162)*XX+
09502 &PARJ(163)*LOG((XX-SZM)**2+SZW**2)+PARJ(164)*ATAN((XX-SZM)/SZW)
09503
09504
09505 MK=0
09506 PAK=0.
09507 IF(PARJ(160).LT.RLU(0)) RETURN
09508 MK=1
09509
09510
09511 XKL=PARJ(135)
09512 XKU=MIN(PARJ(136),1.-(2.*PARJ(127)/ECM)**2)
09513 IF(MSTJ(102).LE.1) THEN
09514 100 XK=1./(1.+(1./XKL-1.)*((1./XKU-1.)/(1./XKL-1.))**RLU(0))
09515 IF(1.+(1.-XK)**2.LT.2.*RLU(0)) GOTO 100
09516
09517
09518 ELSE
09519 SZM=1.-(PARJ(123)/ECM)**2
09520 SZW=PARJ(123)*PARJ(124)/ECM**2
09521 FXKL=FXK(XKL)
09522 FXKU=FXK(XKU)
09523 FXKD=1E-4*(FXKU-FXKL)
09524 FXKR=FXKL+RLU(0)*(FXKU-FXKL)
09525 NXK=0
09526 110 NXK=NXK+1
09527 XK=0.5*(XKL+XKU)
09528 FXKV=FXK(XK)
09529 IF(FXKV.GT.FXKR) THEN
09530 XKU=XK
09531 FXKU=FXKV
09532 ELSE
09533 XKL=XK
09534 FXKL=FXKV
09535 ENDIF
09536 IF(NXK.LT.15.AND.FXKU-FXKL.GT.FXKD) GOTO 110
09537 XK=XKL+(XKU-XKL)*(FXKR-FXKL)/(FXKU-FXKL)
09538 ENDIF
09539 PAK=0.5*ECM*XK
09540
09541
09542 PME=2.*(ULMASS(11)/ECM)**2
09543 120 CTHM=PME*(2./PME)**RLU(0)
09544 IF(1.-(XK**2*CTHM*(1.-0.5*CTHM)+2.*(1.-XK)*PME/MAX(PME,
09545 &CTHM*(1.-0.5*CTHM)))/(1.+(1.-XK)**2).LT.RLU(0)) GOTO 120
09546 CTHE=1.-CTHM
09547 IF(RLU(0).GT.0.5) CTHE=-CTHE
09548 STHE=SQRT(MAX(0.,(CTHM-PME)*(2.-CTHM)))
09549 THEK=ULANGL(CTHE,STHE)
09550 PHIK=PARU(2)*RLU(0)
09551
09552
09553 SGN=1.
09554 IF(0.5*(2.-XK*(1.-CTHE))**2/((2.-XK)**2+(XK*CTHE)**2).GT.
09555 &RLU(0)) SGN=-1.
09556 ALPK=ASIN(SGN*STHE*(XK-SGN*(2.*SQRT(1.-XK)-2.+XK)*CTHE)/
09557 &(2.-XK*(1.-SGN*CTHE)))
09558
09559 RETURN
09560 END
09561
09562
09563
09564 SUBROUTINE LUXKFL(KFL,ECM,ECMC,KFLC)
09565
09566
09567 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
09568 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
09569 SAVE /LUDAT1/,/LUDAT2/
09570
09571
09572 IF(MSTJ(102).LE.1) THEN
09573 RFMAX=4./9.
09574 ELSE
09575 POLL=1.-PARJ(131)*PARJ(132)
09576 SFF=1./(16.*PARU(102)*(1.-PARU(102)))
09577 SFW=ECMC**4/((ECMC**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2)
09578 SFI=SFW*(1.-(PARJ(123)/ECMC)**2)
09579 VE=4.*PARU(102)-1.
09580 HF1I=SFI*SFF*(VE*POLL+PARJ(132)-PARJ(131))
09581 HF1W=SFW*SFF**2*((VE**2+1.)*POLL+2.*VE*(PARJ(132)-PARJ(131)))
09582 RFMAX=MAX(4./9.*POLL-4./3.*(1.-8.*PARU(102)/3.)*HF1I+
09583 & ((1.-8.*PARU(102)/3.)**2+1.)*HF1W,1./9.*POLL+2./3.*
09584 & (-1.+4.*PARU(102)/3.)*HF1I+((-1.+4.*PARU(102)/3.)**2+1.)*HF1W)
09585 ENDIF
09586
09587
09588 NTRY=0
09589 100 NTRY=NTRY+1
09590 IF(NTRY.GT.100) THEN
09591 CALL LUERRM(14,'(LUXKFL:) caught in an infinite loop')
09592 KFLC=0
09593 RETURN
09594 ENDIF
09595 KFLC=KFL
09596 IF(KFL.LE.0) KFLC=1+INT(MSTJ(104)*RLU(0))
09597 MSTJ(93)=1
09598 PMQ=ULMASS(KFLC)
09599 IF(ECM.LT.2.*PMQ+PARJ(127)) GOTO 100
09600 QF=KCHG(KFLC,1)/3.
09601 VQ=1.
09602 IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(MAX(0.,1.-(2.*PMQ/ECMC)**2))
09603
09604
09605 IF(MSTJ(102).LE.1) THEN
09606 RF=QF**2
09607 RFV=0.5*VQ*(3.-VQ**2)*QF**2
09608 ELSE
09609 VF=SIGN(1.,QF)-4.*QF*PARU(102)
09610 RF=QF**2*POLL-2.*QF*VF*HF1I+(VF**2+1.)*HF1W
09611 RFV=0.5*VQ*(3.-VQ**2)*(QF**2*POLL-2.*QF*VF*HF1I+VF**2*HF1W)+
09612 & VQ**3*HF1W
09613 IF(RFV.GT.0.) PARJ(171)=MIN(1.,VQ**3*HF1W/RFV)
09614 ENDIF
09615
09616
09617 IF(KFL.LE.0.AND.RF.LT.RLU(0)*RFMAX) GOTO 100
09618 PARJ(158)=PARJ(158)+1.
09619 IF(ECMC.LT.2.*PMQ+PARJ(127).OR.RFV.LT.RLU(0)*RF) KFLC=0
09620 IF(MSTJ(107).LE.0.AND.KFLC.EQ.0) GOTO 100
09621 IF(KFLC.NE.0) PARJ(159)=PARJ(159)+1.
09622 PARJ(144)=PARJ(157)*PARJ(159)/PARJ(158)
09623 PARJ(148)=PARJ(144)*86.8/ECM**2
09624
09625 RETURN
09626 END
09627
09628
09629
09630 SUBROUTINE LUXJET(ECM,NJET,CUT)
09631
09632
09633 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
09634 SAVE /LUDAT1/
09635 DIMENSION ZHUT(5)
09636
09637
09638 DATA ZHUT/3.0922, 6.2291, 7.4782, 7.8440, 8.2560/
09639
09640
09641 IF(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.5) THEN
09642 CUT=0.
09643
09644
09645 ELSEIF(MSTJ(109).EQ.0.OR.MSTJ(109).EQ.2) THEN
09646 CF=4./3.
09647 IF(MSTJ(109).EQ.2) CF=1.
09648 IF(MSTJ(111).EQ.0) THEN
09649 Q2=ECM**2
09650 Q2R=ECM**2
09651 ELSEIF(MSTU(111).EQ.0) THEN
09652 PARJ(169)=MIN(1.,PARJ(129))
09653 Q2=PARJ(169)*ECM**2
09654 PARJ(168)=MIN(1.,MAX(PARJ(128),EXP(-12.*PARU(1)/
09655 & ((33.-2.*MSTU(112))*PARU(111)))))
09656 Q2R=PARJ(168)*ECM**2
09657 ELSE
09658 PARJ(169)=MIN(1.,MAX(PARJ(129),(2.*PARU(112)/ECM)**2))
09659 Q2=PARJ(169)*ECM**2
09660 PARJ(168)=MIN(1.,MAX(PARJ(128),PARU(112)/ECM,
09661 & (2.*PARU(112)/ECM)**2))
09662 Q2R=PARJ(168)*ECM**2
09663 ENDIF
09664
09665
09666 ALSPI=(3./4.)*CF*ULALPS(Q2R)/PARU(1)
09667 IF(IABS(MSTJ(101)).EQ.1) THEN
09668 RQCD=1.+ALSPI
09669 ELSEIF(MSTJ(109).EQ.0) THEN
09670 RQCD=1.+ALSPI+(1.986-0.115*MSTU(118))*ALSPI**2
09671 IF(MSTJ(111).EQ.1) RQCD=MAX(1.,RQCD+(33.-2.*MSTU(112))/12.*
09672 & LOG(PARJ(168))*ALSPI**2)
09673 ELSE
09674 RQCD=1.+ALSPI-(3./32.+0.519*MSTU(118))*(4.*ALSPI/3.)**2
09675 ENDIF
09676
09677
09678 ALSPI=(3./4.)*CF*ULALPS(Q2)/PARU(1)
09679 CUT=MAX(0.001,PARJ(125),(PARJ(126)/ECM)**2)
09680 IF(IABS(MSTJ(101)).LE.1.OR.(MSTJ(109).EQ.0.AND.MSTJ(111).EQ.0))
09681 & CUT=MAX(CUT,EXP(-SQRT(0.75/ALSPI))/2.)
09682 IF(MSTJ(110).EQ.2) CUT=MAX(0.01,MIN(0.05,CUT))
09683
09684
09685 100 IF(MSTJ(101).EQ.0.OR.CUT.GE.0.25) THEN
09686 PARJ(152)=0.
09687 ELSE
09688 PARJ(152)=(2.*ALSPI/3.)*((3.-6.*CUT+2.*LOG(CUT))*
09689 & LOG(CUT/(1.-2.*CUT))+(2.5+1.5*CUT-6.571)*(1.-3.*CUT)+
09690 & 5.833*(1.-3.*CUT)**2-3.894*(1.-3.*CUT)**3+
09691 & 1.342*(1.-3.*CUT)**4)/RQCD
09692 IF(MSTJ(109).EQ.2.AND.(MSTJ(101).EQ.2.OR.MSTJ(101).LE.-2))
09693 & PARJ(152)=0.
09694 ENDIF
09695
09696
09697 IF(IABS(MSTJ(101)).LE.1.OR.MSTJ(101).EQ.3.OR.MSTJ(109).EQ.2.OR.
09698 & CUT.GE.0.25) THEN
09699 PARJ(153)=0.
09700 ELSEIF(MSTJ(110).LE.1) THEN
09701 CT=LOG(1./CUT-2.)
09702 PARJ(153)=ALSPI**2*CT**2*(2.419+0.5989*CT+0.6782*CT**2-
09703 & 0.2661*CT**3+0.01159*CT**4)/RQCD
09704
09705
09706 ELSEIF(MSTJ(110).EQ.2) THEN
09707 IZA=0
09708 DO 110 IY=1,5
09709 IF(ABS(CUT-0.01*IY).LT.0.0001) IZA=IY
09710 110 CONTINUE
09711 IF(IZA.NE.0) THEN
09712 ZHURAT=ZHUT(IZA)
09713 ELSE
09714 IZ=100.*CUT
09715 ZHURAT=ZHUT(IZ)+(100.*CUT-IZ)*(ZHUT(IZ+1)-ZHUT(IZ))
09716 ENDIF
09717 PARJ(153)=ALSPI*PARJ(152)*ZHURAT
09718 ENDIF
09719
09720
09721 IF(MSTJ(111).EQ.1.AND.IABS(MSTJ(101)).GE.2.AND.MSTJ(101).NE.3.
09722 & AND.CUT.LT.0.25) PARJ(153)=PARJ(153)+(33.-2.*MSTU(112))/12.*
09723 & LOG(PARJ(169))*ALSPI*PARJ(152)
09724
09725
09726 IF(IABS(MSTJ(101)).LE.1.OR.CUT.GE.0.125) THEN
09727 PARJ(154)=0.
09728 ELSE
09729 CT=LOG(1./CUT-5.)
09730 IF(CUT.LE.0.018) THEN
09731 XQQGG=6.349-4.330*CT+0.8304*CT**2
09732 IF(MSTJ(109).EQ.2) XQQGG=(4./3.)**2*(3.035-2.091*CT+
09733 & 0.4059*CT**2)
09734 XQQQQ=1.25*(-0.1080+0.01486*CT+0.009364*CT**2)
09735 IF(MSTJ(109).EQ.2) XQQQQ=8.*XQQQQ
09736 ELSE
09737 XQQGG=-0.09773+0.2959*CT-0.2764*CT**2+0.08832*CT**3
09738 IF(MSTJ(109).EQ.2) XQQGG=(4./3.)**2*(-0.04079+0.1340*CT-
09739 & 0.1326*CT**2+0.04365*CT**3)
09740 XQQQQ=1.25*(0.003661-0.004888*CT-0.001081*CT**2+0.002093*
09741 & CT**3)
09742 IF(MSTJ(109).EQ.2) XQQQQ=8.*XQQQQ
09743 ENDIF
09744 PARJ(154)=ALSPI**2*CT**2*(XQQGG+XQQQQ)/RQCD
09745 PARJ(155)=XQQQQ/(XQQGG+XQQQQ)
09746 ENDIF
09747
09748
09749 IF(MSTJ(111).EQ.1.AND.PARJ(152)+PARJ(153).LT.0..AND.
09750 & PARJ(169).LT.0.99) THEN
09751 PARJ(169)=MIN(1.,1.2*PARJ(169))
09752 Q2=PARJ(169)*ECM**2
09753 ALSPI=(3./4.)*CF*ULALPS(Q2)/PARU(1)
09754 GOTO 100
09755 ENDIF
09756
09757
09758 IF(PARJ(152)+PARJ(153)+PARJ(154).GE.1) THEN
09759 IF(MSTJ(110).EQ.2.AND.CUT.GT.0.0499.AND.MSTJ(111).EQ.1.AND.
09760 & PARJ(169).LT.0.99) THEN
09761 PARJ(169)=MIN(1.,1.2*PARJ(169))
09762 Q2=PARJ(169)*ECM**2
09763 ALSPI=(3./4.)*CF*ULALPS(Q2)/PARU(1)
09764 GOTO 100
09765 ELSEIF(MSTJ(110).EQ.2.AND.CUT.GT.0.0499) THEN
09766 CALL LUERRM(26,
09767 & '(LUXJET:) no allowed y cut value for Zhu parametrization')
09768 ENDIF
09769 CUT=0.26*(4.*CUT)**(PARJ(152)+PARJ(153)+PARJ(154))**(-1./3.)
09770 IF(MSTJ(110).EQ.2) CUT=MAX(0.01,MIN(0.05,CUT))
09771 GOTO 100
09772 ENDIF
09773
09774
09775 ELSE
09776 ALSPI=ULALPS(ECM**2)/PARU(1)
09777 CUT=MAX(0.001,PARJ(125),(PARJ(126)/ECM)**2,EXP(-3./ALSPI))
09778 PARJ(152)=0.
09779 IF(CUT.LT.0.25) PARJ(152)=(ALSPI/3.)*((1.-2.*CUT)*
09780 & LOG((1.-2.*CUT)/CUT)+0.5*(9.*CUT**2-1.))
09781 PARJ(153)=0.
09782 PARJ(154)=0.
09783 ENDIF
09784
09785
09786 PARJ(150)=CUT
09787 IF(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.5) THEN
09788 NJET=2
09789 ELSEIF(MSTJ(101).LE.0) THEN
09790 NJET=MIN(4,2-MSTJ(101))
09791 ELSE
09792 RNJ=RLU(0)
09793 NJET=2
09794 IF(PARJ(152)+PARJ(153)+PARJ(154).GT.RNJ) NJET=3
09795 IF(PARJ(154).GT.RNJ) NJET=4
09796 ENDIF
09797
09798 RETURN
09799 END
09800
09801
09802
09803 SUBROUTINE LUX3JT(NJET,CUT,KFL,ECM,X1,X2)
09804
09805
09806 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
09807 SAVE /LUDAT1/
09808 DIMENSION ZHUP(5,12)
09809
09810
09811 DATA ((ZHUP(IC1,IC2),IC2=1,12),IC1=1,5)/
09812 & 18.29, 89.56, 4.541, -52.09, -109.8, 24.90,
09813 & 11.63, 3.683, 17.50, 0.002440, -1.362, -0.3537,
09814 & 11.42, 6.299, -22.55, -8.915, 59.25, -5.855,
09815 & -32.85, -1.054, -16.90, 0.006489, -0.8156, 0.01095,
09816 & 7.847, -3.964, -35.83, 1.178, 29.39, 0.2806,
09817 & 47.82, -12.36, -56.72, 0.04054, -0.4365, 0.6062,
09818 & 5.441, -56.89, -50.27, 15.13, 114.3, -18.19,
09819 & 97.05, -1.890, -139.9, 0.08153, -0.4984, 0.9439,
09820 & -17.65, 51.44, -58.32, 70.95, -255.7, -78.99,
09821 & 476.9, 29.65, -239.3, 0.4745, -1.174, 6.081/
09822
09823
09824 DILOG(X)=X+X**2/4.+X**3/9.+X**4/16.+X**5/25.+X**6/36.+X**7/49.
09825
09826
09827 MSTJ(120)=2
09828 MSTJ(121)=0
09829 PMQ=ULMASS(KFL)
09830 QME=(2.*PMQ/ECM)**2
09831 IF(MSTJ(109).NE.1) THEN
09832 CUTL=LOG(CUT)
09833 CUTD=LOG(1./CUT-2.)
09834 IF(MSTJ(109).EQ.0) THEN
09835 CF=4./3.
09836 CN=3.
09837 TR=2.
09838 WTMX=MIN(20.,37.-6.*CUTD)
09839 IF(MSTJ(110).EQ.2) WTMX=2.*(7.5+80.*CUT)
09840 ELSE
09841 CF=1.
09842 CN=0.
09843 TR=12.
09844 WTMX=0.
09845 ENDIF
09846
09847
09848 ALS2PI=PARU(118)/PARU(2)
09849 WTOPT=0.
09850 IF(MSTJ(111).EQ.1) WTOPT=(33.-2.*MSTU(112))/6.*LOG(PARJ(169))*
09851 & ALS2PI
09852 WTMAX=MAX(0.,1.+WTOPT+ALS2PI*WTMX)
09853
09854
09855 100 NJET=3
09856 110 Y13L=CUTL+CUTD*RLU(0)
09857 Y23L=CUTL+CUTD*RLU(0)
09858 Y13=EXP(Y13L)
09859 Y23=EXP(Y23L)
09860 Y12=1.-Y13-Y23
09861 IF(Y12.LE.CUT) GOTO 110
09862 IF(Y13**2+Y23**2+2.*Y12.LE.2.*RLU(0)) GOTO 110
09863
09864
09865 IF(MSTJ(101).EQ.2.AND.MSTJ(110).LE.1) THEN
09866 Y12L=LOG(Y12)
09867 Y13M=LOG(1.-Y13)
09868 Y23M=LOG(1.-Y23)
09869 Y12M=LOG(1.-Y12)
09870 IF(Y13.LE.0.5) Y13I=DILOG(Y13)
09871 IF(Y13.GE.0.5) Y13I=1.644934-Y13L*Y13M-DILOG(1.-Y13)
09872 IF(Y23.LE.0.5) Y23I=DILOG(Y23)
09873 IF(Y23.GE.0.5) Y23I=1.644934-Y23L*Y23M-DILOG(1.-Y23)
09874 IF(Y12.LE.0.5) Y12I=DILOG(Y12)
09875 IF(Y12.GE.0.5) Y12I=1.644934-Y12L*Y12M-DILOG(1.-Y12)
09876 WT1=(Y13**2+Y23**2+2.*Y12)/(Y13*Y23)
09877 WT2=CF*(-2.*(CUTL-Y12L)**2-3.*CUTL-1.+3.289868+
09878 & 2.*(2.*CUTL-Y12L)*CUT/Y12)+
09879 & CN*((CUTL-Y12L)**2-(CUTL-Y13L)**2-(CUTL-Y23L)**2-11.*CUTL/6.+
09880 & 67./18.+1.644934-(2.*CUTL-Y12L)*CUT/Y12+(2.*CUTL-Y13L)*
09881 & CUT/Y13+(2.*CUTL-Y23L)*CUT/Y23)+
09882 & TR*(2.*CUTL/3.-10./9.)+
09883 & CF*(Y12/(Y12+Y13)+Y12/(Y12+Y23)+(Y12+Y23)/Y13+(Y12+Y13)/Y23+
09884 & Y13L*(4.*Y12**2+2.*Y12*Y13+4.*Y12*Y23+Y13*Y23)/(Y12+Y23)**2+
09885 & Y23L*(4.*Y12**2+2.*Y12*Y23+4.*Y12*Y13+Y13*Y23)/(Y12+Y13)**2)/
09886 & WT1+
09887 & CN*(Y13L*Y13/(Y12+Y23)+Y23L*Y23/(Y12+Y13))/WT1+
09888 & (CN-2.*CF)*((Y12**2+(Y12+Y13)**2)*(Y12L*Y23L-Y12L*Y12M-Y23L*
09889 & Y23M+1.644934-Y12I-Y23I)/(Y13*Y23)+(Y12**2+(Y12+Y23)**2)*
09890 & (Y12L*Y13L-Y12L*Y12M-Y13L*Y13M+1.644934-Y12I-Y13I)/
09891 & (Y13*Y23)+(Y13**2+Y23**2)/(Y13*Y23*(Y13+Y23))-
09892 & 2.*Y12L*Y12**2/(Y13+Y23)**2-4.*Y12L*Y12/(Y13+Y23))/WT1-
09893 & CN*(Y13L*Y23L-Y13L*Y13M-Y23L*Y23M+1.644934-Y13I-Y23I)
09894 IF(1.+WTOPT+ALS2PI*WT2.LE.0.) MSTJ(121)=1
09895 IF(1.+WTOPT+ALS2PI*WT2.LE.WTMAX*RLU(0)) GOTO 110
09896 PARJ(156)=(WTOPT+ALS2PI*WT2)/(1.+WTOPT+ALS2PI*WT2)
09897
09898 ELSEIF(MSTJ(101).EQ.2.AND.MSTJ(110).EQ.2) THEN
09899
09900 ZX=(Y23-Y13)**2
09901 ZY=1.-Y12
09902 IZA=0
09903 DO 120 IY=1,5
09904 IF(ABS(CUT-0.01*IY).LT.0.0001) IZA=IY
09905 120 CONTINUE
09906 IF(IZA.NE.0) THEN
09907 IZ=IZA
09908 WT2=ZHUP(IZ,1)+ZHUP(IZ,2)*ZX+ZHUP(IZ,3)*ZX**2+(ZHUP(IZ,4)+
09909 & ZHUP(IZ,5)*ZX)*ZY+(ZHUP(IZ,6)+ZHUP(IZ,7)*ZX)*ZY**2+
09910 & (ZHUP(IZ,8)+ZHUP(IZ,9)*ZX)*ZY**3+ZHUP(IZ,10)/(ZX-ZY**2)+
09911 & ZHUP(IZ,11)/(1.-ZY)+ZHUP(IZ,12)/ZY
09912 ELSE
09913 IZ=100.*CUT
09914 WTL=ZHUP(IZ,1)+ZHUP(IZ,2)*ZX+ZHUP(IZ,3)*ZX**2+(ZHUP(IZ,4)+
09915 & ZHUP(IZ,5)*ZX)*ZY+(ZHUP(IZ,6)+ZHUP(IZ,7)*ZX)*ZY**2+
09916 & (ZHUP(IZ,8)+ZHUP(IZ,9)*ZX)*ZY**3+ZHUP(IZ,10)/(ZX-ZY**2)+
09917 & ZHUP(IZ,11)/(1.-ZY)+ZHUP(IZ,12)/ZY
09918 IZ=IZ+1
09919 WTU=ZHUP(IZ,1)+ZHUP(IZ,2)*ZX+ZHUP(IZ,3)*ZX**2+(ZHUP(IZ,4)+
09920 & ZHUP(IZ,5)*ZX)*ZY+(ZHUP(IZ,6)+ZHUP(IZ,7)*ZX)*ZY**2+
09921 & (ZHUP(IZ,8)+ZHUP(IZ,9)*ZX)*ZY**3+ZHUP(IZ,10)/(ZX-ZY**2)+
09922 & ZHUP(IZ,11)/(1.-ZY)+ZHUP(IZ,12)/ZY
09923 WT2=WTL+(WTU-WTL)*(100.*CUT+1.-IZ)
09924 ENDIF
09925 IF(1.+WTOPT+2.*ALS2PI*WT2.LE.0.) MSTJ(121)=1
09926 IF(1.+WTOPT+2.*ALS2PI*WT2.LE.WTMAX*RLU(0)) GOTO 110
09927 PARJ(156)=(WTOPT+2.*ALS2PI*WT2)/(1.+WTOPT+2.*ALS2PI*WT2)
09928 ENDIF
09929
09930
09931 X1=1.-Y23
09932 X2=1.-Y13
09933 X3=1.-Y12
09934 IF(4.*Y23*Y13*Y12/X3**2.LE.QME) NJET=2
09935 IF(MOD(MSTJ(103),4).GE.2.AND.IABS(MSTJ(101)).LE.1.AND.QME*X3+
09936 & 0.5*QME**2+(0.5*QME+0.25*QME**2)*((1.-X2)/(1.-X1)+
09937 & (1.-X1)/(1.-X2)).GT.(X1**2+X2**2)*RLU(0)) NJET=2
09938 IF(MSTJ(101).EQ.-1.AND.NJET.EQ.2) GOTO 100
09939
09940
09941 ELSE
09942 130 NJET=3
09943 140 X3=SQRT(4.*CUT**2+RLU(0)*((1.-CUT)**2-4.*CUT**2))
09944 IF(LOG((X3-CUT)/CUT).LE.RLU(0)*LOG((1.-2.*CUT)/CUT)) GOTO 140
09945 YD=SIGN(2.*CUT*((X3-CUT)/CUT)**RLU(0)-X3,RLU(0)-0.5)
09946 X1=1.-0.5*(X3+YD)
09947 X2=1.-0.5*(X3-YD)
09948 IF(4.*(1.-X1)*(1.-X2)*(1.-X3)/X3**2.LE.QME) NJET=2
09949 IF(MSTJ(102).GE.2) THEN
09950 IF(X3**2-2.*(1.+X3)*(1.-X1)*(1.-X2)*PARJ(171).LT.
09951 & X3**2*RLU(0)) NJET=2
09952 ENDIF
09953 IF(MSTJ(101).EQ.-1.AND.NJET.EQ.2) GOTO 130
09954 ENDIF
09955
09956 RETURN
09957 END
09958
09959
09960
09961 SUBROUTINE LUX4JT(NJET,CUT,KFL,ECM,KFLN,X1,X2,X4,X12,X14)
09962
09963
09964 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
09965 SAVE /LUDAT1/
09966 DIMENSION WTA(4),WTB(4),WTC(4),WTD(4),WTE(4)
09967
09968
09969 PMQ=ULMASS(KFL)
09970 QME=(2.*PMQ/ECM)**2
09971 CT=LOG(1./CUT-5.)
09972 IF(MSTJ(109).EQ.0) THEN
09973 CF=4./3.
09974 CN=3.
09975 TR=2.5
09976 ELSE
09977 CF=1.
09978 CN=0.
09979 TR=15.
09980 ENDIF
09981
09982
09983 100 NJET=4
09984 IT=1
09985 IF(PARJ(155).GT.RLU(0)) IT=2
09986 IF(MSTJ(101).LE.-3) IT=-MSTJ(101)-2
09987 IF(IT.EQ.1) WTMX=0.7/CUT**2
09988 IF(IT.EQ.1.AND.MSTJ(109).EQ.2) WTMX=0.6/CUT**2
09989 IF(IT.EQ.2) WTMX=0.1125*CF*TR/CUT**2
09990 ID=1
09991
09992
09993 110 Y134=3.*CUT+(1.-6.*CUT)*RLU(0)
09994 Y234=3.*CUT+(1.-6.*CUT)*RLU(0)
09995 IF(IT.EQ.1) Y34=(1.-5.*CUT)*EXP(-CT*RLU(0))
09996 IF(IT.EQ.2) Y34=CUT+(1.-6.*CUT)*RLU(0)
09997 IF(Y34.LE.Y134+Y234-1..OR.Y34.GE.Y134*Y234) GOTO 110
09998 VT=RLU(0)
09999 CP=COS(PARU(1)*RLU(0))
10000 Y14=(Y134-Y34)*VT
10001 Y13=Y134-Y14-Y34
10002 VB=Y34*(1.-Y134-Y234+Y34)/((Y134-Y34)*(Y234-Y34))
10003 Y24=0.5*(Y234-Y34)*(1.-4.*SQRT(MAX(0.,VT*(1.-VT)*VB*(1.-VB)))*
10004 &CP-(1.-2.*VT)*(1.-2.*VB))
10005 Y23=Y234-Y34-Y24
10006 Y12=1.-Y134-Y23-Y24
10007 IF(MIN(Y12,Y13,Y14,Y23,Y24).LE.CUT) GOTO 110
10008 Y123=Y12+Y13+Y23
10009 Y124=Y12+Y14+Y24
10010
10011
10012 IC=0
10013 WTTOT=0.
10014 120 IC=IC+1
10015 IF(IT.EQ.1) THEN
10016 WTA(IC)=(Y12*Y34**2-Y13*Y24*Y34+Y14*Y23*Y34+3.*Y12*Y23*Y34+
10017 & 3.*Y12*Y14*Y34+4.*Y12**2*Y34-Y13*Y23*Y24+2.*Y12*Y23*Y24-
10018 & Y13*Y14*Y24-2.*Y12*Y13*Y24+2.*Y12**2*Y24+Y14*Y23**2+2.*Y12*
10019 & Y23**2+Y14**2*Y23+4.*Y12*Y14*Y23+4.*Y12**2*Y23+2.*Y12*Y14**2+
10020 & 2.*Y12*Y13*Y14+4.*Y12**2*Y14+2.*Y12**2*Y13+2.*Y12**3)/(2.*Y13*
10021 & Y134*Y234*Y24)+(Y24*Y34+Y12*Y34+Y13*Y24-Y14*Y23+Y12*Y13)/(Y13*
10022 & Y134**2)+2.*Y23*(1.-Y13)/(Y13*Y134*Y24)+Y34/(2.*Y13*Y24)
10023 WTB(IC)=(Y12*Y24*Y34+Y12*Y14*Y34-Y13*Y24**2+Y13*Y14*Y24+2.*Y12*
10024 & Y14*Y24)/(Y13*Y134*Y23*Y14)+Y12*(1.+Y34)*Y124/(Y134*Y234*Y14*
10025 & Y24)-(2.*Y13*Y24+Y14**2+Y13*Y23+2.*Y12*Y13)/(Y13*Y134*Y14)+
10026 & Y12*Y123*Y124/(2.*Y13*Y14*Y23*Y24)
10027 WTC(IC)=-(5.*Y12*Y34**2+2.*Y12*Y24*Y34+2.*Y12*Y23*Y34+2.*Y12*
10028 & Y14*Y34+2.*Y12*Y13*Y34+4.*Y12**2*Y34-Y13*Y24**2+Y14*Y23*Y24+
10029 & Y13*Y23*Y24+Y13*Y14*Y24-Y12*Y14*Y24-Y13**2*Y24-3.*Y12*Y13*Y24-
10030 & Y14*Y23**2-Y14**2*Y23+Y13*Y14*Y23-3.*Y12*Y14*Y23-Y12*Y13*Y23)/
10031 & (4.*Y134*Y234*Y34**2)+(3.*Y12*Y34**2-3.*Y13*Y24*Y34+3.*Y12*Y24*
10032 & Y34+3.*Y14*Y23*Y34-Y13*Y24**2-Y12*Y23*Y34+6.*Y12*Y14*Y34+2.*Y12*
10033 & Y13*Y34-2.*Y12**2*Y34+Y14*Y23*Y24-3.*Y13*Y23*Y24-2.*Y13*Y14*
10034 & Y24+4.*Y12*Y14*Y24+2.*Y12*Y13*Y24+3.*Y14*Y23**2+2.*Y14**2*Y23+
10035 & 2.*Y14**2*Y12+2.*Y12**2*Y14+6.*Y12*Y14*Y23-2.*Y12*Y13**2-
10036 & 2.*Y12**2*Y13)/(4.*Y13*Y134*Y234*Y34)
10037 WTC(IC)=WTC(IC)+(2.*Y12*Y34**2-2.*Y13*Y24*Y34+Y12*Y24*Y34+
10038 & 4.*Y13*Y23*Y34+4.*Y12*Y14*Y34+2.*Y12*Y13*Y34+2.*Y12**2*Y34-
10039 & Y13*Y24**2+3.*Y14*Y23*Y24+4.*Y13*Y23*Y24-2.*Y13*Y14*Y24+
10040 & 4.*Y12*Y14*Y24+2.*Y12*Y13*Y24+2.*Y14*Y23**2+4.*Y13*Y23**2+
10041 & 2.*Y13*Y14*Y23+2.*Y12*Y14*Y23+4.*Y12*Y13*Y23+2.*Y12*Y14**2+4.*
10042 & Y12**2*Y13+4.*Y12*Y13*Y14+2.*Y12**2*Y14)/(4.*Y13*Y134*Y24*Y34)-
10043 & (Y12*Y34**2-2.*Y14*Y24*Y34-2.*Y13*Y24*Y34-Y14*Y23*Y34+Y13*Y23*
10044 & Y34+Y12*Y14*Y34+2.*Y12*Y13*Y34-2.*Y14**2*Y24-4.*Y13*Y14*Y24-
10045 & 4.*Y13**2*Y24-Y14**2*Y23-Y13**2*Y23+Y12*Y13*Y14-Y12*Y13**2)/
10046 & (2.*Y13*Y34*Y134**2)+(Y12*Y34**2-4.*Y14*Y24*Y34-2.*Y13*Y24*Y34-
10047 & 2.*Y14*Y23*Y34-4.*Y13*Y23*Y34-4.*Y12*Y14*Y34-4.*Y12*Y13*Y34-
10048 & 2.*Y13*Y14*Y24+2.*Y13**2*Y24+2.*Y14**2*Y23-2.*Y13*Y14*Y23-
10049 & Y12*Y14**2-6.*Y12*Y13*Y14-Y12*Y13**2)/(4.*Y34**2*Y134**2)
10050 WTTOT=WTTOT+Y34*CF*(CF*WTA(IC)+(CF-0.5*CN)*WTB(IC)+CN*WTC(IC))/
10051 & 8.
10052 ELSE
10053 WTD(IC)=(Y13*Y23*Y34+Y12*Y23*Y34-Y12**2*Y34+Y13*Y23*Y24+2.*Y12*
10054 & Y23*Y24-Y14*Y23**2+Y12*Y13*Y24+Y12*Y14*Y23+Y12*Y13*Y14)/(Y13**2*
10055 & Y123**2)-(Y12*Y34**2-Y13*Y24*Y34+Y12*Y24*Y34-Y14*Y23*Y34-Y12*
10056 & Y23*Y34-Y13*Y24**2+Y14*Y23*Y24-Y13*Y23*Y24-Y13**2*Y24+Y14*
10057 & Y23**2)/(Y13**2*Y123*Y134)+(Y13*Y14*Y12+Y34*Y14*Y12-Y34**2*Y12+
10058 & Y13*Y14*Y24+2.*Y34*Y14*Y24-Y23*Y14**2+Y34*Y13*Y24+Y34*Y23*Y14+
10059 & Y34*Y13*Y23)/(Y13**2*Y134**2)-(Y34*Y12**2-Y13*Y24*Y12+Y34*Y24*
10060 & Y12-Y23*Y14*Y12-Y34*Y14*Y12-Y13*Y24**2+Y23*Y14*Y24-Y13*Y14*Y24-
10061 & Y13**2*Y24+Y23*Y14**2)/(Y13**2*Y134*Y123)
10062 WTE(IC)=(Y12*Y34*(Y23-Y24+Y14+Y13)+Y13*Y24**2-Y14*Y23*Y24+Y13*
10063 & Y23*Y24+Y13*Y14*Y24+Y13**2*Y24-Y14*Y23*(Y14+Y23+Y13))/(Y13*Y23*
10064 & Y123*Y134)-Y12*(Y12*Y34-Y23*Y24-Y13*Y24-Y14*Y23-Y14*Y13)/(Y13*
10065 & Y23*Y123**2)-(Y14+Y13)*(Y24+Y23)*Y34/(Y13*Y23*Y134*Y234)+
10066 & (Y12*Y34*(Y14-Y24+Y23+Y13)+Y13*Y24**2-Y23*Y14*Y24+Y13*Y14*Y24+
10067 & Y13*Y23*Y24+Y13**2*Y24-Y23*Y14*(Y14+Y23+Y13))/(Y13*Y14*Y134*
10068 & Y123)-Y34*(Y34*Y12-Y14*Y24-Y13*Y24-Y23*Y14-Y23*Y13)/(Y13*Y14*
10069 & Y134**2)-(Y23+Y13)*(Y24+Y14)*Y12/(Y13*Y14*Y123*Y124)
10070 WTTOT=WTTOT+CF*(TR*WTD(IC)+(CF-0.5*CN)*WTE(IC))/16.
10071 ENDIF
10072
10073
10074 130 IF(IC.EQ.1.OR.IC.EQ.3.OR.ID.EQ.2.OR.ID.EQ.3) THEN
10075 YSAV=Y13
10076 Y13=Y14
10077 Y14=YSAV
10078 YSAV=Y23
10079 Y23=Y24
10080 Y24=YSAV
10081 YSAV=Y123
10082 Y123=Y124
10083 Y124=YSAV
10084 ENDIF
10085 IF(IC.EQ.2.OR.IC.EQ.4.OR.ID.EQ.3.OR.ID.EQ.4) THEN
10086 YSAV=Y13
10087 Y13=Y23
10088 Y23=YSAV
10089 YSAV=Y14
10090 Y14=Y24
10091 Y24=YSAV
10092 YSAV=Y134
10093 Y134=Y234
10094 Y234=YSAV
10095 ENDIF
10096 IF(IC.LE.3) GOTO 120
10097 IF(ID.EQ.1.AND.WTTOT.LT.RLU(0)*WTMX) GOTO 110
10098 IC=5
10099
10100
10101 IF(IT.EQ.1) THEN
10102 IF(MSTJ(109).EQ.0.AND.ID.EQ.1) THEN
10103 PARJ(156)=Y34*(2.*(WTA(1)+WTA(2)+WTA(3)+WTA(4))+4.*(WTC(1)+
10104 & WTC(2)+WTC(3)+WTC(4)))/(9.*WTTOT)
10105 IF(WTA(2)+WTA(4)+2.*(WTC(2)+WTC(4)).GT.RLU(0)*(WTA(1)+WTA(2)+
10106 & WTA(3)+WTA(4)+2.*(WTC(1)+WTC(2)+WTC(3)+WTC(4)))) ID=2
10107 IF(ID.EQ.2) GOTO 130
10108 ELSEIF(MSTJ(109).EQ.2.AND.ID.EQ.1) THEN
10109 PARJ(156)=Y34*(WTA(1)+WTA(2)+WTA(3)+WTA(4))/(8.*WTTOT)
10110 IF(WTA(2)+WTA(4).GT.RLU(0)*(WTA(1)+WTA(2)+WTA(3)+WTA(4))) ID=2
10111 IF(ID.EQ.2) GOTO 130
10112 ENDIF
10113 MSTJ(120)=3
10114 IF(MSTJ(109).EQ.0.AND.0.5*Y34*(WTC(1)+WTC(2)+WTC(3)+WTC(4)).GT.
10115 & RLU(0)*WTTOT) MSTJ(120)=4
10116 KFLN=21
10117
10118
10119 IF(Y12.LE.CUT+QME) NJET=2
10120 IF(NJET.EQ.2) GOTO 150
10121 Q12=0.5*(1.-SQRT(1.-QME/Y12))
10122 X1=1.-(1.-Q12)*Y234-Q12*Y134
10123 X4=1.-(1.-Q12)*Y134-Q12*Y234
10124 X2=1.-Y124
10125 X12=(1.-Q12)*Y13+Q12*Y23
10126 X14=Y12-0.5*QME
10127 IF(Y134*Y234/((1.-X1)*(1.-X4)).LE.RLU(0)) NJET=2
10128
10129
10130 ELSE
10131 IF(ID.EQ.1) THEN
10132 WTR=RLU(0)*(WTD(1)+WTD(2)+WTD(3)+WTD(4))
10133 IF(WTR.LT.WTD(2)+WTD(3)+WTD(4)) ID=2
10134 IF(WTR.LT.WTD(3)+WTD(4)) ID=3
10135 IF(WTR.LT.WTD(4)) ID=4
10136 IF(ID.GE.2) GOTO 130
10137 ENDIF
10138 MSTJ(120)=5
10139 PARJ(156)=CF*TR*(WTD(1)+WTD(2)+WTD(3)+WTD(4))/(16.*WTTOT)
10140 140 KFLN=1+INT(5.*RLU(0))
10141 IF(KFLN.NE.KFL.AND.0.2*PARJ(156).LE.RLU(0)) GOTO 140
10142 IF(KFLN.EQ.KFL.AND.1.-0.8*PARJ(156).LE.RLU(0)) GOTO 140
10143 IF(KFLN.GT.MSTJ(104)) NJET=2
10144 PMQN=ULMASS(KFLN)
10145 QMEN=(2.*PMQN/ECM)**2
10146
10147
10148 IF(Y24.LE.CUT+QME.OR.Y13.LE.1.1*QMEN) NJET=2
10149 IF(NJET.EQ.2) GOTO 150
10150 Q24=0.5*(1.-SQRT(1.-QME/Y24))
10151 Q13=0.5*(1.-SQRT(1.-QMEN/Y13))
10152 X1=1.-(1.-Q24)*Y123-Q24*Y134
10153 X4=1.-(1.-Q24)*Y134-Q24*Y123
10154 X2=1.-(1.-Q13)*Y234-Q13*Y124
10155 X12=(1.-Q24)*((1.-Q13)*Y14+Q13*Y34)+Q24*((1.-Q13)*Y12+Q13*Y23)
10156 X14=Y24-0.5*QME
10157 X34=(1.-Q24)*((1.-Q13)*Y23+Q13*Y12)+Q24*((1.-Q13)*Y34+Q13*Y14)
10158 IF(PMQ**2+PMQN**2+MIN(X12,X34)*ECM**2.LE.
10159 & (PARJ(127)+PMQ+PMQN)**2) NJET=2
10160 IF(Y123*Y134/((1.-X1)*(1.-X4)).LE.RLU(0)) NJET=2
10161 ENDIF
10162 150 IF(MSTJ(101).LE.-2.AND.NJET.EQ.2) GOTO 100
10163
10164 RETURN
10165 END
10166
10167
10168
10169 SUBROUTINE LUXDIF(NC,NJET,KFL,ECM,CHI,THE,PHI)
10170
10171
10172 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
10173 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
10174 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
10175 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
10176
10177
10178 QF=KCHG(KFL,1)/3.
10179 POLL=1.-PARJ(131)*PARJ(132)
10180 POLD=PARJ(132)-PARJ(131)
10181 IF(MSTJ(102).LE.1.OR.MSTJ(109).EQ.1) THEN
10182 HF1=POLL
10183 HF2=0.
10184 HF3=PARJ(133)**2
10185 HF4=0.
10186
10187
10188 ELSE
10189 SFF=1./(16.*PARU(102)*(1.-PARU(102)))
10190 SFW=ECM**4/((ECM**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2)
10191 SFI=SFW*(1.-(PARJ(123)/ECM)**2)
10192 AE=-1.
10193 VE=4.*PARU(102)-1.
10194 AF=SIGN(1.,QF)
10195 VF=AF-4.*QF*PARU(102)
10196 HF1=QF**2*POLL-2.*QF*VF*SFI*SFF*(VE*POLL-AE*POLD)+
10197 & (VF**2+AF**2)*SFW*SFF**2*((VE**2+AE**2)*POLL-2.*VE*AE*POLD)
10198 HF2=-2.*QF*AF*SFI*SFF*(AE*POLL-VE*POLD)+2.*VF*AF*SFW*SFF**2*
10199 & (2.*VE*AE*POLL-(VE**2+AE**2)*POLD)
10200 HF3=PARJ(133)**2*(QF**2-2.*QF*VF*SFI*SFF*VE+(VF**2+AF**2)*
10201 & SFW*SFF**2*(VE**2-AE**2))
10202 HF4=-PARJ(133)**2*2.*QF*VF*SFW*(PARJ(123)*PARJ(124)/ECM**2)*
10203 & SFF*AE
10204 ENDIF
10205
10206
10207 SQ2=SQRT(2.)
10208 QME=0.
10209 IF(MSTJ(103).GE.4.AND.IABS(MSTJ(101)).LE.1.AND.MSTJ(102).LE.1.AND.
10210 &MSTJ(109).NE.1) QME=(2.*ULMASS(KFL)/ECM)**2
10211 IF(NJET.EQ.2) THEN
10212 SIGU=4.*SQRT(1.-QME)
10213 SIGL=2.*QME*SQRT(1.-QME)
10214 SIGT=0.
10215 SIGI=0.
10216 SIGA=0.
10217 SIGP=4.
10218
10219
10220 ELSE
10221 IF(NJET.EQ.3) THEN
10222 X1=2.*P(NC+1,4)/ECM
10223 X2=2.*P(NC+3,4)/ECM
10224 ELSE
10225 ECMR=P(NC+1,4)+P(NC+4,4)+SQRT((P(NC+2,1)+P(NC+3,1))**2+
10226 & (P(NC+2,2)+P(NC+3,2))**2+(P(NC+2,3)+P(NC+3,3))**2)
10227 X1=2.*P(NC+1,4)/ECMR
10228 X2=2.*P(NC+4,4)/ECMR
10229 ENDIF
10230
10231
10232 XQ=(1.-X1)/(1.-X2)
10233 CT12=(X1*X2-2.*X1-2.*X2+2.+QME)/SQRT((X1**2-QME)*(X2**2-QME))
10234 ST12=SQRT(1.-CT12**2)
10235 IF(MSTJ(109).NE.1) THEN
10236 SIGU=2.*X1**2+X2**2*(1.+CT12**2)-QME*(3.+CT12**2-X1-X2)-
10237 & QME*X1/XQ+0.5*QME*((X2**2-QME)*ST12**2-2.*X2)*XQ
10238 SIGL=(X2*ST12)**2-QME*(3.-CT12**2-2.5*(X1+X2)+X1*X2+QME)+
10239 & 0.5*QME*(X1**2-X1-QME)/XQ+0.5*QME*((X2**2-QME)*CT12**2-X2)*XQ
10240 SIGT=0.5*(X2**2-QME-0.5*QME*(X2**2-QME)/XQ)*ST12**2
10241 SIGI=((1.-0.5*QME*XQ)*(X2**2-QME)*ST12*CT12+QME*(1.-X1-X2+
10242 & 0.5*X1*X2+0.5*QME)*ST12/CT12)/SQ2
10243 SIGA=X2**2*ST12/SQ2
10244 SIGP=2.*(X1**2-X2**2*CT12)
10245
10246
10247 ELSE
10248 X3=2.-X1-X2
10249 XT=X2*ST12
10250 CT13=SQRT(MAX(0.,1.-(XT/X3)**2))
10251 SIGU=(1.-PARJ(171))*(X3**2-0.5*XT**2)+
10252 & PARJ(171)*(X3**2-0.5*XT**2-4.*(1.-X1)*(1.-X2)**2/X1)
10253 SIGL=(1.-PARJ(171))*0.5*XT**2+
10254 & PARJ(171)*0.5*(1.-X1)**2*XT**2
10255 SIGT=(1.-PARJ(171))*0.25*XT**2+
10256 & PARJ(171)*0.25*XT**2*(1.-2.*X1)
10257 SIGI=-(0.5/SQ2)*((1.-PARJ(171))*XT*X3*CT13+
10258 & PARJ(171)*XT*((1.-2.*X1)*X3*CT13-X1*(X1-X2)))
10259 SIGA=(0.25/SQ2)*XT*(2.*(1.-X1)-X1*X3)
10260 SIGP=X3**2-2.*(1.-X1)*(1.-X2)/X1
10261 ENDIF
10262 ENDIF
10263
10264
10265 HF1A=ABS(HF1)
10266 HF2A=ABS(HF2)
10267 HF3A=ABS(HF3)
10268 HF4A=ABS(HF4)
10269 SIGMAX=(2.*HF1A+HF3A+HF4A)*ABS(SIGU)+2.*(HF1A+HF3A+HF4A)*
10270 &ABS(SIGL)+2.*(HF1A+2.*HF3A+2.*HF4A)*ABS(SIGT)+2.*SQ2*
10271 &(HF1A+2.*HF3A+2.*HF4A)*ABS(SIGI)+4.*SQ2*HF2A*ABS(SIGA)+
10272 &2.*HF2A*ABS(SIGP)
10273
10274
10275 100 CHI=PARU(2)*RLU(0)
10276 CTHE=2.*RLU(0)-1.
10277 PHI=PARU(2)*RLU(0)
10278 CCHI=COS(CHI)
10279 SCHI=SIN(CHI)
10280 C2CHI=COS(2.*CHI)
10281 S2CHI=SIN(2.*CHI)
10282 THE=ACOS(CTHE)
10283 STHE=SIN(THE)
10284 C2PHI=COS(2.*(PHI-PARJ(134)))
10285 S2PHI=SIN(2.*(PHI-PARJ(134)))
10286 SIG=((1.+CTHE**2)*HF1+STHE**2*(C2PHI*HF3-S2PHI*HF4))*SIGU+
10287 &2.*(STHE**2*HF1-STHE**2*(C2PHI*HF3-S2PHI*HF4))*SIGL+
10288 &2.*(STHE**2*C2CHI*HF1+((1.+CTHE**2)*C2CHI*C2PHI-2.*CTHE*S2CHI*
10289 &S2PHI)*HF3-((1.+CTHE**2)*C2CHI*S2PHI+2.*CTHE*S2CHI*C2PHI)*HF4)*
10290 &SIGT-2.*SQ2*(2.*STHE*CTHE*CCHI*HF1-2.*STHE*(CTHE*CCHI*C2PHI-
10291 &SCHI*S2PHI)*HF3+2.*STHE*(CTHE*CCHI*S2PHI+SCHI*C2PHI)*HF4)*SIGI+
10292 &4.*SQ2*STHE*CCHI*HF2*SIGA+2.*CTHE*HF2*SIGP
10293 IF(SIG.LT.SIGMAX*RLU(0)) GOTO 100
10294
10295 RETURN
10296 END
10297
10298
10299
10300 SUBROUTINE LUONIA(KFL,ECM)
10301
10302
10303
10304 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
10305 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
10306 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
10307 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
10308
10309
10310 IF(MSTU(12).GE.1) CALL LULIST(0)
10311 IF(KFL.LT.0.OR.KFL.GT.8) THEN
10312 CALL LUERRM(16,'(LUONIA:) called with unknown flavour code')
10313 IF(MSTU(21).GE.1) RETURN
10314 ENDIF
10315 IF(ECM.LT.PARJ(127)+2.02*PARF(101)) THEN
10316 CALL LUERRM(16,'(LUONIA:) called with too small CM energy')
10317 IF(MSTU(21).GE.1) RETURN
10318 ENDIF
10319
10320
10321 NC=0
10322 IF(MSTJ(115).GE.2) THEN
10323 NC=NC+2
10324 CALL LU1ENT(NC-1,11,0.5*ECM,0.,0.)
10325 K(NC-1,1)=21
10326 CALL LU1ENT(NC,-11,0.5*ECM,PARU(1),0.)
10327 K(NC,1)=21
10328 ENDIF
10329 KFLC=IABS(KFL)
10330 IF(MSTJ(115).GE.3.AND.KFLC.GE.5) THEN
10331 NC=NC+1
10332 KF=110*KFLC+3
10333 MSTU10=MSTU(10)
10334 MSTU(10)=1
10335 P(NC,5)=ECM
10336 CALL LU1ENT(NC,KF,ECM,0.,0.)
10337 K(NC,1)=21
10338 K(NC,3)=1
10339 MSTU(10)=MSTU10
10340 ENDIF
10341
10342
10343 NTRY=0
10344 100 X1=RLU(0)
10345 X2=RLU(0)
10346 X3=2.-X1-X2
10347 IF(X3.GE.1..OR.((1.-X1)/(X2*X3))**2+((1.-X2)/(X1*X3))**2+
10348 &((1.-X3)/(X1*X2))**2.LE.2.*RLU(0)) GOTO 100
10349 NTRY=NTRY+1
10350 NJET=3
10351 IF(MSTJ(101).LE.4) CALL LU3ENT(NC+1,21,21,21,ECM,X1,X3)
10352 IF(MSTJ(101).GE.5) CALL LU3ENT(-(NC+1),21,21,21,ECM,X1,X3)
10353
10354
10355 MSTU(111)=MSTJ(108)
10356 IF(MSTJ(108).EQ.2.AND.(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.1))
10357 &MSTU(111)=1
10358 PARU(112)=PARJ(121)
10359 IF(MSTU(111).EQ.2) PARU(112)=PARJ(122)
10360 QF=0.
10361 IF(KFLC.NE.0) QF=KCHG(KFLC,1)/3.
10362 RGAM=7.2*QF**2*PARU(101)/ULALPS(ECM**2)
10363 MK=0
10364 ECMC=ECM
10365 IF(RLU(0).GT.RGAM/(1.+RGAM)) THEN
10366 IF(1.-MAX(X1,X2,X3).LE.MAX((PARJ(126)/ECM)**2,PARJ(125)))
10367 & NJET=2
10368 IF(NJET.EQ.2.AND.MSTJ(101).LE.4) CALL LU2ENT(NC+1,21,21,ECM)
10369 IF(NJET.EQ.2.AND.MSTJ(101).GE.5) CALL LU2ENT(-(NC+1),21,21,ECM)
10370 ELSE
10371 MK=1
10372 ECMC=SQRT(1.-X1)*ECM
10373 IF(ECMC.LT.2.*PARJ(127)) GOTO 100
10374 K(NC+1,1)=1
10375 K(NC+1,2)=22
10376 K(NC+1,4)=0
10377 K(NC+1,5)=0
10378 IF(MSTJ(101).GE.5) K(NC+2,4)=MSTU(5)*(NC+3)
10379 IF(MSTJ(101).GE.5) K(NC+2,5)=MSTU(5)*(NC+3)
10380 IF(MSTJ(101).GE.5) K(NC+3,4)=MSTU(5)*(NC+2)
10381 IF(MSTJ(101).GE.5) K(NC+3,5)=MSTU(5)*(NC+2)
10382 NJET=2
10383 IF(ECMC.LT.4.*PARJ(127)) THEN
10384 MSTU10=MSTU(10)
10385 MSTU(10)=1
10386 P(NC+2,5)=ECMC
10387 CALL LU1ENT(NC+2,83,0.5*(X2+X3)*ECM,PARU(1),0.)
10388 MSTU(10)=MSTU10
10389 NJET=0
10390 ENDIF
10391 ENDIF
10392 DO 110 IP=NC+1,N
10393 K(IP,3)=K(IP,3)+(MSTJ(115)/2)+(KFLC/5)*(MSTJ(115)/3)*(NC-1)
10394 110 CONTINUE
10395
10396
10397 IF(MSTJ(106).EQ.1) THEN
10398 SQ2=SQRT(2.)
10399 HF1=1.-PARJ(131)*PARJ(132)
10400 HF3=PARJ(133)**2
10401 CT13=(X1*X3-2.*X1-2.*X3+2.)/(X1*X3)
10402 ST13=SQRT(1.-CT13**2)
10403 SIGL=0.5*X3**2*((1.-X2)**2+(1.-X3)**2)*ST13**2
10404 SIGU=(X1*(1.-X1))**2+(X2*(1.-X2))**2+(X3*(1.-X3))**2-SIGL
10405 SIGT=0.5*SIGL
10406 SIGI=(SIGL*CT13/ST13+0.5*X1*X3*(1.-X2)**2*ST13)/SQ2
10407 SIGMAX=(2.*HF1+HF3)*ABS(SIGU)+2.*(HF1+HF3)*ABS(SIGL)+2.*(HF1+
10408 & 2.*HF3)*ABS(SIGT)+2.*SQ2*(HF1+2.*HF3)*ABS(SIGI)
10409
10410
10411 120 CHI=PARU(2)*RLU(0)
10412 CTHE=2.*RLU(0)-1.
10413 PHI=PARU(2)*RLU(0)
10414 CCHI=COS(CHI)
10415 SCHI=SIN(CHI)
10416 C2CHI=COS(2.*CHI)
10417 S2CHI=SIN(2.*CHI)
10418 THE=ACOS(CTHE)
10419 STHE=SIN(THE)
10420 C2PHI=COS(2.*(PHI-PARJ(134)))
10421 S2PHI=SIN(2.*(PHI-PARJ(134)))
10422 SIG=((1.+CTHE**2)*HF1+STHE**2*C2PHI*HF3)*SIGU+2.*(STHE**2*HF1-
10423 & STHE**2*C2PHI*HF3)*SIGL+2.*(STHE**2*C2CHI*HF1+((1.+CTHE**2)*
10424 & C2CHI*C2PHI-2.*CTHE*S2CHI*S2PHI)*HF3)*SIGT-2.*SQ2*(2.*STHE*CTHE*
10425 & CCHI*HF1-2.*STHE*(CTHE*CCHI*C2PHI-SCHI*S2PHI)*HF3)*SIGI
10426 IF(SIG.LT.SIGMAX*RLU(0)) GOTO 120
10427 CALL LUDBRB(NC+1,N,0.,CHI,0D0,0D0,0D0)
10428 CALL LUDBRB(NC+1,N,THE,PHI,0D0,0D0,0D0)
10429 ENDIF
10430
10431
10432 IF(MSTJ(101).GE.5.AND.NJET.GE.2) THEN
10433 CALL LUSHOW(NC+MK+1,-NJET,ECMC)
10434 MSTJ14=MSTJ(14)
10435 IF(MSTJ(105).EQ.-1) MSTJ(14)=-1
10436 IF(MSTJ(105).GE.0) MSTU(28)=0
10437 CALL LUPREP(0)
10438 MSTJ(14)=MSTJ14
10439 IF(MSTJ(105).GE.0.AND.MSTU(28).NE.0) GOTO 100
10440 ENDIF
10441
10442
10443 IF(MSTJ(105).EQ.1) CALL LUEXEC
10444 MSTU(161)=110*KFLC+3
10445 MSTU(162)=0
10446
10447 RETURN
10448 END
10449
10450
10451
10452 SUBROUTINE LUHEPC(MCONV)
10453
10454
10455
10456 INCLUDE '../include/HEPEVT.h'
10457
10458
10459
10460 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
10461 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
10462 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
10463 SAVE /HEPEVT/
10464 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
10465
10466
10467 IF(MCONV.EQ.1) THEN
10468 NEVHEP=0
10469 IF(N.GT.NMXHEP) CALL LUERRM(8,
10470 & '(LUHEPC:) no more space in /HEPEVT/')
10471 NHEP=MIN(N,NMXHEP)
10472 DO 140 I=1,NHEP
10473 ISTHEP(I)=0
10474 IF(K(I,1).GE.1.AND.K(I,1).LE.10) ISTHEP(I)=1
10475 IF(K(I,1).GE.11.AND.K(I,1).LE.20) ISTHEP(I)=2
10476 IF(K(I,1).GE.21.AND.K(I,1).LE.30) ISTHEP(I)=3
10477 IF(K(I,1).GE.31.AND.K(I,1).LE.100) ISTHEP(I)=K(I,1)
10478 IDHEP(I)=K(I,2)
10479 JMOHEP(1,I)=K(I,3)
10480 JMOHEP(2,I)=0
10481 IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) THEN
10482 JDAHEP(1,I)=K(I,4)
10483 JDAHEP(2,I)=K(I,5)
10484 ELSE
10485 JDAHEP(1,I)=0
10486 JDAHEP(2,I)=0
10487 ENDIF
10488 DO 100 J=1,5
10489 PHEP(J,I)=P(I,J)
10490 100 CONTINUE
10491 DO 110 J=1,4
10492 VHEP(J,I)=V(I,J)
10493 110 CONTINUE
10494
10495
10496 IF(I.EQ.1) THEN
10497 INEW=1
10498 ELSE
10499 IF(K(I,1).EQ.21.AND.K(I-1,1).NE.21) INEW=I
10500 ENDIF
10501
10502
10503 IF(I.GE.INEW+2.AND.K(I,1).EQ.21.AND.K(I,3).EQ.0) THEN
10504 IMO1=I-2
10505 IF(I.GE.INEW+3.AND.K(I-1,1).EQ.21.AND.K(I-1,3).EQ.0)
10506 & IMO1=IMO1-1
10507 JMOHEP(1,I)=IMO1
10508 JMOHEP(2,I)=IMO1+1
10509 ELSEIF(K(I,2).GE.91.AND.K(I,2).LE.93) THEN
10510 I1=K(I,3)-1
10511 120 I1=I1+1
10512 IF(I1.GE.I) CALL LUERRM(8,
10513 & '(LUHEPC:) translation of inconsistent event history')
10514 IF(I1.LT.I.AND.K(I1,1).NE.1.AND.K(I1,1).NE.11) GOTO 120
10515 KC=LUCOMP(K(I1,2))
10516 IF(I1.LT.I.AND.KC.EQ.0) GOTO 120
10517 IF(I1.LT.I.AND.KCHG(KC,2).EQ.0) GOTO 120
10518 JMOHEP(2,I)=I1
10519 ELSEIF(K(I,2).EQ.94) THEN
10520 NJET=2
10521 IF(NHEP.GE.I+3.AND.K(I+3,3).LE.I) NJET=3
10522 IF(NHEP.GE.I+4.AND.K(I+4,3).LE.I) NJET=4
10523 JMOHEP(2,I)=MOD(K(I+NJET,4)/MSTU(5),MSTU(5))
10524 IF(JMOHEP(2,I).EQ.JMOHEP(1,I)) JMOHEP(2,I)=
10525 & MOD(K(I+1,4)/MSTU(5),MSTU(5))
10526 ENDIF
10527
10528
10529 IF(K(I,2).EQ.94.AND.MSTU(16).NE.2) THEN
10530 DO 130 I1=JDAHEP(1,I),JDAHEP(2,I)
10531 I2=MOD(K(I1,4)/MSTU(5),MSTU(5))
10532 JDAHEP(1,I2)=I
10533 130 CONTINUE
10534 ENDIF
10535 IF(K(I,2).GE.91.AND.K(I,2).LE.94) GOTO 140
10536 I1=JMOHEP(1,I)
10537 IF(I1.LE.0.OR.I1.GT.NHEP) GOTO 140
10538 IF(K(I1,1).NE.13.AND.K(I1,1).NE.14) GOTO 140
10539 IF(JDAHEP(1,I1).EQ.0) THEN
10540 JDAHEP(1,I1)=I
10541 ELSE
10542 JDAHEP(2,I1)=I
10543 ENDIF
10544 140 CONTINUE
10545 DO 150 I=1,NHEP
10546 IF(K(I,1).NE.13.AND.K(I,1).NE.14) GOTO 150
10547 IF(JDAHEP(2,I).EQ.0) JDAHEP(2,I)=JDAHEP(1,I)
10548 150 CONTINUE
10549
10550
10551 ELSE
10552 IF(NHEP.GT.MSTU(4)) CALL LUERRM(8,
10553 & '(LUHEPC:) no more space in /LUJETS/')
10554 N=MIN(NHEP,MSTU(4))
10555 NKQ=0
10556 KQSUM=0
10557 DO 180 I=1,N
10558 K(I,1)=0
10559 IF(ISTHEP(I).EQ.1) K(I,1)=1
10560 IF(ISTHEP(I).EQ.2) K(I,1)=11
10561 IF(ISTHEP(I).EQ.3) K(I,1)=21
10562 K(I,2)=IDHEP(I)
10563 K(I,3)=JMOHEP(1,I)
10564 K(I,4)=JDAHEP(1,I)
10565 K(I,5)=JDAHEP(2,I)
10566 DO 160 J=1,5
10567 P(I,J)=PHEP(J,I)
10568 160 CONTINUE
10569 DO 170 J=1,4
10570 V(I,J)=VHEP(J,I)
10571 170 CONTINUE
10572 V(I,5)=0.
10573 IF(ISTHEP(I).EQ.2.AND.PHEP(4,I).GT.PHEP(5,I)) THEN
10574 I1=JDAHEP(1,I)
10575 IF(I1.GT.0.AND.I1.LE.NHEP) V(I,5)=(VHEP(4,I1)-VHEP(4,I))*
10576 & PHEP(5,I)/PHEP(4,I)
10577 ENDIF
10578
10579
10580 IF(ISTHEP(I).EQ.1) THEN
10581 KC=LUCOMP(K(I,2))
10582 KQ=0
10583 IF(KC.NE.0) KQ=KCHG(KC,2)*ISIGN(1,K(I,2))
10584 IF(KQ.NE.0) NKQ=NKQ+1
10585 IF(KQ.NE.2) KQSUM=KQSUM+KQ
10586 IF(KQ.NE.0.AND.KQSUM.NE.0) THEN
10587 K(I,1)=2
10588 ELSEIF(KQ.EQ.2.AND.I.LT.N) THEN
10589 IF(K(I+1,2).EQ.21) K(I,1)=2
10590 ENDIF
10591 ENDIF
10592 180 CONTINUE
10593 IF(NKQ.EQ.1.OR.KQSUM.NE.0) CALL LUERRM(8,
10594 & '(LUHEPC:) input parton configuration not colour singlet')
10595 ENDIF
10596
10597 END
10598
10599
10600
10601 SUBROUTINE LUTEST(MTEST)
10602
10603
10604
10605 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
10606 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
10607 SAVE /LUJETS/,/LUDAT1/
10608 DIMENSION PSUM(5),PINI(6),PFIN(6)
10609
10610
10611 IF(MTEST.GE.1) CALL LUTABU(20)
10612 NERR=0
10613 DO 180 IEV=1,600
10614
10615
10616 MSTJ(1)=1
10617 MSTJ(3)=0
10618 MSTJ(11)=1
10619 MSTJ(42)=2
10620 MSTJ(43)=4
10621 MSTJ(44)=2
10622 PARJ(17)=0.1
10623 PARJ(22)=1.5
10624 PARJ(43)=1.
10625 PARJ(54)=-0.05
10626 MSTJ(101)=5
10627 MSTJ(104)=5
10628 MSTJ(105)=0
10629 MSTJ(107)=1
10630 IF(IEV.EQ.301.OR.IEV.EQ.351.OR.IEV.EQ.401) MSTJ(116)=3
10631
10632
10633 IF(IEV.LE.50) THEN
10634 ITY=(IEV+9)/10
10635 MSTJ(3)=-1
10636 IF(ITY.EQ.3.OR.ITY.EQ.4) MSTJ(11)=2
10637 IF(ITY.EQ.1) CALL LU1ENT(1,1,15.,0.,0.)
10638 IF(ITY.EQ.2) CALL LU1ENT(1,3101,15.,0.,0.)
10639 IF(ITY.EQ.3) CALL LU1ENT(1,-2203,15.,0.,0.)
10640 IF(ITY.EQ.4) CALL LU1ENT(1,-4,30.,0.,0.)
10641 IF(ITY.EQ.5) CALL LU1ENT(1,21,15.,0.,0.)
10642
10643
10644 ELSEIF(IEV.LE.130) THEN
10645 ITY=(IEV-41)/10
10646 IF(ITY.EQ.1) CALL LU2ENT(1,1,-1,40.)
10647 IF(ITY.EQ.2) CALL LU2ENT(1,4,-4,30.)
10648 IF(ITY.EQ.3) CALL LU2ENT(1,2,2103,100.)
10649 IF(ITY.EQ.4) CALL LU2ENT(1,21,21,40.)
10650 IF(ITY.EQ.5) CALL LU3ENT(1,2101,21,-3203,30.,0.6,0.8)
10651 IF(ITY.EQ.6) CALL LU3ENT(1,5,21,-5,40.,0.9,0.8)
10652 IF(ITY.EQ.7) CALL LU3ENT(1,21,21,21,60.,0.7,0.5)
10653 IF(ITY.EQ.8) CALL LU4ENT(1,2,21,21,-2,40.,0.4,0.64,0.6,0.12,0.2)
10654
10655
10656 ELSEIF(IEV.LE.200) THEN
10657 ITY=1+(IEV-131)/16
10658 MSTJ(2)=1+MOD(IEV-131,4)
10659 MSTJ(3)=1+MOD((IEV-131)/4,4)
10660 IF(ITY.EQ.1) CALL LU2ENT(1,4,-5,40.)
10661 IF(ITY.EQ.2) CALL LU3ENT(1,3,21,-3,40.,0.9,0.4)
10662 IF(ITY.EQ.3) CALL LU4ENT(1,2,21,21,-2,40.,0.4,0.64,0.6,0.12,0.2)
10663 IF(ITY.GE.4) CALL LU4ENT(1,2,-3,3,-2,40.,0.4,0.64,0.6,0.12,0.2)
10664
10665
10666 ELSEIF(IEV.LE.300) THEN
10667 100 DO 110 J=1,5
10668 PSUM(J)=0.
10669 110 CONTINUE
10670 NJET=2.+6.*RLU(0)
10671 DO 130 I=1,NJET
10672 KFL=21
10673 IF(I.EQ.1) KFL=INT(1.+4.*RLU(0))
10674 IF(I.EQ.NJET) KFL=-INT(1.+4.*RLU(0))
10675 EJET=5.+20.*RLU(0)
10676 THETA=ACOS(2.*RLU(0)-1.)
10677 PHI=6.2832*RLU(0)
10678 IF(I.LT.NJET) CALL LU1ENT(-I,KFL,EJET,THETA,PHI)
10679 IF(I.EQ.NJET) CALL LU1ENT(I,KFL,EJET,THETA,PHI)
10680 IF(I.EQ.1.OR.I.EQ.NJET) MSTJ(93)=1
10681 IF(I.EQ.1.OR.I.EQ.NJET) PSUM(5)=PSUM(5)+ULMASS(KFL)
10682 DO 120 J=1,4
10683 PSUM(J)=PSUM(J)+P(I,J)
10684 120 CONTINUE
10685 130 CONTINUE
10686 IF(PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-PSUM(3)**2.LT.
10687 & (PSUM(5)+PARJ(32))**2) GOTO 100
10688
10689
10690 ELSEIF(IEV.LE.350) THEN
10691 MSTJ(101)=2
10692 CALL LUEEVT(0,40.)
10693
10694
10695 ELSEIF(IEV.LE.400) THEN
10696 MSTJ(42)=1+MOD(IEV,2)
10697 MSTJ(43)=1+MOD(IEV/2,4)
10698 MSTJ(44)=MOD(IEV/8,3)
10699 CALL LUEEVT(0,90.)
10700
10701
10702 ELSEIF(IEV.LE.450) THEN
10703 MSTJ(104)=6
10704 CALL LUEEVT(0,500.)
10705
10706
10707 ELSEIF(IEV.LE.500) THEN
10708 CALL LUONIA(5,9.46)
10709
10710
10711 ELSEIF(IEV.LE.560) THEN
10712 ITY=IEV-501
10713 KFLS=2*(ITY/20)+1
10714 KFLB=8-MOD(ITY/5,4)
10715 KFLC=KFLB-MOD(ITY,5)
10716 CALL LU1ENT(1,100*KFLB+10*KFLC+KFLS,0.,0.,0.)
10717
10718
10719 ELSEIF(IEV.LE.600) THEN
10720 ITY=IEV-561
10721 KFLS=2*(ITY/20)+2
10722 KFLA=8-MOD(ITY/5,4)
10723 KFLB=KFLA-MOD(ITY,5)
10724 KFLC=MAX(1,KFLB-1)
10725 CALL LU1ENT(1,1000*KFLA+100*KFLB+10*KFLC+KFLS,0.,0.,0.)
10726 ENDIF
10727
10728
10729 DO 140 J=1,4
10730 PINI(J)=PLU(0,J)
10731 140 CONTINUE
10732 PINI(6)=PLU(0,6)
10733 CALL LUEXEC
10734 DO 150 J=1,4
10735 PFIN(J)=PLU(0,J)
10736 150 CONTINUE
10737 PFIN(6)=PLU(0,6)
10738
10739
10740
10741 MERR=0
10742 IF(IEV.LE.50) THEN
10743 IF((PFIN(1)-PINI(1))**2+(PFIN(2)-PINI(2))**2.GE.4.) MERR=MERR+1
10744 EPZREM=PINI(4)+PINI(3)-PFIN(4)-PFIN(3)
10745 IF(EPZREM.LT.0..OR.EPZREM.GT.2.*PARJ(31)) MERR=MERR+1
10746 IF(ABS(PFIN(6)-PINI(6)).GT.2.1) MERR=MERR+1
10747 ELSE
10748 DO 160 J=1,4
10749 IF(ABS(PFIN(J)-PINI(J)).GT.0001*PINI(4)) MERR=MERR+1
10750 160 CONTINUE
10751 IF(ABS(PFIN(6)-PINI(6)).GT.0.1) MERR=MERR+1
10752 ENDIF
10753 IF(MERR.NE.0) WRITE(MSTU(11),5000) (PINI(J),J=1,4),PINI(6),
10754 &(PFIN(J),J=1,4),PFIN(6)
10755
10756
10757
10758 DO 170 I=1,N
10759 IF(K(I,1).GT.20) GOTO 170
10760 IF(LUCOMP(K(I,2)).EQ.0) THEN
10761 WRITE(MSTU(11),5100) I
10762 MERR=MERR+1
10763 ENDIF
10764 PD=P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2-P(I,5)**2
10765 IF(ABS(PD).GT.MAX(0.1,0.001*P(I,4)**2).OR.P(I,4).LT.0.) THEN
10766 WRITE(MSTU(11),5200) I
10767 MERR=MERR+1
10768 ENDIF
10769 170 CONTINUE
10770 IF(MTEST.GE.1) CALL LUTABU(21)
10771
10772
10773 IF(MERR.NE.0.OR.MSTU(24).NE.0.OR.MSTU(28).NE.0) THEN
10774 CALL LULIST(2)
10775 ELSEIF(MTEST.GE.1.AND.MOD(IEV-5,100).EQ.0) THEN
10776 CALL LULIST(1)
10777 ENDIF
10778
10779
10780 IF(MERR.NE.0) NERR=NERR+1
10781 IF(NERR.GE.10) THEN
10782 WRITE(MSTU(11),5300) IEV
10783 STOP
10784 ENDIF
10785 180 CONTINUE
10786
10787
10788 IF(MTEST.GE.1) CALL LUTABU(22)
10789 IF(NERR.EQ.0) WRITE(MSTU(11),5400)
10790 IF(NERR.GT.0) WRITE(MSTU(11),5500) NERR
10791
10792
10793 MSTJ(2)=3
10794 PARJ(17)=0.
10795 PARJ(22)=1.
10796 PARJ(43)=0.5
10797 PARJ(54)=0.
10798 MSTJ(105)=1
10799 MSTJ(107)=0
10800
10801
10802 5000 FORMAT(/' Momentum, energy and/or charge were not conserved ',
10803 &'in following event'/' sum of',9X,'px',11X,'py',11X,'pz',11X,
10804 &'E',8X,'charge'/' before',2X,4(1X,F12.5),1X,F8.2/' after',3X,
10805 &4(1X,F12.5),1X,F8.2)
10806 5100 FORMAT(/5X,'Entry no.',I4,' in following event not known code')
10807 5200 FORMAT(/5X,'Entry no.',I4,' in following event has faulty ',
10808 &'kinematics')
10809 5300 FORMAT(/5X,'Ten errors experienced by event ',I3/
10810 &5X,'Something is seriously wrong! Execution stopped now!')
10811 5400 FORMAT(//5X,'End result of LUTEST: no errors detected.')
10812 5500 FORMAT(//5X,'End result of LUTEST:',I2,' errors detected.'/
10813 &5X,'This should not have happened!')
10814
10815 RETURN
10816 END
10817
10818
10819
10820 BLOCK DATA LUDATA
10821
10822
10823
10824 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
10825 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
10826 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
10827 COMMON/LUDAT4/CHAF(500)
10828 CHARACTER CHAF*8
10829 COMMON/LUDATR/MRLU(6),RRLU(100)
10830 SAVE /LUDAT1/,/LUDAT2/,/LUDAT3/,/LUDAT4/,/LUDATR/
10831
10832
10833 DATA MSTU/
10834 & 0, 0, 0, 4000,10000, 500, 2000, 0, 0, 2,
10835 1 6, 1, 1, 0, 1, 1, 0, 0, 0, 0,
10836 2 2, 10, 0, 0, 1, 10, 0, 0, 0, 0,
10837 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
10838 4 2, 2, 1, 4, 2, 1, 1, 0, 0, 0,
10839 5 25, 24, 0, 1, 0, 0, 0, 0, 0, 0,
10840 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
10841 7 30*0,
10842 & 1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
10843 1 1, 5, 3, 5, 0, 0, 0, 0, 0, 0,
10844 2 60*0,
10845 8 7, 401, 1994, 02, 11, 700, 0, 0, 0, 0,
10846 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/
10847 DATA PARU/
10848 & 3.1415927, 6.2831854, 0.1973, 5.068, 0.3894, 2.568, 4*0.,
10849 1 0.001, 0.09, 0.01, 0., 0., 0., 0., 0., 0., 0.,
10850 2 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
10851 3 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
10852 4 2.0, 1.0, 0.25, 2.5, 0.05, 0., 0., 0.0001, 0., 0.,
10853 5 2.5, 1.5, 7.0, 1.0, 0.5, 2.0, 3.2, 0., 0., 0.,
10854 6 40*0.,
10855 & 0.00729735, 0.232, 0., 0., 0., 0., 0., 0., 0., 0.,
10856 1 0.20, 0.25, 1.0, 4.0, 10., 0., 0., 0., 0., 0.,
10857 2 -0.693, -1.0, 0.387, 1.0, -0.08, -1.0, 1.0, 1.0, 1.0, 0.,
10858 3 1.0, -1.0, 1.0, -1.0, 1.0, 0., 0., 0., 0., 0.,
10859 4 5.0, 1.0, 1.0, 0., 1.0, 1.0, 0., 0., 0., 0.,
10860 5 1.0, 0., 0., 0., 1000., 1.0, 1.0, 1.0, 1.0, 0.,
10861 6 1.0, 1.0, 1.0, 1.0, 1.0, 0., 0., 0., 0., 0.,
10862 7 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 0., 0., 0.,
10863 8 1.0, 1.0, 1.0, 0.0, 0.0, 1.0, 1.0, 0.0, 0.0, 0.,
10864 9 0., 0., 0., 0., 1.0, 0., 0., 0., 0., 0./
10865 DATA MSTJ/
10866 & 1, 3, 0, 0, 0, 0, 0, 0, 0, 0,
10867 1 4, 2, 0, 1, 0, 0, 0, 0, 0, 0,
10868 2 2, 1, 1, 2, 1, 2, 2, 0, 0, 0,
10869 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
10870 4 2, 2, 4, 2, 5, 3, 3, 0, 0, 0,
10871 5 0, 3, 0, 0, 0, 0, 0, 0, 0, 0,
10872 6 40*0,
10873 & 5, 2, 7, 5, 1, 1, 0, 2, 0, 2,
10874 1 0, 0, 0, 0, 1, 1, 0, 0, 0, 0,
10875 2 80*0/
10876 DATA PARJ/
10877 & 0.10, 0.30, 0.40, 0.05, 0.50, 0.50, 0.50, 0., 0., 0.,
10878 1 0.50, 0.60, 0.75, 0., 0., 0., 0., 1.0, 1.0, 0.,
10879 2 0.36, 1.0, 0.01, 2.0, 1.0, 0.4, 0., 0., 0., 0.,
10880 3 0.10, 1.0, 0.8, 1.5, 0., 2.0, 0.2, 2.5, 0.6, 0.,
10881 4 0.3, 0.58, 0.5, 0.9, 0.5, 1.0, 1.0, 1.0, 0., 0.,
10882 5 0.77,0.77,0.77,-0.05,-0.005,-0.00001,-0.00001,-0.00001,1.0,0.,
10883 6 4.5, 0.7, 0., 0.003, 0.5, 0.5, 0., 0., 0., 0.,
10884 7 10., 1000., 100., 1000., 0., 0.7, 10., 0., 0., 0.,
10885 8 0.29, 1.0, 1.0, 0., 10., 10., 0., 0., 0., 0.,
10886 9 0.02, 1.0, 0.2, 0., 0., 0., 0., 0., 0., 0.,
10887 & 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
10888 1 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
10889 2 1.0, 0.25,91.187,2.489, 0.01, 2.0, 1.0, 0.25,0.002, 0.,
10890 3 0., 0., 0., 0., 0.01, 0.99, 0., 0., 0.2, 0.,
10891 4 60*0./
10892
10893
10894 DATA (KCHG(I,1),I= 1, 500)/-1,2,-1,2,-1,2,-1,2,2*0,-3,0,-3,0,
10895 &-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,
10896 &3,0,3,0,3,10*0,3,0,2*3,0,3,0,3,0,3,10*0,3,0,2*3,0,3,0,3,0,3,10*0,
10897 &3,0,2*3,0,3,0,3,0,3,10*0,3,0,2*3,0,3,0,3,0,3,10*0,3,0,2*3,0,3,0,
10898 &3,0,3,70*0,3,0,3,28*0,3,2*0,3,8*0,-3,8*0,3,0,-3,0,3,-3,3*0,3,6,0,
10899 &3,5*0,-3,0,3,-3,0,-3,4*0,-3,0,3,6,-3,0,3,-3,0,-3,0,3,6,0,3,5*0,
10900 &-3,0,3,-3,0,-3,114*0/
10901 DATA (KCHG(I,2),I= 1, 500)/8*1,12*0,2,16*0,2,1,50*0,-1,410*0/
10902 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,
10903 &41*0,1,0,7*1,10*0,10*1,10*0,10*1,10*0,10*1,10*0,10*1,10*0,10*1,
10904 &10*0,10*1,70*0,3*1,22*0,1,5*0,1,0,2*1,6*0,1,0,2*1,6*0,2*1,0,5*1,
10905 &0,6*1,4*0,6*1,4*0,16*1,4*0,6*1,114*0/
10906 DATA (PMAS(I,1),I= 1, 500)/0.0099,0.0056,0.199,1.35,5.,160.,
10907 &2*250.,2*0.,0.00051,0.,0.1057,0.,1.777,0.,250.,5*0.,91.187,80.25,
10908 &80.,6*0.,500.,900.,500.,3*300.,350.,200.,5000.,60*0.,0.1396,
10909 &0.4977,0.4936,1.8693,1.8645,1.9688,5.2787,5.2786,5.47972,6.594,
10910 &0.135,0.5475,0.9578,2.9788,9.4,320.,2*500.,2*0.,0.7669,0.8961,
10911 &0.8916,2.0101,2.0071,2.11,2*5.325,5.5068,6.602,0.7683,0.782,
10912 &1.0194,3.0969,9.4603,320.,2*500.,2*0.,1.232,2*1.29,2*2.424,2.536,
10913 &2*5.73,5.97,7.3,1.232,1.17,1.4,3.46,9.875,320.,2*500.,2*0.,0.983,
10914 &2*1.429,2*2.272,2.5,2*5.68,5.92,7.25,0.9827,1.,1.4,3.4151,9.8598,
10915 &320.,2*500.,2*0.,1.26,2*1.402,2*2.372,2.56,2*5.78,6.02,7.3,1.26,
10916 &1.282,1.42,3.5106,9.8919,320.,2*500.,2*0.,1.318,1.432,1.425,
10917 &2*2.46,2.61,2*5.83,6.07,7.35,1.318,1.275,1.525,3.5562,9.9132,
10918 &320.,2*500.,2*0.,2*0.4977,8*0.,3.686,3*0.,10.0233,70*0.,1.1156,
10919 &5*0.,2.2849,0.,2.473,2.466,6*0.,5.641,0.,2*5.84,6*0.,0.9396,
10920 &0.9383,0.,1.1974,1.1926,1.1894,1.3213,1.3149,0.,2.4525,2.4529,
10921 &2.4527,2*2.55,2.73,4*0.,3*5.8,2*5.96,6.12,4*0.,1.234,1.233,1.232,
10922 &1.231,1.3872,1.3837,1.3828,1.535,1.5318,1.6724,3*2.5,2*2.63,2.8,
10923 &4*0.,3*5.81,2*5.97,6.13,114*0./
10924 DATA (PMAS(I,2),I= 1, 500)/22*0.,2.489,2.066,88*0.,0.0002,
10925 &0.001,6*0.,0.149,0.0505,0.0498,7*0.,0.151,0.00843,0.0044,7*0.,
10926 &0.155,2*0.09,2*0.02,0.,4*0.05,0.155,0.36,0.08,2*0.01,5*0.,0.057,
10927 &2*0.287,7*0.05,0.057,0.,0.25,0.014,6*0.,0.4,2*0.174,7*0.05,0.4,
10928 &0.024,0.06,0.0009,6*0.,0.11,0.109,0.098,2*0.019,5*0.02,0.11,
10929 &0.185,0.076,0.002,146*0.,4*0.12,0.0394,0.036,0.0358,0.0099,
10930 &0.0091,131*0./
10931 DATA (PMAS(I,3),I= 1, 500)/22*0.,2*20.,88*0.,0.002,0.005,6*0.,
10932 &0.4,2*0.2,7*0.,0.4,0.1,0.015,7*0.,0.25,0.005,0.01,2*0.08,0.,
10933 &4*0.1,0.25,0.2,0.001,2*0.02,5*0.,0.05,2*0.4,6*0.1,2*0.05,0.,0.35,
10934 &0.05,6*0.,3*0.3,2*0.1,0.03,4*0.1,0.3,0.05,0.02,0.001,6*0.,0.25,
10935 &4*0.12,5*0.05,0.25,0.17,0.2,0.01,146*0.,4*0.14,0.04,2*0.035,
10936 &2*0.05,131*0./
10937 DATA (PMAS(I,4),I= 1, 500)/12*0.,658650.,0.,0.0914,68*0.,0.1,
10938 &0.387,15*0.,7804.,0.,3709.,0.32,0.1259,0.135,3*0.387,0.15,110*0.,
10939 &15500.,26.75,83*0.,78.88,5*0.,0.057,0.,0.025,0.09,6*0.,0.387,0.,
10940 &2*0.387,9*0.,44.3,0.,23.95,49.1,86.9,6*0.,0.13,9*0.,0.387,13*0.,
10941 &24.60001,130*0./
10942 DATA PARF/
10943 & 0.5, 0.25, 0.5, 0.25, 1., 0.5, 0., 0., 0., 0.,
10944 1 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0.,
10945 2 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0.,
10946 3 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0.,
10947 4 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0.,
10948 5 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0.,
10949 6 0.75, 0.5, 0., 0.1667, 0.0833, 0.1667, 0., 0., 0., 0.,
10950 7 0., 0., 1., 0.3333, 0.6667, 0.3333, 0., 0., 0., 0.,
10951 8 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
10952 9 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
10953 & 0.325, 0.325, 0.5, 1.6, 5.0, 0., 0., 0., 0., 0.,
10954 1 0., 0.11, 0.16, 0.048, 0.50, 0.45, 0.55, 0.60, 0., 0.,
10955 2 0.2, 0.1, 0., 0., 0., 0., 0., 0., 0., 0.,
10956 3 1870*0./
10957 DATA ((VCKM(I,J),J=1,4),I=1,4)/
10958 1 0.95113, 0.04884, 0.00003, 0.00000,
10959 2 0.04884, 0.94940, 0.00176, 0.00000,
10960 3 0.00003, 0.00176, 0.99821, 0.00000,
10961 4 0.00000, 0.00000, 0.00000, 1.00000/
10962
10963
10964 DATA (MDCY(I,1),I= 1, 500)/5*0,3*1,6*0,1,0,1,5*0,3*1,6*0,1,0,1,
10965 &2*0,4*1,42*0,7*1,12*0,1,0,15*1,2*0,18*1,2*0,18*1,2*0,18*1,2*0,
10966 &18*1,2*0,18*1,3*0,1,8*0,1,3*0,1,70*0,1,5*0,1,0,2*1,6*0,1,0,2*1,
10967 &9*0,5*1,0,6*1,4*0,6*1,4*0,16*1,4*0,6*1,114*0/
10968 DATA (MDCY(I,2),I= 1, 500)/1,9,17,25,33,41,50,60,2*0,70,74,76,
10969 &81,83,124,126,132,2*0,135,144,156,172,192,6*0,209,0,231,254,274,
10970 &292,301,304,305,42*0,314,315,319,328,331,336,338,11*0,358,359,
10971 &361,367,430,491,524,560,596,635,666,668,675,681,682,683,684,685,
10972 &2*0,686,688,691,694,697,699,700,701,702,703,704,708,713,721,724,
10973 &733,734,735,2*0,736,737,742,747,749,751,753,755,757,759,761,762,
10974 &765,769,770,771,772,773,2*0,774,775,777,779,781,783,785,787,789,
10975 &791,793,794,799,804,806,808,809,810,2*0,811,813,815,817,819,821,
10976 &823,825,827,829,831,833,846,850,852,854,855,856,2*0,857,863,873,
10977 &884,892,900,904,912,920,924,928,936,945,951,953,955,956,957,2*0,
10978 &958,966,8*0,968,3*0,979,70*0,993,5*0,997,0,1073,1074,6*0,1075,0,
10979 &1092,1093,9*0,1094,1096,1097,1100,1101,0,1103,1104,1105,1106,
10980 &1107,1108,4*0,1109,1110,1111,1112,1113,1114,4*0,1115,1116,1119,
10981 &1122,1123,1126,1129,1132,1134,1136,1140,1141,1142,1143,1145,1147,
10982 &4*0,1148,1149,1150,1151,1152,1153,114*0/
10983 DATA (MDCY(I,3),I= 1, 500)/5*8,9,2*10,2*0,4,2,5,2,41,2,6,3,2*0,
10984 &9,12,16,20,17,6*0,22,0,23,20,18,9,3,1,9,42*0,1,4,9,3,5,2,20,11*0,
10985 &1,2,6,63,61,33,2*36,39,31,2,7,6,5*1,2*0,2,3*3,2,5*1,4,5,8,3,9,
10986 &3*1,2*0,1,2*5,7*2,1,3,4,5*1,2*0,1,9*2,1,2*5,2*2,3*1,2*0,11*2,13,
10987 &4,2*2,3*1,2*0,6,10,11,2*8,4,2*8,2*4,8,9,6,2*2,3*1,2*0,8,2,8*0,11,
10988 &3*0,14,70*0,4,5*0,76,0,2*1,6*0,17,0,2*1,9*0,2,1,3,1,2,0,6*1,4*0,
10989 &6*1,4*0,1,2*3,1,3*3,2*2,4,3*1,2*2,1,4*0,6*1,114*0/
10990 DATA (MDME(I,1),I= 1,2000)/6*1,-1,7*1,-1,7*1,-1,7*1,-1,7*1,-1,
10991 &7*1,-1,1,-1,8*1,2*-1,8*1,2*-1,61*1,-1,2*1,-1,6*1,2*-1,7*1,2*-1,
10992 &3*1,-1,6*1,2*-1,6*1,2*-1,3*1,-1,3*1,-1,3*1,5*-1,3*1,-1,6*1,2*-1,
10993 &3*1,-1,11*1,2*-1,6*1,8*-1,3*1,-1,3*1,-1,3*1,5*-1,3*1,4*-1,6*1,
10994 &2*-1,3*1,-1,5*1,-1,8*1,2*-1,3*1,-1,9*1,-1,3*1,-1,9*1,2*-1,2*1,-1,
10995 &16*1,-1,2*1,3*-1,1665*1/
10996 DATA (MDME(I,2),I= 1,2000)/75*102,42,6*102,2*42,2*0,7*41,2*0,
10997 &24*41,6*102,45,29*102,8*32,8*0,16*32,4*0,8*32,4*0,32,4*0,8*32,
10998 &14*0,16*32,7*0,8*32,4*0,32,7*0,8*32,4*0,32,5*0,4*32,5*0,3*32,0,
10999 &6*32,3*0,12,2*42,2*11,9*42,2*45,31,2*45,2*33,31,2*45,20*46,7*0,
11000 &24*42,41*0,16*42,46*0,10*42,20*0,2*13,14*42,16*0,48,3*13,16*42,
11001 &16*0,48,3*13,16*42,19*0,48,3*13,2*42,0,2*11,28*42,0,2,4*0,2,8*0,
11002 &12,32,86,87,88,3,0,2*3,0,2*3,0,2*3,0,3,6*0,3,3*0,1,0,3,2*0,2*3,
11003 &3*0,1,4*0,12,3*0,4*32,2*4,86,87,88,33*0,12,32,86,87,88,31*0,12,0,
11004 &32,86,87,88,40*0,12,0,32,86,87,88,95*0,12,0,32,86,87,88,2*0,4*42,
11005 &6*0,12,11*0,4*32,2*4,9*0,14*42,52*0,10*13,2*84,3*42,8*0,48,3*13,
11006 &2*42,2*85,14*0,84,5*0,85,886*0/
11007 DATA (BRAT(I) ,I= 1, 439)/75*0.,1.,6*0.,0.179,0.178,0.116,
11008 &0.235,0.005,0.056,0.018,0.023,0.011,2*0.004,0.0067,0.014,2*0.002,
11009 &2*0.001,0.0022,0.054,0.002,0.016,0.005,0.011,0.0101,5*0.006,
11010 &0.002,2*0.001,5*0.002,6*0.,1.,29*0.,0.15394,0.11936,0.15394,
11011 &0.11926,0.15254,3*0.,0.03368,0.06664,0.03368,0.06664,0.03368,
11012 &0.06664,2*0.,0.3214,0.0165,2*0.,0.0165,0.3207,2*0.,0.00001,
11013 &0.00059,6*0.,3*0.1081,3*0.,0.0003,0.048,0.8705,4*0.,0.0002,
11014 &0.0603,0.,0.0199,0.0008,3*0.,0.143,0.111,0.143,0.111,0.143,0.085,
11015 &2*0.,0.03,0.058,0.03,0.058,0.03,0.058,8*0.,0.25,0.01,2*0.,0.01,
11016 &0.25,4*0.,0.24,5*0.,3*0.08,6*0.,0.01,0.08,0.82,5*0.,0.09,11*0.,
11017 &0.01,0.08,0.82,5*0.,0.09,9*0.,1.,6*0.,0.01,0.98,0.01,1.,4*0.215,
11018 &2*0.,2*0.07,0.,1.,2*0.08,0.76,0.08,2*0.105,0.04,0.5,0.08,0.14,
11019 &0.01,0.015,0.005,1.,3*0.,1.,4*0.,1.,0.25,0.01,2*0.,0.01,0.25,
11020 &4*0.,0.24,5*0.,3*0.08,0.,1.,2*0.5,0.635,0.212,0.056,0.017,0.048,
11021 &0.032,0.07,0.065,2*0.005,2*0.011,5*0.001,0.07,0.065,2*0.005,
11022 &2*0.011,5*0.001,0.026,0.019,0.066,0.041,0.045,0.076,0.0073,
11023 &2*0.0047,0.026,0.001,0.0006,0.0066,0.005,2*0.003,2*0.0006,
11024 &2*0.001,0.006,0.005,0.012,0.0057,0.067,0.008,0.0022,0.027,0.004,
11025 &0.019,0.012,0.002,0.009,0.0218,0.001,0.022,0.087,0.001,0.0019,
11026 &0.0015,0.0028,0.034,0.027,2*0.002,2*0.004,2*0.002,0.034,0.027/
11027 DATA (BRAT(I) ,I= 440, 655)/2*0.002,2*0.004,2*0.002,0.0365,
11028 &0.045,0.073,0.062,3*0.021,0.0061,0.015,0.025,0.0088,0.074,0.0109,
11029 &0.0041,0.002,0.0035,0.0011,0.001,0.0027,2*0.0016,0.0018,0.011,
11030 &0.0063,0.0052,0.018,0.016,0.0034,0.0036,0.0009,0.0006,0.015,
11031 &0.0923,0.018,0.022,0.0077,0.009,0.0075,0.024,0.0085,0.067,0.0511,
11032 &0.017,0.0004,0.0028,0.01,2*0.02,0.03,2*0.005,2*0.02,0.03,2*0.005,
11033 &0.015,0.037,0.028,0.079,0.095,0.052,0.0078,4*0.001,0.028,0.033,
11034 &0.026,0.05,0.01,4*0.005,0.25,0.0952,0.02,0.055,2*0.005,0.008,
11035 &0.012,0.02,0.055,2*0.005,0.008,0.012,0.01,0.03,0.0035,0.011,
11036 &0.0055,0.0042,0.009,0.018,0.015,0.0185,0.0135,0.025,0.0004,
11037 &0.0007,0.0008,0.0014,0.0019,0.0025,0.4291,0.08,0.07,0.02,0.015,
11038 &0.005,0.02,0.055,2*0.005,0.008,0.012,0.02,0.055,2*0.005,0.008,
11039 &0.012,0.01,0.03,0.0035,0.011,0.0055,0.0042,0.009,0.018,0.015,
11040 &0.0185,0.0135,0.025,0.0004,0.0007,0.0008,0.0014,0.0019,0.0025,
11041 &0.4291,0.08,0.07,0.02,0.015,0.005,0.02,0.055,2*0.005,0.008,0.012,
11042 &0.02,0.055,2*0.005,0.008,0.012,0.01,0.03,0.0035,0.011,0.0055,
11043 &0.0042,0.009,0.018,0.015,0.0185,0.0135,0.025,2*0.0002,0.0007,
11044 &2*0.0004,0.0014,0.001,0.0009,0.0025,0.4291,0.08,0.07,0.02,0.015,
11045 &0.005,0.047,0.122,0.006,0.012,0.035,0.012,0.035,0.003,0.007,0.15,
11046 &0.037,0.008,0.002,0.05,0.015,0.003,0.001,0.014,0.042,0.014,0.042/
11047 DATA (BRAT(I) ,I= 656, 931)/0.24,0.065,0.012,0.003,0.001,0.002,
11048 &0.001,0.002,0.014,0.003,0.988,0.012,0.389,0.319,0.2367,0.049,
11049 &0.005,0.001,0.0003,0.441,0.206,0.3,0.03,0.022,0.001,5*1.,0.99955,
11050 &0.00045,0.665,0.333,0.002,0.666,0.333,0.001,0.65,0.3,0.05,0.56,
11051 &0.44,5*1.,0.99912,0.00079,0.00005,0.00004,0.888,0.085,0.021,
11052 &2*0.003,0.49,0.344,3*0.043,0.023,0.013,0.001,0.0627,0.0597,
11053 &0.8776,3*0.027,0.015,0.045,0.015,0.045,0.77,0.029,4*1.,0.28,0.14,
11054 &0.313,0.157,0.11,0.28,0.14,0.313,0.157,0.11,0.667,0.333,0.667,
11055 &0.333,2*0.5,0.667,0.333,0.667,0.333,4*0.5,1.,0.333,0.334,0.333,
11056 &4*0.25,6*1.,0.667,0.333,0.667,0.333,0.667,0.333,0.667,0.333,
11057 &2*0.5,0.667,0.333,0.667,0.333,4*0.5,1.,0.52,0.26,0.11,2*0.055,
11058 &0.62,0.31,0.035,2*0.0175,0.007,0.993,0.02,0.98,3*1.,2*0.5,0.667,
11059 &0.333,0.667,0.333,0.667,0.333,0.667,0.333,2*0.5,0.667,0.333,
11060 &0.667,0.333,6*0.5,3*0.12,0.097,0.043,4*0.095,4*0.03,4*0.25,0.273,
11061 &0.727,0.35,0.65,3*1.,2*0.35,0.144,0.105,0.048,0.003,0.333,0.166,
11062 &0.168,0.084,0.087,0.043,0.059,2*0.029,0.002,0.332,0.166,0.168,
11063 &0.084,0.086,0.043,0.059,2*0.029,2*0.002,0.3,0.15,0.16,0.08,0.13,
11064 &0.06,0.08,0.04,0.3,0.15,0.16,0.08,0.13,0.06,0.08,0.04,2*0.3,
11065 &2*0.2,0.3,0.15,0.16,0.08,0.13,0.06,0.08,0.04,0.3,0.15,0.16,0.08,
11066 &0.13,0.06,0.08,0.04,2*0.3,2*0.2,2*0.3,2*0.2,2*0.35,0.144,0.105/
11067 DATA (BRAT(I) ,I= 932,2000)/0.024,2*0.012,0.003,0.566,0.283,
11068 &0.069,0.028,0.023,2*0.0115,0.005,0.003,0.356,2*0.178,0.28,
11069 &2*0.004,0.135,0.865,0.22,0.78,3*1.,0.217,0.124,2*0.193,2*0.135,
11070 &0.002,0.001,0.686,0.314,2*0.0083,0.1866,0.324,0.184,0.027,0.001,
11071 &0.093,0.087,0.078,0.0028,3*0.014,0.008,0.024,0.008,0.024,0.425,
11072 &0.02,0.185,0.088,0.043,0.067,0.066,0.641,0.357,2*0.001,0.018,
11073 &2*0.005,0.003,0.002,2*0.006,0.018,2*0.005,0.003,0.002,2*0.006,
11074 &0.0066,0.025,0.016,0.0088,2*0.005,0.0058,0.005,0.0055,4*0.004,
11075 &2*0.002,2*0.004,0.003,0.002,2*0.003,3*0.002,2*0.001,0.002,
11076 &2*0.001,2*0.002,0.0013,0.0018,5*0.001,4*0.003,2*0.005,2*0.002,
11077 &2*0.001,2*0.002,2*0.001,0.2432,0.057,2*0.035,0.15,2*0.075,0.03,
11078 &2*0.015,2*1.,2*0.105,0.04,0.0077,0.02,0.0235,0.0285,0.0435,
11079 &0.0011,0.0022,0.0044,0.4291,0.08,0.07,0.02,0.015,0.005,2*1.,
11080 &0.999,0.001,1.,0.516,0.483,0.001,1.,0.995,0.005,13*1.,0.331,
11081 &0.663,0.006,0.663,0.331,0.006,1.,0.88,2*0.06,0.88,2*0.06,0.88,
11082 &2*0.06,0.667,2*0.333,0.667,0.676,0.234,0.085,0.005,3*1.,4*0.5,
11083 &7*1.,847*0./
11084 DATA (KFDP(I,1),I= 1, 507)/21,22,23,4*-24,25,21,22,23,4*24,25,
11085 &21,22,23,4*-24,25,21,22,23,4*24,25,21,22,23,4*-24,25,21,22,23,
11086 &4*24,25,37,21,22,23,4*-24,25,2*-37,21,22,23,4*24,25,2*37,22,23,
11087 &-24,25,23,24,-12,22,23,-24,25,23,24,-12,-14,35*16,22,23,-24,25,
11088 &23,24,-89,22,23,-24,25,-37,23,24,37,1,2,3,4,5,6,7,8,21,1,2,3,4,5,
11089 &6,7,8,11,13,15,17,1,2,3,4,5,6,7,8,11,12,13,14,15,16,17,18,4*-1,
11090 &4*-3,4*-5,4*-7,-11,-13,-15,-17,1,2,3,4,5,6,7,8,11,13,15,17,21,
11091 &2*22,23,24,1,2,3,4,5,6,7,8,11,12,13,14,15,16,17,18,24,37,2*23,25,
11092 &35,4*-1,4*-3,4*-5,4*-7,-11,-13,-15,-17,3*24,1,2,3,4,5,6,7,8,11,
11093 &13,15,17,21,2*22,23,24,23,25,36,1,2,3,4,5,6,7,8,11,13,15,17,21,
11094 &2*22,23,24,23,-1,-3,-5,-7,-11,-13,-15,-17,24,5,6,21,2,1,2,3,4,5,
11095 &6,11,13,15,82,-11,-13,2*2,-12,-14,-16,2*-2,2*-4,-2,-4,2*89,37,
11096 &2*-89,2*5,-37,2*89,4*-1,4*-3,4*-5,4*-7,-11,-13,-15,-17,-13,130,
11097 &310,-13,3*211,12,14,11*-11,11*-13,-311,-313,-311,-313,-20313,
11098 &2*-311,-313,-311,-313,2*111,2*221,2*331,2*113,2*223,2*333,-311,
11099 &-313,2*-321,211,-311,-321,333,-311,-313,-321,211,2*-321,2*-311,
11100 &-321,211,113,8*-11,8*-13,-321,-323,-321,-323,-311,2*-313,-311,
11101 &-313,2*-311,-321,-10323,-321,-323,-321,-311,2*-313,211,111,333,
11102 &3*-321,-311,-313,-321,-313,310,333,211,2*-321,-311,-313,-311,211,
11103 &-321,3*-311,211,113,321,-15,5*-11,5*-13,221,331,333,221,331,333/
11104 DATA (KFDP(I,1),I= 508, 924)/10221,211,213,211,213,321,323,321,
11105 &323,2212,221,331,333,221,2*2,6*12,6*14,2*16,3*-411,3*-413,2*-411,
11106 &2*-413,2*441,2*443,2*20443,2*2,2*4,2,4,6*12,6*14,2*16,3*-421,
11107 &3*-423,2*-421,2*-423,2*441,2*443,2*20443,2*2,2*4,2,4,6*12,6*14,
11108 &2*16,3*-431,3*-433,2*-431,2*-433,3*441,3*443,3*20443,2*2,2*4,2,4,
11109 &16,2*4,2*12,2*14,2*16,4*2,4*4,2*-11,2*-13,2*-1,2*-3,2*-11,2*-13,
11110 &2*-1,3*22,111,211,2*22,211,22,211,111,3*22,111,82,21,3*0,2*211,
11111 &321,3*311,2*321,421,2*411,2*421,431,511,521,531,541,211,111,13,
11112 &11,211,22,211,2*111,321,130,-213,113,213,211,22,111,11,13,82,11,
11113 &13,15,1,2,3,4,21,22,3*0,223,321,311,323,313,2*311,321,313,323,
11114 &321,423,2*413,2*423,413,523,2*513,2*523,2*513,523,223,213,113,
11115 &-213,313,-313,323,-323,82,21,3*0,221,321,2*311,321,421,2*411,421,
11116 &411,421,521,2*511,2*521,2*511,521,221,211,111,321,130,310,211,
11117 &111,321,130,310,443,82,553,21,3*0,113,213,323,2*313,323,423,
11118 &2*413,2*423,413,523,2*513,2*523,2*513,523,213,-213,10211,10111,
11119 &-10211,2*221,213,2*113,-213,2*321,2*311,313,-313,323,-323,443,82,
11120 &553,21,3*0,213,113,221,223,321,211,321,311,323,313,323,313,321,
11121 &4*311,321,313,323,313,323,311,4*321,421,411,423,413,423,413,421,
11122 &2*411,421,413,423,413,423,411,2*421,411,423,413,521,511,523,513,
11123 &523,513,521,2*511,521,513,523,513,523,511,2*521,511,523,513,511/
11124 DATA (KFDP(I,1),I= 925,2000)/521,513,523,213,-213,221,223,321,
11125 &130,310,111,211,111,2*211,321,130,310,221,111,321,130,310,221,
11126 &211,111,443,82,553,21,3*0,111,211,-12,12,-14,14,211,111,211,111,
11127 &11,13,82,4*443,10441,20443,445,441,11,13,15,1,2,3,4,21,22,2*553,
11128 &10551,20553,555,2212,2*2112,-12,7*-11,7*-13,2*2224,2*2212,2*2214,
11129 &2*3122,2*3212,2*3214,5*3222,4*3224,2*3322,3324,2*2224,7*2212,
11130 &5*2214,2*2112,2*2114,2*3122,2*3212,2*3214,2*3222,2*3224,4*2,3,
11131 &2*2,1,2*2,2*0,-12,-14,-16,5*4122,441,443,20443,2*-2,2*-4,-2,-4,
11132 &2*0,2112,-12,3122,2212,2112,2212,3*3122,3*4122,4132,4232,0,
11133 &3*5122,5132,5232,0,2112,2212,2*2112,2212,2112,2*2212,3122,3212,
11134 &3112,3122,3222,3112,3122,3222,3212,3322,3312,3322,3312,3122,3322,
11135 &3312,-12,3*4122,2*4132,2*4232,4332,3*5122,5132,5232,5332,847*0/
11136 DATA (KFDP(I,2),I= 1, 476)/3*1,2,4,6,8,1,3*2,1,3,5,7,2,3*3,2,4,
11137 &6,8,3,3*4,1,3,5,7,4,3*5,2,4,6,8,5,3*6,1,3,5,7,6,5,3*7,2,4,6,8,7,
11138 &4,6,3*8,1,3,5,7,8,5,7,2*11,12,11,12,2*11,2*13,14,13,14,13,11,13,
11139 &-211,-213,-211,-213,-211,-213,3*-211,-321,-323,-321,-323,3*-321,
11140 &4*-211,-213,-211,-213,-211,-213,-211,-213,-211,-213,6*-211,2*15,
11141 &16,15,16,15,18,2*17,18,17,2*18,2*17,-1,-2,-3,-4,-5,-6,-7,-8,21,
11142 &-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,-1,-2,-3,-4,-5,-6,-7,-8,
11143 &-11,-12,-13,-14,-15,-16,-17,-18,2,4,6,8,2,4,6,8,2,4,6,8,2,4,6,8,
11144 &12,14,16,18,-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,21,22,2*23,
11145 &-24,-1,-2,-3,-4,-5,-6,-7,-8,-11,-12,-13,-14,-15,-16,-17,-18,-24,
11146 &-37,22,25,2*36,2,4,6,8,2,4,6,8,2,4,6,8,2,4,6,8,12,14,16,18,23,22,
11147 &25,-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,21,22,2*23,-24,2*25,
11148 &36,-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,21,22,2*23,-24,25,2,4,
11149 &6,8,12,14,16,18,25,-5,-6,21,11,-3,-4,-5,-6,-7,-8,-13,-15,-17,-82,
11150 &12,14,-1,-3,11,13,15,1,4,3,4,1,3,5,3,5,6,4,21,22,4,7,5,2,4,6,8,2,
11151 &4,6,8,2,4,6,8,2,4,6,8,12,14,16,18,14,2*0,14,111,211,111,-11,-13,
11152 &11*12,11*14,2*211,2*213,211,20213,2*321,2*323,211,213,211,213,
11153 &211,213,211,213,211,213,211,213,3*211,213,211,2*321,8*211,2*113,
11154 &2*211,8*12,8*14,2*211,2*213,2*111,221,2*113,223,333,20213,211,
11155 &2*321,323,2*311,313,-211,111,113,2*211,321,2*211,311,321,310,211/
11156 DATA (KFDP(I,2),I= 477, 857)/-211,4*211,321,4*211,113,2*211,-321,
11157 &16,5*12,5*14,3*211,3*213,211,2*111,2*113,2*-311,2*-313,-2112,
11158 &3*321,323,2*-1,6*-11,6*-13,2*-15,211,213,20213,211,213,20213,431,
11159 &433,431,433,311,313,311,313,311,313,-1,-4,-3,-4,-1,-3,6*-11,
11160 &6*-13,2*-15,211,213,20213,211,213,20213,431,433,431,433,321,323,
11161 &321,323,321,323,-1,-4,-3,-4,-1,-3,6*-11,6*-13,2*-15,211,213,
11162 &20213,211,213,20213,431,433,431,433,221,331,333,221,331,333,221,
11163 &331,333,-1,-4,-3,-4,-1,-3,-15,-3,-1,2*-11,2*-13,2*-15,-1,-4,-3,
11164 &-4,-3,-4,-1,-4,2*12,2*14,2,3,2,3,2*12,2*14,2,1,22,11,22,111,-211,
11165 &211,11,-211,13,-211,111,113,223,22,111,-82,21,3*0,111,22,-211,
11166 &111,22,211,111,22,211,111,22,111,6*22,-211,22,-13,-11,-211,111,
11167 &-211,2*111,-321,310,211,111,2*-211,221,22,-11,-13,-82,-11,-13,
11168 &-15,-1,-2,-3,-4,2*21,3*0,211,-213,113,-211,111,223,213,113,211,
11169 &111,223,211,111,-211,111,321,311,-211,111,211,111,-321,-311,411,
11170 &421,111,-211,111,211,-311,311,-321,321,-82,21,3*0,211,-211,111,
11171 &211,111,211,111,-211,111,311,321,-211,111,211,111,-321,-311,411,
11172 &421,111,-211,111,-321,130,310,-211,111,-321,130,310,22,-82,22,21,
11173 &3*0,211,111,-211,111,211,111,211,111,-211,111,321,311,-211,111,
11174 &211,111,-321,-311,411,421,-211,211,-211,111,2*211,111,-211,211,
11175 &111,211,-321,2*-311,-321,-311,311,-321,321,22,-82,22,21,3*0,111/
11176 DATA (KFDP(I,2),I= 858,2000)/3*211,-311,22,-211,111,-211,111,
11177 &-211,211,-213,113,223,221,211,111,211,111,2*211,213,113,223,221,
11178 &22,211,111,211,111,4*211,-211,111,-211,111,-211,211,-211,211,321,
11179 &311,321,311,-211,111,-211,111,-211,211,-211,2*211,111,211,111,
11180 &4*211,-321,-311,-321,-311,411,421,411,421,-211,211,111,211,-321,
11181 &130,310,22,-211,111,2*-211,-321,130,310,221,111,-321,130,310,221,
11182 &-211,111,22,-82,22,21,3*0,111,-211,11,-11,13,-13,-211,111,-211,
11183 &111,-11,-13,-82,211,111,221,111,4*22,-11,-13,-15,-1,-2,-3,-4,
11184 &2*21,211,111,3*22,-211,111,22,11,7*12,7*14,-321,-323,-311,-313,
11185 &-311,-313,211,213,211,213,211,213,111,221,331,113,223,111,221,
11186 &113,223,321,323,321,-211,-213,111,221,331,113,223,333,10221,111,
11187 &221,331,113,223,211,213,211,213,321,323,321,323,321,323,311,313,
11188 &311,313,2*-1,-3,-1,2203,3201,3203,2203,2101,2103,2*0,11,13,15,
11189 &-211,-213,-20213,-431,-433,3*3122,1,4,3,4,1,3,2*0,-211,11,22,111,
11190 &211,22,-211,111,22,-211,111,211,2*22,0,-211,111,211,2*22,0,
11191 &2*-211,111,22,111,211,22,211,2*-211,2*111,-211,2*211,111,211,
11192 &-211,2*111,211,-321,-211,111,11,-211,111,211,111,22,111,2*22,
11193 &-211,111,211,3*22,847*0/
11194 DATA (KFDP(I,3),I= 1, 944)/75*0,14,6*0,2*16,2*0,5*111,310,130,
11195 &2*0,2*111,310,130,321,113,211,223,221,2*113,2*211,2*223,2*221,
11196 &2*113,221,113,2*213,-213,195*0,4*3,4*4,1,4,3,2*2,10*81,25*0,-211,
11197 &3*111,-311,-313,-311,-321,-313,-323,111,221,331,113,223,-311,
11198 &-313,-311,-321,-313,-323,111,221,331,113,223,22*0,111,113,2*211,
11199 &-211,-311,211,111,3*211,-211,7*211,-321,-323,-311,-321,-313,-323,
11200 &-211,-213,-321,-323,-311,-321,-313,-323,-211,-213,22*0,111,113,
11201 &-311,2*-211,211,-211,310,-211,2*111,211,2*-211,-321,-211,2*211,
11202 &-211,111,-211,2*211,0,221,331,333,321,311,221,331,333,321,311,
11203 &20*0,3,0,-411,-413,-10413,-10411,-20413,-415,-411,-413,-10413,
11204 &-10411,-20413,-415,-411,-413,16*0,-4,-1,-4,-3,2*-2,-421,-423,
11205 &-10423,-10421,-20423,-425,-421,-423,-10423,-10421,-20423,-425,
11206 &-421,-423,16*0,-4,-1,-4,-3,2*-2,-431,-433,-10433,-10431,-20433,
11207 &-435,-431,-433,-10433,-10431,-20433,-435,-431,-433,19*0,-4,-1,-4,
11208 &-3,2*-2,3*0,441,443,441,443,441,443,-4,-1,-4,-3,-4,-3,-4,-1,531,
11209 &533,531,533,3,2,3,2,511,513,511,513,1,2,0,-11,0,2*111,-211,-11,
11210 &11,-13,2*221,3*0,111,27*0,111,2*0,22,111,5*0,111,12*0,2*21,103*0,
11211 &-211,2*111,-211,3*111,-211,111,211,14*0,111,6*0,111,-211,8*0,111,
11212 &-211,9*0,111,-211,111,-211,4*0,111,-211,111,-211,8*0,111,-211,
11213 &111,-211,4*0,111,-211,111,-211,11*0,-211,6*0,111,211,4*0,111/
11214 DATA (KFDP(I,3),I= 945,2000)/13*0,2*111,211,-211,211,-211,7*0,
11215 &-211,111,13*0,2*21,-211,111,6*0,2212,3122,3212,3214,2112,2114,
11216 &2212,2112,3122,3212,3214,2112,2114,2212,2112,52*0,3*3,1,8*0,
11217 &3*4122,8*0,4,1,4,3,2*2,3*0,2112,43*0,3322,861*0/
11218 DATA (KFDP(I,4),I= 1,2000)/88*0,3*111,8*0,-211,0,-211,3*0,111,
11219 &2*-211,0,111,0,2*111,113,221,111,-213,-211,211,195*0,13*81,41*0,
11220 &111,211,111,211,7*0,111,211,111,211,35*0,2*-211,2*111,211,111,
11221 &-211,2*211,2*-211,2*0,-211,111,-211,111,4*0,-211,111,-211,111,
11222 &34*0,111,-211,3*111,3*-211,2*111,3*-211,4*0,-321,-311,3*0,-321,
11223 &-311,20*0,-3,31*0,6*1,30*0,6*2,33*0,6*3,9*0,8*4,4*0,4*-5,4*0,
11224 &2*-5,7*0,-11,264*0,111,-211,4*0,111,57*0,-211,111,5*0,-211,111,
11225 &52*0,2101,2103,2*2101,19*0,6*2101,909*0/
11226 DATA (KFDP(I,5),I= 1,2000)/90*0,111,16*0,111,7*0,111,0,2*111,
11227 &303*0,-211,2*111,-211,111,-211,111,54*0,111,-211,3*111,-211,111,
11228 &1510*0/
11229
11230
11231 DATA (CHAF(I) ,I= 1, 281)/'d','u','s','c','b','t','l','h',
11232 &2*' ','e','nu_e','mu','nu_mu','tau','nu_tau','chi','nu_chi',
11233 &2*' ','g','gamma','Z','W','H',2*' ','reggeon','pomeron',2*' ',
11234 &'Z''','Z"','W''','H''','A','H','eta_tech','LQ_ue','R',40*' ',
11235 &'specflav','rndmflav','phasespa','c-hadron','b-hadron',
11236 &'t-hadron','l-hadron','h-hadron','Wvirt','diquark','cluster',
11237 &'string','indep.','CMshower','SPHEaxis','THRUaxis','CLUSjet',
11238 &'CELLjet','table',' ','pi',2*'K',2*'D','D_s',2*'B','B_s','B_c',
11239 &'pi','eta','eta''','eta_c','eta_b','eta_t','eta_l','eta_h',2*' ',
11240 &'rho',2*'K*',2*'D*','D*_s',2*'B*','B*_s','B*_c','rho','omega',
11241 &'phi','J/psi','Upsilon','Theta','Theta_l','Theta_h',2*' ','b_1',
11242 &2*'K_1',2*'D_1','D_1s',2*'B_1','B_1s','B_1c','b_1','h_1','h''_1',
11243 &'h_1c','h_1b','h_1t','h_1l','h_1h',2*' ','a_0',2*'K*_0',2*'D*_0',
11244 &'D*_0s',2*'B*_0','B*_0s','B*_0c','a_0','f_0','f''_0','chi_0c',
11245 &'chi_0b','chi_0t','chi_0l','chi_0h',2*' ','a_1',2*'K*_1',
11246 &2*'D*_1','D*_1s',2*'B*_1','B*_1s','B*_1c','a_1','f_1','f''_1',
11247 &'chi_1c','chi_1b','chi_1t','chi_1l','chi_1h',2*' ','a_2',
11248 &2*'K*_2',2*'D*_2','D*_2s',2*'B*_2','B*_2s','B*_2c','a_2','f_2',
11249 &'f''_2','chi_2c','chi_2b','chi_2t','chi_2l','chi_2h',2*' ','K_L',
11250 &'K_S',8*' ','psi''',3*' ','Upsilon''',45*' ','pi_diffr'/
11251 DATA (CHAF(I) ,I= 282, 500)/'n_diffr','p_diffr','rho_diff',
11252 &'omega_di','phi_diff','J/psi_di',18*' ','Lambda',5*' ',
11253 &'Lambda_c',' ',2*'Xi_c',6*' ','Lambda_b',' ',2*'Xi_b',6*' ','n',
11254 &'p',' ',3*'Sigma',2*'Xi',' ',3*'Sigma_c',2*'Xi''_c','Omega_c',
11255 &4*' ',3*'Sigma_b',2*'Xi''_b','Omega_b',4*' ',4*'Delta',
11256 &3*'Sigma*',2*'Xi*','Omega',3*'Sigma*_c',2*'Xi*_c','Omega*_c',
11257 &4*' ',3*'Sigma*_b',2*'Xi*_b','Omega*_b',114*' '/
11258
11259
11260 DATA MRLU/19780503,0,0,97,33,0/
11261
11262 END
11263
11264
