Back to home page

sPhenix code displayed by LXR

 
 

    


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

0001  
0002 C***********************************************************************
0003  
0004 C...PYWIDX
0005 C...Calculates full and partial widths of resonances.
0006 C....copy of PYWIDT, used for techniparticle widths
0007  
0008       SUBROUTINE PYWIDX(KFLR,SH,WDTP,WDTE)
0009  
0010 C...Double precision and integer declarations.
0011       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0012       IMPLICIT INTEGER(I-N)
0013       INTEGER PYK,PYCHGE,PYCOMP
0014 C...Parameter statement to help give large particle numbers.
0015       PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000,
0016      &KEXCIT=4000000,KDIMEN=5000000)
0017 C...Commonblocks.
0018       COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0019       COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
0020       COMMON/PYDAT3/MDCY(500,3),MDME(8000,2),BRAT(8000),KFDP(8000,5)
0021       COMMON/PYSUBS/MSEL,MSELPD,MSUB(500),KFIN(2,-40:40),CKIN(200)
0022       COMMON/PYPARS/MSTP(200),PARP(200),MSTI(200),PARI(200)
0023       COMMON/PYINT1/MINT(400),VINT(400)
0024       COMMON/PYINT4/MWID(500),WIDS(500,5)
0025       COMMON/PYMSSM/IMSS(0:99),RMSS(0:99)
0026       COMMON/PYTCSM/ITCM(0:99),RTCM(0:99)
0027       SAVE /PYDAT1/,/PYDAT2/,/PYDAT3/,/PYSUBS/,/PYPARS/,/PYINT1/,
0028      &/PYINT4/,/PYMSSM/,/PYTCSM/
0029 C...Local arrays and saved variables.
0030       DIMENSION WDTP(0:400),WDTE(0:400,0:5),MOFSV(3,2),WIDWSV(3,2),
0031      &WID2SV(3,2)
0032       SAVE MOFSV,WIDWSV,WID2SV
0033       DATA MOFSV/6*0/,WIDWSV/6*0D0/,WID2SV/6*0D0/
0034  
0035 C...Compressed code and sign; mass.
0036       KFLA=IABS(KFLR)
0037       KFLS=ISIGN(1,KFLR)
0038       KC=PYCOMP(KFLA)
0039       SHR=SQRT(SH)
0040       PMR=PMAS(KC,1)
0041  
0042 C...Reset width information.
0043       DO 110 I=0,200
0044         WDTP(I)=0D0
0045         DO 100 J=0,5
0046           WDTE(I,J)=0D0
0047   100   CONTINUE
0048   110 CONTINUE
0049  
0050 C...Common electroweak and strong constants.
0051       XW=PARU(102)
0052       XWV=XW
0053       IF(MSTP(8).GE.2) XW=1D0-(PMAS(24,1)/PMAS(23,1))**2
0054       XW1=1D0-XW
0055       AEM=PYALEM(SH)
0056       IF(MSTP(8).GE.1) AEM=SQRT(2D0)*PARU(105)*PMAS(24,1)**2*XW/PARU(1)
0057       AS=PYALPS(SH)
0058       RADC=1D0+AS/PARU(1)
0059  
0060       IF(KFLA.EQ.23) THEN
0061 C...Z0:
0062         ICASE=1
0063         XWC=1D0/(16D0*XW*XW1)
0064         FAC=(AEM*XWC/3D0)*SHR
0065   120   CONTINUE
0066         DO 130 I=1,MDCY(KC,3)
0067           IDC=I+MDCY(KC,2)-1
0068           IF(MDME(IDC,1).LT.0) GOTO 130
0069           RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH
0070           RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH
0071           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 130
0072           WID2=1D0
0073           IF(I.LE.8) THEN
0074 C...Z0 -> q + qbar
0075             EF=KCHG(I,1)/3D0
0076             AF=SIGN(1D0,EF+0.1D0)
0077             VF=AF-4D0*EF*XWV
0078             FCOF=3D0*RADC
0079             IF(I.GE.6.AND.MSTP(35).GE.1) FCOF=FCOF*PYHFTH(SH,SH*RM1,1D0)
0080             IF(I.EQ.6) WID2=WIDS(6,1)
0081             IF((I.EQ.7.OR.I.EQ.8)) WID2=WIDS(I,1)
0082           ELSEIF(I.LE.16) THEN
0083 C...Z0 -> l+ + l-, nu + nubar
0084             EF=KCHG(I+2,1)/3D0
0085             AF=SIGN(1D0,EF+0.1D0)
0086             VF=AF-4D0*EF*XWV
0087             FCOF=1D0
0088             IF((I.EQ.15.OR.I.EQ.16)) WID2=WIDS(2+I,1)
0089           ENDIF
0090           BE34=SQRT(MAX(0D0,1D0-4D0*RM1))
0091             WDTP(I)=FAC*FCOF*(VF**2*(1D0+2D0*RM1)+AF**2*(1D0-4D0*RM1))*
0092      &      BE34
0093             WDTP(0)=WDTP(0)+WDTP(I)
0094           IF(MDME(IDC,1).GT.0) THEN
0095               WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
0096               WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+
0097      &        WDTE(I,MDME(IDC,1))
0098               WDTE(I,0)=WDTE(I,MDME(IDC,1))
0099               WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
0100           ENDIF
0101   130   CONTINUE
0102  
0103  
0104       ELSEIF(KFLA.EQ.24) THEN
0105 C...W+/-:
0106         FAC=(AEM/(24D0*XW))*SHR
0107         DO 140 I=1,MDCY(KC,3)
0108           IDC=I+MDCY(KC,2)-1
0109           IF(MDME(IDC,1).LT.0) GOTO 140
0110           RM1=PMAS(IABS(KFDP(IDC,1)),1)**2/SH
0111           RM2=PMAS(IABS(KFDP(IDC,2)),1)**2/SH
0112           IF(SQRT(RM1)+SQRT(RM2).GT.1D0) GOTO 140
0113           WID2=1D0
0114           IF(I.LE.16) THEN
0115 C...W+/- -> q + qbar'
0116             FCOF=3D0*RADC*VCKM((I-1)/4+1,MOD(I-1,4)+1)
0117             IF(KFLR.GT.0) THEN
0118               IF(MOD(I,4).EQ.3) WID2=WIDS(6,2)
0119               IF(MOD(I,4).EQ.0) WID2=WIDS(8,2)
0120               IF(I.GE.13) WID2=WID2*WIDS(7,3)
0121             ELSE
0122               IF(MOD(I,4).EQ.3) WID2=WIDS(6,3)
0123               IF(MOD(I,4).EQ.0) WID2=WIDS(8,3)
0124               IF(I.GE.13) WID2=WID2*WIDS(7,2)
0125             ENDIF
0126           ELSEIF(I.LE.20) THEN
0127 C...W+/- -> l+/- + nu
0128             FCOF=1D0
0129             IF(KFLR.GT.0) THEN
0130               IF(I.EQ.20) WID2=WIDS(17,3)*WIDS(18,2)
0131             ELSE
0132               IF(I.EQ.20) WID2=WIDS(17,2)*WIDS(18,3)
0133             ENDIF
0134           ENDIF
0135           WDTP(I)=FAC*FCOF*(2D0-RM1-RM2-(RM1-RM2)**2)*
0136      &    SQRT(MAX(0D0,(1D0-RM1-RM2)**2-4D0*RM1*RM2))
0137           WDTP(0)=WDTP(0)+WDTP(I)
0138           IF(MDME(IDC,1).GT.0) THEN
0139             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
0140             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
0141             WDTE(I,0)=WDTE(I,MDME(IDC,1))
0142             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
0143           ENDIF
0144   140   CONTINUE
0145  
0146 C.....V8 -> quark anti-quark
0147       ELSEIF(KFLA.EQ.KTECHN+100021) THEN
0148         FAC=AS/6D0*SHR
0149         TANT3=RTCM(21)
0150         IF(ITCM(2).EQ.0) THEN
0151           IMDL=1
0152         ELSEIF(ITCM(2).EQ.1) THEN
0153           IMDL=2
0154         ENDIF
0155         DO 150 I=1,MDCY(KC,3)
0156           IDC=I+MDCY(KC,2)-1
0157           IF(MDME(IDC,1).LT.0) GOTO 150
0158           PM1=PMAS(PYCOMP(KFDP(IDC,1)),1)
0159           RM1=PM1**2/SH
0160           IF(RM1.GT.0.25D0) GOTO 150
0161           WID2=1D0
0162           IF(I.EQ.5.OR.I.EQ.6.OR.IMDL.EQ.2) THEN
0163             FMIX=1D0/TANT3**2
0164           ELSE
0165             FMIX=TANT3**2
0166           ENDIF
0167           WDTP(I)=FAC*(1D0+2D0*RM1)*SQRT(1D0-4D0*RM1)*FMIX
0168           IF(I.EQ.6) WID2=WIDS(6,1)
0169           WDTP(0)=WDTP(0)+WDTP(I)
0170           IF(MDME(IDC,1).GT.0) THEN
0171             WDTE(I,MDME(IDC,1))=WDTP(I)*WID2
0172             WDTE(0,MDME(IDC,1))=WDTE(0,MDME(IDC,1))+WDTE(I,MDME(IDC,1))
0173             WDTE(I,0)=WDTE(I,MDME(IDC,1))
0174             WDTE(0,0)=WDTE(0,0)+WDTE(I,0)
0175           ENDIF
0176   150   CONTINUE
0177       ENDIF
0178  
0179       RETURN
0180       END