C++ Interface to Tauola
demo-factory/back/attic/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 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
82 real*4 gfermi,gv,ga,ccabib,scabib,gamel
83 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
84 * ,ampiz,ampi,amro,gamro,ama1,gama1
85 * ,amk,amkz,amkst,gamkst
86*
87 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
88 * ,ampiz,ampi,amro,gamro,ama1,gama1
89 * ,amk,amkz,amkst,gamkst
90 COMMON / taubra / gamprt(30),jlist(30),nchan
91 COMMON / taukle / bra1,brk0,brk0b,brks
92 real*4 bra1,brk0,brk0b,brks
93#if defined (ALEPH)
94 parameter(nmode=15,nm1=0,nm2=1,nm3=8,nm4=2,nm5=1,nm6=3)
95 COMMON / taudcd /idffin(9,nmode),mulpik(nmode)
96 & ,names
97 CHARACTER NAMES(NMODE)*31
98#else
99 parameter(nmode=15,nm1=0,nm2=1,nm3=8,nm4=2,nm5=1,nm6=3)
100 COMMON / decomp /idffin(9,nmode),mulpik(nmode)
101 & ,names
102 CHARACTER NAMES(NMODE)*31
103#endif
104 CHARACTER OLDNAMES(7)*31
105 CHARACTER*80 bxINIT
106 parameter(
107 $ bxinit ='(1x,1h*,g17.8, 16x, a31,a4,a4, 1x,1h*)'
108 $ )
109 real*4 pi,pol1(4)
110*
111*
112* LIST OF BRANCHING RATIOS
113CAM normalised to e nu nutau channel
114CAM enu munu pinu rhonu A1nu Knu K*nu pi
115CAM DATA JLIST / 1, 2, 3, 4, 5, 6, 7,
116#if defined (ALEPH)
117CAM /0.1779,0.1731,0.1106,0.2530,0.1811,0.0072,0.0139
118CAM DATA GAMPRT / 1.000,0.9732,0.6217,1.4221,1.0180,0.0405,0.0781
119CAM DATA GAMPRT /1.000,0.9676,0.6154,1.3503,1.0225,0.0368,O.O758
120CAM
121C
122C conventions of particles names
123c
124cam mode (JAK) 8 9
125CAM channel pi- pi- pi0 pi+ 3pi0 pi-
126cam particle code -1,-1, 2, 1, 0, 0, 2, 2, 2,-1, 0, 0,
127CAM BR relative to electron .2414, .0601,
128c
129* 10 11
130* 1 3pi+- 2pi0 5pi+-
131* 1 -1,-1, 1, 2, 2, 0, -1,-1,-1, 1, 1, 0,
132* 1 .0281, .0045,
133
134* 12 13
135* 2 5pi+- pi0 3pi+- 3pi0
136* 2 -1,-1,-1, 1, 1, 2, -1,-1, 1, 2, 2, 2,
137* 2 .0010, .0062,
138
139* 14 15
140* 3 K- pi- K+ K0 pi- KB
141* 3 -3,-1, 3, 0, 0, 0, 4,-1,-4, 0, 0, 0,
142* 3 .0096, .0169,
143
144* 16 17
145* 4 K- pi0 K0 2pi0 K-
146* 4 -3, 2, 4, 0, 0, 0, 2, 2,-3, 0, 0, 0,
147* 4 .0056, .0045,
148
149* 18 19
150* 5 K- pi- pi+ pi- KB pi0
151* 5 -3,-1, 1, 0, 0, 0, -1,-4, 2, 0, 0, 0,
152* 5 .0219, .0180,
153
154* 20 21
155* 6 eta pi- pi0 pi- pi0 gamma
156* 6 9,-1, 2, 0, 0, 0, -1, 2, 8, 0, 0, 0,
157* 6 .0096, .0088,
158
159* 22 /
160* 7 K- K0 /
161* 7 -3, 4 /
162* 7 .0146 /
163#else
164*AM DATA GAMPRT /1.000,0.9730,0.6054,1.2432,0.8432,0.0432,O.O811,0.616
165*AM
166*AM multipion decays
167*
168* conventions of particles names
169* K-,P-,K+, K0,P-,KB, K-,P0,K0
170* 3, 1,-3 , 4, 1,-4 , 3, 2, 4 ,
171* P0,P0,K-, K-,P-,P+, P-,KB,P0
172* 2, 2, 3 , 3, 1,-1 , 1,-4, 2 ,
173* ET,P-,P0 P-,P0,GM
174* 9, 1, 2 , 1, 2, 8
175*
176#endif
177C
178 dimension nopik(6,nmode),npik(nmode)
179*AM outgoing multiplicity and flavors of multi-pion /multi-K modes
180 DATA npik / 4, 4,
181 1 5, 5,
182 2 6, 6,
183 3 3, 3,
184 4 3, 3,
185 5 3, 3,
186 6 3, 3,
187 7 2 /
188#if defined (ALEPH)
189 DATA nopik / -1,-1, 2, 1, 0, 0, 2, 2, 2,-1, 0, 0,
190 1 -1,-1, 1, 2, 2, 0, -1,-1,-1, 1, 1, 0,
191 2 -1,-1,-1, 1, 1, 2, -1,-1, 1, 2, 2, 2,
192 3 -3,-1, 3, 0, 0, 0, 4,-1,-4, 0, 0, 0,
193 4 -3, 2, 4, 0, 0, 0, 2, 2,-3, 0, 0, 0,
194 5 -3,-1, 1, 0, 0, 0, -1,-4, 2, 0, 0, 0,
195 6 9,-1, 2, 0, 0, 0, -1, 2, 8, 0, 0, 0,
196#else
197 DATA nopik / -1,-1, 1, 2, 0, 0, 2, 2, 2,-1, 0, 0,
198 1 -1,-1, 1, 2, 2, 0, -1,-1,-1, 1, 1, 0,
199 2 -1,-1,-1, 1, 1, 2, -1,-1, 1, 2, 2, 2,
200 3 -3,-1, 3, 0, 0, 0, -4,-1, 4, 0, 0, 0,
201 4 -3, 2,-4, 0, 0, 0, 2, 2,-3, 0, 0, 0,
202 5 -3,-1, 1, 0, 0, 0, -1, 4, 2, 0, 0, 0,
203 6 9,-1, 2, 0, 0, 0, -1, 2, 8, 0, 0, 0,
204#endif
205#if defined (CLEO)
206C AJWMOD fix sign bug, 2/22/99
207 7 -3,-4, 0, 0, 0, 0 /
208#else
209 7 -3, 4, 0, 0, 0, 0 /
210#endif
211* LIST OF BRANCHING RATIOS
212 nchan = nmode + 7
213 DO 1 i = 1,30
214 IF (i.LE.nchan) THEN
215 jlist(i) = i
216#if defined (CePeCe)
217 IF(i.EQ. 1) gamprt(i) = 1.0000
218 IF(i.EQ. 2) gamprt(i) = 1.0000
219 IF(i.EQ. 3) gamprt(i) = 1.0000
220 IF(i.EQ. 4) gamprt(i) = 1.0000
221 IF(i.EQ. 5) gamprt(i) = 1.0000
222 IF(i.EQ. 6) gamprt(i) = 1.0000
223 IF(i.EQ. 7) gamprt(i) = 1.0000
224 IF(i.EQ. 8) gamprt(i) = 1.0000
225 IF(i.EQ. 9) gamprt(i) = 1.0000
226 IF(i.EQ.10) gamprt(i) = 1.0000
227 IF(i.EQ.11) gamprt(i) = 1.0000
228 IF(i.EQ.12) gamprt(i) = 1.0000
229 IF(i.EQ.13) gamprt(i) = 1.0000
230 IF(i.EQ.14) gamprt(i) = 1.0000
231 IF(i.EQ.15) gamprt(i) = 1.0000
232 IF(i.EQ.16) gamprt(i) = 1.0000
233 IF(i.EQ.17) gamprt(i) = 1.0000
234 IF(i.EQ.18) gamprt(i) = 1.0000
235 IF(i.EQ.19) gamprt(i) = 1.0000
236 IF(i.EQ.20) gamprt(i) = 1.0000
237 IF(i.EQ.21) gamprt(i) = 1.0000
238 IF(i.EQ.22) gamprt(i) = 1.0000
239#elif defined (CLEO)
240 IF(i.EQ. 1) gamprt(i) =0.1800
241 IF(i.EQ. 2) gamprt(i) =0.1751
242 IF(i.EQ. 3) gamprt(i) =0.1110
243 IF(i.EQ. 4) gamprt(i) =0.2515
244 IF(i.EQ. 5) gamprt(i) =0.1790
245 IF(i.EQ. 6) gamprt(i) =0.0071
246 IF(i.EQ. 7) gamprt(i) =0.0134
247 IF(i.EQ. 8) gamprt(i) =0.0450
248 IF(i.EQ. 9) gamprt(i) =0.0100
249 IF(i.EQ.10) gamprt(i) =0.0009
250 IF(i.EQ.11) gamprt(i) =0.0004
251 IF(i.EQ.12) gamprt(i) =0.0003
252 IF(i.EQ.13) gamprt(i) =0.0005
253 IF(i.EQ.14) gamprt(i) =0.0015
254 IF(i.EQ.15) gamprt(i) =0.0015
255 IF(i.EQ.16) gamprt(i) =0.0015
256 IF(i.EQ.17) gamprt(i) =0.0005
257 IF(i.EQ.18) gamprt(i) =0.0050
258 IF(i.EQ.19) gamprt(i) =0.0055
259 IF(i.EQ.20) gamprt(i) =0.0017
260 IF(i.EQ.21) gamprt(i) =0.0013
261 IF(i.EQ.22) gamprt(i) =0.0010
262#elif defined (ALEPH)
263 IF(i.EQ. 1) gamprt(i) = 1.0000
264 IF(i.EQ. 2) gamprt(i) = .9732
265 IF(i.EQ. 3) gamprt(i) = .6217
266 IF(i.EQ. 4) gamprt(i) = 1.4221
267 IF(i.EQ. 5) gamprt(i) = 1.0180
268 IF(i.EQ. 6) gamprt(i) = .0405
269 IF(i.EQ. 7) gamprt(i) = .0781
270 IF(i.EQ. 8) gamprt(i) = .2414
271 IF(i.EQ. 9) gamprt(i) = .0601
272 IF(i.EQ.10) gamprt(i) = .0281
273 IF(i.EQ.11) gamprt(i) = .0045
274 IF(i.EQ.12) gamprt(i) = .0010
275 IF(i.EQ.13) gamprt(i) = .0062
276 IF(i.EQ.14) gamprt(i) = .0096
277 IF(i.EQ.15) gamprt(i) = .0169
278 IF(i.EQ.16) gamprt(i) = .0056
279 IF(i.EQ.17) gamprt(i) = .0045
280 IF(i.EQ.18) gamprt(i) = .0219
281 IF(i.EQ.19) gamprt(i) = .0180
282 IF(i.EQ.20) gamprt(i) = .0096
283 IF(i.EQ.21) gamprt(i) = .0088
284 IF(i.EQ.22) gamprt(i) = .0146
285#else
286#endif
287 IF(i.EQ. 1) oldnames(i)=' TAU- --> E- '
288 IF(i.EQ. 2) oldnames(i)=' TAU- --> MU- '
289 IF(i.EQ. 3) oldnames(i)=' TAU- --> PI- '
290 IF(i.EQ. 4) oldnames(i)=' TAU- --> PI-, PI0 '
291 IF(i.EQ. 5) oldnames(i)=' TAU- --> A1- (two subch) '
292 IF(i.EQ. 6) oldnames(i)=' TAU- --> K- '
293 IF(i.EQ. 7) oldnames(i)=' TAU- --> K*- (two subch) '
294 IF(i.EQ. 8) names(i-7)=' TAU- --> 2PI-, PI0, PI+ '
295 IF(i.EQ. 9) names(i-7)=' TAU- --> 3PI0, PI- '
296 IF(i.EQ.10) names(i-7)=' TAU- --> 2PI-, PI+, 2PI0 '
297 IF(i.EQ.11) names(i-7)=' TAU- --> 3PI-, 2PI+, '
298 IF(i.EQ.12) names(i-7)=' TAU- --> 3PI-, 2PI+, PI0 '
299 IF(i.EQ.13) names(i-7)=' TAU- --> 2PI-, PI+, 3PI0 '
300 IF(i.EQ.14) names(i-7)=' TAU- --> K-, PI-, K+ '
301 IF(i.EQ.15) names(i-7)=' TAU- --> K0, PI-, K0B '
302#if defined (ALEPH)
303 IF(i.EQ.16) names(i-7)=' TAU- --> K- PI0 K0 '
304#else
305 IF(i.EQ.16) names(i-7)=' TAU- --> K-, K0, PI0 '
306#endif
307 IF(i.EQ.17) names(i-7)=' TAU- --> PI0 PI0 K- '
308 IF(i.EQ.18) names(i-7)=' TAU- --> K- PI- PI+ '
309 IF(i.EQ.19) names(i-7)=' TAU- --> PI- K0B PI0 '
310 IF(i.EQ.20) names(i-7)=' TAU- --> ETA PI- PI0 '
311 IF(i.EQ.21) names(i-7)=' TAU- --> PI- PI0 GAM '
312 IF(i.EQ.22) names(i-7)=' TAU- --> K- K0 '
313 ELSE
314 jlist(i) = 0
315 gamprt(i) = 0.
316 ENDIF
317 1 CONTINUE
318 DO i=1,nmode
319 mulpik(i)=npik(i)
320 DO j=1,mulpik(i)
321 idffin(j,i)=nopik(j,i)
322 ENDDO
323 ENDDO
324*
325*
326* --- COEFFICIENTS TO FIX RATIO OF:
327* --- A1 3CHARGED/ A1 1CHARGED 2 NEUTRALS MATRIX ELEMENTS (MASLESS LIM.)
328* --- PROBABILITY OF K0 TO BE KS
329* --- PROBABILITY OF K0B TO BE KS
330* --- RATIO OF COEFFICIENTS FOR K*--> K0 PI-
331* --- ALL COEFFICENTS SHOULD BE IN THE RANGE (0.0,1.0)
332* --- THEY MEANING IS PROBABILITY OF THE FIRST CHOICE ONLY IF ONE
333* --- NEGLECTS MASS-PHASE SPACE EFFECTS
334 bra1=0.5
335 brk0=0.5
336 brk0b=0.5
337 brks=0.6667
338*
339
340 gfermi = 1.16637e-5
341 ccabib = 0.975
342 gv = 1.0
343 ga =-1.0
344 gfermi = xpar(32)
345 IF (xpar(itauxpar+100+1).GT.-1d0) THEN
346C initialization form KK
347 ccabib = xpar(itauxpar+7)
348 gv = xpar(itauxpar+8)
349 ga = xpar(itauxpar+9)
350
351 bra1 = xpar(itauxpar+10)
352 brks = xpar(itauxpar+11)
353 brk0 = xpar(itauxpar+12)
354 brk0b = xpar(itauxpar+13)
355 DO k=1,nchan
356 gamprt(k)=xpar(itauxpar+100+k)
357 ENDDO
358 ENDIF
359* ZW 13.04.89 HERE WAS AN ERROR
360 scabib = sqrt(1.-ccabib**2)
361 pi =4.*atan(1.)
362 gamel = gfermi**2*amtau**5/(192*pi**3)
363*
364* CALL DEXAY(-1,pol1)
365*
366* PRINTOUTS FOR KK version
367
368 sum=0
369 DO k=1,nchan
370 sum=sum+gamprt(k)
371 ENDDO
372
373
374 WRITE(iout,bxope)
375 WRITE(iout,bxtxt) ' TAUOLA Initialization SUBROUTINE INITDK: '
376 WRITE(iout,bxtxt) ' Adopted to read from KK '
377 WRITE(iout,bxtxt) ' '
378 WRITE(iout,bxtxt) ' Choice Probability -- Decay Channel'
379 DO k=1,7
380 WRITE(iout,bxinit) gamprt(k)/sum, oldnames(k),'****','***'
381 ENDDO
382 DO k=8,7+nmode
383 WRITE(iout,bxinit) gamprt(k)/sum, names(k-7),'****','***'
384 ENDDO
385 WRITE(iout,bxtxt) ' In addition:'
386 WRITE(iout,bxinit) gv, 'Vector W-tau-nu coupl. ','****','***'
387 WRITE(iout,bxinit) ga, 'Axial W-tau-nu coupl. ','****','***'
388 WRITE(iout,bxinit) gfermi,'Fermi Coupling ','****','***'
389 WRITE(iout,bxinit) ccabib,'cabibo angle ','****','***'
390 WRITE(iout,bxinit) bra1, 'a1 br ratio (massless) ','****','***'
391 WRITE(iout,bxinit) brks, 'K* br ratio (massless) ','****','***'
392 WRITE(iout,bxclo)
393
394 RETURN
395 END
396
397 SUBROUTINE iniphy(XK00)
398* ----------------------------------------------------------------------
399* INITIALISATION OF PARAMETERS
400* USED IN QED and/or GSW ROUTINES
401* ----------------------------------------------------------------------
402 COMMON / qedprm /alfinv,alfpi,xk0
403 real*8 alfinv,alfpi,xk0
404 real*8 pi8,xk00
405*
406 pi8 = 4.d0*datan(1.d0)
407 alfinv = 137.03604d0
408 alfpi = 1d0/(alfinv*pi8)
409 xk0=xk00
410 END
411
412 SUBROUTINE inimas(ITAUXPAR,xpar)
413* ----------------------------------------------------------------------
414* INITIALISATION OF MASSES
415*
416* called by : KORALZ
417* ----------------------------------------------------------------------
418 include "BXformat.h"
419 INTEGER INUT,IOUT
420 COMMON /inout/
421 $ inut, ! Input unit number (not used)
422 $ iout ! Ounput unit number
423 real*8 xpar(*)
424 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
425 * ,ampiz,ampi,amro,gamro,ama1,gama1
426 * ,amk,amkz,amkst,gamkst
427*
428 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
429 * ,ampiz,ampi,amro,gamro,ama1,gama1
430 * ,amk,amkz,amkst,gamkst
431 CHARACTER*80 bxINIT
432 parameter(
433 $ bxinit ='(1x,1h*,g17.8, 16x, a31,a4,a4, 1x,1h*)'
434 $ )
435*
436* IN-COMING / OUT-GOING FERMION MASSES
437 amtau = xpar(656)
438 amnuta = 0.010
439 amel = xpar(616)
440 amnue = 0.0
441 ammu = xpar(636)
442 amnumu = 0.0
443*
444* MASSES USED IN TAU DECAYS
445#if defined (CePeCe)
446 ampiz = 0.134964
447 ampi = 0.139568
448 amro = 0.773
449 gamro = 0.145
450*C GAMRO = 0.666
451 ama1 = 1.251
452 gama1 = 0.599
453 amk = 0.493667
454 amkz = 0.49772
455 amkst = 0.8921
456 gamkst = 0.0513
457#elif defined (CLEO)
458 ampiz = 0.134964
459 ampi = 0.139568
460 amro = 0.773
461 gamro = 0.145
462*C GAMRO = 0.666
463 ama1 = 1.251
464 gama1 = 0.599
465 amk = 0.493667
466 amkz = 0.49772
467 amkst = 0.8921
468 gamkst = 0.0513
469C
470C
471C IN-COMING / OUT-GOING FERMION MASSES
472!! AMNUTA = PKORB(1,2)
473!! AMNUE = PKORB(1,4)
474!! AMNUMU = PKORB(1,6)
475C
476C MASSES USED IN TAU DECAYS Cleo settings
477!! AMPIZ = PKORB(1,7)
478!! AMPI = PKORB(1,8)
479!! AMRO = PKORB(1,9)
480!! GAMRO = PKORB(2,9)
481 ama1 = 1.275 !! PKORB(1,10)
482 gama1 = 0.615 !! PKORB(2,10)
483!! AMK = PKORB(1,11)
484!! AMKZ = PKORB(1,12)
485!! AMKST = PKORB(1,13)
486!! GAMKST = PKORB(2,13)
487C
488#elif defined (ALEPH)
489 ampiz = 0.134964
490 ampi = 0.139568
491 amro = 0.7714
492 gamro = 0.153
493cam AMRO = 0.773
494cam GAMRO = 0.145
495 ama1 = 1.251! PMAS(LUCOMP(ia1),1) ! AMA1 = 1.251
496 gama1 = 0.599! PMAS(LUCOMP(ia1),2) ! GAMA1 = 0.599
497 print *,'INIMAS a1 mass= ',ama1,gama1
498 amk = 0.493667
499 amkz = 0.49772
500 amkst = 0.8921
501 gamkst = 0.0513
502#else
503#endif
504 WRITE(iout,bxope)
505 WRITE(iout,bxtxt) ' TAUOLA Initialization SUBROUTINE INIMAS: '
506 WRITE(iout,bxtxt) ' Adopted to read from KK '
507 WRITE(iout,bxinit) amtau, 'AMTAU tau-mass ','****','***'
508 WRITE(iout,bxinit) amel , 'AMEL electron-mass ','****','***'
509 WRITE(iout,bxinit) ammu , 'AMMU muon-mass ','****','***'
510 WRITE(iout,bxclo)
511
512 END
513
514 SUBROUTINE choice(MNUM,RR,ICHAN,PROB1,PROB2,PROB3,
515 $ AMRX,GAMRX,AMRA,GAMRA,AMRB,GAMRB)
516 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
517 * ,ampiz,ampi,amro,gamro,ama1,gama1
518 * ,amk,amkz,amkst,gamkst
519*
520 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
521 * ,ampiz,ampi,amro,gamro,ama1,gama1
522 * ,amk,amkz,amkst,gamkst
523*
524 amrop=1.1
525 gamrop=0.36
526 amom=.782
527 gamom=0.0084
528* XXXXA CORRESPOND TO S2 CHANNEL !
529 IF(mnum.EQ.0) THEN
530 prob1=0.5
531 prob2=0.5
532 amrx =ama1
533 gamrx=gama1
534 amra =amro
535 gamra=gamro
536 amrb =amro
537 gamrb=gamro
538 ELSEIF(mnum.EQ.1) THEN
539 prob1=0.5
540 prob2=0.5
541 amrx =1.57
542 gamrx=0.9
543 amrb =amkst
544 gamrb=gamkst
545 amra =amro
546 gamra=gamro
547 ELSEIF(mnum.EQ.2) THEN
548 prob1=0.5
549 prob2=0.5
550 amrx =1.57
551 gamrx=0.9
552 amrb =amkst
553 gamrb=gamkst
554 amra =amro
555 gamra=gamro
556 ELSEIF(mnum.EQ.3) THEN
557 prob1=0.5
558 prob2=0.5
559 amrx =1.27
560 gamrx=0.3
561 amra =amkst
562 gamra=gamkst
563 amrb =amkst
564 gamrb=gamkst
565 ELSEIF(mnum.EQ.4) THEN
566 prob1=0.5
567 prob2=0.5
568 amrx =1.27
569 gamrx=0.3
570 amra =amkst
571 gamra=gamkst
572 amrb =amkst
573 gamrb=gamkst
574 ELSEIF(mnum.EQ.5) THEN
575 prob1=0.5
576 prob2=0.5
577 amrx =1.27
578 gamrx=0.3
579 amra =amkst
580 gamra=gamkst
581 amrb =amro
582 gamrb=gamro
583 ELSEIF(mnum.EQ.6) THEN
584 prob1=0.4
585 prob2=0.4
586 amrx =1.27
587 gamrx=0.3
588 amra =amro
589 gamra=gamro
590 amrb =amkst
591 gamrb=gamkst
592 ELSEIF(mnum.EQ.7) THEN
593 prob1=0.0
594 prob2=1.0
595 amrx =1.27
596 gamrx=0.9
597 amra =amro
598 gamra=gamro
599 amrb =amro
600 gamrb=gamro
601 ELSEIF(mnum.EQ.8) THEN
602 prob1=0.0
603 prob2=1.0
604 amrx =amrop
605 gamrx=gamrop
606 amrb =amom
607 gamrb=gamom
608 amra =amro
609 gamra=gamro
610 ELSEIF(mnum.EQ.101) THEN
611 prob1=.35
612 prob2=.35
613 amrx =1.2
614 gamrx=.46
615 amrb =amom
616 gamrb=gamom
617 amra =amom
618 gamra=gamom
619 ELSEIF(mnum.EQ.102) THEN
620 prob1=0.0
621 prob2=0.0
622 amrx =1.4
623 gamrx=.6
624 amrb =amom
625 gamrb=gamom
626 amra =amom
627 gamra=gamom
628 ELSE
629 prob1=0.0
630 prob2=0.0
631 amrx =ama1
632 gamrx=gama1
633 amra =amro
634 gamra=gamro
635 amrb =amro
636 gamrb=gamro
637 ENDIF
638*
639 IF (rr.LE.prob1) THEN
640 ichan=1
641 ELSEIF(rr.LE.(prob1+prob2)) THEN
642 ichan=2
643 ax =amra
644 gx =gamra
645 amra =amrb
646 gamra=gamrb
647 amrb =ax
648 gamrb=gx
649 px =prob1
650 prob1=prob2
651 prob2=px
652 ELSE
653 ichan=3
654 ENDIF
655*
656 prob3=1.0-prob1-prob2
657 END
658
659 FUNCTION dcdmas(IDENT)
660 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
661 * ,ampiz,ampi,amro,gamro,ama1,gama1
662 * ,amk,amkz,amkst,gamkst
663*
664 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
665 * ,ampiz,ampi,amro,gamro,ama1,gama1
666 * ,amk,amkz,amkst,gamkst
667 IF (ident.EQ. 1) THEN
668 apkmas=ampi
669 ELSEIF (ident.EQ.-1) THEN
670 apkmas=ampi
671 ELSEIF (ident.EQ. 2) THEN
672 apkmas=ampiz
673 ELSEIF (ident.EQ.-2) THEN
674 apkmas=ampiz
675 ELSEIF (ident.EQ. 3) THEN
676 apkmas=amk
677 ELSEIF (ident.EQ.-3) THEN
678 apkmas=amk
679 ELSEIF (ident.EQ. 4) THEN
680 apkmas=amkz
681 ELSEIF (ident.EQ.-4) THEN
682 apkmas=amkz
683 ELSEIF (ident.EQ. 8) THEN
684 apkmas=0.0001
685 ELSEIF (ident.EQ.-8) THEN
686 apkmas=0.0001
687 ELSEIF (ident.EQ. 9) THEN
688 apkmas=0.5488
689 ELSEIF (ident.EQ.-9) THEN
690 apkmas=0.5488
691 ELSE
692 print *, 'STOP IN APKMAS, WRONG IDENT=',ident
693 stop
694 ENDIF
695 dcdmas=apkmas
696 END
697 FUNCTION lunpik(ID,ISGN)
698 COMMON / taukle / bra1,brk0,brk0b,brks
699 real*4 bra1,brk0,brk0b,brks
700 real*4 xio(1)
701 ident=id*isgn
702#if defined (ALEPH)
703 IF (ident.EQ. 1) THEN
704 ipkdef= 211
705 ELSEIF (ident.EQ.-1) THEN
706 ipkdef=-211
707 ELSEIF (ident.EQ. 2) THEN
708 ipkdef= 111
709 ELSEIF (ident.EQ.-2) THEN
710 ipkdef= 111
711 ELSEIF (ident.EQ. 3) THEN
712 ipkdef= 321
713 ELSEIF (ident.EQ.-3) THEN
714 ipkdef=-321
715#else
716 IF (ident.EQ. 1) THEN
717 ipkdef=-211
718 ELSEIF (ident.EQ.-1) THEN
719 ipkdef= 211
720 ELSEIF (ident.EQ. 2) THEN
721 ipkdef=111
722 ELSEIF (ident.EQ.-2) THEN
723 ipkdef=111
724 ELSEIF (ident.EQ. 3) THEN
725 ipkdef=-321
726 ELSEIF (ident.EQ.-3) THEN
727 ipkdef= 321
728#endif
729 ELSEIF (ident.EQ. 4) THEN
730*
731* K0 --> K0_LONG (IS 130) / K0_SHORT (IS 310) = 1/1
732 CALL ranmar(xio,1)
733 IF (xio(1).GT.brk0) THEN
734 ipkdef= 130
735 ELSE
736 ipkdef= 310
737 ENDIF
738 ELSEIF (ident.EQ.-4) THEN
739*
740* K0B--> K0_LONG (IS 130) / K0_SHORT (IS 310) = 1/1
741 CALL ranmar(xio,1)
742 IF (xio(1).GT.brk0b) THEN
743 ipkdef= 130
744 ELSE
745 ipkdef= 310
746 ENDIF
747 ELSEIF (ident.EQ. 8) THEN
748 ipkdef= 22
749 ELSEIF (ident.EQ.-8) THEN
750 ipkdef= 22
751 ELSEIF (ident.EQ. 9) THEN
752 ipkdef= 221
753 ELSEIF (ident.EQ.-9) THEN
754 ipkdef= 221
755 ELSE
756 print *, 'STOP IN IPKDEF, WRONG IDENT=',ident
757 stop
758 ENDIF
759 lunpik=ipkdef
760 END
761
762
763#if defined (CLEO)
764
765 SUBROUTINE taurdf(KTO)
766C THIS ROUTINE CAN BE CALLED BEFORE ANY TAU+ OR TAU- EVENT IS GENERATED
767C IT CAN BE USED TO GENERATE TAU+ AND TAU- SAMPLES OF DIFFERENT
768C CONTENTS
769 COMMON / taukle / bra1,brk0,brk0b,brks
770 real*4 bra1,brk0,brk0b,brks
771 COMMON / taubra / gamprt(30),jlist(30),nchan
772 IF (kto.EQ.1) THEN
773C ==================
774C AJWMOD: Set the BRs for (A1+ -> rho+ pi0) and (K*+ -> K0 pi+)
775 bra1 = pkorb(4,1)
776 brks = pkorb(4,3)
777 brk0 = pkorb(4,5)
778 brk0b = pkorb(4,6)
779 ELSE
780C ====
781C AJWMOD: Set the BRs for (A1+ -> rho+ pi0) and (K*+ -> K0 pi+)
782 bra1 = pkorb(4,2)
783 brks = pkorb(4,4)
784 brk0 = pkorb(4,5)
785 brk0b = pkorb(4,6)
786 ENDIF
787C =====
788 END
789#else
790
791 SUBROUTINE taurdf(KTO)
792* THIS ROUTINE CAN BE CALLED BEFORE ANY TAU+ OR TAU- EVENT IS GENERATED
793* IT CAN BE USED TO GENERATE TAU+ AND TAU- SAMPLES OF DIFFERENT
794* CONTENTS
795 COMMON / taukle / bra1,brk0,brk0b,brks
796 real*4 bra1,brk0,brk0b,brks
797 COMMON / taubra / gamprt(30),jlist(30),nchan
798 IF (kto.EQ.1) THEN
799* ==================
800* LIST OF BRANCHING RATIOS
801 nchan = 19
802 DO 1 i = 1,30
803 IF (i.LE.nchan) THEN
804 jlist(i) = i
805 IF(i.EQ. 1) gamprt(i) = .0000
806 IF(i.EQ. 2) gamprt(i) = .0000
807 IF(i.EQ. 3) gamprt(i) = .0000
808 IF(i.EQ. 4) gamprt(i) = .0000
809 IF(i.EQ. 5) gamprt(i) = .0000
810 IF(i.EQ. 6) gamprt(i) = .0000
811 IF(i.EQ. 7) gamprt(i) = .0000
812 IF(i.EQ. 8) gamprt(i) = 1.0000
813 IF(i.EQ. 9) gamprt(i) = 1.0000
814 IF(i.EQ.10) gamprt(i) = 1.0000
815 IF(i.EQ.11) gamprt(i) = 1.0000
816 IF(i.EQ.12) gamprt(i) = 1.0000
817 IF(i.EQ.13) gamprt(i) = 1.0000
818 IF(i.EQ.14) gamprt(i) = 1.0000
819 IF(i.EQ.15) gamprt(i) = 1.0000
820 IF(i.EQ.16) gamprt(i) = 1.0000
821 IF(i.EQ.17) gamprt(i) = 1.0000
822 IF(i.EQ.18) gamprt(i) = 1.0000
823 IF(i.EQ.19) gamprt(i) = 1.0000
824 ELSE
825 jlist(i) = 0
826 gamprt(i) = 0.
827 ENDIF
828 1 CONTINUE
829* --- COEFFICIENTS TO FIX RATIO OF:
830* --- A1 3CHARGED/ A1 1CHARGED 2 NEUTRALS MATRIX ELEMENTS (MASLESS LIM.)
831* --- PROBABILITY OF K0 TO BE KS
832* --- PROBABILITY OF K0B TO BE KS
833* --- RATIO OF COEFFICIENTS FOR K*--> K0 PI-
834* --- ALL COEFFICENTS SHOULD BE IN THE RANGE (0.0,1.0)
835* --- THEY MEANING IS PROBABILITY OF THE FIRST CHOICE ONLY IF ONE
836* --- NEGLECTS MASS-PHASE SPACE EFFECTS
837 bra1=0.5
838 brk0=0.5
839 brk0b=0.5
840 brks=0.6667
841 ELSE
842* ====
843* LIST OF BRANCHING RATIOS
844 nchan = 19
845 DO 2 i = 1,30
846 IF (i.LE.nchan) THEN
847 jlist(i) = i
848 IF(i.EQ. 1) gamprt(i) = .0000
849 IF(i.EQ. 2) gamprt(i) = .0000
850 IF(i.EQ. 3) gamprt(i) = .0000
851 IF(i.EQ. 4) gamprt(i) = .0000
852 IF(i.EQ. 5) gamprt(i) = .0000
853 IF(i.EQ. 6) gamprt(i) = .0000
854 IF(i.EQ. 7) gamprt(i) = .0000
855 IF(i.EQ. 8) gamprt(i) = 1.0000
856 IF(i.EQ. 9) gamprt(i) = 1.0000
857 IF(i.EQ.10) gamprt(i) = 1.0000
858 IF(i.EQ.11) gamprt(i) = 1.0000
859 IF(i.EQ.12) gamprt(i) = 1.0000
860 IF(i.EQ.13) gamprt(i) = 1.0000
861 IF(i.EQ.14) gamprt(i) = 1.0000
862 IF(i.EQ.15) gamprt(i) = 1.0000
863 IF(i.EQ.16) gamprt(i) = 1.0000
864 IF(i.EQ.17) gamprt(i) = 1.0000
865 IF(i.EQ.18) gamprt(i) = 1.0000
866 IF(i.EQ.19) gamprt(i) = 1.0000
867 ELSE
868 jlist(i) = 0
869 gamprt(i) = 0.
870 ENDIF
871 2 CONTINUE
872* --- COEFFICIENTS TO FIX RATIO OF:
873* --- A1 3CHARGED/ A1 1CHARGED 2 NEUTRALS MATRIX ELEMENTS (MASLESS LIM.)
874* --- PROBABILITY OF K0 TO BE KS
875* --- PROBABILITY OF K0B TO BE KS
876* --- RATIO OF COEFFICIENTS FOR K*--> K0 PI-
877* --- ALL COEFFICENTS SHOULD BE IN THE RANGE (0.0,1.0)
878* --- THEY MEANING IS PROBABILITY OF THE FIRST CHOICE ONLY IF ONE
879* --- NEGLECTS MASS-PHASE SPACE EFFECTS
880 bra1=0.5
881 brk0=0.5
882 brk0b=0.5
883 brks=0.6667
884 ENDIF
885* =====
886 END
887*/////////////////////////////////////////////////////////////////////////////////////
888*// //
889*// THE END of //
890*// Standard Tauola interface/initialization routines of functionality exactly //
891*// as in Tauola CPC //
892*// //
893*/////////////////////////////////////////////////////////////////////////////////////
894#endif
895
896
897