File indexing completed on 2025-08-05 08:21:12
0001
0002
0003
0004
0005
0006
0007 SUBROUTINE PYKFIN
0008
0009
0010 IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0011 IMPLICIT INTEGER(I-N)
0012 INTEGER PYK,PYCHGE,PYCOMP
0013
0014 COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0015 COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
0016 SAVE /PYDAT1/,/PYDAT2/
0017
0018 DIMENSION SU6(12),SU6M(7),QBB(7),QBM(7),DMB(14)
0019
0020
0021 MSTU(123)=1
0022
0023 IUD1=1
0024 IUU1=2
0025 IUS0=3
0026 ISU0=4
0027 IUS1=5
0028 ISU1=6
0029 ISS1=7
0030
0031
0032
0033 PARF(146)=1D0
0034 IF(MSTJ(12).GE.5) PARF(146)=3D0*PARJ(18)/(2D0*PARJ(18)+1D0)
0035 IF(PARJ(18).LT.1D0-1D-5.AND.MSTJ(12).LT.5) CALL PYERRM(9,
0036 & '(PYKFIN:) PARJ(18)<1 combined with 0<MSTJ(12)<5 option')
0037 DO 100 I=1,6
0038 SU6(I)=PARF(60+I)
0039 SU6(6+I)=SU6(I)*4*PARF(146)/(3*PARF(146)+1)
0040 100 CONTINUE
0041 SU6(8)=SU6(2)*4/(3*PARF(146)+1)
0042 SU6(6)=SU6(6)*(3+PARF(146))/(3*PARF(146)+1)
0043 DO 110 I=1,6
0044 SU6(I)=SU6(I)+PARJ(18)*PARF(70+I)
0045 SU6(6+I)=SU6(6+I)+PARJ(18)*PARF(70+I)
0046 110 CONTINUE
0047
0048
0049 SU6MUD =MAX(SU6(1) , SU6(8) )
0050 SU6M(IUD1)=MAX(SU6(5) , SU6(12))
0051 SU6M(ISU0)=MAX(SU6(7) ,SU6(2),SU6MUD )
0052 SU6M(IUU1)=MAX(SU6(3) ,SU6(4),SU6(10))
0053 SU6M(ISU1)=MAX(SU6(11),SU6(6),SU6M(IUD1))
0054 SU6M(IUS0)=SU6M(ISU0)
0055 SU6M(ISS1)=SU6M(IUU1)
0056 SU6M(IUS1)=SU6M(ISU1)
0057
0058
0059 PARF(141)=SU6MUD
0060 PARF(142)=SU6M(IUD1)
0061 PARF(143)=SU6M(ISU0)
0062 PARF(144)=SU6M(ISU1)
0063 PARF(145)=SU6M(ISS1)
0064
0065
0066
0067 PUD0=(2D0*SU6(1)+PARJ(2)*SU6(8))
0068 DMB(ISU0)=(SU6(7)+SU6(2)+PARJ(2)*SU6(1))/PUD0
0069 DMB(IUS0)=DMB(ISU0)
0070 DMB(ISS1)=(2D0*SU6(4)+PARJ(2)*SU6(3))/PUD0
0071 DMB(IUU1)=(SU6(3)+SU6(4)+PARJ(2)*SU6(10))/PUD0
0072 DMB(ISU1)=(SU6(11)+SU6(6)+PARJ(2)*SU6(5))/PUD0
0073 DMB(IUS1)=DMB(ISU1)
0074 DMB(IUD1)=(2D0*SU6(5)+PARJ(2)*SU6(12))/PUD0
0075
0076
0077
0078 IF(MSTJ(12).GE.5) THEN
0079 PMUD0=PYMASS(2101)
0080 PMUD1=PYMASS(2103)-PMUD0
0081 PMUS0=PYMASS(3201)-PMUD0
0082 PMUS1=PYMASS(3203)-PMUS0-PMUD0
0083 PMSS1=PYMASS(3303)-PMUS0-PMUD0
0084 QBB(ISU0)=EXP(-(PARJ(9)+PARJ(8))*PMUS0-PARJ(9)*PARF(191))
0085 QBB(IUS0)=EXP(-PARJ(8)*PMUS0)
0086 QBB(ISS1)=EXP(-(PARJ(9)+PARJ(8))*PMSS1)*QBB(ISU0)
0087 QBB(IUU1)=EXP(-PARJ(8)*PMUD1)
0088 QBB(ISU1)=EXP(-(PARJ(9)+PARJ(8))*PMUS1)*QBB(ISU0)
0089 QBB(IUS1)=EXP(-PARJ(8)*PMUS1)*QBB(IUS0)
0090 QBB(IUD1)=QBB(IUU1)
0091 ELSE
0092 PAR2M=SQRT(PARJ(2))
0093 PAR3M=SQRT(PARJ(3))
0094 PAR4M=SQRT(PARJ(4))
0095 QBB(ISU0)=PAR2M*PAR3M
0096 QBB(IUS0)=PAR3M
0097 QBB(ISS1)=PAR2M*PARJ(3)*PAR4M
0098 QBB(IUU1)=PAR4M
0099 QBB(ISU1)=PAR4M*QBB(ISU0)
0100 QBB(IUS1)=PAR4M*QBB(IUS0)
0101 QBB(IUD1)=PAR4M
0102 ENDIF
0103
0104
0105 QBM(ISU0)=QBB(ISU0)
0106 QBM(IUS0)=PARJ(2)*QBB(IUS0)
0107 QBM(ISS1)=PARJ(2)*6D0*QBB(ISS1)
0108 QBM(IUU1)=6D0*QBB(IUU1)
0109 QBM(ISU1)=3D0*QBB(ISU1)
0110 QBM(IUS1)=PARJ(2)*3D0*QBB(IUS1)
0111 QBM(IUD1)=3D0*QBB(IUD1)
0112
0113
0114 DO 120 I=1,7
0115 QBB(I)=QBB(I)*QBM(I)
0116 120 CONTINUE
0117
0118 IF(MSTJ(12).GE.5)THEN
0119
0120 DMB(7+ISU0)=EXP(-PARJ(10)*PMUS0)
0121 DMB(7+IUS0)=PARJ(2)*DMB(7+ISU0)
0122 DMB(7+ISS1)=6D0*PARJ(2)*EXP(-PARJ(10)*PMSS1)*DMB(7+ISU0)
0123 DMB(7+IUU1)=6D0*EXP(-PARJ(10)*PMUD1)
0124 DMB(7+ISU1)=3D0*EXP(-PARJ(10)*PMUS1)*DMB(7+ISU0)
0125 DMB(7+IUS1)=PARJ(2)*DMB(7+ISU1)
0126 DMB(7+IUD1)=DMB(7+IUU1)/2D0
0127
0128
0129
0130
0131
0132 WU=1D0+QBM(IUD1)+QBM(IUS0)+QBM(IUS1)+QBM(IUU1)
0133 PARF(135)=(2D0*(QBM(ISU0)+QBM(ISU1))+QBM(ISS1))/WU
0134 WU=1D0+DMB(7+IUD1)+DMB(7+IUS0)+DMB(7+IUS1)+DMB(7+IUU1)
0135 PARF(136)=(2D0*(DMB(7+ISU0)+DMB(7+ISU1))+DMB(7+ISS1))/WU
0136 PARF(137)=(DMB(7+ISU0)+DMB(7+ISU1))*
0137 & (2D0+DMB(7+ISS1)/(2D0*DMB(7+ISU1)))/WU
0138 ELSE
0139
0140
0141 DO 130 I=1,7
0142 IF(MSTJ(12).LT.3) DMB(I)=1D0
0143 DMB(7+I)=1D0
0144 130 CONTINUE
0145
0146
0147 QBM(IUS0)=QBM(IUS0)*PARJ(7)
0148 QBM(ISS1)=QBM(ISS1)*PARJ(7)
0149 QBM(IUS1)=QBM(IUS1)*PARJ(7)
0150
0151
0152
0153
0154
0155 WU=1D0+QBM(IUD1)+QBM(IUS0)+QBM(IUS1)+QBM(IUU1)
0156 PARF(135)=(2D0*(QBM(ISU0)+QBM(ISU1))+QBM(ISS1))/WU
0157 PARF(136)=PARF(135)*PARJ(6)*QBM(ISU0)/QBM(IUS0)
0158 PARF(137)=(1D0+QBM(IUD1))*(2D0+QBM(IUS0))/WU
0159 ENDIF
0160
0161
0162
0163 DO 140 I=1,7
0164 DMB(7+I)=DMB(7+I)*DMB(I)
0165 DMB(I)=DMB(I)*QBM(I)
0166 QBM(I)=QBM(I)*SU6M(I)/SU6MUD
0167 QBB(I)=QBB(I)*SU6M(I)/SU6MUD
0168 140 CONTINUE
0169
0170
0171
0172 IF(MSTJ(12).LT.5)THEN
0173
0174 PARF(138)=PARJ(6)
0175 WS=PARF(135)*PARF(138)
0176 WQ=WU*PARJ(5)/3D0
0177 PARF(132)=WQ*QBM(IUD1)/QBB(IUD1)
0178 PARF(133)=WQ*
0179 & (QBM(IUS1)/QBB(IUS1)+WS*QBM(ISU1)/QBB(ISU1))/2D0
0180 PARF(134)=WQ*WS*QBM(ISS1)/QBB(ISS1)
0181 PARF(131)=WQ*(1D0+QBM(IUD1)+QBM(IUU1)+QBM(IUS0)+QBM(IUS1)+
0182 & WS*(QBM(ISU0)+QBM(ISU1)+QBM(ISS1)/2D0))/
0183 & (1D0+QBB(IUD1)+QBB(IUU1)+
0184 & 2D0*(QBB(IUS0)+QBB(IUS1))+QBB(ISS1)/2D0)
0185 ELSE
0186
0187
0188 DO 150 IPOS=201,1400
0189 PARF(IPOS)=0D0
0190 150 CONTINUE
0191 DO 160 I=138,140
0192 PARF(I)=0D0
0193 160 CONTINUE
0194 IPOS=200
0195 PARF(193)=PARJ(8)
0196 DO 240 MR=0,7,7
0197 IF(MR.EQ.7) PARF(193)=PARJ(10)
0198 SQWT=2D0*(DMB(MR+IUS0)+DMB(MR+IUS1))/
0199 & (1D0+DMB(MR+IUD1)+DMB(MR+IUU1))
0200 QQWT=DMB(MR+IUU1)/(1D0+DMB(MR+IUD1)+DMB(MR+IUU1))
0201 DO 230 NMES=0,1
0202 IF(NMES.EQ.1) SQWT=PARJ(2)
0203 DO 220 KFQPOP=1,4
0204 IF(MR.EQ.0.AND.KFQPOP.GT.3) GOTO 220
0205 IF(NMES.EQ.0.AND.KFQPOP.GE.3)THEN
0206 SQWT=DMB(MR+ISS1)/(DMB(MR+ISU0)+DMB(MR+ISU1))
0207 QQWT=0.5D0
0208 IF(MR.EQ.0) PARF(193)=PARJ(8)+PARJ(9)
0209 IF(KFQPOP.EQ.4) SQWT=SQWT*(1D0/DMB(7+ISU1)+1D0)/2D0
0210 ENDIF
0211 DO 210 KFQOLD =1,5
0212 IF(MR.EQ.0.AND.KFQOLD.GT.3) GOTO 210
0213 IF(NMES.EQ.1) THEN
0214 IF(MR.EQ.0.AND.KFQPOP.EQ.1) GOTO 210
0215 IF(MR.EQ.7.AND.KFQPOP.NE.1) GOTO 210
0216 ENDIF
0217 WTTOT=0D0
0218 WTFAIL=0D0
0219 DO 190 KMUL=0,5
0220 PJWT=PARJ(12+KMUL)
0221 IF(KMUL.EQ.0) PJWT=1D0-PARJ(14)
0222 IF(KMUL.EQ.1) PJWT=1D0-PARJ(15)-PARJ(16)-PARJ(17)
0223 IF(PJWT.LE.0D0) GOTO 190
0224 IF(PJWT.GT.1D0) PJWT=1D0
0225 IMES=5*KMUL
0226 IMIX=2*KFQOLD+10*KMUL
0227 KFJ=2*KMUL+1
0228 IF(KMUL.EQ.2) KFJ=10003
0229 IF(KMUL.EQ.3) KFJ=10001
0230 IF(KMUL.EQ.4) KFJ=20003
0231 IF(KMUL.EQ.5) KFJ=5
0232 DO 180 KFQVER =1,3
0233 KFLA=MAX(KFQOLD,KFQVER)
0234 KFLB=MIN(KFQOLD,KFQVER)
0235 SWT=PARJ(11+KFLA/3+KFLA/4)
0236 IF(KMUL.EQ.0.OR.KMUL.EQ.2) SWT=1D0-SWT
0237 SWT=SWT*PJWT
0238 QWT=SQWT/(2D0+SQWT)
0239 IF(KFQVER.LT.3)THEN
0240 IF(KFQVER.EQ.KFQPOP) QWT=(1D0-QWT)*QQWT
0241 IF(KFQVER.NE.KFQPOP) QWT=(1D0-QWT)*(1D0-QQWT)
0242 ENDIF
0243 IF(KFQVER.NE.KFQOLD)THEN
0244 IMES=IMES+1
0245 KFM=100*KFLA+10*KFLB+KFJ
0246 PMM=PMAS(PYCOMP(KFM),1)-PMAS(PYCOMP(KFM),3)
0247 PARF(IPOS+IMES)=QWT*SWT*EXP(-PARF(193)*PMM)
0248 WTTOT=WTTOT+PARF(IPOS+IMES)
0249 ELSE
0250 DO 170 ID=3,5
0251 IF(ID.EQ.3) DWT=1D0-PARF(IMIX-1)
0252 IF(ID.EQ.4) DWT=PARF(IMIX-1)-PARF(IMIX)
0253 IF(ID.EQ.5) DWT=PARF(IMIX)
0254 KFM=110*(ID-2)+KFJ
0255 PMM=PMAS(PYCOMP(KFM),1)-PMAS(PYCOMP(KFM),3)
0256 PARF(IPOS+5*KMUL+ID)=QWT*SWT*DWT*EXP(-PARF(193)*PMM)
0257 IF(KMUL.EQ.0.AND.ID.GT.3) THEN
0258 WTFAIL=WTFAIL+QWT*SWT*DWT*(1D0-PARJ(21+ID))
0259 PARF(IPOS+5*KMUL+ID)=
0260 & PARF(IPOS+5*KMUL+ID)*PARJ(21+ID)
0261 ENDIF
0262 WTTOT=WTTOT+PARF(IPOS+5*KMUL+ID)
0263 170 CONTINUE
0264 ENDIF
0265 180 CONTINUE
0266 190 CONTINUE
0267 DO 200 IMES=1,30
0268 PARF(IPOS+IMES)=PARF(IPOS+IMES)/(1D0-WTFAIL)
0269 200 CONTINUE
0270 IF(MR.EQ.7) PARF(140)=
0271 & MAX(PARF(140),WTTOT/(1D0-WTFAIL))
0272 IF(MR.EQ.0) PARF(139-KFQPOP/3)=
0273 & MAX(PARF(139-KFQPOP/3),WTTOT/(1D0-WTFAIL))
0274 IPOS=IPOS+30
0275 210 CONTINUE
0276 220 CONTINUE
0277 230 CONTINUE
0278 240 CONTINUE
0279 IF(PARF(139).GT.1D-10) PARF(138)=PARF(138)/PARF(139)
0280 MSTU(121)=0
0281
0282 ENDIF
0283
0284
0285 PARF(151)=(2D0*(QBB(ISU0)+QBB(ISU1))+QBB(ISS1))/
0286 & (1D0+QBB(IUD1)+QBB(IUU1)+QBB(IUS0)+QBB(IUS1))
0287 PARF(152)=2D0*(QBB(IUS0)+QBB(IUS1))/(1D0+QBB(IUD1)+QBB(IUU1))
0288 PARF(153)=QBB(ISS1)/(QBB(ISU0)+QBB(ISU1))
0289 PARF(154)=QBB(IUU1)/(1D0+QBB(IUD1)+QBB(IUU1))
0290 PARF(155)=QBB(ISU1)/QBB(ISU0)
0291 PARF(156)=QBB(IUS1)/QBB(IUS0)
0292 PARF(157)=QBB(IUD1)
0293
0294 PARF(161)=(2D0*(QBM(ISU0)+QBM(ISU1))+QBM(ISS1))/
0295 & (1D0+QBM(IUD1)+QBM(IUU1)+QBM(IUS0)+QBM(IUS1))
0296 PARF(162)=2D0*(QBM(IUS0)+QBM(IUS1))/(1D0+QBM(IUD1)+QBM(IUU1))
0297 PARF(163)=QBM(ISS1)/(QBM(ISU0)+QBM(ISU1))
0298 PARF(164)=QBM(IUU1)/(1D0+QBM(IUD1)+QBM(IUU1))
0299 PARF(165)=QBM(ISU1)/QBM(ISU0)
0300 PARF(166)=QBM(IUS1)/QBM(IUS0)
0301 PARF(167)=QBM(IUD1)
0302
0303 PARF(171)=(2D0*(DMB(ISU0)+DMB(ISU1))+DMB(ISS1))/
0304 & (1D0+DMB(IUD1)+DMB(IUU1)+DMB(IUS0)+DMB(IUS1))
0305 PARF(172)=2D0*(DMB(IUS0)+DMB(IUS1))/(1D0+DMB(IUD1)+DMB(IUU1))
0306 PARF(173)=DMB(ISS1)/(DMB(ISU0)+DMB(ISU1))
0307 PARF(174)=DMB(IUU1)/(1D0+DMB(IUD1)+DMB(IUU1))
0308 PARF(175)=DMB(ISU1)/DMB(ISU0)
0309 PARF(176)=DMB(IUS1)/DMB(IUS0)
0310 PARF(177)=DMB(IUD1)
0311
0312 PARF(185)=DMB(7+ISU1)/DMB(7+ISU0)
0313 PARF(186)=DMB(7+IUS1)/DMB(7+IUS0)
0314 PARF(187)=DMB(7+IUD1)
0315
0316 RETURN
0317 END