C++ Interface to Tauola
demo-factory/back/attic/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 SUBROUTINE inietc(jakk1,jakk2,itd,ifpho)
7 COMMON / idfc / idff
8 COMMON / taurad / xk0dec,itdkrc
9 DOUBLE PRECISION XK0DEC
10 COMMON / jaki / jak1,jak2,jakp,jakm,ktom
11 COMMON /phoact/ ifphot
12 SAVE
13C KTO=1 will denote tau+, thus :: IDFF=-15
14 idff=-15
15C XK0 for tau decays.
16 xk0dec=0.01
17C radiative correction switch in tau --> e (mu) decays !
18 itdkrc=itd
19C switches of tau+ tau- decay modes !!
20 jak1=jakk1
21 jak2=jakk2
22C photos activation switch
23 ifphot=ifpho
24 end
25
26 SUBROUTINE tralo4(KTOS,PHOI,PHOF,AM)
27!! Corrected 11.10.96 (ZW) tralor for KORALW.
28!! better treatment is to cascade from tau rest-frame through W
29!! restframe down to LAB.
30 COMMON / momdec / q1,q2,p1,p2,p3,p4
31 COMMON /tralid/ idtra
32 double precision Q1(4),Q2(4),P1(4),P2(4),P3(4),P4(4)
33 double precision PIN(4),POUT(4),PBST(4),PBS1(4),QQ(4),PI
34 double precision THET,PHI
35 real*4 phoi(4),phof(4)
36 SAVE
37 DATA pi /3.141592653589793238462643d0/
38 am=sqrt(abs
39 $ (phoi(4)**2-phoi(3)**2-phoi(2)**2-phoi(1)**2))
40 idtra=ktos
41 DO k=1,4
42 pin(k)=phoi(k)
43 phof(k)=phoi(k)
44 ENDDO
45! write(*,*) idtra
46 IF (idtra.EQ.1) THEN
47 DO k=1,4
48 pbst(k)=p1(k)
49 qq(k)=q1(k)
50 ENDDO
51 ELSEIF(idtra.EQ.2) THEN
52 DO k=1,4
53 pbst(k)=p2(k)
54 qq(k)=q1(k)
55 ENDDO
56 ELSEIF(idtra.EQ.3) THEN
57 DO k=1,4
58 pbst(k)=p3(k)
59 qq(k)=q2(k)
60 ENDDO
61 ELSE
62 DO k=1,4
63 pbst(k)=p4(k)
64 qq(k)=q2(k)
65 ENDDO
66 ENDIF
67C for tau- spin-axis is antiparallel to 4-momentum.
68 IF(ktos.EQ.1) CALL rotod2(pi,pin,pin)
69
70 CALL bostdq(1,qq,pbst,pbst)
71 pbs1(4)=pbst(4)
72 pbs1(3)=sqrt(pbst(3)**2+pbst(2)**2+pbst(1)**2)
73 pbs1(2)=0d0
74 pbs1(1)=0d0
75 CALL bostdq(-1,pbs1,pin,pout)
76 thet=acos(pbst(3)/sqrt(pbst(3)**2+pbst(2)**2+pbst(1)**2))
77 phi=0d0
78 phi=acos(pbst(1)/sqrt(pbst(2)**2+pbst(1)**2))
79 IF(pbst(2).LT.0d0) phi=2*pi-phi
80 CALL rotpox(thet,phi,pout)
81 CALL bostdq(-1,qq,pout,pout)
82 DO k=1,4
83 phof(k)=pout(k)
84 ENDDO
85 END
86
87
88 SUBROUTINE choice(MNUM,RR,ICHAN,PROB1,PROB2,PROB3,
89 $ AMRX,GAMRX,AMRA,GAMRA,AMRB,GAMRB)
90 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
91 * ,ampiz,ampi,amro,gamro,ama1,gama1
92 * ,amk,amkz,amkst,gamkst
93C
94 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
95 * ,ampiz,ampi,amro,gamro,ama1,gama1
96 * ,amk,amkz,amkst,gamkst
97C
98 amrop=1.1
99 gamrop=0.36
100 amom=.782
101 gamom=0.0084
102C XXXXA CORRESPOND TO S2 CHANNEL !
103 IF(mnum.EQ.0) THEN
104 prob1=0.5
105 prob2=0.5
106 amrx =ama1
107 gamrx=gama1
108 amra =amro
109 gamra=gamro
110 amrb =amro
111 gamrb=gamro
112 ELSEIF(mnum.EQ.1) THEN
113 prob1=0.5
114 prob2=0.5
115 amrx =1.57
116 gamrx=0.9
117 amrb =amkst
118 gamrb=gamkst
119 amra =amro
120 gamra=gamro
121 ELSEIF(mnum.EQ.2) 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.3) THEN
131 prob1=0.5
132 prob2=0.5
133 amrx =1.27
134 gamrx=0.3
135 amra =amkst
136 gamra=gamkst
137 amrb =amkst
138 gamrb=gamkst
139 ELSEIF(mnum.EQ.4) 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.5) 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 =amro
156 gamrb=gamro
157 ELSEIF(mnum.EQ.6) THEN
158 prob1=0.4
159 prob2=0.4
160 amrx =1.27
161 gamrx=0.3
162 amra =amro
163 gamra=gamro
164 amrb =amkst
165 gamrb=gamkst
166 ELSEIF(mnum.EQ.7) THEN
167 prob1=0.0
168 prob2=1.0
169 amrx =1.27
170 gamrx=0.9
171 amra =amro
172 gamra=gamro
173 amrb =amro
174 gamrb=gamro
175 ELSEIF(mnum.EQ.8) THEN
176 prob1=0.0
177 prob2=1.0
178 amrx =amrop
179 gamrx=gamrop
180 amrb =amom
181 gamrb=gamom
182 amra =amro
183 gamra=gamro
184 ELSEIF(mnum.EQ.101) THEN
185 prob1=.35
186 prob2=.35
187 amrx =1.2
188 gamrx=.46
189 amrb =amom
190 gamrb=gamom
191 amra =amom
192 gamra=gamom
193 ELSEIF(mnum.EQ.102) THEN
194 prob1=0.0
195 prob2=0.0
196 amrx =1.4
197 gamrx=.6
198 amrb =amom
199 gamrb=gamom
200 amra =amom
201 gamra=gamom
202 ELSE
203 prob1=0.0
204 prob2=0.0
205 amrx =ama1
206 gamrx=gama1
207 amra =amro
208 gamra=gamro
209 amrb =amro
210 gamrb=gamro
211 ENDIF
212C
213 IF (rr.LE.prob1) THEN
214 ichan=1
215 ELSEIF(rr.LE.(prob1+prob2)) THEN
216 ichan=2
217 ax =amra
218 gx =gamra
219 amra =amrb
220 gamra=gamrb
221 amrb =ax
222 gamrb=gx
223 px =prob1
224 prob1=prob2
225 prob2=px
226 ELSE
227 ichan=3
228 ENDIF
229C
230 prob3=1.0-prob1-prob2
231 END
232
233 SUBROUTINE initdk
234C ----------------------------------------------------------------------
235C INITIALISATION OF TAU DECAY PARAMETERS and routines
236C
237C called by : KORALZ
238C ----------------------------------------------------------------------
239 COMMON / decpar / gfermi,gv,ga,ccabib,scabib,gamel
240 real*4 gfermi,gv,ga,ccabib,scabib,gamel
241 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
242 * ,ampiz,ampi,amro,gamro,ama1,gama1
243 * ,amk,amkz,amkst,gamkst
244C
245 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
246 * ,ampiz,ampi,amro,gamro,ama1,gama1
247 * ,amk,amkz,amkst,gamkst
248 COMMON / taubra / gamprt(30),jlist(30),nchan
249 COMMON / taukle / bra1,brk0,brk0b,brks
250 real*4 bra1,brk0,brk0b,brks
251#if defined (ALEPH)
252 parameter(nmode=15,nm1=0,nm2=1,nm3=8,nm4=2,nm5=1,nm6=3)
253 COMMON / taudcd /idffin(9,nmode),mulpik(nmode)
254 & ,names
255 CHARACTER NAMES(NMODE)*31
256#else
257 parameter(nmode=15,nm1=0,nm2=1,nm3=8,nm4=2,nm5=1,nm6=3)
258 COMMON / decomp /idffin(9,nmode),mulpik(nmode)
259 & ,names
260 CHARACTER NAMES(NMODE)*31
261#endif
262 real*4 pi,pol(4)
263C
264C LIST OF BRANCHING RATIOS
265CAM normalised to e nu nutau channel
266CAM enu munu pinu rhonu A1nu Knu K*nu pi
267CAM DATA JLIST / 1, 2, 3, 4, 5, 6, 7,
268#if defined (ALEPH)
269CAM /0.1779,0.1731,0.1106,0.2530,0.1811,0.0072,0.0139
270CAM DATA GAMPRT / 1.000,0.9732,0.6217,1.4221,1.0180,0.0405,0.0781
271CAM DATA GAMPRT /1.000,0.9676,0.6154,1.3503,1.0225,0.0368,O.O758
272CAM
273C
274C conventions of particles names
275c
276cam mode (JAK) 8 9
277CAM channel pi- pi- pi0 pi+ 3pi0 pi-
278cam particle code -1,-1, 2, 1, 0, 0, 2, 2, 2,-1, 0, 0,
279CAM BR relative to electron .2414, .0601,
280c
281* 10 11
282* 1 3pi+- 2pi0 5pi+-
283* 1 -1,-1, 1, 2, 2, 0, -1,-1,-1, 1, 1, 0,
284* 1 .0281, .0045,
285
286* 12 13
287* 2 5pi+- pi0 3pi+- 3pi0
288* 2 -1,-1,-1, 1, 1, 2, -1,-1, 1, 2, 2, 2,
289* 2 .0010, .0062,
290
291* 14 15
292* 3 K- pi- K+ K0 pi- KB
293* 3 -3,-1, 3, 0, 0, 0, 4,-1,-4, 0, 0, 0,
294* 3 .0096, .0169,
295
296* 16 17
297* 4 K- pi0 K0 2pi0 K-
298* 4 -3, 2, 4, 0, 0, 0, 2, 2,-3, 0, 0, 0,
299* 4 .0056, .0045,
300
301* 18 19
302* 5 K- pi- pi+ pi- KB pi0
303* 5 -3,-1, 1, 0, 0, 0, -1,-4, 2, 0, 0, 0,
304* 5 .0219, .0180,
305
306* 20 21
307* 6 eta pi- pi0 pi- pi0 gamma
308* 6 9,-1, 2, 0, 0, 0, -1, 2, 8, 0, 0, 0,
309* 6 .0096, .0088,
310
311* 22 /
312* 7 K- K0 /
313* 7 -3, 4 /
314* 7 .0146 /
315#else
316*AM DATA GAMPRT /1.000,0.9730,0.6054,1.2432,0.8432,0.0432,O.O811,0.616
317*AM
318*AM multipion decays
319*
320* conventions of particles names
321* K-,P-,K+, K0,P-,KB, K-,P0,K0
322* 3, 1,-3 , 4, 1,-4 , 3, 2, 4 ,
323* P0,P0,K-, K-,P-,P+, P-,KB,P0
324* 2, 2, 3 , 3, 1,-1 , 1,-4, 2 ,
325* ET,P-,P0 P-,P0,GM
326* 9, 1, 2 , 1, 2, 8
327*
328#endif
329C
330 dimension nopik(6,nmode),npik(nmode)
331CAM outgoing multiplicity and flavors of multi-pion /multi-K modes
332 DATA npik / 4, 4,
333 1 5, 5,
334 2 6, 6,
335 3 3, 3,
336 4 3, 3,
337 5 3, 3,
338 6 3, 3,
339 7 2 /
340#if defined (ALEPH)
341 DATA nopik / -1,-1, 2, 1, 0, 0, 2, 2, 2,-1, 0, 0,
342 1 -1,-1, 1, 2, 2, 0, -1,-1,-1, 1, 1, 0,
343 2 -1,-1,-1, 1, 1, 2, -1,-1, 1, 2, 2, 2,
344 3 -3,-1, 3, 0, 0, 0, 4,-1,-4, 0, 0, 0,
345 4 -3, 2, 4, 0, 0, 0, 2, 2,-3, 0, 0, 0,
346 5 -3,-1, 1, 0, 0, 0, -1,-4, 2, 0, 0, 0,
347 6 9,-1, 2, 0, 0, 0, -1, 2, 8, 0, 0, 0,
348#else
349 DATA nopik / -1,-1, 1, 2, 0, 0, 2, 2, 2,-1, 0, 0,
350 1 -1,-1, 1, 2, 2, 0, -1,-1,-1, 1, 1, 0,
351 2 -1,-1,-1, 1, 1, 2, -1,-1, 1, 2, 2, 2,
352 3 -3,-1, 3, 0, 0, 0, -4,-1, 4, 0, 0, 0,
353 4 -3, 2,-4, 0, 0, 0, 2, 2,-3, 0, 0, 0,
354 5 -3,-1, 1, 0, 0, 0, -1, 4, 2, 0, 0, 0,
355 6 9,-1, 2, 0, 0, 0, -1, 2, 8, 0, 0, 0,
356#endif
357#if defined (CLEO)
358C AJWMOD fix sign bug, 2/22/99
359 7 -3,-4, 0, 0, 0, 0 /
360#else
361 7 -3, 4, 0, 0, 0, 0 /
362#endif
363C LIST OF BRANCHING RATIOS
364 nchan = nmode + 7
365 DO 1 i = 1,30
366 IF (i.LE.nchan) THEN
367 jlist(i) = i
368 IF(i.EQ. 1) gamprt(i) = 1.0000
369 IF(i.EQ. 2) gamprt(i) = 1.0000
370 IF(i.EQ. 3) gamprt(i) = 1.0000
371 IF(i.EQ. 4) gamprt(i) = 1.0000
372 IF(i.EQ. 5) gamprt(i) = 1.0000
373 IF(i.EQ. 6) gamprt(i) = 1.0000
374 IF(i.EQ. 7) gamprt(i) = 1.0000
375 IF(i.EQ. 8) gamprt(i) = 1.0000
376 IF(i.EQ. 9) gamprt(i) = 1.0000
377 IF(i.EQ.10) gamprt(i) = 1.0000
378 IF(i.EQ.11) gamprt(i) = 1.0000
379 IF(i.EQ.12) gamprt(i) = 1.0000
380 IF(i.EQ.13) gamprt(i) = 1.0000
381 IF(i.EQ.14) gamprt(i) = 1.0000
382 IF(i.EQ.15) gamprt(i) = 1.0000
383 IF(i.EQ.16) gamprt(i) = 1.0000
384 IF(i.EQ.17) gamprt(i) = 1.0000
385 IF(i.EQ.18) gamprt(i) = 1.0000
386 IF(i.EQ.19) gamprt(i) = 1.0000
387 IF(i.EQ.20) gamprt(i) = 1.0000
388 IF(i.EQ.21) gamprt(i) = 1.0000
389 IF(i.EQ.22) gamprt(i) = 1.0000
390#if defined (CePeCe)
391 IF(i.EQ. 1) gamprt(i) = 1.0000
392 IF(i.EQ. 2) gamprt(i) = 1.0000
393 IF(i.EQ. 3) gamprt(i) = 1.0000
394 IF(i.EQ. 4) gamprt(i) = 1.0000
395 IF(i.EQ. 5) gamprt(i) = 1.0000
396 IF(i.EQ. 6) gamprt(i) = 1.0000
397 IF(i.EQ. 7) gamprt(i) = 1.0000
398 IF(i.EQ. 8) gamprt(i) = 1.0000
399 IF(i.EQ. 9) gamprt(i) = 1.0000
400 IF(i.EQ.10) gamprt(i) = 1.0000
401 IF(i.EQ.11) gamprt(i) = 1.0000
402 IF(i.EQ.12) gamprt(i) = 1.0000
403 IF(i.EQ.13) gamprt(i) = 1.0000
404 IF(i.EQ.14) gamprt(i) = 1.0000
405 IF(i.EQ.15) gamprt(i) = 1.0000
406 IF(i.EQ.16) gamprt(i) = 1.0000
407 IF(i.EQ.17) gamprt(i) = 1.0000
408 IF(i.EQ.18) gamprt(i) = 1.0000
409 IF(i.EQ.19) gamprt(i) = 1.0000
410 IF(i.EQ.20) gamprt(i) = 1.0000
411 IF(i.EQ.21) gamprt(i) = 1.0000
412 IF(i.EQ.22) gamprt(i) = 1.0000
413#elif defined (CLEO)
414 IF(i.EQ. 1) gamprt(i) =0.1800
415 IF(i.EQ. 2) gamprt(i) =0.1751
416 IF(i.EQ. 3) gamprt(i) =0.1110
417 IF(i.EQ. 4) gamprt(i) =0.2515
418 IF(i.EQ. 5) gamprt(i) =0.1790
419 IF(i.EQ. 6) gamprt(i) =0.0071
420 IF(i.EQ. 7) gamprt(i) =0.0134
421 IF(i.EQ. 8) gamprt(i) =0.0450
422 IF(i.EQ. 9) gamprt(i) =0.0100
423 IF(i.EQ.10) gamprt(i) =0.0009
424 IF(i.EQ.11) gamprt(i) =0.0004
425 IF(i.EQ.12) gamprt(i) =0.0003
426 IF(i.EQ.13) gamprt(i) =0.0005
427 IF(i.EQ.14) gamprt(i) =0.0015
428 IF(i.EQ.15) gamprt(i) =0.0015
429 IF(i.EQ.16) gamprt(i) =0.0015
430 IF(i.EQ.17) gamprt(i) =0.0005
431 IF(i.EQ.18) gamprt(i) =0.0050
432 IF(i.EQ.19) gamprt(i) =0.0055
433 IF(i.EQ.20) gamprt(i) =0.0017
434 IF(i.EQ.21) gamprt(i) =0.0013
435 IF(i.EQ.22) gamprt(i) =0.0010
436#elif defined (ALEPH)
437 IF(i.EQ. 1) gamprt(i) = 1.0000
438 IF(i.EQ. 2) gamprt(i) = .9732
439 IF(i.EQ. 3) gamprt(i) = .6217
440 IF(i.EQ. 4) gamprt(i) = 1.4221
441 IF(i.EQ. 5) gamprt(i) = 1.0180
442 IF(i.EQ. 6) gamprt(i) = .0405
443 IF(i.EQ. 7) gamprt(i) = .0781
444 IF(i.EQ. 8) gamprt(i) = .2414
445 IF(i.EQ. 9) gamprt(i) = .0601
446 IF(i.EQ.10) gamprt(i) = .0281
447 IF(i.EQ.11) gamprt(i) = .0045
448 IF(i.EQ.12) gamprt(i) = .0010
449 IF(i.EQ.13) gamprt(i) = .0062
450 IF(i.EQ.14) gamprt(i) = .0096
451 IF(i.EQ.15) gamprt(i) = .0169
452 IF(i.EQ.16) gamprt(i) = .0056
453 IF(i.EQ.17) gamprt(i) = .0045
454 IF(i.EQ.18) gamprt(i) = .0219
455 IF(i.EQ.19) gamprt(i) = .0180
456 IF(i.EQ.20) gamprt(i) = .0096
457 IF(i.EQ.21) gamprt(i) = .0088
458 IF(i.EQ.22) gamprt(i) = .0146
459#else
460#endif
461 IF(i.EQ. 8) names(i-7)=' TAU- --> 2PI-, PI0, PI+ '
462 IF(i.EQ. 9) names(i-7)=' TAU- --> 3PI0, PI- '
463 IF(i.EQ.10) names(i-7)=' TAU- --> 2PI-, PI+, 2PI0 '
464 IF(i.EQ.11) names(i-7)=' TAU- --> 3PI-, 2PI+, '
465 IF(i.EQ.12) names(i-7)=' TAU- --> 3PI-, 2PI+, PI0 '
466 IF(i.EQ.13) names(i-7)=' TAU- --> 2PI-, PI+, 3PI0 '
467 IF(i.EQ.14) names(i-7)=' TAU- --> K-, PI-, K+ '
468 IF(i.EQ.15) names(i-7)=' TAU- --> K0, PI-, K0B '
469#if defined (ALEPH)
470 IF(i.EQ.16) names(i-7)=' TAU- --> K- PI0 K0 '
471#else
472 IF(i.EQ.16) names(i-7)=' TAU- --> K-, K0, PI0 '
473#endif
474 IF(i.EQ.17) names(i-7)=' TAU- --> PI0, PI0, K- '
475 IF(i.EQ.18) names(i-7)=' TAU- --> K-, PI-, PI+ '
476 IF(i.EQ.19) names(i-7)=' TAU- --> PI-, K0B, PI0 '
477 IF(i.EQ.20) names(i-7)=' TAU- --> ETA, PI-, PI0 '
478 IF(i.EQ.21) names(i-7)=' TAU- --> PI-, PI0, GAM '
479 IF(i.EQ.22) names(i-7)=' TAU- --> K-, K0 '
480 ELSE
481 jlist(i) = 0
482 gamprt(i) = 0.
483 ENDIF
484 1 CONTINUE
485 DO i=1,nmode
486 mulpik(i)=npik(i)
487 DO j=1,mulpik(i)
488 idffin(j,i)=nopik(j,i)
489 ENDDO
490 ENDDO
491C
492C
493C --- COEFFICIENTS TO FIX RATIO OF:
494C --- A1 3CHARGED/ A1 1CHARGED 2 NEUTRALS MATRIX ELEMENTS (MASLESS LIM.)
495C --- PROBABILITY OF K0 TO BE KS
496C --- PROBABILITY OF K0B TO BE KS
497C --- RATIO OF COEFFICIENTS FOR K*--> K0 PI-
498C --- ALL COEFFICENTS SHOULD BE IN THE RANGE (0.0,1.0)
499C --- THEY MEANING IS PROBABILITY OF THE FIRST CHOICE ONLY IF ONE
500C --- NEGLECTS MASS-PHASE SPACE EFFECTS
501 bra1=0.5
502 brk0=0.5
503 brk0b=0.5
504 brks=0.6667
505C
506C --- remaining constants
507 pi =4.*atan(1.)
508 gfermi = 1.16637e-5
509 ccabib = 0.975
510 gv = 1.0
511 ga =-1.0
512C ZW 13.04.89 HERE WAS AN ERROR
513 scabib = sqrt(1.-ccabib**2)
514 gamel = gfermi**2*amtau**5/(192*pi**3)
515C
516 CALL dexay(-1,pol)
517C
518 RETURN
519 END
520 FUNCTION dcdmas(IDENT)
521 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
522 * ,ampiz,ampi,amro,gamro,ama1,gama1
523 * ,amk,amkz,amkst,gamkst
524C
525 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
526 * ,ampiz,ampi,amro,gamro,ama1,gama1
527 * ,amk,amkz,amkst,gamkst
528 IF (ident.EQ. 1) THEN
529 apkmas=ampi
530 ELSEIF (ident.EQ.-1) THEN
531 apkmas=ampi
532 ELSEIF (ident.EQ. 2) THEN
533 apkmas=ampiz
534 ELSEIF (ident.EQ.-2) THEN
535 apkmas=ampiz
536 ELSEIF (ident.EQ. 3) THEN
537 apkmas=amk
538 ELSEIF (ident.EQ.-3) THEN
539 apkmas=amk
540 ELSEIF (ident.EQ. 4) THEN
541 apkmas=amkz
542 ELSEIF (ident.EQ.-4) THEN
543 apkmas=amkz
544 ELSEIF (ident.EQ. 8) THEN
545 apkmas=0.0001
546 ELSEIF (ident.EQ.-8) THEN
547 apkmas=0.0001
548 ELSEIF (ident.EQ. 9) THEN
549 apkmas=0.5488
550 ELSEIF (ident.EQ.-9) THEN
551 apkmas=0.5488
552 ELSE
553 print *, 'STOP IN APKMAS, WRONG IDENT=',ident
554 stop
555 ENDIF
556 dcdmas=apkmas
557 END
558
559 FUNCTION lunpik(ID,ISGN)
560 COMMON / taukle / bra1,brk0,brk0b,brks
561 real*4 bra1,brk0,brk0b,brks
562 real*4 xio
563 dimension xio(1)
564 ident=id*isgn
565#if defined (ALEPH)
566 IF (ident.EQ. 1) THEN
567 ipkdef= 211
568 ELSEIF (ident.EQ.-1) THEN
569 ipkdef=-211
570 ELSEIF (ident.EQ. 2) THEN
571 ipkdef= 111
572 ELSEIF (ident.EQ.-2) THEN
573 ipkdef= 111
574 ELSEIF (ident.EQ. 3) THEN
575 ipkdef= 321
576 ELSEIF (ident.EQ.-3) THEN
577 ipkdef=-321
578#else
579 IF (ident.EQ. 1) THEN
580 ipkdef=-211
581 ELSEIF (ident.EQ.-1) THEN
582 ipkdef= 211
583 ELSEIF (ident.EQ. 2) THEN
584 ipkdef=111
585 ELSEIF (ident.EQ.-2) THEN
586 ipkdef=111
587 ELSEIF (ident.EQ. 3) THEN
588 ipkdef=-321
589 ELSEIF (ident.EQ.-3) THEN
590 ipkdef= 321
591#endif
592 ELSEIF (ident.EQ. 4) THEN
593C
594C K0 --> K0_LONG (IS 130) / K0_SHORT (IS 310) = 1/1
595 CALL ranmar(xio,1)
596 IF (xio(1).GT.brk0) THEN
597 ipkdef= 130
598 ELSE
599 ipkdef= 310
600 ENDIF
601 ELSEIF (ident.EQ.-4) THEN
602C
603C K0B--> K0_LONG (IS 130) / K0_SHORT (IS 310) = 1/1
604 CALL ranmar(xio,1)
605 IF (xio(1).GT.brk0b) THEN
606 ipkdef= 130
607 ELSE
608 ipkdef= 310
609 ENDIF
610 ELSEIF (ident.EQ. 8) THEN
611 ipkdef= 22
612 ELSEIF (ident.EQ.-8) THEN
613 ipkdef= 22
614 ELSEIF (ident.EQ. 9) THEN
615 ipkdef= 221
616 ELSEIF (ident.EQ.-9) THEN
617 ipkdef= 221
618 ELSE
619 print *, 'STOP IN IPKDEF, WRONG IDENT=',ident
620 stop
621 ENDIF
622 lunpik=ipkdef
623 END
624#if defined (CLEO)
625
626 SUBROUTINE taurdf(KTO)
627C THIS ROUTINE CAN BE CALLED BEFORE ANY TAU+ OR TAU- EVENT IS GENERATED
628C IT CAN BE USED TO GENERATE TAU+ AND TAU- SAMPLES OF DIFFERENT
629C CONTENTS
630 COMMON / taukle / bra1,brk0,brk0b,brks
631 real*4 bra1,brk0,brk0b,brks
632 COMMON / taubra / gamprt(30),jlist(30),nchan
633 IF (kto.EQ.1) THEN
634C ==================
635C AJWMOD: Set the BRs for (A1+ -> rho+ pi0) and (K*+ -> K0 pi+)
636 bra1 = pkorb(4,1)
637 brks = pkorb(4,3)
638 brk0 = pkorb(4,5)
639 brk0b = pkorb(4,6)
640 ELSE
641C ====
642C AJWMOD: Set the BRs for (A1+ -> rho+ pi0) and (K*+ -> K0 pi+)
643 bra1 = pkorb(4,2)
644 brks = pkorb(4,4)
645 brk0 = pkorb(4,5)
646 brk0b = pkorb(4,6)
647 ENDIF
648C =====
649 END
650#else
651
652 SUBROUTINE taurdf(KTO)
653* THIS ROUTINE CAN BE CALLED BEFORE ANY TAU+ OR TAU- EVENT IS GENERATED
654* IT CAN BE USED TO GENERATE TAU+ AND TAU- SAMPLES OF DIFFERENT
655* CONTENTS
656 COMMON / taukle / bra1,brk0,brk0b,brks
657 real*4 bra1,brk0,brk0b,brks
658 COMMON / taubra / gamprt(30),jlist(30),nchan
659 IF (kto.EQ.1) THEN
660* ==================
661* LIST OF BRANCHING RATIOS
662 nchan = 19
663 DO 1 i = 1,30
664 IF (i.LE.nchan) THEN
665 jlist(i) = i
666 IF(i.EQ. 1) gamprt(i) = .0000
667 IF(i.EQ. 2) gamprt(i) = .0000
668 IF(i.EQ. 3) gamprt(i) = .0000
669 IF(i.EQ. 4) gamprt(i) = .0000
670 IF(i.EQ. 5) gamprt(i) = .0000
671 IF(i.EQ. 6) gamprt(i) = .0000
672 IF(i.EQ. 7) gamprt(i) = .0000
673 IF(i.EQ. 8) gamprt(i) = 1.0000
674 IF(i.EQ. 9) gamprt(i) = 1.0000
675 IF(i.EQ.10) gamprt(i) = 1.0000
676 IF(i.EQ.11) gamprt(i) = 1.0000
677 IF(i.EQ.12) gamprt(i) = 1.0000
678 IF(i.EQ.13) gamprt(i) = 1.0000
679 IF(i.EQ.14) gamprt(i) = 1.0000
680 IF(i.EQ.15) gamprt(i) = 1.0000
681 IF(i.EQ.16) gamprt(i) = 1.0000
682 IF(i.EQ.17) gamprt(i) = 1.0000
683 IF(i.EQ.18) gamprt(i) = 1.0000
684 IF(i.EQ.19) gamprt(i) = 1.0000
685 ELSE
686 jlist(i) = 0
687 gamprt(i) = 0.
688 ENDIF
689 1 CONTINUE
690* --- COEFFICIENTS TO FIX RATIO OF:
691* --- A1 3CHARGED/ A1 1CHARGED 2 NEUTRALS MATRIX ELEMENTS (MASLESS LIM.)
692* --- PROBABILITY OF K0 TO BE KS
693* --- PROBABILITY OF K0B TO BE KS
694* --- RATIO OF COEFFICIENTS FOR K*--> K0 PI-
695* --- ALL COEFFICENTS SHOULD BE IN THE RANGE (0.0,1.0)
696* --- THEY MEANING IS PROBABILITY OF THE FIRST CHOICE ONLY IF ONE
697* --- NEGLECTS MASS-PHASE SPACE EFFECTS
698 bra1=0.5
699 brk0=0.5
700 brk0b=0.5
701 brks=0.6667
702 ELSE
703* ====
704* LIST OF BRANCHING RATIOS
705 nchan = 19
706 DO 2 i = 1,30
707 IF (i.LE.nchan) THEN
708 jlist(i) = i
709 IF(i.EQ. 1) gamprt(i) = .0000
710 IF(i.EQ. 2) gamprt(i) = .0000
711 IF(i.EQ. 3) gamprt(i) = .0000
712 IF(i.EQ. 4) gamprt(i) = .0000
713 IF(i.EQ. 5) gamprt(i) = .0000
714 IF(i.EQ. 6) gamprt(i) = .0000
715 IF(i.EQ. 7) gamprt(i) = .0000
716 IF(i.EQ. 8) gamprt(i) = 1.0000
717 IF(i.EQ. 9) gamprt(i) = 1.0000
718 IF(i.EQ.10) gamprt(i) = 1.0000
719 IF(i.EQ.11) gamprt(i) = 1.0000
720 IF(i.EQ.12) gamprt(i) = 1.0000
721 IF(i.EQ.13) gamprt(i) = 1.0000
722 IF(i.EQ.14) gamprt(i) = 1.0000
723 IF(i.EQ.15) gamprt(i) = 1.0000
724 IF(i.EQ.16) gamprt(i) = 1.0000
725 IF(i.EQ.17) gamprt(i) = 1.0000
726 IF(i.EQ.18) gamprt(i) = 1.0000
727 IF(i.EQ.19) gamprt(i) = 1.0000
728 ELSE
729 jlist(i) = 0
730 gamprt(i) = 0.
731 ENDIF
732 2 CONTINUE
733* --- COEFFICIENTS TO FIX RATIO OF:
734* --- A1 3CHARGED/ A1 1CHARGED 2 NEUTRALS MATRIX ELEMENTS (MASLESS LIM.)
735* --- PROBABILITY OF K0 TO BE KS
736* --- PROBABILITY OF K0B TO BE KS
737* --- RATIO OF COEFFICIENTS FOR K*--> K0 PI-
738* --- ALL COEFFICENTS SHOULD BE IN THE RANGE (0.0,1.0)
739* --- THEY MEANING IS PROBABILITY OF THE FIRST CHOICE ONLY IF ONE
740* --- NEGLECTS MASS-PHASE SPACE EFFECTS
741 bra1=0.5
742 brk0=0.5
743 brk0b=0.5
744 brks=0.6667
745 ENDIF
746* =====
747 END
748#endif
749 SUBROUTINE iniphx(XK00)
750C ----------------------------------------------------------------------
751C INITIALISATION OF PARAMETERS
752C USED IN QED and/or GSW ROUTINES
753C ----------------------------------------------------------------------
754 COMMON / qedprm /alfinv,alfpi,xk0
755 real*8 alfinv,alfpi,xk0
756 real*8 pi8,xk00
757C
758 pi8 = 4.d0*datan(1.d0)
759 alfinv = 137.03604d0
760 alfpi = 1d0/(alfinv*pi8)
761 xk0=xk00
762 END
763 SUBROUTINE inimas
764C ----------------------------------------------------------------------
765C INITIALISATION OF MASSES
766C
767C called by : KORALZ
768C ----------------------------------------------------------------------
769 COMMON / parmas / amtau,amnuta,amel,amnue,ammu,amnumu
770 * ,ampiz,ampi,amro,gamro,ama1,gama1
771 * ,amk,amkz,amkst,gamkst
772C
773 real*4 amtau,amnuta,amel,amnue,ammu,amnumu
774 * ,ampiz,ampi,amro,gamro,ama1,gama1
775 * ,amk,amkz,amkst,gamkst
776C
777C IN-COMING / OUT-GOING FERMION MASSES
778 amtau = 1.7842
779 amtau = 1.777
780 amnuta = 0.010
781 amel = 0.0005111
782 amnue = 0.0
783 ammu = 0.105659
784 amnumu = 0.0
785C
786C MASSES USED IN TAU DECAYS
787 ampiz = 0.134964
788 ampi = 0.139568
789 amro = 0.773
790 gamro = 0.145
791CC GAMRO = 0.666
792 ama1 = 1.251
793 gama1 = 0.599
794 amk = 0.493667
795 amkz = 0.49772
796 amkst = 0.8921
797 gamkst = 0.0513
798C
799#if defined (CePeCe)
800 ampiz = 0.134964
801 ampi = 0.139568
802 amro = 0.773
803 gamro = 0.145
804*C GAMRO = 0.666
805 ama1 = 1.251
806 gama1 = 0.599
807 amk = 0.493667
808 amkz = 0.49772
809 amkst = 0.8921
810 gamkst = 0.0513
811#elif defined (CLEO)
812 ampiz = 0.134964
813 ampi = 0.139568
814 amro = 0.773
815 gamro = 0.145
816*C GAMRO = 0.666
817 ama1 = 1.251
818 gama1 = 0.599
819 amk = 0.493667
820 amkz = 0.49772
821 amkst = 0.8921
822 gamkst = 0.0513
823C
824C
825C IN-COMING / OUT-GOING FERMION MASSES
826!! AMNUTA = PKORB(1,2)
827!! AMNUE = PKORB(1,4)
828!! AMNUMU = PKORB(1,6)
829C
830C MASSES USED IN TAU DECAYS Cleo settings
831!! AMPIZ = PKORB(1,7)
832!! AMPI = PKORB(1,8)
833!! AMRO = PKORB(1,9)
834!! GAMRO = PKORB(2,9)
835 ama1 = 1.275 !! PKORB(1,10)
836 gama1 = 0.615 !! PKORB(2,10)
837!! AMK = PKORB(1,11)
838!! AMKZ = PKORB(1,12)
839!! AMKST = PKORB(1,13)
840!! GAMKST = PKORB(2,13)
841C
842#elif defined (ALEPH)
843 ampiz = 0.134964
844 ampi = 0.139568
845 amro = 0.7714
846 gamro = 0.153
847cam AMRO = 0.773
848cam GAMRO = 0.145
849 ama1 = 1.251! PMAS(LUCOMP(ia1),1) ! AMA1 = 1.251
850 gama1 = 0.599! PMAS(LUCOMP(ia1),2) ! GAMA1 = 0.599
851 print *,'INIMAS a1 mass= ',ama1,gama1
852 amk = 0.493667
853 amkz = 0.49772
854 amkst = 0.8921
855 gamkst = 0.0513
856#else
857#endif
858
859 RETURN
860 END
861 subroutine bostdq(idir,vv,pp,q)
862* *******************************
863c Boost along arbitrary vector v (see eg. J.D. Jacson, Classical
864c Electrodynamics).
865c Four-vector pp is boosted from an actual frame to the rest frame
866c of the four-vector v (for idir=1) or back (for idir=-1).
867c q is a resulting four-vector.
868c Note: v must be time-like, pp may be arbitrary.
869c
870c Written by: Wieslaw Placzek date: 22.07.1994
871c Last update: 3/29/95 by: M.S.
872c
873 implicit DOUBLE PRECISION (a-h,o-z)
874 parameter(nout=6)
875 DOUBLE PRECISION v(4),p(4),q(4),pp(4),vv(4)
876 save
877!
878 do 1 i=1,4
879 v(i)=vv(i)
880 1 p(i)=pp(i)
881 amv=(v(4)**2-v(1)**2-v(2)**2-v(3)**2)
882 if (amv.le.0d0) then
883 write(6,*) 'bosstv: warning amv**2=',amv
884 endif
885 amv=sqrt(abs(amv))
886 if (idir.eq.-1) then
887 q(4)=( p(1)*v(1)+p(2)*v(2)+p(3)*v(3)+p(4)*v(4))/amv
888 wsp =(q(4)+p(4))/(v(4)+amv)
889 elseif (idir.eq.1) then
890 q(4)=(-p(1)*v(1)-p(2)*v(2)-p(3)*v(3)+p(4)*v(4))/amv
891 wsp =-(q(4)+p(4))/(v(4)+amv)
892 else
893 write(nout,*)' >>> boostv: wrong value of idir = ',idir
894 endif
895 q(1)=p(1)+wsp*v(1)
896 q(2)=p(2)+wsp*v(2)
897 q(3)=p(3)+wsp*v(3)
898 end
899
900
901#if defined (ALEPH)
902 FUNCTION dilogy(X)
903C *****************
904 IMPLICIT REAL*8(a-h,o-z)
905CERN C304 VERSION 29/07/71 DILOG 59 C
906 z=-1.64493406684822
907 IF(x .LT.-1.0) GO TO 1
908 IF(x .LE. 0.5) GO TO 2
909 IF(x .EQ. 1.0) GO TO 3
910 IF(x .LE. 2.0) GO TO 4
911 z=3.2898681336964
912 1 t=1.0/x
913 s=-0.5
914 z=z-0.5* log(abs(x))**2
915 GO TO 5
916 2 t=x
917 s=0.5
918 z=0.
919 GO TO 5
920 3 dilogy=1.64493406684822
921 RETURN
922 4 t=1.0-x
923 s=-0.5
924 z=1.64493406684822 - log(x)* log(abs(t))
925 5 y=2.66666666666666 *t+0.66666666666666
926 b= 0.00000 00000 00001
927 a=y*b +0.00000 00000 00004
928 b=y*a-b+0.00000 00000 00011
929 a=y*b-a+0.00000 00000 00037
930 b=y*a-b+0.00000 00000 00121
931 a=y*b-a+0.00000 00000 00398
932 b=y*a-b+0.00000 00000 01312
933 a=y*b-a+0.00000 00000 04342
934 b=y*a-b+0.00000 00000 14437
935 a=y*b-a+0.00000 00000 48274
936 b=y*a-b+0.00000 00001 62421
937 a=y*b-a+0.00000 00005 50291
938 b=y*a-b+0.00000 00018 79117
939 a=y*b-a+0.00000 00064 74338
940 b=y*a-b+0.00000 00225 36705
941 a=y*b-a+0.00000 00793 87055
942 b=y*a-b+0.00000 02835 75385
943 a=y*b-a+0.00000 10299 04264
944 b=y*a-b+0.00000 38163 29463
945 a=y*b-a+0.00001 44963 00557
946 b=y*a-b+0.00005 68178 22718
947 a=y*b-a+0.00023 20021 96094
948 b=y*a-b+0.00100 16274 96164
949 a=y*b-a+0.00468 63619 59447
950 b=y*a-b+0.02487 93229 24228
951 a=y*b-a+0.16607 30329 27855
952 a=y*a-b+1.93506 43008 6996
953 dilogy=s*t*(a-b)+z
954 RETURN
955C=======================================================================
956C===================END OF CPC PART ====================================
957C=======================================================================
958 END
959#endif
960
961
962
963
964
965
966