pythiaeRHIC/pythia/pyrvgl.f

0001
0002 C*********************************************************************
0003
0004 C...PYRVGL
0005 C...Calculates R-violating gluino decay widths.
0006 C...See BV part of PYRVCH for comments about the way the BV decay width
0007 C...is calculated. Same comments apply here.
0008 C...P. Z. Skands
0009
0010       SUBROUTINE PYRVGL(KFIN,XLAM,IDLAM,LKNT)
0011
0012 C...Double precision and integer declarations.
0013       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0014       IMPLICIT INTEGER(I-N)
0015 C...Parameter statement to help give large particle numbers.
0016       PARAMETER (KSUSY1=1000000,KSUSY2=2000000,KTECHN=3000000,
0017      &KEXCIT=4000000,KDIMEN=5000000)
0018 C...Commonblocks.
0019       COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0020       COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
0021       COMMON/PYMSSM/IMSS(0:99),RMSS(0:99)
0022       COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2),
0023      &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2)
0024       COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3)
0025 C...Local variables.
0026       DOUBLE PRECISION XLAM(0:400)
0027       INTEGER IDLAM(400,3), PYCOMP
0028 C...Information from main routine to PYRVGW
0029       COMMON/PYRVNV/AB(2,16,2),RMS(0:3),RES(6,2),INTRES(6,3),IDR,IDR2
0030      &     ,DCMASS,KFR(3)
0031 C...Auxiliary variables needed for BV (RV Gauge STOre)
0032       COMMON/RVGSTO/XRESI,XRESJ,XRESK,XRESIJ,XRESIK,XRESJK,RVLIJK,RVLKIJ
0033      &     ,RVLJKI,RVLJIK
0034 C...Running quark masses
0035       DOUBLE PRECISION RMQ(6)
0036 C...Decay product masses on/off
0037       LOGICAL DCMASS
0038       SAVE /PYDAT1/,/PYDAT2/,/PYMSSM/,/PYSSMT/,/PYMSRV/,/PYRVNV/,
0039      &     /RVGSTO/
0040
0041 C...IF LQD OR UDD TYPE R-VIOLATION ON.
0042       IF (IMSS(52).GE.1.OR.IMSS(53).GE.1) THEN
0043         KFSM=KFIN-KSUSY1
0044
0045 C... AB(x,y,z):
0046 C       x=1-2  : Select A or B coupling     (1:A ; 2:B)
0047 C       y=1-16 : Sparticle's SM code (1-6:d,u,s,c,b,t ;
0048 C                                    11-16:e,nu_e,mu,... not used here)
0049 C       z=1-2  : Mass eigenstate number
0050         DO 100 I = 1,6
0051 C...A Couplings
0052           AB(1,I,1) = SFMIX(I,2)
0053           AB(1,I,2) = SFMIX(I,4)
0054 C...B Couplings
0055           AB(2,I,1) = -SFMIX(I,1)
0056           AB(2,I,2) = -SFMIX(I,3)
0057   100   CONTINUE
0058         GSTR2 = 4D0*PARU(1) * PYALPS(PMAS(PYCOMP(KFIN),1)**2)
0059 C...LQD DECAYS.
0060         IF (IMSS(52).GE.1) THEN
0061 C...STEP IN I,J,K USING SINGLE COUNTER
0062           DO 120 ISC=0,26
0063 C * GLUINO -> NUBAR_I + DBAR_J + D_K.
0064             LKNT          = LKNT+1
0065             IDLAM(LKNT,1) =-12 -2*MOD(ISC/9,3)
0066             IDLAM(LKNT,2) = -1 -2*MOD(ISC/3,3)
0067             IDLAM(LKNT,3) =  1 +2*MOD(ISC,3)
0068             XLAM(LKNT)=0D0
0069 C...Set coupling, and decay product masses on/off
0070             RVLAMC=RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1)**2
0071      &           * 5D-1 * GSTR2
0072             DCMASS        = .FALSE.
0073             IF (IDLAM(LKNT,2).EQ.-5.OR.IDLAM(LKNT,3).EQ.5) DCMASS=.TRUE.
0074 C...Resonance KF codes (1=I,2=J,3=K)
0075             KFR(1)        = 0
0076             KFR(2)        = -IDLAM(LKNT,2)
0077             KFR(3)        = -IDLAM(LKNT,3)
0078 C...Calculate width.
0079             CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3)
0080      &           ,XLAM(LKNT))
0081 C...Normalize
0082             XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32)
0083 C...Charge conjugate mode.
0084   110       LKNT          = LKNT+1
0085             IDLAM(LKNT,1) =-IDLAM(LKNT-1,1)
0086             IDLAM(LKNT,2) =-IDLAM(LKNT-1,2)
0087             IDLAM(LKNT,3) =-IDLAM(LKNT-1,3)
0088             XLAM(LKNT)    = XLAM(LKNT-1)
0089 C...KINEMATICS CHECK
0090             IF (XLAM(LKNT).EQ.0D0) THEN
0091               LKNT=LKNT-2
0092             ENDIF
0093
0094 C * GLUINO -> LEPTON+_I + UBAR_J + D_K
0095             LKNT = LKNT+1
0096             IDLAM(LKNT,1) =-11 -2*MOD(ISC/9,3)
0097             IDLAM(LKNT,2) = -2 -2*MOD(ISC/3,3)
0098             IDLAM(LKNT,3) =  1 +2*MOD(ISC,3)
0099             XLAM(LKNT)=0D0
0100 C...Set coupling, and decay product masses on/off
0101             RVLAMC = RVLAMP(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1)
0102      &           **2* 5D-1 * GSTR2
0103             DCMASS        = .FALSE.
0104             IF (IDLAM(LKNT,1).EQ.-15.OR.IDLAM(LKNT,2).EQ.-6
0105      &           .OR.IDLAM(LKNT,3).EQ.5) DCMASS = .TRUE.
0106 C...Resonance KF codes (1=I,2=J,3=K)
0107             KFR(1)        = 0
0108             KFR(2)        = -IDLAM(LKNT,2)
0109             KFR(3)        = -IDLAM(LKNT,3)
0110 C...Calculate width.
0111             CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3)
0112      &           ,XLAM(LKNT))
0113             XLAM(LKNT)=XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32)
0114 C...Charge conjugate mode.
0115             LKNT=LKNT+1
0116             IDLAM(LKNT,1) = -IDLAM(LKNT-1,1)
0117             IDLAM(LKNT,2) = -IDLAM(LKNT-1,2)
0118             IDLAM(LKNT,3) = -IDLAM(LKNT-1,3)
0119             XLAM(LKNT)    =  XLAM(LKNT-1)
0120 C...KINEMATICS CHECK
0121             IF (XLAM(LKNT).EQ.0D0) THEN
0122               LKNT=LKNT-2
0123             ENDIF
0124
0125   120     CONTINUE
0126         ENDIF
0127
0128 C...UDD DECAYS.
0129         IF (IMSS(53).GE.1) THEN
0130 C...STEP IN I,J,K USING SINGLE COUNTER
0131           DO 130 ISC=0,26
0132 C * GLUINO -> UBAR_I + DBAR_J + DBAR_K.
0133             IF (MOD(ISC/3,3).LT.MOD(ISC,3)) THEN
0134               LKNT          = LKNT+1
0135               IDLAM(LKNT,1) = -2 -2*MOD(ISC/9,3)
0136               IDLAM(LKNT,2) = -1 -2*MOD(ISC/3,3)
0137               IDLAM(LKNT,3) = -1 -2*MOD(ISC,3)
0138               XLAM(LKNT)=0D0
0139 C...Set coupling, and decay product masses on/off. A factor of 2 for
0140 C...(N_C-1) has been used to cancel a factor 0.5.
0141               RVLAMC=RVLAMB(MOD(ISC/9,3)+1,MOD(ISC/3,3)+1,MOD(ISC,3)+1)
0142      &             **2 * GSTR2
0143               DCMASS        = .FALSE.
0144               IF (IDLAM(LKNT,1).EQ.-6.OR.IDLAM(LKNT,2).EQ.-5
0145      &             .OR.IDLAM(LKNT,3).EQ.-5) DCMASS=.TRUE.
0146 C...Resonance KF codes (1=I,2=J,3=K)
0147               KFR(1)        = IDLAM(LKNT,1)
0148               KFR(2)        = 0
0149               KFR(3)        = 0
0150 C...Calculate width.
0151               CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3)
0152      &             ,XRESI)
0153 C...Resonance KF codes (1=I,2=J,3=K)
0154               KFR(1)        = 0
0155               KFR(2)        = IDLAM(LKNT,2)
0156               KFR(3)        = 0
0157 C...Calculate width.
0158               CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3)
0159      &             ,XRESJ)
0160 C...Resonance KF codes (1=I,2=J,3=K)
0161               KFR(1)        = 0
0162               KFR(2)        = 0
0163               KFR(3)        = IDLAM(LKNT,3)
0164 C...Calculate width.
0165               CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3)
0166      &             ,XRESK)
0167 C...Resonance KF codes (1=I,2=J,3=K)
0168               KFR(1)        = IDLAM(LKNT,1)
0169               KFR(2)        = IDLAM(LKNT,2)
0170               KFR(3)        = 0
0171 C...Calculate width.
0172               CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3)
0173      &             ,XRESIJ)
0174 C...Calculate interference function. (Factor -1/2 to make up for factor
0175 C...-2 in PYRVGW.
0176               IF (ABS((XRESI+XRESJ)/XRESIJ-1D0).GT.1D-4) THEN
0177                 XRESIJ = 5D-1 * (XRESI+XRESJ-XRESIJ)
0178               ELSE
0179                 XRESIJ = 0D0
0180               ENDIF
0181 C...Resonance KF codes (1=I,2=J,3=K)
0182               KFR(1)        = 0
0183               KFR(2)        = IDLAM(LKNT,2)
0184               KFR(3)        = IDLAM(LKNT,3)
0185 C...Calculate width.
0186               CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3)
0187      &             ,XRESJK)
0188               IF (ABS((XRESJ+XRESK)/XRESJK-1).GT.1D-4) THEN
0189                 XRESJK = 5D-1 * (XRESJ+XRESK-XRESJK)
0190               ELSE
0191                 XRESJK = 0D0
0192               ENDIF
0193 C...Resonance KF codes (1=I,2=J,3=K)
0194               KFR(1)        = IDLAM(LKNT,1)
0195               KFR(2)        = 0
0196               KFR(3)        = IDLAM(LKNT,3)
0197 C...Calculate width.
0198               CALL PYRVGW(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),IDLAM(LKNT,3)
0199      &             ,XRESIK)
0200               IF (ABS((XRESI+XRESK)/XRESIK-1).GT.1D-4) THEN
0201                 XRESIK = 5D-1 * (XRESI+XRESK-XRESIK)
0202               ELSE
0203                 XRESIK = 0D0
0204               ENDIF
0205 C...Calculate total width (factor 1/2 from 1/(N_C-1))
0206               XLAM(LKNT) = XRESI + XRESJ + XRESK
0207      &             + 5D-1 * (XRESIJ + XRESIK + XRESJK)
0208 C...Normalize
0209               XLAM(LKNT) = XLAM(LKNT)*RVLAMC/((2*PARU(1)*RMS(0))**3*32)
0210 C...Charge conjugate mode.
0211               LKNT          = LKNT+1
0212               IDLAM(LKNT,1) =-IDLAM(LKNT-1,1)
0213               IDLAM(LKNT,2) =-IDLAM(LKNT-1,2)
0214               IDLAM(LKNT,3) =-IDLAM(LKNT-1,3)
0215               XLAM(LKNT)    = XLAM(LKNT-1)
0216 C...KINEMATICS CHECK
0217               IF (XLAM(LKNT).EQ.0D0) THEN
0218                 LKNT=LKNT-2
0219               ENDIF
0220             ENDIF
0221   130     CONTINUE
0222         ENDIF
0223       ENDIF
0224       RETURN
0225       END