Analysis Software
Documentation for sPHENIX simulation software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
pyrvgl.f
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file pyrvgl.f
1 
2 C*********************************************************************
3 
4 C...PYRVGL
5 C...Calculates R-violating gluino decay widths.
6 C...See BV part of PYRVCH for comments about the way the BV decay width
7 C...is calculated. Same comments apply here.
8 C...P. Z. Skands
9 
10  SUBROUTINE pyrvgl(KFIN,XLAM,IDLAM,LKNT)
11 
12 C...Double precision and integer declarations.
13  IMPLICIT DOUBLE PRECISION(a-h, o-z)
14  IMPLICIT INTEGER(i-n)
15 C...Parameter statement to help give large particle numbers.
16  parameter(ksusy1=1000000,ksusy2=2000000,ktechn=3000000,
17  &kexcit=4000000,kdimen=5000000)
18 C...Commonblocks.
19  common/pydat1/mstu(200),paru(200),mstj(200),parj(200)
20  common/pydat2/kchg(500,4),pmas(500,4),parf(2000),vckm(4,4)
21  common/pymssm/imss(0:99),rmss(0:99)
22  common/pyssmt/zmix(4,4),umix(2,2),vmix(2,2),smz(4),smw(2),
23  &sfmix(16,4),zmixi(4,4),umixi(2,2),vmixi(2,2)
24  common/pymsrv/rvlam(3,3,3), rvlamp(3,3,3), rvlamb(3,3,3)
25 C...Local variables.
26  DOUBLE PRECISION xlam(0:400)
27  INTEGER idlam(400,3), pycomp
28 C...Information from main routine to PYRVGW
29  common/pyrvnv/ab(2,16,2),rms(0:3),res(6,2),intres(6,3),idr,idr2
30  & ,dcmass,kfr(3)
31 C...Auxiliary variables needed for BV (RV Gauge STOre)
32  common/rvgsto/xresi,xresj,xresk,xresij,xresik,xresjk,rvlijk,rvlkij
33  & ,rvljki,rvljik
34 C...Running quark masses
35  DOUBLE PRECISION rmq(6)
36 C...Decay product masses on/off
37  LOGICAL dcmass
38  SAVE /pydat1/,/pydat2/,/pymssm/,/pyssmt/,/pymsrv/,/pyrvnv/,
39  & /rvgsto/
40 
41 C...IF LQD OR UDD TYPE R-VIOLATION ON.
42  IF (imss(52).GE.1.OR.imss(53).GE.1) THEN
43  kfsm=kfin-ksusy1
44 
45 C... AB(x,y,z):
46 C x=1-2 : Select A or B coupling (1:A ; 2:B)
47 C y=1-16 : Sparticle's SM code (1-6:d,u,s,c,b,t ;
48 C 11-16:e,nu_e,mu,... not used here)
49 C z=1-2 : Mass eigenstate number
50  DO 100 i = 1,6
51 C...A Couplings
52  ab(1,i,1) = sfmix(i,2)
53  ab(1,i,2) = sfmix(i,4)
54 C...B Couplings
55  ab(2,i,1) = -sfmix(i,1)
56  ab(2,i,2) = -sfmix(i,3)
57  100 CONTINUE
58  gstr2 = 4d0*paru(1) * pyalps(pmas(pycomp(kfin),1)**2)
59 C...LQD DECAYS.
60  IF (imss(52).GE.1) THEN
61 C...STEP IN I,J,K USING SINGLE COUNTER
62  DO 120 isc=0,26
63 C * GLUINO -> NUBAR_I + DBAR_J + D_K.
64  lknt = lknt+1
65  idlam(lknt,1) =-12 -2*mod(isc/9,3)
66  idlam(lknt,2) = -1 -2*mod(isc/3,3)
67  idlam(lknt,3) = 1 +2*mod(isc,3)
68  xlam(lknt)=0d0
69 C...Set coupling, and decay product masses on/off
70  rvlamc=rvlamp(mod(isc/9,3)+1,mod(isc/3,3)+1,mod(isc,3)+1)**2
71  & * 5d-1 * gstr2
72  dcmass = .false.
73  IF (idlam(lknt,2).EQ.-5.OR.idlam(lknt,3).EQ.5) dcmass=.true.
74 C...Resonance KF codes (1=I,2=J,3=K)
75  kfr(1) = 0
76  kfr(2) = -idlam(lknt,2)
77  kfr(3) = -idlam(lknt,3)
78 C...Calculate width.
79  CALL pyrvgw(kfin,idlam(lknt,1),idlam(lknt,2),idlam(lknt,3)
80  & ,xlam(lknt))
81 C...Normalize
82  xlam(lknt)=xlam(lknt)*rvlamc/((2*paru(1)*rms(0))**3*32)
83 C...Charge conjugate mode.
84  110 lknt = lknt+1
85  idlam(lknt,1) =-idlam(lknt-1,1)
86  idlam(lknt,2) =-idlam(lknt-1,2)
87  idlam(lknt,3) =-idlam(lknt-1,3)
88  xlam(lknt) = xlam(lknt-1)
89 C...KINEMATICS CHECK
90  IF (xlam(lknt).EQ.0d0) THEN
91  lknt=lknt-2
92  ENDIF
93 
94 C * GLUINO -> LEPTON+_I + UBAR_J + D_K
95  lknt = lknt+1
96  idlam(lknt,1) =-11 -2*mod(isc/9,3)
97  idlam(lknt,2) = -2 -2*mod(isc/3,3)
98  idlam(lknt,3) = 1 +2*mod(isc,3)
99  xlam(lknt)=0d0
100 C...Set coupling, and decay product masses on/off
101  rvlamc = rvlamp(mod(isc/9,3)+1,mod(isc/3,3)+1,mod(isc,3)+1)
102  & **2* 5d-1 * gstr2
103  dcmass = .false.
104  IF (idlam(lknt,1).EQ.-15.OR.idlam(lknt,2).EQ.-6
105  & .OR.idlam(lknt,3).EQ.5) dcmass = .true.
106 C...Resonance KF codes (1=I,2=J,3=K)
107  kfr(1) = 0
108  kfr(2) = -idlam(lknt,2)
109  kfr(3) = -idlam(lknt,3)
110 C...Calculate width.
111  CALL pyrvgw(kfin,idlam(lknt,1),idlam(lknt,2),idlam(lknt,3)
112  & ,xlam(lknt))
113  xlam(lknt)=xlam(lknt)*rvlamc/((2*paru(1)*rms(0))**3*32)
114 C...Charge conjugate mode.
115  lknt=lknt+1
116  idlam(lknt,1) = -idlam(lknt-1,1)
117  idlam(lknt,2) = -idlam(lknt-1,2)
118  idlam(lknt,3) = -idlam(lknt-1,3)
119  xlam(lknt) = xlam(lknt-1)
120 C...KINEMATICS CHECK
121  IF (xlam(lknt).EQ.0d0) THEN
122  lknt=lknt-2
123  ENDIF
124 
125  120 CONTINUE
126  ENDIF
127 
128 C...UDD DECAYS.
129  IF (imss(53).GE.1) THEN
130 C...STEP IN I,J,K USING SINGLE COUNTER
131  DO 130 isc=0,26
132 C * GLUINO -> UBAR_I + DBAR_J + DBAR_K.
133  IF (mod(isc/3,3).LT.mod(isc,3)) THEN
134  lknt = lknt+1
135  idlam(lknt,1) = -2 -2*mod(isc/9,3)
136  idlam(lknt,2) = -1 -2*mod(isc/3,3)
137  idlam(lknt,3) = -1 -2*mod(isc,3)
138  xlam(lknt)=0d0
139 C...Set coupling, and decay product masses on/off. A factor of 2 for
140 C...(N_C-1) has been used to cancel a factor 0.5.
141  rvlamc=rvlamb(mod(isc/9,3)+1,mod(isc/3,3)+1,mod(isc,3)+1)
142  & **2 * gstr2
143  dcmass = .false.
144  IF (idlam(lknt,1).EQ.-6.OR.idlam(lknt,2).EQ.-5
145  & .OR.idlam(lknt,3).EQ.-5) dcmass=.true.
146 C...Resonance KF codes (1=I,2=J,3=K)
147  kfr(1) = idlam(lknt,1)
148  kfr(2) = 0
149  kfr(3) = 0
150 C...Calculate width.
151  CALL pyrvgw(kfin,idlam(lknt,1),idlam(lknt,2),idlam(lknt,3)
152  & ,xresi)
153 C...Resonance KF codes (1=I,2=J,3=K)
154  kfr(1) = 0
155  kfr(2) = idlam(lknt,2)
156  kfr(3) = 0
157 C...Calculate width.
158  CALL pyrvgw(kfin,idlam(lknt,1),idlam(lknt,2),idlam(lknt,3)
159  & ,xresj)
160 C...Resonance KF codes (1=I,2=J,3=K)
161  kfr(1) = 0
162  kfr(2) = 0
163  kfr(3) = idlam(lknt,3)
164 C...Calculate width.
165  CALL pyrvgw(kfin,idlam(lknt,1),idlam(lknt,2),idlam(lknt,3)
166  & ,xresk)
167 C...Resonance KF codes (1=I,2=J,3=K)
168  kfr(1) = idlam(lknt,1)
169  kfr(2) = idlam(lknt,2)
170  kfr(3) = 0
171 C...Calculate width.
172  CALL pyrvgw(kfin,idlam(lknt,1),idlam(lknt,2),idlam(lknt,3)
173  & ,xresij)
174 C...Calculate interference function. (Factor -1/2 to make up for factor
175 C...-2 in PYRVGW.
176  IF (abs((xresi+xresj)/xresij-1d0).GT.1d-4) THEN
177  xresij = 5d-1 * (xresi+xresj-xresij)
178  ELSE
179  xresij = 0d0
180  ENDIF
181 C...Resonance KF codes (1=I,2=J,3=K)
182  kfr(1) = 0
183  kfr(2) = idlam(lknt,2)
184  kfr(3) = idlam(lknt,3)
185 C...Calculate width.
186  CALL pyrvgw(kfin,idlam(lknt,1),idlam(lknt,2),idlam(lknt,3)
187  & ,xresjk)
188  IF (abs((xresj+xresk)/xresjk-1).GT.1d-4) THEN
189  xresjk = 5d-1 * (xresj+xresk-xresjk)
190  ELSE
191  xresjk = 0d0
192  ENDIF
193 C...Resonance KF codes (1=I,2=J,3=K)
194  kfr(1) = idlam(lknt,1)
195  kfr(2) = 0
196  kfr(3) = idlam(lknt,3)
197 C...Calculate width.
198  CALL pyrvgw(kfin,idlam(lknt,1),idlam(lknt,2),idlam(lknt,3)
199  & ,xresik)
200  IF (abs((xresi+xresk)/xresik-1).GT.1d-4) THEN
201  xresik = 5d-1 * (xresi+xresk-xresik)
202  ELSE
203  xresik = 0d0
204  ENDIF
205 C...Calculate total width (factor 1/2 from 1/(N_C-1))
206  xlam(lknt) = xresi + xresj + xresk
207  & + 5d-1 * (xresij + xresik + xresjk)
208 C...Normalize
209  xlam(lknt) = xlam(lknt)*rvlamc/((2*paru(1)*rms(0))**3*32)
210 C...Charge conjugate mode.
211  lknt = lknt+1
212  idlam(lknt,1) =-idlam(lknt-1,1)
213  idlam(lknt,2) =-idlam(lknt-1,2)
214  idlam(lknt,3) =-idlam(lknt-1,3)
215  xlam(lknt) = xlam(lknt-1)
216 C...KINEMATICS CHECK
217  IF (xlam(lknt).EQ.0d0) THEN
218  lknt=lknt-2
219  ENDIF
220  ENDIF
221  130 CONTINUE
222  ENDIF
223  ENDIF
224  RETURN
225  END