Analysis Software
Documentation for sPHENIX simulation software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
pyrvne.f
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file pyrvne.f
1 
2 C*********************************************************************
3 
4 C...PYRVNE
5 C...Calculates R-violating neutralino decay widths (pure 1->3 parts).
6 C...P. Z. Skands
7 
8  SUBROUTINE pyrvne(KFIN,XLAM,IDLAM,LKNT)
9 
10 C...Double precision and integer declarations.
11  IMPLICIT DOUBLE PRECISION(a-h, o-z)
12  IMPLICIT INTEGER(i-n)
13 C...Parameter statement to help give large particle numbers.
14  parameter(ksusy1=1000000,ksusy2=2000000,ktechn=3000000,
15  &kexcit=4000000,kdimen=5000000)
16 C...Commonblocks.
17  common/pydat1/mstu(200),paru(200),mstj(200),parj(200)
18  common/pydat2/kchg(500,4),pmas(500,4),parf(2000),vckm(4,4)
19  common/pymssm/imss(0:99),rmss(0:99)
20  common/pyssmt/zmix(4,4),umix(2,2),vmix(2,2),smz(4),smw(2),
21  &sfmix(16,4),zmixi(4,4),umixi(2,2),vmixi(2,2)
22  common/pymsrv/rvlam(3,3,3), rvlamp(3,3,3), rvlamb(3,3,3)
23 C...Local variables.
24  common/pyrvnv/ab(2,16,2),rms(0:3),res(6,2),intres(6,3),idr,idr2
25  & ,dcmass,kfr(3)
26  DOUBLE PRECISION xlam(0:400)
27  DOUBLE PRECISION zpmix(4,4), nmix(4,4), rmq(6)
28  INTEGER idlam(400,3), pycomp
29  LOGICAL dcmass
30  SAVE /pydat1/,/pydat2/,/pymssm/,/pyssmt/,/pymsrv/,/pyrvnv/
31 
32 C...R-VIOLATING DECAYS
33  IF ((imss(51).GE.1).OR.(imss(52).GE.1).OR.(imss(53).GE.1)) THEN
34  kfsm=kfin-ksusy1
35  IF(kfsm.EQ.22.OR.kfsm.EQ.23.OR.kfsm.EQ.25.OR.kfsm.EQ.35) THEN
36 C...WHICH NEUTRALINO ?
37  nchi=1
38  IF (kfsm.EQ.23) nchi=2
39  IF (kfsm.EQ.25) nchi=3
40  IF (kfsm.EQ.35) nchi=4
41 C...SIGN OF MASS (Opposite convention as HERWIG)
42  ism = 1
43  IF (smz(nchi).LT.0d0) ism = -ism
44 
45 C...Useful parameters for the calculation of the A and B constants.
46  wmass = pmas(pycomp(24),1)
47  echg = 2*sqrt(paru(103)*paru(1))
48  cosb=1/(sqrt(1+rmss(5)**2))
49  sinb=rmss(5)/sqrt(1+rmss(5)**2)
50  cosw=sqrt(1-paru(102))
51  sinw=sqrt(paru(102))
52  gw=2d0*sqrt(paru(103)*paru(1))/sinw
53 C...Run quark masses to neutralino mass squared (for Higgs-type
54 C...couplings)
55  sqmchi=pmas(pycomp(kfin),1)**2
56  DO 100 i=1,6
57  rmq(i)=pymrun(i,sqmchi)
58  100 CONTINUE
59 C...EXPRESS NEUTRALINO MIXING IN (photino,Zino,~H_u,~H_d) BASIS
60  DO 110 nchj=1,4
61  zpmix(nchj,1)= zmix(nchj,1)*cosw+zmix(nchj,2)*sinw
62  zpmix(nchj,2)=-zmix(nchj,1)*sinw+zmix(nchj,2)*cosw
63  zpmix(nchj,3)= zmix(nchj,3)
64  zpmix(nchj,4)= zmix(nchj,4)
65  110 CONTINUE
66  c1=gw*zpmix(nchi,3)/(2d0*cosb*wmass)
67  c1u=gw*zpmix(nchi,4)/(2d0*sinb*wmass)
68  c2=echg*zpmix(nchi,1)
69  c3=gw*zpmix(nchi,2)/cosw
70  eu=2d0/3d0
71  ed=-1d0/3d0
72 C... AB(x,y,z):
73 C x=1-2 : Select A or B constant (1:A ; 2:B)
74 C y=1-16 : Sparticle's SM code (1-6:d,u,s,c,b,t ;
75 C 11-16:e,nu_e,mu,...)
76 C z=1-2 : Mass eigenstate number
77 C...CALCULATE COUPLINGS
78  DO 120 i = 11,15,2
79  cms=pmas(pycomp(i),1)
80 C...Intermediate sleptons
81  ab(1,i,1)=ism*(cms*c1*sfmix(i,1) + sfmix(i,2)
82  & *(c2-c3*sinw**2))
83  ab(1,i,2)=ism*(cms*c1*sfmix(i,3) + sfmix(i,4)
84  & *(c2-c3*sinw**2))
85  ab(2,i,1)= cms*c1*sfmix(i,2) - sfmix(i,1)*(c2+c3*(5d-1-sinw
86  & **2))
87  ab(2,i,2)=cms*c1*sfmix(i,4) - sfmix(i,3)*(c2+c3*(5d-1-sinw
88  & **2))
89 C...Inermediate sneutrinos
90  ab(1,i+1,1)=0d0
91  ab(2,i+1,1)=5d-1*c3
92  ab(1,i+1,2)=0d0
93  ab(2,i+1,2)=0d0
94 C...Inermediate sdown
95  j=i-10
96  cms=rmq(j)
97  ab(1,j,1)=ism*(cms*c1*sfmix(j,1) - sfmix(j,2)
98  & *ed*(c2-c3*sinw**2))
99  ab(1,j,2)=ism*(cms*c1*sfmix(j,3) - sfmix(j,4)
100  & *ed*(c2-c3*sinw**2))
101  ab(2,j,1)=cms*c1*sfmix(j,2) + sfmix(j,1)
102  & *(ed*c2-c3*(1d0/2d0+ed*sinw**2))
103  ab(2,j,2)=cms*c1*sfmix(j,4) + sfmix(j,3)
104  & *(ed*c2-c3*(1d0/2d0+ed*sinw**2))
105 C...Inermediate sup
106  j=j+1
107  cms=rmq(j)
108  ab(1,j,1)=ism*(cms*c1u*sfmix(j,1) - sfmix(j,2)
109  & *eu*(c2-c3*sinw**2))
110  ab(1,j,2)=ism*(cms*c1u*sfmix(j,3) - sfmix(j,4)
111  & *eu*(c2-c3*sinw**2))
112  ab(2,j,1)=cms*c1u*sfmix(j,2) + sfmix(j,1)
113  & *(eu*c2+c3*(1d0/2d0-eu*sinw**2))
114  ab(2,j,2)=cms*c1u*sfmix(j,4) + sfmix(j,3)
115  & *(eu*c2+c3*(1d0/2d0-eu*sinw**2))
116  120 CONTINUE
117 
118  IF (imss(51).GE.1) THEN
119 C...LAMBDA COUPLINGS (LLE TYPE R-VIOLATION)
120 C * CHI0_I -> NUBAR_I + LEPTON+_J + lEPTON-_K.
121 C...STEP IN I,J,K USING SINGLE COUNTER
122  DO 130 isc=0,26
123 C...LAMBDA COUPLING ASYM IN I,J
124  IF(mod(isc/9,3).NE.mod(isc/3,3)) THEN
125  lknt = lknt+1
126  idlam(lknt,1) =-12 -2*mod(isc/9,3)
127  idlam(lknt,2) =-11 -2*mod(isc/3,3)
128  idlam(lknt,3) = 11 +2*mod(isc,3)
129  xlam(lknt) = 0d0
130 C...Set coupling, and decay product masses on/off
131  rvlamc = rvlam(mod(isc/9,3)+1,mod(isc/3,3)+1
132  & ,mod(isc,3)+1)**2
133  dcmass=.false.
134  IF (idlam(lknt,2).EQ.-15.OR.idlam(lknt,3).EQ.15)
135  & dcmass = .true.
136 C...Resonance KF codes (1=I,2=J,3=K)
137  kfr(1)=-idlam(lknt,1)
138  kfr(2)=-idlam(lknt,2)
139  kfr(3)=-idlam(lknt,3)
140 C...Calculate width.
141  CALL pyrvgw(kfin,idlam(lknt,1),idlam(lknt,2),
142  & idlam(lknt,3),xlam(lknt))
143  xlam(lknt)=xlam(lknt)*rvlamc/((2*paru(1)*rms(0))**3*32)
144 C...Charge conjugate mode.
145  lknt=lknt+1
146  idlam(lknt,1)=-idlam(lknt-1,1)
147  idlam(lknt,2)=-idlam(lknt-1,2)
148  idlam(lknt,3)=-idlam(lknt-1,3)
149  xlam(lknt)=xlam(lknt-1)
150 C...KINEMATICS CHECK
151  IF (xlam(lknt).EQ.0d0) THEN
152  lknt=lknt-2
153  ENDIF
154  ENDIF
155  130 CONTINUE
156  ENDIF
157 
158  IF (imss(52).GE.1) THEN
159 C...LAMBDA' COUPLINGS. (LQD TYPE R-VIOLATION)
160 C * CHI0 -> NUBAR_I + DBAR_J + D_K
161  DO 140 isc=0,26
162  lknt = lknt+1
163  idlam(lknt,1) =-12 -2*mod(isc/9,3)
164  idlam(lknt,2) = -1 -2*mod(isc/3,3)
165  idlam(lknt,3) = 1 +2*mod(isc,3)
166  xlam(lknt) = 0d0
167 C...Set coupling, and decay product masses on/off
168  rvlamc = 3 * rvlamp(mod(isc/9,3)+1,mod(isc/3,3)+1
169  & ,mod(isc,3)+1)**2
170  dcmass=.false.
171  IF (idlam(lknt,2).EQ.-5.OR.idlam(lknt,3).EQ.5)
172  & dcmass = .true.
173 C...Resonance KF codes (1=I,2=J,3=K)
174  kfr(1)=-idlam(lknt,1)
175  kfr(2)=-idlam(lknt,2)
176  kfr(3)=-idlam(lknt,3)
177 C...Calculate width.
178  CALL pyrvgw(kfin,idlam(lknt,1),idlam(lknt,2),idlam(lknt,3)
179  & ,xlam(lknt))
180  xlam(lknt)=xlam(lknt)*rvlamc/((2*paru(1)*rms(0))**3*32)
181 C...Charge conjugate mode.
182  lknt=lknt+1
183  idlam(lknt,1)=-idlam(lknt-1,1)
184  idlam(lknt,2)=-idlam(lknt-1,2)
185  idlam(lknt,3)=-idlam(lknt-1,3)
186  xlam(lknt)=xlam(lknt-1)
187 C...KINEMATICS CHECK
188  IF (xlam(lknt).EQ.0d0) THEN
189  lknt=lknt-2
190  ENDIF
191 
192 C * CHI0 -> LEPTON_I+ + UBAR_J + D_K
193  lknt = lknt+1
194  idlam(lknt,1) =-11 -2*mod(isc/9,3)
195  idlam(lknt,2) = -2 -2*mod(isc/3,3)
196  idlam(lknt,3) = 1 +2*mod(isc,3)
197  xlam(lknt) = 0d0
198 C...Set coupling, and decay product masses on/off
199  rvlamc = 3 * rvlamp(mod(isc/9,3)+1,mod(isc/3,3)+1
200  & ,mod(isc,3)+1)**2
201  dcmass=.false.
202  IF (idlam(lknt,1).EQ.-15.OR.idlam(lknt,2).EQ.-6
203  & .OR.idlam(lknt,3).EQ.5) dcmass=.true.
204 C...Resonance KF codes (1=I,2=J,3=K)
205  kfr(1)=-idlam(lknt,1)
206  kfr(2)=-idlam(lknt,2)
207  kfr(3)=-idlam(lknt,3)
208 C...Calculate width.
209  CALL pyrvgw(kfin,idlam(lknt,1),idlam(lknt,2),idlam(lknt,3)
210  & ,xlam(lknt))
211  xlam(lknt)=xlam(lknt)*rvlamc/((2*paru(1)*rms(0))**3*32)
212 C...Charge conjugate mode.
213  lknt=lknt+1
214  idlam(lknt,1)=-idlam(lknt-1,1)
215  idlam(lknt,2)=-idlam(lknt-1,2)
216  idlam(lknt,3)=-idlam(lknt-1,3)
217  xlam(lknt)=xlam(lknt-1)
218 C...KINEMATICS CHECK
219  IF (xlam(lknt).EQ.0d0) THEN
220  lknt=lknt-2
221  ENDIF
222  140 CONTINUE
223  ENDIF
224 
225  IF (imss(53).GE.1) THEN
226 C...LAMBDA'' COUPLINGS. (UDD TYPE R-VIOLATION)
227 C * CHI0 -> UBAR_I + DBAR_J + DBAR_K
228  DO 150 isc=0,26
229 C...Symmetry J<->K. Also, LAMB antisymmetric in J and K, so no J=K.
230  IF (mod(isc/3,3).LT.mod(isc,3)) THEN
231  lknt = lknt+1
232  idlam(lknt,1) = -2 -2*mod(isc/9,3)
233  idlam(lknt,2) = -1 -2*mod(isc/3,3)
234  idlam(lknt,3) = -1 -2*mod(isc,3)
235  xlam(lknt) = 0d0
236 C...Set coupling, and decay product masses on/off
237  rvlamc = 6. * rvlamb(mod(isc/9,3)+1,mod(isc/3,3)
238  & +1,mod(isc,3)+1)**2
239  dcmass=.false.
240  IF (idlam(lknt,1).EQ.-6.OR.idlam(lknt,2).EQ.-5
241  & .OR.idlam(lknt,3).EQ.-5) dcmass=.true.
242 C...Resonance KF codes (1=I,2=J,3=K)
243  kfr(1) = idlam(lknt,1)
244  kfr(2) = idlam(lknt,2)
245  kfr(3) = idlam(lknt,3)
246 C...Calculate width.
247  CALL pyrvgw(kfin,idlam(lknt,1),idlam(lknt,2),
248  & idlam(lknt,3),xlam(lknt))
249  xlam(lknt)=xlam(lknt)*rvlamc/((2*paru(1)*rms(0))**3*32)
250 C...Charge conjugate mode.
251  lknt=lknt+1
252  idlam(lknt,1)=-idlam(lknt-1,1)
253  idlam(lknt,2)=-idlam(lknt-1,2)
254  idlam(lknt,3)=-idlam(lknt-1,3)
255  xlam(lknt)=xlam(lknt-1)
256 C...KINEMATICS CHECK
257  IF (xlam(lknt).EQ.0d0) THEN
258  lknt=lknt-2
259  ENDIF
260  ENDIF
261  150 CONTINUE
262  ENDIF
263  ENDIF
264  ENDIF
265 
266  RETURN
267  END