1/* copyright(c) 1991-2023 free software foundation, inc.
2 this file is part of the gnu c library.
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.
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.
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/>. */
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. */
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. */
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:
41 - 3 additional Zanabazar Square characters */
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 ...
47C rename INIPHY to INIPHX
49 SUBROUTINE INIETC(jakk1,jakk2,itd,ifpho)
51 COMMON / TAURAD / XK0DEC,ITDKRC
52 DOUBLE PRECISION XK0DEC
53 COMMON / JAKI / JAK1,JAK2,JAKP,JAKM,KTOM
54 COMMON /PHOACT/ IFPHOT
56C KTO=1 will denote tau+, thus :: IDFF=-15
60C radiative correction switch in tau --> e (mu) decays !
62C switches of tau+ tau- decay modes !!
65C photos activation switch
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
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)
80 DATA PI /3.141592653589793238462643D0/
82 $ (PHOI(4)**2-PHOI(3)**2-PHOI(2)**2-PHOI(1)**2))
94.EQ.
ELSEIF(idtra2) THEN
99.EQ.
ELSEIF(idtra3) THEN
113 CALL BOSTDQ(1,QQ,PBST,PBST)
114 CALL BOSTDQ(1,QQ,P1,P1QQ)
115 CALL BOSTDQ(1,QQ,P2,P2QQ)
117 PBS1(3)=SQRT(PBST(3)**2+PBST(2)**2+PBST(1)**2)
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)
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))
130 PHI=ACOS(P2QQ(1)/SQRT(P2QQ(2)**2+P2QQ(1)**2))
131.LT.
IF(P2QQ(2)0D0) PHI=2*PI-PHI
133 CALL ROTPOX(THET,PHI,POUT)
134 CALL BOSTDQ(-1,QQ,POUT,POUT)
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
147 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
148 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
149 * ,AMK,AMKZ,AMKST,GAMKST
155C XXXXA CORRESPOND TO S2 CHANNEL !
165.EQ.
ELSEIF(MNUM1) THEN
174.EQ.
ELSEIF(MNUM2) THEN
183.EQ.
ELSEIF(MNUM3) THEN
192.EQ.
ELSEIF(MNUM4) THEN
201.EQ.
ELSEIF(MNUM5) THEN
210.EQ.
ELSEIF(MNUM6) THEN
219.EQ.
ELSEIF(MNUM7) THEN
228.EQ.
ELSEIF(MNUM8) THEN
237.EQ.
ELSEIF(MNUM101) THEN
246.EQ.
ELSEIF(MNUM102) THEN
266.LE.
IF (RRPROB1) THEN
268.LE.
ELSEIF(RR(PROB1+PROB2)) THEN
283 PROB3=1.0-PROB1-PROB2
286* ----------------------------------------------------------------------
287* INITIALISATION OF TAU DECAY PARAMETERS and routines
290* ----------------------------------------------------------------------
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
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)
307 CHARACTER NAMES(NMODE)*31
308 CHARACTER OLDNAMES(7)*31
311 $ bxINIT ='(1x,1h*,g17.8, 16x, a31,a4,a4, 1x,1h*)
'
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
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 ,
333 DIMENSION NOPIK(6,NMODE),NPIK(NMODE)
334*AM outgoing multiplicity and flavors of multi-pion /multi-K modes
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
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
'
409 IDFFIN(J,I)=NOPIK(J,I)
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
435* ZW 13.04.89 HERE WAS AN ERROR
436 SCABIB = SQRT(1.-CCABIB**2)
438 GAMEL = GFERMI**2*AMTAU**5/(192*PI**3)
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
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
454.EQ.
ELSEIF (IDENT-1) THEN
456.EQ.
ELSEIF (IDENT 2) THEN
458.EQ.
ELSEIF (IDENT-2) THEN
460.EQ.
ELSEIF (IDENT 3) THEN
462.EQ.
ELSEIF (IDENT-3) THEN
464.EQ.
ELSEIF (IDENT 4) THEN
466.EQ.
ELSEIF (IDENT-4) THEN
468.EQ.
ELSEIF (IDENT 8) THEN
470.EQ.
ELSEIF (IDENT-8) THEN
472.EQ.
ELSEIF (IDENT 9) THEN
474.EQ.
ELSEIF (IDENT-9) THEN
477 PRINT *, 'stop in apkmas, wrong ident=
',IDENT
482 FUNCTION LUNPIK(ID,ISGN)
483 COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS
484 REAL*4 BRA1,BRK0,BRK0B,BRKS
487.EQ.
IF (IDENT 1) THEN
489.EQ.
ELSEIF (IDENT-1) THEN
491.EQ.
ELSEIF (IDENT 2) THEN
493.EQ.
ELSEIF (IDENT-2) THEN
495.EQ.
ELSEIF (IDENT 3) THEN
497.EQ.
ELSEIF (IDENT-3) THEN
499.EQ.
ELSEIF (IDENT 4) THEN
501* K0 --> K0_LONG (IS 130) / K0_SHORT (IS 310) = 1/1
503.GT.
IF (XIO(1)BRK0) THEN
508.EQ.
ELSEIF (IDENT-4) THEN
510* K0B--> K0_LONG (IS 130) / K0_SHORT (IS 310) = 1/1
512.GT.
IF (XIO(1)BRK0B) THEN
517.EQ.
ELSEIF (IDENT 8) THEN
519.EQ.
ELSEIF (IDENT-8) THEN
521.EQ.
ELSEIF (IDENT 9) THEN
523.EQ.
ELSEIF (IDENT-9) THEN
526 PRINT *, 'stop in ipkdef, wrong ident=
',IDENT
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
538 COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS
539 REAL*4 BRA1,BRK0,BRK0B,BRKS
540 COMMON / TAUBRA / GAMPRT(30),JLIST(30),NCHAN
543C AJWMOD: Set the BRs for (A1+ -> rho+ pi0) and (K*+ -> K0 pi+)
550C AJWMOD: Set the BRs for (A1+ -> rho+ pi0) and (K*+ -> K0 pi+)
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
568 PI8 = 4.D0*DATAN(1.D0)
570 ALFPI = 1D0/(ALFINV*PI8)
575C ----------------------------------------------------------------------
576C INITIALISATION OF MASSES
579C ----------------------------------------------------------------------
580 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
581 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
582 * ,AMK,AMKZ,AMKST,GAMKST
584 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
585 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
586 * ,AMK,AMKZ,AMKST,GAMKST
588C IN-COMING / OUT-GOING FERMION MASSES
590C --- tau mass must be the same as in the host program, what-so-ever
598* MASSES USED IN TAU DECAYS
612C IN-COMING / OUT-GOING FERMION MASSES
613!! AMNUTA = PKORB(1,2)
615!! AMNUMU = PKORB(1,6)
617C MASSES USED IN TAU DECAYS Cleo settings
622 AMA1 = 1.275 !! PKORB(1,10)
623 GAMA1 = 0.615 !! PKORB(2,10)
626!! AMKST = PKORB(1,13)
627!! GAMKST = PKORB(2,13)
632 subroutine bostdq(idir,vv,pp,q)
633* *******************************
634c Boost along arbitrary vector v (see eg. J.D. Jacson, Classical
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.
641c Written by: Wieslaw Placzek date: 22.07.1994
642c Last update: 3/29/95 by: M.S.
644 implicit DOUBLE PRECISION (a-h,o-z)
646 DOUBLE PRECISION v(4),p(4),q(4),pp(4),vv(4)
652 amv=(v(4)**2-v(1)**2-v(2)**2-v(3)**2)
654 write(6,*) 'bosstv: warning amv**2=
',amv
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)
664 write(nout,*)' >>> boostv: wrong
value of idir =
',idir