C++ Interface to Tauola
tauola-F/jetset-F/tauola_photos_ini.f
1 /* copyright(c) 1991-2021 free software foundation, inc.
2  this file is part of the gnu c library.
3 
4  the gnu c library is free software; you can redistribute it and/or
5  modify it under the terms of the gnu lesser general Public
6  license as published by the free software foundation; either
7  version 2.1 of the license, or(at your option) any later version.
8 
9  the gnu c library is distributed in the hope that it will be useful,
10  but without any warranty; without even the implied warranty of
11  merchantability or fitness for a particular purpose. see the gnu
12  lesser general Public license for more details.
13 
14  you should have received a copy of the gnu lesser general Public
15  license along with the gnu c library; if not, see
16  <https://www.gnu.org/licenses/>. */
17 
18 
19 /* this header is separate from features.h so that the compiler can
20  include it implicitly at the start of every compilation. it must
21  not itself include <features.h> or any other header that includes
22  <features.h> because the implicit include comes before any feature
23  test macros that may be defined in a source file before it first
24  explicitly includes a system header. gcc knows the name of this
25  header in order to preinclude it. */
26 
27 /* glibc's intent is to support the IEC 559 math functionality, real
28  and complex. If the GCC (4.9 and later) predefined macros
29  specifying compiler intent are available, use them to determine
30  whether the overall intent is to support these features; otherwise,
31  presume an older compiler has intent to support these features and
32  define these macros by default. */
33 
34 
35 
36 /* wchar_t uses Unicode 10.0.0. Version 10.0 of the Unicode Standard is
37  synchronized with ISO/IEC 10646:2017, fifth edition, plus
38  the following additions from Amendment 1 to the fifth edition:
39  - 56 emoji characters
40  - 285 hentaigana
41  - 3 additional Zanabazar Square characters */
42 
43 C this file is created by hand from taumain.F
44 C actions: Remove routines: TAUDEM DECTES TAUFIL FILHEP
45 C add: INIETC will not necesarily work fine ...
46 C replace TRALO4
47 C rename INIPHY to INIPHX
48 
49  SUBROUTINE INIETC(jakk1,jakk2,itd,ifpho)
50  COMMON / IDFC / IDFF
51  COMMON / TAURAD / XK0DEC,ITDKRC
52  DOUBLE PRECISION XK0DEC
53  COMMON / JAKI / JAK1,JAK2,JAKP,JAKM,KTOM
54  COMMON /PHOACT/ IFPHOT
55  SAVE
56 C KTO=1 will denote tau+, thus :: IDFF=-15
57  IDFF=-15
58 C XK0 for tau decays.
59  XK0DEC=0.01
60 C radiative correction switch in tau --> e (mu) decays !
61  ITDKRC=itd
62 C switches of tau+ tau- decay modes !!
63  JAK1=jakk1
64  JAK2=jakk2
65 C photos activation switch
66  IFPHOT=IFPHO
67  end
68 
69  SUBROUTINE TRALO4(KTOS,PHOI,PHOF,AM)
70 !! Corrected 11.10.96 (ZW) tralor for KORALW.
71 !! better treatment is to cascade from tau rest-frame through W
72 !! restframe down to LAB.
73  COMMON / MOMDEC / Q1,Q2,P1,P2,P3,P4
74  COMMON /TRALID/ idtra
75  double precision Q1(4),Q2(4),P1(4),P2(4),P3(4),P4(4),P1QQ(4),P2QQ(4)
76  double precision PIN(4),POUT(4),PBST(4),PBS1(4),QQ(4),PI
77  double precision THET,PHI,EXE
78  REAL*4 PHOI(4),PHOF(4)
79  SAVE
80  DATA PI /3.141592653589793238462643D0/
81  AM=SQRT(ABS
82  $ (PHOI(4)**2-PHOI(3)**2-PHOI(2)**2-PHOI(1)**2))
83  idtra=KTOS
84  DO K=1,4
85  PIN(K)=PHOI(K)
86  PHOF(K)=PHOI(K)
87  ENDDO
88 ! write(*,*) idtra
89 .EQ. IF (idtra1) THEN
90  DO K=1,4
91  PBST(K)=P1(K)
92  QQ(K)=Q1(K)
93  ENDDO
94 .EQ. ELSEIF(idtra2) THEN
95  DO K=1,4
96  PBST(K)=P2(K)
97  QQ(K)=Q1(K)
98  ENDDO
99 .EQ. ELSEIF(idtra3) THEN
100  DO K=1,4
101  PBST(K)=P3(K)
102  QQ(K)=Q2(K)
103  ENDDO
104  ELSE
105  DO K=1,4
106  PBST(K)=P4(K)
107  QQ(K)=Q2(K)
108  ENDDO
109  ENDIF
110 
111 
112 
113  CALL BOSTDQ(1,QQ,PBST,PBST)
114  CALL BOSTDQ(1,QQ,P1,P1QQ)
115  CALL BOSTDQ(1,QQ,P2,P2QQ)
116  PBS1(4)=PBST(4)
117  PBS1(3)=SQRT(PBST(3)**2+PBST(2)**2+PBST(1)**2)
118  PBS1(2)=0D0
119  PBS1(1)=0D0
120  EXE=(PBS1(4)+PBS1(3))/DSQRT(PBS1(4)**2-PBS1(3)**2)
121 C for KTOS=1 boost is antiparallel to 4-momentum of P2.
122 C restframes of tau+ tau- and 'first' frame of 'higgs' are all connected
123 C by boosts along z axis
124 .EQ. IF(KTOS1) EXE=(PBS1(4)-PBS1(3))/DSQRT(PBS1(4)**2-PBS1(3)**2)
125  CALL BOSTD3(EXE,PIN,POUT)
126 
127 C once in Z/gamma/Higgs rest frame we control further kinematics by P2QQ for KTOS=1,2
128  THET=ACOS(P2QQ(3)/SQRT(P2QQ(3)**2+P2QQ(2)**2+P2QQ(1)**2))
129  PHI=0D0
130  PHI=ACOS(P2QQ(1)/SQRT(P2QQ(2)**2+P2QQ(1)**2))
131 .LT. IF(P2QQ(2)0D0) PHI=2*PI-PHI
132 
133  CALL ROTPOX(THET,PHI,POUT)
134  CALL BOSTDQ(-1,QQ,POUT,POUT)
135  DO K=1,4
136  PHOF(K)=POUT(K)
137  ENDDO
138  END
139 
140 
141  SUBROUTINE CHOICE(MNUM,RR,ICHAN,PROB1,PROB2,PROB3,
142  $ AMRX,GAMRX,AMRA,GAMRA,AMRB,GAMRB)
143  COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
144  * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
145  * ,AMK,AMKZ,AMKST,GAMKST
146 C
147  REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
148  * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
149  * ,AMK,AMKZ,AMKST,GAMKST
150 C
151  AMROP=1.1
152  GAMROP=0.36
153  AMOM=.782
154  GAMOM=0.0084
155 C XXXXA CORRESPOND TO S2 CHANNEL !
156 .EQ. IF(MNUM0) THEN
157  PROB1=0.5
158  PROB2=0.5
159  AMRX =AMA1
160  GAMRX=GAMA1
161  AMRA =AMRO
162  GAMRA=GAMRO
163  AMRB =AMRO
164  GAMRB=GAMRO
165 .EQ. ELSEIF(MNUM1) THEN
166  PROB1=0.5
167  PROB2=0.5
168  AMRX =1.57
169  GAMRX=0.9
170  AMRB =AMKST
171  GAMRB=GAMKST
172  AMRA =AMRO
173  GAMRA=GAMRO
174 .EQ. ELSEIF(MNUM2) THEN
175  PROB1=0.5
176  PROB2=0.5
177  AMRX =1.57
178  GAMRX=0.9
179  AMRB =AMKST
180  GAMRB=GAMKST
181  AMRA =AMRO
182  GAMRA=GAMRO
183 .EQ. ELSEIF(MNUM3) THEN
184  PROB1=0.5
185  PROB2=0.5
186  AMRX =1.27
187  GAMRX=0.3
188  AMRA =AMKST
189  GAMRA=GAMKST
190  AMRB =AMKST
191  GAMRB=GAMKST
192 .EQ. ELSEIF(MNUM4) THEN
193  PROB1=0.5
194  PROB2=0.5
195  AMRX =1.27
196  GAMRX=0.3
197  AMRA =AMKST
198  GAMRA=GAMKST
199  AMRB =AMKST
200  GAMRB=GAMKST
201 .EQ. ELSEIF(MNUM5) THEN
202  PROB1=0.5
203  PROB2=0.5
204  AMRX =1.27
205  GAMRX=0.3
206  AMRA =AMKST
207  GAMRA=GAMKST
208  AMRB =AMRO
209  GAMRB=GAMRO
210 .EQ. ELSEIF(MNUM6) THEN
211  PROB1=0.4
212  PROB2=0.4
213  AMRX =1.27
214  GAMRX=0.3
215  AMRA =AMRO
216  GAMRA=GAMRO
217  AMRB =AMKST
218  GAMRB=GAMKST
219 .EQ. ELSEIF(MNUM7) THEN
220  PROB1=0.0
221  PROB2=1.0
222  AMRX =1.27
223  GAMRX=0.9
224  AMRA =AMRO
225  GAMRA=GAMRO
226  AMRB =AMRO
227  GAMRB=GAMRO
228 .EQ. ELSEIF(MNUM8) THEN
229  PROB1=0.0
230  PROB2=1.0
231  AMRX =AMROP
232  GAMRX=GAMROP
233  AMRB =AMOM
234  GAMRB=GAMOM
235  AMRA =AMRO
236  GAMRA=GAMRO
237 .EQ. ELSEIF(MNUM101) THEN
238  PROB1=.35
239  PROB2=.35
240  AMRX =1.2
241  GAMRX=.46
242  AMRB =AMOM
243  GAMRB=GAMOM
244  AMRA =AMOM
245  GAMRA=GAMOM
246 .EQ. ELSEIF(MNUM102) THEN
247  PROB1=0.0
248  PROB2=0.0
249  AMRX =1.4
250  GAMRX=.6
251  AMRB =AMOM
252  GAMRB=GAMOM
253  AMRA =AMOM
254  GAMRA=GAMOM
255  ELSE
256  PROB1=0.0
257  PROB2=0.0
258  AMRX =AMA1
259  GAMRX=GAMA1
260  AMRA =AMRO
261  GAMRA=GAMRO
262  AMRB =AMRO
263  GAMRB=GAMRO
264  ENDIF
265 C
266 .LE. IF (RRPROB1) THEN
267  ICHAN=1
268 .LE. ELSEIF(RR(PROB1+PROB2)) THEN
269  ICHAN=2
270  AX =AMRA
271  GX =GAMRA
272  AMRA =AMRB
273  GAMRA=GAMRB
274  AMRB =AX
275  GAMRB=GX
276  PX =PROB1
277  PROB1=PROB2
278  PROB2=PX
279  ELSE
280  ICHAN=3
281  ENDIF
282 C
283  PROB3=1.0-PROB1-PROB2
284  END
285  SUBROUTINE INITDK
286 * ----------------------------------------------------------------------
287 * INITIALISATION OF TAU DECAY PARAMETERS and routines
288 *
289 * called by : KORALZ
290 * ----------------------------------------------------------------------
291 
292  COMMON / DECPAR / GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
293  REAL*4 GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
294  COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
295  * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
296  * ,AMK,AMKZ,AMKST,GAMKST
297 *
298  REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
299  * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
300  * ,AMK,AMKZ,AMKST,GAMKST
301  COMMON / TAUBRA / GAMPRT(30),JLIST(30),NCHAN
302  COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS
303  REAL*4 BRA1,BRK0,BRK0B,BRKS
304  PARAMETER (NMODE=15,NM1=0,NM2=1,NM3=8,NM4=2,NM5=1,NM6=3)
305  COMMON / TAUDCD /IDFFIN(9,NMODE),MULPIK(NMODE)
306  & ,NAMES
307  CHARACTER NAMES(NMODE)*31
308  CHARACTER OLDNAMES(7)*31
309  CHARACTER*80 bxINIT
310  PARAMETER (
311  $ bxINIT ='(1x,1h*,g17.8, 16x, a31,a4,a4, 1x,1h*)'
312  $ )
313  REAL*4 PI,POL1(4)
314 *
315 *
316 * LIST OF BRANCHING RATIOS
317 CAM normalised to e nu nutau channel
318 CAM enu munu pinu rhonu A1nu Knu K*nu pi
319 CAM DATA JLIST / 1, 2, 3, 4, 5, 6, 7,
320 *AM DATA GAMPRT /1.000,0.9730,0.6054,1.2432,0.8432,0.0432,O.O811,0.616
321 *AM
322 *AM multipion decays
323 *
324 * conventions of particles names
325 * K-,P-,K+, K0,P-,KB, K-,P0,K0
326 * 3, 1,-3 , 4, 1,-4 , 3, 2, 4 ,
327 * P0,P0,K-, K-,P-,P+, P-,KB,P0
328 * 2, 2, 3 , 3, 1,-1 , 1,-4, 2 ,
329 * ET,P-,P0 P-,P0,GM
330 * 9, 1, 2 , 1, 2, 8
331 *
332 C
333  DIMENSION NOPIK(6,NMODE),NPIK(NMODE)
334 *AM outgoing multiplicity and flavors of multi-pion /multi-K modes
335  DATA NPIK / 4, 4,
336  1 5, 5,
337  2 6, 6,
338  3 3, 3,
339  4 3, 3,
340  5 3, 3,
341  6 3, 3,
342  7 2 /
343  DATA NOPIK / -1,-1, 1, 2, 0, 0, 2, 2, 2,-1, 0, 0,
344  1 -1,-1, 1, 2, 2, 0, -1,-1,-1, 1, 1, 0,
345  2 -1,-1,-1, 1, 1, 2, -1,-1, 1, 2, 2, 2,
346  3 -3,-1, 3, 0, 0, 0, -4,-1, 4, 0, 0, 0,
347  4 -3, 2,-4, 0, 0, 0, 2, 2,-3, 0, 0, 0,
348  5 -3,-1, 1, 0, 0, 0, -1, 4, 2, 0, 0, 0,
349  6 9,-1, 2, 0, 0, 0, -1, 2, 8, 0, 0, 0,
350 C AJWMOD fix sign bug, 2/22/99
351  7 -3,-4, 0, 0, 0, 0 /
352 * LIST OF BRANCHING RATIOS
353  NCHAN = NMODE + 7
354  DO 1 I = 1,30
355 .LE. IF (INCHAN) THEN
356  JLIST(I) = I
357 .EQ. IF(I 1) GAMPRT(I) =0.1800
358 .EQ. IF(I 2) GAMPRT(I) =0.1751
359 .EQ. IF(I 3) GAMPRT(I) =0.1110
360 .EQ. IF(I 4) GAMPRT(I) =0.2515
361 .EQ. IF(I 5) GAMPRT(I) =0.1790
362 .EQ. IF(I 6) GAMPRT(I) =0.0071
363 .EQ. IF(I 7) GAMPRT(I) =0.0134
364 .EQ. IF(I 8) GAMPRT(I) =0.0450
365 .EQ. IF(I 9) GAMPRT(I) =0.0100
366 .EQ. IF(I10) GAMPRT(I) =0.0009
367 .EQ. IF(I11) GAMPRT(I) =0.0004
368 .EQ. IF(I12) GAMPRT(I) =0.0003
369 .EQ. IF(I13) GAMPRT(I) =0.0005
370 .EQ. IF(I14) GAMPRT(I) =0.0015
371 .EQ. IF(I15) GAMPRT(I) =0.0015
372 .EQ. IF(I16) GAMPRT(I) =0.0015
373 .EQ. IF(I17) GAMPRT(I) =0.0005
374 .EQ. IF(I18) GAMPRT(I) =0.0050
375 .EQ. IF(I19) GAMPRT(I) =0.0055
376 .EQ. IF(I20) GAMPRT(I) =0.0017
377 .EQ. IF(I21) GAMPRT(I) =0.0013
378 .EQ. IF(I22) GAMPRT(I) =0.0010
379 .EQ. IF(I 1) OLDNAMES(I)=' tau- --> e- '
380 .EQ. IF(I 2) OLDNAMES(I)=' tau- --> mu- '
381 .EQ. IF(I 3) OLDNAMES(I)=' tau- --> pi- '
382 .EQ. IF(I 4) OLDNAMES(I)=' tau- --> pi-, pi0 '
383 .EQ. IF(I 5) OLDNAMES(I)=' tau- --> a1- (two subch) '
384 .EQ. IF(I 6) OLDNAMES(I)=' tau- --> k- '
385 .EQ. IF(I 7) OLDNAMES(I)=' tau- --> k*- (two subch) '
386 .EQ. IF(I 8) NAMES(I-7)=' tau- --> 2pi-, pi0, pi+ '
387 .EQ. IF(I 9) NAMES(I-7)=' tau- --> 3pi0, pi- '
388 .EQ. IF(I10) NAMES(I-7)=' tau- --> 2pi-, pi+, 2pi0 '
389 .EQ. IF(I11) NAMES(I-7)=' tau- --> 3pi-, 2pi+, '
390 .EQ. IF(I12) NAMES(I-7)=' tau- --> 3pi-, 2pi+, pi0 '
391 .EQ. IF(I13) NAMES(I-7)=' tau- --> 2pi-, pi+, 3pi0 '
392 .EQ. IF(I14) NAMES(I-7)=' tau- --> k-, pi-, k+ '
393 .EQ. IF(I15) NAMES(I-7)=' tau- --> k0, pi-, k0b '
394 .EQ. IF(I16) NAMES(I-7)=' tau- --> k-, k0, pi0 '
395 .EQ. IF(I17) NAMES(I-7)=' tau- --> pi0 pi0 k- '
396 .EQ. IF(I18) NAMES(I-7)=' tau- --> k- pi- pi+ '
397 .EQ. IF(I19) NAMES(I-7)=' tau- --> pi- k0b pi0 '
398 .EQ. IF(I20) NAMES(I-7)=' tau- --> eta pi- pi0 '
399 .EQ. IF(I21) NAMES(I-7)=' tau- --> pi- pi0 gam '
400 .EQ. IF(I22) NAMES(I-7)=' tau- --> k- k0 '
401  ELSE
402  JLIST(I) = 0
403  GAMPRT(I) = 0.
404  ENDIF
405  1 CONTINUE
406  DO I=1,NMODE
407  MULPIK(I)=NPIK(I)
408  DO J=1,MULPIK(I)
409  IDFFIN(J,I)=NOPIK(J,I)
410  ENDDO
411  ENDDO
412 *
413 *
414 * --- COEFFICIENTS TO FIX RATIO OF:
415 * --- A1 3CHARGED/ A1 1CHARGED 2 NEUTRALS MATRIX ELEMENTS (MASLESS LIM.)
416 * --- PROBABILITY OF K0 TO BE KS
417 * --- PROBABILITY OF K0B TO BE KS
418 * --- RATIO OF COEFFICIENTS FOR K*--> K0 PI-
419 * --- ALL COEFFICENTS SHOULD BE IN THE RANGE (0.0,1.0)
420 * --- THEY MEANING IS PROBABILITY OF THE FIRST CHOICE ONLY IF ONE
421 * --- NEGLECTS MASS-PHASE SPACE EFFECTS
422  BRA1=0.5
423  BRK0=0.5
424  BRK0B=0.5
425  BRKS=0.6667
426 *
427 
428  GFERMI = 1.16637E-5
429  CCABIB = 0.975
430  GV = 1.0
431  GA =-1.0
432 
433 
434 
435 * ZW 13.04.89 HERE WAS AN ERROR
436  SCABIB = SQRT(1.-CCABIB**2)
437  PI =4.*ATAN(1.)
438  GAMEL = GFERMI**2*AMTAU**5/(192*PI**3)
439 *
440  CALL DEXAY(-1,POL1)
441 *
442  RETURN
443  END
444  FUNCTION DCDMAS(IDENT)
445  COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
446  * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
447  * ,AMK,AMKZ,AMKST,GAMKST
448 *
449  REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
450  * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
451  * ,AMK,AMKZ,AMKST,GAMKST
452 .EQ. IF (IDENT 1) THEN
453  APKMAS=AMPI
454 .EQ. ELSEIF (IDENT-1) THEN
455  APKMAS=AMPI
456 .EQ. ELSEIF (IDENT 2) THEN
457  APKMAS=AMPIZ
458 .EQ. ELSEIF (IDENT-2) THEN
459  APKMAS=AMPIZ
460 .EQ. ELSEIF (IDENT 3) THEN
461  APKMAS=AMK
462 .EQ. ELSEIF (IDENT-3) THEN
463  APKMAS=AMK
464 .EQ. ELSEIF (IDENT 4) THEN
465  APKMAS=AMKZ
466 .EQ. ELSEIF (IDENT-4) THEN
467  APKMAS=AMKZ
468 .EQ. ELSEIF (IDENT 8) THEN
469  APKMAS=0.0001
470 .EQ. ELSEIF (IDENT-8) THEN
471  APKMAS=0.0001
472 .EQ. ELSEIF (IDENT 9) THEN
473  APKMAS=0.5488
474 .EQ. ELSEIF (IDENT-9) THEN
475  APKMAS=0.5488
476  ELSE
477  PRINT *, 'stop in apkmas, wrong ident=',IDENT
478  STOP
479  ENDIF
480  DCDMAS=APKMAS
481  END
482  FUNCTION LUNPIK(ID,ISGN)
483  COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS
484  REAL*4 BRA1,BRK0,BRK0B,BRKS
485  REAL*4 XIO(1)
486  IDENT=ID*ISGN
487 .EQ. IF (IDENT 1) THEN
488  IPKDEF=-211
489 .EQ. ELSEIF (IDENT-1) THEN
490  IPKDEF= 211
491 .EQ. ELSEIF (IDENT 2) THEN
492  IPKDEF=111
493 .EQ. ELSEIF (IDENT-2) THEN
494  IPKDEF=111
495 .EQ. ELSEIF (IDENT 3) THEN
496  IPKDEF=-321
497 .EQ. ELSEIF (IDENT-3) THEN
498  IPKDEF= 321
499 .EQ. ELSEIF (IDENT 4) THEN
500 *
501 * K0 --> K0_LONG (IS 130) / K0_SHORT (IS 310) = 1/1
502  CALL RANMAR(XIO,1)
503 .GT. IF (XIO(1)BRK0) THEN
504  IPKDEF= 130
505  ELSE
506  IPKDEF= 310
507  ENDIF
508 .EQ. ELSEIF (IDENT-4) THEN
509 *
510 * K0B--> K0_LONG (IS 130) / K0_SHORT (IS 310) = 1/1
511  CALL RANMAR(XIO,1)
512 .GT. IF (XIO(1)BRK0B) THEN
513  IPKDEF= 130
514  ELSE
515  IPKDEF= 310
516  ENDIF
517 .EQ. ELSEIF (IDENT 8) THEN
518  IPKDEF= 22
519 .EQ. ELSEIF (IDENT-8) THEN
520  IPKDEF= 22
521 .EQ. ELSEIF (IDENT 9) THEN
522  IPKDEF= 221
523 .EQ. ELSEIF (IDENT-9) THEN
524  IPKDEF= 221
525  ELSE
526  PRINT *, 'stop in ipkdef, wrong ident=',IDENT
527  STOP
528  ENDIF
529  LUNPIK=IPKDEF
530  END
531 
532 
533 
534  SUBROUTINE TAURDF(KTO)
535 C THIS ROUTINE CAN BE CALLED BEFORE ANY TAU+ OR TAU- EVENT IS GENERATED
536 C IT CAN BE USED TO GENERATE TAU+ AND TAU- SAMPLES OF DIFFERENT
537 C CONTENTS
538  COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS
539  REAL*4 BRA1,BRK0,BRK0B,BRKS
540  COMMON / TAUBRA / GAMPRT(30),JLIST(30),NCHAN
541 .EQ. IF (KTO1) THEN
542 C ==================
543 C AJWMOD: Set the BRs for (A1+ -> rho+ pi0) and (K*+ -> K0 pi+)
544  BRA1 = PKORB(4,1)
545  BRKS = PKORB(4,3)
546  BRK0 = PKORB(4,5)
547  BRK0B = PKORB(4,6)
548  ELSE
549 C ====
550 C AJWMOD: Set the BRs for (A1+ -> rho+ pi0) and (K*+ -> K0 pi+)
551  BRA1 = PKORB(4,2)
552  BRKS = PKORB(4,4)
553  BRK0 = PKORB(4,5)
554  BRK0B = PKORB(4,6)
555  ENDIF
556 C =====
557  END
558 
559  SUBROUTINE INIPHX(XK00)
560 * ----------------------------------------------------------------------
561 * INITIALISATION OF PARAMETERS
562 * USED IN QED and/or GSW ROUTINES
563 * ----------------------------------------------------------------------
564  COMMON / QEDPRM /ALFINV,ALFPI,XK0
565  REAL*8 ALFINV,ALFPI,XK0
566  REAL*8 PI8,XK00
567 *
568  PI8 = 4.D0*DATAN(1.D0)
569  ALFINV = 137.03604D0
570  ALFPI = 1D0/(ALFINV*PI8)
571  XK0=XK00
572  END
573 
574  SUBROUTINE INIMAS
575 C ----------------------------------------------------------------------
576 C INITIALISATION OF MASSES
577 C
578 C called by : KORALZ
579 C ----------------------------------------------------------------------
580  COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
581  * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
582  * ,AMK,AMKZ,AMKST,GAMKST
583 *
584  REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
585  * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
586  * ,AMK,AMKZ,AMKST,GAMKST
587 C
588 C IN-COMING / OUT-GOING FERMION MASSES
589  AMTAU = 1.7842
590 C --- tau mass must be the same as in the host program, what-so-ever
591  AMTAU = 1.777
592  AMNUTA = 0.010
593  AMEL = 0.0005111
594  AMNUE = 0.0
595  AMMU = 0.105659
596  AMNUMU = 0.0
597 *
598 * MASSES USED IN TAU DECAYS
599  AMPIZ = 0.134964
600  AMPI = 0.139568
601  AMRO = 0.773
602  GAMRO = 0.145
603 *C GAMRO = 0.666
604  AMA1 = 1.251
605  GAMA1 = 0.599
606  AMK = 0.493667
607  AMKZ = 0.49772
608  AMKST = 0.8921
609  GAMKST = 0.0513
610 C
611 C
612 C IN-COMING / OUT-GOING FERMION MASSES
613 !! AMNUTA = PKORB(1,2)
614 !! AMNUE = PKORB(1,4)
615 !! AMNUMU = PKORB(1,6)
616 C
617 C MASSES USED IN TAU DECAYS Cleo settings
618 !! AMPIZ = PKORB(1,7)
619 !! AMPI = PKORB(1,8)
620 !! AMRO = PKORB(1,9)
621 !! GAMRO = PKORB(2,9)
622  AMA1 = 1.275 !! PKORB(1,10)
623  GAMA1 = 0.615 !! PKORB(2,10)
624 !! AMK = PKORB(1,11)
625 !! AMKZ = PKORB(1,12)
626 !! AMKST = PKORB(1,13)
627 !! GAMKST = PKORB(2,13)
628 C
629 
630  RETURN
631  END
632  subroutine bostdq(idir,vv,pp,q)
633 * *******************************
634 c Boost along arbitrary vector v (see eg. J.D. Jacson, Classical
635 c Electrodynamics).
636 c Four-vector pp is boosted from an actual frame to the rest frame
637 c of the four-vector v (for idir=1) or back (for idir=-1).
638 c q is a resulting four-vector.
639 c Note: v must be time-like, pp may be arbitrary.
640 c
641 c Written by: Wieslaw Placzek date: 22.07.1994
642 c Last update: 3/29/95 by: M.S.
643 c
644  implicit DOUBLE PRECISION (a-h,o-z)
645  parameter (nout=6)
646  DOUBLE PRECISION v(4),p(4),q(4),pp(4),vv(4)
647  save
648 !
649  do 1 i=1,4
650  v(i)=vv(i)
651  1 p(i)=pp(i)
652  amv=(v(4)**2-v(1)**2-v(2)**2-v(3)**2)
653 .le. if (amv0d0) then
654  write(6,*) 'bosstv: warning amv**2=',amv
655  endif
656  amv=sqrt(abs(amv))
657 .eq. if (idir-1) then
658  q(4)=( p(1)*v(1)+p(2)*v(2)+p(3)*v(3)+p(4)*v(4))/amv
659  wsp =(q(4)+p(4))/(v(4)+amv)
660 .eq. elseif (idir1) then
661  q(4)=(-p(1)*v(1)-p(2)*v(2)-p(3)*v(3)+p(4)*v(4))/amv
662  wsp =-(q(4)+p(4))/(v(4)+amv)
663  else
664  write(nout,*)' >>> boostv: wrong value of idir = ',idir
665  endif
666  q(1)=p(1)+wsp*v(1)
667  q(2)=p(2)+wsp*v(2)
668  q(3)=p(3)+wsp*v(3)
669  end
670 
671 
672 
673 
674 
675 
676 
677 
678