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 *AJW 1 version of a1 form factor 44 COMPLEX FUNCTION F3PI(IFORM,QQ,SA,SB) 45 C....................................................................... 47 C. F3PI - 1 version of a1 form factor, used in TAUOLA 56 C. Called : by FORM1-FORM3 in $C_CVSSRC/korb/koralb/formf.F 57 C. Author : Alan Weinstein 2/98 59 C. Detailed description 60 C. First determine whether we are doing pi-2pi0 or 3pi. 61 C. Then implement full form-factor from fit: 62 C. [(rho-pi S-wave) + (rho-prim-pi S-wave) + 63 C. (rho-pi D-wave) + (rho-prim-pi D-wave) + 64 C. (f2 pi D-wave) + (sigmapi S-wave) + (f0pi S-wave)] 65 C. based on fit to pi-2pi0 by M. Schmidler, CBX 97-64-Update (4/22/98) 66 C. All the parameters in this routine are hard-coded!! 68 C....................................................................... 69 * -------------------- Argument declarations --------------- 73 * -------------------- EXTERNAL declarations --------------- 77 * -------------------- SEQUENCE declarations --------------- 79 * -------------------- Local declarations --------------- 82 PARAMETER( CRNAME = 'f3pi
' ) 85 REAL MRO,GRO,MRP,GRP,MF2,GF2,MF0,GF0,MSG,GSG 86 REAL M1,M2,M3,M1SQ,M2SQ,M3SQ,MPIZ,MPIC 88 REAL F134,F150,F15A,F15B,F167 89 REAL F34A,F34B,F35,F35A,F35B,F36A,F36B 90 COMPLEX BT1,BT2,BT3,BT4,BT5,BT6,BT7 91 COMPLEX FRO1,FRO2,FRP1,FRP2 92 COMPLEX FF21,FF22,FF23,FSG1,FSG2,FSG3,FF01,FF02,FF03 95 * -------------------- SAVE declarations --------------- 97 * -------------------- DATA initializations --------------- 100 * ----------------- Executable code starts here ------------ 102 C. Hard-code the fit parameters: 103 .EQ.
IF (IFIRST0) THEN 105 C rho, rhoprime, f2(1275), f0(1186), sigma(made up!) 119 C Fit coefficients for each of the contributions: 122 BT2 = CMPLX(0.12,0.)*CEXP(CMPLX(0., 0.99*PI)) 123 BT3 = CMPLX(0.37,0.)*CEXP(CMPLX(0.,-0.15*PI)) 124 BT4 = CMPLX(0.87,0.)*CEXP(CMPLX(0., 0.53*PI)) 125 BT5 = CMPLX(0.71,0.)*CEXP(CMPLX(0., 0.56*PI)) 126 BT6 = CMPLX(2.10,0.)*CEXP(CMPLX(0., 0.23*PI)) 127 BT7 = CMPLX(0.77,0.)*CEXP(CMPLX(0.,-0.54*PI)) 129 PRINT *,' in f3pi: add(rho-pi s-wave) + (rhop-pi s-wave) +
' 130 PRINT *,' (rho-pi d-wave) + (rhop-pi d-wave) +
' 131 PRINT *,' (f2 pi d-wave) + (sigmapi s-wave) + (f0pi s-wave)
' 137 C. First determine whether we are doing pi-2pi0 or 3pi. 138 C PKORB is set up to remember what flavor of 3pi it gave to KORALB, 139 C since KORALB doesnt bother to remember!! 158 C. Then implement full form-factor from fit: 159 C. [(rho-pi S-wave) + (rho-prim-pi S-wave) + 160 C. (rho-pi D-wave) + (rho-prim-pi D-wave) + 161 C. (f2 pi D-wave) + (sigmapi S-wave) + (f0pi S-wave)] 162 C. based on fit to pi-2pi0 by M. Schmidler, CBX 97-64-Update (4/22/98) 164 C Note that for FORM1, the arguments are S1, S2; 165 C for FORM2, the arguments are S2, S1; 166 C for FORM3, the arguments are S3, S1. 167 C Here, we implement FORM1 and FORM2 at the same time, 168 C so the above switch is just what we need! 170 .EQ..OR..EQ.
IF (IFORM1IFORM2) THEN 173 S3 = QQ-SA-SB+M1SQ+M2SQ+M3SQ 174 .LE..OR..LE.
IF (S30.S20.) RETURN 178 C Lorentz invariants for all the contributions: 179 F134 = -(1./3.)*((S3-M3SQ)-(S1-M1SQ)) 180 F150 = (1./18.)*(QQ-M3SQ+S3)*(2.*M1SQ+2.*M2SQ-S3)/S3 183 C Breit Wigners for all the contributions: 184 FRO1 = BWIGML(S1,MRO,GRO,M2,M3,1) 185 FRP1 = BWIGML(S1,MRP,GRP,M2,M3,1) 186 FRO2 = BWIGML(S2,MRO,GRO,M3,M1,1) 187 FRP2 = BWIGML(S2,MRP,GRP,M3,M1,1) 188 FF23 = BWIGML(S3,MF2,GF2,M1,M2,2) 189 FSG3 = BWIGML(S3,MSG,GSG,M1,M2,0) 190 FF03 = BWIGML(S3,MF0,GF0,M1,M2,0) 192 F3PI = BT1*FRO1+BT2*FRP1+ 193 1 BT3*CMPLX(F134,0.)*FRO2+BT4*CMPLX(F134,0.)*FRP2+ 194 1 BT5*CMPLX(F150,0.)*FF23+ 195 1 BT6*CMPLX(F167,0.)*FSG3+BT7*CMPLX(F167,0.)*FF03 197 C F3PI = FPIKM(SQRT(S1),M2,M3) 198 .EQ.
ELSEIF (IDK2) THEN 200 C Lorentz invariants for all the contributions: 201 F134 = -(1./3.)*((S3-M3SQ)-(S1-M1SQ)) 202 F15A = -(1./2.)*((S2-M2SQ)-(S3-M3SQ)) 203 F15B = -(1./18.)*(QQ-M2SQ+S2)*(2.*M1SQ+2.*M3SQ-S2)/S2 206 C Breit Wigners for all the contributions: 207 FRO1 = BWIGML(S1,MRO,GRO,M2,M3,1) 208 FRP1 = BWIGML(S1,MRP,GRP,M2,M3,1) 209 FRO2 = BWIGML(S2,MRO,GRO,M3,M1,1) 210 FRP2 = BWIGML(S2,MRP,GRP,M3,M1,1) 211 FF21 = BWIGML(S1,MF2,GF2,M2,M3,2) 212 FF22 = BWIGML(S2,MF2,GF2,M3,M1,2) 213 FSG2 = BWIGML(S2,MSG,GSG,M3,M1,0) 214 FF02 = BWIGML(S2,MF0,GF0,M3,M1,0) 216 F3PI = BT1*FRO1+BT2*FRP1+ 217 1 BT3*CMPLX(F134,0.)*FRO2+BT4*CMPLX(F134,0.)*FRP2 218 1 -BT5*CMPLX(F15A,0.)*FF21-BT5*CMPLX(F15B,0.)*FF22 219 1 -BT6*CMPLX(F167,0.)*FSG2-BT7*CMPLX(F167,0.)*FF02 221 C F3PI = FPIKM(SQRT(S1),M2,M3) 224 .EQ.
ELSE IF (IFORM3) THEN 227 S2 = QQ-SA-SB+M1SQ+M2SQ+M3SQ 228 .LE..OR..LE.
IF (S10.S20.) RETURN 232 C Lorentz invariants for all the contributions: 233 F34A = (1./3.)*((S2-M2SQ)-(S3-M3SQ)) 234 F34B = (1./3.)*((S3-M3SQ)-(S1-M1SQ)) 235 F35 =-(1./2.)*((S1-M1SQ)-(S2-M2SQ)) 237 C Breit Wigners for all the contributions: 238 FRO1 = BWIGML(S1,MRO,GRO,M2,M3,1) 239 FRP1 = BWIGML(S1,MRP,GRP,M2,M3,1) 240 FRO2 = BWIGML(S2,MRO,GRO,M3,M1,1) 241 FRP2 = BWIGML(S2,MRP,GRP,M3,M1,1) 242 FF23 = BWIGML(S3,MF2,GF2,M1,M2,2) 245 1 BT3*(CMPLX(F34A,0.)*FRO1+CMPLX(F34B,0.)*FRO2)+ 246 1 BT4*(CMPLX(F34A,0.)*FRP1+CMPLX(F34B,0.)*FRP2)+ 247 1 BT5*CMPLX(F35,0.)*FF23 249 C F3PI = CMPLX(0.,0.) 250 .EQ.
ELSEIF (IDK2) THEN 252 C Lorentz invariants for all the contributions: 253 F34A = (1./3.)*((S2-M2SQ)-(S3-M3SQ)) 254 F34B = (1./3.)*((S3-M3SQ)-(S1-M1SQ)) 255 F35A = -(1./18.)*(QQ-M1SQ+S1)*(2.*M2SQ+2.*M3SQ-S1)/S1 256 F35B = (1./18.)*(QQ-M2SQ+S2)*(2.*M3SQ+2.*M1SQ-S2)/S2 260 C Breit Wigners for all the contributions: 261 FRO1 = BWIGML(S1,MRO,GRO,M2,M3,1) 262 FRP1 = BWIGML(S1,MRP,GRP,M2,M3,1) 263 FRO2 = BWIGML(S2,MRO,GRO,M3,M1,1) 264 FRP2 = BWIGML(S2,MRP,GRP,M3,M1,1) 265 FF21 = BWIGML(S1,MF2,GF2,M2,M3,2) 266 FF22 = BWIGML(S2,MF2,GF2,M3,M1,2) 267 FSG1 = BWIGML(S1,MSG,GSG,M2,M3,0) 268 FSG2 = BWIGML(S2,MSG,GSG,M3,M1,0) 269 FF01 = BWIGML(S1,MF0,GF0,M2,M3,0) 270 FF02 = BWIGML(S2,MF0,GF0,M3,M1,0) 273 1 BT3*(CMPLX(F34A,0.)*FRO1+CMPLX(F34B,0.)*FRO2)+ 274 1 BT4*(CMPLX(F34A,0.)*FRP1+CMPLX(F34B,0.)*FRP2) 275 1 -BT5*(CMPLX(F35A,0.)*FF21+CMPLX(F35B,0.)*FF22) 276 1 -BT6*(CMPLX(F36A,0.)*FSG1+CMPLX(F36B,0.)*FSG2) 277 1 -BT7*(CMPLX(F36A,0.)*FF01+CMPLX(F36B,0.)*FF02) 279 C F3PI = CMPLX(0.,0.) 283 C Add overall a1/a1prime: 289 C ********************************************************** 290 COMPLEX FUNCTION BWIGML(S,M,G,M1,M2,L) 291 C ********************************************************** 292 C L-WAVE BREIT-WIGNER 293 C ********************************************************** 296 REAL MSQ,W,WGS,MP,MM,QS,QM 303 .GT.
IF (W(M1+M2)) THEN 304 QS=SQRT(ABS((S -MP)*(S -MM)))/W 305 QM=SQRT(ABS((MSQ -MP)*(MSQ -MM)))/M 307 WGS=G*(MSQ/W)*(QS/QM)**IPOW 310 BWIGML=CMPLX(MSQ,0.)/CMPLX(MSQ-S,-WGS) 314 C======================================================================= 315 COMPLEX FUNCTION FA1A1P(XMSQ) 316 C ================================================================== 317 C complex form-factor for a1+a1prime. AJW 1/98 318 C ================================================================== 322 REAL XM1,XG1,XM2,XG2,XM1SQ,XM2SQ,GG1,GG2,GF,FG1,FG2 326 .EQ.
IF (IFIRST0) THEN 329 C The user may choose masses and widths that differ from nominal: 334 BET = CMPLX(PKORB(3,17),0.) 335 C scale factors relative to nominal: 336 GG1 = XM1*XG1/(1.3281*0.806) 337 GG2 = XM2*XG2/(1.3281*0.806) 346 F1 = CMPLX(-XM1SQ,0.0)/CMPLX(XMSQ-XM1SQ,FG1) 347 F2 = CMPLX(-XM2SQ,0.0)/CMPLX(XMSQ-XM2SQ,FG2) 352 C======================================================================= 355 C mass-dependent M*Gamma of a1 through its decays to 356 C. [(rho-pi S-wave) + (rho-pi D-wave) + 357 C. (f2 pi D-wave) + (f0pi S-wave)] 358 C. AND simple K*K S-wave 361 DOUBLE PRECISION MKST,MK,MK1SQ,MK2SQ,C3PI,CKST 362 DOUBLE PRECISION S,WGA1C,WGA1N,WG3PIC,WG3PIN,GKST 364 C----------------------------------------------------------------------- 366 .NE.
IF (IFIRST987) THEN 369 C Contribution to M*Gamma(m(3pi)^2) from S-wave K*K: 374 C coupling constants squared: 376 CKST = 4.7621D0**2*C3PI 379 C----------------------------------------------------------------------- 380 C Parameterization of numerical integral of total width of a1 to 3pi. 381 C From M. Schmidtler, CBX-97-64-Update. 386 C Contribution to M*Gamma(m(3pi)^2) from S-wave K*K, if above threshold 388 .GT.
IF (SMK1SQ) GKST = SQRT((S-MK1SQ)*(S-MK2SQ))/(2.*S) 390 WGA1 = SNGL(C3PI*(WG3PIC+WG3PIN)+CKST*GKST) 394 C======================================================================= 395 DOUBLE PRECISION FUNCTION WGA1C(S) 397 C parameterization of m*Gamma(m^2) for pi-2pi0 system 399 DOUBLE PRECISION S,STH,Q0,Q1,Q2,P0,P1,P2,P3,P4,G1_IM 401 PARAMETER(Q0 = 5.80900D0,Q1 = -3.00980D0,Q2 = 4.57920D0, 402 1 P0 = -13.91400D0,P1 = 27.67900D0,P2 = -13.39300D0, 403 2 P3 = 3.19240D0,P4 = -0.10487D0) 405 PARAMETER (STH = 0.1753D0) 406 C--------------------------------------------------------------------- 410 .GT..AND..LT.
ELSEIF((SSTH)(S0.823D0)) THEN 411 G1_IM = Q0*(S-STH)**3*(1. + Q1*(S-STH) + Q2*(S-STH)**2) 413 G1_IM = P0 + P1*S + P2*S**2+ P3*S**3 + P4*S**4 419 C======================================================================= 420 DOUBLE PRECISION FUNCTION WGA1N(S) 422 C parameterization of m*Gamma(m^2) for pi-pi+pi- system 424 DOUBLE PRECISION S,STH,Q0,Q1,Q2,P0,P1,P2,P3,P4,G1_IM 426 PARAMETER(Q0 = 6.28450D0,Q1 = -2.95950D0,Q2 = 4.33550D0, 427 1 P0 = -15.41100D0,P1 = 32.08800D0,P2 = -17.66600D0, 428 2 P3 = 4.93550D0,P4 = -0.37498D0) 430 PARAMETER (STH = 0.1676D0) 431 C--------------------------------------------------------------------- 435 .GT..AND..LT.
ELSEIF((SSTH)(S0.823D0)) THEN 436 G1_IM = Q0*(S-STH)**3*(1. + Q1*(S-STH) + Q2*(S-STH)**2) 438 G1_IM = P0 + P1*S + P2*S**2+ P3*S**3 + P4*S**4