Back to home page

sPhenix code displayed by LXR

 
 

    


File indexing completed on 2025-08-05 08:21:12

0001  
0002 C***************************************************************
0003  
0004 C...PYKFIN
0005 C...Precalculates a set of diquark and popcorn weights.
0006  
0007       SUBROUTINE PYKFIN
0008  
0009 C...Double precision and integer declarations.
0010       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0011       IMPLICIT INTEGER(I-N)
0012       INTEGER PYK,PYCHGE,PYCOMP
0013 C...Commonblocks.
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 C..Diquark indices for dimensional variables
0023       IUD1=1
0024       IUU1=2
0025       IUS0=3
0026       ISU0=4
0027       IUS1=5
0028       ISU1=6
0029       ISS1=7
0030  
0031 C.. *** SU(6) factors **
0032 C..Modify with decuplet- (and Sigma/Lambda-) suppression.
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 C..SU(6)max            q       q'     s,c,b
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 C..Store SU(6)max, in order UD0,UD1,US0,US1,QQ1
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 C..diquark SU(6) survival =
0066 C..sum over quark (quark tunnel weight)*(SU(6)).
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 C.. *** Tunneling factors for Diquark production***
0077 C.. T: half a curtain pair = sqrt(curtain pair factor)
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 C.. tau: spin*(vertex factor)*(T = half-curtain factor)
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 C.. Combine T and tau to diquark weight for q-> B+B+..
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 C..New version: tau  for rank 0 diquark.
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 C..New version: curtain flavour ratios.
0129 C.. s/u for q->B+M+...
0130 C.. s/u for rank 0 diquark: su -> ...M+B+...
0131 C.. Q/q for heavy rank 0 diquark: Qu -> ...M+B+...
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 C..Old version: reset unused rank 0 diquark weights and
0140 C..             unused diquark SU(6) survival weights
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 C..Old version: Shuffle PARJ(7) into tau
0147          QBM(IUS0)=QBM(IUS0)*PARJ(7)
0148          QBM(ISS1)=QBM(ISS1)*PARJ(7)
0149          QBM(IUS1)=QBM(IUS1)*PARJ(7)
0150  
0151 C..Old version: curtain flavour ratios.
0152 C.. s/u for q->B+M+...
0153 C.. s/u for rank 0 diquark: su -> ...M+B+...
0154 C.. Q/q for heavy rank 0 diquark: Qu -> ...M+B+...
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 C..Combine diquark SU(6) survival, SU(6)max, tau and T into factors for:
0162 C..  rank0 D->M+B+..; D->M+B+..; q->B+M+..; q->B+B..
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 C.. *** Popcorn factors ***
0171  
0172       IF(MSTJ(12).LT.5)THEN
0173 C.. Old version: Resulting popcorn weights.
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 C..New version: Store weights for popcorn mesons,
0187 C..get prel. popcorn weights.
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 C..Recombine diquark weights to flavour and spin ratios
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