C++ Interface to Tauola
tauola-BBB/jetset-F/tauola_photos_ini.F
1C this file is created by hand from taumain.F
2C actions: Remove routines: TAUDEM DECTES TAUFIL FILHEP
3C add: INIETC will not necesarily work fine ...
4C replace TRALO4
5C rename INIPHY to INIPHX
6
7 SUBROUTINE inietc(jakk1,jakk2,itd,ifpho)
8 COMMON / idfc / idff
9 COMMON / taurad / xk0dec,itdkrc
10 DOUBLE PRECISION XK0DEC
11 COMMON / jaki / jak1,jak2,jakp,jakm,ktom
12 COMMON /phoact/ ifphot
13 SAVE
14C KTO=1 will denote tau+, thus :: IDFF=-15
15 idff=-15
16C XK0 for tau decays.
17 xk0dec=0.01
18C radiative correction switch in tau --> e (mu) decays !
19 itdkrc=itd
20C switches of tau+ tau- decay modes !!
21 jak1=jakk1
22 jak2=jakk2
23C photos activation switch
24 ifphot=ifpho
25 end
26
27 SUBROUTINE tralo4(KTOS,PHOI,PHOF,AM)
28!! Corrected 11.10.96 (ZW) tralor for KORALW.
29!! better treatment is to cascade from tau rest-frame through W
30!! restframe down to LAB.
31 COMMON / momdec / q1,q2,p1,p2,p3,p4
32 COMMON /tralid/ idtra
33 double precision Q1(4),Q2(4),P1(4),P2(4),P3(4),P4(4),P1QQ(4),P2QQ(4)
34 double precision PIN(4),POUT(4),PBST(4),PBS1(4),QQ(4),PI
35 double precision THET,PHI,EXE
36 real*4 phoi(4),phof(4)
37 SAVE
38 DATA pi /3.141592653589793238462643d0/
39 am=sqrt(abs
40 $ (phoi(4)**2-phoi(3)**2-phoi(2)**2-phoi(1)**2))
41 idtra=ktos
42 DO k=1,4
43 pin(k)=phoi(k)
44 phof(k)=phoi(k)
45 ENDDO
46! write(*,*) idtra
47 IF (idtra.EQ.1) THEN
48 DO k=1,4
49 pbst(k)=p1(k)
50 qq(k)=q1(k)
51 ENDDO
52 ELSEIF(idtra.EQ.2) THEN
53 DO k=1,4
54 pbst(k)=p2(k)
55 qq(k)=q1(k)
56 ENDDO
57 ELSEIF(idtra.EQ.3) THEN
58 DO k=1,4
59 pbst(k)=p3(k)
60 qq(k)=q2(k)
61 ENDDO
62 ELSE
63 DO k=1,4
64 pbst(k)=p4(k)
65 qq(k)=q2(k)
66 ENDDO
67 ENDIF
68
69
70
71 CALL bostdq(1,qq,pbst,pbst)
72 CALL bostdq(1,qq,p1,p1qq)
73 CALL bostdq(1,qq,p2,p2qq)
74 pbs1(4)=pbst(4)
75 pbs1(3)=sqrt(pbst(3)**2+pbst(2)**2+pbst(1)**2)
76 pbs1(2)=0d0
77 pbs1(1)=0d0
78 exe=(pbs1(4)+pbs1(3))/dsqrt(pbs1(4)**2-pbs1(3)**2)
79C for KTOS=1 boost is antiparallel to 4-momentum of P2.
80C restframes of tau+ tau- and 'first' frame of 'higgs' are all connected
81C by boosts along z axis
82 IF(ktos.EQ.1) exe=(pbs1(4)-pbs1(3))/dsqrt(pbs1(4)**2-pbs1(3)**2)
83 CALL bostd3(exe,pin,pout)
84
85C once in Z/gamma/Higgs rest frame we control further kinematics by P2QQ for KTOS=1,2
86 thet=acos(p2qq(3)/sqrt(p2qq(3)**2+p2qq(2)**2+p2qq(1)**2))
87 phi=0d0
88 phi=acos(p2qq(1)/sqrt(p2qq(2)**2+p2qq(1)**2))
89 IF(p2qq(2).LT.0d0) phi=2*pi-phi
90
91 CALL rotpox(thet,phi,pout)
92 CALL bostdq(-1,qq,pout,pout)
93 DO k=1,4
94 phof(k)=pout(k)
95 ENDDO
96 END
97 SUBROUTINE choice(MNUM,RR,ICHAN,PROB1,PROB2,PROB3,
98 $ AMRX,GAMRX,AMRA,GAMRA,AMRB,GAMRB)
99 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
100 * ,ampiz,ampi,amro,gamro,ama1,gama1
101 * ,amk,amkz,amkst,gamkst
102C
103 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
104 * ,ampiz,ampi,amro,gamro,ama1,gama1
105 * ,amk,amkz,amkst,gamkst
106C
107 amrop=1.1
108 gamrop=0.36
109 amom=.782
110 gamom=0.0084
111C XXXXA CORRESPOND TO S2 CHANNEL !
112 IF(mnum.EQ.0) THEN
113 prob1=0.5
114 prob2=0.5
115 amrx =ama1
116 gamrx=gama1
117 amra =amro
118 gamra=gamro
119 amrb =amro
120 gamrb=gamro
121 ELSEIF(mnum.EQ.1) THEN
122 prob1=0.5
123 prob2=0.5
124 amrx =1.57
125 gamrx=0.9
126 amrb =amkst
127 gamrb=gamkst
128 amra =amro
129 gamra=gamro
130 ELSEIF(mnum.EQ.2) THEN
131 prob1=0.5
132 prob2=0.5
133 amrx =1.57
134 gamrx=0.9
135 amrb =amkst
136 gamrb=gamkst
137 amra =amro
138 gamra=gamro
139 ELSEIF(mnum.EQ.3) THEN
140 prob1=0.5
141 prob2=0.5
142 amrx =1.27
143 gamrx=0.3
144 amra =amkst
145 gamra=gamkst
146 amrb =amkst
147 gamrb=gamkst
148 ELSEIF(mnum.EQ.4) THEN
149 prob1=0.5
150 prob2=0.5
151 amrx =1.27
152 gamrx=0.3
153 amra =amkst
154 gamra=gamkst
155 amrb =amkst
156 gamrb=gamkst
157 ELSEIF(mnum.EQ.5) THEN
158 prob1=0.5
159 prob2=0.5
160 amrx =1.27
161 gamrx=0.3
162 amra =amkst
163 gamra=gamkst
164 amrb =amro
165 gamrb=gamro
166 ELSEIF(mnum.EQ.6) THEN
167 prob1=0.4
168 prob2=0.4
169 amrx =1.27
170 gamrx=0.3
171 amra =amro
172 gamra=gamro
173 amrb =amkst
174 gamrb=gamkst
175 ELSEIF(mnum.EQ.7) THEN
176 prob1=0.0
177 prob2=1.0
178 amrx =1.27
179 gamrx=0.9
180 amra =amro
181 gamra=gamro
182 amrb =amro
183 gamrb=gamro
184 ELSEIF(mnum.EQ.8) THEN
185 prob1=0.0
186 prob2=1.0
187 amrx =amrop
188 gamrx=gamrop
189 amrb =amom
190 gamrb=gamom
191 amra =amro
192 gamra=gamro
193 ELSEIF(mnum.EQ.9) THEN
194 prob1=0.5
195 prob2=0.5
196 amrx =ama1
197 gamrx=gama1
198 amra =amro
199 gamra=gamro
200 amrb =amro
201 gamrb=gamro
202 ELSEIF(mnum.EQ.101) THEN
203 prob1=.35
204 prob2=.35
205 amrx =1.2
206 gamrx=.46
207 amrb =amom
208 gamrb=gamom
209 amra =amom
210 gamra=gamom
211 ELSEIF(mnum.EQ.102) THEN
212 prob1=0.0
213 prob2=0.0
214 amrx =1.4
215 gamrx=.6
216 amrb =amom
217 gamrb=gamom
218 amra =amom
219 gamra=gamom
220 ELSEIF(mnum.GE.103.AND.mnum.LE.112) THEN
221 prob1=0.0
222 prob2=0.0
223 amrx =1.4
224 gamrx=.6
225 amrb =amom
226 gamrb=gamom
227 amra =amom
228 gamra=gamom
229
230
231 ELSE
232 prob1=0.0
233 prob2=0.0
234 amrx =ama1
235 gamrx=gama1
236 amra =amro
237 gamra=gamro
238 amrb =amro
239 gamrb=gamro
240 ENDIF
241C
242 IF (rr.LE.prob1) THEN
243 ichan=1
244 ELSEIF(rr.LE.(prob1+prob2)) THEN
245 ichan=2
246 ax =amra
247 gx =gamra
248 amra =amrb
249 gamra=gamrb
250 amrb =ax
251 gamrb=gx
252 px =prob1
253 prob1=prob2
254 prob2=px
255 ELSE
256 ichan=3
257 ENDIF
258C
259 prob3=1.0-prob1-prob2
260 END
261 SUBROUTINE initdk
262* ----------------------------------------------------------------------
263* INITIALISATION OF TAU DECAY PARAMETERS and routines
264*
265* called by : KORALZ
266* ----------------------------------------------------------------------
267
268 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
269 real*4 gfermi,gv,ga,ccabib,scabib,gamel
270 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
271 * ,ampiz,ampi,amro,gamro,ama1,gama1
272 * ,amk,amkz,amkst,gamkst
273*
274 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
275 * ,ampiz,ampi,amro,gamro,ama1,gama1
276 * ,amk,amkz,amkst,gamkst
277 COMMON / taubra / gamprt(500),jlist(500),nchan
278 COMMON / taukle / bra1,brk0,brk0b,brks
279 real*4 bra1,brk0,brk0b,brks
280
281 parameter(nmode=86,nm1=0,nm2=11,nm3=19,nm4=22,nm5=21,nm6=13)
282 COMMON / taudcd /idffin(9,nmode),mulpik(nmode)
283 & ,names
284 CHARACTER NAMES(NMODE)*31
285
286 CHARACTER OLDNAMES(7)*31
287 CHARACTER*80 bxINIT
288 parameter(
289 $ bxinit ='(1x,1h*,g17.8, 16x, a31,a4,a4, 1x,1h*)'
290 $ )
291 real*4 pi,pol1(4)
292*
293*
294* LIST OF BRANCHING RATIOS
295CAM normalised to e nu nutau channel
296CAM enu munu pinu rhonu A1nu Knu K*nu pi
297CAM DATA JLIST / 1, 2, 3, 4, 5, 6, 7,
298
299*AM DATA GAMPRT /1.000,0.9730,0.6054,1.2432,0.8432,0.0432,O.O811,0.616
300*AM
301*AM multipion decays
302*
303* conventions of particles names
304* K-,P-,K+, K0,P-,KB, K-,P0,K0
305* 3, 1,-3 , 4, 1,-4 , 3, 2, 4 ,
306* P0,P0,K-, K-,P-,P+, P-,KB,P0
307* 2, 2, 3 , 3, 1,-1 , 1,-4, 2 ,
308* ET,P-,P0 , P-,P0,GM , P-,P0,P0
309* 9, 1, 2 , 1, 2, 8 , 1, 2, 2
310*
311
312C
313 dimension nopik(9,nmode),npik(nmode)
314*AM outgoing multiplicity and flavors of multi-pion /multi-K modes
315 DATA npik / 4, 4, ! old 4scalar
316 a 4, 4, ! new (may 2004)
317 b 4, 4,
318 c 4, 4,
319 d 4, 4,
320 e 4, 4, ! new (may 2004)
321 e 4, 4, ! new (sep 2004)
322 e 4, 4,
323 e 4, 4,
324 e 4, 4,
325 e 4, 4, ! new (sep 2004)
326 1 5,
327 a 5, 5, ! new (may 2004)
328 b 5, 5,
329 c 5, 5,
330 d 5, 5,
331 e 5, 5, ! new (may 2004)
332 a 5, 5, ! new (sep 2004)
333 b 5, 5,
334 c 5, 5,
335 d 5, 5,
336 e 5, 5, ! new (sep 2004)
337 x 5, ! old npi starts here
338 2 6, 6,
339 a 6, 6, ! new (may 2004)
340 b 6, 6, ! new (may 2004)
341 c 6, 6, ! new (may 2004)
342 d 6, 6, ! new (may 2004)
343 e 6, 6, ! new (may 2004)
344 3 3, 3,
345 4 3, 3,
346 5 3, 3,
347 6 3, 3,
348 7 3, ! new (may 2004) and useful
349 a 3, 3, ! new (may 2004)
350 a 3, 3, ! new (may 2004)
351 a 3, 3, ! new (may 2004)
352 a 3, 3, ! new (may 2004)
353 a 3, 3, ! new (may 2004)
354 8 2,
355 9 2, 2, ! new (may 2004)
356 9 2, 2, ! new (may 2004)
357 9 2, 2, ! new (may 2004)
358 9 2, 2, ! new (may 2004)
359 9 2, 2/ ! new (may 2004)
360
361 DATA nopik / -1,-1, 1, 2, 0, 0,3*0, 2, 2, 2,-1, 0, 0,3*0,
362 a 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0, ! new (may 2004)
363 b 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0, ! new (may 2004)
364 c 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0, ! new (may 2004)
365 d 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0, ! new (may 2004)
366 e 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0, ! new (may 2004)
367 a 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0, ! new (sep 2004)
368 b 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0, ! new (sep 2004)
369 c 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0, ! new (sep 2004)
370 d 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0, ! new (sep 2004)
371 e 4, 2, 2,-1, 0, 0,3*0, 4, 2, 2,-1, 0, 0,3*0, ! new (sep 2004)
372 1 -1,-1, 1, 2, 2, 0,3*0,
373 a -1,-1, 1, 2, 2, 0,3*0, 2, 2, 2, 2, 2, 0,3*0, ! new (may 2004)
374 a 1,-1,-1, 2, 2, 0,3*0, -1, 2, 2, 2, 2, 0,3*0, ! new (may 2004)
375 a -1, 1, 1,-1,-1, 0,3*0, -1,-1, 1, 2, 4, 0,3*0, ! new (may 2004)
376 a -1,-1, 1, 2, 4, 0,3*0, -1,-1, 1, 2, 4, 0,3*0, ! new (may 2004)
377 a -1,-1, 1, 2, 4, 0,3*0, -1,-1, 1, 2, 4, 0,3*0, ! new (may 2004)
378 a -1,-1, 1, 2, 4, 0,3*0, -1,-1, 1, 2, 4, 0,3*0, ! new (sep 2004)
379 a -1,-1, 1, 2, 4, 0,3*0, -1,-1, 1, 2, 4, 0,3*0, ! new (sep 2004)
380 a -1,-1, 1, 2, 4, 0,3*0, -1,-1, 1, 2, 4, 0,3*0, ! new (sep 2004)
381 a -1,-1, 1, 2, 4, 0,3*0, -1,-1, 1, 2, 4, 0,3*0, ! new (sep 2004)
382 a -1,-1, 1, 2, 4, 0,3*0, -1,-1, 1, 2, 4, 0,3*0, ! new (sep 2004)
383 x -1,-1,-1, 1, 1, 0,3*0, ! old npi starts here
384 2 -1,-1,-1, 1, 1, 2,3*0, -1,-1, 1, 2, 2, 2,3*0,
385 a -1,-1,-1, 1, 1, 1,3*0, -1,-1, 1, 2, 2, 1,3*0, ! new (may 2004)
386 b -1,-1,-1, 1, 1, 1,3*0, -1,-1, 1, 2, 2, 1,3*0, ! new (may 2004)
387 c -1,-1,-1, 1, 1, 1,3*0, -1,-1, 1, 2, 2, 1,3*0, ! new (may 2004)
388 d -1,-1,-1, 1, 1, 1,3*0, -1,-1, 1, 2, 2, 1,3*0, ! new (may 2004)
389 e -1,-1,-1, 1, 1, 1,3*0, -1,-1, 1, 2, 2, 1,3*0, ! new (may 2004)
390 3 -3,-1, 3, 0, 0, 0,3*0, -4,-1, 4, 0, 0, 0,3*0,
391 4 -3, 2,-4, 0, 0, 0,3*0, 2, 2,-3, 0, 0, 0,3*0,
392 5 -3,-1, 1, 0, 0, 0,3*0, -1, 4, 2, 0, 0, 0,3*0,
393 6 9,-1, 2, 0, 0, 0,3*0, -1, 2, 8, 0, 0, 0,3*0,
394
395
396C AJWMOD fix sign bug, 2/22/99
397 7 2, 2,-1, 0, 0, 0,3*0, ! new (may 2004) but useful
398 7 2, 2, 2, 0, 0, 0,3*0, 2, 2, 2, 0, 0, 0,3*0, ! new (may 2004)
399 7 2, 2, 2, 0, 0, 0,3*0, 2, 2, 2, 0, 0, 0,3*0, ! new (may 2004)
400 7 2, 2, 2, 0, 0, 0,3*0, 2, 2, 2, 0, 0, 0,3*0, ! new (may 2004)
401 7 2, 2, 2, 0, 0, 0,3*0, 2, 2, 2, 0, 0, 0,3*0, ! new (may 2004)
402 7 2, 2, 2, 0, 0, 0,3*0, 2, 2, 2, 0, 0, 0,3*0, ! new (may 2004)
403
404 8 -3,-4, 0, 0, 0, 0,3*0,
405 8 -3,-3, 0, 0, 0, 0,3*0, -3,-3, 0, 0, 0, 0,3*0, ! new (may 2004)
406 8 -3,-3, 0, 0, 0, 0,3*0, -3,-3, 0, 0, 0, 0,3*0, ! new (may 2004)
407 8 -3,-3, 0, 0, 0, 0,3*0, -3,-3, 0, 0, 0, 0,3*0, ! new (may 2004)
408 8 -3,-3, 0, 0, 0, 0,3*0, -3,-3, 0, 0, 0, 0,3*0, ! new (may 2004)
409 8 -3,-3, 0, 0, 0, 0,3*0, -3,-3, 0, 0, 0, 0,3*0 /! new (may 2004)
410
411
412* LIST OF BRANCHING RATIOS
413 nchan = nmode + 7
414 DO 1 i = 1,500
415 IF (i.LE.nchan) THEN
416 jlist(i) = i
417
418 IF(i.EQ. 1) gamprt(i) =0.1800
419 IF(i.EQ. 2) gamprt(i) =0.1751
420 IF(i.EQ. 3) gamprt(i) =0.1110
421 IF(i.EQ. 4) gamprt(i) =0.2515
422 IF(i.EQ. 5) gamprt(i) =0.1790 /2
423 IF(i.EQ. 6) gamprt(i) =0.0071
424 IF(i.EQ. 7) gamprt(i) =0.0134
425 IF(i.EQ. 8) gamprt(i) =0.0450
426 IF(i.EQ. 9) gamprt(i) =0.0100
427
428 IF(i.EQ.30) gamprt(i) =0.0009
429 IF(i.EQ.33) gamprt(i) =0.004
430 IF(i.EQ.34) gamprt(i) =0.002
431 IF(i.EQ.35) gamprt(i) =0.001
432
433 IF(i.EQ.51) gamprt(i) =0.0004
434 IF(i.EQ.52) gamprt(i) =0.0003
435 IF(i.EQ.53) gamprt(i) =0.0005
436
437 IF(i.EQ.64) gamprt(i) =0.0015
438 IF(i.EQ.65) gamprt(i) =0.0015
439 IF(i.EQ.66) gamprt(i) =0.0015
440 IF(i.EQ.67) gamprt(i) =0.0005
441 IF(i.EQ.68) gamprt(i) =0.0050
442 IF(i.EQ.69) gamprt(i) =0.0055
443 IF(i.EQ.70) gamprt(i) =0.0017
444 IF(i.EQ.71) gamprt(i) =0.0013
445 IF(i.EQ.72) gamprt(i) =0.1790 /2
446
447 IF(i.EQ.83) gamprt(i) =0.0010
448
449 IF(i.EQ. 1) oldnames(i)=' TAU- --> E- '
450 IF(i.EQ. 2) oldnames(i)=' TAU- --> MU- '
451 IF(i.EQ. 3) oldnames(i)=' TAU- --> PI- '
452 IF(i.EQ. 4) oldnames(i)=' TAU- --> PI-, PI0 '
453 IF(i.EQ. 5) oldnames(i)=' TAU- --> PI-, PI-, PI+ '
454 IF(i.EQ. 6) oldnames(i)=' TAU- --> K- '
455 IF(i.EQ. 7) oldnames(i)=' TAU- --> K*- (two subch) '
456 IF(i.EQ. 8) names(i-7)=' TAU- --> 2PI-, PI0, PI+ '
457 IF(i.EQ. 9) names(i-7)=' TAU- --> 3PI0, PI- '
458
459 IF(i.EQ.10) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (may 2004)
460 IF(i.EQ.11) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (may 2004)
461 IF(i.EQ.12) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (may 2004)
462 IF(i.EQ.13) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (may 2004)
463 IF(i.EQ.14) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (may 2004)
464 IF(i.EQ.15) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (may 2004)
465 IF(i.EQ.16) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (may 2004)
466 IF(i.EQ.17) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (may 2004)
467 IF(i.EQ.18) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (may 2004)
468 IF(i.EQ.19) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (may 2004)
469 IF(i.EQ.20) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (sep 2004)
470 IF(i.EQ.21) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (sep 2004)
471 IF(i.EQ.22) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (sep 2004)
472 IF(i.EQ.23) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (sep 2004)
473 IF(i.EQ.24) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (sep 2004)
474 IF(i.EQ.25) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (sep 2004)
475 IF(i.EQ.26) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (sep 2004)
476 IF(i.EQ.27) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (sep 2004)
477 IF(i.EQ.28) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (sep 2004)
478 IF(i.EQ.29) names(i-7)=' TAU- --> xxxxxxx4xxxxxxxx ' ! (sep 2004)
479
480
481 IF(i.EQ.30) names(i-7)=' TAU- --> 2PI-, PI+, 2PI0 old'
482 IF(i.EQ.31) names(i-7)=' TAU- --> a1 --> rho omega ' ! (may 2004)
483 IF(i.EQ.32) names(i-7)=' TAU- --> benchmark curr ' ! (may 2004)
484 IF(i.EQ.33) names(i-7)=' TAU- --> 2PI0, 2PI-, PI+ ' ! (may 2004)
485 IF(i.EQ.34) names(i-7)=' TAU- --> PI- 4PI0 ' ! (may 2004)
486 IF(i.EQ.35) names(i-7)=' TAU- --> 3PI- 2PI+ ' ! (may 2004)
487 IF(i.EQ.36) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (may 2004)
488 IF(i.EQ.37) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (may 2004)
489 IF(i.EQ.38) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (may 2004)
490 IF(i.EQ.39) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (may 2004)
491 IF(i.EQ.40) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (may 2004)
492
493 IF(i.EQ.41) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (sep 2004)
494 IF(i.EQ.42) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (sep 2004)
495 IF(i.EQ.43) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (sep 2004)
496 IF(i.EQ.44) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (sep 2004)
497 IF(i.EQ.45) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (sep 2004)
498 IF(i.EQ.46) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (sep 2004)
499 IF(i.EQ.47) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (sep 2004)
500 IF(i.EQ.48) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (sep 2004)
501 IF(i.EQ.49) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (sep 2004)
502 IF(i.EQ.50) names(i-7)=' TAU- --> xxxxxxxxx5xxxxxx ' ! (sep 2004)
503
504 IF(i.EQ.51) names(i-7)=' TAU- --> 3PI-, 2PI+, '
505 IF(i.EQ.52) names(i-7)=' TAU- --> 3PI-, 2PI+, PI0 '
506 IF(i.EQ.53) names(i-7)=' TAU- --> 2PI-, PI+, 3PI0 '
507 IF(i.EQ.54) names(i-7)=' TAU- --> xxxxxxxxxnxxxxxx ' ! (may 2004)
508 IF(i.EQ.55) names(i-7)=' TAU- --> xxxxxxxxxnxxxxxx ' ! (may 2004)
509 IF(i.EQ.56) names(i-7)=' TAU- --> xxxxxxxxxnxxxxxx ' ! (may 2004)
510 IF(i.EQ.57) names(i-7)=' TAU- --> xxxxxxxxxnxxxxxx ' ! (may 2004)
511 IF(i.EQ.58) names(i-7)=' TAU- --> xxxxxxxxxnxxxxxx ' ! (may 2004)
512 IF(i.EQ.59) names(i-7)=' TAU- --> xxxxxxxxxnxxxxxx ' ! (may 2004)
513 IF(i.EQ.60) names(i-7)=' TAU- --> xxxxxxxxxnxxxxxx ' ! (may 2004)
514 IF(i.EQ.61) names(i-7)=' TAU- --> xxxxxxxxxnxxxxxx ' ! (may 2004)
515 IF(i.EQ.62) names(i-7)=' TAU- --> xxxxxxxxxnxxxxxx ' ! (may 2004)
516 IF(i.EQ.63) names(i-7)=' TAU- --> xxxxxxxxxnxxxxxx ' ! (may 2004)
517
518 IF(i.EQ.64) names(i-7)=' TAU- --> K-, PI-, K+ '
519 IF(i.EQ.65) names(i-7)=' TAU- --> K0, PI-, K0B '
520
521 IF(i.EQ.66) names(i-7)=' TAU- --> K-, K0, PI0 '
522
523 IF(i.EQ.67) names(i-7)=' TAU- --> PI0 PI0 K- '
524 IF(i.EQ.68) names(i-7)=' TAU- --> K- PI- PI+ '
525 IF(i.EQ.69) names(i-7)=' TAU- --> PI- K0B PI0 '
526 IF(i.EQ.70) names(i-7)=' TAU- --> ETA PI- PI0 '
527 IF(i.EQ.71) names(i-7)=' TAU- --> PI- PI0 GAM '
528 IF(i.EQ.72) names(i-7)=' TAU- --> PI- PI0 PI0 '
529 IF(i.EQ.73) names(i-7)=' TAU- --> xxxxxxxxx3xxxxxx ' ! (may 2004)
530 IF(i.EQ.74) names(i-7)=' TAU- --> xxxxxxxxx3xxxxxx ' ! (may 2004)
531 IF(i.EQ.75) names(i-7)=' TAU- --> xxxxxxxxx3xxxxxx ' ! (may 2004)
532 IF(i.EQ.76) names(i-7)=' TAU- --> xxxxxxxxx3xxxxxx ' ! (may 2004)
533 IF(i.EQ.77) names(i-7)=' TAU- --> xxxxxxxxx3xxxxxx ' ! (may 2004)
534 IF(i.EQ.78) names(i-7)=' TAU- --> xxxxxxxxx3xxxxxx ' ! (may 2004)
535 IF(i.EQ.79) names(i-7)=' TAU- --> xxxxxxxxx3xxxxxx ' ! (may 2004)
536 IF(i.EQ.80) names(i-7)=' TAU- --> xxxxxxxxx3xxxxxx ' ! (may 2004)
537 IF(i.EQ.81) names(i-7)=' TAU- --> xxxxxxxxx3xxxxxx ' ! (may 2004)
538 IF(i.EQ.82) names(i-7)=' TAU- --> xxxxxxxxx3xxxxxx ' ! (may 2004)
539
540
541 IF(i.EQ.83) names(i-7)=' TAU- --> K- K0 '
542 IF(i.EQ.84) names(i-7)=' TAU- --> xxxxxxxxx2xxxxxx ' ! (may 2004)
543 IF(i.EQ.85) names(i-7)=' TAU- --> xxxxxxxxx2xxxxxx ' ! (may 2004)
544 IF(i.EQ.86) names(i-7)=' TAU- --> xxxxxxxxx2xxxxxx ' ! (may 2004)
545 IF(i.EQ.87) names(i-7)=' TAU- --> xxxxxxxxx2xxxxxx ' ! (may 2004)
546 IF(i.EQ.88) names(i-7)=' TAU- --> xxxxxxxxx2xxxxxx ' ! (may 2004)
547 IF(i.EQ.89) names(i-7)=' TAU- --> xxxxxxxxx2xxxxxx ' ! (may 2004)
548 IF(i.EQ.90) names(i-7)=' TAU- --> xxxxxxxxx2xxxxxx ' ! (may 2004)
549 IF(i.EQ.91) names(i-7)=' TAU- --> xxxxxxxxx2xxxxxx ' ! (may 2004)
550 IF(i.EQ.92) names(i-7)=' TAU- --> xxxxxxxxx2xxxxxx ' ! (may 2004)
551 IF(i.EQ.93) names(i-7)=' TAU- --> xxxxxxxxx2xxxxxx ' ! (may 2004)
552
553 ELSE
554 jlist(i) = 0
555 gamprt(i) = 0.
556 ENDIF
557 1 CONTINUE
558 DO i=1,nmode
559 mulpik(i)=npik(i)
560 DO j=1,mulpik(i)
561 idffin(j,i)=nopik(j,i)
562 ENDDO
563 ENDDO
564 DO i=1,nchan
565 gamprt(i) = 1d0/nchan
566 ENDDO
567 gamprt(31)=gamprt(31)*0.001
568 gamprt(32)=gamprt(32)*0.001
569 do k=1,10 ! these are brs for empty slots prepared for new channels
570 gamprt(36+k)=gamprt(36+k)*0.001
571 gamprt(30-k)=gamprt(30-k)*0.001
572 gamprt(30+10+k)=gamprt(30+10+k)*0.001
573 gamprt(30-10-k)=gamprt(30-10-k)*0.001
574
575 gamprt(53+k)=gamprt(53+k)*0.001
576 gamprt(72+k)=gamprt(72+k)*0.001
577 gamprt(83+k)=gamprt(83+k)*0.001
578 enddo
579 gamprt(72)=gamprt(72)/2
580 gamprt(5)=gamprt(5)/2
581
582*
583*
584* --- COEFFICIENTS TO FIX RATIO OF:
585* --- A1 3CHARGED/ A1 1CHARGED 2 NEUTRALS MATRIX ELEMENTS (MASLESS LIM.)
586* --- PROBABILITY OF K0 TO BE KS
587* --- PROBABILITY OF K0B TO BE KS
588* --- RATIO OF COEFFICIENTS FOR K*--> K0 PI-
589* --- ALL COEFFICENTS SHOULD BE IN THE RANGE (0.0,1.0)
590* --- THEY MEANING IS PROBABILITY OF THE FIRST CHOICE ONLY IF ONE
591* --- NEGLECTS MASS-PHASE SPACE EFFECTS
592 bra1=1d0 ! 0.5
593 brk0=0.5
594 brk0b=0.5
595 brks=0.6667
596*
597
598 gfermi = 1.16637e-5
599 ccabib = 0.975
600 gv = 1.0
601 ga =-1.0
602
603
604
605* ZW 13.04.89 HERE WAS AN ERROR
606 scabib = sqrt(1.-ccabib**2)
607 pi =4.*atan(1.)
608 gamel = gfermi**2*amtau**5/(192*pi**3)
609*
610 CALL dexay(-1,pol1)
611*
612 RETURN
613 END
614 FUNCTION dcdmas(IDENT)
615 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
616 * ,ampiz,ampi,amro,gamro,ama1,gama1
617 * ,amk,amkz,amkst,gamkst
618*
619 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
620 * ,ampiz,ampi,amro,gamro,ama1,gama1
621 * ,amk,amkz,amkst,gamkst
622 IF (ident.EQ. 1) THEN
623 apkmas=ampi
624 ELSEIF (ident.EQ.-1) THEN
625 apkmas=ampi
626 ELSEIF (ident.EQ. 2) THEN
627 apkmas=ampiz
628 ELSEIF (ident.EQ.-2) THEN
629 apkmas=ampiz
630 ELSEIF (ident.EQ. 3) THEN
631 apkmas=amk
632 ELSEIF (ident.EQ.-3) THEN
633 apkmas=amk
634 ELSEIF (ident.EQ. 4) THEN
635 apkmas=amkz
636 ELSEIF (ident.EQ.-4) THEN
637 apkmas=amkz
638 ELSEIF (ident.EQ. 8) THEN
639 apkmas=0.0001
640 ELSEIF (ident.EQ.-8) THEN
641 apkmas=0.0001
642 ELSEIF (ident.EQ. 9) THEN
643 apkmas=0.5488
644 ELSEIF (ident.EQ.-9) THEN
645 apkmas=0.5488
646 ELSE
647 print *, 'STOP IN APKMAS, WRONG IDENT=',ident
648 stop
649 ENDIF
650 dcdmas=apkmas
651 END
652 FUNCTION lunpik(ID,ISGN)
653 COMMON / taukle / bra1,brk0,brk0b,brks
654 real*4 bra1,brk0,brk0b,brks
655 real*4 xio(1)
656 ident=id*isgn
657
658 IF (ident.EQ. 1) THEN
659 ipkdef=-211
660 ELSEIF (ident.EQ.-1) THEN
661 ipkdef= 211
662 ELSEIF (ident.EQ. 2) THEN
663 ipkdef=111
664 ELSEIF (ident.EQ.-2) THEN
665 ipkdef=111
666 ELSEIF (ident.EQ. 3) THEN
667 ipkdef=-321
668 ELSEIF (ident.EQ.-3) THEN
669 ipkdef= 321
670
671 ELSEIF (ident.EQ. 4) THEN
672*
673* K0 --> K0_LONG (IS 130) / K0_SHORT (IS 310) = 1/1
674 CALL ranmar(xio,1)
675 IF (xio(1).GT.brk0) THEN
676 ipkdef= 130
677 ELSE
678 ipkdef= 310
679 ENDIF
680 ELSEIF (ident.EQ.-4) THEN
681*
682* K0B--> K0_LONG (IS 130) / K0_SHORT (IS 310) = 1/1
683 CALL ranmar(xio,1)
684 IF (xio(1).GT.brk0b) THEN
685 ipkdef= 130
686 ELSE
687 ipkdef= 310
688 ENDIF
689 ELSEIF (ident.EQ. 8) THEN
690 ipkdef= 22
691 ELSEIF (ident.EQ.-8) THEN
692 ipkdef= 22
693 ELSEIF (ident.EQ. 9) THEN
694 ipkdef= 221
695 ELSEIF (ident.EQ.-9) THEN
696 ipkdef= 221
697 ELSE
698 print *, 'STOP IN IPKDEF, WRONG IDENT=',ident
699 stop
700 ENDIF
701 lunpik=ipkdef
702 END
703
704
705
706
707 SUBROUTINE taurdf(KTO)
708C THIS ROUTINE CAN BE CALLED BEFORE ANY TAU+ OR TAU- EVENT IS GENERATED
709C IT CAN BE USED TO GENERATE TAU+ AND TAU- SAMPLES OF DIFFERENT
710C CONTENTS
711 COMMON / taukle / bra1,brk0,brk0b,brks
712 real*4 bra1,brk0,brk0b,brks
713 COMMON / taubra / gamprt(500),jlist(500),nchan
714 IF (kto.EQ.1) THEN
715C ==================
716C AJWMOD: Set the BRs for (A1+ -> rho+ pi0) and (K*+ -> K0 pi+)
717 bra1 = pkorb(4,1)
718 brks = pkorb(4,3)
719 brk0 = pkorb(4,5)
720 brk0b = pkorb(4,6)
721 ELSE
722C ====
723C AJWMOD: Set the BRs for (A1+ -> rho+ pi0) and (K*+ -> K0 pi+)
724 bra1 = pkorb(4,2)
725 brks = pkorb(4,4)
726 brk0 = pkorb(4,5)
727 brk0b = pkorb(4,6)
728 ENDIF
729C =====
730 END
731
732
733 SUBROUTINE iniphx(XK00)
734* ----------------------------------------------------------------------
735* INITIALISATION OF PARAMETERS
736* USED IN QED and/or GSW ROUTINES
737* ----------------------------------------------------------------------
738 COMMON / qedprm /alfinv,alfpi,xk0
739 real*8 alfinv,alfpi,xk0
740 real*8 pi8,xk00
741*
742 pi8 = 4.d0*datan(1.d0)
743 alfinv = 137.03604d0
744 alfpi = 1d0/(alfinv*pi8)
745 xk0=xk00
746 END
747
748 SUBROUTINE inimas
749C ----------------------------------------------------------------------
750C INITIALISATION OF MASSES
751C
752C called by : KORALZ
753C ----------------------------------------------------------------------
754 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
755 * ,ampiz,ampi,amro,gamro,ama1,gama1
756 * ,amk,amkz,amkst,gamkst
757*
758 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
759 * ,ampiz,ampi,amro,gamro,ama1,gama1
760 * ,amk,amkz,amkst,gamkst
761C
762C IN-COMING / OUT-GOING FERMION MASSES
763 amtau = 1.7842
764C --- tau mass must be the same as in the host program, what-so-ever
765 amtau = 1.777
766 amnuta = 0.010
767 amel = 0.0005111
768 amnue = 0.0
769 ammu = 0.105659
770 amnumu = 0.0
771*
772* MASSES USED IN TAU DECAYS
773
774 ampiz = 0.134964
775 ampi = 0.139568
776 amro = 0.773
777 gamro = 0.145
778*C GAMRO = 0.666
779 ama1 = 1.251
780 gama1 = 0.599
781 amk = 0.493667
782 amkz = 0.49772
783 amkst = 0.8921
784 gamkst = 0.0513
785C
786C
787C IN-COMING / OUT-GOING FERMION MASSES
788!! AMNUTA = PKORB(1,2)
789!! AMNUE = PKORB(1,4)
790!! AMNUMU = PKORB(1,6)
791C
792C MASSES USED IN TAU DECAYS Cleo settings
793!! AMPIZ = PKORB(1,7)
794!! AMPI = PKORB(1,8)
795!! AMRO = PKORB(1,9)
796!! GAMRO = PKORB(2,9)
797 ama1 = 1.275 !! PKORB(1,10)
798 gama1 = 0.615 !! PKORB(2,10)
799!! AMK = PKORB(1,11)
800!! AMKZ = PKORB(1,12)
801!! AMKST = PKORB(1,13)
802!! GAMKST = PKORB(2,13)
803C
804
805
806 RETURN
807 END
808 subroutine bostdq(idir,vv,pp,q)
809* *******************************
810c Boost along arbitrary vector v (see eg. J.D. Jacson, Classical
811c Electrodynamics).
812c Four-vector pp is boosted from an actual frame to the rest frame
813c of the four-vector v (for idir=1) or back (for idir=-1).
814c q is a resulting four-vector.
815c Note: v must be time-like, pp may be arbitrary.
816c
817c Written by: Wieslaw Placzek date: 22.07.1994
818c Last update: 3/29/95 by: M.S.
819c
820 implicit DOUBLE PRECISION (a-h,o-z)
821 parameter(nout=6)
822 DOUBLE PRECISION v(4),p(4),q(4),pp(4),vv(4)
823 save
824!
825 do 1 i=1,4
826 v(i)=vv(i)
827 1 p(i)=pp(i)
828 amv=(v(4)**2-v(1)**2-v(2)**2-v(3)**2)
829 if (amv.le.0d0) then
830 write(6,*) 'bosstv: warning amv**2=',amv
831 endif
832 amv=sqrt(abs(amv))
833 if (idir.eq.-1) then
834 q(4)=( p(1)*v(1)+p(2)*v(2)+p(3)*v(3)+p(4)*v(4))/amv
835 wsp =(q(4)+p(4))/(v(4)+amv)
836 elseif (idir.eq.1) then
837 q(4)=(-p(1)*v(1)-p(2)*v(2)-p(3)*v(3)+p(4)*v(4))/amv
838 wsp =-(q(4)+p(4))/(v(4)+amv)
839 else
840 write(nout,*)' >>> boostv: wrong value of idir = ',idir
841 endif
842 q(1)=p(1)+wsp*v(1)
843 q(2)=p(2)+wsp*v(2)
844 q(3)=p(3)+wsp*v(3)
845 end
846
847
848
849
850
851
852
853
854
855