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