C++ Interface to Tauola
tauola/demo-jetset/tauola_photos_ini.f
1/* copyright(c) 1991-2023 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
43C this file is created by hand from taumain.F
44C actions: Remove routines: TAUDEM DECTES TAUFIL FILHEP
45C add: INIETC will not necesarily work fine ...
46C replace TRALO4
47C 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
56C KTO=1 will denote tau+, thus :: IDFF=-15
57 IDFF=-15
58C XK0 for tau decays.
59 XK0DEC=0.01
60C radiative correction switch in tau --> e (mu) decays !
61 ITDKRC=itd
62C switches of tau+ tau- decay modes !!
63 JAK1=jakk1
64 JAK2=jakk2
65C 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)
121C for KTOS=1 boost is antiparallel to 4-momentum of P2.
122C restframes of tau+ tau- and 'first' frame of 'higgs' are all connected
123C 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
127C 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
146C
147 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
148 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
149 * ,AMK,AMKZ,AMKST,GAMKST
150C
151 AMROP=1.1
152 GAMROP=0.36
153 AMOM=.782
154 GAMOM=0.0084
155C 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
265C
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
282C
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
317CAM normalised to e nu nutau channel
318CAM enu munu pinu rhonu A1nu Knu K*nu pi
319CAM 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*
332C
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,
350C 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)
535C THIS ROUTINE CAN BE CALLED BEFORE ANY TAU+ OR TAU- EVENT IS GENERATED
536C IT CAN BE USED TO GENERATE TAU+ AND TAU- SAMPLES OF DIFFERENT
537C 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
542C ==================
543C 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
549C ====
550C 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
556C =====
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
575C ----------------------------------------------------------------------
576C INITIALISATION OF MASSES
577C
578C called by : KORALZ
579C ----------------------------------------------------------------------
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
587C
588C IN-COMING / OUT-GOING FERMION MASSES
589 AMTAU = 1.7842
590C --- 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
610C
611C
612C IN-COMING / OUT-GOING FERMION MASSES
613!! AMNUTA = PKORB(1,2)
614!! AMNUE = PKORB(1,4)
615!! AMNUMU = PKORB(1,6)
616C
617C 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)
628C
629
630 RETURN
631 END
632 subroutine bostdq(idir,vv,pp,q)
633* *******************************
634c Boost along arbitrary vector v (see eg. J.D. Jacson, Classical
635c Electrodynamics).
636c Four-vector pp is boosted from an actual frame to the rest frame
637c of the four-vector v (for idir=1) or back (for idir=-1).
638c q is a resulting four-vector.
639c Note: v must be time-like, pp may be arbitrary.
640c
641c Written by: Wieslaw Placzek date: 22.07.1994
642c Last update: 3/29/95 by: M.S.
643c
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