pythiaeRHIC/pythia/pyrvne.f

0001
0002 C*********************************************************************
0003
0004 C...PYRVNE
0005 C...Calculates R-violating neutralino decay widths (pure 1->3 parts).
0006 C...P. Z. Skands
0007
0008       SUBROUTINE PYRVNE(KFIN,XLAM,IDLAM,LKNT)
0009
0010 C...Double precision and integer declarations.
0011       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0012       IMPLICIT INTEGER(I-N)
0013 C...Parameter statement to help give large particle numbers.
0014       PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000,
0015      &KEXCIT=4000000,KDIMEN=5000000)
0016 C...Commonblocks.
0017       COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0018       COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
0019       COMMON/PYMSSM/IMSS(0:99),RMSS(0:99)
0020       COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2),
0021      &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2)
0022       COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3)
0023 C...Local variables.
0024       COMMON/PYRVNV/AB(2,16,2),RMS(0:3),RES(6,2),INTRES(6,3),IDR,IDR2
0025      &     ,DCMASS,KFR(3)
0026       DOUBLE PRECISION XLAM(0:400)
0027       DOUBLE PRECISION ZPMIX(4,4), NMIX(4,4), RMQ(6)
0028       INTEGER IDLAM(400,3), PYCOMP
0029       LOGICAL DCMASS
0030       SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/,/PYMSRV/,/PYRVNV/
0031
0032 C...R-VIOLATING DECAYS
0033       IF ((IMSS(51).GE.1).OR.(IMSS(52).GE.1).OR.(IMSS(53).GE.1)) THEN
0034         KFSM=KFIN-KSUSY1
0035         IF(KFSM.EQ.22.OR.KFSM.EQ.23.OR.KFSM.EQ.25.OR.KFSM.EQ.35) THEN
0036 C...WHICH NEUTRALINO ?
0037           NCHI=1
0038           IF (KFSM.EQ.23) NCHI=2
0039           IF (KFSM.EQ.25) NCHI=3
0040           IF (KFSM.EQ.35) NCHI=4
0041 C...SIGN OF MASS (Opposite convention as HERWIG)
0042           ISM = 1
0043           IF (SMZ(NCHI).LT.0D0) ISM = -ISM
0044
0045 C...Useful parameters for the calculation of the A and B constants.
0046           WMASS = PMAS(PYCOMP(24),1)
0047           ECHG = 2*SQRT(PARU(103)*PARU(1))
0048           COSB=1/(SQRT(1+RMSS(5)**2))
0049           SINB=RMSS(5)/SQRT(1+RMSS(5)**2)
0050           COSW=SQRT(1-PARU(102))
0051           SINW=SQRT(PARU(102))
0052           GW=2D0*SQRT(PARU(103)*PARU(1))/SINW
0053 C...Run quark masses to neutralino mass squared (for Higgs-type
0054 C...couplings)
0055           SQMCHI=PMAS(PYCOMP(KFIN),1)**2
0056           DO 100 I=1,6
0057             RMQ(I)=PYMRUN(I,SQMCHI)
0058   100     CONTINUE
0059 C...EXPRESS NEUTRALINO MIXING IN (photino,Zino,~H_u,~H_d) BASIS
0060             DO 110 NCHJ=1,4
0061               ZPMIX(NCHJ,1)= ZMIX(NCHJ,1)*COSW+ZMIX(NCHJ,2)*SINW
0062               ZPMIX(NCHJ,2)=-ZMIX(NCHJ,1)*SINW+ZMIX(NCHJ,2)*COSW
0063               ZPMIX(NCHJ,3)= ZMIX(NCHJ,3)
0064               ZPMIX(NCHJ,4)= ZMIX(NCHJ,4)
0065   110       CONTINUE
0066             C1=GW*ZPMIX(NCHI,3)/(2D0*COSB*WMASS)
0067             C1U=GW*ZPMIX(NCHI,4)/(2D0*SINB*WMASS)
0068             C2=ECHG*ZPMIX(NCHI,1)
0069             C3=GW*ZPMIX(NCHI,2)/COSW
0070             EU=2D0/3D0
0071             ED=-1D0/3D0
0072 C... AB(x,y,z):
0073 C       x=1-2  : Select A or B constant     (1:A ; 2:B)
0074 C       y=1-16 : Sparticle's SM code (1-6:d,u,s,c,b,t ;
0075 C                                    11-16:e,nu_e,mu,...)
0076 C       z=1-2  : Mass eigenstate number
0077 C...CALCULATE COUPLINGS
0078           DO 120 I = 11,15,2
0079             CMS=PMAS(PYCOMP(I),1)
0080 C...Intermediate sleptons
0081             AB(1,I,1)=ISM*(CMS*C1*SFMIX(I,1) + SFMIX(I,2)
0082      &           *(C2-C3*SINW**2))
0083             AB(1,I,2)=ISM*(CMS*C1*SFMIX(I,3) + SFMIX(I,4)
0084      &           *(C2-C3*SINW**2))
0085             AB(2,I,1)= CMS*C1*SFMIX(I,2) - SFMIX(I,1)*(C2+C3*(5D-1-SINW
0086      &           **2))
0087             AB(2,I,2)=CMS*C1*SFMIX(I,4) - SFMIX(I,3)*(C2+C3*(5D-1-SINW
0088      &           **2))
0089 C...Inermediate sneutrinos
0090             AB(1,I+1,1)=0D0
0091             AB(2,I+1,1)=5D-1*C3
0092             AB(1,I+1,2)=0D0
0093             AB(2,I+1,2)=0D0
0094 C...Inermediate sdown
0095             J=I-10
0096             CMS=RMQ(J)
0097             AB(1,J,1)=ISM*(CMS*C1*SFMIX(J,1) - SFMIX(J,2)
0098      &           *ED*(C2-C3*SINW**2))
0099             AB(1,J,2)=ISM*(CMS*C1*SFMIX(J,3) - SFMIX(J,4)
0100      &           *ED*(C2-C3*SINW**2))
0101             AB(2,J,1)=CMS*C1*SFMIX(J,2) + SFMIX(J,1)
0102      &           *(ED*C2-C3*(1D0/2D0+ED*SINW**2))
0103             AB(2,J,2)=CMS*C1*SFMIX(J,4) + SFMIX(J,3)
0104      &           *(ED*C2-C3*(1D0/2D0+ED*SINW**2))
0105 C...Inermediate sup
0106             J=J+1
0107             CMS=RMQ(J)
0108             AB(1,J,1)=ISM*(CMS*C1U*SFMIX(J,1) - SFMIX(J,2)
0109      &           *EU*(C2-C3*SINW**2))
0110             AB(1,J,2)=ISM*(CMS*C1U*SFMIX(J,3) - SFMIX(J,4)
0111      &           *EU*(C2-C3*SINW**2))
0112             AB(2,J,1)=CMS*C1U*SFMIX(J,2) + SFMIX(J,1)
0113      &           *(EU*C2+C3*(1D0/2D0-EU*SINW**2))
0114             AB(2,J,2)=CMS*C1U*SFMIX(J,4) + SFMIX(J,3)
0115      &           *(EU*C2+C3*(1D0/2D0-EU*SINW**2))
0116   120     CONTINUE
0117
0118           IF (IMSS(51).GE.1) THEN
0119 C...LAMBDA COUPLINGS (LLE TYPE R-VIOLATION)
0120 C * CHI0_I -> NUBAR_I + LEPTON+_J + lEPTON-_K.
0121 C...STEP IN I,J,K USING SINGLE COUNTER
0122             DO 130 ISC=0,26
0123 C...LAMBDA COUPLING ASYM IN I,J
0124               IF(MOD(ISC/9,3).NE.MOD(ISC/3,3)) THEN
0125                 LKNT = LKNT+1
0126                 IDLAM(LKNT,1) =-12 -2*MOD(ISC/9,3)
0127                 IDLAM(LKNT,2) =-11 -2*MOD(ISC/3,3)
0128                 IDLAM(LKNT,3) = 11 +2*MOD(ISC,3)
0129                 XLAM(LKNT)    = 0D0
0130 C...Set coupling, and decay product masses on/off
0131                 RVLAMC        = RVLAM(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1
0132      &               ,MOD(ISC,3)+1)**2
0133                 DCMASS=.FALSE.
0134                 IF (IDLAM(LKNT,2).EQ.-15.OR.IDLAM(LKNT,3).EQ.15)
0135      &               DCMASS = .TRUE.
0136 C...Resonance KF codes (1=I,2=J,3=K)
0137                 KFR(1)=-IDLAM(LKNT,1)
0138                 KFR(2)=-IDLAM(LKNT,2)
0139                 KFR(3)=-IDLAM(LKNT,3)
0140 C...Calculate width.
0141                 CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),
0142      &               IDLAM(LKNT,3),XLAM(LKNT))
0143                 XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32)
0144 C...Charge conjugate mode.
0145                 LKNT=LKNT+1
0146                 IDLAM(LKNT,1)=-IDLAM(LKNT-1,1)
0147                 IDLAM(LKNT,2)=-IDLAM(LKNT-1,2)
0148                 IDLAM(LKNT,3)=-IDLAM(LKNT-1,3)
0149                 XLAM(LKNT)=XLAM(LKNT-1)
0150 C...KINEMATICS CHECK
0151                 IF (XLAM(LKNT).EQ.0D0) THEN
0152                   LKNT=LKNT-2
0153                 ENDIF
0154               ENDIF
0155   130       CONTINUE
0156           ENDIF
0157
0158           IF (IMSS(52).GE.1) THEN
0159 C...LAMBDA' COUPLINGS. (LQD TYPE R-VIOLATION)
0160 C * CHI0 -> NUBAR_I + DBAR_J + D_K
0161             DO 140 ISC=0,26
0162               LKNT = LKNT+1
0163               IDLAM(LKNT,1) =-12 -2*MOD(ISC/9,3)
0164               IDLAM(LKNT,2) = -1 -2*MOD(ISC/3,3)
0165               IDLAM(LKNT,3) =  1 +2*MOD(ISC,3)
0166               XLAM(LKNT)    =  0D0
0167 C...Set coupling, and decay product masses on/off
0168               RVLAMC        = 3 * RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1
0169      &             ,MOD(ISC,3)+1)**2
0170               DCMASS=.FALSE.
0171               IF (IDLAM(LKNT,2).EQ.-5.OR.IDLAM(LKNT,3).EQ.5)
0172      &             DCMASS = .TRUE.
0173 C...Resonance KF codes (1=I,2=J,3=K)
0174               KFR(1)=-IDLAM(LKNT,1)
0175               KFR(2)=-IDLAM(LKNT,2)
0176               KFR(3)=-IDLAM(LKNT,3)
0177 C...Calculate width.
0178               CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3)
0179      &             ,XLAM(LKNT))
0180               XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32)
0181 C...Charge conjugate mode.
0182               LKNT=LKNT+1
0183               IDLAM(LKNT,1)=-IDLAM(LKNT-1,1)
0184               IDLAM(LKNT,2)=-IDLAM(LKNT-1,2)
0185               IDLAM(LKNT,3)=-IDLAM(LKNT-1,3)
0186               XLAM(LKNT)=XLAM(LKNT-1)
0187 C...KINEMATICS CHECK
0188               IF (XLAM(LKNT).EQ.0D0) THEN
0189                 LKNT=LKNT-2
0190               ENDIF
0191
0192 C * CHI0 -> LEPTON_I+ + UBAR_J + D_K
0193               LKNT = LKNT+1
0194               IDLAM(LKNT,1) =-11 -2*MOD(ISC/9,3)
0195               IDLAM(LKNT,2) = -2 -2*MOD(ISC/3,3)
0196               IDLAM(LKNT,3) =  1 +2*MOD(ISC,3)
0197               XLAM(LKNT)    =  0D0
0198 C...Set coupling, and decay product masses on/off
0199               RVLAMC        = 3 * RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1
0200      &             ,MOD(ISC,3)+1)**2
0201               DCMASS=.FALSE.
0202               IF (IDLAM(LKNT,1).EQ.-15.OR.IDLAM(LKNT,2).EQ.-6
0203      &             .OR.IDLAM(LKNT,3).EQ.5) DCMASS=.TRUE.
0204 C...Resonance KF codes (1=I,2=J,3=K)
0205               KFR(1)=-IDLAM(LKNT,1)
0206               KFR(2)=-IDLAM(LKNT,2)
0207               KFR(3)=-IDLAM(LKNT,3)
0208 C...Calculate width.
0209               CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3)
0210      &             ,XLAM(LKNT))
0211               XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32)
0212 C...Charge conjugate mode.
0213               LKNT=LKNT+1
0214               IDLAM(LKNT,1)=-IDLAM(LKNT-1,1)
0215               IDLAM(LKNT,2)=-IDLAM(LKNT-1,2)
0216               IDLAM(LKNT,3)=-IDLAM(LKNT-1,3)
0217               XLAM(LKNT)=XLAM(LKNT-1)
0218 C...KINEMATICS CHECK
0219               IF (XLAM(LKNT).EQ.0D0) THEN
0220                 LKNT=LKNT-2
0221               ENDIF
0222   140       CONTINUE
0223           ENDIF
0224
0225           IF (IMSS(53).GE.1) THEN
0226 C...LAMBDA'' COUPLINGS. (UDD TYPE R-VIOLATION)
0227 C * CHI0 -> UBAR_I + DBAR_J + DBAR_K
0228             DO 150 ISC=0,26
0229 C...Symmetry J<->K. Also, LAMB antisymmetric in J and K, so no J=K.
0230               IF (MOD(ISC/3,3).LT.MOD(ISC,3)) THEN
0231                 LKNT = LKNT+1
0232                 IDLAM(LKNT,1) = -2 -2*MOD(ISC/9,3)
0233                 IDLAM(LKNT,2) = -1 -2*MOD(ISC/3,3)
0234                 IDLAM(LKNT,3) = -1 -2*MOD(ISC,3)
0235                 XLAM(LKNT)    =  0D0
0236 C...Set coupling, and decay product masses on/off
0237                 RVLAMC        = 6. * RVLAMB(MOD(ISC/9,3)+1,MOD(ISC/3,3)
0238      &               +1,MOD(ISC,3)+1)**2
0239                 DCMASS=.FALSE.
0240                 IF (IDLAM(LKNT,1).EQ.-6.OR.IDLAM(LKNT,2).EQ.-5
0241      &               .OR.IDLAM(LKNT,3).EQ.-5) DCMASS=.TRUE.
0242 C...Resonance KF codes (1=I,2=J,3=K)
0243                 KFR(1) = IDLAM(LKNT,1)
0244                 KFR(2) = IDLAM(LKNT,2)
0245                 KFR(3) = IDLAM(LKNT,3)
0246 C...Calculate width.
0247                 CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),
0248      &               IDLAM(LKNT,3),XLAM(LKNT))
0249                 XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32)
0250 C...Charge conjugate mode.
0251                 LKNT=LKNT+1
0252                 IDLAM(LKNT,1)=-IDLAM(LKNT-1,1)
0253                 IDLAM(LKNT,2)=-IDLAM(LKNT-1,2)
0254                 IDLAM(LKNT,3)=-IDLAM(LKNT-1,3)
0255                 XLAM(LKNT)=XLAM(LKNT-1)
0256 C...KINEMATICS CHECK
0257                 IF (XLAM(LKNT).EQ.0D0) THEN
0258                   LKNT=LKNT-2
0259                 ENDIF
0260               ENDIF
0261   150       CONTINUE
0262           ENDIF
0263         ENDIF
0264       ENDIF
0265
0266       RETURN
0267       END