1 /* copyright(c) 1991-2018 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 <http://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 */ 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 ... 47 C 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 56 C KTO=1 will denote tau+, thus :: IDFF=-15 60 C radiative correction switch in tau --> e (mu) decays ! 62 C switches of tau+ tau- decay modes !! 65 C 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) 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) 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)) 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 155 C 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 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 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, 350 C AJWMOD fix sign bug, 2/22/99 351 7 -3,-4, 0, 0, 0, 0 / 352 * LIST OF BRANCHING RATIOS 355 .LE.
IF (INCHAN) THEN 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) 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 538 COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS 539 REAL*4 BRA1,BRK0,BRK0B,BRKS 540 COMMON / TAUBRA / GAMPRT(30),JLIST(30),NCHAN 543 C AJWMOD: Set the BRs for (A1+ -> rho+ pi0) and (K*+ -> K0 pi+) 550 C 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) 575 C ---------------------------------------------------------------------- 576 C INITIALISATION OF MASSES 579 C ---------------------------------------------------------------------- 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 588 C IN-COMING / OUT-GOING FERMION MASSES 590 C --- tau mass must be the same as in the host program, what-so-ever 598 * MASSES USED IN TAU DECAYS 612 C IN-COMING / OUT-GOING FERMION MASSES 613 !! AMNUTA = PKORB(1,2) 614 !! AMNUE = PKORB(1,4) 615 !! AMNUMU = PKORB(1,6) 617 C MASSES USED IN TAU DECAYS Cleo settings 618 !! AMPIZ = PKORB(1,7) 621 !! GAMRO = PKORB(2,9) 622 AMA1 = 1.275 !! PKORB(1,10) 623 GAMA1 = 0.615 !! PKORB(2,10) 625 !! AMKZ = PKORB(1,12) 626 !! AMKST = PKORB(1,13) 627 !! GAMKST = PKORB(2,13) 632 subroutine bostdq(idir,vv,pp,q) 633 * ******************************* 634 c Boost along arbitrary vector v (see eg. J.D. Jacson, Classical 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. 641 c Written by: Wieslaw Placzek date: 22.07.1994 642 c 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) 653 .le.
if (amv0d0) then 654 write(6,*) 'bosstv: warning amv**2=
',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) 664 write(nout,*)' >>> boostv: wrong
value of idir =
',idir