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 *///////////////////////////////////////////////////////////////////////////////////// 45 *// !!!!!!! WARNING!!!!! This source is agressive !!!! // 47 *// Due to short common block names it owerwrites variables in other parts // 50 *// One should add suffix c_Taul_ to names of all commons as soon as possible!!!! // 52 *///////////////////////////////////////////////////////////////////////////////////// 54 *///////////////////////////////////////////////////////////////////////////////////// 56 *// Standard Tauola interface/initialization routines of functionality exactly // 57 *// as in Tauola CPC but input is partially from xpar(*) matrix // 58 *// ITAUXPAR is for indirect adressing // 60 *///////////////////////////////////////////////////////////////////////////////////// 63 SUBROUTINE INIETC(ITAUXPAR,xpar) 68 $ INUT, ! Input unit number (not used) 69 $ IOUT ! Ounput unit number 71 COMMON / TAURAD / XK0DEC,ITDKRC 72 DOUBLE PRECISION XK0DEC 73 COMMON / JAKI / JAK1,JAK2,JAKP,JAKM,KTOM 74 * Note: I dont see KeyA1=2,3 realy implemented in the code SJ. ?????? 77 $ KeyA1 ! Special switch for tests of dGamma/dQ**2 in a1 decay 78 * KeyA1=1 constant width of a1 and rho 79 * KeyA1=2 free choice of rho propagator (defined in function FPIK) 80 * and free choice of a1 mass and width. function g(Q**2) 81 * (see formula 3.48 in Comp. Phys. Comm. 64 (1991) 275) 82 * hard coded both in Monte Carlo and in testing distribution. 83 * KeyA1=3 function g(Q**2) hardcoded in the Monte Carlo 84 * (it is timy to calculate!), but appropriately adjusted in testing distribution. 86 idff = xpar(ITAUXPAR+3) ! Lund identifier for first tau (15 for tau-) 88 xk0dec = xpar(ITAUXPAR+5) ! IR-cut for QED rad. in leptonic decays 89 C radiative correction switch in tau --> e (mu) decays ! 90 itdkRC = xpar(ITAUXPAR+4) ! QED rad. in leptonic decays 91 C switches of tau+ tau- decay modes !! 92 Jak1 = xpar(ITAUXPAR+1) ! Decay Mask for first tau 93 Jak2 = xpar(ITAUXPAR+2) ! Decay Mask for second tau 94 C output file number for TAUOLA 96 C KeyA1 is used for formfactors actually not in use 97 KeyA1 = xpar(ITAUXPAR+6) ! Type of a1 current 100 WRITE(iout,bxtxt) ' parameters passed from kk to tauola:
' 101 WRITE(iout,bxl1i) Jak1, 'dec.
type 1-st tau
','jak1
','t01
' 102 WRITE(iout,bxl1i) Jak2, 'dec.
type 2-nd tau
','jak2
','t02
' 103 WRITE(iout,bxl1i) KeyA1, 'current
type a1 dec.
','keya1
','t03
' 104 WRITE(iout,bxl1i) idff, 'pdg id 1-st tau
','idff
','t04
' 105 WRITE(iout,bxl1i) itdkRC, 'r.c. switch lept dec
','itdkrc
','t05
' 106 WRITE(iout,bxl1g) xk0dec, 'ir-cut for lept r.c.
','xk0dec
','t06
' 111 SUBROUTINE INITDK(ITAUXPAR,xpar) 112 * ---------------------------------------------------------------------- 113 * INITIALISATION OF TAU DECAY PARAMETERS and routines 116 * ---------------------------------------------------------------------- 120 $ INUT, ! Input unit number (not used) 121 $ IOUT ! Ounput unit number 124 COMMON / DECPAR / GFERMI,GV,GA,CCABIB,SCABIB,GAMEL 125 REAL*4 GFERMI,GV,GA,CCABIB,SCABIB,GAMEL 126 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU 127 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 128 * ,AMK,AMKZ,AMKST,GAMKST 130 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU 131 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 132 * ,AMK,AMKZ,AMKST,GAMKST 133 COMMON / TAUBRA / GAMPRT(30),JLIST(30),NCHAN 134 COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS 135 REAL*4 BRA1,BRK0,BRK0B,BRKS 136 PARAMETER (NMODE=15,NM1=0,NM2=1,NM3=8,NM4=2,NM5=1,NM6=3) 137 COMMON / TAUDCD /IDFFIN(9,NMODE),MULPIK(NMODE) 139 CHARACTER NAMES(NMODE)*31 140 CHARACTER OLDNAMES(7)*31 143 $ bxINIT ='(1x,1h*,g17.8, 16x, a31,a4,a4, 1x,1h*)
' 148 * LIST OF BRANCHING RATIOS 149 CAM normalised to e nu nutau channel 150 CAM enu munu pinu rhonu A1nu Knu K*nu pi 151 CAM DATA JLIST / 1, 2, 3, 4, 5, 6, 7, 152 *AM DATA GAMPRT /1.000,0.9730,0.6054,1.2432,0.8432,0.0432,O.O811,0.616 156 * conventions of particles names 157 * K-,P-,K+, K0,P-,KB, K-,P0,K0 158 * 3, 1,-3 , 4, 1,-4 , 3, 2, 4 , 159 * P0,P0,K-, K-,P-,P+, P-,KB,P0 160 * 2, 2, 3 , 3, 1,-1 , 1,-4, 2 , 165 DIMENSION NOPIK(6,NMODE),NPIK(NMODE) 166 *AM outgoing multiplicity and flavors of multi-pion /multi-K modes 175 DATA NOPIK / -1,-1, 1, 2, 0, 0, 2, 2, 2,-1, 0, 0, 176 1 -1,-1, 1, 2, 2, 0, -1,-1,-1, 1, 1, 0, 177 2 -1,-1,-1, 1, 1, 2, -1,-1, 1, 2, 2, 2, 178 3 -3,-1, 3, 0, 0, 0, -4,-1, 4, 0, 0, 0, 179 4 -3, 2,-4, 0, 0, 0, 2, 2,-3, 0, 0, 0, 180 5 -3,-1, 1, 0, 0, 0, -1, 4, 2, 0, 0, 0, 181 6 9,-1, 2, 0, 0, 0, -1, 2, 8, 0, 0, 0, 182 C AJWMOD fix sign bug, 2/22/99 183 7 -3,-4, 0, 0, 0, 0 / 184 * LIST OF BRANCHING RATIOS 187 .LE.
IF (INCHAN) THEN 189 .EQ.
IF(I 1) GAMPRT(I) =0.1800 190 .EQ.
IF(I 2) GAMPRT(I) =0.1751 191 .EQ.
IF(I 3) GAMPRT(I) =0.1110 192 .EQ.
IF(I 4) GAMPRT(I) =0.2515 193 .EQ.
IF(I 5) GAMPRT(I) =0.1790 194 .EQ.
IF(I 6) GAMPRT(I) =0.0071 195 .EQ.
IF(I 7) GAMPRT(I) =0.0134 196 .EQ.
IF(I 8) GAMPRT(I) =0.0450 197 .EQ.
IF(I 9) GAMPRT(I) =0.0100 198 .EQ.
IF(I10) GAMPRT(I) =0.0009 199 .EQ.
IF(I11) GAMPRT(I) =0.0004 200 .EQ.
IF(I12) GAMPRT(I) =0.0003 201 .EQ.
IF(I13) GAMPRT(I) =0.0005 202 .EQ.
IF(I14) GAMPRT(I) =0.0015 203 .EQ.
IF(I15) GAMPRT(I) =0.0015 204 .EQ.
IF(I16) GAMPRT(I) =0.0015 205 .EQ.
IF(I17) GAMPRT(I) =0.0005 206 .EQ.
IF(I18) GAMPRT(I) =0.0050 207 .EQ.
IF(I19) GAMPRT(I) =0.0055 208 .EQ.
IF(I20) GAMPRT(I) =0.0017 209 .EQ.
IF(I21) GAMPRT(I) =0.0013 210 .EQ.
IF(I22) GAMPRT(I) =0.0010 211 .EQ.
IF(I 1) OLDNAMES(I)=' tau- --> e-
' 212 .EQ.
IF(I 2) OLDNAMES(I)=' tau- --> mu-
' 213 .EQ.
IF(I 3) OLDNAMES(I)=' tau- --> pi-
' 214 .EQ.
IF(I 4) OLDNAMES(I)=' tau- --> pi-, pi0
' 215 .EQ.
IF(I 5) OLDNAMES(I)=' tau- --> a1- (two subch)
' 216 .EQ.
IF(I 6) OLDNAMES(I)=' tau- --> k-
' 217 .EQ.
IF(I 7) OLDNAMES(I)=' tau- --> k*- (two subch)
' 218 .EQ.
IF(I 8) NAMES(I-7)=' tau- --> 2pi-, pi0, pi+
' 219 .EQ.
IF(I 9) NAMES(I-7)=' tau- --> 3pi0, pi-
' 220 .EQ.
IF(I10) NAMES(I-7)=' tau- --> 2pi-, pi+, 2pi0
' 221 .EQ.
IF(I11) NAMES(I-7)=' tau- --> 3pi-, 2pi+,
' 222 .EQ.
IF(I12) NAMES(I-7)=' tau- --> 3pi-, 2pi+, pi0
' 223 .EQ.
IF(I13) NAMES(I-7)=' tau- --> 2pi-, pi+, 3pi0
' 224 .EQ.
IF(I14) NAMES(I-7)=' tau- --> k-, pi-, k+
' 225 .EQ.
IF(I15) NAMES(I-7)=' tau- --> k0, pi-, k0b
' 226 .EQ.
IF(I16) NAMES(I-7)=' tau- --> k-, k0, pi0
' 227 .EQ.
IF(I17) NAMES(I-7)=' tau- --> pi0 pi0 k-
' 228 .EQ.
IF(I18) NAMES(I-7)=' tau- --> k- pi- pi+
' 229 .EQ.
IF(I19) NAMES(I-7)=' tau- --> pi- k0b pi0
' 230 .EQ.
IF(I20) NAMES(I-7)=' tau- --> eta pi- pi0
' 231 .EQ.
IF(I21) NAMES(I-7)=' tau- --> pi- pi0 gam
' 232 .EQ.
IF(I22) NAMES(I-7)=' tau- --> k- k0
' 241 IDFFIN(J,I)=NOPIK(J,I) 246 * --- COEFFICIENTS TO FIX RATIO OF: 247 * --- A1 3CHARGED/ A1 1CHARGED 2 NEUTRALS MATRIX ELEMENTS (MASLESS LIM.) 248 * --- PROBABILITY OF K0 TO BE KS 249 * --- PROBABILITY OF K0B TO BE KS 250 * --- RATIO OF COEFFICIENTS FOR K*--> K0 PI- 251 * --- ALL COEFFICENTS SHOULD BE IN THE RANGE (0.0,1.0) 252 * --- THEY MEANING IS PROBABILITY OF THE FIRST CHOICE ONLY IF ONE 253 * --- NEGLECTS MASS-PHASE SPACE EFFECTS 268 .GT.
IF (XPAR(ITAUXPAR+100+1)-1D0) THEN 269 C initialization form KK 270 CCABIB = XPAR(ITAUXPAR+7) 271 GV = XPAR(ITAUXPAR+8) 272 GA = XPAR(ITAUXPAR+9) 274 BRA1 = XPAR(ITAUXPAR+10) 275 BRKS = XPAR(ITAUXPAR+11) 276 BRK0 = XPAR(ITAUXPAR+12) 277 BRK0B = XPAR(ITAUXPAR+13) 279 GAMPRT(K)=XPAR(ITAUXPAR+100+K) 282 * ZW 13.04.89 HERE WAS AN ERROR 283 SCABIB = SQRT(1.-CCABIB**2) 285 GAMEL = GFERMI**2*AMTAU**5/(192*PI**3) 287 * CALL DEXAY(-1,pol1) 289 * PRINTOUTS FOR KK version 298 WRITE(iout,bxtxt) ' tauola initialization
SUBROUTINE initdk:
' 299 WRITE(iout,bxtxt) ' adopted to read from kk
' 300 WRITE(iout,bxtxt) ' ' 301 WRITE(iout,bxtxt) ' choice probability -- decay channel
' 303 WRITE(iout,bxINIT) GAMPRT(K)/SUM, OLDNAMES(K),'****
','***
' 306 WRITE(iout,bxINIT) GAMPRT(K)/SUM, NAMES(K-7),'****
','***
' 308 WRITE(iout,bxtxt) ' in addition:
' 309 WRITE(iout,bxINIT) GV, 'vector w-tau-nu coupl.
','****
','***
' 310 WRITE(iout,bxINIT) GA, 'axial w-tau-nu coupl.
','****
','***
' 311 WRITE(iout,bxINIT) GFERMI,'fermi coupling
','****
','***
' 312 WRITE(iout,bxINIT) CCABIB,'cabibo angle
','****
','***
' 313 WRITE(iout,bxINIT) BRA1, 'a1 br ratio (massless)
','****
','***
' 314 WRITE(iout,bxINIT) BRKS, 'k* br ratio (massless)
','****
','***
' 320 SUBROUTINE INIPHY(XK00) 321 * ---------------------------------------------------------------------- 322 * INITIALISATION OF PARAMETERS 323 * USED IN QED and/or GSW ROUTINES 324 * ---------------------------------------------------------------------- 325 COMMON / QEDPRM /ALFINV,ALFPI,XK0 326 REAL*8 ALFINV,ALFPI,XK0 329 PI8 = 4.D0*DATAN(1.D0) 331 ALFPI = 1D0/(ALFINV*PI8) 335 SUBROUTINE INIMAS(ITAUXPAR,xpar) 336 * ---------------------------------------------------------------------- 337 * INITIALISATION OF MASSES 340 * ---------------------------------------------------------------------- 344 $ INUT, ! Input unit number (not used) 345 $ IOUT ! Ounput unit number 347 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU 348 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 349 * ,AMK,AMKZ,AMKST,GAMKST 351 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU 352 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 353 * ,AMK,AMKZ,AMKST,GAMKST 356 $ bxINIT ='(1x,1h*,g17.8, 16x, a31,a4,a4, 1x,1h*)
' 359 * IN-COMING / OUT-GOING FERMION MASSES 367 * MASSES USED IN TAU DECAYS 381 C IN-COMING / OUT-GOING FERMION MASSES 382 !! AMNUTA = PKORB(1,2) 383 !! AMNUE = PKORB(1,4) 384 !! AMNUMU = PKORB(1,6) 386 C MASSES USED IN TAU DECAYS Cleo settings 387 !! AMPIZ = PKORB(1,7) 390 !! GAMRO = PKORB(2,9) 391 AMA1 = 1.275 !! PKORB(1,10) 392 GAMA1 = 0.615 !! PKORB(2,10) 394 !! AMKZ = PKORB(1,12) 395 !! AMKST = PKORB(1,13) 396 !! GAMKST = PKORB(2,13) 400 WRITE(iout,bxtxt) ' tauola initialization subroutine inimas:
' 401 WRITE(iout,bxtxt) ' adopted to read from kk
' 402 WRITE(iout,bxINIT) amtau, 'amtau tau-mass
','****
','***
' 403 WRITE(iout,bxINIT) amel , 'amel electron-mass
','****
','***
' 404 WRITE(iout,bxINIT) ammu , 'ammu muon-mass
','****
','***
' 408 SUBROUTINE CHOICE(MNUM,RR,ICHAN,PROB1,PROB2,PROB3, 409 $ AMRX,GAMRX,AMRA,GAMRA,AMRB,GAMRB) 410 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU 411 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 412 * ,AMK,AMKZ,AMKST,GAMKST 414 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU 415 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 416 * ,AMK,AMKZ,AMKST,GAMKST 422 C XXXXA CORRESPOND TO S2 CHANNEL ! 432 .EQ.
ELSEIF(MNUM1) THEN 441 .EQ.
ELSEIF(MNUM2) THEN 450 .EQ.
ELSEIF(MNUM3) THEN 459 .EQ.
ELSEIF(MNUM4) THEN 468 .EQ.
ELSEIF(MNUM5) THEN 477 .EQ.
ELSEIF(MNUM6) THEN 486 .EQ.
ELSEIF(MNUM7) THEN 495 .EQ.
ELSEIF(MNUM8) THEN 504 .EQ.
ELSEIF(MNUM101) THEN 513 .EQ.
ELSEIF(MNUM102) THEN 533 .LE.
IF (RRPROB1) THEN 535 .LE.
ELSEIF(RR(PROB1+PROB2)) THEN 550 PROB3=1.0-PROB1-PROB2 552 FUNCTION DCDMAS(IDENT) 553 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU 554 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 555 * ,AMK,AMKZ,AMKST,GAMKST 557 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU 558 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 559 * ,AMK,AMKZ,AMKST,GAMKST 560 .EQ.
IF (IDENT 1) THEN 562 .EQ.
ELSEIF (IDENT-1) THEN 564 .EQ.
ELSEIF (IDENT 2) THEN 566 .EQ.
ELSEIF (IDENT-2) THEN 568 .EQ.
ELSEIF (IDENT 3) THEN 570 .EQ.
ELSEIF (IDENT-3) THEN 572 .EQ.
ELSEIF (IDENT 4) THEN 574 .EQ.
ELSEIF (IDENT-4) THEN 576 .EQ.
ELSEIF (IDENT 8) THEN 578 .EQ.
ELSEIF (IDENT-8) THEN 580 .EQ.
ELSEIF (IDENT 9) THEN 582 .EQ.
ELSEIF (IDENT-9) THEN 585 PRINT *, 'stop in apkmas, wrong ident=
',IDENT 590 FUNCTION LUNPIK(ID,ISGN) 591 COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS 592 REAL*4 BRA1,BRK0,BRK0B,BRKS 595 .EQ.
IF (IDENT 1) THEN 597 .EQ.
ELSEIF (IDENT-1) THEN 599 .EQ.
ELSEIF (IDENT 2) THEN 601 .EQ.
ELSEIF (IDENT-2) THEN 603 .EQ.
ELSEIF (IDENT 3) THEN 605 .EQ.
ELSEIF (IDENT-3) THEN 607 .EQ.
ELSEIF (IDENT 4) THEN 609 * K0 --> K0_LONG (IS 130) / K0_SHORT (IS 310) = 1/1 611 .GT.
IF (XIO(1)BRK0) THEN 616 .EQ.
ELSEIF (IDENT-4) THEN 618 * K0B--> K0_LONG (IS 130) / K0_SHORT (IS 310) = 1/1 620 .GT.
IF (XIO(1)BRK0B) THEN 625 .EQ.
ELSEIF (IDENT 8) THEN 627 .EQ.
ELSEIF (IDENT-8) THEN 629 .EQ.
ELSEIF (IDENT 9) THEN 631 .EQ.
ELSEIF (IDENT-9) THEN 634 PRINT *, 'stop in ipkdef, wrong ident=
',IDENT 642 SUBROUTINE TAURDF(KTO) 643 C THIS ROUTINE CAN BE CALLED BEFORE ANY TAU+ OR TAU- EVENT IS GENERATED 644 C IT CAN BE USED TO GENERATE TAU+ AND TAU- SAMPLES OF DIFFERENT 646 COMMON / TAUKLE / BRA1,BRK0,BRK0B,BRKS 647 REAL*4 BRA1,BRK0,BRK0B,BRKS 648 COMMON / TAUBRA / GAMPRT(30),JLIST(30),NCHAN 651 C AJWMOD: Set the BRs for (A1+ -> rho+ pi0) and (K*+ -> K0 pi+) 658 C AJWMOD: Set the BRs for (A1+ -> rho+ pi0) and (K*+ -> K0 pi+)