File indexing completed on 2023-10-25 09:48:33
0001
0002
0003
0004
0005
0006
0007
0008
0009
0010
0011
0012
0013
0014
0015
0016 SUBROUTINE LU1ENT(IP,KF,PE,THE,PHI)
0017
0018
0019 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
0020 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0021 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
0022 SAVE
0023
0024
0025 MSTU(28)=0
0026 IF(MSTU(12).GE.1) CALL LULIST(0)
0027 IPA=MAX(1,IABS(IP))
0028 IF(IPA.GT.MSTU(4)) CALL LUERRM(21,
0029 &'(LU1ENT:) writing outside LUJETS memory')
0030 KC=LUCOMP(KF)
0031 IF(KC.EQ.0) CALL LUERRM(12,'(LU1ENT:) unknown flavour code')
0032
0033
0034 PM=0.
0035 IF(MSTU(10).EQ.1) PM=P(IPA,5)
0036 IF(MSTU(10).GE.2) PM=ULMASS(KF)
0037 DO 100 J=1,5
0038 K(IPA,J)=0
0039 P(IPA,J)=0.
0040 100 V(IPA,J)=0.
0041
0042
0043 K(IPA,1)=1
0044 IF(IP.LT.0) K(IPA,1)=2
0045 K(IPA,2)=KF
0046 P(IPA,5)=PM
0047 P(IPA,4)=MAX(PE,PM)
0048 PA=SQRT(P(IPA,4)**2-P(IPA,5)**2)
0049 P(IPA,1)=PA*SIN(THE)*COS(PHI)
0050 P(IPA,2)=PA*SIN(THE)*SIN(PHI)
0051 P(IPA,3)=PA*COS(THE)
0052
0053
0054 N=IPA
0055 IF(IP.EQ.0) CALL LUEXEC
0056
0057 RETURN
0058 END
0059
0060
0061
0062 SUBROUTINE LU2ENT(IP,KF1,KF2,PECM)
0063
0064
0065
0066 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
0067 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0068 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
0069 SAVE
0070
0071
0072 MSTU(28)=0
0073 IF(MSTU(12).GE.1) CALL LULIST(0)
0074 IPA=MAX(1,IABS(IP))
0075 IF(IPA.GT.MSTU(4)-1) CALL LUERRM(21,
0076 &'(LU2ENT:) writing outside LUJETS memory')
0077 KC1=LUCOMP(KF1)
0078 KC2=LUCOMP(KF2)
0079 IF(KC1.EQ.0.OR.KC2.EQ.0) CALL LUERRM(12,
0080 &'(LU2ENT:) unknown flavour code')
0081
0082
0083 PM1=0.
0084 IF(MSTU(10).EQ.1) PM1=P(IPA,5)
0085 IF(MSTU(10).GE.2) PM1=ULMASS(KF1)
0086 PM2=0.
0087 IF(MSTU(10).EQ.1) PM2=P(IPA+1,5)
0088 IF(MSTU(10).GE.2) PM2=ULMASS(KF2)
0089 DO 100 I=IPA,IPA+1
0090 DO 100 J=1,5
0091 K(I,J)=0
0092 P(I,J)=0.
0093 100 V(I,J)=0.
0094
0095
0096 KQ1=KCHG(KC1,2)*ISIGN(1,KF1)
0097 KQ2=KCHG(KC2,2)*ISIGN(1,KF2)
0098 IF(KQ1+KQ2.NE.0.AND.KQ1+KQ2.NE.4) CALL LUERRM(2,
0099 &'(LU2ENT:) unphysical flavour combination')
0100 K(IPA,2)=KF1
0101 K(IPA+1,2)=KF2
0102
0103
0104 IF(IP.GE.0) THEN
0105 K(IPA,1)=1
0106 IF(KQ1.NE.0.AND.KQ2.NE.0) K(IPA,1)=2
0107 K(IPA+1,1)=1
0108
0109
0110 ELSE
0111 IF(KQ1.EQ.0.OR.KQ2.EQ.0) CALL LUERRM(2,
0112 & '(LU2ENT:) requested flavours can not develop parton shower')
0113 K(IPA,1)=3
0114 K(IPA+1,1)=3
0115 K(IPA,4)=MSTU(5)*(IPA+1)
0116 K(IPA,5)=K(IPA,4)
0117 K(IPA+1,4)=MSTU(5)*IPA
0118 K(IPA+1,5)=K(IPA+1,4)
0119 ENDIF
0120
0121
0122 IF(PECM.LE.PM1+PM2) CALL LUERRM(13,
0123 &'(LU2ENT:) energy smaller than sum of masses')
0124 PA=SQRT(MAX(0.,(PECM**2-PM1**2-PM2**2)**2-(2.*PM1*PM2)**2))/
0125 &(2.*PECM)
0126 P(IPA,3)=PA
0127 P(IPA,4)=SQRT(PM1**2+PA**2)
0128 P(IPA,5)=PM1
0129 P(IPA+1,3)=-PA
0130 P(IPA+1,4)=SQRT(PM2**2+PA**2)
0131 P(IPA+1,5)=PM2
0132
0133
0134 N=IPA+1
0135 IF(IP.EQ.0) CALL LUEXEC
0136
0137 RETURN
0138 END
0139
0140
0141
0142 SUBROUTINE LU3ENT(IP,KF1,KF2,KF3,PECM,X1,X3)
0143
0144
0145
0146
0147 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
0148 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0149 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
0150 SAVE
0151
0152
0153 MSTU(28)=0
0154 IF(MSTU(12).GE.1) CALL LULIST(0)
0155 IPA=MAX(1,IABS(IP))
0156 IF(IPA.GT.MSTU(4)-2) CALL LUERRM(21,
0157 &'(LU3ENT:) writing outside LUJETS memory')
0158 KC1=LUCOMP(KF1)
0159 KC2=LUCOMP(KF2)
0160 KC3=LUCOMP(KF3)
0161 IF(KC1.EQ.0.OR.KC2.EQ.0.OR.KC3.EQ.0) CALL LUERRM(12,
0162 &'(LU3ENT:) unknown flavour code')
0163
0164
0165 PM1=0.
0166 IF(MSTU(10).EQ.1) PM1=P(IPA,5)
0167 IF(MSTU(10).GE.2) PM1=ULMASS(KF1)
0168 PM2=0.
0169 IF(MSTU(10).EQ.1) PM2=P(IPA+1,5)
0170 IF(MSTU(10).GE.2) PM2=ULMASS(KF2)
0171 PM3=0.
0172 IF(MSTU(10).EQ.1) PM3=P(IPA+2,5)
0173 IF(MSTU(10).GE.2) PM3=ULMASS(KF3)
0174 DO 100 I=IPA,IPA+2
0175 DO 100 J=1,5
0176 K(I,J)=0
0177 P(I,J)=0.
0178 100 V(I,J)=0.
0179
0180
0181 KQ1=KCHG(KC1,2)*ISIGN(1,KF1)
0182 KQ2=KCHG(KC2,2)*ISIGN(1,KF2)
0183 KQ3=KCHG(KC3,2)*ISIGN(1,KF3)
0184 IF(KQ1.EQ.0.AND.KQ2.EQ.0.AND.KQ3.EQ.0) THEN
0185 ELSEIF(KQ1.NE.0.AND.KQ2.EQ.2.AND.(KQ1+KQ3.EQ.0.OR.KQ1+KQ3.EQ.4))
0186 &THEN
0187 ELSE
0188 CALL LUERRM(2,'(LU3ENT:) unphysical flavour combination')
0189 ENDIF
0190 K(IPA,2)=KF1
0191 K(IPA+1,2)=KF2
0192 K(IPA+2,2)=KF3
0193
0194
0195 IF(IP.GE.0) THEN
0196 K(IPA,1)=1
0197 IF(KQ1.NE.0.AND.(KQ2.NE.0.OR.KQ3.NE.0)) K(IPA,1)=2
0198 K(IPA+1,1)=1
0199 IF(KQ2.NE.0.AND.KQ3.NE.0) K(IPA+1,1)=2
0200 K(IPA+2,1)=1
0201
0202
0203 ELSE
0204 IF(KQ1.EQ.0.OR.KQ2.EQ.0.OR.KQ3.EQ.0) CALL LUERRM(2,
0205 & '(LU3ENT:) requested flavours can not develop parton shower')
0206 K(IPA,1)=3
0207 K(IPA+1,1)=3
0208 K(IPA+2,1)=3
0209 KCS=4
0210 IF(KQ1.EQ.-1) KCS=5
0211 K(IPA,KCS)=MSTU(5)*(IPA+1)
0212 K(IPA,9-KCS)=MSTU(5)*(IPA+2)
0213 K(IPA+1,KCS)=MSTU(5)*(IPA+2)
0214 K(IPA+1,9-KCS)=MSTU(5)*IPA
0215 K(IPA+2,KCS)=MSTU(5)*IPA
0216 K(IPA+2,9-KCS)=MSTU(5)*(IPA+1)
0217 ENDIF
0218
0219
0220 MKERR=0
0221 IF(0.5*X1*PECM.LE.PM1.OR.0.5*(2.-X1-X3)*PECM.LE.PM2.OR.
0222 &0.5*X3*PECM.LE.PM3) MKERR=1
0223 PA1=SQRT(MAX(0.,(0.5*X1*PECM)**2-PM1**2))
0224 PA2=SQRT(MAX(0.,(0.5*(2.-X1-X3)*PECM)**2-PM2**2))
0225 PA3=SQRT(MAX(0.,(0.5*X3*PECM)**2-PM3**2))
0226 CTHE2=(PA3**2-PA1**2-PA2**2)/(2.*PA1*PA2)
0227 CTHE3=(PA2**2-PA1**2-PA3**2)/(2.*PA1*PA3)
0228 IF(ABS(CTHE2).GE.1.001.OR.ABS(CTHE3).GE.1.001) MKERR=1
0229 CTHE3=MAX(-1.,MIN(1.,CTHE3))
0230 IF(MKERR.NE.0) CALL LUERRM(13,
0231 &'(LU3ENT:) unphysical kinematical variable setup')
0232
0233
0234 P(IPA,3)=PA1
0235 P(IPA,4)=SQRT(PA1**2+PM1**2)
0236 P(IPA,5)=PM1
0237 P(IPA+2,1)=PA3*SQRT(1.-CTHE3**2)
0238 P(IPA+2,3)=PA3*CTHE3
0239 P(IPA+2,4)=SQRT(PA3**2+PM3**2)
0240 P(IPA+2,5)=PM3
0241 P(IPA+1,1)=-P(IPA+2,1)
0242 P(IPA+1,3)=-P(IPA,3)-P(IPA+2,3)
0243 P(IPA+1,4)=SQRT(P(IPA+1,1)**2+P(IPA+1,3)**2+PM2**2)
0244 P(IPA+1,5)=PM2
0245
0246
0247 N=IPA+2
0248 IF(IP.EQ.0) CALL LUEXEC
0249
0250 RETURN
0251 END
0252
0253
0254
0255 SUBROUTINE LU4ENT(IP,KF1,KF2,KF3,KF4,PECM,X1,X2,X4,X12,X14)
0256
0257
0258
0259
0260 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
0261 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0262 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
0263 SAVE
0264
0265
0266 MSTU(28)=0
0267 IF(MSTU(12).GE.1) CALL LULIST(0)
0268 IPA=MAX(1,IABS(IP))
0269 IF(IPA.GT.MSTU(4)-3) CALL LUERRM(21,
0270 &'(LU4ENT:) writing outside LUJETS momory')
0271 KC1=LUCOMP(KF1)
0272 KC2=LUCOMP(KF2)
0273 KC3=LUCOMP(KF3)
0274 KC4=LUCOMP(KF4)
0275 IF(KC1.EQ.0.OR.KC2.EQ.0.OR.KC3.EQ.0.OR.KC4.EQ.0) CALL LUERRM(12,
0276 &'(LU4ENT:) unknown flavour code')
0277
0278
0279 PM1=0.
0280 IF(MSTU(10).EQ.1) PM1=P(IPA,5)
0281 IF(MSTU(10).GE.2) PM1=ULMASS(KF1)
0282 PM2=0.
0283 IF(MSTU(10).EQ.1) PM2=P(IPA+1,5)
0284 IF(MSTU(10).GE.2) PM2=ULMASS(KF2)
0285 PM3=0.
0286 IF(MSTU(10).EQ.1) PM3=P(IPA+2,5)
0287 IF(MSTU(10).GE.2) PM3=ULMASS(KF3)
0288 PM4=0.
0289 IF(MSTU(10).EQ.1) PM4=P(IPA+3,5)
0290 IF(MSTU(10).GE.2) PM4=ULMASS(KF4)
0291 DO 100 I=IPA,IPA+3
0292 DO 100 J=1,5
0293 K(I,J)=0
0294 P(I,J)=0.
0295 100 V(I,J)=0.
0296
0297
0298 KQ1=KCHG(KC1,2)*ISIGN(1,KF1)
0299 KQ2=KCHG(KC2,2)*ISIGN(1,KF2)
0300 KQ3=KCHG(KC3,2)*ISIGN(1,KF3)
0301 KQ4=KCHG(KC4,2)*ISIGN(1,KF4)
0302 IF(KQ1.EQ.0.AND.KQ2.EQ.0.AND.KQ3.EQ.0.AND.KQ4.EQ.0) THEN
0303 ELSEIF(KQ1.NE.0.AND.KQ2.EQ.2.AND.KQ3.EQ.2.AND.(KQ1+KQ4.EQ.0.OR.
0304 &KQ1+KQ4.EQ.4)) THEN
0305 ELSEIF(KQ1.NE.0.AND.KQ1+KQ2.EQ.0.AND.KQ3.NE.0.AND.KQ3+KQ4.EQ.0.)
0306 &THEN
0307 ELSE
0308 CALL LUERRM(2,'(LU4ENT:) unphysical flavour combination')
0309 ENDIF
0310 K(IPA,2)=KF1
0311 K(IPA+1,2)=KF2
0312 K(IPA+2,2)=KF3
0313 K(IPA+3,2)=KF4
0314
0315
0316 IF(IP.GE.0) THEN
0317 K(IPA,1)=1
0318 IF(KQ1.NE.0.AND.(KQ2.NE.0.OR.KQ3.NE.0.OR.KQ4.NE.0)) K(IPA,1)=2
0319 K(IPA+1,1)=1
0320 IF(KQ2.NE.0.AND.KQ1+KQ2.NE.0.AND.(KQ3.NE.0.OR.KQ4.NE.0))
0321 & K(IPA+1,1)=2
0322 K(IPA+2,1)=1
0323 IF(KQ3.NE.0.AND.KQ4.NE.0) K(IPA+2,1)=2
0324 K(IPA+3,1)=1
0325
0326
0327
0328 ELSEIF(KQ1+KQ2.NE.0) THEN
0329 IF(KQ1.EQ.0.OR.KQ2.EQ.0.OR.KQ3.EQ.0.OR.KQ4.EQ.0) CALL LUERRM(2,
0330 & '(LU4ENT:) requested flavours can not develop parton shower')
0331 K(IPA,1)=3
0332 K(IPA+1,1)=3
0333 K(IPA+2,1)=3
0334 K(IPA+3,1)=3
0335 KCS=4
0336 IF(KQ1.EQ.-1) KCS=5
0337 K(IPA,KCS)=MSTU(5)*(IPA+1)
0338 K(IPA,9-KCS)=MSTU(5)*(IPA+3)
0339 K(IPA+1,KCS)=MSTU(5)*(IPA+2)
0340 K(IPA+1,9-KCS)=MSTU(5)*IPA
0341 K(IPA+2,KCS)=MSTU(5)*(IPA+3)
0342 K(IPA+2,9-KCS)=MSTU(5)*(IPA+1)
0343 K(IPA+3,KCS)=MSTU(5)*IPA
0344 K(IPA+3,9-KCS)=MSTU(5)*(IPA+2)
0345
0346
0347 ELSE
0348 IF(KQ1.EQ.0.OR.KQ2.EQ.0.OR.KQ3.EQ.0.OR.KQ4.EQ.0) CALL LUERRM(2,
0349 & '(LU4ENT:) requested flavours can not develop parton shower')
0350 K(IPA,1)=3
0351 K(IPA+1,1)=3
0352 K(IPA+2,1)=3
0353 K(IPA+3,1)=3
0354 K(IPA,4)=MSTU(5)*(IPA+1)
0355 K(IPA,5)=K(IPA,4)
0356 K(IPA+1,4)=MSTU(5)*IPA
0357 K(IPA+1,5)=K(IPA+1,4)
0358 K(IPA+2,4)=MSTU(5)*(IPA+3)
0359 K(IPA+2,5)=K(IPA+2,4)
0360 K(IPA+3,4)=MSTU(5)*(IPA+2)
0361 K(IPA+3,5)=K(IPA+3,4)
0362 ENDIF
0363
0364
0365 MKERR=0
0366 IF(0.5*X1*PECM.LE.PM1.OR.0.5*X2*PECM.LE.PM2.OR.0.5*(2.-X1-X2-X4)*
0367 &PECM.LE.PM3.OR.0.5*X4*PECM.LE.PM4) MKERR=1
0368 PA1=SQRT(MAX(0.,(0.5*X1*PECM)**2-PM1**2))
0369 PA2=SQRT(MAX(0.,(0.5*X2*PECM)**2-PM2**2))
0370 PA3=SQRT(MAX(0.,(0.5*(2.-X1-X2-X4)*PECM)**2-PM3**2))
0371 PA4=SQRT(MAX(0.,(0.5*X4*PECM)**2-PM4**2))
0372 X24=X1+X2+X4-1.-X12-X14+(PM3**2-PM1**2-PM2**2-PM4**2)/PECM**2
0373 CTHE4=(X1*X4-2.*X14)*PECM**2/(4.*PA1*PA4)
0374 IF(ABS(CTHE4).GE.1.002) MKERR=1
0375 CTHE4=MAX(-1.,MIN(1.,CTHE4))
0376 STHE4=SQRT(1.-CTHE4**2)
0377 CTHE2=(X1*X2-2.*X12)*PECM**2/(4.*PA1*PA2)
0378 IF(ABS(CTHE2).GE.1.002) MKERR=1
0379 CTHE2=MAX(-1.,MIN(1.,CTHE2))
0380 STHE2=SQRT(1.-CTHE2**2)
0381 CPHI2=((X2*X4-2.*X24)*PECM**2-4.*PA2*CTHE2*PA4*CTHE4)/
0382 &(4.*PA2*STHE2*PA4*STHE4)
0383 IF(ABS(CPHI2).GE.1.05) MKERR=1
0384 CPHI2=MAX(-1.,MIN(1.,CPHI2))
0385 IF(MKERR.EQ.1) CALL LUERRM(13,
0386 &'(LU4ENT:) unphysical kinematical variable setup')
0387
0388
0389 P(IPA,3)=PA1
0390 P(IPA,4)=SQRT(PA1**2+PM1**2)
0391 P(IPA,5)=PM1
0392 P(IPA+3,1)=PA4*STHE4
0393 P(IPA+3,3)=PA4*CTHE4
0394 P(IPA+3,4)=SQRT(PA4**2+PM4**2)
0395 P(IPA+3,5)=PM4
0396 P(IPA+1,1)=PA2*STHE2*CPHI2
0397 P(IPA+1,2)=PA2*STHE2*SQRT(1.-CPHI2**2)*(-1.)**INT(RLU(0)+0.5)
0398 P(IPA+1,3)=PA2*CTHE2
0399 P(IPA+1,4)=SQRT(PA2**2+PM2**2)
0400 P(IPA+1,5)=PM2
0401 P(IPA+2,1)=-P(IPA+1,1)-P(IPA+3,1)
0402 P(IPA+2,2)=-P(IPA+1,2)
0403 P(IPA+2,3)=-P(IPA,3)-P(IPA+1,3)-P(IPA+3,3)
0404 P(IPA+2,4)=SQRT(P(IPA+2,1)**2+P(IPA+2,2)**2+P(IPA+2,3)**2+PM3**2)
0405 P(IPA+2,5)=PM3
0406
0407
0408 N=IPA+3
0409 IF(IP.EQ.0) CALL LUEXEC
0410
0411 RETURN
0412 END
0413
0414
0415
0416 SUBROUTINE LUJOIN(NJOIN,IJOIN)
0417
0418
0419
0420 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
0421 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0422 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
0423 DIMENSION IJOIN(*)
0424 SAVE
0425
0426
0427 IF(NJOIN.LT.2) GOTO 120
0428 KQSUM=0
0429 DO 100 IJN=1,NJOIN
0430 I=IJOIN(IJN)
0431 IF(I.LE.0.OR.I.GT.N) GOTO 120
0432 IF(K(I,1).LT.1.OR.K(I,1).GT.3) GOTO 120
0433 KC=LUCOMP(K(I,2))
0434 IF(KC.EQ.0) GOTO 120
0435 KQ=KCHG(KC,2)*ISIGN(1,K(I,2))
0436 IF(KQ.EQ.0) GOTO 120
0437 IF(IJN.NE.1.AND.IJN.NE.NJOIN.AND.KQ.NE.2) GOTO 120
0438 IF(KQ.NE.2) KQSUM=KQSUM+KQ
0439 100 IF(IJN.EQ.1) KQS=KQ
0440 IF(KQSUM.NE.0) GOTO 120
0441
0442
0443 KCS=(9-KQS)/2
0444 IF(KQS.EQ.2) KCS=INT(4.5+RLU(0))
0445 DO 110 IJN=1,NJOIN
0446 I=IJOIN(IJN)
0447 K(I,1)=3
0448 IF(IJN.NE.1) IP=IJOIN(IJN-1)
0449 IF(IJN.EQ.1) IP=IJOIN(NJOIN)
0450 IF(IJN.NE.NJOIN) IN=IJOIN(IJN+1)
0451 IF(IJN.EQ.NJOIN) IN=IJOIN(1)
0452 K(I,KCS)=MSTU(5)*IN
0453 K(I,9-KCS)=MSTU(5)*IP
0454 IF(IJN.EQ.1.AND.KQS.NE.2) K(I,9-KCS)=0
0455 110 IF(IJN.EQ.NJOIN.AND.KQS.NE.2) K(I,KCS)=0
0456
0457
0458 RETURN
0459 120 CALL LUERRM(12,
0460 &'(LUJOIN:) given entries can not be joined by one string')
0461
0462 RETURN
0463 END
0464
0465
0466
0467 SUBROUTINE LUGIVE(CHIN)
0468
0469
0470 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
0471 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0472 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
0473 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
0474 COMMON/LUDAT4/CHAF(500)
0475 CHARACTER CHAF*8
0476 CHARACTER CHIN*(*),CHFIX*104,CHBIT*104,CHOLD*8,CHNEW*8,
0477 &CHNAM*4,CHVAR(17)*4,CHALP(2)*26,CHIND*8,CHINI*10,CHINR*16
0478 SAVE
0479 DATA CHVAR/'N','K','P','V','MSTU','PARU','MSTJ','PARJ','KCHG',
0480 &'PMAS','PARF','VCKM','MDCY','MDME','BRAT','KFDP','CHAF'/
0481 DATA CHALP/'abcdefghijklmnopqrstuvwxyz',
0482 &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
0483
0484
0485 IF(MSTU(12).GE.1) CALL LULIST(0)
0486 CHBIT=CHIN//' '
0487 LBIT=101
0488 100 LBIT=LBIT-1
0489 IF(CHBIT(LBIT:LBIT).EQ.' ') GOTO 100
0490 LTOT=0
0491 DO 110 LCOM=1,LBIT
0492 IF(CHBIT(LCOM:LCOM).EQ.' ') GOTO 110
0493 LTOT=LTOT+1
0494 CHFIX(LTOT:LTOT)=CHBIT(LCOM:LCOM)
0495 110 CONTINUE
0496 LLOW=0
0497 120 LHIG=LLOW+1
0498 130 LHIG=LHIG+1
0499 IF(LHIG.LE.LTOT.AND.CHFIX(LHIG:LHIG).NE.';') GOTO 130
0500 LBIT=LHIG-LLOW-1
0501 CHBIT(1:LBIT)=CHFIX(LLOW+1:LHIG-1)
0502
0503
0504 LNAM=1
0505 140 LNAM=LNAM+1
0506 IF(CHBIT(LNAM:LNAM).NE.'('.AND.CHBIT(LNAM:LNAM).NE.'='.AND.
0507 &LNAM.LE.4) GOTO 140
0508 CHNAM=CHBIT(1:LNAM-1)//' '
0509 DO 150 LCOM=1,LNAM-1
0510 DO 150 LALP=1,26
0511 150 IF(CHNAM(LCOM:LCOM).EQ.CHALP(1)(LALP:LALP)) CHNAM(LCOM:LCOM)=
0512 &CHALP(2)(LALP:LALP)
0513 IVAR=0
0514 DO 160 IV=1,17
0515 160 IF(CHNAM.EQ.CHVAR(IV)) IVAR=IV
0516 IF(IVAR.EQ.0) THEN
0517 CALL LUERRM(18,'(LUGIVE:) do not recognize variable '//CHNAM)
0518 LLOW=LHIG
0519 IF(LLOW.LT.LTOT) GOTO 120
0520 RETURN
0521 ENDIF
0522
0523
0524 I=0
0525 J=0
0526 IF(CHBIT(LNAM:LNAM).EQ.'(') THEN
0527 LIND=LNAM
0528 170 LIND=LIND+1
0529 IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 170
0530 CHIND=' '
0531 IF((CHBIT(LNAM+1:LNAM+1).EQ.'C'.OR.CHBIT(LNAM+1:LNAM+1).EQ.'c').
0532 & AND.(IVAR.EQ.9.OR.IVAR.EQ.10.OR.IVAR.EQ.13.OR.IVAR.EQ.17)) THEN
0533 CHIND(LNAM-LIND+11:8)=CHBIT(LNAM+2:LIND-1)
0534 READ(CHIND,'(I8)') I1
0535 I=LUCOMP(I1)
0536 ELSE
0537 CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1)
0538 READ(CHIND,'(I8)') I
0539 ENDIF
0540 LNAM=LIND
0541 IF(CHBIT(LNAM:LNAM).EQ.')') LNAM=LNAM+1
0542 ENDIF
0543 IF(CHBIT(LNAM:LNAM).EQ.',') THEN
0544 LIND=LNAM
0545 180 LIND=LIND+1
0546 IF(CHBIT(LIND:LIND).NE.')'.AND.CHBIT(LIND:LIND).NE.',') GOTO 180
0547 CHIND=' '
0548 CHIND(LNAM-LIND+10:8)=CHBIT(LNAM+1:LIND-1)
0549 READ(CHIND,'(I8)') J
0550 LNAM=LIND+1
0551 ENDIF
0552
0553
0554 IERR=1
0555 IF(CHBIT(LNAM:LNAM).NE.'=') GOTO 190
0556 IF(IVAR.EQ.1) THEN
0557 IF(I.NE.0.OR.J.NE.0) GOTO 190
0558 IOLD=N
0559 ELSEIF(IVAR.EQ.2) THEN
0560 IF(I.LT.1.OR.I.GT.MSTU(4).OR.J.LT.1.OR.J.GT.5) GOTO 190
0561 IOLD=K(I,J)
0562 ELSEIF(IVAR.EQ.3) THEN
0563 IF(I.LT.1.OR.I.GT.MSTU(4).OR.J.LT.1.OR.J.GT.5) GOTO 190
0564 ROLD=P(I,J)
0565 ELSEIF(IVAR.EQ.4) THEN
0566 IF(I.LT.1.OR.I.GT.MSTU(4).OR.J.LT.1.OR.J.GT.5) GOTO 190
0567 ROLD=V(I,J)
0568 ELSEIF(IVAR.EQ.5) THEN
0569 IF(I.LT.1.OR.I.GT.200.OR.J.NE.0) GOTO 190
0570 IOLD=MSTU(I)
0571 ELSEIF(IVAR.EQ.6) THEN
0572 IF(I.LT.1.OR.I.GT.200.OR.J.NE.0) GOTO 190
0573 ROLD=PARU(I)
0574 ELSEIF(IVAR.EQ.7) THEN
0575 IF(I.LT.1.OR.I.GT.200.OR.J.NE.0) GOTO 190
0576 IOLD=MSTJ(I)
0577 ELSEIF(IVAR.EQ.8) THEN
0578 IF(I.LT.1.OR.I.GT.200.OR.J.NE.0) GOTO 190
0579 ROLD=PARJ(I)
0580 ELSEIF(IVAR.EQ.9) THEN
0581 IF(I.LT.1.OR.I.GT.MSTU(6).OR.J.LT.1.OR.J.GT.3) GOTO 190
0582 IOLD=KCHG(I,J)
0583 ELSEIF(IVAR.EQ.10) THEN
0584 IF(I.LT.1.OR.I.GT.MSTU(6).OR.J.LT.1.OR.J.GT.4) GOTO 190
0585 ROLD=PMAS(I,J)
0586 ELSEIF(IVAR.EQ.11) THEN
0587 IF(I.LT.1.OR.I.GT.2000.OR.J.NE.0) GOTO 190
0588 ROLD=PARF(I)
0589 ELSEIF(IVAR.EQ.12) THEN
0590 IF(I.LT.1.OR.I.GT.4.OR.J.LT.1.OR.J.GT.4) GOTO 190
0591 ROLD=VCKM(I,J)
0592 ELSEIF(IVAR.EQ.13) THEN
0593 IF(I.LT.1.OR.I.GT.MSTU(6).OR.J.LT.1.OR.J.GT.3) GOTO 190
0594 IOLD=MDCY(I,J)
0595 ELSEIF(IVAR.EQ.14) THEN
0596 IF(I.LT.1.OR.I.GT.MSTU(7).OR.J.LT.1.OR.J.GT.2) GOTO 190
0597 IOLD=MDME(I,J)
0598 ELSEIF(IVAR.EQ.15) THEN
0599 IF(I.LT.1.OR.I.GT.MSTU(7).OR.J.NE.0) GOTO 190
0600 ROLD=BRAT(I)
0601 ELSEIF(IVAR.EQ.16) THEN
0602 IF(I.LT.1.OR.I.GT.MSTU(7).OR.J.LT.1.OR.J.GT.5) GOTO 190
0603 IOLD=KFDP(I,J)
0604 ELSEIF(IVAR.EQ.17) THEN
0605 IF(I.LT.1.OR.I.GT.MSTU(6).OR.J.NE.0) GOTO 190
0606 CHOLD=CHAF(I)
0607 ENDIF
0608 IERR=0
0609 190 IF(IERR.EQ.1) THEN
0610 CALL LUERRM(18,'(LUGIVE:) unallowed indices for '//
0611 & CHBIT(1:LNAM-1))
0612 LLOW=LHIG
0613 IF(LLOW.LT.LTOT) GOTO 120
0614 RETURN
0615 ENDIF
0616
0617
0618 IF(LNAM.GE.LBIT) THEN
0619 CHBIT(LNAM:14)=' '
0620 CHBIT(15:60)=' has the value '
0621 IF(IVAR.EQ.1.OR.IVAR.EQ.2.OR.IVAR.EQ.5.OR.IVAR.EQ.7.OR.
0622 & IVAR.EQ.9.OR.IVAR.EQ.13.OR.IVAR.EQ.14.OR.IVAR.EQ.16) THEN
0623 WRITE(CHBIT(51:60),'(I10)') IOLD
0624 ELSEIF(IVAR.NE.17) THEN
0625 WRITE(CHBIT(47:60),'(F14.5)') ROLD
0626 ELSE
0627 CHBIT(53:60)=CHOLD
0628 ENDIF
0629 IF(MSTU(13).GE.1) WRITE(MSTU(11),1000) CHBIT(1:60)
0630 LLOW=LHIG
0631 IF(LLOW.LT.LTOT) GOTO 120
0632 RETURN
0633 ENDIF
0634
0635
0636 IF(IVAR.EQ.1.OR.IVAR.EQ.2.OR.IVAR.EQ.5.OR.IVAR.EQ.7.OR.
0637 &IVAR.EQ.9.OR.IVAR.EQ.13.OR.IVAR.EQ.14.OR.IVAR.EQ.16) THEN
0638 CHINI=' '
0639 CHINI(LNAM-LBIT+11:10)=CHBIT(LNAM+1:LBIT)
0640 READ(CHINI,'(I10)') INEW
0641 ELSEIF(IVAR.NE.17) THEN
0642 CHINR=' '
0643 CHINR(LNAM-LBIT+17:16)=CHBIT(LNAM+1:LBIT)
0644 READ(CHINR,'(F16.2)') RNEW
0645 ELSE
0646 CHNEW=CHBIT(LNAM+1:LBIT)//' '
0647 ENDIF
0648
0649
0650 IF(IVAR.EQ.1) THEN
0651 N=INEW
0652 ELSEIF(IVAR.EQ.2) THEN
0653 K(I,J)=INEW
0654 ELSEIF(IVAR.EQ.3) THEN
0655 P(I,J)=RNEW
0656 ELSEIF(IVAR.EQ.4) THEN
0657 V(I,J)=RNEW
0658 ELSEIF(IVAR.EQ.5) THEN
0659 MSTU(I)=INEW
0660 ELSEIF(IVAR.EQ.6) THEN
0661 PARU(I)=RNEW
0662 ELSEIF(IVAR.EQ.7) THEN
0663 MSTJ(I)=INEW
0664 ELSEIF(IVAR.EQ.8) THEN
0665 PARJ(I)=RNEW
0666 ELSEIF(IVAR.EQ.9) THEN
0667 KCHG(I,J)=INEW
0668 ELSEIF(IVAR.EQ.10) THEN
0669 PMAS(I,J)=RNEW
0670 ELSEIF(IVAR.EQ.11) THEN
0671 PARF(I)=RNEW
0672 ELSEIF(IVAR.EQ.12) THEN
0673 VCKM(I,J)=RNEW
0674 ELSEIF(IVAR.EQ.13) THEN
0675 MDCY(I,J)=INEW
0676 ELSEIF(IVAR.EQ.14) THEN
0677 MDME(I,J)=INEW
0678 ELSEIF(IVAR.EQ.15) THEN
0679 BRAT(I)=RNEW
0680 ELSEIF(IVAR.EQ.16) THEN
0681 KFDP(I,J)=INEW
0682 ELSEIF(IVAR.EQ.17) THEN
0683 CHAF(I)=CHNEW
0684 ENDIF
0685
0686
0687 CHBIT(LNAM:14)=' '
0688 CHBIT(15:60)=' changed from to '
0689 IF(IVAR.EQ.1.OR.IVAR.EQ.2.OR.IVAR.EQ.5.OR.IVAR.EQ.7.OR.
0690 &IVAR.EQ.9.OR.IVAR.EQ.13.OR.IVAR.EQ.14.OR.IVAR.EQ.16) THEN
0691 WRITE(CHBIT(33:42),'(I10)') IOLD
0692 WRITE(CHBIT(51:60),'(I10)') INEW
0693 ELSEIF(IVAR.NE.17) THEN
0694 WRITE(CHBIT(29:42),'(F14.5)') ROLD
0695 WRITE(CHBIT(47:60),'(F14.5)') RNEW
0696 ELSE
0697 CHBIT(35:42)=CHOLD
0698 CHBIT(53:60)=CHNEW
0699 ENDIF
0700 IF(MSTU(13).GE.1) WRITE(MSTU(11),1000) CHBIT(1:60)
0701 LLOW=LHIG
0702 IF(LLOW.LT.LTOT) GOTO 120
0703
0704
0705 1000 FORMAT(5X,A60)
0706
0707 RETURN
0708 END
0709
0710
0711
0712 SUBROUTINE LUEXEC
0713
0714
0715 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
0716 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0717 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
0718 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
0719 DIMENSION PS(2,6)
0720 SAVE
0721
0722
0723 MSTU(24)=0
0724 IF(MSTU(12).GE.1) CALL LULIST(0)
0725 MSTU(31)=MSTU(31)+1
0726 MSTU(1)=0
0727 MSTU(2)=0
0728 MSTU(3)=0
0729 MCONS=1
0730
0731
0732 NSAV=N
0733 DO 100 I=1,2
0734 DO 100 J=1,6
0735 100 PS(I,J)=0.
0736 DO 120 I=1,N
0737 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 120
0738 DO 110 J=1,4
0739 110 PS(1,J)=PS(1,J)+P(I,J)
0740 PS(1,6)=PS(1,6)+LUCHGE(K(I,2))
0741 120 CONTINUE
0742 PARU(21)=PS(1,4)
0743
0744
0745 CALL LUPREP(0)
0746
0747
0748 MBE=0
0749 130 MBE=MBE+1
0750 IP=0
0751 140 IP=IP+1
0752 KC=0
0753 IF(K(IP,1).GT.0.AND.K(IP,1).LE.10) KC=LUCOMP(K(IP,2))
0754 IF(KC.EQ.0) THEN
0755
0756
0757
0758 ELSEIF(KCHG(KC,2).EQ.0) THEN
0759 IF(MSTJ(21).GE.1.AND.MDCY(KC,1).GE.1.AND.(MSTJ(51).LE.0.OR.MBE.
0760 & EQ.2.OR.PMAS(KC,2).GE.PARJ(91).OR.IABS(K(IP,2)).EQ.311))
0761 & CALL LUDECY(IP)
0762
0763
0764 IF(MSTJ(92).GT.0) THEN
0765 IP1=MSTJ(92)
0766 QMAX=SQRT(MAX(0.,(P(IP1,4)+P(IP1+1,4))**2-(P(IP1,1)+P(IP1+1,
0767 & 1))**2-(P(IP1,2)+P(IP1+1,2))**2-(P(IP1,3)+P(IP1+1,3))**2))
0768 CALL LUSHOW(IP1,IP1+1,QMAX)
0769 CALL LUPREP(IP1)
0770 MSTJ(92)=0
0771 ELSEIF(MSTJ(92).LT.0) THEN
0772 IP1=-MSTJ(92)
0773 CALL LUSHOW(IP1,-3,P(IP,5))
0774 CALL LUPREP(IP1)
0775 MSTJ(92)=0
0776 ENDIF
0777
0778
0779 ELSEIF(K(IP,1).EQ.1.OR.K(IP,1).EQ.2) THEN
0780 MFRAG=MSTJ(1)
0781 IF(MFRAG.GE.1.AND.K(IP,1).EQ.1) MFRAG=2
0782 IF(MSTJ(21).GE.2.AND.K(IP,1).EQ.2.AND.N.GT.IP) THEN
0783 IF(K(IP+1,1).EQ.1.AND.K(IP+1,3).EQ.K(IP,3).AND.
0784 & K(IP,3).GT.0.AND.K(IP,3).LT.IP) THEN
0785 IF(KCHG(LUCOMP(K(K(IP,3),2)),2).EQ.0) MFRAG=MIN(1,MFRAG)
0786 ENDIF
0787 ENDIF
0788 IF(MFRAG.EQ.1) CALL LUSTRF(IP)
0789 IF(MFRAG.EQ.2) CALL LUINDF(IP)
0790 IF(MFRAG.EQ.2.AND.K(IP,1).EQ.1) MCONS=0
0791 IF(MFRAG.EQ.2.AND.(MSTJ(3).LE.0.OR.MOD(MSTJ(3),5).EQ.0)) MCONS=0
0792 ENDIF
0793
0794
0795 IF(MSTU(24).NE.0.AND.MSTU(21).GE.2) THEN
0796 ELSEIF(IP.LT.N.AND.N.LT.MSTU(4)-20-MSTU(32)) THEN
0797 GOTO 140
0798 ELSEIF(IP.LT.N) THEN
0799 CALL LUERRM(11,'(LUEXEC:) no more memory left in LUJETS')
0800 ENDIF
0801
0802
0803 IF(MBE.EQ.1.AND.MSTJ(51).GE.1) THEN
0804 CALL LUBOEI(NSAV)
0805 GOTO 130
0806 ENDIF
0807
0808
0809 DO 160 I=1,N
0810 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 160
0811 DO 150 J=1,4
0812 150 PS(2,J)=PS(2,J)+P(I,J)
0813 PS(2,6)=PS(2,6)+LUCHGE(K(I,2))
0814 160 CONTINUE
0815 PDEV=(ABS(PS(2,1)-PS(1,1))+ABS(PS(2,2)-PS(1,2))+ABS(PS(2,3)-
0816 &PS(1,3))+ABS(PS(2,4)-PS(1,4)))/(1.+ABS(PS(2,4))+ABS(PS(1,4)))
0817 IF(MCONS.EQ.1.AND.PDEV.GT.PARU(11)) CALL LUERRM(15,
0818 &'(LUEXEC:) four-momentum was not conserved')
0819 IF(MCONS.EQ.1.AND.ABS(PS(2,6)-PS(1,6)).GT.0.1) CALL LUERRM(15,
0820 &'(LUEXEC:) charge was not conserved')
0821
0822 RETURN
0823 END
0824
0825
0826
0827 SUBROUTINE LUPREP(IP)
0828
0829
0830
0831 IMPLICIT DOUBLE PRECISION(D)
0832 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
0833 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0834 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
0835 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
0836 DIMENSION DPS(5),DPC(5),UE(3)
0837 SAVE
0838
0839
0840 I1=N
0841 DO 130 MQGST=1,2
0842 DO 120 I=MAX(1,IP),N
0843 IF(K(I,1).NE.3) GOTO 120
0844 KC=LUCOMP(K(I,2))
0845 IF(KC.EQ.0) GOTO 120
0846 KQ=KCHG(KC,2)
0847 IF(KQ.EQ.0.OR.(MQGST.EQ.1.AND.KQ.EQ.2)) GOTO 120
0848
0849
0850 KCS=4
0851 IF(KQ*ISIGN(1,K(I,2)).LT.0) KCS=5
0852 IA=I
0853 NSTP=0
0854 100 NSTP=NSTP+1
0855 IF(NSTP.GT.4*N) THEN
0856 CALL LUERRM(14,'(LUPREP:) caught in infinite loop')
0857 RETURN
0858 ENDIF
0859
0860
0861 IF(K(IA,1).EQ.3) THEN
0862 IF(I1.GE.MSTU(4)-MSTU(32)-5) THEN
0863 CALL LUERRM(11,'(LUPREP:) no more memory left in LUJETS')
0864 RETURN
0865 ENDIF
0866 I1=I1+1
0867 K(I1,1)=2
0868 IF(NSTP.GE.2.AND.IABS(K(IA,2)).NE.21) K(I1,1)=1
0869 K(I1,2)=K(IA,2)
0870 K(I1,3)=IA
0871 K(I1,4)=0
0872 K(I1,5)=0
0873 DO 110 J=1,5
0874 P(I1,J)=P(IA,J)
0875 110 V(I1,J)=V(IA,J)
0876 K(IA,1)=K(IA,1)+10
0877 IF(K(I1,1).EQ.1) GOTO 120
0878 ENDIF
0879
0880
0881 IB=IA
0882 IF(MOD(K(IB,KCS)/MSTU(5)**2,2).EQ.0.AND.MOD(K(IB,KCS),MSTU(5)).
0883 &NE.0) THEN
0884 IA=MOD(K(IB,KCS),MSTU(5))
0885 K(IB,KCS)=K(IB,KCS)+MSTU(5)**2
0886 MREV=0
0887 ELSE
0888 IF(K(IB,KCS).GE.2*MSTU(5)**2.OR.MOD(K(IB,KCS)/MSTU(5),MSTU(5)).
0889 & EQ.0) KCS=9-KCS
0890 IA=MOD(K(IB,KCS)/MSTU(5),MSTU(5))
0891 K(IB,KCS)=K(IB,KCS)+2*MSTU(5)**2
0892 MREV=1
0893 ENDIF
0894 IF(IA.LE.0.OR.IA.GT.N) THEN
0895 CALL LUERRM(12,'(LUPREP:) colour rearrangement failed')
0896 RETURN
0897 ENDIF
0898 IF(MOD(K(IA,4)/MSTU(5),MSTU(5)).EQ.IB.OR.MOD(K(IA,5)/MSTU(5),
0899 &MSTU(5)).EQ.IB) THEN
0900 IF(MREV.EQ.1) KCS=9-KCS
0901 IF(MOD(K(IA,KCS)/MSTU(5),MSTU(5)).NE.IB) KCS=9-KCS
0902 K(IA,KCS)=K(IA,KCS)+2*MSTU(5)**2
0903 ELSE
0904 IF(MREV.EQ.0) KCS=9-KCS
0905 IF(MOD(K(IA,KCS),MSTU(5)).NE.IB) KCS=9-KCS
0906 K(IA,KCS)=K(IA,KCS)+MSTU(5)**2
0907 ENDIF
0908 IF(IA.NE.I) GOTO 100
0909 K(I1,1)=1
0910 120 CONTINUE
0911 130 CONTINUE
0912 N=I1
0913
0914
0915 IF(MSTJ(14).LE.0) GOTO 320
0916 NS=N
0917 140 NSIN=N-NS
0918 PDM=1.+PARJ(32)
0919 IC=0
0920 DO 190 I=MAX(1,IP),NS
0921 IF(K(I,1).NE.1.AND.K(I,1).NE.2) THEN
0922 ELSEIF(K(I,1).EQ.2.AND.IC.EQ.0) THEN
0923 NSIN=NSIN+1
0924 IC=I
0925 DO 150 J=1,4
0926 150 DPS(J)=P(I,J)
0927 MSTJ(93)=1
0928 DPS(5)=ULMASS(K(I,2))
0929 ELSEIF(K(I,1).EQ.2) THEN
0930 DO 160 J=1,4
0931 160 DPS(J)=DPS(J)+P(I,J)
0932 ELSEIF(IC.NE.0.AND.KCHG(LUCOMP(K(I,2)),2).NE.0) THEN
0933 DO 170 J=1,4
0934 170 DPS(J)=DPS(J)+P(I,J)
0935 MSTJ(93)=1
0936 DPS(5)=DPS(5)+ULMASS(K(I,2))
0937 PD=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2))-DPS(5)
0938 IF(PD.LT.PDM) THEN
0939 PDM=PD
0940 DO 180 J=1,5
0941 180 DPC(J)=DPS(J)
0942 IC1=IC
0943 IC2=I
0944 ENDIF
0945 IC=0
0946 ELSE
0947 NSIN=NSIN+1
0948 ENDIF
0949 190 CONTINUE
0950 IF(PDM.GE.PARJ(32)) GOTO 320
0951
0952
0953 NSAV=N
0954 PECM=SQRT(MAX(0D0,DPC(4)**2-DPC(1)**2-DPC(2)**2-DPC(3)**2))
0955 K(N+1,1)=11
0956 K(N+1,2)=91
0957 K(N+1,3)=IC1
0958 K(N+1,4)=N+2
0959 K(N+1,5)=N+3
0960 P(N+1,1)=DPC(1)
0961 P(N+1,2)=DPC(2)
0962 P(N+1,3)=DPC(3)
0963 P(N+1,4)=DPC(4)
0964 P(N+1,5)=PECM
0965
0966
0967 K(N+2,1)=1
0968 K(N+3,1)=1
0969 IF(MSTU(16).NE.2) THEN
0970 K(N+2,3)=N+1
0971 K(N+3,3)=N+1
0972 ELSE
0973 K(N+2,3)=IC1
0974 K(N+3,3)=IC2
0975 ENDIF
0976 K(N+2,4)=0
0977 K(N+3,4)=0
0978 K(N+2,5)=0
0979 K(N+3,5)=0
0980 IF(IABS(K(IC1,2)).NE.21) THEN
0981 KC1=LUCOMP(K(IC1,2))
0982 KC2=LUCOMP(K(IC2,2))
0983 IF(KC1.EQ.0.OR.KC2.EQ.0) GOTO 320
0984 KQ1=KCHG(KC1,2)*ISIGN(1,K(IC1,2))
0985 KQ2=KCHG(KC2,2)*ISIGN(1,K(IC2,2))
0986 IF(KQ1+KQ2.NE.0) GOTO 320
0987 200 CALL LUKFDI(K(IC1,2),0,KFLN,K(N+2,2))
0988 CALL LUKFDI(K(IC2,2),-KFLN,KFLDMP,K(N+3,2))
0989 IF(K(N+2,2).EQ.0.OR.K(N+3,2).EQ.0) GOTO 200
0990 ELSE
0991 IF(IABS(K(IC2,2)).NE.21) GOTO 320
0992 210 CALL LUKFDI(1+INT((2.+PARJ(2))*RLU(0)),0,KFLN,KFDMP)
0993 CALL LUKFDI(KFLN,0,KFLM,K(N+2,2))
0994 CALL LUKFDI(-KFLN,-KFLM,KFLDMP,K(N+3,2))
0995 IF(K(N+2,2).EQ.0.OR.K(N+3,2).EQ.0) GOTO 210
0996 ENDIF
0997 P(N+2,5)=ULMASS(K(N+2,2))
0998 P(N+3,5)=ULMASS(K(N+3,2))
0999 IF(P(N+2,5)+P(N+3,5)+PARJ(64).GE.PECM.AND.NSIN.EQ.1) GOTO 320
1000 IF(P(N+2,5)+P(N+3,5)+PARJ(64).GE.PECM) GOTO 260
1001
1002
1003 IF(PECM.GE.0.02*DPC(4)) THEN
1004 PA=SQRT((PECM**2-(P(N+2,5)+P(N+3,5))**2)*(PECM**2-
1005 & (P(N+2,5)-P(N+3,5))**2))/(2.*PECM)
1006 UE(3)=2.*RLU(0)-1.
1007 PHI=PARU(2)*RLU(0)
1008 UE(1)=SQRT(1.-UE(3)**2)*COS(PHI)
1009 UE(2)=SQRT(1.-UE(3)**2)*SIN(PHI)
1010 DO 220 J=1,3
1011 P(N+2,J)=PA*UE(J)
1012 220 P(N+3,J)=-PA*UE(J)
1013 P(N+2,4)=SQRT(PA**2+P(N+2,5)**2)
1014 P(N+3,4)=SQRT(PA**2+P(N+3,5)**2)
1015 CALL LUDBRB(N+2,N+3,0.,0.,DPC(1)/DPC(4),DPC(2)/DPC(4),
1016 & DPC(3)/DPC(4))
1017 ELSE
1018 NP=0
1019 DO 230 I=IC1,IC2
1020 230 IF(K(I,1).EQ.1.OR.K(I,1).EQ.2) NP=NP+1
1021 HA=P(IC1,4)*P(IC2,4)-P(IC1,1)*P(IC2,1)-P(IC1,2)*P(IC2,2)-
1022 & P(IC1,3)*P(IC2,3)
1023 IF(NP.GE.3.OR.HA.LE.1.25*P(IC1,5)*P(IC2,5)) GOTO 260
1024 HD1=0.5*(P(N+2,5)**2-P(IC1,5)**2)
1025 HD2=0.5*(P(N+3,5)**2-P(IC2,5)**2)
1026 HR=SQRT(MAX(0.,((HA-HD1-HD2)**2-(P(N+2,5)*P(N+3,5))**2)/
1027 & (HA**2-(P(IC1,5)*P(IC2,5))**2)))-1.
1028 HC=P(IC1,5)**2+2.*HA+P(IC2,5)**2
1029 HK1=((P(IC2,5)**2+HA)*HR+HD1-HD2)/HC
1030 HK2=((P(IC1,5)**2+HA)*HR+HD2-HD1)/HC
1031 DO 240 J=1,4
1032 P(N+2,J)=(1.+HK1)*P(IC1,J)-HK2*P(IC2,J)
1033 240 P(N+3,J)=(1.+HK2)*P(IC2,J)-HK1*P(IC1,J)
1034 ENDIF
1035 DO 250 J=1,4
1036 V(N+1,J)=V(IC1,J)
1037 V(N+2,J)=V(IC1,J)
1038 250 V(N+3,J)=V(IC2,J)
1039 V(N+1,5)=0.
1040 V(N+2,5)=0.
1041 V(N+3,5)=0.
1042 N=N+3
1043 GOTO 300
1044
1045
1046 260 K(N+1,5)=N+2
1047 IF(IABS(K(IC1,2)).GT.100.AND.IABS(K(IC2,2)).GT.100) THEN
1048 GOTO 320
1049 ELSEIF(IABS(K(IC1,2)).NE.21) THEN
1050 CALL LUKFDI(K(IC1,2),K(IC2,2),KFLDMP,K(N+2,2))
1051 ELSE
1052 KFLN=1+INT((2.+PARJ(2))*RLU(0))
1053 CALL LUKFDI(KFLN,-KFLN,KFLDMP,K(N+2,2))
1054 ENDIF
1055 IF(K(N+2,2).EQ.0) GOTO 260
1056 P(N+2,5)=ULMASS(K(N+2,2))
1057
1058
1059 IR=0
1060 HA=0.
1061 DO 280 MCOMB=1,3
1062 IF(IR.NE.0) GOTO 280
1063 DO 270 I=MAX(1,IP),N
1064 IF(K(I,1).LE.0.OR.K(I,1).GT.10.OR.(I.GE.IC1.AND.I.LE.IC2.
1065 &AND.K(I,1).GE.1.AND.K(I,1).LE.2)) GOTO 270
1066 IF(MCOMB.EQ.1) KCI=LUCOMP(K(I,2))
1067 IF(MCOMB.EQ.1.AND.KCI.EQ.0) GOTO 270
1068 IF(MCOMB.EQ.1.AND.KCHG(KCI,2).EQ.0.AND.I.LE.NS) GOTO 270
1069 IF(MCOMB.EQ.2.AND.IABS(K(I,2)).GT.10.AND.IABS(K(I,2)).LE.100)
1070 &GOTO 270
1071 HCR=DPC(4)*P(I,4)-DPC(1)*P(I,1)-DPC(2)*P(I,2)-DPC(3)*P(I,3)
1072 IF(HCR.GT.HA) THEN
1073 IR=I
1074 HA=HCR
1075 ENDIF
1076 270 CONTINUE
1077 280 CONTINUE
1078
1079
1080 HB=PECM**2+HA
1081 HC=P(N+2,5)**2+HA
1082 HD=P(IR,5)**2+HA
1083
1084 HK2=0.0
1085 IF(HA**2-(PECM*P(IR,5))**2.EQ.0.0.OR.HB+HD.EQ.0.0) GO TO 285
1086
1087 HK2=0.5*(HB*SQRT(((HB+HC)**2-4.*(HB+HD)*P(N+2,5)**2)/
1088 &(HA**2-(PECM*P(IR,5))**2))-(HB+HC))/(HB+HD)
1089 285 HK1=(0.5*(P(N+2,5)**2-PECM**2)+HD*HK2)/HB
1090 DO 290 J=1,4
1091 P(N+2,J)=(1.+HK1)*DPC(J)-HK2*P(IR,J)
1092 P(IR,J)=(1.+HK2)*P(IR,J)-HK1*DPC(J)
1093 V(N+1,J)=V(IC1,J)
1094 290 V(N+2,J)=V(IC1,J)
1095 V(N+1,5)=0.
1096 V(N+2,5)=0.
1097 N=N+2
1098
1099
1100 300 DO 310 I=IC1,IC2
1101 IF((K(I,1).EQ.1.OR.K(I,1).EQ.2).AND.KCHG(LUCOMP(K(I,2)),2).NE.0)
1102 &THEN
1103 K(I,1)=K(I,1)+10
1104 IF(MSTU(16).NE.2) THEN
1105 K(I,4)=NSAV+1
1106 K(I,5)=NSAV+1
1107 ELSE
1108 K(I,4)=NSAV+2
1109 K(I,5)=N
1110 ENDIF
1111 ENDIF
1112 310 CONTINUE
1113 IF(N.LT.MSTU(4)-MSTU(32)-5) GOTO 140
1114
1115
1116 320 NP=0
1117 KFN=0
1118 KQS=0
1119 DO 330 J=1,5
1120 330 DPS(J)=0.
1121 DO 360 I=MAX(1,IP),N
1122 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 360
1123 KC=LUCOMP(K(I,2))
1124 IF(KC.EQ.0) GOTO 360
1125 KQ=KCHG(KC,2)*ISIGN(1,K(I,2))
1126 IF(KQ.EQ.0) GOTO 360
1127 NP=NP+1
1128 IF(KQ.NE.2) THEN
1129 KFN=KFN+1
1130 KQS=KQS+KQ
1131 MSTJ(93)=1
1132 DPS(5)=DPS(5)+ULMASS(K(I,2))
1133 ENDIF
1134 DO 340 J=1,4
1135 340 DPS(J)=DPS(J)+P(I,J)
1136 IF(K(I,1).EQ.1) THEN
1137 IF(NP.NE.1.AND.(KFN.EQ.1.OR.KFN.GE.3.OR.KQS.NE.0)) CALL
1138 & LUERRM(2,'(LUPREP:) unphysical flavour combination')
1139 IF(NP.NE.1.AND.DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2.LT.
1140 & (0.9*PARJ(32)+DPS(5))**2) CALL LUERRM(3,
1141 & '(LUPREP:) too small mass in jet system')
1142 NP=0
1143 KFN=0
1144 KQS=0
1145 DO 350 J=1,5
1146 350 DPS(J)=0.
1147 ENDIF
1148 360 CONTINUE
1149
1150 RETURN
1151 END
1152
1153
1154
1155 SUBROUTINE LUSTRF(IP)
1156
1157
1158 IMPLICIT DOUBLE PRECISION(D)
1159 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
1160 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
1161 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
1162 DIMENSION DPS(5),KFL(3),PMQ(3),PX(3),PY(3),GAM(3),IE(2),PR(2),
1163 &IN(9),DHM(4),DHG(4),DP(5,5),IRANK(2),MJU(4),IJU(3),PJU(5,5),
1164 &TJU(5),KFJH(2),NJS(2),KFJS(2),PJS(4,5)
1165 SAVE
1166
1167
1168 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)
1169 DFOUR(I,J)=DP(I,4)*DP(J,4)-DP(I,1)*DP(J,1)-DP(I,2)*DP(J,2)-
1170 &DP(I,3)*DP(J,3)
1171
1172
1173 MSTJ(91)=0
1174 NSAV=N
1175 NP=0
1176 KQSUM=0
1177 DO 100 J=1,5
1178 100 DPS(J)=0.
1179 MJU(1)=0
1180 MJU(2)=0
1181 I=IP-1
1182 110 I=I+1
1183 IF(I.GT.MIN(N,MSTU(4)-MSTU(32))) THEN
1184 CALL LUERRM(12,'(LUSTRF:) failed to reconstruct jet system')
1185 IF(MSTU(21).GE.1) RETURN
1186 ENDIF
1187 IF(K(I,1).NE.1.AND.K(I,1).NE.2.AND.K(I,1).NE.41) GOTO 110
1188 KC=LUCOMP(K(I,2))
1189 IF(KC.EQ.0) GOTO 110
1190 KQ=KCHG(KC,2)*ISIGN(1,K(I,2))
1191 IF(KQ.EQ.0) GOTO 110
1192 IF(N+5*NP+11.GT.MSTU(4)-MSTU(32)-5) THEN
1193 CALL LUERRM(11,'(LUSTRF:) no more memory left in LUJETS')
1194 IF(MSTU(21).GE.1) RETURN
1195 ENDIF
1196
1197
1198 NP=NP+1
1199 DO 120 J=1,5
1200 K(N+NP,J)=K(I,J)
1201 P(N+NP,J)=P(I,J)
1202 120 DPS(J)=DPS(J)+P(I,J)
1203 K(N+NP,3)=I
1204 IF(P(N+NP,4)**2.LT.P(N+NP,1)**2+P(N+NP,2)**2+P(N+NP,3)**2) THEN
1205 P(N+NP,4)=SQRT(P(N+NP,1)**2+P(N+NP,2)**2+P(N+NP,3)**2+
1206 & P(N+NP,5)**2)
1207 DPS(4)=DPS(4)+MAX(0.,P(N+NP,4)-P(I,4))
1208 ENDIF
1209 IF(KQ.NE.2) KQSUM=KQSUM+KQ
1210 IF(K(I,1).EQ.41) THEN
1211 KQSUM=KQSUM+2*KQ
1212 IF(KQSUM.EQ.KQ) MJU(1)=N+NP
1213 IF(KQSUM.NE.KQ) MJU(2)=N+NP
1214 ENDIF
1215 IF(K(I,1).EQ.2.OR.K(I,1).EQ.41) GOTO 110
1216 IF(KQSUM.NE.0) THEN
1217 CALL LUERRM(12,'(LUSTRF:) unphysical flavour combination')
1218 IF(MSTU(21).GE.1) RETURN
1219 ENDIF
1220
1221
1222 CALL LUDBRB(N+1,N+NP,0.,0.,-DPS(1)/DPS(4),-DPS(2)/DPS(4),
1223 &-DPS(3)/DPS(4))
1224
1225
1226 NTRYR=0
1227 PARU12=PARU(12)
1228 PARU13=PARU(13)
1229 MJU(3)=MJU(1)
1230 MJU(4)=MJU(2)
1231 NR=NP
1232 130 IF(NR.GE.3) THEN
1233 PDRMIN=2.*PARU12
1234 DO 140 I=N+1,N+NR
1235 IF(I.EQ.N+NR.AND.IABS(K(N+1,2)).NE.21) GOTO 140
1236 I1=I+1
1237 IF(I.EQ.N+NR) I1=N+1
1238 IF(K(I,1).EQ.41.OR.K(I1,1).EQ.41) GOTO 140
1239 IF(MJU(1).NE.0.AND.I1.LT.MJU(1).AND.IABS(K(I1,2)).NE.21)
1240 & GOTO 140
1241 IF(MJU(2).NE.0.AND.I.GT.MJU(2).AND.IABS(K(I,2)).NE.21) GOTO 140
1242 PAP=SQRT((P(I,1)**2+P(I,2)**2+P(I,3)**2)*(P(I1,1)**2+
1243 & P(I1,2)**2+P(I1,3)**2))
1244 PVP=P(I,1)*P(I1,1)+P(I,2)*P(I1,2)+P(I,3)*P(I1,3)
1245 PDR=4.*(PAP-PVP)**2/(PARU13**2*PAP+2.*(PAP-PVP))
1246 IF(PDR.LT.PDRMIN) THEN
1247 IR=I
1248 PDRMIN=PDR
1249 ENDIF
1250 140 CONTINUE
1251
1252
1253 IF(PDRMIN.LT.PARU12.AND.IR.EQ.N+NR) THEN
1254 DO 150 J=1,4
1255 150 P(N+1,J)=P(N+1,J)+P(N+NR,J)
1256 P(N+1,5)=SQRT(MAX(0.,P(N+1,4)**2-P(N+1,1)**2-P(N+1,2)**2-
1257 & P(N+1,3)**2))
1258 NR=NR-1
1259 GOTO 130
1260 ELSEIF(PDRMIN.LT.PARU12) THEN
1261 DO 160 J=1,4
1262 160 P(IR,J)=P(IR,J)+P(IR+1,J)
1263 P(IR,5)=SQRT(MAX(0.,P(IR,4)**2-P(IR,1)**2-P(IR,2)**2-
1264 & P(IR,3)**2))
1265 DO 170 I=IR+1,N+NR-1
1266 K(I,2)=K(I+1,2)
1267 DO 170 J=1,5
1268 170 P(I,J)=P(I+1,J)
1269 IF(IR.EQ.N+NR-1) K(IR,2)=K(N+NR,2)
1270 NR=NR-1
1271 IF(MJU(1).GT.IR) MJU(1)=MJU(1)-1
1272 IF(MJU(2).GT.IR) MJU(2)=MJU(2)-1
1273 GOTO 130
1274 ENDIF
1275 ENDIF
1276 NTRYR=NTRYR+1
1277
1278
1279
1280 NRS=MAX(5*NR+11,NP)
1281 NTRY=0
1282 180 NTRY=NTRY+1
1283 IF(NTRY.GT.100.AND.NTRYR.LE.4) THEN
1284 PARU12=4.*PARU12
1285 PARU13=2.*PARU13
1286 GOTO 130
1287 ELSEIF(NTRY.GT.100) THEN
1288 CALL LUERRM(14,'(LUSTRF:) caught in infinite loop')
1289 IF(MSTU(21).GE.1) RETURN
1290 ENDIF
1291 I=N+NRS
1292 IF(MJU(1).EQ.0.AND.MJU(2).EQ.0) GOTO 500
1293 DO 490 JT=1,2
1294 NJS(JT)=0
1295 IF(MJU(JT).EQ.0) GOTO 490
1296 JS=3-2*JT
1297
1298
1299 DO 190 IU=1,3
1300 IJU(IU)=0
1301 DO 190 J=1,5
1302 190 PJU(IU,J)=0.
1303 IU=0
1304 DO 200 I1=N+1+(JT-1)*(NR-1),N+NR+(JT-1)*(1-NR),JS
1305 IF(K(I1,2).NE.21.AND.IU.LE.2) THEN
1306 IU=IU+1
1307 IJU(IU)=I1
1308 ENDIF
1309 DO 200 J=1,4
1310 200 PJU(IU,J)=PJU(IU,J)+P(I1,J)
1311 DO 210 IU=1,3
1312 210 PJU(IU,5)=SQRT(PJU(IU,1)**2+PJU(IU,2)**2+PJU(IU,3)**2)
1313 IF(K(IJU(3),2)/100.NE.10*K(IJU(1),2)+K(IJU(2),2).AND.
1314 &K(IJU(3),2)/100.NE.10*K(IJU(2),2)+K(IJU(1),2)) THEN
1315 CALL LUERRM(12,'(LUSTRF:) unphysical flavour combination')
1316 IF(MSTU(21).GE.1) RETURN
1317 ENDIF
1318
1319
1320 T12=(PJU(1,1)*PJU(2,1)+PJU(1,2)*PJU(2,2)+PJU(1,3)*PJU(2,3))/
1321 &(PJU(1,5)*PJU(2,5))
1322 T13=(PJU(1,1)*PJU(3,1)+PJU(1,2)*PJU(3,2)+PJU(1,3)*PJU(3,3))/
1323 &(PJU(1,5)*PJU(3,5))
1324 T23=(PJU(2,1)*PJU(3,1)+PJU(2,2)*PJU(3,2)+PJU(2,3)*PJU(3,3))/
1325 &(PJU(2,5)*PJU(3,5))
1326 T11=SQRT((2./3.)*(1.-T12)*(1.-T13)/(1.-T23))
1327 T22=SQRT((2./3.)*(1.-T12)*(1.-T23)/(1.-T13))
1328 TSQ=SQRT((2.*T11*T22+T12-1.)*(1.+T12))
1329 T1F=(TSQ-T22*(1.+T12))/(1.-T12**2)
1330 T2F=(TSQ-T11*(1.+T12))/(1.-T12**2)
1331 DO 220 J=1,3
1332 220 TJU(J)=-(T1F*PJU(1,J)/PJU(1,5)+T2F*PJU(2,J)/PJU(2,5))
1333 TJU(4)=SQRT(1.+TJU(1)**2+TJU(2)**2+TJU(3)**2)
1334 DO 230 IU=1,3
1335 230 PJU(IU,5)=TJU(4)*PJU(IU,4)-TJU(1)*PJU(IU,1)-TJU(2)*PJU(IU,2)-
1336 &TJU(3)*PJU(IU,3)
1337
1338
1339 IF(PJU(1,5)+PJU(2,5).GT.PJU(1,4)+PJU(2,4)) THEN
1340 DO 240 J=1,3
1341 240 TJU(J)=0.
1342 TJU(4)=1.
1343 PJU(1,5)=PJU(1,4)
1344 PJU(2,5)=PJU(2,4)
1345 PJU(3,5)=PJU(3,4)
1346 ENDIF
1347
1348
1349 ISTA=I
1350 DO 470 IU=1,2
1351 NS=IJU(IU+1)-IJU(IU)
1352
1353
1354 DO 260 IS=1,NS
1355 IS1=IJU(IU)+IS-1
1356 IS2=IJU(IU)+IS
1357 DO 250 J=1,5
1358 DP(1,J)=0.5*P(IS1,J)
1359 IF(IS.EQ.1) DP(1,J)=P(IS1,J)
1360 DP(2,J)=0.5*P(IS2,J)
1361 250 IF(IS.EQ.NS) DP(2,J)=-PJU(IU,J)
1362 IF(IS.EQ.NS) DP(2,4)=SQRT(PJU(IU,1)**2+PJU(IU,2)**2+PJU(IU,3)**2)
1363 IF(IS.EQ.NS) DP(2,5)=0.
1364 DP(3,5)=DFOUR(1,1)
1365 DP(4,5)=DFOUR(2,2)
1366 DHKC=DFOUR(1,2)
1367 IF(DP(3,5)+2.*DHKC+DP(4,5).LE.0.) THEN
1368 DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2)
1369 DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2)
1370 DP(3,5)=0D0
1371 DP(4,5)=0D0
1372 DHKC=DFOUR(1,2)
1373 ENDIF
1374 DHKS=SQRT(DHKC**2-DP(3,5)*DP(4,5))
1375 DHK1=0.5*((DP(4,5)+DHKC)/DHKS-1.)
1376 DHK2=0.5*((DP(3,5)+DHKC)/DHKS-1.)
1377 IN1=N+NR+4*IS-3
1378 P(IN1,5)=SQRT(DP(3,5)+2.*DHKC+DP(4,5))
1379 DO 260 J=1,4
1380 P(IN1,J)=(1.+DHK1)*DP(1,J)-DHK2*DP(2,J)
1381 260 P(IN1+1,J)=(1.+DHK2)*DP(2,J)-DHK1*DP(1,J)
1382
1383
1384 ISAV=I
1385 270 NTRY=NTRY+1
1386 IF(NTRY.GT.100.AND.NTRYR.LE.4) THEN
1387 PARU12=4.*PARU12
1388 PARU13=2.*PARU13
1389 GOTO 130
1390 ELSEIF(NTRY.GT.100) THEN
1391 CALL LUERRM(14,'(LUSTRF:) caught in infinite loop')
1392 IF(MSTU(21).GE.1) RETURN
1393 ENDIF
1394 I=ISAV
1395 IRANKJ=0
1396 IE(1)=K(N+1+(JT/2)*(NP-1),3)
1397 IN(4)=N+NR+1
1398 IN(5)=IN(4)+1
1399 IN(6)=N+NR+4*NS+1
1400 DO 280 JQ=1,2
1401 DO 280 IN1=N+NR+2+JQ,N+NR+4*NS-2+JQ,4
1402 P(IN1,1)=2-JQ
1403 P(IN1,2)=JQ-1
1404 280 P(IN1,3)=1.
1405 KFL(1)=K(IJU(IU),2)
1406 PX(1)=0.
1407 PY(1)=0.
1408 GAM(1)=0.
1409 DO 290 J=1,5
1410 290 PJU(IU+3,J)=0.
1411
1412
1413 DO 300 J=1,4
1414 DP(1,J)=P(IN(4),J)
1415 DP(2,J)=P(IN(4)+1,J)
1416 DP(3,J)=0.
1417 300 DP(4,J)=0.
1418 DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2)
1419 DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2)
1420 DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4)
1421 DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4)
1422 DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4)
1423 IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1.
1424 IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1.
1425 IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1.
1426 IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1.
1427 DHC12=DFOUR(1,2)
1428 DHCX1=DFOUR(3,1)/DHC12
1429 DHCX2=DFOUR(3,2)/DHC12
1430 DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12)
1431 DHCY1=DFOUR(4,1)/DHC12
1432 DHCY2=DFOUR(4,2)/DHC12
1433 DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12
1434 DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2)
1435 DO 310 J=1,4
1436 DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J))
1437 P(IN(6),J)=DP(3,J)
1438 310 P(IN(6)+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)-
1439 &DHCYX*DP(3,J))
1440
1441
1442 320 I=I+1
1443 IF(2*I-NSAV.GE.MSTU(4)-MSTU(32)-5) THEN
1444 CALL LUERRM(11,'(LUSTRF:) no more memory left in LUJETS')
1445 IF(MSTU(21).GE.1) RETURN
1446 ENDIF
1447 IRANKJ=IRANKJ+1
1448 K(I,1)=1
1449 K(I,3)=IE(1)
1450 K(I,4)=0
1451 K(I,5)=0
1452
1453
1454 330 CALL LUKFDI(KFL(1),0,KFL(3),K(I,2))
1455 IF(K(I,2).EQ.0) GOTO 270
1456 IF(MSTJ(12).GE.3.AND.IRANKJ.EQ.1.AND.IABS(KFL(1)).LE.10.AND.
1457 &IABS(KFL(3)).GT.10) THEN
1458 IF(RLU(0).GT.PARJ(19)) GOTO 330
1459 ENDIF
1460 P(I,5)=ULMASS(K(I,2))
1461 CALL LUPTDI(KFL(1),PX(3),PY(3))
1462 PR(1)=P(I,5)**2+(PX(1)+PX(3))**2+(PY(1)+PY(3))**2
1463 CALL LUZDIS(KFL(1),KFL(3),PR(1),Z)
1464 GAM(3)=(1.-Z)*(GAM(1)+PR(1)/Z)
1465 DO 340 J=1,3
1466 340 IN(J)=IN(3+J)
1467
1468
1469 IF(IN(1)+1.EQ.IN(2).AND.Z*P(IN(1)+2,3)*P(IN(2)+2,3)*
1470 &P(IN(1),5)**2.GE.PR(1)) THEN
1471 P(IN(1)+2,4)=Z*P(IN(1)+2,3)
1472 P(IN(2)+2,4)=PR(1)/(P(IN(1)+2,4)*P(IN(1),5)**2)
1473 DO 350 J=1,4
1474 350 P(I,J)=(PX(1)+PX(3))*P(IN(3),J)+(PY(1)+PY(3))*P(IN(3)+1,J)
1475 GOTO 420
1476 ELSEIF(IN(1)+1.EQ.IN(2)) THEN
1477 P(IN(2)+2,4)=P(IN(2)+2,3)
1478 P(IN(2)+2,1)=1.
1479 IN(2)=IN(2)+4
1480 IF(IN(2).GT.N+NR+4*NS) GOTO 270
1481 IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN
1482 P(IN(1)+2,4)=P(IN(1)+2,3)
1483 P(IN(1)+2,1)=0.
1484 IN(1)=IN(1)+4
1485 ENDIF
1486 ENDIF
1487
1488
1489 360 IF(IN(1).GT.N+NR+4*NS.OR.IN(2).GT.N+NR+4*NS.OR.
1490 &IN(1).GT.IN(2)) GOTO 270
1491 IF(IN(1).NE.IN(4).OR.IN(2).NE.IN(5)) THEN
1492 DO 370 J=1,4
1493 DP(1,J)=P(IN(1),J)
1494 DP(2,J)=P(IN(2),J)
1495 DP(3,J)=0.
1496 370 DP(4,J)=0.
1497 DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2)
1498 DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2)
1499 DHC12=DFOUR(1,2)
1500 IF(DHC12.LE.1E-2) THEN
1501 P(IN(1)+2,4)=P(IN(1)+2,3)
1502 P(IN(1)+2,1)=0.
1503 IN(1)=IN(1)+4
1504 GOTO 360
1505 ENDIF
1506 IN(3)=N+NR+4*NS+5
1507 DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4)
1508 DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4)
1509 DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4)
1510 IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1.
1511 IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1.
1512 IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1.
1513 IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1.
1514 DHCX1=DFOUR(3,1)/DHC12
1515 DHCX2=DFOUR(3,2)/DHC12
1516 DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12)
1517 DHCY1=DFOUR(4,1)/DHC12
1518 DHCY2=DFOUR(4,2)/DHC12
1519 DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12
1520 DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2)
1521 DO 380 J=1,4
1522 DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J))
1523 P(IN(3),J)=DP(3,J)
1524 380 P(IN(3)+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)-
1525 & DHCYX*DP(3,J))
1526
1527 PXP=-(PX(3)*FOUR(IN(6),IN(3))+PY(3)*FOUR(IN(6)+1,IN(3)))
1528 PYP=-(PX(3)*FOUR(IN(6),IN(3)+1)+PY(3)*FOUR(IN(6)+1,IN(3)+1))
1529 IF(ABS(PXP**2+PYP**2-PX(3)**2-PY(3)**2).LT.0.01) THEN
1530 PX(3)=PXP
1531 PY(3)=PYP
1532 ENDIF
1533 ENDIF
1534
1535
1536 DO 400 J=1,4
1537 DHG(J)=0.
1538 P(I,J)=PX(1)*P(IN(6),J)+PY(1)*P(IN(6)+1,J)+PX(3)*P(IN(3),J)+
1539 &PY(3)*P(IN(3)+1,J)
1540 DO 390 IN1=IN(4),IN(1)-4,4
1541 390 P(I,J)=P(I,J)+P(IN1+2,3)*P(IN1,J)
1542 DO 400 IN2=IN(5),IN(2)-4,4
1543 400 P(I,J)=P(I,J)+P(IN2+2,3)*P(IN2,J)
1544 DHM(1)=FOUR(I,I)
1545 DHM(2)=2.*FOUR(I,IN(1))
1546 DHM(3)=2.*FOUR(I,IN(2))
1547 DHM(4)=2.*FOUR(IN(1),IN(2))
1548
1549
1550 DO 410 IN2=IN(1)+1,IN(2),4
1551 DO 410 IN1=IN(1),IN2-1,4
1552 DHC=2.*FOUR(IN1,IN2)
1553 DHG(1)=DHG(1)+P(IN1+2,1)*P(IN2+2,1)*DHC
1554 IF(IN1.EQ.IN(1)) DHG(2)=DHG(2)-P(IN2+2,1)*DHC
1555 IF(IN2.EQ.IN(2)) DHG(3)=DHG(3)+P(IN1+2,1)*DHC
1556 410 IF(IN1.EQ.IN(1).AND.IN2.EQ.IN(2)) DHG(4)=DHG(4)-DHC
1557
1558
1559 DHS1=DHM(3)*DHG(4)-DHM(4)*DHG(3)
1560 IF(ABS(DHS1).LT.1E-4) GOTO 270
1561 DHS2=DHM(4)*(GAM(3)-DHG(1))-DHM(2)*DHG(3)-DHG(4)*
1562 &(P(I,5)**2-DHM(1))+DHG(2)*DHM(3)
1563 DHS3=DHM(2)*(GAM(3)-DHG(1))-DHG(2)*(P(I,5)**2-DHM(1))
1564 P(IN(2)+2,4)=0.5*(SQRT(MAX(0D0,DHS2**2-4.*DHS1*DHS3))/ABS(DHS1)-
1565 &DHS2/DHS1)
1566 IF(DHM(2)+DHM(4)*P(IN(2)+2,4).LE.0.) GOTO 270
1567 P(IN(1)+2,4)=(P(I,5)**2-DHM(1)-DHM(3)*P(IN(2)+2,4))/
1568 &(DHM(2)+DHM(4)*P(IN(2)+2,4))
1569
1570
1571 IF(P(IN(2)+2,4).GT.P(IN(2)+2,3)) THEN
1572 P(IN(2)+2,4)=P(IN(2)+2,3)
1573 P(IN(2)+2,1)=1.
1574 IN(2)=IN(2)+4
1575 IF(IN(2).GT.N+NR+4*NS) GOTO 270
1576 IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN
1577 P(IN(1)+2,4)=P(IN(1)+2,3)
1578 P(IN(1)+2,1)=0.
1579 IN(1)=IN(1)+4
1580 ENDIF
1581 GOTO 360
1582 ELSEIF(P(IN(1)+2,4).GT.P(IN(1)+2,3)) THEN
1583 P(IN(1)+2,4)=P(IN(1)+2,3)
1584 P(IN(1)+2,1)=0.
1585 IN(1)=IN(1)+JS
1586 GOTO 710
1587 ENDIF
1588
1589
1590 420 DO 430 J=1,4
1591 P(I,J)=P(I,J)+P(IN(1)+2,4)*P(IN(1),J)+P(IN(2)+2,4)*P(IN(2),J)
1592 430 PJU(IU+3,J)=PJU(IU+3,J)+P(I,J)
1593 IF(P(I,4).LE.0.) GOTO 270
1594 PJU(IU+3,5)=TJU(4)*PJU(IU+3,4)-TJU(1)*PJU(IU+3,1)-
1595 &TJU(2)*PJU(IU+3,2)-TJU(3)*PJU(IU+3,3)
1596 IF(PJU(IU+3,5).LT.PJU(IU,5)) THEN
1597 KFL(1)=-KFL(3)
1598 PX(1)=-PX(3)
1599 PY(1)=-PY(3)
1600 GAM(1)=GAM(3)
1601 IF(IN(3).NE.IN(6)) THEN
1602 DO 440 J=1,4
1603 P(IN(6),J)=P(IN(3),J)
1604 440 P(IN(6)+1,J)=P(IN(3)+1,J)
1605 ENDIF
1606 DO 450 JQ=1,2
1607 IN(3+JQ)=IN(JQ)
1608 P(IN(JQ)+2,3)=P(IN(JQ)+2,3)-P(IN(JQ)+2,4)
1609 450 P(IN(JQ)+2,1)=P(IN(JQ)+2,1)-(3-2*JQ)*P(IN(JQ)+2,4)
1610 GOTO 320
1611 ENDIF
1612
1613
1614 IF(IABS(KFL(1)).GT.10) GOTO 270
1615 I=I-1
1616 KFJH(IU)=KFL(1)
1617 DO 460 J=1,4
1618 460 PJU(IU+3,J)=PJU(IU+3,J)-P(I+1,J)
1619 470 CONTINUE
1620
1621
1622 NJS(JT)=I-ISTA
1623 KFJS(JT)=K(K(MJU(JT+2),3),2)
1624 KFLS=2*INT(RLU(0)+3.*PARJ(4)/(1.+3.*PARJ(4)))+1
1625 IF(KFJH(1).EQ.KFJH(2)) KFLS=3
1626 IF(ISTA.NE.I) KFJS(JT)=ISIGN(1000*MAX(IABS(KFJH(1)),
1627 &IABS(KFJH(2)))+100*MIN(IABS(KFJH(1)),IABS(KFJH(2)))+
1628 &KFLS,KFJH(1))
1629 DO 480 J=1,4
1630 PJS(JT,J)=PJU(1,J)+PJU(2,J)+P(MJU(JT),J)
1631 480 PJS(JT+2,J)=PJU(4,J)+PJU(5,J)
1632 PJS(JT,5)=SQRT(MAX(0.,PJS(JT,4)**2-PJS(JT,1)**2-PJS(JT,2)**2-
1633 &PJS(JT,3)**2))
1634 490 CONTINUE
1635
1636
1637 500 IF(MJU(1).NE.0.AND.MJU(2).NE.0) THEN
1638 NS=MJU(2)-MJU(1)
1639 NB=MJU(1)-N
1640 ELSEIF(MJU(1).NE.0) THEN
1641 NS=N+NR-MJU(1)
1642 NB=MJU(1)-N
1643 ELSEIF(MJU(2).NE.0) THEN
1644 NS=MJU(2)-N
1645 NB=1
1646 ELSEIF(IABS(K(N+1,2)).NE.21) THEN
1647 NS=NR-1
1648 NB=1
1649 ELSE
1650 NS=NR+1
1651 W2SUM=0.
1652 DO 510 IS=1,NR
1653 P(N+NR+IS,1)=0.5*FOUR(N+IS,N+IS+1-NR*(IS/NR))
1654 510 W2SUM=W2SUM+P(N+NR+IS,1)
1655 W2RAN=RLU(0)*W2SUM
1656 NB=0
1657 520 NB=NB+1
1658 W2SUM=W2SUM-P(N+NR+NB,1)
1659 IF(W2SUM.GT.W2RAN.AND.NB.LT.NR) GOTO 520
1660 ENDIF
1661
1662
1663 DO 540 IS=1,NS
1664 IS1=N+IS+NB-1-NR*((IS+NB-2)/NR)
1665 IS2=N+IS+NB-NR*((IS+NB-1)/NR)
1666 DO 530 J=1,5
1667 DP(1,J)=P(IS1,J)
1668 IF(IABS(K(IS1,2)).EQ.21) DP(1,J)=0.5*DP(1,J)
1669 IF(IS1.EQ.MJU(1)) DP(1,J)=PJS(1,J)-PJS(3,J)
1670 DP(2,J)=P(IS2,J)
1671 IF(IABS(K(IS2,2)).EQ.21) DP(2,J)=0.5*DP(2,J)
1672 530 IF(IS2.EQ.MJU(2)) DP(2,J)=PJS(2,J)-PJS(4,J)
1673 DP(3,5)=DFOUR(1,1)
1674 DP(4,5)=DFOUR(2,2)
1675 DHKC=DFOUR(1,2)
1676 IF(DP(3,5)+2.*DHKC+DP(4,5).LE.0.) THEN
1677 DP(3,5)=DP(1,5)**2
1678 DP(4,5)=DP(2,5)**2
1679 DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2+DP(1,5)**2)
1680 DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2+DP(2,5)**2)
1681 DHKC=DFOUR(1,2)
1682 ENDIF
1683 DHKS=SQRT(DHKC**2-DP(3,5)*DP(4,5))
1684 DHK1=0.5*((DP(4,5)+DHKC)/DHKS-1.)
1685 DHK2=0.5*((DP(3,5)+DHKC)/DHKS-1.)
1686 IN1=N+NR+4*IS-3
1687 P(IN1,5)=SQRT(DP(3,5)+2.*DHKC+DP(4,5))
1688 DO 540 J=1,4
1689 P(IN1,J)=(1.+DHK1)*DP(1,J)-DHK2*DP(2,J)
1690 540 P(IN1+1,J)=(1.+DHK2)*DP(2,J)-DHK1*DP(1,J)
1691
1692
1693 ISAV=I
1694 550 NTRY=NTRY+1
1695 IF(NTRY.GT.100.AND.NTRYR.LE.4) THEN
1696 PARU12=4.*PARU12
1697 PARU13=2.*PARU13
1698 GOTO 130
1699 ELSEIF(NTRY.GT.100) THEN
1700 CALL LUERRM(14,'(LUSTRF:) caught in infinite loop')
1701 IF(MSTU(21).GE.1) RETURN
1702 ENDIF
1703 I=ISAV
1704 DO 560 J=1,4
1705 P(N+NRS,J)=0.
1706 DO 560 IS=1,NR
1707 560 P(N+NRS,J)=P(N+NRS,J)+P(N+IS,J)
1708 DO 570 JT=1,2
1709 IRANK(JT)=0
1710 IF(MJU(JT).NE.0) IRANK(JT)=NJS(JT)
1711 IF(NS.GT.NR) IRANK(JT)=1
1712 IE(JT)=K(N+1+(JT/2)*(NP-1),3)
1713 IN(3*JT+1)=N+NR+1+4*(JT/2)*(NS-1)
1714 IN(3*JT+2)=IN(3*JT+1)+1
1715 IN(3*JT+3)=N+NR+4*NS+2*JT-1
1716 DO 570 IN1=N+NR+2+JT,N+NR+4*NS-2+JT,4
1717 P(IN1,1)=2-JT
1718 P(IN1,2)=JT-1
1719 570 P(IN1,3)=1.
1720
1721
1722 IF(NS.LT.NR) THEN
1723 PX(1)=0.
1724 PY(1)=0.
1725 IF(NS.EQ.1.AND.MJU(1)+MJU(2).EQ.0) CALL LUPTDI(0,PX(1),PY(1))
1726 PX(2)=-PX(1)
1727 PY(2)=-PY(1)
1728 DO 580 JT=1,2
1729 KFL(JT)=K(IE(JT),2)
1730 IF(MJU(JT).NE.0) KFL(JT)=KFJS(JT)
1731 MSTJ(93)=1
1732 PMQ(JT)=ULMASS(KFL(JT))
1733 580 GAM(JT)=0.
1734
1735
1736 ELSE
1737 KFL(3)=INT(1.+(2.+PARJ(2))*RLU(0))*(-1)**INT(RLU(0)+0.5)
1738 CALL LUKFDI(KFL(3),0,KFL(1),KDUMP)
1739 KFL(2)=-KFL(1)
1740 IF(IABS(KFL(1)).GT.10.AND.RLU(0).GT.0.5) THEN
1741 KFL(2)=-(KFL(1)+ISIGN(10000,KFL(1)))
1742 ELSEIF(IABS(KFL(1)).GT.10) THEN
1743 KFL(1)=-(KFL(2)+ISIGN(10000,KFL(2)))
1744 ENDIF
1745 CALL LUPTDI(KFL(1),PX(1),PY(1))
1746 PX(2)=-PX(1)
1747 PY(2)=-PY(1)
1748 PR3=MIN(25.,0.1*P(N+NR+1,5)**2)
1749 590 CALL LUZDIS(KFL(1),KFL(2),PR3,Z)
1750 ZR=PR3/(Z*P(N+NR+1,5)**2)
1751 IF(ZR.GE.1.) GOTO 590
1752 DO 600 JT=1,2
1753 MSTJ(93)=1
1754 PMQ(JT)=ULMASS(KFL(JT))
1755 GAM(JT)=PR3*(1.-Z)/Z
1756 IN1=N+NR+3+4*(JT/2)*(NS-1)
1757 P(IN1,JT)=1.-Z
1758 P(IN1,3-JT)=JT-1
1759 P(IN1,3)=(2-JT)*(1.-Z)+(JT-1)*Z
1760 P(IN1+1,JT)=ZR
1761 P(IN1+1,3-JT)=2-JT
1762 600 P(IN1+1,3)=(2-JT)*(1.-ZR)+(JT-1)*ZR
1763 ENDIF
1764
1765
1766 DO 640 JT=1,2
1767 IF(JT.EQ.1.OR.NS.EQ.NR-1) THEN
1768 IN1=IN(3*JT+1)
1769 IN3=IN(3*JT+3)
1770 DO 610 J=1,4
1771 DP(1,J)=P(IN1,J)
1772 DP(2,J)=P(IN1+1,J)
1773 DP(3,J)=0.
1774 610 DP(4,J)=0.
1775 DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2)
1776 DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2)
1777 DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4)
1778 DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4)
1779 DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4)
1780 IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1.
1781 IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1.
1782 IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1.
1783 IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1.
1784 DHC12=DFOUR(1,2)
1785 DHCX1=DFOUR(3,1)/DHC12
1786 DHCX2=DFOUR(3,2)/DHC12
1787 DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12)
1788 DHCY1=DFOUR(4,1)/DHC12
1789 DHCY2=DFOUR(4,2)/DHC12
1790 DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12
1791 DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2)
1792 DO 620 J=1,4
1793 DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J))
1794 P(IN3,J)=DP(3,J)
1795 620 P(IN3+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)-
1796 & DHCYX*DP(3,J))
1797 ELSE
1798 DO 630 J=1,4
1799 P(IN3+2,J)=P(IN3,J)
1800 630 P(IN3+3,J)=P(IN3+1,J)
1801 ENDIF
1802 640 CONTINUE
1803
1804
1805 IF(MJU(1)+MJU(2).GT.0) THEN
1806 DO 660 JT=1,2
1807 IF(NJS(JT).EQ.0) GOTO 660
1808 DO 650 J=1,4
1809 650 P(N+NRS,J)=P(N+NRS,J)-PJS(JT+2,J)
1810 660 CONTINUE
1811 ENDIF
1812
1813
1814 670 I=I+1
1815 IF(2*I-NSAV.GE.MSTU(4)-MSTU(32)-5) THEN
1816 CALL LUERRM(11,'(LUSTRF:) no more memory left in LUJETS')
1817 IF(MSTU(21).GE.1) RETURN
1818 ENDIF
1819 JT=1.5+RLU(0)
1820 IF(IABS(KFL(3-JT)).GT.10) JT=3-JT
1821 JR=3-JT
1822 JS=3-2*JT
1823 IRANK(JT)=IRANK(JT)+1
1824 K(I,1)=1
1825 K(I,3)=IE(JT)
1826 K(I,4)=0
1827 K(I,5)=0
1828
1829
1830 680 CALL LUKFDI(KFL(JT),0,KFL(3),K(I,2))
1831 IF(K(I,2).EQ.0) GOTO 550
1832 IF(MSTJ(12).GE.3.AND.IRANK(JT).EQ.1.AND.IABS(KFL(JT)).LE.10.AND.
1833 &IABS(KFL(3)).GT.10) THEN
1834 IF(RLU(0).GT.PARJ(19)) GOTO 680
1835 ENDIF
1836 P(I,5)=ULMASS(K(I,2))
1837 CALL LUPTDI(KFL(JT),PX(3),PY(3))
1838 PR(JT)=P(I,5)**2+(PX(JT)+PX(3))**2+(PY(JT)+PY(3))**2
1839
1840
1841 MSTJ(93)=1
1842 PMQ(3)=ULMASS(KFL(3))
1843 WMIN=PARJ(32+MSTJ(11))+PMQ(1)+PMQ(2)+PARJ(36)*PMQ(3)
1844 IF(IABS(KFL(JT)).GT.10.AND.IABS(KFL(3)).GT.10) WMIN=
1845 &WMIN-0.5*PARJ(36)*PMQ(3)
1846 WREM2=FOUR(N+NRS,N+NRS)
1847 IF(WREM2.LT.0.10) GOTO 550
1848 IF(WREM2.LT.MAX(WMIN*(1.+(2.*RLU(0)-1.)*PARJ(37)),
1849 &PARJ(32)+PMQ(1)+PMQ(2))**2) GOTO 810
1850
1851
1852 CALL LUZDIS(KFL(JT),KFL(3),PR(JT),Z)
1853 KFL1A=IABS(KFL(1))
1854 KFL2A=IABS(KFL(2))
1855 IF(MAX(MOD(KFL1A,10),MOD(KFL1A/1000,10),MOD(KFL2A,10),
1856 &MOD(KFL2A/1000,10)).GE.4) THEN
1857 PR(JR)=(PMQ(JR)+PMQ(3))**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2
1858 PW12=SQRT(MAX(0.,(WREM2-PR(1)-PR(2))**2-4.*PR(1)*PR(2)))
1859 Z=(WREM2+PR(JT)-PR(JR)+PW12*(2.*Z-1.))/(2.*WREM2)
1860 PR(JR)=(PMQ(JR)+PARJ(32+MSTJ(11)))**2+(PX(JR)-PX(3))**2+
1861 & (PY(JR)-PY(3))**2
1862 IF((1.-Z)*(WREM2-PR(JT)/Z).LT.PR(JR)) GOTO 810
1863 ENDIF
1864 GAM(3)=(1.-Z)*(GAM(JT)+PR(JT)/Z)
1865 DO 690 J=1,3
1866 690 IN(J)=IN(3*JT+J)
1867
1868
1869 IF(IN(1)+1.EQ.IN(2).AND.Z*P(IN(1)+2,3)*P(IN(2)+2,3)*
1870 &P(IN(1),5)**2.GE.PR(JT)) THEN
1871 P(IN(JT)+2,4)=Z*P(IN(JT)+2,3)
1872 P(IN(JR)+2,4)=PR(JT)/(P(IN(JT)+2,4)*P(IN(1),5)**2)
1873 DO 700 J=1,4
1874 700 P(I,J)=(PX(JT)+PX(3))*P(IN(3),J)+(PY(JT)+PY(3))*P(IN(3)+1,J)
1875 GOTO 770
1876 ELSEIF(IN(1)+1.EQ.IN(2)) THEN
1877 P(IN(JR)+2,4)=P(IN(JR)+2,3)
1878 P(IN(JR)+2,JT)=1.
1879 IN(JR)=IN(JR)+4*JS
1880 IF(JS*IN(JR).GT.JS*IN(4*JR)) GOTO 550
1881 IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN
1882 P(IN(JT)+2,4)=P(IN(JT)+2,3)
1883 P(IN(JT)+2,JT)=0.
1884 IN(JT)=IN(JT)+4*JS
1885 ENDIF
1886 ENDIF
1887
1888
1889 710 IF(JS*IN(1).GT.JS*IN(3*JR+1).OR.JS*IN(2).GT.JS*IN(3*JR+2).OR.
1890 &IN(1).GT.IN(2)) GOTO 550
1891 IF(IN(1).NE.IN(3*JT+1).OR.IN(2).NE.IN(3*JT+2)) THEN
1892 DO 720 J=1,4
1893 DP(1,J)=P(IN(1),J)
1894 DP(2,J)=P(IN(2),J)
1895 DP(3,J)=0.
1896 720 DP(4,J)=0.
1897 DP(1,4)=SQRT(DP(1,1)**2+DP(1,2)**2+DP(1,3)**2)
1898 DP(2,4)=SQRT(DP(2,1)**2+DP(2,2)**2+DP(2,3)**2)
1899 DHC12=DFOUR(1,2)
1900 IF(DHC12.LE.1E-2) THEN
1901 P(IN(JT)+2,4)=P(IN(JT)+2,3)
1902 P(IN(JT)+2,JT)=0.
1903 IN(JT)=IN(JT)+4*JS
1904 GOTO 710
1905 ENDIF
1906 IN(3)=N+NR+4*NS+5
1907 DP(5,1)=DP(1,1)/DP(1,4)-DP(2,1)/DP(2,4)
1908 DP(5,2)=DP(1,2)/DP(1,4)-DP(2,2)/DP(2,4)
1909 DP(5,3)=DP(1,3)/DP(1,4)-DP(2,3)/DP(2,4)
1910 IF(DP(5,1)**2.LE.DP(5,2)**2+DP(5,3)**2) DP(3,1)=1.
1911 IF(DP(5,1)**2.GT.DP(5,2)**2+DP(5,3)**2) DP(3,3)=1.
1912 IF(DP(5,2)**2.LE.DP(5,1)**2+DP(5,3)**2) DP(4,2)=1.
1913 IF(DP(5,2)**2.GT.DP(5,1)**2+DP(5,3)**2) DP(4,3)=1.
1914 DHCX1=DFOUR(3,1)/DHC12
1915 DHCX2=DFOUR(3,2)/DHC12
1916 DHCXX=1D0/SQRT(1D0+2D0*DHCX1*DHCX2*DHC12)
1917 DHCY1=DFOUR(4,1)/DHC12
1918 DHCY2=DFOUR(4,2)/DHC12
1919 DHCYX=DHCXX*(DHCX1*DHCY2+DHCX2*DHCY1)*DHC12
1920 DHCYY=1D0/SQRT(1D0+2D0*DHCY1*DHCY2*DHC12-DHCYX**2)
1921 DO 730 J=1,4
1922 DP(3,J)=DHCXX*(DP(3,J)-DHCX2*DP(1,J)-DHCX1*DP(2,J))
1923 P(IN(3),J)=DP(3,J)
1924 730 P(IN(3)+1,J)=DHCYY*(DP(4,J)-DHCY2*DP(1,J)-DHCY1*DP(2,J)-
1925 & DHCYX*DP(3,J))
1926
1927 PXP=-(PX(3)*FOUR(IN(3*JT+3),IN(3))+PY(3)*
1928 & FOUR(IN(3*JT+3)+1,IN(3)))
1929 PYP=-(PX(3)*FOUR(IN(3*JT+3),IN(3)+1)+PY(3)*
1930 & FOUR(IN(3*JT+3)+1,IN(3)+1))
1931 IF(ABS(PXP**2+PYP**2-PX(3)**2-PY(3)**2).LT.0.01) THEN
1932 PX(3)=PXP
1933 PY(3)=PYP
1934 ENDIF
1935 ENDIF
1936
1937
1938 DO 750 J=1,4
1939 DHG(J)=0.
1940 P(I,J)=PX(JT)*P(IN(3*JT+3),J)+PY(JT)*P(IN(3*JT+3)+1,J)+
1941 &PX(3)*P(IN(3),J)+PY(3)*P(IN(3)+1,J)
1942 DO 740 IN1=IN(3*JT+1),IN(1)-4*JS,4*JS
1943 740 P(I,J)=P(I,J)+P(IN1+2,3)*P(IN1,J)
1944 DO 750 IN2=IN(3*JT+2),IN(2)-4*JS,4*JS
1945 750 P(I,J)=P(I,J)+P(IN2+2,3)*P(IN2,J)
1946 DHM(1)=FOUR(I,I)
1947 DHM(2)=2.*FOUR(I,IN(1))
1948 DHM(3)=2.*FOUR(I,IN(2))
1949 DHM(4)=2.*FOUR(IN(1),IN(2))
1950
1951
1952 DO 760 IN2=IN(1)+1,IN(2),4
1953 DO 760 IN1=IN(1),IN2-1,4
1954 DHC=2.*FOUR(IN1,IN2)
1955 DHG(1)=DHG(1)+P(IN1+2,JT)*P(IN2+2,JT)*DHC
1956 IF(IN1.EQ.IN(1)) DHG(2)=DHG(2)-JS*P(IN2+2,JT)*DHC
1957 IF(IN2.EQ.IN(2)) DHG(3)=DHG(3)+JS*P(IN1+2,JT)*DHC
1958 760 IF(IN1.EQ.IN(1).AND.IN2.EQ.IN(2)) DHG(4)=DHG(4)-DHC
1959
1960
1961 DHS1=DHM(JR+1)*DHG(4)-DHM(4)*DHG(JR+1)
1962 IF(ABS(DHS1).LT.1E-4) GOTO 550
1963 DHS2=DHM(4)*(GAM(3)-DHG(1))-DHM(JT+1)*DHG(JR+1)-DHG(4)*
1964 &(P(I,5)**2-DHM(1))+DHG(JT+1)*DHM(JR+1)
1965 DHS3=DHM(JT+1)*(GAM(3)-DHG(1))-DHG(JT+1)*(P(I,5)**2-DHM(1))
1966 P(IN(JR)+2,4)=0.5*(SQRT(MAX(0D0,DHS2**2-4.*DHS1*DHS3))/ABS(DHS1)-
1967 &DHS2/DHS1)
1968 IF(DHM(JT+1)+DHM(4)*P(IN(JR)+2,4).LE.0.) GOTO 550
1969 P(IN(JT)+2,4)=(P(I,5)**2-DHM(1)-DHM(JR+1)*P(IN(JR)+2,4))/
1970 &(DHM(JT+1)+DHM(4)*P(IN(JR)+2,4))
1971
1972
1973 IF(P(IN(JR)+2,4).GT.P(IN(JR)+2,3)) THEN
1974 P(IN(JR)+2,4)=P(IN(JR)+2,3)
1975 P(IN(JR)+2,JT)=1.
1976 IN(JR)=IN(JR)+4*JS
1977 IF(JS*IN(JR).GT.JS*IN(4*JR)) GOTO 550
1978 IF(FOUR(IN(1),IN(2)).LE.1E-2) THEN
1979 P(IN(JT)+2,4)=P(IN(JT)+2,3)
1980 P(IN(JT)+2,JT)=0.
1981 IN(JT)=IN(JT)+4*JS
1982 ENDIF
1983 GOTO 710
1984 ELSEIF(P(IN(JT)+2,4).GT.P(IN(JT)+2,3)) THEN
1985 P(IN(JT)+2,4)=P(IN(JT)+2,3)
1986 P(IN(JT)+2,JT)=0.
1987 IN(JT)=IN(JT)+4*JS
1988 GOTO 710
1989 ENDIF
1990
1991
1992 770 DO 780 J=1,4
1993 P(I,J)=P(I,J)+P(IN(1)+2,4)*P(IN(1),J)+P(IN(2)+2,4)*P(IN(2),J)
1994 780 P(N+NRS,J)=P(N+NRS,J)-P(I,J)
1995 IF(P(I,4).LE.0.) GOTO 550
1996 KFL(JT)=-KFL(3)
1997 PMQ(JT)=PMQ(3)
1998 PX(JT)=-PX(3)
1999 PY(JT)=-PY(3)
2000 GAM(JT)=GAM(3)
2001 IF(IN(3).NE.IN(3*JT+3)) THEN
2002 DO 790 J=1,4
2003 P(IN(3*JT+3),J)=P(IN(3),J)
2004 790 P(IN(3*JT+3)+1,J)=P(IN(3)+1,J)
2005 ENDIF
2006 DO 800 JQ=1,2
2007 IN(3*JT+JQ)=IN(JQ)
2008 P(IN(JQ)+2,3)=P(IN(JQ)+2,3)-P(IN(JQ)+2,4)
2009 800 P(IN(JQ)+2,JT)=P(IN(JQ)+2,JT)-JS*(3-2*JQ)*P(IN(JQ)+2,4)
2010 GOTO 670
2011
2012
2013 810 I=I+1
2014 K(I,1)=1
2015 K(I,3)=IE(JR)
2016 K(I,4)=0
2017 K(I,5)=0
2018 CALL LUKFDI(KFL(JR),-KFL(3),KFLDMP,K(I,2))
2019 IF(K(I,2).EQ.0) GOTO 550
2020 P(I,5)=ULMASS(K(I,2))
2021 PR(JR)=P(I,5)**2+(PX(JR)-PX(3))**2+(PY(JR)-PY(3))**2
2022
2023
2024 JQ=1
2025 IF(P(IN(4)+2,3)*P(IN(5)+2,3)*FOUR(IN(4),IN(5)).LT.P(IN(7),3)*
2026 &P(IN(8),3)*FOUR(IN(7),IN(8))) JQ=2
2027 DHC12=FOUR(IN(3*JQ+1),IN(3*JQ+2))
2028 DHR1=FOUR(N+NRS,IN(3*JQ+2))/DHC12
2029 DHR2=FOUR(N+NRS,IN(3*JQ+1))/DHC12
2030 IF(IN(4).NE.IN(7).OR.IN(5).NE.IN(8)) THEN
2031 PX(3-JQ)=-FOUR(N+NRS,IN(3*JQ+3))-PX(JQ)
2032 PY(3-JQ)=-FOUR(N+NRS,IN(3*JQ+3)+1)-PY(JQ)
2033 PR(3-JQ)=P(I+(JT+JQ-3)**2-1,5)**2+(PX(3-JQ)+(2*JQ-3)*JS*
2034 & PX(3))**2+(PY(3-JQ)+(2*JQ-3)*JS*PY(3))**2
2035 ENDIF
2036
2037
2038 WREM2=WREM2+(PX(1)+PX(2))**2+(PY(1)+PY(2))**2
2039 FD=(SQRT(PR(1))+SQRT(PR(2)))/SQRT(WREM2)
2040 IF(MJU(1)+MJU(2).NE.0.AND.I.EQ.ISAV+2.AND.FD.GE.1.) GOTO 180
2041 IF(FD.GE.1.) GOTO 550
2042 FA=WREM2+PR(JT)-PR(JR)
2043 IF(MSTJ(11).EQ.2) PREV=0.5*FD**PARJ(37+MSTJ(11))
2044 IF(MSTJ(11).NE.2) PREV=0.5*EXP(MAX(-100.,LOG(FD)*
2045 &PARJ(37+MSTJ(11))*(PR(1)+PR(2))**2))
2046 FB=SIGN(SQRT(MAX(0.,FA**2-4.*WREM2*PR(JT))),JS*(RLU(0)-PREV))
2047 KFL1A=IABS(KFL(1))
2048 KFL2A=IABS(KFL(2))
2049 IF(MAX(MOD(KFL1A,10),MOD(KFL1A/1000,10),MOD(KFL2A,10),
2050 &MOD(KFL2A/1000,10)).GE.6) FB=SIGN(SQRT(MAX(0.,FA**2-
2051 &4.*WREM2*PR(JT))),FLOAT(JS))
2052 DO 820 J=1,4
2053 P(I-1,J)=(PX(JT)+PX(3))*P(IN(3*JQ+3),J)+(PY(JT)+PY(3))*
2054 &P(IN(3*JQ+3)+1,J)+0.5*(DHR1*(FA+FB)*P(IN(3*JQ+1),J)+
2055 &DHR2*(FA-FB)*P(IN(3*JQ+2),J))/WREM2
2056 820 P(I,J)=P(N+NRS,J)-P(I-1,J)
2057
2058
2059 N=I-NRS+1
2060 DO 830 I=NSAV+1,NSAV+NP
2061 IM=K(I,3)
2062 K(IM,1)=K(IM,1)+10
2063 IF(MSTU(16).NE.2) THEN
2064 K(IM,4)=NSAV+1
2065 K(IM,5)=NSAV+1
2066 ELSE
2067 K(IM,4)=NSAV+2
2068 K(IM,5)=N
2069 ENDIF
2070 830 CONTINUE
2071
2072
2073 NSAV=NSAV+1
2074 K(NSAV,1)=11
2075 K(NSAV,2)=92
2076 K(NSAV,3)=IP
2077 K(NSAV,4)=NSAV+1
2078 K(NSAV,5)=N
2079 DO 840 J=1,4
2080 P(NSAV,J)=DPS(J)
2081 840 V(NSAV,J)=V(IP,J)
2082 P(NSAV,5)=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2))
2083 V(NSAV,5)=0.
2084 DO 850 I=NSAV+1,N
2085 DO 850 J=1,5
2086 K(I,J)=K(I+NRS-1,J)
2087 P(I,J)=P(I+NRS-1,J)
2088 850 V(I,J)=0.
2089
2090
2091 DO 860 I=NSAV+1,N
2092 DO 860 J=1,5
2093 K(I-NSAV+N,J)=K(I,J)
2094 860 P(I-NSAV+N,J)=P(I,J)
2095 I1=NSAV
2096 DO 880 I=N+1,2*N-NSAV
2097 IF(K(I,3).NE.IE(1)) GOTO 880
2098 I1=I1+1
2099 DO 870 J=1,5
2100 K(I1,J)=K(I,J)
2101 870 P(I1,J)=P(I,J)
2102 IF(MSTU(16).NE.2) K(I1,3)=NSAV
2103 880 CONTINUE
2104 DO 900 I=2*N-NSAV,N+1,-1
2105 IF(K(I,3).EQ.IE(1)) GOTO 900
2106 I1=I1+1
2107 DO 890 J=1,5
2108 K(I1,J)=K(I,J)
2109 890 P(I1,J)=P(I,J)
2110 IF(MSTU(16).NE.2) K(I1,3)=NSAV
2111 900 CONTINUE
2112
2113
2114 CALL LUDBRB(NSAV+1,N,0.,0.,DPS(1)/DPS(4),DPS(2)/DPS(4),
2115 &DPS(3)/DPS(4))
2116 DO 910 I=NSAV+1,N
2117 DO 910 J=1,4
2118 910 V(I,J)=V(IP,J)
2119
2120 RETURN
2121 END
2122
2123
2124
2125 SUBROUTINE LUINDF(IP)
2126
2127
2128
2129 IMPLICIT DOUBLE PRECISION(D)
2130 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
2131 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
2132 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
2133 DIMENSION DPS(5),PSI(4),NFI(3),NFL(3),IFET(3),KFLF(3),
2134 &KFLO(2),PXO(2),PYO(2),WO(2)
2135 SAVE
2136
2137
2138 NSAV=N
2139 NJET=0
2140 KQSUM=0
2141 DO 100 J=1,5
2142 100 DPS(J)=0.
2143 I=IP-1
2144 110 I=I+1
2145 IF(I.GT.MIN(N,MSTU(4)-MSTU(32))) THEN
2146 CALL LUERRM(12,'(LUINDF:) failed to reconstruct jet system')
2147 IF(MSTU(21).GE.1) RETURN
2148 ENDIF
2149 IF(K(I,1).NE.1.AND.K(I,1).NE.2) GOTO 110
2150 KC=LUCOMP(K(I,2))
2151 IF(KC.EQ.0) GOTO 110
2152 KQ=KCHG(KC,2)*ISIGN(1,K(I,2))
2153 IF(KQ.EQ.0) GOTO 110
2154 NJET=NJET+1
2155 IF(KQ.NE.2) KQSUM=KQSUM+KQ
2156 DO 120 J=1,5
2157 K(NSAV+NJET,J)=K(I,J)
2158 P(NSAV+NJET,J)=P(I,J)
2159 120 DPS(J)=DPS(J)+P(I,J)
2160 K(NSAV+NJET,3)=I
2161 IF(K(I,1).EQ.2.OR.(MSTJ(3).LE.5.AND.N.GT.I.AND.
2162 &K(I+1,1).EQ.2)) GOTO 110
2163 IF(NJET.NE.1.AND.KQSUM.NE.0) THEN
2164 CALL LUERRM(12,'(LUINDF:) unphysical flavour combination')
2165 IF(MSTU(21).GE.1) RETURN
2166 ENDIF
2167
2168
2169 IF(NJET.NE.1) CALL LUDBRB(NSAV+1,NSAV+NJET,0.,0.,-DPS(1)/DPS(4),
2170 &-DPS(2)/DPS(4),-DPS(3)/DPS(4))
2171 PECM=0.
2172 DO 130 J=1,3
2173 130 NFI(J)=0
2174 DO 140 I=NSAV+1,NSAV+NJET
2175 PECM=PECM+P(I,4)
2176 KFA=IABS(K(I,2))
2177 IF(KFA.LE.3) THEN
2178 NFI(KFA)=NFI(KFA)+ISIGN(1,K(I,2))
2179 ELSEIF(KFA.GT.1000) THEN
2180 KFLA=MOD(KFA/1000,10)
2181 KFLB=MOD(KFA/100,10)
2182 IF(KFLA.LE.3) NFI(KFLA)=NFI(KFLA)+ISIGN(1,K(I,2))
2183 IF(KFLB.LE.3) NFI(KFLB)=NFI(KFLB)+ISIGN(1,K(I,2))
2184 ENDIF
2185 140 CONTINUE
2186
2187
2188 NTRY=0
2189 150 NTRY=NTRY+1
2190 N=NSAV+NJET
2191 IF(NTRY.GT.200) THEN
2192 CALL LUERRM(14,'(LUINDF:) caught in infinite loop')
2193 IF(MSTU(21).GE.1) RETURN
2194 ENDIF
2195 DO 160 J=1,3
2196 NFL(J)=NFI(J)
2197 IFET(J)=0
2198 160 KFLF(J)=0
2199
2200
2201 DO 230 IP1=NSAV+1,NSAV+NJET
2202 MSTJ(91)=0
2203 NSAV1=N
2204
2205
2206 KFLH=IABS(K(IP1,2))
2207 IF(KFLH.GT.10) KFLH=MOD(KFLH/1000,10)
2208 KFLO(2)=0
2209 WF=P(IP1,4)+SQRT(P(IP1,1)**2+P(IP1,2)**2+P(IP1,3)**2)
2210
2211
2212 170 IF(IABS(K(IP1,2)).NE.21) THEN
2213 NSTR=1
2214 KFLO(1)=K(IP1,2)
2215 CALL LUPTDI(0,PXO(1),PYO(1))
2216 WO(1)=WF
2217
2218
2219 ELSEIF(MSTJ(2).LE.2) THEN
2220 NSTR=1
2221 IF(MSTJ(2).EQ.2) MSTJ(91)=1
2222 KFLO(1)=INT(1.+(2.+PARJ(2))*RLU(0))*(-1)**INT(RLU(0)+0.5)
2223 CALL LUPTDI(0,PXO(1),PYO(1))
2224 WO(1)=WF
2225
2226
2227
2228 ELSE
2229 NSTR=2
2230 IF(MSTJ(2).EQ.4) MSTJ(91)=1
2231 KFLO(1)=INT(1.+(2.+PARJ(2))*RLU(0))*(-1)**INT(RLU(0)+0.5)
2232 KFLO(2)=-KFLO(1)
2233 CALL LUPTDI(0,PXO(1),PYO(1))
2234 PXO(2)=-PXO(1)
2235 PYO(2)=-PYO(1)
2236 WO(1)=WF*RLU(0)**(1./3.)
2237 WO(2)=WF-WO(1)
2238 ENDIF
2239
2240
2241 DO 220 ISTR=1,NSTR
2242 180 I=N
2243 IRANK=0
2244 KFL1=KFLO(ISTR)
2245 PX1=PXO(ISTR)
2246 PY1=PYO(ISTR)
2247 W=WO(ISTR)
2248
2249
2250 190 I=I+1
2251 IF(I.GE.MSTU(4)-MSTU(32)-NJET-5) THEN
2252 CALL LUERRM(11,'(LUINDF:) no more memory left in LUJETS')
2253 IF(MSTU(21).GE.1) RETURN
2254 ENDIF
2255 IRANK=IRANK+1
2256 K(I,1)=1
2257 K(I,3)=IP1
2258 K(I,4)=0
2259 K(I,5)=0
2260 200 CALL LUKFDI(KFL1,0,KFL2,K(I,2))
2261 IF(K(I,2).EQ.0) GOTO 180
2262 IF(MSTJ(12).GE.3.AND.IRANK.EQ.1.AND.IABS(KFL1).LE.10.AND.
2263 &IABS(KFL2).GT.10) THEN
2264 IF(RLU(0).GT.PARJ(19)) GOTO 200
2265 ENDIF
2266
2267
2268 P(I,5)=ULMASS(K(I,2))
2269 CALL LUPTDI(KFL1,PX2,PY2)
2270 P(I,1)=PX1+PX2
2271 P(I,2)=PY1+PY2
2272 PR=P(I,5)**2+P(I,1)**2+P(I,2)**2
2273 CALL LUZDIS(KFL1,KFL2,PR,Z)
2274 P(I,3)=0.5*(Z*W-PR/(Z*W))
2275 P(I,4)=0.5*(Z*W+PR/(Z*W))
2276 IF(MSTJ(3).GE.1.AND.IRANK.EQ.1.AND.KFLH.GE.4.AND.
2277 &P(I,3).LE.0.001) THEN
2278 IF(W.GE.P(I,5)+0.5*PARJ(32)) GOTO 180
2279 P(I,3)=0.0001
2280 P(I,4)=SQRT(PR)
2281 Z=P(I,4)/W
2282 ENDIF
2283
2284
2285 KFL1=-KFL2
2286 PX1=-PX2
2287 PY1=-PY2
2288 W=(1.-Z)*W
2289 DO 210 J=1,5
2290 210 V(I,J)=0.
2291
2292
2293 IF(MSTJ(3).GE.0.AND.P(I,3).LT.0.) I=I-1
2294 IF(W.GT.PARJ(31)) GOTO 190
2295 220 N=I
2296 IF(MOD(MSTJ(3),5).EQ.4.AND.N.EQ.NSAV1) WF=WF+0.1*PARJ(32)
2297 IF(MOD(MSTJ(3),5).EQ.4.AND.N.EQ.NSAV1) GOTO 170
2298
2299
2300 THE=ULANGL(P(IP1,3),SQRT(P(IP1,1)**2+P(IP1,2)**2))
2301 PHI=ULANGL(P(IP1,1),P(IP1,2))
2302 CALL LUDBRB(NSAV1+1,N,THE,PHI,0D0,0D0,0D0)
2303 K(K(IP1,3),4)=NSAV1+1
2304 K(K(IP1,3),5)=N
2305
2306
2307 230 CONTINUE
2308 IF(NJET.EQ.1.OR.MSTJ(3).LE.0) GOTO 470
2309 IF(MOD(MSTJ(3),5).NE.0.AND.N-NSAV-NJET.LT.2) GOTO 150
2310
2311
2312 DO 240 I=NSAV+NJET+1,N
2313 KFA=IABS(K(I,2))
2314 KFLA=MOD(KFA/1000,10)
2315 KFLB=MOD(KFA/100,10)
2316 KFLC=MOD(KFA/10,10)
2317 IF(KFLA.EQ.0) THEN
2318 IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)-ISIGN(1,K(I,2))*(-1)**KFLB
2319 IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)+ISIGN(1,K(I,2))*(-1)**KFLB
2320 ELSE
2321 IF(KFLA.LE.3) NFL(KFLA)=NFL(KFLA)-ISIGN(1,K(I,2))
2322 IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)-ISIGN(1,K(I,2))
2323 IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)-ISIGN(1,K(I,2))
2324 ENDIF
2325 240 CONTINUE
2326 NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+
2327 &NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3
2328 IF(NREQ.EQ.0) GOTO 320
2329
2330
2331 NREM=0
2332 250 IREM=0
2333 P2MIN=PECM**2
2334 DO 260 I=NSAV+NJET+1,N
2335 P2=P(I,1)**2+P(I,2)**2+P(I,3)**2
2336 IF(K(I,1).EQ.1.AND.P2.LT.P2MIN) IREM=I
2337 260 IF(K(I,1).EQ.1.AND.P2.LT.P2MIN) P2MIN=P2
2338 IF(IREM.EQ.0) GOTO 150
2339 K(IREM,1)=7
2340 KFA=IABS(K(IREM,2))
2341 KFLA=MOD(KFA/1000,10)
2342 KFLB=MOD(KFA/100,10)
2343 KFLC=MOD(KFA/10,10)
2344 IF(KFLA.GE.4.OR.KFLB.GE.4) K(IREM,1)=8
2345 IF(K(IREM,1).EQ.8) GOTO 250
2346 IF(KFLA.EQ.0) THEN
2347 ISGN=ISIGN(1,K(IREM,2))*(-1)**KFLB
2348 IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)+ISGN
2349 IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)-ISGN
2350 ELSE
2351 IF(KFLA.LE.3) NFL(KFLA)=NFL(KFLA)+ISIGN(1,K(IREM,2))
2352 IF(KFLB.LE.3) NFL(KFLB)=NFL(KFLB)+ISIGN(1,K(IREM,2))
2353 IF(KFLC.LE.3) NFL(KFLC)=NFL(KFLC)+ISIGN(1,K(IREM,2))
2354 ENDIF
2355 NREM=NREM+1
2356 NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+
2357 &NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3
2358 IF(NREQ.GT.NREM) GOTO 250
2359 DO 270 I=NSAV+NJET+1,N
2360 270 IF(K(I,1).EQ.8) K(I,1)=1
2361
2362
2363 280 NFET=2
2364 IF(NFL(1)+NFL(2)+NFL(3).NE.0) NFET=3
2365 IF(NREQ.LT.NREM) NFET=1
2366 IF(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3)).EQ.0) NFET=0
2367 DO 290 J=1,NFET
2368 IFET(J)=1+(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3)))*RLU(0)
2369 KFLF(J)=ISIGN(1,NFL(1))
2370 IF(IFET(J).GT.IABS(NFL(1))) KFLF(J)=ISIGN(2,NFL(2))
2371 290 IF(IFET(J).GT.IABS(NFL(1))+IABS(NFL(2))) KFLF(J)=ISIGN(3,NFL(3))
2372 IF(NFET.EQ.2.AND.(IFET(1).EQ.IFET(2).OR.KFLF(1)*KFLF(2).GT.0))
2373 &GOTO 280
2374 IF(NFET.EQ.3.AND.(IFET(1).EQ.IFET(2).OR.IFET(1).EQ.IFET(3).OR.
2375 &IFET(2).EQ.IFET(3).OR.KFLF(1)*KFLF(2).LT.0.OR.KFLF(1)*KFLF(3).
2376 <.0.OR.KFLF(1)*(NFL(1)+NFL(2)+NFL(3)).LT.0)) GOTO 280
2377 IF(NFET.EQ.0) KFLF(1)=1+INT((2.+PARJ(2))*RLU(0))
2378 IF(NFET.EQ.0) KFLF(2)=-KFLF(1)
2379 IF(NFET.EQ.1) KFLF(2)=ISIGN(1+INT((2.+PARJ(2))*RLU(0)),-KFLF(1))
2380 IF(NFET.LE.2) KFLF(3)=0
2381 IF(KFLF(3).NE.0) THEN
2382 KFLFC=ISIGN(1000*MAX(IABS(KFLF(1)),IABS(KFLF(3)))+
2383 & 100*MIN(IABS(KFLF(1)),IABS(KFLF(3)))+1,KFLF(1))
2384 IF(KFLF(1).EQ.KFLF(3).OR.(1.+3.*PARJ(4))*RLU(0).GT.1.)
2385 & KFLFC=KFLFC+ISIGN(2,KFLFC)
2386 ELSE
2387 KFLFC=KFLF(1)
2388 ENDIF
2389 CALL LUKFDI(KFLFC,KFLF(2),KFLDMP,KF)
2390 IF(KF.EQ.0) GOTO 280
2391 DO 300 J=1,MAX(2,NFET)
2392 300 NFL(IABS(KFLF(J)))=NFL(IABS(KFLF(J)))-ISIGN(1,KFLF(J))
2393
2394
2395 NPOS=MIN(1+INT(RLU(0)*NREM),NREM)
2396 DO 310 I=NSAV+NJET+1,N
2397 IF(K(I,1).EQ.7) NPOS=NPOS-1
2398 IF(K(I,1).EQ.1.OR.NPOS.NE.0) GOTO 310
2399 K(I,1)=1
2400 K(I,2)=KF
2401 P(I,5)=ULMASS(K(I,2))
2402 P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2)
2403 310 CONTINUE
2404 NREM=NREM-1
2405 NREQ=(IABS(NFL(1))+IABS(NFL(2))+IABS(NFL(3))-IABS(NFL(1)+
2406 &NFL(2)+NFL(3)))/2+IABS(NFL(1)+NFL(2)+NFL(3))/3
2407 IF(NREM.GT.0) GOTO 280
2408
2409
2410 320 MTMP = MOD(MSTJ(3),5)
2411 IF(MTMP.NE.0.AND.MTMP.NE.4) THEN
2412 DO 330 J=1,3
2413 PSI(J)=0.
2414 DO 330 I=NSAV+NJET+1,N
2415 330 PSI(J)=PSI(J)+P(I,J)
2416 PSI(4)=PSI(1)**2+PSI(2)**2+PSI(3)**2
2417 PWS=0.
2418 DO 340 I=NSAV+NJET+1,N
2419 IF(MOD(MSTJ(3),5).EQ.1) PWS=PWS+P(I,4)
2420 IF(MOD(MSTJ(3),5).EQ.2) PWS=PWS+SQRT(P(I,5)**2+(PSI(1)*P(I,1)+
2421 & PSI(2)*P(I,2)+PSI(3)*P(I,3))**2/PSI(4))
2422 340 IF(MOD(MSTJ(3),5).EQ.3) PWS=PWS+1.
2423 DO 360 I=NSAV+NJET+1,N
2424 IF(MOD(MSTJ(3),5).EQ.1) PW=P(I,4)
2425 IF(MOD(MSTJ(3),5).EQ.2) PW=SQRT(P(I,5)**2+(PSI(1)*P(I,1)+
2426 & PSI(2)*P(I,2)+PSI(3)*P(I,3))**2/PSI(4))
2427 IF(MOD(MSTJ(3),5).EQ.3) PW=1.
2428 DO 350 J=1,3
2429 350 P(I,J)=P(I,J)-PSI(J)*PW/PWS
2430 360 P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2)
2431
2432
2433 ELSEIF(MOD(MSTJ(3),5).EQ.4) THEN
2434 DO 370 I=N+1,N+NJET
2435 K(I,1)=0
2436 DO 370 J=1,5
2437 370 P(I,J)=0.
2438 DO 390 I=NSAV+NJET+1,N
2439 IR1=K(I,3)
2440 IR2=N+IR1-NSAV
2441 K(IR2,1)=K(IR2,1)+1
2442 PLS=(P(I,1)*P(IR1,1)+P(I,2)*P(IR1,2)+P(I,3)*P(IR1,3))/
2443 & (P(IR1,1)**2+P(IR1,2)**2+P(IR1,3)**2)
2444 DO 380 J=1,3
2445 380 P(IR2,J)=P(IR2,J)+P(I,J)-PLS*P(IR1,J)
2446 P(IR2,4)=P(IR2,4)+P(I,4)
2447 390 P(IR2,5)=P(IR2,5)+PLS
2448 PSS=0.
2449 DO 400 I=N+1,N+NJET
2450 400 IF(K(I,1).NE.0) PSS=PSS+P(I,4)/(PECM*(0.8*P(I,5)+0.2))
2451 DO 420 I=NSAV+NJET+1,N
2452 IR1=K(I,3)
2453 IR2=N+IR1-NSAV
2454 PLS=(P(I,1)*P(IR1,1)+P(I,2)*P(IR1,2)+P(I,3)*P(IR1,3))/
2455 & (P(IR1,1)**2+P(IR1,2)**2+P(IR1,3)**2)
2456 DO 410 J=1,3
2457 410 P(I,J)=P(I,J)-P(IR2,J)/K(IR2,1)+(1./(P(IR2,5)*PSS)-1.)*PLS*
2458 & P(IR1,J)
2459 420 P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2)
2460 ENDIF
2461
2462
2463 IF(MOD(MSTJ(3),5).NE.0) THEN
2464 PMS=0.
2465 PES=0.
2466 PQS=0.
2467 DO 430 I=NSAV+NJET+1,N
2468 PMS=PMS+P(I,5)
2469 PES=PES+P(I,4)
2470 430 PQS=PQS+P(I,5)**2/P(I,4)
2471 IF(PMS.GE.PECM) GOTO 150
2472 NECO=0
2473 440 NECO=NECO+1
2474 PFAC=(PECM-PQS)/(PES-PQS)
2475 PES=0.
2476 PQS=0.
2477 DO 460 I=NSAV+NJET+1,N
2478 DO 450 J=1,3
2479 450 P(I,J)=PFAC*P(I,J)
2480 P(I,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2+P(I,5)**2)
2481 PES=PES+P(I,4)
2482 460 PQS=PQS+P(I,5)**2/P(I,4)
2483 IF(NECO.LT.10.AND.ABS(PECM-PES).GT.2E-6*PECM) GOTO 440
2484 ENDIF
2485
2486
2487 470 DO 480 I=NSAV+NJET+1,N
2488 IF(MSTU(16).NE.2) K(I,3)=NSAV+1
2489 480 IF(MSTU(16).EQ.2) K(I,3)=K(K(I,3),3)
2490 DO 490 I=NSAV+1,NSAV+NJET
2491 I1=K(I,3)
2492 K(I1,1)=K(I1,1)+10
2493 IF(MSTU(16).NE.2) THEN
2494 K(I1,4)=NSAV+1
2495 K(I1,5)=NSAV+1
2496 ELSE
2497 K(I1,4)=K(I1,4)-NJET+1
2498 K(I1,5)=K(I1,5)-NJET+1
2499 IF(K(I1,5).LT.K(I1,4)) THEN
2500 K(I1,4)=0
2501 K(I1,5)=0
2502 ENDIF
2503 ENDIF
2504 490 CONTINUE
2505
2506
2507 NSAV=NSAV+1
2508 K(NSAV,1)=11
2509 K(NSAV,2)=93
2510 K(NSAV,3)=IP
2511 K(NSAV,4)=NSAV+1
2512 K(NSAV,5)=N-NJET+1
2513 DO 500 J=1,4
2514 P(NSAV,J)=DPS(J)
2515 500 V(NSAV,J)=V(IP,J)
2516 P(NSAV,5)=SQRT(MAX(0D0,DPS(4)**2-DPS(1)**2-DPS(2)**2-DPS(3)**2))
2517 V(NSAV,5)=0.
2518 DO 510 I=NSAV+NJET,N
2519 DO 510 J=1,5
2520 K(I-NJET+1,J)=K(I,J)
2521 P(I-NJET+1,J)=P(I,J)
2522 510 V(I-NJET+1,J)=V(I,J)
2523 N=N-NJET+1
2524
2525
2526 IF(NJET.NE.1) CALL LUDBRB(NSAV+1,N,0.,0.,DPS(1)/DPS(4),
2527 &DPS(2)/DPS(4),DPS(3)/DPS(4))
2528 DO 520 I=NSAV+1,N
2529 DO 520 J=1,4
2530 520 V(I,J)=V(IP,J)
2531
2532 RETURN
2533 END
2534
2535
2536
2537 SUBROUTINE LUDECY(IP)
2538
2539
2540 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
2541 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
2542 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
2543 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
2544 DIMENSION VDCY(4),KFLO(4),KFL1(4),PV(10,5),RORD(10),UE(3),BE(3),
2545 &WTCOR(10)
2546 SAVE
2547 DATA WTCOR/2.,5.,15.,60.,250.,1500.,1.2E4,1.2E5,150.,16./
2548
2549
2550
2551 PAWT(A,B,C)=SQRT((A**2-(B+C)**2)*(A**2-(B-C)**2))/(2.*A)
2552 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)
2553 HMEPS(HA)=((1.-HRQ-HA)**2+3.*HA*(1.+HRQ-HA))*
2554 &SQRT((1.-HRQ-HA)**2-4.*HRQ*HA)
2555
2556
2557 NTRY=0
2558 NSAV=N
2559 KFA=IABS(K(IP,2))
2560 KFS=ISIGN(1,K(IP,2))
2561 KC=LUCOMP(KFA)
2562 MSTJ(92)=0
2563
2564
2565 IF(K(IP,1).EQ.5) THEN
2566 V(IP,5)=0.
2567 ELSEIF(K(IP,1).NE.4) THEN
2568 V(IP,5)=-PMAS(KC,4)*LOG(RLU(0))
2569 ENDIF
2570 DO 100 J=1,4
2571 100 VDCY(J)=V(IP,J)+V(IP,5)*P(IP,J)/P(IP,5)
2572
2573
2574 MOUT=0
2575 IF(MSTJ(22).EQ.2) THEN
2576 IF(PMAS(KC,4).GT.PARJ(71)) MOUT=1
2577 ELSEIF(MSTJ(22).EQ.3) THEN
2578 IF(VDCY(1)**2+VDCY(2)**2+VDCY(3)**2.GT.PARJ(72)**2) MOUT=1
2579 ELSEIF(MSTJ(22).EQ.4) THEN
2580 IF(VDCY(1)**2+VDCY(2)**2.GT.PARJ(73)**2) MOUT=1
2581 IF(ABS(VDCY(3)).GT.PARJ(74)) MOUT=1
2582 ENDIF
2583 IF(MOUT.EQ.1.AND.K(IP,1).NE.5) THEN
2584 K(IP,1)=4
2585 RETURN
2586 ENDIF
2587
2588
2589 KCA=KC
2590 IF(MDCY(KC,2).GT.0) THEN
2591 MDMDCY=MDME(MDCY(KC,2),2)
2592 IF(MDMDCY.GT.80.AND.MDMDCY.LE.90) KCA=MDMDCY
2593 ENDIF
2594 IF(MDCY(KCA,2).LE.0.OR.MDCY(KCA,3).LE.0) THEN
2595 CALL LUERRM(9,'(LUDECY:) no decay channel defined')
2596 RETURN
2597 ENDIF
2598 IF(MOD(KFA/1000,10).EQ.0.AND.(KCA.EQ.85.OR.KCA.EQ.87)) KFS=-KFS
2599 IF(KCHG(KC,3).EQ.0) THEN
2600 KFSP=1
2601 KFSN=0
2602 IF(RLU(0).GT.0.5) KFS=-KFS
2603 ELSEIF(KFS.GT.0) THEN
2604 KFSP=1
2605 KFSN=0
2606 ELSE
2607 KFSP=0
2608 KFSN=1
2609 ENDIF
2610
2611
2612 NOPE=0
2613 BRSU=0.
2614 DO 120 IDL=MDCY(KCA,2),MDCY(KCA,2)+MDCY(KCA,3)-1
2615 IF(MDME(IDL,1).NE.1.AND.KFSP*MDME(IDL,1).NE.2.AND.
2616 &KFSN*MDME(IDL,1).NE.3) GOTO 120
2617 IF(MDME(IDL,2).GT.100) GOTO 120
2618 NOPE=NOPE+1
2619 BRSU=BRSU+BRAT(IDL)
2620 120 CONTINUE
2621 IF(NOPE.EQ.0) THEN
2622 CALL LUERRM(2,'(LUDECY:) all decay channels closed by user')
2623 RETURN
2624 ENDIF
2625
2626
2627 130 RBR=BRSU*RLU(0)
2628 IDL=MDCY(KCA,2)-1
2629 140 IDL=IDL+1
2630 IF(MDME(IDL,1).NE.1.AND.KFSP*MDME(IDL,1).NE.2.AND.
2631 &KFSN*MDME(IDL,1).NE.3) THEN
2632 IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1) GOTO 140
2633 ELSEIF(MDME(IDL,2).GT.100) THEN
2634 IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1) GOTO 140
2635 ELSE
2636 IDC=IDL
2637 RBR=RBR-BRAT(IDL)
2638 IF(IDL.LT.MDCY(KCA,2)+MDCY(KCA,3)-1.AND.RBR.GT.0.) GOTO 140
2639 ENDIF
2640
2641
2642 MMAT=MDME(IDC,2)
2643 150 NTRY=NTRY+1
2644 IF(NTRY.GT.1000) THEN
2645 CALL LUERRM(14,'(LUDECY:) caught in infinite loop')
2646 IF(MSTU(21).GE.1) RETURN
2647 ENDIF
2648 I=N
2649 NP=0
2650 NQ=0
2651 MBST=0
2652 IF(MMAT.GE.11.AND.MMAT.NE.46.AND.P(IP,4).GT.20.*P(IP,5)) MBST=1
2653 DO 160 J=1,4
2654 PV(1,J)=0.
2655 160 IF(MBST.EQ.0) PV(1,J)=P(IP,J)
2656 IF(MBST.EQ.1) PV(1,4)=P(IP,5)
2657 PV(1,5)=P(IP,5)
2658 PS=0.
2659 PSQ=0.
2660 MREM=0
2661
2662
2663 JTMAX=5
2664 IF(MDME(IDC+1,2).EQ.101) JTMAX=10
2665 DO 170 JT=1,JTMAX
2666 IF(JT.LE.5) KP=KFDP(IDC,JT)
2667 IF(JT.GE.6) KP=KFDP(IDC+1,JT-5)
2668 IF(KP.EQ.0) GOTO 170
2669 KPA=IABS(KP)
2670 KCP=LUCOMP(KPA)
2671 IF(KCHG(KCP,3).EQ.0.AND.KPA.NE.81.AND.KPA.NE.82) THEN
2672 KFP=KP
2673 ELSEIF(KPA.NE.81.AND.KPA.NE.82) THEN
2674 KFP=KFS*KP
2675 ELSEIF(KPA.EQ.81.AND.MOD(KFA/1000,10).EQ.0) THEN
2676 KFP=-KFS*MOD(KFA/10,10)
2677 ELSEIF(KPA.EQ.81.AND.MOD(KFA/100,10).GE.MOD(KFA/10,10)) THEN
2678 KFP=KFS*(100*MOD(KFA/10,100)+3)
2679 ELSEIF(KPA.EQ.81) THEN
2680 KFP=KFS*(1000*MOD(KFA/10,10)+100*MOD(KFA/100,10)+1)
2681 ELSEIF(KP.EQ.82) THEN
2682 CALL LUKFDI(-KFS*INT(1.+(2.+PARJ(2))*RLU(0)),0,KFP,KDUMP)
2683 IF(KFP.EQ.0) GOTO 150
2684 MSTJ(93)=1
2685 IF(PV(1,5).LT.PARJ(32)+2.*ULMASS(KFP)) GOTO 150
2686 ELSEIF(KP.EQ.-82) THEN
2687 KFP=-KFP
2688 IF(IABS(KFP).GT.10) KFP=KFP+ISIGN(10000,KFP)
2689 ENDIF
2690 IF(KPA.EQ.81.OR.KPA.EQ.82) KCP=LUCOMP(KFP)
2691
2692
2693 KFPA=IABS(KFP)
2694 KQP=KCHG(KCP,2)
2695 IF(MMAT.GE.11.AND.MMAT.LE.30.AND.KQP.NE.0) THEN
2696 NQ=NQ+1
2697 KFLO(NQ)=KFP
2698 MSTJ(93)=2
2699 PSQ=PSQ+ULMASS(KFLO(NQ))
2700 ELSEIF(MMAT.GE.42.AND.MMAT.LE.43.AND.NP.EQ.3.AND.MOD(NQ,2).EQ.1)
2701 &THEN
2702 NQ=NQ-1
2703 PS=PS-P(I,5)
2704 K(I,1)=1
2705 KFI=K(I,2)
2706 CALL LUKFDI(KFP,KFI,KFLDMP,K(I,2))
2707 IF(K(I,2).EQ.0) GOTO 150
2708 MSTJ(93)=1
2709 P(I,5)=ULMASS(K(I,2))
2710 PS=PS+P(I,5)
2711 ELSE
2712 I=I+1
2713 NP=NP+1
2714 IF(MMAT.NE.33.AND.KQP.NE.0) NQ=NQ+1
2715 IF(MMAT.EQ.33.AND.KQP.NE.0.AND.KQP.NE.2) NQ=NQ+1
2716 K(I,1)=1+MOD(NQ,2)
2717 IF(MMAT.EQ.4.AND.JT.LE.2.AND.KFP.EQ.21) K(I,1)=2
2718 IF(MMAT.EQ.4.AND.JT.EQ.3) K(I,1)=1
2719 K(I,2)=KFP
2720 K(I,3)=IP
2721 K(I,4)=0
2722 K(I,5)=0
2723 P(I,5)=ULMASS(KFP)
2724 IF(MMAT.EQ.45.AND.KFPA.EQ.89) P(I,5)=PARJ(32)
2725 PS=PS+P(I,5)
2726 ENDIF
2727 170 CONTINUE
2728
2729
2730 180 IF(MMAT.GE.11.AND.MMAT.LE.30) THEN
2731 PSP=PS
2732 CNDE=PARJ(61)*LOG(MAX((PV(1,5)-PS-PSQ)/PARJ(62),1.1))
2733 IF(MMAT.EQ.12) CNDE=CNDE+PARJ(63)
2734 190 NTRY=NTRY+1
2735 IF(NTRY.GT.1000) THEN
2736 CALL LUERRM(14,'(LUDECY:) caught in infinite loop')
2737 IF(MSTU(21).GE.1) RETURN
2738 ENDIF
2739 IF(MMAT.LE.20) THEN
2740 GAUSS=SQRT(-2.*CNDE*LOG(MAX(1E-10,RLU(0))))*
2741 & SIN(PARU(2)*RLU(0))
2742 ND=0.5+0.5*NP+0.25*NQ+CNDE+GAUSS
2743 IF(ND.LT.NP+NQ/2.OR.ND.LT.2.OR.ND.GT.10) GOTO 190
2744 IF(MMAT.EQ.13.AND.ND.EQ.2) GOTO 190
2745 IF(MMAT.EQ.14.AND.ND.LE.3) GOTO 190
2746 IF(MMAT.EQ.15.AND.ND.LE.4) GOTO 190
2747 ELSE
2748 ND=MMAT-20
2749 ENDIF
2750
2751
2752 DO 200 JT=1,4
2753 200 KFL1(JT)=KFLO(JT)
2754 IF(ND.EQ.NP+NQ/2) GOTO 220
2755 DO 210 I=N+NP+1,N+ND-NQ/2
2756 JT=1+INT((NQ-1)*RLU(0))
2757 CALL LUKFDI(KFL1(JT),0,KFL2,K(I,2))
2758 IF(K(I,2).EQ.0) GOTO 190
2759 210 KFL1(JT)=-KFL2
2760 220 JT=2
2761 JT2=3
2762 JT3=4
2763 IF(NQ.EQ.4.AND.RLU(0).LT.PARJ(66)) JT=4
2764 IF(JT.EQ.4.AND.ISIGN(1,KFL1(1)*(10-IABS(KFL1(1))))*
2765 & ISIGN(1,KFL1(JT)*(10-IABS(KFL1(JT)))).GT.0) JT=3
2766 IF(JT.EQ.3) JT2=2
2767 IF(JT.EQ.4) JT3=2
2768 CALL LUKFDI(KFL1(1),KFL1(JT),KFLDMP,K(N+ND-NQ/2+1,2))
2769 IF(K(N+ND-NQ/2+1,2).EQ.0) GOTO 190
2770 IF(NQ.EQ.4) CALL LUKFDI(KFL1(JT2),KFL1(JT3),KFLDMP,K(N+ND,2))
2771 IF(NQ.EQ.4.AND.K(N+ND,2).EQ.0) GOTO 190
2772
2773
2774 PS=PSP
2775 DO 230 I=N+NP+1,N+ND
2776 K(I,1)=1
2777 K(I,3)=IP
2778 K(I,4)=0
2779 K(I,5)=0
2780 P(I,5)=ULMASS(K(I,2))
2781 230 PS=PS+P(I,5)
2782 IF(PS+PARJ(64).GT.PV(1,5)) GOTO 190
2783
2784
2785 ELSEIF((MMAT.EQ.31.OR.MMAT.EQ.33.OR.MMAT.EQ.44.OR.MMAT.EQ.45).
2786 &AND.NP.GE.3) THEN
2787 PS=PS-P(N+NP,5)
2788 PQT=(P(N+NP,5)+PARJ(65))/PV(1,5)
2789 DO 240 J=1,5
2790 P(N+NP,J)=PQT*PV(1,J)
2791 240 PV(1,J)=(1.-PQT)*PV(1,J)
2792 IF(PS+PARJ(64).GT.PV(1,5)) GOTO 150
2793 ND=NP-1
2794 MREM=1
2795
2796
2797 ELSEIF(MMAT.EQ.46) THEN
2798 MSTJ(93)=1
2799 PSMC=ULMASS(K(N+1,2))
2800 MSTJ(93)=1
2801 PSMC=PSMC+ULMASS(K(N+2,2))
2802 IF(MAX(PS,PSMC)+PARJ(32).GT.PV(1,5)) GOTO 130
2803 HR1=(P(N+1,5)/PV(1,5))**2
2804 HR2=(P(N+2,5)/PV(1,5))**2
2805 IF((1.-HR1-HR2)*(2.+HR1+HR2)*SQRT((1.-HR1-HR2)**2-4.*HR1*HR2).
2806 & LT.2.*RLU(0)) GOTO 130
2807 ND=NP
2808
2809
2810 ELSE
2811 IF(NP.GE.2.AND.PS+PARJ(64).GT.PV(1,5)) GOTO 150
2812 ND=NP
2813 ENDIF
2814
2815
2816 IF(MMAT.EQ.45.AND.MSTJ(25).LE.0) THEN
2817 HLQ=(PARJ(32)/PV(1,5))**2
2818 HUQ=(1.-(P(N+2,5)+PARJ(64))/PV(1,5))**2
2819 HRQ=(P(N+2,5)/PV(1,5))**2
2820 250 HW=HLQ+RLU(0)*(HUQ-HLQ)
2821 IF(HMEPS(HW).LT.RLU(0)) GOTO 250
2822 P(N+1,5)=PV(1,5)*SQRT(HW)
2823
2824
2825 ELSEIF(MMAT.EQ.45) THEN
2826 HQW=(PV(1,5)/PMAS(24,1))**2
2827 HLW=(PARJ(32)/PMAS(24,1))**2
2828 HUW=((PV(1,5)-P(N+2,5)-PARJ(64))/PMAS(24,1))**2
2829 HRQ=(P(N+2,5)/PV(1,5))**2
2830 HG=PMAS(24,2)/PMAS(24,1)
2831 HATL=ATAN((HLW-1.)/HG)
2832 HM=MIN(1.,HUW-0.001)
2833 HMV1=HMEPS(HM/HQW)/((HM-1.)**2+HG**2)
2834 260 HM=HM-HG
2835 HMV2=HMEPS(HM/HQW)/((HM-1.)**2+HG**2)
2836 HSAV1=HMEPS(HM/HQW)
2837 HSAV2=1./((HM-1.)**2+HG**2)
2838 IF(HMV2.GT.HMV1.AND.HM-HG.GT.HLW) THEN
2839 HMV1=HMV2
2840 GOTO 260
2841 ENDIF
2842 HMV=MIN(2.*HMV1,HMEPS(HM/HQW)/HG**2)
2843 HM1=1.-SQRT(1./HMV-HG**2)
2844 IF(HM1.GT.HLW.AND.HM1.LT.HM) THEN
2845 HM=HM1
2846 ELSEIF(HMV2.LE.HMV1) THEN
2847 HM=MAX(HLW,HM-MIN(0.1,1.-HM))
2848 ENDIF
2849 HATM=ATAN((HM-1.)/HG)
2850 HWT1=(HATM-HATL)/HG
2851 HWT2=HMV*(MIN(1.,HUW)-HM)
2852 HWT3=0.
2853 IF(HUW.GT.1.) THEN
2854 HATU=ATAN((HUW-1.)/HG)
2855 HMP1=HMEPS(1./HQW)
2856 HWT3=HMP1*HATU/HG
2857 ENDIF
2858
2859
2860 270 HREG=RLU(0)*(HWT1+HWT2+HWT3)
2861 IF(HREG.LE.HWT1) THEN
2862 HW=1.+HG*TAN(HATL+RLU(0)*(HATM-HATL))
2863 HACC=HMEPS(HW/HQW)
2864 ELSEIF(HREG.LE.HWT1+HWT2) THEN
2865 HW=HM+RLU(0)*(MIN(1.,HUW)-HM)
2866 HACC=HMEPS(HW/HQW)/((HW-1.)**2+HG**2)/HMV
2867 ELSE
2868 HW=1.+HG*TAN(RLU(0)*HATU)
2869 HACC=HMEPS(HW/HQW)/HMP1
2870 ENDIF
2871 IF(HACC.LT.RLU(0)) GOTO 270
2872 P(N+1,5)=PMAS(24,1)*SQRT(HW)
2873 ENDIF
2874
2875
2876 NM=0
2877 MSGN=0
2878 IF(MMAT.EQ.3.OR.MMAT.EQ.46) THEN
2879 IM=K(IP,3)
2880 IF(IM.LT.0.OR.IM.GE.IP) IM=0
2881 IF(IM.NE.0) KFAM=IABS(K(IM,2))
2882 IF(IM.NE.0.AND.MMAT.EQ.3) THEN
2883 DO 280 IL=MAX(IP-2,IM+1),MIN(IP+2,N)
2884 280 IF(K(IL,3).EQ.IM) NM=NM+1
2885 IF(NM.NE.2.OR.KFAM.LE.100.OR.MOD(KFAM,10).NE.1.OR.
2886 & MOD(KFAM/1000,10).NE.0) NM=0
2887 ELSEIF(IM.NE.0.AND.MMAT.EQ.46) THEN
2888 MSGN=ISIGN(1,K(IM,2)*K(IP,2))
2889 IF(KFAM.GT.100.AND.MOD(KFAM/1000,10).EQ.0) MSGN=
2890 & MSGN*(-1)**MOD(KFAM/100,10)
2891 ENDIF
2892 ENDIF
2893
2894
2895 IF(ND.EQ.1) THEN
2896 DO 290 J=1,4
2897 290 P(N+1,J)=P(IP,J)
2898 GOTO 510
2899 ENDIF
2900
2901
2902 PV(ND,5)=P(N+ND,5)
2903 IF(ND.GE.3) THEN
2904 WTMAX=1./WTCOR(ND-2)
2905 PMAX=PV(1,5)-PS+P(N+ND,5)
2906 PMIN=0.
2907 DO 300 IL=ND-1,1,-1
2908 PMAX=PMAX+P(N+IL,5)
2909 PMIN=PMIN+P(N+IL+1,5)
2910 300 WTMAX=WTMAX*PAWT(PMAX,PMIN,P(N+IL,5))
2911 ENDIF
2912
2913
2914 310 IF(ND.EQ.2) THEN
2915 ELSEIF(MMAT.EQ.2) THEN
2916 PMES=4.*PMAS(11,1)**2
2917 PMRHO2=PMAS(131,1)**2
2918 PGRHO2=PMAS(131,2)**2
2919 320 PMST=PMES*(P(IP,5)**2/PMES)**RLU(0)
2920 WT=(1+0.5*PMES/PMST)*SQRT(MAX(0.,1.-PMES/PMST))*
2921 & (1.-PMST/P(IP,5)**2)**3*(1.+PGRHO2/PMRHO2)/
2922 & ((1.-PMST/PMRHO2)**2+PGRHO2/PMRHO2)
2923 IF(WT.LT.RLU(0)) GOTO 320
2924 PV(2,5)=MAX(2.00001*PMAS(11,1),SQRT(PMST))
2925
2926
2927 ELSE
2928 330 RORD(1)=1.
2929 DO 350 IL1=2,ND-1
2930 RSAV=RLU(0)
2931 DO 340 IL2=IL1-1,1,-1
2932 IF(RSAV.LE.RORD(IL2)) GOTO 350
2933 340 RORD(IL2+1)=RORD(IL2)
2934 350 RORD(IL2+1)=RSAV
2935 RORD(ND)=0.
2936 WT=1.
2937 DO 360 IL=ND-1,1,-1
2938 PV(IL,5)=PV(IL+1,5)+P(N+IL,5)+(RORD(IL)-RORD(IL+1))*(PV(1,5)-PS)
2939 360 WT=WT*PAWT(PV(IL,5),PV(IL+1,5),P(N+IL,5))
2940 IF(WT.LT.RLU(0)*WTMAX) GOTO 330
2941 ENDIF
2942
2943
2944 370 DO 390 IL=1,ND-1
2945 PA=PAWT(PV(IL,5),PV(IL+1,5),P(N+IL,5))
2946 UE(3)=2.*RLU(0)-1.
2947 PHI=PARU(2)*RLU(0)
2948 UE(1)=SQRT(1.-UE(3)**2)*COS(PHI)
2949 UE(2)=SQRT(1.-UE(3)**2)*SIN(PHI)
2950 DO 380 J=1,3
2951 P(N+IL,J)=PA*UE(J)
2952 380 PV(IL+1,J)=-PA*UE(J)
2953 P(N+IL,4)=SQRT(PA**2+P(N+IL,5)**2)
2954 390 PV(IL+1,4)=SQRT(PA**2+PV(IL+1,5)**2)
2955
2956
2957 DO 400 J=1,4
2958 400 P(N+ND,J)=PV(ND,J)
2959 DO 430 IL=ND-1,1,-1
2960 DO 410 J=1,3
2961 410 BE(J)=PV(IL,J)/PV(IL,4)
2962 GA=PV(IL,4)/PV(IL,5)
2963 DO 430 I=N+IL,N+ND
2964 BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3)
2965 DO 420 J=1,3
2966 420 P(I,J)=P(I,J)+GA*(GA*BEP/(1.+GA)+P(I,4))*BE(J)
2967 430 P(I,4)=GA*(P(I,4)+BEP)
2968
2969
2970 IF(MMAT.EQ.1) THEN
2971 WT=(P(N+1,5)*P(N+2,5)*P(N+3,5))**2-(P(N+1,5)*FOUR(N+2,N+3))**2
2972 & -(P(N+2,5)*FOUR(N+1,N+3))**2-(P(N+3,5)*FOUR(N+1,N+2))**2
2973 & +2.*FOUR(N+1,N+2)*FOUR(N+1,N+3)*FOUR(N+2,N+3)
2974 IF(MAX(WT*WTCOR(9)/P(IP,5)**6,0.001).LT.RLU(0)) GOTO 310
2975
2976
2977 ELSEIF(MMAT.EQ.2) THEN
2978 FOUR12=FOUR(N+1,N+2)
2979 FOUR13=FOUR(N+1,N+3)
2980 FOUR23=0.5*PMST-0.25*PMES
2981 WT=(PMST-0.5*PMES)*(FOUR12**2+FOUR13**2)+
2982 & PMES*(FOUR12*FOUR13+FOUR12**2+FOUR13**2)
2983 IF(WT.LT.RLU(0)*0.25*PMST*(P(IP,5)**2-PMST)**2) GOTO 370
2984
2985
2986
2987 ELSEIF(MMAT.EQ.3.AND.NM.EQ.2) THEN
2988 IF((P(IP,5)**2*FOUR(IM,N+1)-FOUR(IP,IM)*FOUR(IP,N+1))**2.LE.
2989 & RLU(0)*(FOUR(IP,IM)**2-(P(IP,5)*P(IM,5))**2)*(FOUR(IP,N+1)**2-
2990 & (P(IP,5)*P(N+1,5))**2)) GOTO 370
2991
2992
2993 ELSEIF(MMAT.EQ.4) THEN
2994 HX1=2.*FOUR(IP,N+1)/P(IP,5)**2
2995 HX2=2.*FOUR(IP,N+2)/P(IP,5)**2
2996 HX3=2.*FOUR(IP,N+3)/P(IP,5)**2
2997 WT=((1.-HX1)/(HX2*HX3))**2+((1.-HX2)/(HX1*HX3))**2+
2998 & ((1.-HX3)/(HX1*HX2))**2
2999 IF(WT.LT.2.*RLU(0)) GOTO 310
3000 IF(K(IP+1,2).EQ.22.AND.(1.-HX1)*P(IP,5)**2.LT.4.*PARJ(32)**2)
3001 & GOTO 310
3002
3003
3004 ELSEIF(MMAT.EQ.41) THEN
3005 HX1=2.*FOUR(IP,N+1)/P(IP,5)**2
3006 IF(8.*HX1*(3.-2.*HX1)/9..LT.RLU(0)) GOTO 310
3007
3008
3009 ELSEIF(MMAT.GE.42.AND.MMAT.LE.44.AND.ND.EQ.3) THEN
3010 IF(MBST.EQ.0) WT=FOUR(IP,N+1)*FOUR(N+2,N+3)
3011 IF(MBST.EQ.1) WT=P(IP,5)*P(N+1,4)*FOUR(N+2,N+3)
3012 IF(WT.LT.RLU(0)*P(IP,5)*PV(1,5)**3/WTCOR(10)) GOTO 310
3013 ELSEIF(MMAT.GE.42.AND.MMAT.LE.44) THEN
3014 DO 440 J=1,4
3015 P(N+NP+1,J)=0.
3016 DO 440 IS=N+3,N+NP
3017 440 P(N+NP+1,J)=P(N+NP+1,J)+P(IS,J)
3018 IF(MBST.EQ.0) WT=FOUR(IP,N+1)*FOUR(N+2,N+NP+1)
3019 IF(MBST.EQ.1) WT=P(IP,5)*P(N+1,4)*FOUR(N+2,N+NP+1)
3020 IF(WT.LT.RLU(0)*P(IP,5)*PV(1,5)**3/WTCOR(10)) GOTO 310
3021
3022
3023 ELSEIF(MMAT.EQ.46.AND.MSGN.NE.0) THEN
3024 IF(MSGN.GT.0) WT=FOUR(IM,N+1)*FOUR(N+2,IP+1)
3025 IF(MSGN.LT.0) WT=FOUR(IM,N+2)*FOUR(N+1,IP+1)
3026 IF(WT.LT.RLU(0)*P(IM,5)**4/WTCOR(10)) GOTO 370
3027 ENDIF
3028
3029
3030 IF(MREM.EQ.1) THEN
3031 DO 450 J=1,5
3032 450 PV(1,J)=PV(1,J)/(1.-PQT)
3033 ND=ND+1
3034 MREM=0
3035 ENDIF
3036
3037
3038
3039 IF((MMAT.EQ.31.OR.MMAT.EQ.45).AND.ND.EQ.3) THEN
3040 MSTJ(93)=1
3041 PM2=ULMASS(K(N+2,2))
3042 MSTJ(93)=1
3043 PM3=ULMASS(K(N+3,2))
3044 IF(P(N+2,5)**2+P(N+3,5)**2+2.*FOUR(N+2,N+3).GE.
3045 & (PARJ(32)+PM2+PM3)**2) GOTO 510
3046 K(N+2,1)=1
3047 KFTEMP=K(N+2,2)
3048 CALL LUKFDI(KFTEMP,K(N+3,2),KFLDMP,K(N+2,2))
3049 IF(K(N+2,2).EQ.0) GOTO 150
3050 P(N+2,5)=ULMASS(K(N+2,2))
3051 PS=P(N+1,5)+P(N+2,5)
3052 PV(2,5)=P(N+2,5)
3053 MMAT=0
3054 ND=2
3055 GOTO 370
3056 ELSEIF(MMAT.EQ.44) THEN
3057 MSTJ(93)=1
3058 PM3=ULMASS(K(N+3,2))
3059 MSTJ(93)=1
3060 PM4=ULMASS(K(N+4,2))
3061 IF(P(N+3,5)**2+P(N+4,5)**2+2.*FOUR(N+3,N+4).GE.
3062 & (PARJ(32)+PM3+PM4)**2) GOTO 480
3063 K(N+3,1)=1
3064 KFTEMP=K(N+3,2)
3065 CALL LUKFDI(KFTEMP,K(N+4,2),KFLDMP,K(N+3,2))
3066 IF(K(N+3,2).EQ.0) GOTO 150
3067 P(N+3,5)=ULMASS(K(N+3,2))
3068 DO 460 J=1,3
3069 460 P(N+3,J)=P(N+3,J)+P(N+4,J)
3070 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)
3071 HA=P(N+1,4)**2-P(N+2,4)**2
3072 HB=HA-(P(N+1,5)**2-P(N+2,5)**2)
3073 HC=(P(N+1,1)-P(N+2,1))**2+(P(N+1,2)-P(N+2,2))**2+
3074 & (P(N+1,3)-P(N+2,3))**2
3075 HD=(PV(1,4)-P(N+3,4))**2
3076 HE=HA**2-2.*HD*(P(N+1,4)**2+P(N+2,4)**2)+HD**2
3077 HF=HD*HC-HB**2
3078 HG=HD*HC-HA*HB
3079 HH=(SQRT(HG**2+HE*HF)-HG)/(2.*HF)
3080 DO 470 J=1,3
3081 PCOR=HH*(P(N+1,J)-P(N+2,J))
3082 P(N+1,J)=P(N+1,J)+PCOR
3083 470 P(N+2,J)=P(N+2,J)-PCOR
3084 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)
3085 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)
3086 ND=ND-1
3087 ENDIF
3088
3089
3090 480 IF(MMAT.GE.42.AND.MMAT.LE.44.AND.IABS(K(N+1,2)).LT.10) THEN
3091 PMR=SQRT(MAX(0.,P(N+1,5)**2+P(N+2,5)**2+2.*FOUR(N+1,N+2)))
3092 MSTJ(93)=1
3093 PM1=ULMASS(K(N+1,2))
3094 MSTJ(93)=1
3095 PM2=ULMASS(K(N+2,2))
3096 IF(PMR.GT.PARJ(32)+PM1+PM2) GOTO 490
3097 KFLDUM=INT(1.5+RLU(0))
3098 CALL LUKFDI(K(N+1,2),-ISIGN(KFLDUM,K(N+1,2)),KFLDMP,KF1)
3099 CALL LUKFDI(K(N+2,2),-ISIGN(KFLDUM,K(N+2,2)),KFLDMP,KF2)
3100 IF(KF1.EQ.0.OR.KF2.EQ.0) GOTO 150
3101 PSM=ULMASS(KF1)+ULMASS(KF2)
3102 IF(MMAT.EQ.42.AND.PMR.GT.PARJ(64)+PSM) GOTO 490
3103 IF(MMAT.GE.43.AND.PMR.GT.0.2*PARJ(32)+PSM) GOTO 490
3104 IF(ND.EQ.4.OR.KFA.EQ.15) GOTO 150
3105 K(N+1,1)=1
3106 KFTEMP=K(N+1,2)
3107 CALL LUKFDI(KFTEMP,K(N+2,2),KFLDMP,K(N+1,2))
3108 IF(K(N+1,2).EQ.0) GOTO 150
3109 P(N+1,5)=ULMASS(K(N+1,2))
3110 K(N+2,2)=K(N+3,2)
3111 P(N+2,5)=P(N+3,5)
3112 PS=P(N+1,5)+P(N+2,5)
3113 PV(2,5)=P(N+3,5)
3114 MMAT=0
3115 ND=2
3116 GOTO 370
3117 ENDIF
3118
3119
3120 490 IF(MMAT.EQ.42.AND.IABS(K(N+1,2)).LT.10) THEN
3121 KFLO(1)=K(N+1,2)
3122 KFLO(2)=K(N+2,2)
3123 K(N+1,1)=K(N+3,1)
3124 K(N+1,2)=K(N+3,2)
3125 DO 500 J=1,5
3126 PV(1,J)=P(N+1,J)+P(N+2,J)
3127 500 P(N+1,J)=P(N+3,J)
3128 PV(1,5)=PMR
3129 N=N+1
3130 NP=0
3131 NQ=2
3132 PS=0.
3133 MSTJ(93)=2
3134 PSQ=ULMASS(KFLO(1))
3135 MSTJ(93)=2
3136 PSQ=PSQ+ULMASS(KFLO(2))
3137 MMAT=11
3138 GOTO 180
3139 ENDIF
3140
3141
3142 510 N=N+ND
3143 IF(MBST.EQ.1) THEN
3144 DO 520 J=1,3
3145 520 BE(J)=P(IP,J)/P(IP,4)
3146 GA=P(IP,4)/P(IP,5)
3147 DO 540 I=NSAV+1,N
3148 BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3)
3149 DO 530 J=1,3
3150 530 P(I,J)=P(I,J)+GA*(GA*BEP/(1.+GA)+P(I,4))*BE(J)
3151 540 P(I,4)=GA*(P(I,4)+BEP)
3152 ENDIF
3153
3154
3155 DO 560 I=NSAV+1,N
3156 DO 550 J=1,4
3157 550 V(I,J)=VDCY(J)
3158 560 V(I,5)=0.
3159
3160
3161 IF(MSTJ(23).GE.1.AND.MMAT.EQ.4.AND.K(NSAV+1,2).EQ.21) THEN
3162 K(NSAV+1,1)=3
3163 K(NSAV+2,1)=3
3164 K(NSAV+3,1)=3
3165 K(NSAV+1,4)=MSTU(5)*(NSAV+2)
3166 K(NSAV+1,5)=MSTU(5)*(NSAV+3)
3167 K(NSAV+2,4)=MSTU(5)*(NSAV+3)
3168 K(NSAV+2,5)=MSTU(5)*(NSAV+1)
3169 K(NSAV+3,4)=MSTU(5)*(NSAV+1)
3170 K(NSAV+3,5)=MSTU(5)*(NSAV+2)
3171 MSTJ(92)=-(NSAV+1)
3172 ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.4) THEN
3173 K(NSAV+2,1)=3
3174 K(NSAV+3,1)=3
3175 K(NSAV+2,4)=MSTU(5)*(NSAV+3)
3176 K(NSAV+2,5)=MSTU(5)*(NSAV+3)
3177 K(NSAV+3,4)=MSTU(5)*(NSAV+2)
3178 K(NSAV+3,5)=MSTU(5)*(NSAV+2)
3179 MSTJ(92)=NSAV+2
3180 ELSEIF(MSTJ(23).GE.1.AND.(MMAT.EQ.32.OR.MMAT.EQ.44.OR.MMAT.EQ.46).
3181 &AND.IABS(K(NSAV+1,2)).LE.10.AND.IABS(K(NSAV+2,2)).LE.10) THEN
3182 K(NSAV+1,1)=3
3183 K(NSAV+2,1)=3
3184 K(NSAV+1,4)=MSTU(5)*(NSAV+2)
3185 K(NSAV+1,5)=MSTU(5)*(NSAV+2)
3186 K(NSAV+2,4)=MSTU(5)*(NSAV+1)
3187 K(NSAV+2,5)=MSTU(5)*(NSAV+1)
3188 MSTJ(92)=NSAV+1
3189 ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.33.AND.IABS(K(NSAV+2,2)).EQ.21)
3190 &THEN
3191 K(NSAV+1,1)=3
3192 K(NSAV+2,1)=3
3193 K(NSAV+3,1)=3
3194 KCP=LUCOMP(K(NSAV+1,2))
3195 KQP=KCHG(KCP,2)*ISIGN(1,K(NSAV+1,2))
3196 JCON=4
3197 IF(KQP.LT.0) JCON=5
3198 K(NSAV+1,JCON)=MSTU(5)*(NSAV+2)
3199 K(NSAV+2,9-JCON)=MSTU(5)*(NSAV+1)
3200 K(NSAV+2,JCON)=MSTU(5)*(NSAV+3)
3201 K(NSAV+3,9-JCON)=MSTU(5)*(NSAV+2)
3202 MSTJ(92)=NSAV+1
3203 ELSEIF(MSTJ(23).GE.1.AND.MMAT.EQ.33) THEN
3204 K(NSAV+1,1)=3
3205 K(NSAV+3,1)=3
3206 K(NSAV+1,4)=MSTU(5)*(NSAV+3)
3207 K(NSAV+1,5)=MSTU(5)*(NSAV+3)
3208 K(NSAV+3,4)=MSTU(5)*(NSAV+1)
3209 K(NSAV+3,5)=MSTU(5)*(NSAV+1)
3210 MSTJ(92)=NSAV+1
3211 ENDIF
3212
3213
3214 IF(K(IP,1).EQ.5) K(IP,1)=15
3215 IF(K(IP,1).LE.10) K(IP,1)=11
3216 K(IP,4)=NSAV+1
3217 K(IP,5)=N
3218
3219 RETURN
3220 END
3221
3222
3223
3224 SUBROUTINE LUKFDI(KFL1,KFL2,KFL3,KF)
3225
3226
3227 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
3228 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
3229 SAVE
3230
3231
3232 KF1A=IABS(KFL1)
3233 KF2A=IABS(KFL2)
3234 KFL3=0
3235 KF=0
3236 IF(KF1A.EQ.0) RETURN
3237 IF(KF2A.NE.0) THEN
3238 IF(KF1A.LE.10.AND.KF2A.LE.10.AND.KFL1*KFL2.GT.0) RETURN
3239 IF(KF1A.GT.10.AND.KF2A.GT.10) RETURN
3240 IF((KF1A.GT.10.OR.KF2A.GT.10).AND.KFL1*KFL2.LT.0) RETURN
3241 ENDIF
3242
3243
3244 IF(MSTJ(15).EQ.1) THEN
3245 KTAB1=-1
3246 IF(KF1A.GE.1.AND.KF1A.LE.6) KTAB1=KF1A
3247 KFL1A=MOD(KF1A/1000,10)
3248 KFL1B=MOD(KF1A/100,10)
3249 KFL1S=MOD(KF1A,10)
3250 IF(KFL1A.GE.1.AND.KFL1A.LE.4.AND.KFL1B.GE.1.AND.KFL1B.LE.4)
3251 & KTAB1=6+KFL1A*(KFL1A-2)+2*KFL1B+(KFL1S-1)/2
3252 IF(KFL1A.GE.1.AND.KFL1A.LE.4.AND.KFL1A.EQ.KFL1B) KTAB1=KTAB1-1
3253 IF(KF1A.GE.1.AND.KF1A.LE.6) KFL1A=KF1A
3254 KTAB2=0
3255 IF(KF2A.NE.0) THEN
3256 KTAB2=-1
3257 IF(KF2A.GE.1.AND.KF2A.LE.6) KTAB2=KF2A
3258 KFL2A=MOD(KF2A/1000,10)
3259 KFL2B=MOD(KF2A/100,10)
3260 KFL2S=MOD(KF2A,10)
3261 IF(KFL2A.GE.1.AND.KFL2A.LE.4.AND.KFL2B.GE.1.AND.KFL2B.LE.4)
3262 & KTAB2=6+KFL2A*(KFL2A-2)+2*KFL2B+(KFL2S-1)/2
3263 IF(KFL2A.GE.1.AND.KFL2A.LE.4.AND.KFL2A.EQ.KFL2B) KTAB2=KTAB2-1
3264 ENDIF
3265 IF(KTAB1.GE.0.AND.KTAB2.GE.0) GOTO 140
3266 ENDIF
3267
3268
3269 100 PAR2=PARJ(2)
3270 PAR3=PARJ(3)
3271 PAR4=3.*PARJ(4)
3272 IF(MSTJ(12).GE.2) THEN
3273 PAR3M=SQRT(PARJ(3))
3274 PAR4M=1./(3.*SQRT(PARJ(4)))
3275 PARDM=PARJ(7)/(PARJ(7)+PAR3M*PARJ(6))
3276 PARS0=PARJ(5)*(2.+(1.+PAR2*PAR3M*PARJ(7))*(1.+PAR4M))
3277 PARS1=PARJ(7)*PARS0/(2.*PAR3M)+PARJ(5)*(PARJ(6)*(1.+PAR4M)+
3278 & PAR2*PAR3M*PARJ(6)*PARJ(7))
3279 PARS2=PARJ(5)*2.*PARJ(6)*PARJ(7)*(PAR2*PARJ(7)+(1.+PAR4M)/PAR3M)
3280 PARSM=MAX(PARS0,PARS1,PARS2)
3281 PAR4=PAR4*(1.+PARSM)/(1.+PARSM/(3.*PAR4M))
3282 ENDIF
3283
3284
3285 MBARY=0
3286 KFDA=0
3287 IF(KF1A.LE.10) THEN
3288 IF(KF2A.EQ.0.AND.MSTJ(12).GE.1.AND.(1.+PARJ(1))*RLU(0).GT.1.)
3289 & MBARY=1
3290 IF(KF2A.GT.10) MBARY=2
3291 IF(KF2A.GT.10.AND.KF2A.LE.10000) KFDA=KF2A
3292 ELSE
3293 MBARY=2
3294 IF(KF1A.LE.10000) KFDA=KF1A
3295 ENDIF
3296
3297
3298 IF(KFDA.NE.0.AND.MSTJ(12).GE.2) THEN
3299 KFLDA=MOD(KFDA/1000,10)
3300 KFLDB=MOD(KFDA/100,10)
3301 KFLDS=MOD(KFDA,10)
3302 WTDQ=PARS0
3303 IF(MAX(KFLDA,KFLDB).EQ.3) WTDQ=PARS1
3304 IF(MIN(KFLDA,KFLDB).EQ.3) WTDQ=PARS2
3305 IF(KFLDS.EQ.1) WTDQ=WTDQ/(3.*PAR4M)
3306 IF((1.+WTDQ)*RLU(0).GT.1.) MBARY=-1
3307 IF(MBARY.EQ.-1.AND.KF2A.NE.0) RETURN
3308 ENDIF
3309
3310
3311 IF(MBARY.LE.0) THEN
3312 KFS=ISIGN(1,KFL1)
3313 IF(MBARY.EQ.0) THEN
3314 IF(KF2A.EQ.0) KFL3=ISIGN(1+INT((2.+PAR2)*RLU(0)),-KFL1)
3315 KFLA=MAX(KF1A,KF2A+IABS(KFL3))
3316 KFLB=MIN(KF1A,KF2A+IABS(KFL3))
3317 IF(KFLA.NE.KF1A) KFS=-KFS
3318
3319
3320 ELSE
3321 KFL1A=MOD(KF1A/1000,10)
3322 KFL1B=MOD(KF1A/100,10)
3323 110 KFL1D=KFL1A+INT(RLU(0)+0.5)*(KFL1B-KFL1A)
3324 KFL1E=KFL1A+KFL1B-KFL1D
3325 IF((KFL1D.EQ.3.AND.RLU(0).GT.PARDM).OR.(KFL1E.EQ.3.AND.
3326 & RLU(0).LT.PARDM)) THEN
3327 KFL1D=KFL1A+KFL1B-KFL1D
3328 KFL1E=KFL1A+KFL1B-KFL1E
3329 ENDIF
3330 KFL3A=1+INT((2.+PAR2*PAR3M*PARJ(7))*RLU(0))
3331 IF((KFL1E.NE.KFL3A.AND.RLU(0).GT.(1.+PAR4M)/MAX(2.,1.+PAR4M)).
3332 & OR.(KFL1E.EQ.KFL3A.AND.RLU(0).GT.2./MAX(2.,1.+PAR4M)))
3333 & GOTO 110
3334 KFLDS=3
3335 IF(KFL1E.NE.KFL3A) KFLDS=2*INT(RLU(0)+1./(1.+PAR4M))+1
3336 KFL3=ISIGN(10000+1000*MAX(KFL1E,KFL3A)+100*MIN(KFL1E,KFL3A)+
3337 & KFLDS,-KFL1)
3338 KFLA=MAX(KFL1D,KFL3A)
3339 KFLB=MIN(KFL1D,KFL3A)
3340 IF(KFLA.NE.KFL1D) KFS=-KFS
3341 ENDIF
3342
3343
3344 IF(KFLA.LE.2) KMUL=INT(PARJ(11)+RLU(0))
3345 IF(KFLA.EQ.3) KMUL=INT(PARJ(12)+RLU(0))
3346 IF(KFLA.GE.4) KMUL=INT(PARJ(13)+RLU(0))
3347 IF(KMUL.EQ.0.AND.PARJ(14).GT.0.) THEN
3348 IF(RLU(0).LT.PARJ(14)) KMUL=2
3349 ELSEIF(KMUL.EQ.1.AND.PARJ(15)+PARJ(16)+PARJ(17).GT.0.) THEN
3350 RMUL=RLU(0)
3351 IF(RMUL.LT.PARJ(15)) KMUL=3
3352 IF(KMUL.EQ.1.AND.RMUL.LT.PARJ(15)+PARJ(16)) KMUL=4
3353 IF(KMUL.EQ.1.AND.RMUL.LT.PARJ(15)+PARJ(16)+PARJ(17)) KMUL=5
3354 ENDIF
3355 KFLS=3
3356 IF(KMUL.EQ.0.OR.KMUL.EQ.3) KFLS=1
3357 IF(KMUL.EQ.5) KFLS=5
3358 IF(KFLA.NE.KFLB) THEN
3359 KF=(100*KFLA+10*KFLB+KFLS)*KFS*(-1)**KFLA
3360 ELSE
3361 RMIX=RLU(0)
3362 IMIX=2*KFLA+10*KMUL
3363 IF(KFLA.LE.3) KF=110*(1+INT(RMIX+PARF(IMIX-1))+
3364 & INT(RMIX+PARF(IMIX)))+KFLS
3365 IF(KFLA.GE.4) KF=110*KFLA+KFLS
3366 ENDIF
3367 IF(KMUL.EQ.2.OR.KMUL.EQ.3) KF=KF+ISIGN(10000,KF)
3368 IF(KMUL.EQ.4) KF=KF+ISIGN(20000,KF)
3369
3370
3371 ELSE
3372 120 IF(KF1A.LE.10.AND.KF2A.EQ.0) THEN
3373 KFLA=KF1A
3374 130 KFLB=1+INT((2.+PAR2*PAR3)*RLU(0))
3375 KFLC=1+INT((2.+PAR2*PAR3)*RLU(0))
3376 KFLDS=1
3377 IF(KFLB.GE.KFLC) KFLDS=3
3378 IF(KFLDS.EQ.1.AND.PAR4*RLU(0).GT.1.) GOTO 130
3379 IF(KFLDS.EQ.3.AND.PAR4.LT.RLU(0)) GOTO 130
3380 KFL3=ISIGN(1000*MAX(KFLB,KFLC)+100*MIN(KFLB,KFLC)+KFLDS,KFL1)
3381
3382
3383 ELSEIF(KF1A.LE.10) THEN
3384 KFLA=KF1A
3385 KFLB=MOD(KF2A/1000,10)
3386 KFLC=MOD(KF2A/100,10)
3387 KFLDS=MOD(KF2A,10)
3388
3389
3390 ELSE
3391 IF(KF2A.EQ.0) KFL3=ISIGN(1+INT((2.+PAR2)*RLU(0)),KFL1)
3392 KFLA=KF2A+IABS(KFL3)
3393 KFLB=MOD(KF1A/1000,10)
3394 KFLC=MOD(KF1A/100,10)
3395 KFLDS=MOD(KF1A,10)
3396 ENDIF
3397
3398
3399 KBARY=KFLDS
3400 IF(KFLDS.EQ.3.AND.KFLB.NE.KFLC) KBARY=5
3401 IF(KFLA.NE.KFLB.AND.KFLA.NE.KFLC) KBARY=KBARY+1
3402 WT=PARF(60+KBARY)+PARJ(18)*PARF(70+KBARY)
3403 IF(MBARY.EQ.1.AND.MSTJ(12).GE.2) THEN
3404 WTDQ=PARS0
3405 IF(MAX(KFLB,KFLC).EQ.3) WTDQ=PARS1
3406 IF(MIN(KFLB,KFLC).EQ.3) WTDQ=PARS2
3407 IF(KFLDS.EQ.1) WTDQ=WTDQ/(3.*PAR4M)
3408 IF(KFLDS.EQ.1) WT=WT*(1.+WTDQ)/(1.+PARSM/(3.*PAR4M))
3409 IF(KFLDS.EQ.3) WT=WT*(1.+WTDQ)/(1.+PARSM)
3410 ENDIF
3411 IF(KF2A.EQ.0.AND.WT.LT.RLU(0)) GOTO 120
3412
3413
3414 KFLD=MAX(KFLA,KFLB,KFLC)
3415 KFLF=MIN(KFLA,KFLB,KFLC)
3416 KFLE=KFLA+KFLB+KFLC-KFLD-KFLF
3417 KFLS=2
3418 IF((PARF(60+KBARY)+PARJ(18)*PARF(70+KBARY))*RLU(0).GT.
3419 & PARF(60+KBARY)) KFLS=4
3420 KFLL=0
3421 IF(KFLS.EQ.2.AND.KFLD.GT.KFLE.AND.KFLE.GT.KFLF) THEN
3422 IF(KFLDS.EQ.1.AND.KFLA.EQ.KFLD) KFLL=1
3423 IF(KFLDS.EQ.1.AND.KFLA.NE.KFLD) KFLL=INT(0.25+RLU(0))
3424 IF(KFLDS.EQ.3.AND.KFLA.NE.KFLD) KFLL=INT(0.75+RLU(0))
3425 ENDIF
3426 IF(KFLL.EQ.0) KF=ISIGN(1000*KFLD+100*KFLE+10*KFLF+KFLS,KFL1)
3427 IF(KFLL.EQ.1) KF=ISIGN(1000*KFLD+100*KFLF+10*KFLE+KFLS,KFL1)
3428 ENDIF
3429 RETURN
3430
3431
3432 140 IF(KTAB2.EQ.0.AND.MSTJ(12).LE.0) THEN
3433 KT3L=1
3434 KT3U=6
3435 ELSEIF(KTAB2.EQ.0.AND.KTAB1.GE.7.AND.MSTJ(12).LE.1) THEN
3436 KT3L=1
3437 KT3U=6
3438 ELSEIF(KTAB2.EQ.0) THEN
3439 KT3L=1
3440 KT3U=22
3441 ELSE
3442 KT3L=KTAB2
3443 KT3U=KTAB2
3444 ENDIF
3445 RFL=0.
3446 DO 150 KTS=0,2
3447 DO 150 KT3=KT3L,KT3U
3448 RFL=RFL+PARF(120+80*KTAB1+25*KTS+KT3)
3449 150 CONTINUE
3450 RFL=RLU(0)*RFL
3451 DO 160 KTS=0,2
3452 KTABS=KTS
3453 DO 160 KT3=KT3L,KT3U
3454 KTAB3=KT3
3455 RFL=RFL-PARF(120+80*KTAB1+25*KTS+KT3)
3456 160 IF(RFL.LE.0.) GOTO 170
3457 170 CONTINUE
3458
3459
3460 IF(KTAB3.LE.6) THEN
3461 KFL3A=KTAB3
3462 KFL3B=0
3463 KFL3=ISIGN(KFL3A,KFL1*(2*KTAB1-13))
3464 ELSE
3465 KFL3A=1
3466 IF(KTAB3.GE.8) KFL3A=2
3467 IF(KTAB3.GE.11) KFL3A=3
3468 IF(KTAB3.GE.16) KFL3A=4
3469 KFL3B=(KTAB3-6-KFL3A*(KFL3A-2))/2
3470 KFL3=1000*KFL3A+100*KFL3B+1
3471 IF(KFL3A.EQ.KFL3B.OR.KTAB3.NE.6+KFL3A*(KFL3A-2)+2*KFL3B) KFL3=
3472 & KFL3+2
3473 KFL3=ISIGN(KFL3,KFL1*(13-2*KTAB1))
3474 ENDIF
3475
3476
3477 IF(KFL3A.EQ.KFL1A.AND.KFL3B.EQ.KFL1B.AND.(KFL3A.LE.3.OR.
3478 &KFL3B.NE.0)) THEN
3479 RFL=RLU(0)*(PARF(143+80*KTAB1+25*KTABS)+PARF(144+80*KTAB1+
3480 & 25*KTABS)+PARF(145+80*KTAB1+25*KTABS))
3481 KF=110+2*KTABS+1
3482 IF(RFL.GT.PARF(143+80*KTAB1+25*KTABS)) KF=220+2*KTABS+1
3483 IF(RFL.GT.PARF(143+80*KTAB1+25*KTABS)+PARF(144+80*KTAB1+
3484 & 25*KTABS)) KF=330+2*KTABS+1
3485 ELSEIF(KTAB1.LE.6.AND.KTAB3.LE.6) THEN
3486 KFLA=MAX(KTAB1,KTAB3)
3487 KFLB=MIN(KTAB1,KTAB3)
3488 KFS=ISIGN(1,KFL1)
3489 IF(KFLA.NE.KF1A) KFS=-KFS
3490 KF=(100*KFLA+10*KFLB+2*KTABS+1)*KFS*(-1)**KFLA
3491 ELSEIF(KTAB1.GE.7.AND.KTAB3.GE.7) THEN
3492 KFS=ISIGN(1,KFL1)
3493 IF(KFL1A.EQ.KFL3A) THEN
3494 KFLA=MAX(KFL1B,KFL3B)
3495 KFLB=MIN(KFL1B,KFL3B)
3496 IF(KFLA.NE.KFL1B) KFS=-KFS
3497 ELSEIF(KFL1A.EQ.KFL3B) THEN
3498 KFLA=KFL3A
3499 KFLB=KFL1B
3500 KFS=-KFS
3501 ELSEIF(KFL1B.EQ.KFL3A) THEN
3502 KFLA=KFL1A
3503 KFLB=KFL3B
3504 ELSEIF(KFL1B.EQ.KFL3B) THEN
3505 KFLA=MAX(KFL1A,KFL3A)
3506 KFLB=MIN(KFL1A,KFL3A)
3507 IF(KFLA.NE.KFL1A) KFS=-KFS
3508 ELSE
3509 CALL LUERRM(2,'(LUKFDI:) no matching flavours for qq -> qq')
3510 GOTO 100
3511 ENDIF
3512 KF=(100*KFLA+10*KFLB+2*KTABS+1)*KFS*(-1)**KFLA
3513
3514
3515 ELSE
3516 IF(KTAB1.GE.7) THEN
3517 KFLA=KFL3A
3518 KFLB=KFL1A
3519 KFLC=KFL1B
3520 ELSE
3521 KFLA=KFL1A
3522 KFLB=KFL3A
3523 KFLC=KFL3B
3524 ENDIF
3525 KFLD=MAX(KFLA,KFLB,KFLC)
3526 KFLF=MIN(KFLA,KFLB,KFLC)
3527 KFLE=KFLA+KFLB+KFLC-KFLD-KFLF
3528 IF(KTABS.EQ.0) KF=ISIGN(1000*KFLD+100*KFLF+10*KFLE+2,KFL1)
3529 IF(KTABS.GE.1) KF=ISIGN(1000*KFLD+100*KFLE+10*KFLF+2*KTABS,KFL1)
3530 ENDIF
3531
3532
3533 IF(KFL2.NE.0) KFL3=0
3534 KC=LUCOMP(KF)
3535 IF(KC.EQ.0) THEN
3536 CALL LUERRM(2,'(LUKFDI:) user-defined flavour probabilities '//
3537 & 'failed')
3538 GOTO 100
3539 ENDIF
3540
3541 RETURN
3542 END
3543
3544
3545
3546 SUBROUTINE LUPTDI(KFL,PX,PY)
3547
3548
3549 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
3550 SAVE
3551
3552
3553 KFLA=IABS(KFL)
3554 PT=PARJ(21)*SQRT(-LOG(MAX(1E-10,RLU(0))))
3555 IF(MSTJ(91).EQ.1) PT=PARJ(22)*PT
3556 IF(KFLA.EQ.0.AND.MSTJ(13).LE.0) PT=0.
3557 PHI=PARU(2)*RLU(0)
3558 PX=PT*COS(PHI)
3559 PY=PT*SIN(PHI)
3560
3561 RETURN
3562 END
3563
3564
3565
3566 SUBROUTINE LUZDIS(KFL1,KFL2,PR,Z)
3567
3568
3569 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
3570 SAVE /LUDAT1/
3571
3572
3573 KFLA=IABS(KFL1)
3574 KFLB=IABS(KFL2)
3575 ZDIVC=0.
3576 ZDIV=0.
3577 fint=0.
3578 KFLH=KFLA
3579 IF(KFLA.GE.10) KFLH=MOD(KFLA/1000,10)
3580
3581
3582 IF(MSTJ(11).EQ.1.OR.(MSTJ(11).EQ.3.AND.KFLH.LE.3)) THEN
3583 FA=PARJ(41)
3584 IF(MSTJ(91).EQ.1) FA=PARJ(43)
3585 IF(KFLB.GE.10) FA=FA+PARJ(45)
3586 FB=PARJ(42)*PR
3587 IF(MSTJ(91).EQ.1) FB=PARJ(44)*PR
3588 FC=1.
3589 IF(KFLA.GE.10) FC=FC-PARJ(45)
3590 IF(KFLB.GE.10) FC=FC+PARJ(45)
3591 MC=1
3592 IF(ABS(FC-1.).GT.0.01) MC=2
3593
3594
3595 IF(FA.LT.0.02) THEN
3596 MA=1
3597 ZMAX=1.
3598 IF(FC.GT.FB) ZMAX=FB/FC
3599 ELSEIF(ABS(FC-FA).LT.0.01) THEN
3600 MA=2
3601 ZMAX=FB/(FB+FC)
3602 ELSE
3603 MA=3
3604 ZMAX=0.5*(FB+FC-SQRT((FB-FC)**2+4.*FA*FB))/(FC-FA)
3605 IF(ZMAX.GT.0.99.AND.FB.GT.100.) ZMAX=1.-FA/FB
3606 ENDIF
3607
3608
3609 MMAX=2
3610 IF(ZMAX.LT.0.1) THEN
3611 MMAX=1
3612 ZDIV=2.75*ZMAX
3613 IF(MC.EQ.1) THEN
3614 FINT=1.-LOG(ZDIV)
3615 ELSE
3616 ZDIVC=ZDIV**(1.-FC)
3617 FINT=1.+(1.-1./ZDIVC)/(FC-1.)
3618 ENDIF
3619 ELSEIF(ZMAX.GT.0.85.AND.FB.GT.1.) THEN
3620 MMAX=3
3621 FSCB=SQRT(4.+(FC/FB)**2)
3622 ZDIV=FSCB-1./ZMAX-(FC/FB)*LOG(ZMAX*0.5*(FSCB+FC/FB))
3623 IF(MA.GE.2) ZDIV=ZDIV+(FA/FB)*LOG(1.-ZMAX)
3624 ZDIV=MIN(ZMAX,MAX(0.,ZDIV))
3625 FINT=1.+FB*(1.-ZDIV)
3626 ENDIF
3627
3628
3629 100 Z=RLU(0)
3630 FPRE=1.
3631 IF(MMAX.EQ.1) THEN
3632 IF(FINT*RLU(0).LE.1.) THEN
3633 Z=ZDIV*Z
3634 ELSEIF(MC.EQ.1) THEN
3635 Z=ZDIV**Z
3636 FPRE=ZDIV/Z
3637 ELSE
3638 Z=1./(ZDIVC+Z*(1.-ZDIVC))**(1./(1.-FC))
3639 FPRE=(ZDIV/Z)**FC
3640 ENDIF
3641 ELSEIF(MMAX.EQ.3) THEN
3642 IF(FINT*RLU(0).LE.1.) THEN
3643 Z=ZDIV+LOG(Z)/FB
3644 FPRE=EXP(FB*(Z-ZDIV))
3645 ELSE
3646 Z=ZDIV+Z*(1.-ZDIV)
3647 ENDIF
3648 ENDIF
3649
3650
3651 IF(Z.LE.FB/(50.+FB).OR.Z.GE.1.) GOTO 100
3652 FVAL=(ZMAX/Z)**FC*EXP(FB*(1./ZMAX-1./Z))
3653 IF(MA.GE.2) FVAL=((1.-Z)/(1.-ZMAX))**FA*FVAL
3654 IF(FVAL.LT.RLU(0)*FPRE) GOTO 100
3655
3656
3657 ELSE
3658 FC=PARJ(50+MAX(1,KFLH))
3659 IF(MSTJ(91).EQ.1) FC=PARJ(59)
3660 110 Z=RLU(0)
3661 IF(FC.GE.0..AND.FC.LE.1.) THEN
3662 IF(FC.GT.RLU(0)) Z=1.-Z**(1./3.)
3663 ELSEIF(FC.GT.-1.) THEN
3664 IF(-4.*FC*Z*(1.-Z)**2.LT.RLU(0)*((1.-Z)**2-FC*Z)**2) GOTO 110
3665 ELSE
3666 IF(FC.GT.0.) Z=1.-Z**(1./FC)
3667 IF(FC.LT.0.) Z=Z**(-1./FC)
3668 ENDIF
3669 ENDIF
3670
3671 RETURN
3672 END
3673
3674
3675
3676 SUBROUTINE LUSHOW(IP1,IP2,QMAX)
3677
3678
3679 IMPLICIT DOUBLE PRECISION(D)
3680 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
3681 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
3682 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
3683 DIMENSION PMTH(5,40),PS(5),PMA(4),PMSD(4),IEP(4),IPA(4),
3684 &KFLA(4),KFLD(4),KFL(4),ITRY(4),ISI(4),ISL(4),DP(4),DPT(5,4)
3685 SAVE
3686
3687
3688 IF(MSTJ(41).LE.0.OR.(MSTJ(41).EQ.1.AND.QMAX.LE.PARJ(82)).OR.
3689 &QMAX.LE.MIN(PARJ(82),PARJ(83)).OR.MSTJ(41).GE.3) RETURN
3690 PMTH(1,21)=ULMASS(21)
3691 PMTH(2,21)=SQRT(PMTH(1,21)**2+0.25*PARJ(82)**2)
3692 PMTH(3,21)=2.*PMTH(2,21)
3693 PMTH(4,21)=PMTH(3,21)
3694 PMTH(5,21)=PMTH(3,21)
3695 PMTH(1,22)=ULMASS(22)
3696 PMTH(2,22)=SQRT(PMTH(1,22)**2+0.25*PARJ(83)**2)
3697 PMTH(3,22)=2.*PMTH(2,22)
3698 PMTH(4,22)=PMTH(3,22)
3699 PMTH(5,22)=PMTH(3,22)
3700 PMQTH1=PARJ(82)
3701 IF(MSTJ(41).EQ.2) PMQTH1=MIN(PARJ(82),PARJ(83))
3702 PMQTH2=PMTH(2,21)
3703 IF(MSTJ(41).EQ.2) PMQTH2=MIN(PMTH(2,21),PMTH(2,22))
3704 DO 100 IF=1,8
3705 PMTH(1,IF)=ULMASS(IF)
3706 PMTH(2,IF)=SQRT(PMTH(1,IF)**2+0.25*PMQTH1**2)
3707 PMTH(3,IF)=PMTH(2,IF)+PMQTH2
3708 PMTH(4,IF)=SQRT(PMTH(1,IF)**2+0.25*PARJ(82)**2)+PMTH(2,21)
3709 100 PMTH(5,IF)=SQRT(PMTH(1,IF)**2+0.25*PARJ(83)**2)+PMTH(2,22)
3710 PT2MIN=MAX(0.5*PARJ(82),1.1*PARJ(81))**2
3711 ALAMS=PARJ(81)**2
3712 ALFM=LOG(PT2MIN/ALAMS)
3713
3714
3715 M3JC=0
3716 IF(IP1.GT.0.AND.IP1.LE.MIN(N,MSTU(4)-MSTU(32)).AND.IP2.EQ.0) THEN
3717 NPA=1
3718 IPA(1)=IP1
3719 ELSEIF(MIN(IP1,IP2).GT.0.AND.MAX(IP1,IP2).LE.MIN(N,MSTU(4)-
3720 &MSTU(32))) THEN
3721 NPA=2
3722 IPA(1)=IP1
3723 IPA(2)=IP2
3724 ELSEIF(IP1.GT.0.AND.IP1.LE.MIN(N,MSTU(4)-MSTU(32)).AND.IP2.LT.0.
3725 &AND.IP2.GE.-3) THEN
3726 NPA=IABS(IP2)
3727 DO 110 I=1,NPA
3728 110 IPA(I)=IP1+I-1
3729 ELSE
3730 CALL LUERRM(12,
3731 & '(LUSHOW:) failed to reconstruct showering system')
3732 IF(MSTU(21).GE.1) RETURN
3733 ENDIF
3734
3735
3736 IREJ=0
3737 DO 120 J=1,5
3738 120 PS(J)=0.
3739 PM=0.
3740 DO 130 I=1,NPA
3741 KFLA(I)=IABS(K(IPA(I),2))
3742 PMA(I)=P(IPA(I),5)
3743 IF(KFLA(I).NE.0.AND.(KFLA(I).LE.8.OR.KFLA(I).EQ.21))
3744 &PMA(I)=PMTH(3,KFLA(I))
3745 PM=PM+PMA(I)
3746 IF(KFLA(I).EQ.0.OR.(KFLA(I).GT.8.AND.KFLA(I).NE.21).OR.
3747 &PMA(I).GT.QMAX) IREJ=IREJ+1
3748 DO 130 J=1,4
3749 130 PS(J)=PS(J)+P(IPA(I),J)
3750 IF(IREJ.EQ.NPA) RETURN
3751 PS(5)=SQRT(MAX(0.,PS(4)**2-PS(1)**2-PS(2)**2-PS(3)**2))
3752 IF(NPA.EQ.1) PS(5)=PS(4)
3753 IF(PS(5).LE.PM+PMQTH1) RETURN
3754 IF(NPA.EQ.2.AND.MSTJ(47).GE.1) THEN
3755 IF(KFLA(1).GE.1.AND.KFLA(1).LE.8.AND.KFLA(2).GE.1.AND.
3756 & KFLA(2).LE.8) M3JC=1
3757 IF(MSTJ(47).GE.2) M3JC=1
3758 ENDIF
3759
3760
3761 NS=N
3762 IF(N.GT.MSTU(4)-MSTU(32)-5) THEN
3763 CALL LUERRM(11,'(LUSHOW:) no more memory left in LUJETS')
3764 IF(MSTU(21).GE.1) RETURN
3765 ENDIF
3766 IF(NPA.GE.2) THEN
3767 K(N+1,1)=11
3768 K(N+1,2)=21
3769 K(N+1,3)=0
3770 K(N+1,4)=0
3771 K(N+1,5)=0
3772 P(N+1,1)=0.
3773 P(N+1,2)=0.
3774 P(N+1,3)=0.
3775 P(N+1,4)=PS(5)
3776 P(N+1,5)=PS(5)
3777 V(N+1,5)=PS(5)**2
3778 N=N+1
3779 ENDIF
3780
3781
3782 NEP=NPA
3783 IM=NS
3784 IF(NPA.EQ.1) IM=NS-1
3785 140 IM=IM+1
3786 IF(N.GT.NS) THEN
3787 IF(IM.GT.N) GOTO 380
3788 KFLM=IABS(K(IM,2))
3789 IF(KFLM.EQ.0.OR.(KFLM.GT.8.AND.KFLM.NE.21)) GOTO 140
3790 IF(P(IM,5).LT.PMTH(2,KFLM)) GOTO 140
3791 IGM=K(IM,3)
3792 ELSE
3793 IGM=-1
3794 ENDIF
3795 IF(N+NEP.GT.MSTU(4)-MSTU(32)-5) THEN
3796 CALL LUERRM(11,'(LUSHOW:) no more memory left in LUJETS')
3797 IF(MSTU(21).GE.1) RETURN
3798 ENDIF
3799
3800
3801
3802 IAU=0
3803 IF(IGM.GT.0) THEN
3804 IF(K(IM-1,3).EQ.IGM) IAU=IM-1
3805 IF(N.GE.IM+1.AND.K(IM+1,3).EQ.IGM) IAU=IM+1
3806 ENDIF
3807 IF(IGM.GE.0) THEN
3808 K(IM,4)=N+1
3809 DO 150 I=1,NEP
3810 150 K(N+I,3)=IM
3811 ELSE
3812 K(N+1,3)=IPA(1)
3813 ENDIF
3814 IF(IGM.LE.0) THEN
3815 DO 160 I=1,NEP
3816 160 K(N+I,2)=K(IPA(I),2)
3817 ELSEIF(KFLM.NE.21) THEN
3818 K(N+1,2)=K(IM,2)
3819 K(N+2,2)=K(IM,5)
3820 ELSEIF(K(IM,5).EQ.21) THEN
3821 K(N+1,2)=21
3822 K(N+2,2)=21
3823 ELSE
3824 K(N+1,2)=K(IM,5)
3825 K(N+2,2)=-K(IM,5)
3826 ENDIF
3827
3828
3829 DO 170 IP=1,NEP
3830 K(N+IP,1)=3
3831 K(N+IP,4)=0
3832 K(N+IP,5)=0
3833 KFLD(IP)=IABS(K(N+IP,2))
3834 ITRY(IP)=0
3835 ISL(IP)=0
3836 ISI(IP)=0
3837 170 IF(KFLD(IP).GT.0.AND.(KFLD(IP).LE.8.OR.KFLD(IP).EQ.21)) ISI(IP)=1
3838 ISLM=0
3839
3840
3841 IF(IGM.LE.0) THEN
3842 DO 180 I=1,NPA
3843 IF(NPA.GE.3) P(N+I,4)=(PS(4)*P(IPA(I),4)-PS(1)*P(IPA(I),1)-
3844 & PS(2)*P(IPA(I),2)-PS(3)*P(IPA(I),3))/PS(5)
3845 P(N+I,5)=MIN(QMAX,PS(5))
3846 IF(NPA.GE.3) P(N+I,5)=MIN(P(N+I,5),P(N+I,4))
3847 180 IF(ISI(I).EQ.0) P(N+I,5)=P(IPA(I),5)
3848 ELSE
3849 IF(MSTJ(43).LE.2) PEM=V(IM,2)
3850 IF(MSTJ(43).GE.3) PEM=P(IM,4)
3851 P(N+1,5)=MIN(P(IM,5),V(IM,1)*PEM)
3852 P(N+2,5)=MIN(P(IM,5),(1.-V(IM,1))*PEM)
3853 IF(K(N+2,2).EQ.22) P(N+2,5)=PMTH(1,22)
3854 ENDIF
3855 DO 190 I=1,NEP
3856 PMSD(I)=P(N+I,5)
3857 IF(ISI(I).EQ.1) THEN
3858 IF(P(N+I,5).LE.PMTH(3,KFLD(I))) P(N+I,5)=PMTH(1,KFLD(I))
3859 ENDIF
3860 190 V(N+I,5)=P(N+I,5)**2
3861
3862
3863 200 INUM=0
3864 IF(NEP.EQ.1) INUM=1
3865 DO 210 I=1,NEP
3866 210 IF(INUM.EQ.0.AND.ISL(I).EQ.1) INUM=I
3867 DO 220 I=1,NEP
3868 IF(INUM.EQ.0.AND.ITRY(I).EQ.0.AND.ISI(I).EQ.1) THEN
3869 IF(P(N+I,5).GE.PMTH(2,KFLD(I))) INUM=I
3870 ENDIF
3871 220 CONTINUE
3872 IF(INUM.EQ.0) THEN
3873 RMAX=0.
3874 DO 230 I=1,NEP
3875 IF(ISI(I).EQ.1.AND.PMSD(I).GE.PMQTH2) THEN
3876 RPM=P(N+I,5)/PMSD(I)
3877 IF(RPM.GT.RMAX.AND.P(N+I,5).GE.PMTH(2,KFLD(I))) THEN
3878 RMAX=RPM
3879 INUM=I
3880 ENDIF
3881 ENDIF
3882 230 CONTINUE
3883 ENDIF
3884
3885
3886 INUM=MAX(1,INUM)
3887 IEP(1)=N+INUM
3888 DO 240 I=2,NEP
3889 IEP(I)=IEP(I-1)+1
3890 240 IF(IEP(I).GT.N+NEP) IEP(I)=N+1
3891 DO 250 I=1,NEP
3892 250 KFL(I)=IABS(K(IEP(I),2))
3893 ITRY(INUM)=ITRY(INUM)+1
3894 IF(ITRY(INUM).GT.200) THEN
3895 CALL LUERRM(14,'(LUSHOW:) caught in infinite loop')
3896 IF(MSTU(21).GE.1) RETURN
3897 ENDIF
3898 Z=0.5
3899 IF(KFL(1).EQ.0.OR.(KFL(1).GT.8.AND.KFL(1).NE.21)) GOTO 300
3900 IF(P(IEP(1),5).LT.PMTH(2,KFL(1))) GOTO 300
3901
3902
3903 IF(NEP.EQ.1) THEN
3904 PMED=PS(4)
3905 ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN
3906 PMED=P(IM,5)
3907 ELSE
3908 IF(INUM.EQ.1) PMED=V(IM,1)*PEM
3909 IF(INUM.EQ.2) PMED=(1.-V(IM,1))*PEM
3910 ENDIF
3911 IF(MOD(MSTJ(43),2).EQ.1) THEN
3912 ZC=PMTH(2,21)/PMED
3913 ZCE=PMTH(2,22)/PMED
3914 ELSE
3915 ZC=0.5*(1.-SQRT(MAX(0.,1.-(2.*PMTH(2,21)/PMED)**2)))
3916 IF(ZC.LT.1E-4) ZC=(PMTH(2,21)/PMED)**2
3917 ZCE=0.5*(1.-SQRT(MAX(0.,1.-(2.*PMTH(2,22)/PMED)**2)))
3918 IF(ZCE.LT.1E-4) ZCE=(PMTH(2,22)/PMED)**2
3919 ENDIF
3920 ZC=MIN(ZC,0.491)
3921 ZCE=MIN(ZCE,0.491)
3922 IF((MSTJ(41).EQ.1.AND.ZC.GT.0.49).OR.(MSTJ(41).EQ.2.AND.
3923 &MIN(ZC,ZCE).GT.0.49)) THEN
3924 P(IEP(1),5)=PMTH(1,KFL(1))
3925 V(IEP(1),5)=P(IEP(1),5)**2
3926 GOTO 300
3927 ENDIF
3928
3929
3930 IF(MSTJ(49).EQ.0.AND.KFL(1).EQ.21) THEN
3931 FBR=6.*LOG((1.-ZC)/ZC)+MSTJ(45)*(0.5-ZC)
3932 ELSEIF(MSTJ(49).EQ.0) THEN
3933 FBR=(8./3.)*LOG((1.-ZC)/ZC)
3934
3935
3936 ELSEIF(MSTJ(49).EQ.1.AND.KFL(1).EQ.21) THEN
3937 FBR=(PARJ(87)+MSTJ(45)*PARJ(88))*(1.-2.*ZC)
3938 ELSEIF(MSTJ(49).EQ.1) THEN
3939 FBR=(1.-2.*ZC)/3.
3940 IF(IGM.EQ.0.AND.M3JC.EQ.1) FBR=4.*FBR
3941
3942
3943 ELSEIF(KFL(1).EQ.21) THEN
3944 FBR=6.*MSTJ(45)*(0.5-ZC)
3945 ELSE
3946 FBR=2.*LOG((1.-ZC)/ZC)
3947 ENDIF
3948
3949
3950 IF(MSTJ(41).EQ.2.AND.KFL(1).GE.1.AND.KFL(1).LE.8)
3951 &FBRE=(KCHG(KFL(1),1)/3.)**2*2.*LOG((1.-ZCE)/ZCE)
3952
3953
3954 260 PMS=V(IEP(1),5)
3955 IF(IGM.GE.0) THEN
3956 PM2=0.
3957 DO 270 I=2,NEP
3958 PM=P(IEP(I),5)
3959 IF(KFL(I).GT.0.AND.(KFL(I).LE.8.OR.KFL(I).EQ.21)) PM=
3960 & PMTH(2,KFL(I))
3961 270 PM2=PM2+PM
3962 PMS=MIN(PMS,(P(IM,5)-PM2)**2)
3963 ENDIF
3964
3965
3966 B0=27./6.
3967 DO 280 IF=4,MSTJ(45)
3968 280 IF(PMS.GT.4.*PMTH(2,IF)**2) B0=(33.-2.*IF)/6.
3969 IF(MSTJ(44).LE.0) THEN
3970 PMSQCD=PMS*EXP(MAX(-100.,LOG(RLU(0))*PARU(2)/(PARU(111)*FBR)))
3971 ELSEIF(MSTJ(44).EQ.1) THEN
3972 PMSQCD=4.*ALAMS*(0.25*PMS/ALAMS)**(RLU(0)**(B0/FBR))
3973 ELSE
3974 PMSQCD=PMS*RLU(0)**(ALFM*B0/FBR)
3975 ENDIF
3976 IF(ZC.GT.0.49.OR.PMSQCD.LE.PMTH(4,KFL(1))**2) PMSQCD=
3977 &PMTH(2,KFL(1))**2
3978 V(IEP(1),5)=PMSQCD
3979 MCE=1
3980
3981
3982 IF(MSTJ(41).EQ.2.AND.KFL(1).GE.1.AND.KFL(1).LE.8) THEN
3983 PMSQED=PMS*EXP(MAX(-100.,LOG(RLU(0))*PARU(2)/(PARU(101)*FBRE)))
3984 IF(ZCE.GT.0.49.OR.PMSQED.LE.PMTH(5,KFL(1))**2) PMSQED=
3985 & PMTH(2,KFL(1))**2
3986 IF(PMSQED.GT.PMSQCD) THEN
3987 V(IEP(1),5)=PMSQED
3988 MCE=2
3989 ENDIF
3990 ENDIF
3991
3992
3993 P(IEP(1),5)=SQRT(V(IEP(1),5))
3994 IF(P(IEP(1),5).LE.PMTH(3,KFL(1))) THEN
3995 P(IEP(1),5)=PMTH(1,KFL(1))
3996 V(IEP(1),5)=P(IEP(1),5)**2
3997 GOTO 300
3998 ENDIF
3999
4000
4001 IF(MCE.EQ.2) THEN
4002 Z=1.-(1.-ZCE)*(ZCE/(1.-ZCE))**RLU(0)
4003 IF(1.+Z**2.LT.2.*RLU(0)) GOTO 260
4004 K(IEP(1),5)=22
4005
4006
4007 ELSEIF(MSTJ(49).NE.1.AND.KFL(1).NE.21) THEN
4008 Z=1.-(1.-ZC)*(ZC/(1.-ZC))**RLU(0)
4009 IF(1.+Z**2.LT.2.*RLU(0)) GOTO 260
4010 K(IEP(1),5)=21
4011 ELSEIF(MSTJ(49).EQ.0.AND.MSTJ(45)*(0.5-ZC).LT.RLU(0)*FBR) THEN
4012 Z=(1.-ZC)*(ZC/(1.-ZC))**RLU(0)
4013 IF(RLU(0).GT.0.5) Z=1.-Z
4014 IF((1.-Z*(1.-Z))**2.LT.RLU(0)) GOTO 260
4015 K(IEP(1),5)=21
4016 ELSEIF(MSTJ(49).NE.1) THEN
4017 Z=ZC+(1.-2.*ZC)*RLU(0)
4018 IF(Z**2+(1.-Z)**2.LT.RLU(0)) GOTO 260
4019 KFLB=1+INT(MSTJ(45)*RLU(0))
4020 PMQ=4.*PMTH(2,KFLB)**2/V(IEP(1),5)
4021 IF(PMQ.GE.1.) GOTO 260
4022 PMQ0=4.*PMTH(2,21)**2/V(IEP(1),5)
4023 IF(MOD(MSTJ(43),2).EQ.0.AND.(1.+0.5*PMQ)*SQRT(1.-PMQ).LT.
4024 & RLU(0)*(1.+0.5*PMQ0)*SQRT(1.-PMQ0)) GOTO 260
4025 K(IEP(1),5)=KFLB
4026
4027
4028 ELSEIF(KFL(1).NE.21) THEN
4029 Z=1.-SQRT(ZC**2+RLU(0)*(1.-2.*ZC))
4030 K(IEP(1),5)=21
4031 ELSEIF(RLU(0)*(PARJ(87)+MSTJ(45)*PARJ(88)).LE.PARJ(87)) THEN
4032 Z=ZC+(1.-2.*ZC)*RLU(0)
4033 K(IEP(1),5)=21
4034 ELSE
4035 Z=ZC+(1.-2.*ZC)*RLU(0)
4036 KFLB=1+INT(MSTJ(45)*RLU(0))
4037 PMQ=4.*PMTH(2,KFLB)**2/V(IEP(1),5)
4038 IF(PMQ.GE.1.) GOTO 260
4039 K(IEP(1),5)=KFLB
4040 ENDIF
4041 IF(MCE.EQ.1.AND.MSTJ(44).GE.2) THEN
4042 IF(Z*(1.-Z)*V(IEP(1),5).LT.PT2MIN) GOTO 260
4043 IF(ALFM/LOG(V(IEP(1),5)*Z*(1.-Z)/ALAMS).LT.RLU(0)) GOTO 260
4044 ENDIF
4045
4046
4047 IF(KFL(1).EQ.21) THEN
4048 KFLGD1=IABS(K(IEP(1),5))
4049 KFLGD2=KFLGD1
4050 ELSE
4051 KFLGD1=KFL(1)
4052 KFLGD2=IABS(K(IEP(1),5))
4053 ENDIF
4054 IF(NEP.EQ.1) THEN
4055 PED=PS(4)
4056 ELSEIF(NEP.GE.3) THEN
4057 PED=P(IEP(1),4)
4058 ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN
4059 PED=0.5*(V(IM,5)+V(IEP(1),5)-PM2**2)/P(IM,5)
4060 ELSE
4061 IF(IEP(1).EQ.N+1) PED=V(IM,1)*PEM
4062 IF(IEP(1).EQ.N+2) PED=(1.-V(IM,1))*PEM
4063 ENDIF
4064 IF(MOD(MSTJ(43),2).EQ.1) THEN
4065 PMQTH3=0.5*PARJ(82)
4066 IF(KFLGD2.EQ.22) PMQTH3=0.5*PARJ(83)
4067 PMQ1=(PMTH(1,KFLGD1)**2+PMQTH3**2)/V(IEP(1),5)
4068 PMQ2=(PMTH(1,KFLGD2)**2+PMQTH3**2)/V(IEP(1),5)
4069 ZD=SQRT(MAX(0.,(1.-V(IEP(1),5)/PED**2)*((1.-PMQ1-PMQ2)**2-
4070 & 4.*PMQ1*PMQ2)))
4071 ZH=1.+PMQ1-PMQ2
4072 ELSE
4073 ZD=SQRT(MAX(0.,1.-V(IEP(1),5)/PED**2))
4074 ZH=1.
4075 ENDIF
4076 ZL=0.5*(ZH-ZD)
4077 ZU=0.5*(ZH+ZD)
4078 IF(Z.LT.ZL.OR.Z.GT.ZU) GOTO 260
4079 IF(KFL(1).EQ.21) V(IEP(1),3)=LOG(ZU*(1.-ZL)/MAX(1E-20,ZL*
4080 &(1.-ZU)))
4081 IF(KFL(1).NE.21) V(IEP(1),3)=LOG((1.-ZL)/MAX(1E-10,1.-ZU))
4082
4083
4084 IF(IGM.EQ.0.AND.M3JC.EQ.1) THEN
4085 X1=Z*(1.+V(IEP(1),5)/V(NS+1,5))
4086 X2=1.-V(IEP(1),5)/V(NS+1,5)
4087 X3=(1.-X1)+(1.-X2)
4088 IF(MCE.EQ.2) THEN
4089 KI1=K(IPA(INUM),2)
4090 KI2=K(IPA(3-INUM),2)
4091 QF1=KCHG(IABS(KI1),1)*ISIGN(1,KI1)/3.
4092 QF2=KCHG(IABS(KI2),1)*ISIGN(1,KI2)/3.
4093 WSHOW=QF1**2*(1.-X1)/X3*(1.+(X1/(2.-X2))**2)+
4094 & QF2**2*(1.-X2)/X3*(1.+(X2/(2.-X1))**2)
4095 WME=(QF1*(1.-X1)/X3-QF2*(1.-X2)/X3)**2*(X1**2+X2**2)
4096 ELSEIF(MSTJ(49).NE.1) THEN
4097 WSHOW=1.+(1.-X1)/X3*(X1/(2.-X2))**2+
4098 & (1.-X2)/X3*(X2/(2.-X1))**2
4099 WME=X1**2+X2**2
4100 ELSE
4101 WSHOW=4.*X3*((1.-X1)/(2.-X2)**2+(1.-X2)/(2.-X1)**2)
4102 WME=X3**2
4103 ENDIF
4104 IF(WME.LT.RLU(0)*WSHOW) GOTO 260
4105
4106
4107 ELSEIF(MCE.EQ.1.AND.IGM.GT.0.AND.MSTJ(42).GE.2) THEN
4108 MAOM=1
4109 ZM=V(IM,1)
4110 IF(IEP(1).EQ.N+2) ZM=1.-V(IM,1)
4111 THE2ID=Z*(1.-Z)*(ZM*P(IM,4))**2/V(IEP(1),5)
4112 IAOM=IM
4113 290 IF(K(IAOM,5).EQ.22) THEN
4114 IAOM=K(IAOM,3)
4115 IF(K(IAOM,3).LE.NS) MAOM=0
4116 IF(MAOM.EQ.1) GOTO 290
4117 ENDIF
4118 IF(MAOM.EQ.1) THEN
4119 THE2IM=V(IAOM,1)*(1.-V(IAOM,1))*P(IAOM,4)**2/V(IAOM,5)
4120 IF(THE2ID.LT.THE2IM) GOTO 260
4121 ENDIF
4122 ENDIF
4123
4124
4125 IF(MSTJ(48).EQ.1) THEN
4126 IF(NEP.EQ.1.AND.IM.EQ.NS) THEN
4127 THE2ID=Z*(1.-Z)*PS(4)**2/V(IEP(1),5)
4128 IF(THE2ID.LT.1./PARJ(85)**2) GOTO 260
4129 ELSEIF(NEP.EQ.2.AND.IEP(1).EQ.NS+2) THEN
4130 THE2ID=Z*(1.-Z)*(0.5*P(IM,4))**2/V(IEP(1),5)
4131 IF(THE2ID.LT.1./PARJ(85)**2) GOTO 260
4132 ELSEIF(NEP.EQ.2.AND.IEP(1).EQ.NS+3) THEN
4133 THE2ID=Z*(1.-Z)*(0.5*P(IM,4))**2/V(IEP(1),5)
4134 IF(THE2ID.LT.1./PARJ(86)**2) GOTO 260
4135 ENDIF
4136 ENDIF
4137
4138
4139 300 V(IEP(1),1)=Z
4140 ISL(1)=0
4141 ISL(2)=0
4142 IF(NEP.EQ.1) GOTO 330
4143 IF(NEP.EQ.2.AND.P(IEP(1),5)+P(IEP(2),5).GE.P(IM,5)) GOTO 200
4144 DO 310 I=1,NEP
4145 IF(ITRY(I).EQ.0.AND.KFLD(I).GT.0.AND.(KFLD(I).LE.8.OR.KFLD(I).EQ.
4146 &21)) THEN
4147 IF(P(N+I,5).GE.PMTH(2,KFLD(I))) GOTO 200
4148 ENDIF
4149 310 CONTINUE
4150
4151
4152 IF(NEP.EQ.3) THEN
4153 PA1S=(P(N+1,4)+P(N+1,5))*(P(N+1,4)-P(N+1,5))
4154 PA2S=(P(N+2,4)+P(N+2,5))*(P(N+2,4)-P(N+2,5))
4155 PA3S=(P(N+3,4)+P(N+3,5))*(P(N+3,4)-P(N+3,5))
4156 PTS=0.25*(2.*PA1S*PA2S+2.*PA1S*PA3S+2.*PA2S*PA3S-
4157 & PA1S**2-PA2S**2-PA3S**2)/PA1S
4158 IF(PTS.LE.0.) GOTO 200
4159 ELSEIF(IGM.EQ.0.OR.MSTJ(43).LE.2.OR.MOD(MSTJ(43),2).EQ.0) THEN
4160 DO 320 I1=N+1,N+2
4161 KFLDA=IABS(K(I1,2))
4162 IF(KFLDA.EQ.0.OR.(KFLDA.GT.8.AND.KFLDA.NE.21)) GOTO 320
4163 IF(P(I1,5).LT.PMTH(2,KFLDA)) GOTO 320
4164 IF(KFLDA.EQ.21) THEN
4165 KFLGD1=IABS(K(I1,5))
4166 KFLGD2=KFLGD1
4167 ELSE
4168 KFLGD1=KFLDA
4169 KFLGD2=IABS(K(I1,5))
4170 ENDIF
4171 I2=2*N+3-I1
4172 IF(IGM.EQ.0.OR.MSTJ(43).LE.2) THEN
4173 PED=0.5*(V(IM,5)+V(I1,5)-V(I2,5))/P(IM,5)
4174 ELSE
4175 IF(I1.EQ.N+1) ZM=V(IM,1)
4176 IF(I1.EQ.N+2) ZM=1.-V(IM,1)
4177 PML=SQRT((V(IM,5)-V(N+1,5)-V(N+2,5))**2-
4178 & 4.*V(N+1,5)*V(N+2,5))
4179 PED=PEM*(0.5*(V(IM,5)-PML+V(I1,5)-V(I2,5))+PML*ZM)/V(IM,5)
4180 ENDIF
4181 IF(MOD(MSTJ(43),2).EQ.1) THEN
4182 PMQTH3=0.5*PARJ(82)
4183 IF(KFLGD2.EQ.22) PMQTH3=0.5*PARJ(83)
4184 PMQ1=(PMTH(1,KFLGD1)**2+PMQTH3**2)/V(I1,5)
4185 PMQ2=(PMTH(1,KFLGD2)**2+PMQTH3**2)/V(I1,5)
4186 ZD=SQRT(MAX(0.,(1.-V(I1,5)/PED**2)*((1.-PMQ1-PMQ2)**2-
4187 & 4.*PMQ1*PMQ2)))
4188 ZH=1.+PMQ1-PMQ2
4189 ELSE
4190 ZD=SQRT(MAX(0.,1.-V(I1,5)/PED**2))
4191 ZH=1.
4192 ENDIF
4193 ZL=0.5*(ZH-ZD)
4194 ZU=0.5*(ZH+ZD)
4195 IF(I1.EQ.N+1.AND.(V(I1,1).LT.ZL.OR.V(I1,1).GT.ZU)) ISL(1)=1
4196 IF(I1.EQ.N+2.AND.(V(I1,1).LT.ZL.OR.V(I1,1).GT.ZU)) ISL(2)=1
4197 IF(KFLDA.EQ.21) V(I1,4)=LOG(ZU*(1.-ZL)/MAX(1E-20,ZL*(1.-ZU)))
4198 IF(KFLDA.NE.21) V(I1,4)=LOG((1.-ZL)/MAX(1E-10,1.-ZU))
4199 320 CONTINUE
4200 IF(ISL(1).EQ.1.AND.ISL(2).EQ.1.AND.ISLM.NE.0) THEN
4201 ISL(3-ISLM)=0
4202 ISLM=3-ISLM
4203 ELSEIF(ISL(1).EQ.1.AND.ISL(2).EQ.1) THEN
4204 ZDR1=MAX(0.,V(N+1,3)/V(N+1,4)-1.)
4205 ZDR2=MAX(0.,V(N+2,3)/V(N+2,4)-1.)
4206 IF(ZDR2.GT.RLU(0)*(ZDR1+ZDR2)) ISL(1)=0
4207 IF(ISL(1).EQ.1) ISL(2)=0
4208 IF(ISL(1).EQ.0) ISLM=1
4209 IF(ISL(2).EQ.0) ISLM=2
4210 ENDIF
4211 IF(ISL(1).EQ.1.OR.ISL(2).EQ.1) GOTO 200
4212 ENDIF
4213 IF(IGM.GT.0.AND.MOD(MSTJ(43),2).EQ.1.AND.(P(N+1,5).GE.
4214 &PMTH(2,KFLD(1)).OR.P(N+2,5).GE.PMTH(2,KFLD(2)))) THEN
4215 PMQ1=V(N+1,5)/V(IM,5)
4216 PMQ2=V(N+2,5)/V(IM,5)
4217 ZD=SQRT(MAX(0.,(1.-V(IM,5)/PEM**2)*((1.-PMQ1-PMQ2)**2-
4218 & 4.*PMQ1*PMQ2)))
4219 ZH=1.+PMQ1-PMQ2
4220 ZL=0.5*(ZH-ZD)
4221 ZU=0.5*(ZH+ZD)
4222 IF(V(IM,1).LT.ZL.OR.V(IM,1).GT.ZU) GOTO 200
4223 ENDIF
4224
4225
4226 330 MAZIP=0
4227 MAZIC=0
4228 IF(NEP.EQ.1) THEN
4229 P(N+1,1)=0.
4230 P(N+1,2)=0.
4231 P(N+1,3)=SQRT(MAX(0.,(P(IPA(1),4)+P(N+1,5))*(P(IPA(1),4)-
4232 & P(N+1,5))))
4233 P(N+1,4)=P(IPA(1),4)
4234 V(N+1,2)=P(N+1,4)
4235 ELSEIF(IGM.EQ.0.AND.NEP.EQ.2) THEN
4236 PED1=0.5*(V(IM,5)+V(N+1,5)-V(N+2,5))/P(IM,5)
4237 P(N+1,1)=0.
4238 P(N+1,2)=0.
4239 P(N+1,3)=SQRT(MAX(0.,(PED1+P(N+1,5))*(PED1-P(N+1,5))))
4240 P(N+1,4)=PED1
4241 P(N+2,1)=0.
4242 P(N+2,2)=0.
4243 P(N+2,3)=-P(N+1,3)
4244 P(N+2,4)=P(IM,5)-PED1
4245 V(N+1,2)=P(N+1,4)
4246 V(N+2,2)=P(N+2,4)
4247 ELSEIF(NEP.EQ.3) THEN
4248 P(N+1,1)=0.
4249 P(N+1,2)=0.
4250 P(N+1,3)=SQRT(MAX(0.,PA1S))
4251 P(N+2,1)=SQRT(PTS)
4252 P(N+2,2)=0.
4253 P(N+2,3)=0.5*(PA3S-PA2S-PA1S)/P(N+1,3)
4254 P(N+3,1)=-P(N+2,1)
4255 P(N+3,2)=0.
4256 P(N+3,3)=-(P(N+1,3)+P(N+2,3))
4257 V(N+1,2)=P(N+1,4)
4258 V(N+2,2)=P(N+2,4)
4259 V(N+3,2)=P(N+3,4)
4260
4261
4262 ELSE
4263 ZM=V(IM,1)
4264 PZM=SQRT(MAX(0.,(PEM+P(IM,5))*(PEM-P(IM,5))))
4265 PMLS=(V(IM,5)-V(N+1,5)-V(N+2,5))**2-4.*V(N+1,5)*V(N+2,5)
4266 IF(PZM.LE.0.) THEN
4267 PTS=0.
4268 ELSEIF(MOD(MSTJ(43),2).EQ.1) THEN
4269 PTS=(PEM**2*(ZM*(1.-ZM)*V(IM,5)-(1.-ZM)*V(N+1,5)-
4270 & ZM*V(N+2,5))-0.25*PMLS)/PZM**2
4271 ELSE
4272 PTS=PMLS*(ZM*(1.-ZM)*PEM**2/V(IM,5)-0.25)/PZM**2
4273 ENDIF
4274 PT=SQRT(MAX(0.,PTS))
4275
4276
4277 HAZIP=0.
4278 IF(MSTJ(49).NE.1.AND.MOD(MSTJ(46),2).EQ.1.AND.K(IM,2).EQ.21.
4279 & AND.IAU.NE.0) THEN
4280 IF(K(IGM,3).NE.0) MAZIP=1
4281 ZAU=V(IGM,1)
4282 IF(IAU.EQ.IM+1) ZAU=1.-V(IGM,1)
4283 IF(MAZIP.EQ.0) ZAU=0.
4284 IF(K(IGM,2).NE.21) THEN
4285 HAZIP=2.*ZAU/(1.+ZAU**2)
4286 ELSE
4287 HAZIP=(ZAU/(1.-ZAU*(1.-ZAU)))**2
4288 ENDIF
4289 IF(K(N+1,2).NE.21) THEN
4290 HAZIP=HAZIP*(-2.*ZM*(1.-ZM))/(1.-2.*ZM*(1.-ZM))
4291 ELSE
4292 HAZIP=HAZIP*(ZM*(1.-ZM)/(1.-ZM*(1.-ZM)))**2
4293 ENDIF
4294 ENDIF
4295
4296
4297
4298 HAZIC=0.
4299 IF(MSTJ(46).GE.2.AND.(K(N+1,2).EQ.21.OR.K(N+2,2).EQ.21).
4300 & AND.IAU.NE.0) THEN
4301 IF(K(IGM,3).NE.0) MAZIC=N+1
4302 IF(K(IGM,3).NE.0.AND.K(N+1,2).NE.21) MAZIC=N+2
4303 IF(K(IGM,3).NE.0.AND.K(N+1,2).EQ.21.AND.K(N+2,2).EQ.21.AND.
4304 & ZM.GT.0.5) MAZIC=N+2
4305 IF(K(IAU,2).EQ.22) MAZIC=0
4306 ZS=ZM
4307 IF(MAZIC.EQ.N+2) ZS=1.-ZM
4308 ZGM=V(IGM,1)
4309 IF(IAU.EQ.IM-1) ZGM=1.-V(IGM,1)
4310 IF(MAZIC.EQ.0) ZGM=1.
4311 HAZIC=(P(IM,5)/P(IGM,5))*SQRT((1.-ZS)*(1.-ZGM)/(ZS*ZGM))
4312 HAZIC=MIN(0.95,HAZIC)
4313 ENDIF
4314 ENDIF
4315
4316
4317 340 IF(NEP.EQ.2.AND.IGM.GT.0) THEN
4318 IF(MOD(MSTJ(43),2).EQ.1) THEN
4319 P(N+1,4)=PEM*V(IM,1)
4320 ELSE
4321 P(N+1,4)=PEM*(0.5*(V(IM,5)-SQRT(PMLS)+V(N+1,5)-V(N+2,5))+
4322 & SQRT(PMLS)*ZM)/V(IM,5)
4323 ENDIF
4324 PHI=PARU(2)*RLU(0)
4325 P(N+1,1)=PT*COS(PHI)
4326 P(N+1,2)=PT*SIN(PHI)
4327 IF(PZM.GT.0.) THEN
4328 P(N+1,3)=0.5*(V(N+2,5)-V(N+1,5)-V(IM,5)+2.*PEM*P(N+1,4))/PZM
4329 ELSE
4330 P(N+1,3)=0.
4331 ENDIF
4332 P(N+2,1)=-P(N+1,1)
4333 P(N+2,2)=-P(N+1,2)
4334 P(N+2,3)=PZM-P(N+1,3)
4335 P(N+2,4)=PEM-P(N+1,4)
4336 IF(MSTJ(43).LE.2) THEN
4337 V(N+1,2)=(PEM*P(N+1,4)-PZM*P(N+1,3))/P(IM,5)
4338 V(N+2,2)=(PEM*P(N+2,4)-PZM*P(N+2,3))/P(IM,5)
4339 ENDIF
4340 ENDIF
4341
4342
4343 IF(IGM.GT.0) THEN
4344 IF(MSTJ(43).LE.2) THEN
4345 BEX=P(IGM,1)/P(IGM,4)
4346 BEY=P(IGM,2)/P(IGM,4)
4347 BEZ=P(IGM,3)/P(IGM,4)
4348 GA=P(IGM,4)/P(IGM,5)
4349 GABEP=GA*(GA*(BEX*P(IM,1)+BEY*P(IM,2)+BEZ*P(IM,3))/(1.+GA)-
4350 & P(IM,4))
4351 ELSE
4352 BEX=0.
4353 BEY=0.
4354 BEZ=0.
4355 GA=1.
4356 GABEP=0.
4357 ENDIF
4358 THE=ULANGL(P(IM,3)+GABEP*BEZ,SQRT((P(IM,1)+GABEP*BEX)**2+
4359 & (P(IM,2)+GABEP*BEY)**2))
4360 PHI=ULANGL(P(IM,1)+GABEP*BEX,P(IM,2)+GABEP*BEY)
4361 DO 350 I=N+1,N+2
4362 DP(1)=COS(THE)*COS(PHI)*P(I,1)-SIN(PHI)*P(I,2)+
4363 & SIN(THE)*COS(PHI)*P(I,3)
4364 DP(2)=COS(THE)*SIN(PHI)*P(I,1)+COS(PHI)*P(I,2)+
4365 & SIN(THE)*SIN(PHI)*P(I,3)
4366 DP(3)=-SIN(THE)*P(I,1)+COS(THE)*P(I,3)
4367 DP(4)=P(I,4)
4368 DBP=BEX*DP(1)+BEY*DP(2)+BEZ*DP(3)
4369 DGABP=GA*(GA*DBP/(1D0+GA)+DP(4))
4370 P(I,1)=DP(1)+DGABP*BEX
4371 P(I,2)=DP(2)+DGABP*BEY
4372 P(I,3)=DP(3)+DGABP*BEZ
4373 350 P(I,4)=GA*(DP(4)+DBP)
4374 ENDIF
4375
4376
4377 IF(MAZIP.NE.0.OR.MAZIC.NE.0) THEN
4378 DO 360 J=1,3
4379 DPT(1,J)=P(IM,J)
4380 DPT(2,J)=P(IAU,J)
4381 360 DPT(3,J)=P(N+1,J)
4382 DPMA=DPT(1,1)*DPT(2,1)+DPT(1,2)*DPT(2,2)+DPT(1,3)*DPT(2,3)
4383 DPMD=DPT(1,1)*DPT(3,1)+DPT(1,2)*DPT(3,2)+DPT(1,3)*DPT(3,3)
4384 DPMM=DPT(1,1)**2+DPT(1,2)**2+DPT(1,3)**2
4385 DO 370 J=1,3
4386 DPT(4,J)=DPT(2,J)-DPMA*DPT(1,J)/DPMM
4387 370 DPT(5,J)=DPT(3,J)-DPMD*DPT(1,J)/DPMM
4388 DPT(4,4)=SQRT(DPT(4,1)**2+DPT(4,2)**2+DPT(4,3)**2)
4389 DPT(5,4)=SQRT(DPT(5,1)**2+DPT(5,2)**2+DPT(5,3)**2)
4390 IF(MIN(DPT(4,4),DPT(5,4)).GT.0.1*PARJ(82)) THEN
4391 CAD=(DPT(4,1)*DPT(5,1)+DPT(4,2)*DPT(5,2)+
4392 & DPT(4,3)*DPT(5,3))/(DPT(4,4)*DPT(5,4))
4393 IF(MAZIP.NE.0) THEN
4394 IF(1.+HAZIP*(2.*CAD**2-1.).LT.RLU(0)*(1.+ABS(HAZIP)))
4395 & GOTO 340
4396 ENDIF
4397 IF(MAZIC.NE.0) THEN
4398 IF(MAZIC.EQ.N+2) CAD=-CAD
4399 IF((1.-HAZIC)*(1.-HAZIC*CAD)/(1.+HAZIC**2-2.*HAZIC*CAD).
4400 & LT.RLU(0)) GOTO 340
4401 ENDIF
4402 ENDIF
4403 ENDIF
4404
4405
4406 IF(IGM.GE.0) K(IM,1)=14
4407 N=N+NEP
4408 NEP=2
4409 IF(N.GT.MSTU(4)-MSTU(32)-5) THEN
4410 CALL LUERRM(11,'(LUSHOW:) no more memory left in LUJETS')
4411 IF(MSTU(21).GE.1) N=NS
4412 IF(MSTU(21).GE.1) RETURN
4413 ENDIF
4414 GOTO 140
4415
4416
4417 380 IF(NPA.GE.2) THEN
4418 K(NS+1,1)=11
4419 K(NS+1,2)=94
4420 K(NS+1,3)=IP1
4421 IF(IP2.GT.0.AND.IP2.LT.IP1) K(NS+1,3)=IP2
4422 K(NS+1,4)=NS+2
4423 K(NS+1,5)=NS+1+NPA
4424 IIM=1
4425 ELSE
4426 IIM=0
4427 ENDIF
4428
4429
4430 DO 390 I=NS+1+IIM,N
4431 IF(K(I,1).LE.10.AND.K(I,2).EQ.22) THEN
4432 K(I,1)=1
4433 ELSEIF(K(I,1).LE.10) THEN
4434 K(I,4)=MSTU(5)*(K(I,4)/MSTU(5))
4435 K(I,5)=MSTU(5)*(K(I,5)/MSTU(5))
4436 ELSEIF(K(MOD(K(I,4),MSTU(5))+1,2).NE.22) THEN
4437 ID1=MOD(K(I,4),MSTU(5))
4438 IF(K(I,2).GE.1.AND.K(I,2).LE.8) ID1=MOD(K(I,4),MSTU(5))+1
4439 ID2=2*MOD(K(I,4),MSTU(5))+1-ID1
4440 K(I,4)=MSTU(5)*(K(I,4)/MSTU(5))+ID1
4441 K(I,5)=MSTU(5)*(K(I,5)/MSTU(5))+ID2
4442 K(ID1,4)=K(ID1,4)+MSTU(5)*I
4443 K(ID1,5)=K(ID1,5)+MSTU(5)*ID2
4444 K(ID2,4)=K(ID2,4)+MSTU(5)*ID1
4445 K(ID2,5)=K(ID2,5)+MSTU(5)*I
4446 ELSE
4447 ID1=MOD(K(I,4),MSTU(5))
4448 ID2=ID1+1
4449 K(I,4)=MSTU(5)*(K(I,4)/MSTU(5))+ID1
4450 K(I,5)=MSTU(5)*(K(I,5)/MSTU(5))+ID1
4451 K(ID1,4)=K(ID1,4)+MSTU(5)*I
4452 K(ID1,5)=K(ID1,5)+MSTU(5)*I
4453 K(ID2,4)=0
4454 K(ID2,5)=0
4455 ENDIF
4456 390 CONTINUE
4457
4458
4459 IF(NPA.GE.2) THEN
4460 BEX=PS(1)/PS(4)
4461 BEY=PS(2)/PS(4)
4462 BEZ=PS(3)/PS(4)
4463 GA=PS(4)/PS(5)
4464 GABEP=GA*(GA*(BEX*P(IPA(1),1)+BEY*P(IPA(1),2)+BEZ*P(IPA(1),3))
4465 & /(1.+GA)-P(IPA(1),4))
4466 ELSE
4467 BEX=0.
4468 BEY=0.
4469 BEZ=0.
4470 GABEP=0.
4471 ENDIF
4472 THE=ULANGL(P(IPA(1),3)+GABEP*BEZ,SQRT((P(IPA(1),1)
4473 &+GABEP*BEX)**2+(P(IPA(1),2)+GABEP*BEY)**2))
4474 PHI=ULANGL(P(IPA(1),1)+GABEP*BEX,P(IPA(1),2)+GABEP*BEY)
4475 IF(NPA.EQ.3) THEN
4476 CHI=ULANGL(COS(THE)*COS(PHI)*(P(IPA(2),1)+GABEP*BEX)+COS(THE)*
4477 & SIN(PHI)*(P(IPA(2),2)+GABEP*BEY)-SIN(THE)*(P(IPA(2),3)+GABEP*
4478 & BEZ),-SIN(PHI)*(P(IPA(2),1)+GABEP*BEX)+COS(PHI)*(P(IPA(2),2)+
4479 & GABEP*BEY))
4480 CALL LUDBRB(NS+1,N,0.,CHI,0D0,0D0,0D0)
4481 ENDIF
4482 DBEX=DBLE(BEX)
4483 DBEY=DBLE(BEY)
4484 DBEZ=DBLE(BEZ)
4485 CALL LUDBRB(NS+1,N,THE,PHI,DBEX,DBEY,DBEZ)
4486
4487
4488 DO 400 I=NS+1,N
4489 DO 400 J=1,5
4490 400 V(I,J)=V(IP1,J)
4491
4492
4493 IF(N.EQ.NS+NPA+IIM) THEN
4494 N=NS
4495 ELSE
4496 DO 410 IP=1,NPA
4497 K(IPA(IP),1)=14
4498 K(IPA(IP),4)=K(IPA(IP),4)+NS+IIM+IP
4499 K(IPA(IP),5)=K(IPA(IP),5)+NS+IIM+IP
4500 K(NS+IIM+IP,3)=IPA(IP)
4501 IF(IIM.EQ.1.AND.MSTU(16).NE.2) K(NS+IIM+IP,3)=NS+1
4502 K(NS+IIM+IP,4)=MSTU(5)*IPA(IP)+K(NS+IIM+IP,4)
4503 410 K(NS+IIM+IP,5)=MSTU(5)*IPA(IP)+K(NS+IIM+IP,5)
4504 ENDIF
4505
4506 RETURN
4507 END
4508
4509
4510
4511 SUBROUTINE LUBOEI(NSAV)
4512
4513
4514
4515
4516 IMPLICIT DOUBLE PRECISION(D)
4517 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
4518 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
4519 DIMENSION DPS(4),KFBE(9),NBE(0:9),BEI(100)
4520 SAVE
4521 DATA KFBE/211,-211,111,321,-321,130,310,221,331/
4522
4523
4524 IF((MSTJ(51).NE.1.AND.MSTJ(51).NE.2).OR.N-NSAV.LE.1) RETURN
4525 DO 100 J=1,4
4526 100 DPS(J)=0.
4527 DO 120 I=1,N
4528 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 120
4529 DO 110 J=1,4
4530 110 DPS(J)=DPS(J)+P(I,J)
4531 120 CONTINUE
4532 CALL LUDBRB(0,0,0.,0.,-DPS(1)/DPS(4),-DPS(2)/DPS(4),
4533 &-DPS(3)/DPS(4))
4534 PECM=0.
4535 DO 130 I=1,N
4536 130 IF(K(I,1).GE.1.AND.K(I,1).LE.10) PECM=PECM+P(I,4)
4537
4538
4539 NBE(0)=N+MSTU(3)
4540 DO 160 IBE=1,MIN(9,MSTJ(51))
4541 NBE(IBE)=NBE(IBE-1)
4542 DO 150 I=NSAV+1,N
4543 IF(K(I,2).NE.KFBE(IBE)) GOTO 150
4544 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 150
4545 IF(NBE(IBE).GE.MSTU(4)-MSTU(32)-5) THEN
4546 CALL LUERRM(11,'(LUBOEI:) no more memory left in LUJETS')
4547 RETURN
4548 ENDIF
4549 NBE(IBE)=NBE(IBE)+1
4550 K(NBE(IBE),1)=I
4551 DO 140 J=1,3
4552 140 P(NBE(IBE),J)=0.
4553 150 CONTINUE
4554 160 CONTINUE
4555
4556
4557 DO 210 IBE=1,MIN(9,MSTJ(51))
4558 IF(IBE.NE.1.AND.IBE.NE.4.AND.IBE.LE.7) GOTO 180
4559 IF(IBE.EQ.1.AND.MAX(NBE(1)-NBE(0),NBE(2)-NBE(1),NBE(3)-NBE(2)).
4560 &LE.1) GOTO 180
4561 IF(IBE.EQ.4.AND.MAX(NBE(4)-NBE(3),NBE(5)-NBE(4),NBE(6)-NBE(5),
4562 &NBE(7)-NBE(6)).LE.1) GOTO 180
4563 IF(IBE.GE.8.AND.NBE(IBE)-NBE(IBE-1).LE.1) GOTO 180
4564 IF(IBE.EQ.1) PMHQ=2.*ULMASS(211)
4565 IF(IBE.EQ.4) PMHQ=2.*ULMASS(321)
4566 IF(IBE.EQ.8) PMHQ=2.*ULMASS(221)
4567 IF(IBE.EQ.9) PMHQ=2.*ULMASS(331)
4568 QDEL=0.1*MIN(PMHQ,PARJ(93))
4569 IF(MSTJ(51).EQ.1) THEN
4570 NBIN=MIN(100,NINT(9.*PARJ(93)/QDEL))
4571 BEEX=EXP(0.5*QDEL/PARJ(93))
4572 BERT=EXP(-QDEL/PARJ(93))
4573 ELSE
4574 NBIN=MIN(100,NINT(3.*PARJ(93)/QDEL))
4575 ENDIF
4576 DO 170 IBIN=1,NBIN
4577 QBIN=QDEL*(IBIN-0.5)
4578 BEI(IBIN)=QDEL*(QBIN**2+QDEL**2/12.)/SQRT(QBIN**2+PMHQ**2)
4579 IF(MSTJ(51).EQ.1) THEN
4580 BEEX=BEEX*BERT
4581 BEI(IBIN)=BEI(IBIN)*BEEX
4582 ELSE
4583 BEI(IBIN)=BEI(IBIN)*EXP(-(QBIN/PARJ(93))**2)
4584 ENDIF
4585 170 IF(IBIN.GE.2) BEI(IBIN)=BEI(IBIN)+BEI(IBIN-1)
4586
4587
4588 180 DO 200 I1M=NBE(IBE-1)+1,NBE(IBE)-1
4589 I1=K(I1M,1)
4590 DO 200 I2M=I1M+1,NBE(IBE)
4591 I2=K(I2M,1)
4592 Q2OLD=MAX(0.,(P(I1,4)+P(I2,4))**2-(P(I1,1)+P(I2,1))**2-(P(I1,2)+
4593 &P(I2,2))**2-(P(I1,3)+P(I2,3))**2-(P(I1,5)+P(I2,5))**2)
4594 QOLD=SQRT(Q2OLD)
4595
4596
4597 IF(QOLD.LT.0.5*QDEL) THEN
4598 QMOV=QOLD/3.
4599 ELSEIF(QOLD.LT.(NBIN-0.1)*QDEL) THEN
4600 RBIN=QOLD/QDEL
4601 IBIN=RBIN
4602 RINP=(RBIN**3-IBIN**3)/(3*IBIN*(IBIN+1)+1)
4603 QMOV=(BEI(IBIN)+RINP*(BEI(IBIN+1)-BEI(IBIN)))*
4604 & SQRT(Q2OLD+PMHQ**2)/Q2OLD
4605 ELSE
4606 QMOV=BEI(NBIN)*SQRT(Q2OLD+PMHQ**2)/Q2OLD
4607 ENDIF
4608 Q2NEW=Q2OLD*(QOLD/(QOLD+3.*PARJ(92)*QMOV))**(2./3.)
4609
4610
4611 HC1=(P(I1,4)+P(I2,4))**2-(Q2OLD-Q2NEW)
4612 HC2=(Q2OLD-Q2NEW)*(P(I1,4)-P(I2,4))**2
4613 HA=0.5*(1.-SQRT(HC1*Q2NEW/(HC1*Q2OLD-HC2)))
4614 DO 190 J=1,3
4615 PD=HA*(P(I2,J)-P(I1,J))
4616 P(I1M,J)=P(I1M,J)+PD
4617 190 P(I2M,J)=P(I2M,J)-PD
4618 200 CONTINUE
4619 210 CONTINUE
4620
4621
4622 DO 230 IM=NBE(0)+1,NBE(MIN(9,MSTJ(51)))
4623 I=K(IM,1)
4624 DO 220 J=1,3
4625 220 P(I,J)=P(I,J)+P(IM,J)
4626 230 P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2)
4627
4628
4629 PES=0.
4630 PQS=0.
4631 DO 240 I=1,N
4632 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 240
4633 PES=PES+P(I,4)
4634 PQS=PQS+P(I,5)**2/P(I,4)
4635 240 CONTINUE
4636 FAC=(PECM-PQS)/(PES-PQS)
4637 DO 260 I=1,N
4638 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 260
4639 DO 250 J=1,3
4640 250 P(I,J)=FAC*P(I,J)
4641 P(I,4)=SQRT(P(I,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2)
4642 260 CONTINUE
4643
4644
4645 CALL LUDBRB(0,0,0.,0.,DPS(1)/DPS(4),DPS(2)/DPS(4),DPS(3)/DPS(4))
4646
4647 RETURN
4648 END
4649
4650
4651
4652 FUNCTION ULMASS(KF)
4653
4654
4655 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
4656 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
4657 SAVE
4658
4659
4660 ULMASS=0.
4661 KFA=IABS(KF)
4662 KC=LUCOMP(KF)
4663 IF(KC.EQ.0) RETURN
4664 PARF(106)=PMAS(6,1)
4665 PARF(107)=PMAS(7,1)
4666 PARF(108)=PMAS(8,1)
4667
4668
4669 IF((MSTJ(93).EQ.1.OR.MSTJ(93).EQ.2).AND.KFA.LE.10) THEN
4670 ULMASS=PARF(100+KFA)
4671 IF(MSTJ(93).EQ.2) ULMASS=MAX(0.,ULMASS-PARF(121))
4672
4673
4674 ELSEIF(KFA.LE.100.OR.KC.LE.80.OR.KC.GT.100) THEN
4675 ULMASS=PMAS(KC,1)
4676
4677
4678 ELSE
4679 KFLA=MOD(KFA/1000,10)
4680 KFLB=MOD(KFA/100,10)
4681 KFLC=MOD(KFA/10,10)
4682 KFLS=MOD(KFA,10)
4683 KFLR=MOD(KFA/10000,10)
4684 PMA=PARF(100+KFLA)
4685 PMB=PARF(100+KFLB)
4686 PMC=PARF(100+KFLC)
4687
4688
4689 IF(KFLA.EQ.0.AND.KFLR.EQ.0.AND.KFLS.LE.3) THEN
4690 IF(KFLS.EQ.1) PMSPL=-3./(PMB*PMC)
4691 IF(KFLS.GE.3) PMSPL=1./(PMB*PMC)
4692 ULMASS=PARF(111)+PMB+PMC+PARF(113)*PARF(101)**2*PMSPL
4693 ELSEIF(KFLA.EQ.0) THEN
4694 KMUL=2
4695 IF(KFLS.EQ.1) KMUL=3
4696 IF(KFLR.EQ.2) KMUL=4
4697 IF(KFLS.EQ.5) KMUL=5
4698 ULMASS=PARF(113+KMUL)+PMB+PMC
4699 ELSEIF(KFLC.EQ.0) THEN
4700 IF(KFLS.EQ.1) PMSPL=-3./(PMA*PMB)
4701 IF(KFLS.EQ.3) PMSPL=1./(PMA*PMB)
4702 ULMASS=2.*PARF(112)/3.+PMA+PMB+PARF(114)*PARF(101)**2*PMSPL
4703 IF(MSTJ(93).EQ.1) ULMASS=PMA+PMB
4704 IF(MSTJ(93).EQ.2) ULMASS=MAX(0.,ULMASS-PARF(122)-
4705 & 2.*PARF(112)/3.)
4706 ELSE
4707 IF(KFLS.EQ.2.AND.KFLA.EQ.KFLB) THEN
4708 PMSPL=1./(PMA*PMB)-2./(PMA*PMC)-2./(PMB*PMC)
4709 ELSEIF(KFLS.EQ.2.AND.KFLB.GE.KFLC) THEN
4710 PMSPL=-2./(PMA*PMB)-2./(PMA*PMC)+1./(PMB*PMC)
4711 ELSEIF(KFLS.EQ.2) THEN
4712 PMSPL=-3./(PMB*PMC)
4713 ELSE
4714 PMSPL=1./(PMA*PMB)+1./(PMA*PMC)+1./(PMB*PMC)
4715 ENDIF
4716 ULMASS=PARF(112)+PMA+PMB+PMC+PARF(114)*PARF(101)**2*PMSPL
4717 ENDIF
4718 ENDIF
4719
4720
4721
4722 IF(MSTJ(24).GE.1.AND.PMAS(KC,2).GT.1E-4) THEN
4723 IF(MSTJ(24).EQ.1.OR.(MSTJ(24).EQ.2.AND.KFA.GT.100)) THEN
4724 ULMASS=ULMASS+0.5*PMAS(KC,2)*TAN((2.*RLU(0)-1.)*
4725 & ATAN(2.*PMAS(KC,3)/PMAS(KC,2)))
4726 ELSE
4727 PM0=ULMASS
4728 PMLOW=ATAN((MAX(0.,PM0-PMAS(KC,3))**2-PM0**2)/
4729 & (PM0*PMAS(KC,2)))
4730 PMUPP=ATAN((PM0+PMAS(KC,3))**2-PM0**2)/(PM0*PMAS(KC,2))
4731 ULMASS=SQRT(MAX(0.,PM0**2+PM0*PMAS(KC,2)*TAN(PMLOW+
4732 & (PMUPP-PMLOW)*RLU(0))))
4733 ENDIF
4734 ENDIF
4735 MSTJ(93)=0
4736
4737 RETURN
4738 END
4739
4740
4741
4742 SUBROUTINE LUNAME(KF,CHAU)
4743
4744
4745 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
4746 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
4747 COMMON/LUDAT4/CHAF(500)
4748 CHARACTER CHAF*8
4749 CHARACTER CHAU*16
4750 SAVE
4751
4752
4753 CHAU=' '
4754 KFA=IABS(KF)
4755 KC=LUCOMP(KF)
4756 IF(KC.EQ.0) RETURN
4757 KQ=LUCHGE(KF)
4758 KFLA=MOD(KFA/1000,10)
4759 KFLB=MOD(KFA/100,10)
4760 KFLC=MOD(KFA/10,10)
4761 KFLS=MOD(KFA,10)
4762 KFLR=MOD(KFA/10000,10)
4763
4764
4765 IF(KFA.LE.100.OR.(KFA.GT.100.AND.KC.GT.100)) THEN
4766 CHAU=CHAF(KC)
4767 LEN=0
4768 DO 100 LEM=1,8
4769 100 IF(CHAU(LEM:LEM).NE.' ') LEN=LEM
4770
4771
4772 ELSEIF(KFLC.EQ.0) THEN
4773 CHAU(1:2)=CHAF(KFLA)(1:1)//CHAF(KFLB)(1:1)
4774 IF(KFLS.EQ.1) CHAU(3:4)='_0'
4775 IF(KFLS.EQ.3) CHAU(3:4)='_1'
4776 LEN=4
4777
4778
4779 ELSEIF(KFLA.EQ.0) THEN
4780 IF(KFLB.EQ.5) CHAU(1:1)='B'
4781 IF(KFLB.EQ.6) CHAU(1:1)='T'
4782 IF(KFLB.EQ.7) CHAU(1:1)='L'
4783 IF(KFLB.EQ.8) CHAU(1:1)='H'
4784 LEN=1
4785 IF(KFLR.EQ.0.AND.KFLS.EQ.1) THEN
4786 ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.3) THEN
4787 CHAU(2:2)='*'
4788 LEN=2
4789 ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.3) THEN
4790 CHAU(2:3)='_1'
4791 LEN=3
4792 ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.1) THEN
4793 CHAU(2:4)='*_0'
4794 LEN=4
4795 ELSEIF(KFLR.EQ.2) THEN
4796 CHAU(2:4)='*_1'
4797 LEN=4
4798 ELSEIF(KFLS.EQ.5) THEN
4799 CHAU(2:4)='*_2'
4800 LEN=4
4801 ENDIF
4802 IF(KFLC.GE.3.AND.KFLR.EQ.0.AND.KFLS.LE.3) THEN
4803 CHAU(LEN+1:LEN+2)='_'//CHAF(KFLC)(1:1)
4804 LEN=LEN+2
4805 ELSEIF(KFLC.GE.3) THEN
4806 CHAU(LEN+1:LEN+1)=CHAF(KFLC)(1:1)
4807 LEN=LEN+1
4808 ENDIF
4809
4810
4811 ELSE
4812 IF(KFLB.LE.2.AND.KFLC.LE.2) THEN
4813 CHAU='Sigma '
4814 IF(KFLC.GT.KFLB) CHAU='Lambda'
4815 IF(KFLS.EQ.4) CHAU='Sigma*'
4816 LEN=5
4817 IF(CHAU(6:6).NE.' ') LEN=6
4818 ELSEIF(KFLB.LE.2.OR.KFLC.LE.2) THEN
4819 CHAU='Xi '
4820 IF(KFLA.GT.KFLB.AND.KFLB.GT.KFLC) CHAU='Xi'''
4821 IF(KFLS.EQ.4) CHAU='Xi*'
4822 LEN=2
4823 IF(CHAU(3:3).NE.' ') LEN=3
4824 ELSE
4825 CHAU='Omega '
4826 IF(KFLA.GT.KFLB.AND.KFLB.GT.KFLC) CHAU='Omega'''
4827 IF(KFLS.EQ.4) CHAU='Omega*'
4828 LEN=5
4829 IF(CHAU(6:6).NE.' ') LEN=6
4830 ENDIF
4831
4832
4833 CHAU(LEN+1:LEN+2)='_'//CHAF(KFLA)(1:1)
4834 LEN=LEN+2
4835 IF(KFLB.GE.KFLC.AND.KFLC.GE.4) THEN
4836 CHAU(LEN+1:LEN+2)=CHAF(KFLB)(1:1)//CHAF(KFLC)(1:1)
4837 LEN=LEN+2
4838 ELSEIF(KFLB.GE.KFLC.AND.KFLB.GE.4) THEN
4839 CHAU(LEN+1:LEN+1)=CHAF(KFLB)(1:1)
4840 LEN=LEN+1
4841 ELSEIF(KFLC.GT.KFLB.AND.KFLB.GE.4) THEN
4842 CHAU(LEN+1:LEN+2)=CHAF(KFLC)(1:1)//CHAF(KFLB)(1:1)
4843 LEN=LEN+2
4844 ELSEIF(KFLC.GT.KFLB.AND.KFLC.GE.4) THEN
4845 CHAU(LEN+1:LEN+1)=CHAF(KFLC)(1:1)
4846 LEN=LEN+1
4847 ENDIF
4848 ENDIF
4849
4850
4851 IF(KF.GT.0.OR.LEN.EQ.0) THEN
4852 ELSEIF(KFA.GT.10.AND.KFA.LE.40.AND.KQ.NE.0) THEN
4853 ELSEIF(KFA.EQ.89.OR.(KFA.GE.91.AND.KFA.LE.99)) THEN
4854 ELSEIF(KFA.GT.100.AND.KFLA.EQ.0.AND.KQ.NE.0) THEN
4855 ELSEIF(MSTU(15).LE.1) THEN
4856 CHAU(LEN+1:LEN+1)='~'
4857 LEN=LEN+1
4858 ELSE
4859 CHAU(LEN+1:LEN+3)='bar'
4860 LEN=LEN+3
4861 ENDIF
4862
4863
4864 IF(KQ.EQ.6) CHAU(LEN+1:LEN+2)='++'
4865 IF(KQ.EQ.-6) CHAU(LEN+1:LEN+2)='--'
4866 IF(KQ.EQ.3) CHAU(LEN+1:LEN+1)='+'
4867 IF(KQ.EQ.-3) CHAU(LEN+1:LEN+1)='-'
4868 IF(KQ.EQ.0.AND.(KFA.LE.22.OR.LEN.EQ.0)) THEN
4869 ELSEIF(KQ.EQ.0.AND.(KFA.GE.81.AND.KFA.LE.100)) THEN
4870 ELSEIF(KFA.GT.100.AND.KFLA.EQ.0.AND.KFLB.EQ.KFLC.AND.
4871 &KFLB.NE.1) THEN
4872 ELSEIF(KQ.EQ.0) THEN
4873 CHAU(LEN+1:LEN+1)='0'
4874 ENDIF
4875
4876 RETURN
4877 END
4878
4879
4880
4881 FUNCTION LUCHGE(KF)
4882
4883
4884 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
4885 SAVE
4886
4887
4888 LUCHGE=0
4889 KFA=IABS(KF)
4890 KC=LUCOMP(KFA)
4891 IF(KC.EQ.0) THEN
4892 ELSEIF(KFA.LE.100.OR.KC.LE.80.OR.KC.GT.100) THEN
4893 LUCHGE=KCHG(KC,1)
4894
4895
4896 ELSEIF(MOD(KFA/1000,10).EQ.0) THEN
4897 LUCHGE=(KCHG(MOD(KFA/100,10),1)-KCHG(MOD(KFA/10,10),1))*
4898 & (-1)**MOD(KFA/100,10)
4899 ELSEIF(MOD(KFA/10,10).EQ.0) THEN
4900 LUCHGE=KCHG(MOD(KFA/1000,10),1)+KCHG(MOD(KFA/100,10),1)
4901 ELSE
4902 LUCHGE=KCHG(MOD(KFA/1000,10),1)+KCHG(MOD(KFA/100,10),1)+
4903 & KCHG(MOD(KFA/10,10),1)
4904 ENDIF
4905
4906
4907 LUCHGE=LUCHGE*ISIGN(1,KF)
4908
4909 RETURN
4910 END
4911
4912
4913
4914 FUNCTION LUCOMP(KF)
4915
4916
4917
4918 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
4919 SAVE
4920
4921
4922 LUCOMP=0
4923 KFA=IABS(KF)
4924 KFLA=MOD(KFA/1000,10)
4925 KFLB=MOD(KFA/100,10)
4926 KFLC=MOD(KFA/10,10)
4927 KFLS=MOD(KFA,10)
4928 KFLR=MOD(KFA/10000,10)
4929
4930
4931 IF(KFA.EQ.0.OR.KFA.GE.100000) THEN
4932 ELSEIF(KFA.LE.100) THEN
4933 LUCOMP=KFA
4934 IF(KF.LT.0.AND.KCHG(KFA,3).EQ.0) LUCOMP=0
4935 ELSEIF(KFLS.EQ.0) THEN
4936 IF(KF.EQ.130) LUCOMP=221
4937 IF(KF.EQ.310) LUCOMP=222
4938 IF(KFA.EQ.210) LUCOMP=281
4939 IF(KFA.EQ.2110) LUCOMP=282
4940 IF(KFA.EQ.2210) LUCOMP=283
4941
4942
4943 ELSEIF(KFA-10000*KFLR.LT.1000) THEN
4944 IF(KFLB.EQ.0.OR.KFLB.EQ.9.OR.KFLC.EQ.0.OR.KFLC.EQ.9) THEN
4945 ELSEIF(KFLB.LT.KFLC) THEN
4946 ELSEIF(KF.LT.0.AND.KFLB.EQ.KFLC) THEN
4947 ELSEIF(KFLB.EQ.KFLC) THEN
4948 IF(KFLR.EQ.0.AND.KFLS.EQ.1) THEN
4949 LUCOMP=110+KFLB
4950 ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.3) THEN
4951 LUCOMP=130+KFLB
4952 ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.3) THEN
4953 LUCOMP=150+KFLB
4954 ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.1) THEN
4955 LUCOMP=170+KFLB
4956 ELSEIF(KFLR.EQ.2.AND.KFLS.EQ.3) THEN
4957 LUCOMP=190+KFLB
4958 ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.5) THEN
4959 LUCOMP=210+KFLB
4960 ENDIF
4961 ELSEIF(KFLB.LE.5.AND.KFLC.LE.3) THEN
4962 IF(KFLR.EQ.0.AND.KFLS.EQ.1) THEN
4963 LUCOMP=100+((KFLB-1)*(KFLB-2))/2+KFLC
4964 ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.3) THEN
4965 LUCOMP=120+((KFLB-1)*(KFLB-2))/2+KFLC
4966 ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.3) THEN
4967 LUCOMP=140+((KFLB-1)*(KFLB-2))/2+KFLC
4968 ELSEIF(KFLR.EQ.1.AND.KFLS.EQ.1) THEN
4969 LUCOMP=160+((KFLB-1)*(KFLB-2))/2+KFLC
4970 ELSEIF(KFLR.EQ.2.AND.KFLS.EQ.3) THEN
4971 LUCOMP=180+((KFLB-1)*(KFLB-2))/2+KFLC
4972 ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.5) THEN
4973 LUCOMP=200+((KFLB-1)*(KFLB-2))/2+KFLC
4974 ENDIF
4975 ELSEIF((KFLS.EQ.1.AND.KFLR.LE.1).OR.(KFLS.EQ.3.AND.KFLR.LE.2).
4976 & OR.(KFLS.EQ.5.AND.KFLR.EQ.0)) THEN
4977 LUCOMP=80+KFLB
4978 ENDIF
4979
4980
4981 ELSEIF((KFLR.EQ.0.OR.KFLR.EQ.1).AND.KFLC.EQ.0) THEN
4982 IF(KFLS.NE.1.AND.KFLS.NE.3) THEN
4983 ELSEIF(KFLA.EQ.9.OR.KFLB.EQ.0.OR.KFLB.EQ.9) THEN
4984 ELSEIF(KFLA.LT.KFLB) THEN
4985 ELSEIF(KFLS.EQ.1.AND.KFLA.EQ.KFLB) THEN
4986 ELSE
4987 LUCOMP=90
4988 ENDIF
4989
4990
4991 ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.2) THEN
4992 IF(KFLA.EQ.9.OR.KFLB.EQ.0.OR.KFLB.EQ.9.OR.KFLC.EQ.9) THEN
4993 ELSEIF(KFLA.LE.KFLC.OR.KFLA.LT.KFLB) THEN
4994 ELSEIF(KFLA.GE.6.OR.KFLB.GE.4.OR.KFLC.GE.4) THEN
4995 LUCOMP=80+KFLA
4996 ELSEIF(KFLB.LT.KFLC) THEN
4997 LUCOMP=300+((KFLA+1)*KFLA*(KFLA-1))/6+(KFLC*(KFLC-1))/2+KFLB
4998 ELSE
4999 LUCOMP=330+((KFLA+1)*KFLA*(KFLA-1))/6+(KFLB*(KFLB-1))/2+KFLC
5000 ENDIF
5001
5002
5003 ELSEIF(KFLR.EQ.0.AND.KFLS.EQ.4) THEN
5004 IF(KFLA.EQ.9.OR.KFLB.EQ.0.OR.KFLB.EQ.9.OR.KFLC.EQ.9) THEN
5005 ELSEIF(KFLA.LT.KFLB.OR.KFLB.LT.KFLC) THEN
5006 ELSEIF(KFLA.GE.6.OR.KFLB.GE.4) THEN
5007 LUCOMP=80+KFLA
5008 ELSE
5009 LUCOMP=360+((KFLA+1)*KFLA*(KFLA-1))/6+(KFLB*(KFLB-1))/2+KFLC
5010 ENDIF
5011 ENDIF
5012
5013 RETURN
5014 END
5015
5016
5017
5018 SUBROUTINE LUERRM(MERR,CHMESS)
5019
5020
5021 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
5022 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
5023 CHARACTER CHMESS*(*)
5024 SAVE
5025
5026
5027 IF(MERR.LE.10) THEN
5028 MSTU(27)=MSTU(27)+1
5029 MSTU(28)=MERR
5030 IF(MSTU(25).EQ.1.AND.MSTU(27).LE.MSTU(26)) WRITE(MSTU(11),1000)
5031 & MERR,MSTU(31),CHMESS
5032
5033
5034 ELSEIF(MERR.LE.20) THEN
5035 MSTU(23)=MSTU(23)+1
5036 MSTU(24)=MERR-10
5037 IF(MSTU(21).GE.1.AND.MSTU(23).LE.MSTU(22)) WRITE(MSTU(11),1100)
5038 & MERR-10,MSTU(31),CHMESS
5039 IF(MSTU(21).GE.2.AND.MSTU(23).GT.MSTU(22)) THEN
5040 WRITE(MSTU(11),1100) MERR-10,MSTU(31),CHMESS
5041 WRITE(MSTU(11),1200)
5042 IF(MERR.NE.17) CALL LULIST(2)
5043 STOP
5044 ENDIF
5045
5046
5047 ELSE
5048 WRITE(MSTU(11),1300) MERR-20,MSTU(31),CHMESS
5049 STOP
5050 ENDIF
5051
5052
5053 1000 FORMAT(/5X,'Advisory warning type',I2,' given after',I6,
5054 &' LUEXEC calls:'/5X,A)
5055 1100 FORMAT(/5X,'Error type',I2,' has occured after',I6,
5056 &' LUEXEC calls:'/5X,A)
5057 1200 FORMAT(5X,'Execution will be stopped after listing of last ',
5058 &'event!')
5059 1300 FORMAT(/5X,'Fatal error type',I2,' has occured after',I6,
5060 &' LUEXEC calls:'/5X,A/5X,'Execution will now be stopped!')
5061
5062 RETURN
5063 END
5064
5065
5066
5067 FUNCTION ULALPS(Q2)
5068
5069
5070 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
5071 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
5072 SAVE
5073
5074
5075 IF(MSTU(111).LE.0) THEN
5076 ULALPS=PARU(111)
5077 MSTU(118)=MSTU(112)
5078 PARU(117)=0.
5079 PARU(118)=PARU(111)
5080 RETURN
5081 ENDIF
5082
5083
5084 Q2EFF=Q2
5085 IF(MSTU(115).GE.2) Q2EFF=MAX(Q2,PARU(114))
5086 NF=MSTU(112)
5087 ALAM2=PARU(112)**2
5088 100 IF(NF.GT.MAX(2,MSTU(113))) THEN
5089 Q2THR=PARU(113)*PMAS(NF,1)**2
5090 IF(Q2EFF.LT.Q2THR) THEN
5091 NF=NF-1
5092 ALAM2=ALAM2*(Q2THR/ALAM2)**(2./(33.-2.*NF))
5093 GOTO 100
5094 ENDIF
5095 ENDIF
5096 110 IF(NF.LT.MIN(8,MSTU(114))) THEN
5097 Q2THR=PARU(113)*PMAS(NF+1,1)**2
5098 IF(Q2EFF.GT.Q2THR) THEN
5099 NF=NF+1
5100 ALAM2=ALAM2*(ALAM2/Q2THR)**(2./(33.-2.*NF))
5101 GOTO 110
5102 ENDIF
5103 ENDIF
5104 IF(MSTU(115).EQ.1) Q2EFF=Q2EFF+ALAM2
5105 PARU(117)=SQRT(ALAM2)
5106
5107
5108 B0=(33.-2.*NF)/6.
5109 ALGQ=LOG(Q2EFF/ALAM2)
5110 IF(MSTU(111).EQ.1) THEN
5111 ULALPS=PARU(2)/(B0*ALGQ)
5112 ELSE
5113 B1=(153.-19.*NF)/6.
5114 ULALPS=PARU(2)/(B0*ALGQ)*(1.-B1*LOG(ALGQ)/(B0**2*ALGQ))
5115 ENDIF
5116 MSTU(118)=NF
5117 PARU(118)=ULALPS
5118
5119 RETURN
5120 END
5121
5122
5123
5124 FUNCTION ULANGL(X,Y)
5125
5126
5127 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
5128 SAVE
5129
5130 ULANGL=0.
5131 R=SQRT(X**2+Y**2)
5132 IF(R.LT.1E-20) RETURN
5133 IF(ABS(X)/R.LT.0.8) THEN
5134 ULANGL=SIGN(ACOS(X/R),Y)
5135 ELSE
5136 ULANGL=ASIN(Y/R)
5137 IF(X.LT.0..AND.ULANGL.GE.0.) THEN
5138 ULANGL=PARU(1)-ULANGL
5139 ELSEIF(X.LT.0.) THEN
5140 ULANGL=-PARU(1)-ULANGL
5141 ENDIF
5142 ENDIF
5143
5144 RETURN
5145 END
5146
5147
5148
5149 SUBROUTINE LUROBO(THE,PHI,BEX,BEY,BEZ)
5150
5151
5152 IMPLICIT DOUBLE PRECISION(D)
5153 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
5154 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
5155 DIMENSION ROT(3,3),PR(3),VR(3),DP(4),DV(4)
5156 SAVE
5157
5158
5159 IMIN=1
5160 IF(MSTU(1).GT.0) IMIN=MSTU(1)
5161 IMAX=N
5162 IF(MSTU(2).GT.0) IMAX=MSTU(2)
5163 DBX=BEX
5164 DBY=BEY
5165 DBZ=BEZ
5166 GOTO 100
5167
5168
5169 ENTRY LUDBRB(IMI,IMA,THE,PHI,DBEX,DBEY,DBEZ)
5170 IMIN=IMI
5171 IF(IMIN.LE.0) IMIN=1
5172 IMAX=IMA
5173 IF(IMAX.LE.0) IMAX=N
5174 DBX=DBEX
5175 DBY=DBEY
5176 DBZ=DBEZ
5177
5178
5179 100 IF(IMIN.GT.MSTU(4).OR.IMAX.GT.MSTU(4)) THEN
5180 CALL LUERRM(11,'(LUROBO:) range outside LUJETS memory')
5181 RETURN
5182 ENDIF
5183
5184
5185 IF(THE**2+PHI**2.GT.1E-20) THEN
5186 ROT(1,1)=COS(THE)*COS(PHI)
5187 ROT(1,2)=-SIN(PHI)
5188 ROT(1,3)=SIN(THE)*COS(PHI)
5189 ROT(2,1)=COS(THE)*SIN(PHI)
5190 ROT(2,2)=COS(PHI)
5191 ROT(2,3)=SIN(THE)*SIN(PHI)
5192 ROT(3,1)=-SIN(THE)
5193 ROT(3,2)=0.
5194 ROT(3,3)=COS(THE)
5195 DO 130 I=IMIN,IMAX
5196 IF(K(I,1).LE.0) GOTO 130
5197 DO 110 J=1,3
5198 PR(J)=P(I,J)
5199 110 VR(J)=V(I,J)
5200 DO 120 J=1,3
5201 P(I,J)=ROT(J,1)*PR(1)+ROT(J,2)*PR(2)+ROT(J,3)*PR(3)
5202 120 V(I,J)=ROT(J,1)*VR(1)+ROT(J,2)*VR(2)+ROT(J,3)*VR(3)
5203 130 CONTINUE
5204 ENDIF
5205
5206
5207 IF(DBX**2+DBY**2+DBZ**2.GT.1E-20) THEN
5208 DB=SQRT(DBX**2+DBY**2+DBZ**2)
5209 IF(DB.GT.0.99999999D0) THEN
5210
5211 CALL LUERRM(3,'(LUROBO:) boost vector too large')
5212 DBX=DBX*(0.99999999D0/DB)
5213 DBY=DBY*(0.99999999D0/DB)
5214 DBZ=DBZ*(0.99999999D0/DB)
5215 DB=0.99999999D0
5216 ENDIF
5217 DGA=1D0/SQRT(1D0-DB**2)
5218 DO 150 I=IMIN,IMAX
5219 IF(K(I,1).LE.0) GOTO 150
5220 DO 140 J=1,4
5221 DP(J)=P(I,J)
5222 140 DV(J)=V(I,J)
5223 DBP=DBX*DP(1)+DBY*DP(2)+DBZ*DP(3)
5224 DGABP=DGA*(DGA*DBP/(1D0+DGA)+DP(4))
5225 P(I,1)=DP(1)+DGABP*DBX
5226 P(I,2)=DP(2)+DGABP*DBY
5227 P(I,3)=DP(3)+DGABP*DBZ
5228 P(I,4)=DGA*(DP(4)+DBP)
5229 DBV=DBX*DV(1)+DBY*DV(2)+DBZ*DV(3)
5230 DGABV=DGA*(DGA*DBV/(1D0+DGA)+DV(4))
5231 V(I,1)=DV(1)+DGABV*DBX
5232 V(I,2)=DV(2)+DGABV*DBY
5233 V(I,3)=DV(3)+DGABV*DBZ
5234 V(I,4)=DGA*(DV(4)+DBV)
5235 150 CONTINUE
5236 ENDIF
5237
5238 RETURN
5239 END
5240
5241
5242
5243
5244
5245
5246 SUBROUTINE HIROBO(THE,PHI,BEX,BEY,BEZ)
5247
5248
5249 IMPLICIT DOUBLE PRECISION(D)
5250 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
5251 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
5252 DIMENSION ROT(3,3),PR(3),DP(4)
5253 SAVE
5254
5255
5256 IMIN=1
5257 IF(MSTU(1).GT.0) IMIN=MSTU(1)
5258 IMAX=N
5259 IF(MSTU(2).GT.0) IMAX=MSTU(2)
5260 DBX=BEX
5261 DBY=BEY
5262 DBZ=BEZ
5263
5264
5265 IF(IMIN.GT.MSTU(4).OR.IMAX.GT.MSTU(4)) THEN
5266 CALL LUERRM(11,'(LUROBO:) range outside LUJETS memory')
5267 RETURN
5268 ENDIF
5269
5270
5271 IF(THE**2+PHI**2.GT.1E-20) THEN
5272 ROT(1,1)=COS(THE)*COS(PHI)
5273 ROT(1,2)=-SIN(PHI)
5274 ROT(1,3)=SIN(THE)*COS(PHI)
5275 ROT(2,1)=COS(THE)*SIN(PHI)
5276 ROT(2,2)=COS(PHI)
5277 ROT(2,3)=SIN(THE)*SIN(PHI)
5278 ROT(3,1)=-SIN(THE)
5279 ROT(3,2)=0.
5280 ROT(3,3)=COS(THE)
5281 DO 130 I=IMIN,IMAX
5282 IF(K(I,1).LE.0) GOTO 130
5283 DO 110 J=1,3
5284 110 PR(J)=P(I,J)
5285 DO 120 J=1,3
5286 120 P(I,J)=ROT(J,1)*PR(1)+ROT(J,2)*PR(2)+ROT(J,3)*PR(3)
5287 130 CONTINUE
5288 ENDIF
5289
5290
5291 IF(DBX**2+DBY**2+DBZ**2.GT.1E-20) THEN
5292 DB=SQRT(DBX**2+DBY**2+DBZ**2)
5293 IF(DB.GT.0.99999999D0) THEN
5294
5295 CALL LUERRM(3,'(LUROBO:) boost vector too large')
5296 DBX=DBX*(0.99999999D0/DB)
5297 DBY=DBY*(0.99999999D0/DB)
5298 DBZ=DBZ*(0.99999999D0/DB)
5299 DB=0.99999999D0
5300 ENDIF
5301 DGA=1D0/SQRT(1D0-DB**2)
5302 DO 150 I=IMIN,IMAX
5303 IF(K(I,1).LE.0) GOTO 150
5304 DO 140 J=1,4
5305 140 DP(J)=P(I,J)
5306 DBP=DBX*DP(1)+DBY*DP(2)+DBZ*DP(3)
5307 DGABP=DGA*(DGA*DBP/(1D0+DGA)+DP(4))
5308 P(I,1)=DP(1)+DGABP*DBX
5309 P(I,2)=DP(2)+DGABP*DBY
5310 P(I,3)=DP(3)+DGABP*DBZ
5311 P(I,4)=DGA*(DP(4)+DBP)
5312 150 CONTINUE
5313 ENDIF
5314
5315 RETURN
5316 END
5317
5318
5319
5320 SUBROUTINE LUEDIT(MEDIT)
5321
5322
5323
5324 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
5325 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
5326 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
5327 DIMENSION NS(2),PTS(2),PLS(2)
5328 SAVE
5329
5330
5331 IF((MEDIT.GE.0.AND.MEDIT.LE.3).OR.MEDIT.EQ.5) THEN
5332 IMAX=N
5333 IF(MSTU(2).GT.0) IMAX=MSTU(2)
5334 I1=MAX(1,MSTU(1))-1
5335 DO 110 I=MAX(1,MSTU(1)),IMAX
5336 IF(K(I,1).EQ.0.OR.K(I,1).GT.20) GOTO 110
5337 IF(MEDIT.EQ.1) THEN
5338 IF(K(I,1).GT.10) GOTO 110
5339 ELSEIF(MEDIT.EQ.2) THEN
5340 IF(K(I,1).GT.10) GOTO 110
5341 KC=LUCOMP(K(I,2))
5342 IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.KC.EQ.18)
5343 & GOTO 110
5344 ELSEIF(MEDIT.EQ.3) THEN
5345 IF(K(I,1).GT.10) GOTO 110
5346 KC=LUCOMP(K(I,2))
5347 IF(KC.EQ.0) GOTO 110
5348 IF(KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0) GOTO 110
5349 ELSEIF(MEDIT.EQ.5) THEN
5350 IF(K(I,1).EQ.13.OR.K(I,1).EQ.14) GOTO 110
5351 KC=LUCOMP(K(I,2))
5352 IF(KC.EQ.0) GOTO 110
5353 IF(K(I,1).GE.11.AND.KCHG(KC,2).EQ.0) GOTO 110
5354 ENDIF
5355
5356
5357 I1=I1+1
5358 DO 100 J=1,5
5359 K(I1,J)=K(I,J)
5360 P(I1,J)=P(I,J)
5361 100 V(I1,J)=V(I,J)
5362 K(I1,3)=0
5363 110 CONTINUE
5364 N=I1
5365
5366
5367 ELSEIF(MEDIT.GE.11.AND.MEDIT.LE.15) THEN
5368 I1=0
5369 DO 120 I=1,N
5370 K(I,3)=MOD(K(I,3),MSTU(5))
5371 IF(MEDIT.EQ.11.AND.K(I,1).LT.0) GOTO 120
5372 IF(MEDIT.EQ.12.AND.K(I,1).EQ.0) GOTO 120
5373 IF(MEDIT.EQ.13.AND.(K(I,1).EQ.11.OR.K(I,1).EQ.12.OR.
5374 & K(I,1).EQ.15).AND.K(I,2).NE.94) GOTO 120
5375 IF(MEDIT.EQ.14.AND.(K(I,1).EQ.13.OR.K(I,1).EQ.14.OR.
5376 & K(I,2).EQ.94)) GOTO 120
5377 IF(MEDIT.EQ.15.AND.K(I,1).GE.21) GOTO 120
5378 I1=I1+1
5379 K(I,3)=K(I,3)+MSTU(5)*I1
5380 120 CONTINUE
5381
5382
5383 DO 140 I=1,N
5384 IF(K(I,1).LE.0.OR.K(I,1).GT.20.OR.K(I,3)/MSTU(5).EQ.0) GOTO 140
5385 ID=I
5386 130 IM=MOD(K(ID,3),MSTU(5))
5387 IF(MEDIT.EQ.13.AND.IM.GT.0.AND.IM.LE.N) THEN
5388 IF((K(IM,1).EQ.11.OR.K(IM,1).EQ.12.OR.K(IM,1).EQ.15).AND.
5389 & K(IM,2).NE.94) THEN
5390 ID=IM
5391 GOTO 130
5392 ENDIF
5393 ELSEIF(MEDIT.EQ.14.AND.IM.GT.0.AND.IM.LE.N) THEN
5394 IF(K(IM,1).EQ.13.OR.K(IM,1).EQ.14.OR.K(IM,2).EQ.94) THEN
5395 ID=IM
5396 GOTO 130
5397 ENDIF
5398 ENDIF
5399 K(I,3)=MSTU(5)*(K(I,3)/MSTU(5))
5400 IF(IM.NE.0) K(I,3)=K(I,3)+K(IM,3)/MSTU(5)
5401 IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) THEN
5402 IF(K(I,4).GT.0.AND.K(I,4).LE.MSTU(4)) K(I,4)=
5403 & K(K(I,4),3)/MSTU(5)
5404 IF(K(I,5).GT.0.AND.K(I,5).LE.MSTU(4)) K(I,5)=
5405 & K(K(I,5),3)/MSTU(5)
5406 ELSE
5407 KCM=MOD(K(I,4)/MSTU(5),MSTU(5))
5408 IF(KCM.GT.0.AND.KCM.LE.MSTU(4)) KCM=K(KCM,3)/MSTU(5)
5409 KCD=MOD(K(I,4),MSTU(5))
5410 IF(KCD.GT.0.AND.KCD.LE.MSTU(4)) KCD=K(KCD,3)/MSTU(5)
5411 K(I,4)=MSTU(5)**2*(K(I,4)/MSTU(5)**2)+MSTU(5)*KCM+KCD
5412 KCM=MOD(K(I,5)/MSTU(5),MSTU(5))
5413 IF(KCM.GT.0.AND.KCM.LE.MSTU(4)) KCM=K(KCM,3)/MSTU(5)
5414 KCD=MOD(K(I,5),MSTU(5))
5415 IF(KCD.GT.0.AND.KCD.LE.MSTU(4)) KCD=K(KCD,3)/MSTU(5)
5416 K(I,5)=MSTU(5)**2*(K(I,5)/MSTU(5)**2)+MSTU(5)*KCM+KCD
5417 ENDIF
5418 140 CONTINUE
5419
5420
5421 I1=0
5422 DO 160 I=1,N
5423 IF(K(I,3)/MSTU(5).EQ.0) GOTO 160
5424 I1=I1+1
5425 DO 150 J=1,5
5426 K(I1,J)=K(I,J)
5427 P(I1,J)=P(I,J)
5428 150 V(I1,J)=V(I,J)
5429 K(I1,3)=MOD(K(I1,3),MSTU(5))
5430 160 CONTINUE
5431 N=I1
5432
5433
5434 ELSEIF(MEDIT.EQ.21) THEN
5435 IF(2*N.GE.MSTU(4)) THEN
5436 CALL LUERRM(11,'(LUEDIT:) no more memory left in LUJETS')
5437 RETURN
5438 ENDIF
5439 DO 170 I=1,N
5440 DO 170 J=1,5
5441 K(MSTU(4)-I,J)=K(I,J)
5442 P(MSTU(4)-I,J)=P(I,J)
5443 170 V(MSTU(4)-I,J)=V(I,J)
5444 MSTU(32)=N
5445
5446
5447 ELSEIF(MEDIT.EQ.22) THEN
5448 DO 180 I=1,MSTU(32)
5449 DO 180 J=1,5
5450 K(I,J)=K(MSTU(4)-I,J)
5451 P(I,J)=P(MSTU(4)-I,J)
5452 180 V(I,J)=V(MSTU(4)-I,J)
5453 N=MSTU(32)
5454
5455
5456 ELSEIF(MEDIT.EQ.23) THEN
5457 I1=0
5458 DO 190 I=1,N
5459 KH=K(I,3)
5460 IF(KH.GE.1) THEN
5461 IF(K(KH,1).GT.20) KH=0
5462 ENDIF
5463 IF(KH.NE.0) GOTO 200
5464 I1=I1+1
5465 190 IF(K(I,1).GT.10.AND.K(I,1).LE.20) K(I,1)=K(I,1)-10
5466 200 N=I1
5467
5468
5469 ELSEIF(MEDIT.EQ.31.OR.MEDIT.EQ.32) THEN
5470 CALL LUDBRB(1,N+MSTU(3),0.,-ULANGL(P(MSTU(61),1),
5471 & P(MSTU(61),2)),0D0,0D0,0D0)
5472 CALL LUDBRB(1,N+MSTU(3),-ULANGL(P(MSTU(61),3),
5473 & P(MSTU(61),1)),0.,0D0,0D0,0D0)
5474 CALL LUDBRB(1,N+MSTU(3),0.,-ULANGL(P(MSTU(61)+1,1),
5475 & P(MSTU(61)+1,2)),0D0,0D0,0D0)
5476 IF(MEDIT.EQ.31) RETURN
5477
5478
5479 DO 210 IS=1,2
5480 NS(IS)=0
5481 PTS(IS)=0.
5482 210 PLS(IS)=0.
5483 DO 220 I=1,N
5484 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 220
5485 IF(MSTU(41).GE.2) THEN
5486 KC=LUCOMP(K(I,2))
5487 IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
5488 & KC.EQ.18) GOTO 220
5489 IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
5490 & GOTO 220
5491 ENDIF
5492 IS=2.-SIGN(0.5,P(I,3))
5493 NS(IS)=NS(IS)+1
5494 PTS(IS)=PTS(IS)+SQRT(P(I,1)**2+P(I,2)**2)
5495 220 CONTINUE
5496 IF(NS(1)*PTS(2)**2.LT.NS(2)*PTS(1)**2)
5497 & CALL LUDBRB(1,N+MSTU(3),PARU(1),0.,0D0,0D0,0D0)
5498
5499
5500 DO 230 I=1,N
5501 IF(P(I,3).GE.0.) GOTO 230
5502 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 230
5503 IF(MSTU(41).GE.2) THEN
5504 KC=LUCOMP(K(I,2))
5505 IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
5506 & KC.EQ.18) GOTO 230
5507 IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
5508 & GOTO 230
5509 ENDIF
5510 IS=2.-SIGN(0.5,P(I,1))
5511 PLS(IS)=PLS(IS)-P(I,3)
5512 230 CONTINUE
5513 IF(PLS(2).GT.PLS(1)) CALL LUDBRB(1,N+MSTU(3),0.,PARU(1),
5514 & 0D0,0D0,0D0)
5515 ENDIF
5516
5517 RETURN
5518 END
5519
5520
5521
5522 SUBROUTINE LULIST(MLIST)
5523
5524
5525
5526 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
5527 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
5528 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
5529 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
5530 CHARACTER CHAP*16,CHAC*16,CHAN*16,CHAD(5)*16,CHMO(12)*3,CHDL(7)*4
5531 DIMENSION PS(6)
5532 SAVE
5533 DATA CHMO/'Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep',
5534 &'Oct','Nov','Dec'/,CHDL/'(())',' ','()','!!','<>','==','(==)'/
5535
5536 CHMO(1)=CHMO(1)
5537
5538
5539
5540
5541
5542
5543
5544
5545
5546 IF(MLIST.GE.1.AND.MLIST.LE.3) THEN
5547 IF(MLIST.EQ.1) WRITE(MSTU(11),1100)
5548 IF(MLIST.EQ.2) WRITE(MSTU(11),1200)
5549 IF(MLIST.EQ.3) WRITE(MSTU(11),1300)
5550 LMX=12
5551 IF(MLIST.GE.2) LMX=16
5552 ISTR=0
5553 IMAX=N
5554 IF(MSTU(2).GT.0) IMAX=MSTU(2)
5555 DO 120 I=MAX(1,MSTU(1)),MAX(IMAX,N+MAX(0,MSTU(3)))
5556 IF((I.GT.IMAX.AND.I.LE.N).OR.K(I,1).LT.0) GOTO 120
5557
5558
5559 CALL LUNAME(K(I,2),CHAP)
5560 LEN=0
5561 DO 100 LEM=1,16
5562 100 IF(CHAP(LEM:LEM).NE.' ') LEN=LEM
5563 MDL=(K(I,1)+19)/10
5564 LDL=0
5565 IF(MDL.EQ.2.OR.MDL.GE.8) THEN
5566 CHAC=CHAP
5567 IF(LEN.GT.LMX) CHAC(LMX:LMX)='?'
5568 ELSE
5569 LDL=1
5570 IF(MDL.EQ.1.OR.MDL.EQ.7) LDL=2
5571 IF(LEN.EQ.0) THEN
5572 CHAC=CHDL(MDL)(1:2*LDL)//' '
5573 ELSE
5574 CHAC=CHDL(MDL)(1:LDL)//CHAP(1:MIN(LEN,LMX-2*LDL))//
5575 & CHDL(MDL)(LDL+1:2*LDL)//' '
5576 IF(LEN+2*LDL.GT.LMX) CHAC(LMX:LMX)='?'
5577 ENDIF
5578 ENDIF
5579
5580
5581 IF(K(I,1).EQ.1.OR.K(I,1).EQ.2.OR.K(I,1).EQ.11.OR.K(I,1).EQ.12)
5582 & THEN
5583 KC=LUCOMP(K(I,2))
5584 KCC=0
5585 IF(KC.NE.0) KCC=KCHG(KC,2)
5586 IF(KCC.NE.0.AND.ISTR.EQ.0) THEN
5587 ISTR=1
5588 IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='A'
5589 ELSEIF(KCC.NE.0.AND.(K(I,1).EQ.2.OR.K(I,1).EQ.12)) THEN
5590 IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='I'
5591 ELSEIF(KCC.NE.0) THEN
5592 ISTR=0
5593 IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='V'
5594 ENDIF
5595 ENDIF
5596
5597
5598 IF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.9999.) THEN
5599 WRITE(MSTU(11),1400) I,CHAC(1:12),(K(I,J1),J1=1,3),
5600 & (P(I,J2),J2=1,5)
5601 ELSEIF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.99999.) THEN
5602 WRITE(MSTU(11),1500) I,CHAC(1:12),(K(I,J1),J1=1,3),
5603 & (P(I,J2),J2=1,5)
5604 ELSEIF(MLIST.EQ.1) THEN
5605 WRITE(MSTU(11),1600) I,CHAC(1:12),(K(I,J1),J1=1,3),
5606 & (P(I,J2),J2=1,5)
5607 ELSEIF(MSTU(5).EQ.10000.AND.(K(I,1).EQ.3.OR.K(I,1).EQ.13.OR.
5608 & K(I,1).EQ.14)) THEN
5609 WRITE(MSTU(11),1700) I,CHAC,(K(I,J1),J1=1,3),
5610 & K(I,4)/100000000,MOD(K(I,4)/10000,10000),MOD(K(I,4),10000),
5611 & K(I,5)/100000000,MOD(K(I,5)/10000,10000),MOD(K(I,5),10000),
5612 & (P(I,J2),J2=1,5)
5613 ELSE
5614 WRITE(MSTU(11),1800) I,CHAC,(K(I,J1),J1=1,5),(P(I,J2),J2=1,5)
5615 ENDIF
5616 IF(MLIST.EQ.3) WRITE(MSTU(11),1900) (V(I,J),J=1,5)
5617
5618
5619 IF(MSTU(70).GE.1) THEN
5620 ISEP=0
5621 DO 110 J=1,MIN(10,MSTU(70))
5622 110 IF(I.EQ.MSTU(70+J)) ISEP=1
5623 IF(ISEP.EQ.1.AND.MLIST.EQ.1) WRITE(MSTU(11),2000)
5624 IF(ISEP.EQ.1.AND.MLIST.GE.2) WRITE(MSTU(11),2100)
5625 ENDIF
5626 120 CONTINUE
5627
5628
5629 DO 130 J=1,6
5630 130 PS(J)=PLU(0,J)
5631 IF(MLIST.EQ.1.AND.ABS(PS(4)).LT.9999.) THEN
5632 WRITE(MSTU(11),2200) PS(6),(PS(J),J=1,5)
5633 ELSEIF(MLIST.EQ.1.AND.ABS(PS(4)).LT.99999.) THEN
5634 WRITE(MSTU(11),2300) PS(6),(PS(J),J=1,5)
5635 ELSEIF(MLIST.EQ.1) THEN
5636 WRITE(MSTU(11),2400) PS(6),(PS(J),J=1,5)
5637 ELSE
5638 WRITE(MSTU(11),2500) PS(6),(PS(J),J=1,5)
5639 ENDIF
5640
5641
5642 ELSEIF(MLIST.EQ.11) THEN
5643 WRITE(MSTU(11),2600)
5644 DO 140 KF=1,40
5645 CALL LUNAME(KF,CHAP)
5646 CALL LUNAME(-KF,CHAN)
5647 IF(CHAP.NE.' '.AND.CHAN.EQ.' ') WRITE(MSTU(11),2700) KF,CHAP
5648 140 IF(CHAN.NE.' ') WRITE(MSTU(11),2700) KF,CHAP,-KF,CHAN
5649 DO 150 KFLS=1,3,2
5650 DO 150 KFLA=1,8
5651 DO 150 KFLB=1,KFLA-(3-KFLS)/2
5652 KF=1000*KFLA+100*KFLB+KFLS
5653 CALL LUNAME(KF,CHAP)
5654 CALL LUNAME(-KF,CHAN)
5655 150 WRITE(MSTU(11),2700) KF,CHAP,-KF,CHAN
5656 DO 170 KMUL=0,5
5657 KFLS=3
5658 IF(KMUL.EQ.0.OR.KMUL.EQ.3) KFLS=1
5659 IF(KMUL.EQ.5) KFLS=5
5660 KFLR=0
5661 IF(KMUL.EQ.2.OR.KMUL.EQ.3) KFLR=1
5662 IF(KMUL.EQ.4) KFLR=2
5663 DO 170 KFLB=1,8
5664 DO 160 KFLC=1,KFLB-1
5665 KF=10000*KFLR+100*KFLB+10*KFLC+KFLS
5666 CALL LUNAME(KF,CHAP)
5667 CALL LUNAME(-KF,CHAN)
5668 160 WRITE(MSTU(11),2700) KF,CHAP,-KF,CHAN
5669 KF=10000*KFLR+110*KFLB+KFLS
5670 CALL LUNAME(KF,CHAP)
5671 170 WRITE(MSTU(11),2700) KF,CHAP
5672 KF=130
5673 CALL LUNAME(KF,CHAP)
5674 WRITE(MSTU(11),2700) KF,CHAP
5675 KF=310
5676 CALL LUNAME(KF,CHAP)
5677 WRITE(MSTU(11),2700) KF,CHAP
5678 DO 190 KFLSP=1,3
5679 KFLS=2+2*(KFLSP/3)
5680 DO 190 KFLA=1,8
5681 DO 190 KFLB=1,KFLA
5682 DO 180 KFLC=1,KFLB
5683 IF(KFLSP.EQ.1.AND.(KFLA.EQ.KFLB.OR.KFLB.EQ.KFLC)) GOTO 180
5684 IF(KFLSP.EQ.2.AND.KFLA.EQ.KFLC) GOTO 180
5685 IF(KFLSP.EQ.1) KF=1000*KFLA+100*KFLC+10*KFLB+KFLS
5686 IF(KFLSP.GE.2) KF=1000*KFLA+100*KFLB+10*KFLC+KFLS
5687 CALL LUNAME(KF,CHAP)
5688 CALL LUNAME(-KF,CHAN)
5689 WRITE(MSTU(11),2700) KF,CHAP,-KF,CHAN
5690 180 CONTINUE
5691 190 CONTINUE
5692
5693
5694 ELSEIF(MLIST.EQ.12) THEN
5695 WRITE(MSTU(11),2800)
5696 MSTJ24=MSTJ(24)
5697 MSTJ(24)=0
5698 KFMAX=20883
5699 IF(MSTU(2).NE.0) KFMAX=MSTU(2)
5700 DO 220 KF=MAX(1,MSTU(1)),KFMAX
5701 KC=LUCOMP(KF)
5702 IF(KC.EQ.0) GOTO 220
5703 IF(MSTU(14).EQ.0.AND.KF.GT.100.AND.KC.LE.100) GOTO 220
5704 IF(MSTU(14).GT.0.AND.KF.GT.100.AND.MAX(MOD(KF/1000,10),
5705 & MOD(KF/100,10)).GT.MSTU(14)) GOTO 220
5706
5707
5708 CALL LUNAME(KF,CHAP)
5709 IF(KF.LE.100.AND.CHAP.EQ.' '.AND.MDCY(KC,2).EQ.0) GOTO 220
5710 CALL LUNAME(-KF,CHAN)
5711 PM=ULMASS(KF)
5712 WRITE(MSTU(11),2900) KF,KC,CHAP,CHAN,KCHG(KC,1),KCHG(KC,2),
5713 & KCHG(KC,3),PM,PMAS(KC,2),PMAS(KC,3),PMAS(KC,4),MDCY(KC,1)
5714
5715
5716
5717 IF(KF.GT.100.AND.KC.LE.100) GOTO 220
5718 DO 210 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1
5719 DO 200 J=1,5
5720 200 CALL LUNAME(KFDP(IDC,J),CHAD(J))
5721 210 WRITE(MSTU(11),3000) IDC,MDME(IDC,1),MDME(IDC,2),BRAT(IDC),
5722 & (CHAD(J),J=1,5)
5723 220 CONTINUE
5724 MSTJ(24)=MSTJ24
5725
5726
5727 ELSEIF(MLIST.EQ.13) THEN
5728 WRITE(MSTU(11),3100)
5729 DO 230 I=1,200
5730 230 WRITE(MSTU(11),3200) I,MSTU(I),PARU(I),MSTJ(I),PARJ(I),PARF(I)
5731 ENDIF
5732
5733
5734
5735
5736 1100 FORMAT(///28X,'Event listing (summary)'//4X,'I particle/jet KS',
5737 &5X,'KF orig p_x p_y p_z E m'/)
5738 1200 FORMAT(///28X,'Event listing (standard)'//4X,'I particle/jet',
5739 &' K(I,1) K(I,2) K(I,3) K(I,4) K(I,5) P(I,1)',
5740 &' P(I,2) P(I,3) P(I,4) P(I,5)'/)
5741 1300 FORMAT(///28X,'Event listing (with vertices)'//4X,'I particle/j',
5742 &'et K(I,1) K(I,2) K(I,3) K(I,4) K(I,5) P(I,1)',
5743 &' P(I,2) P(I,3) P(I,4) P(I,5)'/73X,
5744 &'V(I,1) V(I,2) V(I,3) V(I,4) V(I,5)'/)
5745 1400 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.3)
5746 1500 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.2)
5747 1600 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.1)
5748 1700 FORMAT(1X,I4,2X,A16,1X,I3,1X,I8,2X,I4,2(3X,I1,2I4),5F13.5)
5749 1800 FORMAT(1X,I4,2X,A16,1X,I3,1X,I8,2X,I4,2(3X,I9),5F13.5)
5750 1900 FORMAT(66X,5(1X,F12.3))
5751 2000 FORMAT(1X,78('='))
5752 2100 FORMAT(1X,130('='))
5753 2200 FORMAT(19X,'sum:',F6.2,5X,5F9.3)
5754 2300 FORMAT(19X,'sum:',F6.2,5X,5F9.2)
5755 2400 FORMAT(19X,'sum:',F6.2,5X,5F9.1)
5756 2500 FORMAT(19X,'sum charge:',F6.2,3X,'sum momentum and inv. mass:',
5757 &5F13.5)
5758 2600 FORMAT(///20X,'List of KF codes in program'/)
5759 2700 FORMAT(4X,I6,4X,A16,6X,I6,4X,A16)
5760 2800 FORMAT(///30X,'Particle/parton data table'//5X,'KF',5X,'KC',4X,
5761 &'particle',8X,'antiparticle',6X,'chg col anti',8X,'mass',7X,
5762 &'width',7X,'w-cut',5X,'lifetime',1X,'decay'/11X,'IDC',1X,'on/off',
5763 &1X,'ME',3X,'Br.rat.',4X,'decay products')
5764 2900 FORMAT(/1X,I6,3X,I4,4X,A16,A16,3I5,1X,F12.5,2(1X,F11.5),
5765 &2X,F12.5,3X,I2)
5766 3000 FORMAT(10X,I4,2X,I3,2X,I3,2X,F8.5,4X,5A16)
5767 3100 FORMAT(///20X,'Parameter value table'//4X,'I',3X,'MSTU(I)',
5768 &8X,'PARU(I)',3X,'MSTJ(I)',8X,'PARJ(I)',8X,'PARF(I)')
5769 3200 FORMAT(1X,I4,1X,I9,1X,F14.5,1X,I9,1X,F14.5,1X,F14.5)
5770
5771 RETURN
5772 END
5773
5774
5775
5776 SUBROUTINE LUUPDA(MUPDA,LFN)
5777
5778
5779 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
5780 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
5781 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
5782 COMMON/LUDAT4/CHAF(500)
5783 CHARACTER CHAF*8
5784 CHARACTER CHINL*80,CHKC*4,CHVAR(19)*9,CHLIN*72,
5785 &CHBLK(20)*72,CHOLD*12,CHTMP*12,CHNEW*12,CHCOM*12
5786 SAVE
5787 DATA CHVAR/ 'KCHG(I,1)','KCHG(I,2)','KCHG(I,3)','PMAS(I,1)',
5788 &'PMAS(I,2)','PMAS(I,3)','PMAS(I,4)','MDCY(I,1)','MDCY(I,2)',
5789 &'MDCY(I,3)','MDME(I,1)','MDME(I,2)','BRAT(I) ','KFDP(I,1)',
5790 &'KFDP(I,2)','KFDP(I,3)','KFDP(I,4)','KFDP(I,5)','CHAF(I) '/
5791
5792
5793 IF(MSTU(12).GE.1) CALL LULIST(0)
5794 IF(MUPDA.EQ.1) THEN
5795 DO 110 KC=1,MSTU(6)
5796 WRITE(LFN,1000) KC,CHAF(KC),(KCHG(KC,J1),J1=1,3),
5797 & (PMAS(KC,J2),J2=1,4),MDCY(KC,1)
5798 DO 100 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1
5799 100 WRITE(LFN,1100) MDME(IDC,1),MDME(IDC,2),BRAT(IDC),
5800 & (KFDP(IDC,J),J=1,5)
5801 110 CONTINUE
5802
5803
5804 ELSEIF(MUPDA.EQ.2) THEN
5805 DO 120 I=1,MSTU(7)
5806 MDME(I,1)=1
5807 MDME(I,2)=0
5808 BRAT(I)=0.
5809 DO 120 J=1,5
5810 120 KFDP(I,J)=0
5811 KC=0
5812 IDC=0
5813 NDC=0
5814 130 READ(LFN,1200,END=140) CHINL
5815 IF(CHINL(2:5).NE.' ') THEN
5816 CHKC=CHINL(2:5)
5817 IF(KC.NE.0) THEN
5818 MDCY(KC,2)=0
5819 IF(NDC.NE.0) MDCY(KC,2)=IDC+1-NDC
5820 MDCY(KC,3)=NDC
5821 ENDIF
5822 READ(CHKC,1300) KC
5823 IF(KC.LE.0.OR.KC.GT.MSTU(6)) CALL LUERRM(27,
5824 & '(LUUPDA:) Read KC code illegal, KC ='//CHKC)
5825 READ(CHINL,1000) KCR,CHAF(KC),(KCHG(KC,J1),J1=1,3),
5826 & (PMAS(KC,J2),J2=1,4),MDCY(KC,1)
5827 NDC=0
5828 ELSE
5829 IDC=IDC+1
5830 NDC=NDC+1
5831 IF(IDC.GE.MSTU(7)) CALL LUERRM(27,
5832 & '(LUUPDA:) Decay data arrays full by KC ='//CHKC)
5833 READ(CHINL,1100) MDME(IDC,1),MDME(IDC,2),BRAT(IDC),
5834 & (KFDP(IDC,J),J=1,5)
5835 ENDIF
5836 GOTO 130
5837 140 MDCY(KC,2)=0
5838 IF(NDC.NE.0) MDCY(KC,2)=IDC+1-NDC
5839 MDCY(KC,3)=NDC
5840
5841
5842 MSTJ24=MSTJ(24)
5843 MSTJ(24)=0
5844 DO 170 KC=1,MSTU(6)
5845 WRITE(CHKC,1300) KC
5846 IF(MIN(PMAS(KC,1),PMAS(KC,2),PMAS(KC,3),PMAS(KC,1)-PMAS(KC,3),
5847 & PMAS(KC,4)).LT.0..OR.MDCY(KC,3).LT.0) CALL LUERRM(17,
5848 & '(LUUPDA:) Mass/width/life/(# channels) wrong for KC ='//CHKC)
5849 BRSUM=0.
5850 DO 160 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1
5851 IF(MDME(IDC,2).GT.80) GOTO 160
5852 KQ=KCHG(KC,1)
5853 PMS=PMAS(KC,1)-PMAS(KC,3)-PARJ(64)
5854 MERR=0
5855 DO 150 J=1,5
5856 KP=KFDP(IDC,J)
5857 IF(KP.EQ.0.OR.KP.EQ.81.OR.IABS(KP).EQ.82) THEN
5858 ELSEIF(LUCOMP(KP).EQ.0) THEN
5859 MERR=3
5860 ELSE
5861 KQ=KQ-LUCHGE(KP)
5862 PMS=PMS-ULMASS(KP)
5863 ENDIF
5864 150 CONTINUE
5865 IF(KQ.NE.0) MERR=MAX(2,MERR)
5866 IF(KFDP(IDC,2).NE.0.AND.(KC.LE.20.OR.KC.GT.40).AND.
5867 & (KC.LE.80.OR.KC.GT.100).AND.MDME(IDC,2).NE.34.AND.
5868 & MDME(IDC,2).NE.61.AND.PMS.LT.0.) MERR=MAX(1,MERR)
5869 IF(MERR.EQ.3) CALL LUERRM(17,
5870 & '(LUUPDA:) Unknown particle code in decay of KC ='//CHKC)
5871 IF(MERR.EQ.2) CALL LUERRM(17,
5872 & '(LUUPDA:) Charge not conserved in decay of KC ='//CHKC)
5873 IF(MERR.EQ.1) CALL LUERRM(7,
5874 & '(LUUPDA:) Kinematically unallowed decay of KC ='//CHKC)
5875 BRSUM=BRSUM+BRAT(IDC)
5876 160 CONTINUE
5877 WRITE(CHTMP,1500) BRSUM
5878 IF(ABS(BRSUM).GT.0.0005.AND.ABS(BRSUM-1.).GT.0.0005) CALL
5879 & LUERRM(7,'(LUUPDA:) Sum of branching ratios is '//CHTMP(5:12)//
5880 & ' for KC ='//CHKC)
5881 170 CONTINUE
5882 MSTJ(24)=MSTJ24
5883
5884
5885 ELSEIF(MUPDA.EQ.3) THEN
5886 DO 240 IVAR=1,19
5887 NDIM=MSTU(6)
5888 IF(IVAR.GE.11.AND.IVAR.LE.18) NDIM=MSTU(7)
5889 NLIN=1
5890 CHLIN=' '
5891 CHLIN(7:35)='DATA ('//CHVAR(IVAR)//',I= 1, )/'
5892 LLIN=35
5893 CHOLD='START'
5894
5895
5896 DO 220 IDIM=1,NDIM
5897 IF(IVAR.EQ.1) WRITE(CHTMP,1400) KCHG(IDIM,1)
5898 IF(IVAR.EQ.2) WRITE(CHTMP,1400) KCHG(IDIM,2)
5899 IF(IVAR.EQ.3) WRITE(CHTMP,1400) KCHG(IDIM,3)
5900 IF(IVAR.EQ.4) WRITE(CHTMP,1500) PMAS(IDIM,1)
5901 IF(IVAR.EQ.5) WRITE(CHTMP,1500) PMAS(IDIM,2)
5902 IF(IVAR.EQ.6) WRITE(CHTMP,1500) PMAS(IDIM,3)
5903 IF(IVAR.EQ.7) WRITE(CHTMP,1500) PMAS(IDIM,4)
5904 IF(IVAR.EQ.8) WRITE(CHTMP,1400) MDCY(IDIM,1)
5905 IF(IVAR.EQ.9) WRITE(CHTMP,1400) MDCY(IDIM,2)
5906 IF(IVAR.EQ.10) WRITE(CHTMP,1400) MDCY(IDIM,3)
5907 IF(IVAR.EQ.11) WRITE(CHTMP,1400) MDME(IDIM,1)
5908 IF(IVAR.EQ.12) WRITE(CHTMP,1400) MDME(IDIM,2)
5909 IF(IVAR.EQ.13) WRITE(CHTMP,1500) BRAT(IDIM)
5910 IF(IVAR.EQ.14) WRITE(CHTMP,1400) KFDP(IDIM,1)
5911 IF(IVAR.EQ.15) WRITE(CHTMP,1400) KFDP(IDIM,2)
5912 IF(IVAR.EQ.16) WRITE(CHTMP,1400) KFDP(IDIM,3)
5913 IF(IVAR.EQ.17) WRITE(CHTMP,1400) KFDP(IDIM,4)
5914 IF(IVAR.EQ.18) WRITE(CHTMP,1400) KFDP(IDIM,5)
5915 IF(IVAR.EQ.19) CHTMP=CHAF(IDIM)
5916
5917
5918 LLOW=1
5919 LHIG=1
5920 DO 180 LL=1,12
5921 IF(CHTMP(13-LL:13-LL).NE.' ') LLOW=13-LL
5922 180 IF(CHTMP(LL:LL).NE.' ') LHIG=LL
5923 CHNEW=CHTMP(LLOW:LHIG)//' '
5924 LNEW=1+LHIG-LLOW
5925 IF((IVAR.GE.4.AND.IVAR.LE.7).OR.IVAR.EQ.13) THEN
5926 LNEW=LNEW+1
5927 190 LNEW=LNEW-1
5928 IF(CHNEW(LNEW:LNEW).EQ.'0') GOTO 190
5929 IF(LNEW.EQ.1) CHNEW(1:2)='0.'
5930 IF(LNEW.EQ.1) LNEW=2
5931 ELSEIF(IVAR.EQ.19) THEN
5932 DO 200 LL=LNEW,1,-1
5933 IF(CHNEW(LL:LL).EQ.'''') THEN
5934 CHTMP=CHNEW
5935 CHNEW=CHTMP(1:LL)//''''//CHTMP(LL+1:11)
5936 LNEW=LNEW+1
5937 ENDIF
5938 200 CONTINUE
5939 CHTMP=CHNEW
5940 CHNEW(1:LNEW+2)=''''//CHTMP(1:LNEW)//''''
5941 LNEW=LNEW+2
5942 ENDIF
5943
5944
5945 IF(CHNEW.NE.CHOLD) THEN
5946 NRPT=1
5947 CHOLD=CHNEW
5948 CHCOM=CHNEW
5949 LCOM=LNEW
5950 ELSE
5951 LRPT=LNEW+1
5952 IF(NRPT.GE.2) LRPT=LNEW+3
5953 IF(NRPT.GE.10) LRPT=LNEW+4
5954 IF(NRPT.GE.100) LRPT=LNEW+5
5955 IF(NRPT.GE.1000) LRPT=LNEW+6
5956 LLIN=LLIN-LRPT
5957 NRPT=NRPT+1
5958 WRITE(CHTMP,1400) NRPT
5959 LRPT=1
5960 IF(NRPT.GE.10) LRPT=2
5961 IF(NRPT.GE.100) LRPT=3
5962 IF(NRPT.GE.1000) LRPT=4
5963 CHCOM(1:LRPT+1+LNEW)=CHTMP(13-LRPT:12)//'*'//CHNEW(1:LNEW)
5964 LCOM=LRPT+1+LNEW
5965 ENDIF
5966
5967
5968
5969 IF(LLIN+LCOM.LE.70) THEN
5970 CHLIN(LLIN+1:LLIN+LCOM+1)=CHCOM(1:LCOM)//','
5971 LLIN=LLIN+LCOM+1
5972 ELSEIF(NLIN.LE.19) THEN
5973 CHLIN(LLIN+1:72)=' '
5974 CHBLK(NLIN)=CHLIN
5975 NLIN=NLIN+1
5976 CHLIN(6:6+LCOM+1)='&'//CHCOM(1:LCOM)//','
5977 LLIN=6+LCOM+1
5978 ELSE
5979 CHLIN(LLIN:72)='/'//' '
5980 CHBLK(NLIN)=CHLIN
5981 WRITE(CHTMP,1400) IDIM-NRPT
5982 CHBLK(1)(30:33)=CHTMP(9:12)
5983 DO 210 ILIN=1,NLIN
5984 210 WRITE(LFN,1600) CHBLK(ILIN)
5985 NLIN=1
5986 CHLIN=' '
5987 CHLIN(7:35+LCOM+1)='DATA ('//CHVAR(IVAR)//',I= , )/'//
5988 & CHCOM(1:LCOM)//','
5989 WRITE(CHTMP,1400) IDIM-NRPT+1
5990 CHLIN(25:28)=CHTMP(9:12)
5991 LLIN=35+LCOM+1
5992 ENDIF
5993 220 CONTINUE
5994
5995
5996 CHLIN(LLIN:72)='/'//' '
5997 CHBLK(NLIN)=CHLIN
5998 WRITE(CHTMP,1400) NDIM
5999 CHBLK(1)(30:33)=CHTMP(9:12)
6000 DO 230 ILIN=1,NLIN
6001 230 WRITE(LFN,1600) CHBLK(ILIN)
6002 240 CONTINUE
6003 ENDIF
6004
6005
6006 1000 FORMAT(1X,I4,2X,A8,3I3,3F12.5,2X,F12.5,I3)
6007 1100 FORMAT(5X,2I5,F12.5,5I8)
6008 1200 FORMAT(A80)
6009 1300 FORMAT(I4)
6010 1400 FORMAT(I12)
6011 1500 FORMAT(F12.5)
6012 1600 FORMAT(A72)
6013
6014 RETURN
6015 END
6016
6017
6018
6019 FUNCTION KLU(I,J)
6020
6021
6022 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
6023 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
6024 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
6025 SAVE
6026
6027
6028
6029 KLU=0
6030 IF(I.LT.0.OR.I.GT.MSTU(4).OR.J.LE.0) THEN
6031 ELSEIF(I.EQ.0.AND.J.EQ.1) THEN
6032 KLU=N
6033 ELSEIF(I.EQ.0.AND.(J.EQ.2.OR.J.EQ.6)) THEN
6034 DO 100 I1=1,N
6035 IF(J.EQ.2.AND.K(I1,1).GE.1.AND.K(I1,1).LE.10) KLU=KLU+1
6036 IF(J.EQ.6.AND.K(I1,1).GE.1.AND.K(I1,1).LE.10) KLU=KLU+
6037 & LUCHGE(K(I1,2))
6038 100 CONTINUE
6039 ELSEIF(I.EQ.0) THEN
6040
6041
6042 ELSEIF(J.LE.5) THEN
6043 KLU=K(I,J)
6044 ELSEIF(J.EQ.6) THEN
6045 KLU=LUCHGE(K(I,2))
6046
6047
6048 ELSEIF(J.LE.8) THEN
6049 IF(K(I,1).GE.1.AND.K(I,1).LE.10) KLU=1
6050 IF(J.EQ.8) KLU=KLU*K(I,2)
6051 ELSEIF(J.LE.12) THEN
6052 KFA=IABS(K(I,2))
6053 KC=LUCOMP(KFA)
6054 KQ=0
6055 IF(KC.NE.0) KQ=KCHG(KC,2)
6056 IF(J.EQ.9.AND.KC.NE.0.AND.KQ.NE.0) KLU=K(I,2)
6057 IF(J.EQ.10.AND.KC.NE.0.AND.KQ.EQ.0) KLU=K(I,2)
6058 IF(J.EQ.11) KLU=KC
6059 IF(J.EQ.12) KLU=KQ*ISIGN(1,K(I,2))
6060
6061
6062 ELSEIF(J.EQ.13) THEN
6063 KFA=IABS(K(I,2))
6064 KLU=MOD(KFA/100,10)*(-1)**MOD(KFA/100,10)
6065 IF(KFA.LT.10) KLU=KFA
6066 IF(MOD(KFA/1000,10).NE.0) KLU=MOD(KFA/1000,10)
6067 KLU=KLU*ISIGN(1,K(I,2))
6068
6069
6070 ELSEIF(J.LE.16) THEN
6071 I2=I
6072 I1=I
6073 110 KLU=KLU+1
6074 I3=I2
6075 I2=I1
6076 I1=K(I1,3)
6077 IF(I1.GT.0.AND.