File indexing completed on 2024-04-06 12:13:47
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.K(I1,1).GT.0.AND.K(I1,1).LE.20) GOTO 110
6078 IF(J.EQ.15) KLU=I2
6079 IF(J.EQ.16) THEN
6080 KLU=0
6081 DO 120 I1=I2+1,I3
6082 120 IF(K(I1,3).EQ.I2.AND.K(I1,1).GT.0.AND.K(I1,1).LE.20) KLU=KLU+1
6083 ENDIF
6084
6085
6086 ELSEIF(J.EQ.17) THEN
6087 I1=I
6088 130 KLU=KLU+1
6089 I3=I1
6090 I1=K(I1,3)
6091 I0=MAX(1,I1)
6092 KC=LUCOMP(K(I0,2))
6093 IF(I1.EQ.0.OR.K(I0,1).LE.0.OR.K(I0,1).GT.20.OR.KC.EQ.0) THEN
6094 IF(KLU.EQ.1) KLU=-1
6095 IF(KLU.GT.1) KLU=0
6096 RETURN
6097 ENDIF
6098 IF(KCHG(KC,2).EQ.0) GOTO 130
6099 IF(K(I1,1).NE.12) KLU=0
6100 IF(K(I1,1).NE.12) RETURN
6101 I2=I1
6102 140 I2=I2+1
6103 IF(I2.LT.N.AND.K(I2,1).NE.11) GOTO 140
6104 K3M=K(I3-1,3)
6105 IF(K3M.GE.I1.AND.K3M.LE.I2) KLU=0
6106 K3P=K(I3+1,3)
6107 IF(I3.LT.N.AND.K3P.GE.I1.AND.K3P.LE.I2) KLU=0
6108
6109
6110 ELSEIF(J.EQ.18) THEN
6111 IF(K(I,1).EQ.11.OR.K(I,1).EQ.12) KLU=MAX(0,K(I,5)-K(I,4)+1)
6112 IF(K(I,4).EQ.0.OR.K(I,5).EQ.0) KLU=0
6113 ELSEIF(J.LE.22) THEN
6114 IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) RETURN
6115 IF(J.EQ.19) KLU=MOD(K(I,4)/MSTU(5),MSTU(5))
6116 IF(J.EQ.20) KLU=MOD(K(I,5)/MSTU(5),MSTU(5))
6117 IF(J.EQ.21) KLU=MOD(K(I,4),MSTU(5))
6118 IF(J.EQ.22) KLU=MOD(K(I,5),MSTU(5))
6119 ELSE
6120 ENDIF
6121
6122 RETURN
6123 END
6124
6125
6126
6127 FUNCTION PLU(I,J)
6128
6129
6130 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
6131 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
6132 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
6133 DIMENSION PSUM(4)
6134 SAVE
6135
6136
6137
6138 PLU=0.
6139 IF(I.LT.0.OR.I.GT.MSTU(4).OR.J.LE.0) THEN
6140 ELSEIF(I.EQ.0.AND.J.LE.4) THEN
6141 DO 100 I1=1,N
6142 100 IF(K(I1,1).GT.0.AND.K(I1,1).LE.10) PLU=PLU+P(I1,J)
6143 ELSEIF(I.EQ.0.AND.J.EQ.5) THEN
6144 DO 110 J1=1,4
6145 PSUM(J1)=0.
6146 DO 110 I1=1,N
6147 110 IF(K(I1,1).GT.0.AND.K(I1,1).LE.10) PSUM(J1)=PSUM(J1)+P(I1,J1)
6148 PLU=SQRT(MAX(0.,PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-PSUM(3)**2))
6149 ELSEIF(I.EQ.0.AND.J.EQ.6) THEN
6150 DO 120 I1=1,N
6151 120 IF(K(I1,1).GT.0.AND.K(I1,1).LE.10) PLU=PLU+LUCHGE(K(I1,2))/3.
6152 ELSEIF(I.EQ.0) THEN
6153
6154
6155 ELSEIF(J.LE.5) THEN
6156 PLU=P(I,J)
6157
6158
6159 ELSEIF(J.LE.12) THEN
6160 IF(J.EQ.6) PLU=LUCHGE(K(I,2))/3.
6161 IF(J.EQ.7.OR.J.EQ.8) PLU=P(I,1)**2+P(I,2)**2+P(I,3)**2
6162 IF(J.EQ.9.OR.J.EQ.10) PLU=P(I,1)**2+P(I,2)**2
6163 IF(J.EQ.11.OR.J.EQ.12) PLU=P(I,5)**2+P(I,1)**2+P(I,2)**2
6164 IF(J.EQ.8.OR.J.EQ.10.OR.J.EQ.12) PLU=SQRT(PLU)
6165
6166
6167 ELSEIF(J.LE.16) THEN
6168 IF(J.LE.14) PLU=ULANGL(P(I,3),SQRT(P(I,1)**2+P(I,2)**2))
6169 IF(J.GE.15) PLU=ULANGL(P(I,1),P(I,2))
6170 IF(J.EQ.14.OR.J.EQ.16) PLU=PLU*180./PARU(1)
6171
6172
6173 ELSEIF(J.LE.19) THEN
6174 PMR=0.
6175 IF(J.EQ.17) PMR=P(I,5)
6176 IF(J.EQ.18) PMR=ULMASS(211)
6177 PR=MAX(1E-20,PMR**2+P(I,1)**2+P(I,2)**2)
6178 PLU=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/SQRT(PR),
6179 & 1E20)),P(I,3))
6180
6181
6182 ELSEIF(J.LE.25) THEN
6183 IF(J.EQ.20) PLU=2.*SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)/PARU(21)
6184 IF(J.EQ.21) PLU=2.*P(I,3)/PARU(21)
6185 IF(J.EQ.22) PLU=2.*SQRT(P(I,1)**2+P(I,2)**2)/PARU(21)
6186 IF(J.EQ.23) PLU=2.*P(I,4)/PARU(21)
6187 IF(J.EQ.24) PLU=(P(I,4)+P(I,3))/PARU(21)
6188 IF(J.EQ.25) PLU=(P(I,4)-P(I,3))/PARU(21)
6189 ENDIF
6190
6191 RETURN
6192 END
6193
6194
6195
6196 SUBROUTINE LUSPHE(SPH,APL)
6197
6198
6199
6200 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
6201 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
6202 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
6203 DIMENSION SM(3,3),SV(3,3)
6204 SAVE
6205
6206
6207 NP=0
6208 DO 100 J1=1,3
6209 DO 100 J2=J1,3
6210 100 SM(J1,J2)=0.
6211 PS=0.
6212 DO 120 I=1,N
6213 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 120
6214 IF(MSTU(41).GE.2) THEN
6215 KC=LUCOMP(K(I,2))
6216 IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
6217 & KC.EQ.18) GOTO 120
6218 IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
6219 & GOTO 120
6220 ENDIF
6221 NP=NP+1
6222 PA=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)
6223 PWT=1.
6224 IF(ABS(PARU(41)-2.).GT.0.001) PWT=MAX(1E-10,PA)**(PARU(41)-2.)
6225 DO 110 J1=1,3
6226 DO 110 J2=J1,3
6227 110 SM(J1,J2)=SM(J1,J2)+PWT*P(I,J1)*P(I,J2)
6228 PS=PS+PWT*PA**2
6229 120 CONTINUE
6230
6231
6232 IF(NP.LE.1) THEN
6233 CALL LUERRM(8,'(LUSPHE:) too few particles for analysis')
6234 SPH=-1.
6235 APL=-1.
6236 RETURN
6237 ENDIF
6238 DO 130 J1=1,3
6239 DO 130 J2=J1,3
6240 130 SM(J1,J2)=SM(J1,J2)/PS
6241
6242
6243 SQ=(SM(1,1)*SM(2,2)+SM(1,1)*SM(3,3)+SM(2,2)*SM(3,3)-SM(1,2)**2-
6244 &SM(1,3)**2-SM(2,3)**2)/3.-1./9.
6245 SR=-0.5*(SQ+1./9.+SM(1,1)*SM(2,3)**2+SM(2,2)*SM(1,3)**2+SM(3,3)*
6246 &SM(1,2)**2-SM(1,1)*SM(2,2)*SM(3,3))+SM(1,2)*SM(1,3)*SM(2,3)+1./27.
6247 SP=COS(ACOS(MAX(MIN(SR/SQRT(-SQ**3),1.),-1.))/3.)
6248 P(N+1,4)=1./3.+SQRT(-SQ)*MAX(2.*SP,SQRT(3.*(1.-SP**2))-SP)
6249 P(N+3,4)=1./3.+SQRT(-SQ)*MIN(2.*SP,-SQRT(3.*(1.-SP**2))-SP)
6250 P(N+2,4)=1.-P(N+1,4)-P(N+3,4)
6251 IF(P(N+2,4).LT.1E-5) THEN
6252 CALL LUERRM(8,'(LUSPHE:) all particles back-to-back')
6253 SPH=-1.
6254 APL=-1.
6255 RETURN
6256 ENDIF
6257
6258
6259 DO 170 I=1,3,2
6260 DO 140 J1=1,3
6261 SV(J1,J1)=SM(J1,J1)-P(N+I,4)
6262 DO 140 J2=J1+1,3
6263 SV(J1,J2)=SM(J1,J2)
6264 140 SV(J2,J1)=SM(J1,J2)
6265 SMAX=0.
6266 DO 150 J1=1,3
6267 DO 150 J2=1,3
6268 IF(ABS(SV(J1,J2)).LE.SMAX) GOTO 150
6269 JA=J1
6270 JB=J2
6271 SMAX=ABS(SV(J1,J2))
6272 150 CONTINUE
6273 SMAX=0.
6274 DO 160 J3=JA+1,JA+2
6275 J1=J3-3*((J3-1)/3)
6276 RL=SV(J1,JB)/SV(JA,JB)
6277 DO 160 J2=1,3
6278 SV(J1,J2)=SV(J1,J2)-RL*SV(JA,J2)
6279 IF(ABS(SV(J1,J2)).LE.SMAX) GOTO 160
6280 JC=J1
6281 SMAX=ABS(SV(J1,J2))
6282 160 CONTINUE
6283 JB1=JB+1-3*(JB/3)
6284 JB2=JB+2-3*((JB+1)/3)
6285 P(N+I,JB1)=-SV(JC,JB2)
6286 P(N+I,JB2)=SV(JC,JB1)
6287 P(N+I,JB)=-(SV(JA,JB1)*P(N+I,JB1)+SV(JA,JB2)*P(N+I,JB2))/
6288 &SV(JA,JB)
6289 PA=SQRT(P(N+I,1)**2+P(N+I,2)**2+P(N+I,3)**2)
6290 SGN=(-1.)**INT(RLU(0)+0.5)
6291 DO 170 J=1,3
6292 170 P(N+I,J)=SGN*P(N+I,J)/PA
6293
6294
6295 SGN=(-1.)**INT(RLU(0)+0.5)
6296 P(N+2,1)=SGN*(P(N+1,2)*P(N+3,3)-P(N+1,3)*P(N+3,2))
6297 P(N+2,2)=SGN*(P(N+1,3)*P(N+3,1)-P(N+1,1)*P(N+3,3))
6298 P(N+2,3)=SGN*(P(N+1,1)*P(N+3,2)-P(N+1,2)*P(N+3,1))
6299 DO 180 I=1,3
6300 K(N+I,1)=31
6301 K(N+I,2)=95
6302 K(N+I,3)=I
6303 K(N+I,4)=0
6304 K(N+I,5)=0
6305 P(N+I,5)=0.
6306 DO 180 J=1,5
6307 180 V(I,J)=0.
6308
6309
6310 MSTU(61)=N+1
6311 MSTU(62)=NP
6312 IF(MSTU(43).LE.1) MSTU(3)=3
6313 IF(MSTU(43).GE.2) N=N+3
6314 SPH=1.5*(P(N+2,4)+P(N+3,4))
6315 APL=1.5*P(N+3,4)
6316
6317 RETURN
6318 END
6319
6320
6321
6322 SUBROUTINE LUTHRU(THR,OBL)
6323
6324
6325
6326 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
6327 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
6328 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
6329 DIMENSION TDI(3),TPR(3)
6330 SAVE
6331
6332
6333 NP=0
6334 PS=0.
6335 DO 100 I=1,N
6336 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 100
6337 IF(MSTU(41).GE.2) THEN
6338 KC=LUCOMP(K(I,2))
6339 IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
6340 & KC.EQ.18) GOTO 100
6341 IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
6342 & GOTO 100
6343 ENDIF
6344 IF(N+NP+MSTU(44)+15.GE.MSTU(4)-MSTU(32)-5) THEN
6345 CALL LUERRM(11,'(LUTHRU:) no more memory left in LUJETS')
6346 THR=-2.
6347 OBL=-2.
6348 RETURN
6349 ENDIF
6350 NP=NP+1
6351 K(N+NP,1)=23
6352 P(N+NP,1)=P(I,1)
6353 P(N+NP,2)=P(I,2)
6354 P(N+NP,3)=P(I,3)
6355 P(N+NP,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)
6356 P(N+NP,5)=1.
6357 IF(ABS(PARU(42)-1.).GT.0.001) P(N+NP,5)=P(N+NP,4)**(PARU(42)-1.)
6358 PS=PS+P(N+NP,4)*P(N+NP,5)
6359 100 CONTINUE
6360
6361
6362 IF(NP.LE.1) THEN
6363 CALL LUERRM(8,'(LUTHRU:) too few particles for analysis')
6364 THR=-1.
6365 OBL=-1.
6366 RETURN
6367 ENDIF
6368
6369
6370 DO 280 ILD=1,2
6371 IF(ILD.EQ.2) THEN
6372 K(N+NP+1,1)=31
6373 PHI=ULANGL(P(N+NP+1,1),P(N+NP+1,2))
6374 CALL LUDBRB(N+1,N+NP+1,0.,-PHI,0D0,0D0,0D0)
6375 THE=ULANGL(P(N+NP+1,3),P(N+NP+1,1))
6376 CALL LUDBRB(N+1,N+NP+1,-THE,0.,0D0,0D0,0D0)
6377 ENDIF
6378
6379
6380 DO 110 ILF=N+NP+4,N+NP+MSTU(44)+4
6381 110 P(ILF,4)=0.
6382 DO 150 I=N+1,N+NP
6383 IF(ILD.EQ.2) P(I,4)=SQRT(P(I,1)**2+P(I,2)**2)
6384 DO 120 ILF=N+NP+MSTU(44)+3,N+NP+4,-1
6385 IF(P(I,4).LE.P(ILF,4)) GOTO 130
6386 DO 120 J=1,5
6387 120 P(ILF+1,J)=P(ILF,J)
6388 ILF=N+NP+3
6389 130 DO 140 J=1,5
6390 140 P(ILF+1,J)=P(I,J)
6391 150 CONTINUE
6392
6393
6394 DO 160 ILG=N+NP+MSTU(44)+5,N+NP+MSTU(44)+15
6395 160 P(ILG,4)=0.
6396 NC=2**(MIN(MSTU(44),NP)-1)
6397 DO 220 ILC=1,NC
6398 DO 170 J=1,3
6399 170 TDI(J)=0.
6400 DO 180 ILF=1,MIN(MSTU(44),NP)
6401 SGN=P(N+NP+ILF+3,5)
6402 IF(2**ILF*((ILC+2**(ILF-1)-1)/2**ILF).GE.ILC) SGN=-SGN
6403 DO 180 J=1,4-ILD
6404 180 TDI(J)=TDI(J)+SGN*P(N+NP+ILF+3,J)
6405 TDS=TDI(1)**2+TDI(2)**2+TDI(3)**2
6406 DO 190 ILG=N+NP+MSTU(44)+MIN(ILC,10)+4,N+NP+MSTU(44)+5,-1
6407 IF(TDS.LE.P(ILG,4)) GOTO 200
6408 DO 190 J=1,4
6409 190 P(ILG+1,J)=P(ILG,J)
6410 ILG=N+NP+MSTU(44)+4
6411 200 DO 210 J=1,3
6412 210 P(ILG+1,J)=TDI(J)
6413 P(ILG+1,4)=TDS
6414 220 CONTINUE
6415
6416
6417 P(N+NP+ILD,4)=0.
6418 ILG=0
6419 230 ILG=ILG+1
6420 THP=0.
6421 240 THPS=THP
6422 DO 250 J=1,3
6423 IF(THP.LE.1E-10) TDI(J)=P(N+NP+MSTU(44)+4+ILG,J)
6424 IF(THP.GT.1E-10) TDI(J)=TPR(J)
6425 250 TPR(J)=0.
6426 DO 260 I=N+1,N+NP
6427 SGN=SIGN(P(I,5),TDI(1)*P(I,1)+TDI(2)*P(I,2)+TDI(3)*P(I,3))
6428 DO 260 J=1,4-ILD
6429 260 TPR(J)=TPR(J)+SGN*P(I,J)
6430 THP=SQRT(TPR(1)**2+TPR(2)**2+TPR(3)**2)/PS
6431 IF(THP.GE.THPS+PARU(48)) GOTO 240
6432
6433
6434 IF(THP.LT.P(N+NP+ILD,4)-PARU(48).AND.ILG.LT.MIN(10,NC)) GOTO 230
6435 IF(THP.GT.P(N+NP+ILD,4)+PARU(48)) THEN
6436 IAGR=0
6437 SGN=(-1.)**INT(RLU(0)+0.5)
6438 DO 270 J=1,3
6439 270 P(N+NP+ILD,J)=SGN*TPR(J)/(PS*THP)
6440 P(N+NP+ILD,4)=THP
6441 P(N+NP+ILD,5)=0.
6442 ENDIF
6443 IAGR=IAGR+1
6444 280 IF(IAGR.LT.MSTU(45).AND.ILG.LT.MIN(10,NC)) GOTO 230
6445
6446
6447 SGN=(-1.)**INT(RLU(0)+0.5)
6448 P(N+NP+3,1)=-SGN*P(N+NP+2,2)
6449 P(N+NP+3,2)=SGN*P(N+NP+2,1)
6450 P(N+NP+3,3)=0.
6451 THP=0.
6452 DO 290 I=N+1,N+NP
6453 290 THP=THP+P(I,5)*ABS(P(N+NP+3,1)*P(I,1)+P(N+NP+3,2)*P(I,2))
6454 P(N+NP+3,4)=THP/PS
6455 P(N+NP+3,5)=0.
6456
6457
6458 DO 300 ILD=1,3
6459 K(N+ILD,1)=31
6460 K(N+ILD,2)=96
6461 K(N+ILD,3)=ILD
6462 K(N+ILD,4)=0
6463 K(N+ILD,5)=0
6464 DO 300 J=1,5
6465 P(N+ILD,J)=P(N+NP+ILD,J)
6466 300 V(N+ILD,J)=0.
6467 CALL LUDBRB(N+1,N+3,THE,PHI,0D0,0D0,0D0)
6468
6469
6470 MSTU(61)=N+1
6471 MSTU(62)=NP
6472 IF(MSTU(43).LE.1) MSTU(3)=3
6473 IF(MSTU(43).GE.2) N=N+3
6474 THR=P(N+1,4)
6475 OBL=P(N+2,4)-P(N+3,4)
6476
6477 RETURN
6478 END
6479
6480
6481
6482 SUBROUTINE LUCLUS(NJET)
6483
6484
6485
6486 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
6487 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
6488 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
6489 DIMENSION PS(5)
6490
6491 INTEGER NSAV,NP,NPRE,NREM
6492 SAVE
6493
6494
6495 R2T(I1,I2)=(P(I1,5)*P(I2,5)-P(I1,1)*P(I2,1)-P(I1,2)*P(I2,2)-
6496 &P(I1,3)*P(I2,3))*2.*P(I1,5)*P(I2,5)/(0.0001+P(I1,5)+P(I2,5))**2
6497 R2M(I1,I2)=2.*P(I1,4)*P(I2,4)*(1.-(P(I1,1)*P(I2,1)+P(I1,2)*
6498 &P(I2,2)+P(I1,3)*P(I2,3))/(P(I1,5)*P(I2,5)))
6499
6500
6501 IF(MSTU(48).LE.0) THEN
6502 NP=0
6503 DO 100 J=1,5
6504 100 PS(J)=0.
6505 PSS=0.
6506 ELSE
6507 NJET=NSAV
6508 IF(MSTU(43).GE.2) N=N-NJET
6509 DO 110 I=N+1,N+NJET
6510 110 P(I,5)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)
6511 IF(MSTU(46).LE.3) R2ACC=PARU(44)**2
6512 IF(MSTU(46).GE.4) R2ACC=PARU(45)*PS(5)**2
6513 NLOOP=0
6514 GOTO 290
6515 ENDIF
6516
6517
6518 DO 140 I=1,N
6519 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 140
6520 IF(MSTU(41).GE.2) THEN
6521 KC=LUCOMP(K(I,2))
6522 IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
6523 & KC.EQ.18) GOTO 140
6524 IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
6525 & GOTO 140
6526 ENDIF
6527 IF(N+2*NP.GE.MSTU(4)-MSTU(32)-5) THEN
6528 CALL LUERRM(11,'(LUCLUS:) no more memory left in LUJETS')
6529 NJET=-1
6530 RETURN
6531 ENDIF
6532
6533
6534 NP=NP+1
6535 K(N+NP,3)=I
6536 DO 120 J=1,5
6537 120 P(N+NP,J)=P(I,J)
6538 IF(MSTU(42).EQ.0) P(N+NP,5)=0.
6539 IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) P(N+NP,5)=PMAS(101,1)
6540 P(N+NP,4)=SQRT(P(N+NP,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2)
6541 P(N+NP,5)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)
6542 DO 130 J=1,4
6543 130 PS(J)=PS(J)+P(N+NP,J)
6544 PSS=PSS+P(N+NP,5)
6545 140 CONTINUE
6546 DO 150 I=N+1,N+NP
6547 K(I+NP,3)=K(I,3)
6548 DO 150 J=1,5
6549 150 P(I+NP,J)=P(I,J)
6550 PS(5)=SQRT(MAX(0.,PS(4)**2-PS(1)**2-PS(2)**2-PS(3)**2))
6551
6552
6553 IF(NP.LT.MSTU(47)) THEN
6554 CALL LUERRM(8,'(LUCLUS:) too few particles for analysis')
6555 NJET=-1
6556 RETURN
6557 ENDIF
6558
6559
6560 NLOOP=0
6561 IF(MSTU(46).LE.3) R2ACC=PARU(44)**2
6562 IF(MSTU(46).GE.4) R2ACC=PARU(45)*PS(5)**2
6563 RINIT=1.25*PARU(43)
6564 IF(NP.LE.MSTU(47)+2) RINIT=0.
6565 160 RINIT=0.8*RINIT
6566 NPRE=0
6567 NREM=NP
6568 DO 170 I=N+NP+1,N+2*NP
6569 170 K(I,4)=0
6570
6571
6572 IF(MSTU(46).LE.2) THEN
6573 DO 180 J=1,4
6574 180 P(N+1,J)=0.
6575 DO 200 I=N+NP+1,N+2*NP
6576 IF(P(I,5).GT.2.*RINIT) GOTO 200
6577 NREM=NREM-1
6578 K(I,4)=1
6579 DO 190 J=1,4
6580 190 P(N+1,J)=P(N+1,J)+P(I,J)
6581 200 CONTINUE
6582 P(N+1,5)=SQRT(P(N+1,1)**2+P(N+1,2)**2+P(N+1,3)**2)
6583 IF(P(N+1,5).GT.2.*RINIT) NPRE=1
6584 IF(RINIT.GE.0.2*PARU(43).AND.NPRE+NREM.LT.MSTU(47)) GOTO 160
6585 ENDIF
6586
6587
6588 210 NPRE=NPRE+1
6589 PMAX=0.
6590 DO 220 I=N+NP+1,N+2*NP
6591 IF(K(I,4).NE.0.OR.P(I,5).LE.PMAX) GOTO 220
6592 IMAX=I
6593 PMAX=P(I,5)
6594 220 CONTINUE
6595 DO 230 J=1,5
6596 230 P(N+NPRE,J)=P(IMAX,J)
6597 NREM=NREM-1
6598 K(IMAX,4)=NPRE
6599
6600
6601 IF(MSTU(46).LE.2) THEN
6602 DO 250 I=N+NP+1,N+2*NP
6603 IF(K(I,4).NE.0) GOTO 250
6604 R2=R2T(I,IMAX)
6605 IF(R2.GT.RINIT**2) GOTO 250
6606 NREM=NREM-1
6607 K(I,4)=NPRE
6608 DO 240 J=1,4
6609 240 P(N+NPRE,J)=P(N+NPRE,J)+P(I,J)
6610 250 CONTINUE
6611 P(N+NPRE,5)=SQRT(P(N+NPRE,1)**2+P(N+NPRE,2)**2+P(N+NPRE,3)**2)
6612
6613
6614 ELSE
6615 260 IMIN=0
6616 R2MIN=RINIT**2
6617 DO 270 I=N+NP+1,N+2*NP
6618 IF(K(I,4).NE.0) GOTO 270
6619 R2=R2M(I,N+NPRE)
6620 IF(R2.GE.R2MIN) GOTO 270
6621 IMIN=I
6622 R2MIN=R2
6623 270 CONTINUE
6624 IF(IMIN.NE.0) THEN
6625 DO 280 J=1,4
6626 280 P(N+NPRE,J)=P(N+NPRE,J)+P(IMIN,J)
6627 P(N+NPRE,5)=SQRT(P(N+NPRE,1)**2+P(N+NPRE,2)**2+P(N+NPRE,3)**2)
6628 NREM=NREM-1
6629 K(IMIN,4)=NPRE
6630 GOTO 260
6631 ENDIF
6632 ENDIF
6633
6634
6635 IF(RINIT.GE.0.2*PARU(43).AND.NPRE+NREM.LT.MSTU(47)) GOTO 160
6636 IF(NREM.GT.0) GOTO 210
6637 NJET=NPRE
6638
6639
6640 290 TSAV=0.
6641 PSJT=0.
6642 300 IF(MSTU(46).LE.1) THEN
6643 DO 310 I=N+1,N+NJET
6644 DO 310 J=1,4
6645 310 V(I,J)=0.
6646 DO 340 I=N+NP+1,N+2*NP
6647 R2MIN=PSS**2
6648 DO 320 IJET=N+1,N+NJET
6649 IF(P(IJET,5).LT.RINIT) GOTO 320
6650 R2=R2T(I,IJET)
6651 IF(R2.GE.R2MIN) GOTO 320
6652 IMIN=IJET
6653 R2MIN=R2
6654 320 CONTINUE
6655 K(I,4)=IMIN-N
6656 DO 330 J=1,4
6657 330 V(IMIN,J)=V(IMIN,J)+P(I,J)
6658 340 CONTINUE
6659 PSJT=0.
6660 DO 360 I=N+1,N+NJET
6661 DO 350 J=1,4
6662 350 P(I,J)=V(I,J)
6663 P(I,5)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)
6664 360 PSJT=PSJT+P(I,5)
6665 ENDIF
6666
6667
6668 R2MIN=2.*R2ACC
6669 DO 370 ITRY1=N+1,N+NJET-1
6670 DO 370 ITRY2=ITRY1+1,N+NJET
6671 IF(MSTU(46).LE.2) R2=R2T(ITRY1,ITRY2)
6672 IF(MSTU(46).GE.3) R2=R2M(ITRY1,ITRY2)
6673 IF(R2.GE.R2MIN) GOTO 370
6674 IMIN1=ITRY1
6675 IMIN2=ITRY2
6676 R2MIN=R2
6677 370 CONTINUE
6678
6679
6680 IF(NJET.GT.MSTU(47).AND.R2MIN.LT.R2ACC) THEN
6681 IREC=MIN(IMIN1,IMIN2)
6682 IDEL=MAX(IMIN1,IMIN2)
6683 DO 380 J=1,4
6684 380 P(IREC,J)=P(IMIN1,J)+P(IMIN2,J)
6685 P(IREC,5)=SQRT(P(IREC,1)**2+P(IREC,2)**2+P(IREC,3)**2)
6686 DO 390 I=IDEL+1,N+NJET
6687 DO 390 J=1,5
6688 390 P(I-1,J)=P(I,J)
6689 IF(MSTU(46).GE.2) THEN
6690 DO 400 I=N+NP+1,N+2*NP
6691 IORI=N+K(I,4)
6692 IF(IORI.EQ.IDEL) K(I,4)=IREC-N
6693 400 IF(IORI.GT.IDEL) K(I,4)=K(I,4)-1
6694 ENDIF
6695 NJET=NJET-1
6696 GOTO 290
6697
6698
6699 ELSEIF(NJET.EQ.MSTU(47).AND.MSTU(46).LE.1.AND.NLOOP.LE.2) THEN
6700 DO 410 I=N+1,N+NJET
6701 410 K(I,5)=0
6702 DO 420 I=N+NP+1,N+2*NP
6703 420 K(N+K(I,4),5)=K(N+K(I,4),5)+1
6704 IEMP=0
6705 DO 430 I=N+1,N+NJET
6706 430 IF(K(I,5).EQ.0) IEMP=I
6707 IF(IEMP.NE.0) THEN
6708 NLOOP=NLOOP+1
6709 ISPL=0
6710 R2MAX=0.
6711 DO 440 I=N+NP+1,N+2*NP
6712 IF(K(N+K(I,4),5).LE.1.OR.P(I,5).LT.RINIT) GOTO 440
6713 IJET=N+K(I,4)
6714 R2=R2T(I,IJET)
6715 IF(R2.LE.R2MAX) GOTO 440
6716 ISPL=I
6717 R2MAX=R2
6718 440 CONTINUE
6719 IF(ISPL.NE.0) THEN
6720 IJET=N+K(ISPL,4)
6721 DO 450 J=1,4
6722 P(IEMP,J)=P(ISPL,J)
6723 450 P(IJET,J)=P(IJET,J)-P(ISPL,J)
6724 P(IEMP,5)=P(ISPL,5)
6725 P(IJET,5)=SQRT(P(IJET,1)**2+P(IJET,2)**2+P(IJET,3)**2)
6726 IF(NLOOP.LE.2) GOTO 290
6727 ENDIF
6728 ENDIF
6729 ENDIF
6730
6731
6732 IF(MSTU(46).LE.1.AND.NLOOP.LE.2.AND.PSJT/PSS.GT.TSAV+PARU(48))
6733 &THEN
6734 TSAV=PSJT/PSS
6735 GOTO 300
6736 ENDIF
6737
6738
6739 DO 460 I=N+1,N+NJET
6740 DO 460 J=1,5
6741 460 V(I,J)=P(I,J)
6742 DO 490 INEW=N+1,N+NJET
6743 PEMAX=0.
6744 DO 470 ITRY=N+1,N+NJET
6745 IF(V(ITRY,4).LE.PEMAX) GOTO 470
6746 IMAX=ITRY
6747 PEMAX=V(ITRY,4)
6748 470 CONTINUE
6749 K(INEW,1)=31
6750 K(INEW,2)=97
6751 K(INEW,3)=INEW-N
6752 K(INEW,4)=0
6753 DO 480 J=1,5
6754 480 P(INEW,J)=V(IMAX,J)
6755 V(IMAX,4)=-1.
6756 490 K(IMAX,5)=INEW
6757
6758
6759 DO 500 I=N+NP+1,N+2*NP
6760 IORI=K(N+K(I,4),5)
6761 K(I,4)=IORI-N
6762 IF(K(K(I,3),1).NE.3) K(K(I,3),4)=IORI-N
6763 K(IORI,4)=K(IORI,4)+1
6764 500 CONTINUE
6765 IEMP=0
6766 PSJT=0.
6767 DO 520 I=N+1,N+NJET
6768 K(I,5)=0
6769 PSJT=PSJT+P(I,5)
6770 P(I,5)=SQRT(MAX(P(I,4)**2-P(I,5)**2,0.))
6771 DO 510 J=1,5
6772 510 V(I,J)=0.
6773 520 IF(K(I,4).EQ.0) IEMP=I
6774
6775
6776 MSTU(61)=N+1
6777 MSTU(62)=NP
6778 MSTU(63)=NPRE
6779 PARU(61)=PS(5)
6780 PARU(62)=PSJT/PSS
6781 PARU(63)=SQRT(R2MIN)
6782 IF(NJET.LE.1) PARU(63)=0.
6783 IF(IEMP.NE.0) THEN
6784 CALL LUERRM(8,'(LUCLUS:) failed to reconstruct as requested')
6785 NJET=-1
6786 ENDIF
6787 IF(MSTU(43).LE.1) MSTU(3)=NJET
6788 IF(MSTU(43).GE.2) N=N+NJET
6789 NSAV=NJET
6790
6791 RETURN
6792 END
6793
6794
6795
6796 SUBROUTINE LUCELL(NJET)
6797
6798
6799
6800 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
6801 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
6802 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
6803 SAVE
6804
6805
6806 NCE2=2*MSTU(51)*MSTU(52)
6807 PTLRAT=1./SINH(PARU(51))**2
6808 NP=0
6809 NC=N
6810 DO 110 I=1,N
6811 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 110
6812 IF(P(I,1)**2+P(I,2)**2.LE.PTLRAT*P(I,3)**2) GOTO 110
6813 IF(MSTU(41).GE.2) THEN
6814 KC=LUCOMP(K(I,2))
6815 IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
6816 & KC.EQ.18) GOTO 110
6817 IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
6818 & GOTO 110
6819 ENDIF
6820 NP=NP+1
6821 PT=SQRT(P(I,1)**2+P(I,2)**2)
6822 ETA=SIGN(LOG((SQRT(PT**2+P(I,3)**2)+ABS(P(I,3)))/PT),P(I,3))
6823 IETA=MAX(1,MIN(MSTU(51),1+INT(MSTU(51)*0.5*(ETA/PARU(51)+1.))))
6824 PHI=ULANGL(P(I,1),P(I,2))
6825 IPHI=MAX(1,MIN(MSTU(52),1+INT(MSTU(52)*0.5*(PHI/PARU(1)+1.))))
6826 IETPH=MSTU(52)*IETA+IPHI
6827
6828
6829 DO 100 IC=N+1,NC
6830 IF(IETPH.EQ.K(IC,3)) THEN
6831 K(IC,4)=K(IC,4)+1
6832 P(IC,5)=P(IC,5)+PT
6833 GOTO 110
6834 ENDIF
6835 100 CONTINUE
6836 IF(NC.GE.MSTU(4)-MSTU(32)-5) THEN
6837 CALL LUERRM(11,'(LUCELL:) no more memory left in LUJETS')
6838 NJET=-2
6839 RETURN
6840 ENDIF
6841 NC=NC+1
6842 K(NC,3)=IETPH
6843 K(NC,4)=1
6844 K(NC,5)=2
6845 P(NC,1)=(PARU(51)/MSTU(51))*(2*IETA-1-MSTU(51))
6846 P(NC,2)=(PARU(1)/MSTU(52))*(2*IPHI-1-MSTU(52))
6847 P(NC,5)=PT
6848 110 CONTINUE
6849
6850
6851 IF(MSTU(53).GE.1) THEN
6852 DO 130 IC=N+1,NC
6853 PEI=P(IC,5)
6854 IF(MSTU(53).EQ.2) PEI=P(IC,5)/COSH(P(IC,1))
6855 120 PEF=PEI+PARU(55)*SQRT(-2.*LOG(MAX(1E-10,RLU(0)))*PEI)*
6856 & COS(PARU(2)*RLU(0))
6857 IF(PEF.LT.0..OR.PEF.GT.PARU(56)*PEI) GOTO 120
6858 P(IC,5)=PEF
6859 130 IF(MSTU(53).EQ.2) P(IC,5)=PEF*COSH(P(IC,1))
6860 ENDIF
6861
6862
6863 NJ=NC
6864 140 ETMAX=0.
6865 DO 150 IC=N+1,NC
6866 IF(K(IC,5).NE.2) GOTO 150
6867 IF(P(IC,5).LE.ETMAX) GOTO 150
6868 ICMAX=IC
6869 ETA=P(IC,1)
6870 PHI=P(IC,2)
6871 ETMAX=P(IC,5)
6872 150 CONTINUE
6873 IF(ETMAX.LT.PARU(52)) GOTO 210
6874 IF(NJ.GE.MSTU(4)-MSTU(32)-5) THEN
6875 CALL LUERRM(11,'(LUCELL:) no more memory left in LUJETS')
6876 NJET=-2
6877 RETURN
6878 ENDIF
6879 K(ICMAX,5)=1
6880 NJ=NJ+1
6881 K(NJ,4)=0
6882 K(NJ,5)=1
6883 P(NJ,1)=ETA
6884 P(NJ,2)=PHI
6885 P(NJ,3)=0.
6886 P(NJ,4)=0.
6887 P(NJ,5)=0.
6888
6889
6890 DO 160 IC=N+1,NC
6891 IF(K(IC,5).EQ.0) GOTO 160
6892 IF(ABS(P(IC,1)-ETA).GT.PARU(54)) GOTO 160
6893 DPHIA=ABS(P(IC,2)-PHI)
6894 IF(DPHIA.GT.PARU(54).AND.DPHIA.LT.PARU(2)-PARU(54)) GOTO 160
6895 PHIC=P(IC,2)
6896 IF(DPHIA.GT.PARU(1)) PHIC=PHIC+SIGN(PARU(2),PHI)
6897 IF((P(IC,1)-ETA)**2+(PHIC-PHI)**2.GT.PARU(54)**2) GOTO 160
6898 K(IC,5)=-K(IC,5)
6899 K(NJ,4)=K(NJ,4)+K(IC,4)
6900 P(NJ,3)=P(NJ,3)+P(IC,5)*P(IC,1)
6901 P(NJ,4)=P(NJ,4)+P(IC,5)*PHIC
6902 P(NJ,5)=P(NJ,5)+P(IC,5)
6903 160 CONTINUE
6904
6905
6906 IF(P(NJ,5).LT.PARU(53)) THEN
6907 NJ=NJ-1
6908 DO 170 IC=N+1,NC
6909 170 IF(K(IC,5).LT.0) K(IC,5)=-K(IC,5)
6910 ELSEIF(MSTU(54).LE.2) THEN
6911 P(NJ,3)=P(NJ,3)/P(NJ,5)
6912 P(NJ,4)=P(NJ,4)/P(NJ,5)
6913 IF(ABS(P(NJ,4)).GT.PARU(1)) P(NJ,4)=P(NJ,4)-SIGN(PARU(2),
6914 & P(NJ,4))
6915 DO 180 IC=N+1,NC
6916 180 IF(K(IC,1).LT.0) K(IC,1)=0
6917 ELSE
6918 DO 190 J=1,4
6919 190 P(NJ,J)=0.
6920 DO 200 IC=N+1,NC
6921 IF(K(IC,5).GE.0) GOTO 200
6922 P(NJ,1)=P(NJ,1)+P(IC,5)*COS(P(IC,2))
6923 P(NJ,2)=P(NJ,2)+P(IC,5)*SIN(P(IC,2))
6924 P(NJ,3)=P(NJ,3)+P(IC,5)*SINH(P(IC,1))
6925 P(NJ,4)=P(NJ,4)+P(IC,5)*COSH(P(IC,1))
6926 K(IC,5)=0
6927 200 CONTINUE
6928 ENDIF
6929 GOTO 140
6930
6931
6932 210 DO 230 I=1,NJ-NC
6933 ETMAX=0.
6934 DO 220 IJ=NC+1,NJ
6935 IF(K(IJ,5).EQ.0) GOTO 220
6936 IF(P(IJ,5).LT.ETMAX) GOTO 220
6937 IJMAX=IJ
6938 ETMAX=P(IJ,5)
6939 220 CONTINUE
6940 K(IJMAX,5)=0
6941 K(N+I,1)=31
6942 K(N+I,2)=98
6943 K(N+I,3)=I
6944 K(N+I,4)=K(IJMAX,4)
6945 K(N+I,5)=0
6946 DO 230 J=1,5
6947 P(N+I,J)=P(IJMAX,J)
6948 230 V(N+I,J)=0.
6949 NJET=NJ-NC
6950
6951
6952 IF(MSTU(54).EQ.2) THEN
6953 DO 240 I=N+1,N+NJET
6954 ETA=P(I,3)
6955 P(I,1)=P(I,5)*COS(P(I,4))
6956 P(I,2)=P(I,5)*SIN(P(I,4))
6957 P(I,3)=P(I,5)*SINH(ETA)
6958 P(I,4)=P(I,5)*COSH(ETA)
6959 240 P(I,5)=0.
6960 ELSEIF(MSTU(54).GE.3) THEN
6961 DO 250 I=N+1,N+NJET
6962 250 P(I,5)=SQRT(MAX(0.,P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2))
6963 ENDIF
6964
6965
6966 MSTU(61)=N+1
6967 MSTU(62)=NP
6968 MSTU(63)=NC-N
6969 IF(MSTU(43).LE.1) MSTU(3)=NJET
6970 IF(MSTU(43).GE.2) N=N+NJET
6971
6972 RETURN
6973 END
6974
6975
6976
6977 SUBROUTINE LUJMAS(PMH,PML)
6978
6979
6980
6981 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
6982 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
6983 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
6984 DIMENSION SM(3,3),SAX(3),PS(3,5)
6985 SAVE
6986
6987
6988 NP=0
6989 DO 110 J1=1,3
6990 DO 100 J2=J1,3
6991 100 SM(J1,J2)=0.
6992 DO 110 J2=1,4
6993 110 PS(J1,J2)=0.
6994 PSS=0.
6995
6996
6997 DO 150 I=1,N
6998 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 150
6999 IF(MSTU(41).GE.2) THEN
7000 KC=LUCOMP(K(I,2))
7001 IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
7002 & KC.EQ.18) GOTO 150
7003 IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
7004 & GOTO 150
7005 ENDIF
7006 IF(N+NP+1.GE.MSTU(4)-MSTU(32)-5) THEN
7007 CALL LUERRM(11,'(LUJMAS:) no more memory left in LUJETS')
7008 PMH=-2.
7009 PML=-2.
7010 RETURN
7011 ENDIF
7012 NP=NP+1
7013 DO 120 J=1,5
7014 120 P(N+NP,J)=P(I,J)
7015 IF(MSTU(42).EQ.0) P(N+NP,5)=0.
7016 IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) P(N+NP,5)=PMAS(101,1)
7017 P(N+NP,4)=SQRT(P(N+NP,5)**2+P(I,1)**2+P(I,2)**2+P(I,3)**2)
7018
7019
7020 DO 130 J1=1,3
7021 DO 130 J2=J1,3
7022 130 SM(J1,J2)=SM(J1,J2)+P(I,J1)*P(I,J2)
7023 PSS=PSS+(P(I,1)**2+P(I,2)**2+P(I,3)**2)
7024 DO 140 J=1,4
7025 140 PS(3,J)=PS(3,J)+P(N+NP,J)
7026 150 CONTINUE
7027
7028
7029 IF(NP.LE.1) THEN
7030 CALL LUERRM(8,'(LUJMAS:) too few particles for analysis')
7031 PMH=-1.
7032 PML=-1.
7033 RETURN
7034 ENDIF
7035 PARU(61)=SQRT(MAX(0.,PS(3,4)**2-PS(3,1)**2-PS(3,2)**2-PS(3,3)**2))
7036
7037
7038 DO 160 J1=1,3
7039 DO 160 J2=J1,3
7040 160 SM(J1,J2)=SM(J1,J2)/PSS
7041 SQ=(SM(1,1)*SM(2,2)+SM(1,1)*SM(3,3)+SM(2,2)*SM(3,3)-SM(1,2)**2-
7042 &SM(1,3)**2-SM(2,3)**2)/3.-1./9.
7043 SR=-0.5*(SQ+1./9.+SM(1,1)*SM(2,3)**2+SM(2,2)*SM(1,3)**2+SM(3,3)*
7044 &SM(1,2)**2-SM(1,1)*SM(2,2)*SM(3,3))+SM(1,2)*SM(1,3)*SM(2,3)+1./27.
7045 SP=COS(ACOS(MAX(MIN(SR/SQRT(-SQ**3),1.),-1.))/3.)
7046 SMA=1./3.+SQRT(-SQ)*MAX(2.*SP,SQRT(3.*(1.-SP**2))-SP)
7047
7048
7049 DO J1=1,3
7050 SM(J1,J1)=SM(J1,J1)-SMA
7051
7052 IF(J1<3) THEN
7053 DO J2=J1+1,3
7054 SM(J2,J1)=SM(J1,J2)
7055 ENDDO
7056 ENDIF
7057 ENDDO
7058 SMAX=0.
7059 DO 180 J1=1,3
7060 DO 180 J2=1,3
7061 IF(ABS(SM(J1,J2)).LE.SMAX) GOTO 180
7062 JA=J1
7063 JB=J2
7064 SMAX=ABS(SM(J1,J2))
7065 180 CONTINUE
7066 SMAX=0.
7067 DO 190 J3=JA+1,JA+2
7068 J1=J3-3*((J3-1)/3)
7069 RL=SM(J1,JB)/SM(JA,JB)
7070 DO 190 J2=1,3
7071 SM(J1,J2)=SM(J1,J2)-RL*SM(JA,J2)
7072 IF(ABS(SM(J1,J2)).LE.SMAX) GOTO 190
7073 JC=J1
7074 SMAX=ABS(SM(J1,J2))
7075 190 CONTINUE
7076 JB1=JB+1-3*(JB/3)
7077 JB2=JB+2-3*((JB+1)/3)
7078 SAX(JB1)=-SM(JC,JB2)
7079 SAX(JB2)=SM(JC,JB1)
7080 SAX(JB)=-(SM(JA,JB1)*SAX(JB1)+SM(JA,JB2)*SAX(JB2))/SM(JA,JB)
7081
7082
7083 DO 200 I=N+1,N+NP
7084 PSAX=P(I,1)*SAX(1)+P(I,2)*SAX(2)+P(I,3)*SAX(3)
7085 IS=1
7086 IF(PSAX.LT.0.) IS=2
7087 K(I,3)=IS
7088 DO 200 J=1,4
7089 200 PS(IS,J)=PS(IS,J)+P(I,J)
7090 PMS=(PS(1,4)**2-PS(1,1)**2-PS(1,2)**2-PS(1,3)**2)+
7091 &(PS(2,4)**2-PS(2,1)**2-PS(2,2)**2-PS(2,3)**2)
7092
7093
7094 210 PMD=0.
7095 IM=0
7096 DO 220 J=1,4
7097 220 PS(3,J)=PS(1,J)-PS(2,J)
7098 DO 230 I=N+1,N+NP
7099 PPS=P(I,4)*PS(3,4)-P(I,1)*PS(3,1)-P(I,2)*PS(3,2)-P(I,3)*PS(3,3)
7100 IF(K(I,3).EQ.1) PMDI=2.*(P(I,5)**2-PPS)
7101 IF(K(I,3).EQ.2) PMDI=2.*(P(I,5)**2+PPS)
7102 IF(PMDI.LT.PMD) THEN
7103 PMD=PMDI
7104 IM=I
7105 ENDIF
7106 230 CONTINUE
7107
7108
7109 IF(PMD.LT.-PARU(48)*PMS) THEN
7110 PMS=PMS+PMD
7111 IS=K(IM,3)
7112 DO 240 J=1,4
7113 PS(IS,J)=PS(IS,J)-P(IM,J)
7114 240 PS(3-IS,J)=PS(3-IS,J)+P(IM,J)
7115 K(IM,3)=3-IS
7116 GOTO 210
7117 ENDIF
7118
7119
7120 MSTU(61)=N+1
7121 MSTU(62)=NP
7122 PS(1,5)=SQRT(MAX(0.,PS(1,4)**2-PS(1,1)**2-PS(1,2)**2-PS(1,3)**2))
7123 PS(2,5)=SQRT(MAX(0.,PS(2,4)**2-PS(2,1)**2-PS(2,2)**2-PS(2,3)**2))
7124 PMH=MAX(PS(1,5),PS(2,5))
7125 PML=MIN(PS(1,5),PS(2,5))
7126
7127 RETURN
7128 END
7129
7130
7131
7132 SUBROUTINE LUFOWO(H10,H20,H30,H40)
7133
7134
7135 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
7136 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
7137 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
7138 SAVE
7139
7140
7141 NP=0
7142 H0=0.
7143 HD=0.
7144 DO 110 I=1,N
7145 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 110
7146 IF(MSTU(41).GE.2) THEN
7147 KC=LUCOMP(K(I,2))
7148 IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
7149 & KC.EQ.18) GOTO 110
7150 IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
7151 & GOTO 110
7152 ENDIF
7153 IF(N+NP.GE.MSTU(4)-MSTU(32)-5) THEN
7154 CALL LUERRM(11,'(LUFOWO:) no more memory left in LUJETS')
7155 H10=-1.
7156 H20=-1.
7157 H30=-1.
7158 H40=-1.
7159 RETURN
7160 ENDIF
7161 NP=NP+1
7162 DO 100 J=1,3
7163 100 P(N+NP,J)=P(I,J)
7164 P(N+NP,4)=SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)
7165 H0=H0+P(N+NP,4)
7166 HD=HD+P(N+NP,4)**2
7167 110 CONTINUE
7168 H0=H0**2
7169
7170
7171 IF(NP.LE.1) THEN
7172 CALL LUERRM(8,'(LUFOWO:) too few particles for analysis')
7173 H10=-1.
7174 H20=-1.
7175 H30=-1.
7176 H40=-1.
7177 RETURN
7178 ENDIF
7179
7180
7181 H10=0.
7182 H20=0.
7183 H30=0.
7184 H40=0.
7185 DO 120 I1=N+1,N+NP
7186 DO 120 I2=I1+1,N+NP
7187 CTHE=(P(I1,1)*P(I2,1)+P(I1,2)*P(I2,2)+P(I1,3)*P(I2,3))/
7188 &(P(I1,4)*P(I2,4))
7189 H10=H10+P(I1,4)*P(I2,4)*CTHE
7190 H20=H20+P(I1,4)*P(I2,4)*(1.5*CTHE**2-0.5)
7191 H30=H30+P(I1,4)*P(I2,4)*(2.5*CTHE**3-1.5*CTHE)
7192 H40=H40+P(I1,4)*P(I2,4)*(4.375*CTHE**4-3.75*CTHE**2+0.375)
7193 120 CONTINUE
7194
7195
7196 MSTU(61)=N+1
7197 MSTU(62)=NP
7198 H10=(HD+2.*H10)/H0
7199 H20=(HD+2.*H20)/H0
7200 H30=(HD+2.*H30)/H0
7201 H40=(HD+2.*H40)/H0
7202
7203 RETURN
7204 END
7205
7206
7207
7208 SUBROUTINE LUTABU(MTABU)
7209
7210
7211
7212
7213 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
7214 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
7215 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
7216 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
7217 DIMENSION KFIS(100,2),NPIS(100,0:10),KFFS(400),NPFS(400,4),
7218 &FEVFM(10,4),FM1FM(3,10,4),FM2FM(3,10,4),FMOMA(4),FMOMS(4),
7219 &FEVEE(50),FE1EC(50),FE2EC(50),FE1EA(25),FE2EA(25),
7220 &KFDM(8),KFDC(200,0:8),NPDC(200)
7221
7222
7223
7224 CHARACTER CHAU*16,CHIS(2)*12,CHDC(8)*12
7225 SAVE
7226 DATA NEVIS/0/,NKFIS/0/,NEVFS/0/,NPRFS/0/,NFIFS/0/,NCHFS/0/,
7227 &NKFFS/0/,NEVFM/0/,NMUFM/0/,FM1FM/120*0./,FM2FM/120*0./,
7228 &NEVEE/0/,FE1EC/50*0./,FE2EC/50*0./,FE1EA/25*0./,FE2EA/25*0./,
7229 &NEVDC/0/,NKFDC/0/,NREDC/0/
7230
7231
7232 IF(MTABU.EQ.10) THEN
7233 NEVIS=0
7234 NKFIS=0
7235
7236
7237 ELSEIF(MTABU.EQ.11) THEN
7238 NEVIS=NEVIS+1
7239 KFM1=2*IABS(MSTU(161))
7240 IF(MSTU(161).GT.0) KFM1=KFM1-1
7241 KFM2=2*IABS(MSTU(162))
7242 IF(MSTU(162).GT.0) KFM2=KFM2-1
7243 KFMN=MIN(KFM1,KFM2)
7244 KFMX=MAX(KFM1,KFM2)
7245 DO 100 I=1,NKFIS
7246 IF(KFMN.EQ.KFIS(I,1).AND.KFMX.EQ.KFIS(I,2)) THEN
7247 IKFIS=-I
7248 GOTO 110
7249 ELSEIF(KFMN.LT.KFIS(I,1).OR.(KFMN.EQ.KFIS(I,1).AND.
7250 & KFMX.LT.KFIS(I,2))) THEN
7251 IKFIS=I
7252 GOTO 110
7253 ENDIF
7254 100 CONTINUE
7255 IKFIS=NKFIS+1
7256 110 IF(IKFIS.LT.0) THEN
7257 IKFIS=-IKFIS
7258 ELSE
7259 IF(NKFIS.GE.100) RETURN
7260 DO 120 I=NKFIS,IKFIS,-1
7261 KFIS(I+1,1)=KFIS(I,1)
7262 KFIS(I+1,2)=KFIS(I,2)
7263 DO 120 J=0,10
7264 120 NPIS(I+1,J)=NPIS(I,J)
7265 NKFIS=NKFIS+1
7266 KFIS(IKFIS,1)=KFMN
7267 KFIS(IKFIS,2)=KFMX
7268 DO 130 J=0,10
7269 130 NPIS(IKFIS,J)=0
7270 ENDIF
7271 NPIS(IKFIS,0)=NPIS(IKFIS,0)+1
7272
7273
7274 NP=0
7275 DO 150 I=1,N
7276 IF(K(I,1).LE.0.OR.K(I,1).GT.12) THEN
7277 ELSEIF(IABS(K(I,2)).GT.80.AND.IABS(K(I,2)).LE.100) THEN
7278 ELSEIF(IABS(K(I,2)).GT.100.AND.MOD(IABS(K(I,2))/10,10).NE.0)
7279 & THEN
7280 ELSE
7281 IM=I
7282 140 IM=K(IM,3)
7283 IF(IM.LE.0.OR.IM.GT.N) THEN
7284 NP=NP+1
7285 ELSEIF(K(IM,1).LE.0.OR.K(IM,1).GT.20) THEN
7286 NP=NP+1
7287 ELSEIF(IABS(K(IM,2)).GT.80.AND.IABS(K(IM,2)).LE.100) THEN
7288 ELSEIF(IABS(K(IM,2)).GT.100.AND.MOD(IABS(K(IM,2))/10,10).NE.0)
7289 & THEN
7290 ELSE
7291 GOTO 140
7292 ENDIF
7293 ENDIF
7294 150 CONTINUE
7295 NPCO=MAX(NP,1)
7296 IF(NP.GE.6) NPCO=6
7297 IF(NP.GE.8) NPCO=7
7298 IF(NP.GE.11) NPCO=8
7299 IF(NP.GE.16) NPCO=9
7300 IF(NP.GE.26) NPCO=10
7301 NPIS(IKFIS,NPCO)=NPIS(IKFIS,NPCO)+1
7302 MSTU(62)=NP
7303
7304
7305 ELSEIF(MTABU.EQ.12) THEN
7306 FAC=1./MAX(1,NEVIS)
7307 WRITE(MSTU(11),1000) NEVIS
7308 DO 160 I=1,NKFIS
7309 KFMN=KFIS(I,1)
7310 IF(KFMN.EQ.0) KFMN=KFIS(I,2)
7311 KFM1=(KFMN+1)/2
7312 IF(2*KFM1.EQ.KFMN) KFM1=-KFM1
7313 CALL LUNAME(KFM1,CHAU)
7314 CHIS(1)=CHAU(1:12)
7315 IF(CHAU(13:13).NE.' ') CHIS(1)(12:12)='?'
7316 KFMX=KFIS(I,2)
7317 IF(KFIS(I,1).EQ.0) KFMX=0
7318 KFM2=(KFMX+1)/2
7319 IF(2*KFM2.EQ.KFMX) KFM2=-KFM2
7320 CALL LUNAME(KFM2,CHAU)
7321 CHIS(2)=CHAU(1:12)
7322 IF(CHAU(13:13).NE.' ') CHIS(2)(12:12)='?'
7323 160 WRITE(MSTU(11),1100) CHIS(1),CHIS(2),FAC*NPIS(I,0),
7324 & (NPIS(I,J)/FLOAT(NPIS(I,0)),J=1,10)
7325
7326
7327 ELSEIF(MTABU.EQ.13) THEN
7328 FAC=1./MAX(1,NEVIS)
7329 DO 170 I=1,NKFIS
7330 KFMN=KFIS(I,1)
7331 IF(KFMN.EQ.0) KFMN=KFIS(I,2)
7332 KFM1=(KFMN+1)/2
7333 IF(2*KFM1.EQ.KFMN) KFM1=-KFM1
7334 KFMX=KFIS(I,2)
7335 IF(KFIS(I,1).EQ.0) KFMX=0
7336 KFM2=(KFMX+1)/2
7337 IF(2*KFM2.EQ.KFMX) KFM2=-KFM2
7338 K(I,1)=32
7339 K(I,2)=99
7340 K(I,3)=KFM1
7341 K(I,4)=KFM2
7342 K(I,5)=NPIS(I,0)
7343 DO 170 J=1,5
7344 P(I,J)=FAC*NPIS(I,J)
7345 170 V(I,J)=FAC*NPIS(I,J+5)
7346 N=NKFIS
7347 DO 180 J=1,5
7348 K(N+1,J)=0
7349 P(N+1,J)=0.
7350 180 V(N+1,J)=0.
7351 K(N+1,1)=32
7352 K(N+1,2)=99
7353 K(N+1,5)=NEVIS
7354 MSTU(3)=1
7355
7356
7357 ELSEIF(MTABU.EQ.20) THEN
7358 NEVFS=0
7359 NPRFS=0
7360 NFIFS=0
7361 NCHFS=0
7362 NKFFS=0
7363
7364
7365 ELSEIF(MTABU.EQ.21) THEN
7366 NEVFS=NEVFS+1
7367 MSTU(62)=0
7368 DO 230 I=1,N
7369 IF(K(I,1).LE.0.OR.K(I,1).GT.20.OR.K(I,1).EQ.13) GOTO 230
7370 MSTU(62)=MSTU(62)+1
7371 KC=LUCOMP(K(I,2))
7372 MPRI=0
7373 IF(K(I,3).LE.0.OR.K(I,3).GT.N) THEN
7374 MPRI=1
7375 ELSEIF(K(K(I,3),1).LE.0.OR.K(K(I,3),1).GT.20) THEN
7376 MPRI=1
7377 ELSEIF(KC.EQ.0) THEN
7378 ELSEIF(K(K(I,3),1).EQ.13) THEN
7379 IM=K(K(I,3),3)
7380 IF(IM.LE.0.OR.IM.GT.N) THEN
7381 MPRI=1
7382 ELSEIF(K(IM,1).LE.0.OR.K(IM,1).GT.20) THEN
7383 MPRI=1
7384 ENDIF
7385 ELSEIF(KCHG(KC,2).EQ.0) THEN
7386 KCM=LUCOMP(K(K(I,3),2))
7387 IF(KCM.NE.0) THEN
7388 IF(KCHG(KCM,2).NE.0) MPRI=1
7389 ENDIF
7390 ENDIF
7391 IF(KC.NE.0.AND.MPRI.EQ.1) THEN
7392 IF(KCHG(KC,2).EQ.0) NPRFS=NPRFS+1
7393 ENDIF
7394 IF(K(I,1).LE.10) THEN
7395 NFIFS=NFIFS+1
7396 IF(LUCHGE(K(I,2)).NE.0) NCHFS=NCHFS+1
7397 ENDIF
7398
7399
7400 KFA=IABS(K(I,2))
7401 KFS=3-ISIGN(1,K(I,2))-MPRI
7402 DO 190 IP=1,NKFFS
7403 IF(KFA.EQ.KFFS(IP)) THEN
7404 IKFFS=-IP
7405 GOTO 200
7406 ELSEIF(KFA.LT.KFFS(IP)) THEN
7407 IKFFS=IP
7408 GOTO 200
7409 ENDIF
7410 190 CONTINUE
7411 IKFFS=NKFFS+1
7412 200 IF(IKFFS.LT.0) THEN
7413 IKFFS=-IKFFS
7414 ELSE
7415 IF(NKFFS.GE.400) RETURN
7416 DO 210 IP=NKFFS,IKFFS,-1
7417 KFFS(IP+1)=KFFS(IP)
7418 DO 210 J=1,4
7419 210 NPFS(IP+1,J)=NPFS(IP,J)
7420 NKFFS=NKFFS+1
7421 KFFS(IKFFS)=KFA
7422 DO 220 J=1,4
7423 220 NPFS(IKFFS,J)=0
7424 ENDIF
7425 NPFS(IKFFS,KFS)=NPFS(IKFFS,KFS)+1
7426 230 CONTINUE
7427
7428
7429 ELSEIF(MTABU.EQ.22) THEN
7430 FAC=1./MAX(1,NEVFS)
7431 WRITE(MSTU(11),1200) NEVFS,FAC*NPRFS,FAC*NFIFS,FAC*NCHFS
7432 DO 240 I=1,NKFFS
7433 CALL LUNAME(KFFS(I),CHAU)
7434 KC=LUCOMP(KFFS(I))
7435 MDCYF=0
7436 IF(KC.NE.0) MDCYF=MDCY(KC,1)
7437 240 WRITE(MSTU(11),1300) KFFS(I),CHAU,MDCYF,(FAC*NPFS(I,J),J=1,4),
7438 & FAC*(NPFS(I,1)+NPFS(I,2)+NPFS(I,3)+NPFS(I,4))
7439
7440
7441 ELSEIF(MTABU.EQ.23) THEN
7442 FAC=1./MAX(1,NEVFS)
7443 DO 260 I=1,NKFFS
7444 K(I,1)=32
7445 K(I,2)=99
7446 K(I,3)=KFFS(I)
7447 K(I,4)=0
7448 K(I,5)=NPFS(I,1)+NPFS(I,2)+NPFS(I,3)+NPFS(I,4)
7449 DO 250 J=1,4
7450 P(I,J)=FAC*NPFS(I,J)
7451 250 V(I,J)=0.
7452 P(I,5)=FAC*K(I,5)
7453 260 V(I,5)=0.
7454 N=NKFFS
7455 DO 270 J=1,5
7456 K(N+1,J)=0
7457 P(N+1,J)=0.
7458 270 V(N+1,J)=0.
7459 K(N+1,1)=32
7460 K(N+1,2)=99
7461 K(N+1,5)=NEVFS
7462 P(N+1,1)=FAC*NPRFS
7463 P(N+1,2)=FAC*NFIFS
7464 P(N+1,3)=FAC*NCHFS
7465 MSTU(3)=1
7466
7467
7468 ELSEIF(MTABU.EQ.30) THEN
7469 NEVFM=0
7470 NMUFM=0
7471 DO 280 IM=1,3
7472 DO 280 IB=1,10
7473 DO 280 IP=1,4
7474 FM1FM(IM,IB,IP)=0.
7475 280 FM2FM(IM,IB,IP)=0.
7476
7477
7478 ELSEIF(MTABU.EQ.31) THEN
7479 NEVFM=NEVFM+1
7480 NLOW=N+MSTU(3)
7481 NUPP=NLOW
7482 DO 360 I=1,N
7483 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 360
7484 IF(MSTU(41).GE.2) THEN
7485 KC=LUCOMP(K(I,2))
7486 IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
7487 & KC.EQ.18) GOTO 360
7488 IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
7489 & GOTO 360
7490 ENDIF
7491 PMR=0.
7492 IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) PMR=ULMASS(211)
7493 IF(MSTU(42).GE.2) PMR=P(I,5)
7494 PR=MAX(1E-20,PMR**2+P(I,1)**2+P(I,2)**2)
7495 YETA=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/SQRT(PR),
7496 & 1E20)),P(I,3))
7497 IF(ABS(YETA).GT.PARU(57)) GOTO 360
7498 PHI=ULANGL(P(I,1),P(I,2))
7499 IYETA=512.*(YETA+PARU(57))/(2.*PARU(57))
7500 IYETA=MAX(0,MIN(511,IYETA))
7501 IPHI=512.*(PHI+PARU(1))/PARU(2)
7502 IPHI=MAX(0,MIN(511,IPHI))
7503 IYEP=0
7504 DO 290 IB=0,9
7505 290 IYEP=IYEP+4**IB*(2*MOD(IYETA/2**IB,2)+MOD(IPHI/2**IB,2))
7506
7507
7508 IF(NUPP.GT.MSTU(4)-5-MSTU(32)) THEN
7509 CALL LUERRM(11,'(LUTABU:) no more memory left in LUJETS')
7510 RETURN
7511 ENDIF
7512 NUPP=NUPP+1
7513 IF(NUPP.EQ.NLOW+1) THEN
7514 K(NUPP,1)=IYETA
7515 K(NUPP,2)=IPHI
7516 K(NUPP,3)=IYEP
7517 ELSE
7518 DO 300 I1=NUPP-1,NLOW+1,-1
7519 IF(IYETA.GE.K(I1,1)) GOTO 310
7520 300 K(I1+1,1)=K(I1,1)
7521 310 K(I1+1,1)=IYETA
7522 DO 320 I1=NUPP-1,NLOW+1,-1
7523 IF(IPHI.GE.K(I1,2)) GOTO 330
7524 320 K(I1+1,2)=K(I1,2)
7525 330 K(I1+1,2)=IPHI
7526 DO 340 I1=NUPP-1,NLOW+1,-1
7527 IF(IYEP.GE.K(I1,3)) GOTO 350
7528 340 K(I1+1,3)=K(I1,3)
7529 350 K(I1+1,3)=IYEP
7530 ENDIF
7531 360 CONTINUE
7532 K(NUPP+1,1)=2**10
7533 K(NUPP+1,2)=2**10
7534 K(NUPP+1,3)=4**10
7535
7536
7537 DO 400 IM=1,3
7538 DO 370 IB=1,10
7539 DO 370 IP=1,4
7540 370 FEVFM(IB,IP)=0.
7541 DO 380 IB=1,10
7542 IF(IM.LE.2) IBIN=2**(10-IB)
7543 IF(IM.EQ.3) IBIN=4**(10-IB)
7544 IAGR=K(NLOW+1,IM)/IBIN
7545 NAGR=1
7546 DO 380 I=NLOW+2,NUPP+1
7547 ICUT=K(I,IM)/IBIN
7548 IF(ICUT.EQ.IAGR) THEN
7549 NAGR=NAGR+1
7550 ELSE
7551 IF(NAGR.EQ.1) THEN
7552 ELSEIF(NAGR.EQ.2) THEN
7553 FEVFM(IB,1)=FEVFM(IB,1)+2.
7554 ELSEIF(NAGR.EQ.3) THEN
7555 FEVFM(IB,1)=FEVFM(IB,1)+6.
7556 FEVFM(IB,2)=FEVFM(IB,2)+6.
7557 ELSEIF(NAGR.EQ.4) THEN
7558 FEVFM(IB,1)=FEVFM(IB,1)+12.
7559 FEVFM(IB,2)=FEVFM(IB,2)+24.
7560 FEVFM(IB,3)=FEVFM(IB,3)+24.
7561 ELSE
7562 FEVFM(IB,1)=FEVFM(IB,1)+NAGR*(NAGR-1.)
7563 FEVFM(IB,2)=FEVFM(IB,2)+NAGR*(NAGR-1.)*(NAGR-2.)
7564 FEVFM(IB,3)=FEVFM(IB,3)+NAGR*(NAGR-1.)*(NAGR-2.)*(NAGR-3.)
7565 FEVFM(IB,4)=FEVFM(IB,4)+NAGR*(NAGR-1.)*(NAGR-2.)*(NAGR-3.)*
7566 & (NAGR-4.)
7567 ENDIF
7568 IAGR=ICUT
7569 NAGR=1
7570 ENDIF
7571 380 CONTINUE
7572
7573
7574 DO 390 IB=10,1,-1
7575 DO 390 IP=1,4
7576 IF(FEVFM(1,IP).LT.0.5) THEN
7577 FEVFM(IB,IP)=0.
7578 ELSEIF(IM.LE.2) THEN
7579 FEVFM(IB,IP)=2**((IB-1)*IP)*FEVFM(IB,IP)/FEVFM(1,IP)
7580 ELSE
7581 FEVFM(IB,IP)=4**((IB-1)*IP)*FEVFM(IB,IP)/FEVFM(1,IP)
7582 ENDIF
7583 FM1FM(IM,IB,IP)=FM1FM(IM,IB,IP)+FEVFM(IB,IP)
7584 390 FM2FM(IM,IB,IP)=FM2FM(IM,IB,IP)+FEVFM(IB,IP)**2
7585 400 CONTINUE
7586 NMUFM=NMUFM+(NUPP-NLOW)
7587 MSTU(62)=NUPP-NLOW
7588
7589
7590 ELSEIF(MTABU.EQ.32) THEN
7591 FAC=1./MAX(1,NEVFM)
7592 IF(MSTU(42).LE.0) WRITE(MSTU(11),1400) NEVFM,'eta'
7593 IF(MSTU(42).EQ.1) WRITE(MSTU(11),1400) NEVFM,'ypi'
7594 IF(MSTU(42).GE.2) WRITE(MSTU(11),1400) NEVFM,'y '
7595 DO 420 IM=1,3
7596 WRITE(MSTU(11),1500)
7597 DO 420 IB=1,10
7598 BYETA=2.*PARU(57)
7599 IF(IM.NE.2) BYETA=BYETA/2**(IB-1)
7600 BPHI=PARU(2)
7601 IF(IM.NE.1) BPHI=BPHI/2**(IB-1)
7602 IF(IM.LE.2) BNAVE=FAC*NMUFM/FLOAT(2**(IB-1))
7603 IF(IM.EQ.3) BNAVE=FAC*NMUFM/FLOAT(4**(IB-1))
7604 DO 410 IP=1,4
7605 FMOMA(IP)=FAC*FM1FM(IM,IB,IP)
7606 410 FMOMS(IP)=SQRT(MAX(0.,FAC*(FAC*FM2FM(IM,IB,IP)-FMOMA(IP)**2)))
7607 420 WRITE(MSTU(11),1600) BYETA,BPHI,BNAVE,(FMOMA(IP),FMOMS(IP),
7608 & IP=1,4)
7609
7610
7611 ELSEIF(MTABU.EQ.33) THEN
7612 FAC=1./MAX(1,NEVFM)
7613 DO 430 IM=1,3
7614 DO 430 IB=1,10
7615 I=10*(IM-1)+IB
7616 K(I,1)=32
7617 K(I,2)=99
7618 K(I,3)=1
7619 IF(IM.NE.2) K(I,3)=2**(IB-1)
7620 K(I,4)=1
7621 IF(IM.NE.1) K(I,4)=2**(IB-1)
7622 K(I,5)=0
7623 P(I,1)=2.*PARU(57)/K(I,3)
7624 V(I,1)=PARU(2)/K(I,4)
7625 DO 430 IP=1,4
7626 P(I,IP+1)=FAC*FM1FM(IM,IB,IP)
7627 430 V(I,IP+1)=SQRT(MAX(0.,FAC*(FAC*FM2FM(IM,IB,IP)-P(I,IP+1)**2)))
7628 N=30
7629 DO 440 J=1,5
7630 K(N+1,J)=0
7631 P(N+1,J)=0.
7632 440 V(N+1,J)=0.
7633 K(N+1,1)=32
7634 K(N+1,2)=99
7635 K(N+1,5)=NEVFM
7636 MSTU(3)=1
7637
7638
7639 ELSEIF(MTABU.EQ.40) THEN
7640 NEVEE=0
7641 DO 450 J=1,25
7642 FE1EC(J)=0.
7643 FE2EC(J)=0.
7644 FE1EC(51-J)=0.
7645 FE2EC(51-J)=0.
7646 FE1EA(J)=0.
7647 450 FE2EA(J)=0.
7648
7649
7650 ELSEIF(MTABU.EQ.41) THEN
7651 NEVEE=NEVEE+1
7652 NLOW=N+MSTU(3)
7653 NUPP=NLOW
7654 ECM=0.
7655 DO 460 I=1,N
7656 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 460
7657 IF(MSTU(41).GE.2) THEN
7658 KC=LUCOMP(K(I,2))
7659 IF(KC.EQ.0.OR.KC.EQ.12.OR.KC.EQ.14.OR.KC.EQ.16.OR.
7660 & KC.EQ.18) GOTO 460
7661 IF(MSTU(41).GE.3.AND.KCHG(KC,2).EQ.0.AND.LUCHGE(K(I,2)).EQ.0)
7662 & GOTO 460
7663 ENDIF
7664 PMR=0.
7665 IF(MSTU(42).EQ.1.AND.K(I,2).NE.22) PMR=ULMASS(211)
7666 IF(MSTU(42).GE.2) PMR=P(I,5)
7667 IF(NUPP.GT.MSTU(4)-5-MSTU(32)) THEN
7668 CALL LUERRM(11,'(LUTABU:) no more memory left in LUJETS')
7669 RETURN
7670 ENDIF
7671 NUPP=NUPP+1
7672 P(NUPP,1)=P(I,1)
7673 P(NUPP,2)=P(I,2)
7674 P(NUPP,3)=P(I,3)
7675 P(NUPP,4)=SQRT(PMR**2+P(I,1)**2+P(I,2)**2+P(I,3)**2)
7676 P(NUPP,5)=MAX(1E-10,SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2))
7677 ECM=ECM+P(NUPP,4)
7678 460 CONTINUE
7679 IF(NUPP.EQ.NLOW) RETURN
7680
7681
7682 FAC=(2./ECM**2)*50./PARU(1)
7683 DO 470 J=1,50
7684 470 FEVEE(J)=0.
7685 DO 480 I1=NLOW+2,NUPP
7686 DO 480 I2=NLOW+1,I1-1
7687 CTHE=(P(I1,1)*P(I2,1)+P(I1,2)*P(I2,2)+P(I1,3)*P(I2,3))/
7688 & (P(I1,5)*P(I2,5))
7689 THE=ACOS(MAX(-1.,MIN(1.,CTHE)))
7690 ITHE=MAX(1,MIN(50,1+INT(50.*THE/PARU(1))))
7691 480 FEVEE(ITHE)=FEVEE(ITHE)+FAC*P(I1,4)*P(I2,4)
7692 DO 490 J=1,25
7693 FE1EC(J)=FE1EC(J)+FEVEE(J)
7694 FE2EC(J)=FE2EC(J)+FEVEE(J)**2
7695 FE1EC(51-J)=FE1EC(51-J)+FEVEE(51-J)
7696 FE2EC(51-J)=FE2EC(51-J)+FEVEE(51-J)**2
7697 FE1EA(J)=FE1EA(J)+(FEVEE(51-J)-FEVEE(J))
7698 490 FE2EA(J)=FE2EA(J)+(FEVEE(51-J)-FEVEE(J))**2
7699 MSTU(62)=NUPP-NLOW
7700
7701
7702 ELSEIF(MTABU.EQ.42) THEN
7703 FAC=1./MAX(1,NEVEE)
7704 WRITE(MSTU(11),1700) NEVEE
7705 DO 500 J=1,25
7706 FEEC1=FAC*FE1EC(J)
7707 FEES1=SQRT(MAX(0.,FAC*(FAC*FE2EC(J)-FEEC1**2)))
7708 FEEC2=FAC*FE1EC(51-J)
7709 FEES2=SQRT(MAX(0.,FAC*(FAC*FE2EC(51-J)-FEEC2**2)))
7710 FEECA=FAC*FE1EA(J)
7711 FEESA=SQRT(MAX(0.,FAC*(FAC*FE2EA(J)-FEECA**2)))
7712 500 WRITE(MSTU(11),1800) 3.6*(J-1),3.6*J,FEEC1,FEES1,FEEC2,FEES2,
7713 & FEECA,FEESA
7714
7715
7716 ELSEIF(MTABU.EQ.43) THEN
7717 FAC=1./MAX(1,NEVEE)
7718 DO 510 I=1,25
7719 K(I,1)=32
7720 K(I,2)=99
7721 K(I,3)=0
7722 K(I,4)=0
7723 K(I,5)=0
7724 P(I,1)=FAC*FE1EC(I)
7725 V(I,1)=SQRT(MAX(0.,FAC*(FAC*FE2EC(I)-P(I,1)**2)))
7726 P(I,2)=FAC*FE1EC(51-I)
7727 V(I,2)=SQRT(MAX(0.,FAC*(FAC*FE2EC(51-I)-P(I,2)**2)))
7728 P(I,3)=FAC*FE1EA(I)
7729 V(I,3)=SQRT(MAX(0.,FAC*(FAC*FE2EA(I)-P(I,3)**2)))
7730 P(I,4)=PARU(1)*(I-1)/50.
7731 P(I,5)=PARU(1)*I/50.
7732 V(I,4)=3.6*(I-1)
7733 510 V(I,5)=3.6*I
7734 N=25
7735 DO 520 J=1,5
7736 K(N+1,J)=0
7737 P(N+1,J)=0.
7738 520 V(N+1,J)=0.
7739 K(N+1,1)=32
7740 K(N+1,2)=99
7741 K(N+1,5)=NEVEE
7742 MSTU(3)=1
7743
7744
7745 ELSEIF(MTABU.EQ.50) THEN
7746 NEVDC=0
7747 NKFDC=0
7748 NREDC=0
7749
7750
7751 ELSEIF(MTABU.EQ.51) THEN
7752 NEVDC=NEVDC+1
7753 NDS=0
7754 DO 550 I=1,N
7755 IF(K(I,1).LE.0.OR.K(I,1).GE.6) GOTO 550
7756 NDS=NDS+1
7757 IF(NDS.GT.8) THEN
7758 NREDC=NREDC+1
7759 RETURN
7760 ENDIF
7761 KFM=2*IABS(K(I,2))
7762 IF(K(I,2).LT.0) KFM=KFM-1
7763 DO 530 IDS=NDS-1,1,-1
7764 IIN=IDS+1
7765 IF(KFM.LT.KFDM(IDS)) GOTO 540
7766 530 KFDM(IDS+1)=KFDM(IDS)
7767 IIN=1
7768 540 KFDM(IIN)=KFM
7769 550 CONTINUE
7770
7771
7772 DO 570 IDC=1,NKFDC
7773 IF(NDS.LT.KFDC(IDC,0)) THEN
7774 IKFDC=IDC
7775 GOTO 580
7776 ELSEIF(NDS.EQ.KFDC(IDC,0)) THEN
7777 DO 560 I=1,NDS
7778 IF(KFDM(I).LT.KFDC(IDC,I)) THEN
7779 IKFDC=IDC
7780 GOTO 580
7781 ELSEIF(KFDM(I).GT.KFDC(IDC,I)) THEN
7782 GOTO 570
7783 ENDIF
7784 560 CONTINUE
7785 IKFDC=-IDC
7786 GOTO 580
7787 ENDIF
7788 570 CONTINUE
7789 IKFDC=NKFDC+1
7790 580 IF(IKFDC.LT.0) THEN
7791 IKFDC=-IKFDC
7792 ELSEIF(NKFDC.GE.200) THEN
7793 NREDC=NREDC+1
7794 RETURN
7795 ELSE
7796 DO 590 IDC=NKFDC,IKFDC,-1
7797 NPDC(IDC+1)=NPDC(IDC)
7798 DO 590 I=0,8
7799 590 KFDC(IDC+1,I)=KFDC(IDC,I)
7800 NKFDC=NKFDC+1
7801 KFDC(IKFDC,0)=NDS
7802 DO 600 I=1,NDS
7803 600 KFDC(IKFDC,I)=KFDM(I)
7804 NPDC(IKFDC)=0
7805 ENDIF
7806 NPDC(IKFDC)=NPDC(IKFDC)+1
7807
7808
7809 ELSEIF(MTABU.EQ.52) THEN
7810 FAC=1./MAX(1,NEVDC)
7811 WRITE(MSTU(11),1900) NEVDC
7812 DO 620 IDC=1,NKFDC
7813 DO 610 I=1,KFDC(IDC,0)
7814 KFM=KFDC(IDC,I)
7815 KF=(KFM+1)/2
7816 IF(2*KF.NE.KFM) KF=-KF
7817 CALL LUNAME(KF,CHAU)
7818 CHDC(I)=CHAU(1:12)
7819 610 IF(CHAU(13:13).NE.' ') CHDC(I)(12:12)='?'
7820 620 WRITE(MSTU(11),2000) FAC*NPDC(IDC),(CHDC(I),I=1,KFDC(IDC,0))
7821 IF(NREDC.NE.0) WRITE(MSTU(11),2100) FAC*NREDC
7822
7823
7824 ELSEIF(MTABU.EQ.53) THEN
7825 FAC=1./MAX(1,NEVDC)
7826 DO 650 IDC=1,NKFDC
7827 K(IDC,1)=32
7828 K(IDC,2)=99
7829 K(IDC,3)=0
7830 K(IDC,4)=0
7831 K(IDC,5)=KFDC(IDC,0)
7832 DO 630 J=1,5
7833 P(IDC,J)=0.
7834 630 V(IDC,J)=0.
7835 DO 640 I=1,KFDC(IDC,0)
7836 KFM=KFDC(IDC,I)
7837 KF=(KFM+1)/2
7838 IF(2*KF.NE.KFM) KF=-KF
7839 IF(I.LE.5) P(IDC,I)=KF
7840 640 IF(I.GE.6) V(IDC,I-5)=KF
7841 650 V(IDC,5)=FAC*NPDC(IDC)
7842 N=NKFDC
7843 DO 660 J=1,5
7844 K(N+1,J)=0
7845 P(N+1,J)=0.
7846 660 V(N+1,J)=0.
7847 K(N+1,1)=32
7848 K(N+1,2)=99
7849 K(N+1,5)=NEVDC
7850 V(N+1,5)=FAC*NREDC
7851 MSTU(3)=1
7852 ENDIF
7853
7854
7855 1000 FORMAT(///20X,'Event statistics - initial state'/
7856 &20X,'based on an analysis of ',I6,' events'//
7857 &3X,'Main flavours after',8X,'Fraction',4X,'Subfractions ',
7858 &'according to fragmenting system multiplicity'/
7859 &4X,'hard interaction',24X,'1',7X,'2',7X,'3',7X,'4',7X,'5',
7860 &6X,'6-7',5X,'8-10',3X,'11-15',3X,'16-25',4X,'>25'/)
7861 1100 FORMAT(3X,A12,1X,A12,F10.5,1X,10F8.4)
7862 1200 FORMAT(///20X,'Event statistics - final state'/
7863 &20X,'based on an analysis of ',I6,' events'//
7864 &5X,'Mean primary multiplicity =',F8.3/
7865 &5X,'Mean final multiplicity =',F8.3/
7866 &5X,'Mean charged multiplicity =',F8.3//
7867 &5X,'Number of particles produced per event (directly and via ',
7868 &'decays/branchings)'/
7869 &5X,'KF Particle/jet MDCY',8X,'Particles',9X,'Antiparticles',
7870 &5X,'Total'/34X,'prim seco prim seco'/)
7871 1300 FORMAT(1X,I6,4X,A16,I2,5(1X,F9.4))
7872 1400 FORMAT(///20X,'Factorial moments analysis of multiplicity'/
7873 &20X,'based on an analysis of ',I6,' events'//
7874 &3X,'delta-',A3,' delta-phi <n>/bin',10X,'<F2>',18X,'<F3>',
7875 &18X,'<F4>',18X,'<F5>'/35X,4(' value error '))
7876 1500 FORMAT(10X)
7877 1600 FORMAT(2X,2F10.4,F12.4,4(F12.4,F10.4))
7878 1700 FORMAT(///20X,'Energy-Energy Correlation and Asymmetry'/
7879 &20X,'based on an analysis of ',I6,' events'//
7880 &2X,'theta range',8X,'EEC(theta)',8X,'EEC(180-theta)',7X,
7881 &'EECA(theta)'/2X,'in degrees ',3(' value error')/)
7882 1800 FORMAT(2X,F4.1,' - ',F4.1,3(F11.4,F9.4))
7883 1900 FORMAT(///20X,'Decay channel analysis - final state'/
7884 &20X,'based on an analysis of ',I6,' events'//
7885 &2X,'Probability',10X,'Complete final state'/)
7886 2000 FORMAT(2X,F9.5,5X,8(A12,1X))
7887 2100 FORMAT(2X,F9.5,5X,'into other channels (more than 8 particles ',
7888 &'or table overflow)')
7889
7890 RETURN
7891 END
7892
7893
7894
7895 SUBROUTINE LUEEVT(KFL,ECM)
7896
7897
7898 IMPLICIT DOUBLE PRECISION(D)
7899 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
7900 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
7901 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
7902 SAVE
7903
7904
7905 IF(MSTU(12).GE.1) CALL LULIST(0)
7906 IF(KFL.LT.0.OR.KFL.GT.8) THEN
7907 CALL LUERRM(16,'(LUEEVT:) called with unknown flavour code')
7908 IF(MSTU(21).GE.1) RETURN
7909 ENDIF
7910 IF(KFL.LE.5) ECMMIN=PARJ(127)+2.02*PARF(100+MAX(1,KFL))
7911 IF(KFL.GE.6) ECMMIN=PARJ(127)+2.02*PMAS(KFL,1)
7912 IF(ECM.LT.ECMMIN) THEN
7913 CALL LUERRM(16,'(LUEEVT:) called with too small CM energy')
7914 IF(MSTU(21).GE.1) RETURN
7915 ENDIF
7916
7917
7918 IF(MSTJ(109).EQ.2.AND.MSTJ(110).NE.1) THEN
7919 CALL LUERRM(6,
7920 & '(LUEEVT:) MSTJ(109) value requires MSTJ(110) = 1')
7921 MSTJ(110)=1
7922 ENDIF
7923 IF(MSTJ(109).EQ.2.AND.MSTJ(111).NE.0) THEN
7924 CALL LUERRM(6,
7925 & '(LUEEVT:) MSTJ(109) value requires MSTJ(111) = 0')
7926 MSTJ(111)=0
7927 ENDIF
7928
7929
7930 MSTU(111)=MSTJ(108)
7931 IF(MSTJ(108).EQ.2.AND.(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.1))
7932 &MSTU(111)=1
7933 PARU(112)=PARJ(121)
7934 IF(MSTU(111).EQ.2) PARU(112)=PARJ(122)
7935 IF(MSTJ(116).GT.0.AND.(MSTJ(116).GE.2.OR.ABS(ECM-PARJ(151)).GE.
7936 &PARJ(139).OR.10*MSTJ(102)+KFL.NE.MSTJ(119))) CALL LUXTOT(KFL,ECM,
7937 &XTOT)
7938 IF(MSTJ(116).GE.3) MSTJ(116)=1
7939
7940
7941 NTRY=0
7942 100 NTRY=NTRY+1
7943 IF(NTRY.GT.100) THEN
7944 CALL LUERRM(14,'(LUEEVT:) caught in an infinite loop')
7945 RETURN
7946 ENDIF
7947 NC=0
7948 IF(MSTJ(115).GE.2) THEN
7949 NC=NC+2
7950 CALL LU1ENT(NC-1,11,0.5*ECM,0.,0.)
7951 K(NC-1,1)=21
7952 CALL LU1ENT(NC,-11,0.5*ECM,PARU(1),0.)
7953 K(NC,1)=21
7954 ENDIF
7955
7956
7957 MK=0
7958 ECMC=ECM
7959 IF(MSTJ(107).GE.1.AND.MSTJ(116).GE.1) CALL LURADK(ECM,MK,PAK,
7960 &THEK,PHIK,ALPK)
7961 IF(MK.EQ.1) ECMC=SQRT(ECM*(ECM-2.*PAK))
7962 IF(MSTJ(115).GE.1.AND.MK.EQ.1) THEN
7963 NC=NC+1
7964 CALL LU1ENT(NC,22,PAK,THEK,PHIK)
7965 K(NC,3)=MIN(MSTJ(115)/2,1)
7966 ENDIF
7967
7968
7969 IF(MSTJ(115).GE.3) THEN
7970 NC=NC+1
7971 KF=22
7972 IF(MSTJ(102).EQ.2) KF=23
7973 MSTU10=MSTU(10)
7974 MSTU(10)=1
7975 P(NC,5)=ECMC
7976 CALL LU1ENT(NC,KF,ECMC,0.,0.)
7977 K(NC,1)=21
7978 K(NC,3)=1
7979 MSTU(10)=MSTU10
7980 ENDIF
7981
7982
7983 CALL LUXKFL(KFL,ECM,ECMC,KFLC)
7984 IF(KFLC.EQ.0) GOTO 100
7985 CALL LUXJET(ECMC,NJET,CUT)
7986 KFLN=21
7987 IF(NJET.EQ.4) CALL LUX4JT(NJET,CUT,KFLC,ECMC,KFLN,X1,X2,X4,
7988 &X12,X14)
7989 IF(NJET.EQ.3) CALL LUX3JT(NJET,CUT,KFLC,ECMC,X1,X3)
7990 IF(NJET.EQ.2) MSTJ(120)=1
7991
7992
7993 IF(NJET.EQ.2.AND.MSTJ(101).NE.5) CALL LU2ENT(NC+1,KFLC,-KFLC,ECMC)
7994 IF(NJET.EQ.2.AND.MSTJ(101).EQ.5) CALL LU2ENT(-(NC+1),KFLC,-KFLC,
7995 &ECMC)
7996 IF(NJET.EQ.3) CALL LU3ENT(NC+1,KFLC,21,-KFLC,ECMC,X1,X3)
7997 IF(NJET.EQ.4.AND.KFLN.EQ.21) CALL LU4ENT(NC+1,KFLC,KFLN,KFLN,
7998 &-KFLC,ECMC,X1,X2,X4,X12,X14)
7999 IF(NJET.EQ.4.AND.KFLN.NE.21) CALL LU4ENT(NC+1,KFLC,-KFLN,KFLN,
8000 &-KFLC,ECMC,X1,X2,X4,X12,X14)
8001 DO 110 IP=NC+1,N
8002 110 K(IP,3)=K(IP,3)+MIN(MSTJ(115)/2,1)+(MSTJ(115)/3)*(NC-1)
8003
8004
8005 IF(MSTJ(106).EQ.1) THEN
8006 CALL LUXDIF(NC,NJET,KFLC,ECMC,CHI,THE,PHI)
8007 CALL LUDBRB(NC+1,N,0.,CHI,0D0,0D0,0D0)
8008 CALL LUDBRB(NC+1,N,THE,PHI,0D0,0D0,0D0)
8009 ENDIF
8010
8011
8012 IF(MK.EQ.1) THEN
8013 DBEK=-PAK/(ECM-PAK)
8014 NMIN=NC+1-MSTJ(115)/3
8015 CALL LUDBRB(NMIN,N,0.,-PHIK,0D0,0D0,0D0)
8016 CALL LUDBRB(NMIN,N,ALPK,0.,DBEK*SIN(THEK),0D0,DBEK*COS(THEK))
8017 CALL LUDBRB(NMIN,N,0.,PHIK,0D0,0D0,0D0)
8018 ENDIF
8019
8020
8021 IF(MSTJ(101).EQ.5) THEN
8022 CALL LUSHOW(N-1,N,ECMC)
8023 MSTJ14=MSTJ(14)
8024 IF(MSTJ(105).EQ.-1) MSTJ(14)=0
8025 IF(MSTJ(105).GE.0) MSTU(28)=0
8026 CALL LUPREP(0)
8027 MSTJ(14)=MSTJ14
8028 IF(MSTJ(105).GE.0.AND.MSTU(28).NE.0) GOTO 100
8029 ENDIF
8030
8031
8032 IF(MSTJ(105).EQ.1) CALL LUEXEC
8033 MSTU(161)=KFLC
8034 MSTU(162)=-KFLC
8035
8036 RETURN
8037 END
8038
8039
8040
8041 SUBROUTINE LUXTOT(KFL,ECM,XTOT)
8042
8043
8044
8045 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
8046 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
8047 SAVE
8048
8049
8050 PARJ(151)=ECM
8051 MSTJ(119)=10*MSTJ(102)+KFL
8052 IF(MSTJ(111).EQ.0) THEN
8053 Q2R=ECM**2
8054 ELSEIF(MSTU(111).EQ.0) THEN
8055 PARJ(168)=MIN(1.,MAX(PARJ(128),EXP(-12.*PARU(1)/
8056 & ((33.-2.*MSTU(112))*PARU(111)))))
8057 Q2R=PARJ(168)*ECM**2
8058 ELSE
8059 PARJ(168)=MIN(1.,MAX(PARJ(128),PARU(112)/ECM,
8060 & (2.*PARU(112)/ECM)**2))
8061 Q2R=PARJ(168)*ECM**2
8062 ENDIF
8063 ALSPI=ULALPS(Q2R)/PARU(1)
8064
8065
8066 IF(MSTJ(101).EQ.0.OR.MSTJ(109).EQ.1) THEN
8067 RQCD=1.
8068 ELSEIF(IABS(MSTJ(101)).EQ.1.AND.MSTJ(109).EQ.0) THEN
8069 RQCD=1.+ALSPI
8070 ELSEIF(MSTJ(109).EQ.0) THEN
8071 RQCD=1.+ALSPI+(1.986-0.115*MSTU(118))*ALSPI**2
8072 IF(MSTJ(111).EQ.1) RQCD=MAX(1.,RQCD+(33.-2.*MSTU(112))/12.*
8073 & LOG(PARJ(168))*ALSPI**2)
8074 ELSEIF(IABS(MSTJ(101)).EQ.1) THEN
8075 RQCD=1.+(3./4.)*ALSPI
8076 ELSE
8077 RQCD=1.+(3./4.)*ALSPI-(3./32.+0.519*MSTU(118))*ALSPI**2
8078 ENDIF
8079
8080
8081 IF(MSTJ(102).GE.3) THEN
8082 RVA=3.*(3.+(4.*PARU(102)-1.)**2)+6.*RQCD*(2.+(1.-8.*PARU(102)/
8083 & 3.)**2+(4.*PARU(102)/3.-1.)**2)
8084 DO 100 KFLC=5,6
8085 VQ=1.
8086 IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(MAX(0.,1.-(2.*ULMASS(KFLC)/
8087 & ECM)**2))
8088 IF(KFLC.EQ.5) VF=4.*PARU(102)/3.-1.
8089 IF(KFLC.EQ.6) VF=1.-8.*PARU(102)/3.
8090 100 RVA=RVA+3.*RQCD*(0.5*VQ*(3.-VQ**2)*VF**2+VQ**3)
8091 PARJ(124)=PARU(101)*PARJ(123)*RVA/(48.*PARU(102)*(1.-PARU(102)))
8092 ENDIF
8093
8094
8095 POLL=1.-PARJ(131)*PARJ(132)
8096 IF(MSTJ(102).GE.2) THEN
8097 SFF=1./(16.*PARU(102)*(1.-PARU(102)))
8098 SFW=ECM**4/((ECM**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2)
8099 SFI=SFW*(1.-(PARJ(123)/ECM)**2)
8100 VE=4.*PARU(102)-1.
8101 SF1I=SFF*(VE*POLL+PARJ(132)-PARJ(131))
8102 SF1W=SFF**2*((VE**2+1.)*POLL+2.*VE*(PARJ(132)-PARJ(131)))
8103 HF1I=SFI*SF1I
8104 HF1W=SFW*SF1W
8105 ENDIF
8106
8107
8108 RTOT=0.
8109 RQQ=0.
8110 RQV=0.
8111 RVA=0.
8112 DO 110 KFLC=1,MAX(MSTJ(104),KFL)
8113 IF(KFL.GT.0.AND.KFLC.NE.KFL) GOTO 110
8114 MSTJ(93)=1
8115 PMQ=ULMASS(KFLC)
8116 IF(ECM.LT.2.*PMQ+PARJ(127)) GOTO 110
8117 QF=KCHG(KFLC,1)/3.
8118 VQ=1.
8119 IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(1.-(2.*PMQ/ECM)**2)
8120
8121
8122 RQQ=RQQ+3.*QF**2*POLL
8123 IF(MSTJ(102).LE.1) THEN
8124 RTOT=RTOT+3.*0.5*VQ*(3.-VQ**2)*QF**2*POLL
8125 ELSE
8126 VF=SIGN(1.,QF)-4.*QF*PARU(102)
8127 RQV=RQV-6.*QF*VF*SF1I
8128 RVA=RVA+3.*(VF**2+1.)*SF1W
8129 RTOT=RTOT+3.*(0.5*VQ*(3.-VQ**2)*(QF**2*POLL-2.*QF*VF*HF1I+
8130 & VF**2*HF1W)+VQ**3*HF1W)
8131 ENDIF
8132 110 CONTINUE
8133 RSUM=RQQ
8134 IF(MSTJ(102).GE.2) RSUM=RQQ+SFI*RQV+SFW*RVA
8135
8136
8137 PARJ(141)=RQQ
8138 PARJ(142)=RTOT
8139 PARJ(143)=RTOT*RQCD
8140 PARJ(144)=PARJ(143)
8141 PARJ(145)=PARJ(141)*86.8/ECM**2
8142 PARJ(146)=PARJ(142)*86.8/ECM**2
8143 PARJ(147)=PARJ(143)*86.8/ECM**2
8144 PARJ(148)=PARJ(147)
8145 PARJ(157)=RSUM*RQCD
8146 PARJ(158)=0.
8147 PARJ(159)=0.
8148 XTOT=PARJ(147)
8149 IF(MSTJ(107).LE.0) RETURN
8150
8151
8152 XKL=PARJ(135)
8153 XKU=MIN(PARJ(136),1.-(2.*PARJ(127)/ECM)**2)
8154 ALE=2.*LOG(ECM/ULMASS(11))-1.
8155 SIGV=ALE/3.+2.*LOG(ECM**2/(ULMASS(13)*ULMASS(15)))/3.-4./3.+
8156 &1.526*LOG(ECM**2/0.932)
8157
8158
8159 IF(MSTJ(102).LE.1) THEN
8160 SIGV=1.5*ALE-0.5+PARU(1)**2/3.+2.*SIGV
8161 SIGS=ALE*(2.*LOG(XKL)-LOG(1.-XKL)-XKL)
8162 SIGH=ALE*(2.*LOG(XKU/XKL)-LOG((1.-XKU)/(1.-XKL))-(XKU-XKL))
8163
8164
8165 ELSE
8166 SZM=1.-(PARJ(123)/ECM)**2
8167 SZW=PARJ(123)*PARJ(124)/ECM**2
8168 PARJ(161)=-RQQ/RSUM
8169 PARJ(162)=-(RQQ+RQV+RVA)/RSUM
8170 PARJ(163)=(RQV*(1.-0.5*SZM-SFI)+RVA*(1.5-SZM-SFW))/RSUM
8171 PARJ(164)=(RQV*SZW**2*(1.-2.*SFW)+RVA*(2.*SFI+SZW**2-4.+3.*SZM-
8172 & SZM**2))/(SZW*RSUM)
8173 SIGV=1.5*ALE-0.5+PARU(1)**2/3.+((2.*RQQ+SFI*RQV)/RSUM)*SIGV+
8174 & (SZW*SFW*RQV/RSUM)*PARU(1)*20./9.
8175 SIGS=ALE*(2.*LOG(XKL)+PARJ(161)*LOG(1.-XKL)+PARJ(162)*XKL+
8176 & PARJ(163)*LOG(((XKL-SZM)**2+SZW**2)/(SZM**2+SZW**2))+
8177 & PARJ(164)*(ATAN((XKL-SZM)/SZW)-ATAN(-SZM/SZW)))
8178 SIGH=ALE*(2.*LOG(XKU/XKL)+PARJ(161)*LOG((1.-XKU)/(1.-XKL))+
8179 & PARJ(162)*(XKU-XKL)+PARJ(163)*LOG(((XKU-SZM)**2+SZW**2)/
8180 & ((XKL-SZM)**2+SZW**2))+PARJ(164)*(ATAN((XKU-SZM)/SZW)-
8181 & ATAN((XKL-SZM)/SZW)))
8182 ENDIF
8183
8184
8185 PARJ(160)=SIGH/(PARU(1)/PARU(101)+SIGV+SIGS+SIGH)
8186 PARJ(157)=RSUM*(1.+(PARU(101)/PARU(1))*(SIGV+SIGS+SIGH))*RQCD
8187 PARJ(144)=PARJ(157)
8188 PARJ(148)=PARJ(144)*86.8/ECM**2
8189 XTOT=PARJ(148)
8190
8191 RETURN
8192 END
8193
8194
8195
8196 SUBROUTINE LURADK(ECM,MK,PAK,THEK,PHIK,ALPK)
8197
8198
8199 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
8200 SAVE
8201
8202
8203 FXK(XX)=2.*LOG(XX)+PARJ(161)*LOG(1.-XX)+PARJ(162)*XX+
8204 &PARJ(163)*LOG((XX-SZM)**2+SZW**2)+PARJ(164)*ATAN((XX-SZM)/SZW)
8205
8206
8207 MK=0
8208 PAK=0.
8209 IF(PARJ(160).LT.RLU(0)) RETURN
8210 MK=1
8211
8212
8213 XKL=PARJ(135)
8214 XKU=MIN(PARJ(136),1.-(2.*PARJ(127)/ECM)**2)
8215 IF(MSTJ(102).LE.1) THEN
8216 100 XK=1./(1.+(1./XKL-1.)*((1./XKU-1.)/(1./XKL-1.))**RLU(0))
8217 IF(1.+(1.-XK)**2.LT.2.*RLU(0)) GOTO 100
8218
8219
8220 ELSE
8221 SZM=1.-(PARJ(123)/ECM)**2
8222 SZW=PARJ(123)*PARJ(124)/ECM**2
8223 FXKL=FXK(XKL)
8224 FXKU=FXK(XKU)
8225 FXKD=1E-4*(FXKU-FXKL)
8226 FXKR=FXKL+RLU(0)*(FXKU-FXKL)
8227 NXK=0
8228 110 NXK=NXK+1
8229 XK=0.5*(XKL+XKU)
8230 FXKV=FXK(XK)
8231 IF(FXKV.GT.FXKR) THEN
8232 XKU=XK
8233 FXKU=FXKV
8234 ELSE
8235 XKL=XK
8236 FXKL=FXKV
8237 ENDIF
8238 IF(NXK.LT.15.AND.FXKU-FXKL.GT.FXKD) GOTO 110
8239 XK=XKL+(XKU-XKL)*(FXKR-FXKL)/(FXKU-FXKL)
8240 ENDIF
8241 PAK=0.5*ECM*XK
8242
8243
8244 PME=2.*(ULMASS(11)/ECM)**2
8245 120 CTHM=PME*(2./PME)**RLU(0)
8246 IF(1.-(XK**2*CTHM*(1.-0.5*CTHM)+2.*(1.-XK)*PME/MAX(PME,
8247 &CTHM*(1.-0.5*CTHM)))/(1.+(1.-XK)**2).LT.RLU(0)) GOTO 120
8248 CTHE=1.-CTHM
8249 IF(RLU(0).GT.0.5) CTHE=-CTHE
8250 STHE=SQRT(MAX(0.,(CTHM-PME)*(2.-CTHM)))
8251 THEK=ULANGL(CTHE,STHE)
8252 PHIK=PARU(2)*RLU(0)
8253
8254
8255 SGN=1.
8256 IF(0.5*(2.-XK*(1.-CTHE))**2/((2.-XK)**2+(XK*CTHE)**2).GT.
8257 &RLU(0)) SGN=-1.
8258 ALPK=ASIN(SGN*STHE*(XK-SGN*(2.*SQRT(1.-XK)-2.+XK)*CTHE)/
8259 &(2.-XK*(1.-SGN*CTHE)))
8260
8261 RETURN
8262 END
8263
8264
8265
8266 SUBROUTINE LUXKFL(KFL,ECM,ECMC,KFLC)
8267
8268
8269 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
8270 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
8271 SAVE
8272
8273
8274 IF(MSTJ(102).LE.1) THEN
8275 RFMAX=4./9.
8276 ELSE
8277 POLL=1.-PARJ(131)*PARJ(132)
8278 SFF=1./(16.*PARU(102)*(1.-PARU(102)))
8279 SFW=ECMC**4/((ECMC**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2)
8280 SFI=SFW*(1.-(PARJ(123)/ECMC)**2)
8281 VE=4.*PARU(102)-1.
8282 HF1I=SFI*SFF*(VE*POLL+PARJ(132)-PARJ(131))
8283 HF1W=SFW*SFF**2*((VE**2+1.)*POLL+2.*VE*(PARJ(132)-PARJ(131)))
8284 RFMAX=MAX(4./9.*POLL-4./3.*(1.-8.*PARU(102)/3.)*HF1I+
8285 & ((1.-8.*PARU(102)/3.)**2+1.)*HF1W,1./9.*POLL+2./3.*
8286 & (-1.+4.*PARU(102)/3.)*HF1I+((-1.+4.*PARU(102)/3.)**2+1.)*HF1W)
8287 ENDIF
8288
8289
8290 NTRY=0
8291 100 NTRY=NTRY+1
8292 IF(NTRY.GT.100) THEN
8293 CALL LUERRM(14,'(LUXKFL:) caught in an infinite loop')
8294 KFLC=0
8295 RETURN
8296 ENDIF
8297 KFLC=KFL
8298 IF(KFL.LE.0) KFLC=1+INT(MSTJ(104)*RLU(0))
8299 MSTJ(93)=1
8300 PMQ=ULMASS(KFLC)
8301 IF(ECM.LT.2.*PMQ+PARJ(127)) GOTO 100
8302 QF=KCHG(KFLC,1)/3.
8303 VQ=1.
8304 IF(MOD(MSTJ(103),2).EQ.1) VQ=SQRT(MAX(0.,1.-(2.*PMQ/ECMC)**2))
8305
8306
8307 IF(MSTJ(102).LE.1) THEN
8308 RF=QF**2
8309 RFV=0.5*VQ*(3.-VQ**2)*QF**2
8310 ELSE
8311 VF=SIGN(1.,QF)-4.*QF*PARU(102)
8312 RF=QF**2*POLL-2.*QF*VF*HF1I+(VF**2+1.)*HF1W
8313 RFV=0.5*VQ*(3.-VQ**2)*(QF**2*POLL-2.*QF*VF*HF1I+VF**2*HF1W)+
8314 & VQ**3*HF1W
8315 ENDIF
8316
8317
8318 IF(KFL.LE.0.AND.RF.LT.RLU(0)*RFMAX) GOTO 100
8319 PARJ(158)=PARJ(158)+1.
8320 IF(ECMC.LT.2.*PMQ+PARJ(127).OR.RFV.LT.RLU(0)*RF) KFLC=0
8321 IF(MSTJ(107).LE.0.AND.KFLC.EQ.0) GOTO 100
8322 IF(KFLC.NE.0) PARJ(159)=PARJ(159)+1.
8323 PARJ(144)=PARJ(157)*PARJ(159)/PARJ(158)
8324 PARJ(148)=PARJ(144)*86.8/ECM**2
8325
8326 RETURN
8327 END
8328
8329
8330
8331 SUBROUTINE LUXJET(ECM,NJET,CUT)
8332
8333
8334 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
8335 DIMENSION ZHUT(5)
8336 SAVE
8337
8338
8339 DATA ZHUT/3.0922, 6.2291, 7.4782, 7.8440, 8.2560/
8340
8341
8342 IF(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.5) THEN
8343 CUT=0.
8344
8345
8346 ELSEIF(MSTJ(109).EQ.0.OR.MSTJ(109).EQ.2) THEN
8347 CF=4./3.
8348 IF(MSTJ(109).EQ.2) CF=1.
8349 IF(MSTJ(111).EQ.0) THEN
8350 Q2=ECM**2
8351 Q2R=ECM**2
8352 ELSEIF(MSTU(111).EQ.0) THEN
8353 PARJ(169)=MIN(1.,PARJ(129))
8354 Q2=PARJ(169)*ECM**2
8355 PARJ(168)=MIN(1.,MAX(PARJ(128),EXP(-12.*PARU(1)/
8356 & ((33.-2.*MSTU(112))*PARU(111)))))
8357 Q2R=PARJ(168)*ECM**2
8358 ELSE
8359 PARJ(169)=MIN(1.,MAX(PARJ(129),(2.*PARU(112)/ECM)**2))
8360 Q2=PARJ(169)*ECM**2
8361 PARJ(168)=MIN(1.,MAX(PARJ(128),PARU(112)/ECM,
8362 & (2.*PARU(112)/ECM)**2))
8363 Q2R=PARJ(168)*ECM**2
8364 ENDIF
8365
8366
8367 ALSPI=(3./4.)*CF*ULALPS(Q2R)/PARU(1)
8368 IF(IABS(MSTJ(101)).EQ.1) THEN
8369 RQCD=1.+ALSPI
8370 ELSEIF(MSTJ(109).EQ.0) THEN
8371 RQCD=1.+ALSPI+(1.986-0.115*MSTU(118))*ALSPI**2
8372 IF(MSTJ(111).EQ.1) RQCD=MAX(1.,RQCD+(33.-2.*MSTU(112))/12.*
8373 & LOG(PARJ(168))*ALSPI**2)
8374 ELSE
8375 RQCD=1.+ALSPI-(3./32.+0.519*MSTU(118))*(4.*ALSPI/3.)**2
8376 ENDIF
8377
8378
8379 ALSPI=(3./4.)*CF*ULALPS(Q2)/PARU(1)
8380 CUT=MAX(0.001,PARJ(125),(PARJ(126)/ECM)**2)
8381 IF(IABS(MSTJ(101)).LE.1.OR.(MSTJ(109).EQ.0.AND.MSTJ(111).EQ.0))
8382 & CUT=MAX(CUT,EXP(-SQRT(0.75/ALSPI))/2.)
8383 IF(MSTJ(110).EQ.2) CUT=MAX(0.01,MIN(0.05,CUT))
8384
8385
8386 100 IF(MSTJ(101).EQ.0.OR.CUT.GE.0.25) THEN
8387 PARJ(152)=0.
8388 ELSE
8389 PARJ(152)=(2.*ALSPI/3.)*((3.-6.*CUT+2.*LOG(CUT))*
8390 & LOG(CUT/(1.-2.*CUT))+(2.5+1.5*CUT-6.571)*(1.-3.*CUT)+
8391 & 5.833*(1.-3.*CUT)**2-3.894*(1.-3.*CUT)**3+
8392 & 1.342*(1.-3.*CUT)**4)/RQCD
8393 IF(MSTJ(109).EQ.2.AND.(MSTJ(101).EQ.2.OR.MSTJ(101).LE.-2))
8394 & PARJ(152)=0.
8395 ENDIF
8396
8397
8398 IF(IABS(MSTJ(101)).LE.1.OR.MSTJ(101).EQ.3.OR.MSTJ(109).EQ.2.OR.
8399 & CUT.GE.0.25) THEN
8400 PARJ(153)=0.
8401 ELSEIF(MSTJ(110).LE.1) THEN
8402 CT=LOG(1./CUT-2.)
8403 PARJ(153)=ALSPI**2*CT**2*(2.419+0.5989*CT+0.6782*CT**2-
8404 & 0.2661*CT**3+0.01159*CT**4)/RQCD
8405
8406
8407 ELSEIF(MSTJ(110).EQ.2) THEN
8408 IZA=0
8409 DO 110 IY=1,5
8410 110 IF(ABS(CUT-0.01*IY).LT.0.0001) IZA=IY
8411 IF(IZA.NE.0) THEN
8412 ZHURAT=ZHUT(IZA)
8413 ELSE
8414 IZ=100.*CUT
8415 ZHURAT=ZHUT(IZ)+(100.*CUT-IZ)*(ZHUT(IZ+1)-ZHUT(IZ))
8416 ENDIF
8417 PARJ(153)=ALSPI*PARJ(152)*ZHURAT
8418 ENDIF
8419
8420
8421 IF(MSTJ(111).EQ.1.AND.IABS(MSTJ(101)).GE.2.AND.MSTJ(101).NE.3.
8422 & AND.CUT.LT.0.25) PARJ(153)=PARJ(153)+(33.-2.*MSTU(112))/12.*
8423 & LOG(PARJ(169))*ALSPI*PARJ(152)
8424
8425
8426 IF(IABS(MSTJ(101)).LE.1.OR.CUT.GE.0.125) THEN
8427 PARJ(154)=0.
8428 ELSE
8429 CT=LOG(1./CUT-5.)
8430 IF(CUT.LE.0.018) THEN
8431 XQQGG=6.349-4.330*CT+0.8304*CT**2
8432 IF(MSTJ(109).EQ.2) XQQGG=(4./3.)**2*(3.035-2.091*CT+
8433 & 0.4059*CT**2)
8434 XQQQQ=1.25*(-0.1080+0.01486*CT+0.009364*CT**2)
8435 IF(MSTJ(109).EQ.2) XQQQQ=8.*XQQQQ
8436 ELSE
8437 XQQGG=-0.09773+0.2959*CT-0.2764*CT**2+0.08832*CT**3
8438 IF(MSTJ(109).EQ.2) XQQGG=(4./3.)**2*(-0.04079+0.1340*CT-
8439 & 0.1326*CT**2+0.04365*CT**3)
8440 XQQQQ=1.25*(0.003661-0.004888*CT-0.001081*CT**2+0.002093*
8441 & CT**3)
8442 IF(MSTJ(109).EQ.2) XQQQQ=8.*XQQQQ
8443 ENDIF
8444 PARJ(154)=ALSPI**2*CT**2*(XQQGG+XQQQQ)/RQCD
8445 PARJ(155)=XQQQQ/(XQQGG+XQQQQ)
8446 ENDIF
8447
8448
8449 IF(MSTJ(111).EQ.1.AND.PARJ(152)+PARJ(153).LT.0..AND.
8450 & PARJ(169).LT.0.99) THEN
8451 PARJ(169)=MIN(1.,1.2*PARJ(169))
8452 Q2=PARJ(169)*ECM**2
8453 ALSPI=(3./4.)*CF*ULALPS(Q2)/PARU(1)
8454 GOTO 100
8455 ENDIF
8456
8457
8458 IF(PARJ(152)+PARJ(153)+PARJ(154).GE.1) THEN
8459 IF(MSTJ(110).EQ.2.AND.CUT.GT.0.0499.AND.MSTJ(111).EQ.1.AND.
8460 & PARJ(169).LT.0.99) THEN
8461 PARJ(169)=MIN(1.,1.2*PARJ(169))
8462 Q2=PARJ(169)*ECM**2
8463 ALSPI=(3./4.)*CF*ULALPS(Q2)/PARU(1)
8464 GOTO 100
8465 ELSEIF(MSTJ(110).EQ.2.AND.CUT.GT.0.0499) THEN
8466 CALL LUERRM(26,
8467 & '(LUXJET:) no allowed y cut value for Zhu parametrization')
8468 ENDIF
8469 CUT=0.26*(4.*CUT)**(PARJ(152)+PARJ(153)+PARJ(154))**(-1./3.)
8470 IF(MSTJ(110).EQ.2) CUT=MAX(0.01,MIN(0.05,CUT))
8471 GOTO 100
8472 ENDIF
8473
8474
8475 ELSE
8476 ALSPI=ULALPS(ECM**2)/PARU(1)
8477 CUT=MAX(0.001,PARJ(125),(PARJ(126)/ECM)**2,EXP(-3./ALSPI))
8478 PARJ(152)=0.
8479 IF(CUT.LT.0.25) PARJ(152)=(ALSPI/3.)*((1.-2.*CUT)*
8480 & LOG((1.-2.*CUT)/CUT)+0.5*(9.*CUT**2-1.))
8481 PARJ(153)=0.
8482 PARJ(154)=0.
8483 ENDIF
8484
8485
8486 PARJ(150)=CUT
8487 IF(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.5) THEN
8488 NJET=2
8489 ELSEIF(MSTJ(101).LE.0) THEN
8490 NJET=MIN(4,2-MSTJ(101))
8491 ELSE
8492 RNJ=RLU(0)
8493 NJET=2
8494 IF(PARJ(152)+PARJ(153)+PARJ(154).GT.RNJ) NJET=3
8495 IF(PARJ(154).GT.RNJ) NJET=4
8496 ENDIF
8497
8498 RETURN
8499 END
8500
8501
8502
8503 SUBROUTINE LUX3JT(NJET,CUT,KFL,ECM,X1,X2)
8504
8505
8506 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
8507 DIMENSION ZHUP(5,12)
8508 SAVE
8509
8510
8511 DATA ((ZHUP(IC1,IC2),IC2=1,12),IC1=1,5)/
8512 & 18.29, 89.56, 4.541, -52.09, -109.8, 24.90,
8513 & 11.63, 3.683, 17.50, 0.002440, -1.362, -0.3537,
8514 & 11.42, 6.299, -22.55, -8.915, 59.25, -5.855,
8515 & -32.85, -1.054, -16.90, 0.006489, -0.8156, 0.01095,
8516 & 7.847, -3.964, -35.83, 1.178, 29.39, 0.2806,
8517 & 47.82, -12.36, -56.72, 0.04054, -0.4365, 0.6062,
8518 & 5.441, -56.89, -50.27, 15.13, 114.3, -18.19,
8519 & 97.05, -1.890, -139.9, 0.08153, -0.4984, 0.9439,
8520 & -17.65, 51.44, -58.32, 70.95, -255.7, -78.99,
8521 & 476.9, 29.65, -239.3, 0.4745, -1.174, 6.081/
8522
8523
8524 DILOG(X)=X+X**2/4.+X**3/9.+X**4/16.+X**5/25.+X**6/36.+X**7/49.
8525
8526
8527 MSTJ(120)=2
8528 MSTJ(121)=0
8529 PMQ=ULMASS(KFL)
8530 QME=(2.*PMQ/ECM)**2
8531 IF(MSTJ(109).NE.1) THEN
8532 CUTL=LOG(CUT)
8533 CUTD=LOG(1./CUT-2.)
8534 IF(MSTJ(109).EQ.0) THEN
8535 CF=4./3.
8536 CN=3.
8537 TR=2.
8538 WTMX=MIN(20.,37.-6.*CUTD)
8539 IF(MSTJ(110).EQ.2) WTMX=2.*(7.5+80.*CUT)
8540 ELSE
8541 CF=1.
8542 CN=0.
8543 TR=12.
8544 WTMX=0.
8545 ENDIF
8546
8547
8548 ALS2PI=PARU(118)/PARU(2)
8549 WTOPT=0.
8550 IF(MSTJ(111).EQ.1) WTOPT=(33.-2.*MSTU(112))/6.*LOG(PARJ(169))*
8551 & ALS2PI
8552 WTMAX=MAX(0.,1.+WTOPT+ALS2PI*WTMX)
8553
8554
8555 100 NJET=3
8556 110 Y13L=CUTL+CUTD*RLU(0)
8557 Y23L=CUTL+CUTD*RLU(0)
8558 Y13=EXP(Y13L)
8559 Y23=EXP(Y23L)
8560 Y12=1.-Y13-Y23
8561 IF(Y12.LE.CUT) GOTO 110
8562 IF(Y13**2+Y23**2+2.*Y12.LE.2.*RLU(0)) GOTO 110
8563
8564
8565 IF(MSTJ(101).EQ.2.AND.MSTJ(110).LE.1) THEN
8566 Y12L=LOG(Y12)
8567 Y13M=LOG(1.-Y13)
8568 Y23M=LOG(1.-Y23)
8569 Y12M=LOG(1.-Y12)
8570 IF(Y13.LE.0.5) Y13I=DILOG(Y13)
8571 IF(Y13.GE.0.5) Y13I=1.644934-Y13L*Y13M-DILOG(1.-Y13)
8572 IF(Y23.LE.0.5) Y23I=DILOG(Y23)
8573 IF(Y23.GE.0.5) Y23I=1.644934-Y23L*Y23M-DILOG(1.-Y23)
8574 IF(Y12.LE.0.5) Y12I=DILOG(Y12)
8575 IF(Y12.GE.0.5) Y12I=1.644934-Y12L*Y12M-DILOG(1.-Y12)
8576 WT1=(Y13**2+Y23**2+2.*Y12)/(Y13*Y23)
8577 WT2=CF*(-2.*(CUTL-Y12L)**2-3.*CUTL-1.+3.289868+
8578 & 2.*(2.*CUTL-Y12L)*CUT/Y12)+
8579 & CN*((CUTL-Y12L)**2-(CUTL-Y13L)**2-(CUTL-Y23L)**2-11.*CUTL/6.+
8580 & 67./18.+1.644934-(2.*CUTL-Y12L)*CUT/Y12+(2.*CUTL-Y13L)*
8581 & CUT/Y13+(2.*CUTL-Y23L)*CUT/Y23)+
8582 & TR*(2.*CUTL/3.-10./9.)+
8583 & CF*(Y12/(Y12+Y13)+Y12/(Y12+Y23)+(Y12+Y23)/Y13+(Y12+Y13)/Y23+
8584 & Y13L*(4.*Y12**2+2.*Y12*Y13+4.*Y12*Y23+Y13*Y23)/(Y12+Y23)**2+
8585 & Y23L*(4.*Y12**2+2.*Y12*Y23+4.*Y12*Y13+Y13*Y23)/(Y12+Y13)**2)/
8586 & WT1+
8587 & CN*(Y13L*Y13/(Y12+Y23)+Y23L*Y23/(Y12+Y13))/WT1+
8588 & (CN-2.*CF)*((Y12**2+(Y12+Y13)**2)*(Y12L*Y23L-Y12L*Y12M-Y23L*
8589 & Y23M+1.644934-Y12I-Y23I)/(Y13*Y23)+(Y12**2+(Y12+Y23)**2)*
8590 & (Y12L*Y13L-Y12L*Y12M-Y13L*Y13M+1.644934-Y12I-Y13I)/
8591 & (Y13*Y23)+(Y13**2+Y23**2)/(Y13*Y23*(Y13+Y23))-
8592 & 2.*Y12L*Y12**2/(Y13+Y23)**2-4.*Y12L*Y12/(Y13+Y23))/WT1-
8593 & CN*(Y13L*Y23L-Y13L*Y13M-Y23L*Y23M+1.644934-Y13I-Y23I)
8594 IF(1.+WTOPT+ALS2PI*WT2.LE.0.) MSTJ(121)=1
8595 IF(1.+WTOPT+ALS2PI*WT2.LE.WTMAX*RLU(0)) GOTO 110
8596 PARJ(156)=(WTOPT+ALS2PI*WT2)/(1.+WTOPT+ALS2PI*WT2)
8597
8598 ELSEIF(MSTJ(101).EQ.2.AND.MSTJ(110).EQ.2) THEN
8599
8600 ZX=(Y23-Y13)**2
8601 ZY=1.-Y12
8602 IZA=0
8603 DO 120 IY=1,5
8604 120 IF(ABS(CUT-0.01*IY).LT.0.0001) IZA=IY
8605 IF(IZA.NE.0) THEN
8606 IZ=IZA
8607 WT2=ZHUP(IZ,1)+ZHUP(IZ,2)*ZX+ZHUP(IZ,3)*ZX**2+(ZHUP(IZ,4)+
8608 & ZHUP(IZ,5)*ZX)*ZY+(ZHUP(IZ,6)+ZHUP(IZ,7)*ZX)*ZY**2+
8609 & (ZHUP(IZ,8)+ZHUP(IZ,9)*ZX)*ZY**3+ZHUP(IZ,10)/(ZX-ZY**2)+
8610 & ZHUP(IZ,11)/(1.-ZY)+ZHUP(IZ,12)/ZY
8611 ELSE
8612 IZ=100.*CUT
8613 WTL=ZHUP(IZ,1)+ZHUP(IZ,2)*ZX+ZHUP(IZ,3)*ZX**2+(ZHUP(IZ,4)+
8614 & ZHUP(IZ,5)*ZX)*ZY+(ZHUP(IZ,6)+ZHUP(IZ,7)*ZX)*ZY**2+
8615 & (ZHUP(IZ,8)+ZHUP(IZ,9)*ZX)*ZY**3+ZHUP(IZ,10)/(ZX-ZY**2)+
8616 & ZHUP(IZ,11)/(1.-ZY)+ZHUP(IZ,12)/ZY
8617 IZ=IZ+1
8618 WTU=ZHUP(IZ,1)+ZHUP(IZ,2)*ZX+ZHUP(IZ,3)*ZX**2+(ZHUP(IZ,4)+
8619 & ZHUP(IZ,5)*ZX)*ZY+(ZHUP(IZ,6)+ZHUP(IZ,7)*ZX)*ZY**2+
8620 & (ZHUP(IZ,8)+ZHUP(IZ,9)*ZX)*ZY**3+ZHUP(IZ,10)/(ZX-ZY**2)+
8621 & ZHUP(IZ,11)/(1.-ZY)+ZHUP(IZ,12)/ZY
8622 WT2=WTL+(WTU-WTL)*(100.*CUT+1.-IZ)
8623 ENDIF
8624 IF(1.+WTOPT+2.*ALS2PI*WT2.LE.0.) MSTJ(121)=1
8625 IF(1.+WTOPT+2.*ALS2PI*WT2.LE.WTMAX*RLU(0)) GOTO 110
8626 PARJ(156)=(WTOPT+2.*ALS2PI*WT2)/(1.+WTOPT+2.*ALS2PI*WT2)
8627 ENDIF
8628
8629
8630 X1=1.-Y23
8631 X2=1.-Y13
8632 X3=1.-Y12
8633 IF(4.*Y23*Y13*Y12/X3**2.LE.QME) NJET=2
8634 IF(MOD(MSTJ(103),4).GE.2.AND.IABS(MSTJ(101)).LE.1.AND.QME*X3+
8635 & 0.5*QME**2+(0.5*QME+0.25*QME**2)*((1.-X2)/(1.-X1)+
8636 & (1.-X1)/(1.-X2)).GT.(X1**2+X2**2)*RLU(0)) NJET=2
8637 IF(MSTJ(101).EQ.-1.AND.NJET.EQ.2) GOTO 100
8638
8639
8640 ELSE
8641 130 NJET=3
8642 140 Y12=SQRT(4.*CUT**2+RLU(0)*((1.-CUT)**2-4.*CUT**2))
8643 IF(LOG((Y12-CUT)/CUT).LE.RLU(0)*LOG((1.-2.*CUT)/CUT)) GOTO 140
8644 YD=SIGN(2.*CUT*((Y12-CUT)/CUT)**RLU(0)-Y12,RLU(0)-0.5)
8645 X1=1.-0.5*(Y12+YD)
8646 X2=1.-0.5*(Y12-YD)
8647 IF(4.*(1.-X1)*(1.-X2)*Y12/(1.-Y12)**2.LE.QME) NJET=2
8648 IF(MSTJ(101).EQ.-1.AND.NJET.EQ.2) GOTO 130
8649 ENDIF
8650
8651 RETURN
8652 END
8653
8654
8655
8656 SUBROUTINE LUX4JT(NJET,CUT,KFL,ECM,KFLN,X1,X2,X4,X12,X14)
8657
8658
8659 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
8660 DIMENSION WTA(4),WTB(4),WTC(4),WTD(4),WTE(4)
8661 SAVE
8662
8663
8664 PMQ=ULMASS(KFL)
8665 QME=(2.*PMQ/ECM)**2
8666 CT=LOG(1./CUT-5.)
8667 IF(MSTJ(109).EQ.0) THEN
8668 CF=4./3.
8669 CN=3.
8670 TR=2.
8671 ELSE
8672 CF=1.
8673 CN=0.
8674 TR=12.
8675 ENDIF
8676
8677
8678 100 NJET=4
8679 IT=1
8680 IF(PARJ(155).GT.RLU(0)) IT=2
8681 IF(MSTJ(101).LE.-3) IT=-MSTJ(101)-2
8682 IF(IT.EQ.1) WTMX=0.7/CUT**2
8683 IF(IT.EQ.1.AND.MSTJ(109).EQ.2) WTMX=0.6/CUT**2
8684 IF(IT.EQ.2) WTMX=0.1125*CF*TR/CUT**2
8685 ID=1
8686
8687
8688 110 Y134=3.*CUT+(1.-6.*CUT)*RLU(0)
8689 Y234=3.*CUT+(1.-6.*CUT)*RLU(0)
8690 IF(IT.EQ.1) Y34=(1.-5.*CUT)*EXP(-CT*RLU(0))
8691 IF(IT.EQ.2) Y34=CUT+(1.-6.*CUT)*RLU(0)
8692 IF(Y34.LE.Y134+Y234-1..OR.Y34.GE.Y134*Y234) GOTO 110
8693 VT=RLU(0)
8694 CP=COS(PARU(1)*RLU(0))
8695 Y14=(Y134-Y34)*VT
8696 Y13=Y134-Y14-Y34
8697 VB=Y34*(1.-Y134-Y234+Y34)/((Y134-Y34)*(Y234-Y34))
8698 Y24=0.5*(Y234-Y34)*(1.-4.*SQRT(MAX(0.,VT*(1.-VT)*VB*(1.-VB)))*
8699 &CP-(1.-2.*VT)*(1.-2.*VB))
8700 Y23=Y234-Y34-Y24
8701 Y12=1.-Y134-Y23-Y24
8702 IF(MIN(Y12,Y13,Y14,Y23,Y24).LE.CUT) GOTO 110
8703 Y123=Y12+Y13+Y23
8704 Y124=Y12+Y14+Y24
8705
8706
8707 IC=0
8708 WTTOT=0.
8709 120 IC=IC+1
8710 IF(IT.EQ.1) THEN
8711 WTA(IC)=(Y12*Y34**2-Y13*Y24*Y34+Y14*Y23*Y34+3.*Y12*Y23*Y34+
8712 & 3.*Y12*Y14*Y34+4.*Y12**2*Y34-Y13*Y23*Y24+2.*Y12*Y23*Y24-
8713 & Y13*Y14*Y24-2.*Y12*Y13*Y24+2.*Y12**2*Y24+Y14*Y23**2+2.*Y12*
8714 & Y23**2+Y14**2*Y23+4.*Y12*Y14*Y23+4.*Y12**2*Y23+2.*Y12*Y14**2+
8715 & 2.*Y12*Y13*Y14+4.*Y12**2*Y14+2.*Y12**2*Y13+2.*Y12**3)/(2.*Y13*
8716 & Y134*Y234*Y24)+(Y24*Y34+Y12*Y34+Y13*Y24-Y14*Y23+Y12*Y13)/(Y13*
8717 & Y134**2)+2.*Y23*(1.-Y13)/(Y13*Y134*Y24)+Y34/(2.*Y13*Y24)
8718 WTB(IC)=(Y12*Y24*Y34+Y12*Y14*Y34-Y13*Y24**2+Y13*Y14*Y24+2.*Y12*
8719 & Y14*Y24)/(Y13*Y134*Y23*Y14)+Y12*(1.+Y34)*Y124/(Y134*Y234*Y14*
8720 & Y24)-(2.*Y13*Y24+Y14**2+Y13*Y23+2.*Y12*Y13)/(Y13*Y134*Y14)+
8721 & Y12*Y123*Y124/(2.*Y13*Y14*Y23*Y24)
8722 WTC(IC)=-(5.*Y12*Y34**2+2.*Y12*Y24*Y34+2.*Y12*Y23*Y34+2.*Y12*
8723 & Y14*Y34+2.*Y12*Y13*Y34+4.*Y12**2*Y34-Y13*Y24**2+Y14*Y23*Y24+
8724 & Y13*Y23*Y24+Y13*Y14*Y24-Y12*Y14*Y24-Y13**2*Y24-3.*Y12*Y13*Y24-
8725 & Y14*Y23**2-Y14**2*Y23+Y13*Y14*Y23-3.*Y12*Y14*Y23-Y12*Y13*Y23)/
8726 & (4.*Y134*Y234*Y34**2)+(3.*Y12*Y34**2-3.*Y13*Y24*Y34+3.*Y12*Y24*
8727 & Y34+3.*Y14*Y23*Y34-Y13*Y24**2-Y12*Y23*Y34+6.*Y12*Y14*Y34+2.*Y12*
8728 & Y13*Y34-2.*Y12**2*Y34+Y14*Y23*Y24-3.*Y13*Y23*Y24-2.*Y13*Y14*
8729 & Y24+4.*Y12*Y14*Y24+2.*Y12*Y13*Y24+3.*Y14*Y23**2+2.*Y14**2*Y23+
8730 & 2.*Y14**2*Y12+2.*Y12**2*Y14+6.*Y12*Y14*Y23-2.*Y12*Y13**2-
8731 & 2.*Y12**2*Y13)/(4.*Y13*Y134*Y234*Y34)
8732 WTC(IC)=WTC(IC)+(2.*Y12*Y34**2-2.*Y13*Y24*Y34+Y12*Y24*Y34+
8733 & 4.*Y13*Y23*Y34+4.*Y12*Y14*Y34+2.*Y12*Y13*Y34+2.*Y12**2*Y34-
8734 & Y13*Y24**2+3.*Y14*Y23*Y24+4.*Y13*Y23*Y24-2.*Y13*Y14*Y24+
8735 & 4.*Y12*Y14*Y24+2.*Y12*Y13*Y24+2.*Y14*Y23**2+4.*Y13*Y23**2+
8736 & 2.*Y13*Y14*Y23+2.*Y12*Y14*Y23+4.*Y12*Y13*Y23+2.*Y12*Y14**2+4.*
8737 & Y12**2*Y13+4.*Y12*Y13*Y14+2.*Y12**2*Y14)/(4.*Y13*Y134*Y24*Y34)-
8738 & (Y12*Y34**2-2.*Y14*Y24*Y34-2.*Y13*Y24*Y34-Y14*Y23*Y34+Y13*Y23*
8739 & Y34+Y12*Y14*Y34+2.*Y12*Y13*Y34-2.*Y14**2*Y24-4.*Y13*Y14*Y24-
8740 & 4.*Y13**2*Y24-Y14**2*Y23-Y13**2*Y23+Y12*Y13*Y14-Y12*Y13**2)/
8741 & (2.*Y13*Y34*Y134**2)+(Y12*Y34**2-4.*Y14*Y24*Y34-2.*Y13*Y24*Y34-
8742 & 2.*Y14*Y23*Y34-4.*Y13*Y23*Y34-4.*Y12*Y14*Y34-4.*Y12*Y13*Y34-
8743 & 2.*Y13*Y14*Y24+2.*Y13**2*Y24+2.*Y14**2*Y23-2.*Y13*Y14*Y23-
8744 & Y12*Y14**2-6.*Y12*Y13*Y14-Y12*Y13**2)/(4.*Y34**2*Y134**2)
8745 WTTOT=WTTOT+Y34*CF*(CF*WTA(IC)+(CF-0.5*CN)*WTB(IC)+CN*WTC(IC))/
8746 & 8.
8747 ELSE
8748 WTD(IC)=(Y13*Y23*Y34+Y12*Y23*Y34-Y12**2*Y34+Y13*Y23*Y24+2.*Y12*
8749 & Y23*Y24-Y14*Y23**2+Y12*Y13*Y24+Y12*Y14*Y23+Y12*Y13*Y14)/(Y13**2*
8750 & Y123**2)-(Y12*Y34**2-Y13*Y24*Y34+Y12*Y24*Y34-Y14*Y23*Y34-Y12*
8751 & Y23*Y34-Y13*Y24**2+Y14*Y23*Y24-Y13*Y23*Y24-Y13**2*Y24+Y14*
8752 & Y23**2)/(Y13**2*Y123*Y134)+(Y13*Y14*Y12+Y34*Y14*Y12-Y34**2*Y12+
8753 & Y13*Y14*Y24+2.*Y34*Y14*Y24-Y23*Y14**2+Y34*Y13*Y24+Y34*Y23*Y14+
8754 & Y34*Y13*Y23)/(Y13**2*Y134**2)-(Y34*Y12**2-Y13*Y24*Y12+Y34*Y24*
8755 & Y12-Y23*Y14*Y12-Y34*Y14*Y12-Y13*Y24**2+Y23*Y14*Y24-Y13*Y14*Y24-
8756 & Y13**2*Y24+Y23*Y14**2)/(Y13**2*Y134*Y123)
8757 WTE(IC)=(Y12*Y34*(Y23-Y24+Y14+Y13)+Y13*Y24**2-Y14*Y23*Y24+Y13*
8758 & Y23*Y24+Y13*Y14*Y24+Y13**2*Y24-Y14*Y23*(Y14+Y23+Y13))/(Y13*Y23*
8759 & Y123*Y134)-Y12*(Y12*Y34-Y23*Y24-Y13*Y24-Y14*Y23-Y14*Y13)/(Y13*
8760 & Y23*Y123**2)-(Y14+Y13)*(Y24+Y23)*Y34/(Y13*Y23*Y134*Y234)+
8761 & (Y12*Y34*(Y14-Y24+Y23+Y13)+Y13*Y24**2-Y23*Y14*Y24+Y13*Y14*Y24+
8762 & Y13*Y23*Y24+Y13**2*Y24-Y23*Y14*(Y14+Y23+Y13))/(Y13*Y14*Y134*
8763 & Y123)-Y34*(Y34*Y12-Y14*Y24-Y13*Y24-Y23*Y14-Y23*Y13)/(Y13*Y14*
8764 & Y134**2)-(Y23+Y13)*(Y24+Y14)*Y12/(Y13*Y14*Y123*Y124)
8765 WTTOT=WTTOT+CF*(TR*WTD(IC)+(CF-0.5*CN)*WTE(IC))/16.
8766 ENDIF
8767
8768
8769 130 IF(IC.EQ.1.OR.IC.EQ.3.OR.ID.EQ.2.OR.ID.EQ.3) THEN
8770 YSAV=Y13
8771 Y13=Y14
8772 Y14=YSAV
8773 YSAV=Y23
8774 Y23=Y24
8775 Y24=YSAV
8776 YSAV=Y123
8777 Y123=Y124
8778 Y124=YSAV
8779 ENDIF
8780 IF(IC.EQ.2.OR.IC.EQ.4.OR.ID.EQ.3.OR.ID.EQ.4) THEN
8781 YSAV=Y13
8782 Y13=Y23
8783 Y23=YSAV
8784 YSAV=Y14
8785 Y14=Y24
8786 Y24=YSAV
8787 YSAV=Y134
8788 Y134=Y234
8789 Y234=YSAV
8790 ENDIF
8791 IF(IC.LE.3) GOTO 120
8792 IF(ID.EQ.1.AND.WTTOT.LT.RLU(0)*WTMX) GOTO 110
8793 IC=5
8794
8795
8796 IF(IT.EQ.1) THEN
8797 IF(MSTJ(109).EQ.0.AND.ID.EQ.1) THEN
8798 PARJ(156)=Y34*(2.*(WTA(1)+WTA(2)+WTA(3)+WTA(4))+4.*(WTC(1)+
8799 & WTC(2)+WTC(3)+WTC(4)))/(9.*WTTOT)
8800 IF(WTA(2)+WTA(4)+2.*(WTC(2)+WTC(4)).GT.RLU(0)*(WTA(1)+WTA(2)+
8801 & WTA(3)+WTA(4)+2.*(WTC(1)+WTC(2)+WTC(3)+WTC(4)))) ID=2
8802 IF(ID.EQ.2) GOTO 130
8803 ELSEIF(MSTJ(109).EQ.2.AND.ID.EQ.1) THEN
8804 PARJ(156)=Y34*(WTA(1)+WTA(2)+WTA(3)+WTA(4))/(8.*WTTOT)
8805 IF(WTA(2)+WTA(4).GT.RLU(0)*(WTA(1)+WTA(2)+WTA(3)+WTA(4))) ID=2
8806 IF(ID.EQ.2) GOTO 130
8807 ENDIF
8808 MSTJ(120)=3
8809 IF(MSTJ(109).EQ.0.AND.0.5*Y34*(WTC(1)+WTC(2)+WTC(3)+WTC(4)).GT.
8810 & RLU(0)*WTTOT) MSTJ(120)=4
8811 KFLN=21
8812
8813
8814 IF(Y12.LE.CUT+QME) NJET=2
8815 IF(NJET.EQ.2) GOTO 150
8816 Q12=0.5*(1.-SQRT(1.-QME/Y12))
8817 X1=1.-(1.-Q12)*Y234-Q12*Y134
8818 X4=1.-(1.-Q12)*Y134-Q12*Y234
8819 X2=1.-Y124
8820 X12=(1.-Q12)*Y13+Q12*Y23
8821 X14=Y12-0.5*QME
8822 IF(Y134*Y234/((1.-X1)*(1.-X4)).LE.RLU(0)) NJET=2
8823
8824
8825 ELSE
8826 IF(ID.EQ.1) THEN
8827 WTR=RLU(0)*(WTD(1)+WTD(2)+WTD(3)+WTD(4))
8828 IF(WTR.LT.WTD(2)+WTD(3)+WTD(4)) ID=2
8829 IF(WTR.LT.WTD(3)+WTD(4)) ID=3
8830 IF(WTR.LT.WTD(4)) ID=4
8831 IF(ID.GE.2) GOTO 130
8832 ENDIF
8833 MSTJ(120)=5
8834 PARJ(156)=CF*TR*(WTD(1)+WTD(2)+WTD(3)+WTD(4))/(16.*WTTOT)
8835 140 KFLN=1+INT(5.*RLU(0))
8836 IF(KFLN.NE.KFL.AND.0.2*PARJ(156).LE.RLU(0)) GOTO 140
8837 IF(KFLN.EQ.KFL.AND.1.-0.8*PARJ(156).LE.RLU(0)) GOTO 140
8838 IF(KFLN.GT.MSTJ(104)) NJET=2
8839 PMQN=ULMASS(KFLN)
8840 QMEN=(2.*PMQN/ECM)**2
8841
8842
8843 IF(Y24.LE.CUT+QME.OR.Y13.LE.1.1*QMEN) NJET=2
8844 IF(NJET.EQ.2) GOTO 150
8845 Q24=0.5*(1.-SQRT(1.-QME/Y24))
8846 Q13=0.5*(1.-SQRT(1.-QMEN/Y13))
8847 X1=1.-(1.-Q24)*Y123-Q24*Y134
8848 X4=1.-(1.-Q24)*Y134-Q24*Y123
8849 X2=1.-(1.-Q13)*Y234-Q13*Y124
8850 X12=(1.-Q24)*((1.-Q13)*Y14+Q13*Y34)+Q24*((1.-Q13)*Y12+Q13*Y23)
8851 X14=Y24-0.5*QME
8852 X34=(1.-Q24)*((1.-Q13)*Y23+Q13*Y12)+Q24*((1.-Q13)*Y34+Q13*Y14)
8853 IF(PMQ**2+PMQN**2+MIN(X12,X34)*ECM**2.LE.
8854 & (PARJ(127)+PMQ+PMQN)**2) NJET=2
8855 IF(Y123*Y134/((1.-X1)*(1.-X4)).LE.RLU(0)) NJET=2
8856 ENDIF
8857 150 IF(MSTJ(101).LE.-2.AND.NJET.EQ.2) GOTO 100
8858
8859 RETURN
8860 END
8861
8862
8863
8864 SUBROUTINE LUXDIF(NC,NJET,KFL,ECM,CHI,THE,PHI)
8865
8866
8867 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
8868 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
8869 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
8870 SAVE
8871
8872
8873 QF=KCHG(KFL,1)/3.
8874 POLL=1.-PARJ(131)*PARJ(132)
8875 POLD=PARJ(132)-PARJ(131)
8876 IF(MSTJ(102).LE.1.OR.MSTJ(109).EQ.1) THEN
8877 HF1=POLL
8878 HF2=0.
8879 HF3=PARJ(133)**2
8880 HF4=0.
8881
8882
8883 ELSE
8884 SFF=1./(16.*PARU(102)*(1.-PARU(102)))
8885 SFW=ECM**4/((ECM**2-PARJ(123)**2)**2+(PARJ(123)*PARJ(124))**2)
8886 SFI=SFW*(1.-(PARJ(123)/ECM)**2)
8887 AE=-1.
8888 VE=4.*PARU(102)-1.
8889 AF=SIGN(1.,QF)
8890 VF=AF-4.*QF*PARU(102)
8891 HF1=QF**2*POLL-2.*QF*VF*SFI*SFF*(VE*POLL-AE*POLD)+
8892 & (VF**2+AF**2)*SFW*SFF**2*((VE**2+AE**2)*POLL-2.*VE*AE*POLD)
8893 HF2=-2.*QF*AF*SFI*SFF*(AE*POLL-VE*POLD)+2.*VF*AF*SFW*SFF**2*
8894 & (2.*VE*AE*POLL-(VE**2+AE**2)*POLD)
8895 HF3=PARJ(133)**2*(QF**2-2.*QF*VF*SFI*SFF*VE+(VF**2+AF**2)*
8896 & SFW*SFF**2*(VE**2-AE**2))
8897 HF4=-PARJ(133)**2*2.*QF*VF*SFW*(PARJ(123)*PARJ(124)/ECM**2)*
8898 & SFF*AE
8899 ENDIF
8900
8901
8902 SQ2=SQRT(2.)
8903 QME=0.
8904 IF(MSTJ(103).GE.4.AND.IABS(MSTJ(101)).LE.1.AND.MSTJ(102).LE.1.AND.
8905 &MSTJ(109).NE.1) QME=(2.*ULMASS(KFL)/ECM)**2
8906 IF(NJET.EQ.2) THEN
8907 SIGU=4.*SQRT(1.-QME)
8908 SIGL=2.*QME*SQRT(1.-QME)
8909 SIGT=0.
8910 SIGI=0.
8911 SIGA=0.
8912 SIGP=4.
8913
8914
8915 ELSE
8916 IF(NJET.EQ.3) THEN
8917 X1=2.*P(NC+1,4)/ECM
8918 X2=2.*P(NC+3,4)/ECM
8919 ELSE
8920 ECMR=P(NC+1,4)+P(NC+4,4)+SQRT((P(NC+2,1)+P(NC+3,1))**2+
8921 & (P(NC+2,2)+P(NC+3,2))**2+(P(NC+2,3)+P(NC+3,3))**2)
8922 X1=2.*P(NC+1,4)/ECMR
8923 X2=2.*P(NC+4,4)/ECMR
8924 ENDIF
8925
8926
8927 XQ=(1.-X1)/(1.-X2)
8928 CT12=(X1*X2-2.*X1-2.*X2+2.+QME)/SQRT((X1**2-QME)*(X2**2-QME))
8929 ST12=SQRT(1.-CT12**2)
8930 IF(MSTJ(109).NE.1) THEN
8931 SIGU=2.*X1**2+X2**2*(1.+CT12**2)-QME*(3.+CT12**2-X1-X2)-
8932 & QME*X1/XQ+0.5*QME*((X2**2-QME)*ST12**2-2.*X2)*XQ
8933 SIGL=(X2*ST12)**2-QME*(3.-CT12**2-2.5*(X1+X2)+X1*X2+QME)+
8934 & 0.5*QME*(X1**2-X1-QME)/XQ+0.5*QME*((X2**2-QME)*CT12**2-X2)*XQ
8935 SIGT=0.5*(X2**2-QME-0.5*QME*(X2**2-QME)/XQ)*ST12**2
8936 SIGI=((1.-0.5*QME*XQ)*(X2**2-QME)*ST12*CT12+QME*(1.-X1-X2+
8937 & 0.5*X1*X2+0.5*QME)*ST12/CT12)/SQ2
8938 SIGA=X2**2*ST12/SQ2
8939 SIGP=2.*(X1**2-X2**2*CT12)
8940
8941
8942 ELSE
8943 SIGU=2.*(2.-X1-X2)**2-(X2*ST12)**2
8944 SIGL=(X2*ST12)**2
8945 SIGT=0.5*SIGL
8946 SIGI=-(2.-X1-X2)*X2*ST12/SQ2
8947 SIGA=0.
8948 SIGP=0.
8949 ENDIF
8950 ENDIF
8951
8952
8953 HF1A=ABS(HF1)
8954 HF2A=ABS(HF2)
8955 HF3A=ABS(HF3)
8956 HF4A=ABS(HF4)
8957 SIGMAX=(2.*HF1A+HF3A+HF4A)*ABS(SIGU)+2.*(HF1A+HF3A+HF4A)*
8958 &ABS(SIGL)+2.*(HF1A+2.*HF3A+2.*HF4A)*ABS(SIGT)+2.*SQ2*
8959 &(HF1A+2.*HF3A+2.*HF4A)*ABS(SIGI)+4.*SQ2*HF2A*ABS(SIGA)+
8960 &2.*HF2A*ABS(SIGP)
8961
8962
8963 100 CHI=PARU(2)*RLU(0)
8964 CTHE=2.*RLU(0)-1.
8965 PHI=PARU(2)*RLU(0)
8966 CCHI=COS(CHI)
8967 SCHI=SIN(CHI)
8968 C2CHI=COS(2.*CHI)
8969 S2CHI=SIN(2.*CHI)
8970 THE=ACOS(CTHE)
8971 STHE=SIN(THE)
8972 C2PHI=COS(2.*(PHI-PARJ(134)))
8973 S2PHI=SIN(2.*(PHI-PARJ(134)))
8974 SIG=((1.+CTHE**2)*HF1+STHE**2*(C2PHI*HF3-S2PHI*HF4))*SIGU+
8975 &2.*(STHE**2*HF1-STHE**2*(C2PHI*HF3-S2PHI*HF4))*SIGL+
8976 &2.*(STHE**2*C2CHI*HF1+((1.+CTHE**2)*C2CHI*C2PHI-2.*CTHE*S2CHI*
8977 &S2PHI)*HF3-((1.+CTHE**2)*C2CHI*S2PHI+2.*CTHE*S2CHI*C2PHI)*HF4)*
8978 &SIGT-2.*SQ2*(2.*STHE*CTHE*CCHI*HF1-2.*STHE*(CTHE*CCHI*C2PHI-
8979 &SCHI*S2PHI)*HF3+2.*STHE*(CTHE*CCHI*S2PHI+SCHI*C2PHI)*HF4)*SIGI+
8980 &4.*SQ2*STHE*CCHI*HF2*SIGA+2.*CTHE*HF2*SIGP
8981 IF(SIG.LT.SIGMAX*RLU(0)) GOTO 100
8982
8983 RETURN
8984 END
8985
8986
8987
8988 SUBROUTINE LUONIA(KFL,ECM)
8989
8990
8991
8992 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
8993 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
8994 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
8995 SAVE
8996
8997
8998 IF(MSTU(12).GE.1) CALL LULIST(0)
8999 IF(KFL.LT.0.OR.KFL.GT.8) THEN
9000 CALL LUERRM(16,'(LUONIA:) called with unknown flavour code')
9001 IF(MSTU(21).GE.1) RETURN
9002 ENDIF
9003 IF(ECM.LT.PARJ(127)+2.02*PARF(101)) THEN
9004 CALL LUERRM(16,'(LUONIA:) called with too small CM energy')
9005 IF(MSTU(21).GE.1) RETURN
9006 ENDIF
9007
9008
9009 NC=0
9010 IF(MSTJ(115).GE.2) THEN
9011 NC=NC+2
9012 CALL LU1ENT(NC-1,11,0.5*ECM,0.,0.)
9013 K(NC-1,1)=21
9014 CALL LU1ENT(NC,-11,0.5*ECM,PARU(1),0.)
9015 K(NC,1)=21
9016 ENDIF
9017 KFLC=IABS(KFL)
9018 IF(MSTJ(115).GE.3.AND.KFLC.GE.5) THEN
9019 NC=NC+1
9020 KF=110*KFLC+3
9021 MSTU10=MSTU(10)
9022 MSTU(10)=1
9023 P(NC,5)=ECM
9024 CALL LU1ENT(NC,KF,ECM,0.,0.)
9025 K(NC,1)=21
9026 K(NC,3)=1
9027 MSTU(10)=MSTU10
9028 ENDIF
9029
9030
9031 NTRY=0
9032 100 X1=RLU(0)
9033 X2=RLU(0)
9034 X3=2.-X1-X2
9035 IF(X3.GE.1..OR.((1.-X1)/(X2*X3))**2+((1.-X2)/(X1*X3))**2+
9036 &((1.-X3)/(X1*X2))**2.LE.2.*RLU(0)) GOTO 100
9037 NTRY=NTRY+1
9038 NJET=3
9039 IF(MSTJ(101).LE.4) CALL LU3ENT(NC+1,21,21,21,ECM,X1,X3)
9040 IF(MSTJ(101).GE.5) CALL LU3ENT(-(NC+1),21,21,21,ECM,X1,X3)
9041
9042
9043 MSTU(111)=MSTJ(108)
9044 IF(MSTJ(108).EQ.2.AND.(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.1))
9045 &MSTU(111)=1
9046 PARU(112)=PARJ(121)
9047 IF(MSTU(111).EQ.2) PARU(112)=PARJ(122)
9048 QF=0.
9049 IF(KFLC.NE.0) QF=KCHG(KFLC,1)/3.
9050 RGAM=7.2*QF**2*PARU(101)/ULALPS(ECM**2)
9051 MK=0
9052 ECMC=ECM
9053 IF(RLU(0).GT.RGAM/(1.+RGAM)) THEN
9054 IF(1.-MAX(X1,X2,X3).LE.MAX((PARJ(126)/ECM)**2,PARJ(125)))
9055 & NJET=2
9056 IF(NJET.EQ.2.AND.MSTJ(101).LE.4) CALL LU2ENT(NC+1,21,21,ECM)
9057 IF(NJET.EQ.2.AND.MSTJ(101).GE.5) CALL LU2ENT(-(NC+1),21,21,ECM)
9058 ELSE
9059 MK=1
9060 ECMC=SQRT(1.-X1)*ECM
9061 IF(ECMC.LT.2.*PARJ(127)) GOTO 100
9062 K(NC+1,1)=1
9063 K(NC+1,2)=22
9064 K(NC+1,4)=0
9065 K(NC+1,5)=0
9066 IF(MSTJ(101).GE.5) K(NC+2,4)=MSTU(5)*(NC+3)
9067 IF(MSTJ(101).GE.5) K(NC+2,5)=MSTU(5)*(NC+3)
9068 IF(MSTJ(101).GE.5) K(NC+3,4)=MSTU(5)*(NC+2)
9069 IF(MSTJ(101).GE.5) K(NC+3,5)=MSTU(5)*(NC+2)
9070 NJET=2
9071 IF(ECMC.LT.4.*PARJ(127)) THEN
9072 MSTU10=MSTU(10)
9073 MSTU(10)=1
9074 P(NC+2,5)=ECMC
9075 CALL LU1ENT(NC+2,83,0.5*(X2+X3)*ECM,PARU(1),0.)
9076 MSTU(10)=MSTU10
9077 NJET=0
9078 ENDIF
9079 ENDIF
9080 DO 110 IP=NC+1,N
9081 110 K(IP,3)=K(IP,3)+(MSTJ(115)/2)+(KFLC/5)*(MSTJ(115)/3)*(NC-1)
9082
9083
9084 IF(MSTJ(106).EQ.1) THEN
9085 SQ2=SQRT(2.)
9086 HF1=1.-PARJ(131)*PARJ(132)
9087 HF3=PARJ(133)**2
9088 CT13=(X1*X3-2.*X1-2.*X3+2.)/(X1*X3)
9089 ST13=SQRT(1.-CT13**2)
9090 SIGL=0.5*X3**2*((1.-X2)**2+(1.-X3)**2)*ST13**2
9091 SIGU=(X1*(1.-X1))**2+(X2*(1.-X2))**2+(X3*(1.-X3))**2-SIGL
9092 SIGT=0.5*SIGL
9093 SIGI=(SIGL*CT13/ST13+0.5*X1*X3*(1.-X2)**2*ST13)/SQ2
9094 SIGMAX=(2.*HF1+HF3)*ABS(SIGU)+2.*(HF1+HF3)*ABS(SIGL)+2.*(HF1+
9095 & 2.*HF3)*ABS(SIGT)+2.*SQ2*(HF1+2.*HF3)*ABS(SIGI)
9096
9097
9098 120 CHI=PARU(2)*RLU(0)
9099 CTHE=2.*RLU(0)-1.
9100 PHI=PARU(2)*RLU(0)
9101 CCHI=COS(CHI)
9102 SCHI=SIN(CHI)
9103 C2CHI=COS(2.*CHI)
9104 S2CHI=SIN(2.*CHI)
9105 THE=ACOS(CTHE)
9106 STHE=SIN(THE)
9107 C2PHI=COS(2.*(PHI-PARJ(134)))
9108 S2PHI=SIN(2.*(PHI-PARJ(134)))
9109 SIG=((1.+CTHE**2)*HF1+STHE**2*C2PHI*HF3)*SIGU+2.*(STHE**2*HF1-
9110 & STHE**2*C2PHI*HF3)*SIGL+2.*(STHE**2*C2CHI*HF1+((1.+CTHE**2)*
9111 & C2CHI*C2PHI-2.*CTHE*S2CHI*S2PHI)*HF3)*SIGT-2.*SQ2*(2.*STHE*CTHE*
9112 & CCHI*HF1-2.*STHE*(CTHE*CCHI*C2PHI-SCHI*S2PHI)*HF3)*SIGI
9113 IF(SIG.LT.SIGMAX*RLU(0)) GOTO 120
9114 CALL LUDBRB(NC+1,N,0.,CHI,0D0,0D0,0D0)
9115 CALL LUDBRB(NC+1,N,THE,PHI,0D0,0D0,0D0)
9116 ENDIF
9117
9118
9119 IF(MSTJ(101).GE.5.AND.NJET.GE.2) THEN
9120 CALL LUSHOW(NC+MK+1,-NJET,ECMC)
9121 MSTJ14=MSTJ(14)
9122 IF(MSTJ(105).EQ.-1) MSTJ(14)=0
9123 IF(MSTJ(105).GE.0) MSTU(28)=0
9124 CALL LUPREP(0)
9125 MSTJ(14)=MSTJ14
9126 IF(MSTJ(105).GE.0.AND.MSTU(28).NE.0) GOTO 100
9127 ENDIF
9128
9129
9130 IF(MSTJ(105).EQ.1) CALL LUEXEC
9131 MSTU(161)=110*KFLC+3
9132 MSTU(162)=0
9133
9134 RETURN
9135 END
9136
9137
9138
9139 SUBROUTINE LUHEPC(MCONV)
9140
9141
9142
9143 PARAMETER (NMXHEP=9000)
9144 COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP),
9145 &JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP)
9146 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
9147 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
9148 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
9149 SAVE
9150
9151
9152 IF(MCONV.EQ.1) THEN
9153 NEVHEP=0
9154 IF(N.GT.NMXHEP) CALL LUERRM(8,
9155 & '(LUHEPC:) no more space in /HEPEVT/')
9156 NHEP=MIN(N,NMXHEP)
9157 DO 140 I=1,NHEP
9158 ISTHEP(I)=0
9159 IF(K(I,1).GE.1.AND.K(I,1).LE.10) ISTHEP(I)=1
9160 IF(K(I,1).GE.11.AND.K(I,1).LE.20) ISTHEP(I)=2
9161 IF(K(I,1).GE.21.AND.K(I,1).LE.30) ISTHEP(I)=3
9162 IF(K(I,1).GE.31.AND.K(I,1).LE.100) ISTHEP(I)=K(I,1)
9163 IDHEP(I)=K(I,2)
9164 JMOHEP(1,I)=K(I,3)
9165 JMOHEP(2,I)=0
9166 IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) THEN
9167 JDAHEP(1,I)=K(I,4)
9168 JDAHEP(2,I)=K(I,5)
9169 ELSE
9170 JDAHEP(1,I)=0
9171 JDAHEP(2,I)=0
9172 ENDIF
9173 DO 100 J=1,5
9174 100 PHEP(J,I)=P(I,J)
9175 DO 110 J=1,4
9176 110 VHEP(J,I)=V(I,J)
9177
9178
9179 IF(K(I,2).GE.91.AND.K(I,2).LE.93) THEN
9180 I1=K(I,3)-1
9181 120 I1=I1+1
9182 IF(I1.GE.I) CALL LUERRM(8,
9183 & '(LUHEPC:) translation of inconsistent event history')
9184 IF(I1.LT.I.AND.K(I1,1).NE.1.AND.K(I1,1).NE.11) GOTO 120
9185 KC=LUCOMP(K(I1,2))
9186 IF(I1.LT.I.AND.KC.EQ.0) GOTO 120
9187 IF(I1.LT.I.AND.KCHG(KC,2).EQ.0) GOTO 120
9188 JMOHEP(2,I)=I1
9189 ELSEIF(K(I,2).EQ.94) THEN
9190 NJET=2
9191 IF(NHEP.GE.I+3.AND.K(I+3,3).LE.I) NJET=3
9192 IF(NHEP.GE.I+4.AND.K(I+4,3).LE.I) NJET=4
9193 JMOHEP(2,I)=MOD(K(I+NJET,4)/MSTU(5),MSTU(5))
9194 IF(JMOHEP(2,I).EQ.JMOHEP(1,I)) JMOHEP(2,I)=
9195 & MOD(K(I+1,4)/MSTU(5),MSTU(5))
9196 ENDIF
9197
9198
9199 IF(K(I,2).EQ.94.AND.MSTU(16).NE.2) THEN
9200 DO 130 I1=JDAHEP(1,I),JDAHEP(2,I)
9201 I2=MOD(K(I1,4)/MSTU(5),MSTU(5))
9202 130 JDAHEP(1,I2)=I
9203 ENDIF
9204 IF(K(I,2).GE.91.AND.K(I,2).LE.94) GOTO 140
9205 I1=JMOHEP(1,I)
9206 IF(I1.LE.0.OR.I1.GT.NHEP) GOTO 140
9207 IF(K(I1,1).NE.13.AND.K(I1,1).NE.14) GOTO 140
9208 IF(JDAHEP(1,I1).EQ.0) THEN
9209 JDAHEP(1,I1)=I
9210 ELSE
9211 JDAHEP(2,I1)=I
9212 ENDIF
9213 140 CONTINUE
9214 DO 150 I=1,NHEP
9215 IF(K(I,1).NE.13.AND.K(I,1).NE.14) GOTO 150
9216 IF(JDAHEP(2,I).EQ.0) JDAHEP(2,I)=JDAHEP(1,I)
9217 150 CONTINUE
9218
9219
9220 ELSE
9221 IF(NHEP.GT.MSTU(4)) CALL LUERRM(8,
9222 & '(LUHEPC:) no more space in /LUJETS/')
9223 N=MIN(NHEP,MSTU(4))
9224 NKQ=0
9225 KQSUM=0
9226 DO 180 I=1,N
9227 K(I,1)=0
9228 IF(ISTHEP(I).EQ.1) K(I,1)=1
9229 IF(ISTHEP(I).EQ.2) K(I,1)=11
9230 IF(ISTHEP(I).EQ.3) K(I,1)=21
9231 K(I,2)=IDHEP(I)
9232 K(I,3)=JMOHEP(1,I)
9233 K(I,4)=JDAHEP(1,I)
9234 K(I,5)=JDAHEP(2,I)
9235 DO 160 J=1,5
9236 160 P(I,J)=PHEP(J,I)
9237 DO 170 J=1,4
9238 170 V(I,J)=VHEP(J,I)
9239 V(I,5)=0.
9240 IF(ISTHEP(I).EQ.2.AND.PHEP(4,I).GT.PHEP(5,I)) THEN
9241 I1=JDAHEP(1,I)
9242 IF(I1.GT.0.AND.I1.LE.NHEP) V(I,5)=(VHEP(4,I1)-VHEP(4,I))*
9243 & PHEP(5,I)/PHEP(4,I)
9244 ENDIF
9245
9246
9247 IF(ISTHEP(I).EQ.1) THEN
9248 KC=LUCOMP(K(I,2))
9249 KQ=0
9250 IF(KC.NE.0) KQ=KCHG(KC,2)*ISIGN(1,K(I,2))
9251 IF(KQ.NE.0) NKQ=NKQ+1
9252 IF(KQ.NE.2) KQSUM=KQSUM+KQ
9253 IF(KQ.NE.0.AND.KQSUM.NE.0) THEN
9254 K(I,1)=2
9255 ELSEIF(KQ.EQ.2.AND.I.LT.N) THEN
9256 IF(K(I+1,2).EQ.21) K(I,1)=2
9257 ENDIF
9258 ENDIF
9259 180 CONTINUE
9260 IF(NKQ.EQ.1.OR.KQSUM.NE.0) CALL LUERRM(8,
9261 & '(LUHEPC:) input parton configuration not colour singlet')
9262 ENDIF
9263
9264 END
9265
9266
9267
9268 SUBROUTINE LUTEST(MTEST)
9269
9270
9271
9272 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
9273 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
9274 DIMENSION PSUM(5),PINI(6),PFIN(6)
9275 SAVE
9276
9277
9278 IF(MTEST.GE.1) CALL LUTABU(20)
9279 NERR=0
9280 DO 170 IEV=1,600
9281
9282
9283 MSTJ(1)=1
9284 MSTJ(3)=0
9285 MSTJ(11)=1
9286 MSTJ(42)=2
9287 MSTJ(43)=4
9288 MSTJ(44)=2
9289 PARJ(17)=0.1
9290 PARJ(22)=1.5
9291 PARJ(43)=1.
9292 PARJ(54)=-0.05
9293 MSTJ(101)=5
9294 MSTJ(104)=5
9295 MSTJ(105)=0
9296 MSTJ(107)=1
9297 IF(IEV.EQ.301.OR.IEV.EQ.351.OR.IEV.EQ.401) MSTJ(116)=3
9298
9299
9300 IF(IEV.LE.50) THEN
9301 ITY=(IEV+9)/10
9302 MSTJ(3)=-1
9303 IF(ITY.EQ.3.OR.ITY.EQ.4) MSTJ(11)=2
9304 IF(ITY.EQ.1) CALL LU1ENT(1,1,15.,0.,0.)
9305 IF(ITY.EQ.2) CALL LU1ENT(1,3101,15.,0.,0.)
9306 IF(ITY.EQ.3) CALL LU1ENT(1,-2203,15.,0.,0.)
9307 IF(ITY.EQ.4) CALL LU1ENT(1,-4,30.,0.,0.)
9308 IF(ITY.EQ.5) CALL LU1ENT(1,21,15.,0.,0.)
9309
9310
9311 ELSEIF(IEV.LE.130) THEN
9312 ITY=(IEV-41)/10
9313 IF(ITY.EQ.1) CALL LU2ENT(1,1,-1,40.)
9314 IF(ITY.EQ.2) CALL LU2ENT(1,4,-4,30.)
9315 IF(ITY.EQ.3) CALL LU2ENT(1,2,2103,100.)
9316 IF(ITY.EQ.4) CALL LU2ENT(1,21,21,40.)
9317 IF(ITY.EQ.5) CALL LU3ENT(1,2101,21,-3203,30.,0.6,0.8)
9318 IF(ITY.EQ.6) CALL LU3ENT(1,5,21,-5,40.,0.9,0.8)
9319 IF(ITY.EQ.7) CALL LU3ENT(1,21,21,21,60.,0.7,0.5)
9320 IF(ITY.EQ.8) CALL LU4ENT(1,2,21,21,-2,40.,0.4,0.64,0.6,0.12,0.2)
9321
9322
9323 ELSEIF(IEV.LE.200) THEN
9324 ITY=1+(IEV-131)/16
9325 MSTJ(2)=1+MOD(IEV-131,4)
9326 MSTJ(3)=1+MOD((IEV-131)/4,4)
9327 IF(ITY.EQ.1) CALL LU2ENT(1,4,-5,40.)
9328 IF(ITY.EQ.2) CALL LU3ENT(1,3,21,-3,40.,0.9,0.4)
9329 IF(ITY.EQ.3) CALL LU4ENT(1,2,21,21,-2,40.,0.4,0.64,0.6,0.12,0.2)
9330 IF(ITY.GE.4) CALL LU4ENT(1,2,-3,3,-2,40.,0.4,0.64,0.6,0.12,0.2)
9331
9332
9333 ELSEIF(IEV.LE.300) THEN
9334 100 DO 110 J=1,5
9335 110 PSUM(J)=0.
9336 NJET=2.+6.*RLU(0)
9337 DO 120 I=1,NJET
9338 KFL=21
9339 IF(I.EQ.1) KFL=INT(1.+4.*RLU(0))
9340 IF(I.EQ.NJET) KFL=-INT(1.+4.*RLU(0))
9341 EJET=5.+20.*RLU(0)
9342 THETA=ACOS(2.*RLU(0)-1.)
9343 PHI=6.2832*RLU(0)
9344 IF(I.LT.NJET) CALL LU1ENT(-I,KFL,EJET,THETA,PHI)
9345 IF(I.EQ.NJET) CALL LU1ENT(I,KFL,EJET,THETA,PHI)
9346 IF(I.EQ.1.OR.I.EQ.NJET) PSUM(5)=PSUM(5)+ULMASS(KFL)
9347 DO 120 J=1,4
9348 120 PSUM(J)=PSUM(J)+P(I,J)
9349 IF(PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-PSUM(3)**2.LT.
9350 & (PSUM(5)+PARJ(32))**2) GOTO 100
9351
9352
9353 ELSEIF(IEV.LE.350) THEN
9354 MSTJ(101)=2
9355 CALL LUEEVT(0,40.)
9356
9357
9358 ELSEIF(IEV.LE.400) THEN
9359 MSTJ(42)=1+MOD(IEV,2)
9360 MSTJ(43)=1+MOD(IEV/2,4)
9361 MSTJ(44)=MOD(IEV/8,3)
9362 CALL LUEEVT(0,90.)
9363
9364
9365 ELSEIF(IEV.LE.450) THEN
9366 MSTJ(104)=6
9367 CALL LUEEVT(0,500.)
9368
9369
9370 ELSEIF(IEV.LE.500) THEN
9371 CALL LUONIA(5,9.46)
9372
9373
9374 ELSEIF(IEV.LE.560) THEN
9375 ITY=IEV-501
9376 KFLS=2*(ITY/20)+1
9377 KFLB=8-MOD(ITY/5,4)
9378 KFLC=KFLB-MOD(ITY,5)
9379 CALL LU1ENT(1,100*KFLB+10*KFLC+KFLS,0.,0.,0.)
9380
9381
9382 ELSEIF(IEV.LE.600) THEN
9383 ITY=IEV-561
9384 KFLS=2*(ITY/20)+2
9385 KFLA=8-MOD(ITY/5,4)
9386 KFLB=KFLA-MOD(ITY,5)
9387 KFLC=MAX(1,KFLB-1)
9388 CALL LU1ENT(1,1000*KFLA+100*KFLB+10*KFLC+KFLS,0.,0.,0.)
9389 ENDIF
9390
9391
9392 DO 130 J=1,4
9393 130 PINI(J)=PLU(0,J)
9394 PINI(6)=PLU(0,6)
9395 CALL LUEXEC
9396 DO 140 J=1,4
9397 140 PFIN(J)=PLU(0,J)
9398 PFIN(6)=PLU(0,6)
9399
9400
9401
9402 MERR=0
9403 IF(IEV.LE.50) THEN
9404 IF((PFIN(1)-PINI(1))**2+(PFIN(2)-PINI(2))**2.GE.4.) MERR=MERR+1
9405 EPZREM=PINI(4)+PINI(3)-PFIN(4)-PFIN(3)
9406 IF(EPZREM.LT.0..OR.EPZREM.GT.2.*PARJ(31)) MERR=MERR+1
9407 IF(ABS(PFIN(6)-PINI(6)).GT.2.1) MERR=MERR+1
9408 ELSE
9409 DO 150 J=1,4
9410 150 IF(ABS(PFIN(J)-PINI(J)).GT.0001*PINI(4)) MERR=MERR+1
9411 IF(ABS(PFIN(6)-PINI(6)).GT.0.1) MERR=MERR+1
9412 ENDIF
9413 IF(MERR.NE.0) WRITE(MSTU(11),1000) (PINI(J),J=1,4),PINI(6),
9414 &(PFIN(J),J=1,4),PFIN(6)
9415
9416
9417
9418 DO 160 I=1,N
9419 IF(K(I,1).GT.20) GOTO 160
9420 IF(LUCOMP(K(I,2)).EQ.0) THEN
9421 WRITE(MSTU(11),1100) I
9422 MERR=MERR+1
9423 ENDIF
9424 PD=P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2-P(I,5)**2
9425 IF(ABS(PD).GT.MAX(0.1,0.001*P(I,4)**2).OR.P(I,4).LT.0.) THEN
9426 WRITE(MSTU(11),1200) I
9427 MERR=MERR+1
9428 ENDIF
9429 160 CONTINUE
9430 IF(MTEST.GE.1) CALL LUTABU(21)
9431
9432
9433 IF(MERR.NE.0.OR.MSTU(24).NE.0.OR.MSTU(28).NE.0) THEN
9434 CALL LULIST(2)
9435 ELSEIF(MTEST.GE.1.AND.MOD(IEV-5,100).EQ.0) THEN
9436 CALL LULIST(1)
9437 ENDIF
9438
9439
9440 IF(MERR.NE.0) NERR=NERR+1
9441 IF(NERR.GE.10) THEN
9442 WRITE(MSTU(11),1300) IEV
9443 STOP
9444 ENDIF
9445 170 CONTINUE
9446 IF(MTEST.GE.1) CALL LUTABU(22)
9447 WRITE(MSTU(11),1400) NERR
9448
9449
9450 MSTJ(2)=3
9451 PARJ(17)=0.
9452 PARJ(22)=1.
9453 PARJ(43)=0.5
9454 PARJ(54)=0.
9455 MSTJ(105)=1
9456 MSTJ(107)=0
9457
9458
9459 1000 FORMAT(/' Momentum, energy and/or charge were not conserved ',
9460 &'in following event'/' sum of',9X,'px',11X,'py',11X,'pz',11X,
9461 &'E',8X,'charge'/' before',2X,4(1X,F12.5),1X,F8.2/' after',3X,
9462 &4(1X,F12.5),1X,F8.2)
9463 1100 FORMAT(/5X,'Entry no.',I4,' in following event not known code')
9464 1200 FORMAT(/5X,'Entry no.',I4,' in following event has faulty ',
9465 &'kinematics')
9466 1300 FORMAT(/5X,'Ten errors experienced by event ',I3/
9467 &5X,'Something is seriously wrong! Execution stopped now!')
9468 1400 FORMAT(/5X,'Number of erroneous or suspect events in run:',I3/
9469 &5X,'(0 fine, 1 acceptable if a single jet, ',
9470 &'>=2 something is wrong)')
9471
9472 RETURN
9473 END
9474
9475
9476
9477 BLOCK DATA LUDATA
9478
9479
9480
9481 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
9482 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
9483 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
9484 COMMON/LUDAT4/CHAF(500)
9485 CHARACTER CHAF*8
9486 COMMON/LUDATR/MRLU(6),RRLU(100)
9487 SAVE
9488
9489
9490 DATA MSTU/
9491 & 0, 0, 0, 9000,10000, 500, 2000, 0, 0, 2,
9492 1 6, 1, 1, 0, 1, 1, 0, 0, 0, 0,
9493 2 2, 10, 0, 0, 1, 10, 0, 0, 0, 0,
9494 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
9495 4 2, 2, 1, 4, 2, 1, 1, 0, 0, 0,
9496 5 25, 24, 0, 1, 0, 0, 0, 0, 0, 0,
9497 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
9498 7 40*0,
9499 1 1, 5, 3, 5, 0, 0, 0, 0, 0, 0,
9500 2 60*0,
9501 8 7, 2, 1989, 11, 25, 0, 0, 0, 0, 0,
9502 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/
9503 DATA PARU/
9504 & 3.1415927, 6.2831854, 0.1973, 5.068, 0.3894, 2.568, 4*0.,
9505 1 0.001, 0.09, 0.01, 0., 0., 0., 0., 0., 0., 0.,
9506 2 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
9507 3 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
9508 4 2.0, 1.0, 0.25, 2.5, 0.05, 0., 0., 0.0001, 0., 0.,
9509 5 2.5, 1.5, 7.0, 1.0, 0.5, 2.0, 3.2, 0., 0., 0.,
9510 6 40*0.,
9511 & 0.0072974, 0.230, 0., 0., 0., 0., 0., 0., 0., 0.,
9512 1 0.20, 0.25, 1.0, 4.0, 0., 0., 0., 0., 0., 0.,
9513 2 1.0, 0., 0., 0., 0., 0., 0., 0., 0., 0.,
9514 3 70*0./
9515 DATA MSTJ/
9516 & 1, 3, 0, 0, 0, 0, 0, 0, 0, 0,
9517 1 1, 2, 0, 1, 0, 0, 0, 0, 0, 0,
9518 2 2, 2, 1, 2, 1, 0, 0, 0, 0, 0,
9519 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
9520 4 1, 2, 4, 2, 5, 0, 1, 0, 0, 0,
9521 5 0, 3, 0, 0, 0, 0, 0, 0, 0, 0,
9522 6 40*0,
9523 & 5, 2, 7, 5, 1, 1, 0, 2, 0, 1,
9524 1 0, 0, 0, 0, 1, 1, 0, 0, 0, 0,
9525 2 80*0/
9526 DATA PARJ/
9527 & 0.10, 0.30, 0.40, 0.05, 0.50, 0.50, 0.50, 0., 0., 0.,
9528 1 0.50, 0.60, 0.75, 0., 0., 0., 0., 1.0, 1.0, 0.,
9529 2 0.35, 1.0, 0., 0., 0., 0., 0., 0., 0., 0.,
9530 3 0.10, 1.0, 0.8, 1.5, 0.8, 2.0, 0.2, 2.5, 0.6, 2.5,
9531 4 0.5, 0.9, 0.5, 0.9, 0.5, 0., 0., 0., 0., 0.,
9532 5 0.77, 0.77, 0.77, 0., 0., 0., 0., 0., 1.0, 0.,
9533 6 4.5, 0.7, 0., 0.003, 0.5, 0.5, 0., 0., 0., 0.,
9534 7 10., 1000., 100., 1000., 0., 0., 0., 0., 0., 0.,
9535 8 0.4, 1.0, 1.0, 0., 10., 10., 0., 0., 0., 0.,
9536 9 0.02, 1.0, 0.2, 0., 0., 0., 0., 0., 0., 0.,
9537 & 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
9538 1 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
9539 2 1.5, 0.5, 91.2, 2.40, 0.02, 2.0, 1.0, 0.25,0.002, 0.,
9540 3 0., 0., 0., 0., 0.01, 0.99, 0., 0., 0.2, 0.,
9541 4 60*0./
9542
9543
9544 DATA (KCHG(I,1),I= 1, 500)/-1,2,-1,2,-1,2,-1,2,2*0,-3,0,-3,0,
9545 &-3,0,-3,6*0,3,9*0,3,2*0,3,46*0,2,-1,2,-1,2,3,11*0,3,0,2*3,
9546 &0,3,0,3,12*0,3,0,2*3,0,3,0,3,12*0,3,0,2*3,0,3,0,3,12*0,3,0,2*3,0,
9547 &3,0,3,12*0,3,0,2*3,0,3,0,3,12*0,3,0,2*3,0,3,0,3,72*0,3,0,3,28*0,
9548 &3,2*0,3,8*0,-3,8*0,3,0,-3,0,3,-3,3*0,3,6,0,3,5*0,-3,0,3,-3,0,-3,
9549 &4*0,-3,0,3,6,-3,0,3,-3,0,-3,0,3,6,0,3,5*0,-3,0,3,-3,0,-3,114*0/
9550 DATA (KCHG(I,2),I= 1, 500)/8*1,12*0,2,68*0,-1,410*0/
9551 DATA (KCHG(I,3),I= 1, 500)/8*1,2*0,8*1,5*0,1,9*0,1,2*0,1,2*0,1,
9552 &41*0,1,0,7*1,10*0,9*1,11*0,9*1,11*0,9*1,11*0,9*1,11*0,9*1,
9553 &11*0,9*1,71*0,3*1,22*0,1,5*0,1,0,2*1,6*0,1,0,2*1,6*0,2*1,0,5*1,
9554 &0,6*1,4*0,6*1,4*0,16*1,4*0,6*1,114*0/
9555 DATA (PMAS(I,1),I= 1, 500)/.0099,.0056,.199,1.35,5.,90.,120.,
9556 &200.,2*0.,.00051,0.,.1057,0.,1.7841,0.,60.,5*0.,91.2,80.,15.,
9557 &6*0.,300.,900.,600.,300.,900.,300.,2*0.,5000.,60*0.,.1396,.4977,
9558 &.4936,1.8693,1.8645,1.9693,5.2794,5.2776,5.47972,0.,.135,.5488,
9559 &.9575,2.9796,9.4,117.99,238.,397.,2*0.,.7669,.8962,.8921,
9560 &2.0101,2.0071,2.1127,2*5.3354,5.5068,0.,.77,.782,1.0194,3.0969,
9561 &9.4603,118.,238.,397.,2*0.,1.233,2*1.3,2*2.322,2.51,2*5.73,5.97,
9562 &0.,1.233,1.17,1.41,3.46,9.875,118.42,238.42,397.42,2*0.,
9563 &.983,2*1.429,2*2.272,2.46,2*5.68,5.92,0.,.983,1.,1.4,3.4151,
9564 &9.8598,118.4,238.4,397.4,2*0.,1.26,2*1.401,2*2.372,
9565 &2.56,2*5.78,6.02,0.,1.26,1.283,1.422,3.5106,9.8919,118.5,238.5,
9566 &397.5,2*0.,1.318,2*1.426,2*2.422,2.61,2*5.83,6.07,0.,1.318,1.274,
9567 &1.525,3.5563,9.9132,118.45,238.45,397.45,2*0.,2*.4977,
9568 &83*0.,1.1156,5*0.,2.2849,0.,2*2.46,6*0.,5.62,0.,2*5.84,6*0.,
9569 &.9396,.9383,0.,1.1974,1.1926,1.1894,1.3213,1.3149,0.,2.454,
9570 &2.4529,2.4522,2*2.55,2.73,4*0.,3*5.8,2*5.96,6.12,4*0.,1.234,
9571 &1.233,1.232,1.231,1.3872,1.3837,1.3828,1.535,1.5318,1.6724,3*2.5,
9572 &2*2.63,2.8,4*0.,3*5.81,2*5.97,6.13,114*0./
9573 DATA (PMAS(I,2),I= 1, 500)/22*0.,2.4,2.3,88*0.,.0002,.001,
9574 &6*0.,.149,.0505,.0513,7*0.,.153,.0085,.0044,7*0.,.15,2*.09,2*.06,
9575 &.04,3*.1,0.,.15,.335,.08,2*.01,5*0.,.057,2*.287,2*.06,.04,3*.1,
9576 &0.,.057,0.,.25,.0135,6*0.,.4,2*.184,2*.06,.04,3*.1,0.,.4,.025,
9577 &.055,.0135,6*0.,.11,.115,.099,2*.06,4*.1,0.,.11,.185,.076,.0026,
9578 &146*0.,4*.115,.039,2*.036,.0099,.0091,131*0./
9579 DATA (PMAS(I,3),I= 1, 500)/22*0.,2*20.,88*0.,.002,.005,6*0.,.4,
9580 &2*.2,7*0.,.4,.1,.015,7*0.,.25,2*.01,3*.08,2*.2,.12,0.,.25,.2,
9581 &.001,2*.02,5*0.,.05,2*.4,3*.08,2*.2,.12,0.,.05,0.,.35,.05,6*0.,
9582 &3*.3,2*.08,.06,2*.2,.12,0.,.3,.05,.025,.001,6*0.,.25,4*.12,4*.2,
9583 &0.,.25,.17,.2,.01,146*0.,4*.14,.04,2*.035,2*.05,131*0./
9584 DATA (PMAS(I,4),I= 1, 500)/12*0.,658650.,0.,.091,68*0.,.1,.43,
9585 &15*0.,7803.,.00003,3709.,.32,.128,.131,3*.393,84*0.,.004,26*0.,
9586 &15540.,26.75,83*0.,78.88,5*0.,.054,0.,2*.13,6*0.,.393,0.,2*.393,
9587 &9*0.,44.3,0.,24.,49.1,86.9,6*0.,.13,9*0.,.393,13*0.,24.6,130*0./
9588 DATA PARF/
9589 & 0.5, 0.25, 0.5, 0.25, 1., 0.5, 0., 0., 0., 0.,
9590 1 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0.,
9591 2 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0.,
9592 3 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0.,
9593 4 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0.,
9594 5 0.5, 0., 0.5, 0., 1., 1., 0., 0., 0., 0.,
9595 6 0.75, 0.5, 0., 0.1667, 0.0833, 0.1667, 0., 0., 0., 0.,
9596 7 0., 0., 1., 0.3333, 0.6667, 0.3333, 0., 0., 0., 0.,
9597 8 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
9598 9 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
9599 & 0.325, 0.325, 0.5, 1.6, 5.0, 0., 0., 0., 0., 0.,
9600 1 0., 0.11, 0.16, 0.048, 0.50, 0.45, 0.55, 0.60, 0., 0.,
9601 2 0.2, 0.1, 0., 0., 0., 0., 0., 0., 0., 0.,
9602 3 1870*0./
9603 DATA ((VCKM(I,J),J=1,4),I=1,4)/
9604 1 0.95150, 0.04847, 0.00003, 0.00000,
9605 2 0.04847, 0.94936, 0.00217, 0.00000,
9606 3 0.00003, 0.00217, 0.99780, 0.00000,
9607 4 0.00000, 0.00000, 0.00000, 1.00000/
9608
9609
9610 DATA (MDCY(I,1),I= 1, 500)/14*0,1,0,1,5*0,3*1,6*0,1,4*0,1,2*0,
9611 &1,42*0,7*1,12*0,1,0,6*1,0,8*1,2*0,9*1,0,8*1,2*0,9*1,0,8*1,2*0,
9612 &9*1,0,8*1,2*0,9*1,0,8*1,2*0,9*1,0,8*1,3*0,1,83*0,1,5*0,1,0,2*1,
9613 &6*0,1,0,2*1,9*0,5*1,0,6*1,4*0,6*1,4*0,16*1,4*0,6*1,114*0/
9614 DATA (MDCY(I,2),I= 1, 500)/1,9,17,25,33,41,49,57,2*0,65,69,71,
9615 &76,78,118,120,125,2*0,127,136,149,166,186,6*0,203,4*0,219,2*0,
9616 &227,42*0,236,237,241,250,252,254,256,11*0,276,277,279,285,406,
9617 &574,606,607,608,0,609,611,617,623,624,625,626,627,2*0,628,629,
9618 &632,635,638,640,641,642,643,0,644,645,650,658,661,670,685,686,
9619 &2*0,687,688,693,698,700,702,703,705,707,0,709,710,713,717,718,
9620 &719,721,722,2*0,723,726,728,730,734,738,740,744,748,0,752,755,
9621 &759,763,765,767,769,770,2*0,771,773,775,777,779,781,784,786,788,
9622 &0,791,793,806,810,812,814,816,817,2*0,818,824,835,846,854,862,
9623 &867,875,883,0,888,895,903,905,907,909,911,912,2*0,913,921,83*0,
9624 &923,5*0,927,0,1001,1002,6*0,1003,0,1004,1005,9*0,1006,1008,1009,
9625 &1012,1013,0,1015,1016,1017,1018,1019,1020,4*0,1021,1022,1023,
9626 &1024,1025,1026,4*0,1027,1028,1031,1034,1035,1038,1041,1044,1046,
9627 &1048,1052,1053,1054,1055,1057,1059,4*0,1060,1061,1062,1063,1064,
9628 &1065,114*0/
9629 DATA (MDCY(I,3),I= 1, 500)/8*8,2*0,4,2,5,2,40,2,5,2,2*0,9,13,
9630 &17,20,17,6*0,16,4*0,8,2*0,9,42*0,1,4,9,3*2,20,11*0,1,2,6,121,168,
9631 &32,3*1,0,2,2*6,5*1,2*0,1,3*3,2,4*1,0,1,5,8,3,9,15,2*1,2*0,1,2*5,
9632 &2*2,1,3*2,0,1,3,4,2*1,2,2*1,2*0,3,2*2,2*4,2,3*4,0,3,2*4,3*2,2*1,
9633 &2*0,5*2,3,2*2,3,0,2,13,4,3*2,2*1,2*0,6,2*11,2*8,5,2*8,5,0,7,8,
9634 &4*2,2*1,2*0,8,2,83*0,4,5*0,74,0,2*1,6*0,1,0,2*1,9*0,2,1,3,1,2,0,
9635 &6*1,4*0,6*1,4*0,1,2*3,1,3*3,2*2,4,3*1,2*2,1,4*0,6*1,114*0/
9636 DATA (MDME(I,1),I= 1,2000)/6*1,-1,7*1,-1,7*1,-1,7*1,-1,7*1,-1,
9637 &7*1,-1,85*1,2*-1,7*1,2*-1,3*1,2*-1,6*1,2*-1,6*1,3*-1,3*1,-1,3*1,
9638 &-1,3*1,5*-1,3*1,-1,6*1,2*-1,3*1,-1,11*1,2*-1,6*1,2*-1,3*1,-1,3*1,
9639 &-1,4*1,2*-1,2*1,-1,488*1,2*0,1275*1/
9640 DATA (MDME(I,2),I= 1,2000)/70*102,42,6*102,2*42,2*0,7*41,2*0,
9641 &23*41,6*102,45,28*102,8*32,9*0,16*32,4*0,8*32,4*0,32,4*0,8*32,
9642 &8*0,4*32,4*0,6*32,3*0,12,2*42,2*11,9*42,6*45,20*46,7*0,34*42,
9643 &86*0,2*25,26,24*42,142*0,25,26,0,10*42,19*0,2*13,3*85,0,2,4*0,2,
9644 &8*0,2*32,87,88,3*3,0,2*3,0,2*3,0,3,5*0,3,1,0,3,2*0,2*3,3*0,1,4*0,
9645 &12,3*0,4*32,2*4,6*0,5*32,2*4,2*45,87,88,30*0,12,32,0,32,87,88,
9646 &41*0,12,0,32,0,32,87,88,40*0,12,0,32,0,32,87,88,88*0,12,0,32,0,
9647 &32,87,88,2*0,4*42,8*0,14*42,50*0,10*13,2*84,3*85,14*0,84,5*0,85,
9648 &974*0/
9649 DATA (BRAT(I) ,I= 1, 525)/70*0.,1.,6*0.,2*.177,.108,.225,.003,
9650 &.06,.02,.025,.013,2*.004,.007,.014,2*.002,2*.001,.054,.014,.016,
9651 &.005,2*.012,5*.006,.002,2*.001,5*.002,6*0.,1.,28*0.,.143,.111,
9652 &.143,.111,.143,.085,2*0.,.03,.058,.03,.058,.03,.058,3*0.,.25,.01,
9653 &2*0.,.01,.25,4*0.,.24,5*0.,3*.08,3*0.,.01,.08,.82,5*0.,.09,6*0.,
9654 &.143,.111,.143,.111,.143,.085,2*0.,.03,.058,.03,.058,.03,.058,
9655 &4*0.,1.,5*0.,4*.215,2*0.,2*.07,0.,1.,2*.08,.76,.08,2*.112,.05,
9656 &.476,.08,.14,.01,.015,.005,1.,0.,1.,0.,1.,0.,.25,.01,2*0.,.01,
9657 &.25,4*0.,.24,5*0.,3*.08,0.,1.,2*.5,.635,.212,.056,.017,.048,.032,
9658 &.035,.03,2*.015,.044,2*.022,9*.001,.035,.03,2*.015,.044,2*.022,
9659 &9*.001,.028,.017,.066,.02,.008,2*.006,.003,.001,2*.002,.003,.001,
9660 &2*.002,.005,.002,.005,.006,.004,.012,2*.005,.008,2*.005,.037,
9661 &.004,.067,2*.01,2*.001,3*.002,.003,8*.002,.005,4*.004,.015,.005,
9662 &.027,2*.005,.007,.014,.007,.01,.008,.012,.015,11*.002,3*.004,
9663 &.002,.004,6*.002,2*.004,.005,.011,.005,.015,.02,2*.01,3*.004,
9664 &5*.002,.015,.02,2*.01,3*.004,5*.002,.038,.048,.082,.06,.028,.021,
9665 &2*.005,2*.002,.005,.018,.005,.01,.008,.005,3*.004,.001,3*.003,
9666 &.001,2*.002,.003,2*.002,2*.001,.002,.001,.002,.001,.005,4*.003,
9667 &.001,2*.002,.003,2*.001,.013,.03,.058,.055,3*.003,2*.01,.007,
9668 &.019,4*.005,.015,3*.005,8*.002,3*.001,.002,2*.001,.003,16*.001/
9669 DATA (BRAT(I) ,I= 526, 893)/.019,2*.003,.002,.005,.004,.008,
9670 &.003,.006,.003,.01,5*.002,2*.001,2*.002,11*.001,.002,14*.001,
9671 &.018,.005,.01,2*.015,.017,4*.015,.017,3*.015,.025,.08,2*.025,.04,
9672 &.001,2*.005,.02,.04,2*.06,.04,.01,4*.005,.25,.115,3*1.,.988,.012,
9673 &.389,.319,.237,.049,.005,.001,.441,.205,.301,.03,.022,.001,6*1.,
9674 &.665,.333,.002,.666,.333,.001,.49,.34,.17,.52,.48,5*1.,.893,.08,
9675 &.017,2*.005,.495,.343,3*.043,.019,.013,.001,2*.069,.862,3*.027,
9676 &.015,.045,.015,.045,.77,.029,6*.02,5*.05,.115,.015,.5,0.,3*1.,
9677 &.28,.14,.313,.157,.11,.28,.14,.313,.157,.11,.667,.333,.667,.333,
9678 &1.,.667,.333,.667,.333,2*.5,1.,.333,.334,.333,4*.25,2*1.,.3,.7,
9679 &2*1.,.8,2*.1,.667,.333,.667,.333,.6,.3,.067,.033,.6,.3,.067,.033,
9680 &2*.5,.6,.3,.067,.033,.6,.3,.067,.033,2*.4,2*.1,.8,2*.1,.52,.26,
9681 &2*.11,.62,.31,2*.035,.007,.993,.02,.98,.3,.7,2*1.,2*.5,.667,.333,
9682 &.667,.333,.667,.333,.667,.333,2*.35,.3,.667,.333,.667,.333,2*.35,
9683 &.3,2*.5,3*.14,.1,.05,4*.08,.028,.027,.028,.027,4*.25,.273,.727,
9684 &.35,.65,.3,.7,2*1.,2*.35,.144,.105,.048,.003,.332,.166,.168,.084,
9685 &.086,.043,.059,2*.029,2*.002,.332,.166,.168,.084,.086,.043,.059,
9686 &2*.029,2*.002,.3,.15,.16,.08,.13,.06,.08,.04,.3,.15,.16,.08,.13,
9687 &.06,.08,.04,2*.4,.1,2*.05,.3,.15,.16,.08,.13,.06,.08,.04,.3,.15,
9688 &.16,.08,.13,.06,.08,.04,2*.4,.1,2*.05,2*.35,.144,.105,2*.024/
9689 DATA (BRAT(I) ,I= 894,2000)/.003,.573,.287,.063,.028,2*.021,
9690 &.004,.003,2*.5,.15,.85,.22,.78,.3,.7,2*1.,.217,.124,2*.193,
9691 &2*.135,.002,.001,.686,.314,.641,.357,2*.001,.018,2*.005,.003,
9692 &.002,2*.006,.018,2*.005,.003,.002,2*.006,.005,.025,.015,.006,
9693 &2*.005,.004,.005,5*.004,2*.002,2*.004,.003,.002,2*.003,3*.002,
9694 &2*.001,.002,2*.001,2*.002,5*.001,4*.003,2*.005,2*.002,2*.001,
9695 &2*.002,2*.001,.255,.057,2*.035,.15,2*.075,.03,2*.015,5*1.,.999,
9696 &.001,1.,.516,.483,.001,1.,.995,.005,13*1.,.331,.663,.006,.663,
9697 &.331,.006,1.,.88,2*.06,.88,2*.06,.88,2*.06,.667,2*.333,.667,.676,
9698 &.234,.085,.005,3*1.,4*.5,7*1.,935*0./
9699 DATA (KFDP(I,1),I= 1, 499)/21,22,23,4*-24,25,21,22,23,4*24,25,
9700 &21,22,23,4*-24,25,21,22,23,4*24,25,21,22,23,4*-24,25,21,22,23,
9701 &4*24,25,21,22,23,4*-24,25,21,22,23,4*24,25,22,23,-24,25,23,24,
9702 &-12,22,23,-24,25,23,24,-12,-14,34*16,22,23,-24,25,23,24,-89,22,
9703 &23,-24,25,23,24,1,2,3,4,5,6,7,8,21,1,2,3,4,5,6,7,8,11,13,15,17,
9704 &37,1,2,3,4,5,6,7,8,11,12,13,14,15,16,17,18,37,4*-1,4*-3,4*-5,
9705 &4*-7,-11,-13,-15,-17,1,2,3,4,5,6,7,8,11,13,15,17,21,2*22,23,24,1,
9706 &2,3,4,5,6,7,8,11,12,13,14,15,16,17,18,-1,-3,-5,-7,-11,-13,-15,
9707 &-17,1,2,3,4,5,6,11,13,15,82,-11,-13,2*2,-12,-14,-16,2*-2,2*-4,-2,
9708 &-4,2*89,2*-89,2*89,4*-1,4*-3,4*-5,4*-7,-11,-13,-15,-17,-13,130,
9709 &310,-13,3*211,12,14,16*-11,16*-13,-311,-313,-311,-313,-311,-313,
9710 &-311,-313,2*111,2*221,2*331,2*113,2*223,2*333,-311,-313,2*-311,
9711 &-313,3*-311,-321,-323,-321,2*211,2*213,-213,113,3*213,3*211,
9712 &2*213,2*-311,-313,-321,2*-311,-313,-311,-313,4*-311,-321,-323,
9713 &2*-321,3*211,213,2*211,213,5*211,213,4*211,3*213,211,213,321,311,
9714 &3,2*2,12*-11,12*-13,-321,-323,-321,-323,-311,-313,-311,-313,-311,
9715 &-313,-311,-313,-311,-313,-311,-321,-323,-321,-323,211,213,211,
9716 &213,111,221,331,113,223,333,221,331,113,223,113,223,113,223,333,
9717 &223,333,321,323,321,323,311,313,-321,-323,3*-321,-323,2*-321,
9718 &-323,-321,-311,-313,3*-311,-313,2*-311,-313,-321,-323,3*-321/
9719 DATA (KFDP(I,1),I= 500, 873)/-323,2*-321,-311,2*333,211,213,
9720 &2*211,2*213,4*211,10*111,-321,-323,5*-321,-323,2*-321,-311,-313,
9721 &4*-311,-313,4*-311,-321,-323,2*-321,-323,-321,-313,-311,-313,
9722 &-311,211,213,2*211,213,4*211,111,221,113,223,113,223,2*3,-15,
9723 &5*-11,5*-13,221,331,333,221,331,333,211,213,211,213,321,323,321,
9724 &323,2212,221,331,333,221,2*2,3*0,3*22,111,211,2*22,2*211,111,
9725 &3*22,111,3*21,2*0,211,321,3*311,2*321,421,2*411,2*421,431,511,
9726 &521,531,2*211,22,211,2*111,321,130,-213,113,213,211,22,111,11,13,
9727 &82,11,13,15,1,2,3,4,21,22,11,12,13,14,15,16,1,2,3,4,5,21,22,2*89,
9728 &2*0,223,321,311,323,313,2*311,321,313,323,321,421,2*411,421,433,
9729 &521,2*511,521,523,513,223,213,113,-213,313,-313,323,-323,82,21,
9730 &663,21,2*0,221,213,113,321,2*311,321,421,411,423,413,411,421,413,
9731 &423,431,433,521,511,523,513,511,521,513,523,521,511,531,533,221,
9732 &213,-213,211,111,321,130,211,111,321,130,443,82,553,21,663,21,
9733 &2*0,113,213,323,2*313,323,423,2*413,423,421,411,433,523,2*513,
9734 &523,521,511,533,213,-213,10211,10111,-10211,2*221,213,2*113,-213,
9735 &2*321,2*311,313,-313,323,-323,443,82,553,21,663,21,2*0,213,113,
9736 &221,223,321,211,321,311,323,313,323,313,321,5*311,321,313,323,
9737 &313,323,311,4*321,421,411,423,413,423,413,421,2*411,421,413,423,
9738 &413,423,411,2*421,411,433,2*431,521,511,523,513,523,513,521/
9739 DATA (KFDP(I,1),I= 874,2000)/2*511,521,513,523,513,523,511,2*521,
9740 &511,533,2*531,213,-213,221,223,321,130,111,211,111,2*211,321,130,
9741 &221,111,321,130,443,82,553,21,663,21,2*0,111,211,-12,12,-14,14,
9742 &211,111,211,111,2212,2*2112,-12,7*-11,7*-13,2*2224,2*2212,2*2214,
9743 &2*3122,2*3212,2*3214,5*3222,4*3224,2*3322,3324,2*2224,5*2212,
9744 &5*2214,2*2112,2*2114,2*3122,2*3212,2*3214,2*3222,2*3224,4*2,3,
9745 &2*2,1,2*2,5*0,2112,-12,3122,2212,2112,2212,3*3122,3*4122,4132,
9746 &4232,0,3*5122,5132,5232,0,2112,2212,2*2112,2212,2112,2*2212,3122,
9747 &3212,3112,3122,3222,3112,3122,3222,3212,3322,3312,3322,3312,3122,
9748 &3322,3312,-12,3*4122,2*4132,2*4232,4332,3*5122,5132,5232,5332,
9749 &935*0/
9750 DATA (KFDP(I,2),I= 1, 496)/3*1,2,4,6,8,1,3*2,1,3,5,7,2,3*3,2,4,
9751 &6,8,3,3*4,1,3,5,7,4,3*5,2,4,6,8,5,3*6,1,3,5,7,6,3*7,2,4,6,8,7,
9752 &3*8,1,3,5,7,8,2*11,12,11,12,2*11,2*13,14,13,14,13,11,13,-211,
9753 &-213,-211,-213,-211,-213,3*-211,-321,-323,-321,-323,2*-321,
9754 &4*-211,-213,-211,-213,-211,-213,-211,-213,-211,-213,6*-211,2*15,
9755 &16,15,16,15,18,2*17,18,17,18,17,-1,-2,-3,-4,-5,-6,-7,-8,21,-1,-2,
9756 &-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,-37,-1,-2,-3,-4,-5,-6,-7,-8,
9757 &-11,-12,-13,-14,-15,-16,-17,-18,-37,2,4,6,8,2,4,6,8,2,4,6,8,2,4,
9758 &6,8,12,14,16,18,-1,-2,-3,-4,-5,-6,-7,-8,-11,-13,-15,-17,21,22,
9759 &2*23,-24,-1,-2,-3,-4,-5,-6,-7,-8,-11,-12,-13,-14,-15,-16,-17,-18,
9760 &2,4,6,8,12,14,16,18,-3,-4,-5,-6,-7,-8,-13,-15,-17,-82,12,14,-1,
9761 &-3,11,13,15,1,4,3,4,1,3,5,3,6,4,7,5,2,4,6,8,2,4,6,8,2,4,6,8,2,4,
9762 &6,8,12,14,16,18,14,2*0,14,111,211,111,-11,-13,16*12,16*14,2*211,
9763 &2*213,2*321,2*323,211,213,211,213,211,213,211,213,211,213,211,
9764 &213,2*211,213,7*211,213,211,111,211,111,2*211,-213,213,2*113,223,
9765 &2*113,221,321,2*311,321,313,4*211,213,113,213,-213,2*211,213,113,
9766 &111,221,331,111,113,223,4*113,223,6*211,213,4*211,-321,-311,3*-1,
9767 &12*12,12*14,2*211,2*213,2*111,2*221,2*331,2*113,2*223,333,2*321,
9768 &2*323,2*-211,2*-213,6*111,4*221,2*331,3*113,2*223,2*-211,2*-213,
9769 &113,111,2*211,213,6*211,321,2*211,213,211,2*111,113,2*223,2*321/
9770 DATA (KFDP(I,2),I= 497, 863)/323,321,2*311,313,2*311,111,211,
9771 &2*-211,-213,-211,-213,-211,-213,3*-211,5*111,2*113,223,113,223,
9772 &2*211,213,5*211,213,3*211,213,2*211,2*111,221,113,223,3*321,323,
9773 &2*321,323,311,313,311,313,3*211,2*-211,-213,3*-211,4*111,2*113,
9774 &2*-1,16,5*12,5*14,3*211,3*213,2*111,2*113,2*-311,2*-313,-2112,
9775 &3*321,323,2*-1,3*0,22,11,22,111,-211,211,11,2*-211,111,113,223,
9776 &22,111,3*21,2*0,111,-211,111,22,211,111,22,211,111,22,111,5*22,
9777 &2*-211,111,-211,2*111,-321,310,211,111,2*-211,221,22,-11,-13,-82,
9778 &-11,-13,-15,-1,-2,-3,-4,2*21,-11,-12,-13,-14,-15,-16,-1,-2,-3,-4,
9779 &-5,2*21,5,3,2*0,211,-213,113,-211,111,223,211,111,211,111,223,
9780 &211,111,-211,2*111,-211,111,211,111,-321,-311,111,-211,111,211,
9781 &-311,311,-321,321,-82,21,22,21,2*0,211,111,211,-211,111,211,111,
9782 &211,111,211,111,-211,111,-211,3*111,-211,111,-211,111,211,111,
9783 &211,111,-321,-311,3*111,-211,211,-211,111,-321,310,-211,111,-321,
9784 &310,22,-82,22,21,22,21,2*0,211,111,-211,111,211,111,211,111,-211,
9785 &111,321,311,111,-211,111,211,111,-321,-311,111,-211,211,-211,111,
9786 &2*211,111,-211,211,111,211,-321,2*-311,-321,-311,311,-321,321,22,
9787 &-82,22,21,22,21,2*0,111,3*211,-311,22,-211,111,-211,111,-211,211,
9788 &-213,113,223,221,22,211,111,211,111,2*211,213,113,223,221,22,211,
9789 &111,211,111,4*211,-211,111,-211,111,-211,211,-211,211,321,311/
9790 DATA (KFDP(I,2),I= 864,2000)/2*111,211,-211,111,-211,111,-211,
9791 &211,-211,2*211,111,211,111,4*211,-321,-311,2*111,211,-211,211,
9792 &111,211,-321,310,22,-211,111,2*-211,-321,310,221,111,-321,310,22,
9793 &-82,22,21,22,21,2*0,111,-211,11,-11,13,-13,-211,111,-211,111,
9794 &-211,111,22,11,7*12,7*14,-321,-323,-311,-313,-311,-313,211,213,
9795 &211,213,211,213,111,221,331,113,223,111,221,113,223,321,323,321,
9796 &-211,-213,111,221,331,113,223,111,221,331,113,223,211,213,211,
9797 &213,321,323,321,323,321,323,311,313,311,313,2*-1,-3,-1,2203,
9798 &2*3201,2203,2101,2103,5*0,-211,11,22,111,211,22,-211,111,22,-211,
9799 &111,211,2*22,0,-211,111,211,2*22,0,2*-211,111,22,111,211,22,211,
9800 &2*-211,2*111,-211,2*211,111,211,-211,2*111,211,-321,-211,111,11,
9801 &-211,111,211,111,22,111,2*22,-211,111,211,3*22,935*0/
9802 DATA (KFDP(I,3),I= 1, 918)/70*0,14,6*0,2*16,2*0,5*111,310,130,
9803 &2*0,2*111,310,130,113,211,223,221,2*113,2*211,2*223,2*221,2*113,
9804 &221,113,2*213,-213,123*0,4*3,4*4,1,4,3,2*2,6*81,25*0,-211,3*111,
9805 &-311,-313,-311,2*-321,2*-311,111,221,331,113,223,211,111,211,111,
9806 &-311,-313,-311,2*-321,2*-311,111,221,331,113,223,211,111,211,111,
9807 &20*0,3*111,2*221,331,113,223,3*211,-211,111,-211,111,211,111,211,
9808 &-211,111,113,111,223,2*111,-311,4*211,2*111,2*211,111,7*211,
9809 &7*111,113,221,2*223,2*-211,-213,4*-211,-213,-211,-213,-211,2*211,
9810 &2,2*0,-321,-323,-311,-321,-311,2*-321,-211,-213,2*-211,211,-321,
9811 &-323,-311,-321,-311,2*-321,-211,-213,2*-211,211,46*0,3*111,113,
9812 &2*221,331,2*223,-311,3*-211,-213,8*111,113,3*211,213,2*111,-211,
9813 &3*111,113,111,2*113,221,331,223,111,221,331,113,223,113,2*223,
9814 &2*221,3*111,221,113,223,4*211,3*-211,-213,-211,5*111,-321,3*211,
9815 &3*111,2*211,2*111,2*-211,-213,3*111,221,113,223,6*111,3*0,221,
9816 &331,333,321,311,221,331,333,321,311,19*0,3,5*0,-11,0,2*111,-211,
9817 &-11,11,2*221,3*0,111,22*0,111,2*0,22,111,5*0,111,12*0,2*21,11*0,
9818 &2*21,2*-6,111*0,-211,2*111,-211,3*111,-211,111,211,15*0,111,6*0,
9819 &111,-211,9*0,111,-211,9*0,111,-211,111,-211,4*0,111,-211,111,
9820 &-211,4*0,-211,4*0,111,-211,111,-211,4*0,111,-211,111,-211,4*0,
9821 &-211,3*0,-211,5*0,111,211,3*0,111,10*0,2*111,211,-211,211,-211/
9822 DATA (KFDP(I,3),I= 919,2000)/7*0,2212,3122,3212,3214,2112,2114,
9823 &2212,2112,3122,3212,3214,2112,2114,2212,2112,50*0,3*3,1,12*0,
9824 &2112,43*0,3322,949*0/
9825 DATA (KFDP(I,4),I= 1,2000)/83*0,3*111,9*0,-211,3*0,111,2*-211,
9826 &0,111,0,2*111,113,221,111,-213,-211,211,123*0,13*81,37*0,111,
9827 &3*211,111,5*0,-211,111,-211,111,2*0,111,3*211,111,5*0,-211,111,
9828 &-211,111,50*0,2*111,2*-211,2*111,-211,211,3*111,211,14*111,221,
9829 &113,223,2*111,2*113,223,2*111,-1,4*0,-211,111,-211,211,111,2*0,
9830 &2*111,-211,2*0,-211,111,-211,211,111,2*0,2*111,-211,96*0,6*111,
9831 &3*-211,-213,4*111,113,6*111,3*-211,3*111,2*-211,2*111,3*-211,
9832 &12*111,6*0,-321,-311,3*0,-321,-311,19*0,-3,11*0,-11,280*0,111,
9833 &-211,3*0,111,29*0,-211,111,5*0,-211,111,50*0,2101,2103,2*2101,
9834 &1006*0/
9835 DATA (KFDP(I,5),I= 1,2000)/85*0,111,15*0,111,7*0,111,0,2*111,
9836 &175*0,111,-211,111,7*0,2*111,4*0,111,-211,111,7*0,2*111,93*0,111,
9837 &-211,111,3*0,111,-211,4*0,111,-211,111,3*0,111,-211,1571*0/
9838
9839
9840 DATA (CHAF(I) ,I= 1, 331)/'d','u','s','c','b','t','l','h',
9841 &2*' ','e','nu_e','mu','nu_mu','tau','nu_tau','chi','nu_chi',
9842 &2*' ','g','gamma','Z','W','H',6*' ','Z''','Z"','W''','H''','H"',
9843 &'H',2*' ','R',40*' ','specflav','rndmflav','phasespa','c-hadron',
9844 &'b-hadron','t-hadron','l-hadron','h-hadron','Wvirt','diquark',
9845 &'cluster','string','indep.','CMshower','SPHEaxis','THRUaxis',
9846 &'CLUSjet','CELLjet','table',' ','pi',2*'K',2*'D','D_s',2*'B',
9847 &'B_s',' ','pi','eta','eta''','eta_c','eta_b','eta_t','eta_l',
9848 &'eta_h',2*' ','rho',2*'K*',2*'D*','D*_s',2*'B*','B*_s',' ','rho',
9849 &'omega','phi','J/psi','Upsilon','Theta','Theta_l','Theta_h',
9850 &2*' ','b_1',2*'K_1',2*'D_1','D_1s',2*'B_1','B_1s',' ','b_1',
9851 &'h_1','h''_1','h_1c','h_1b','h_1t','h_1l','h_1h',2*' ','a_0',
9852 &2*'K*_0',2*'D*_0','D*_0s',2*'B*_0','B*_0s',' ','a_0','f_0',
9853 &'f''_0','chi_0c','chi_0b','chi_0t','chi_0l','chi_0h',2*' ','a_1',
9854 &2*'K*_1',2*'D*_1','D*_1s',2*'B*_1','B*_1s',' ','a_1','f_1',
9855 &'f''_1','chi_1c','chi_1b','chi_1t','chi_1l','chi_1h',2*' ','a_2',
9856 &2*'K*_2',2*'D*_2','D*_2s',2*'B*_2','B*_2s',' ','a_2','f_2',
9857 &'f''_2','chi_2c','chi_2b','chi_2t','chi_2l','chi_2h',2*' ','K_L',
9858 &'K_S',58*' ','pi_diffr','n_diffr','p_diffr',22*' ','Lambda',5*' ',
9859 &'Lambda_c',' ',2*'Xi_c',6*' ','Lambda_b',' ',2*'Xi_b',6*' '/
9860 DATA (CHAF(I) ,I= 332, 500)/'n','p',' ',3*'Sigma',2*'Xi',' ',
9861 &3*'Sigma_c',2*'Xi''_c','Omega_c',
9862 &4*' ',3*'Sigma_b',2*'Xi''_b','Omega_b',4*' ',4*'Delta',
9863 &3*'Sigma*',2*'Xi*','Omega',3*'Sigma*_c',2*'Xi*_c','Omega*_c',
9864 &4*' ',3*'Sigma*_b',2*'Xi*_b','Omega*_b',114*' '/
9865
9866
9867 DATA MRLU/19780503,0,0,97,33,0/
9868
9869 END
9870 SUBROUTINE PYINIT(FRAME,BEAM,TARGET,WIN)
9871
9872
9873
9874 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
9875 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
9876 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
9877 COMMON/LUDAT4/CHAF(500)
9878 CHARACTER CHAF*8
9879 COMMON/PYSUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
9880 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
9881 COMMON/PYINT1/MINT(400),VINT(400)
9882 COMMON/PYINT2/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2)
9883 COMMON/PYINT5/NGEN(0:200,3),XSEC(0:200,3)
9884 CHARACTER*(*) FRAME,BEAM,TARGET
9885 CHARACTER CHFRAM*8,CHBEAM*8,CHTARG*8,CHMO(12)*3,CHLH(2)*6
9886 SAVE
9887 DATA CHMO/'Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep',
9888 &'Oct','Nov','Dec'/, CHLH/'lepton','hadron'/
9889
9890 CHMO(1)=CHMO(1)
9891
9892
9893
9894 CALL LULIST(0)
9895
9896
9897
9898 CHFRAM=FRAME//' '
9899 CHBEAM=BEAM//' '
9900 CHTARG=TARGET//' '
9901 CALL PYINKI(CHFRAM,CHBEAM,CHTARG,WIN)
9902
9903
9904 IF(MSEL.NE.0) THEN
9905 DO 100 I=1,200
9906 100 MSUB(I)=0
9907 ENDIF
9908 IF(MINT(43).EQ.1.AND.(MSEL.EQ.1.OR.MSEL.EQ.2)) THEN
9909
9910 IF(MINT(11)+MINT(12).EQ.0) MSUB(1)=1
9911 IF(MINT(11)+MINT(12).NE.0) MSUB(2)=1
9912 ELSEIF(MSEL.EQ.1) THEN
9913
9914 MSUB(11)=1
9915 MSUB(12)=1
9916 MSUB(13)=1
9917 MSUB(28)=1
9918 MSUB(53)=1
9919 MSUB(68)=1
9920 IF(MSTP(82).LE.1.AND.CKIN(3).LT.PARP(81)) MSUB(95)=1
9921 IF(MSTP(82).GE.2.AND.CKIN(3).LT.PARP(82)) MSUB(95)=1
9922 ELSEIF(MSEL.EQ.2) THEN
9923
9924 MSUB(11)=1
9925 MSUB(12)=1
9926 MSUB(13)=1
9927 MSUB(28)=1
9928 MSUB(53)=1
9929 MSUB(68)=1
9930 MSUB(91)=1
9931 MSUB(92)=1
9932 MSUB(93)=1
9933 MSUB(95)=1
9934 ELSEIF(MSEL.GE.4.AND.MSEL.LE.8) THEN
9935
9936 MSUB(81)=1
9937 MSUB(82)=1
9938 DO 110 J=1,MIN(8,MDCY(21,3))
9939 110 MDME(MDCY(21,2)+J-1,1)=0
9940 MDME(MDCY(21,2)+MSEL-1,1)=1
9941 ELSEIF(MSEL.EQ.10) THEN
9942
9943 MSUB(14)=1
9944 MSUB(18)=1
9945 MSUB(29)=1
9946 ELSEIF(MSEL.EQ.11) THEN
9947
9948 MSUB(1)=1
9949 ELSEIF(MSEL.EQ.12) THEN
9950
9951 MSUB(2)=1
9952 ELSEIF(MSEL.EQ.13) THEN
9953
9954 MSUB(15)=1
9955 MSUB(30)=1
9956 ELSEIF(MSEL.EQ.14) THEN
9957
9958 MSUB(16)=1
9959 MSUB(31)=1
9960 ELSEIF(MSEL.EQ.15) THEN
9961
9962 MSUB(19)=1
9963 MSUB(20)=1
9964 MSUB(22)=1
9965 MSUB(23)=1
9966 MSUB(25)=1
9967 ELSEIF(MSEL.EQ.16) THEN
9968
9969 MSUB(3)=1
9970 MSUB(5)=1
9971 MSUB(8)=1
9972 MSUB(102)=1
9973 ELSEIF(MSEL.EQ.17) THEN
9974
9975 MSUB(24)=1
9976 MSUB(26)=1
9977 ELSEIF(MSEL.EQ.21) THEN
9978
9979 MSUB(141)=1
9980 ELSEIF(MSEL.EQ.22) THEN
9981
9982 MSUB(142)=1
9983 ELSEIF(MSEL.EQ.23) THEN
9984
9985 MSUB(143)=1
9986 ENDIF
9987
9988
9989 MINT(44)=0
9990 DO 120 ISUB=1,200
9991 IF(MINT(43).LT.4.AND.ISUB.GE.91.AND.ISUB.LE.96.AND.
9992 &MSUB(ISUB).EQ.1) THEN
9993 WRITE(MSTU(11),1200) ISUB,CHLH(MINT(41)),CHLH(MINT(42))
9994 STOP
9995 ELSEIF(MSUB(ISUB).EQ.1.AND.ISET(ISUB).EQ.-1) THEN
9996 WRITE(MSTU(11),1300) ISUB
9997 STOP
9998 ELSEIF(MSUB(ISUB).EQ.1.AND.ISET(ISUB).LE.-2) THEN
9999 WRITE(MSTU(11),1400) ISUB
10000 STOP
10001 ELSEIF(MSUB(ISUB).EQ.1) THEN
10002 MINT(44)=MINT(44)+1
10003 ENDIF
10004 120 CONTINUE
10005 IF(MINT(44).EQ.0) THEN
10006 WRITE(MSTU(11),1500)
10007 STOP
10008 ENDIF
10009 MINT(45)=MINT(44)-MSUB(91)-MSUB(92)-MSUB(93)-MSUB(94)
10010
10011
10012 MSTP(1)=MIN(4,MSTP(1))
10013 MSTU(114)=MIN(MSTU(114),2*MSTP(1))
10014 MSTP(54)=MIN(MSTP(54),2*MSTP(1))
10015
10016
10017 DO 140 I=-20,20
10018 VINT(180+I)=0.
10019 IA=IABS(I)
10020 IF(IA.GE.1.AND.IA.LE.2*MSTP(1)) THEN
10021 DO 130 J=1,MSTP(1)
10022 IB=2*J-1+MOD(IA,2)
10023 IPM=(5-ISIGN(1,I))/2
10024 IDC=J+MDCY(IA,2)+2
10025 130 IF(MDME(IDC,1).EQ.1.OR.MDME(IDC,1).EQ.IPM) VINT(180+I)=
10026 & VINT(180+I)+VCKM((IA+1)/2,(IB+1)/2)
10027 ELSEIF(IA.GE.11.AND.IA.LE.10+2*MSTP(1)) THEN
10028 VINT(180+I)=1.
10029 ENDIF
10030 140 CONTINUE
10031
10032
10033 MSTU(111)=MSTP(2)
10034 IF(MSTP(3).GE.1) THEN
10035 ALAM=PARP(1)
10036 IF(MSTP(51).EQ.1) ALAM=0.2
10037 IF(MSTP(51).EQ.2) ALAM=0.29
10038 IF(MSTP(51).EQ.3) ALAM=0.2
10039 IF(MSTP(51).EQ.4) ALAM=0.4
10040 IF(MSTP(51).EQ.11) ALAM=0.16
10041 IF(MSTP(51).EQ.12) ALAM=0.26
10042 IF(MSTP(51).EQ.13) ALAM=0.36
10043 PARP(1)=ALAM
10044 PARP(61)=ALAM
10045 PARU(112)=ALAM
10046 PARJ(81)=ALAM
10047 ENDIF
10048
10049
10050 CALL PYINRE
10051
10052
10053 DO 150 I=0,200
10054 DO 150 J=1,3
10055 NGEN(I,J)=0
10056 150 XSEC(I,J)=0.
10057 VINT(108)=0.
10058
10059
10060 IF(MINT(43).EQ.4) CALL PYXTOT
10061
10062
10063 IF(MSTP(121).LE.0) CALL PYMAXI
10064
10065
10066 IF(MSTP(131).NE.0) CALL PYOVLY(1)
10067
10068
10069 IF(MINT(43).EQ.4.AND.(MINT(45).NE.0.OR.MSTP(131).NE.0).AND.
10070 &MSTP(82).GE.2) CALL PYMULT(1)
10071
10072
10073
10074
10075
10076
10077
10078 1200 FORMAT(1X,'Error: process number ',I3,' not meaningful for ',A6,
10079 &'-',A6,' interactions.'/1X,'Execution stopped!')
10080 1300 FORMAT(1X,'Error: requested subprocess',I4,' not implemented.'/
10081 &1X,'Execution stopped!')
10082 1400 FORMAT(1X,'Error: requested subprocess',I4,' not existing.'/
10083 &1X,'Execution stopped!')
10084 1500 FORMAT(1X,'Error: no subprocess switched on.'/
10085 &1X,'Execution stopped.')
10086
10087
10088
10089 RETURN
10090 END
10091
10092
10093
10094 SUBROUTINE PYTHIA
10095
10096
10097
10098 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
10099 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
10100 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
10101 COMMON/PYSUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
10102 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
10103 COMMON/PYINT1/MINT(400),VINT(400)
10104 COMMON/PYINT2/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2)
10105 COMMON/PYINT5/NGEN(0:200,3),XSEC(0:200,3)
10106 SAVE
10107
10108
10109 MINT(7)=0
10110 MINT(8)=0
10111 NOVL=1
10112 IF(MSTP(131).NE.0) CALL PYOVLY(2)
10113 IF(MSTP(131).NE.0) NOVL=MINT(81)
10114 MINT(83)=0
10115 MINT(84)=MSTP(126)
10116 MSTU(70)=0
10117 DO 190 IOVL=1,NOVL
10118 IF(MINT(84)+100.GE.MSTU(4)) THEN
10119 CALL LUERRM(11,
10120 & '(PYTHIA:) no more space in LUJETS for overlayed events')
10121 IF(MSTU(21).GE.1) GOTO 200
10122 ENDIF
10123 MINT(82)=IOVL
10124
10125
10126 100 CONTINUE
10127 IF(IOVL.EQ.1) NGEN(0,2)=NGEN(0,2)+1
10128 MINT(31)=0
10129 MINT(51)=0
10130 CALL PYRAND
10131 ISUB=MINT(1)
10132 IF(IOVL.EQ.1) THEN
10133 NGEN(ISUB,2)=NGEN(ISUB,2)+1
10134
10135
10136 DO 110 J=1,200
10137 MSTI(J)=0
10138 110 PARI(J)=0.
10139 MSTI(1)=MINT(1)
10140 MSTI(2)=MINT(2)
10141 MSTI(11)=MINT(11)
10142 MSTI(12)=MINT(12)
10143 MSTI(15)=MINT(15)
10144 MSTI(16)=MINT(16)
10145 MSTI(17)=MINT(17)
10146 MSTI(18)=MINT(18)
10147 PARI(11)=VINT(1)
10148 PARI(12)=VINT(2)
10149 IF(ISUB.NE.95) THEN
10150 DO 120 J=13,22
10151 120 PARI(J)=VINT(30+J)
10152 PARI(33)=VINT(41)
10153 PARI(34)=VINT(42)
10154 PARI(35)=PARI(33)-PARI(34)
10155 PARI(36)=VINT(21)
10156 PARI(37)=VINT(22)
10157 PARI(38)=VINT(26)
10158 PARI(41)=VINT(23)
10159 ENDIF
10160 ENDIF
10161
10162 IF(MSTP(111).EQ.-1) GOTO 160
10163 IF(ISUB.LE.90.OR.ISUB.GE.95) THEN
10164
10165
10166 CALL PYSCAT
10167 IF(MINT(51).EQ.1) GOTO 100
10168
10169
10170 IPU1=MINT(84)+1
10171 IPU2=MINT(84)+2
10172 IF(MSTP(61).GE.1.AND.MINT(43).NE.1.AND.ISUB.NE.95)
10173 & CALL PYSSPA(IPU1,IPU2)
10174 NSAV1=N
10175
10176
10177 IF(MSTP(81).GE.1.AND.MINT(43).EQ.4.AND.ISUB.NE.95)
10178 & CALL PYMULT(6)
10179 MINT(1)=ISUB
10180 NSAV2=N
10181
10182
10183 CALL PYREMN(IPU1,IPU2)
10184 IF(MINT(51).EQ.1) GOTO 100
10185 NSAV3=N
10186
10187
10188 IPU3=MINT(84)+3
10189 IPU4=MINT(84)+4
10190 IF(MSTP(71).GE.1.AND.ISUB.NE.95.AND.K(IPU3,1).GT.0.AND.
10191 & K(IPU3,1).LE.10.AND.K(IPU4,1).GT.0.AND.K(IPU4,1).LE.10) THEN
10192 QMAX=SQRT(PARP(71)*VINT(52))
10193 IF(ISUB.EQ.5) QMAX=SQRT(PMAS(23,1)**2)
10194 IF(ISUB.EQ.8) QMAX=SQRT(PMAS(24,1)**2)
10195 CALL LUSHOW(IPU3,IPU4,QMAX)
10196 ENDIF
10197
10198
10199 IF(IOVL.EQ.1) THEN
10200 PARI(65)=2.*PARI(17)
10201 DO 130 I=MSTP(126)+1,N
10202 IF(K(I,1).LE.0.OR.K(I,1).GT.10) GOTO 130
10203 PT=SQRT(P(I,1)**2+P(I,2)**2)
10204 PARI(69)=PARI(69)+PT
10205 IF(I.LE.NSAV1.OR.I.GT.NSAV3) PARI(66)=PARI(66)+PT
10206 IF(I.GT.NSAV1.AND.I.LE.NSAV2) PARI(68)=PARI(68)+PT
10207 130 CONTINUE
10208 PARI(67)=PARI(68)
10209 PARI(71)=VINT(151)
10210 PARI(72)=VINT(152)
10211 PARI(73)=VINT(151)
10212 PARI(74)=VINT(152)
10213 ENDIF
10214
10215
10216 IF(MSTP(41).GE.1.AND.ISUB.NE.95) CALL PYRESD
10217
10218 ELSE
10219
10220 CALL PYDIFF
10221 IF(IOVL.EQ.1) THEN
10222 PARI(65)=2.*PARI(17)
10223 PARI(66)=PARI(65)
10224 PARI(69)=PARI(65)
10225 ENDIF
10226 ENDIF
10227
10228
10229 IF(MSTP(113).GE.1) THEN
10230 DO 140 I=MINT(83)+1,N
10231 140 IF(K(I,1).GT.0.AND.K(I,1).LE.10) P(I,4)=SQRT(P(I,1)**2+
10232 & P(I,2)**2+P(I,3)**2+P(I,5)**2)
10233 ENDIF
10234
10235
10236 MSTU(28)=0
10237 CALL LUPREP(MINT(84)+1)
10238 IF(MSTP(112).EQ.1.AND.MSTU(28).EQ.3) GOTO 100
10239 IF(MSTP(125).EQ.0.OR.MSTP(125).EQ.1) THEN
10240 DO 150 I=MINT(84)+1,N
10241 IF(K(I,2).NE.94) GOTO 150
10242 K(I+1,3)=MOD(K(I+1,4)/MSTU(5),MSTU(5))
10243 K(I+2,3)=MOD(K(I+2,4)/MSTU(5),MSTU(5))
10244 150 CONTINUE
10245 CALL LUEDIT(12)
10246 CALL LUEDIT(14)
10247 IF(MSTP(125).EQ.0) CALL LUEDIT(15)
10248 IF(MSTP(125).EQ.0) MINT(4)=0
10249 ENDIF
10250
10251
10252 IF(IOVL.EQ.1.AND.MSTP(125).LE.0) THEN
10253 MSTU(70)=1
10254 MSTU(71)=N
10255 ELSEIF(IOVL.EQ.1) THEN
10256 MSTU(70)=3
10257 MSTU(71)=2
10258 MSTU(72)=MINT(4)
10259 MSTU(73)=N
10260 ENDIF
10261
10262
10263 IF(MSTP(111).GE.1) CALL LUEXEC
10264 IF(MSTP(125).EQ.0.OR.MSTP(125).EQ.1) CALL LUEDIT(14)
10265
10266
10267 160 IF(IOVL.EQ.1) THEN
10268 IF(MSTP(111).NE.-1) NGEN(ISUB,3)=NGEN(ISUB,3)+1
10269 NGEN(0,3)=NGEN(0,3)+1
10270 XSEC(0,3)=0.
10271 DO 170 I=1,200
10272 IF(I.EQ.96) THEN
10273 XSEC(I,3)=0.
10274 ELSEIF(MSUB(95).EQ.1.AND.(I.EQ.11.OR.I.EQ.12.OR.I.EQ.13.OR.
10275 & I.EQ.28.OR.I.EQ.53.OR.I.EQ.68)) THEN
10276 XSEC(I,3)=XSEC(96,2)*NGEN(I,3)/MAX(1.,FLOAT(NGEN(96,1))*
10277 & FLOAT(NGEN(96,2)))
10278 ELSEIF(NGEN(I,1).EQ.0) THEN
10279 XSEC(I,3)=0.
10280 ELSEIF(NGEN(I,2).EQ.0) THEN
10281 XSEC(I,3)=XSEC(I,2)*NGEN(0,3)/(FLOAT(NGEN(I,1))*
10282 & FLOAT(NGEN(0,2)))
10283 ELSE
10284 XSEC(I,3)=XSEC(I,2)*NGEN(I,3)/(FLOAT(NGEN(I,1))*
10285 & FLOAT(NGEN(I,2)))
10286 ENDIF
10287 170 XSEC(0,3)=XSEC(0,3)+XSEC(I,3)
10288 IF(MSUB(95).EQ.1) THEN
10289 NGENS=NGEN(91,3)+NGEN(92,3)+NGEN(93,3)+NGEN(94,3)+NGEN(95,3)
10290 XSECS=XSEC(91,3)+XSEC(92,3)+XSEC(93,3)+XSEC(94,3)+XSEC(95,3)
10291 XMAXS=XSEC(95,1)
10292 IF(MSUB(91).EQ.1) XMAXS=XMAXS+XSEC(91,1)
10293 IF(MSUB(92).EQ.1) XMAXS=XMAXS+XSEC(92,1)
10294 IF(MSUB(93).EQ.1) XMAXS=XMAXS+XSEC(93,1)
10295 IF(MSUB(94).EQ.1) XMAXS=XMAXS+XSEC(94,1)
10296 FAC=1.
10297 IF(NGENS.LT.NGEN(0,3)) FAC=(XMAXS-XSECS)/(XSEC(0,3)-XSECS)
10298 XSEC(11,3)=FAC*XSEC(11,3)
10299 XSEC(12,3)=FAC*XSEC(12,3)
10300 XSEC(13,3)=FAC*XSEC(13,3)
10301 XSEC(28,3)=FAC*XSEC(28,3)
10302 XSEC(53,3)=FAC*XSEC(53,3)
10303 XSEC(68,3)=FAC*XSEC(68,3)
10304 XSEC(0,3)=XSEC(91,3)+XSEC(92,3)+XSEC(93,3)+XSEC(94,3)+
10305 & XSEC(95,1)
10306 ENDIF
10307
10308
10309 MINT(5)=MINT(5)+1
10310 MSTI(3)=MINT(3)
10311 MSTI(4)=MINT(4)
10312 MSTI(5)=MINT(5)
10313 MSTI(6)=MINT(6)
10314 MSTI(7)=MINT(7)
10315 MSTI(8)=MINT(8)
10316 MSTI(13)=MINT(13)
10317 MSTI(14)=MINT(14)
10318 MSTI(21)=MINT(21)
10319 MSTI(22)=MINT(22)
10320 MSTI(23)=MINT(23)
10321 MSTI(24)=MINT(24)
10322 MSTI(25)=MINT(25)
10323 MSTI(26)=MINT(26)
10324 MSTI(31)=MINT(31)
10325 PARI(1)=XSEC(0,3)
10326 PARI(2)=XSEC(0,3)/MINT(5)
10327 PARI(31)=VINT(141)
10328 PARI(32)=VINT(142)
10329 IF(ISUB.NE.95.AND.MINT(7)*MINT(8).NE.0) THEN
10330 PARI(42)=2.*VINT(47)/VINT(1)
10331 DO 180 IS=7,8
10332 PARI(36+IS)=P(MINT(IS),3)/VINT(1)
10333 PARI(38+IS)=P(MINT(IS),4)/VINT(1)
10334 I=MINT(IS)
10335 PR=MAX(1E-20,P(I,5)**2+P(I,1)**2+P(I,2)**2)
10336 PARI(40+IS)=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/
10337 & SQRT(PR),1E20)),P(I,3))
10338 PR=MAX(1E-20,P(I,1)**2+P(I,2)**2)
10339 PARI(42+IS)=SIGN(LOG(MIN((SQRT(PR+P(I,3)**2)+ABS(P(I,3)))/
10340 & SQRT(PR),1E20)),P(I,3))
10341 PARI(44+IS)=P(I,3)/SQRT(P(I,1)**2+P(I,2)**2+P(I,3)**2)
10342 PARI(46+IS)=ULANGL(P(I,3),SQRT(P(I,1)**2+P(I,2)**2))
10343 PARI(48+IS)=ULANGL(P(I,1),P(I,2))
10344 180 CONTINUE
10345 ENDIF
10346 PARI(61)=VINT(148)
10347 IF(ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.3) THEN
10348 MSTU(161)=MINT(21)
10349 MSTU(162)=0
10350 ELSE
10351 MSTU(161)=MINT(21)
10352 MSTU(162)=MINT(22)
10353 ENDIF
10354 ENDIF
10355
10356
10357 MSTI(41)=IOVL
10358 IF(IOVL.GE.2.AND.IOVL.LE.10) MSTI(40+IOVL)=ISUB
10359 IF(MSTU(70).LT.10) THEN
10360 MSTU(70)=MSTU(70)+1
10361 MSTU(70+MSTU(70))=N
10362 ENDIF
10363 MINT(83)=N
10364 MINT(84)=N+MSTP(126)
10365 190 CONTINUE
10366
10367
10368 IF(MSTP(131).EQ.1.AND.MSTP(133).GE.1) THEN
10369 PARI(91)=VINT(132)
10370 PARI(92)=VINT(133)
10371 PARI(93)=VINT(134)
10372 IF(MSTP(133).EQ.2) PARI(93)=PARI(93)*XSEC(0,3)/VINT(131)
10373 ENDIF
10374
10375
10376 200 CALL PYFRAM(MSTP(124))
10377
10378 RETURN
10379 END
10380
10381
10382
10383 SUBROUTINE PYSTAT(MSTAT)
10384
10385
10386
10387 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
10388 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
10389 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
10390 COMMON/PYSUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
10391 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
10392 COMMON/PYINT1/MINT(400),VINT(400)
10393 COMMON/PYINT4/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3)
10394 COMMON/PYINT5/NGEN(0:200,3),XSEC(0:200,3)
10395 COMMON/PYINT6/PROC(0:200)
10396 CHARACTER PROC*28
10397 CHARACTER CHAU*16,CHPA(-40:40)*12,CHIN(2)*12,
10398 &STATE(-1:5)*4,CHKIN(21)*18
10399 SAVE
10400 DATA STATE/'----','off ','on ','on/+','on/-','on/1','on/2'/,
10401 &CHKIN/' m_hard (GeV/c^2) ',' p_T_hard (GeV/c) ',
10402 &'m_finite (GeV/c^2)',' y*_subsystem ',' y*_large ',
10403 &' y*_small ',' eta*_large ',' eta*_small ',
10404 &'cos(theta*)_large ','cos(theta*)_small ',' x_1 ',
10405 &' x_2 ',' x_F ',' cos(theta_hard) ',
10406 &'m''_hard (GeV/c^2) ',' tau ',' y* ',
10407 &'cos(theta_hard^-) ','cos(theta_hard^+) ',' x_T^2 ',
10408 &' tau'' '/
10409
10410
10411 IF(MSTAT.LE.1) THEN
10412 WRITE(MSTU(11),1000)
10413 WRITE(MSTU(11),1100)
10414 WRITE(MSTU(11),1200) 0,PROC(0),NGEN(0,3),NGEN(0,1),XSEC(0,3)
10415 DO 100 I=1,200
10416 IF(MSUB(I).NE.1) GOTO 100
10417 WRITE(MSTU(11),1200) I,PROC(I),NGEN(I,3),NGEN(I,1),XSEC(I,3)
10418 100 CONTINUE
10419 WRITE(MSTU(11),1300) 1.-FLOAT(NGEN(0,3))/
10420 & MAX(1.,FLOAT(NGEN(0,2)))
10421
10422
10423 ELSEIF(MSTAT.EQ.2) THEN
10424 DO 110 KF=-40,40
10425 CALL LUNAME(KF,CHAU)
10426 110 CHPA(KF)=CHAU(1:12)
10427 WRITE(MSTU(11),1400)
10428 WRITE(MSTU(11),1500)
10429
10430 DO 130 I=1,17
10431 KC=I
10432 IF(I.GE.9) KC=I+2
10433 IF(I.EQ.17) KC=21
10434 WRITE(MSTU(11),1600) CHPA(KC),0.,0.,STATE(MDCY(KC,1)),0.
10435 DO 120 J=1,MDCY(KC,3)
10436 IDC=J+MDCY(KC,2)-1
10437 120 IF(MDME(IDC,2).EQ.102) WRITE(MSTU(11),1700) CHPA(KFDP(IDC,1)),
10438 & CHPA(KFDP(IDC,2)),0.,0.,STATE(MDME(IDC,1)),0.
10439 130 CONTINUE
10440
10441 DO 150 I=1,6
10442 KC=I+22
10443 IF(I.EQ.4) KC=32
10444 IF(I.EQ.5) KC=37
10445 IF(I.EQ.6) KC=40
10446 IF(WIDE(KC,0).GT.0.) THEN
10447 WRITE(MSTU(11),1600) CHPA(KC),WIDP(KC,0),1.,
10448 & STATE(MDCY(KC,1)),1.
10449 DO 140 J=1,MDCY(KC,3)
10450 IDC=J+MDCY(KC,2)-1
10451 140 WRITE(MSTU(11),1700) CHPA(KFDP(IDC,1)),CHPA(KFDP(IDC,2)),
10452 & WIDP(KC,J),WIDP(KC,J)/WIDP(KC,0),STATE(MDME(IDC,1)),
10453 & WIDE(KC,J)/WIDE(KC,0)
10454 ELSE
10455 WRITE(MSTU(11),1600) CHPA(KC),WIDP(KC,0),1.,
10456 & STATE(MDCY(KC,1)),0.
10457 ENDIF
10458 150 CONTINUE
10459 WRITE(MSTU(11),1800)
10460
10461
10462 ELSEIF(MSTAT.EQ.3) THEN
10463 WRITE(MSTU(11),1900)
10464 CALL LUNAME(MINT(11),CHAU)
10465 CHIN(1)=CHAU(1:12)
10466 CALL LUNAME(MINT(12),CHAU)
10467 CHIN(2)=CHAU(1:12)
10468 WRITE(MSTU(11),2000) CHIN(1),CHIN(2)
10469 DO 160 KF=-40,40
10470 CALL LUNAME(KF,CHAU)
10471 160 CHPA(KF)=CHAU(1:12)
10472 IF(MINT(43).EQ.1) THEN
10473 WRITE(MSTU(11),2100) CHPA(MINT(11)),STATE(KFIN(1,MINT(11))),
10474 & CHPA(MINT(12)),STATE(KFIN(2,MINT(12)))
10475 ELSEIF(MINT(43).EQ.2) THEN
10476 WRITE(MSTU(11),2100) CHPA(MINT(11)),STATE(KFIN(1,MINT(11))),
10477 & CHPA(-MSTP(54)),STATE(KFIN(2,-MSTP(54)))
10478 DO 170 I=-MSTP(54)+1,-1
10479 170 WRITE(MSTU(11),2200) CHPA(I),STATE(KFIN(2,I))
10480 DO 180 I=1,MSTP(54)
10481 180 WRITE(MSTU(11),2200) CHPA(I),STATE(KFIN(2,I))
10482 WRITE(MSTU(11),2200) CHPA(21),STATE(KFIN(2,21))
10483 ELSEIF(MINT(43).EQ.3) THEN
10484 WRITE(MSTU(11),2100) CHPA(-MSTP(54)),STATE(KFIN(1,-MSTP(54))),
10485 & CHPA(MINT(12)),STATE(KFIN(2,MINT(12)))
10486 DO 190 I=-MSTP(54)+1,-1
10487 190 WRITE(MSTU(11),2300) CHPA(I),STATE(KFIN(1,I))
10488 DO 200 I=1,MSTP(54)
10489 200 WRITE(MSTU(11),2300) CHPA(I),STATE(KFIN(1,I))
10490 WRITE(MSTU(11),2300) CHPA(21),STATE(KFIN(1,21))
10491 ELSEIF(MINT(43).EQ.4) THEN
10492 DO 210 I=-MSTP(54),-1
10493 210 WRITE(MSTU(11),2100) CHPA(I),STATE(KFIN(1,I)),CHPA(I),
10494 & STATE(KFIN(2,I))
10495 DO 220 I=1,MSTP(54)
10496 220 WRITE(MSTU(11),2100) CHPA(I),STATE(KFIN(1,I)),CHPA(I),
10497 & STATE(KFIN(2,I))
10498 WRITE(MSTU(11),2100) CHPA(21),STATE(KFIN(1,21)),CHPA(21),
10499 & STATE(KFIN(2,21))
10500 ENDIF
10501 WRITE(MSTU(11),2400)
10502
10503
10504 ELSEIF(MSTAT.EQ.4) THEN
10505 WRITE(MSTU(11),2500)
10506 WRITE(MSTU(11),2600)
10507 SHRMAX=CKIN(2)
10508 IF(SHRMAX.LT.0.) SHRMAX=VINT(1)
10509 WRITE(MSTU(11),2700) CKIN(1),CHKIN(1),SHRMAX
10510 PTHMIN=MAX(CKIN(3),CKIN(5))
10511 PTHMAX=CKIN(4)
10512 IF(PTHMAX.LT.0.) PTHMAX=0.5*SHRMAX
10513 WRITE(MSTU(11),2800) CKIN(3),PTHMIN,CHKIN(2),PTHMAX
10514 WRITE(MSTU(11),2900) CHKIN(3),CKIN(6)
10515 DO 230 I=4,14
10516 230 WRITE(MSTU(11),2700) CKIN(2*I-1),CHKIN(I),CKIN(2*I)
10517 SPRMAX=CKIN(32)
10518 IF(SPRMAX.LT.0.) SPRMAX=VINT(1)
10519 WRITE(MSTU(11),2700) CKIN(31),CHKIN(13),SPRMAX
10520 WRITE(MSTU(11),3000)
10521 WRITE(MSTU(11),3100)
10522 WRITE(MSTU(11),2600)
10523 DO 240 I=16,21
10524 240 WRITE(MSTU(11),2700) VINT(I-5),CHKIN(I),VINT(I+15)
10525 WRITE(MSTU(11),3000)
10526
10527
10528 ELSEIF(MSTAT.EQ.5) THEN
10529 WRITE(MSTU(11),3200)
10530 WRITE(MSTU(11),3300)
10531 DO 250 I=1,100
10532 250 WRITE(MSTU(11),3400) I,MSTP(I),PARP(I),100+I,MSTP(100+I),
10533 & PARP(100+I)
10534 ENDIF
10535
10536
10537 1000 FORMAT('1',9('*'),1X,'PYSTAT: Statistics on Number of ',
10538 &'Events and Cross-sections',1X,9('*'))
10539 1100 FORMAT(/1X,78('=')/1X,'I',34X,'I',28X,'I',12X,'I'/1X,'I',12X,
10540 &'Subprocess',12X,'I',6X,'Number of points',6X,'I',4X,'Sigma',3X,
10541 &'I'/1X,'I',34X,'I',28X,'I',12X,'I'/1X,'I',34('-'),'I',28('-'),
10542 &'I',4X,'(mb)',4X,'I'/1X,'I',34X,'I',28X,'I',12X,'I'/1X,'I',1X,
10543 &'N:o',1X,'Type',25X,'I',4X,'Generated',9X,'Tried',1X,'I',12X,
10544 &'I'/1X,'I',34X,'I',28X,'I',12X,'I'/1X,78('=')/1X,'I',34X,'I',28X,
10545 &'I',12X,'I')
10546 1200 FORMAT(1X,'I',1X,I3,1X,A28,1X,'I',1X,I12,1X,I13,1X,'I',1X,1P,
10547 &E10.3,1X,'I')
10548 1300 FORMAT(1X,'I',34X,'I',28X,'I',12X,'I'/1X,78('=')//
10549 &1X,'********* Fraction of events that fail fragmentation ',
10550 &'cuts =',1X,F8.5,' *********'/)
10551 1400 FORMAT('1',17('*'),1X,'PYSTAT: Decay Widths and Branching ',
10552 &'Ratios',1X,17('*'))
10553 1500 FORMAT(/1X,78('=')/1X,'I',29X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/
10554 &1X,'I',1X,'Branching/Decay Channel',5X,'I',1X,'Width (GeV)',1X,
10555 &'I',7X,'B.R.',1X,'I',1X,'Stat',1X,'I',2X,'Eff. B.R.',1X,'I'/1X,
10556 &'I',29X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/1X,78('='))
10557 1600 FORMAT(1X,'I',29X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/1X,'I',1X,
10558 &A12,1X,'->',13X,'I',2X,1P,E10.3,0P,1X,'I',1X,1P,E10.3,0P,1X,'I',
10559 &1X,A4,1X,'I',1X,1P,E10.3,0P,1X,'I')
10560 1700 FORMAT(1X,'I',1X,A12,1X,'+',1X,A12,1X,'I',2X,1P,E10.3,0P,1X,'I',
10561 &1X,1P,E10.3,0P,1X,'I',1X,A4,1X,'I',1X,1P,E10.3,0P,1X,'I')
10562 1800 FORMAT(1X,'I',29X,'I',13X,'I',12X,'I',6X,'I',12X,'I'/1X,78('='))
10563 1900 FORMAT('1',7('*'),1X,'PYSTAT: Allowed Incoming Partons/',
10564 &'Particles at Hard Interaction',1X,7('*'))
10565 2000 FORMAT(/1X,78('=')/1X,'I',38X,'I',37X,'I'/1X,'I',1X,
10566 &'Beam particle:',1X,A,10X,'I',1X,'Target particle:',1X,A,7X,
10567 &'I'/1X,'I',38X,'I',37X,'I'/1X,'I',1X,'Content',9X,'State',16X,
10568 &'I',1X,'Content',9X,'State',15X,'I'/1X,'I',38X,'I',37X,'I'/1X,
10569 &78('=')/1X,'I',38X,'I',37X,'I')
10570 2100 FORMAT(1X,'I',1X,A,5X,A,16X,'I',1X,A,5X,A,15X,'I')
10571 2200 FORMAT(1X,'I',38X,'I',1X,A,5X,A,15X,'I')
10572 2300 FORMAT(1X,'I',1X,A,5X,A,16X,'I',37X,'I')
10573 2400 FORMAT(1X,'I',38X,'I',37X,'I'/1X,78('='))
10574 2500 FORMAT('1',12('*'),1X,'PYSTAT: User-Defined Limits on ',
10575 &'Kinematical Variables',1X,12('*'))
10576 2600 FORMAT(/1X,78('=')/1X,'I',76X,'I')
10577 2700 FORMAT(1X,'I',16X,1P,E10.3,0P,1X,'<',1X,A,1X,'<',1X,1P,E10.3,0P,
10578 &16X,'I')
10579 2800 FORMAT(1X,'I',3X,1P,E10.3,0P,1X,'(',1P,E10.3,0P,')',1X,'<',1X,A,
10580 &1X,'<',1X,1P,E10.3,0P,16X,'I')
10581 2900 FORMAT(1X,'I',29X,A,1X,'=',1X,1P,E10.3,0P,16X,'I')
10582 3000 FORMAT(1X,'I',76X,'I'/1X,78('='))
10583 3100 FORMAT(////1X,5('*'),1X,'PYSTAT: Derived Limits on Kinematical ',
10584 &'Variables Used in Generation',1X,5('*'))
10585 3200 FORMAT('1',12('*'),1X,'PYSTAT: Summary of Status Codes and ',
10586 &'Parameter Values',1X,12('*'))
10587 3300 FORMAT(/3X,'I',4X,'MSTP(I)',9X,'PARP(I)',20X,'I',4X,'MSTP(I)',9X,
10588 &'PARP(I)'/)
10589 3400 FORMAT(1X,I3,5X,I6,6X,1P,E10.3,0P,18X,I3,5X,I6,6X,1P,E10.3)
10590
10591 RETURN
10592 END
10593
10594
10595
10596 SUBROUTINE PYINKI(CHFRAM,CHBEAM,CHTARG,WIN)
10597
10598
10599
10600 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
10601 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
10602 COMMON/PYSUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
10603 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
10604 COMMON/PYINT1/MINT(400),VINT(400)
10605 CHARACTER CHFRAM*8,CHBEAM*8,CHTARG*8,CHCOM(3)*8,CHALP(2)*26,
10606 &CHIDNT(3)*8,CHTEMP*8,CHCDE(18)*8,CHINIT*76
10607 DIMENSION LEN(3),KCDE(18)
10608 SAVE
10609 DATA CHALP/'abcdefghijklmnopqrstuvwxyz',
10610 &'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/
10611 DATA CHCDE/'e- ','e+ ','nue ','nue~ ',
10612 &'mu- ','mu+ ','numu ','numu~ ','tau- ',
10613 &'tau+ ','nutau ','nutau~ ','pi+ ','pi- ',
10614 &'n ','n~ ','p ','p~ '/
10615 DATA KCDE/11,-11,12,-12,13,-13,14,-14,15,-15,16,-16,
10616 &211,-211,2112,-2112,2212,-2212/
10617
10618
10619 CHCOM(1)=CHFRAM
10620 CHCOM(2)=CHBEAM
10621 CHCOM(3)=CHTARG
10622 DO 120 I=1,3
10623 LEN(I)=8
10624 DO 100 LL=8,1,-1
10625 IF(LEN(I).EQ.LL.AND.CHCOM(I)(LL:LL).EQ.' ') LEN(I)=LL-1
10626 DO 100 LA=1,26
10627 100 IF(CHCOM(I)(LL:LL).EQ.CHALP(2)(LA:LA)) CHCOM(I)(LL:LL)=
10628 &CHALP(1)(LA:LA)
10629 CHIDNT(I)=CHCOM(I)
10630 DO 110 LL=1,6
10631 IF(CHIDNT(I)(LL:LL+2).EQ.'bar') THEN
10632 CHTEMP=CHIDNT(I)
10633 CHIDNT(I)=CHTEMP(1:LL-1)//'~'//CHTEMP(LL+3:8)//' '
10634 ENDIF
10635 110 CONTINUE
10636 DO 120 LL=1,8
10637 IF(CHIDNT(I)(LL:LL).EQ.'_') THEN
10638 CHTEMP=CHIDNT(I)
10639 CHIDNT(I)=CHTEMP(1:LL-1)//CHTEMP(LL+1:8)//' '
10640 ENDIF
10641 120 CONTINUE
10642
10643
10644 N=2
10645 DO 140 I=1,2
10646 K(I,2)=0
10647 DO 130 J=1,18
10648 130 IF(CHIDNT(I+1).EQ.CHCDE(J)) K(I,2)=KCDE(J)
10649 P(I,5)=ULMASS(K(I,2))
10650 MINT(40+I)=1
10651 IF(IABS(K(I,2)).GT.100) MINT(40+I)=2
10652 DO 140 J=1,5
10653 140 V(I,J)=0.
10654 IF(K(1,2).EQ.0) WRITE(MSTU(11),1000) CHBEAM(1:LEN(2))
10655 IF(K(2,2).EQ.0) WRITE(MSTU(11),1100) CHTARG(1:LEN(3))
10656 IF(K(1,2).EQ.0.OR.K(2,2).EQ.0) STOP
10657 DO 150 J=6,10
10658 150 VINT(J)=0.
10659 CHINIT=' '
10660
10661
10662 IF(CHCOM(1)(1:2).EQ.'cm') THEN
10663 IF(CHCOM(2)(1:1).NE.'e') THEN
10664 LOFFS=(34-(LEN(2)+LEN(3)))/2
10665 CHINIT(LOFFS+1:76)='PYTHIA will be initialized for a '//
10666 & CHCOM(2)(1:LEN(2))//'-'//CHCOM(3)(1:LEN(3))//' collider'//' '
10667 ELSE
10668 LOFFS=(33-(LEN(2)+LEN(3)))/2
10669 CHINIT(LOFFS+1:76)='PYTHIA will be initialized for an '//
10670 & CHCOM(2)(1:LEN(2))//'-'//CHCOM(3)(1:LEN(3))//' collider'//' '
10671 ENDIF
10672
10673
10674 S=WIN**2
10675 P(1,1)=0.
10676 P(1,2)=0.
10677 P(2,1)=0.
10678 P(2,2)=0.
10679 P(1,3)=SQRT(((S-P(1,5)**2-P(2,5)**2)**2-(2.*P(1,5)*P(2,5))**2)/
10680 & (4.*S))
10681 P(2,3)=-P(1,3)
10682 P(1,4)=SQRT(P(1,3)**2+P(1,5)**2)
10683 P(2,4)=SQRT(P(2,3)**2+P(2,5)**2)
10684
10685
10686 ELSEIF(CHCOM(1)(1:3).EQ.'fix') THEN
10687 LOFFS=(29-(LEN(2)+LEN(3)))/2
10688 CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '//
10689 & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))//
10690 & ' fixed target'//' '
10691
10692
10693 P(1,1)=0.
10694 P(1,2)=0.
10695 P(2,1)=0.
10696 P(2,2)=0.
10697 P(1,3)=WIN
10698 P(1,4)=SQRT(P(1,3)**2+P(1,5)**2)
10699 P(2,3)=0.
10700 P(2,4)=P(2,5)
10701 S=P(1,5)**2+P(2,5)**2+2.*P(2,4)*P(1,4)
10702 VINT(10)=P(1,3)/(P(1,4)+P(2,4))
10703 CALL LUROBO(0.,0.,0.,0.,-VINT(10))
10704
10705
10706
10707 ELSEIF(CHCOM(1)(1:3).EQ.'use') THEN
10708 LOFFS=(13-(LEN(1)+LEN(2)))/2
10709 CHINIT(LOFFS+1:76)='PYTHIA will be initialized for '//
10710 & CHCOM(2)(1:LEN(2))//' on '//CHCOM(3)(1:LEN(3))//
10711 & 'user-specified configuration'//' '
10712
10713
10714
10715
10716 P(1,4)=SQRT(P(1,1)**2+P(1,2)**2+P(1,3)**2+P(1,5)**2)
10717 P(2,4)=SQRT(P(2,1)**2+P(2,2)**2+P(2,3)**2+P(2,5)**2)
10718 DO 160 J=1,3
10719 160 VINT(7+J)=(DBLE(P(1,J))+DBLE(P(2,J)))/DBLE(P(1,4)+P(2,4))
10720 CALL LUROBO(0.,0.,-VINT(8),-VINT(9),-VINT(10))
10721 VINT(7)=ULANGL(P(1,1),P(1,2))
10722 CALL LUROBO(0.,-VINT(7),0.,0.,0.)
10723 VINT(6)=ULANGL(P(1,3),P(1,1))
10724 CALL LUROBO(-VINT(6),0.,0.,0.,0.)
10725 S=P(1,5)**2+P(2,5)**2+2.*(P(1,4)*P(2,4)-P(1,3)*P(2,3))
10726
10727
10728
10729 ELSE
10730 WRITE(MSTU(11),1800) CHFRAM(1:LEN(1))
10731 STOP
10732 ENDIF
10733 IF(S.LT.PARP(2)**2) THEN
10734 WRITE(MSTU(11),1900) SQRT(S)
10735 STOP
10736 ENDIF
10737
10738
10739 MINT(11)=K(1,2)
10740 MINT(12)=K(2,2)
10741 MINT(43)=2*MINT(41)+MINT(42)-2
10742 VINT(1)=SQRT(S)
10743 VINT(2)=S
10744 VINT(3)=P(1,5)
10745 VINT(4)=P(2,5)
10746 VINT(5)=P(1,3)
10747
10748
10749 IF(MSTP(82).LE.1) VINT(149)=4.*PARP(81)**2/S
10750 IF(MSTP(82).GE.2) VINT(149)=4.*PARP(82)**2/S
10751
10752
10753 1000 FORMAT(1X,'Error: unrecognized beam particle ''',A,'''.'/
10754 &1X,'Execution stopped!')
10755 1100 FORMAT(1X,'Error: unrecognized target particle ''',A,'''.'/
10756 &1X,'Execution stopped!')
10757
10758
10759
10760
10761
10762
10763
10764
10765
10766 1800 FORMAT(1X,'Error: unrecognized coordinate frame ''',A,'''.'/
10767 &1X,'Execution stopped!')
10768 1900 FORMAT(1X,'Error: too low CM energy,',F8.3,' GeV for event ',
10769 &'generation.'/1X,'Execution stopped!')
10770
10771 RETURN
10772 END
10773
10774
10775
10776 SUBROUTINE PYINRE
10777
10778
10779
10780
10781 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
10782 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
10783 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
10784 COMMON/PYSUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
10785 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
10786 COMMON/PYINT1/MINT(400),VINT(400)
10787 COMMON/PYINT2/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2)
10788 COMMON/PYINT4/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3)
10789 COMMON/PYINT6/PROC(0:200)
10790 CHARACTER PROC*28
10791 DIMENSION WDTP(0:40),WDTE(0:40,0:5)
10792 SAVE
10793
10794
10795 AEM=PARU(101)
10796 XW=PARU(102)
10797 DO 100 I=21,40
10798 DO 100 J=0,40
10799 WIDP(I,J)=0.
10800 100 WIDE(I,J)=0.
10801
10802
10803 WMAS=PMAS(24,1)
10804 WFAC=AEM/(24.*XW)*WMAS
10805 CALL PYWIDT(24,WMAS,WDTP,WDTE)
10806 WIDS(24,1)=((WDTE(0,1)+WDTE(0,2))*(WDTE(0,1)+WDTE(0,3))+
10807 &(WDTE(0,1)+WDTE(0,2)+WDTE(0,1)+WDTE(0,3))*(WDTE(0,4)+WDTE(0,5))+
10808 &2.*WDTE(0,4)*WDTE(0,5))/WDTP(0)**2
10809 WIDS(24,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0)
10810 WIDS(24,3)=(WDTE(0,1)+WDTE(0,3)+WDTE(0,4))/WDTP(0)
10811 DO 110 I=0,40
10812 WIDP(24,I)=WFAC*WDTP(I)
10813 110 WIDE(24,I)=WFAC*WDTE(I,0)
10814
10815
10816 HCMAS=PMAS(37,1)
10817 HCFAC=AEM/(8.*XW)*(HCMAS/WMAS)**2*HCMAS
10818 CALL PYWIDT(37,HCMAS,WDTP,WDTE)
10819 WIDS(37,1)=((WDTE(0,1)+WDTE(0,2))*(WDTE(0,1)+WDTE(0,3))+
10820 &(WDTE(0,1)+WDTE(0,2)+WDTE(0,1)+WDTE(0,3))*(WDTE(0,4)+WDTE(0,5))+
10821 &2.*WDTE(0,4)*WDTE(0,5))/WDTP(0)**2
10822 WIDS(37,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0)
10823 WIDS(37,3)=(WDTE(0,1)+WDTE(0,3)+WDTE(0,4))/WDTP(0)
10824 DO 120 I=0,40
10825 WIDP(37,I)=HCFAC*WDTP(I)
10826 120 WIDE(37,I)=HCFAC*WDTE(I,0)
10827
10828
10829 ZMAS=PMAS(23,1)
10830 ZFAC=AEM/(48.*XW*(1.-XW))*ZMAS
10831 CALL PYWIDT(23,ZMAS,WDTP,WDTE)
10832 WIDS(23,1)=((WDTE(0,1)+WDTE(0,2))**2+
10833 &2.*(WDTE(0,1)+WDTE(0,2))*(WDTE(0,4)+WDTE(0,5))+
10834 &2.*WDTE(0,4)*WDTE(0,5))/WDTP(0)**2
10835 WIDS(23,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0)
10836 WIDS(23,3)=0.
10837 DO 130 I=0,40
10838 WIDP(23,I)=ZFAC*WDTP(I)
10839 130 WIDE(23,I)=ZFAC*WDTE(I,0)
10840
10841
10842 HMAS=PMAS(25,1)
10843 HFAC=AEM/(8.*XW)*(HMAS/WMAS)**2*HMAS
10844 CALL PYWIDT(25,HMAS,WDTP,WDTE)
10845 WIDS(25,1)=((WDTE(0,1)+WDTE(0,2))**2+
10846 &2.*(WDTE(0,1)+WDTE(0,2))*(WDTE(0,4)+WDTE(0,5))+
10847 &2.*WDTE(0,4)*WDTE(0,5))/WDTP(0)**2
10848 WIDS(25,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0)
10849 WIDS(25,3)=0.
10850 DO 140 I=0,40
10851 WIDP(25,I)=HFAC*WDTP(I)
10852 140 WIDE(25,I)=HFAC*WDTE(I,0)
10853
10854
10855 ZPMAS=PMAS(32,1)
10856 ZPFAC=AEM/(48.*XW*(1.-XW))*ZPMAS
10857 CALL PYWIDT(32,ZPMAS,WDTP,WDTE)
10858 WIDS(32,1)=((WDTE(0,1)+WDTE(0,2)+WDTE(0,3))**2+
10859 &2.*(WDTE(0,1)+WDTE(0,2))*(WDTE(0,4)+WDTE(0,5))+
10860 &2.*WDTE(0,4)*WDTE(0,5))/WDTP(0)**2
10861 WIDS(32,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0)
10862 WIDS(32,3)=0.
10863 DO 150 I=0,40
10864 WIDP(32,I)=ZPFAC*WDTP(I)
10865 150 WIDE(32,I)=ZPFAC*WDTE(I,0)
10866
10867
10868 RMAS=PMAS(40,1)
10869 RFAC=0.08*RMAS/((MSTP(1)-1)*(1.+6.*(1.+ULALPS(RMAS**2)/PARU(1))))
10870 CALL PYWIDT(40,RMAS,WDTP,WDTE)
10871 WIDS(40,1)=((WDTE(0,1)+WDTE(0,2))*(WDTE(0,1)+WDTE(0,3))+
10872 &(WDTE(0,1)+WDTE(0,2)+WDTE(0,1)+WDTE(0,3))*(WDTE(0,4)+WDTE(0,5))+
10873 &2.*WDTE(0,4)*WDTE(0,5))/WDTP(0)**2
10874 WIDS(40,2)=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))/WDTP(0)
10875 WIDS(40,3)=(WDTE(0,1)+WDTE(0,3)+WDTE(0,4))/WDTP(0)
10876 DO 160 I=0,40
10877 WIDP(40,I)=WFAC*WDTP(I)
10878 160 WIDE(40,I)=WFAC*WDTE(I,0)
10879
10880
10881 KFLQM=1
10882 DO 170 I=1,MIN(8,MDCY(21,3))
10883 IDC=I+MDCY(21,2)-1
10884 IF(MDME(IDC,1).LE.0) GOTO 170
10885 KFLQM=I
10886 170 CONTINUE
10887 MINT(46)=KFLQM
10888 KFPR(81,1)=KFLQM
10889 KFPR(81,2)=KFLQM
10890 KFPR(82,1)=KFLQM
10891 KFPR(82,2)=KFLQM
10892
10893
10894 DO 180 I=1,6
10895 IF(I.LE.3) KC=I+22
10896 IF(I.EQ.4) KC=32
10897 IF(I.EQ.5) KC=37
10898 IF(I.EQ.6) KC=40
10899 PMAS(KC,2)=WIDP(KC,0)
10900 PMAS(KC,3)=MIN(0.9*PMAS(KC,1),10.*PMAS(KC,2))
10901 DO 180 J=1,MDCY(KC,3)
10902 IDC=J+MDCY(KC,2)-1
10903 BRAT(IDC)=WIDE(KC,J)/WIDE(KC,0)
10904 180 CONTINUE
10905
10906
10907 IF(MSTP(43).EQ.1) THEN
10908 PROC(1)='f + fb -> gamma*'
10909 ELSEIF(MSTP(43).EQ.2) THEN
10910 PROC(1)='f + fb -> Z0'
10911 ELSEIF(MSTP(43).EQ.3) THEN
10912 PROC(1)='f + fb -> gamma*/Z0'
10913 ENDIF
10914
10915
10916 IF(MSTP(44).EQ.1) THEN
10917 PROC(141)='f + fb -> gamma*'
10918 ELSEIF(MSTP(44).EQ.2) THEN
10919 PROC(141)='f + fb -> Z0'
10920 ELSEIF(MSTP(44).EQ.3) THEN
10921 PROC(141)='f + fb -> Z''0'
10922 ELSEIF(MSTP(44).EQ.4) THEN
10923 PROC(141)='f + fb -> gamma*/Z0'
10924 ELSEIF(MSTP(44).EQ.5) THEN
10925 PROC(141)='f + fb -> gamma*/Z''0'
10926 ELSEIF(MSTP(44).EQ.6) THEN
10927 PROC(141)='f + fb -> Z0/Z''0'
10928 ELSEIF(MSTP(44).EQ.7) THEN
10929 PROC(141)='f + fb -> gamma*/Z0/Z''0'
10930 ENDIF
10931
10932 RETURN
10933 END
10934
10935
10936
10937 SUBROUTINE PYXTOT
10938
10939
10940
10941 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
10942 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
10943 COMMON/PYINT1/MINT(400),VINT(400)
10944 COMMON/PYINT5/NGEN(0:200,3),XSEC(0:200,3)
10945 DIMENSION BCS(5,8),BCB(2,5),BCC(3)
10946 SAVE
10947
10948
10949
10950
10951 DATA ((BCS(I,J),J=1,8),I=1,5)/
10952 1 41.74, 0.66, 0.0000, 337., 0.0, 0.0, -39.3, 0.48,
10953 2 41.66, 0.60, 0.0000, 306., 0.0, 0.0, -34.6, 0.51,
10954 3 41.36, 0.63, 0.0000, 299., 7.3, 0.5, -40.4, 0.47,
10955 4 41.68, 0.63, 0.0083, 330., 0.0, 0.0, -39.0, 0.48,
10956 5 41.13, 0.59, 0.0074, 278., 10.5, 0.5, -41.2, 0.46/
10957 DATA ((BCB(I,J),J=1,5),I=1,2)/
10958 1 10.79, -0.049, 0.040, 21.5, 1.23,
10959 2 9.92, -0.027, 0.013, 18.9, 1.07/
10960 DATA BCC/2.0164346,-0.5590311,0.0376279/
10961
10962
10963 NFIT=MIN(5,MAX(1,MSTP(31)))
10964 SIGP=BCS(NFIT,1)+BCS(NFIT,2)*(-0.25*PARU(1)**2*
10965 &(1.-0.25*BCS(NFIT,3)*PARU(1)**2)+(1.+0.5*BCS(NFIT,3)*PARU(1)**2)*
10966 &(LOG(VINT(2)/BCS(NFIT,4)))**2+BCS(NFIT,3)*
10967 &(LOG(VINT(2)/BCS(NFIT,4)))**4)/
10968 &((1.-0.25*BCS(NFIT,3)*PARU(1)**2)**2+2.*BCS(NFIT,3)*
10969 &(1.+0.25*BCS(NFIT,3)*PARU(1)**2)*(LOG(VINT(2)/BCS(NFIT,4)))**2+
10970 &BCS(NFIT,3)**2*(LOG(VINT(2)/BCS(NFIT,4)))**4)+BCS(NFIT,5)*
10971 &VINT(2)**(BCS(NFIT,6)-1.)*SIN(0.5*PARU(1)*BCS(NFIT,6))
10972 SIGM=-BCS(NFIT,7)*VINT(2)**(BCS(NFIT,8)-1.)*
10973 &COS(0.5*PARU(1)*BCS(NFIT,8))
10974 REFP=BCS(NFIT,2)*PARU(1)*LOG(VINT(2)/BCS(NFIT,4))/
10975 &((1.-0.25*BCS(NFIT,3)*PARU(1)**2)**2+2.*BCS(NFIT,3)*
10976 &(1.+0.25*BCS(NFIT,3)*PARU(1)**2)+(LOG(VINT(2)/BCS(NFIT,4)))**2+
10977 &BCS(NFIT,3)**2*(LOG(VINT(2)/BCS(NFIT,4)))**4)-BCS(NFIT,5)*
10978 &VINT(2)**(BCS(NFIT,6)-1.)*COS(0.5*PARU(1)*BCS(NFIT,6))
10979 REFM=-BCS(NFIT,7)*VINT(2)**(BCS(NFIT,8)-1.)*
10980 &SIN(0.5*PARU(1)*BCS(NFIT,8))
10981 SIGMA=SIGP-ISIGN(1,MINT(11)*MINT(12))*SIGM
10982 RHO=(REFP-ISIGN(1,MINT(11)*MINT(12))*REFM)/SIGMA
10983
10984
10985 NFIT=1
10986 IF(MSTP(31).GE.4) NFIT=2
10987 BP=BCB(NFIT,1)+BCB(NFIT,2)*LOG(VINT(2))+
10988 &BCB(NFIT,3)*(LOG(VINT(2)))**2
10989 BM=BCB(NFIT,4)+BCB(NFIT,5)*LOG(VINT(2))
10990 B=BP-ISIGN(1,MINT(11)*MINT(12))*SIGM/SIGP*(BM-BP)
10991 VINT(121)=B
10992 C=-0.5*BCC(2)/BCC(3)*(1.-SQRT(MAX(0.,1.+4.*BCC(3)/BCC(2)**2*
10993 &(1.E-03*VINT(1)-BCC(1)))))
10994 VINT(122)=C
10995
10996
10997 SIGEL=SIGMA**2*(1.+RHO**2)/(16.*PARU(1)*PARU(5)*B)
10998
10999
11000 SIGSD=2.*0.68*(1.+36./VINT(2))*LOG(0.6+0.1*VINT(2))
11001
11002
11003
11004 SIGDD=SIGSD**2/(3.*SIGEL)
11005
11006
11007 SIGND=SIGMA-SIGDD-SIGSD-SIGEL
11008
11009
11010 IF(IABS(MINT(11)).EQ.211.AND.IABS(MINT(12)).EQ.211) THEN
11011 SIGMA=4./9.*SIGMA
11012 SIGDD=4./9.*SIGDD
11013 SIGSD=4./9.*SIGSD
11014 SIGEL=4./9.*SIGEL
11015 SIGND=4./9.*SIGND
11016 ELSEIF(IABS(MINT(11)).EQ.211.OR.IABS(MINT(12)).EQ.211) THEN
11017 SIGMA=2./3.*SIGMA
11018 SIGDD=2./3.*SIGDD
11019 SIGSD=2./3.*SIGSD
11020 SIGEL=2./3.*SIGEL
11021 SIGND=2./3.*SIGND
11022 ENDIF
11023
11024
11025 VINT(101)=SIGMA
11026 VINT(102)=SIGEL
11027 VINT(103)=SIGSD
11028 VINT(104)=SIGDD
11029 VINT(106)=SIGND
11030 XSEC(95,1)=SIGND
11031
11032 RETURN
11033 END
11034
11035
11036
11037 SUBROUTINE PYMAXI
11038
11039
11040
11041
11042 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
11043 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
11044 COMMON/PYSUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
11045 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
11046 COMMON/PYINT1/MINT(400),VINT(400)
11047 COMMON/PYINT2/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2)
11048 COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000)
11049 COMMON/PYINT4/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3)
11050 COMMON/PYINT5/NGEN(0:200,3),XSEC(0:200,3)
11051 COMMON/PYINT6/PROC(0:200)
11052 CHARACTER PROC*28
11053 CHARACTER CVAR(4)*4
11054 DIMENSION NPTS(4),MVARPT(200,4),VINTPT(200,30),SIGSPT(200),
11055 &NAREL(6),WTREL(6),WTMAT(6,6),COEFU(6),IACCMX(4),SIGSMX(4),
11056 &SIGSSM(3)
11057 SAVE
11058 DATA CVAR/'tau ','tau''','y* ','cth '/
11059
11060
11061 VINT(143)=1.
11062 VINT(144)=1.
11063 XSEC(0,1)=0.
11064 DO 350 ISUB=1,200
11065 IF(ISUB.GE.91.AND.ISUB.LE.95) THEN
11066 XSEC(ISUB,1)=VINT(ISUB+11)
11067 IF(MSUB(ISUB).NE.1) GOTO 350
11068 GOTO 340
11069 ELSEIF(ISUB.EQ.96) THEN
11070 IF(MINT(43).NE.4) GOTO 350
11071 IF(MSUB(95).NE.1.AND.MSTP(81).LE.0.AND.MSTP(131).LE.0) GOTO 350
11072 ELSEIF(ISUB.EQ.11.OR.ISUB.EQ.12.OR.ISUB.EQ.13.OR.ISUB.EQ.28.OR.
11073 &ISUB.EQ.53.OR.ISUB.EQ.68) THEN
11074 IF(MSUB(ISUB).NE.1.OR.MSUB(95).EQ.1) GOTO 350
11075 ELSE
11076 IF(MSUB(ISUB).NE.1) GOTO 350
11077 ENDIF
11078 MINT(1)=ISUB
11079 ISTSB=ISET(ISUB)
11080 IF(ISUB.EQ.96) ISTSB=2
11081 IF(MSTP(122).GE.2) WRITE(MSTU(11),1000) ISUB
11082
11083
11084 MINT(72)=0
11085 KFR1=0
11086 IF(ISTSB.EQ.1.OR.ISTSB.EQ.3) THEN
11087 KFR1=KFPR(ISUB,1)
11088 ELSEIF(ISUB.GE.71.AND.ISUB.LE.77) THEN
11089 KFR1=25
11090 ENDIF
11091 IF(KFR1.NE.0) THEN
11092 TAUR1=PMAS(KFR1,1)**2/VINT(2)
11093 GAMR1=PMAS(KFR1,1)*PMAS(KFR1,2)/VINT(2)
11094 MINT(72)=1
11095 MINT(73)=KFR1
11096 VINT(73)=TAUR1
11097 VINT(74)=GAMR1
11098 ENDIF
11099 IF(ISUB.EQ.141) THEN
11100 KFR2=23
11101 TAUR2=PMAS(KFR2,1)**2/VINT(2)
11102 GAMR2=PMAS(KFR2,1)*PMAS(KFR2,2)/VINT(2)
11103 MINT(72)=2
11104 MINT(74)=KFR2
11105 VINT(75)=TAUR2
11106 VINT(76)=GAMR2
11107 ENDIF
11108
11109
11110 SQM3=0.
11111 SQM4=0.
11112 MINT(71)=0
11113 VINT(71)=CKIN(3)
11114 IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN
11115 IF(KFPR(ISUB,1).NE.0) SQM3=PMAS(KFPR(ISUB,1),1)**2
11116 IF(KFPR(ISUB,2).NE.0) SQM4=PMAS(KFPR(ISUB,2),1)**2
11117 IF(MIN(SQM3,SQM4).LT.CKIN(6)**2) MINT(71)=1
11118 IF(MINT(71).EQ.1) VINT(71)=MAX(CKIN(3),CKIN(5))
11119 IF(ISUB.EQ.96.AND.MSTP(82).LE.1) VINT(71)=PARP(81)
11120 IF(ISUB.EQ.96.AND.MSTP(82).GE.2) VINT(71)=0.08*PARP(82)
11121 ENDIF
11122 VINT(63)=SQM3
11123 VINT(64)=SQM4
11124
11125
11126 NPTS(1)=2+2*MINT(72)
11127 IF(MINT(43).EQ.1.AND.(ISTSB.EQ.1.OR.ISTSB.EQ.2)) NPTS(1)=1
11128 NPTS(2)=1
11129 IF(MINT(43).GE.2.AND.(ISTSB.EQ.3.OR.ISTSB.EQ.4)) NPTS(2)=2
11130 NPTS(3)=1
11131 IF(MINT(43).EQ.4) NPTS(3)=3
11132 NPTS(4)=1
11133 IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) NPTS(4)=5
11134 NTRY=NPTS(1)*NPTS(2)*NPTS(3)*NPTS(4)
11135
11136
11137 DO 100 J=1,20
11138 100 COEF(ISUB,J)=0.
11139 COEF(ISUB,1)=1.
11140 COEF(ISUB,7)=0.5
11141 COEF(ISUB,8)=0.5
11142 COEF(ISUB,10)=1.
11143 COEF(ISUB,15)=1.
11144 MCTH=0
11145 MTAUP=0
11146 CTH=0.
11147 TAUP=0.
11148 SIGSAM=0.
11149
11150
11151
11152 CALL PYKLIM(1)
11153 NACC=0
11154 DO 120 ITRY=1,NTRY
11155 IF(MOD(ITRY-1,NPTS(2)*NPTS(3)*NPTS(4)).EQ.0) THEN
11156 MTAU=1+(ITRY-1)/(NPTS(2)*NPTS(3)*NPTS(4))
11157 CALL PYKMAP(1,MTAU,0.5)
11158 IF(ISTSB.EQ.3.OR.ISTSB.EQ.4) CALL PYKLIM(4)
11159 ENDIF
11160 IF((ISTSB.EQ.3.OR.ISTSB.EQ.4).AND.MOD(ITRY-1,NPTS(3)*NPTS(4)).
11161 &EQ.0) THEN
11162 MTAUP=1+MOD((ITRY-1)/(NPTS(3)*NPTS(4)),NPTS(2))
11163 CALL PYKMAP(4,MTAUP,0.5)
11164 ENDIF
11165 IF(MOD(ITRY-1,NPTS(3)*NPTS(4)).EQ.0) CALL PYKLIM(2)
11166 IF(MOD(ITRY-1,NPTS(4)).EQ.0) THEN
11167 MYST=1+MOD((ITRY-1)/NPTS(4),NPTS(3))
11168 CALL PYKMAP(2,MYST,0.5)
11169 CALL PYKLIM(3)
11170 ENDIF
11171 IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN
11172 MCTH=1+MOD(ITRY-1,NPTS(4))
11173 CALL PYKMAP(3,MCTH,0.5)
11174 ENDIF
11175 IF(ISUB.EQ.96) VINT(25)=VINT(21)*(1.-VINT(23)**2)
11176
11177
11178 MINT(51)=0
11179 CALL PYKLIM(0)
11180 IF(MINT(51).EQ.1) GOTO 120
11181 NACC=NACC+1
11182 MVARPT(NACC,1)=MTAU
11183 MVARPT(NACC,2)=MTAUP
11184 MVARPT(NACC,3)=MYST
11185 MVARPT(NACC,4)=MCTH
11186 DO 110 J=1,30
11187 110 VINTPT(NACC,J)=VINT(10+J)
11188 CALL PYSIGH(NCHN,SIGS)
11189 SIGSPT(NACC)=SIGS
11190 IF(SIGS.GT.SIGSAM) SIGSAM=SIGS
11191 IF(MSTP(122).GE.2) WRITE(MSTU(11),1100) MTAU,MTAUP,MYST,MCTH,
11192 &VINT(21),VINT(22),VINT(23),VINT(26),SIGS
11193 120 CONTINUE
11194 IF(SIGSAM.EQ.0.) THEN
11195 WRITE(MSTU(11),1200) ISUB
11196 STOP
11197 ENDIF
11198
11199
11200 TAUMIN=VINT(11)
11201 TAUMAX=VINT(31)
11202 ATAU1=LOG(TAUMAX/TAUMIN)
11203 ATAU2=(TAUMAX-TAUMIN)/(TAUMAX*TAUMIN)
11204 IF(NPTS(1).GE.3) THEN
11205 ATAU3=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR1)/(TAUMAX+TAUR1))/TAUR1
11206 ATAU4=(ATAN((TAUMAX-TAUR1)/GAMR1)-ATAN((TAUMIN-TAUR1)/GAMR1))/
11207 & GAMR1
11208 ENDIF
11209 IF(NPTS(1).GE.5) THEN
11210 ATAU5=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR2)/(TAUMAX+TAUR2))/TAUR2
11211 ATAU6=(ATAN((TAUMAX-TAUR2)/GAMR2)-ATAN((TAUMIN-TAUR2)/GAMR2))/
11212 & GAMR2
11213 ENDIF
11214 YSTMIN=0.5*LOG(TAUMIN)
11215 YSTMAX=-YSTMIN
11216 AYST0=YSTMAX-YSTMIN
11217 AYST1=0.5*(YSTMAX-YSTMIN)**2
11218 AYST3=2.*(ATAN(EXP(YSTMAX))-ATAN(EXP(YSTMIN)))
11219
11220
11221 DO 230 IVAR=1,4
11222 IF(NPTS(IVAR).EQ.1) GOTO 230
11223 IF(ISUB.EQ.96.AND.IVAR.EQ.4) GOTO 230
11224 NBIN=NPTS(IVAR)
11225 DO 130 J1=1,NBIN
11226 NAREL(J1)=0
11227 WTREL(J1)=0.
11228 COEFU(J1)=0.
11229 DO 130 J2=1,NBIN
11230 130 WTMAT(J1,J2)=0.
11231 DO 140 IACC=1,NACC
11232 IBIN=MVARPT(IACC,IVAR)
11233 NAREL(IBIN)=NAREL(IBIN)+1
11234 WTREL(IBIN)=WTREL(IBIN)+SIGSPT(IACC)
11235
11236
11237 IF(IVAR.EQ.1) THEN
11238 TAU=VINTPT(IACC,11)
11239 WTMAT(IBIN,1)=WTMAT(IBIN,1)+1.
11240 WTMAT(IBIN,2)=WTMAT(IBIN,2)+(ATAU1/ATAU2)/TAU
11241 IF(NBIN.GE.3) THEN
11242 WTMAT(IBIN,3)=WTMAT(IBIN,3)+(ATAU1/ATAU3)/(TAU+TAUR1)
11243 WTMAT(IBIN,4)=WTMAT(IBIN,4)+(ATAU1/ATAU4)*TAU/
11244 & ((TAU-TAUR1)**2+GAMR1**2)
11245 ENDIF
11246 IF(NBIN.GE.5) THEN
11247 WTMAT(IBIN,5)=WTMAT(IBIN,5)+(ATAU1/ATAU5)/(TAU+TAUR2)
11248 WTMAT(IBIN,6)=WTMAT(IBIN,6)+(ATAU1/ATAU6)*TAU/
11249 & ((TAU-TAUR2)**2+GAMR2**2)
11250 ENDIF
11251
11252
11253 ELSEIF(IVAR.EQ.2) THEN
11254 TAU=VINTPT(IACC,11)
11255 TAUP=VINTPT(IACC,16)
11256 TAUPMN=VINTPT(IACC,6)
11257 TAUPMX=VINTPT(IACC,26)
11258 ATAUP1=LOG(TAUPMX/TAUPMN)
11259 ATAUP2=((1.-TAU/TAUPMX)**4-(1.-TAU/TAUPMN)**4)/(4.*TAU)
11260 WTMAT(IBIN,1)=WTMAT(IBIN,1)+1.
11261 WTMAT(IBIN,2)=WTMAT(IBIN,2)+(ATAUP1/ATAUP2)*(1.-TAU/TAUP)**3/
11262 & TAUP
11263
11264
11265 ELSEIF(IVAR.EQ.3) THEN
11266 YST=VINTPT(IACC,12)
11267 WTMAT(IBIN,1)=WTMAT(IBIN,1)+(AYST0/AYST1)*(YST-YSTMIN)
11268 WTMAT(IBIN,2)=WTMAT(IBIN,2)+(AYST0/AYST1)*(YSTMAX-YST)
11269 WTMAT(IBIN,3)=WTMAT(IBIN,3)+(AYST0/AYST3)/COSH(YST)
11270 ELSE
11271 RM34=2.*SQM3*SQM4/(VINTPT(IACC,11)*VINT(2))**2
11272 RSQM=1.+RM34
11273 CTHMAX=SQRT(1.-4.*VINT(71)**2/(TAUMAX*VINT(2)))
11274 CTHMIN=-CTHMAX
11275 IF(CTHMAX.GT.0.9999) RM34=MAX(RM34,2.*VINT(71)**2/
11276 & (TAUMAX*VINT(2)))
11277 ACTH1=CTHMAX-CTHMIN
11278 ACTH2=LOG(MAX(RM34,RSQM-CTHMIN)/MAX(RM34,RSQM-CTHMAX))
11279 ACTH3=LOG(MAX(RM34,RSQM+CTHMAX)/MAX(RM34,RSQM+CTHMIN))
11280 ACTH4=1./MAX(RM34,RSQM-CTHMAX)-1./MAX(RM34,RSQM-CTHMIN)
11281 ACTH5=1./MAX(RM34,RSQM+CTHMIN)-1./MAX(RM34,RSQM+CTHMAX)
11282 CTH=VINTPT(IACC,13)
11283 WTMAT(IBIN,1)=WTMAT(IBIN,1)+1.
11284 WTMAT(IBIN,2)=WTMAT(IBIN,2)+(ACTH1/ACTH2)/MAX(RM34,RSQM-CTH)
11285 WTMAT(IBIN,3)=WTMAT(IBIN,3)+(ACTH1/ACTH3)/MAX(RM34,RSQM+CTH)
11286 WTMAT(IBIN,4)=WTMAT(IBIN,4)+(ACTH1/ACTH4)/MAX(RM34,RSQM-CTH)**2
11287 WTMAT(IBIN,5)=WTMAT(IBIN,5)+(ACTH1/ACTH5)/MAX(RM34,RSQM+CTH)**2
11288 ENDIF
11289 140 CONTINUE
11290
11291
11292 IF(MSTP(122).GE.2) WRITE(MSTU(11),1300) CVAR(IVAR)
11293 MSOLV=1
11294 DO 150 IBIN=1,NBIN
11295 IF(MSTP(122).GE.2) WRITE(MSTU(11),1400) (WTMAT(IBIN,IRED),
11296 &IRED=1,NBIN),WTREL(IBIN)
11297 150 IF(NAREL(IBIN).EQ.0) MSOLV=0
11298 IF(MSOLV.EQ.0) THEN
11299 DO 160 IBIN=1,NBIN
11300 160 COEFU(IBIN)=1.
11301
11302
11303 ELSE
11304 DO 170 IRED=1,NBIN-1
11305 DO 170 IBIN=IRED+1,NBIN
11306 RQT=WTMAT(IBIN,IRED)/WTMAT(IRED,IRED)
11307 WTREL(IBIN)=WTREL(IBIN)-RQT*WTREL(IRED)
11308 DO 170 ICOE=IRED,NBIN
11309 170 WTMAT(IBIN,ICOE)=WTMAT(IBIN,ICOE)-RQT*WTMAT(IRED,ICOE)
11310 DO 190 IRED=NBIN,1,-1
11311 DO 180 ICOE=IRED+1,NBIN
11312 180 WTREL(IRED)=WTREL(IRED)-WTMAT(IRED,ICOE)*COEFU(ICOE)
11313 190 COEFU(IRED)=WTREL(IRED)/WTMAT(IRED,IRED)
11314 ENDIF
11315
11316
11317 COEFSU=0.
11318 DO 200 IBIN=1,NBIN
11319 COEFU(IBIN)=MAX(0.,COEFU(IBIN))
11320 200 COEFSU=COEFSU+COEFU(IBIN)
11321 IF(IVAR.EQ.1) IOFF=0
11322 IF(IVAR.EQ.2) IOFF=14
11323 IF(IVAR.EQ.3) IOFF=6
11324 IF(IVAR.EQ.4) IOFF=9
11325 IF(COEFSU.GT.0.) THEN
11326 DO 210 IBIN=1,NBIN
11327 210 COEF(ISUB,IOFF+IBIN)=PARP(121)/NBIN+(1.-PARP(121))*COEFU(IBIN)/
11328 & COEFSU
11329 ELSE
11330 DO 220 IBIN=1,NBIN
11331 220 COEF(ISUB,IOFF+IBIN)=1./NBIN
11332 ENDIF
11333 IF(MSTP(122).GE.2) WRITE(MSTU(11),1500) CVAR(IVAR),
11334 &(COEF(ISUB,IOFF+IBIN),IBIN=1,NBIN)
11335 230 CONTINUE
11336
11337
11338 DO 240 J=1,4
11339 IACCMX(J)=0
11340 240 SIGSMX(J)=0.
11341 NMAX=0
11342 DO 290 IACC=1,NACC
11343 DO 250 J=1,30
11344 250 VINT(10+J)=VINTPT(IACC,J)
11345 CALL PYSIGH(NCHN,SIGS)
11346 IEQ=0
11347 DO 260 IMV=1,NMAX
11348 260 IF(ABS(SIGS-SIGSMX(IMV)).LT.1E-4*(SIGS+SIGSMX(IMV))) IEQ=IMV
11349 IF(IEQ.EQ.0) THEN
11350 DO 270 IMV=NMAX,1,-1
11351 IIN=IMV+1
11352 IF(SIGS.LE.SIGSMX(IMV)) GOTO 280
11353 IACCMX(IMV+1)=IACCMX(IMV)
11354 270 SIGSMX(IMV+1)=SIGSMX(IMV)
11355 IIN=1
11356 280 IACCMX(IIN)=IACC
11357 SIGSMX(IIN)=SIGS
11358 IF(NMAX.LE.1) NMAX=NMAX+1
11359 ENDIF
11360 290 CONTINUE
11361
11362
11363 IF(MSTP(122).GE.2) WRITE(MSTU(11),1600)
11364 SIGSAM=SIGSMX(1)
11365 DO 330 IMAX=1,NMAX
11366 IACC=IACCMX(IMAX)
11367 MTAU=MVARPT(IACC,1)
11368 MTAUP=MVARPT(IACC,2)
11369 MYST=MVARPT(IACC,3)
11370 MCTH=MVARPT(IACC,4)
11371 VTAU=0.5
11372 VYST=0.5
11373 VCTH=0.5
11374 VTAUP=0.5
11375
11376
11377 DO 320 IRPT=1,2
11378 DO 310 IVAR=1,4
11379 IF(NPTS(IVAR).EQ.1) GOTO 310
11380 IF(IVAR.EQ.1) VVAR=VTAU
11381 IF(IVAR.EQ.2) VVAR=VTAUP
11382 IF(IVAR.EQ.3) VVAR=VYST
11383 IF(IVAR.EQ.4) VVAR=VCTH
11384 IF(IVAR.EQ.1) MVAR=MTAU
11385 IF(IVAR.EQ.2) MVAR=MTAUP
11386 IF(IVAR.EQ.3) MVAR=MYST
11387 IF(IVAR.EQ.4) MVAR=MCTH
11388 IF(IRPT.EQ.1) VDEL=0.1
11389 IF(IRPT.EQ.2) VDEL=MAX(0.01,MIN(0.05,VVAR-0.02,0.98-VVAR))
11390 IF(IRPT.EQ.1) VMAR=0.02
11391 IF(IRPT.EQ.2) VMAR=0.002
11392 IMOV0=1
11393 IF(IRPT.EQ.1.AND.IVAR.EQ.1) IMOV0=0
11394 DO 300 IMOV=IMOV0,8
11395
11396
11397 IF(IMOV.EQ.0) THEN
11398 INEW=2
11399 VNEW=VVAR
11400 ELSEIF(IMOV.EQ.1) THEN
11401 INEW=3
11402 VNEW=VVAR+VDEL
11403 ELSEIF(IMOV.EQ.2) THEN
11404 INEW=1
11405 VNEW=VVAR-VDEL
11406 ELSEIF(SIGSSM(3).GE.MAX(SIGSSM(1),SIGSSM(2)).AND.
11407 &VVAR+2.*VDEL.LT.1.-VMAR) THEN
11408 VVAR=VVAR+VDEL
11409 SIGSSM(1)=SIGSSM(2)
11410 SIGSSM(2)=SIGSSM(3)
11411 INEW=3
11412 VNEW=VVAR+VDEL
11413 ELSEIF(SIGSSM(1).GE.MAX(SIGSSM(2),SIGSSM(3)).AND.
11414 &VVAR-2.*VDEL.GT.VMAR) THEN
11415 VVAR=VVAR-VDEL
11416 SIGSSM(3)=SIGSSM(2)
11417 SIGSSM(2)=SIGSSM(1)
11418 INEW=1
11419 VNEW=VVAR-VDEL
11420 ELSEIF(SIGSSM(3).GE.SIGSSM(1)) THEN
11421 VDEL=0.5*VDEL
11422 VVAR=VVAR+VDEL
11423 SIGSSM(1)=SIGSSM(2)
11424 INEW=2
11425 VNEW=VVAR
11426 ELSE
11427 VDEL=0.5*VDEL
11428 VVAR=VVAR-VDEL
11429 SIGSSM(3)=SIGSSM(2)
11430 INEW=2
11431 VNEW=VVAR
11432 ENDIF
11433
11434
11435 IF(IVAR.EQ.1) THEN
11436 VTAU=VNEW
11437 CALL PYKMAP(1,MTAU,VTAU)
11438 IF(ISTSB.EQ.3.OR.ISTSB.EQ.4) CALL PYKLIM(4)
11439 ENDIF
11440 IF(IVAR.LE.2.AND.(ISTSB.EQ.3.OR.ISTSB.EQ.4)) THEN
11441 IF(IVAR.EQ.2) VTAUP=VNEW
11442 CALL PYKMAP(4,MTAUP,VTAUP)
11443 ENDIF
11444 IF(IVAR.LE.2) CALL PYKLIM(2)
11445 IF(IVAR.LE.3) THEN
11446 IF(IVAR.EQ.3) VYST=VNEW
11447 CALL PYKMAP(2,MYST,VYST)
11448 CALL PYKLIM(3)
11449 ENDIF
11450 IF(ISTSB.EQ.2.OR.ISTSB.EQ.4) THEN
11451 IF(IVAR.EQ.4) VCTH=VNEW
11452 CALL PYKMAP(3,MCTH,VCTH)
11453 ENDIF
11454 IF(ISUB.EQ.96) VINT(25)=VINT(21)*(1.-VINT(23)**2)
11455
11456
11457 CALL PYSIGH(NCHN,SIGS)
11458 SIGSSM(INEW)=SIGS
11459 IF(SIGS.GT.SIGSAM) SIGSAM=SIGS
11460 IF(MSTP(122).GE.2) WRITE(MSTU(11),1700) IMAX,IVAR,MVAR,IMOV,
11461 &VNEW,VINT(21),VINT(22),VINT(23),VINT(26),SIGS
11462 300 CONTINUE
11463 310 CONTINUE
11464 320 CONTINUE
11465 IF(IMAX.EQ.1) SIGS11=SIGSAM
11466 330 CONTINUE
11467 XSEC(ISUB,1)=1.05*SIGSAM
11468 340 IF(ISUB.NE.96) XSEC(0,1)=XSEC(0,1)+XSEC(ISUB,1)
11469 350 CONTINUE
11470
11471
11472 IF(MSTP(122).GE.1) THEN
11473 WRITE(MSTU(11),1800)
11474 WRITE(MSTU(11),1900)
11475 DO 360 ISUB=1,200
11476 IF(MSUB(ISUB).NE.1.AND.ISUB.NE.96) GOTO 360
11477 IF(ISUB.EQ.96.AND.MINT(43).NE.4) GOTO 360
11478 IF(ISUB.EQ.96.AND.MSUB(95).NE.1.AND.MSTP(81).LE.0) GOTO 360
11479 IF(MSUB(95).EQ.1.AND.(ISUB.EQ.11.OR.ISUB.EQ.12.OR.ISUB.EQ.13.OR.
11480 & ISUB.EQ.28.OR.ISUB.EQ.53.OR.ISUB.EQ.68)) GOTO 360
11481 WRITE(MSTU(11),2000) ISUB,PROC(ISUB),XSEC(ISUB,1)
11482 360 CONTINUE
11483 WRITE(MSTU(11),2100)
11484 ENDIF
11485
11486
11487 1000 FORMAT(/1X,'Coefficient optimization and maximum search for ',
11488 &'subprocess no',I4/1X,'Coefficient modes tau',10X,'y*',9X,
11489 &'cth',9X,'tau''',7X,'sigma')
11490 1100 FORMAT(1X,4I4,F12.8,F12.6,F12.7,F12.8,1P,E12.4)
11491 1200 FORMAT(1X,'Error: requested subprocess ',I3,' has vanishing ',
11492 &'cross-section.'/1X,'Execution stopped!')
11493 1300 FORMAT(1X,'Coefficients of equation system to be solved for ',A4)
11494 1400 FORMAT(1X,1P,7E11.3)
11495 1500 FORMAT(1X,'Result for ',A4,':',6F9.4)
11496 1600 FORMAT(1X,'Maximum search for given coefficients'/2X,'MAX VAR ',
11497 &'MOD MOV VNEW',7X,'tau',7X,'y*',8X,'cth',7X,'tau''',7X,'sigma')
11498 1700 FORMAT(1X,4I4,F8.4,F11.7,F9.3,F11.6,F11.7,1P,E12.4)
11499 1800 FORMAT(/1X,8('*'),1X,'PYMAXI: summary of differential ',
11500 &'cross-section maximum search',1X,8('*'))
11501 1900 FORMAT(/11X,58('=')/11X,'I',38X,'I',17X,'I'/11X,'I ISUB ',
11502 &'Subprocess name',15X,'I Maximum value I'/11X,'I',38X,'I',
11503 &17X,'I'/11X,58('=')/11X,'I',38X,'I',17X,'I')
11504 2000 FORMAT(11X,'I',2X,I3,3X,A28,2X,'I',2X,1P,E12.4,3X,'I')
11505 2100 FORMAT(11X,'I',38X,'I',17X,'I'/11X,58('='))
11506
11507 RETURN
11508 END
11509
11510
11511
11512 SUBROUTINE PYOVLY(MOVLY)
11513
11514
11515
11516
11517 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
11518 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
11519 COMMON/PYINT1/MINT(400),VINT(400)
11520 DIMENSION WTI(0:100)
11521 SAVE
11522
11523
11524 IF(MOVLY.EQ.1) THEN
11525 VINT(131)=VINT(106)
11526 IF(MSTP(132).GE.2) VINT(131)=VINT(131)+VINT(104)
11527 IF(MSTP(132).GE.3) VINT(131)=VINT(131)+VINT(103)
11528 IF(MSTP(132).GE.4) VINT(131)=VINT(131)+VINT(102)
11529
11530
11531 IF(MSTP(133).EQ.1) THEN
11532 XNAVE=VINT(131)*PARP(131)
11533 IF(XNAVE.GT.40.) WRITE(MSTU(11),1000) XNAVE
11534 WTI(0)=EXP(-MIN(50.,XNAVE))
11535 WTS=0.
11536 WTN=0.
11537 DO 100 I=1,100
11538 WTI(I)=WTI(I-1)*XNAVE/I
11539 IF(I-2.5.GT.XNAVE.AND.WTI(I).LT.1E-6) GOTO 110
11540 WTS=WTS+WTI(I)
11541 WTN=WTN+WTI(I)*I
11542 100 IMAX=I
11543 110 VINT(132)=XNAVE
11544 VINT(133)=WTN/WTS
11545 VINT(134)=WTS
11546
11547
11548 ELSEIF(MSTP(133).EQ.2) THEN
11549 XNAVE=VINT(131)*PARP(131)
11550 IF(XNAVE.GT.40.) WRITE(MSTU(11),1000) XNAVE
11551 WTI(1)=EXP(-MIN(50.,XNAVE))*XNAVE
11552 WTS=WTI(1)
11553 WTN=WTI(1)
11554 DO 120 I=2,100
11555 WTI(I)=WTI(I-1)*XNAVE/(I-1)
11556 IF(I-2.5.GT.XNAVE.AND.WTI(I).LT.1E-6) GOTO 130
11557 WTS=WTS+WTI(I)
11558 WTN=WTN+WTI(I)*I
11559 120 IMAX=I
11560 130 VINT(132)=XNAVE
11561 VINT(133)=WTN/WTS
11562 VINT(134)=WTS
11563 ENDIF
11564
11565
11566 ELSE
11567 IF(MSTP(133).EQ.0) THEN
11568 MINT(81)=MAX(1,MSTP(134))
11569 ELSE
11570 WTR=WTS*RLU(0)
11571 DO 140 I=1,IMAX
11572 MINT(81)=I
11573 WTR=WTR-WTI(I)
11574 IF(WTR.LE.0.) GOTO 150
11575 140 CONTINUE
11576 150 CONTINUE
11577 ENDIF
11578 ENDIF
11579
11580
11581 1000 FORMAT(1X,'Warning: requested average number of events per bunch',
11582 &'crossing too large, ',1P,E12.4)
11583
11584 RETURN
11585 END
11586
11587
11588
11589 SUBROUTINE PYRAND
11590
11591
11592
11593
11594
11595 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
11596 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
11597 COMMON/PYSUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
11598 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
11599 COMMON/PYINT1/MINT(400),VINT(400)
11600 COMMON/PYINT2/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2)
11601 COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000)
11602 COMMON/PYINT4/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3)
11603 COMMON/PYINT5/NGEN(0:200,3),XSEC(0:200,3)
11604 SAVE
11605
11606
11607 MINT(17)=0
11608 MINT(18)=0
11609 VINT(143)=1.
11610 VINT(144)=1.
11611 IF(MSUB(95).EQ.1.OR.MINT(82).GE.2) CALL PYMULT(2)
11612 ISUB=0
11613 100 MINT(51)=0
11614
11615
11616 IF(MINT(82).EQ.1.AND.(ISUB.LE.90.OR.ISUB.GT.96)) THEN
11617 RSUB=XSEC(0,1)*RLU(0)
11618 DO 110 I=1,200
11619 IF(MSUB(I).NE.1) GOTO 110
11620 ISUB=I
11621 RSUB=RSUB-XSEC(I,1)
11622 IF(RSUB.LE.0.) GOTO 120
11623 110 CONTINUE
11624 120 IF(ISUB.EQ.95) ISUB=96
11625
11626
11627 ELSEIF(MINT(82).GE.2.AND.ISUB.EQ.0) THEN
11628 RSUB=VINT(131)*RLU(0)
11629 ISUB=96
11630 IF(RSUB.GT.VINT(106)) ISUB=93
11631 IF(RSUB.GT.VINT(106)+VINT(104)) ISUB=92
11632 IF(RSUB.GT.VINT(106)+VINT(104)+VINT(103)) ISUB=91
11633 ENDIF
11634 IF(MINT(82).EQ.1) NGEN(0,1)=NGEN(0,1)+1
11635 IF(MINT(82).EQ.1) NGEN(ISUB,1)=NGEN(ISUB,1)+1
11636 MINT(1)=ISUB
11637
11638
11639 MINT(72)=0
11640 KFR1=0
11641 IF(ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.3) THEN
11642 KFR1=KFPR(ISUB,1)
11643 ELSEIF(ISUB.GE.71.AND.ISUB.LE.77) THEN
11644 KFR1=25
11645 ENDIF
11646 IF(KFR1.NE.0) THEN
11647 TAUR1=PMAS(KFR1,1)**2/VINT(2)
11648 GAMR1=PMAS(KFR1,1)*PMAS(KFR1,2)/VINT(2)
11649 MINT(72)=1
11650 MINT(73)=KFR1
11651 VINT(73)=TAUR1
11652 VINT(74)=GAMR1
11653 ENDIF
11654 IF(ISUB.EQ.141) THEN
11655 KFR2=23
11656 TAUR2=PMAS(KFR2,1)**2/VINT(2)
11657 GAMR2=PMAS(KFR2,1)*PMAS(KFR2,2)/VINT(2)
11658 MINT(72)=2
11659 MINT(74)=KFR2
11660 VINT(75)=TAUR2
11661 VINT(76)=GAMR2
11662 ENDIF
11663
11664
11665
11666 VINT(63)=0.
11667 VINT(64)=0.
11668 MINT(71)=0
11669 VINT(71)=CKIN(3)
11670 IF(MINT(82).GE.2) VINT(71)=0.
11671 IF(ISET(ISUB).EQ.2.OR.ISET(ISUB).EQ.4) THEN
11672 DO 130 I=1,2
11673 IF(KFPR(ISUB,I).EQ.0) THEN
11674 ELSEIF(MSTP(42).LE.0) THEN
11675 VINT(62+I)=PMAS(KFPR(ISUB,I),1)**2
11676 ELSE
11677 VINT(62+I)=ULMASS(KFPR(ISUB,I))**2
11678 ENDIF
11679 130 CONTINUE
11680 IF(MIN(VINT(63),VINT(64)).LT.CKIN(6)**2) MINT(71)=1
11681 IF(MINT(71).EQ.1) VINT(71)=MAX(CKIN(3),CKIN(5))
11682 ENDIF
11683
11684 IF(ISET(ISUB).EQ.0) THEN
11685
11686
11687 IS=INT(1.5+RLU(0))
11688 VINT(63)=VINT(3)**2
11689 VINT(64)=VINT(4)**2
11690 IF(ISUB.EQ.92.OR.ISUB.EQ.93) VINT(62+IS)=PARP(111)**2
11691 IF(ISUB.EQ.93) VINT(65-IS)=PARP(111)**2
11692 SH=VINT(2)
11693 SQM1=VINT(3)**2
11694 SQM2=VINT(4)**2
11695 SQM3=VINT(63)
11696 SQM4=VINT(64)
11697 SQLA12=(SH-SQM1-SQM2)**2-4.*SQM1*SQM2
11698 SQLA34=(SH-SQM3-SQM4)**2-4.*SQM3*SQM4
11699 THTER1=SQM1+SQM2+SQM3+SQM4-(SQM1-SQM2)*(SQM3-SQM4)/SH-SH
11700 THTER2=SQRT(MAX(0.,SQLA12))*SQRT(MAX(0.,SQLA34))/SH
11701 THL=0.5*(THTER1-THTER2)
11702 THU=0.5*(THTER1+THTER2)
11703 THM=MIN(MAX(THL,PARP(101)),THU)
11704 JTMAX=0
11705 IF(ISUB.EQ.92.OR.ISUB.EQ.93) JTMAX=ISUB-91
11706 DO 140 JT=1,JTMAX
11707 MINT(13+3*JT-IS*(2*JT-3))=1
11708 SQMMIN=VINT(59+3*JT-IS*(2*JT-3))
11709 SQMI=VINT(8-3*JT+IS*(2*JT-3))**2
11710 SQMJ=VINT(3*JT-1-IS*(2*JT-3))**2
11711 SQMF=VINT(68-3*JT+IS*(2*JT-3))
11712 SQUA=0.5*SH/SQMI*((1.+(SQMI-SQMJ)/SH)*THM+SQMI-SQMF-
11713 & SQMJ**2/SH+(SQMI+SQMJ)*SQMF/SH+(SQMI-SQMJ)**2/SH**2*SQMF)
11714 QUAR=SH/SQMI*(THM*(THM+SH-SQMI-SQMJ-SQMF*(1.-(SQMI-SQMJ)/SH))+
11715 & SQMI*SQMJ-SQMJ*SQMF*(1.+(SQMI-SQMJ-SQMF)/SH))
11716 SQMMAX=SQUA+SQRT(MAX(0.,SQUA**2-QUAR))
11717 IF(ABS(QUAR/SQUA**2).LT.1.E-06) SQMMAX=0.5*QUAR/SQUA
11718 SQMMAX=MIN(SQMMAX,(VINT(1)-SQRT(SQMF))**2)
11719 VINT(59+3*JT-IS*(2*JT-3))=SQMMIN*(SQMMAX/SQMMIN)**RLU(0)
11720 140 CONTINUE
11721
11722 SQM3=VINT(63)
11723 SQM4=VINT(64)
11724 SQLA34=(SH-SQM3-SQM4)**2-4.*SQM3*SQM4
11725 THTER1=SQM1+SQM2+SQM3+SQM4-(SQM1-SQM2)*(SQM3-SQM4)/SH-SH
11726 THTER2=SQRT(MAX(0.,SQLA12))*SQRT(MAX(0.,SQLA34))/SH
11727 THL=0.5*(THTER1-THTER2)
11728 THU=0.5*(THTER1+THTER2)
11729 B=VINT(121)
11730 C=VINT(122)
11731 IF(ISUB.EQ.92.OR.ISUB.EQ.93) THEN
11732 B=0.5*B
11733 C=0.5*C
11734 ENDIF
11735 THM=MIN(MAX(THL,PARP(101)),THU)
11736 EXPTH=0.
11737 THARG=B*(THM-THU)
11738 IF(THARG.GT.-20.) EXPTH=EXP(THARG)
11739 150 TH=THU+LOG(EXPTH+(1.-EXPTH)*RLU(0))/B
11740 TH=MAX(THM,MIN(THU,TH))
11741 RATLOG=MIN((B+C*(TH+THM))*(TH-THM),(B+C*(TH+THU))*(TH-THU))
11742 IF(RATLOG.LT.LOG(RLU(0))) GOTO 150
11743 VINT(21)=1.
11744 VINT(22)=0.
11745 VINT(23)=MIN(1.,MAX(-1.,(2.*TH-THTER1)/THTER2))
11746
11747
11748
11749
11750
11751
11752
11753
11754
11755 ELSEIF(ISET(ISUB).GE.1.AND.ISET(ISUB).LE.4) THEN
11756 CALL PYKLIM(1)
11757 IF(MINT(51).NE.0) GOTO 100
11758 RTAU=RLU(0)
11759 MTAU=1
11760 IF(RTAU.GT.COEF(ISUB,1)) MTAU=2
11761 IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)) MTAU=3
11762 IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)+COEF(ISUB,3)) MTAU=4
11763 IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)+COEF(ISUB,3)+COEF(ISUB,4))
11764 & MTAU=5
11765 IF(RTAU.GT.COEF(ISUB,1)+COEF(ISUB,2)+COEF(ISUB,3)+COEF(ISUB,4)+
11766 & COEF(ISUB,5)) MTAU=6
11767 CALL PYKMAP(1,MTAU,RLU(0))
11768
11769
11770
11771
11772
11773 IF(ISET(ISUB).EQ.3.OR.ISET(ISUB).EQ.4) THEN
11774 CALL PYKLIM(4)
11775 IF(MINT(51).NE.0) GOTO 100
11776 RTAUP=RLU(0)
11777 MTAUP=1
11778 IF(RTAUP.GT.COEF(ISUB,15)) MTAUP=2
11779 CALL PYKMAP(4,MTAUP,RLU(0))
11780 ENDIF
11781
11782
11783
11784
11785 CALL PYKLIM(2)
11786 IF(MINT(51).NE.0) GOTO 100
11787 RYST=RLU(0)
11788 MYST=1
11789 IF(RYST.GT.COEF(ISUB,7)) MYST=2
11790 IF(RYST.GT.COEF(ISUB,7)+COEF(ISUB,8)) MYST=3
11791 CALL PYKMAP(2,MYST,RLU(0))
11792
11793
11794
11795
11796
11797
11798
11799 CALL PYKLIM(3)
11800 IF(MINT(51).NE.0) GOTO 100
11801 IF(ISET(ISUB).EQ.2.OR.ISET(ISUB).EQ.4) THEN
11802 RCTH=RLU(0)
11803 MCTH=1
11804 IF(RCTH.GT.COEF(ISUB,10)) MCTH=2
11805 IF(RCTH.GT.COEF(ISUB,10)+COEF(ISUB,11)) MCTH=3
11806 IF(RCTH.GT.COEF(ISUB,10)+COEF(ISUB,11)+COEF(ISUB,12)) MCTH=4
11807 IF(RCTH.GT.COEF(ISUB,10)+COEF(ISUB,11)+COEF(ISUB,12)+
11808 & COEF(ISUB,13)) MCTH=5
11809 CALL PYKMAP(3,MCTH,RLU(0))
11810 ENDIF
11811
11812
11813 ELSEIF(ISET(ISUB).EQ.5) THEN
11814 CALL PYMULT(3)
11815 ISUB=MINT(1)
11816 ENDIF
11817
11818
11819 VINT(24)=PARU(2)*RLU(0)
11820
11821
11822 MINT(51)=0
11823 IF(ISUB.LE.90.OR.ISUB.GT.100) CALL PYKLIM(0)
11824 IF(MINT(51).NE.0) GOTO 100
11825 IF(MINT(82).EQ.1.AND.MSTP(141).GE.1) THEN
11826 MCUT=0
11827 IF(MSUB(91)+MSUB(92)+MSUB(93)+MSUB(94)+MSUB(95).EQ.0)
11828 & CALL PYKCUT(MCUT)
11829 IF(MCUT.NE.0) GOTO 100
11830 ENDIF
11831
11832
11833 CALL PYSIGH(NCHN,SIGS)
11834
11835
11836 IF(MINT(82).EQ.1.AND.ISUB.LE.90.OR.ISUB.GE.96) THEN
11837 XSEC(ISUB,2)=XSEC(ISUB,2)+SIGS
11838 ELSEIF(MINT(82).EQ.1) THEN
11839 XSEC(ISUB,2)=XSEC(ISUB,2)+XSEC(ISUB,1)
11840 ENDIF
11841
11842
11843 IF(MINT(43).EQ.4.AND.MSTP(82).GE.3) THEN
11844 VINT(153)=SIGS
11845 CALL PYMULT(4)
11846 ENDIF
11847
11848
11849 VIOL=SIGS/XSEC(ISUB,1)
11850 IF(VIOL.LT.RLU(0)) GOTO 100
11851
11852
11853
11854 IF(MSTP(123).LE.0) THEN
11855 IF(VIOL.GT.1.) THEN
11856 WRITE(MSTU(11),1000) VIOL,NGEN(0,3)+1
11857 WRITE(MSTU(11),1100) ISUB,VINT(21),VINT(22),VINT(23),VINT(26)
11858 STOP
11859 ENDIF
11860 ELSEIF(MSTP(123).EQ.1) THEN
11861 IF(VIOL.GT.VINT(108)) THEN
11862 VINT(108)=VIOL
11863
11864
11865
11866
11867
11868 ENDIF
11869 ELSEIF(VIOL.GT.VINT(108)) THEN
11870 VINT(108)=VIOL
11871 IF(VIOL.GT.1.) THEN
11872 XDIF=XSEC(ISUB,1)*(VIOL-1.)
11873 XSEC(ISUB,1)=XSEC(ISUB,1)+XDIF
11874 IF(MSUB(ISUB).EQ.1.AND.(ISUB.LE.90.OR.ISUB.GT.96))
11875 & XSEC(0,1)=XSEC(0,1)+XDIF
11876
11877
11878
11879
11880
11881
11882
11883
11884
11885 VINT(108)=1.
11886 ENDIF
11887 ENDIF
11888
11889
11890 VINT(148)=1.
11891 IF(MINT(43).EQ.4.AND.(ISUB.LE.90.OR.ISUB.GE.96).AND.MSTP(82).GE.3)
11892 &THEN
11893 CALL PYMULT(5)
11894 IF(VINT(150).LT.RLU(0)) GOTO 100
11895 ENDIF
11896 IF(MINT(82).EQ.1.AND.MSUB(95).EQ.1) THEN
11897 IF(ISUB.LE.90.OR.ISUB.GE.95) NGEN(95,1)=NGEN(95,1)+1
11898 IF(ISUB.LE.90.OR.ISUB.GE.96) NGEN(96,2)=NGEN(96,2)+1
11899 ENDIF
11900 IF(ISUB.LE.90.OR.ISUB.GE.96) MINT(31)=MINT(31)+1
11901
11902
11903 RSIGS=SIGS*RLU(0)
11904 QT2=VINT(48)
11905 RQQBAR=PARP(87)*(1.-(QT2/(QT2+(PARP(88)*PARP(82))**2))**2)
11906 IF(ISUB.NE.95.AND.(ISUB.NE.96.OR.MSTP(82).LE.1.OR.
11907 &RLU(0).GT.RQQBAR)) THEN
11908 DO 190 ICHN=1,NCHN
11909 KFL1=ISIG(ICHN,1)
11910 KFL2=ISIG(ICHN,2)
11911 MINT(2)=ISIG(ICHN,3)
11912 RSIGS=RSIGS-SIGH(ICHN)
11913 IF(RSIGS.LE.0.) GOTO 210
11914 190 CONTINUE
11915
11916
11917 ELSEIF(ISUB.EQ.96) THEN
11918 CALL PYSPLI(MINT(11),21,KFL1,KFLDUM)
11919 CALL PYSPLI(MINT(12),21,KFL2,KFLDUM)
11920 MINT(1)=11
11921 MINT(2)=1
11922 IF(KFL1.EQ.KFL2.AND.RLU(0).LT.0.5) MINT(2)=2
11923
11924
11925 ELSE
11926 KFL1=21
11927 KFL2=21
11928 RSIGS=6.*RLU(0)
11929 MINT(2)=1
11930 IF(RSIGS.GT.1.) MINT(2)=2
11931 IF(RSIGS.GT.2.) MINT(2)=3
11932 ENDIF
11933
11934
11935 210 IF(MINT(2).GT.10) THEN
11936 MINT(1)=MINT(2)/10
11937 MINT(2)=MOD(MINT(2),10)
11938 ENDIF
11939 MINT(15)=KFL1
11940 MINT(16)=KFL2
11941 MINT(13)=MINT(15)
11942 MINT(14)=MINT(16)
11943 VINT(141)=VINT(41)
11944 VINT(142)=VINT(42)
11945
11946
11947 1000 FORMAT(1X,'Error: maximum violated by',1P,E11.3,1X,
11948 &'in event',1X,I7,'.'/1X,'Execution stopped!')
11949 1100 FORMAT(1X,'ISUB = ',I3,'; Point of violation:'/1X,'tau =',1P,
11950 &E11.3,', y* =',E11.3,', cthe = ',0P,F11.7,', tau'' =',1P,E11.3)
11951
11952
11953
11954
11955
11956
11957 RETURN
11958 END
11959
11960
11961
11962 SUBROUTINE PYSCAT
11963
11964
11965
11966 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
11967 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
11968 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
11969 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
11970 COMMON/PYSUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
11971 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
11972 COMMON/PYINT1/MINT(400),VINT(400)
11973 COMMON/PYINT2/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2)
11974 COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000)
11975 COMMON/PYINT4/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3)
11976 COMMON/PYINT5/NGEN(0:200,3),XSEC(0:200,3)
11977 DIMENSION WDTP(0:40),WDTE(0:40,0:5),PMQ(2),Z(2),CTHE(2),PHI(2)
11978 SAVE
11979
11980
11981 ISUB=MINT(1)
11982 IDOC=6+ISET(ISUB)
11983 IF(ISUB.EQ.95) IDOC=8
11984 MINT(3)=IDOC-6
11985 IF(IDOC.GE.9) IDOC=IDOC+2
11986 MINT(4)=IDOC
11987 IPU1=MINT(84)+1
11988 IPU2=MINT(84)+2
11989 IPU3=MINT(84)+3
11990 IPU4=MINT(84)+4
11991 IPU5=MINT(84)+5
11992 IPU6=MINT(84)+6
11993
11994
11995 DO 100 JT=1,MSTP(126)+10
11996 I=MINT(83)+JT
11997 DO 100 J=1,5
11998 K(I,J)=0
11999 P(I,J)=0.
12000 100 V(I,J)=0.
12001 DO 110 JT=1,2
12002 I=MINT(83)+JT
12003 K(I,1)=21
12004 K(I,2)=MINT(10+JT)
12005 P(I,1)=0.
12006 P(I,2)=0.
12007 P(I,5)=VINT(2+JT)
12008 P(I,3)=VINT(5)*(-1)**(JT+1)
12009 110 P(I,4)=SQRT(P(I,3)**2+P(I,5)**2)
12010 MINT(6)=2
12011 KFRES=0
12012
12013
12014 SH=VINT(44)
12015 SHR=SQRT(SH)
12016 SHP=VINT(26)*VINT(2)
12017 SHPR=SQRT(SHP)
12018 SHUSER=SHR
12019 IF(ISET(ISUB).GE.3) SHUSER=SHPR
12020 DO 120 JT=1,2
12021 I=MINT(84)+JT
12022 K(I,1)=14
12023 K(I,2)=MINT(14+JT)
12024 K(I,3)=MINT(83)+2+JT
12025 120 P(I,5)=ULMASS(K(I,2))
12026 IF(P(IPU1,5)+P(IPU2,5).GE.SHUSER) THEN
12027 P(IPU1,5)=0.
12028 P(IPU2,5)=0.
12029 ENDIF
12030 P(IPU1,4)=0.5*(SHUSER+(P(IPU1,5)**2-P(IPU2,5)**2)/SHUSER)
12031 P(IPU1,3)=SQRT(MAX(0.,P(IPU1,4)**2-P(IPU1,5)**2))
12032 P(IPU2,4)=SHUSER-P(IPU1,4)
12033 P(IPU2,3)=-P(IPU1,3)
12034
12035
12036 DO 130 JT=1,2
12037 I1=MINT(83)+4+JT
12038 I2=MINT(84)+JT
12039 K(I1,1)=21
12040 K(I1,2)=K(I2,2)
12041 K(I1,3)=I1-2
12042 DO 130 J=1,5
12043 130 P(I1,J)=P(I2,J)
12044
12045
12046 IF(ISUB.EQ.12.OR.ISUB.EQ.53) THEN
12047 CALL PYWIDT(21,SHR,WDTP,WDTE)
12048 RKFL=(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))*RLU(0)
12049 DO 140 I=1,2*MSTP(1)
12050 KFLQ=I
12051 RKFL=RKFL-(WDTE(I,1)+WDTE(I,2)+WDTE(I,4))
12052 IF(RKFL.LE.0.) GOTO 150
12053 140 CONTINUE
12054 150 CONTINUE
12055 ENDIF
12056
12057
12058 JS=1
12059 MINT(21)=MINT(15)
12060 MINT(22)=MINT(16)
12061 MINT(23)=0
12062 MINT(24)=0
12063 KCC=20
12064 KCS=ISIGN(1,MINT(15))
12065
12066 IF(ISUB.LE.10) THEN
12067 IF(ISUB.EQ.1) THEN
12068
12069 KFRES=23
12070
12071 ELSEIF(ISUB.EQ.2) THEN
12072
12073 KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
12074 KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
12075 KFRES=ISIGN(24,KCH1+KCH2)
12076
12077 ELSEIF(ISUB.EQ.3) THEN
12078
12079 KFRES=25
12080
12081 ELSEIF(ISUB.EQ.4) THEN
12082
12083
12084 ELSEIF(ISUB.EQ.5) THEN
12085
12086 XH=SH/SHP
12087 MINT(21)=MINT(15)
12088 MINT(22)=MINT(16)
12089 PMQ(1)=ULMASS(MINT(21))
12090 PMQ(2)=ULMASS(MINT(22))
12091 240 JT=INT(1.5+RLU(0))
12092 ZMIN=2.*PMQ(JT)/SHPR
12093 ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT)))
12094 ZMAX=MIN(1.-XH,ZMAX)
12095 Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU(0)
12096 IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT.
12097 & (1.-XH)**2/(4.*XH)*RLU(0)) GOTO 240
12098 SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP)
12099 IF(SQC1.LT.1.E-8) GOTO 240
12100 C1=SQRT(SQC1)
12101 C2=1.+2.*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
12102 CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
12103 CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT)))
12104 Z(3-JT)=1.-XH/(1.-Z(JT))
12105 SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
12106 IF(SQC1.LT.1.E-8) GOTO 240
12107 C1=SQRT(SQC1)
12108 C2=1.+2.*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
12109 CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
12110 CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT)))
12111 PHIR=PARU(2)*RLU(0)
12112 CPHI=COS(PHIR)
12113 ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI
12114 Z1=2.-Z(JT)
12115 Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP)
12116 Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
12117 Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
12118 & PMQ(3-JT)**2/SHP))
12119 ZMIN=2.*PMQ(3-JT)/SHPR
12120 ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
12121 ZMAX=MIN(1.-XH,ZMAX)
12122 IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 240
12123 KCC=22
12124 KFRES=25
12125
12126 ELSEIF(ISUB.EQ.6) THEN
12127
12128
12129 ELSEIF(ISUB.EQ.7) THEN
12130
12131
12132 ELSEIF(ISUB.EQ.8) THEN
12133
12134 XH=SH/SHP
12135 250 DO 280 JT=1,2
12136 I=MINT(14+JT)
12137 IA=IABS(I)
12138 IF(IA.LE.10) THEN
12139 RVCKM=VINT(180+I)*RLU(0)
12140 DO 270 J=1,MSTP(1)
12141 IB=2*J-1+MOD(IA,2)
12142 IPM=(5-ISIGN(1,I))/2
12143 IDC=J+MDCY(IA,2)+2
12144 IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 270
12145 MINT(20+JT)=ISIGN(IB,I)
12146 RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
12147 IF(RVCKM.LE.0.) GOTO 280
12148 270 CONTINUE
12149 ELSE
12150 IB=2*((IA+1)/2)-1+MOD(IA,2)
12151 MINT(20+JT)=ISIGN(IB,I)
12152 ENDIF
12153 280 PMQ(JT)=ULMASS(MINT(20+JT))
12154 JT=INT(1.5+RLU(0))
12155 ZMIN=2.*PMQ(JT)/SHPR
12156 ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT)))
12157 ZMAX=MIN(1.-XH,ZMAX)
12158 Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU(0)
12159 IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT.
12160 & (1.-XH)**2/(4.*XH)*RLU(0)) GOTO 250
12161 SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP)
12162 IF(SQC1.LT.1.E-8) GOTO 250
12163 C1=SQRT(SQC1)
12164 C2=1.+2.*(PMAS(24,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
12165 CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
12166 CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT)))
12167 Z(3-JT)=1.-XH/(1.-Z(JT))
12168 SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
12169 IF(SQC1.LT.1.E-8) GOTO 250
12170 C1=SQRT(SQC1)
12171 C2=1.+2.*(PMAS(24,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
12172 CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
12173 CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT)))
12174 PHIR=PARU(2)*RLU(0)
12175 CPHI=COS(PHIR)
12176 ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI
12177 Z1=2.-Z(JT)
12178 Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP)
12179 Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
12180 Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
12181 & PMQ(3-JT)**2/SHP))
12182 ZMIN=2.*PMQ(3-JT)/SHPR
12183 ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
12184 ZMAX=MIN(1.-XH,ZMAX)
12185 IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 250
12186 KCC=22
12187 KFRES=25
12188 ENDIF
12189
12190 ELSEIF(ISUB.LE.20) THEN
12191 IF(ISUB.EQ.11) THEN
12192
12193 KCC=MINT(2)
12194 IF(MINT(15)*MINT(16).LT.0) KCC=KCC+2
12195
12196 ELSEIF(ISUB.EQ.12) THEN
12197
12198 MINT(21)=ISIGN(KFLQ,MINT(15))
12199 MINT(22)=-MINT(21)
12200 KCC=4
12201
12202 ELSEIF(ISUB.EQ.13) THEN
12203
12204 MINT(21)=21
12205 MINT(22)=21
12206 KCC=MINT(2)+4
12207
12208 ELSEIF(ISUB.EQ.14) THEN
12209
12210 IF(RLU(0).GT.0.5) JS=2
12211 MINT(20+JS)=21
12212 MINT(23-JS)=22
12213 KCC=17+JS
12214
12215 ELSEIF(ISUB.EQ.15) THEN
12216
12217 IF(RLU(0).GT.0.5) JS=2
12218 MINT(20+JS)=21
12219 MINT(23-JS)=23
12220 KCC=17+JS
12221
12222 ELSEIF(ISUB.EQ.16) THEN
12223
12224 KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
12225 KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
12226 IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2
12227 MINT(20+JS)=21
12228 MINT(23-JS)=ISIGN(24,KCH1+KCH2)
12229 KCC=17+JS
12230
12231 ELSEIF(ISUB.EQ.17) THEN
12232
12233 IF(RLU(0).GT.0.5) JS=2
12234 MINT(20+JS)=21
12235 MINT(23-JS)=25
12236 KCC=17+JS
12237
12238 ELSEIF(ISUB.EQ.18) THEN
12239
12240 MINT(21)=22
12241 MINT(22)=22
12242
12243 ELSEIF(ISUB.EQ.19) THEN
12244
12245 IF(RLU(0).GT.0.5) JS=2
12246 MINT(20+JS)=22
12247 MINT(23-JS)=23
12248
12249 ELSEIF(ISUB.EQ.20) THEN
12250
12251 KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
12252 KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
12253 IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2
12254 MINT(20+JS)=22
12255 MINT(23-JS)=ISIGN(24,KCH1+KCH2)
12256 ENDIF
12257
12258 ELSEIF(ISUB.LE.30) THEN
12259 IF(ISUB.EQ.21) THEN
12260
12261 IF(RLU(0).GT.0.5) JS=2
12262 MINT(20+JS)=22
12263 MINT(23-JS)=25
12264
12265 ELSEIF(ISUB.EQ.22) THEN
12266
12267 MINT(21)=23
12268 MINT(22)=23
12269
12270 ELSEIF(ISUB.EQ.23) THEN
12271
12272 KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
12273 KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
12274 IF(MINT(15)*(KCH1+KCH2).LT.0) JS=2
12275 MINT(20+JS)=23
12276 MINT(23-JS)=ISIGN(24,KCH1+KCH2)
12277
12278 ELSEIF(ISUB.EQ.24) THEN
12279
12280 IF(RLU(0).GT.0.5) JS=2
12281 MINT(20+JS)=23
12282 MINT(23-JS)=25
12283
12284 ELSEIF(ISUB.EQ.25) THEN
12285
12286 MINT(21)=-ISIGN(24,MINT(15))
12287 MINT(22)=-MINT(21)
12288
12289 ELSEIF(ISUB.EQ.26) THEN
12290
12291 KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
12292 KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
12293 IF(MINT(15)*(KCH1+KCH2).GT.0) JS=2
12294 MINT(20+JS)=ISIGN(24,KCH1+KCH2)
12295 MINT(23-JS)=25
12296
12297 ELSEIF(ISUB.EQ.27) THEN
12298
12299
12300 ELSEIF(ISUB.EQ.28) THEN
12301
12302 KCC=MINT(2)+6
12303 IF(MINT(15).EQ.21) KCC=KCC+2
12304 IF(MINT(15).NE.21) KCS=ISIGN(1,MINT(15))
12305 IF(MINT(16).NE.21) KCS=ISIGN(1,MINT(16))
12306
12307 ELSEIF(ISUB.EQ.29) THEN
12308
12309 IF(MINT(15).EQ.21) JS=2
12310 MINT(23-JS)=22
12311 KCC=15+JS
12312 KCS=ISIGN(1,MINT(14+JS))
12313
12314 ELSEIF(ISUB.EQ.30) THEN
12315
12316 IF(MINT(15).EQ.21) JS=2
12317 MINT(23-JS)=23
12318 KCC=15+JS
12319 KCS=ISIGN(1,MINT(14+JS))
12320 ENDIF
12321
12322 ELSEIF(ISUB.LE.40) THEN
12323 IF(ISUB.EQ.31) THEN
12324
12325 IF(MINT(15).EQ.21) JS=2
12326 I=MINT(14+JS)
12327 IA=IABS(I)
12328 MINT(23-JS)=ISIGN(24,KCHG(IA,1)*I)
12329 RVCKM=VINT(180+I)*RLU(0)
12330 DO 220 J=1,MSTP(1)
12331 IB=2*J-1+MOD(IA,2)
12332 IPM=(5-ISIGN(1,I))/2
12333 IDC=J+MDCY(IA,2)+2
12334 IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 220
12335 MINT(20+JS)=ISIGN(IB,I)
12336 RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
12337 IF(RVCKM.LE.0.) GOTO 230
12338 220 CONTINUE
12339 230 KCC=15+JS
12340 KCS=ISIGN(1,MINT(14+JS))
12341
12342 ELSEIF(ISUB.EQ.32) THEN
12343
12344 IF(MINT(15).EQ.21) JS=2
12345 MINT(23-JS)=25
12346 KCC=15+JS
12347 KCS=ISIGN(1,MINT(14+JS))
12348
12349 ELSEIF(ISUB.EQ.33) THEN
12350
12351
12352 ELSEIF(ISUB.EQ.34) THEN
12353
12354
12355 ELSEIF(ISUB.EQ.35) THEN
12356
12357
12358 ELSEIF(ISUB.EQ.36) THEN
12359
12360
12361 ELSEIF(ISUB.EQ.37) THEN
12362
12363
12364 ELSEIF(ISUB.EQ.38) THEN
12365
12366
12367 ELSEIF(ISUB.EQ.39) THEN
12368
12369
12370 ELSEIF(ISUB.EQ.40) THEN
12371
12372 ENDIF
12373
12374 ELSEIF(ISUB.LE.50) THEN
12375 IF(ISUB.EQ.41) THEN
12376
12377
12378 ELSEIF(ISUB.EQ.42) THEN
12379
12380
12381 ELSEIF(ISUB.EQ.43) THEN
12382
12383
12384 ELSEIF(ISUB.EQ.44) THEN
12385
12386
12387 ELSEIF(ISUB.EQ.45) THEN
12388
12389
12390 ELSEIF(ISUB.EQ.46) THEN
12391
12392
12393 ELSEIF(ISUB.EQ.47) THEN
12394
12395
12396 ELSEIF(ISUB.EQ.48) THEN
12397
12398
12399 ELSEIF(ISUB.EQ.49) THEN
12400
12401
12402 ELSEIF(ISUB.EQ.50) THEN
12403
12404 ENDIF
12405
12406 ELSEIF(ISUB.LE.60) THEN
12407 IF(ISUB.EQ.51) THEN
12408
12409
12410 ELSEIF(ISUB.EQ.52) THEN
12411
12412
12413 ELSEIF(ISUB.EQ.53) THEN
12414
12415 KCS=(-1)**INT(1.5+RLU(0))
12416 MINT(21)=ISIGN(KFLQ,KCS)
12417 MINT(22)=-MINT(21)
12418 KCC=MINT(2)+10
12419
12420 ELSEIF(ISUB.EQ.54) THEN
12421
12422
12423 ELSEIF(ISUB.EQ.55) THEN
12424
12425
12426 ELSEIF(ISUB.EQ.56) THEN
12427
12428
12429 ELSEIF(ISUB.EQ.57) THEN
12430
12431
12432 ELSEIF(ISUB.EQ.58) THEN
12433
12434
12435 ELSEIF(ISUB.EQ.59) THEN
12436
12437
12438 ELSEIF(ISUB.EQ.60) THEN
12439
12440 ENDIF
12441
12442 ELSEIF(ISUB.LE.70) THEN
12443 IF(ISUB.EQ.61) THEN
12444
12445
12446 ELSEIF(ISUB.EQ.62) THEN
12447
12448
12449 ELSEIF(ISUB.EQ.63) THEN
12450
12451
12452 ELSEIF(ISUB.EQ.64) THEN
12453
12454
12455 ELSEIF(ISUB.EQ.65) THEN
12456
12457
12458 ELSEIF(ISUB.EQ.66) THEN
12459
12460
12461 ELSEIF(ISUB.EQ.67) THEN
12462
12463
12464 ELSEIF(ISUB.EQ.68) THEN
12465
12466 KCC=MINT(2)+12
12467 KCS=(-1)**INT(1.5+RLU(0))
12468
12469 ELSEIF(ISUB.EQ.69) THEN
12470
12471
12472 ELSEIF(ISUB.EQ.70) THEN
12473
12474 ENDIF
12475
12476 ELSEIF(ISUB.LE.80) THEN
12477 IF(ISUB.EQ.71.OR.ISUB.EQ.72) THEN
12478
12479 XH=SH/SHP
12480 MINT(21)=MINT(15)
12481 MINT(22)=MINT(16)
12482 PMQ(1)=ULMASS(MINT(21))
12483 PMQ(2)=ULMASS(MINT(22))
12484 290 JT=INT(1.5+RLU(0))
12485 ZMIN=2.*PMQ(JT)/SHPR
12486 ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT)))
12487 ZMAX=MIN(1.-XH,ZMAX)
12488 Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU(0)
12489 IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT.
12490 & (1.-XH)**2/(4.*XH)*RLU(0)) GOTO 290
12491 SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP)
12492 IF(SQC1.LT.1.E-8) GOTO 290
12493 C1=SQRT(SQC1)
12494 C2=1.+2.*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
12495 CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
12496 CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT)))
12497 Z(3-JT)=1.-XH/(1.-Z(JT))
12498 SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
12499 IF(SQC1.LT.1.E-8) GOTO 290
12500 C1=SQRT(SQC1)
12501 C2=1.+2.*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
12502 CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
12503 CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT)))
12504 PHIR=PARU(2)*RLU(0)
12505 CPHI=COS(PHIR)
12506 ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI
12507 Z1=2.-Z(JT)
12508 Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP)
12509 Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
12510 Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
12511 & PMQ(3-JT)**2/SHP))
12512 ZMIN=2.*PMQ(3-JT)/SHPR
12513 ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
12514 ZMAX=MIN(1.-XH,ZMAX)
12515 IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 290
12516 KCC=22
12517
12518 ELSEIF(ISUB.EQ.73) THEN
12519
12520 XH=SH/SHP
12521 300 JT=INT(1.5+RLU(0))
12522 I=MINT(14+JT)
12523 IA=IABS(I)
12524 IF(IA.LE.10) THEN
12525 RVCKM=VINT(180+I)*RLU(0)
12526 DO 320 J=1,MSTP(1)
12527 IB=2*J-1+MOD(IA,2)
12528 IPM=(5-ISIGN(1,I))/2
12529 IDC=J+MDCY(IA,2)+2
12530 IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 320
12531 MINT(20+JT)=ISIGN(IB,I)
12532 RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
12533 IF(RVCKM.LE.0.) GOTO 330
12534 320 CONTINUE
12535 ELSE
12536 IB=2*((IA+1)/2)-1+MOD(IA,2)
12537 MINT(20+JT)=ISIGN(IB,I)
12538 ENDIF
12539 330 PMQ(JT)=ULMASS(MINT(20+JT))
12540 MINT(23-JT)=MINT(17-JT)
12541 PMQ(3-JT)=ULMASS(MINT(23-JT))
12542 JT=INT(1.5+RLU(0))
12543 ZMIN=2.*PMQ(JT)/SHPR
12544 ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT)))
12545 ZMAX=MIN(1.-XH,ZMAX)
12546 Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU(0)
12547 IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT.
12548 & (1.-XH)**2/(4.*XH)*RLU(0)) GOTO 300
12549 SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP)
12550 IF(SQC1.LT.1.E-8) GOTO 300
12551 C1=SQRT(SQC1)
12552 C2=1.+2.*(PMAS(23,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
12553 CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
12554 CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT)))
12555 Z(3-JT)=1.-XH/(1.-Z(JT))
12556 SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
12557 IF(SQC1.LT.1.E-8) GOTO 300
12558 C1=SQRT(SQC1)
12559 C2=1.+2.*(PMAS(23,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
12560 CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
12561 CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT)))
12562 PHIR=PARU(2)*RLU(0)
12563 CPHI=COS(PHIR)
12564 ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI
12565 Z1=2.-Z(JT)
12566 Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP)
12567 Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
12568 Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
12569 & PMQ(3-JT)**2/SHP))
12570 ZMIN=2.*PMQ(3-JT)/SHPR
12571 ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
12572 ZMAX=MIN(1.-XH,ZMAX)
12573 IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 300
12574 KCC=22
12575
12576 ELSEIF(ISUB.EQ.74) THEN
12577
12578
12579 ELSEIF(ISUB.EQ.75) THEN
12580
12581
12582 ELSEIF(ISUB.EQ.76.OR.ISUB.EQ.77) THEN
12583
12584 XH=SH/SHP
12585 340 DO 370 JT=1,2
12586 I=MINT(14+JT)
12587 IA=IABS(I)
12588 IF(IA.LE.10) THEN
12589 RVCKM=VINT(180+I)*RLU(0)
12590 DO 360 J=1,MSTP(1)
12591 IB=2*J-1+MOD(IA,2)
12592 IPM=(5-ISIGN(1,I))/2
12593 IDC=J+MDCY(IA,2)+2
12594 IF(MDME(IDC,1).NE.1.AND.MDME(IDC,1).NE.IPM) GOTO 360
12595 MINT(20+JT)=ISIGN(IB,I)
12596 RVCKM=RVCKM-VCKM((IA+1)/2,(IB+1)/2)
12597 IF(RVCKM.LE.0.) GOTO 370
12598 360 CONTINUE
12599 ELSE
12600 IB=2*((IA+1)/2)-1+MOD(IA,2)
12601 MINT(20+JT)=ISIGN(IB,I)
12602 ENDIF
12603 370 PMQ(JT)=ULMASS(MINT(20+JT))
12604 JT=INT(1.5+RLU(0))
12605 ZMIN=2.*PMQ(JT)/SHPR
12606 ZMAX=1.-PMQ(3-JT)/SHPR-(SH-PMQ(JT)**2)/(SHPR*(SHPR-PMQ(3-JT)))
12607 ZMAX=MIN(1.-XH,ZMAX)
12608 Z(JT)=ZMIN+(ZMAX-ZMIN)*RLU(0)
12609 IF(-1.+(1.+XH)/(1.-Z(JT))-XH/(1.-Z(JT))**2.LT.
12610 & (1.-XH)**2/(4.*XH)*RLU(0)) GOTO 340
12611 SQC1=1.-4.*PMQ(JT)**2/(Z(JT)**2*SHP)
12612 IF(SQC1.LT.1.E-8) GOTO 340
12613 C1=SQRT(SQC1)
12614 C2=1.+2.*(PMAS(24,1)**2-PMQ(JT)**2)/(Z(JT)*SHP)
12615 CTHE(JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
12616 CTHE(JT)=MIN(1.,MAX(-1.,CTHE(JT)))
12617 Z(3-JT)=1.-XH/(1.-Z(JT))
12618 SQC1=1.-4.*PMQ(3-JT)**2/(Z(3-JT)**2*SHP)
12619 IF(SQC1.LT.1.E-8) GOTO 340
12620 C1=SQRT(SQC1)
12621 C2=1.+2.*(PMAS(24,1)**2-PMQ(3-JT)**2)/(Z(3-JT)*SHP)
12622 CTHE(3-JT)=(C2-(C2**2-C1**2)/(C2+(2.*RLU(0)-1.)*C1))/C1
12623 CTHE(3-JT)=MIN(1.,MAX(-1.,CTHE(3-JT)))
12624 PHIR=PARU(2)*RLU(0)
12625 CPHI=COS(PHIR)
12626 ANG=CTHE(1)*CTHE(2)-SQRT(1.-CTHE(1)**2)*SQRT(1.-CTHE(2)**2)*CPHI
12627 Z1=2.-Z(JT)
12628 Z2=ANG*SQRT(Z(JT)**2-4.*PMQ(JT)**2/SHP)
12629 Z3=1.-Z(JT)-XH+(PMQ(1)**2+PMQ(2)**2)/SHP
12630 Z(3-JT)=2./(Z1**2-Z2**2)*(Z1*Z3+Z2*SQRT(Z3**2-(Z1**2-Z2**2)*
12631 & PMQ(3-JT)**2/SHP))
12632 ZMIN=2.*PMQ(3-JT)/SHPR
12633 ZMAX=1.-PMQ(JT)/SHPR-(SH-PMQ(3-JT)**2)/(SHPR*(SHPR-PMQ(JT)))
12634 ZMAX=MIN(1.-XH,ZMAX)
12635 IF(Z(3-JT).LT.ZMIN.OR.Z(3-JT).GT.ZMAX) GOTO 340
12636 KCC=22
12637
12638 ELSEIF(ISUB.EQ.78) THEN
12639
12640
12641 ELSEIF(ISUB.EQ.79) THEN
12642
12643 ENDIF
12644
12645 ELSEIF(ISUB.LE.90) THEN
12646 IF(ISUB.EQ.81) THEN
12647
12648 MINT(21)=ISIGN(MINT(46),MINT(15))
12649 MINT(22)=-MINT(21)
12650 KCC=4
12651
12652 ELSEIF(ISUB.EQ.82) THEN
12653
12654 KCS=(-1)**INT(1.5+RLU(0))
12655 MINT(21)=ISIGN(MINT(46),KCS)
12656 MINT(22)=-MINT(21)
12657 KCC=MINT(2)+10
12658 ENDIF
12659
12660 ELSEIF(ISUB.LE.100) THEN
12661 IF(ISUB.EQ.95) THEN
12662
12663 KCC=MINT(2)+12
12664 KCS=(-1)**INT(1.5+RLU(0))
12665
12666 ELSEIF(ISUB.EQ.96) THEN
12667
12668 ENDIF
12669
12670 ELSEIF(ISUB.LE.110) THEN
12671 IF(ISUB.EQ.101) THEN
12672
12673 KCC=21
12674 KFRES=22
12675
12676 ELSEIF(ISUB.EQ.102) THEN
12677
12678 KCC=21
12679 KFRES=25
12680 ENDIF
12681
12682 ELSEIF(ISUB.LE.120) THEN
12683 IF(ISUB.EQ.111) THEN
12684
12685 IF(RLU(0).GT.0.5) JS=2
12686 MINT(20+JS)=21
12687 MINT(23-JS)=25
12688 KCC=17+JS
12689
12690 ELSEIF(ISUB.EQ.112) THEN
12691
12692 IF(MINT(15).EQ.21) JS=2
12693 MINT(23-JS)=25
12694 KCC=15+JS
12695 KCS=ISIGN(1,MINT(14+JS))
12696
12697 ELSEIF(ISUB.EQ.113) THEN
12698
12699 IF(RLU(0).GT.0.5) JS=2
12700 MINT(23-JS)=25
12701 KCC=22+JS
12702 KCS=(-1)**INT(1.5+RLU(0))
12703
12704 ELSEIF(ISUB.EQ.114) THEN
12705
12706 IF(RLU(0).GT.0.5) JS=2
12707 MINT(21)=22
12708 MINT(22)=22
12709 KCC=21
12710
12711 ELSEIF(ISUB.EQ.115) THEN
12712
12713
12714 ELSEIF(ISUB.EQ.116) THEN
12715
12716
12717 ELSEIF(ISUB.EQ.117) THEN
12718
12719 ENDIF
12720
12721 ELSEIF(ISUB.LE.140) THEN
12722 IF(ISUB.EQ.121) THEN
12723
12724 ENDIF
12725
12726 ELSEIF(ISUB.LE.160) THEN
12727 IF(ISUB.EQ.141) THEN
12728
12729 KFRES=32
12730
12731 ELSEIF(ISUB.EQ.142) THEN
12732
12733 KCH1=KCHG(IABS(MINT(15)),1)*ISIGN(1,MINT(15))
12734 KCH2=KCHG(IABS(MINT(16)),1)*ISIGN(1,MINT(16))
12735 KFRES=ISIGN(37,KCH1+KCH2)
12736
12737 ELSEIF(ISUB.EQ.143) THEN
12738
12739 KFRES=ISIGN(40,MINT(15)+MINT(16))
12740 ENDIF
12741
12742 ELSE
12743 IF(ISUB.EQ.161) THEN
12744
12745 IF(MINT(16).EQ.21) JS=2
12746 IA=IABS(MINT(17-JS))
12747 MINT(20+JS)=ISIGN(37,KCHG(IA,1)*MINT(17-JS))
12748 JA=IA+MOD(IA,2)-MOD(IA+1,2)
12749 MINT(23-JS)=ISIGN(JA,MINT(17-JS))
12750 KCC=18-JS
12751 IF(MINT(15).NE.21) KCS=ISIGN(1,MINT(15))
12752 IF(MINT(16).NE.21) KCS=ISIGN(1,MINT(16))
12753 ENDIF
12754 ENDIF
12755
12756 IF(IDOC.EQ.7) THEN
12757
12758 I=MINT(83)+7
12759 K(IPU3,1)=1
12760 K(IPU3,2)=KFRES
12761 K(IPU3,3)=I
12762 P(IPU3,4)=SHUSER
12763 P(IPU3,5)=SHUSER
12764 K(IPU1,4)=IPU2
12765 K(IPU1,5)=IPU2
12766 K(IPU2,4)=IPU1
12767 K(IPU2,5)=IPU1
12768 K(I,1)=21
12769 K(I,2)=KFRES
12770 P(I,4)=SHUSER
12771 P(I,5)=SHUSER
12772 N=IPU3
12773 MINT(21)=KFRES
12774 MINT(22)=0
12775
12776 ELSEIF(IDOC.EQ.8) THEN
12777
12778 DO 390 JT=1,2
12779 I=MINT(84)+2+JT
12780 K(I,1)=1
12781 IF(IABS(MINT(20+JT)).LE.10.OR.MINT(20+JT).EQ.21) K(I,1)=3
12782 K(I,2)=MINT(20+JT)
12783 K(I,3)=MINT(83)+IDOC+JT-2
12784 IF(IABS(K(I,2)).LE.10.OR.K(I,2).EQ.21) THEN
12785 P(I,5)=ULMASS(K(I,2))
12786 ELSE
12787 P(I,5)=SQRT(VINT(63+MOD(JS+JT,2)))
12788 ENDIF
12789 390 CONTINUE
12790 IF(P(IPU3,5)+P(IPU4,5).GE.SHR) THEN
12791 KFA1=IABS(MINT(21))
12792 KFA2=IABS(MINT(22))
12793 IF((KFA1.GT.3.AND.KFA1.NE.21).OR.(KFA2.GT.3.AND.KFA2.NE.21))
12794 & THEN
12795 MINT(51)=1
12796 RETURN
12797 ENDIF
12798 P(IPU3,5)=0.
12799 P(IPU4,5)=0.
12800 ENDIF
12801 P(IPU3,4)=0.5*(SHR+(P(IPU3,5)**2-P(IPU4,5)**2)/SHR)
12802 P(IPU3,3)=SQRT(MAX(0.,P(IPU3,4)**2-P(IPU3,5)**2))
12803 P(IPU4,4)=SHR-P(IPU3,4)
12804 P(IPU4,3)=-P(IPU3,3)
12805 N=IPU4
12806 MINT(7)=MINT(83)+7
12807 MINT(8)=MINT(83)+8
12808
12809
12810 CALL LUDBRB(IPU3,IPU4,ACOS(VINT(23)),VINT(24),0D0,0D0,0D0)
12811
12812 ELSEIF(IDOC.EQ.9) THEN
12813
12814
12815 ELSEIF(IDOC.EQ.11) THEN
12816
12817 PHI(1)=PARU(2)*RLU(0)
12818 PHI(2)=PHI(1)-PHIR
12819 DO 400 JT=1,2
12820 I=MINT(84)+2+JT
12821 K(I,1)=1
12822 IF(IABS(MINT(20+JT)).LE.10.OR.MINT(20+JT).EQ.21) K(I,1)=3
12823 K(I,2)=MINT(20+JT)
12824 K(I,3)=MINT(83)+IDOC+JT-2
12825 P(I,5)=ULMASS(K(I,2))
12826 IF(0.5*SHPR*Z(JT).LE.P(I,5)) P(I,5)=0.
12827 PABS=SQRT(MAX(0.,(0.5*SHPR*Z(JT))**2-P(I,5)**2))
12828 PTABS=PABS*SQRT(MAX(0.,1.-CTHE(JT)**2))
12829 P(I,1)=PTABS*COS(PHI(JT))
12830 P(I,2)=PTABS*SIN(PHI(JT))
12831 P(I,3)=PABS*CTHE(JT)*(-1)**(JT+1)
12832 P(I,4)=0.5*SHPR*Z(JT)
12833 IZW=MINT(83)+6+JT
12834 K(IZW,1)=21
12835 K(IZW,2)=23
12836 IF(ISUB.EQ.8) K(IZW,2)=ISIGN(24,LUCHGE(MINT(14+JT)))
12837 K(IZW,3)=IZW-2
12838 P(IZW,1)=-P(I,1)
12839 P(IZW,2)=-P(I,2)
12840 P(IZW,3)=(0.5*SHPR-PABS*CTHE(JT))*(-1)**(JT+1)
12841 P(IZW,4)=0.5*SHPR*(1.-Z(JT))
12842 400 P(IZW,5)=-SQRT(MAX(0.,P(IZW,3)**2+PTABS**2-P(IZW,4)**2))
12843 I=MINT(83)+9
12844 K(IPU5,1)=1
12845 K(IPU5,2)=KFRES
12846 K(IPU5,3)=I
12847 P(IPU5,5)=SHR
12848 P(IPU5,1)=-P(IPU3,1)-P(IPU4,1)
12849 P(IPU5,2)=-P(IPU3,2)-P(IPU4,2)
12850 P(IPU5,3)=-P(IPU3,3)-P(IPU4,3)
12851 P(IPU5,4)=SHPR-P(IPU3,4)-P(IPU4,4)
12852 K(I,1)=21
12853 K(I,2)=KFRES
12854 DO 410 J=1,5
12855 410 P(I,J)=P(IPU5,J)
12856 N=IPU5
12857 MINT(23)=KFRES
12858
12859 ELSEIF(IDOC.EQ.12) THEN
12860
12861 PHI(1)=PARU(2)*RLU(0)
12862 PHI(2)=PHI(1)-PHIR
12863 DO 420 JT=1,2
12864 I=MINT(84)+2+JT
12865 K(I,1)=1
12866 IF(IABS(MINT(20+JT)).LE.10.OR.MINT(20+JT).EQ.21) K(I,1)=3
12867 K(I,2)=MINT(20+JT)
12868 K(I,3)=MINT(83)+IDOC+JT-2
12869 P(I,5)=ULMASS(K(I,2))
12870 IF(0.5*SHPR*Z(JT).LE.P(I,5)) P(I,5)=0.
12871 PABS=SQRT(MAX(0.,(0.5*SHPR*Z(JT))**2-P(I,5)**2))
12872 PTABS=PABS*SQRT(MAX(0.,1.-CTHE(JT)**2))
12873 P(I,1)=PTABS*COS(PHI(JT))
12874 P(I,2)=PTABS*SIN(PHI(JT))
12875 P(I,3)=PABS*CTHE(JT)*(-1)**(JT+1)
12876 P(I,4)=0.5*SHPR*Z(JT)
12877 IZW=MINT(83)+6+JT
12878 K(IZW,1)=21
12879 IF(MINT(14+JT).EQ.MINT(20+JT)) THEN
12880 K(IZW,2)=23
12881 ELSE
12882 K(IZW,2)=ISIGN(24,LUCHGE(MINT(14+JT))-LUCHGE(MINT(20+JT)))
12883 ENDIF
12884 K(IZW,3)=IZW-2
12885 P(IZW,1)=-P(I,1)
12886 P(IZW,2)=-P(I,2)
12887 P(IZW,3)=(0.5*SHPR-PABS*CTHE(JT))*(-1)**(JT+1)
12888 P(IZW,4)=0.5*SHPR*(1.-Z(JT))
12889 P(IZW,5)=-SQRT(MAX(0.,P(IZW,3)**2+PTABS**2-P(IZW,4)**2))
12890 IPU=MINT(84)+4+JT
12891 K(IPU,1)=3
12892 K(IPU,2)=KFPR(ISUB,JT)
12893 K(IPU,3)=MINT(83)+8+JT
12894 IF(IABS(K(IPU,2)).LE.10.OR.K(IPU,2).EQ.21) THEN
12895 P(IPU,5)=ULMASS(K(IPU,2))
12896 ELSE
12897 P(IPU,5)=SQRT(VINT(63+MOD(JS+JT,2)))
12898 ENDIF
12899 MINT(22+JT)=K(IZW,2)
12900 420 CONTINUE
12901 IF(ISUB.EQ.72) K(MINT(84)+4+INT(1.5+RLU(0)),2)=-24
12902
12903 I1=MINT(83)+7
12904 I2=MINT(83)+8
12905 BEXCM=(P(I1,1)+P(I2,1))/(P(I1,4)+P(I2,4))
12906 BEYCM=(P(I1,2)+P(I2,2))/(P(I1,4)+P(I2,4))
12907 BEZCM=(P(I1,3)+P(I2,3))/(P(I1,4)+P(I2,4))
12908 GAMCM=(P(I1,4)+P(I2,4))/SHR
12909 BEPCM=BEXCM*P(I1,1)+BEYCM*P(I1,2)+BEZCM*P(I1,3)
12910 PX=P(I1,1)+GAMCM*(GAMCM/(1.+GAMCM)*BEPCM-P(I1,4))*BEXCM
12911 PY=P(I1,2)+GAMCM*(GAMCM/(1.+GAMCM)*BEPCM-P(I1,4))*BEYCM
12912 PZ=P(I1,3)+GAMCM*(GAMCM/(1.+GAMCM)*BEPCM-P(I1,4))*BEZCM
12913 THECM=ULANGL(PZ,SQRT(PX**2+PY**2))
12914 PHICM=ULANGL(PX,PY)
12915
12916 SQLAM=(SH-P(IPU5,5)**2-P(IPU6,5)**2)**2-4.*P(IPU5,5)**2*
12917 & P(IPU6,5)**2
12918 PABS=SQRT(MAX(0.,SQLAM/(4.*SH)))
12919 CTHWZ=VINT(23)
12920 STHWZ=SQRT(MAX(0.,1.-CTHWZ**2))
12921 PHIWZ=VINT(24)-PHICM
12922 P(IPU5,1)=PABS*STHWZ*COS(PHIWZ)
12923 P(IPU5,2)=PABS*STHWZ*SIN(PHIWZ)
12924 P(IPU5,3)=PABS*CTHWZ
12925 P(IPU5,4)=SQRT(PABS**2+P(IPU5,5)**2)
12926 P(IPU6,1)=-P(IPU5,1)
12927 P(IPU6,2)=-P(IPU5,2)
12928 P(IPU6,3)=-P(IPU5,3)
12929 P(IPU6,4)=SQRT(PABS**2+P(IPU6,5)**2)
12930 CALL LUDBRB(IPU5,IPU6,THECM,PHICM,DBLE(BEXCM),DBLE(BEYCM),
12931 & DBLE(BEZCM))
12932 DO 430 JT=1,2
12933 I1=MINT(83)+8+JT
12934 I2=MINT(84)+4+JT
12935 K(I1,1)=21
12936 K(I1,2)=K(I2,2)
12937 DO 430 J=1,5
12938 430 P(I1,J)=P(I2,J)
12939 N=IPU6
12940 MINT(7)=MINT(83)+9
12941 MINT(8)=MINT(83)+10
12942 ENDIF
12943
12944 IF(IDOC.GE.8) THEN
12945
12946 DO 440 J=1,2
12947 JC=J
12948 IF(KCS.EQ.-1) JC=3-J
12949 IF(ICOL(KCC,1,JC).NE.0.AND.K(IPU1,1).EQ.14) K(IPU1,J+3)=
12950 & K(IPU1,J+3)+MINT(84)+ICOL(KCC,1,JC)
12951 IF(ICOL(KCC,2,JC).NE.0.AND.K(IPU2,1).EQ.14) K(IPU2,J+3)=
12952 & K(IPU2,J+3)+MINT(84)+ICOL(KCC,2,JC)
12953 IF(ICOL(KCC,3,JC).NE.0.AND.K(IPU3,1).EQ.3) K(IPU3,J+3)=
12954 & MSTU(5)*(MINT(84)+ICOL(KCC,3,JC))
12955 440 IF(ICOL(KCC,4,JC).NE.0.AND.K(IPU4,1).EQ.3) K(IPU4,J+3)=
12956 & MSTU(5)*(MINT(84)+ICOL(KCC,4,JC))
12957
12958
12959 DO 450 I=1,2
12960 I1=MINT(83)+IDOC-2+I
12961 I2=MINT(84)+2+I
12962 K(I1,1)=21
12963 K(I1,2)=K(I2,2)
12964 IF(IDOC.LE.9) K(I1,3)=0
12965 IF(IDOC.GE.11) K(I1,3)=MINT(83)+2+I
12966 DO 450 J=1,5
12967 450 P(I1,J)=P(I2,J)
12968 ENDIF
12969 MINT(52)=N
12970
12971
12972 IF(ISUB.EQ.95) THEN
12973 K(IPU3,1)=K(IPU3,1)+10
12974 K(IPU4,1)=K(IPU4,1)+10
12975 DO 460 J=41,66
12976 460 VINT(J)=0.
12977 DO 470 I=MINT(83)+5,MINT(83)+8
12978 DO 470 J=1,5
12979 470 P(I,J)=0.
12980 ENDIF
12981
12982 RETURN
12983 END
12984
12985
12986
12987 SUBROUTINE PYSSPA(IPU1,IPU2)
12988
12989
12990 IMPLICIT DOUBLE PRECISION(D)
12991 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
12992 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
12993 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
12994 COMMON/PYSUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
12995 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
12996 COMMON/PYINT1/MINT(400),VINT(400)
12997 COMMON/PYINT2/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2)
12998 COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000)
12999 DIMENSION KFLS(4),IS(2),XS(2),ZS(2),Q2S(2),TEVS(2),ROBO(5),
13000 &XFS(2,-6:6),XFA(-6:6),XFB(-6:6),XFN(-6:6),WTAP(-6:6),WTSF(-6:6),
13001 &THE2(2),ALAM(2),DQ2(3),DPC(3),DPD(4),DPB(4)
13002 SAVE
13003
13004
13005 IPUS1=IPU1
13006 IPUS2=IPU2
13007 ISUB=MINT(1)
13008 Q2E=VINT(52)
13009 IF(ISET(ISUB).EQ.1) THEN
13010 Q2E=Q2E/PARP(67)
13011 ELSEIF(ISET(ISUB).EQ.3.OR.ISET(ISUB).EQ.4) THEN
13012 Q2E=PMAS(23,1)**2
13013 IF(ISUB.EQ.8.OR.ISUB.EQ.76.OR.ISUB.EQ.77) Q2E=PMAS(24,1)**2
13014 ENDIF
13015 TMAX=LOG(PARP(67)*PARP(63)*Q2E/PARP(61)**2)
13016 IF(PARP(67)*Q2E.LT.MAX(PARP(62)**2,2.*PARP(61)**2).OR.
13017 &TMAX.LT.0.2) RETURN
13018
13019
13020 XE0=2.*PARP(65)/VINT(1)
13021 ALAMS=PARU(111)
13022 PARU(111)=PARP(61)
13023 NS=N
13024 100 N=NS
13025 DO 110 JT=1,2
13026 KFLS(JT)=MINT(14+JT)
13027 KFLS(JT+2)=KFLS(JT)
13028 XS(JT)=VINT(40+JT)
13029 ZS(JT)=1.
13030 Q2S(JT)=PARP(67)*Q2E
13031 TEVS(JT)=TMAX
13032 ALAM(JT)=PARP(61)
13033 THE2(JT)=100.
13034 DO 110 KFL=-6,6
13035 110 XFS(JT,KFL)=XSFX(JT,KFL)
13036 DSH=VINT(44)
13037 IF(ISET(ISUB).EQ.3.OR.ISET(ISUB).EQ.4) DSH=VINT(26)*VINT(2)
13038
13039
13040 120 N=N+1
13041 JT=1
13042 IF(N.GT.NS+1.AND.Q2S(2).GT.Q2S(1)) JT=2
13043 KFLB=KFLS(JT)
13044 XB=XS(JT)
13045 DO 130 KFL=-6,6
13046 130 XFB(KFL)=XFS(JT,KFL)
13047 DSHR=2D0*SQRT(DSH)
13048 DSHZ=DSH/DBLE(ZS(JT))
13049 XE=MAX(XE0,XB*(1./(1.-PARP(66))-1.))
13050 IF(XB+XE.GE.0.999) THEN
13051 Q2B=0.
13052 GOTO 220
13053 ENDIF
13054
13055
13056 IF(MSTP(62).LE.1) THEN
13057 Q2B=0.5*(1./ZS(JT)+1.)*Q2S(JT)+0.5*(1./ZS(JT)-1.)*(Q2S(3-JT)-
13058 & SNGL(DSH)+SQRT((SNGL(DSH)+Q2S(1)+Q2S(2))**2+8.*Q2S(1)*Q2S(2)*
13059 & ZS(JT)/(1.-ZS(JT))))
13060 TEVB=LOG(PARP(63)*Q2B/ALAM(JT)**2)
13061 ELSE
13062 Q2B=Q2S(JT)
13063 TEVB=TEVS(JT)
13064 ENDIF
13065 ALSDUM=ULALPS(PARP(63)*Q2B)
13066 TEVB=TEVB+2.*LOG(ALAM(JT)/PARU(117))
13067 TEVBSV=TEVB
13068 ALAM(JT)=PARU(117)
13069 B0=(33.-2.*MSTU(118))/6.
13070
13071
13072 DO 140 KFL=-6,6
13073 WTAP(KFL)=0.
13074 140 WTSF(KFL)=0.
13075 IF(KFLB.EQ.21) THEN
13076 WTAPQ=16.*(1.-SQRT(XB+XE))/(3.*SQRT(XB))
13077 DO 150 KFL=-MSTP(54),MSTP(54)
13078 IF(KFL.EQ.0) WTAP(KFL)=6.*LOG((1.-XB)/XE)
13079 150 IF(KFL.NE.0) WTAP(KFL)=WTAPQ
13080 ELSE
13081 WTAP(0)=0.5*XB*(1./(XB+XE)-1.)
13082 WTAP(KFLB)=8.*LOG((1.-XB)*(XB+XE)/XE)/3.
13083 ENDIF
13084 160 WTSUM=0.
13085 IF(KFLB.NE.21) XFBO=XFB(KFLB)
13086 IF(KFLB.EQ.21) XFBO=XFB(0)
13087
13088
13089 IF(XFBO.EQ.0.0) THEN
13090 WRITE(MSTU(11),1000)
13091 WRITE(MSTU(11),1001) KFLB,XFB(KFLB)
13092 XFBO=0.00001
13093 ENDIF
13094
13095 DO 170 KFL=-MSTP(54),MSTP(54)
13096 WTSF(KFL)=XFB(KFL)/XFBO
13097 170 WTSUM=WTSUM+WTAP(KFL)*WTSF(KFL)
13098 WTSUM=MAX(0.0001,WTSUM)
13099
13100
13101 180 IF(MSTP(64).LE.0) THEN
13102 TEVB=TEVB+LOG(RLU(0))*PARU(2)/(PARU(111)*WTSUM)
13103 ELSEIF(MSTP(64).EQ.1) THEN
13104 TEVB=TEVB*EXP(MAX(-100.,LOG(RLU(0))*B0/WTSUM))
13105 ELSE
13106 TEVB=TEVB*EXP(MAX(-100.,LOG(RLU(0))*B0/(5.*WTSUM)))
13107 ENDIF
13108 190 Q2REF=ALAM(JT)**2*EXP(TEVB)
13109 Q2B=Q2REF/PARP(63)
13110
13111
13112 IF(Q2B.LT.PARP(62)**2) THEN
13113 Q2B=0.
13114 ELSE
13115 WTRAN=RLU(0)*WTSUM
13116 KFLA=-MSTP(54)-1
13117 200 KFLA=KFLA+1
13118 WTRAN=WTRAN-WTAP(KFLA)*WTSF(KFLA)
13119 IF(KFLA.LT.MSTP(54).AND.WTRAN.GT.0.) GOTO 200
13120 IF(KFLA.EQ.0) KFLA=21
13121
13122
13123 IF(KFLB.EQ.21.AND.KFLA.EQ.21) THEN
13124 Z=1./(1.+((1.-XB)/XB)*(XE/(1.-XB))**RLU(0))
13125 WTZ=(1.-Z*(1.-Z))**2
13126 ELSEIF(KFLB.EQ.21) THEN
13127 Z=XB/(1.-RLU(0)*(1.-SQRT(XB+XE)))**2
13128 WTZ=0.5*(1.+(1.-Z)**2)*SQRT(Z)
13129 ELSEIF(KFLA.EQ.21) THEN
13130 Z=XB*(1.+RLU(0)*(1./(XB+XE)-1.))
13131 WTZ=1.-2.*Z*(1.-Z)
13132 ELSE
13133 Z=1.-(1.-XB)*(XE/((XB+XE)*(1.-XB)))**RLU(0)
13134 WTZ=0.5*(1.+Z**2)
13135 ENDIF
13136
13137
13138 IF(MSTP(65).GE.1) THEN
13139 RSOFT=6.
13140 IF(KFLB.NE.21) RSOFT=8./3.
13141 Z=Z*(TEVB/TEVS(JT))**(RSOFT*XE/((XB+XE)*B0))
13142 IF(Z.LE.XB) GOTO 180
13143 ENDIF
13144
13145
13146 IF(MSTP(64).GE.2) THEN
13147 IF((1.-Z)*Q2B.LT.PARP(62)**2) GOTO 180
13148 ALPRAT=TEVB/(TEVB+LOG(1.-Z))
13149 IF(ALPRAT.LT.5.*RLU(0)) GOTO 180
13150 IF(ALPRAT.GT.5.) WTZ=WTZ*ALPRAT/5.
13151 ENDIF
13152
13153
13154 IF(MSTP(62).GE.3) THEN
13155 THE2T=(4.*Z**2*Q2B)/(VINT(2)*(1.-Z)*XB**2)
13156 IF(THE2T.GT.THE2(JT)) GOTO 180
13157 ENDIF
13158
13159
13160 CALL PYSTFU(MINT(10+JT),XB,Q2REF,XFN,JT)
13161 IF(KFLB.NE.21) XFBN=XFN(KFLB)
13162 IF(KFLB.EQ.21) XFBN=XFN(0)
13163 IF(XFBN.LT.1E-20) THEN
13164 IF(KFLA.EQ.KFLB) THEN
13165 TEVB=TEVBSV
13166 WTAP(KFLB)=0.
13167 GOTO 160
13168 ELSEIF(TEVBSV-TEVB.GT.0.2) THEN
13169 TEVB=0.5*(TEVBSV+TEVB)
13170 GOTO 190
13171 ELSE
13172 XFBN=1E-10
13173 ENDIF
13174 ENDIF
13175 DO 210 KFL=-MSTP(54),MSTP(54)
13176 210 XFB(KFL)=XFN(KFL)
13177 XA=XB/Z
13178 CALL PYSTFU(MINT(10+JT),XA,Q2REF,XFA,JT)
13179 IF(KFLA.NE.21) XFAN=XFA(KFLA)
13180 IF(KFLA.EQ.21) XFAN=XFA(0)
13181 IF(XFAN.LT.1E-20) GOTO 160
13182 IF(KFLA.NE.21) WTSFA=WTSF(KFLA)
13183 IF(KFLA.EQ.21) WTSFA=WTSF(0)
13184 IF(WTZ*XFAN/XFBN.LT.RLU(0)*WTSFA) GOTO 160
13185 ENDIF
13186
13187
13188 220 IF(N.EQ.NS+2) THEN
13189 DQ2(JT)=Q2B
13190 DPLCM=SQRT((DSH+DQ2(1)+DQ2(2))**2-4D0*DQ2(1)*DQ2(2))/DSHR
13191 DO 240 JR=1,2
13192 I=NS+JR
13193 IF(JR.EQ.1) IPO=IPUS1
13194 IF(JR.EQ.2) IPO=IPUS2
13195 DO 230 J=1,5
13196 K(I,J)=0
13197 P(I,J)=0.
13198 230 V(I,J)=0.
13199 K(I,1)=14
13200 K(I,2)=KFLS(JR+2)
13201 K(I,4)=IPO
13202 K(I,5)=IPO
13203 P(I,3)=DPLCM*(-1)**(JR+1)
13204 P(I,4)=(DSH+DQ2(3-JR)-DQ2(JR))/DSHR
13205 P(I,5)=-SQRT(SNGL(DQ2(JR)))
13206 K(IPO,1)=14
13207 K(IPO,3)=I
13208 K(IPO,4)=MOD(K(IPO,4),MSTU(5))+MSTU(5)*I
13209 240 K(IPO,5)=MOD(K(IPO,5),MSTU(5))+MSTU(5)*I
13210
13211
13212 ELSEIF(N.GT.NS+2) THEN
13213 JR=3-JT
13214 DQ2(3)=Q2B
13215 DPC(1)=P(IS(1),4)
13216 DPC(2)=P(IS(2),4)
13217 DPC(3)=0.5*(ABS(P(IS(1),3))+ABS(P(IS(2),3)))
13218 DPD(1)=DSH+DQ2(JR)+DQ2(JT)
13219 DPD(2)=DSHZ+DQ2(JR)+DQ2(3)
13220 DPD(3)=SQRT(DPD(1)**2-4D0*DQ2(JR)*DQ2(JT))
13221 DPD(4)=SQRT(DPD(2)**2-4D0*DQ2(JR)*DQ2(3))
13222 IKIN=0
13223 IF(Q2S(JR).GE.(0.5*PARP(62))**2.AND.DPD(1)-DPD(3).GE.
13224 & 1D-10*DPD(1)) IKIN=1
13225 IF(IKIN.EQ.0) DMSMA=(DQ2(JT)/DBLE(ZS(JT))-DQ2(3))*(DSH/
13226 & (DSH+DQ2(JT))-DSH/(DSHZ+DQ2(3)))
13227 IF(IKIN.EQ.1) DMSMA=(DPD(1)*DPD(2)-DPD(3)*DPD(4))/(2.*
13228 & DQ2(JR))-DQ2(JT)-DQ2(3)
13229
13230
13231 IT=N
13232 DO 250 J=1,5
13233 K(IT,J)=0
13234 P(IT,J)=0.
13235 250 V(IT,J)=0.
13236 K(IT,1)=3
13237 K(IT,2)=21
13238 IF(KFLB.EQ.21.AND.KFLS(JT+2).NE.21) K(IT,2)=-KFLS(JT+2)
13239 IF(KFLB.NE.21.AND.KFLS(JT+2).EQ.21) K(IT,2)=KFLB
13240 P(IT,5)=ULMASS(K(IT,2))
13241 IF(SNGL(DMSMA).LE.P(IT,5)**2) GOTO 100
13242 IF(MSTP(63).GE.1) THEN
13243 P(IT,4)=(DSHZ-DSH-P(IT,5)**2)/DSHR
13244 P(IT,3)=SQRT(P(IT,4)**2-P(IT,5)**2)
13245 IF(MSTP(63).EQ.1) THEN
13246 Q2TIM=DMSMA
13247 ELSEIF(MSTP(63).EQ.2) THEN
13248 Q2TIM=MIN(SNGL(DMSMA),PARP(71)*Q2S(JT))
13249 ELSE
13250
13251 Q2TIM=DMSMA
13252 ENDIF
13253 CALL LUSHOW(IT,0,SQRT(Q2TIM))
13254 IF(N.GE.IT+1) P(IT,5)=P(IT+1,5)
13255 ENDIF
13256
13257
13258 DMS=P(IT,5)**2
13259 IF(IKIN.EQ.0) DPT2=(DMSMA-DMS)*(DSHZ+DQ2(3))/(DSH+DQ2(JT))
13260 IF(IKIN.EQ.1) DPT2=(DMSMA-DMS)*(0.5*DPD(1)*DPD(2)+0.5*DPD(3)*
13261 & DPD(4)-DQ2(JR)*(DQ2(JT)+DQ2(3)+DMS))/(4.*DSH*DPC(3)**2)
13262 IF(DPT2.LT.0.) GOTO 100
13263 DPB(1)=(0.5*DPD(2)-DPC(JR)*(DSHZ+DQ2(JR)-DQ2(JT)-DMS)/
13264 & DSHR)/DPC(3)-DPC(3)
13265 P(IT,1)=SQRT(SNGL(DPT2))
13266 P(IT,3)=DPB(1)*(-1)**(JT+1)
13267 P(IT,4)=(DSHZ-DSH-DMS)/DSHR
13268 IF(N.GE.IT+1) THEN
13269 DPB(1)=SQRT(DPB(1)**2+DPT2)
13270 DPB(2)=SQRT(DPB(1)**2+DMS)
13271 DPB(3)=P(IT+1,3)
13272 DPB(4)=SQRT(DPB(3)**2+DMS)
13273 DBEZ=(DPB(4)*DPB(1)-DPB(3)*DPB(2))/(DPB(4)*DPB(2)-DPB(3)*
13274 & DPB(1))
13275 CALL LUDBRB(IT+1,N,0.,0.,0D0,0D0,DBEZ)
13276 THE=ULANGL(P(IT,3),P(IT,1))
13277 CALL LUDBRB(IT+1,N,THE,0.,0D0,0D0,0D0)
13278 ENDIF
13279
13280
13281 DO 260 J=1,5
13282 K(N+1,J)=0
13283 P(N+1,J)=0.
13284 260 V(N+1,J)=0.
13285 K(N+1,1)=14
13286 K(N+1,2)=KFLB
13287 P(N+1,1)=P(IT,1)
13288 P(N+1,3)=P(IT,3)+P(IS(JT),3)
13289 P(N+1,4)=P(IT,4)+P(IS(JT),4)
13290 P(N+1,5)=-SQRT(SNGL(DQ2(3)))
13291
13292
13293 K(IS(JT),3)=N+1
13294 K(IT,3)=N+1
13295 ID1=IT
13296 IF((K(N+1,2).GT.0.AND.K(N+1,2).NE.21.AND.K(ID1,2).GT.0.AND.
13297 & K(ID1,2).NE.21).OR.(K(N+1,2).LT.0.AND.K(ID1,2).EQ.21).OR.
13298 & (K(N+1,2).EQ.21.AND.K(ID1,2).EQ.21.AND.RLU(0).GT.0.5).OR.
13299 & (K(N+1,2).EQ.21.AND.K(ID1,2).LT.0)) ID1=IS(JT)
13300 ID2=IT+IS(JT)-ID1
13301 K(N+1,4)=K(N+1,4)+ID1
13302 K(N+1,5)=K(N+1,5)+ID2
13303 K(ID1,4)=K(ID1,4)+MSTU(5)*(N+1)
13304 K(ID1,5)=K(ID1,5)+MSTU(5)*ID2
13305 K(ID2,4)=K(ID2,4)+MSTU(5)*ID1
13306 K(ID2,5)=K(ID2,5)+MSTU(5)*(N+1)
13307 N=N+1
13308
13309
13310 CALL LUDBRB(NS+1,N,0.,0.,-DBLE((P(N,1)+P(IS(JR),1))/(P(N,4)+
13311 & P(IS(JR),4))),0D0,-DBLE((P(N,3)+P(IS(JR),3))/(P(N,4)+
13312 & P(IS(JR),4))))
13313 IR=N+(JT-1)*(IS(1)-N)
13314 CALL LUDBRB(NS+1,N,-ULANGL(P(IR,3),P(IR,1)),PARU(2)*RLU(0),
13315 & 0D0,0D0,0D0)
13316 ENDIF
13317
13318
13319 IS(JT)=N
13320 Q2S(JT)=Q2B
13321 DQ2(JT)=Q2B
13322 IF(MSTP(62).GE.3) THE2(JT)=THE2T
13323 DSH=DSHZ
13324 IF(Q2B.GE.(0.5*PARP(62))**2) THEN
13325 KFLS(JT+2)=KFLS(JT)
13326 KFLS(JT)=KFLA
13327 XS(JT)=XA
13328 ZS(JT)=Z
13329 DO 270 KFL=-6,6
13330 270 XFS(JT,KFL)=XFA(KFL)
13331 TEVS(JT)=TEVB
13332 ELSE
13333 IF(JT.EQ.1) IPU1=N
13334 IF(JT.EQ.2) IPU2=N
13335 ENDIF
13336 IF(N.GT.MSTU(4)-MSTU(32)-10) THEN
13337 CALL LUERRM(11,'(PYSSPA:) no more memory left in LUJETS')
13338 IF(MSTU(21).GE.1) N=NS
13339 IF(MSTU(21).GE.1) RETURN
13340 ENDIF
13341 IF(MAX(Q2S(1),Q2S(2)).GE.(0.5*PARP(62))**2.OR.N.LE.NS+1) GOTO 120
13342
13343
13344 DO 280 J=1,3
13345 280 ROBO(J+2)=(P(NS+1,J)+P(NS+2,J))/(P(NS+1,4)+P(NS+2,4))
13346 DO 290 J=1,5
13347 290 P(N+2,J)=P(NS+1,J)
13348 ROBOT=ROBO(3)**2+ROBO(4)**2+ROBO(5)**2
13349 IF(ROBOT.GE.0.999999) THEN
13350 ROBOT=1.00001*SQRT(ROBOT)
13351 ROBO(3)=ROBO(3)/ROBOT
13352 ROBO(4)=ROBO(4)/ROBOT
13353 ROBO(5)=ROBO(5)/ROBOT
13354 ENDIF
13355 CALL LUDBRB(N+2,N+2,0.,0.,-DBLE(ROBO(3)),-DBLE(ROBO(4)),
13356 &-DBLE(ROBO(5)))
13357 ROBO(2)=ULANGL(P(N+2,1),P(N+2,2))
13358 ROBO(1)=ULANGL(P(N+2,3),SQRT(P(N+2,1)**2+P(N+2,2)**2))
13359 CALL LUDBRB(MINT(83)+5,NS,ROBO(1),ROBO(2),DBLE(ROBO(3)),
13360 &DBLE(ROBO(4)),DBLE(ROBO(5)))
13361
13362
13363 K(IPU1,3)=MINT(83)+3
13364 K(IPU2,3)=MINT(83)+4
13365 DO 300 JT=1,2
13366 MINT(12+JT)=KFLS(JT)
13367 300 VINT(140+JT)=XS(JT)
13368 PARU(111)=ALAMS
13369 1000 FORMAT(5X,'structure function has a zero point here')
13370 1001 FORMAT(5X,'xf(x,i=',I5,')=',F10.5)
13371
13372 RETURN
13373 END
13374
13375
13376
13377 SUBROUTINE PYMULT(MMUL)
13378
13379
13380
13381
13382 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
13383 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
13384 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
13385 COMMON/PYSUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
13386 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
13387 COMMON/PYINT1/MINT(400),VINT(400)
13388 COMMON/PYINT2/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2)
13389 COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000)
13390 COMMON/PYINT5/NGEN(0:200,3),XSEC(0:200,3)
13391 DIMENSION NMUL(20),SIGM(20),KSTR(500,2)
13392 SAVE
13393
13394
13395 IF(MMUL.EQ.1) THEN
13396 IF(MSTP(122).GE.1) WRITE(MSTU(11),1000) MSTP(82)
13397 ISUB=96
13398 MINT(1)=96
13399 VINT(63)=0.
13400 VINT(64)=0.
13401 VINT(143)=1.
13402 VINT(144)=1.
13403
13404
13405 100 SIGSUM=0.
13406 DO 120 IXT2=1,20
13407 NMUL(IXT2)=MSTP(83)
13408 SIGM(IXT2)=0.
13409 DO 110 ITRY=1,MSTP(83)
13410 RSCA=0.05*((21-IXT2)-RLU(0))
13411 XT2=VINT(149)*(1.+VINT(149))/(VINT(149)+RSCA)-VINT(149)
13412 XT2=MAX(0.01*VINT(149),XT2)
13413 VINT(25)=XT2
13414
13415
13416 IF(RLU(0).LE.COEF(ISUB,1)) THEN
13417 TAUP=(2.*(1.+SQRT(1.-XT2))/XT2-1.)**RLU(0)
13418 TAU=XT2*(1.+TAUP)**2/(4.*TAUP)
13419 ELSE
13420 TAU=XT2*(1.+TAN(RLU(0)*ATAN(SQRT(1./XT2-1.)))**2)
13421 ENDIF
13422 VINT(21)=TAU
13423 CALL PYKLIM(2)
13424 RYST=RLU(0)
13425 MYST=1
13426 IF(RYST.GT.COEF(ISUB,7)) MYST=2
13427 IF(RYST.GT.COEF(ISUB,7)+COEF(ISUB,8)) MYST=3
13428 CALL PYKMAP(2,MYST,RLU(0))
13429 VINT(23)=SQRT(MAX(0.,1.-XT2/TAU))*(-1)**INT(1.5+RLU(0))
13430
13431
13432 VINT(71)=0.5*VINT(1)*SQRT(XT2)
13433 CALL PYSIGH(NCHN,SIGS)
13434 110 SIGM(IXT2)=SIGM(IXT2)+SIGS
13435 120 SIGSUM=SIGSUM+SIGM(IXT2)
13436 SIGSUM=SIGSUM/(20.*MSTP(83))
13437
13438
13439 IF(SIGSUM.LT.1.1*VINT(106)) THEN
13440 IF(MSTP(122).GE.1) WRITE(MSTU(11),1100) PARP(82),SIGSUM
13441 PARP(82)=0.9*PARP(82)
13442 VINT(149)=4.*PARP(82)**2/VINT(2)
13443 GOTO 100
13444 ENDIF
13445 IF(MSTP(122).GE.1) WRITE(MSTU(11),1200) PARP(82), SIGSUM
13446
13447
13448 YKE=SIGSUM/VINT(106)
13449 SO=0.5
13450 XI=0.
13451 YI=0.
13452 XK=0.5
13453 IIT=0
13454 130 IF(IIT.EQ.0) THEN
13455 XK=2.*XK
13456 ELSEIF(IIT.EQ.1) THEN
13457 XK=0.5*XK
13458 ELSE
13459 XK=XI+(YKE-YI)*(XF-XI)/(YF-YI)
13460 ENDIF
13461
13462
13463 IF(MSTP(82).EQ.2) THEN
13464 SP=0.5*PARU(1)*(1.-EXP(-XK))
13465 SOP=SP/PARU(1)
13466 ELSE
13467 IF(MSTP(82).EQ.3) DELTAB=0.02
13468 IF(MSTP(82).EQ.4) DELTAB=MIN(0.01,0.05*PARP(84))
13469 SP=0.
13470 SOP=0.
13471 B=-0.5*DELTAB
13472 140 B=B+DELTAB
13473 IF(MSTP(82).EQ.3) THEN
13474 OV=EXP(-B**2)/PARU(2)
13475 ELSE
13476 CQ2=PARP(84)**2
13477 OV=((1.-PARP(83))**2*EXP(-MIN(100.,B**2))+2.*PARP(83)*
13478 & (1.-PARP(83))*2./(1.+CQ2)*EXP(-MIN(100.,B**2*2./(1.+CQ2)))+
13479 & PARP(83)**2/CQ2*EXP(-MIN(100.,B**2/CQ2)))/PARU(2)
13480 ENDIF
13481 PACC=1.-EXP(-MIN(100.,PARU(1)*XK*OV))
13482 SP=SP+PARU(2)*B*DELTAB*PACC
13483 SOP=SOP+PARU(2)*B*DELTAB*OV*PACC
13484 IF(B.LT.1..OR.B*PACC.GT.1E-6) GOTO 140
13485 ENDIF
13486 YK=PARU(1)*XK*SO/SP
13487
13488
13489 IF(YK.LT.YKE) THEN
13490 XI=XK
13491 YI=YK
13492 IF(IIT.EQ.1) IIT=2
13493 ELSE
13494 XF=XK
13495 YF=YK
13496 IF(IIT.EQ.0) IIT=1
13497 ENDIF
13498 IF(ABS(YK-YKE).GE.1E-5*YKE) GOTO 130
13499
13500
13501 VINT(145)=SIGSUM
13502 VINT(146)=SOP/SO
13503 VINT(147)=SOP/SP
13504
13505
13506 ELSEIF(MMUL.EQ.2) THEN
13507 IF(MSTP(82).LE.0) THEN
13508 ELSEIF(MSTP(82).EQ.1) THEN
13509 XT2=1.
13510 XT2FAC=XSEC(96,1)/VINT(106)*VINT(149)/(1.-VINT(149))
13511 ELSEIF(MSTP(82).EQ.2) THEN
13512 XT2=1.
13513 XT2FAC=VINT(146)*XSEC(96,1)/VINT(106)*VINT(149)*(1.+VINT(149))
13514 ELSE
13515 XC2=4.*CKIN(3)**2/VINT(2)
13516 IF(CKIN(3).LE.CKIN(5).OR.MINT(82).GE.2) XC2=0.
13517 ENDIF
13518
13519 ELSEIF(MMUL.EQ.3) THEN
13520
13521
13522
13523 ISUB=MINT(1)
13524 IF(MSTP(82).LE.0) THEN
13525 XT2=0.
13526 ELSEIF(MSTP(82).EQ.1) THEN
13527 XT2=XT2FAC*XT2/(XT2FAC-XT2*LOG(RLU(0)))
13528 ELSEIF(MSTP(82).EQ.2) THEN
13529 IF(XT2.LT.1..AND.EXP(-XT2FAC*XT2/(VINT(149)*(XT2+
13530 & VINT(149)))).GT.RLU(0)) XT2=1.
13531 IF(XT2.GE.1.) THEN
13532 XT2=(1.+VINT(149))*XT2FAC/(XT2FAC-(1.+VINT(149))*LOG(1.-
13533 & RLU(0)*(1.-EXP(-XT2FAC/(VINT(149)*(1.+VINT(149)))))))-
13534 & VINT(149)
13535 ELSE
13536 XT2=-XT2FAC/LOG(EXP(-XT2FAC/(XT2+VINT(149)))+RLU(0)*
13537 & (EXP(-XT2FAC/VINT(149))-EXP(-XT2FAC/(XT2+VINT(149)))))-
13538 & VINT(149)
13539 ENDIF
13540 XT2=MAX(0.01*VINT(149),XT2)
13541 ELSE
13542 XT2=(XC2+VINT(149))*(1.+VINT(149))/(1.+VINT(149)-
13543 & RLU(0)*(1.-XC2))-VINT(149)
13544 XT2=MAX(0.01*VINT(149),XT2)
13545 ENDIF
13546 VINT(25)=XT2
13547
13548
13549 IF(MSTP(82).LE.1.AND.XT2.LT.VINT(149)) THEN
13550 IF(MINT(82).EQ.1) NGEN(0,1)=NGEN(0,1)-1
13551 IF(MINT(82).EQ.1) NGEN(ISUB,1)=NGEN(ISUB,1)-1
13552 ISUB=95
13553 MINT(1)=ISUB
13554 VINT(21)=0.01*VINT(149)
13555 VINT(22)=0.
13556 VINT(23)=0.
13557 VINT(25)=0.01*VINT(149)
13558
13559 ELSE
13560
13561
13562 IF(RLU(0).LE.COEF(ISUB,1)) THEN
13563 TAUP=(2.*(1.+SQRT(1.-XT2))/XT2-1.)**RLU(0)
13564 TAU=XT2*(1.+TAUP)**2/(4.*TAUP)
13565 ELSE
13566 TAU=XT2*(1.+TAN(RLU(0)*ATAN(SQRT(1./XT2-1.)))**2)
13567 ENDIF
13568 VINT(21)=TAU
13569 CALL PYKLIM(2)
13570 RYST=RLU(0)
13571 MYST=1
13572 IF(RYST.GT.COEF(ISUB,7)) MYST=2
13573 IF(RYST.GT.COEF(ISUB,7)+COEF(ISUB,8)) MYST=3
13574 CALL PYKMAP(2,MYST,RLU(0))
13575 VINT(23)=SQRT(MAX(0.,1.-XT2/TAU))*(-1)**INT(1.5+RLU(0))
13576 ENDIF
13577 VINT(71)=0.5*VINT(1)*SQRT(VINT(25))
13578
13579
13580 ELSEIF(MMUL.EQ.4) THEN
13581 ISUB=MINT(1)
13582 XTS=VINT(25)
13583 IF(ISET(ISUB).EQ.1) XTS=VINT(21)
13584 IF(ISET(ISUB).EQ.2) XTS=(4.*VINT(48)+2.*VINT(63)+2.*VINT(64))/
13585 & VINT(2)
13586 IF(ISET(ISUB).EQ.3.OR.ISET(ISUB).EQ.4) XTS=VINT(26)
13587 RBIN=MAX(0.000001,MIN(0.999999,XTS*(1.+VINT(149))/
13588 & (XTS+VINT(149))))
13589 IRBIN=INT(1.+20.*RBIN)
13590 IF(ISUB.EQ.96) NMUL(IRBIN)=NMUL(IRBIN)+1
13591 IF(ISUB.EQ.96) SIGM(IRBIN)=SIGM(IRBIN)+VINT(153)
13592
13593
13594 ELSEIF(MMUL.EQ.5) THEN
13595 IF(MSTP(82).EQ.3) THEN
13596 VINT(148)=RLU(0)/(PARU(2)*VINT(147))
13597 ELSE
13598 RTYPE=RLU(0)
13599 CQ2=PARP(84)**2
13600 IF(RTYPE.LT.(1.-PARP(83))**2) THEN
13601 B2=-LOG(RLU(0))
13602 ELSEIF(RTYPE.LT.1.-PARP(83)**2) THEN
13603 B2=-0.5*(1.+CQ2)*LOG(RLU(0))
13604 ELSE
13605 B2=-CQ2*LOG(RLU(0))
13606 ENDIF
13607 VINT(148)=((1.-PARP(83))**2*EXP(-MIN(100.,B2))+2.*PARP(83)*
13608 & (1.-PARP(83))*2./(1.+CQ2)*EXP(-MIN(100.,B2*2./(1.+CQ2)))+
13609 & PARP(83)**2/CQ2*EXP(-MIN(100.,B2/CQ2)))/(PARU(2)*VINT(147))
13610 ENDIF
13611
13612
13613
13614 RNCOR=(IRBIN-20.*RBIN)*NMUL(IRBIN)
13615 SIGCOR=(IRBIN-20.*RBIN)*SIGM(IRBIN)
13616 DO 150 IBIN=IRBIN+1,20
13617 RNCOR=RNCOR+NMUL(IBIN)
13618 150 SIGCOR=SIGCOR+SIGM(IBIN)
13619 SIGABV=(SIGCOR/RNCOR)*VINT(149)*(1.-XTS)/(XTS+VINT(149))
13620 VINT(150)=EXP(-MIN(100.,VINT(146)*VINT(148)*SIGABV/VINT(106)))
13621
13622
13623 ELSEIF(MMUL.EQ.6) THEN
13624
13625
13626 ISUB=MINT(1)
13627 NMAX=MINT(84)+4
13628 IF(ISET(ISUB).EQ.1) NMAX=MINT(84)+2
13629 NSTR=0
13630 DO 170 I=MINT(84)+1,NMAX
13631 KCS=KCHG(LUCOMP(K(I,2)),2)*ISIGN(1,K(I,2))
13632 IF(KCS.EQ.0) GOTO 170
13633 DO 160 J=1,4
13634 IF(KCS.EQ.1.AND.(J.EQ.2.OR.J.EQ.4)) GOTO 160
13635 IF(KCS.EQ.-1.AND.(J.EQ.1.OR.J.EQ.3)) GOTO 160
13636 IF(J.LE.2) THEN
13637 IST=MOD(K(I,J+3)/MSTU(5),MSTU(5))
13638 ELSE
13639 IST=MOD(K(I,J+1),MSTU(5))
13640 ENDIF
13641 IF(IST.LT.MINT(84).OR.IST.GT.I) GOTO 160
13642 IF(KCHG(LUCOMP(K(IST,2)),2).EQ.0) GOTO 160
13643 NSTR=NSTR+1
13644 IF(J.EQ.1.OR.J.EQ.4) THEN
13645 KSTR(NSTR,1)=I
13646 KSTR(NSTR,2)=IST
13647 ELSE
13648 KSTR(NSTR,1)=IST
13649 KSTR(NSTR,2)=I
13650 ENDIF
13651 160 CONTINUE
13652 170 CONTINUE
13653
13654
13655 XT2=VINT(25)
13656 IF(ISET(ISUB).EQ.1) XT2=VINT(21)
13657 IF(ISET(ISUB).EQ.2) XT2=(4.*VINT(48)+2.*VINT(63)+2.*VINT(64))/
13658 & VINT(2)
13659 IF(ISET(ISUB).EQ.3.OR.ISET(ISUB).EQ.4) XT2=VINT(26)
13660 ISUB=96
13661 MINT(1)=96
13662 IF(MSTP(82).LE.1) THEN
13663 XT2FAC=XSEC(ISUB,1)*VINT(149)/((1.-VINT(149))*VINT(106))
13664 ELSE
13665 XT2FAC=VINT(146)*VINT(148)*XSEC(ISUB,1)/VINT(106)*
13666 & VINT(149)*(1.+VINT(149))
13667 ENDIF
13668 VINT(63)=0.
13669 VINT(64)=0.
13670 VINT(151)=0.
13671 VINT(152)=0.
13672 VINT(143)=1.-VINT(141)
13673 VINT(144)=1.-VINT(142)
13674
13675
13676 180 IF(MSTP(82).LE.1) THEN
13677 XT2=XT2FAC*XT2/(XT2FAC-XT2*LOG(RLU(0)))
13678 IF(XT2.LT.VINT(149)) GOTO 220
13679 ELSE
13680 IF(XT2.LE.0.01*VINT(149)) GOTO 220
13681 XT2=XT2FAC*(XT2+VINT(149))/(XT2FAC-(XT2+VINT(149))*
13682 & LOG(RLU(0)))-VINT(149)
13683 IF(XT2.LE.0.) GOTO 220
13684 XT2=MAX(0.01*VINT(149),XT2)
13685 ENDIF
13686 VINT(25)=XT2
13687
13688
13689 IF(RLU(0).LE.COEF(ISUB,1)) THEN
13690 TAUP=(2.*(1.+SQRT(1.-XT2))/XT2-1.)**RLU(0)
13691 TAU=XT2*(1.+TAUP)**2/(4.*TAUP)
13692 ELSE
13693 TAU=XT2*(1.+TAN(RLU(0)*ATAN(SQRT(1./XT2-1.)))**2)
13694 ENDIF
13695 VINT(21)=TAU
13696 CALL PYKLIM(2)
13697 RYST=RLU(0)
13698 MYST=1
13699 IF(RYST.GT.COEF(ISUB,7)) MYST=2
13700 IF(RYST.GT.COEF(ISUB,7)+COEF(ISUB,8)) MYST=3
13701 CALL PYKMAP(2,MYST,RLU(0))
13702 VINT(23)=SQRT(MAX(0.,1.-XT2/TAU))*(-1)**INT(1.5+RLU(0))
13703
13704
13705 X1M=SQRT(TAU)*EXP(VINT(22))
13706 X2M=SQRT(TAU)*EXP(-VINT(22))
13707 IF(VINT(143)-X1M.LT.0.01.OR.VINT(144)-X2M.LT.0.01) GOTO 180
13708 VINT(71)=0.5*VINT(1)*SQRT(XT2)
13709 CALL PYSIGH(NCHN,SIGS)
13710 IF(SIGS.LT.XSEC(ISUB,1)*RLU(0)) GOTO 180
13711
13712
13713 DO 190 I=N+1,N+2
13714 DO 190 J=1,5
13715 K(I,J)=0
13716 P(I,J)=0.
13717 190 V(I,J)=0.
13718 RFLAV=RLU(0)
13719 PT=0.5*VINT(1)*SQRT(XT2)
13720 PHI=PARU(2)*RLU(0)
13721 CTH=VINT(23)
13722
13723
13724 K(N+1,1)=3
13725 K(N+1,2)=21
13726 IF(RFLAV.GE.MAX(PARP(85),PARP(86))) K(N+1,2)=
13727 & 1+INT((2.+PARJ(2))*RLU(0))
13728 P(N+1,1)=PT*COS(PHI)
13729 P(N+1,2)=PT*SIN(PHI)
13730 P(N+1,3)=0.25*VINT(1)*(VINT(41)*(1.+CTH)-VINT(42)*(1.-CTH))
13731 P(N+1,4)=0.25*VINT(1)*(VINT(41)*(1.+CTH)+VINT(42)*(1.-CTH))
13732 P(N+1,5)=0.
13733
13734
13735 K(N+2,1)=3
13736 K(N+2,2)=21
13737 IF(K(N+1,2).NE.21) K(N+2,2)=-K(N+1,2)
13738 P(N+2,1)=-P(N+1,1)
13739 P(N+2,2)=-P(N+1,2)
13740 P(N+2,3)=0.25*VINT(1)*(VINT(41)*(1.-CTH)-VINT(42)*(1.+CTH))
13741 P(N+2,4)=0.25*VINT(1)*(VINT(41)*(1.-CTH)+VINT(42)*(1.+CTH))
13742 P(N+2,5)=0.
13743
13744 IF(RFLAV.LT.PARP(85).AND.NSTR.GE.1) THEN
13745
13746 DO 210 I=N+1,N+2
13747 DMIN=1E8
13748 DO 200 ISTR=1,NSTR
13749 I1=KSTR(ISTR,1)
13750 I2=KSTR(ISTR,2)
13751 DIST=(P(I,4)*P(I1,4)-P(I,1)*P(I1,1)-P(I,2)*P(I1,2)-
13752 & P(I,3)*P(I1,3))*(P(I,4)*P(I2,4)-P(I,1)*P(I2,1)-
13753 & P(I,2)*P(I2,2)-P(I,3)*P(I2,3))/MAX(1.,P(I1,4)*P(I2,4)-
13754 & P(I1,1)*P(I2,1)-P(I1,2)*P(I2,2)-P(I1,3)*P(I2,3))
13755 IF(ISTR.EQ.1.OR.DIST.LT.DMIN) THEN
13756 DMIN=DIST
13757 IST1=I1
13758 IST2=I2
13759 ISTM=ISTR
13760 ENDIF
13761 200 CONTINUE
13762
13763
13764 IF(K(IST1,4)/MSTU(5).EQ.IST2) K(IST1,4)=MSTU(5)*I+
13765 & MOD(K(IST1,4),MSTU(5))
13766 IF(MOD(K(IST1,5),MSTU(5)).EQ.IST2) K(IST1,5)=
13767 & MSTU(5)*(K(IST1,5)/MSTU(5))+I
13768 K(I,5)=MSTU(5)*IST1
13769 K(I,4)=MSTU(5)*IST2
13770 IF(K(IST2,5)/MSTU(5).EQ.IST1) K(IST2,5)=MSTU(5)*I+
13771 & MOD(K(IST2,5),MSTU(5))
13772 IF(MOD(K(IST2,4),MSTU(5)).EQ.IST1) K(IST2,4)=
13773 & MSTU(5)*(K(IST2,4)/MSTU(5))+I
13774 KSTR(ISTM,2)=I
13775 KSTR(NSTR+1,1)=I
13776 KSTR(NSTR+1,2)=IST2
13777 210 NSTR=NSTR+1
13778
13779
13780 ELSEIF(K(N+1,2).EQ.21) THEN
13781 K(N+1,4)=MSTU(5)*(N+2)
13782 K(N+1,5)=MSTU(5)*(N+2)
13783 K(N+2,4)=MSTU(5)*(N+1)
13784 K(N+2,5)=MSTU(5)*(N+1)
13785 KSTR(NSTR+1,1)=N+1
13786 KSTR(NSTR+1,2)=N+2
13787 KSTR(NSTR+2,1)=N+2
13788 KSTR(NSTR+2,2)=N+1
13789 NSTR=NSTR+2
13790
13791
13792 ELSE
13793 K(N+1,4)=MSTU(5)*(N+2)
13794 K(N+2,5)=MSTU(5)*(N+1)
13795 KSTR(NSTR+1,1)=N+1
13796 KSTR(NSTR+1,2)=N+2
13797 NSTR=NSTR+1
13798 ENDIF
13799
13800
13801 N=N+2
13802 IF(N.GT.MSTU(4)-MSTU(32)-10) THEN
13803 CALL LUERRM(11,'(PYMULT:) no more memory left in LUJETS')
13804 IF(MSTU(21).GE.1) RETURN
13805 ENDIF
13806 MINT(31)=MINT(31)+1
13807 VINT(151)=VINT(151)+VINT(41)
13808 VINT(152)=VINT(152)+VINT(42)
13809 VINT(143)=VINT(143)-VINT(41)
13810 VINT(144)=VINT(144)-VINT(42)
13811 IF(MINT(31).LT.240) GOTO 180
13812 220 CONTINUE
13813 ENDIF
13814
13815
13816 1000 FORMAT(/1X,'****** PYMULT: initialization of multiple inter',
13817 &'actions for MSTP(82) =',I2,' ******')
13818 1100 FORMAT(8X,'pT0 =',F5.2,' GeV gives sigma(parton-parton) =',1P,
13819 &E9.2,' mb: rejected')
13820 1200 FORMAT(8X,'pT0 =',F5.2,' GeV gives sigma(parton-parton) =',1P,
13821 &E9.2,' mb: accepted')
13822
13823 RETURN
13824 END
13825
13826
13827
13828 SUBROUTINE PYREMN(IPU1,IPU2)
13829
13830
13831
13832 COMMON/HIPARNT/HIPR1(100),IHPR2(50),HINT1(100),IHNT2(50)
13833 COMMON/HISTRNG/NFP(300,15),PPHI(300,15),NFT(300,15),PTHI(300,15)
13834
13835 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
13836 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
13837 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
13838 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
13839 COMMON/PYINT1/MINT(400),VINT(400)
13840 DIMENSION KFLCH(2),KFLSP(2),CHI(2),PMS(6),IS(2),ROBO(5)
13841 SAVE
13842
13843 IF(MINT(43).EQ.1) THEN
13844 DO 100 JT=1,2
13845 I=MINT(83)+JT+2
13846 K(I,1)=21
13847 K(I,2)=K(I-2,2)
13848 K(I,3)=I-2
13849 DO 100 J=1,5
13850 100 P(I,J)=P(I-2,J)
13851 ENDIF
13852
13853
13854 IF(IPU1.EQ.0.AND.IPU2.EQ.0) RETURN
13855 ISUB=MINT(1)
13856 ILEP=0
13857 IF(IPU1.EQ.0) ILEP=1
13858 IF(IPU2.EQ.0) ILEP=2
13859 IF(ISUB.EQ.95) ILEP=-1
13860 IF(ILEP.EQ.1) IQ=MINT(84)+1
13861 IF(ILEP.EQ.2) IQ=MINT(84)+2
13862 IP=MAX(IPU1,IPU2)
13863 ILEPR=MINT(83)+5-ILEP
13864 NS=N
13865
13866
13867 110 DO 130 JT=1,2
13868 I=MINT(83)+JT+2
13869 IF(JT.EQ.1) IPU=IPU1
13870 IF(JT.EQ.2) IPU=IPU2
13871 K(I,1)=21
13872 K(I,3)=I-2
13873 IF(ISUB.EQ.95) THEN
13874 K(I,2)=21
13875 SHS=0.
13876 ELSEIF(MINT(40+JT).EQ.1.AND.IPU.NE.0) THEN
13877 K(I,2)=K(IPU,2)
13878 P(I,5)=P(IPU,5)
13879 P(I,1)=0.
13880 P(I,2)=0.
13881 PMS(JT)=P(I,5)**2
13882 ELSEIF(IPU.NE.0) THEN
13883 K(I,2)=K(IPU,2)
13884 P(I,5)=P(IPU,5)
13885
13886
13887
13888
13889
13890 RPT1=0.0
13891 RPT2=0.0
13892 SS_W2=(PPHI(IHNT2(11),4)+PTHI(IHNT2(12),4))**2
13893 & -(PPHI(IHNT2(11),1)+PTHI(IHNT2(12),1))**2
13894 & -(PPHI(IHNT2(11),2)+PTHI(IHNT2(12),2))**2
13895 & -(PPHI(IHNT2(11),3)+PTHI(IHNT2(12),3))**2
13896
13897
13898 IF(SS_W2.LE.4.0*PARP(93)**2) GOTO 1211
13899
13900 IF(IHPR2(5).LE.0) THEN
13901 120 IF(MSTP(91).LE.0) THEN
13902 PT=0.
13903 ELSEIF(MSTP(91).EQ.1) THEN
13904 PT=PARP(91)*SQRT(-LOG(RLU(0)))
13905 ELSE
13906 RPT1=RLU(0)
13907 RPT2=RLU(0)
13908 PT=-PARP(92)*LOG(RPT1*RPT2)
13909 ENDIF
13910 IF(PT.GT.PARP(93)) GOTO 120
13911 PHI=PARU(2)*RLU(0)
13912 RPT1=PT*COS(PHI)
13913 RPT2=PT*SIN(PHI)
13914 ELSE IF(IHPR2(5).EQ.1) THEN
13915 IF(JT.EQ.1) JPT=NFP(IHNT2(11),11)
13916 IF(JT.EQ.2) JPT=NFT(IHNT2(12),11)
13917 1205 PTGS=PARP(91)*SQRT(-LOG(RLU(0)))
13918 IF(PTGS.GT.PARP(93)) GO TO 1205
13919 PHI=2.0*HIPR1(40)*RLU(0)
13920 RPT1=PTGS*COS(PHI)
13921 RPT2=PTGS*SIN(PHI)
13922 DO 1210 I_INT=1,JPT-1
13923 PKCSQ=PARP(91)*SQRT(-LOG(RLU(0)))
13924 PHI=2.0*HIPR1(40)*RLU(0)
13925 RPT1=RPT1+PKCSQ*COS(PHI)
13926 RPT2=RPT2+PKCSQ*SIN(PHI)
13927 1210 CONTINUE
13928 IF(RPT1**2+RPT2**2.GE.SS_W2/4.0) GO TO 1205
13929 ENDIF
13930
13931
13932
13933
13934
13935
13936 1211 P(I,1)=RPT1
13937 P(I,2)=RPT2
13938 PMS(JT)=P(I,5)**2+P(I,1)**2+P(I,2)**2
13939 ELSE
13940 K(I,2)=K(IQ,2)
13941 Q2=VINT(52)
13942 P(I,5)=-SQRT(Q2)
13943 PMS(JT)=-Q2
13944 SHS=(1.-VINT(43-JT))*Q2/VINT(43-JT)+VINT(5-JT)**2
13945 ENDIF
13946 130 CONTINUE
13947
13948
13949 I1=MINT(83)+3
13950 I2=MINT(83)+4
13951 IF(ILEP.EQ.0) SHS=VINT(141)*VINT(142)*VINT(2)+
13952 &(P(I1,1)+P(I2,1))**2+(P(I1,2)+P(I2,2))**2
13953 SHR=SQRT(MAX(0.,SHS))
13954 IF(ILEP.EQ.0) THEN
13955 IF((SHS-PMS(1)-PMS(2))**2-4.*PMS(1)*PMS(2).LE.0.) GOTO 110
13956 P(I1,4)=0.5*(SHR+(PMS(1)-PMS(2))/SHR)
13957 P(I1,3)=SQRT(MAX(0.,P(I1,4)**2-PMS(1)))
13958 P(I2,4)=SHR-P(I1,4)
13959 P(I2,3)=-P(I1,3)
13960 ELSEIF(ILEP.EQ.1) THEN
13961 P(I1,4)=P(IQ,4)
13962 P(I1,3)=P(IQ,3)
13963 P(I2,4)=P(IP,4)
13964 P(I2,3)=P(IP,3)
13965 ELSEIF(ILEP.EQ.2) THEN
13966 P(I1,4)=P(IP,4)
13967 P(I1,3)=P(IP,3)
13968 P(I2,4)=P(IQ,4)
13969 P(I2,3)=P(IQ,3)
13970 ENDIF
13971 IF(MINT(43).EQ.1) RETURN
13972
13973
13974 IF(ILEP.EQ.0) THEN
13975 ROBO(3)=(P(I1,1)+P(I2,1))/SHR
13976 ROBO(4)=(P(I1,2)+P(I2,2))/SHR
13977 CALL LUDBRB(I1,I2,0.,0.,-DBLE(ROBO(3)),-DBLE(ROBO(4)),0D0)
13978 ROBO(2)=ULANGL(P(I1,1),P(I1,2))
13979 CALL LUDBRB(I1,I2,0.,-ROBO(2),0D0,0D0,0D0)
13980 ROBO(1)=ULANGL(P(I1,3),P(I1,1))
13981 CALL LUDBRB(I1,I2,-ROBO(1),0.,0D0,0D0,0D0)
13982 NMAX=MAX(MINT(52),IPU1,IPU2)
13983 CALL LUDBRB(I1,NMAX,ROBO(1),ROBO(2),DBLE(ROBO(3)),DBLE(ROBO(4)),
13984 & 0D0)
13985 ROBO(5)=MAX(-0.999999,MIN(0.999999,(VINT(141)-VINT(142))/
13986 & (VINT(141)+VINT(142))))
13987 CALL LUDBRB(I1,NMAX,0.,0.,0D0,0D0,DBLE(ROBO(5)))
13988 ENDIF
13989
13990
13991
13992 IF(ILEP.LE.0) THEN
13993 IF(MSTP(81).LE.0.OR.MSTP(82).LE.0.OR.ISUB.EQ.95) THEN
13994 VINT(151)=0.
13995 VINT(152)=0.
13996 ENDIF
13997 PEH=P(I1,4)+P(I2,4)+0.5*VINT(1)*(VINT(151)+VINT(152))
13998 PZH=P(I1,3)+P(I2,3)+0.5*VINT(1)*(VINT(151)-VINT(152))
13999 SHH=(VINT(1)-PEH)**2-(P(I1,1)+P(I2,1))**2-(P(I1,2)+P(I2,2))**2-
14000 & PZH**2
14001 PMMIN=P(MINT(83)+1,5)+P(MINT(83)+2,5)+ULMASS(K(I1,2))+
14002 & ULMASS(K(I2,2))
14003 IF(SHR.GE.VINT(1).OR.SHH.LE.(PMMIN+PARP(111))**2) THEN
14004 MINT(51)=1
14005 RETURN
14006 ENDIF
14007 SHR=SQRT(SHH+(P(I1,1)+P(I2,1))**2+(P(I1,2)+P(I2,2))**2)
14008 ELSE
14009 PEI=P(IQ,4)+P(IP,4)
14010 PZI=P(IQ,3)+P(IP,3)
14011 PMS(ILEP)=MAX(0.,PEI**2-PZI**2)
14012 PMMIN=P(ILEPR-2,5)+ULMASS(K(ILEPR,2))+SQRT(PMS(ILEP))
14013 IF(SHR.LE.PMMIN+PARP(111)) THEN
14014 MINT(51)=1
14015 RETURN
14016 ENDIF
14017 ENDIF
14018
14019
14020 140 I=NS
14021 DO 190 JT=1,2
14022 IF(JT.EQ.ILEP) GOTO 190
14023 IF(JT.EQ.1) IPU=IPU1
14024 IF(JT.EQ.2) IPU=IPU2
14025 CALL PYSPLI(MINT(10+JT),MINT(12+JT),KFLCH(JT),KFLSP(JT))
14026 I=I+1
14027 IS(JT)=I
14028 DO 150 J=1,5
14029 K(I,J)=0
14030 P(I,J)=0.
14031 150 V(I,J)=0.
14032 K(I,1)=3
14033 K(I,2)=KFLSP(JT)
14034 K(I,3)=MINT(83)+JT
14035 P(I,5)=ULMASS(K(I,2))
14036
14037
14038 KFLS=(3-KCHG(LUCOMP(KFLSP(JT)),2)*ISIGN(1,KFLSP(JT)))/2
14039 K(I,KFLS+3)=IPU
14040 K(IPU,6-KFLS)=MOD(K(IPU,6-KFLS),MSTU(5))+MSTU(5)*I
14041 IF(KFLCH(JT).EQ.0) THEN
14042 P(I,1)=-P(MINT(83)+JT+2,1)
14043 P(I,2)=-P(MINT(83)+JT+2,2)
14044 PMS(JT)=P(I,5)**2+P(I,1)**2+P(I,2)**2
14045
14046
14047 ELSE
14048 CALL LUPTDI(1,P(I,1),P(I,2))
14049 PMS(JT+2)=P(I,5)**2+P(I,1)**2+P(I,2)**2
14050 I=I+1
14051 DO 160 J=1,5
14052 K(I,J)=0
14053 P(I,J)=0.
14054 160 V(I,J)=0.
14055 K(I,1)=1
14056 K(I,2)=KFLCH(JT)
14057 K(I,3)=MINT(83)+JT
14058 P(I,5)=ULMASS(K(I,2))
14059 P(I,1)=-P(MINT(83)+JT+2,1)-P(I-1,1)
14060 P(I,2)=-P(MINT(83)+JT+2,2)-P(I-1,2)
14061 PMS(JT+4)=P(I,5)**2+P(I,1)**2+P(I,2)**2
14062
14063 IMB=1
14064 IF(MOD(MINT(10+JT)/1000,10).NE.0) IMB=2
14065 IF(IABS(KFLCH(JT)).LE.10.OR.KFLCH(JT).EQ.21) THEN
14066 CHIK=PARP(92+2*IMB)
14067 IF(MSTP(92).LE.1) THEN
14068 IF(IMB.EQ.1) CHI(JT)=RLU(0)
14069 IF(IMB.EQ.2) CHI(JT)=1.-SQRT(RLU(0))
14070 ELSEIF(MSTP(92).EQ.2) THEN
14071 CHI(JT)=1.-RLU(0)**(1./(1.+CHIK))
14072 ELSEIF(MSTP(92).EQ.3) THEN
14073 CUT=2.*0.3/VINT(1)
14074 170 CHI(JT)=RLU(0)**2
14075 IF((CHI(JT)**2/(CHI(JT)**2+CUT**2))**0.25*(1.-CHI(JT))**CHIK
14076 & .LT.RLU(0)) GOTO 170
14077 ELSE
14078 CUT=2.*0.3/VINT(1)
14079 CUTR=(1.+SQRT(1.+CUT**2))/CUT
14080 180 CHIR=CUT*CUTR**RLU(0)
14081 CHI(JT)=(CHIR**2-CUT**2)/(2.*CHIR)
14082 IF((1.-CHI(JT))**CHIK.LT.RLU(0)) GOTO 180
14083 ENDIF
14084
14085 ELSE
14086 IF(MSTP(92).LE.1) THEN
14087 IF(IMB.EQ.1) CHI(JT)=RLU(0)
14088 IF(IMB.EQ.2) CHI(JT)=1.-SQRT(RLU(0))
14089 ELSE
14090 CHI(JT)=1.-RLU(0)**(1./(1.+PARP(93+2*IMB)))
14091 ENDIF
14092 IF(MOD(KFLCH(JT)/1000,10).NE.0) CHI(JT)=1.-CHI(JT)
14093 ENDIF
14094 PMS(JT)=PMS(JT+4)/CHI(JT)+PMS(JT+2)/(1.-CHI(JT))
14095 KFLS=KCHG(LUCOMP(KFLCH(JT)),2)*ISIGN(1,KFLCH(JT))
14096 IF(KFLS.NE.0) THEN
14097 K(I,1)=3
14098 KFLS=(3-KFLS)/2
14099 K(I,KFLS+3)=IPU
14100 K(IPU,6-KFLS)=MOD(K(IPU,6-KFLS),MSTU(5))+MSTU(5)*I
14101 ENDIF
14102 ENDIF
14103 190 CONTINUE
14104 IF(SHR.LE.SQRT(PMS(1))+SQRT(PMS(2))) GOTO 140
14105 N=I
14106
14107
14108 DO 200 JT=1,2
14109 IF(JT.EQ.ILEP) GOTO 200
14110 PE=0.5*(SHR+(PMS(JT)-PMS(3-JT))/SHR)
14111 PZ=SQRT(PE**2-PMS(JT))
14112 IF(KFLCH(JT).EQ.0) THEN
14113 P(IS(JT),4)=PE
14114 P(IS(JT),3)=PZ*(-1)**(JT-1)
14115 ELSE
14116 PW1=CHI(JT)*(PE+PZ)
14117 P(IS(JT)+1,4)=0.5*(PW1+PMS(JT+4)/PW1)
14118 P(IS(JT)+1,3)=0.5*(PW1-PMS(JT+4)/PW1)*(-1)**(JT-1)
14119 P(IS(JT),4)=PE-P(IS(JT)+1,4)
14120 P(IS(JT),3)=PZ*(-1)**(JT-1)-P(IS(JT)+1,3)
14121 ENDIF
14122 200 CONTINUE
14123
14124
14125 IF(ILEP.LE.0) THEN
14126 CALL LUDBRB(NS+1,N,0.,0.,0D0,0D0,-DBLE(PZH/(VINT(1)-PEH)))
14127
14128 ELSE
14129 NMAX=MAX(IP,MINT(52))
14130 PEF=SHR-PE
14131 PZF=PZ*(-1)**(ILEP-1)
14132 PT2=P(ILEPR,1)**2+P(ILEPR,2)**2
14133 PHIPT=ULANGL(P(ILEPR,1),P(ILEPR,2))
14134 CALL LUDBRB(MINT(84)+1,NMAX,0.,-PHIPT,0D0,0D0,0D0)
14135 RQP=P(IQ,3)*(PT2+PEI**2)-P(IQ,4)*PEI*PZI
14136 SINTH=P(IQ,4)*SQRT(PT2*(PT2+PEI**2)/(RQP**2+PT2*
14137 & P(IQ,4)**2*PZI**2))*SIGN(1.,-RQP)
14138 CALL LUDBRB(MINT(84)+1,NMAX,ASIN(SINTH),0.,0D0,0D0,0D0)
14139 BETAX=(-PEI*PZI*SINTH+SQRT(PT2*(PT2+PEI**2-(PZI*SINTH)**2)))/
14140 & (PT2+PEI**2)
14141 CALL LUDBRB(MINT(84)+1,NMAX,0.,0.,DBLE(BETAX),0D0,0D0)
14142 CALL LUDBRB(MINT(84)+1,NMAX,0.,PHIPT,0D0,0D0,0D0)
14143 PEM=P(IQ,4)+P(IP,4)
14144 PZM=P(IQ,3)+P(IP,3)
14145 BETAZ=(-PEM*PZM+PZF*SQRT(PZF**2+PEM**2-PZM**2))/(PZF**2+PEM**2)
14146 CALL LUDBRB(MINT(84)+1,NMAX,0.,0.,0D0,0D0,DBLE(BETAZ))
14147 CALL LUDBRB(I1,I2,ASIN(SINTH),0.,DBLE(BETAX),0D0,0D0)
14148 CALL LUDBRB(I1,I2,0.,PHIPT,0D0,0D0,DBLE(BETAZ))
14149 ENDIF
14150
14151 RETURN
14152 END
14153
14154
14155
14156 SUBROUTINE PYRESD
14157
14158
14159
14160 IMPLICIT DOUBLE PRECISION(D)
14161 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
14162 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
14163 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
14164 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
14165 COMMON/PYSUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
14166 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
14167 COMMON/PYINT1/MINT(400),VINT(400)
14168 COMMON/PYINT2/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2)
14169 COMMON/PYINT4/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3)
14170 DIMENSION IREF(10,6),KDCY(2),KFL1(2),KFL2(2),NSD(2),ILIN(6),
14171 &COUP(6,4),PK(6,4),PKK(6,6),CTHE(2),PHI(2),WDTP(0:40),
14172 &WDTE(0:40,0:5)
14173 COMPLEX FGK,HA(6,6),HC(6,6)
14174 SAVE
14175
14176
14177
14178 FGK(I1,I2,I3,I4,I5,I6)=4.*HA(I1,I3)*HC(I2,I6)*(HA(I1,I5)*
14179 &HC(I1,I4)+HA(I3,I5)*HC(I3,I4))
14180 DIGK(DT,DU)=-4.*D34*D56+DT*(3.*DT+4.*DU)+DT**2*(DT*DU/(D34*D56)-
14181 &2.*(1./D34+1./D56)*(DT+DU)+2.*(D34/D56+D56/D34))
14182 DJGK(DT,DU)=8.*(D34+D56)**2-8.*(D34+D56)*(DT+DU)-6.*DT*DU-
14183 &2.*DT*DU*(DT*DU/(D34*D56)-2.*(1./D34+1./D56)*(DT+DU)+
14184 &2.*(D34/D56+D56/D34))
14185
14186
14187 ISUB=MINT(1)
14188 SH=VINT(44)
14189 IREF(1,5)=0
14190 IREF(1,6)=0
14191 IF(ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.3) THEN
14192 IREF(1,1)=MINT(84)+2+ISET(ISUB)
14193 IREF(1,2)=0
14194 IREF(1,3)=MINT(83)+6+ISET(ISUB)
14195 IREF(1,4)=0
14196 ELSEIF(ISET(ISUB).EQ.2.OR.ISET(ISUB).EQ.4) THEN
14197 IREF(1,1)=MINT(84)+1+ISET(ISUB)
14198 IREF(1,2)=MINT(84)+2+ISET(ISUB)
14199 IREF(1,3)=MINT(83)+5+ISET(ISUB)
14200 IREF(1,4)=MINT(83)+6+ISET(ISUB)
14201 ENDIF
14202 NP=1
14203 IP=0
14204 100 IP=IP+1
14205 NINH=0
14206
14207
14208 JTMAX=2
14209 IF(IP.EQ.1.AND.(ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.3)) JTMAX=1
14210 DO 140 JT=1,JTMAX
14211 KDCY(JT)=0
14212 KFL1(JT)=0
14213 KFL2(JT)=0
14214 NSD(JT)=IREF(IP,JT)
14215 ID=IREF(IP,JT)
14216 IF(ID.EQ.0) GOTO 140
14217 KFA=IABS(K(ID,2))
14218 IF(KFA.LT.23.OR.KFA.GT.40) GOTO 140
14219 IF(MDCY(KFA,1).NE.0) THEN
14220 IF(ISUB.EQ.1.OR.ISUB.EQ.141) MINT(61)=1
14221 CALL PYWIDT(KFA,P(ID,5),WDTP,WDTE)
14222 IF(KCHG(KFA,3).EQ.0) THEN
14223 IPM=2
14224 ELSE
14225 IPM=(5+ISIGN(1,K(ID,2)))/2
14226 ENDIF
14227 IF(JTMAX.EQ.1.OR.IABS(K(IREF(IP,1),2)).NE.IABS(K(IREF(IP,2),2)))
14228 & THEN
14229 I12=4
14230 ELSE
14231 IF(JT.EQ.1) I12=INT(4.5+RLU(0))
14232 I12=9-I12
14233 ENDIF
14234 RKFL=(WDTE(0,1)+WDTE(0,IPM)+WDTE(0,I12))*RLU(0)
14235 DO 120 I=1,MDCY(KFA,3)
14236 IDC=I+MDCY(KFA,2)-1
14237 KFL1(JT)=KFDP(IDC,1)*ISIGN(1,K(ID,2))
14238 KFL2(JT)=KFDP(IDC,2)*ISIGN(1,K(ID,2))
14239 RKFL=RKFL-(WDTE(I,1)+WDTE(I,IPM)+WDTE(I,I12))
14240 IF(RKFL.LE.0.) GOTO 130
14241 120 CONTINUE
14242 130 CONTINUE
14243 ENDIF
14244
14245
14246 IF((KFA.EQ.23.OR.KFA.EQ.24).AND.KFL1(JT).EQ.0) NINH=NINH+1
14247 IF(KFL1(JT).EQ.0) GOTO 140
14248 KDCY(JT)=2
14249 IF(IABS(KFL1(JT)).LE.10.OR.KFL1(JT).EQ.21) KDCY(JT)=1
14250 IF((IABS(KFL1(JT)).GE.23.AND.IABS(KFL1(JT)).LE.25).OR.
14251 &(IABS(KFL1(JT)).EQ.37)) KDCY(JT)=3
14252 NSD(JT)=N
14253
14254
14255 IF(KDCY(JT).EQ.1) THEN
14256 CALL LU2ENT(-(N+1),KFL1(JT),KFL2(JT),P(ID,5))
14257 ELSE
14258 CALL LU2ENT(N+1,KFL1(JT),KFL2(JT),P(ID,5))
14259 ENDIF
14260 IF(JTMAX.EQ.1) THEN
14261 CTHE(JT)=VINT(13)+(VINT(33)-VINT(13)+VINT(34)-VINT(14))*RLU(0)
14262 IF(CTHE(JT).GT.VINT(33)) CTHE(JT)=CTHE(JT)+VINT(14)-VINT(33)
14263 PHI(JT)=VINT(24)
14264 ELSE
14265 CTHE(JT)=2.*RLU(0)-1.
14266 PHI(JT)=PARU(2)*RLU(0)
14267 ENDIF
14268 140 CONTINUE
14269 IF(MINT(3).EQ.1.AND.IP.EQ.1) THEN
14270 MINT(25)=KFL1(1)
14271 MINT(26)=KFL2(1)
14272 ENDIF
14273 IF(JTMAX.EQ.1.AND.KDCY(1).EQ.0) GOTO 530
14274 IF(JTMAX.EQ.2.AND.KDCY(1).EQ.0.AND.KDCY(2).EQ.0) GOTO 530
14275 IF(MSTP(45).LE.0.OR.IREF(IP,2).EQ.0.OR.NINH.GE.1) GOTO 500
14276 IF(K(IREF(1,1),2).EQ.25.AND.IP.EQ.1) GOTO 500
14277 IF(K(IREF(1,1),2).EQ.25.AND.KDCY(1)*KDCY(2).EQ.0) GOTO 500
14278
14279
14280 ILIN(1)=MINT(84)+1
14281 IF(K(MINT(84)+1,2).GT.0) ILIN(1)=MINT(84)+2
14282 IF(K(ILIN(1),2).EQ.21) ILIN(1)=2*MINT(84)+3-ILIN(1)
14283 ILIN(2)=2*MINT(84)+3-ILIN(1)
14284 IMIN=1
14285 IF(IREF(IP,5).EQ.25) IMIN=3
14286 IMAX=2
14287 IORD=1
14288 IF(K(IREF(IP,1),2).EQ.23) IORD=2
14289 IF(K(IREF(IP,1),2).EQ.24.AND.K(IREF(IP,2),2).EQ.-24) IORD=2
14290 IF(IABS(K(IREF(IP,IORD),2)).EQ.25) IORD=3-IORD
14291 IF(KDCY(IORD).EQ.0) IORD=3-IORD
14292
14293
14294 DO 390 JT=IORD,3-IORD,3-2*IORD
14295 IF(KDCY(JT).EQ.0) THEN
14296 ILIN(IMAX+1)=NSD(JT)
14297 IMAX=IMAX+1
14298 ELSEIF(K(NSD(JT)+1,2).GT.0) THEN
14299 ILIN(IMAX+1)=N+2*JT-1
14300 ILIN(IMAX+2)=N+2*JT
14301 IMAX=IMAX+2
14302 K(N+2*JT-1,2)=K(NSD(JT)+1,2)
14303 K(N+2*JT,2)=K(NSD(JT)+2,2)
14304 ELSE
14305 ILIN(IMAX+1)=N+2*JT
14306 ILIN(IMAX+2)=N+2*JT-1
14307 IMAX=IMAX+2
14308 K(N+2*JT-1,2)=K(NSD(JT)+1,2)
14309 K(N+2*JT,2)=K(NSD(JT)+2,2)
14310 ENDIF
14311 390 CONTINUE
14312
14313
14314 XW=PARU(102)
14315 DO 410 I=IMIN,IMAX
14316 DO 400 J=1,4
14317 400 COUP(I,J)=0.
14318 KFA=IABS(K(ILIN(I),2))
14319 IF(KFA.GT.20) GOTO 410
14320 COUP(I,1)=LUCHGE(KFA)/3.
14321 COUP(I,2)=(-1)**MOD(KFA,2)
14322 COUP(I,4)=-2.*COUP(I,1)*XW
14323 COUP(I,3)=COUP(I,2)+COUP(I,4)
14324 410 CONTINUE
14325 SQMZ=PMAS(23,1)**2
14326 GZMZ=PMAS(23,1)*PMAS(23,2)
14327 SQMW=PMAS(24,1)**2
14328 GZMW=PMAS(24,1)*PMAS(24,2)
14329 SQMZP=PMAS(32,1)**2
14330 GZMZP=PMAS(32,1)*PMAS(32,2)
14331
14332
14333 420 DO 430 I=N+1,N+4
14334 K(I,1)=1
14335 DO 430 J=1,5
14336 430 P(I,J)=0.
14337 DO 440 JT=1,JTMAX
14338 IF(KDCY(JT).EQ.0) GOTO 440
14339 ID=IREF(IP,JT)
14340 P(N+2*JT-1,3)=0.5*P(ID,5)
14341 P(N+2*JT-1,4)=0.5*P(ID,5)
14342 P(N+2*JT,3)=-0.5*P(ID,5)
14343 P(N+2*JT,4)=0.5*P(ID,5)
14344 CTHE(JT)=2.*RLU(0)-1.
14345 PHI(JT)=PARU(2)*RLU(0)
14346 CALL LUDBRB(N+2*JT-1,N+2*JT,ACOS(CTHE(JT)),PHI(JT),
14347 &DBLE(P(ID,1)/P(ID,4)),DBLE(P(ID,2)/P(ID,4)),DBLE(P(ID,3)/P(ID,4)))
14348 440 CONTINUE
14349
14350
14351
14352 DO 450 I=1,IMAX
14353 K(N+4+I,1)=1
14354 P(N+4+I,4)=SQRT(P(ILIN(I),1)**2+P(ILIN(I),2)**2+P(ILIN(I),3)**2+
14355 &P(ILIN(I),5)**2)
14356 P(N+4+I,5)=P(ILIN(I),5)
14357 DO 450 J=1,3
14358 450 P(N+4+I,J)=P(ILIN(I),J)
14359 THERR=ACOS(2.*RLU(0)-1.)
14360 PHIRR=PARU(2)*RLU(0)
14361 CALL LUDBRB(N+5,N+4+IMAX,THERR,PHIRR,0D0,0D0,0D0)
14362 DO 460 I=1,IMAX
14363 DO 460 J=1,4
14364 460 PK(I,J)=P(N+4+I,J)
14365
14366
14367 IF(ISUB.EQ.22.OR.ISUB.EQ.23.OR.ISUB.EQ.25) THEN
14368 DO 470 I1=IMIN,IMAX-1
14369 DO 470 I2=I1+1,IMAX
14370 HA(I1,I2)=SQRT((PK(I1,4)-PK(I1,3))*(PK(I2,4)+PK(I2,3))/
14371 & (1E-20+PK(I1,1)**2+PK(I1,2)**2))*CMPLX(PK(I1,1),PK(I1,2))-
14372 & SQRT((PK(I1,4)+PK(I1,3))*(PK(I2,4)-PK(I2,3))/
14373 & (1E-20+PK(I2,1)**2+PK(I2,2)**2))*CMPLX(PK(I2,1),PK(I2,2))
14374 HC(I1,I2)=CONJG(HA(I1,I2))
14375 IF(I1.LE.2) HA(I1,I2)=CMPLX(0.,1.)*HA(I1,I2)
14376 IF(I1.LE.2) HC(I1,I2)=CMPLX(0.,1.)*HC(I1,I2)
14377 HA(I2,I1)=-HA(I1,I2)
14378 470 HC(I2,I1)=-HC(I1,I2)
14379 ENDIF
14380 DO 480 I=1,2
14381 DO 480 J=1,4
14382 480 PK(I,J)=-PK(I,J)
14383 DO 490 I1=IMIN,IMAX-1
14384 DO 490 I2=I1+1,IMAX
14385 PKK(I1,I2)=2.*(PK(I1,4)*PK(I2,4)-PK(I1,1)*PK(I2,1)-
14386 &PK(I1,2)*PK(I2,2)-PK(I1,3)*PK(I2,3))
14387 490 PKK(I2,I1)=PKK(I1,I2)
14388
14389 IF(IREF(IP,5).EQ.25) THEN
14390
14391 WT=16.*PKK(3,5)*PKK(4,6)
14392 IF(IP.EQ.1) WTMAX=SH**2
14393 IF(IP.GE.2) WTMAX=P(IREF(IP,6),5)**4
14394
14395 ELSEIF(ISUB.EQ.1) THEN
14396 IF(KFA.NE.37) THEN
14397
14398 EI=KCHG(IABS(MINT(15)),1)/3.
14399 AI=SIGN(1.,EI+0.1)
14400 VI=AI-4.*EI*XW
14401 EF=KCHG(KFA,1)/3.
14402 AF=SIGN(1.,EF+0.1)
14403 VF=AF-4.*EF*XW
14404 GG=1.
14405 GZ=1./(8.*XW*(1.-XW))*SH*(SH-SQMZ)/((SH-SQMZ)**2+GZMZ**2)
14406 ZZ=1./(16.*XW*(1.-XW))**2*SH**2/((SH-SQMZ)**2+GZMZ**2)
14407 IF(MSTP(43).EQ.1) THEN
14408
14409 GZ=0.
14410 ZZ=0.
14411 ELSEIF(MSTP(43).EQ.2) THEN
14412
14413 GG=0.
14414 GZ=0.
14415 ENDIF
14416 ASYM=2.*(EI*AI*GZ*EF*AF+4.*VI*AI*ZZ*VF*AF)/(EI**2*GG*EF**2+
14417 & EI*VI*GZ*EF*VF+(VI**2+AI**2)*ZZ*(VF**2+AF**2))
14418 WT=1.+ASYM*CTHE(JT)+CTHE(JT)**2
14419 WTMAX=2.+ABS(ASYM)
14420 ELSE
14421
14422 WT=1.-CTHE(JT)**2
14423 WTMAX=1.
14424 ENDIF
14425
14426 ELSEIF(ISUB.EQ.2) THEN
14427
14428 WT=(1.+CTHE(JT))**2
14429 WTMAX=4.
14430
14431 ELSEIF(ISUB.EQ.15.OR.ISUB.EQ.19) THEN
14432
14433
14434 WT=((COUP(1,3)*COUP(3,3))**2+(COUP(1,4)*COUP(3,4))**2)*
14435 & (PKK(1,3)**2+PKK(2,4)**2)+((COUP(1,3)*COUP(3,4))**2+
14436 & (COUP(1,4)*COUP(3,3))**2)*(PKK(1,4)**2+PKK(2,3)**2)
14437 WTMAX=(COUP(1,3)**2+COUP(1,4)**2)*(COUP(3,3)**2+COUP(3,4)**2)*
14438 & ((PKK(1,3)+PKK(1,4))**2+(PKK(2,3)+PKK(2,4))**2)
14439
14440 ELSEIF(ISUB.EQ.16.OR.ISUB.EQ.20) THEN
14441
14442
14443 WT=PKK(1,3)**2+PKK(2,4)**2
14444 WTMAX=(PKK(1,3)+PKK(1,4))**2+(PKK(2,3)+PKK(2,4))**2
14445
14446 ELSEIF(ISUB.EQ.22) THEN
14447
14448 S34=P(IREF(IP,IORD),5)**2
14449 S56=P(IREF(IP,3-IORD),5)**2
14450 TI=PKK(1,3)+PKK(1,4)+S34
14451 UI=PKK(1,5)+PKK(1,6)+S56
14452 WT=COUP(1,3)**4*((COUP(3,3)*COUP(5,3)*ABS(FGK(1,2,3,4,5,6)/
14453 & TI+FGK(1,2,5,6,3,4)/UI))**2+(COUP(3,4)*COUP(5,3)*ABS(
14454 & FGK(1,2,4,3,5,6)/TI+FGK(1,2,5,6,4,3)/UI))**2+(COUP(3,3)*
14455 & COUP(5,4)*ABS(FGK(1,2,3,4,6,5)/TI+FGK(1,2,6,5,3,4)/UI))**2+
14456 & (COUP(3,4)*COUP(5,4)*ABS(FGK(1,2,4,3,6,5)/TI+FGK(1,2,6,5,4,3)/
14457 & UI))**2)+COUP(1,4)**4*((COUP(3,3)*COUP(5,3)*ABS(
14458 & FGK(2,1,5,6,3,4)/TI+FGK(2,1,3,4,5,6)/UI))**2+(COUP(3,4)*
14459 & COUP(5,3)*ABS(FGK(2,1,6,5,3,4)/TI+FGK(2,1,3,4,6,5)/UI))**2+
14460 & (COUP(3,3)*COUP(5,4)*ABS(FGK(2,1,5,6,4,3)/TI+FGK(2,1,4,3,5,6)/
14461 & UI))**2+(COUP(3,4)*COUP(5,4)*ABS(FGK(2,1,6,5,4,3)/TI+
14462 & FGK(2,1,4,3,6,5)/UI))**2)
14463 WTMAX=4.*S34*S56*(COUP(1,3)**4+COUP(1,4)**4)*(COUP(3,3)**2+
14464 & COUP(3,4)**2)*(COUP(5,3)**2+COUP(5,4)**2)*4.*(TI/UI+UI/TI+
14465 & 2.*SH*(S34+S56)/(TI*UI)-S34*S56*(1./TI**2+1./UI**2))
14466
14467 ELSEIF(ISUB.EQ.23) THEN
14468
14469 D34=P(IREF(IP,IORD),5)**2
14470 D56=P(IREF(IP,3-IORD),5)**2
14471 DT=PKK(1,3)+PKK(1,4)+D34
14472 DU=PKK(1,5)+PKK(1,6)+D56
14473 CAWZ=COUP(2,3)/SNGL(DT)-2.*(1.-XW)*COUP(1,2)/(SH-SQMW)
14474 CBWZ=COUP(1,3)/SNGL(DU)+2.*(1.-XW)*COUP(1,2)/(SH-SQMW)
14475 WT=COUP(5,3)**2*ABS(CAWZ*FGK(1,2,3,4,5,6)+CBWZ*
14476 & FGK(1,2,5,6,3,4))**2+COUP(5,4)**2*ABS(CAWZ*
14477 & FGK(1,2,3,4,6,5)+CBWZ*FGK(1,2,6,5,3,4))**2
14478 WTMAX=4.*D34*D56*(COUP(5,3)**2+COUP(5,4)**2)*(CAWZ**2*
14479 & DIGK(DT,DU)+CBWZ**2*DIGK(DU,DT)+CAWZ*CBWZ*DJGK(DT,DU))
14480
14481 ELSEIF(ISUB.EQ.24) THEN
14482
14483 WT=((COUP(1,3)*COUP(3,3))**2+(COUP(1,4)*COUP(3,4))**2)*
14484 & PKK(1,3)*PKK(2,4)+((COUP(1,3)*COUP(3,4))**2+(COUP(1,4)*
14485 & COUP(3,3))**2)*PKK(1,4)*PKK(2,3)
14486 WTMAX=(COUP(1,3)**2+COUP(1,4)**2)*(COUP(3,3)**2+COUP(3,4)**2)*
14487 & (PKK(1,3)+PKK(1,4))*(PKK(2,3)+PKK(2,4))
14488
14489 ELSEIF(ISUB.EQ.25) THEN
14490
14491 D34=P(IREF(IP,IORD),5)**2
14492 D56=P(IREF(IP,3-IORD),5)**2
14493 DT=PKK(1,3)+PKK(1,4)+D34
14494 DU=PKK(1,5)+PKK(1,6)+D56
14495 CDWW=(COUP(1,3)*SQMZ/(SH-SQMZ)+COUP(1,2))/SH
14496 CAWW=CDWW+0.5*(COUP(1,2)+1.)/SNGL(DT)
14497 CBWW=CDWW+0.5*(COUP(1,2)-1.)/SNGL(DU)
14498 CCWW=COUP(1,4)*SQMZ/(SH-SQMZ)/SH
14499 WT=ABS(CAWW*FGK(1,2,3,4,5,6)-CBWW*FGK(1,2,5,6,3,4))**2+
14500 & CCWW**2*ABS(FGK(2,1,5,6,3,4)-FGK(2,1,3,4,5,6))**2
14501 WTMAX=4.*D34*D56*(CAWW**2*DIGK(DT,DU)+CBWW**2*DIGK(DU,DT)-CAWW*
14502 & CBWW*DJGK(DT,DU)+CCWW**2*(DIGK(DT,DU)+DIGK(DU,DT)-DJGK(DT,DU)))
14503
14504 ELSEIF(ISUB.EQ.26) THEN
14505
14506 WT=PKK(1,3)*PKK(2,4)
14507 WTMAX=(PKK(1,3)+PKK(1,4))*(PKK(2,3)+PKK(2,4))
14508
14509 ELSEIF(ISUB.EQ.30) THEN
14510
14511 IF(K(ILIN(1),2).GT.0) WT=((COUP(1,3)*COUP(3,3))**2+
14512 & (COUP(1,4)*COUP(3,4))**2)*(PKK(1,4)**2+PKK(3,5)**2)+
14513 & ((COUP(1,3)*COUP(3,4))**2+(COUP(1,4)*COUP(3,3))**2)*
14514 & (PKK(1,3)**2+PKK(4,5)**2)
14515 IF(K(ILIN(1),2).LT.0) WT=((COUP(1,3)*COUP(3,3))**2+
14516 & (COUP(1,4)*COUP(3,4))**2)*(PKK(1,3)**2+PKK(4,5)**2)+
14517 & ((COUP(1,3)*COUP(3,4))**2+(COUP(1,4)*COUP(3,3))**2)*
14518 & (PKK(1,4)**2+PKK(3,5)**2)
14519 WTMAX=(COUP(1,3)**2+COUP(1,4)**2)*(COUP(3,3)**2+COUP(3,4)**2)*
14520 & ((PKK(1,3)+PKK(1,4))**2+(PKK(3,5)+PKK(4,5))**2)
14521
14522 ELSEIF(ISUB.EQ.31) THEN
14523
14524 IF(K(ILIN(1),2).GT.0) WT=PKK(1,4)**2+PKK(3,5)**2
14525 IF(K(ILIN(1),2).LT.0) WT=PKK(1,3)**2+PKK(4,5)**2
14526 WTMAX=(PKK(1,3)+PKK(1,4))**2+(PKK(3,5)+PKK(4,5))**2
14527
14528 ELSEIF(ISUB.EQ.141) THEN
14529
14530 EI=KCHG(IABS(MINT(15)),1)/3.
14531 AI=SIGN(1.,EI+0.1)
14532 VI=AI-4.*EI*XW
14533 API=SIGN(1.,EI+0.1)
14534 VPI=API-4.*EI*XW
14535 EF=KCHG(KFA,1)/3.
14536 AF=SIGN(1.,EF+0.1)
14537 VF=AF-4.*EF*XW
14538 APF=SIGN(1.,EF+0.1)
14539 VPF=APF-4.*EF*XW
14540 GG=1.
14541 GZ=1./(8.*XW*(1.-XW))*SH*(SH-SQMZ)/((SH-SQMZ)**2+GZMZ**2)
14542 GZP=1./(8.*XW*(1.-XW))*SH*(SH-SQMZP)/((SH-SQMZP)**2+GZMZP**2)
14543 ZZ=1./(16.*XW*(1.-XW))**2*SH**2/((SH-SQMZ)**2+GZMZ**2)
14544 ZZP=2./(16.*XW*(1.-XW))**2*
14545 & SH**2*((SH-SQMZ)*(SH-SQMZP)+GZMZ*GZMZP)/
14546 & (((SH-SQMZ)**2+GZMZ**2)*((SH-SQMZP)**2+GZMZP**2))
14547 ZPZP=1./(16.*XW*(1.-XW))**2*SH**2/((SH-SQMZP)**2+GZMZP**2)
14548 IF(MSTP(44).EQ.1) THEN
14549
14550 GZ=0.
14551 GZP=0.
14552 ZZ=0.
14553 ZZP=0.
14554 ZPZP=0.
14555 ELSEIF(MSTP(44).EQ.2) THEN
14556
14557 GG=0.
14558 GZ=0.
14559 GZP=0.
14560 ZZP=0.
14561 ZPZP=0.
14562 ELSEIF(MSTP(44).EQ.3) THEN
14563
14564 GG=0.
14565 GZ=0.
14566 GZP=0.
14567 ZZ=0.
14568 ZZP=0.
14569 ELSEIF(MSTP(44).EQ.4) THEN
14570
14571 GZP=0.
14572 ZZP=0.
14573 ZPZP=0.
14574 ELSEIF(MSTP(44).EQ.5) THEN
14575
14576 GZ=0.
14577 ZZ=0.
14578 ZZP=0.
14579 ELSEIF(MSTP(44).EQ.6) THEN
14580
14581 GG=0.
14582 GZ=0.
14583 GZP=0.
14584 ENDIF
14585 ASYM=2.*(EI*AI*GZ*EF*AF+EI*API*GZP*EF*APF+4.*VI*AI*ZZ*VF*AF+
14586 & (VI*API+VPI*AI)*ZZP*(VF*APF+VPF*AF)+4.*VPI*API*ZPZP*VPF*APF)/
14587 & (EI**2*GG*EF**2+EI*VI*GZ*EF*VF+EI*VPI*GZP*EF*VPF+
14588 & (VI**2+AI**2)*ZZ*(VF**2+AF**2)+(VI*VPI+AI*API)*ZZP*
14589 & (VF*VPF+AF*APF)+(VPI**2+API**2)*ZPZP*(VPF**2+APF**2))
14590 WT=1.+ASYM*CTHE(JT)+CTHE(JT)**2
14591 WTMAX=2.+ABS(ASYM)
14592
14593 ELSE
14594 WT=1.
14595 WTMAX=1.
14596 ENDIF
14597
14598 IF(WT.LT.RLU(0)*WTMAX) GOTO 420
14599
14600
14601
14602 500 DO 520 JT=1,JTMAX
14603 IF(KDCY(JT).EQ.0) GOTO 520
14604 ID=IREF(IP,JT)
14605 CALL LUDBRB(NSD(JT)+1,NSD(JT)+2,ACOS(CTHE(JT)),PHI(JT),
14606 &DBLE(P(ID,1)/P(ID,4)),DBLE(P(ID,2)/P(ID,4)),DBLE(P(ID,3)/P(ID,4)))
14607 K(ID,1)=K(ID,1)+10
14608 K(ID,4)=NSD(JT)+1
14609 K(ID,5)=NSD(JT)+2
14610 IDOC=MINT(83)+MINT(4)
14611 DO 510 I=NSD(JT)+1,NSD(JT)+2
14612 MINT(4)=MINT(4)+1
14613 I1=MINT(83)+MINT(4)
14614 K(I,3)=I1
14615 K(I1,1)=21
14616 K(I1,2)=K(I,2)
14617 K(I1,3)=IREF(IP,JT+2)
14618 DO 510 J=1,5
14619 510 P(I1,J)=P(I,J)
14620 IF(JTMAX.EQ.1) THEN
14621 MINT(7)=MINT(83)+6+2*ISET(ISUB)
14622 MINT(8)=MINT(83)+7+2*ISET(ISUB)
14623 ENDIF
14624 IF(MSTP(71).GE.1.AND.KDCY(JT).EQ.1) CALL LUSHOW(NSD(JT)+1,
14625 &NSD(JT)+2,P(ID,5))
14626
14627
14628 IF(KDCY(JT).NE.3) GOTO 520
14629 NP=NP+1
14630 IREF(NP,1)=NSD(JT)+1
14631 IREF(NP,2)=NSD(JT)+2
14632 IREF(NP,3)=IDOC+1
14633 IREF(NP,4)=IDOC+2
14634 IREF(NP,5)=K(IREF(IP,JT),2)
14635 IREF(NP,6)=IREF(IP,JT)
14636 520 CONTINUE
14637 530 IF(IP.LT.NP) GOTO 100
14638
14639 RETURN
14640 END
14641
14642
14643
14644 SUBROUTINE PYDIFF
14645
14646
14647 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
14648 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
14649 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
14650 COMMON/PYINT1/MINT(400),VINT(400)
14651 SAVE
14652
14653
14654 DO 100 JT=1,MSTP(126)+10
14655 I=MINT(83)+JT
14656 DO 100 J=1,5
14657 K(I,J)=0
14658 P(I,J)=0.
14659 100 V(I,J)=0.
14660 N=MINT(84)
14661 MINT(3)=0
14662 MINT(21)=0
14663 MINT(22)=0
14664 MINT(23)=0
14665 MINT(24)=0
14666 MINT(4)=4
14667 DO 110 JT=1,2
14668 I=MINT(83)+JT
14669 K(I,1)=21
14670 K(I,2)=MINT(10+JT)
14671 P(I,5)=VINT(2+JT)
14672 P(I,3)=VINT(5)*(-1)**(JT+1)
14673 110 P(I,4)=SQRT(P(I,3)**2+P(I,5)**2)
14674 MINT(6)=2
14675
14676
14677 ISUB=MINT(1)
14678 SQLAM=(VINT(2)-VINT(63)-VINT(64))**2-4.*VINT(63)*VINT(64)
14679 PZ=SQRT(SQLAM)/(2.*VINT(1))
14680 DO 150 JT=1,2
14681 I=MINT(83)+JT
14682 PE=(VINT(2)+VINT(62+JT)-VINT(65-JT))/(2.*VINT(1))
14683
14684
14685 IF(MINT(16+JT).LE.0) THEN
14686 N=N+1
14687 K(N,1)=1
14688 K(N,2)=K(I,2)
14689 K(N,3)=I+2
14690 P(N,3)=PZ*(-1)**(JT+1)
14691 P(N,4)=PE
14692 P(N,5)=P(I,5)
14693
14694
14695 ELSEIF(MSTP(101).EQ.1) THEN
14696 N=N+2
14697 K(N-1,1)=2
14698 K(N,1)=1
14699 K(N-1,3)=I+2
14700 K(N,3)=I+2
14701 CALL PYSPLI(K(I,2),21,K(N,2),K(N-1,2))
14702 P(N-1,5)=ULMASS(K(N-1,2))
14703 P(N,5)=ULMASS(K(N,2))
14704 SQLAM=(VINT(62+JT)-P(N-1,5)**2-P(N,5)**2)**2-
14705 & 4.*P(N-1,5)**2*P(N,5)**2
14706 P(N-1,3)=(PE*SQRT(SQLAM)+PZ*(VINT(62+JT)+P(N-1,5)**2-
14707 & P(N,5)**2))/(2.*VINT(62+JT))*(-1)**(JT+1)
14708 P(N-1,4)=SQRT(P(N-1,3)**2+P(N-1,5)**2)
14709 P(N,3)=PZ*(-1)**(JT+1)-P(N-1,3)
14710 P(N,4)=SQRT(P(N,3)**2+P(N,5)**2)
14711
14712
14713 ELSE
14714 N=N+3
14715 K(N-2,1)=2
14716 K(N-1,1)=2
14717 K(N,1)=1
14718 K(N-2,3)=I+2
14719 K(N-1,3)=I+2
14720 K(N,3)=I+2
14721 CALL PYSPLI(K(I,2),21,K(N,2),K(N-2,2))
14722 K(N-1,2)=21
14723 P(N-2,5)=ULMASS(K(N-2,2))
14724 P(N-1,5)=0.
14725 P(N,5)=ULMASS(K(N,2))
14726
14727 120 IMB=1
14728 IF(MOD(K(I,2)/1000,10).NE.0) IMB=2
14729 CHIK=PARP(92+2*IMB)
14730 IF(MSTP(92).LE.1) THEN
14731 IF(IMB.EQ.1) CHI=RLU(0)
14732 IF(IMB.EQ.2) CHI=1.-SQRT(RLU(0))
14733 ELSEIF(MSTP(92).EQ.2) THEN
14734 CHI=1.-RLU(0)**(1./(1.+CHIK))
14735 ELSEIF(MSTP(92).EQ.3) THEN
14736 CUT=2.*0.3/VINT(1)
14737 130 CHI=RLU(0)**2
14738 IF((CHI**2/(CHI**2+CUT**2))**0.25*(1.-CHI)**CHIK.LT.
14739 & RLU(0)) GOTO 130
14740 ELSE
14741 CUT=2.*0.3/VINT(1)
14742 CUTR=(1.+SQRT(1.+CUT**2))/CUT
14743 140 CHIR=CUT*CUTR**RLU(0)
14744 CHI=(CHIR**2-CUT**2)/(2.*CHIR)
14745 IF((1.-CHI)**CHIK.LT.RLU(0)) GOTO 140
14746 ENDIF
14747 IF(CHI.LT.P(N,5)**2/VINT(62+JT).OR.CHI.GT.1.-P(N-2,5)**2/
14748 & VINT(62+JT)) GOTO 120
14749 SQM=P(N-2,5)**2/(1.-CHI)+P(N,5)**2/CHI
14750 IF((SQRT(SQM)+PARJ(32))**2.GE.VINT(62+JT)) GOTO 120
14751 PZI=(PE*(VINT(62+JT)-SQM)+PZ*(VINT(62+JT)+SQM))/
14752 & (2.*VINT(62+JT))
14753 PEI=SQRT(PZI**2+SQM)
14754 PQQP=(1.-CHI)*(PEI+PZI)
14755 P(N-2,3)=0.5*(PQQP-P(N-2,5)**2/PQQP)*(-1)**(JT+1)
14756 P(N-2,4)=SQRT(P(N-2,3)**2+P(N-2,5)**2)
14757 P(N-1,3)=(PZ-PZI)*(-1)**(JT+1)
14758 P(N-1,4)=ABS(P(N-1,3))
14759 P(N,3)=PZI*(-1)**(JT+1)-P(N-2,3)
14760 P(N,4)=SQRT(P(N,3)**2+P(N,5)**2)
14761 ENDIF
14762
14763
14764 K(I+2,1)=21
14765 IF(MINT(16+JT).EQ.0) K(I+2,2)=MINT(10+JT)
14766 IF(MINT(16+JT).NE.0) K(I+2,2)=10*(MINT(10+JT)/10)
14767 K(I+2,3)=I
14768 P(I+2,3)=PZ*(-1)**(JT+1)
14769 P(I+2,4)=PE
14770 P(I+2,5)=SQRT(VINT(62+JT))
14771 150 CONTINUE
14772
14773
14774 CALL LUDBRB(MINT(83)+3,N,ACOS(VINT(23)),VINT(24),0D0,0D0,0D0)
14775
14776 RETURN
14777 END
14778
14779
14780
14781 SUBROUTINE PYFRAM(IFRAME)
14782
14783
14784 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
14785 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
14786 COMMON/PYINT1/MINT(400),VINT(400)
14787 SAVE
14788
14789 IF(IFRAME.LT.1.OR.IFRAME.GT.2) THEN
14790 WRITE(MSTU(11),1000) IFRAME,MINT(6)
14791 RETURN
14792 ENDIF
14793 IF(IFRAME.EQ.MINT(6)) RETURN
14794
14795 IF(MINT(6).EQ.1) THEN
14796
14797
14798 CALL LUROBO(0.,0.,-VINT(8),-VINT(9),-VINT(10))
14799 CALL LUROBO(0.,-VINT(7),0.,0.,0.)
14800 CALL LUROBO(-VINT(6),0.,0.,0.,0.)
14801 MINT(6)=2
14802
14803 ELSE
14804
14805
14806 CALL LUROBO(VINT(6),VINT(7),VINT(8),VINT(9),VINT(10))
14807 MINT(6)=1
14808 ENDIF
14809 MSTI(6)=MINT(6)
14810
14811 1000 FORMAT(1X,'Error: illegal values in subroutine PYFRAM.',1X,
14812 &'No transformation performed.'/1X,'IFRAME =',1X,I5,'; MINT(6) =',
14813 &1X,I5)
14814
14815 RETURN
14816 END
14817
14818
14819
14820 SUBROUTINE PYWIDT(KFLR,RMAS,WDTP,WDTE)
14821
14822
14823 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
14824 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
14825 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
14826 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
14827 COMMON/PYINT1/MINT(400),VINT(400)
14828 COMMON/PYINT4/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3)
14829 DIMENSION WDTP(0:40),WDTE(0:40,0:5)
14830 SAVE
14831
14832
14833 KFLA=IABS(KFLR)
14834 SQM=RMAS**2
14835 AS=ULALPS(SQM)
14836 AEM=PARU(101)
14837 XW=PARU(102)
14838 RADC=1.+AS/PARU(1)
14839
14840
14841 DO 100 I=0,40
14842 WDTP(I)=0.
14843 DO 100 J=0,5
14844 100 WDTE(I,J)=0.
14845
14846 IF(KFLA.EQ.21) THEN
14847
14848 DO 110 I=1,MDCY(21,3)
14849 IDC=I+MDCY(21,2)-1
14850 RM1=(PMAS(IABS(KFDP(IDC,1)),1)/RMAS)**2
14851 RM2=(PMAS(IABS(KFDP(IDC,2)),1)/RMAS)**2
14852 IF(SQRT(RM1)+SQRT(RM2).GT.1..OR.MDME(IDC,1).LT.0) GOTO 110
14853 IF(I.LE.8) THEN
14854
14855 WDTP(I)=(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))
14856 WID2=1.
14857 ENDIF
14858 WDTP(0)=WDTP(0)+WDTP(I)
14859 IF(MDME(IDC,1).GT.0) THEN
14860 WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
14861 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
14862 WDTE(I,0)=WDTE(I,MDME(IDC,1))
14863 WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
14864 ENDIF
14865 110 CONTINUE
14866
14867 ELSEIF(KFLA.EQ.23) THEN
14868
14869 IF(MINT(61).EQ.1) THEN
14870 EI=KCHG(IABS(MINT(15)),1)/3.
14871 AI=SIGN(1.,EI)
14872 VI=AI-4.*EI*XW
14873 SQMZ=PMAS(23,1)**2
14874 GZMZ=PMAS(23,2)*PMAS(23,1)
14875 GGI=EI**2
14876 GZI=EI*VI/(8.*XW*(1.-XW))*SQM*(SQM-SQMZ)/
14877 & ((SQM-SQMZ)**2+GZMZ**2)
14878 ZZI=(VI**2+AI**2)/(16.*XW*(1.-XW))**2*SQM**2/
14879 & ((SQM-SQMZ)**2+GZMZ**2)
14880 IF(MSTP(43).EQ.1) THEN
14881
14882 GZI=0.
14883 ZZI=0.
14884 ELSEIF(MSTP(43).EQ.2) THEN
14885
14886 GGI=0.
14887 GZI=0.
14888 ENDIF
14889 ELSEIF(MINT(61).EQ.2) THEN
14890 VINT(111)=0.
14891 VINT(112)=0.
14892 VINT(114)=0.
14893 ENDIF
14894 DO 120 I=1,MDCY(23,3)
14895 IDC=I+MDCY(23,2)-1
14896 RM1=(PMAS(IABS(KFDP(IDC,1)),1)/RMAS)**2
14897 RM2=(PMAS(IABS(KFDP(IDC,2)),1)/RMAS)**2
14898 IF(SQRT(RM1)+SQRT(RM2).GT.1..OR.MDME(IDC,1).LT.0) GOTO 120
14899 IF(I.LE.8) THEN
14900
14901 EF=KCHG(I,1)/3.
14902 AF=SIGN(1.,EF+0.1)
14903 VF=AF-4.*EF*XW
14904 IF(MINT(61).EQ.0) THEN
14905 WDTP(I)=3.*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*
14906 & SQRT(MAX(0.,1.-4.*RM1))*RADC
14907 ELSEIF(MINT(61).EQ.1) THEN
14908 WDTP(I)=3.*((GGI*EF**2+GZI*EF*VF+ZZI*VF**2)*
14909 & (1.+2.*RM1)+ZZI*AF**2*(1.-4.*RM1))*
14910 & SQRT(MAX(0.,1.-4.*RM1))*RADC
14911 ELSEIF(MINT(61).EQ.2) THEN
14912 GGF=3.*EF**2*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))*RADC
14913 GZF=3.*EF*VF*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))*RADC
14914 ZZF=3.*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*
14915 & SQRT(MAX(0.,1.-4.*RM1))*RADC
14916 ENDIF
14917 WID2=1.
14918 ELSEIF(I.LE.16) THEN
14919
14920 EF=KCHG(I+2,1)/3.
14921 AF=SIGN(1.,EF+0.1)
14922 VF=AF-4.*EF*XW
14923 WDTP(I)=(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*
14924 & SQRT(MAX(0.,1.-4.*RM1))
14925 IF(MINT(61).EQ.0) THEN
14926 WDTP(I)=(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*
14927 & SQRT(MAX(0.,1.-4.*RM1))
14928 ELSEIF(MINT(61).EQ.1) THEN
14929 WDTP(I)=((GGI*EF**2+GZI*EF*VF+ZZI*VF**2)*
14930 & (1.+2.*RM1)+ZZI*AF**2*(1.-4.*RM1))*
14931 & SQRT(MAX(0.,1.-4.*RM1))
14932 ELSEIF(MINT(61).EQ.2) THEN
14933 GGF=EF**2*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))
14934 GZF=EF*VF*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))
14935 ZZF=(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*
14936 & SQRT(MAX(0.,1.-4.*RM1))
14937 ENDIF
14938 WID2=1.
14939 ELSE
14940
14941 CF=2.*(1.-2.*XW)
14942 IF(MINT(61).EQ.0) THEN
14943 WDTP(I)=0.25*CF**2*(1.-4.*RM1)*SQRT(MAX(0.,1.-4.*RM1))
14944 ELSEIF(MINT(61).EQ.1) THEN
14945 WDTP(I)=0.25*(GGI+GZI*CF+ZZI*CF**2)*(1.-4.*RM1)*
14946 & SQRT(MAX(0.,1.-4.*RM1))
14947 ELSEIF(MINT(61).EQ.2) THEN
14948 GGF=0.25*(1.-4.*RM1)*SQRT(MAX(0.,1.-4.*RM1))
14949 GZF=0.25*CF*(1.-4.*RM1)*SQRT(MAX(0.,1.-4.*RM1))
14950 ZZF=0.25*CF**2*(1.-4.*RM1)*SQRT(MAX(0.,1.-4.*RM1))
14951 ENDIF
14952 WID2=WIDS(37,1)
14953 ENDIF
14954 WDTP(0)=WDTP(0)+WDTP(I)
14955 IF(MDME(IDC,1).GT.0) THEN
14956 WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
14957 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
14958 WDTE(I,0)=WDTE(I,MDME(IDC,1))
14959 WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
14960 VINT(111)=VINT(111)+GGF*WID2
14961 VINT(112)=VINT(112)+GZF*WID2
14962 VINT(114)=VINT(114)+ZZF*WID2
14963 ENDIF
14964 120 CONTINUE
14965 IF(MSTP(43).EQ.1) THEN
14966
14967 VINT(112)=0.
14968 VINT(114)=0.
14969 ELSEIF(MSTP(43).EQ.2) THEN
14970
14971 VINT(111)=0.
14972 VINT(112)=0.
14973 ENDIF
14974
14975 ELSEIF(KFLA.EQ.24) THEN
14976
14977 DO 130 I=1,MDCY(24,3)
14978 IDC=I+MDCY(24,2)-1
14979 RM1=(PMAS(IABS(KFDP(IDC,1)),1)/RMAS)**2
14980 RM2=(PMAS(IABS(KFDP(IDC,2)),1)/RMAS)**2
14981 IF(SQRT(RM1)+SQRT(RM2).GT.1..OR.MDME(IDC,1).LT.0) GOTO 130
14982 IF(I.LE.16) THEN
14983
14984 WDTP(I)=3.*(2.-RM1-RM2-(RM1-RM2)**2)*
14985 & SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))*
14986 & VCKM((I-1)/4+1,MOD(I-1,4)+1)*RADC
14987 WID2=1.
14988 ELSE
14989
14990 WDTP(I)=(2.-RM1-RM2-(RM1-RM2)**2)*
14991 & SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))
14992 WID2=1.
14993 ENDIF
14994 WDTP(0)=WDTP(0)+WDTP(I)
14995 IF(MDME(IDC,1).GT.0) THEN
14996 WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
14997 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
14998 WDTE(I,0)=WDTE(I,MDME(IDC,1))
14999 WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
15000 ENDIF
15001 130 CONTINUE
15002
15003 ELSEIF(KFLA.EQ.25) THEN
15004
15005 DO 170 I=1,MDCY(25,3)
15006 IDC=I+MDCY(25,2)-1
15007 RM1=(PMAS(IABS(KFDP(IDC,1)),1)/RMAS)**2
15008 RM2=(PMAS(IABS(KFDP(IDC,2)),1)/RMAS)**2
15009 IF(SQRT(RM1)+SQRT(RM2).GT.1..OR.MDME(IDC,1).LT.0) GOTO 170
15010 IF(I.LE.8) THEN
15011
15012 WDTP(I)=3.*RM1*(1.-4.*RM1)*SQRT(MAX(0.,1.-4.*RM1))*RADC
15013 WID2=1.
15014 ELSEIF(I.LE.12) THEN
15015
15016 WDTP(I)=RM1*(1.-4.*RM1)*SQRT(MAX(0.,1.-4.*RM1))
15017 WID2=1.
15018 ELSEIF(I.EQ.13) THEN
15019
15020 ETARE=0.
15021 ETAIM=0.
15022 DO 140 J=1,2*MSTP(1)
15023 EPS=(2.*PMAS(J,1)/RMAS)**2
15024 IF(EPS.LE.1.) THEN
15025 IF(EPS.GT.1.E-4) THEN
15026 ROOT=SQRT(1.-EPS)
15027 RLN=LOG((1.+ROOT)/(1.-ROOT))
15028 ELSE
15029 RLN=LOG(4./EPS-2.)
15030 ENDIF
15031 PHIRE=0.25*(RLN**2-PARU(1)**2)
15032 PHIIM=0.5*PARU(1)*RLN
15033 ELSE
15034 PHIRE=-(ASIN(1./SQRT(EPS)))**2
15035 PHIIM=0.
15036 ENDIF
15037 ETARE=ETARE+0.5*EPS*(1.+(EPS-1.)*PHIRE)
15038 ETAIM=ETAIM+0.5*EPS*(EPS-1.)*PHIIM
15039 140 CONTINUE
15040 ETA2=ETARE**2+ETAIM**2
15041 WDTP(I)=(AS/PARU(1))**2*ETA2
15042 WID2=1.
15043 ELSEIF(I.EQ.14) THEN
15044
15045 ETARE=0.
15046 ETAIM=0.
15047 DO 150 J=1,3*MSTP(1)+1
15048 IF(J.LE.2*MSTP(1)) THEN
15049 EJ=KCHG(J,1)/3.
15050 EPS=(2.*PMAS(J,1)/RMAS)**2
15051 ELSEIF(J.LE.3*MSTP(1)) THEN
15052 JL=2*(J-2*MSTP(1))-1
15053 EJ=KCHG(10+JL,1)/3.
15054 EPS=(2.*PMAS(10+JL,1)/RMAS)**2
15055 ELSE
15056 EPS=(2.*PMAS(24,1)/RMAS)**2
15057 ENDIF
15058 IF(EPS.LE.1.) THEN
15059 IF(EPS.GT.1.E-4) THEN
15060 ROOT=SQRT(1.-EPS)
15061 RLN=LOG((1.+ROOT)/(1.-ROOT))
15062 ELSE
15063 RLN=LOG(4./EPS-2.)
15064 ENDIF
15065 PHIRE=0.25*(RLN**2-PARU(1)**2)
15066 PHIIM=0.5*PARU(1)*RLN
15067 ELSE
15068 PHIRE=-(ASIN(1./SQRT(EPS)))**2
15069 PHIIM=0.
15070 ENDIF
15071 IF(J.LE.2*MSTP(1)) THEN
15072 ETARE=ETARE+0.5*3.*EJ**2*EPS*(1.+(EPS-1.)*PHIRE)
15073 ETAIM=ETAIM+0.5*3.*EJ**2*EPS*(EPS-1.)*PHIIM
15074 ELSEIF(J.LE.3*MSTP(1)) THEN
15075 ETARE=ETARE+0.5*EJ**2*EPS*(1.+(EPS-1.)*PHIRE)
15076 ETAIM=ETAIM+0.5*EJ**2*EPS*(EPS-1.)*PHIIM
15077 ELSE
15078 ETARE=ETARE-0.5-0.75*EPS*(1.+(EPS-2.)*PHIRE)
15079 ETAIM=ETAIM+0.75*EPS*(EPS-2.)*PHIIM
15080 ENDIF
15081 150 CONTINUE
15082 ETA2=ETARE**2+ETAIM**2
15083 WDTP(I)=(AEM/PARU(1))**2*0.5*ETA2
15084 WID2=1.
15085 ELSEIF(I.EQ.15) THEN
15086
15087 ETARE=0.
15088 ETAIM=0.
15089 DO 160 J=1,3*MSTP(1)+1
15090 IF(J.LE.2*MSTP(1)) THEN
15091 EJ=KCHG(J,1)/3.
15092 AJ=SIGN(1.,EJ+0.1)
15093 VJ=AJ-4.*EJ*XW
15094 EPS=(2.*PMAS(J,1)/RMAS)**2
15095 EPSP=(2.*PMAS(J,1)/PMAS(23,1))**2
15096 ELSEIF(J.LE.3*MSTP(1)) THEN
15097 JL=2*(J-2*MSTP(1))-1
15098 EJ=KCHG(10+JL,1)/3.
15099 AJ=SIGN(1.,EJ+0.1)
15100 VJ=AI-4.*EJ*XW
15101 EPS=(2.*PMAS(10+JL,1)/RMAS)**2
15102 EPSP=(2.*PMAS(10+JL,1)/PMAS(23,1))**2
15103 ELSE
15104 EPS=(2.*PMAS(24,1)/RMAS)**2
15105 EPSP=(2.*PMAS(24,1)/PMAS(23,1))**2
15106 ENDIF
15107 IF(EPS.LE.1.) THEN
15108 ROOT=SQRT(1.-EPS)
15109 IF(EPS.GT.1.E-4) THEN
15110 RLN=LOG((1.+ROOT)/(1.-ROOT))
15111 ELSE
15112 RLN=LOG(4./EPS-2.)
15113 ENDIF
15114 PHIRE=0.25*(RLN**2-PARU(1)**2)
15115 PHIIM=0.5*PARU(1)*RLN
15116 PSIRE=-(1.+0.5*ROOT*RLN)
15117 PSIIM=0.5*PARU(1)*ROOT
15118 ELSE
15119 PHIRE=-(ASIN(1./SQRT(EPS)))**2
15120 PHIIM=0.
15121 PSIRE=-(1.+SQRT(EPS-1.)*ASIN(1./SQRT(EPS)))
15122 PSIIM=0.
15123 ENDIF
15124 IF(EPSP.LE.1.) THEN
15125 ROOT=SQRT(1.-EPSP)
15126 IF(EPSP.GT.1.E-4) THEN
15127 RLN=LOG((1.+ROOT)/(1.-ROOT))
15128 ELSE
15129 RLN=LOG(4./EPSP-2.)
15130 ENDIF
15131 PHIREP=0.25*(RLN**2-PARU(1)**2)
15132 PHIIMP=0.5*PARU(1)*RLN
15133 PSIREP=-(1.+0.5*ROOT*RLN)
15134 PSIIMP=0.5*PARU(1)*ROOT
15135 ELSE
15136 PHIREP=-(ASIN(1./SQRT(EPSP)))**2
15137 PHIIMP=0.
15138 PSIREP=-(1.+SQRT(EPSP-1.)*ASIN(1./SQRT(EPSP)))
15139 PSIIMP=0.
15140 ENDIF
15141 FXYRE=EPS*EPSP/(8.*(EPS-EPSP))*(1.-EPS*EPSP/(EPS-EPSP)*(PHIRE-
15142 & PHIREP)+2.*EPS/(EPS-EPSP)*(PSIRE-PSIREP))
15143 FXYIM=EPS*EPSP/(8.*(EPS-EPSP))*(-EPS*EPSP/(EPS-EPSP)*(PHIIM-
15144 & PHIIMP)+2.*EPS/(EPS-EPSP)*(PSIIM-PSIIMP))
15145 F1RE=EPS*EPSP/(2.*(EPS-EPSP))*(PHIRE-PHIREP)
15146 F1IM=EPS*EPSP/(2.*(EPS-EPSP))*(PHIIM-PHIIMP)
15147 IF(J.LE.2*MSTP(1)) THEN
15148 ETARE=ETARE-3.*EJ*VJ*(FXYRE-0.25*F1RE)
15149 ETAIM=ETAIM-3.*EJ*VJ*(FXYIM-0.25*F1IM)
15150 ELSEIF(J.LE.3*MSTP(1)) THEN
15151 ETARE=ETARE-EJ*VJ*(FXYRE-0.25*F1RE)
15152 ETAIM=ETAIM-EJ*VJ*(FXYIM-0.25*F1IM)
15153 ELSE
15154 ETARE=ETARE-SQRT(1.-XW)*(((1.+2./EPS)*XW/SQRT(1.-XW)-
15155 & (5.+2./EPS))*FXYRE+(3.-XW/SQRT(1.-XW))*F1RE)
15156 ETAIM=ETAIM-SQRT(1.-XW)*(((1.+2./EPS)*XW/SQRT(1.-XW)-
15157 & (5.+2./EPS))*FXYIM+(3.-XW/SQRT(1.-XW))*F1IM)
15158 ENDIF
15159 160 CONTINUE
15160 ETA2=ETARE**2+ETAIM**2
15161 WDTP(I)=(AEM/PARU(1))**2*(1.-(PMAS(23,1)/RMAS)**2)**3/XW*ETA2
15162 WID2=WIDS(23,2)
15163 ELSE
15164
15165 WDTP(I)=(1.-4.*RM1+12.*RM1**2)*SQRT(MAX(0.,1.-4.*RM1))/
15166 & (2.*(18-I))
15167 WID2=WIDS(7+I,1)
15168 ENDIF
15169 WDTP(0)=WDTP(0)+WDTP(I)
15170 IF(MDME(IDC,1).GT.0) THEN
15171 WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
15172 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
15173 WDTE(I,0)=WDTE(I,MDME(IDC,1))
15174 WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
15175 ENDIF
15176 170 CONTINUE
15177
15178 ELSEIF(KFLA.EQ.32) THEN
15179
15180 IF(MINT(61).EQ.1) THEN
15181 EI=KCHG(IABS(MINT(15)),1)/3.
15182 AI=SIGN(1.,EI)
15183 VI=AI-4.*EI*XW
15184 SQMZ=PMAS(23,1)**2
15185 GZMZ=PMAS(23,2)*PMAS(23,1)
15186 API=SIGN(1.,EI)
15187 VPI=API-4.*EI*XW
15188 SQMZP=PMAS(32,1)**2
15189 GZPMZP=PMAS(32,2)*PMAS(32,1)
15190 GGI=EI**2
15191 GZI=EI*VI/(8.*XW*(1.-XW))*SQM*(SQM-SQMZ)/
15192 & ((SQM-SQMZ)**2+GZMZ**2)
15193 GZPI=EI*VPI/(8.*XW*(1.-XW))*SQM*(SQM-SQMZP)/
15194 & ((SQM-SQMZP)**2+GZPMZP**2)
15195 ZZI=(VI**2+AI**2)/(16.*XW*(1.-XW))**2*SQM**2/
15196 & ((SQM-SQMZ)**2+GZMZ**2)
15197 ZZPI=2.*(VI*VPI+AI*API)/(16.*XW*(1.-XW))**2*
15198 & SQM**2*((SQM-SQMZ)*(SQM-SQMZP)+GZMZ*GZPMZP)/
15199 & (((SQM-SQMZ)**2+GZMZ**2)*((SQM-SQMZP)**2+GZPMZP**2))
15200 ZPZPI=(VPI**2+API**2)/(16.*XW*(1.-XW))**2*SQM**2/
15201 & ((SQM-SQMZP)**2+GZPMZP**2)
15202 IF(MSTP(44).EQ.1) THEN
15203
15204 GZI=0.
15205 GZPI=0.
15206 ZZI=0.
15207 ZZPI=0.
15208 ZPZPI=0.
15209 ELSEIF(MSTP(44).EQ.2) THEN
15210
15211 GGI=0.
15212 GZI=0.
15213 GZPI=0.
15214 ZZPI=0.
15215 ZPZPI=0.
15216 ELSEIF(MSTP(44).EQ.3) THEN
15217
15218 GGI=0.
15219 GZI=0.
15220 GZPI=0.
15221 ZZI=0.
15222 ZZPI=0.
15223 ELSEIF(MSTP(44).EQ.4) THEN
15224
15225 GZPI=0.
15226 ZZPI=0.
15227 ZPZPI=0.
15228 ELSEIF(MSTP(44).EQ.5) THEN
15229
15230 GZI=0.
15231 ZZI=0.
15232 ZZPI=0.
15233 ELSEIF(MSTP(44).EQ.6) THEN
15234
15235 GGI=0.
15236 GZI=0.
15237 GZPI=0.
15238 ENDIF
15239 ELSEIF(MINT(61).EQ.2) THEN
15240 VINT(111)=0.
15241 VINT(112)=0.
15242 VINT(113)=0.
15243 VINT(114)=0.
15244 VINT(115)=0.
15245 VINT(116)=0.
15246 ENDIF
15247 DO 180 I=1,MDCY(32,3)
15248 IDC=I+MDCY(32,2)-1
15249 RM1=(PMAS(IABS(KFDP(IDC,1)),1)/RMAS)**2
15250 RM2=(PMAS(IABS(KFDP(IDC,2)),1)/RMAS)**2
15251 IF(SQRT(RM1)+SQRT(RM2).GT.1..OR.MDME(IDC,1).LT.0) GOTO 180
15252 IF(I.LE.8) THEN
15253
15254 EF=KCHG(I,1)/3.
15255 AF=SIGN(1.,EF+0.1)
15256 VF=AF-4.*EF*XW
15257 APF=SIGN(1.,EF+0.1)
15258 VPF=APF-4.*EF*XW
15259 IF(MINT(61).EQ.0) THEN
15260 WDTP(I)=3.*(VPF**2*(1.+2.*RM1)+APF**2*(1.-4.*RM1))*
15261 & SQRT(MAX(0.,1.-4.*RM1))*RADC
15262 ELSEIF(MINT(61).EQ.1) THEN
15263 WDTP(I)=3.*((GGI*EF**2+GZI*EF*VF+GZPI*EF*VPF+ZZI*VF**2+
15264 & ZZPI*VF*VPF+ZPZPI*VPF**2)*(1.+2.*RM1)+(ZZI*AF**2+
15265 & ZZPI*AF*APF+ZPZPI*APF**2)*(1.-4.*RM1))*
15266 & SQRT(MAX(0.,1.-4.*RM1))*RADC
15267 ELSEIF(MINT(61).EQ.2) THEN
15268 GGF=3.*EF**2*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))*RADC
15269 GZF=3.*EF*VF*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))*RADC
15270 GZPF=3.*EF*VPF*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))*RADC
15271 ZZF=3.*(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*
15272 & SQRT(MAX(0.,1.-4.*RM1))*RADC
15273 ZZPF=3.*(VF*VPF*(1.+2.*RM1)+AF*APF*(1.-4.*RM1))*
15274 & SQRT(MAX(0.,1.-4.*RM1))*RADC
15275 ZPZPF=3.*(VPF**2*(1.+2.*RM1)+APF**2*(1.-4.*RM1))*
15276 & SQRT(MAX(0.,1.-4.*RM1))*RADC
15277 ENDIF
15278 WID2=1.
15279 ELSE
15280
15281 EF=KCHG(I+2,1)/3.
15282 AF=SIGN(1.,EF+0.1)
15283 VF=AF-4.*EF*XW
15284 APF=SIGN(1.,EF+0.1)
15285 VPF=APF-4.*EF*XW
15286 IF(MINT(61).EQ.0) THEN
15287 WDTP(I)=(VPF**2*(1.+2.*RM1)+APF**2*(1.-4.*RM1))*
15288 & SQRT(MAX(0.,1.-4.*RM1))
15289 ELSEIF(MINT(61).EQ.1) THEN
15290 WDTP(I)=((GGI*EF**2+GZI*EF*VF+GZPI*EF*VPF+ZZI*VF**2+
15291 & ZZPI*VF*VPF+ZPZPI*VPF**2)*(1.+2.*RM1)+(ZZI*AF**2+
15292 & ZZPI*AF*APF+ZPZPI*APF**2)*(1.-4.*RM1))*
15293 & SQRT(MAX(0.,1.-4.*RM1))
15294 ELSEIF(MINT(61).EQ.2) THEN
15295 GGF=EF**2*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))
15296 GZF=EF*VF*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))
15297 GZPF=EF*VPF*(1.+2.*RM1)*SQRT(MAX(0.,1.-4.*RM1))
15298 ZZF=(VF**2*(1.+2.*RM1)+AF**2*(1.-4.*RM1))*
15299 & SQRT(MAX(0.,1.-4.*RM1))
15300 ZZPF=(VF*VPF*(1.+2.*RM1)+AF*APF*(1.-4.*RM1))*
15301 & SQRT(MAX(0.,1.-4.*RM1))
15302 ZPZPF=(VPF**2*(1.+2.*RM1)+APF**2*(1.-4.*RM1))*
15303 & SQRT(MAX(0.,1.-4.*RM1))
15304 ENDIF
15305 WID2=1.
15306 ENDIF
15307 WDTP(0)=WDTP(0)+WDTP(I)
15308 IF(MDME(IDC,1).GT.0) THEN
15309 WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
15310 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
15311 WDTE(I,0)=WDTE(I,MDME(IDC,1))
15312 WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
15313 VINT(111)=VINT(111)+GGF
15314 VINT(112)=VINT(112)+GZF
15315 VINT(113)=VINT(113)+GZPF
15316 VINT(114)=VINT(114)+ZZF
15317 VINT(115)=VINT(115)+ZZPF
15318 VINT(116)=VINT(116)+ZPZPF
15319 ENDIF
15320 180 CONTINUE
15321 IF(MSTP(44).EQ.1) THEN
15322
15323 VINT(112)=0.
15324 VINT(113)=0.
15325 VINT(114)=0.
15326 VINT(115)=0.
15327 VINT(116)=0.
15328 ELSEIF(MSTP(44).EQ.2) THEN
15329
15330 VINT(111)=0.
15331 VINT(112)=0.
15332 VINT(113)=0.
15333 VINT(115)=0.
15334 VINT(116)=0.
15335 ELSEIF(MSTP(44).EQ.3) THEN
15336
15337 VINT(111)=0.
15338 VINT(112)=0.
15339 VINT(113)=0.
15340 VINT(114)=0.
15341 VINT(115)=0.
15342 ELSEIF(MSTP(44).EQ.4) THEN
15343
15344 VINT(113)=0.
15345 VINT(115)=0.
15346 VINT(116)=0.
15347 ELSEIF(MSTP(44).EQ.5) THEN
15348
15349 VINT(112)=0.
15350 VINT(114)=0.
15351 VINT(115)=0.
15352 ELSEIF(MSTP(44).EQ.6) THEN
15353
15354 VINT(111)=0.
15355 VINT(112)=0.
15356 VINT(113)=0.
15357 ENDIF
15358
15359 ELSEIF(KFLA.EQ.37) THEN
15360
15361 DO 190 I=1,MDCY(37,3)
15362 IDC=I+MDCY(37,2)-1
15363 RM1=(PMAS(IABS(KFDP(IDC,1)),1)/RMAS)**2
15364 RM2=(PMAS(IABS(KFDP(IDC,2)),1)/RMAS)**2
15365 IF(SQRT(RM1)+SQRT(RM2).GT.1..OR.MDME(IDC,1).LT.0) GOTO 190
15366 IF(I.LE.4) THEN
15367
15368 WDTP(I)=3.*((RM1*PARU(121)+RM2/PARU(121))*
15369 & (1.-RM1-RM2)-4.*RM1*RM2)*
15370 & SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))*RADC
15371 WID2=1.
15372 ELSE
15373
15374 WDTP(I)=((RM1*PARU(121)+RM2/PARU(121))*
15375 & (1.-RM1-RM2)-4.*RM1*RM2)*
15376 & SQRT(MAX(0.,(1.-RM1-RM2)**2-4.*RM1*RM2))
15377 WID2=1.
15378 ENDIF
15379 WDTP(0)=WDTP(0)+WDTP(I)
15380 IF(MDME(IDC,1).GT.0) THEN
15381 WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
15382 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
15383 WDTE(I,0)=WDTE(I,MDME(IDC,1))
15384 WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
15385 ENDIF
15386 190 CONTINUE
15387
15388 ELSEIF(KFLA.EQ.40) THEN
15389
15390 DO 200 I=1,MDCY(40,3)
15391 IDC=I+MDCY(40,2)-1
15392 RM1=(PMAS(IABS(KFDP(IDC,1)),1)/RMAS)**2
15393 RM2=(PMAS(IABS(KFDP(IDC,2)),1)/RMAS)**2
15394 IF(SQRT(RM1)+SQRT(RM2).GT.1..OR.MDME(IDC,1).LT.0) GOTO 200
15395 IF(I.LE.4) THEN
15396
15397 WDTP(I)=3.*RADC
15398 WID2=1.
15399 ELSE
15400
15401 WDTP(I)=1.
15402 WID2=1.
15403 ENDIF
15404 WDTP(0)=WDTP(0)+WDTP(I)
15405 IF(MDME(IDC,1).GT.0) THEN
15406 WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
15407 WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
15408 WDTE(I,0)=WDTE(I,MDME(IDC,1))
15409 WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
15410 ENDIF
15411 200 CONTINUE
15412
15413 ENDIF
15414 MINT(61)=0
15415
15416 RETURN
15417 END
15418
15419
15420
15421 SUBROUTINE PYKLIM(ILIM)
15422
15423
15424
15425 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
15426 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
15427 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
15428 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
15429 COMMON/PYSUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
15430 COMMON/PYINT1/MINT(400),VINT(400)
15431 COMMON/PYINT2/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2)
15432 SAVE
15433
15434
15435 ISUB=MINT(1)
15436 IF(ISUB.EQ.96) GOTO 110
15437 SQM3=VINT(63)
15438 SQM4=VINT(64)
15439 IF(ILIM.NE.1) THEN
15440 TAU=VINT(21)
15441 RM3=SQM3/(TAU*VINT(2))
15442 RM4=SQM4/(TAU*VINT(2))
15443 BE34=SQRT((1.-RM3-RM4)**2-4.*RM3*RM4)
15444 ENDIF
15445 PTHMIN=CKIN(3)
15446 IF(MIN(SQM3,SQM4).LT.CKIN(6)**2) PTHMIN=MAX(CKIN(3),CKIN(5))
15447
15448 IF(ILIM.EQ.0) THEN
15449
15450
15451 YST=VINT(22)
15452 CTH=VINT(23)
15453 TAUP=VINT(26)
15454 IF(ISET(ISUB).LE.2) THEN
15455 X1=SQRT(TAU)*EXP(YST)
15456 X2=SQRT(TAU)*EXP(-YST)
15457 ELSE
15458 X1=SQRT(TAUP)*EXP(YST)
15459 X2=SQRT(TAUP)*EXP(-YST)
15460 ENDIF
15461 XF=X1-X2
15462 IF(TAU*VINT(2).LT.CKIN(1)**2) MINT(51)=1
15463 IF(CKIN(2).GE.0..AND.TAU*VINT(2).GT.CKIN(2)**2) MINT(51)=1
15464 IF(X1.LT.CKIN(21).OR.X1.GT.CKIN(22)) MINT(51)=1
15465 IF(X2.LT.CKIN(23).OR.X2.GT.CKIN(24)) MINT(51)=1
15466 IF(XF.LT.CKIN(25).OR.XF.GT.CKIN(26)) MINT(51)=1
15467 IF(YST.LT.CKIN(7).OR.YST.GT.CKIN(8)) MINT(51)=1
15468 IF(ISET(ISUB).EQ.2.OR.ISET(ISUB).EQ.4) THEN
15469 PTH=0.5*BE34*SQRT(TAU*VINT(2)*(1.-CTH**2))
15470 Y3=YST+0.5*LOG((1.+RM3-RM4+BE34*CTH)/(1.+RM3-RM4-BE34*CTH))
15471 Y4=YST+0.5*LOG((1.+RM4-RM3-BE34*CTH)/(1.+RM4-RM3+BE34*CTH))
15472 YLARGE=MAX(Y3,Y4)
15473 YSMALL=MIN(Y3,Y4)
15474 ETALAR=10.
15475 ETASMA=-10.
15476 STH=SQRT(1.-CTH**2)
15477 IF(STH.LT.1.E-6) GOTO 100
15478 EXPET3=((1.+RM3-RM4)*SINH(YST)+BE34*COSH(YST)*CTH+
15479 & SQRT(((1.+RM3-RM4)*COSH(YST)+BE34*SINH(YST)*CTH)**2-4.*RM3))/
15480 & (BE34*STH)
15481 EXPET4=((1.-RM3+RM4)*SINH(YST)-BE34*COSH(YST)*CTH+
15482 & SQRT(((1.-RM3+RM4)*COSH(YST)-BE34*SINH(YST)*CTH)**2-4.*RM4))/
15483 & (BE34*STH)
15484 ETA3=LOG(MIN(1.E10,MAX(1.E-10,EXPET3)))
15485 ETA4=LOG(MIN(1.E10,MAX(1.E-10,EXPET4)))
15486 ETALAR=MAX(ETA3,ETA4)
15487 ETASMA=MIN(ETA3,ETA4)
15488
15489 CTSTM1=(1.+RM3-RM4)*COSH(YST)
15490 CTSTM2=BE34*SINH(YST)*CTH
15491 100 CTS3=((1.+RM3-RM4)*SINH(YST)+BE34*COSH(YST)*CTH)/
15492
15493 & SQRT((CTSTM1+CTSTM2)**2-4.*RM3)
15494 CTS4=((1.-RM3+RM4)*SINH(YST)-BE34*COSH(YST)*CTH)/
15495 & SQRT(((1.-RM3+RM4)*COSH(YST)-BE34*SINH(YST)*CTH)**2-4.*RM4)
15496 CTSLAR=MAX(CTS3,CTS4)
15497 CTSSMA=MIN(CTS3,CTS4)
15498 IF(PTH.LT.PTHMIN) MINT(51)=1
15499 IF(CKIN(4).GE.0..AND.PTH.GT.CKIN(4)) MINT(51)=1
15500 IF(YLARGE.LT.CKIN(9).OR.YLARGE.GT.CKIN(10)) MINT(51)=1
15501 IF(YSMALL.LT.CKIN(11).OR.YSMALL.GT.CKIN(12)) MINT(51)=1
15502 IF(ETALAR.LT.CKIN(13).OR.ETALAR.GT.CKIN(14)) MINT(51)=1
15503 IF(ETASMA.LT.CKIN(15).OR.ETASMA.GT.CKIN(16)) MINT(51)=1
15504 IF(CTSLAR.LT.CKIN(17).OR.CTSLAR.GT.CKIN(18)) MINT(51)=1
15505 IF(CTSSMA.LT.CKIN(19).OR.CTSSMA.GT.CKIN(20)) MINT(51)=1
15506 IF(CTH.LT.CKIN(27).OR.CTH.GT.CKIN(28)) MINT(51)=1
15507 ENDIF
15508 IF(ISET(ISUB).EQ.3.OR.ISET(ISUB).EQ.4) THEN
15509 IF(TAUP*VINT(2).LT.CKIN(31)**2) MINT(51)=1
15510 IF(CKIN(32).GE.0..AND.TAUP*VINT(2).GT.CKIN(32)**2) MINT(51)=1
15511 ENDIF
15512
15513 ELSEIF(ILIM.EQ.1) THEN
15514
15515
15516 TAUMN0=0.
15517 TAUMX0=1.
15518
15519 TAUMN1=CKIN(1)**2/VINT(2)
15520 TAUMX1=1.
15521 IF(CKIN(2).GE.0.) TAUMX1=CKIN(2)**2/VINT(2)
15522
15523 TM3=SQRT(SQM3+PTHMIN**2)
15524 TM4=SQRT(SQM4+PTHMIN**2)
15525 YDCOSH=1.
15526 IF(CKIN(9).GT.CKIN(12)) YDCOSH=COSH(CKIN(9)-CKIN(12))
15527 TAUMN2=(TM3**2+2.*TM3*TM4*YDCOSH+TM4**2)/VINT(2)
15528 TAUMX2=1.
15529
15530 CTH2MN=MIN(CKIN(27)**2,CKIN(28)**2)
15531 CTH2MX=MAX(CKIN(27)**2,CKIN(28)**2)
15532 TAUMN3=0.
15533 IF(CKIN(27)*CKIN(28).GT.0.) TAUMN3=
15534 & (SQRT(SQM3+PTHMIN**2/(1.-CTH2MN))+
15535 & SQRT(SQM4+PTHMIN**2/(1.-CTH2MN)))**2/VINT(2)
15536 TAUMX3=1.
15537 IF(CKIN(4).GE.0..AND.CTH2MX.LT.1.) TAUMX3=
15538 & (SQRT(SQM3+CKIN(4)**2/(1.-CTH2MX))+
15539 & SQRT(SQM4+CKIN(4)**2/(1.-CTH2MX)))**2/VINT(2)
15540
15541 TAUMN4=CKIN(21)*CKIN(23)
15542 TAUMX4=CKIN(22)*CKIN(24)
15543
15544 TAUMN5=0.
15545 TAUMX5=MAX(1.-CKIN(25),1.+CKIN(26))
15546 VINT(11)=MAX(TAUMN0,TAUMN1,TAUMN2,TAUMN3,TAUMN4,TAUMN5)
15547 VINT(31)=MIN(TAUMX0,TAUMX1,TAUMX2,TAUMX3,TAUMX4,TAUMX5)
15548 IF(MINT(43).EQ.1.AND.(ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.2)) THEN
15549 VINT(11)=0.99999
15550 VINT(31)=1.00001
15551 ENDIF
15552 IF(VINT(31).LE.VINT(11)) MINT(51)=1
15553
15554 ELSEIF(ILIM.EQ.2) THEN
15555
15556 IF(ISET(ISUB).EQ.3.OR.ISET(ISUB).EQ.4) TAU=VINT(26)
15557 TAURT=SQRT(TAU)
15558
15559 YSTMN0=LOG(TAURT)
15560 YSTMX0=-YSTMN0
15561
15562 YSTMN1=CKIN(7)
15563 YSTMX1=CKIN(8)
15564
15565 YSTMN2=LOG(MAX(TAU,CKIN(21))/TAURT)
15566 YSTMX2=LOG(MAX(TAU,CKIN(22))/TAURT)
15567
15568 YSTMN3=-LOG(MAX(TAU,CKIN(24))/TAURT)
15569 YSTMX3=-LOG(MAX(TAU,CKIN(23))/TAURT)
15570
15571 YEPMN4=0.5*ABS(CKIN(25))/TAURT
15572 YSTMN4=SIGN(LOG(SQRT(1.+YEPMN4**2)+YEPMN4),CKIN(25))
15573 YEPMX4=0.5*ABS(CKIN(26))/TAURT
15574 YSTMX4=SIGN(LOG(SQRT(1.+YEPMX4**2)+YEPMX4),CKIN(26))
15575
15576 YEPSMN=(RM3-RM4)*SINH(CKIN(9)-CKIN(11))
15577 YEPSMX=(RM3-RM4)*SINH(CKIN(10)-CKIN(12))
15578 YDIFMN=ABS(LOG(SQRT(1.+YEPSMN**2)-YEPSMN))
15579 YDIFMX=ABS(LOG(SQRT(1.+YEPSMX**2)-YEPSMX))
15580 YSTMN5=0.5*(CKIN(9)+CKIN(11)-YDIFMN)
15581 YSTMX5=0.5*(CKIN(10)+CKIN(12)+YDIFMX)
15582
15583
15584 CTHLIM=SQRT(1.-4.*PTHMIN**2/(BE34*TAU*VINT(2)))
15585 RZMN=BE34*MAX(CKIN(27),-CTHLIM)
15586 RZMX=BE34*MIN(CKIN(28),CTHLIM)
15587 YEX3MX=(1.+RM3-RM4+RZMX)/MAX(1E-10,1.+RM3-RM4-RZMX)
15588 YEX4MX=(1.+RM4-RM3-RZMN)/MAX(1E-10,1.+RM4-RM3+RZMN)
15589 YEX3MN=MAX(1E-10,1.+RM3-RM4+RZMN)/(1.+RM3-RM4-RZMN)
15590 YEX4MN=MAX(1E-10,1.+RM4-RM3-RZMX)/(1.+RM4-RM3+RZMX)
15591 YSTMN6=CKIN(9)-0.5*LOG(MAX(YEX3MX,YEX4MX))
15592 YSTMX6=CKIN(12)-0.5*LOG(MIN(YEX3MN,YEX4MN))
15593 VINT(12)=MAX(YSTMN0,YSTMN1,YSTMN2,YSTMN3,YSTMN4,YSTMN5,YSTMN6)
15594 VINT(32)=MIN(YSTMX0,YSTMX1,YSTMX2,YSTMX3,YSTMX4,YSTMX5,YSTMX6)
15595 IF(MINT(43).EQ.1) THEN
15596 VINT(12)=-0.00001
15597 VINT(32)=0.00001
15598 ELSEIF(MINT(43).EQ.2) THEN
15599 VINT(12)=0.99999*YSTMX0
15600 VINT(32)=1.00001*YSTMX0
15601 ELSEIF(MINT(43).EQ.3) THEN
15602 VINT(12)=-1.00001*YSTMX0
15603 VINT(32)=-0.99999*YSTMX0
15604 ENDIF
15605 IF(VINT(32).LE.VINT(12)) MINT(51)=1
15606
15607 ELSEIF(ILIM.EQ.3) THEN
15608
15609 YST=VINT(22)
15610
15611 CTNMN0=-1.
15612 CTNMX0=0.
15613 CTPMN0=0.
15614 CTPMX0=1.
15615
15616 CTNMN1=MIN(0.,CKIN(27))
15617 CTNMX1=MIN(0.,CKIN(28))
15618 CTPMN1=MAX(0.,CKIN(27))
15619 CTPMX1=MAX(0.,CKIN(28))
15620
15621 CTNMN2=-SQRT(1.-4.*PTHMIN**2/(BE34**2*TAU*VINT(2)))
15622 CTPMX2=-CTNMN2
15623 CTNMX2=0.
15624 CTPMN2=0.
15625 IF(CKIN(4).GE.0.) THEN
15626 CTNMX2=-SQRT(MAX(0.,1.-4.*CKIN(4)**2/(BE34**2*TAU*VINT(2))))
15627 CTPMN2=-CTNMX2
15628 ENDIF
15629
15630 CTNMN3=MIN(0.,MAX((1.+RM3-RM4)/BE34*TANH(CKIN(11)-YST),
15631 & -(1.-RM3+RM4)/BE34*TANH(CKIN(10)-YST)))
15632 CTNMX3=MIN(0.,(1.+RM3-RM4)/BE34*TANH(CKIN(12)-YST),
15633 & -(1.-RM3+RM4)/BE34*TANH(CKIN(9)-YST))
15634 CTPMN3=MAX(0.,(1.+RM3-RM4)/BE34*TANH(CKIN(9)-YST),
15635 & -(1.-RM3+RM4)/BE34*TANH(CKIN(12)-YST))
15636 CTPMX3=MAX(0.,MIN((1.+RM3-RM4)/BE34*TANH(CKIN(10)-YST),
15637 & -(1.-RM3+RM4)/BE34*TANH(CKIN(11)-YST)))
15638 VINT(13)=MAX(CTNMN0,CTNMN1,CTNMN2,CTNMN3)
15639 VINT(33)=MIN(CTNMX0,CTNMX1,CTNMX2,CTNMX3)
15640 VINT(14)=MAX(CTPMN0,CTPMN1,CTPMN2,CTPMN3)
15641 VINT(34)=MIN(CTPMX0,CTPMX1,CTPMX2,CTPMX3)
15642 IF(VINT(33).LE.VINT(13).AND.VINT(34).LE.VINT(14)) MINT(51)=1
15643
15644 ELSEIF(ILIM.EQ.4) THEN
15645
15646
15647 TAPMN0=TAU
15648 TAPMX0=1.
15649
15650 TAPMN1=CKIN(31)**2/VINT(2)
15651 TAPMX1=1.
15652 IF(CKIN(32).GE.0.) TAPMX1=CKIN(32)**2/VINT(2)
15653 VINT(16)=MAX(TAPMN0,TAPMN1)
15654 VINT(36)=MIN(TAPMX0,TAPMX1)
15655 IF(MINT(43).EQ.1) THEN
15656 VINT(16)=0.99999
15657 VINT(36)=1.00001
15658 ENDIF
15659 IF(VINT(36).LE.VINT(16)) MINT(51)=1
15660
15661 ENDIF
15662 RETURN
15663
15664
15665
15666 110 IF(ILIM.EQ.0) THEN
15667 ELSEIF(ILIM.EQ.1) THEN
15668 IF(MSTP(82).LE.1) VINT(11)=4.*PARP(81)**2/VINT(2)
15669 IF(MSTP(82).GE.2) VINT(11)=PARP(82)**2/VINT(2)
15670 VINT(31)=1.
15671 ELSEIF(ILIM.EQ.2) THEN
15672 VINT(12)=0.5*LOG(VINT(21))
15673 VINT(32)=-VINT(12)
15674 ELSEIF(ILIM.EQ.3) THEN
15675 IF(MSTP(82).LE.1) ST2EFF=4.*PARP(81)**2/(VINT(21)*VINT(2))
15676 IF(MSTP(82).GE.2) ST2EFF=0.01*PARP(82)**2/(VINT(21)*VINT(2))
15677 VINT(13)=-SQRT(MAX(0.,1.-ST2EFF))
15678 VINT(33)=0.
15679 VINT(14)=0.
15680 VINT(34)=-VINT(13)
15681 ENDIF
15682
15683 RETURN
15684 END
15685
15686
15687
15688 SUBROUTINE PYKMAP(IVAR,MVAR,VVAR)
15689
15690
15691
15692
15693 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
15694 COMMON/PYINT1/MINT(400),VINT(400)
15695 COMMON/PYINT2/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2)
15696 SAVE
15697
15698
15699 ISUB=MINT(1)
15700 IF(IVAR.EQ.1) THEN
15701 TAUMIN=VINT(11)
15702 TAUMAX=VINT(31)
15703 IF(MVAR.EQ.3.OR.MVAR.EQ.4) THEN
15704 TAURE=VINT(73)
15705 GAMRE=VINT(74)
15706 ELSEIF(MVAR.EQ.5.OR.MVAR.EQ.6) THEN
15707 TAURE=VINT(75)
15708 GAMRE=VINT(76)
15709 ENDIF
15710 IF(MINT(43).EQ.1.AND.(ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.2)) THEN
15711 TAU=1.
15712 ELSEIF(MVAR.EQ.1) THEN
15713 TAU=TAUMIN*(TAUMAX/TAUMIN)**VVAR
15714 ELSEIF(MVAR.EQ.2) THEN
15715 TAU=TAUMAX*TAUMIN/(TAUMIN+(TAUMAX-TAUMIN)*VVAR)
15716 ELSEIF(MVAR.EQ.3.OR.MVAR.EQ.5) THEN
15717 RATGEN=(TAURE+TAUMAX)/(TAURE+TAUMIN)*TAUMIN/TAUMAX
15718 TAU=TAURE*TAUMIN/((TAURE+TAUMIN)*RATGEN**VVAR-TAUMIN)
15719 ELSE
15720 AUPP=ATAN((TAUMAX-TAURE)/GAMRE)
15721 ALOW=ATAN((TAUMIN-TAURE)/GAMRE)
15722 TAU=TAURE+GAMRE*TAN(ALOW+(AUPP-ALOW)*VVAR)
15723 ENDIF
15724 VINT(21)=MIN(TAUMAX,MAX(TAUMIN,TAU))
15725
15726
15727 ELSEIF(IVAR.EQ.2) THEN
15728 YSTMIN=VINT(12)
15729 YSTMAX=VINT(32)
15730 IF(MINT(43).EQ.1) THEN
15731 YST=0.
15732 ELSEIF(MINT(43).EQ.2) THEN
15733 IF(ISET(ISUB).LE.2) YST=-0.5*LOG(VINT(21))
15734 IF(ISET(ISUB).GE.3) YST=-0.5*LOG(VINT(26))
15735 ELSEIF(MINT(43).EQ.3) THEN
15736 IF(ISET(ISUB).LE.2) YST=0.5*LOG(VINT(21))
15737 IF(ISET(ISUB).GE.3) YST=0.5*LOG(VINT(26))
15738 ELSEIF(MVAR.EQ.1) THEN
15739 YST=YSTMIN+(YSTMAX-YSTMIN)*SQRT(VVAR)
15740 ELSEIF(MVAR.EQ.2) THEN
15741 YST=YSTMAX-(YSTMAX-YSTMIN)*SQRT(1.-VVAR)
15742 ELSE
15743 AUPP=ATAN(EXP(YSTMAX))
15744 ALOW=ATAN(EXP(YSTMIN))
15745 YST=LOG(TAN(ALOW+(AUPP-ALOW)*VVAR))
15746 ENDIF
15747 VINT(22)=MIN(YSTMAX,MAX(YSTMIN,YST))
15748
15749
15750 ELSEIF(IVAR.EQ.3) THEN
15751 RM34=2.*VINT(63)*VINT(64)/(VINT(21)*VINT(2))**2
15752 RSQM=1.+RM34
15753 IF(2.*VINT(71)**2/(VINT(21)*VINT(2)).LT.0.0001) RM34=MAX(RM34,
15754 & 2.*VINT(71)**2/(VINT(21)*VINT(2)))
15755 CTNMIN=VINT(13)
15756 CTNMAX=VINT(33)
15757 CTPMIN=VINT(14)
15758 CTPMAX=VINT(34)
15759 IF(MVAR.EQ.1) THEN
15760 ANEG=CTNMAX-CTNMIN
15761 APOS=CTPMAX-CTPMIN
15762 IF(ANEG.GT.0..AND.VVAR*(ANEG+APOS).LE.ANEG) THEN
15763 VCTN=VVAR*(ANEG+APOS)/ANEG
15764 CTH=CTNMIN+(CTNMAX-CTNMIN)*VCTN
15765 ELSE
15766 VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS
15767 CTH=CTPMIN+(CTPMAX-CTPMIN)*VCTP
15768 ENDIF
15769 ELSEIF(MVAR.EQ.2) THEN
15770 RMNMIN=MAX(RM34,RSQM-CTNMIN)
15771 RMNMAX=MAX(RM34,RSQM-CTNMAX)
15772 RMPMIN=MAX(RM34,RSQM-CTPMIN)
15773 RMPMAX=MAX(RM34,RSQM-CTPMAX)
15774 ANEG=LOG(RMNMIN/RMNMAX)
15775 APOS=LOG(RMPMIN/RMPMAX)
15776 IF(ANEG.GT.0..AND.VVAR*(ANEG+APOS).LE.ANEG) THEN
15777 VCTN=VVAR*(ANEG+APOS)/ANEG
15778 CTH=RSQM-RMNMIN*(RMNMAX/RMNMIN)**VCTN
15779 ELSE
15780 VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS
15781 CTH=RSQM-RMPMIN*(RMPMAX/RMPMIN)**VCTP
15782 ENDIF
15783 ELSEIF(MVAR.EQ.3) THEN
15784 RMNMIN=MAX(RM34,RSQM+CTNMIN)
15785 RMNMAX=MAX(RM34,RSQM+CTNMAX)
15786 RMPMIN=MAX(RM34,RSQM+CTPMIN)
15787 RMPMAX=MAX(RM34,RSQM+CTPMAX)
15788 ANEG=LOG(RMNMAX/RMNMIN)
15789 APOS=LOG(RMPMAX/RMPMIN)
15790 IF(ANEG.GT.0..AND.VVAR*(ANEG+APOS).LE.ANEG) THEN
15791 VCTN=VVAR*(ANEG+APOS)/ANEG
15792 CTH=RMNMIN*(RMNMAX/RMNMIN)**VCTN-RSQM
15793 ELSE
15794 VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS
15795 CTH=RMPMIN*(RMPMAX/RMPMIN)**VCTP-RSQM
15796 ENDIF
15797 ELSEIF(MVAR.EQ.4) THEN
15798 RMNMIN=MAX(RM34,RSQM-CTNMIN)
15799 RMNMAX=MAX(RM34,RSQM-CTNMAX)
15800 RMPMIN=MAX(RM34,RSQM-CTPMIN)
15801 RMPMAX=MAX(RM34,RSQM-CTPMAX)
15802 ANEG=1./RMNMAX-1./RMNMIN
15803 APOS=1./RMPMAX-1./RMPMIN
15804 IF(ANEG.GT.0..AND.VVAR*(ANEG+APOS).LE.ANEG) THEN
15805 VCTN=VVAR*(ANEG+APOS)/ANEG
15806 CTH=RSQM-1./(1./RMNMIN+ANEG*VCTN)
15807 ELSE
15808 VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS
15809 CTH=RSQM-1./(1./RMPMIN+APOS*VCTP)
15810 ENDIF
15811 ELSEIF(MVAR.EQ.5) THEN
15812 RMNMIN=MAX(RM34,RSQM+CTNMIN)
15813 RMNMAX=MAX(RM34,RSQM+CTNMAX)
15814 RMPMIN=MAX(RM34,RSQM+CTPMIN)
15815 RMPMAX=MAX(RM34,RSQM+CTPMAX)
15816 ANEG=1./RMNMIN-1./RMNMAX
15817 APOS=1./RMPMIN-1./RMPMAX
15818 IF(ANEG.GT.0..AND.VVAR*(ANEG+APOS).LE.ANEG) THEN
15819 VCTN=VVAR*(ANEG+APOS)/ANEG
15820 CTH=1./(1./RMNMIN-ANEG*VCTN)-RSQM
15821 ELSE
15822 VCTP=(VVAR*(ANEG+APOS)-ANEG)/APOS
15823 CTH=1./(1./RMPMIN-APOS*VCTP)-RSQM
15824 ENDIF
15825 ENDIF
15826 IF(CTH.LT.0.) CTH=MIN(CTNMAX,MAX(CTNMIN,CTH))
15827 IF(CTH.GT.0.) CTH=MIN(CTPMAX,MAX(CTPMIN,CTH))
15828 VINT(23)=CTH
15829
15830
15831 ELSEIF(IVAR.EQ.4) THEN
15832 TAU=VINT(11)
15833 TAUPMN=VINT(16)
15834 TAUPMX=VINT(36)
15835 IF(MINT(43).EQ.1) THEN
15836 TAUP=1.
15837 ELSEIF(MVAR.EQ.1) THEN
15838 TAUP=TAUPMN*(TAUPMX/TAUPMN)**VVAR
15839 ELSE
15840 AUPP=(1.-TAU/TAUPMX)**4
15841 ALOW=(1.-TAU/TAUPMN)**4
15842 TAUP=TAU/(1.-(ALOW+(AUPP-ALOW)*VVAR)**0.25)
15843 ENDIF
15844 VINT(26)=MIN(TAUPMX,MAX(TAUPMN,TAUP))
15845 ENDIF
15846
15847 RETURN
15848 END
15849
15850
15851
15852 SUBROUTINE PYSIGH(NCHN,SIGS)
15853
15854
15855
15856
15857
15858
15859
15860
15861
15862
15863 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
15864 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
15865 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
15866 COMMON/PYSUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
15867 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
15868 COMMON/PYINT1/MINT(400),VINT(400)
15869 COMMON/PYINT2/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2)
15870 COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000)
15871 COMMON/PYINT4/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3)
15872 COMMON/PYINT5/NGEN(0:200,3),XSEC(0:200,3)
15873 DIMENSION X(2),XPQ(-6:6),KFAC(2,-40:40),WDTP(0:40),WDTE(0:40,0:5)
15874 SAVE
15875
15876
15877 NCHN=0
15878 SIGS=0.
15879
15880
15881 ISUB=MINT(1)
15882 TAUMIN=VINT(11)
15883 YSTMIN=VINT(12)
15884 CTNMIN=VINT(13)
15885 CTPMIN=VINT(14)
15886 XT2MIN=VINT(15)
15887 TAUPMN=VINT(16)
15888 TAU=VINT(21)
15889 YST=VINT(22)
15890 CTH=VINT(23)
15891 XT2=VINT(25)
15892 TAUP=VINT(26)
15893 TAUMAX=VINT(31)
15894 YSTMAX=VINT(32)
15895 CTNMAX=VINT(33)
15896 CTPMAX=VINT(34)
15897 XT2MAX=VINT(35)
15898 TAUPMX=VINT(36)
15899
15900
15901 IF(ISET(ISUB).LE.2.OR.ISET(ISUB).EQ.5) THEN
15902 X(1)=SQRT(TAU)*EXP(YST)
15903 X(2)=SQRT(TAU)*EXP(-YST)
15904 ELSE
15905 X(1)=SQRT(TAUP)*EXP(YST)
15906 X(2)=SQRT(TAUP)*EXP(-YST)
15907 ENDIF
15908 IF(MINT(43).EQ.4.AND.ISET(ISUB).GE.1.AND.
15909 &(X(1).GT.0.999.OR.X(2).GT.0.999)) RETURN
15910 SH=TAU*VINT(2)
15911 SQM3=VINT(63)
15912 SQM4=VINT(64)
15913 RM3=SQM3/SH
15914 RM4=SQM4/SH
15915 BE34=SQRT((1.-RM3-RM4)**2-4.*RM3*RM4)
15916 RPTS=4.*VINT(71)**2/SH
15917 BE34L=SQRT(MAX(0.,(1.-RM3-RM4)**2-4.*RM3*RM4-RPTS))
15918 RM34=2.*RM3*RM4
15919 RSQM=1.+RM34
15920 RTHM=(4.*RM3*RM4+RPTS)/(1.-RM3-RM4+BE34L)
15921 TH=-0.5*SH*MAX(RTHM,1.-RM3-RM4-BE34*CTH)
15922 UH=-0.5*SH*MAX(RTHM,1.-RM3-RM4+BE34*CTH)
15923 SQPTH=0.25*SH*BE34**2*(1.-CTH**2)
15924 SH2=SH**2
15925 TH2=TH**2
15926 UH2=UH**2
15927
15928
15929 IF(ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.3) THEN
15930 Q2=SH
15931 ELSEIF(MOD(ISET(ISUB),2).EQ.0.OR.ISET(ISUB).EQ.5) THEN
15932 IF(MSTP(32).EQ.1) THEN
15933 Q2=2.*SH*TH*UH/(SH**2+TH**2+UH**2)
15934 ELSEIF(MSTP(32).EQ.2) THEN
15935 Q2=SQPTH+0.5*(SQM3+SQM4)
15936 ELSEIF(MSTP(32).EQ.3) THEN
15937 Q2=MIN(-TH,-UH)
15938 ELSEIF(MSTP(32).EQ.4) THEN
15939 Q2=SH
15940 ENDIF
15941 IF(ISET(ISUB).EQ.5.AND.MSTP(82).GE.2) Q2=Q2+PARP(82)**2
15942 ENDIF
15943
15944
15945 VINT(41)=X(1)
15946 VINT(42)=X(2)
15947 VINT(44)=SH
15948 VINT(43)=SQRT(SH)
15949 VINT(45)=TH
15950 VINT(46)=UH
15951 VINT(48)=SQPTH
15952 VINT(47)=SQRT(SQPTH)
15953 VINT(50)=TAUP*VINT(2)
15954 VINT(49)=SQRT(MAX(0.,VINT(50)))
15955 VINT(52)=Q2
15956 VINT(51)=SQRT(Q2)
15957
15958
15959 IF(ISET(ISUB).LE.0) GOTO 145
15960 IF(MINT(43).GE.2) THEN
15961 Q2SF=Q2
15962 IF(ISET(ISUB).EQ.3.OR.ISET(ISUB).EQ.4) THEN
15963 Q2SF=PMAS(23,1)**2
15964 IF(ISUB.EQ.8.OR.ISUB.EQ.76.OR.ISUB.EQ.77) Q2SF=PMAS(24,1)**2
15965 ENDIF
15966 DO 100 I=3-MINT(41),MINT(42)
15967 XSF=X(I)
15968 IF(ISET(ISUB).EQ.5) XSF=X(I)/VINT(142+I)
15969 CALL PYSTFU(MINT(10+I),XSF,Q2SF,XPQ,I)
15970 DO 100 KFL=-6,6
15971 100 XSFX(I,KFL)=XPQ(KFL)
15972 ENDIF
15973
15974
15975 IF(MSTP(33).NE.3) AS=ULALPS(Q2)
15976 FACK=1.
15977 FACA=1.
15978 IF(MSTP(33).EQ.1) THEN
15979 FACK=PARP(31)
15980 ELSEIF(MSTP(33).EQ.2) THEN
15981 FACK=PARP(31)
15982 FACA=PARP(32)/PARP(31)
15983 ELSEIF(MSTP(33).EQ.3) THEN
15984 Q2AS=PARP(33)*Q2
15985 IF(ISET(ISUB).EQ.5.AND.MSTP(82).GE.2) Q2AS=Q2AS+
15986 & PARU(112)*PARP(82)
15987 AS=ULALPS(Q2AS)
15988 ENDIF
15989 RADC=1.+AS/PARU(1)
15990
15991
15992 DO 130 I=1,2
15993 DO 110 J=-40,40
15994 110 KFAC(I,J)=0
15995 IF(MINT(40+I).EQ.1) THEN
15996 KFAC(I,MINT(10+I))=1
15997 ELSE
15998 DO 120 J=-40,40
15999 KFAC(I,J)=KFIN(I,J)
16000 IF(ABS(J).GT.MSTP(54).AND.J.NE.21) KFAC(I,J)=0
16001 IF(ABS(J).LE.6) THEN
16002 IF(XSFX(I,J).LT.1.E-10) KFAC(I,J)=0
16003 ELSEIF(J.EQ.21) THEN
16004 IF(XSFX(I,0).LT.1.E-10) KFAC(I,21)=0
16005 ENDIF
16006 120 CONTINUE
16007 ENDIF
16008 130 CONTINUE
16009
16010
16011 MIN1=0
16012 MAX1=0
16013 MIN2=0
16014 MAX2=0
16015 DO 140 J=-20,20
16016 IF(KFAC(1,-J).EQ.1) MIN1=-J
16017 IF(KFAC(1,J).EQ.1) MAX1=J
16018 IF(KFAC(2,-J).EQ.1) MIN2=-J
16019 IF(KFAC(2,J).EQ.1) MAX2=J
16020 140 CONTINUE
16021 MINA=MIN(MIN1,MIN2)
16022 MAXA=MAX(MAX1,MAX2)
16023
16024
16025 SQMZ=PMAS(23,1)**2
16026 GMMZ=PMAS(23,1)*PMAS(23,2)
16027 SQMW=PMAS(24,1)**2
16028 GMMW=PMAS(24,1)*PMAS(24,2)
16029 SQMH=PMAS(25,1)**2
16030 GMMH=PMAS(25,1)*PMAS(25,2)
16031 SQMZP=PMAS(32,1)**2
16032 GMMZP=PMAS(32,1)*PMAS(32,2)
16033 SQMHC=PMAS(37,1)**2
16034 GMMHC=PMAS(37,1)*PMAS(37,2)
16035 SQMR=PMAS(40,1)**2
16036 GMMR=PMAS(40,1)*PMAS(40,2)
16037 AEM=PARU(101)
16038 XW=PARU(102)
16039
16040
16041 COMFAC=PARU(1)*PARU(5)/VINT(2)
16042 IF(MINT(43).EQ.4) COMFAC=COMFAC*FACK
16043 IF((MINT(43).GE.2.OR.ISET(ISUB).EQ.3.OR.ISET(ISUB).EQ.4).AND.
16044 &ISET(ISUB).NE.5) THEN
16045 ATAU0=LOG(TAUMAX/TAUMIN)
16046 ATAU1=(TAUMAX-TAUMIN)/(TAUMAX*TAUMIN)
16047 H1=COEF(ISUB,1)+(ATAU0/ATAU1)*COEF(ISUB,2)/TAU
16048 IF(MINT(72).GE.1) THEN
16049 TAUR1=VINT(73)
16050 GAMR1=VINT(74)
16051 ATAU2=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR1)/(TAUMAX+TAUR1))/TAUR1
16052 ATAU3=(ATAN((TAUMAX-TAUR1)/GAMR1)-ATAN((TAUMIN-TAUR1)/GAMR1))/
16053 & GAMR1
16054 H1=H1+(ATAU0/ATAU2)*COEF(ISUB,3)/(TAU+TAUR1)+
16055 & (ATAU0/ATAU3)*COEF(ISUB,4)*TAU/((TAU-TAUR1)**2+GAMR1**2)
16056 ENDIF
16057 IF(MINT(72).EQ.2) THEN
16058 TAUR2=VINT(75)
16059 GAMR2=VINT(76)
16060 ATAU4=LOG(TAUMAX/TAUMIN*(TAUMIN+TAUR2)/(TAUMAX+TAUR2))/TAUR2
16061 ATAU5=(ATAN((TAUMAX-TAUR2)/GAMR2)-ATAN((TAUMIN-TAUR2)/GAMR2))/
16062 & GAMR2
16063 H1=H1+(ATAU0/ATAU4)*COEF(ISUB,5)/(TAU+TAUR2)+
16064 & (ATAU0/ATAU5)*COEF(ISUB,6)*TAU/((TAU-TAUR2)**2+GAMR2**2)
16065 ENDIF
16066 COMFAC=COMFAC*ATAU0/(TAU*H1)
16067 ENDIF
16068 IF(MINT(43).EQ.4.AND.ISET(ISUB).NE.5) THEN
16069 AYST0=YSTMAX-YSTMIN
16070 AYST1=0.5*(YSTMAX-YSTMIN)**2
16071 AYST2=AYST1
16072 AYST3=2.*(ATAN(EXP(YSTMAX))-ATAN(EXP(YSTMIN)))
16073 H2=(AYST0/AYST1)*COEF(ISUB,7)*(YST-YSTMIN)+(AYST0/AYST2)*
16074 & COEF(ISUB,8)*(YSTMAX-YST)+(AYST0/AYST3)*COEF(ISUB,9)/COSH(YST)
16075 COMFAC=COMFAC*AYST0/H2
16076 ENDIF
16077
16078
16079
16080 ACTH0=CTNMAX-CTNMIN+CTPMAX-CTPMIN
16081 IF((ISET(ISUB).EQ.1.OR.ISET(ISUB).EQ.3).AND.
16082 &MDCY(KFPR(ISUB,1),1).EQ.1) THEN
16083 IF(KFPR(ISUB,1).EQ.25.OR.KFPR(ISUB,1).EQ.37) THEN
16084 COMFAC=COMFAC*0.5*ACTH0
16085 ELSE
16086 COMFAC=COMFAC*0.125*(3.*ACTH0+CTNMAX**3-CTNMIN**3+
16087 & CTPMAX**3-CTPMIN**3)
16088 ENDIF
16089
16090
16091 ELSEIF(ISET(ISUB).EQ.2.OR.ISET(ISUB).EQ.4) THEN
16092 ACTH1=LOG((MAX(RM34,RSQM-CTNMIN)*MAX(RM34,RSQM-CTPMIN))/
16093 & (MAX(RM34,RSQM-CTNMAX)*MAX(RM34,RSQM-CTPMAX)))
16094 ACTH2=LOG((MAX(RM34,RSQM+CTNMAX)*MAX(RM34,RSQM+CTPMAX))/
16095 & (MAX(RM34,RSQM+CTNMIN)*MAX(RM34,RSQM+CTPMIN)))
16096 ACTH3=1./MAX(RM34,RSQM-CTNMAX)-1./MAX(RM34,RSQM-CTNMIN)+
16097 & 1./MAX(RM34,RSQM-CTPMAX)-1./MAX(RM34,RSQM-CTPMIN)
16098 ACTH4=1./MAX(RM34,RSQM+CTNMIN)-1./MAX(RM34,RSQM+CTNMAX)+
16099 & 1./MAX(RM34,RSQM+CTPMIN)-1./MAX(RM34,RSQM+CTPMAX)
16100 H3=COEF(ISUB,10)+
16101 & (ACTH0/ACTH1)*COEF(ISUB,11)/MAX(RM34,RSQM-CTH)+
16102 & (ACTH0/ACTH2)*COEF(ISUB,12)/MAX(RM34,RSQM+CTH)+
16103 & (ACTH0/ACTH3)*COEF(ISUB,13)/MAX(RM34,RSQM-CTH)**2+
16104 & (ACTH0/ACTH4)*COEF(ISUB,14)/MAX(RM34,RSQM+CTH)**2
16105 COMFAC=COMFAC*ACTH0*0.5*BE34/H3
16106 ENDIF
16107
16108
16109 IF(MINT(43).GE.2.AND.(ISET(ISUB).EQ.3.OR.ISET(ISUB).EQ.4)) THEN
16110 ATAUP0=LOG(TAUPMX/TAUPMN)
16111 ATAUP1=((1.-TAU/TAUPMX)**4-(1.-TAU/TAUPMN)**4)/(4.*TAU)
16112 H4=COEF(ISUB,15)+
16113 & ATAUP0/ATAUP1*COEF(ISUB,16)/TAUP*(1.-TAU/TAUP)**3
16114 IF(1.-TAU/TAUP.GT.1.E-4) THEN
16115 FZW=(1.+TAU/TAUP)*LOG(TAUP/TAU)-2.*(1.-TAU/TAUP)
16116 ELSE
16117 FZW=1./6.*(1.-TAU/TAUP)**3*TAU/TAUP
16118 ENDIF
16119 COMFAC=COMFAC*ATAUP0*FZW/H4
16120 ENDIF
16121
16122
16123 IF(ISET(ISUB).EQ.5) THEN
16124 COMFAC=PARU(1)*PARU(5)*FACK*0.5*VINT(2)/SH2
16125 ATAU0=LOG(2.*(1.+SQRT(1.-XT2))/XT2-1.)
16126 ATAU1=2.*ATAN(1./XT2-1.)/SQRT(XT2)
16127 H1=COEF(ISUB,1)+(ATAU0/ATAU1)*COEF(ISUB,2)/SQRT(TAU)
16128 COMFAC=COMFAC*ATAU0/H1
16129 AYST0=YSTMAX-YSTMIN
16130 AYST1=0.5*(YSTMAX-YSTMIN)**2
16131 AYST3=2.*(ATAN(EXP(YSTMAX))-ATAN(EXP(YSTMIN)))
16132 H2=(AYST0/AYST1)*COEF(ISUB,7)*(YST-YSTMIN)+(AYST0/AYST1)*
16133 & COEF(ISUB,8)*(YSTMAX-YST)+(AYST0/AYST3)*COEF(ISUB,9)/COSH(YST)
16134 COMFAC=COMFAC*AYST0/H2
16135 IF(MSTP(82).LE.1) COMFAC=COMFAC*XT2**2*(1./VINT(149)-1.)
16136
16137
16138 IF(MSTP(82).GE.2) COMFAC=COMFAC*XT2**2/(VINT(149)*
16139 & (1.+VINT(149)))
16140 ENDIF
16141
16142
16143
16144 145 IF(ISUB.LE.10) THEN
16145 IF(ISUB.EQ.1) THEN
16146
16147 MINT(61)=2
16148 CALL PYWIDT(23,SQRT(SH),WDTP,WDTE)
16149 FACZ=COMFAC*AEM**2*4./3.
16150 DO 150 I=MINA,MAXA
16151 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 150
16152 EI=KCHG(IABS(I),1)/3.
16153 AI=SIGN(1.,EI)
16154 VI=AI-4.*EI*XW
16155 FACF=1.
16156 IF(IABS(I).LE.10) FACF=FACA/3.
16157 NCHN=NCHN+1
16158 ISIG(NCHN,1)=I
16159 ISIG(NCHN,2)=-I
16160 ISIG(NCHN,3)=1
16161 SIGH(NCHN)=FACF*FACZ*(EI**2*VINT(111)+EI*VI/(8.*XW*(1.-XW))*
16162 & SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2)*VINT(112)+(VI**2+AI**2)/
16163 & (16.*XW*(1.-XW))**2*SH2/((SH-SQMZ)**2+GMMZ**2)*VINT(114))
16164 150 CONTINUE
16165
16166 ELSEIF(ISUB.EQ.2) THEN
16167
16168 CALL PYWIDT(24,SQRT(SH),WDTP,WDTE)
16169 FACW=COMFAC*(AEM/XW)**2*1./24*SH2/((SH-SQMW)**2+GMMW**2)
16170 DO 170 I=MIN1,MAX1
16171 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 170
16172 IA=IABS(I)
16173 DO 160 J=MIN2,MAX2
16174 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 160
16175 JA=IABS(J)
16176 IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 160
16177 IF((IA.LE.10.AND.JA.GT.10).OR.(IA.GT.10.AND.JA.LE.10)) GOTO 160
16178 KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
16179 FACF=1.
16180 IF(IA.LE.10) FACF=VCKM((IA+1)/2,(JA+1)/2)*FACA/3.
16181 NCHN=NCHN+1
16182 ISIG(NCHN,1)=I
16183 ISIG(NCHN,2)=J
16184 ISIG(NCHN,3)=1
16185 SIGH(NCHN)=FACF*FACW*(WDTE(0,1)+WDTE(0,(5-KCHW)/2)+WDTE(0,4))
16186 160 CONTINUE
16187 170 CONTINUE
16188
16189 ELSEIF(ISUB.EQ.3) THEN
16190
16191 CALL PYWIDT(25,SQRT(SH),WDTP,WDTE)
16192 FACH=COMFAC*(AEM/XW)**2*1./48.*(SH/SQMW)**2*
16193 & SH2/((SH-SQMH)**2+GMMH**2)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
16194 DO 180 I=MINA,MAXA
16195 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 180
16196 RMQ=PMAS(IABS(I),1)**2/SH
16197 NCHN=NCHN+1
16198 ISIG(NCHN,1)=I
16199 ISIG(NCHN,2)=-I
16200 ISIG(NCHN,3)=1
16201 SIGH(NCHN)=FACH*RMQ*SQRT(MAX(0.,1.-4.*RMQ))
16202 180 CONTINUE
16203
16204 ELSEIF(ISUB.EQ.4) THEN
16205
16206
16207 ELSEIF(ISUB.EQ.5) THEN
16208
16209 CALL PYWIDT(25,SQRT(SH),WDTP,WDTE)
16210 FACH=COMFAC*1./(128.*PARU(1)**2*16.*(1.-XW)**3)*(AEM/XW)**4*
16211 & (SH/SQMW)**2*SH2/((SH-SQMH)**2+GMMH**2)*
16212 & (WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
16213 DO 200 I=MIN1,MAX1
16214 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 200
16215 DO 190 J=MIN2,MAX2
16216 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 190
16217 EI=KCHG(IABS(I),1)/3.
16218 AI=SIGN(1.,EI)
16219 VI=AI-4.*EI*XW
16220 EJ=KCHG(IABS(J),1)/3.
16221 AJ=SIGN(1.,EJ)
16222 VJ=AJ-4.*EJ*XW
16223 NCHN=NCHN+1
16224 ISIG(NCHN,1)=I
16225 ISIG(NCHN,2)=J
16226 ISIG(NCHN,3)=1
16227 SIGH(NCHN)=FACH*(VI**2+AI**2)*(VJ**2+AJ**2)
16228 190 CONTINUE
16229 200 CONTINUE
16230
16231 ELSEIF(ISUB.EQ.6) THEN
16232
16233
16234 ELSEIF(ISUB.EQ.7) THEN
16235
16236
16237 ELSEIF(ISUB.EQ.8) THEN
16238
16239 CALL PYWIDT(25,SQRT(SH),WDTP,WDTE)
16240 FACH=COMFAC*1./(128*PARU(1)**2)*(AEM/XW)**4*(SH/SQMW)**2*
16241 & SH2/((SH-SQMH)**2+GMMH**2)*(WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
16242 DO 220 I=MIN1,MAX1
16243 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 220
16244 EI=SIGN(1.,FLOAT(I))*KCHG(IABS(I),1)
16245 DO 210 J=MIN2,MAX2
16246 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 210
16247 EJ=SIGN(1.,FLOAT(J))*KCHG(IABS(J),1)
16248 IF(EI*EJ.GT.0.) GOTO 210
16249 NCHN=NCHN+1
16250 ISIG(NCHN,1)=I
16251 ISIG(NCHN,2)=J
16252 ISIG(NCHN,3)=1
16253 SIGH(NCHN)=FACH*VINT(180+I)*VINT(180+J)
16254 210 CONTINUE
16255 220 CONTINUE
16256 ENDIF
16257
16258
16259
16260 ELSEIF(ISUB.LE.20) THEN
16261 IF(ISUB.EQ.11) THEN
16262
16263 FACQQ1=COMFAC*AS**2*4./9.*(SH2+UH2)/TH2
16264 FACQQB=COMFAC*AS**2*4./9.*((SH2+UH2)/TH2*FACA-
16265 & MSTP(34)*2./3.*UH2/(SH*TH))
16266 FACQQ2=COMFAC*AS**2*4./9.*((SH2+TH2)/UH2-
16267 & MSTP(34)*2./3.*SH2/(TH*UH))
16268 DO 240 I=MIN1,MAX1
16269 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 240
16270 DO 230 J=MIN2,MAX2
16271 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 230
16272 NCHN=NCHN+1
16273 ISIG(NCHN,1)=I
16274 ISIG(NCHN,2)=J
16275 ISIG(NCHN,3)=1
16276 SIGH(NCHN)=FACQQ1
16277 IF(I.EQ.-J) SIGH(NCHN)=FACQQB
16278 IF(I.EQ.J) THEN
16279 SIGH(NCHN)=0.5*SIGH(NCHN)
16280 NCHN=NCHN+1
16281 ISIG(NCHN,1)=I
16282 ISIG(NCHN,2)=J
16283 ISIG(NCHN,3)=2
16284 SIGH(NCHN)=0.5*FACQQ2
16285 ENDIF
16286 230 CONTINUE
16287 240 CONTINUE
16288
16289 ELSEIF(ISUB.EQ.12) THEN
16290
16291 CALL PYWIDT(21,SQRT(SH),WDTP,WDTE)
16292 FACQQB=COMFAC*AS**2*4./9.*(TH2+UH2)/SH2*(WDTE(0,1)+WDTE(0,2)+
16293 & WDTE(0,3)+WDTE(0,4))
16294 DO 250 I=MINA,MAXA
16295 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 250
16296 NCHN=NCHN+1
16297 ISIG(NCHN,1)=I
16298 ISIG(NCHN,2)=-I
16299 ISIG(NCHN,3)=1
16300 SIGH(NCHN)=FACQQB
16301 250 CONTINUE
16302
16303 ELSEIF(ISUB.EQ.13) THEN
16304
16305 FACGG1=COMFAC*AS**2*32./27.*(UH/TH-(2.+MSTP(34)*1./4.)*UH2/SH2)
16306 FACGG2=COMFAC*AS**2*32./27.*(TH/UH-(2.+MSTP(34)*1./4.)*TH2/SH2)
16307 DO 260 I=MINA,MAXA
16308 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 260
16309 NCHN=NCHN+1
16310 ISIG(NCHN,1)=I
16311 ISIG(NCHN,2)=-I
16312 ISIG(NCHN,3)=1
16313 SIGH(NCHN)=0.5*FACGG1
16314 NCHN=NCHN+1
16315 ISIG(NCHN,1)=I
16316 ISIG(NCHN,2)=-I
16317 ISIG(NCHN,3)=2
16318 SIGH(NCHN)=0.5*FACGG2
16319 260 CONTINUE
16320
16321 ELSEIF(ISUB.EQ.14) THEN
16322
16323 FACGG=COMFAC*AS*AEM*8./9.*(TH2+UH2)/(TH*UH)
16324 DO 270 I=MINA,MAXA
16325 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 270
16326 EI=KCHG(IABS(I),1)/3.
16327 NCHN=NCHN+1
16328 ISIG(NCHN,1)=I
16329 ISIG(NCHN,2)=-I
16330 ISIG(NCHN,3)=1
16331 SIGH(NCHN)=FACGG*EI**2
16332 270 CONTINUE
16333
16334 ELSEIF(ISUB.EQ.15) THEN
16335
16336 FACZG=COMFAC*AS*AEM/(XW*(1.-XW))*1./18.*
16337 & (TH2+UH2+2.*SQM4*SH)/(TH*UH)
16338 FACZG=FACZG*WIDS(23,2)
16339 DO 280 I=MINA,MAXA
16340 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 280
16341 EI=KCHG(IABS(I),1)/3.
16342 AI=SIGN(1.,EI)
16343 VI=AI-4.*EI*XW
16344 NCHN=NCHN+1
16345 ISIG(NCHN,1)=I
16346 ISIG(NCHN,2)=-I
16347 ISIG(NCHN,3)=1
16348 SIGH(NCHN)=FACZG*(VI**2+AI**2)
16349 280 CONTINUE
16350
16351 ELSEIF(ISUB.EQ.16) THEN
16352
16353 FACWG=COMFAC*AS*AEM/XW*2./9.*(TH2+UH2+2.*SQM4*SH)/(TH*UH)
16354 DO 300 I=MIN1,MAX1
16355 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 300
16356 IA=IABS(I)
16357 DO 290 J=MIN2,MAX2
16358 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 290
16359 JA=IABS(J)
16360 IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 290
16361 KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
16362 FCKM=1.
16363 IF(MINT(43).EQ.4) FCKM=VCKM((IA+1)/2,(JA+1)/2)
16364 NCHN=NCHN+1
16365 ISIG(NCHN,1)=I
16366 ISIG(NCHN,2)=J
16367 ISIG(NCHN,3)=1
16368 SIGH(NCHN)=FACWG*FCKM*WIDS(24,(5-KCHW)/2)
16369 290 CONTINUE
16370 300 CONTINUE
16371
16372 ELSEIF(ISUB.EQ.17) THEN
16373
16374
16375 ELSEIF(ISUB.EQ.18) THEN
16376
16377 FACGG=COMFAC*FACA*AEM**2*1./3.*(TH2+UH2)/(TH*UH)
16378 DO 310 I=MINA,MAXA
16379 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 310
16380 EI=KCHG(IABS(I),1)/3.
16381 NCHN=NCHN+1
16382 ISIG(NCHN,1)=I
16383 ISIG(NCHN,2)=-I
16384 ISIG(NCHN,3)=1
16385 SIGH(NCHN)=FACGG*EI**4
16386 310 CONTINUE
16387
16388 ELSEIF(ISUB.EQ.19) THEN
16389
16390 FACGZ=COMFAC*FACA*AEM**2/(XW*(1.-XW))*1./24.*
16391 & (TH2+UH2+2.*SQM4*SH)/(TH*UH)
16392 FACGZ=FACGZ*WIDS(23,2)
16393 DO 320 I=MINA,MAXA
16394 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 320
16395 EI=KCHG(IABS(I),1)/3.
16396 AI=SIGN(1.,EI)
16397 VI=AI-4.*EI*XW
16398 NCHN=NCHN+1
16399 ISIG(NCHN,1)=I
16400 ISIG(NCHN,2)=-I
16401 ISIG(NCHN,3)=1
16402 SIGH(NCHN)=FACGZ*EI**2*(VI**2+AI**2)
16403 320 CONTINUE
16404
16405 ELSEIF(ISUB.EQ.20) THEN
16406
16407 FACGW=COMFAC*FACA*AEM**2/XW*1./6.*
16408 & ((2.*UH-TH)/(3.*(SH-SQM4)))**2*(TH2+UH2+2.*SQM4*SH)/(TH*UH)
16409 DO 340 I=MIN1,MAX1
16410 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 340
16411 IA=IABS(I)
16412 DO 330 J=MIN2,MAX2
16413 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 330
16414 JA=IABS(J)
16415 IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 330
16416 KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
16417 FCKM=1.
16418 IF(MINT(43).EQ.4) FCKM=VCKM((IA+1)/2,(JA+1)/2)
16419 NCHN=NCHN+1
16420 ISIG(NCHN,1)=I
16421 ISIG(NCHN,2)=J
16422 ISIG(NCHN,3)=1
16423 SIGH(NCHN)=FACGW*FCKM*WIDS(24,(5-KCHW)/2)
16424 330 CONTINUE
16425 340 CONTINUE
16426 ENDIF
16427
16428 ELSEIF(ISUB.LE.30) THEN
16429 IF(ISUB.EQ.21) THEN
16430
16431
16432 ELSEIF(ISUB.EQ.22) THEN
16433
16434 FACZZ=COMFAC*FACA*(AEM/(XW*(1.-XW)))**2*1./768.*
16435 & (UH/TH+TH/UH+2.*(SQM3+SQM4)*SH/(TH*UH)-
16436 & SQM3*SQM4*(1./TH2+1./UH2))
16437 FACZZ=FACZZ*WIDS(23,1)
16438 DO 350 I=MINA,MAXA
16439 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 350
16440 EI=KCHG(IABS(I),1)/3.
16441 AI=SIGN(1.,EI)
16442 VI=AI-4.*EI*XW
16443 NCHN=NCHN+1
16444 ISIG(NCHN,1)=I
16445 ISIG(NCHN,2)=-I
16446 ISIG(NCHN,3)=1
16447 SIGH(NCHN)=FACZZ*(VI**4+6.*VI**2*AI**2+AI**4)
16448 350 CONTINUE
16449
16450 ELSEIF(ISUB.EQ.23) THEN
16451
16452 FACZW=COMFAC*FACA*(AEM/XW)**2*1./6.
16453 FACZW=FACZW*WIDS(23,2)
16454 THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2)
16455 DO 370 I=MIN1,MAX1
16456 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 370
16457 IA=IABS(I)
16458 DO 360 J=MIN2,MAX2
16459 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 360
16460 JA=IABS(J)
16461 IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 360
16462 KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
16463 EI=KCHG(IA,1)/3.
16464 AI=SIGN(1.,EI)
16465 VI=AI-4.*EI*XW
16466 EJ=KCHG(JA,1)/3.
16467 AJ=SIGN(1.,EJ)
16468 VJ=AJ-4.*EJ*XW
16469 IF(VI+AI.GT.0) THEN
16470 VISAV=VI
16471 AISAV=AI
16472 VI=VJ
16473 AI=AJ
16474 VJ=VISAV
16475 AJ=AISAV
16476 ENDIF
16477 FCKM=1.
16478 IF(MINT(43).EQ.4) FCKM=VCKM((IA+1)/2,(JA+1)/2)
16479 NCHN=NCHN+1
16480 ISIG(NCHN,1)=I
16481 ISIG(NCHN,2)=J
16482 ISIG(NCHN,3)=1
16483 SIGH(NCHN)=FACZW*FCKM*(1./(SH-SQMW)**2*
16484 & ((9.-8.*XW)/4.*THUH+(8.*XW-6.)/4.*SH*(SQM3+SQM4))+
16485 & (THUH-SH*(SQM3+SQM4))/(2.*(SH-SQMW))*((VJ+AJ)/TH-(VI+AI)/UH)+
16486 & THUH/(16.*(1.-XW))*((VJ+AJ)**2/TH2+(VI+AI)**2/UH2)+
16487 & SH*(SQM3+SQM4)/(8.*(1.-XW))*(VI+AI)*(VJ+AJ)/(TH*UH))*
16488 & WIDS(24,(5-KCHW)/2)
16489 360 CONTINUE
16490 370 CONTINUE
16491
16492 ELSEIF(ISUB.EQ.24) THEN
16493
16494 THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2)
16495 FACHZ=COMFAC*FACA*(AEM/(XW*(1.-XW)))**2*1./96.*
16496 & (THUH+2.*SH*SQMZ)/(SH-SQMZ)**2
16497 FACHZ=FACHZ*WIDS(23,2)*WIDS(25,2)
16498 DO 380 I=MINA,MAXA
16499 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 380
16500 EI=KCHG(IABS(I),1)/3.
16501 AI=SIGN(1.,EI)
16502 VI=AI-4.*EI*XW
16503 NCHN=NCHN+1
16504 ISIG(NCHN,1)=I
16505 ISIG(NCHN,2)=-I
16506 ISIG(NCHN,3)=1
16507 SIGH(NCHN)=FACHZ*(VI**2+AI**2)
16508 380 CONTINUE
16509
16510 ELSEIF(ISUB.EQ.25) THEN
16511
16512 FACWW=COMFAC*FACA*(AEM/XW)**2*1./12.
16513 FACWW=FACWW*WIDS(24,1)
16514 THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2)
16515 DO 390 I=MINA,MAXA
16516 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 390
16517 EI=KCHG(IABS(I),1)/3.
16518 AI=SIGN(1.,EI)
16519 VI=AI-4.*EI*XW
16520 DSIGWW=THUH/SH2*(3.-(SH-3.*(SQM3+SQM4))/(SH-SQMZ)*
16521 & (VI+AI)/(2.*AI*(1.-XW))+(SH/(SH-SQMZ))**2*
16522 & (1.-2.*(SQM3+SQM4)/SH+12.*SQM3*SQM4/SH2)*(VI**2+AI**2)/
16523 & (8.*(1.-XW)**2))-2.*SQMZ/(SH-SQMZ)*(VI+AI)/AI+
16524 & SQMZ*SH/(SH-SQMZ)**2*(1.-2.*(SQM3+SQM4)/SH)*(VI**2+AI**2)/
16525 & (2.*(1.-XW))
16526 IF(KCHG(IABS(I),1).LT.0) THEN
16527 DSIGWW=DSIGWW+2.*(1.+SQMZ/(SH-SQMZ)*(VI+AI)/(2.*AI))*
16528 & (THUH/(SH*TH)-(SQM3+SQM4)/TH)+THUH/TH2
16529 ELSE
16530 DSIGWW=DSIGWW+2.*(1.+SQMZ/(SH-SQMZ)*(VI+AI)/(2.*AI))*
16531 & (THUH/(SH*UH)-(SQM3+SQM4)/UH)+THUH/UH2
16532 ENDIF
16533 NCHN=NCHN+1
16534 ISIG(NCHN,1)=I
16535 ISIG(NCHN,2)=-I
16536 ISIG(NCHN,3)=1
16537 SIGH(NCHN)=FACWW*DSIGWW
16538 390 CONTINUE
16539
16540 ELSEIF(ISUB.EQ.26) THEN
16541
16542 THUH=MAX(TH*UH-SQM3*SQM4,SH*CKIN(3)**2)
16543 FACHW=COMFAC*FACA*(AEM/XW)**2*1./24.*(THUH+2.*SH*SQMW)/
16544 & (SH-SQMW)**2
16545 FACHW=FACHW*WIDS(25,2)
16546 DO 410 I=MIN1,MAX1
16547 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 410
16548 IA=IABS(I)
16549 DO 400 J=MIN2,MAX2
16550 IF(J.EQ.0.OR.KFAC(1,J).EQ.0) GOTO 400
16551 JA=IABS(J)
16552 IF(I*J.GT.0.OR.MOD(IA+JA,2).EQ.0) GOTO 400
16553 KCHW=(KCHG(IA,1)*ISIGN(1,I)+KCHG(JA,1)*ISIGN(1,J))/3
16554 FCKM=1.
16555 IF(MINT(43).EQ.4) FCKM=VCKM((IA+1)/2,(JA+1)/2)
16556 NCHN=NCHN+1
16557 ISIG(NCHN,1)=I
16558 ISIG(NCHN,2)=J
16559 ISIG(NCHN,3)=1
16560 SIGH(NCHN)=FACHW*FCKM*WIDS(24,(5-KCHW)/2)
16561 400 CONTINUE
16562 410 CONTINUE
16563
16564 ELSEIF(ISUB.EQ.27) THEN
16565
16566
16567 ELSEIF(ISUB.EQ.28) THEN
16568
16569 FACQG1=COMFAC*AS**2*4./9.*((2.+MSTP(34)*1./4.)*UH2/TH2-UH/SH)*
16570 & FACA
16571 FACQG2=COMFAC*AS**2*4./9.*((2.+MSTP(34)*1./4.)*SH2/TH2-SH/UH)
16572 DO 430 I=MINA,MAXA
16573 IF(I.EQ.0) GOTO 430
16574 DO 420 ISDE=1,2
16575 IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 420
16576 IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 420
16577 NCHN=NCHN+1
16578 ISIG(NCHN,ISDE)=I
16579 ISIG(NCHN,3-ISDE)=21
16580 ISIG(NCHN,3)=1
16581 SIGH(NCHN)=FACQG1
16582 NCHN=NCHN+1
16583 ISIG(NCHN,ISDE)=I
16584 ISIG(NCHN,3-ISDE)=21
16585 ISIG(NCHN,3)=2
16586 SIGH(NCHN)=FACQG2
16587 420 CONTINUE
16588 430 CONTINUE
16589
16590 ELSEIF(ISUB.EQ.29) THEN
16591
16592 FGQ=COMFAC*FACA*AS*AEM*1./3.*(SH2+UH2)/(-SH*UH)
16593 DO 450 I=MINA,MAXA
16594 IF(I.EQ.0) GOTO 450
16595 EI=KCHG(IABS(I),1)/3.
16596 FACGQ=FGQ*EI**2
16597 DO 440 ISDE=1,2
16598 IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 440
16599 IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 440
16600 NCHN=NCHN+1
16601 ISIG(NCHN,ISDE)=I
16602 ISIG(NCHN,3-ISDE)=21
16603 ISIG(NCHN,3)=1
16604 SIGH(NCHN)=FACGQ
16605 440 CONTINUE
16606 450 CONTINUE
16607
16608 ELSEIF(ISUB.EQ.30) THEN
16609
16610 FZQ=COMFAC*FACA*AS*AEM/(XW*(1.-XW))*1./48.*
16611 & (SH2+UH2+2.*SQM4*TH)/(-SH*UH)
16612 FZQ=FZQ*WIDS(23,2)
16613 DO 470 I=MINA,MAXA
16614 IF(I.EQ.0) GOTO 470
16615 EI=KCHG(IABS(I),1)/3.
16616 AI=SIGN(1.,EI)
16617 VI=AI-4.*EI*XW
16618 FACZQ=FZQ*(VI**2+AI**2)
16619 DO 460 ISDE=1,2
16620 IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 460
16621 IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 460
16622 NCHN=NCHN+1
16623 ISIG(NCHN,ISDE)=I
16624 ISIG(NCHN,3-ISDE)=21
16625 ISIG(NCHN,3)=1
16626 SIGH(NCHN)=FACZQ
16627 460 CONTINUE
16628 470 CONTINUE
16629 ENDIF
16630
16631 ELSEIF(ISUB.LE.40) THEN
16632 IF(ISUB.EQ.31) THEN
16633
16634 FACWQ=COMFAC*FACA*AS*AEM/XW*1./12.*
16635 & (SH2+UH2+2.*SQM4*TH)/(-SH*UH)
16636 DO 490 I=MINA,MAXA
16637 IF(I.EQ.0) GOTO 490
16638 IA=IABS(I)
16639 KCHW=ISIGN(1,KCHG(IA,1)*ISIGN(1,I))
16640 DO 480 ISDE=1,2
16641 IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 480
16642 IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 480
16643 NCHN=NCHN+1
16644 ISIG(NCHN,ISDE)=I
16645 ISIG(NCHN,3-ISDE)=21
16646 ISIG(NCHN,3)=1
16647 SIGH(NCHN)=FACWQ*VINT(180+I)*WIDS(24,(5-KCHW)/2)
16648 480 CONTINUE
16649 490 CONTINUE
16650
16651 ELSEIF(ISUB.EQ.32) THEN
16652
16653
16654 ELSEIF(ISUB.EQ.33) THEN
16655
16656
16657 ELSEIF(ISUB.EQ.34) THEN
16658
16659
16660 ELSEIF(ISUB.EQ.35) THEN
16661
16662
16663 ELSEIF(ISUB.EQ.36) THEN
16664
16665
16666 ELSEIF(ISUB.EQ.37) THEN
16667
16668
16669 ELSEIF(ISUB.EQ.38) THEN
16670
16671
16672 ELSEIF(ISUB.EQ.39) THEN
16673
16674
16675 ELSEIF(ISUB.EQ.40) THEN
16676
16677 ENDIF
16678
16679 ELSEIF(ISUB.LE.50) THEN
16680 IF(ISUB.EQ.41) THEN
16681
16682
16683 ELSEIF(ISUB.EQ.42) THEN
16684
16685
16686 ELSEIF(ISUB.EQ.43) THEN
16687
16688
16689 ELSEIF(ISUB.EQ.44) THEN
16690
16691
16692 ELSEIF(ISUB.EQ.45) THEN
16693
16694
16695 ELSEIF(ISUB.EQ.46) THEN
16696
16697
16698 ELSEIF(ISUB.EQ.47) THEN
16699
16700
16701 ELSEIF(ISUB.EQ.48) THEN
16702
16703
16704 ELSEIF(ISUB.EQ.49) THEN
16705
16706
16707 ELSEIF(ISUB.EQ.50) THEN
16708
16709 ENDIF
16710
16711 ELSEIF(ISUB.LE.60) THEN
16712 IF(ISUB.EQ.51) THEN
16713
16714
16715 ELSEIF(ISUB.EQ.52) THEN
16716
16717
16718 ELSEIF(ISUB.EQ.53) THEN
16719
16720 CALL PYWIDT(21,SQRT(SH),WDTP,WDTE)
16721 FACQQ1=COMFAC*AS**2*1./6.*(UH/TH-(2.+MSTP(34)*1./4.)*UH2/SH2)*
16722 & (WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))*FACA
16723 FACQQ2=COMFAC*AS**2*1./6.*(TH/UH-(2.+MSTP(34)*1./4.)*TH2/SH2)*
16724 & (WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))*FACA
16725 IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 500
16726 NCHN=NCHN+1
16727 ISIG(NCHN,1)=21
16728 ISIG(NCHN,2)=21
16729 ISIG(NCHN,3)=1
16730 SIGH(NCHN)=FACQQ1
16731 NCHN=NCHN+1
16732 ISIG(NCHN,1)=21
16733 ISIG(NCHN,2)=21
16734 ISIG(NCHN,3)=2
16735 SIGH(NCHN)=FACQQ2
16736 500 CONTINUE
16737
16738 ELSEIF(ISUB.EQ.54) THEN
16739
16740
16741 ELSEIF(ISUB.EQ.55) THEN
16742
16743
16744 ELSEIF(ISUB.EQ.56) THEN
16745
16746
16747 ELSEIF(ISUB.EQ.57) THEN
16748
16749
16750 ELSEIF(ISUB.EQ.58) THEN
16751
16752
16753 ELSEIF(ISUB.EQ.59) THEN
16754
16755
16756 ELSEIF(ISUB.EQ.60) THEN
16757
16758 ENDIF
16759
16760 ELSEIF(ISUB.LE.70) THEN
16761 IF(ISUB.EQ.61) THEN
16762
16763
16764 ELSEIF(ISUB.EQ.62) THEN
16765
16766
16767 ELSEIF(ISUB.EQ.63) THEN
16768
16769
16770 ELSEIF(ISUB.EQ.64) THEN
16771
16772
16773 ELSEIF(ISUB.EQ.65) THEN
16774
16775
16776 ELSEIF(ISUB.EQ.66) THEN
16777
16778
16779 ELSEIF(ISUB.EQ.67) THEN
16780
16781
16782 ELSEIF(ISUB.EQ.68) THEN
16783
16784 FACGG1=COMFAC*AS**2*9./4.*(SH2/TH2+2.*SH/TH+3.+2.*TH/SH+
16785 & TH2/SH2)*FACA
16786 FACGG2=COMFAC*AS**2*9./4.*(UH2/SH2+2.*UH/SH+3.+2.*SH/UH+
16787 & SH2/UH2)*FACA
16788 FACGG3=COMFAC*AS**2*9./4.*(TH2/UH2+2.*TH/UH+3+2.*UH/TH+UH2/TH2)
16789 IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 510
16790 NCHN=NCHN+1
16791 ISIG(NCHN,1)=21
16792 ISIG(NCHN,2)=21
16793 ISIG(NCHN,3)=1
16794 SIGH(NCHN)=0.5*FACGG1
16795 NCHN=NCHN+1
16796 ISIG(NCHN,1)=21
16797 ISIG(NCHN,2)=21
16798 ISIG(NCHN,3)=2
16799 SIGH(NCHN)=0.5*FACGG2
16800 NCHN=NCHN+1
16801 ISIG(NCHN,1)=21
16802 ISIG(NCHN,2)=21
16803 ISIG(NCHN,3)=3
16804 SIGH(NCHN)=0.5*FACGG3
16805 510 CONTINUE
16806
16807 ELSEIF(ISUB.EQ.69) THEN
16808
16809
16810 ELSEIF(ISUB.EQ.70) THEN
16811
16812 ENDIF
16813
16814 ELSEIF(ISUB.LE.80) THEN
16815 IF(ISUB.EQ.71) THEN
16816
16817 BE2=1.-4.*SQMZ/SH
16818 TH=-0.5*SH*BE2*(1.-CTH)
16819 UH=-0.5*SH*BE2*(1.+CTH)
16820 SHANG=1./(1.-XW)*SQMW/SQMZ*(1.+BE2)**2
16821 ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG
16822 ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG
16823 THANG=1./(1.-XW)*SQMW/SQMZ*(BE2-CTH)**2
16824 ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG
16825 ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG
16826 UHANG=1./(1.-XW)*SQMW/SQMZ*(BE2+CTH)**2
16827 AUHRE=(UH-SQMH)/((UH-SQMH)**2+GMMH**2)*UHANG
16828 AUHIM=-GMMH/((UH-SQMH)**2+GMMH**2)*UHANG
16829 FACH=0.5*COMFAC*1./(4096.*PARU(1)**2*16.*(1.-XW)**2)*
16830 & (AEM/XW)**4*(SH/SQMW)**2*((ASHRE+ATHRE+AUHRE)**2+
16831 & (ASHIM+ATHIM+AUHIM)**2)*SQMZ/SQMW
16832 DO 530 I=MIN1,MAX1
16833 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 530
16834 EI=KCHG(IABS(I),1)/3.
16835 AI=SIGN(1.,EI)
16836 VI=AI-4.*EI*XW
16837 AVI=AI**2+VI**2
16838 DO 520 J=MIN2,MAX2
16839 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 520
16840 EJ=KCHG(IABS(J),1)/3.
16841 AJ=SIGN(1.,EJ)
16842 VJ=AJ-4.*EJ*XW
16843 AVJ=AJ**2+VJ**2
16844 NCHN=NCHN+1
16845 ISIG(NCHN,1)=I
16846 ISIG(NCHN,2)=J
16847 ISIG(NCHN,3)=1
16848 SIGH(NCHN)=FACH*AVI*AVJ
16849 520 CONTINUE
16850 530 CONTINUE
16851
16852 ELSEIF(ISUB.EQ.72) THEN
16853
16854 BE2=SQRT((1.-4.*SQMW/SH)*(1.-4.*SQMZ/SH))
16855 CTH2=CTH**2
16856 TH=-0.5*SH*(1.-2.*(SQMW+SQMZ)/SH-BE2*CTH)
16857 UH=-0.5*SH*(1.-2.*(SQMW+SQMZ)/SH+BE2*CTH)
16858 SHANG=4.*SQRT(SQMW/(SQMZ*(1.-XW)))*(1.-2.*SQMW/SH)*
16859 & (1.-2.*SQMZ/SH)
16860 ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG
16861 ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG
16862 ATWRE=(1.-XW)/SQMZ*SH/(TH-SQMW)*((CTH-BE2)**2*(3./2.+BE2/2.*CTH-
16863 & (SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4.*((SQMW+SQMZ)/SH*
16864 & (1.-3.*CTH2)+8.*SQMW*SQMZ/SH2*(2.*CTH2-1.)+
16865 & 4.*(SQMW**2+SQMZ**2)/SH2*CTH2+2.*(SQMW+SQMZ)/SH*BE2*CTH))
16866 ATWIM=0.
16867 AUWRE=(1.-XW)/SQMZ*SH/(UH-SQMW)*((CTH+BE2)**2*(3./2.-BE2/2.*CTH-
16868 & (SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4.*((SQMW+SQMZ)/SH*
16869 & (1.-3.*CTH2)+8.*SQMW*SQMZ/SH2*(2.*CTH2-1.)+
16870 & 4.*(SQMW**2+SQMZ**2)/SH2*CTH2-2.*(SQMW+SQMZ)/SH*BE2*CTH))
16871 AUWIM=0.
16872 A4RE=2.*(1.-XW)/SQMZ*(3.-CTH2-4.*(SQMW+SQMZ)/SH)
16873 A4IM=0.
16874 FACH=COMFAC*1./(4096.*PARU(1)**2*16.*(1.-XW)**2)*(AEM/XW)**4*
16875 & (SH/SQMW)**2*((ASHRE+ATWRE+AUWRE+A4RE)**2+
16876 & (ASHIM+ATWIM+AUWIM+A4IM)**2)*SQMZ/SQMW
16877 DO 550 I=MIN1,MAX1
16878 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 550
16879 EI=KCHG(IABS(I),1)/3.
16880 AI=SIGN(1.,EI)
16881 VI=AI-4.*EI*XW
16882 AVI=AI**2+VI**2
16883 DO 540 J=MIN2,MAX2
16884 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 540
16885 EJ=KCHG(IABS(J),1)/3.
16886 AJ=SIGN(1.,EJ)
16887 VJ=AJ-4.*EJ*XW
16888 AVJ=AJ**2+VJ**2
16889 NCHN=NCHN+1
16890 ISIG(NCHN,1)=I
16891 ISIG(NCHN,2)=J
16892 ISIG(NCHN,3)=1
16893 SIGH(NCHN)=FACH*AVI*AVJ
16894 540 CONTINUE
16895 550 CONTINUE
16896
16897 ELSEIF(ISUB.EQ.73) THEN
16898
16899 BE2=1.-2.*(SQMZ+SQMW)/SH+((SQMZ-SQMW)/SH)**2
16900 EP1=1.+(SQMZ-SQMW)/SH
16901 EP2=1.-(SQMZ-SQMW)/SH
16902 TH=-0.5*SH*BE2*(1.-CTH)
16903 UH=(SQMZ-SQMW)**2/SH-0.5*SH*BE2*(1.+CTH)
16904 THANG=SQRT(SQMW/(SQMZ*(1.-XW)))*(BE2-EP1*CTH)*(BE2-EP2*CTH)
16905 ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG
16906 ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG
16907 ASWRE=(1.-XW)/SQMZ*SH/(SH-SQMW)*(-BE2*(EP1+EP2)**4*CTH+
16908 & 1./4.*(BE2+EP1*EP2)**2*((EP1-EP2)**2-4.*BE2*CTH)+
16909 & 2.*BE2*(BE2+EP1*EP2)*(EP1+EP2)**2*CTH-
16910 & 1./16.*SH/SQMW*(EP1**2-EP2**2)**2*(BE2+EP1*EP2)**2)
16911 ASWIM=0.
16912 AUWRE=(1.-XW)/SQMZ*SH/(UH-SQMW)*(-BE2*(EP2+EP1*CTH)*
16913 & (EP1+EP2*CTH)*(BE2+EP1*EP2)+BE2*(EP2+EP1*CTH)*
16914 & (BE2+EP1*EP2*CTH)*(2.*EP2-EP2*CTH+EP1)-BE2*(EP2+EP1*CTH)**2*
16915 & (BE2-EP2**2*CTH)-1./8.*(BE2+EP1*EP2*CTH)**2*((EP1+EP2)**2+
16916 & 2.*BE2*(1.-CTH))+1./32.*SH/SQMW*(BE2+EP1*EP2*CTH)**2*
16917 & (EP1**2-EP2**2)**2-BE2*(EP1+EP2*CTH)*(EP2+EP1*CTH)*
16918 & (BE2+EP1*EP2)+BE2*(EP1+EP2*CTH)*(BE2+EP1*EP2*CTH)*
16919 & (2.*EP1-EP1*CTH+EP2)-BE2*(EP1+EP2*CTH)**2*(BE2-EP1**2*CTH)-
16920 & 1./8.*(BE2+EP1*EP2*CTH)**2*((EP1+EP2)**2+2.*BE2*(1.-CTH))+
16921 & 1./32.*SH/SQMW*(BE2+EP1*EP2*CTH)**2*(EP1**2-EP2**2)**2)
16922 AUWIM=0.
16923 A4RE=(1.-XW)/SQMZ*(EP1**2*EP2**2*(CTH**2-1.)-
16924 & 2.*BE2*(EP1**2+EP2**2+EP1*EP2)*CTH-2.*BE2*EP1*EP2)
16925 A4IM=0.
16926 FACH=COMFAC*1./(4096.*PARU(1)**2*4.*(1.-XW))*(AEM/XW)**4*
16927 & (SH/SQMW)**2*((ATHRE+ASWRE+AUWRE+A4RE)**2+
16928 & (ATHIM+ASWIM+AUWIM+A4IM)**2)*SQRT(SQMZ/SQMW)
16929 DO 570 I=MIN1,MAX1
16930 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 570
16931 EI=KCHG(IABS(I),1)/3.
16932 AI=SIGN(1.,EI)
16933 VI=AI-4.*EI*XW
16934 AVI=AI**2+VI**2
16935 DO 560 J=MIN2,MAX2
16936 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 560
16937 EJ=KCHG(IABS(J),1)/3.
16938 AJ=SIGN(1.,EJ)
16939 VJ=AI-4.*EJ*XW
16940 AVJ=AJ**2+VJ**2
16941 NCHN=NCHN+1
16942 ISIG(NCHN,1)=I
16943 ISIG(NCHN,2)=J
16944 ISIG(NCHN,3)=1
16945 SIGH(NCHN)=FACH*(AVI*VINT(180+J)+VINT(180+I)*AVJ)
16946 560 CONTINUE
16947 570 CONTINUE
16948
16949 ELSEIF(ISUB.EQ.75) THEN
16950
16951
16952 ELSEIF(ISUB.EQ.76) THEN
16953
16954 BE2=SQRT((1.-4.*SQMW/SH)*(1.-4.*SQMZ/SH))
16955 CTH2=CTH**2
16956 TH=-0.5*SH*(1.-2.*(SQMW+SQMZ)/SH-BE2*CTH)
16957 UH=-0.5*SH*(1.-2.*(SQMW+SQMZ)/SH+BE2*CTH)
16958 SHANG=4.*SQRT(SQMW/(SQMZ*(1.-XW)))*(1.-2.*SQMW/SH)*
16959 & (1.-2.*SQMZ/SH)
16960 ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG
16961 ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG
16962 ATWRE=(1.-XW)/SQMZ*SH/(TH-SQMW)*((CTH-BE2)**2*(3./2.+BE2/2.*CTH-
16963 & (SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4.*((SQMW+SQMZ)/SH*
16964 & (1.-3.*CTH2)+8.*SQMW*SQMZ/SH2*(2.*CTH2-1.)+
16965 & 4.*(SQMW**2+SQMZ**2)/SH2*CTH2+2.*(SQMW+SQMZ)/SH*BE2*CTH))
16966 ATWIM=0.
16967 AUWRE=(1.-XW)/SQMZ*SH/(UH-SQMW)*((CTH+BE2)**2*(3./2.-BE2/2.*CTH-
16968 & (SQMW+SQMZ)/SH+(SQMW-SQMZ)**2/(SH*SQMW))+4.*((SQMW+SQMZ)/SH*
16969 & (1.-3.*CTH2)+8.*SQMW*SQMZ/SH2*(2.*CTH2-1.)+
16970 & 4.*(SQMW**2+SQMZ**2)/SH2*CTH2-2.*(SQMW+SQMZ)/SH*BE2*CTH))
16971 AUWIM=0.
16972 A4RE=2.*(1.-XW)/SQMZ*(3.-CTH2-4.*(SQMW+SQMZ)/SH)
16973 A4IM=0.
16974 FACH=0.5*COMFAC*1./(4096.*PARU(1)**2)*(AEM/XW)**4*(SH/SQMW)**2*
16975 & ((ASHRE+ATWRE+AUWRE+A4RE)**2+(ASHIM+ATWIM+AUWIM+A4IM)**2)
16976 DO 590 I=MIN1,MAX1
16977 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 590
16978 EI=SIGN(1.,FLOAT(I))*KCHG(IABS(I),1)
16979 DO 580 J=MIN2,MAX2
16980 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 580
16981 EJ=SIGN(1.,FLOAT(J))*KCHG(IABS(J),1)
16982 IF(EI*EJ.GT.0.) GOTO 580
16983 NCHN=NCHN+1
16984 ISIG(NCHN,1)=I
16985 ISIG(NCHN,2)=J
16986 ISIG(NCHN,3)=1
16987 SIGH(NCHN)=FACH*VINT(180+I)*VINT(180+J)
16988 580 CONTINUE
16989 590 CONTINUE
16990
16991 ELSEIF(ISUB.EQ.77) THEN
16992
16993 BE2=1.-4.*SQMW/SH
16994 BE4=BE2**2
16995 CTH2=CTH**2
16996 CTH3=CTH**3
16997 TH=-0.5*SH*BE2*(1.-CTH)
16998 UH=-0.5*SH*BE2*(1.+CTH)
16999 SHANG=(1.+BE2)**2
17000 ASHRE=(SH-SQMH)/((SH-SQMH)**2+GMMH**2)*SHANG
17001 ASHIM=-GMMH/((SH-SQMH)**2+GMMH**2)*SHANG
17002 THANG=(BE2-CTH)**2
17003 ATHRE=(TH-SQMH)/((TH-SQMH)**2+GMMH**2)*THANG
17004 ATHIM=-GMMH/((TH-SQMH)**2+GMMH**2)*THANG
17005 SGZANG=1./SQMW*BE2*(3.-BE2)**2*CTH
17006 ASGRE=XW*SGZANG
17007 ASGIM=0.
17008 ASZRE=(1.-XW)*SH/(SH-SQMZ)*SGZANG
17009 ASZIM=0.
17010 TGZANG=1./SQMW*(BE2*(4.-2.*BE2+BE4)+BE2*(4.-10.*BE2+BE4)*CTH+
17011 & (2.-11.*BE2+10.*BE4)*CTH2+BE2*CTH3)
17012 ATGRE=0.5*XW*SH/TH*TGZANG
17013 ATGIM=0.
17014 ATZRE=0.5*(1.-XW)*SH/(TH-SQMZ)*TGZANG
17015 ATZIM=0.
17016 A4RE=1./SQMW*(1.+2.*BE2-6.*BE2*CTH-CTH2)
17017 A4IM=0.
17018 FACH=COMFAC*1./(4096.*PARU(1)**2)*(AEM/XW)**4*(SH/SQMW)**2*
17019 & ((ASHRE+ATHRE+ASGRE+ASZRE+ATGRE+ATZRE+A4RE)**2+
17020 & (ASHIM+ATHIM+ASGIM+ASZIM+ATGIM+ATZIM+A4IM)**2)
17021 DO 610 I=MIN1,MAX1
17022 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 610
17023 EI=SIGN(1.,FLOAT(I))*KCHG(IABS(I),1)
17024 DO 600 J=MIN2,MAX2
17025 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 600
17026 EJ=SIGN(1.,FLOAT(J))*KCHG(IABS(J),1)
17027 IF(EI*EJ.GT.0.) GOTO 600
17028 NCHN=NCHN+1
17029 ISIG(NCHN,1)=I
17030 ISIG(NCHN,2)=J
17031 ISIG(NCHN,3)=1
17032 SIGH(NCHN)=FACH*VINT(180+I)*VINT(180+J)
17033 600 CONTINUE
17034 610 CONTINUE
17035
17036 ELSEIF(ISUB.EQ.78) THEN
17037
17038
17039 ELSEIF(ISUB.EQ.79) THEN
17040
17041
17042 ENDIF
17043
17044
17045
17046 ELSEIF(ISUB.LE.90) THEN
17047 IF(ISUB.EQ.81) THEN
17048
17049 FACQQB=COMFAC*AS**2*4./9.*(((TH-SQM3)**2+
17050 & (UH-SQM3)**2)/SH2+2.*SQM3/SH)
17051 IF(MSTP(35).GE.1) THEN
17052 IF(MSTP(35).EQ.1) THEN
17053 ALSSG=PARP(35)
17054 ELSE
17055 MST115=MSTU(115)
17056 MSTU(115)=MSTP(36)
17057 Q2BN=SQRT(SQM3*((SQRT(SH)-2.*SQRT(SQM3))**2+PARP(36)**2))
17058 ALSSG=ULALPS(Q2BN)
17059 MSTU(115)=MST115
17060 ENDIF
17061 XREPU=PARU(1)*ALSSG/(6.*SQRT(MAX(1E-20,1.-4.*SQM3/SH)))
17062 FREPU=XREPU/(EXP(MIN(100.,XREPU))-1.)
17063 PARI(81)=FREPU
17064 FACQQB=FACQQB*FREPU
17065 ENDIF
17066 DO 620 I=MINA,MAXA
17067 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 620
17068 NCHN=NCHN+1
17069 ISIG(NCHN,1)=I
17070 ISIG(NCHN,2)=-I
17071 ISIG(NCHN,3)=1
17072 SIGH(NCHN)=FACQQB
17073 620 CONTINUE
17074
17075 ELSEIF(ISUB.EQ.82) THEN
17076
17077 FACQQ1=COMFAC*FACA*AS**2*1./6.*((UH-SQM3)/(TH-SQM3)-
17078 & 2.*(UH-SQM3)**2/SH2+4.*SQM3/SH*(TH*UH-SQM3**2)/(TH-SQM3)**2)
17079 FACQQ2=COMFAC*FACA*AS**2*1./6.*((TH-SQM3)/(UH-SQM3)-
17080 & 2.*(TH-SQM3)**2/SH2+4.*SQM3/SH*(TH*UH-SQM3**2)/(UH-SQM3)**2)
17081 IF(MSTP(35).GE.1) THEN
17082 IF(MSTP(35).EQ.1) THEN
17083 ALSSG=PARP(35)
17084 ELSE
17085 MST115=MSTU(115)
17086 MSTU(115)=MSTP(36)
17087 Q2BN=SQRT(SQM3*((SQRT(SH)-2.*SQRT(SQM3))**2+PARP(36)**2))
17088 ALSSG=ULALPS(Q2BN)
17089 MSTU(115)=MST115
17090 ENDIF
17091 XATTR=4.*PARU(1)*ALSSG/(3.*SQRT(MAX(1E-20,1.-4.*SQM3/SH)))
17092 FATTR=XATTR/(1.-EXP(-MIN(100.,XATTR)))
17093 XREPU=PARU(1)*ALSSG/(6.*SQRT(MAX(1E-20,1.-4.*SQM3/SH)))
17094 FREPU=XREPU/(EXP(MIN(100.,XREPU))-1.)
17095 FATRE=(2.*FATTR+5.*FREPU)/7.
17096 PARI(81)=FATRE
17097 FACQQ1=FACQQ1*FATRE
17098 FACQQ2=FACQQ2*FATRE
17099 ENDIF
17100 IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 630
17101 NCHN=NCHN+1
17102 ISIG(NCHN,1)=21
17103 ISIG(NCHN,2)=21
17104 ISIG(NCHN,3)=1
17105 SIGH(NCHN)=FACQQ1
17106 NCHN=NCHN+1
17107 ISIG(NCHN,1)=21
17108 ISIG(NCHN,2)=21
17109 ISIG(NCHN,3)=2
17110 SIGH(NCHN)=FACQQ2
17111 630 CONTINUE
17112
17113 ENDIF
17114
17115
17116
17117 ELSEIF(ISUB.LE.100) THEN
17118 IF(ISUB.EQ.91) THEN
17119
17120 SIGS=XSEC(ISUB,1)
17121
17122 ELSEIF(ISUB.EQ.92) THEN
17123
17124 SIGS=XSEC(ISUB,1)
17125
17126 ELSEIF(ISUB.EQ.93) THEN
17127
17128 SIGS=XSEC(ISUB,1)
17129
17130 ELSEIF(ISUB.EQ.94) THEN
17131
17132 SIGS=XSEC(ISUB,1)
17133
17134 ELSEIF(ISUB.EQ.95) THEN
17135
17136 SIGS=XSEC(ISUB,1)
17137
17138 ELSEIF(ISUB.EQ.96) THEN
17139
17140 CALL PYWIDT(21,SQRT(SH),WDTP,WDTE)
17141
17142
17143 FACQQ1=COMFAC*AS**2*4./9.*(SH2+UH2)/TH2
17144 FACQQB=COMFAC*AS**2*4./9.*((SH2+UH2)/TH2*FACA-
17145 & MSTP(34)*2./3.*UH2/(SH*TH))
17146 FACQQ2=COMFAC*AS**2*4./9.*((SH2+TH2)/UH2-
17147 & MSTP(34)*2./3.*SH2/(TH*UH))
17148 DO 650 I=-3,3
17149 IF(I.EQ.0) GOTO 650
17150 DO 640 J=-3,3
17151 IF(J.EQ.0) GOTO 640
17152 NCHN=NCHN+1
17153 ISIG(NCHN,1)=I
17154 ISIG(NCHN,2)=J
17155 ISIG(NCHN,3)=111
17156 SIGH(NCHN)=FACQQ1
17157 IF(I.EQ.-J) SIGH(NCHN)=FACQQB
17158 IF(I.EQ.J) THEN
17159 SIGH(NCHN)=0.5*SIGH(NCHN)
17160 NCHN=NCHN+1
17161 ISIG(NCHN,1)=I
17162 ISIG(NCHN,2)=J
17163 ISIG(NCHN,3)=112
17164 SIGH(NCHN)=0.5*FACQQ2
17165 ENDIF
17166 640 CONTINUE
17167 650 CONTINUE
17168
17169
17170 FACQQB=COMFAC*AS**2*4./9.*(TH2+UH2)/SH2*(WDTE(0,1)+WDTE(0,2)+
17171 & WDTE(0,3)+WDTE(0,4))
17172 FACGG1=COMFAC*AS**2*32./27.*(UH/TH-(2.+MSTP(34)*1./4.)*UH2/SH2)
17173 FACGG2=COMFAC*AS**2*32./27.*(TH/UH-(2.+MSTP(34)*1./4.)*TH2/SH2)
17174 DO 660 I=-3,3
17175 IF(I.EQ.0) GOTO 660
17176 NCHN=NCHN+1
17177 ISIG(NCHN,1)=I
17178 ISIG(NCHN,2)=-I
17179 ISIG(NCHN,3)=121
17180 SIGH(NCHN)=FACQQB
17181 NCHN=NCHN+1
17182 ISIG(NCHN,1)=I
17183 ISIG(NCHN,2)=-I
17184 ISIG(NCHN,3)=131
17185 SIGH(NCHN)=0.5*FACGG1
17186 NCHN=NCHN+1
17187 ISIG(NCHN,1)=I
17188 ISIG(NCHN,2)=-I
17189 ISIG(NCHN,3)=132
17190 SIGH(NCHN)=0.5*FACGG2
17191 660 CONTINUE
17192
17193
17194 FACQG1=COMFAC*AS**2*4./9.*((2.+MSTP(34)*1./4.)*UH2/TH2-UH/SH)*
17195 & FACA
17196 FACQG2=COMFAC*AS**2*4./9.*((2.+MSTP(34)*1./4.)*SH2/TH2-SH/UH)
17197 DO 680 I=-3,3
17198 IF(I.EQ.0) GOTO 680
17199 DO 670 ISDE=1,2
17200 NCHN=NCHN+1
17201 ISIG(NCHN,ISDE)=I
17202 ISIG(NCHN,3-ISDE)=21
17203 ISIG(NCHN,3)=281
17204 SIGH(NCHN)=FACQG1
17205 NCHN=NCHN+1
17206 ISIG(NCHN,ISDE)=I
17207 ISIG(NCHN,3-ISDE)=21
17208 ISIG(NCHN,3)=282
17209 SIGH(NCHN)=FACQG2
17210 670 CONTINUE
17211 680 CONTINUE
17212
17213
17214 FACQQ1=COMFAC*AS**2*1./6.*(UH/TH-(2.+MSTP(34)*1./4.)*UH2/SH2)*
17215 & (WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))*FACA
17216 FACQQ2=COMFAC*AS**2*1./6.*(TH/UH-(2.+MSTP(34)*1./4.)*TH2/SH2)*
17217 & (WDTE(0,1)+WDTE(0,2)+WDTE(0,3)+WDTE(0,4))*FACA
17218 FACGG1=COMFAC*AS**2*9./4.*(SH2/TH2+2.*SH/TH+3.+2.*TH/SH+
17219 & TH2/SH2)*FACA
17220 FACGG2=COMFAC*AS**2*9./4.*(UH2/SH2+2.*UH/SH+3.+2.*SH/UH+
17221 & SH2/UH2)*FACA
17222 FACGG3=COMFAC*AS**2*9./4.*(TH2/UH2+2.*TH/UH+3+2.*UH/TH+UH2/TH2)
17223 NCHN=NCHN+1
17224 ISIG(NCHN,1)=21
17225 ISIG(NCHN,2)=21
17226 ISIG(NCHN,3)=531
17227 SIGH(NCHN)=FACQQ1
17228 NCHN=NCHN+1
17229 ISIG(NCHN,1)=21
17230 ISIG(NCHN,2)=21
17231 ISIG(NCHN,3)=532
17232 SIGH(NCHN)=FACQQ2
17233 NCHN=NCHN+1
17234 ISIG(NCHN,1)=21
17235 ISIG(NCHN,2)=21
17236 ISIG(NCHN,3)=681
17237 SIGH(NCHN)=0.5*FACGG1
17238 NCHN=NCHN+1
17239 ISIG(NCHN,1)=21
17240 ISIG(NCHN,2)=21
17241 ISIG(NCHN,3)=682
17242 SIGH(NCHN)=0.5*FACGG2
17243 NCHN=NCHN+1
17244 ISIG(NCHN,1)=21
17245 ISIG(NCHN,2)=21
17246 ISIG(NCHN,3)=683
17247 SIGH(NCHN)=0.5*FACGG3
17248 ENDIF
17249
17250
17251
17252 ELSEIF(ISUB.LE.110) THEN
17253 IF(ISUB.EQ.101) THEN
17254
17255
17256 ELSEIF(ISUB.EQ.102) THEN
17257
17258 CALL PYWIDT(25,SQRT(SH),WDTP,WDTE)
17259 ETARE=0.
17260 ETAIM=0.
17261 DO 690 I=1,2*MSTP(1)
17262 EPS=4.*PMAS(I,1)**2/SH
17263 IF(EPS.LE.1.) THEN
17264 IF(EPS.GT.1.E-4) THEN
17265 ROOT=SQRT(1.-EPS)
17266 RLN=LOG((1.+ROOT)/(1.-ROOT))
17267 ELSE
17268 RLN=LOG(4./EPS-2.)
17269 ENDIF
17270 PHIRE=0.25*(RLN**2-PARU(1)**2)
17271 PHIIM=0.5*PARU(1)*RLN
17272 ELSE
17273 PHIRE=-(ASIN(1./SQRT(EPS)))**2
17274 PHIIM=0.
17275 ENDIF
17276 ETARE=ETARE+0.5*EPS*(1.+(EPS-1.)*PHIRE)
17277 ETAIM=ETAIM+0.5*EPS*(EPS-1.)*PHIIM
17278 690 CONTINUE
17279 ETA2=ETARE**2+ETAIM**2
17280 FACH=COMFAC*FACA*(AS/PARU(1)*AEM/XW)**2*1./512.*
17281 & (SH/SQMW)**2*ETA2*SH2/((SH-SQMH)**2+GMMH**2)*
17282 & (WDTE(0,1)+WDTE(0,2)+WDTE(0,4))
17283 IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 700
17284 NCHN=NCHN+1
17285 ISIG(NCHN,1)=21
17286 ISIG(NCHN,2)=21
17287 ISIG(NCHN,3)=1
17288 SIGH(NCHN)=FACH
17289 700 CONTINUE
17290
17291 ENDIF
17292
17293
17294
17295 ELSEIF(ISUB.LE.120) THEN
17296 IF(ISUB.EQ.111) THEN
17297
17298 A5STUR=0.
17299 A5STUI=0.
17300 DO 710 I=1,2*MSTP(1)
17301 SQMQ=PMAS(I,1)**2
17302 EPSS=4.*SQMQ/SH
17303 EPSH=4.*SQMQ/SQMH
17304 A5STUR=A5STUR+SQMQ/SQMH*(4.+4.*SH/(TH+UH)*(PYW1AU(EPSS,1)-
17305 & PYW1AU(EPSH,1))+(1.-4.*SQMQ/(TH+UH))*(PYW2AU(EPSS,1)-
17306 & PYW2AU(EPSH,1)))
17307 A5STUI=A5STUI+SQMQ/SQMH*(4.*SH/(TH+UH)*(PYW1AU(EPSS,2)-
17308 & PYW1AU(EPSH,2))+(1.-4.*SQMQ/(TH+UH))*(PYW2AU(EPSS,2)-
17309 & PYW2AU(EPSH,2)))
17310 710 CONTINUE
17311 FACGH=COMFAC*FACA/(144.*PARU(1)**2)*AEM/XW*AS**3*SQMH/SQMW*
17312 & SQMH/SH*(UH**2+TH**2)/(UH+TH)**2*(A5STUR**2+A5STUI**2)
17313 FACGH=FACGH*WIDS(25,2)
17314 DO 720 I=MINA,MAXA
17315 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 720
17316 NCHN=NCHN+1
17317 ISIG(NCHN,1)=I
17318 ISIG(NCHN,2)=-I
17319 ISIG(NCHN,3)=1
17320 SIGH(NCHN)=FACGH
17321 720 CONTINUE
17322
17323 ELSEIF(ISUB.EQ.112) THEN
17324
17325 A5TSUR=0.
17326 A5TSUI=0.
17327 DO 730 I=1,2*MSTP(1)
17328 SQMQ=PMAS(I,1)**2
17329 EPST=4.*SQMQ/TH
17330 EPSH=4.*SQMQ/SQMH
17331 A5TSUR=A5TSUR+SQMQ/SQMH*(4.+4.*TH/(SH+UH)*(PYW1AU(EPST,1)-
17332 & PYW1AU(EPSH,1))+(1.-4.*SQMQ/(SH+UH))*(PYW2AU(EPST,1)-
17333 & PYW2AU(EPSH,1)))
17334 A5TSUI=A5TSUI+SQMQ/SQMH*(4.*TH/(SH+UH)*(PYW1AU(EPST,2)-
17335 & PYW1AU(EPSH,2))+(1.-4.*SQMQ/(SH+UH))*(PYW2AU(EPST,2)-
17336 & PYW2AU(EPSH,2)))
17337 730 CONTINUE
17338 FACQH=COMFAC*FACA/(384.*PARU(1)**2)*AEM/XW*AS**3*SQMH/SQMW*
17339 & SQMH/(-TH)*(UH**2+SH**2)/(UH+SH)**2*(A5TSUR**2+A5TSUI**2)
17340 FACQH=FACQH*WIDS(25,2)
17341 DO 750 I=MINA,MAXA
17342 IF(I.EQ.0) GOTO 750
17343 DO 740 ISDE=1,2
17344 IF(ISDE.EQ.1.AND.KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 740
17345 IF(ISDE.EQ.2.AND.KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 740
17346 NCHN=NCHN+1
17347 ISIG(NCHN,ISDE)=I
17348 ISIG(NCHN,3-ISDE)=21
17349 ISIG(NCHN,3)=1
17350 SIGH(NCHN)=FACQH
17351 740 CONTINUE
17352 750 CONTINUE
17353
17354 ELSEIF(ISUB.EQ.113) THEN
17355
17356 A2STUR=0.
17357 A2STUI=0.
17358 A2USTR=0.
17359 A2USTI=0.
17360 A2TUSR=0.
17361 A2TUSI=0.
17362 A4STUR=0.
17363 A4STUI=0.
17364 DO 760 I=6,2*MSTP(1)
17365
17366 SQMQ=PMAS(I,1)**2
17367 EPSS=4.*SQMQ/SH
17368 EPST=4.*SQMQ/TH
17369 EPSU=4.*SQMQ/UH
17370 EPSH=4.*SQMQ/SQMH
17371 IF(EPSH.LT.1.E-6) GOTO 760
17372 BESTU=0.5*(1.+SQRT(1.+EPSS*TH/UH))
17373 BEUST=0.5*(1.+SQRT(1.+EPSU*SH/TH))
17374 BETUS=0.5*(1.+SQRT(1.+EPST*UH/SH))
17375 BEUTS=BESTU
17376 BETSU=BEUST
17377 BESUT=BETUS
17378 W3STUR=PYI3AU(BESTU,EPSH,1)-PYI3AU(BESTU,EPSS,1)-
17379 & PYI3AU(BESTU,EPSU,1)
17380 W3STUI=PYI3AU(BESTU,EPSH,2)-PYI3AU(BESTU,EPSS,2)-
17381 & PYI3AU(BESTU,EPSU,2)
17382 W3SUTR=PYI3AU(BESUT,EPSH,1)-PYI3AU(BESUT,EPSS,1)-
17383 & PYI3AU(BESUT,EPST,1)
17384 W3SUTI=PYI3AU(BESUT,EPSH,2)-PYI3AU(BESUT,EPSS,2)-
17385 & PYI3AU(BESUT,EPST,2)
17386 W3TSUR=PYI3AU(BETSU,EPSH,1)-PYI3AU(BETSU,EPST,1)-
17387 & PYI3AU(BETSU,EPSU,1)
17388 W3TSUI=PYI3AU(BETSU,EPSH,2)-PYI3AU(BETSU,EPST,2)-
17389 & PYI3AU(BETSU,EPSU,2)
17390 W3TUSR=PYI3AU(BETUS,EPSH,1)-PYI3AU(BETUS,EPST,1)-
17391 & PYI3AU(BETUS,EPSS,1)
17392 W3TUSI=PYI3AU(BETUS,EPSH,2)-PYI3AU(BETUS,EPST,2)-
17393 & PYI3AU(BETUS,EPSS,2)
17394 W3USTR=PYI3AU(BEUST,EPSH,1)-PYI3AU(BEUST,EPSU,1)-
17395 & PYI3AU(BEUST,EPST,1)
17396 W3USTI=PYI3AU(BEUST,EPSH,2)-PYI3AU(BEUST,EPSU,2)-
17397 & PYI3AU(BEUST,EPST,2)
17398 W3UTSR=PYI3AU(BEUTS,EPSH,1)-PYI3AU(BEUTS,EPSU,1)-
17399 & PYI3AU(BEUTS,EPSS,1)
17400 W3UTSI=PYI3AU(BEUTS,EPSH,2)-PYI3AU(BEUTS,EPSU,2)-
17401 & PYI3AU(BEUTS,EPSS,2)
17402 B2STUR=SQMQ/SQMH**2*(SH*(UH-SH)/(SH+UH)+2.*TH*UH*(UH+2.*SH)/
17403 & (SH+UH)**2*(PYW1AU(EPST,1)-PYW1AU(EPSH,1))+(SQMQ-SH/4.)*
17404 & (0.5*PYW2AU(EPSS,1)+0.5*PYW2AU(EPSH,1)-PYW2AU(EPST,1)+W3STUR)+
17405 & SH**2*(2.*SQMQ/(SH+UH)**2-0.5/(SH+UH))*(PYW2AU(EPST,1)-
17406 & PYW2AU(EPSH,1))+0.5*TH*UH/SH*(PYW2AU(EPSH,1)-2.*PYW2AU(EPST,1))+
17407 & 0.125*(SH-12.*SQMQ-4.*TH*UH/SH)*W3TSUR)
17408 B2STUI=SQMQ/SQMH**2*(2.*TH*UH*(UH+2.*SH)/(SH+UH)**2*
17409 & (PYW1AU(EPST,2)-PYW1AU(EPSH,2))+(SQMQ-SH/4.)*
17410 & (0.5*PYW2AU(EPSS,2)+0.5*PYW2AU(EPSH,2)-PYW2AU(EPST,2)+W3STUI)+
17411 & SH**2*(2.*SQMQ/(SH+UH)**2-0.5/(SH+UH))*(PYW2AU(EPST,2)-
17412 & PYW2AU(EPSH,2))+0.5*TH*UH/SH*(PYW2AU(EPSH,2)-2.*PYW2AU(EPST,2))+
17413 & 0.125*(SH-12.*SQMQ-4.*TH*UH/SH)*W3TSUI)
17414 B2SUTR=SQMQ/SQMH**2*(SH*(TH-SH)/(SH+TH)+2.*UH*TH*(TH+2.*SH)/
17415 & (SH+TH)**2*(PYW1AU(EPSU,1)-PYW1AU(EPSH,1))+(SQMQ-SH/4.)*
17416 & (0.5*PYW2AU(EPSS,1)+0.5*PYW2AU(EPSH,1)-PYW2AU(EPSU,1)+W3SUTR)+
17417 & SH**2*(2.*SQMQ/(SH+TH)**2-0.5/(SH+TH))*(PYW2AU(EPSU,1)-
17418 & PYW2AU(EPSH,1))+0.5*UH*TH/SH*(PYW2AU(EPSH,1)-2.*PYW2AU(EPSU,1))+
17419 & 0.125*(SH-12.*SQMQ-4.*UH*TH/SH)*W3USTR)
17420 B2SUTI=SQMQ/SQMH**2*(2.*UH*TH*(TH+2.*SH)/(SH+TH)**2*
17421 & (PYW1AU(EPSU,2)-PYW1AU(EPSH,2))+(SQMQ-SH/4.)*
17422 & (0.5*PYW2AU(EPSS,2)+0.5*PYW2AU(EPSH,2)-PYW2AU(EPSU,2)+W3SUTI)+
17423 & SH**2*(2.*SQMQ/(SH+TH)**2-0.5/(SH+TH))*(PYW2AU(EPSU,2)-
17424 & PYW2AU(EPSH,2))+0.5*UH*TH/SH*(PYW2AU(EPSH,2)-2.*PYW2AU(EPSU,2))+
17425 & 0.125*(SH-12.*SQMQ-4.*UH*TH/SH)*W3USTI)
17426 B2TSUR=SQMQ/SQMH**2*(TH*(UH-TH)/(TH+UH)+2.*SH*UH*(UH+2.*TH)/
17427 & (TH+UH)**2*(PYW1AU(EPSS,1)-PYW1AU(EPSH,1))+(SQMQ-TH/4.)*
17428 & (0.5*PYW2AU(EPST,1)+0.5*PYW2AU(EPSH,1)-PYW2AU(EPSS,1)+W3TSUR)+
17429 & TH**2*(2.*SQMQ/(TH+UH)**2-0.5/(TH+UH))*(PYW2AU(EPSS,1)-
17430 & PYW2AU(EPSH,1))+0.5*SH*UH/TH*(PYW2AU(EPSH,1)-2.*PYW2AU(EPSS,1))+
17431 & 0.125*(TH-12.*SQMQ-4.*SH*UH/TH)*W3STUR)
17432 B2TSUI=SQMQ/SQMH**2*(2.*SH*UH*(UH+2.*TH)/(TH+UH)**2*
17433 & (PYW1AU(EPSS,2)-PYW1AU(EPSH,2))+(SQMQ-TH/4.)*
17434 & (0.5*PYW2AU(EPST,2)+0.5*PYW2AU(EPSH,2)-PYW2AU(EPSS,2)+W3TSUI)+
17435 & TH**2*(2.*SQMQ/(TH+UH)**2-0.5/(TH+UH))*(PYW2AU(EPSS,2)-
17436 & PYW2AU(EPSH,2))+0.5*SH*UH/TH*(PYW2AU(EPSH,2)-2.*PYW2AU(EPSS,2))+
17437 & 0.125*(TH-12.*SQMQ-4.*SH*UH/TH)*W3STUI)
17438 B2TUSR=SQMQ/SQMH**2*(TH*(SH-TH)/(TH+SH)+2.*UH*SH*(SH+2.*TH)/
17439 & (TH+SH)**2*(PYW1AU(EPSU,1)-PYW1AU(EPSH,1))+(SQMQ-TH/4.)*
17440 & (0.5*PYW2AU(EPST,1)+0.5*PYW2AU(EPSH,1)-PYW2AU(EPSU,1)+W3TUSR)+
17441 & TH**2*(2.*SQMQ/(TH+SH)**2-0.5/(TH+SH))*(PYW2AU(EPSU,1)-
17442 & PYW2AU(EPSH,1))+0.5*UH*SH/TH*(PYW2AU(EPSH,1)-2.*PYW2AU(EPSU,1))+
17443 & 0.125*(TH-12.*SQMQ-4.*UH*SH/TH)*W3UTSR)
17444 B2TUSI=SQMQ/SQMH**2*(2.*UH*SH*(SH+2.*TH)/(TH+SH)**2*
17445 & (PYW1AU(EPSU,2)-PYW1AU(EPSH,2))+(SQMQ-TH/4.)*
17446 & (0.5*PYW2AU(EPST,2)+0.5*PYW2AU(EPSH,2)-PYW2AU(EPSU,2)+W3TUSI)+
17447 & TH**2*(2.*SQMQ/(TH+SH)**2-0.5/(TH+SH))*(PYW2AU(EPSU,2)-
17448 & PYW2AU(EPSH,2))+0.5*UH*SH/TH*(PYW2AU(EPSH,2)-2.*PYW2AU(EPSU,2))+
17449 & 0.125*(TH-12.*SQMQ-4.*UH*SH/TH)*W3UTSI)
17450 B2USTR=SQMQ/SQMH**2*(UH*(TH-UH)/(UH+TH)+2.*SH*TH*(TH+2.*UH)/
17451 & (UH+TH)**2*(PYW1AU(EPSS,1)-PYW1AU(EPSH,1))+(SQMQ-UH/4.)*
17452 & (0.5*PYW2AU(EPSU,1)+0.5*PYW2AU(EPSH,1)-PYW2AU(EPSS,1)+W3USTR)+
17453 & UH**2*(2.*SQMQ/(UH+TH)**2-0.5/(UH+TH))*(PYW2AU(EPSS,1)-
17454 & PYW2AU(EPSH,1))+0.5*SH*TH/UH*(PYW2AU(EPSH,1)-2.*PYW2AU(EPSS,1))+
17455 & 0.125*(UH-12.*SQMQ-4.*SH*TH/UH)*W3SUTR)
17456 B2USTI=SQMQ/SQMH**2*(2.*SH*TH*(TH+2.*UH)/(UH+TH)**2*
17457 & (PYW1AU(EPSS,2)-PYW1AU(EPSH,2))+(SQMQ-UH/4.)*
17458 & (0.5*PYW2AU(EPSU,2)+0.5*PYW2AU(EPSH,2)-PYW2AU(EPSS,2)+W3USTI)+
17459 & UH**2*(2.*SQMQ/(UH+TH)**2-0.5/(UH+TH))*(PYW2AU(EPSS,2)-
17460 & PYW2AU(EPSH,2))+0.5*SH*TH/UH*(PYW2AU(EPSH,2)-2.*PYW2AU(EPSS,2))+
17461 & 0.125*(UH-12.*SQMQ-4.*SH*TH/UH)*W3SUTI)
17462 B2UTSR=SQMQ/SQMH**2*(UH*(SH-UH)/(UH+SH)+2.*TH*SH*(SH+2.*UH)/
17463 & (UH+SH)**2*(PYW1AU(EPST,1)-PYW1AU(EPSH,1))+(SQMQ-UH/4.)*
17464 & (0.5*PYW2AU(EPSU,1)+0.5*PYW2AU(EPSH,1)-PYW2AU(EPST,1)+W3UTSR)+
17465 & UH**2*(2.*SQMQ/(UH+SH)**2-0.5/(UH+SH))*(PYW2AU(EPST,1)-
17466 & PYW2AU(EPSH,1))+0.5*TH*SH/UH*(PYW2AU(EPSH,1)-2.*PYW2AU(EPST,1))+
17467 & 0.125*(UH-12.*SQMQ-4.*TH*SH/UH)*W3TUSR)
17468 B2UTSI=SQMQ/SQMH**2*(2.*TH*SH*(SH+2.*UH)/(UH+SH)**2*
17469 & (PYW1AU(EPST,2)-PYW1AU(EPSH,2))+(SQMQ-UH/4.)*
17470 & (0.5*PYW2AU(EPSU,2)+0.5*PYW2AU(EPSH,2)-PYW2AU(EPST,2)+W3UTSI)+
17471 & UH**2*(2.*SQMQ/(UH+SH)**2-0.5/(UH+SH))*(PYW2AU(EPST,2)-
17472 & PYW2AU(EPSH,2))+0.5*TH*SH/UH*(PYW2AU(EPSH,2)-2.*PYW2AU(EPST,2))+
17473 & 0.125*(UH-12.*SQMQ-4.*TH*SH/UH)*W3TUSI)
17474 B4STUR=SQMQ/SQMH*(-2./3.+(SQMQ/SQMH-1./4.)*(PYW2AU(EPSS,1)-
17475 & PYW2AU(EPSH,1)+W3STUR))
17476 B4STUI=SQMQ/SQMH*(SQMQ/SQMH-1./4.)*(PYW2AU(EPSS,2)-
17477 & PYW2AU(EPSH,2)+W3STUI)
17478 B4TUSR=SQMQ/SQMH*(-2./3.+(SQMQ/SQMH-1./4.)*(PYW2AU(EPST,1)-
17479 & PYW2AU(EPSH,1)+W3TUSR))
17480 B4TUSI=SQMQ/SQMH*(SQMQ/SQMH-1./4.)*(PYW2AU(EPST,2)-
17481 & PYW2AU(EPSH,2)+W3TUSI)
17482 B4USTR=SQMQ/SQMH*(-2./3.+(SQMQ/SQMH-1./4.)*(PYW2AU(EPSU,1)-
17483 & PYW2AU(EPSH,1)+W3USTR))
17484 B4USTI=SQMQ/SQMH*(SQMQ/SQMH-1./4.)*(PYW2AU(EPSU,2)-
17485 & PYW2AU(EPSH,2)+W3USTI)
17486 A2STUR=A2STUR+B2STUR+B2SUTR
17487 A2STUI=A2STUI+B2STUI+B2SUTI
17488 A2USTR=A2USTR+B2USTR+B2UTSR
17489 A2USTI=A2USTI+B2USTI+B2UTSI
17490 A2TUSR=A2TUSR+B2TUSR+B2TSUR
17491 A2TUSI=A2TUSI+B2TUSI+B2TSUI
17492 A4STUR=A4STUR+B4STUR+B4USTR+B4TUSR
17493 A4STUI=A4STUI+B4STUI+B4USTI+B4TUSI
17494 760 CONTINUE
17495 FACGH=COMFAC*FACA*3./(128.*PARU(1)**2)*AEM/XW*AS**3*
17496 & SQMH/SQMW*SQMH**3/(SH*TH*UH)*(A2STUR**2+A2STUI**2+A2USTR**2+
17497 & A2USTI**2+A2TUSR**2+A2TUSI**2+A4STUR**2+A4STUI**2)
17498 FACGH=FACGH*WIDS(25,2)
17499 IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 770
17500 NCHN=NCHN+1
17501 ISIG(NCHN,1)=21
17502 ISIG(NCHN,2)=21
17503 ISIG(NCHN,3)=1
17504 SIGH(NCHN)=FACGH
17505 770 CONTINUE
17506
17507 ELSEIF(ISUB.EQ.114) THEN
17508
17509 ASRE=0.
17510 ASIM=0.
17511 DO 780 I=1,2*MSTP(1)
17512 EI=KCHG(IABS(I),1)/3.
17513 SQMQ=PMAS(I,1)**2
17514 EPSS=4.*SQMQ/SH
17515 EPST=4.*SQMQ/TH
17516 EPSU=4.*SQMQ/UH
17517 IF(EPSS+ABS(EPST)+ABS(EPSU).LT.3.E-6) THEN
17518 A0STUR=1.+(TH-UH)/SH*LOG(TH/UH)+0.5*(TH2+UH2)/SH2*
17519 & (LOG(TH/UH)**2+PARU(1)**2)
17520 A0STUI=0.
17521 A0TSUR=1.+(SH-UH)/TH*LOG(-SH/UH)+0.5*(SH2+UH2)/TH2*
17522 & LOG(-SH/UH)**2
17523 A0TSUI=-PARU(1)*((SH-UH)/TH+(SH2+UH2)/TH2*LOG(-SH/UH))
17524 A0UTSR=1.+(TH-SH)/UH*LOG(-TH/SH)+0.5*(TH2+SH2)/UH2*
17525 & LOG(-TH/SH)**2
17526 A0UTSI=PARU(1)*((TH-SH)/UH+(TH2+SH2)/UH2*LOG(-TH/SH))
17527 A1STUR=-1.
17528 A1STUI=0.
17529 A2STUR=-1.
17530 A2STUI=0.
17531 ELSE
17532 BESTU=0.5*(1.+SQRT(1.+EPSS*TH/UH))
17533 BEUST=0.5*(1.+SQRT(1.+EPSU*SH/TH))
17534 BETUS=0.5*(1.+SQRT(1.+EPST*UH/SH))
17535 BEUTS=BESTU
17536 BETSU=BEUST
17537 BESUT=BETUS
17538 A0STUR=1.+(1.+2.*TH/SH)*PYW1AU(EPST,1)+(1.+2.*UH/SH)*
17539 & PYW1AU(EPSU,1)+0.5*((TH2+UH2)/SH2-EPSS)*(PYW2AU(EPST,1)+
17540 & PYW2AU(EPSU,1))-0.25*EPST*(1.-0.5*EPSS)*(PYI3AU(BESUT,EPSS,1)+
17541 & PYI3AU(BESUT,EPST,1))-0.25*EPSU*(1.-0.5*EPSS)*
17542 & (PYI3AU(BESTU,EPSS,1)+PYI3AU(BESTU,EPSU,1))+
17543 & 0.25*(-2.*(TH2+UH2)/SH2+4.*EPSS+EPST+EPSU+0.5*EPST*EPSU)*
17544 & (PYI3AU(BETSU,EPST,1)+PYI3AU(BETSU,EPSU,1))
17545 A0STUI=(1.+2.*TH/SH)*PYW1AU(EPST,2)+(1.+2.*UH/SH)*
17546 & PYW1AU(EPSU,2)+0.5*((TH2+UH2)/SH2-EPSS)*(PYW2AU(EPST,2)+
17547 & PYW2AU(EPSU,2))-0.25*EPST*(1.-0.5*EPSS)*(PYI3AU(BESUT,EPSS,2)+
17548 & PYI3AU(BESUT,EPST,2))-0.25*EPSU*(1.-0.5*EPSS)*
17549 & (PYI3AU(BESTU,EPSS,2)+PYI3AU(BESTU,EPSU,2))+
17550 & 0.25*(-2.*(TH2+UH2)/SH2+4.*EPSS+EPST+EPSU+0.5*EPST*EPSU)*
17551 & (PYI3AU(BETSU,EPST,2)+PYI3AU(BETSU,EPSU,2))
17552 A0TSUR=1.+(1.+2.*SH/TH)*PYW1AU(EPSS,1)+(1.+2.*UH/TH)*
17553 & PYW1AU(EPSU,1)+0.5*((SH2+UH2)/TH2-EPST)*(PYW2AU(EPSS,1)+
17554 & PYW2AU(EPSU,1))-0.25*EPSS*(1.-0.5*EPST)*(PYI3AU(BETUS,EPST,1)+
17555 & PYI3AU(BETUS,EPSS,1))-0.25*EPSU*(1.-0.5*EPST)*
17556 & (PYI3AU(BETSU,EPST,1)+PYI3AU(BETSU,EPSU,1))+
17557 & 0.25*(-2.*(SH2+UH2)/TH2+4.*EPST+EPSS+EPSU+0.5*EPSS*EPSU)*
17558 & (PYI3AU(BESTU,EPSS,1)+PYI3AU(BESTU,EPSU,1))
17559 A0TSUI=(1.+2.*SH/TH)*PYW1AU(EPSS,2)+(1.+2.*UH/TH)*
17560 & PYW1AU(EPSU,2)+0.5*((SH2+UH2)/TH2-EPST)*(PYW2AU(EPSS,2)+
17561 & PYW2AU(EPSU,2))-0.25*EPSS*(1.-0.5*EPST)*(PYI3AU(BETUS,EPST,2)+
17562 & PYI3AU(BETUS,EPSS,2))-0.25*EPSU*(1.-0.5*EPST)*
17563 & (PYI3AU(BETSU,EPST,2)+PYI3AU(BETSU,EPSU,2))+
17564 & 0.25*(-2.*(SH2+UH2)/TH2+4.*EPST+EPSS+EPSU+0.5*EPSS*EPSU)*
17565 & (PYI3AU(BESTU,EPSS,2)+PYI3AU(BESTU,EPSU,2))
17566 A0UTSR=1.+(1.+2.*TH/UH)*PYW1AU(EPST,1)+(1.+2.*SH/UH)*
17567 & PYW1AU(EPSS,1)+0.5*((TH2+SH2)/UH2-EPSU)*(PYW2AU(EPST,1)+
17568 & PYW2AU(EPSS,1))-0.25*EPST*(1.-0.5*EPSU)*(PYI3AU(BEUST,EPSU,1)+
17569 & PYI3AU(BEUST,EPST,1))-0.25*EPSS*(1.-0.5*EPSU)*
17570 & (PYI3AU(BEUTS,EPSU,1)+PYI3AU(BEUTS,EPSS,1))+
17571 & 0.25*(-2.*(TH2+SH2)/UH2+4.*EPSU+EPST+EPSS+0.5*EPST*EPSS)*
17572 & (PYI3AU(BETUS,EPST,1)+PYI3AU(BETUS,EPSS,1))
17573 A0UTSI=(1.+2.*TH/UH)*PYW1AU(EPST,2)+(1.+2.*SH/UH)*
17574 & PYW1AU(EPSS,2)+0.5*((TH2+SH2)/UH2-EPSU)*(PYW2AU(EPST,2)+
17575 & PYW2AU(EPSS,2))-0.25*EPST*(1.-0.5*EPSU)*(PYI3AU(BEUST,EPSU,2)+
17576 & PYI3AU(BEUST,EPST,2))-0.25*EPSS*(1.-0.5*EPSU)*
17577 & (PYI3AU(BEUTS,EPSU,2)+PYI3AU(BEUTS,EPSS,2))+
17578 & 0.25*(-2.*(TH2+SH2)/UH2+4.*EPSU+EPST+EPSS+0.5*EPST*EPSS)*
17579 & (PYI3AU(BETUS,EPST,2)+PYI3AU(BETUS,EPSS,2))
17580 A1STUR=-1.-0.25*(EPSS+EPST+EPSU)*(PYW2AU(EPSS,1)+
17581 & PYW2AU(EPST,1)+PYW2AU(EPSU,1))+0.25*(EPSU+0.5*EPSS*EPST)*
17582 & (PYI3AU(BESUT,EPSS,1)+PYI3AU(BESUT,EPST,1))+
17583 & 0.25*(EPST+0.5*EPSS*EPSU)*(PYI3AU(BESTU,EPSS,1)+
17584 & PYI3AU(BESTU,EPSU,1))+0.25*(EPSS+0.5*EPST*EPSU)*
17585 & (PYI3AU(BETSU,EPST,1)+PYI3AU(BETSU,EPSU,1))
17586 A1STUI=-0.25*(EPSS+EPST+EPSU)*(PYW2AU(EPSS,2)+PYW2AU(EPST,2)+
17587 & PYW2AU(EPSU,2))+0.25*(EPSU+0.5*EPSS*EPST)*
17588 & (PYI3AU(BESUT,EPSS,2)+PYI3AU(BESUT,EPST,2))+
17589 & 0.25*(EPST+0.5*EPSS*EPSU)*(PYI3AU(BESTU,EPSS,2)+
17590 & PYI3AU(BESTU,EPSU,2))+0.25*(EPSS+0.5*EPST*EPSU)*
17591 & (PYI3AU(BETSU,EPST,2)+PYI3AU(BETSU,EPSU,2))
17592 A2STUR=-1.+0.125*EPSS*EPST*(PYI3AU(BESUT,EPSS,1)+
17593 & PYI3AU(BESUT,EPST,1))+0.125*EPSS*EPSU*(PYI3AU(BESTU,EPSS,1)+
17594 & PYI3AU(BESTU,EPSU,1))+0.125*EPST*EPSU*(PYI3AU(BETSU,EPST,1)+
17595 & PYI3AU(BETSU,EPSU,1))
17596 A2STUI=0.125*EPSS*EPST*(PYI3AU(BESUT,EPSS,2)+
17597 & PYI3AU(BESUT,EPST,2))+0.125*EPSS*EPSU*(PYI3AU(BESTU,EPSS,2)+
17598 & PYI3AU(BESTU,EPSU,2))+0.125*EPST*EPSU*(PYI3AU(BETSU,EPST,2)+
17599 & PYI3AU(BETSU,EPSU,2))
17600 ENDIF
17601 ASRE=ASRE+EI**2*(A0STUR+A0TSUR+A0UTSR+4.*A1STUR+A2STUR)
17602 ASIM=ASIM+EI**2*(A0STUI+A0TSUI+A0UTSI+4.*A1STUI+A2STUI)
17603 780 CONTINUE
17604 FACGG=COMFAC*FACA/(8.*PARU(1)**2)*AS**2*AEM**2*(ASRE**2+ASIM**2)
17605 IF(KFAC(1,21)*KFAC(2,21).EQ.0) GOTO 790
17606 NCHN=NCHN+1
17607 ISIG(NCHN,1)=21
17608 ISIG(NCHN,2)=21
17609 ISIG(NCHN,3)=1
17610 SIGH(NCHN)=FACGG
17611 790 CONTINUE
17612
17613 ELSEIF(ISUB.EQ.115) THEN
17614
17615
17616 ELSEIF(ISUB.EQ.116) THEN
17617
17618
17619 ELSEIF(ISUB.EQ.117) THEN
17620
17621
17622 ENDIF
17623
17624
17625
17626 ELSEIF(ISUB.LE.140) THEN
17627 IF(ISUB.EQ.121) THEN
17628
17629
17630 ENDIF
17631
17632
17633
17634 ELSEIF(ISUB.LE.160) THEN
17635 IF(ISUB.EQ.141) THEN
17636
17637 MINT(61)=2
17638 CALL PYWIDT(32,SQRT(SH),WDTP,WDTE)
17639 FACZP=COMFAC*AEM**2*4./9.
17640 DO 800 I=MINA,MAXA
17641 IF(I.EQ.0.OR.KFAC(1,I)*KFAC(2,-I).EQ.0) GOTO 800
17642 EI=KCHG(IABS(I),1)/3.
17643 AI=SIGN(1.,EI)
17644 VI=AI-4.*EI*XW
17645 API=SIGN(1.,EI)
17646 VPI=API-4.*EI*XW
17647 NCHN=NCHN+1
17648 ISIG(NCHN,1)=I
17649 ISIG(NCHN,2)=-I
17650 ISIG(NCHN,3)=1
17651 SIGH(NCHN)=FACZP*(EI**2*VINT(111)+EI*VI/(8.*XW*(1.-XW))*
17652 & SH*(SH-SQMZ)/((SH-SQMZ)**2+GMMZ**2)*VINT(112)+EI*VPI/(8.*XW*
17653 & (1.-XW))*SH*(SH-SQMZP)/((SH-SQMZP)**2+GMMZP**2)*VINT(113)+
17654 & (VI**2+AI**2)/(16.*XW*(1.-XW))**2*SH2/((SH-SQMZ)**2+GMMZ**2)*
17655 & VINT(114)+2.*(VI*VPI+AI*API)/(16.*XW*(1.-XW))**2*SH2*
17656 & ((SH-SQMZ)*(SH-SQMZP)+GMMZ*GMMZP)/(((SH-SQMZ)**2+GMMZ**2)*
17657 & ((SH-SQMZP)**2+GMMZP**2))*VINT(115)+(VPI**2+API**2)/
17658 & (16.*XW*(1.-XW))**2*SH2/((SH-SQMZP)**2+GMMZP**2)*VINT(116))
17659 800 CONTINUE
17660
17661 ELSEIF(ISUB.EQ.142) THEN
17662
17663 CALL PYWIDT(37,SQRT(SH),WDTP,WDTE)
17664 FHC=COMFAC*(AEM/XW)**2*1./48.*(SH/SQMW)**2*SH2/
17665 & ((SH-SQMHC)**2+GMMHC**2)
17666
17667 DO 840 I=1,MSTP(54)/2
17668 IL=2*I-1
17669 IU=2*I
17670 RMQL=PMAS(IL,1)**2/SH
17671 RMQU=PMAS(IU,1)**2/SH
17672 FACHC=FHC*((RMQL*PARU(121)+RMQU/PARU(121))*(1.-RMQL-RMQU)-
17673 & 4.*RMQL*RMQU)/SQRT(MAX(0.,(1.-RMQL-RMQU)**2-4.*RMQL*RMQU))
17674 IF(KFAC(1,IL)*KFAC(2,-IU).EQ.0) GOTO 810
17675 KCHHC=(KCHG(IL,1)-KCHG(IU,1))/3
17676 NCHN=NCHN+1
17677 ISIG(NCHN,1)=IL
17678 ISIG(NCHN,2)=-IU
17679 ISIG(NCHN,3)=1
17680 SIGH(NCHN)=FACHC*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4))
17681 810 IF(KFAC(1,-IL)*KFAC(2,IU).EQ.0) GOTO 820
17682 KCHHC=(-KCHG(IL,1)+KCHG(IU,1))/3
17683 NCHN=NCHN+1
17684 ISIG(NCHN,1)=-IL
17685 ISIG(NCHN,2)=IU
17686 ISIG(NCHN,3)=1
17687 SIGH(NCHN)=FACHC*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4))
17688 820 IF(KFAC(1,IU)*KFAC(2,-IL).EQ.0) GOTO 830
17689 KCHHC=(KCHG(IU,1)-KCHG(IL,1))/3
17690 NCHN=NCHN+1
17691 ISIG(NCHN,1)=IU
17692 ISIG(NCHN,2)=-IL
17693 ISIG(NCHN,3)=1
17694 SIGH(NCHN)=FACHC*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4))
17695 830 IF(KFAC(1,-IU)*KFAC(2,IL).EQ.0) GOTO 840
17696 KCHHC=(-KCHG(IU,1)+KCHG(IL,1))/3
17697 NCHN=NCHN+1
17698 ISIG(NCHN,1)=-IU
17699 ISIG(NCHN,2)=IL
17700 ISIG(NCHN,3)=1
17701 SIGH(NCHN)=FACHC*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4))
17702 840 CONTINUE
17703
17704 ELSEIF(ISUB.EQ.143) THEN
17705
17706 CALL PYWIDT(40,SQRT(SH),WDTP,WDTE)
17707 FACR=COMFAC*(AEM/XW)**2*1./9.*SH2/((SH-SQMR)**2+GMMR**2)
17708 DO 860 I=MIN1,MAX1
17709 IF(I.EQ.0.OR.KFAC(1,I).EQ.0) GOTO 860
17710 IA=IABS(I)
17711 DO 850 J=MIN2,MAX2
17712 IF(J.EQ.0.OR.KFAC(2,J).EQ.0) GOTO 850
17713 JA=IABS(J)
17714 IF(I*J.GT.0.OR.IABS(IA-JA).NE.2) GOTO 850
17715 NCHN=NCHN+1
17716 ISIG(NCHN,1)=I
17717 ISIG(NCHN,2)=J
17718 ISIG(NCHN,3)=1
17719 SIGH(NCHN)=FACR*(WDTE(0,1)+WDTE(0,(10-(I+J))/4)+WDTE(0,4))
17720 850 CONTINUE
17721 860 CONTINUE
17722
17723 ENDIF
17724
17725
17726
17727 ELSE
17728 IF(ISUB.EQ.161) THEN
17729
17730 FHCQ=COMFAC*FACA*AS*AEM/XW*1./24
17731 DO 900 I=1,MSTP(54)
17732 IU=I+MOD(I,2)
17733 SQMQ=PMAS(IU,1)**2
17734 FACHCQ=FHCQ/PARU(121)*SQMQ/SQMW*(SH/(SQMQ-UH)+
17735 & 2.*SQMQ*(SQMHC-UH)/(SQMQ-UH)**2+(SQMQ-UH)/SH+
17736 & 2.*SQMQ/(SQMQ-UH)+2.*(SQMHC-UH)/(SQMQ-UH)*(SQMHC-SQMQ-SH)/SH)
17737 IF(KFAC(1,-I)*KFAC(2,21).EQ.0) GOTO 870
17738 KCHHC=ISIGN(1,-KCHG(I,1))
17739 NCHN=NCHN+1
17740 ISIG(NCHN,1)=-I
17741 ISIG(NCHN,2)=21
17742 ISIG(NCHN,3)=1
17743 SIGH(NCHN)=FACHCQ*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4))
17744 870 IF(KFAC(1,I)*KFAC(2,21).EQ.0) GOTO 880
17745 KCHHC=ISIGN(1,KCHG(I,1))
17746 NCHN=NCHN+1
17747 ISIG(NCHN,1)=I
17748 ISIG(NCHN,2)=21
17749 ISIG(NCHN,3)=1
17750 SIGH(NCHN)=FACHCQ*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4))
17751 880 IF(KFAC(1,21)*KFAC(2,-I).EQ.0) GOTO 890
17752 KCHHC=ISIGN(1,-KCHG(I,1))
17753 NCHN=NCHN+1
17754 ISIG(NCHN,1)=21
17755 ISIG(NCHN,2)=-I
17756 ISIG(NCHN,3)=1
17757 SIGH(NCHN)=FACHCQ*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4))
17758 890 IF(KFAC(1,21)*KFAC(2,I).EQ.0) GOTO 900
17759 KCHHC=ISIGN(1,KCHG(I,1))
17760 NCHN=NCHN+1
17761 ISIG(NCHN,1)=21
17762 ISIG(NCHN,2)=I
17763 ISIG(NCHN,3)=1
17764 SIGH(NCHN)=FACHCQ*(WDTE(0,1)+WDTE(0,(5-KCHHC)/2)+WDTE(0,4))
17765 900 CONTINUE
17766
17767 ENDIF
17768 ENDIF
17769
17770
17771 IF(ISUB.LE.90.OR.ISUB.GE.96) THEN
17772 DO 910 ICHN=1,NCHN
17773 IF(MINT(41).EQ.2) THEN
17774 KFL1=ISIG(ICHN,1)
17775 IF(KFL1.EQ.21) KFL1=0
17776 SIGH(ICHN)=SIGH(ICHN)*XSFX(1,KFL1)
17777 ENDIF
17778 IF(MINT(42).EQ.2) THEN
17779 KFL2=ISIG(ICHN,2)
17780 IF(KFL2.EQ.21) KFL2=0
17781 SIGH(ICHN)=SIGH(ICHN)*XSFX(2,KFL2)
17782 ENDIF
17783 910 SIGS=SIGS+SIGH(ICHN)
17784 ENDIF
17785
17786 RETURN
17787 END
17788
17789
17790
17791 SUBROUTINE PYSTFU(KF,X,Q2,XPQ,JBT)
17792
17793
17794
17795
17796
17797 COMMON/HIPARNT/HIPR1(100),IHPR2(50),HINT1(100),IHNT2(50)
17798 COMMON/HIJCRDN/YP(3,300),YT(3,300)
17799
17800 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
17801 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
17802 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
17803 COMMON/PYINT1/MINT(400),VINT(400)
17804 DIMENSION XPQ(-6:6),XQ(6),TX(6),TT(6),TS(6),NEHLQ(8,2),
17805 &CEHLQ(6,6,2,8,2),CDO(3,6,5,2),COW(3,5,4,2)
17806 SAVE
17807
17808
17809
17810
17811
17812 DATA NEHLQ/3,4,7,5,7,7,7,7,3,4,7,6,7,7,7,7/
17813
17814 DATA (((CEHLQ(IX,IT,NX,1,1),IX=1,6),IT=1,6),NX=1,2)/
17815 1 7.677E-01,-2.087E-01,-3.303E-01,-2.517E-02,-1.570E-02,-1.000E-04,
17816 2-5.326E-01,-2.661E-01, 3.201E-01, 1.192E-01, 2.434E-02, 7.620E-03,
17817 3 2.162E-01, 1.881E-01,-8.375E-02,-6.515E-02,-1.743E-02,-5.040E-03,
17818 4-9.211E-02,-9.952E-02, 1.373E-02, 2.506E-02, 8.770E-03, 2.550E-03,
17819 5 3.670E-02, 4.409E-02, 9.600E-04,-7.960E-03,-3.420E-03,-1.050E-03,
17820 6-1.549E-02,-2.026E-02,-3.060E-03, 2.220E-03, 1.240E-03, 4.100E-04,
17821 1 2.395E-01, 2.905E-01, 9.778E-02, 2.149E-02, 3.440E-03, 5.000E-04,
17822 2 1.751E-02,-6.090E-03,-2.687E-02,-1.916E-02,-7.970E-03,-2.750E-03,
17823 3-5.760E-03,-5.040E-03, 1.080E-03, 2.490E-03, 1.530E-03, 7.500E-04,
17824 4 1.740E-03, 1.960E-03, 3.000E-04,-3.400E-04,-2.900E-04,-1.800E-04,
17825 5-5.300E-04,-6.400E-04,-1.700E-04, 4.000E-05, 6.000E-05, 4.000E-05,
17826 6 1.700E-04, 2.200E-04, 8.000E-05, 1.000E-05,-1.000E-05,-1.000E-05/
17827 DATA (((CEHLQ(IX,IT,NX,1,2),IX=1,6),IT=1,6),NX=1,2)/
17828 1 7.237E-01,-2.189E-01,-2.995E-01,-1.909E-02,-1.477E-02, 2.500E-04,
17829 2-5.314E-01,-2.425E-01, 3.283E-01, 1.119E-01, 2.223E-02, 7.070E-03,
17830 3 2.289E-01, 1.890E-01,-9.859E-02,-6.900E-02,-1.747E-02,-5.080E-03,
17831 4-1.041E-01,-1.084E-01, 2.108E-02, 2.975E-02, 9.830E-03, 2.830E-03,
17832 5 4.394E-02, 5.116E-02,-1.410E-03,-1.055E-02,-4.230E-03,-1.270E-03,
17833 6-1.991E-02,-2.539E-02,-2.780E-03, 3.430E-03, 1.720E-03, 5.500E-04,
17834 1 2.410E-01, 2.884E-01, 9.369E-02, 1.900E-02, 2.530E-03, 2.400E-04,
17835 2 1.765E-02,-9.220E-03,-3.037E-02,-2.085E-02,-8.440E-03,-2.810E-03,
17836 3-6.450E-03,-5.260E-03, 1.720E-03, 3.110E-03, 1.830E-03, 8.700E-04,
17837 4 2.120E-03, 2.320E-03, 2.600E-04,-4.900E-04,-3.900E-04,-2.300E-04,
17838 5-6.900E-04,-8.200E-04,-2.000E-04, 7.000E-05, 9.000E-05, 6.000E-05,
17839 6 2.400E-04, 3.100E-04, 1.100E-04, 0.000E+00,-2.000E-05,-2.000E-05/
17840
17841 DATA (((CEHLQ(IX,IT,NX,2,1),IX=1,6),IT=1,6),NX=1,2)/
17842 1 3.813E-01,-8.090E-02,-1.634E-01,-2.185E-02,-8.430E-03,-6.200E-04,
17843 2-2.948E-01,-1.435E-01, 1.665E-01, 6.638E-02, 1.473E-02, 4.080E-03,
17844 3 1.252E-01, 1.042E-01,-4.722E-02,-3.683E-02,-1.038E-02,-2.860E-03,
17845 4-5.478E-02,-5.678E-02, 8.900E-03, 1.484E-02, 5.340E-03, 1.520E-03,
17846 5 2.220E-02, 2.567E-02,-3.000E-05,-4.970E-03,-2.160E-03,-6.500E-04,
17847 6-9.530E-03,-1.204E-02,-1.510E-03, 1.510E-03, 8.300E-04, 2.700E-04,
17848 1 1.261E-01, 1.354E-01, 3.958E-02, 8.240E-03, 1.660E-03, 4.500E-04,
17849 2 3.890E-03,-1.159E-02,-1.625E-02,-9.610E-03,-3.710E-03,-1.260E-03,
17850 3-1.910E-03,-5.600E-04, 1.590E-03, 1.590E-03, 8.400E-04, 3.900E-04,
17851 4 6.400E-04, 4.900E-04,-1.500E-04,-2.900E-04,-1.800E-04,-1.000E-04,
17852 5-2.000E-04,-1.900E-04, 0.000E+00, 6.000E-05, 4.000E-05, 3.000E-05,
17853 6 7.000E-05, 8.000E-05, 2.000E-05,-1.000E-05,-1.000E-05,-1.000E-05/
17854 DATA (((CEHLQ(IX,IT,NX,2,2),IX=1,6),IT=1,6),NX=1,2)/
17855 1 3.578E-01,-8.622E-02,-1.480E-01,-1.840E-02,-7.820E-03,-4.500E-04,
17856 2-2.925E-01,-1.304E-01, 1.696E-01, 6.243E-02, 1.353E-02, 3.750E-03,
17857 3 1.318E-01, 1.041E-01,-5.486E-02,-3.872E-02,-1.038E-02,-2.850E-03,
17858 4-6.162E-02,-6.143E-02, 1.303E-02, 1.740E-02, 5.940E-03, 1.670E-03,
17859 5 2.643E-02, 2.957E-02,-1.490E-03,-6.450E-03,-2.630E-03,-7.700E-04,
17860 6-1.218E-02,-1.497E-02,-1.260E-03, 2.240E-03, 1.120E-03, 3.500E-04,
17861 1 1.263E-01, 1.334E-01, 3.732E-02, 7.070E-03, 1.260E-03, 3.400E-04,
17862 2 3.660E-03,-1.357E-02,-1.795E-02,-1.031E-02,-3.880E-03,-1.280E-03,
17863 3-2.100E-03,-3.600E-04, 2.050E-03, 1.920E-03, 9.800E-04, 4.400E-04,
17864 4 7.700E-04, 5.400E-04,-2.400E-04,-3.900E-04,-2.400E-04,-1.300E-04,
17865 5-2.600E-04,-2.300E-04, 2.000E-05, 9.000E-05, 6.000E-05, 4.000E-05,
17866 6 9.000E-05, 1.000E-04, 2.000E-05,-2.000E-05,-2.000E-05,-1.000E-05/
17867
17868 DATA (((CEHLQ(IX,IT,NX,3,1),IX=1,6),IT=1,6),NX=1,2)/
17869 1 6.870E-02,-6.861E-02, 2.973E-02,-5.400E-03, 3.780E-03,-9.700E-04,
17870 2-1.802E-02, 1.400E-04, 6.490E-03,-8.540E-03, 1.220E-03,-1.750E-03,
17871 3-4.650E-03, 1.480E-03,-5.930E-03, 6.000E-04,-1.030E-03,-8.000E-05,
17872 4 6.440E-03, 2.570E-03, 2.830E-03, 1.150E-03, 7.100E-04, 3.300E-04,
17873 5-3.930E-03,-2.540E-03,-1.160E-03,-7.700E-04,-3.600E-04,-1.900E-04,
17874 6 2.340E-03, 1.930E-03, 5.300E-04, 3.700E-04, 1.600E-04, 9.000E-05,
17875 1 1.014E+00,-1.106E+00, 3.374E-01,-7.444E-02, 8.850E-03,-8.700E-04,
17876 2 9.233E-01,-1.285E+00, 4.475E-01,-9.786E-02, 1.419E-02,-1.120E-03,
17877 3 4.888E-02,-1.271E-01, 8.606E-02,-2.608E-02, 4.780E-03,-6.000E-04,
17878 4-2.691E-02, 4.887E-02,-1.771E-02, 1.620E-03, 2.500E-04,-6.000E-05,
17879 5 7.040E-03,-1.113E-02, 1.590E-03, 7.000E-04,-2.000E-04, 0.000E+00,
17880 6-1.710E-03, 2.290E-03, 3.800E-04,-3.500E-04, 4.000E-05, 1.000E-05/
17881 DATA (((CEHLQ(IX,IT,NX,3,2),IX=1,6),IT=1,6),NX=1,2)/
17882 1 1.008E-01,-7.100E-02, 1.973E-02,-5.710E-03, 2.930E-03,-9.900E-04,
17883 2-5.271E-02,-1.823E-02, 1.792E-02,-6.580E-03, 1.750E-03,-1.550E-03,
17884 3 1.220E-02, 1.763E-02,-8.690E-03,-8.800E-04,-1.160E-03,-2.100E-04,
17885 4-1.190E-03,-7.180E-03, 2.360E-03, 1.890E-03, 7.700E-04, 4.100E-04,
17886 5-9.100E-04, 2.040E-03,-3.100E-04,-1.050E-03,-4.000E-04,-2.400E-04,
17887 6 1.190E-03,-1.700E-04,-2.000E-04, 4.200E-04, 1.700E-04, 1.000E-04,
17888 1 1.081E+00,-1.189E+00, 3.868E-01,-8.617E-02, 1.115E-02,-1.180E-03,
17889 2 9.917E-01,-1.396E+00, 4.998E-01,-1.159E-01, 1.674E-02,-1.720E-03,
17890 3 5.099E-02,-1.338E-01, 9.173E-02,-2.885E-02, 5.890E-03,-6.500E-04,
17891 4-3.178E-02, 5.703E-02,-2.070E-02, 2.440E-03, 1.100E-04,-9.000E-05,
17892 5 8.970E-03,-1.392E-02, 2.050E-03, 6.500E-04,-2.300E-04, 2.000E-05,
17893 6-2.340E-03, 3.010E-03, 5.000E-04,-3.900E-04, 6.000E-05, 1.000E-05/
17894
17895 DATA (((CEHLQ(IX,IT,NX,4,1),IX=1,6),IT=1,6),NX=1,2)/
17896 1 9.482E-01,-9.578E-01, 1.009E-01,-1.051E-01, 3.456E-02,-3.054E-02,
17897 2-9.627E-01, 5.379E-01, 3.368E-01,-9.525E-02, 1.488E-02,-2.051E-02,
17898 3 4.300E-01,-8.306E-02,-3.372E-01, 4.902E-02,-9.160E-03, 1.041E-02,
17899 4-1.925E-01,-1.790E-02, 2.183E-01, 7.490E-03, 4.140E-03,-1.860E-03,
17900 5 8.183E-02, 1.926E-02,-1.072E-01,-1.944E-02,-2.770E-03,-5.200E-04,
17901 6-3.884E-02,-1.234E-02, 5.410E-02, 1.879E-02, 3.350E-03, 1.040E-03,
17902 1 2.948E+01,-3.902E+01, 1.464E+01,-3.335E+00, 5.054E-01,-5.915E-02,
17903 2 2.559E+01,-3.955E+01, 1.661E+01,-4.299E+00, 6.904E-01,-8.243E-02,
17904 3-1.663E+00, 1.176E+00, 1.118E+00,-7.099E-01, 1.948E-01,-2.404E-02,
17905 4-2.168E-01, 8.170E-01,-7.169E-01, 1.851E-01,-1.924E-02,-3.250E-03,
17906 5 2.088E-01,-4.355E-01, 2.239E-01,-2.446E-02,-3.620E-03, 1.910E-03,
17907 6-9.097E-02, 1.601E-01,-5.681E-02,-2.500E-03, 2.580E-03,-4.700E-04/
17908 DATA (((CEHLQ(IX,IT,NX,4,2),IX=1,6),IT=1,6),NX=1,2)/
17909 1 2.367E+00, 4.453E-01, 3.660E-01, 9.467E-02, 1.341E-01, 1.661E-02,
17910 2-3.170E+00,-1.795E+00, 3.313E-02,-2.874E-01,-9.827E-02,-7.119E-02,
17911 3 1.823E+00, 1.457E+00,-2.465E-01, 3.739E-02, 6.090E-03, 1.814E-02,
17912 4-1.033E+00,-9.827E-01, 2.136E-01, 1.169E-01, 5.001E-02, 1.684E-02,
17913 5 5.133E-01, 5.259E-01,-1.173E-01,-1.139E-01,-4.988E-02,-2.021E-02,
17914 6-2.881E-01,-3.145E-01, 5.667E-02, 9.161E-02, 4.568E-02, 1.951E-02,
17915 1 3.036E+01,-4.062E+01, 1.578E+01,-3.699E+00, 6.020E-01,-7.031E-02,
17916 2 2.700E+01,-4.167E+01, 1.770E+01,-4.804E+00, 7.862E-01,-1.060E-01,
17917 3-1.909E+00, 1.357E+00, 1.127E+00,-7.181E-01, 2.232E-01,-2.481E-02,
17918 4-2.488E-01, 9.781E-01,-8.127E-01, 2.094E-01,-2.997E-02,-4.710E-03,
17919 5 2.506E-01,-5.427E-01, 2.672E-01,-3.103E-02,-1.800E-03, 2.870E-03,
17920 6-1.128E-01, 2.087E-01,-6.972E-02,-2.480E-03, 2.630E-03,-8.400E-04/
17921
17922 DATA (((CEHLQ(IX,IT,NX,5,1),IX=1,6),IT=1,6),NX=1,2)/
17923 1 4.968E-02,-4.173E-02, 2.102E-02,-3.270E-03, 3.240E-03,-6.700E-04,
17924 2-6.150E-03,-1.294E-02, 6.740E-03,-6.890E-03, 9.000E-04,-1.510E-03,
17925 3-8.580E-03, 5.050E-03,-4.900E-03,-1.600E-04,-9.400E-04,-1.500E-04,
17926 4 7.840E-03, 1.510E-03, 2.220E-03, 1.400E-03, 7.000E-04, 3.500E-04,
17927 5-4.410E-03,-2.220E-03,-8.900E-04,-8.500E-04,-3.600E-04,-2.000E-04,
17928 6 2.520E-03, 1.840E-03, 4.100E-04, 3.900E-04, 1.600E-04, 9.000E-05,
17929 1 9.235E-01,-1.085E+00, 3.464E-01,-7.210E-02, 9.140E-03,-9.100E-04,
17930 2 9.315E-01,-1.274E+00, 4.512E-01,-9.775E-02, 1.380E-02,-1.310E-03,
17931 3 4.739E-02,-1.296E-01, 8.482E-02,-2.642E-02, 4.760E-03,-5.700E-04,
17932 4-2.653E-02, 4.953E-02,-1.735E-02, 1.750E-03, 2.800E-04,-6.000E-05,
17933 5 6.940E-03,-1.132E-02, 1.480E-03, 6.500E-04,-2.100E-04, 0.000E+00,
17934 6-1.680E-03, 2.340E-03, 4.200E-04,-3.400E-04, 5.000E-05, 1.000E-05/
17935 DATA (((CEHLQ(IX,IT,NX,5,2),IX=1,6),IT=1,6),NX=1,2)/
17936 1 6.478E-02,-4.537E-02, 1.643E-02,-3.490E-03, 2.710E-03,-6.700E-04,
17937 2-2.223E-02,-2.126E-02, 1.247E-02,-6.290E-03, 1.120E-03,-1.440E-03,
17938 3-1.340E-03, 1.362E-02,-6.130E-03,-7.900E-04,-9.000E-04,-2.000E-04,
17939 4 5.080E-03,-3.610E-03, 1.700E-03, 1.830E-03, 6.800E-04, 4.000E-04,
17940 5-3.580E-03, 6.000E-05,-2.600E-04,-1.050E-03,-3.800E-04,-2.300E-04,
17941 6 2.420E-03, 9.300E-04,-1.000E-04, 4.500E-04, 1.700E-04, 1.100E-04,
17942 1 9.868E-01,-1.171E+00, 3.940E-01,-8.459E-02, 1.124E-02,-1.250E-03,
17943 2 1.001E+00,-1.383E+00, 5.044E-01,-1.152E-01, 1.658E-02,-1.830E-03,
17944 3 4.928E-02,-1.368E-01, 9.021E-02,-2.935E-02, 5.800E-03,-6.600E-04,
17945 4-3.133E-02, 5.785E-02,-2.023E-02, 2.630E-03, 1.600E-04,-8.000E-05,
17946 5 8.840E-03,-1.416E-02, 1.900E-03, 5.800E-04,-2.500E-04, 1.000E-05,
17947 6-2.300E-03, 3.080E-03, 5.500E-04,-3.700E-04, 7.000E-05, 1.000E-05/
17948
17949 DATA (((CEHLQ(IX,IT,NX,6,1),IX=1,6),IT=1,6),NX=1,2)/
17950 1 9.270E-03,-1.817E-02, 9.590E-03,-6.390E-03, 1.690E-03,-1.540E-03,
17951 2 5.710E-03,-1.188E-02, 6.090E-03,-4.650E-03, 1.240E-03,-1.310E-03,
17952 3-3.960E-03, 7.100E-03,-3.590E-03, 1.840E-03,-3.900E-04, 3.400E-04,
17953 4 1.120E-03,-1.960E-03, 1.120E-03,-4.800E-04, 1.000E-04,-4.000E-05,
17954 5 4.000E-05,-3.000E-05,-1.800E-04, 9.000E-05,-5.000E-05,-2.000E-05,
17955 6-4.200E-04, 7.300E-04,-1.600E-04, 5.000E-05, 5.000E-05, 5.000E-05,
17956 1 8.098E-01,-1.042E+00, 3.398E-01,-6.824E-02, 8.760E-03,-9.000E-04,
17957 2 8.961E-01,-1.217E+00, 4.339E-01,-9.287E-02, 1.304E-02,-1.290E-03,
17958 3 3.058E-02,-1.040E-01, 7.604E-02,-2.415E-02, 4.600E-03,-5.000E-04,
17959 4-2.451E-02, 4.432E-02,-1.651E-02, 1.430E-03, 1.200E-04,-1.000E-04,
17960 5 1.122E-02,-1.457E-02, 2.680E-03, 5.800E-04,-1.200E-04, 3.000E-05,
17961 6-7.730E-03, 7.330E-03,-7.600E-04,-2.400E-04, 1.000E-05, 0.000E+00/
17962 DATA (((CEHLQ(IX,IT,NX,6,2),IX=1,6),IT=1,6),NX=1,2)/
17963 1 9.980E-03,-1.945E-02, 1.055E-02,-6.870E-03, 1.860E-03,-1.560E-03,
17964 2 5.700E-03,-1.203E-02, 6.250E-03,-4.860E-03, 1.310E-03,-1.370E-03,
17965 3-4.490E-03, 7.990E-03,-4.170E-03, 2.050E-03,-4.400E-04, 3.300E-04,
17966 4 1.470E-03,-2.480E-03, 1.460E-03,-5.700E-04, 1.200E-04,-1.000E-05,
17967 5-9.000E-05, 1.500E-04,-3.200E-04, 1.200E-04,-6.000E-05,-4.000E-05,
17968 6-4.200E-04, 7.600E-04,-1.400E-04, 4.000E-05, 7.000E-05, 5.000E-05,
17969 1 8.698E-01,-1.131E+00, 3.836E-01,-8.111E-02, 1.048E-02,-1.300E-03,
17970 2 9.626E-01,-1.321E+00, 4.854E-01,-1.091E-01, 1.583E-02,-1.700E-03,
17971 3 3.057E-02,-1.088E-01, 8.022E-02,-2.676E-02, 5.590E-03,-5.600E-04,
17972 4-2.845E-02, 5.164E-02,-1.918E-02, 2.210E-03,-4.000E-05,-1.500E-04,
17973 5 1.311E-02,-1.751E-02, 3.310E-03, 5.100E-04,-1.200E-04, 5.000E-05,
17974 6-8.590E-03, 8.380E-03,-9.200E-04,-2.600E-04, 1.000E-05,-1.000E-05/
17975
17976 DATA (((CEHLQ(IX,IT,NX,7,1),IX=1,6),IT=1,6),NX=1,2)/
17977 1 9.010E-03,-1.401E-02, 7.150E-03,-4.130E-03, 1.260E-03,-1.040E-03,
17978 2 6.280E-03,-9.320E-03, 4.780E-03,-2.890E-03, 9.100E-04,-8.200E-04,
17979 3-2.930E-03, 4.090E-03,-1.890E-03, 7.600E-04,-2.300E-04, 1.400E-04,
17980 4 3.900E-04,-1.200E-03, 4.400E-04,-2.500E-04, 2.000E-05,-2.000E-05,
17981 5 2.600E-04, 1.400E-04,-8.000E-05, 1.000E-04, 1.000E-05, 1.000E-05,
17982 6-2.600E-04, 3.200E-04, 1.000E-05,-1.000E-05, 1.000E-05,-1.000E-05,
17983 1 8.029E-01,-1.075E+00, 3.792E-01,-7.843E-02, 1.007E-02,-1.090E-03,
17984 2 7.903E-01,-1.099E+00, 4.153E-01,-9.301E-02, 1.317E-02,-1.410E-03,
17985 3-1.704E-02,-1.130E-02, 2.882E-02,-1.341E-02, 3.040E-03,-3.600E-04,
17986 4-7.200E-04, 7.230E-03,-5.160E-03, 1.080E-03,-5.000E-05,-4.000E-05,
17987 5 3.050E-03,-4.610E-03, 1.660E-03,-1.300E-04,-1.000E-05, 1.000E-05,
17988 6-4.360E-03, 5.230E-03,-1.610E-03, 2.000E-04,-2.000E-05, 0.000E+00/
17989 DATA (((CEHLQ(IX,IT,NX,7,2),IX=1,6),IT=1,6),NX=1,2)/
17990 1 8.980E-03,-1.459E-02, 7.510E-03,-4.410E-03, 1.310E-03,-1.070E-03,
17991 2 5.970E-03,-9.440E-03, 4.800E-03,-3.020E-03, 9.100E-04,-8.500E-04,
17992 3-3.050E-03, 4.440E-03,-2.100E-03, 8.500E-04,-2.400E-04, 1.400E-04,
17993 4 5.300E-04,-1.300E-03, 5.600E-04,-2.700E-04, 3.000E-05,-2.000E-05,
17994 5 2.000E-04, 1.400E-04,-1.100E-04, 1.000E-04, 0.000E+00, 0.000E+00,
17995 6-2.600E-04, 3.200E-04, 0.000E+00,-3.000E-05, 1.000E-05,-1.000E-05,
17996 1 8.672E-01,-1.174E+00, 4.265E-01,-9.252E-02, 1.244E-02,-1.460E-03,
17997 2 8.500E-01,-1.194E+00, 4.630E-01,-1.083E-01, 1.614E-02,-1.830E-03,
17998 3-2.241E-02,-5.630E-03, 2.815E-02,-1.425E-02, 3.520E-03,-4.300E-04,
17999 4-7.300E-04, 8.030E-03,-5.780E-03, 1.380E-03,-1.300E-04,-4.000E-05,
18000 5 3.460E-03,-5.380E-03, 1.960E-03,-2.100E-04, 1.000E-05, 1.000E-05,
18001 6-4.850E-03, 5.950E-03,-1.890E-03, 2.600E-04,-3.000E-05, 0.000E+00/
18002
18003 DATA (((CEHLQ(IX,IT,NX,8,1),IX=1,6),IT=1,6),NX=1,2)/
18004 1 4.410E-03,-7.480E-03, 3.770E-03,-2.580E-03, 7.300E-04,-7.100E-04,
18005 2 3.840E-03,-6.050E-03, 3.030E-03,-2.030E-03, 5.800E-04,-5.900E-04,
18006 3-8.800E-04, 1.660E-03,-7.500E-04, 4.700E-04,-1.000E-04, 1.000E-04,
18007 4-8.000E-05,-1.500E-04, 1.200E-04,-9.000E-05, 3.000E-05, 0.000E+00,
18008 5 1.300E-04,-2.200E-04,-2.000E-05,-2.000E-05,-2.000E-05,-2.000E-05,
18009 6-7.000E-05, 1.900E-04,-4.000E-05, 2.000E-05, 0.000E+00, 0.000E+00,
18010 1 6.623E-01,-9.248E-01, 3.519E-01,-7.930E-02, 1.110E-02,-1.180E-03,
18011 2 6.380E-01,-9.062E-01, 3.582E-01,-8.479E-02, 1.265E-02,-1.390E-03,
18012 3-2.581E-02, 2.125E-02, 4.190E-03,-4.980E-03, 1.490E-03,-2.100E-04,
18013 4 7.100E-04, 5.300E-04,-1.270E-03, 3.900E-04,-5.000E-05,-1.000E-05,
18014 5 3.850E-03,-5.060E-03, 1.860E-03,-3.500E-04, 4.000E-05, 0.000E+00,
18015 6-3.530E-03, 4.460E-03,-1.500E-03, 2.700E-04,-3.000E-05, 0.000E+00/
18016 DATA (((CEHLQ(IX,IT,NX,8,2),IX=1,6),IT=1,6),NX=1,2)/
18017 1 4.260E-03,-7.530E-03, 3.830E-03,-2.680E-03, 7.600E-04,-7.300E-04,
18018 2 3.640E-03,-6.050E-03, 3.030E-03,-2.090E-03, 5.900E-04,-6.000E-04,
18019 3-9.200E-04, 1.710E-03,-8.200E-04, 5.000E-04,-1.200E-04, 1.000E-04,
18020 4-5.000E-05,-1.600E-04, 1.300E-04,-9.000E-05, 3.000E-05, 0.000E+00,
18021 5 1.300E-04,-2.100E-04,-1.000E-05,-2.000E-05,-2.000E-05,-1.000E-05,
18022 6-8.000E-05, 1.800E-04,-5.000E-05, 2.000E-05, 0.000E+00, 0.000E+00,
18023 1 7.146E-01,-1.007E+00, 3.932E-01,-9.246E-02, 1.366E-02,-1.540E-03,
18024 2 6.856E-01,-9.828E-01, 3.977E-01,-9.795E-02, 1.540E-02,-1.790E-03,
18025 3-3.053E-02, 2.758E-02, 2.150E-03,-4.880E-03, 1.640E-03,-2.500E-04,
18026 4 9.200E-04, 4.200E-04,-1.340E-03, 4.600E-04,-8.000E-05,-1.000E-05,
18027 5 4.230E-03,-5.660E-03, 2.140E-03,-4.300E-04, 6.000E-05, 0.000E+00,
18028 6-3.890E-03, 5.000E-03,-1.740E-03, 3.300E-04,-4.000E-05, 0.000E+00/
18029
18030
18031
18032
18033 DATA ((CDO(IP,IS,1,1),IS=1,6),IP=1,3)/
18034 1 4.190E-01, 3.460E+00, 4.400E+00, 0.000E+00, 0.000E+00, 0.000E+00,
18035 2 4.000E-03, 7.240E-01,-4.860E+00, 0.000E+00, 0.000E+00, 0.000E+00,
18036 3-7.000E-03,-6.600E-02, 1.330E+00, 0.000E+00, 0.000E+00, 0.000E+00/
18037 DATA ((CDO(IP,IS,1,2),IS=1,6),IP=1,3)/
18038 1 3.740E-01, 3.330E+00, 6.030E+00, 0.000E+00, 0.000E+00, 0.000E+00,
18039 2 1.400E-02, 7.530E-01,-6.220E+00, 0.000E+00, 0.000E+00, 0.000E+00,
18040 3 0.000E+00,-7.600E-02, 1.560E+00, 0.000E+00, 0.000E+00, 0.000E+00/
18041
18042 DATA ((CDO(IP,IS,2,1),IS=1,6),IP=1,3)/
18043 1 7.630E-01, 4.000E+00, 0.000E+00, 0.000E+00, 0.000E+00, 0.000E+00,
18044 2-2.370E-01, 6.270E-01,-4.210E-01, 0.000E+00, 0.000E+00, 0.000E+00,
18045 3 2.600E-02,-1.900E-02, 3.300E-02, 0.000E+00, 0.000E+00, 0.000E+00/
18046 DATA ((CDO(IP,IS,2,2),IS=1,6),IP=1,3)/
18047 1 7.610E-01, 3.830E+00, 0.000E+00, 0.000E+00, 0.000E+00, 0.000E+00,
18048 2-2.320E-01, 6.270E-01,-4.180E-01, 0.000E+00, 0.000E+00, 0.000E+00,
18049 3 2.300E-02,-1.900E-02, 3.600E-02, 0.000E+00, 0.000E+00, 0.000E+00/
18050
18051 DATA ((CDO(IP,IS,3,1),IS=1,6),IP=1,3)/
18052 1 1.265E+00, 0.000E+00, 8.050E+00, 0.000E+00, 0.000E+00, 0.000E+00,
18053 2-1.132E+00,-3.720E-01, 1.590E+00, 6.310E+00,-1.050E+01, 1.470E+01,
18054 3 2.930E-01,-2.900E-02,-1.530E-01,-2.730E-01,-3.170E+00, 9.800E+00/
18055 DATA ((CDO(IP,IS,3,2),IS=1,6),IP=1,3)/
18056 1 1.670E+00, 0.000E+00, 9.150E+00, 0.000E+00, 0.000E+00, 0.000E+00,
18057 2-1.920E+00,-2.730E-01, 5.300E-01, 1.570E+01,-1.010E+02, 2.230E+02,
18058 3 5.820E-01,-1.640E-01,-7.630E-01,-2.830E+00, 4.470E+01,-1.170E+02/
18059
18060 DATA ((CDO(IP,IS,4,1),IS=1,6),IP=1,3)/
18061 1 0.000E+00,-3.600E-02, 6.350E+00, 0.000E+00, 0.000E+00, 0.000E+00,
18062 2 1.350E-01,-2.220E-01, 3.260E+00,-3.030E+00, 1.740E+01,-1.790E+01,
18063 3-7.500E-02,-5.800E-02,-9.090E-01, 1.500E+00,-1.130E+01, 1.560E+01/
18064 DATA ((CDO(IP,IS,4,2),IS=1,6),IP=1,3)/
18065 1 0.000E+00,-1.200E-01, 3.510E+00, 0.000E+00, 0.000E+00, 0.000E+00,
18066 2 6.700E-02,-2.330E-01, 3.660E+00,-4.740E-01, 9.500E+00,-1.660E+01,
18067 3-3.100E-02,-2.300E-02,-4.530E-01, 3.580E-01,-5.430E+00, 1.550E+01/
18068
18069 DATA ((CDO(IP,IS,5,1),IS=1,6),IP=1,3)/
18070 1 1.560E+00, 0.000E+00, 6.000E+00, 9.000E+00, 0.000E+00, 0.000E+00,
18071 2-1.710E+00,-9.490E-01, 1.440E+00,-7.190E+00,-1.650E+01, 1.530E+01,
18072 3 6.380E-01, 3.250E-01,-1.050E+00, 2.550E-01, 1.090E+01,-1.010E+01/
18073 DATA ((CDO(IP,IS,5,2),IS=1,6),IP=1,3)/
18074 1 8.790E-01, 0.000E+00, 4.000E+00, 9.000E+00, 0.000E+00, 0.000E+00,
18075 2-9.710E-01,-1.160E+00, 1.230E+00,-5.640E+00,-7.540E+00,-5.960E-01,
18076 3 4.340E-01, 4.760E-01,-2.540E-01,-8.170E-01, 5.500E+00, 1.260E-01/
18077
18078
18079
18080
18081 DATA ((COW(IP,IS,1,1),IS=1,5),IP=1,3)/
18082 1 4.0000E-01, 7.0000E-01, 0.0000E+00, 0.0000E+00, 0.0000E+00,
18083 2 -6.2120E-02, 6.4780E-01, 0.0000E+00, 0.0000E+00, 0.0000E+00,
18084 3 -7.1090E-03, 1.3350E-02, 0.0000E+00, 0.0000E+00, 0.0000E+00/
18085 DATA ((COW(IP,IS,1,2),IS=1,5),IP=1,3)/
18086 1 4.0000E-01, 6.2800E-01, 0.0000E+00, 0.0000E+00, 0.0000E+00,
18087 2 -5.9090E-02, 6.4360E-01, 0.0000E+00, 0.0000E+00, 0.0000E+00,
18088 3 -6.5240E-03, 1.4510E-02, 0.0000E+00, 0.0000E+00, 0.0000E+00/
18089
18090 DATA ((COW(IP,IS,2,1),IS=1,5),IP=1,3)/
18091 1 8.8800E-01, 0.0000E+00, 3.1100E+00, 6.0000E+00, 0.0000E+00,
18092 2 -1.8020E+00, -1.5760E+00, -1.3170E-01, 2.8010E+00, -1.7280E+01,
18093 3 1.8120E+00, 1.2000E+00, 5.0680E-01, -1.2160E+01, 2.0490E+01/
18094 DATA ((COW(IP,IS,2,2),IS=1,5),IP=1,3)/
18095 1 7.9400E-01, 0.0000E+00, 2.8900E+00, 6.0000E+00, 0.0000E+00,
18096 2 -9.1440E-01, -1.2370E+00, 5.9660E-01, -3.6710E+00, -8.1910E+00,
18097 3 5.9660E-01, 6.5820E-01, -2.5500E-01, -2.3040E+00, 7.7580E+00/
18098
18099 DATA ((COW(IP,IS,3,1),IS=1,5),IP=1,3)/
18100 1 9.0000E-01, 0.0000E+00, 5.0000E+00, 0.0000E+00, 0.0000E+00,
18101 2 -2.4280E-01, -2.1200E-01, 8.6730E-01, 1.2660E+00, 2.3820E+00,
18102 3 1.3860E-01, 3.6710E-03, 4.7470E-02, -2.2150E+00, 3.4820E-01/
18103 DATA ((COW(IP,IS,3,2),IS=1,5),IP=1,3)/
18104 1 9.0000E-01, 0.0000E+00, 5.0000E+00, 0.0000E+00, 0.0000E+00,
18105 2 -1.4170E-01, -1.6970E-01, -2.4740E+00, -2.5340E+00, 5.6210E-01,
18106 3 -1.7400E-01, -9.6230E-02, 1.5750E+00, 1.3780E+00, -2.7010E-01/
18107
18108 DATA ((COW(IP,IS,4,1),IS=1,5),IP=1,3)/
18109 1 0.0000E+00, -2.2120E-02, 2.8940E+00, 0.0000E+00, 0.0000E+00,
18110 2 7.9280E-02, -3.7850E-01, 9.4330E+00, 5.2480E+00, 8.3880E+00,
18111 3 -6.1340E-02, -1.0880E-01, -1.0852E+01, -7.1870E+00, -1.1610E+01/
18112 DATA ((COW(IP,IS,4,2),IS=1,5),IP=1,3)/
18113 1 0.0000E+00, -8.8200E-02, 1.9240E+00, 0.0000E+00, 0.0000E+00,
18114 2 6.2290E-02, -2.8920E-01, 2.4240E-01, -4.4630E+00, -8.3670E-01,
18115 3 -4.0990E-02, -1.0820E-01, 2.0360E+00, 5.2090E+00, -4.8400E-02/
18116
18117
18118 EULBET(X,Y)=PYGAMM(X)*PYGAMM(Y)/PYGAMM(X+Y)
18119
18120
18121 ALAM=0.
18122 DO 100 KFL=-6,6
18123 100 XPQ(KFL)=0.
18124 IF(X.LT.0..OR.X.GT.1.) THEN
18125 WRITE(MSTU(11),1000) X
18126 RETURN
18127 ENDIF
18128 KFA=IABS(KF)
18129 IF(KFA.NE.211.AND.KFA.NE.2212.AND.KFA.NE.2112) THEN
18130 WRITE(MSTU(11),1100) KF
18131 RETURN
18132 ENDIF
18133
18134
18135 IF(MSTP(51).EQ.0.OR.MSTP(52).GE.2) THEN
18136 KFE=KFA
18137 IF(KFA.EQ.2112) KFE=2212
18138 CALL PYSTFE(KFE,X,Q2,XPQ)
18139 GOTO 230
18140 ENDIF
18141 IF(KFA.EQ.211) GOTO 200
18142
18143 IF(MSTP(51).EQ.1.OR.MSTP(51).EQ.2) THEN
18144
18145
18146
18147
18148 NSET=MSTP(51)
18149 IF(NSET.EQ.1) ALAM=0.2
18150 IF(NSET.EQ.2) ALAM=0.29
18151 TMIN=LOG(5./ALAM**2)
18152 TMAX=LOG(1E8/ALAM**2)
18153 IF(MSTP(52).EQ.0) THEN
18154 T=TMIN
18155 ELSE
18156 T=LOG(Q2/ALAM**2)
18157 ENDIF
18158 VT=MAX(-1.,MIN(1.,(2.*T-TMAX-TMIN)/(TMAX-TMIN)))
18159 NX=1
18160 IF(X.LE.0.1) NX=2
18161 IF(NX.EQ.1) VX=(2.*X-1.1)/0.9
18162 IF(NX.EQ.2) VX=MAX(-1.,(2.*LOG(X)+11.51293)/6.90776)
18163 CXS=1.
18164 IF(X.LT.1E-4.AND.ABS(PARP(51)-1.).GT.0.01) CXS=
18165 & (1E-4/X)**(PARP(51)-1.)
18166
18167
18168 TX(1)=1.
18169 TX(2)=VX
18170 TX(3)=2.*VX**2-1.
18171 TX(4)=4.*VX**3-3.*VX
18172 TX(5)=8.*VX**4-8.*VX**2+1.
18173 TX(6)=16.*VX**5-20.*VX**3+5.*VX
18174 TT(1)=1.
18175 TT(2)=VT
18176 TT(3)=2.*VT**2-1.
18177 TT(4)=4.*VT**3-3.*VT
18178 TT(5)=8.*VT**4-8.*VT**2+1.
18179 TT(6)=16.*VT**5-20.*VT**3+5.*VT
18180
18181
18182 DO 120 KFL=1,6
18183 XQSUM=0.
18184 DO 110 IT=1,6
18185 DO 110 IX=1,6
18186 110 XQSUM=XQSUM+CEHLQ(IX,IT,NX,KFL,NSET)*TX(IX)*TT(IT)
18187 120 XQ(KFL)=XQSUM*(1.-X)**NEHLQ(KFL,NSET)*CXS
18188
18189
18190 XPQ(0)=XQ(4)
18191 XPQ(1)=XQ(2)+XQ(3)
18192 XPQ(2)=XQ(1)+XQ(3)
18193 XPQ(3)=XQ(5)
18194 XPQ(4)=XQ(6)
18195 XPQ(-1)=XQ(3)
18196 XPQ(-2)=XQ(3)
18197 XPQ(-3)=XQ(5)
18198 XPQ(-4)=XQ(6)
18199
18200
18201 IF(MSTP(54).GE.5) THEN
18202 IF(NSET.EQ.1) TMIN=8.1905
18203 IF(NSET.EQ.2) TMIN=7.4474
18204 IF(T.LE.TMIN) GOTO 140
18205 VT=MAX(-1.,MIN(1.,(2.*T-TMAX-TMIN)/(TMAX-TMIN)))
18206 TT(1)=1.
18207 TT(2)=VT
18208 TT(3)=2.*VT**2-1.
18209 TT(4)=4.*VT**3-3.*VT
18210 TT(5)=8.*VT**4-8.*VT**2+1.
18211 TT(6)=16.*VT**5-20.*VT**3+5.*VT
18212 XQSUM=0.
18213 DO 130 IT=1,6
18214 DO 130 IX=1,6
18215 130 XQSUM=XQSUM+CEHLQ(IX,IT,NX,7,NSET)*TX(IX)*TT(IT)
18216 XPQ(5)=XQSUM*(1.-X)**NEHLQ(7,NSET)
18217 XPQ(-5)=XPQ(5)
18218 140 CONTINUE
18219 ENDIF
18220
18221
18222 IF(MSTP(54).GE.6) THEN
18223 IF(NSET.EQ.1) TMIN=11.5528
18224 IF(NSET.EQ.2) TMIN=10.8097
18225 TMIN=TMIN+2.*LOG(PMAS(6,1)/30.)
18226 TMAX=TMAX+2.*LOG(PMAS(6,1)/30.)
18227 IF(T.LE.TMIN) GOTO 160
18228 VT=MAX(-1.,MIN(1.,(2.*T-TMAX-TMIN)/(TMAX-TMIN)))
18229 TT(1)=1.
18230 TT(2)=VT
18231 TT(3)=2.*VT**2-1.
18232 TT(4)=4.*VT**3-3.*VT
18233 TT(5)=8.*VT**4-8.*VT**2+1.
18234 TT(6)=16.*VT**5-20.*VT**3+5.*VT
18235 XQSUM=0.
18236 DO 150 IT=1,6
18237 DO 150 IX=1,6
18238 150 XQSUM=XQSUM+CEHLQ(IX,IT,NX,8,NSET)*TX(IX)*TT(IT)
18239 XPQ(6)=XQSUM*(1.-X)**NEHLQ(8,NSET)
18240 XPQ(-6)=XPQ(6)
18241 160 CONTINUE
18242 ENDIF
18243
18244 ELSEIF(MSTP(51).EQ.3.OR.MSTP(51).EQ.4) THEN
18245
18246
18247
18248
18249 NSET=MSTP(51)-2
18250 IF(NSET.EQ.1) ALAM=0.2
18251 IF(NSET.EQ.2) ALAM=0.4
18252 IF(MSTP(52).LE.0) THEN
18253 SD=0.
18254 ELSE
18255 SD=LOG(LOG(MAX(Q2,4.)/ALAM**2)/LOG(4./ALAM**2))
18256 ENDIF
18257
18258
18259 DO 180 KFL=1,5
18260 DO 170 IS=1,6
18261 170 TS(IS)=CDO(1,IS,KFL,NSET)+CDO(2,IS,KFL,NSET)*SD+
18262 & CDO(3,IS,KFL,NSET)*SD**2
18263 IF(KFL.LE.2) THEN
18264 XQ(KFL)=X**TS(1)*(1.-X)**TS(2)*(1.+TS(3)*X)/(EULBET(TS(1),
18265 & TS(2)+1.)*(1.+TS(3)*TS(1)/(TS(1)+TS(2)+1.)))
18266 ELSE
18267 XQ(KFL)=TS(1)*X**TS(2)*(1.-X)**TS(3)*(1.+TS(4)*X+TS(5)*X**2+
18268 & TS(6)*X**3)
18269 ENDIF
18270 180 CONTINUE
18271
18272
18273 XPQ(0)=XQ(5)
18274 XPQ(1)=XQ(2)+XQ(3)/6.
18275 XPQ(2)=3.*XQ(1)-XQ(2)+XQ(3)/6.
18276 XPQ(3)=XQ(3)/6.
18277 XPQ(4)=XQ(4)
18278 XPQ(-1)=XQ(3)/6.
18279 XPQ(-2)=XQ(3)/6.
18280 XPQ(-3)=XQ(3)/6.
18281 XPQ(-4)=XQ(4)
18282
18283
18284
18285
18286 ELSEIF(MSTP(51).GE.11.AND.MSTP(51).LE.13) THEN
18287 CALL PYSTFE(2212,X,Q2,XPQ)
18288
18289
18290 ELSE
18291 WRITE(MSTU(11),1200) MSTP(51)
18292 ENDIF
18293 GOTO 230
18294
18295 200 IF((MSTP(51).GE.1.AND.MSTP(51).LE.4).OR.
18296 &(MSTP(51).GE.11.AND.MSTP(51).LE.13)) THEN
18297
18298
18299
18300
18301 NSET=1
18302 IF(MSTP(51).EQ.2.OR.MSTP(51).EQ.4.OR.MSTP(51).EQ.13) NSET=2
18303 IF(NSET.EQ.1) ALAM=0.2
18304 IF(NSET.EQ.2) ALAM=0.4
18305 IF(MSTP(52).LE.0) THEN
18306 SD=0.
18307 ELSE
18308 SD=LOG(LOG(MAX(Q2,4.)/ALAM**2)/LOG(4./ALAM**2))
18309 ENDIF
18310
18311
18312 DO 220 KFL=1,4
18313 DO 210 IS=1,5
18314 210 TS(IS)=COW(1,IS,KFL,NSET)+COW(2,IS,KFL,NSET)*SD+
18315 & COW(3,IS,KFL,NSET)*SD**2
18316 IF(KFL.EQ.1) THEN
18317 XQ(KFL)=X**TS(1)*(1.-X)**TS(2)/EULBET(TS(1),TS(2)+1.)
18318 ELSE
18319 XQ(KFL)=TS(1)*X**TS(2)*(1.-X)**TS(3)*(1.+TS(4)*X+TS(5)*X**2)
18320 ENDIF
18321 220 CONTINUE
18322
18323
18324 XPQ(0)=XQ(2)
18325 XPQ(1)=XQ(3)/6.
18326 XPQ(2)=XQ(1)+XQ(3)/6.
18327 XPQ(3)=XQ(3)/6.
18328 XPQ(4)=XQ(4)
18329 XPQ(-1)=XQ(1)+XQ(3)/6.
18330 XPQ(-2)=XQ(3)/6.
18331 XPQ(-3)=XQ(3)/6.
18332 XPQ(-4)=XQ(4)
18333
18334
18335 ELSE
18336 WRITE(MSTU(11),1200) MSTP(51)
18337 ENDIF
18338
18339
18340 230 IF(KFA.EQ.2112) THEN
18341 XPS=XPQ(1)
18342 XPQ(1)=XPQ(2)
18343 XPQ(2)=XPS
18344 XPS=XPQ(-1)
18345 XPQ(-1)=XPQ(-2)
18346 XPQ(-2)=XPS
18347 ENDIF
18348 IF(KF.LT.0) THEN
18349 DO 240 KFL=1,4
18350 XPS=XPQ(KFL)
18351 XPQ(KFL)=XPQ(-KFL)
18352 240 XPQ(-KFL)=XPS
18353 ENDIF
18354
18355
18356 DO 250 KFL=-6,6
18357 XPQ(KFL)=MAX(0.,XPQ(KFL))
18358 250 IF(IABS(KFL).GT.MSTP(54)) XPQ(KFL)=0.
18359
18360
18361 IF((JBT.NE.1.AND.JBT.NE.2).OR.IHPR2(6).EQ.0
18362 & .OR.IHNT2(16).EQ.1) GO TO 400
18363 ATNM=IHNT2(2*JBT-1)
18364 IF(ATNM.LE.1.0) GO TO 400
18365 IF(JBT.EQ.1) THEN
18366 BBR2=(YP(1,IHNT2(11))**2+YP(2,IHNT2(11))**2)/1.44/ATNM**0.66666
18367 ELSEIF(JBT.EQ.2) THEN
18368 BBR2=(YT(1,IHNT2(12))**2+YT(2,IHNT2(12))**2)/1.44/ATNM**0.66666
18369 ENDIF
18370 BBR2=MIN(1.0,BBR2)
18371 ABX=(ATNM**0.33333333-1.0)
18372 APX=HIPR1(6)*4.0/3.0*ABX*SQRT(1.0-BBR2)
18373 AAX=1.192*ALOG(ATNM)**0.1666666
18374 RRX=AAX*(X**3-1.2*X**2+0.21*X)+1.0
18375 & -(APX-1.079*ABX*SQRT(X)/ALOG(ATNM+1.0))*EXP(-X**2.0/0.01)
18376 DO 300 KFL=-6,6
18377 XPQ(KFL)=XPQ(KFL)*RRX
18378 300 CONTINUE
18379
18380
18381
18382
18383 400 CONTINUE
18384
18385 1000 FORMAT(' Error: x value outside physical range, x =',1P,E12.3)
18386 1100 FORMAT(' Error: illegal particle code for structure function,',
18387 &' KF =',I5)
18388 1200 FORMAT(' Error: bad value of parameter MSTP(51) in PYSTFU,',
18389 &' MSTP(51) =',I5)
18390
18391 RETURN
18392 END
18393
18394
18395
18396 SUBROUTINE PYSPLI(KF,KFLIN,KFLCH,KFLSP)
18397
18398
18399
18400 DIMENSION KFL(3)
18401
18402
18403 KFA=IABS(KF)
18404 KFS=ISIGN(1,KF)
18405 KFL(1)=MOD(KFA/1000,10)
18406 KFL(2)=MOD(KFA/100,10)
18407 KFL(3)=MOD(KFA/10,10)
18408 KFLR=KFLIN*KFS
18409 KFLCH=0
18410
18411
18412 IF(KFL(1).EQ.0) THEN
18413 KFL(2)=KFL(2)*(-1)**KFL(2)
18414 KFL(3)=-KFL(3)*(-1)**IABS(KFL(2))
18415 IF(KFLR.EQ.KFL(2)) THEN
18416 KFLSP=KFL(3)
18417 ELSEIF(KFLR.EQ.KFL(3)) THEN
18418 KFLSP=KFL(2)
18419 ELSEIF(IABS(KFLR).EQ.21.AND.RLU(0).GT.0.5) THEN
18420 KFLSP=KFL(2)
18421 KFLCH=KFL(3)
18422 ELSEIF(IABS(KFLR).EQ.21) THEN
18423 KFLSP=KFL(3)
18424 KFLCH=KFL(2)
18425 ELSEIF(KFLR*KFL(2).GT.0) THEN
18426 CALL LUKFDI(-KFLR,KFL(2),KFDUMP,KFLCH)
18427 KFLSP=KFL(3)
18428 ELSE
18429 CALL LUKFDI(-KFLR,KFL(3),KFDUMP,KFLCH)
18430 KFLSP=KFL(2)
18431 ENDIF
18432
18433
18434 ELSE
18435 NAGR=0
18436 DO 100 J=1,3
18437 100 IF(KFLR.EQ.KFL(J)) NAGR=NAGR+1
18438 IF(NAGR.GE.1) THEN
18439 RAGR=0.00001+(NAGR-0.00002)*RLU(0)
18440 IAGR=0
18441 DO 110 J=1,3
18442 IF(KFLR.EQ.KFL(J)) RAGR=RAGR-1.
18443 110 IF(IAGR.EQ.0.AND.RAGR.LE.0.) IAGR=J
18444 ELSE
18445 IAGR=1.00001+2.99998*RLU(0)
18446 ENDIF
18447 ID1=1
18448 IF(IAGR.EQ.1) ID1=2
18449 IF(IAGR.EQ.1.AND.KFL(3).GT.KFL(2)) ID1=3
18450 ID2=6-IAGR-ID1
18451 KSP=3
18452 IF(MOD(KFA,10).EQ.2.AND.KFL(1).EQ.KFL(2)) THEN
18453 IF(IAGR.NE.3.AND.RLU(0).GT.0.25) KSP=1
18454 ELSEIF(MOD(KFA,10).EQ.2.AND.KFL(2).GE.KFL(3)) THEN
18455 IF(IAGR.NE.1.AND.RLU(0).GT.0.25) KSP=1
18456 ELSEIF(MOD(KFA,10).EQ.2) THEN
18457 IF(IAGR.EQ.1) KSP=1
18458 IF(IAGR.NE.1.AND.RLU(0).GT.0.75) KSP=1
18459 ENDIF
18460 KFLSP=1000*KFL(ID1)+100*KFL(ID2)+KSP
18461 IF(KFLIN.EQ.21) THEN
18462 KFLCH=KFL(IAGR)
18463 ELSEIF(NAGR.EQ.0.AND.KFLR.GT.0) THEN
18464 CALL LUKFDI(-KFLR,KFL(IAGR),KFDUMP,KFLCH)
18465 ELSEIF(NAGR.EQ.0) THEN
18466 CALL LUKFDI(10000+KFLSP,-KFLR,KFDUMP,KFLCH)
18467 KFLSP=KFL(IAGR)
18468 ENDIF
18469 ENDIF
18470
18471
18472 KFLCH=KFLCH*KFS
18473 KFLSP=KFLSP*KFS
18474
18475 RETURN
18476 END
18477
18478
18479
18480 FUNCTION PYGAMM(X)
18481
18482
18483
18484
18485 DIMENSION B(8)
18486 DATA B/-0.577191652,0.988205891,-0.897056937,0.918206857,
18487 &-0.756704078,0.482199394,-0.193527818,0.035868343/
18488
18489 NX=INT(X)
18490 DX=X-NX
18491
18492 PYGAMM=1.
18493 DO 100 I=1,8
18494 100 PYGAMM=PYGAMM+B(I)*DX**I
18495 IF(X.LT.1.) THEN
18496 PYGAMM=PYGAMM/X
18497 ELSE
18498 DO 110 IX=1,NX-1
18499 110 PYGAMM=(X-IX)*PYGAMM
18500 ENDIF
18501
18502 RETURN
18503 END
18504
18505
18506
18507 FUNCTION PYW1AU(EPS,IREIM)
18508
18509
18510
18511
18512 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
18513 SAVE
18514
18515 ASINH(X)=LOG(X+SQRT(X**2+1.))
18516 ACOSH(X)=LOG(X+SQRT(X**2-1.))
18517
18518 IF(EPS.LT.0.) THEN
18519 W1RE=2.*SQRT(1.-EPS)*ASINH(SQRT(-1./EPS))
18520 W1IM=0.
18521 ELSEIF(EPS.LT.1.) THEN
18522 W1RE=2.*SQRT(1.-EPS)*ACOSH(SQRT(1./EPS))
18523 W1IM=-PARU(1)*SQRT(1.-EPS)
18524 ELSE
18525 W1RE=2.*SQRT(EPS-1.)*ASIN(SQRT(1./EPS))
18526 W1IM=0.
18527 ENDIF
18528
18529
18530 PYW1AU=W1RE
18531 IF(IREIM.EQ.2) PYW1AU=W1IM
18532
18533 RETURN
18534 END
18535
18536
18537
18538 FUNCTION PYW2AU(EPS,IREIM)
18539
18540
18541
18542
18543 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
18544 SAVE
18545
18546 ASINH(X)=LOG(X+SQRT(X**2+1.))
18547 ACOSH(X)=LOG(X+SQRT(X**2-1.))
18548
18549 IF(EPS.LT.0.) THEN
18550 W2RE=4.*(ASINH(SQRT(-1./EPS)))**2
18551 W2IM=0.
18552 ELSEIF(EPS.LT.1.) THEN
18553 W2RE=4.*(ACOSH(SQRT(1./EPS)))**2-PARU(1)**2
18554 W2IM=-4.*PARU(1)*ACOSH(SQRT(1./EPS))
18555 ELSE
18556 W2RE=-4.*(ASIN(SQRT(1./EPS)))**2
18557 W2IM=0.
18558 ENDIF
18559
18560
18561 PYW2AU=W2RE
18562 IF(IREIM.EQ.2) PYW2AU=W2IM
18563
18564 RETURN
18565 END
18566
18567
18568
18569 FUNCTION PYI3AU(BE,EPS,IREIM)
18570
18571
18572
18573
18574 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
18575 SAVE
18576
18577 PYI3AU=0.
18578
18579 IF(EPS.LT.1.) GA=0.5*(1.+SQRT(1.-EPS))
18580
18581 IF(EPS.LT.0.) THEN
18582 F3RE=PYSPEN((GA-1.)/(GA+BE-1.),0.,1)-PYSPEN(GA/(GA+BE-1.),0.,1)+
18583 & PYSPEN((BE-GA)/BE,0.,1)-PYSPEN((BE-GA)/(BE-1.),0.,1)+
18584 & (LOG(BE)**2-LOG(BE-1.)**2)/2.+LOG(GA)*LOG((GA+BE-1.)/BE)+
18585 & LOG(GA-1.)*LOG((BE-1.)/(GA+BE-1.))
18586 F3IM=0.
18587 ELSEIF(EPS.LT.1.) THEN
18588 F3RE=PYSPEN((GA-1.)/(GA+BE-1.),0.,1)-PYSPEN(GA/(GA+BE-1.),0.,1)+
18589 & PYSPEN(GA/(GA-BE),0.,1)-PYSPEN((GA-1.)/(GA-BE),0.,1)+
18590 & LOG(GA/(1.-GA))*LOG((GA+BE-1.)/(BE-GA))
18591 F3IM=-PARU(1)*LOG((GA+BE-1.)/(BE-GA))
18592 ELSE
18593 RSQ=EPS/(EPS-1.+(2.*BE-1.)**2)
18594 RCTHE=RSQ*(1.-2.*BE/EPS)
18595 RSTHE=SQRT(RSQ-RCTHE**2)
18596 RCPHI=RSQ*(1.+2.*(BE-1.)/EPS)
18597 RSPHI=SQRT(RSQ-RCPHI**2)
18598 R=SQRT(RSQ)
18599 THE=ACOS(RCTHE/R)
18600 PHI=ACOS(RCPHI/R)
18601 F3RE=PYSPEN(RCTHE,RSTHE,1)+PYSPEN(RCTHE,-RSTHE,1)-
18602 & PYSPEN(RCPHI,RSPHI,1)-PYSPEN(RCPHI,-RSPHI,1)+
18603 & (PHI-THE)*(PHI+THE-PARU(1))
18604 F3IM=PYSPEN(RCTHE,RSTHE,2)+PYSPEN(RCTHE,-RSTHE,2)-
18605 & PYSPEN(RCPHI,RSPHI,2)-PYSPEN(RCPHI,-RSPHI,2)
18606 ENDIF
18607
18608 IF(IREIM.EQ.1) PYI3AU=2./(2.*BE-1.)*F3RE
18609 IF(IREIM.EQ.2) PYI3AU=2./(2.*BE-1.)*F3IM
18610
18611 RETURN
18612 END
18613
18614
18615
18616 FUNCTION PYSPEN(XREIN,XIMIN,IREIM)
18617
18618
18619
18620 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
18621 DIMENSION B(0:14)
18622 SAVE
18623
18624 DATA B/
18625 & 1.000000E+00, -5.000000E-01, 1.666667E-01,
18626 & 0.000000E+00, -3.333333E-02, 0.000000E+00,
18627 & 2.380952E-02, 0.000000E+00, -3.333333E-02,
18628 & 0.000000E+00, 7.575757E-02, 0.000000E+00,
18629 &-2.531135E-01, 0.000000E+00, 1.166667E+00/
18630
18631 XRE=XREIN
18632 XIM=XIMIN
18633 PYSPEN=0.
18634 IF(ABS(1.-XRE).LT.1.E-6.AND.ABS(XIM).LT.1.E-6) THEN
18635 IF(IREIM.EQ.1) PYSPEN=PARU(1)**2/6.
18636 IF(IREIM.EQ.2) PYSPEN=0.
18637 RETURN
18638 ENDIF
18639
18640 XMOD=SQRT(XRE**2+XIM**2)
18641 IF(XMOD.LT.1.E-6) THEN
18642 IF(IREIM.EQ.1) PYSPEN=0.
18643 IF(IREIM.EQ.2) PYSPEN=0.
18644 RETURN
18645 ENDIF
18646
18647 XARG=SIGN(ACOS(XRE/XMOD),XIM)
18648 SP0RE=0.
18649 SP0IM=0.
18650 SGN=1.
18651 IF(XMOD.GT.1.) THEN
18652 ALGXRE=LOG(XMOD)
18653 ALGXIM=XARG-SIGN(PARU(1),XARG)
18654 SP0RE=-PARU(1)**2/6.-(ALGXRE**2-ALGXIM**2)/2.
18655 SP0IM=-ALGXRE*ALGXIM
18656 SGN=-1.
18657 XMOD=1./XMOD
18658 XARG=-XARG
18659 XRE=XMOD*COS(XARG)
18660 XIM=XMOD*SIN(XARG)
18661 ENDIF
18662 IF(XRE.GT.0.5) THEN
18663 ALGXRE=LOG(XMOD)
18664 ALGXIM=XARG
18665 XRE=1.-XRE
18666 XIM=-XIM
18667 XMOD=SQRT(XRE**2+XIM**2)
18668 XARG=SIGN(ACOS(XRE/XMOD),XIM)
18669 ALGYRE=LOG(XMOD)
18670 ALGYIM=XARG
18671 SP0RE=SP0RE+SGN*(PARU(1)**2/6.-(ALGXRE*ALGYRE-ALGXIM*ALGYIM))
18672 SP0IM=SP0IM-SGN*(ALGXRE*ALGYIM+ALGXIM*ALGYRE)
18673 SGN=-SGN
18674 ENDIF
18675
18676 XRE=1.-XRE
18677 XIM=-XIM
18678 XMOD=SQRT(XRE**2+XIM**2)
18679 XARG=SIGN(ACOS(XRE/XMOD),XIM)
18680 ZRE=-LOG(XMOD)
18681 ZIM=-XARG
18682
18683 SPRE=0.
18684 SPIM=0.
18685 SAVERE=1.
18686 SAVEIM=0.
18687 DO 100 I=0,14
18688 TERMRE=(SAVERE*ZRE-SAVEIM*ZIM)/FLOAT(I+1)
18689 TERMIM=(SAVERE*ZIM+SAVEIM*ZRE)/FLOAT(I+1)
18690 SAVERE=TERMRE
18691 SAVEIM=TERMIM
18692 SPRE=SPRE+B(I)*TERMRE
18693 100 SPIM=SPIM+B(I)*TERMIM
18694
18695 IF(IREIM.EQ.1) PYSPEN=SP0RE+SGN*SPRE
18696 IF(IREIM.EQ.2) PYSPEN=SP0IM+SGN*SPIM
18697
18698 RETURN
18699 END
18700
18701
18702
18703 SUBROUTINE PYTEST(MTEST)
18704
18705
18706
18707 COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
18708 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
18709 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
18710 COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)
18711 COMMON/PYSUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
18712 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
18713 SAVE
18714
18715
18716 MSTP(122)=1
18717 IF(MTEST.LE.0) MSTP(122)=0
18718 MDCY(LUCOMP(111),1)=0
18719 NERR=0
18720 DO 130 IPROC=1,7
18721
18722
18723 MSEL=0
18724 DO 100 ISUB=1,200
18725 100 MSUB(ISUB)=0
18726 CKIN(1)=2.
18727 CKIN(3)=0.
18728 MSTP(2)=1
18729 MSTP(33)=0
18730 MSTP(81)=1
18731 MSTP(82)=1
18732 MSTP(111)=1
18733 MSTP(131)=0
18734 MSTP(133)=0
18735 PARP(131)=0.01
18736
18737
18738 IF(IPROC.EQ.1) THEN
18739 PZSUM=300.
18740 PESUM=SQRT(PZSUM**2+ULMASS(211)**2)+ULMASS(2212)
18741 PQSUM=2.
18742 MSEL=10
18743 CKIN(3)=5.
18744 CALL PYINIT('FIXT','pi+','p',PZSUM)
18745
18746
18747 ELSEIF(IPROC.EQ.2) THEN
18748 PESUM=63.
18749 PZSUM=0.
18750 PQSUM=2.
18751 MSEL=1
18752 CKIN(3)=5.
18753 CALL PYINIT('CMS','p','p',PESUM)
18754
18755
18756 ELSEIF(IPROC.EQ.3) THEN
18757 PESUM=630.
18758 PZSUM=0.
18759 PQSUM=0.
18760 MSEL=12
18761 CKIN(1)=20.
18762 MSTP(82)=4
18763 MSTP(2)=2
18764 MSTP(33)=3
18765 CALL PYINIT('CMS','p','pbar',PESUM)
18766
18767
18768 ELSEIF(IPROC.EQ.4) THEN
18769 PESUM=1800.
18770 PZSUM=0.
18771 PQSUM=0.
18772 MSUB(22)=1
18773 MSUB(23)=1
18774 MSUB(25)=1
18775 CKIN(1)=200.
18776 MSTP(111)=0
18777 MSTP(131)=1
18778 MSTP(133)=2
18779 PARP(131)=0.04
18780 CALL PYINIT('CMS','p','pbar',PESUM)
18781
18782
18783 ELSEIF(IPROC.EQ.5) THEN
18784 PESUM=17000.
18785 PZSUM=0.
18786 PQSUM=0.
18787 MSEL=16
18788 PMAS(25,1)=300.
18789 CKIN(1)=200.
18790 MSTP(81)=0
18791 MSTP(111)=0
18792 CALL PYINIT('CMS','p','pbar',PESUM)
18793
18794
18795 ELSEIF(IPROC.EQ.6) THEN
18796 PESUM=40000.
18797 PZSUM=0.
18798 PQSUM=0.
18799 MSEL=21
18800 PMAS(32,1)=600.
18801 CKIN(1)=400.
18802 MSTP(81)=0
18803 MSTP(111)=0
18804 CALL PYINIT('CMS','p','pbar',PESUM)
18805
18806
18807 ELSEIF(IPROC.EQ.7) THEN
18808 PESUM=1000.
18809 PZSUM=0.
18810 PQSUM=0.
18811 MSUB(25)=1
18812 CALL PYINIT('CMS','e+','e-',PESUM)
18813 ENDIF
18814
18815
18816 DO 120 IEV=1,20
18817 CALL PYTHIA
18818 PESUMM=PESUM
18819 IF(IPROC.EQ.4) PESUMM=MSTI(41)*PESUM
18820
18821
18822 MERR=0
18823 DEVE=ABS(PLU(0,4)-PESUMM)+ABS(PLU(0,3)-PZSUM)
18824 DEVT=ABS(PLU(0,1))+ABS(PLU(0,2))
18825 DEVQ=ABS(PLU(0,6)-PQSUM)
18826 IF(DEVE.GT.1E-3*PESUM.OR.DEVT.GT.MAX(0.01,1E-5*PESUM).OR.
18827 &DEVQ.GT.0.1) MERR=1
18828 IF(MERR.NE.0) WRITE(MSTU(11),1000) IPROC,IEV
18829
18830
18831
18832 DO 110 I=1,N
18833 IF(K(I,1).GT.20) GOTO 110
18834 IF(LUCOMP(K(I,2)).EQ.0) THEN
18835 WRITE(MSTU(11),1100) I
18836 MERR=MERR+1
18837 ENDIF
18838 PD=P(I,4)**2-P(I,1)**2-P(I,2)**2-P(I,3)**2-P(I,5)**2*
18839 &SIGN(1.,P(I,5))
18840 IF(ABS(PD).GT.MAX(0.1,0.002*P(I,4)**2,0.002*P(I,5)**2).OR.
18841 &(P(I,5).GE.0..AND.P(I,4).LT.0.)) THEN
18842 WRITE(MSTU(11),1200) I
18843 MERR=MERR+1
18844 ENDIF
18845 110 CONTINUE
18846
18847
18848 IF(MERR.GE.1) NERR=NERR+1
18849 IF(NERR.GE.10) THEN
18850 WRITE(MSTU(11),1300)
18851 CALL LULIST(1)
18852 STOP
18853 ENDIF
18854 IF(MTEST.GE.1.AND.(MERR.GE.1.OR.IEV.EQ.1)) THEN
18855 IF(MERR.GE.1) WRITE(MSTU(11),1400)
18856 CALL LULIST(1)
18857 ENDIF
18858 120 CONTINUE
18859
18860
18861 IF(MTEST.GE.1) CALL PYSTAT(1)
18862 130 CONTINUE
18863
18864
18865 IF(NERR.EQ.0) WRITE(MSTU(11),1500)
18866 IF(NERR.GT.0) WRITE(MSTU(11),1600) NERR
18867 RETURN
18868
18869
18870 1000 FORMAT(/5X,'Energy/momentum/flavour nonconservation for process',
18871 &I2,', event',I4)
18872 1100 FORMAT(/5X,'Entry no.',I4,' in following event not known code')
18873 1200 FORMAT(/5X,'Entry no.',I4,' in following event has faulty ',
18874 &'kinematics')
18875 1300 FORMAT(/5X,'This is the tenth error experienced! Something is ',
18876 &'wrong.'/5X,'Execution will be stopped after listing of event.')
18877 1400 FORMAT(5X,'Faulty event follows:')
18878 1500 FORMAT(//5X,'End result of run: no errors detected.')
18879 1600 FORMAT(//5X,'End result of run:',I2,' errors detected.'/
18880 &5X,'This should not have happened!')
18881 END
18882
18883
18884
18885 BLOCK DATA PYDATA
18886
18887
18888 COMMON/PYSUBS/MSEL,MSUB(200),KFIN(2,-40:40),CKIN(200)
18889 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
18890 COMMON/PYINT1/MINT(400),VINT(400)
18891 COMMON/PYINT2/ISET(200),KFPR(200,2),COEF(200,20),ICOL(40,4,2)
18892 COMMON/PYINT3/XSFX(2,-40:40),ISIG(1000,3),SIGH(1000)
18893 COMMON/PYINT4/WIDP(21:40,0:40),WIDE(21:40,0:40),WIDS(21:40,3)
18894 COMMON/PYINT5/NGEN(0:200,3),XSEC(0:200,3)
18895 COMMON/PYINT6/PROC(0:200)
18896 CHARACTER PROC*28
18897 SAVE
18898
18899
18900 DATA MSEL/1/
18901 DATA MSUB/200*0/
18902 DATA ((KFIN(I,J),J=-40,40),I=1,2)/40*1,0,80*1,0,40*1/
18903 DATA CKIN/
18904 & 2.0, -1.0, 0.0, -1.0, 1.0, 1.0, -10., 10., -10., 10.,
18905 1 -10., 10., -10., 10., -10., 10., -1.0, 1.0, -1.0, 1.0,
18906 2 0.0, 1.0, 0.0, 1.0, -1.0, 1.0, -1.0, 1.0, 0., 0.,
18907 3 2.0, -1.0, 0., 0., 0., 0., 0., 0., 0., 0.,
18908 4 160*0./
18909
18910
18911 DATA (MSTP(I),I=1,100)/
18912 & 3, 1, 2, 0, 0, 0, 0, 0, 0, 0,
18913 1 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
18914 2 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
18915 3 1, 2, 0, 0, 0, 2, 0, 0, 0, 0,
18916 4 1, 0, 3, 7, 1, 0, 0, 0, 0, 0,
18917 5 1, 1, 20, 6, 0, 0, 0, 0, 0, 0,
18918 6 1, 2, 2, 2, 1, 0, 0, 0, 0, 0,
18919 7 1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
18920 8 1, 1, 100, 0, 0, 0, 0, 0, 0, 0,
18921 9 1, 4, 0, 0, 0, 0, 0, 0, 0, 0/
18922 DATA (MSTP(I),I=101,200)/
18923 & 1, 0, 0, 0, 0, 0, 0, 0, 0, 0,
18924 1 1, 1, 1, 0, 0, 0, 0, 0, 0, 0,
18925 2 0, 1, 2, 1, 1, 20, 0, 0, 0, 0,
18926 3 0, 4, 0, 1, 0, 0, 0, 0, 0, 0,
18927 4 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
18928 5 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
18929 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
18930 7 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
18931 8 5, 3, 1989, 11, 24, 0, 0, 0, 0, 0,
18932 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/
18933 DATA (PARP(I),I=1,100)/
18934 & 0.25, 10., 0., 0., 0., 0., 0., 0., 0., 0.,
18935 1 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
18936 2 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
18937 3 1.5, 2.0, 0.075, 0., 0.2, 0., 0., 0., 0., 0.,
18938 4 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
18939 5 1.0, 2.26, 1.E4, 1.E-4, 0., 0., 0., 0., 0., 0.,
18940 6 0.25, 1.0, 0.25, 1.0, 2.0, 1.E-3, 4.0, 0., 0., 0.,
18941 7 4.0, 0., 0., 0., 0., 0., 0., 0., 0., 0.,
18942 8 1.6, 1.85, 0.5, 0.2, 0.33, 0.66, 0.7, 0.5, 0., 0.,
18943 9 0.44, 0.44, 2.0, 1.0, 0., 3.0, 1.0, 0.75, 0., 0./
18944 DATA (PARP(I),I=101,200)/
18945 & -0.02, 0., 0., 0., 0., 0., 0., 0., 0., 0.,
18946 1 2.0, 0., 0., 0., 0., 0., 0., 0., 0., 0.,
18947 2 0.4, 0., 0., 0., 0., 0., 0., 0., 0., 0.,
18948 3 0.01, 0., 0., 0., 0., 0., 0., 0., 0., 0.,
18949 4 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
18950 5 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
18951 6 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
18952 7 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
18953 8 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
18954 9 0., 0., 0., 0., 0., 0., 0., 0., 0., 0./
18955 DATA MSTI/200*0/
18956 DATA PARI/200*0./
18957 DATA MINT/400*0/
18958 DATA VINT/400*0./
18959
18960
18961 DATA (ISET(I),I=1,100)/
18962 & 1, 1, 1, -1, 3, -1, -1, 3, -2, -2,
18963 1 2, 2, 2, 2, 2, 2, -1, 2, 2, 2,
18964 2 -1, 2, 2, 2, 2, 2, -1, 2, 2, 2,
18965 3 2, -1, -1, -1, -1, -1, -1, -1, -1, -1,
18966 4 -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
18967 5 -1, -1, 2, -1, -1, -1, -1, -1, -1, -1,
18968 6 -1, -1, -1, -1, -1, -1, -1, 2, -1, -1,
18969 7 4, 4, 4, -1, -1, 4, 4, -1, -1, -2,
18970 8 2, 2, -2, -2, -2, -2, -2, -2, -2, -2,
18971 9 0, 0, 0, -1, 0, 5, -2, -2, -2, -2/
18972 DATA (ISET(I),I=101,200)/
18973 & -1, 1, -2, -2, -2, -2, -2, -2, -2, -2,
18974 1 2, 2, 2, 2, -1, -1, -1, -2, -2, -2,
18975 2 -1, -2, -2, -2, -2, -2, -2, -2, -2, -2,
18976 3 -2, -2, -2, -2, -2, -2, -2, -2, -2, -2,
18977 4 1, 1, 1, -2, -2, -2, -2, -2, -2, -2,
18978 5 -2, -2, -2, -2, -2, -2, -2, -2, -2, -2,
18979 6 2, -2, -2, -2, -2, -2, -2, -2, -2, -2,
18980 7 -2, -2, -2, -2, -2, -2, -2, -2, -2, -2,
18981 8 -2, -2, -2, -2, -2, -2, -2, -2, -2, -2,
18982 9 -2, -2, -2, -2, -2, -2, -2, -2, -2, -2/
18983 DATA ((KFPR(I,J),J=1,2),I=1,50)/
18984 & 23, 0, 24, 0, 25, 0, 24, 0, 25, 0,
18985 & 24, 0, 23, 0, 25, 0, 0, 0, 0, 0,
18986 1 0, 0, 0, 0, 21, 21, 21, 22, 21, 23,
18987 1 21, 24, 21, 25, 22, 22, 22, 23, 22, 24,
18988 2 22, 25, 23, 23, 23, 24, 23, 25, 24, 24,
18989 2 24, 25, 25, 25, 0, 21, 0, 22, 0, 23,
18990 3 0, 24, 0, 25, 0, 21, 0, 22, 0, 23,
18991 3 0, 24, 0, 25, 0, 21, 0, 22, 0, 23,
18992 4 0, 24, 0, 25, 0, 21, 0, 22, 0, 23,
18993 4 0, 24, 0, 25, 0, 21, 0, 22, 0, 23/
18994 DATA ((KFPR(I,J),J=1,2),I=51,100)/
18995 5 0, 24, 0, 25, 0, 0, 0, 0, 0, 0,
18996 5 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
18997 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
18998 6 0, 0, 0, 0, 21, 21, 24, 24, 22, 24,
18999 7 23, 23, 24, 24, 23, 24, 23, 25, 22, 22,
19000 7 23, 23, 24, 24, 24, 25, 25, 25, 0, 0,
19001 8 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
19002 8 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
19003 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
19004 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/
19005 DATA ((KFPR(I,J),J=1,2),I=101,150)/
19006 & 23, 0, 25, 0, 0, 0, 0, 0, 0, 0,
19007 & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
19008 1 21, 25, 0, 25, 21, 25, 22, 22, 22, 23,
19009 1 23, 23, 24, 24, 0, 0, 0, 0, 0, 0,
19010 2 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
19011 2 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
19012 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
19013 3 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
19014 4 32, 0, 37, 0, 40, 0, 0, 0, 0, 0,
19015 4 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/
19016 DATA ((KFPR(I,J),J=1,2),I=151,200)/
19017 5 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
19018 5 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
19019 6 0, 37, 0, 0, 0, 0, 0, 0, 0, 0,
19020 6 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
19021 7 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
19022 7 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
19023 8 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
19024 8 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
19025 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
19026 9 0, 0, 0, 0, 0, 0, 0, 0, 0, 0/
19027 DATA COEF/4000*0./
19028 DATA (((ICOL(I,J,K),K=1,2),J=1,4),I=1,40)/
19029 1 4,0,3,0,2,0,1,0,3,0,4,0,1,0,2,0,2,0,0,1,4,0,0,3,3,0,0,4,1,0,0,2,
19030 2 3,0,0,4,1,4,3,2,4,0,0,3,4,2,1,3,2,0,4,1,4,0,2,3,4,0,3,4,2,0,1,2,
19031 3 3,2,1,0,1,4,3,0,4,3,3,0,2,1,1,0,3,2,1,4,1,0,0,2,2,4,3,1,2,0,0,1,
19032 4 3,2,1,4,1,4,3,2,4,2,1,3,4,2,1,3,3,4,4,3,1,2,2,1,2,0,3,1,2,0,0,0,
19033 5 4,2,1,0,0,0,1,0,3,0,0,3,1,2,0,0,4,0,0,4,0,0,1,2,2,0,0,1,4,4,3,3,
19034 6 2,2,1,1,4,4,3,3,3,3,4,4,1,1,2,2,3,2,1,3,1,2,0,0,4,2,1,4,0,0,1,2,
19035 7 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
19036 8 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
19037 9 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
19038 & 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0/
19039
19040
19041 DATA PROC(0)/ 'All included subprocesses '/
19042 DATA (PROC(I),I=1,20)/
19043 1'f + fb -> gamma*/Z0 ', 'f + fb'' -> W+/- ',
19044 2'f + fb -> H0 ', 'gamma + W+/- -> W+/- ',
19045 3'Z0 + Z0 -> H0 ', 'Z0 + W+/- -> W+/- ',
19046 4' ', 'W+ + W- -> H0 ',
19047 5' ', ' ',
19048 6'f + f'' -> f + f'' ','f + fb -> f'' + fb'' ',
19049 7'f + fb -> g + g ', 'f + fb -> g + gamma ',
19050 8'f + fb -> g + Z0 ', 'f + fb'' -> g + W+/- ',
19051 9'f + fb -> g + H0 ', 'f + fb -> gamma + gamma ',
19052 &'f + fb -> gamma + Z0 ', 'f + fb'' -> gamma + W+/- '/
19053 DATA (PROC(I),I=21,40)/
19054 1'f + fb -> gamma + H0 ', 'f + fb -> Z0 + Z0 ',
19055 2'f + fb'' -> Z0 + W+/- ', 'f + fb -> Z0 + H0 ',
19056 3'f + fb -> W+ + W- ', 'f + fb'' -> W+/- + H0 ',
19057 4'f + fb -> H0 + H0 ', 'f + g -> f + g ',
19058 5'f + g -> f + gamma ', 'f + g -> f + Z0 ',
19059 6'f + g -> f'' + W+/- ', 'f + g -> f + H0 ',
19060 7'f + gamma -> f + g ', 'f + gamma -> f + gamma ',
19061 8'f + gamma -> f + Z0 ', 'f + gamma -> f'' + W+/- ',
19062 9'f + gamma -> f + H0 ', 'f + Z0 -> f + g ',
19063 &'f + Z0 -> f + gamma ', 'f + Z0 -> f + Z0 '/
19064 DATA (PROC(I),I=41,60)/
19065 1'f + Z0 -> f'' + W+/- ', 'f + Z0 -> f + H0 ',
19066 2'f + W+/- -> f'' + g ', 'f + W+/- -> f'' + gamma ',
19067 3'f + W+/- -> f'' + Z0 ', 'f + W+/- -> f'' + W+/- ',
19068 4'f + W+/- -> f'' + H0 ', 'f + H0 -> f + g ',
19069 5'f + H0 -> f + gamma ', 'f + H0 -> f + Z0 ',
19070 6'f + H0 -> f'' + W+/- ', 'f + H0 -> f + H0 ',
19071 7'g + g -> f + fb ', 'g + gamma -> f + fb ',
19072 8'g + Z0 -> f + fb ', 'g + W+/- -> f + fb'' ',
19073 9'g + H0 -> f + fb ', 'gamma + gamma -> f + fb ',
19074 &'gamma + Z0 -> f + fb ', 'gamma + W+/- -> f + fb'' '/
19075 DATA (PROC(I),I=61,80)/
19076 1'gamma + H0 -> f + fb ', 'Z0 + Z0 -> f + fb ',
19077 2'Z0 + W+/- -> f + fb'' ', 'Z0 + H0 -> f + fb ',
19078 3'W+ + W- -> f + fb ', 'W+/- + H0 -> f + fb'' ',
19079 4'H0 + H0 -> f + fb ', 'g + g -> g + g ',
19080 5'gamma + gamma -> W+ + W- ', 'gamma + W+/- -> gamma + W+/-',
19081 6'Z0 + Z0 -> Z0 + Z0 ', 'Z0 + Z0 -> W+ + W- ',
19082 7'Z0 + W+/- -> Z0 + W+/- ', 'Z0 + Z0 -> Z0 + H0 ',
19083 8'W+ + W- -> gamma + gamma ', 'W+ + W- -> Z0 + Z0 ',
19084 9'W+/- + W+/- -> W+/- + W+/- ', 'W+/- + H0 -> W+/- + H0 ',
19085 &'H0 + H0 -> H0 + H0 ', ' '/
19086 DATA (PROC(I),I=81,100)/
19087 1'q + qb -> Q + QB, massive ', 'g + g -> Q + QB, massive ',
19088 2' ', ' ',
19089 3' ', ' ',
19090 4' ', ' ',
19091 5' ', ' ',
19092 6'Elastic scattering ', 'Single diffractive ',
19093 7'Double diffractive ', 'Central diffractive ',
19094 8'Low-pT scattering ', 'Semihard QCD 2 -> 2 ',
19095 9' ', ' ',
19096 &' ', ' '/
19097 DATA (PROC(I),I=101,120)/
19098 1'g + g -> gamma*/Z0 ', 'g + g -> H0 ',
19099 2' ', ' ',
19100 3' ', ' ',
19101 4' ', ' ',
19102 5' ', ' ',
19103 6'f + fb -> g + H0 ', 'q + g -> q + H0 ',
19104 7'g + g -> g + H0 ', 'g + g -> gamma + gamma ',
19105 8'g + g -> gamma + Z0 ', 'g + g -> Z0 + Z0 ',
19106 9'g + g -> W+ + W- ', ' ',
19107 &' ', ' '/
19108 DATA (PROC(I),I=121,140)/
19109 1'g + g -> f + fb + H0 ', ' ',
19110 2' ', ' ',
19111 3' ', ' ',
19112 4' ', ' ',
19113 5' ', ' ',
19114 6' ', ' ',
19115 7' ', ' ',
19116 8' ', ' ',
19117 9' ', ' ',
19118 &' ', ' '/
19119 DATA (PROC(I),I=141,160)/
19120 1'f + fb -> gamma*/Z0/Z''0 ', 'f + fb'' -> H+/- ',
19121 2'f + fb -> R ', ' ',
19122 3' ', ' ',
19123 4' ', ' ',
19124 5' ', ' ',
19125 6' ', ' ',
19126 7' ', ' ',
19127 8' ', ' ',
19128 9' ', ' ',
19129 &' ', ' '/
19130 DATA (PROC(I),I=161,180)/
19131 1'f + g -> f'' + H+/- ', ' ',
19132 2' ', ' ',
19133 3' ', ' ',
19134 4' ', ' ',
19135 5' ', ' ',
19136 6' ', ' ',
19137 7' ', ' ',
19138 8' ', ' ',
19139 9' ', ' ',
19140 &' ', ' '/
19141 DATA (PROC(I),I=181,200)/ 20*' '/
19142
19143 END
19144
19145
19146
19147 SUBROUTINE PYKCUT(MCUT)
19148
19149
19150
19151
19152
19153
19154
19155 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
19156 SAVE
19157
19158 MCUT=0
19159
19160 RETURN
19161 END
19162
19163
19164
19165 SUBROUTINE PYSTFE(KF,X,Q2,XPQ)
19166
19167
19168
19169
19170
19171
19172
19173
19174
19175
19176
19177
19178
19179
19180
19181
19182
19183
19184
19185
19186
19187
19188
19189
19190
19191
19192
19193
19194 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
19195 SAVE /LUDAT1/
19196 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
19197 SAVE /LUDAT2/
19198 COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
19199 SAVE /PYPARS/
19200 DIMENSION XPQ(-6:6),XFDFLM(9)
19201 CHARACTER CHDFLM(9)*5,HEADER*40
19202 DATA CHDFLM/'UPVAL','DOVAL','GLUON','QBAR ','UBAR ','SBAR ',
19203 &'CBAR ','BBAR ','TBAR '/
19204 DATA HEADER/'Tung evolution package has been invoked'/
19205 DATA INIT/0/
19206 KF=KF
19207 HEADER=HEADER
19208 CHDFLM(1)=CHDFLM(1)
19209
19210
19211 IF(MSTP(51).GE.11.AND.MSTP(51).LE.13.AND.MSTP(52).LE.1) THEN
19212 XDFLM=MAX(0.51E-4,X)
19213 Q2DFLM=MAX(10.,MIN(1E8,Q2))
19214 IF(MSTP(52).EQ.0) Q2DFLM=10.
19215 DO 100 J=1,9
19216 IF(MSTP(52).EQ.1.AND.J.EQ.9) THEN
19217 Q2DFLM=Q2DFLM*(40./PMAS(6,1))**2
19218 Q2DFLM=MAX(10.,MIN(1E8,Q2))
19219 ENDIF
19220 XFDFLM(J)=0.
19221
19222
19223
19224
19225 100 CONTINUE
19226 IF(X.LT.0.51E-4.AND.ABS(PARP(51)-1.).GT.0.01) THEN
19227 CXS=(0.51E-4/X)**(PARP(51)-1.)
19228 DO 110 J=1,7
19229 110 XFDFLM(J)=XFDFLM(J)*CXS
19230 ENDIF
19231 XPQ(0)=XFDFLM(3)
19232 XPQ(1)=XFDFLM(2)+XFDFLM(5)
19233 XPQ(2)=XFDFLM(1)+XFDFLM(5)
19234 XPQ(3)=XFDFLM(6)
19235 XPQ(4)=XFDFLM(7)
19236 XPQ(5)=XFDFLM(8)
19237 XPQ(6)=XFDFLM(9)
19238 XPQ(-1)=XFDFLM(5)
19239 XPQ(-2)=XFDFLM(5)
19240 XPQ(-3)=XFDFLM(6)
19241 XPQ(-4)=XFDFLM(7)
19242 XPQ(-5)=XFDFLM(8)
19243 XPQ(-6)=XFDFLM(9)
19244
19245
19246
19247
19248 ELSE
19249 IF(INIT.EQ.0) THEN
19250 I1=0
19251 IF(MSTP(52).EQ.4) I1=1
19252 IHDRN=1
19253 NU=MSTP(53)
19254 I2=MSTP(51)
19255 IF(MSTP(51).GE.11) I2=MSTP(51)-3
19256 I3=0
19257 IF(MSTP(52).EQ.3) I3=1
19258
19259
19260 ALAM=0.75*PARP(1)
19261 TPMS=PMAS(6,1)
19262 QINI=PARP(52)
19263 QMAX=PARP(53)
19264 XMIN=PARP(54)
19265
19266
19267
19268
19269
19270
19271 INIT=1
19272 ENDIF
19273
19274
19275 Q=SQRT(Q2)
19276 DO 200 I=-6,6
19277 FIXQ=0.
19278
19279
19280 200 XPQ(I)=X*FIXQ
19281
19282
19283 XPS=XPQ(1)
19284 XPQ(1)=XPQ(2)
19285 XPQ(2)=XPS
19286 XPS=XPQ(-1)
19287 XPQ(-1)=XPQ(-2)
19288 XPQ(-2)=XPS
19289 ENDIF
19290
19291 RETURN
19292 END