Back to home page

sPhenix code displayed by LXR
 
 

    

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

0001  
0002 C*********************************************************************
0003  
0004 C...PYRVSF
0005 C...Calculates R-violating decays of sfermions.
0006 C...P. Z. Skands
0007  
0008       SUBROUTINE PYRVSF(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/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
0018       COMMON/PYMSSM/IMSS(0:99),RMSS(0:99)
0019       COMMON/PYSSMT/ZMIX(4,4),UMIX(2,2),VMIX(2,2),SMZ(4),SMW(2),
0020      &SFMIX(16,4),ZMIXI(4,4),UMIXI(2,2),VMIXI(2,2)
0021       COMMON/PYMSRV/RVLAM(3,3,3), RVLAMP(3,3,3), RVLAMB(3,3,3)
0022 C...Local variables.
0023       DOUBLE PRECISION XLAM(0:400)
0024       INTEGER IDLAM(400,3), PYCOMP
0025       SAVE /PYMSRV/,/PYSSMT/,/PYMSSM/,/PYDAT2/
0026  
0027 C...IS R-VIOLATION ON ?
0028       IF ((IMSS(51).GE.1).OR.(IMSS(52).GE.1).OR.(IMSS(53).GE.1)) THEN
0029 C...Mass eigenstate counter
0030         ICNT=INT(KFIN/KSUSY1)
0031 C...SM KF code of SUSY particle
0032         KFSM=KFIN-ICNT*KSUSY1
0033 C...Squared Sparticle Mass
0034         SM=PMAS(PYCOMP(KFIN),1)**2
0035 C... Squared mass of top quark
0036         SMT=PMAS(PYCOMP(6),1)**2
0037 C...IS L-VIOLATION ON ?
0038         IF ((IMSS(51).GE.1).OR.(IMSS(52).GE.1)) THEN
0039 C...SLEPTON -> NU(BAR) + LEPTON and UBAR + D
0040           IF(ICNT.NE.0.AND.(KFSM.EQ.11.OR.KFSM.EQ.13.OR.KFSM.EQ.15))
0041      &         THEN
0042             K=INT((KFSM-9)/2)
0043             DO 110 I=1,3
0044               DO 100 J=1,3
0045                 IF(I.NE.J) THEN
0046 C...~e,~mu,~tau -> nu_I + lepton-_J
0047                   LKNT = LKNT+1
0048                   IDLAM(LKNT,1)= 12 +2*(I-1)
0049                   IDLAM(LKNT,2)= 11 +2*(J-1)
0050                   IDLAM(LKNT,3)= 0
0051                   XLAM(LKNT)=0D0
0052                   RM2=RVLAM(I,J,K)**2*SFMIX(KFSM,2*ICNT)**2 * SM
0053                   IF (IMSS(51).NE.0) XLAM(LKNT) =
0054      &                 PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4)
0055 C...KINEMATICS CHECK
0056                   IF (XLAM(LKNT).EQ.0D0) THEN
0057                     LKNT=LKNT-1
0058                   ENDIF
0059                 ENDIF
0060   100         CONTINUE
0061   110       CONTINUE
0062 C...~e,~mu,~tau -> nu_Ibar + lepton-_K
0063             J=INT((KFSM-9)/2)
0064             DO 130 I=1,3
0065               IF(I.NE.J) THEN
0066                 DO 120 K=1,3
0067                   LKNT = LKNT+1
0068                   IDLAM(LKNT,1)=-12 -2*(I-1)
0069                   IDLAM(LKNT,2)= 11 +2*(K-1)
0070                   IDLAM(LKNT,3)= 0
0071                   XLAM(LKNT)=0D0
0072                   RM2=RVLAM(I,J,K)**2*SFMIX(KFSM,2*ICNT-1)**2 * SM
0073                   IF (IMSS(51).NE.0) XLAM(LKNT) =
0074      &                 PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4)
0075 C...KINEMATICS CHECK
0076                   IF (XLAM(LKNT).EQ.0D0) THEN
0077                     LKNT=LKNT-1
0078                   ENDIF
0079   120           CONTINUE
0080               ENDIF
0081   130       CONTINUE
0082 C...~e,~mu,~tau -> u_Jbar + d_K
0083             I=INT((KFSM-9)/2)
0084             DO 150 J=1,3
0085               DO 140 K=1,3
0086                 LKNT = LKNT+1
0087                 IDLAM(LKNT,1)=-2 -2*(J-1)
0088                 IDLAM(LKNT,2)= 1 +2*(K-1)
0089                 IDLAM(LKNT,3)= 0
0090                 XLAM(LKNT)=0
0091                 IF (IMSS(52).NE.0) THEN
0092 C...Use massive top quark
0093                   IF (IDLAM(LKNT,1).EQ.-6) THEN
0094                     RM2=3*RVLAMP(I,J,K)**2*SFMIX(KFSM,2*ICNT-1)**2
0095      &                   * (SM-SMT)
0096                     XLAM(LKNT) =
0097      &                   PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,3)
0098 C...If no top quark, all decay products massless
0099                   ELSE
0100                     RM2=3*RVLAMP(I,J,K)**2*SFMIX(KFSM,2*ICNT-1)**2 * SM
0101                     XLAM(LKNT) =
0102      &                   PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4)
0103                   ENDIF
0104 C...KINEMATICS CHECK
0105                   IF (XLAM(LKNT).EQ.0D0) THEN
0106                     LKNT=LKNT-1
0107                   ENDIF
0108                 ENDIF
0109   140         CONTINUE
0110   150       CONTINUE
0111           ENDIF
0112 C * SNEUTRINO -> LEPTON+ + LEPTON- and DBAR + D
0113 C...No right-handed neutrinos
0114           IF(ICNT.EQ.1) THEN
0115             IF(KFSM.EQ.12.OR.KFSM.EQ.14.OR.KFSM.EQ.16) THEN
0116               J=INT((KFSM-10)/2)
0117               DO 170 I=1,3
0118                 DO 160 K=1,3
0119                   IF (I.NE.J) THEN
0120 C...~nu_J -> lepton+_I + lepton-_K
0121                     LKNT = LKNT+1
0122                     IDLAM(LKNT,1)=-11 -2*(I-1)
0123                     IDLAM(LKNT,2)= 11 +2*(K-1)
0124                     IDLAM(LKNT,3)=  0
0125                     XLAM(LKNT)=0D0
0126                     RM2=RVLAM(I,J,K)**2 * SM
0127                     IF (IMSS(51).NE.0) XLAM(LKNT) =
0128      &                   PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4)
0129 C...KINEMATICS CHECK
0130                     IF (XLAM(LKNT).EQ.0D0) THEN
0131                       LKNT=LKNT-1
0132                     ENDIF
0133                   ENDIF
0134   160           CONTINUE
0135   170         CONTINUE
0136 C...~nu_I -> dbar_J + d_K
0137               I=INT((KFSM-10)/2)
0138               DO 190 J=1,3
0139                 DO 180 K=1,3
0140                   LKNT = LKNT+1
0141                   IDLAM(LKNT,1)=-1 -2*(J-1)
0142                   IDLAM(LKNT,2)= 1 +2*(K-1)
0143                   IDLAM(LKNT,3)= 0
0144                   XLAM(LKNT)=0D0
0145                   RM2=3*RVLAMP(I,J,K)**2 * SM
0146                   IF (IMSS(52).NE.0) XLAM(LKNT) =
0147      &                 PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4)
0148 C...KINEMATICS CHECK
0149                   IF (XLAM(LKNT).EQ.0D0) THEN
0150                     LKNT=LKNT-1
0151                   ENDIF
0152   180           CONTINUE
0153   190         CONTINUE
0154             ENDIF
0155           ENDIF
0156 C * SDOWN -> NU(BAR) + D and LEPTON- + U
0157           IF(ICNT.NE.0.AND.(KFSM.EQ.1.OR.KFSM.EQ.3.OR.KFSM.EQ.5)) THEN
0158             J=INT((KFSM+1)/2)
0159             DO 210 I=1,3
0160               DO 200 K=1,3
0161 C...~d_J -> nu_Ibar + d_K
0162                 LKNT = LKNT+1
0163                 IDLAM(LKNT,1)=-12 -2*(I-1)
0164                 IDLAM(LKNT,2)=  1 +2*(K-1)
0165                 IDLAM(LKNT,3)=  0
0166                 XLAM(LKNT)=0D0
0167                 RM2=RVLAMP(I,J,K)**2*SFMIX(KFSM,2*ICNT-1)**2 * SM
0168                 IF (IMSS(52).NE.0) XLAM(LKNT) =
0169      &               PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4)
0170 C...KINEMATICS CHECK
0171                 IF (XLAM(LKNT).EQ.0D0) THEN
0172                   LKNT=LKNT-1
0173                 ENDIF
0174   200         CONTINUE
0175   210       CONTINUE
0176             K=INT((KFSM+1)/2)
0177             DO 240 I=1,3
0178               DO 230 J=1,3
0179 C...~d_K -> nu_I + d_J
0180                 LKNT = LKNT+1
0181                 IDLAM(LKNT,1)= 12 +2*(I-1)
0182                 IDLAM(LKNT,2)=  1 +2*(J-1)
0183                 IDLAM(LKNT,3)=  0
0184                 XLAM(LKNT)=0D0
0185                 RM2=RVLAMP(I,J,K)**2*SFMIX(KFSM,2*ICNT)**2 * SM
0186                 IF (IMSS(52).NE.0) XLAM(LKNT) =
0187      &               PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4)
0188 C...KINEMATICS CHECK
0189                 IF (XLAM(LKNT).EQ.0D0) THEN
0190                   LKNT=LKNT-1
0191                 ENDIF
0192 C...~d_K -> lepton_I- + u_J
0193   220           LKNT = LKNT+1
0194                 IDLAM(LKNT,1)= 11 +2*(I-1)
0195                 IDLAM(LKNT,2)=  2 +2*(J-1)
0196                 IDLAM(LKNT,3)=  0
0197                 XLAM(LKNT)=0D0
0198                 IF (IMSS(52).NE.0) THEN
0199 C...Use massive top quark
0200                   IF (IDLAM(LKNT,2).EQ.6) THEN
0201                     RM2=RVLAMP(I,J,K)**2*SFMIX(KFSM,2*ICNT)**2*(SM-SMT)
0202                     XLAM(LKNT) =
0203      &                   PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,2)
0204 C...If no top quark, all decay products massless
0205                   ELSE
0206                     RM2=RVLAMP(I,J,K)**2*SFMIX(KFSM,2*ICNT)**2 * SM
0207                     XLAM(LKNT) =
0208      &                   PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4)
0209                   ENDIF
0210 C...KINEMATICS CHECK
0211                   IF (XLAM(LKNT).EQ.0D0) THEN
0212                     LKNT=LKNT-1
0213                   ENDIF
0214                 ENDIF
0215   230         CONTINUE
0216   240       CONTINUE
0217           ENDIF
0218 C * SUP -> LEPTON+ + D
0219           IF(ICNT.NE.0.AND.(KFSM.EQ.2.OR.KFSM.EQ.4.OR.KFSM.EQ.6)) THEN
0220             J=NINT(KFSM/2.)
0221             DO 260 I=1,3
0222               DO 250 K=1,3
0223 C...~u_J -> lepton_I+ + d_K
0224                 LKNT = LKNT+1
0225                 IDLAM(LKNT,1)=-11 -2*(I-1)
0226                 IDLAM(LKNT,2)=  1 +2*(K-1)
0227                 IDLAM(LKNT,3)=  0
0228                 XLAM(LKNT)=0D0
0229                 RM2=RVLAMP(I,J,K)**2*SFMIX(KFSM,2*ICNT-1)**2 * SM
0230                 IF (IMSS(52).NE.0) XLAM(LKNT) =
0231      &               PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4)
0232 C...KINEMATICS CHECK
0233                 IF (XLAM(LKNT).EQ.0D0) THEN
0234                   LKNT=LKNT-1
0235                 ENDIF
0236   250         CONTINUE
0237   260       CONTINUE
0238           ENDIF
0239         ENDIF
0240 C...BARYON NUMBER VIOLATING DECAYS
0241         IF (IMSS(53).GE.1) THEN
0242 C * SUP -> DBAR + DBAR
0243           IF(ICNT.NE.0.AND.(KFSM.EQ.2.OR.KFSM.EQ.4.OR.KFSM.EQ.6)) THEN
0244             I = KFSM/2
0245             DO 280 J=1,3
0246               DO 270 K=1,3
0247 C...~u_I -> dbar_J + dbar_K
0248                 IF (J.LT.K) THEN
0249 C...(anti-) symmetry J <-> K.
0250                   LKNT = LKNT + 1
0251                   IDLAM(LKNT,1) = -1 -2*(J-1)
0252                   IDLAM(LKNT,2) = -1 -2*(K-1)
0253                   IDLAM(LKNT,3) =  0
0254                   XLAM(LKNT)    =  0D0
0255                   RM2 = 2.*(RVLAMB(I,J,K)**2)
0256      &                 * SFMIX(KFSM,2*ICNT)**2 * SM
0257                   XLAM(LKNT)    =
0258      &                 PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4)
0259 C...KINEMATICS CHECK
0260                   IF (XLAM(LKNT).EQ.0D0) THEN
0261                     LKNT = LKNT-1
0262                   ENDIF
0263                 ENDIF
0264   270         CONTINUE
0265   280       CONTINUE
0266           ENDIF
0267 C * SDOWN -> UBAR + DBAR
0268           IF(ICNT.NE.0.AND.(KFSM.EQ.1.OR.KFSM.EQ.3.OR.KFSM.EQ.5)) THEN
0269             K=(KFSM+1)/2
0270             DO 300 I=1,3
0271               DO 290 J=1,3
0272 C...LAMB coupling antisymmetric in J and K.
0273                 IF (J.NE.K) THEN
0274 C...~d_K -> ubar_I + dbar_K
0275                   LKNT = LKNT + 1
0276                   IDLAM(LKNT,1)= -2 -2*(I-1)
0277                   IDLAM(LKNT,2)= -1 -2*(J-1)
0278                   IDLAM(LKNT,3)=  0
0279                   XLAM(LKNT)=0D0
0280 C...Use massive top quark
0281                   IF (IDLAM(LKNT,1).EQ.-6) THEN
0282                     RM2=2*RVLAMB(I,J,K)**2*SFMIX(KFSM,2*ICNT)**2*(SM-SMT
0283      &                   )
0284                     XLAM(LKNT) =
0285      &                   PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,3)
0286 C...If no top quark, all decay products massless
0287                   ELSE
0288                     RM2=2*RVLAMB(I,J,K)**2*SFMIX(KFSM,2*ICNT)**2 * SM
0289                     XLAM(LKNT) =
0290      &                   PYRVSB(KFIN,IDLAM(LKNT,1),IDLAM(LKNT,2),RM2,4)
0291                   ENDIF
0292 C...KINEMATICS CHECK
0293                   IF (XLAM(LKNT).EQ.0D0) THEN
0294                     LKNT=LKNT-1
0295                   ENDIF
0296                 ENDIF
0297   290         CONTINUE
0298   300       CONTINUE
0299           ENDIF
0300         ENDIF
0301       ENDIF
0302  
0303       RETURN
0304       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated by the 2.3.7 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!