C++ Interface to Tauola
tauola-BBB/tauface-KK-F/Tauface.f
1*/////////////////////////////////////////////////////////////////////////////////////
2*// //
3*// !!!!!!! WARNING!!!!! This source is agressive !!!! //
4*// //
5*// Due to short common block names it owerwrites variables in other parts //
6*// of the code. //
7*// //
8*// One should add suffix c_Taul_ to names of all commons as soon as possible!!!! //
9*// //
10*/////////////////////////////////////////////////////////////////////////////////////
11
12*/////////////////////////////////////////////////////////////////////////////////////
13*// //
14*// Standard Tauola interface/initialization routines of functionality exactly //
15*// as in Tauola CPC but input is partially from xpar(*) matrix //
16*// ITAUXPAR is for indirect adressing //
17*// //
18*/////////////////////////////////////////////////////////////////////////////////////
19
20
21 SUBROUTINE inietc(ITAUXPAR,xpar)
22 include "BXformat.h"
23 real*8 xpar(*)
24 INTEGER INUT,IOUT
25 COMMON /inout/
26 $ inut, ! Input unit number (not used)
27 $ iout ! Ounput unit number
28 COMMON / idfc / idff
29 COMMON / taurad / xk0dec,itdkrc
30 DOUBLE PRECISION XK0DEC
31 COMMON / jaki / jak1,jak2,jakp,jakm,ktom
32* Note: I dont see KeyA1=2,3 realy implemented in the code SJ. ??????
33 INTEGER KeyA1
34 COMMON /testa1/
35 $ keya1 ! Special switch for tests of dGamma/dQ**2 in a1 decay
36* KeyA1=1 constant width of a1 and rho
37* KeyA1=2 free choice of rho propagator (defined in function FPIK)
38* and free choice of a1 mass and width. function g(Q**2)
39* (see formula 3.48 in Comp. Phys. Comm. 64 (1991) 275)
40* hard coded both in Monte Carlo and in testing distribution.
41* KeyA1=3 function g(Q**2) hardcoded in the Monte Carlo
42* (it is timy to calculate!), but appropriately adjusted in testing distribution.
43 SAVE
44 idff = xpar(itauxpar+3) ! Lund identifier for first tau (15 for tau-)
45C XK0 for tau decays.
46 xk0dec = xpar(itauxpar+5) ! IR-cut for QED rad. in leptonic decays
47C radiative correction switch in tau --> e (mu) decays !
48 itdkrc = xpar(itauxpar+4) ! QED rad. in leptonic decays
49C switches of tau+ tau- decay modes !!
50 jak1 = xpar(itauxpar+1) ! Decay Mask for first tau
51 jak2 = xpar(itauxpar+2) ! Decay Mask for second tau
52C output file number for TAUOLA
53 iout = xpar(4)
54C KeyA1 is used for formfactors actually not in use
55 keya1 = xpar(itauxpar+6) ! Type of a1 current
56
57 WRITE(iout,bxope)
58 WRITE(iout,bxtxt) ' Parameters passed from KK to Tauola: '
59 WRITE(iout,bxl1i) jak1, 'dec. type 1-st tau ','Jak1 ','t01'
60 WRITE(iout,bxl1i) jak2, 'dec. type 2-nd tau ','Jak2 ','t02'
61 WRITE(iout,bxl1i) keya1, 'current type a1 dec.','KeyA1 ','t03'
62 WRITE(iout,bxl1i) idff, 'PDG id 1-st tau ','idff ','t04'
63 WRITE(iout,bxl1i) itdkrc, 'R.c. switch lept dec','itdkRC','t05'
64 WRITE(iout,bxl1g) xk0dec, 'IR-cut for lept r.c.','xk0dec','t06'
65 WRITE(iout,bxclo)
66
67 end
68
69 SUBROUTINE initdk(ITAUXPAR,xpar)
70* ----------------------------------------------------------------------
71* INITIALISATION OF TAU DECAY PARAMETERS and routines
72*
73* called by : KORALZ
74* ----------------------------------------------------------------------
75 include "BXformat.h"
76 INTEGER INUT,IOUT
77 COMMON /inout/
78 $ inut, ! Input unit number (not used)
79 $ iout ! Ounput unit number
80 real*8 xpar(*)
81
82 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
83 real*4 gfermi,gv,ga,ccabib,scabib,gamel
84 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
85 * ,ampiz,ampi,amro,gamro,ama1,gama1
86 * ,amk,amkz,amkst,gamkst
87*
88 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
89 * ,ampiz,ampi,amro,gamro,ama1,gama1
90 * ,amk,amkz,amkst,gamkst
91 COMMON / taubra / gamprt(500),jlist(500),nchan
92 COMMON / taukle / bra1,brk0,brk0b,brks
93 real*4 bra1,brk0,brk0b,brks
94
95 parameter(nmode=86,nm1=0,nm2=11,nm3=19,nm4=22,nm5=21,nm6=13)
96 COMMON / taudcd /idffin(9,nmode),mulpik(nmode)
97 & ,names
98 CHARACTER NAMES(NMODE)*31
99
100 CHARACTER OLDNAMES(7)*31
101 CHARACTER*80 bxINIT
102 parameter(
103 $ bxinit ='(1x,1h*,g17.8, 16x, a31,a4,a4, 1x,1h*)'
104 $ )
105 real*4 pi,pol1(4)
106*
107*
108* LIST OF BRANCHING RATIOS
109CAM normalised to e nu nutau channel
110CAM enu munu pinu rhonu A1nu Knu K*nu pi
111CAM DATA JLIST / 1, 2, 3, 4, 5, 6, 7,
112
113*AM DATA GAMPRT /1.000,0.9730,0.6054,1.2432,0.8432,0.0432,O.O811,0.616
114*AM
115*AM multipion decays
116*
117* conventions of particles names
118* K-,P-,K+, K0,P-,KB, K-,P0,K0
119* 3, 1,-3 , 4, 1,-4 , 3, 2, 4 ,
120* P0,P0,K-, K-,P-,P+, P-,KB,P0
121* 2, 2, 3 , 3, 1,-1 , 1,-4, 2 ,
122* ET,P-,P0 P-,P0,GM
123* 9, 1, 2 , 1, 2, 8
124*
125
126C
127 dimension nopik(9,nmode),npik(nmode)
128*AM outgoing multiplicity and flavors of multi-pion /multi-K modes
129 DATA npik / 4, 4, ! old 4scalar
130 a 4, 4, ! new (may 2004)
131 b 4, 4,
132 c 4, 4,
133 d 4, 4,
134 e 4, 4, ! new (may 2004)
135 e 4, 4, ! new (sep 2004)
136 e 4, 4,
137 e 4, 4,
138 e 4, 4,
139 e 4, 4, ! new (sep 2004)
140 1 5,
141 a 5, 5, ! new (may 2004)
142 b 5, 5,
143 c 5, 5,
144 d 5, 5,
145 e 5, 5, ! new (may 2004)
146 a 5, 5, ! new (sep 2004)
147 b 5, 5,
148 c 5, 5,
149 d 5, 5,
150 e 5, 5, ! new (sep 2004)
151 x 5, ! old npi starts here
152 2 6, 6,
153 a 6, 6, ! new (may 2004)
154 b 6, 6, ! new (may 2004)
155 c 6, 6, ! new (may 2004)
156 d 6, 6, ! new (may 2004)
157 e 6, 6, ! new (may 2004)
158 3 3, 3,
159 4 3, 3,
160 5 3, 3,
161 6 3, 3,
162 7 3, ! new (may 2004) and useful
163 a 3, 3, ! new (may 2004)
164 a 3, 3, ! new (may 2004)
165 a 3, 3, ! new (may 2004)
166 a 3, 3, ! new (may 2004)
167 a 3, 3, ! new (may 2004)
168 8 2,
169 9 2, 2, ! new (may 2004)
170 9 2, 2, ! new (may 2004)
171 9 2, 2, ! new (may 2004)
172 9 2, 2, ! new (may 2004)
173 9 2, 2/ ! new (may 2004)
174
175 DATA nopik / -1,-1, 1, 2, 0, 0,3*0, 2, 2, 2,-1, 0, 0,3*0,
176 a 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0, ! new (may 2004)
177 b 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0, ! new (may 2004)
178 c 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0, ! new (may 2004)
179 d 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0, ! new (may 2004)
180 e 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0, ! new (may 2004)
181 a 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0, ! new (sep 2004)
182 b 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0, ! new (sep 2004)
183 c 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0, ! new (sep 2004)
184 d 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0, ! new (sep 2004)
185 e 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0, ! new (sep 2004)
186 1 -1,-1, 1, 2, 2, 0,3*0,
187 a -1,-1, 1, 2, 4, 0,3*0, -1,-1, 1, 2, 4, 0,3*0, ! new (may 2004)
188 a 1,-1,-1, 2, 2, 0,3*0, -1, 2, 2, 2, 2, 0,3*0, ! new (may 2004)
189 a -1, 1, 1,-1,-1, 0,3*0, -1,-1, 1, 2, 4, 0,3*0, ! new (may 2004)
190 a -1,-1, 1, 2, 4, 0,3*0, -1,-1, 1, 2, 4, 0,3*0, ! new (may 2004)
191 a -1,-1, 1, 2, 4, 0,3*0, -1,-1, 1, 2, 4, 0,3*0, ! new (may 2004)
192 a -1,-1, 1, 2, 4, 0,3*0, -1,-1, 1, 2, 4, 0,3*0, ! new (sep 2004)
193 a -1,-1, 1, 2, 4, 0,3*0, -1,-1, 1, 2, 4, 0,3*0, ! new (sep 2004)
194 a -1,-1, 1, 2, 4, 0,3*0, -1,-1, 1, 2, 4, 0,3*0, ! new (sep 2004)
195 a -1,-1, 1, 2, 4, 0,3*0, -1,-1, 1, 2, 4, 0,3*0, ! new (sep 2004)
196 a -1,-1, 1, 2, 4, 0,3*0, -1,-1, 1, 2, 4, 0,3*0, ! new (sep 2004)
197 x -1,-1,-1, 1, 1, 0,3*0, ! old npi starts here
198 2 -1,-1,-1, 1, 1, 2,3*0, -1,-1, 1, 2, 2, 2,3*0,
199 a -1,-1,-1, 1, 1, 1,3*0, -1,-1, 1, 2, 2, 1,3*0, ! new (may 2004)
200 b -1,-1,-1, 1, 1, 1,3*0, -1,-1, 1, 2, 2, 1,3*0, ! new (may 2004)
201 c -1,-1,-1, 1, 1, 1,3*0, -1,-1, 1, 2, 2, 1,3*0, ! new (may 2004)
202 d -1,-1,-1, 1, 1, 1,3*0, -1,-1, 1, 2, 2, 1,3*0, ! new (may 2004)
203 e -1,-1,-1, 1, 1, 1,3*0, -1,-1, 1, 2, 2, 1,3*0, ! new (may 2004)
204 3 -3,-1, 3, 0, 0, 0,3*0, -4,-1, 4, 0, 0, 0,3*0,
205 4 -3, 2,-4, 0, 0, 0,3*0, 2, 2,-3, 0, 0, 0,3*0,
206 5 -3,-1, 1, 0, 0, 0,3*0, -1, 4, 2, 0, 0, 0,3*0,
207 6 9,-1, 2, 0, 0, 0,3*0, -1, 2, 8, 0, 0, 0,3*0,
208
209
210C AJWMOD fix sign bug, 2/22/99
211 7 2, 2,-1, 0, 0, 0,3*0, ! new (may 2004) but useful
212 7 2, 2, 2, 0, 0, 0,3*0, 2, 2, 2, 0, 0, 0,3*0, ! new (may 2004)
213 7 2, 2, 2, 0, 0, 0,3*0, 2, 2, 2, 0, 0, 0,3*0, ! new (may 2004)
214 7 2, 2, 2, 0, 0, 0,3*0, 2, 2, 2, 0, 0, 0,3*0, ! new (may 2004)
215 7 2, 2, 2, 0, 0, 0,3*0, 2, 2, 2, 0, 0, 0,3*0, ! new (may 2004)
216 7 2, 2, 2, 0, 0, 0,3*0, 2, 2, 2, 0, 0, 0,3*0, ! new (may 2004)
217
218 8 -3,-4, 0, 0, 0, 0,3*0,
219 8 -3,-3, 0, 0, 0, 0,3*0, -3,-3, 0, 0, 0, 0,3*0, ! new (may 2004)
220 8 -3,-3, 0, 0, 0, 0,3*0, -3,-3, 0, 0, 0, 0,3*0, ! new (may 2004)
221 8 -3,-3, 0, 0, 0, 0,3*0, -3,-3, 0, 0, 0, 0,3*0, ! new (may 2004)
222 8 -3,-3, 0, 0, 0, 0,3*0, -3,-3, 0, 0, 0, 0,3*0, ! new (may 2004)
223 8 -3,-3, 0, 0, 0, 0,3*0, -3,-3, 0, 0, 0, 0,3*0 /! new (may 2004)
224
225
226* LIST OF BRANCHING RATIOS
227 nchan = nmode + 7
228 DO 1 i = 1,500
229 IF (i.LE.nchan) THEN
230 jlist(i) = i
231
232 IF(i.EQ. 1) gamprt(i) = 1.0000
233 IF(i.EQ. 2) gamprt(i) = 1.0000
234 IF(i.EQ. 3) gamprt(i) = 1.0000
235 IF(i.EQ. 4) gamprt(i) = 1.0000
236 IF(i.EQ. 5) gamprt(i) = 1.0000
237 IF(i.EQ. 6) gamprt(i) = 1.0000
238 IF(i.EQ. 7) gamprt(i) = 1.0000
239 IF(i.EQ. 8) gamprt(i) = 1.0000
240 IF(i.EQ. 9) gamprt(i) = 1.0000
241 IF(i.EQ.10) gamprt(i) = 1.0000
242 IF(i.EQ.11) gamprt(i) = 1.0000
243 IF(i.EQ.12) gamprt(i) = 1.0000
244 IF(i.EQ.13) gamprt(i) = 1.0000
245 IF(i.EQ.14) gamprt(i) = 1.0000
246 IF(i.EQ.15) gamprt(i) = 1.0000
247 IF(i.EQ.16) gamprt(i) = 1.0000
248 IF(i.EQ.17) gamprt(i) = 1.0000
249 IF(i.EQ.18) gamprt(i) = 1.0000
250 IF(i.EQ.19) gamprt(i) = 1.0000
251 IF(i.EQ.20) gamprt(i) = 1.0000
252 IF(i.EQ.21) gamprt(i) = 1.0000
253 IF(i.EQ.22) gamprt(i) = 1.0000
254 IF(i.GT.22.AND.i.LE.93) gamprt(i) = 1.0000
255C second default
256 IF(i.GT.0.AND.i.LE.93) gamprt(i) = 0.0000
257 IF(i.EQ. 1) gamprt(i) =0.1800
258 IF(i.EQ. 2) gamprt(i) =0.1751
259 IF(i.EQ. 3) gamprt(i) =0.1110
260 IF(i.EQ. 4) gamprt(i) =0.2515
261 IF(i.EQ. 5) gamprt(i) =0.1790 /2
262 IF(i.EQ. 6) gamprt(i) =0.0071
263 IF(i.EQ. 7) gamprt(i) =0.0134
264 IF(i.EQ. 8) gamprt(i) =0.0450
265 IF(i.EQ. 9) gamprt(i) =0.0100
266
267 IF(i.EQ.30) gamprt(i) =0.0009
268 IF(i.EQ.33) gamprt(i) =0.004
269 IF(i.EQ.34) gamprt(i) =0.002
270 IF(i.EQ.35) gamprt(i) =0.001
271
272 IF(i.EQ.51) gamprt(i) =0.0004
273 IF(i.EQ.52) gamprt(i) =0.0003
274 IF(i.EQ.53) gamprt(i) =0.0005
275
276 IF(i.EQ.64) gamprt(i) =0.0015
277 IF(i.EQ.65) gamprt(i) =0.0015
278 IF(i.EQ.66) gamprt(i) =0.0015
279 IF(i.EQ.67) gamprt(i) =0.0005
280 IF(i.EQ.68) gamprt(i) =0.0050
281 IF(i.EQ.69) gamprt(i) =0.0055
282 IF(i.EQ.70) gamprt(i) =0.0017
283 IF(i.EQ.71) gamprt(i) =0.0013
284 IF(i.EQ.72) gamprt(i) =0.1790 /2
285
286 IF(i.EQ.83) gamprt(i) =0.0010
287
288 IF(i.EQ. 1) oldnames(i)=' TAU- --> E- '
289 IF(i.EQ. 2) oldnames(i)=' TAU- --> MU- '
290 IF(i.EQ. 3) oldnames(i)=' TAU- --> PI- '
291 IF(i.EQ. 4) oldnames(i)=' TAU- --> PI-, PI0 '
292 IF(i.EQ. 5) oldnames(i)=' TAU- --> PI-, PI-, PI+ '
293 IF(i.EQ. 6) oldnames(i)=' TAU- --> K- '
294 IF(i.EQ. 7) oldnames(i)=' TAU- --> K*- (two subch) '
295 IF(i.EQ. 8) names(i-7)=' TAU- --> 2PI-, PI0, PI+ '
296 IF(i.EQ. 9) names(i-7)=' TAU- --> 3PI0, PI- '
297
298 IF(i.EQ.10) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (may 2004)
299 IF(i.EQ.11) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (may 2004)
300 IF(i.EQ.12) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (may 2004)
301 IF(i.EQ.13) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (may 2004)
302 IF(i.EQ.14) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (may 2004)
303 IF(i.EQ.15) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (may 2004)
304 IF(i.EQ.16) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (may 2004)
305 IF(i.EQ.17) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (may 2004)
306 IF(i.EQ.18) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (may 2004)
307 IF(i.EQ.19) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (may 2004)
308 IF(i.EQ.20) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (sep 2004)
309 IF(i.EQ.21) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (sep 2004)
310 IF(i.EQ.22) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (sep 2004)
311 IF(i.EQ.23) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (sep 2004)
312 IF(i.EQ.24) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (sep 2004)
313 IF(i.EQ.25) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (sep 2004)
314 IF(i.EQ.26) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (sep 2004)
315 IF(i.EQ.27) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (sep 2004)
316 IF(i.EQ.28) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (sep 2004)
317 IF(i.EQ.29) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (sep 2004)
318
319
320 IF(i.EQ.30) names(i-7)=' TAU- --> 2PI-, PI+, 2PI0 '
321
322 IF(i.EQ.31) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (may 2004)
323 IF(i.EQ.32) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (may 2004)
324 IF(i.EQ.33) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (may 2004)
325 IF(i.EQ.34) names(i-7)=' TAU- --> PI- 4PI0 ' ! (may 2004)
326 IF(i.EQ.35) names(i-7)=' TAU- --> 3PI- 2PI+ ' ! (may 2004)
327 IF(i.EQ.36) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (may 2004)
328 IF(i.EQ.37) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (may 2004)
329 IF(i.EQ.38) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (may 2004)
330 IF(i.EQ.39) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (may 2004)
331 IF(i.EQ.40) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (may 2004)
332
333 IF(i.EQ.41) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (sep 2004)
334 IF(i.EQ.42) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (sep 2004)
335 IF(i.EQ.43) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (sep 2004)
336 IF(i.EQ.44) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (sep 2004)
337 IF(i.EQ.45) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (sep 2004)
338 IF(i.EQ.46) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (sep 2004)
339 IF(i.EQ.47) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (sep 2004)
340 IF(i.EQ.48) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (sep 2004)
341 IF(i.EQ.49) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (sep 2004)
342 IF(i.EQ.50) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (sep 2004)
343
344 IF(i.EQ.51) names(i-7)=' TAU- --> 3PI-, 2PI+, '
345 IF(i.EQ.52) names(i-7)=' TAU- --> 3PI-, 2PI+, PI0 '
346 IF(i.EQ.53) names(i-7)=' TAU- --> 2PI-, PI+, 3PI0 '
347 IF(i.EQ.54) names(i-7)=' TAU- --> xxxxxxxxxnxxxxxx ' ! (may 2004)
348 IF(i.EQ.55) names(i-7)=' TAU- --> xxxxxxxxxnxxxxxx ' ! (may 2004)
349 IF(i.EQ.56) names(i-7)=' TAU- --> xxxxxxxxxnxxxxxx ' ! (may 2004)
350 IF(i.EQ.57) names(i-7)=' TAU- --> xxxxxxxxxnxxxxxx ' ! (may 2004)
351 IF(i.EQ.58) names(i-7)=' TAU- --> xxxxxxxxxnxxxxxx ' ! (may 2004)
352 IF(i.EQ.59) names(i-7)=' TAU- --> xxxxxxxxxnxxxxxx ' ! (may 2004)
353 IF(i.EQ.60) names(i-7)=' TAU- --> xxxxxxxxxnxxxxxx ' ! (may 2004)
354 IF(i.EQ.61) names(i-7)=' TAU- --> xxxxxxxxxnxxxxxx ' ! (may 2004)
355 IF(i.EQ.62) names(i-7)=' TAU- --> xxxxxxxxxnxxxxxx ' ! (may 2004)
356 IF(i.EQ.63) names(i-7)=' TAU- --> xxxxxxxxxnxxxxxx ' ! (may 2004)
357
358 IF(i.EQ.64) names(i-7)=' TAU- --> K-, PI-, K+ '
359 IF(i.EQ.65) names(i-7)=' TAU- --> K0, PI-, K0B '
360
361 IF(i.EQ.66) names(i-7)=' TAU- --> K-, K0, PI0 '
362
363 IF(i.EQ.67) names(i-7)=' TAU- --> PI0 PI0 K- '
364 IF(i.EQ.68) names(i-7)=' TAU- --> K- PI- PI+ '
365 IF(i.EQ.69) names(i-7)=' TAU- --> PI- K0B PI0 '
366 IF(i.EQ.70) names(i-7)=' TAU- --> ETA PI- PI0 '
367 IF(i.EQ.71) names(i-7)=' TAU- --> PI- PI0 GAM '
368 IF(i.EQ.72) names(i-7)=' TAU- --> PI- PI0 PI0 '
369 IF(i.EQ.73) names(i-7)=' TAU- --> xxxxxxxxx3xxxxxx ' ! (may 2004)
370 IF(i.EQ.74) names(i-7)=' TAU- --> xxxxxxxxx3xxxxxx ' ! (may 2004)
371 IF(i.EQ.75) names(i-7)=' TAU- --> xxxxxxxxx3xxxxxx ' ! (may 2004)
372 IF(i.EQ.76) names(i-7)=' TAU- --> xxxxxxxxx3xxxxxx ' ! (may 2004)
373 IF(i.EQ.77) names(i-7)=' TAU- --> xxxxxxxxx3xxxxxx ' ! (may 2004)
374 IF(i.EQ.78) names(i-7)=' TAU- --> xxxxxxxxx3xxxxxx ' ! (may 2004)
375 IF(i.EQ.79) names(i-7)=' TAU- --> xxxxxxxxx3xxxxxx ' ! (may 2004)
376 IF(i.EQ.80) names(i-7)=' TAU- --> xxxxxxxxx3xxxxxx ' ! (may 2004)
377 IF(i.EQ.81) names(i-7)=' TAU- --> xxxxxxxxx3xxxxxx ' ! (may 2004)
378 IF(i.EQ.82) names(i-7)=' TAU- --> xxxxxxxxx3xxxxxx ' ! (may 2004)
379
380
381 IF(i.EQ.83) names(i-7)=' TAU- --> K- K0 '
382 IF(i.EQ.84) names(i-7)=' TAU- --> xxxxxxxxx2xxxxxx ' ! (may 2004)
383 IF(i.EQ.85) names(i-7)=' TAU- --> xxxxxxxxx2xxxxxx ' ! (may 2004)
384 IF(i.EQ.86) names(i-7)=' TAU- --> xxxxxxxxx2xxxxxx ' ! (may 2004)
385 IF(i.EQ.87) names(i-7)=' TAU- --> xxxxxxxxx2xxxxxx ' ! (may 2004)
386 IF(i.EQ.88) names(i-7)=' TAU- --> xxxxxxxxx2xxxxxx ' ! (may 2004)
387 IF(i.EQ.89) names(i-7)=' TAU- --> xxxxxxxxx2xxxxxx ' ! (may 2004)
388 IF(i.EQ.90) names(i-7)=' TAU- --> xxxxxxxxx2xxxxxx ' ! (may 2004)
389 IF(i.EQ.91) names(i-7)=' TAU- --> xxxxxxxxx2xxxxxx ' ! (may 2004)
390 IF(i.EQ.92) names(i-7)=' TAU- --> xxxxxxxxx2xxxxxx ' ! (may 2004)
391 IF(i.EQ.93) names(i-7)=' TAU- --> xxxxxxxxx2xxxxxx ' ! (may 2004)
392
393 ELSE
394 jlist(i) = 0
395 gamprt(i) = 0.
396 ENDIF
397 1 CONTINUE
398 DO i=1,nmode
399 mulpik(i)=npik(i)
400 DO j=1,mulpik(i)
401 idffin(j,i)=nopik(j,i)
402 ENDDO
403 ENDDO
404*
405*
406* --- COEFFICIENTS TO FIX RATIO OF:
407* --- A1 3CHARGED/ A1 1CHARGED 2 NEUTRALS MATRIX ELEMENTS (MASLESS LIM.)
408* --- PROBABILITY OF K0 TO BE KS
409* --- PROBABILITY OF K0B TO BE KS
410* --- RATIO OF COEFFICIENTS FOR K*--> K0 PI-
411* --- ALL COEFFICENTS SHOULD BE IN THE RANGE (0.0,1.0)
412* --- THEY MEANING IS PROBABILITY OF THE FIRST CHOICE ONLY IF ONE
413* --- NEGLECTS MASS-PHASE SPACE EFFECTS
414 bra1=1d0 ! 0.5
415 brk0=0.5
416 brk0b=0.5
417 brks=0.6667
418*
419
420 gfermi = 1.16637e-5
421 ccabib = 0.975
422 gv = 1.0
423 ga =-1.0
424
425
426
427 gfermi = xpar(32)
428 IF (xpar(itauxpar+100+1).GT.-1d0) THEN
429C initialization form KK
430 ccabib = xpar(itauxpar+7)
431 gv = xpar(itauxpar+8)
432 ga = xpar(itauxpar+9)
433
434 bra1 = 1d0 ! XPAR(ITAUXPAR+10) ! input is overruled; must be 1d0 now
435 brks = xpar(itauxpar+11)
436 brk0 = xpar(itauxpar+12)
437 brk0b = xpar(itauxpar+13)
438 DO k=1,nchan
439C GAMPRT(K)=XPAR(ITAUXPAR+100+K)
440
441 IF(k.EQ. 1) gamprt(k) =xpar(itauxpar+100+k)
442 IF(k.EQ. 2) gamprt(k) =xpar(itauxpar+100+k)
443 IF(k.EQ. 3) gamprt(k) =xpar(itauxpar+100+k)
444 IF(k.EQ. 4) gamprt(k) =xpar(itauxpar+100+k)
445 IF(k.EQ. 5) gamprt(k) =xpar(itauxpar+100+k) /2
446 IF(k.EQ. 6) gamprt(k) =xpar(itauxpar+100+k)
447 IF(k.EQ. 7) gamprt(k) =xpar(itauxpar+100+k)
448 IF(k.EQ. 8) gamprt(k) =xpar(itauxpar+100+k)
449 IF(k.EQ. 9) gamprt(k) =xpar(itauxpar+100+k)
450
451 IF(k.EQ.30) gamprt(k) =xpar(itauxpar+100+10)
452
453 IF(k.EQ.51) gamprt(k) =xpar(itauxpar+100+11)
454 IF(k.EQ.52) gamprt(k) =xpar(itauxpar+100+12)
455 IF(k.EQ.53) gamprt(k) =xpar(itauxpar+100+13)
456
457 IF(k.EQ.64) gamprt(k) =xpar(itauxpar+100+14)
458 IF(k.EQ.65) gamprt(k) =xpar(itauxpar+100+15)
459 IF(k.EQ.66) gamprt(k) =xpar(itauxpar+100+16)
460 IF(k.EQ.67) gamprt(k) =xpar(itauxpar+100+17)
461 IF(k.EQ.68) gamprt(k) =xpar(itauxpar+100+18)
462 IF(k.EQ.69) gamprt(k) =xpar(itauxpar+100+19)
463 IF(k.EQ.70) gamprt(k) =xpar(itauxpar+100+20)
464 IF(k.EQ.71) gamprt(k) =xpar(itauxpar+100+21)
465 IF(k.EQ.72) gamprt(k) =xpar(itauxpar+100+5) /2
466
467 IF(k.EQ.83) gamprt(k) =xpar(itauxpar+100+22)
468
469 IF(k.EQ.33) gamprt(i) =xpar(itauxpar+100+23)
470 IF(k.EQ.34) gamprt(i) =xpar(itauxpar+100+24)
471 IF(k.EQ.35) gamprt(i) =xpar(itauxpar+100+25)
472
473 ENDDO
474 ENDIF
475* ZW 13.04.89 HERE WAS AN ERROR
476 scabib = sqrt(1.-ccabib**2)
477 pi =4.*atan(1.)
478 gamel = gfermi**2*amtau**5/(192*pi**3)
479*
480* CALL DEXAY(-1,pol1)
481*
482* PRINTOUTS FOR KK version
483
484 sum=0
485 DO k=1,nchan
486 sum=sum+gamprt(k)
487 ENDDO
488
489
490 WRITE(iout,bxope)
491 WRITE(iout,bxtxt) ' TAUOLA Initialization SUBROUTINE INITDK: '
492 WRITE(iout,bxtxt) ' Adopted to read from KK '
493 WRITE(iout,bxtxt) ' '
494 WRITE(iout,bxtxt) ' Choice Probability -- Decay Channel'
495 DO k=1,7
496 WRITE(iout,bxinit) gamprt(k)/sum, oldnames(k),'****','***'
497 ENDDO
498 DO k=8,7+nmode
499 WRITE(iout,bxinit) gamprt(k)/sum, names(k-7),'****','***'
500 ENDDO
501 WRITE(iout,bxtxt) ' In addition:'
502 WRITE(iout,bxinit) gv, 'Vector W-tau-nu coupl. ','****','***'
503 WRITE(iout,bxinit) ga, 'Axial W-tau-nu coupl. ','****','***'
504 WRITE(iout,bxinit) gfermi,'Fermi Coupling ','****','***'
505 WRITE(iout,bxinit) ccabib,'cabibo angle ','****','***'
506 WRITE(iout,bxinit) bra1, 'a1 br ratio (massless) ','****','***'
507 WRITE(iout,bxinit) brks, 'K* br ratio (massless) ','****','***'
508 WRITE(iout,bxclo)
509
510 RETURN
511 END
512
513 SUBROUTINE iniphy(XK00)
514* ----------------------------------------------------------------------
515* INITIALISATION OF PARAMETERS
516* USED IN QED and/or GSW ROUTINES
517* ----------------------------------------------------------------------
518 COMMON / qedprm /alfinv,alfpi,xk0
519 real*8 alfinv,alfpi,xk0
520 real*8 pi8,xk00
521*
522 pi8 = 4.d0*datan(1.d0)
523 alfinv = 137.03604d0
524 alfpi = 1d0/(alfinv*pi8)
525 xk0=xk00
526 END
527
528 SUBROUTINE inimas(ITAUXPAR,xpar)
529* ----------------------------------------------------------------------
530* INITIALISATION OF MASSES
531*
532* called by : KORALZ
533* ----------------------------------------------------------------------
534 include "BXformat.h"
535 INTEGER INUT,IOUT
536 COMMON /inout/
537 $ inut, ! Input unit number (not used)
538 $ iout ! Ounput unit number
539 real*8 xpar(*)
540 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
541 * ,ampiz,ampi,amro,gamro,ama1,gama1
542 * ,amk,amkz,amkst,gamkst
543*
544 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
545 * ,ampiz,ampi,amro,gamro,ama1,gama1
546 * ,amk,amkz,amkst,gamkst
547 CHARACTER*80 bxINIT
548 parameter(
549 $ bxinit ='(1x,1h*,g17.8, 16x, a31,a4,a4, 1x,1h*)'
550 $ )
551*
552* IN-COMING / OUT-GOING FERMION MASSES
553 amtau = xpar(656)
554 amnuta = 0.010
555 amel = xpar(616)
556 amnue = 0.0
557 ammu = xpar(636)
558 amnumu = 0.0
559*
560* MASSES USED IN TAU DECAYS
561
562 ampiz = 0.134964
563 ampi = 0.139568
564 amro = 0.773
565 gamro = 0.145
566*C GAMRO = 0.666
567 ama1 = 1.251
568 gama1 = 0.599
569 amk = 0.493667
570 amkz = 0.49772
571 amkst = 0.8921
572 gamkst = 0.0513
573
574
575 WRITE(iout,bxope)
576 WRITE(iout,bxtxt) ' TAUOLA Initialization SUBROUTINE INIMAS: '
577 WRITE(iout,bxtxt) ' Adopted to read from KK '
578 WRITE(iout,bxinit) amtau, 'AMTAU tau-mass ','****','***'
579 WRITE(iout,bxinit) amel , 'AMEL electron-mass ','****','***'
580 WRITE(iout,bxinit) ammu , 'AMMU muon-mass ','****','***'
581 WRITE(iout,bxclo)
582
583 END
584 SUBROUTINE choice(MNUM,RR,ICHAN,PROB1,PROB2,PROB3,
585 $ AMRX,GAMRX,AMRA,GAMRA,AMRB,GAMRB)
586 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
587 * ,ampiz,ampi,amro,gamro,ama1,gama1
588 * ,amk,amkz,amkst,gamkst
589C
590 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
591 * ,ampiz,ampi,amro,gamro,ama1,gama1
592 * ,amk,amkz,amkst,gamkst
593C
594 amrop=1.1
595 gamrop=0.36
596 amom=.782
597 gamom=0.0084
598C XXXXA CORRESPOND TO S2 CHANNEL !
599 IF(mnum.EQ.0) THEN
600 prob1=0.5
601 prob2=0.5
602 amrx =ama1
603 gamrx=gama1
604 amra =amro
605 gamra=gamro
606 amrb =amro
607 gamrb=gamro
608 ELSEIF(mnum.EQ.1) THEN
609 prob1=0.5
610 prob2=0.5
611 amrx =1.57
612 gamrx=0.9
613 amrb =amkst
614 gamrb=gamkst
615 amra =amro
616 gamra=gamro
617 ELSEIF(mnum.EQ.2) THEN
618 prob1=0.5
619 prob2=0.5
620 amrx =1.57
621 gamrx=0.9
622 amrb =amkst
623 gamrb=gamkst
624 amra =amro
625 gamra=gamro
626 ELSEIF(mnum.EQ.3) THEN
627 prob1=0.5
628 prob2=0.5
629 amrx =1.27
630 gamrx=0.3
631 amra =amkst
632 gamra=gamkst
633 amrb =amkst
634 gamrb=gamkst
635 ELSEIF(mnum.EQ.4) THEN
636 prob1=0.5
637 prob2=0.5
638 amrx =1.27
639 gamrx=0.3
640 amra =amkst
641 gamra=gamkst
642 amrb =amkst
643 gamrb=gamkst
644 ELSEIF(mnum.EQ.5) THEN
645 prob1=0.5
646 prob2=0.5
647 amrx =1.27
648 gamrx=0.3
649 amra =amkst
650 gamra=gamkst
651 amrb =amro
652 gamrb=gamro
653 ELSEIF(mnum.EQ.6) THEN
654 prob1=0.4
655 prob2=0.4
656 amrx =1.27
657 gamrx=0.3
658 amra =amro
659 gamra=gamro
660 amrb =amkst
661 gamrb=gamkst
662 ELSEIF(mnum.EQ.7) THEN
663 prob1=0.0
664 prob2=1.0
665 amrx =1.27
666 gamrx=0.9
667 amra =amro
668 gamra=gamro
669 amrb =amro
670 gamrb=gamro
671 ELSEIF(mnum.EQ.8) THEN
672 prob1=0.0
673 prob2=1.0
674 amrx =amrop
675 gamrx=gamrop
676 amrb =amom
677 gamrb=gamom
678 amra =amro
679 gamra=gamro
680 ELSEIF(mnum.EQ.9) THEN
681 prob1=0.5
682 prob2=0.5
683 amrx =ama1
684 gamrx=gama1
685 amra =amro
686 gamra=gamro
687 amrb =amro
688 gamrb=gamro
689 ELSEIF(mnum.EQ.101) THEN
690 prob1=.35
691 prob2=.35
692 amrx =1.2
693 gamrx=.46
694 amrb =amom
695 gamrb=gamom
696 amra =amom
697 gamra=gamom
698 ELSEIF(mnum.EQ.102) THEN
699 prob1=0.0
700 prob2=0.0
701 amrx =1.4
702 gamrx=.6
703 amrb =amom
704 gamrb=gamom
705 amra =amom
706 gamra=gamom
707 ELSEIF(mnum.GE.103.AND.mnum.LE.112) THEN
708 prob1=0.0
709 prob2=0.0
710 amrx =1.4
711 gamrx=.6
712 amrb =amom
713 gamrb=gamom
714 amra =amom
715 gamra=gamom
716
717
718 ELSE
719 prob1=0.0
720 prob2=0.0
721 amrx =ama1
722 gamrx=gama1
723 amra =amro
724 gamra=gamro
725 amrb =amro
726 gamrb=gamro
727 ENDIF
728C
729 IF (rr.LE.prob1) THEN
730 ichan=1
731 ELSEIF(rr.LE.(prob1+prob2)) THEN
732 ichan=2
733 ax =amra
734 gx =gamra
735 amra =amrb
736 gamra=gamrb
737 amrb =ax
738 gamrb=gx
739 px =prob1
740 prob1=prob2
741 prob2=px
742 ELSE
743 ichan=3
744 ENDIF
745C
746 prob3=1.0-prob1-prob2
747 END
748 FUNCTION dcdmas(IDENT)
749 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
750 * ,ampiz,ampi,amro,gamro,ama1,gama1
751 * ,amk,amkz,amkst,gamkst
752*
753 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
754 * ,ampiz,ampi,amro,gamro,ama1,gama1
755 * ,amk,amkz,amkst,gamkst
756 IF (ident.EQ. 1) THEN
757 apkmas=ampi
758 ELSEIF (ident.EQ.-1) THEN
759 apkmas=ampi
760 ELSEIF (ident.EQ. 2) THEN
761 apkmas=ampiz
762 ELSEIF (ident.EQ.-2) THEN
763 apkmas=ampiz
764 ELSEIF (ident.EQ. 3) THEN
765 apkmas=amk
766 ELSEIF (ident.EQ.-3) THEN
767 apkmas=amk
768 ELSEIF (ident.EQ. 4) THEN
769 apkmas=amkz
770 ELSEIF (ident.EQ.-4) THEN
771 apkmas=amkz
772 ELSEIF (ident.EQ. 8) THEN
773 apkmas=0.0001
774 ELSEIF (ident.EQ.-8) THEN
775 apkmas=0.0001
776 ELSEIF (ident.EQ. 9) THEN
777 apkmas=0.5488
778 ELSEIF (ident.EQ.-9) THEN
779 apkmas=0.5488
780 ELSE
781 print *, 'STOP IN APKMAS, WRONG IDENT=',ident
782 stop
783 ENDIF
784 dcdmas=apkmas
785 END
786 FUNCTION lunpik(ID,ISGN)
787 COMMON / taukle / bra1,brk0,brk0b,brks
788 real*4 bra1,brk0,brk0b,brks
789 real*4 xio(1)
790 ident=id*isgn
791
792 IF (ident.EQ. 1) THEN
793 ipkdef=-211
794 ELSEIF (ident.EQ.-1) THEN
795 ipkdef= 211
796 ELSEIF (ident.EQ. 2) THEN
797 ipkdef=111
798 ELSEIF (ident.EQ.-2) THEN
799 ipkdef=111
800 ELSEIF (ident.EQ. 3) THEN
801 ipkdef=-321
802 ELSEIF (ident.EQ.-3) THEN
803 ipkdef= 321
804
805 ELSEIF (ident.EQ. 4) THEN
806*
807* K0 --> K0_LONG (IS 130) / K0_SHORT (IS 310) = 1/1
808 CALL ranmar(xio,1)
809 IF (xio(1).GT.brk0) THEN
810 ipkdef= 130
811 ELSE
812 ipkdef= 310
813 ENDIF
814 ELSEIF (ident.EQ.-4) THEN
815*
816* K0B--> K0_LONG (IS 130) / K0_SHORT (IS 310) = 1/1
817 CALL ranmar(xio,1)
818 IF (xio(1).GT.brk0b) THEN
819 ipkdef= 130
820 ELSE
821 ipkdef= 310
822 ENDIF
823 ELSEIF (ident.EQ. 8) THEN
824 ipkdef= 22
825 ELSEIF (ident.EQ.-8) THEN
826 ipkdef= 22
827 ELSEIF (ident.EQ. 9) THEN
828 ipkdef= 221
829 ELSEIF (ident.EQ.-9) THEN
830 ipkdef= 221
831 ELSE
832 print *, 'STOP IN IPKDEF, WRONG IDENT=',ident
833 stop
834 ENDIF
835 lunpik=ipkdef
836 END
837
838
839
840
841 SUBROUTINE taurdf(KTO)
842* THIS ROUTINE CAN BE CALLED BEFORE ANY TAU+ OR TAU- EVENT IS GENERATED
843* IT CAN BE USED TO GENERATE TAU+ AND TAU- SAMPLES OF DIFFERENT
844* CONTENTS
845 COMMON / taukle / bra1,brk0,brk0b,brks
846 real*4 bra1,brk0,brk0b,brks
847 COMMON / taubra / gamprt(500),jlist(500),nchan
848 RETURN ! this routine is called somewhere and is now deactivated, one has to fill it in properly for use.
849 IF (kto.EQ.1) THEN
850* ==================
851* LIST OF BRANCHING RATIOS
852 nchan = 19
853 DO 1 i = 1,500
854 IF (i.LE.nchan) THEN
855 jlist(i) = i
856 IF(i.EQ. 1) gamprt(i) = .0000
857 IF(i.EQ. 2) gamprt(i) = .0000
858 IF(i.EQ. 3) gamprt(i) = .0000
859 IF(i.EQ. 4) gamprt(i) = .0000
860 IF(i.EQ. 5) gamprt(i) = .0000
861 IF(i.EQ. 6) gamprt(i) = .0000
862 IF(i.EQ. 7) gamprt(i) = .0000
863 IF(i.EQ. 8) gamprt(i) = 1.0000
864 IF(i.EQ. 9) gamprt(i) = 1.0000
865 IF(i.EQ.10) gamprt(i) = 1.0000
866 IF(i.EQ.11) gamprt(i) = 1.0000
867 IF(i.EQ.12) gamprt(i) = 1.0000
868 IF(i.EQ.13) gamprt(i) = 1.0000
869 IF(i.EQ.14) gamprt(i) = 1.0000
870 IF(i.EQ.15) gamprt(i) = 1.0000
871 IF(i.EQ.16) gamprt(i) = 1.0000
872 IF(i.EQ.17) gamprt(i) = 1.0000
873 IF(i.EQ.18) gamprt(i) = 1.0000
874 IF(i.EQ.19) gamprt(i) = 1.0000
875 ELSE
876 jlist(i) = 0
877 gamprt(i) = 0.
878 ENDIF
879 1 CONTINUE
880* --- COEFFICIENTS TO FIX RATIO OF:
881* --- A1 3CHARGED/ A1 1CHARGED 2 NEUTRALS MATRIX ELEMENTS (MASLESS LIM.)
882* --- PROBABILITY OF K0 TO BE KS
883* --- PROBABILITY OF K0B TO BE KS
884* --- RATIO OF COEFFICIENTS FOR K*--> K0 PI-
885* --- ALL COEFFICENTS SHOULD BE IN THE RANGE (0.0,1.0)
886* --- THEY MEANING IS PROBABILITY OF THE FIRST CHOICE ONLY IF ONE
887* --- NEGLECTS MASS-PHASE SPACE EFFECTS
888 bra1=0.5
889 brk0=0.5
890 brk0b=0.5
891 brks=0.6667
892 ELSE
893* ====
894* LIST OF BRANCHING RATIOS
895 nchan = 19
896 DO 2 i = 1,500
897 IF (i.LE.nchan) THEN
898 jlist(i) = i
899 IF(i.EQ. 1) gamprt(i) = .0000
900 IF(i.EQ. 2) gamprt(i) = .0000
901 IF(i.EQ. 3) gamprt(i) = .0000
902 IF(i.EQ. 4) gamprt(i) = .0000
903 IF(i.EQ. 5) gamprt(i) = .0000
904 IF(i.EQ. 6) gamprt(i) = .0000
905 IF(i.EQ. 7) gamprt(i) = .0000
906 IF(i.EQ. 8) gamprt(i) = 1.0000
907 IF(i.EQ. 9) gamprt(i) = 1.0000
908 IF(i.EQ.10) gamprt(i) = 1.0000
909 IF(i.EQ.11) gamprt(i) = 1.0000
910 IF(i.EQ.12) gamprt(i) = 1.0000
911 IF(i.EQ.13) gamprt(i) = 1.0000
912 IF(i.EQ.14) gamprt(i) = 1.0000
913 IF(i.EQ.15) gamprt(i) = 1.0000
914 IF(i.EQ.16) gamprt(i) = 1.0000
915 IF(i.EQ.17) gamprt(i) = 1.0000
916 IF(i.EQ.18) gamprt(i) = 1.0000
917 IF(i.EQ.19) gamprt(i) = 1.0000
918 ELSE
919 jlist(i) = 0
920 gamprt(i) = 0.
921 ENDIF
922 2 CONTINUE
923* --- COEFFICIENTS TO FIX RATIO OF:
924* --- A1 3CHARGED/ A1 1CHARGED 2 NEUTRALS MATRIX ELEMENTS (MASLESS LIM.)
925* --- PROBABILITY OF K0 TO BE KS
926* --- PROBABILITY OF K0B TO BE KS
927* --- RATIO OF COEFFICIENTS FOR K*--> K0 PI-
928* --- ALL COEFFICENTS SHOULD BE IN THE RANGE (0.0,1.0)
929* --- THEY MEANING IS PROBABILITY OF THE FIRST CHOICE ONLY IF ONE
930* --- NEGLECTS MASS-PHASE SPACE EFFECTS
931 bra1=0.5
932 brk0=0.5
933 brk0b=0.5
934 brks=0.6667
935 ENDIF
936* =====
937 END
938