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