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 FUNCTION FORMOM(XMAA,XMOM) 44 C ================================================================== 45 C formfactorfor pi-pi0 gamma final state 46 C R. Decker, Z. Phys C36 (1987) 487. 47 C ================================================================== 48 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU 49 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 50 * ,AMK,AMKZ,AMKST,GAMKST 52 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU 53 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 54 * ,AMK,AMKZ,AMKST,GAMKST 55 COMMON / DECPAR / GFERMI,GV,GA,CCABIB,SCABIB,GAMEL 56 REAL*4 GFERMI,GV,GA,CCABIB,SCABIB,GAMEL 60 * THIS INLINE FUNCT. CALCULATES THE SCALAR PART OF THE PROPAGATOR 61 BWIGN(XM,AM,GAMMA)=1./CMPLX(XM**2-AM**2,GAMMA*AM) 72 FQED =SQRT(4.0*3.1415926535/137.03604) 73 FORMOM=FQED*FRO**2/SQRT(2.0)*GCOUP**2*BWIGN(XMOM,AMOM,GAMOM) 74 $ *(BWIGN(XMAA,AMRO,GAMRO)+ELPHA*BWIGN(XMAA,AMROP,GAMROP)) 75 $ *(BWIGN( 0.0,AMRO,GAMRO)+ELPHA*BWIGN( 0.0,AMROP,GAMROP)) 77 C======================================================================= 78 COMPLEX FUNCTION FK1AB(XMSQ,INDX) 79 C ================================================================== 80 C complex form-factor for a1+a1prime. AJW 1/98 81 C ================================================================== 83 COMPLEX F1,F2,AMPA,AMPB 87 .EQ.
IF (IFIRST0) THEN 103 AMPA = CMPLX(PKORB(3,81),0.) 104 AMPB = CMPLX(PKORB(3,82),0.) 105 .EQ.
ELSE IF (INDX2) THEN 106 AMPA = CMPLX(PKORB(3,83),0.) 107 AMPB = CMPLX(PKORB(3,84),0.) 108 .EQ.
ELSEIF (INDX3) THEN 109 AMPA = CMPLX(PKORB(3,85),0.) 110 AMPB = CMPLX(PKORB(3,86),0.) 111 .EQ.
ELSEIF (INDX4) THEN 112 AMPA = CMPLX(PKORB(3,87),0.) 113 AMPB = CMPLX(PKORB(3,88),0.) 119 F1 = CMPLX(-XM1SQ,0.0)/CMPLX(XMSQ-XM1SQ,FG1) 120 F2 = CMPLX(-XM2SQ,0.0)/CMPLX(XMSQ-XM2SQ,FG2) 121 FK1AB = AMPA*F1+AMPB*F2 125 FUNCTION FORM1(MNUM,QQ,S1,SDWA) 126 C ================================================================== 127 C formfactorfor F1 for 3 scalar final state 128 C R. Fisher, J. Wess and F. Wagner Z. Phys C3 (1980) 313 129 C H. Georgi, Weak interactions and modern particle theory, 130 C The Benjamin/Cummings Pub. Co., Inc. 1984. 131 C R. Decker, E. Mirkes, R. Sauer, Z. Was Karlsruhe preprint TTP92-25 133 C ================================================================== 135 COMPLEX FORM1,WIGNER,WIGFOR,FPIKM,BWIGM 136 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU 137 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 138 * ,AMK,AMKZ,AMKST,GAMKST 140 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU 141 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 142 * ,AMK,AMKZ,AMKST,GAMKST 143 COMPLEX FORMA1,FORMK1,FORMRO,FORMKS 144 COMPLEX FA1A1P,FK1AB,F3PI 147 C ------------ 3 pi hadronic state (a1) 148 C FORMRO = FPIKM(SQRT(S1),AMPI,AMPI) 149 C FORMRO = F3PI(1,QQ,S1,SDWA) 150 C FORMA1 = FA1A1P(QQ) 151 C FORM1 = FORMA1*FORMRO 152 FORM1 = F3PI(1,QQ,S1,SDWA) 154 .EQ.
ELSEIF (MNUM1) THEN 155 C ------------ K- pi- K+ (K*0 K-) 156 FORMKS = BWIGM(S1,AMKST,GAMKST,AMPI,AMK) 158 FORM1 = FORMA1*FORMKS 160 .EQ.
ELSEIF (MNUM2) THEN 161 C ------------ K0 pi- K0B (K*- K0) 162 FORMKS = BWIGM(S1,AMKST,GAMKST,AMPI,AMK) 164 FORM1 = FORMA1*FORMKS 166 .EQ.
ELSEIF (MNUM3) THEN 167 C ------------ K- pi0 K0 (K*0 K-) 168 FORMKS = BWIGM(S1,AMKST,GAMKST,AMPI,AMK) 170 FORM1 = FORMA1*FORMKS 172 .EQ.
ELSEIF (MNUM4) THEN 173 C ------------ pi0 pi0 K- (K*-pi0) 174 FORMKS = BWIGM(S1,AMKST,GAMKST,AMPI,AMK) 176 FORM1 = FORMK1*FORMKS 178 .EQ.
ELSEIF (MNUM5) THEN 179 C ------------ K- pi- pi+ (rho0 K-) 181 FORMRO = FPIKM(SQRT(S1),AMPI,AMPI) 182 FORM1 = FORMK1*FORMRO 184 .EQ.
ELSEIF (MNUM6) THEN 185 C ------------ pi- K0B pi0 (pi- K*0B) 187 FORMKS = BWIGM(S1,AMKST,GAMKST,AMK,AMPI) 188 FORM1 = FORMK1*FORMKS 190 .EQ.
ELSEIF (MNUM7) THEN 191 C -------------- eta pi- pi0 final state 195 FUNCTION FORM2(MNUM,QQ,S1,SDWA) 196 C ================================================================== 197 C formfactorfor F2 for 3 scalar final state 198 C R. Fisher, J. Wess and F. Wagner Z. Phys C3 (1980) 313 199 C H. Georgi, Weak interactions and modern particle theory, 200 C The Benjamin/Cummings Pub. Co., Inc. 1984. 201 C R. Decker, E. Mirkes, R. Sauer, Z. Was Karlsruhe preprint TTP92-25 203 C ================================================================== 205 COMPLEX FORM2,WIGNER,WIGFOR,FPIKM,BWIGM 206 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU 207 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 208 * ,AMK,AMKZ,AMKST,GAMKST 210 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU 211 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 212 * ,AMK,AMKZ,AMKST,GAMKST 213 COMPLEX FORMA1,FORMK1,FORMRO,FORMKS 214 COMPLEX FA1A1P,FK1AB,F3PI 217 C ------------ 3 pi hadronic state (a1) 218 C FORMRO = FPIKM(SQRT(S1),AMPI,AMPI) 219 C FORMRO = F3PI(2,QQ,S1,SDWA) 220 C FORMA1 = FA1A1P(QQ) 221 C FORM2 = FORMA1*FORMRO 222 FORM2 = F3PI(2,QQ,S1,SDWA) 224 .EQ.
ELSEIF (MNUM1) THEN 225 C ------------ K- pi- K+ (rho0 pi-) 226 FORMRO = FPIKM(SQRT(S1),AMK,AMK) 228 FORM2 = FORMA1*FORMRO 230 .EQ.
ELSEIF (MNUM2) THEN 231 C ------------ K0 pi- K0B (rho0 pi-) 232 FORMRO = FPIKM(SQRT(S1),AMK,AMK) 234 FORM2 = FORMA1*FORMRO 236 .EQ.
ELSEIF (MNUM3) THEN 237 C ------------ K- pi0 K0 (rho- pi0) 238 FORMRO = FPIKM(SQRT(S1),AMK,AMK) 240 FORM2 = FORMA1*FORMRO 242 .EQ.
ELSEIF (MNUM4) THEN 243 C ------------ pi0 pi0 K- (K*-pi0) 244 FORMKS = BWIGM(S1,AMKST,GAMKST,AMPI,AMK) 246 FORM2 = FORMK1*FORMKS 248 .EQ.
ELSEIF (MNUM5) THEN 249 C ------------ K- pi- pi+ (K*0B pi-) 250 FORMKS = BWIGM(S1,AMKST,GAMKST,AMPI,AMK) 252 FORM2 = FORMK1*FORMKS 254 .EQ.
ELSEIF (MNUM6) THEN 255 C ------------ pi- K0B pi0 (rho- K0B) 256 FORMRO = FPIKM(SQRT(S1),AMPI,AMPI) 258 FORM2 = FORMK1*FORMRO 260 .EQ.
ELSEIF (MNUM7) THEN 261 C -------------- eta pi- pi0 final state 266 COMPLEX FUNCTION BWIGM(S,M,G,XM1,XM2) 267 C ********************************************************** 268 C P-WAVE BREIT-WIGNER FOR RHO 269 C ********************************************************** 273 C ------------ PARAMETERS -------------------- 277 C ------- BREIT-WIGNER ----------------------- 279 .GT.
IF (S(XM1+XM2)**2) THEN 280 QS=SQRT(ABS((S -(XM1+XM2)**2)*(S -(XM1-XM2)**2)))/SQRT(S) 281 QM=SQRT(ABS((M**2-(XM1+XM2)**2)*(M**2-(XM1-XM2)**2)))/M 283 GS=G*(M/W)**2*(QS/QM)**3 287 BWIGM=M**2/CMPLX(M**2-S,-SQRT(S)*GS) 290 COMPLEX FUNCTION FPIKM(W,XM1,XM2) 291 C ********************************************************** 293 C ********************************************************** 295 REAL ROM,ROG,ROM1,ROG1,BETA1,PI,PIM,S,W 299 C ------------ PARAMETERS -------------------- 300 .EQ.
IF (INIT0 ) THEN 310 C ----------------------------------------------- 312 FPIKM=(BWIGM(S,ROM,ROG,XM1,XM2)+BETA1*BWIGM(S,ROM1,ROG1,XM1,XM2)) 316 COMPLEX FUNCTION FPIKMD(W,XM1,XM2) 317 C ********************************************************** 319 C ********************************************************** 321 REAL ROM,ROG,ROM1,ROG1,PI,PIM,S,W 325 C ------------ PARAMETERS -------------------- 326 .EQ.
IF (INIT0 ) THEN 339 C ----------------------------------------------- 341 FPIKMD=(DELTA*BWIGM(S,ROM,ROG,XM1,XM2) 342 $ +BETA*BWIGM(S,ROM1,ROG1,XM1,XM2) 343 $ + BWIGM(S,ROM2,ROG2,XM1,XM2)) 348 FUNCTION FORM3(MNUM,QQ,S1,SDWA) 349 C ================================================================== 350 C formfactorfor F3 for 3 scalar final state 351 C R. Fisher, J. Wess and F. Wagner Z. Phys C3 (1980) 313 352 C H. Georgi, Weak interactions and modern particle theory, 353 C The Benjamin/Cummings Pub. Co., Inc. 1984. 354 C R. Decker, E. Mirkes, R. Sauer, Z. Was Karlsruhe preprint TTP92-25 356 C ================================================================== 358 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU 359 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 360 * ,AMK,AMKZ,AMKST,GAMKST 362 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU 363 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 364 * ,AMK,AMKZ,AMKST,GAMKST 366 COMPLEX FORMA1,FORMK1,FORMRO,FORMKS 367 COMPLEX FA1A1P,FK1AB,F3PI 370 C ------------ 3 pi hadronic state (a1) 371 C FORMRO = FPIKM(SQRT(S1),AMPI,AMPI) 372 C FORMRO = F3PI(3,QQ,S1,SDWA) 373 C FORMA1 = FA1A1P(QQ) 374 C FORM3 = FORMA1*FORMRO 375 FORM3 = F3PI(3,QQ,S1,SDWA) 377 .EQ.
ELSEIF (MNUM3) THEN 378 C ------------ K- pi0 K0 (K*- K0) 379 FORMKS = BWIGM(S1,AMKST,GAMKST,AMPIZ,AMK) 381 FORM3 = FORMA1*FORMKS 383 .EQ.
ELSEIF (MNUM6) THEN 384 C ------------ pi- K0B pi0 (K*- pi0) 385 FORMKS = BWIGM(S1,AMKST,GAMKST,AMK,AMPI) 387 FORM3 = FORMK1*FORMKS 393 FUNCTION FORM4(MNUM,QQ,S1,S2,S3) 394 C ================================================================== 395 C formfactorfor F4 for 3 scalar final state 396 C R. Decker, in preparation 397 C R. Decker, E. Mirkes, R. Sauer, Z. Was Karlsruhe preprint TTP92-25 399 C ================================================================== 401 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU 402 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 403 * ,AMK,AMKZ,AMKST,GAMKST 405 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU 406 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 407 * ,AMK,AMKZ,AMKST,GAMKST 408 COMPLEX FORM4,WIGNER,FPIKM 410 C ---- this formfactor is switched off .. . 413 FUNCTION FORM5(MNUM,QQ,S1,S2) 414 C ================================================================== 415 C formfactorfor F5 for 3 scalar final state 416 C G. Kramer, W. Palmer, S. Pinsky, Phys. Rev. D30 (1984) 89. 417 C G. Kramer, W. Palmer Z. Phys. C25 (1984) 195. 418 C R. Decker, E. Mirkes, R. Sauer, Z. Was Karlsruhe preprint TTP92-25 420 C ================================================================== 422 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU 423 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 424 * ,AMK,AMKZ,AMKST,GAMKST 426 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU 427 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 428 * ,AMK,AMKZ,AMKST,GAMKST 429 COMPLEX FORM5,WIGNER,FPIKM,FPIKMD,BWIGM 431 C ------------ 3 pi hadronic state (a1) 433 .EQ.
ELSEIF (MNUM1) THEN 434 C ------------ K- pi- K+ 436 FORM5=FPIKMD(SQRT(QQ),AMPI,AMPI)/(1+ELPHA) 437 $ *( FPIKM(SQRT(S2),AMPI,AMPI) 438 $ +ELPHA*BWIGM(S1,AMKST,GAMKST,AMPI,AMK)) 439 .EQ.
ELSEIF (MNUM2) THEN 440 C ------------ K0 pi- K0B 442 FORM5=FPIKMD(SQRT(QQ),AMPI,AMPI)/(1+ELPHA) 443 $ *( FPIKM(SQRT(S2),AMPI,AMPI) 444 $ +ELPHA*BWIGM(S1,AMKST,GAMKST,AMPI,AMK)) 445 .EQ.
ELSEIF (MNUM3) THEN 446 C ------------ K- K0 pi0 448 .EQ.
ELSEIF (MNUM4) THEN 449 C ------------ pi0 pi0 K- 451 .EQ.
ELSEIF (MNUM5) THEN 452 C ------------ K- pi- pi+ 454 FORM5=BWIGM(QQ,AMKST,GAMKST,AMPI,AMK)/(1+ELPHA) 455 $ *( FPIKM(SQRT(S1),AMPI,AMPI) 456 $ +ELPHA*BWIGM(S2,AMKST,GAMKST,AMPI,AMK)) 457 .EQ.
ELSEIF (MNUM6) THEN 458 C ------------ pi- K0B pi0 460 FORM5=BWIGM(QQ,AMKST,GAMKST,AMPI,AMKZ)/(1+ELPHA) 461 $ *( FPIKM(SQRT(S2),AMPI,AMPI) 462 $ +ELPHA*BWIGM(S1,AMKST,GAMKST,AMPI,AMK)) 463 .EQ.
ELSEIF (MNUM7) THEN 464 C -------------- eta pi- pi0 final state 465 FORM5=FPIKMD(SQRT(QQ),AMPI,AMPI)*FPIKM(SQRT(S1),AMPI,AMPI) 469 SUBROUTINE CURRX(MNUM,PIM1,PIM2,PIM3,PIM4,HADCUR) 470 C ================================================================== 471 C hadronic current for 4 pi final state 472 C R. Fisher, J. Wess and F. Wagner Z. Phys C3 (1980) 313 473 C R. Decker Z. Phys C36 (1987) 487. 474 C M. Gell-Mann, D. Sharp, W. Wagner Phys. Rev. Lett 8 (1962) 261. 475 C ================================================================== 477 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU 478 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 479 * ,AMK,AMKZ,AMKST,GAMKST 481 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU 482 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 483 * ,AMK,AMKZ,AMKST,GAMKST 484 COMMON / DECPAR / GFERMI,GV,GA,CCABIB,SCABIB,GAMEL 485 REAL*4 GFERMI,GV,GA,CCABIB,SCABIB,GAMEL 486 C ARBITRARY FIXING OF THE FOUR PI X-SECTION NORMALIZATION 487 COMMON /ARBIT/ ARFLAT,AROMEG 488 REAL PIM1(4),PIM2(4),PIM3(4),PIM4(4),PAA(4) 489 COMPLEX HADCUR(4),FORM1,FORM2,FORM3,FPIKM 493 DATA PI /3.141592653589793238462643/ 495 BWIGN(A,XM,XG)=1.0/CMPLX(A-XM**2,XM*XG) 497 C --- masses and constants 510 COEF1=2.0*SQRT(3.0)/FPI**2*ARFLAT 512 C --- initialization of four vectors 517 PAA(K)=PIM1(K)+PIM2(K)+PIM3(K)+PIM4(K) 524 C =================================================================== 525 C pi- pi- p0 pi+ case ==== 526 C =================================================================== 527 QQ=PAA(4)**2-PAA(3)**2-PAA(2)**2-PAA(1)**2 528 C --- loop over thre contribution of the non-omega current 530 SK=(PP(K,4)+PIM4(4))**2-(PP(K,3)+PIM4(3))**2 531 $ -(PP(K,2)+PIM4(2))**2-(PP(K,1)+PIM4(1))**2 532 C -- definition of AA matrix 538 C ... and the rest ... 541 DENOM=(PAA(4)-PP(L,4))**2-(PAA(3)-PP(L,3))**2 542 $ -(PAA(2)-PP(L,2))**2-(PAA(1)-PP(L,1))**2 548 $ -SIG*(PAA(I)-2.0*PP(L,I))*(PAA(J)-PP(L,J))/DENOM 552 C --- lets add something to HADCURR 553 FORM1= FPIKM(SQRT(SK),AMPI,AMPI) *FPIKM(SQRT(QQ),AMPI,AMPI) 554 C FORM1= FPIKM(SQRT(SK),AMPI,AMPI) *FPIKMD(SQRT(QQ),AMPI,AMPI) 555 CCCCCCCCCCCCCCCCC FORM1=WIGFOR(SK,AMRO,GAMRO) (tests) 558 .EQ.
IF (K3) FIX=-2.0 562 $ HADCUR(I)+CMPLX(FIX*COEF1)*FORM1*AA(I,J)*(PP(K,J)-PP(4,J)) 564 C --- end of the non omega current (3 possibilities) 568 C --- there are two possibilities for omega current 569 C --- PA PB are corresponding first and second pi-s 575 C --- lorentz invariants 588 .EQ.
IF (K4) SIGN= 1.0 589 QQA=QQA+SIGN*(PAA(K)-PA(K))**2 590 SS23=SS23+SIGN*(PB(K) +PIM3(K))**2 591 SS24=SS24+SIGN*(PB(K) +PIM4(K))**2 592 SS34=SS34+SIGN*(PIM3(K)+PIM4(K))**2 593 QP1P2=QP1P2+SIGN*(PAA(K)-PA(K))*PB(K) 594 QP1P3=QP1P3+SIGN*(PAA(K)-PA(K))*PIM3(K) 595 QP1P4=QP1P4+SIGN*(PAA(K)-PA(K))*PIM4(K) 596 P1P2=P1P2+SIGN*PA(K)*PB(K) 597 P1P3=P1P3+SIGN*PA(K)*PIM3(K) 598 P1P4=P1P4+SIGN*PA(K)*PIM4(K) 601 FORM2=COEF2*(BWIGN(QQ,AMRO,GAMRO)+ELPHA*BWIGN(QQ,AMROP,GAMROP)) 602 C FORM3=BWIGN(QQA,AMOM,GAMOM)*(BWIGN(SS23,AMRO,GAMRO)+ 603 C $ BWIGN(SS24,AMRO,GAMRO)+BWIGN(SS34,AMRO,GAMRO)) 604 FORM3=BWIGN(QQA,AMOM,GAMOM) 607 HADCUR(K)=HADCUR(K)+FORM2*FORM3*( 608 $ PB (K)*(QP1P3*P1P4-QP1P4*P1P3) 609 $ +PIM3(K)*(QP1P4*P1P2-QP1P2*P1P4) 610 $ +PIM4(K)*(QP1P2*P1P3-QP1P3*P1P2) ) 615 C =================================================================== 616 C pi0 pi0 p0 pi- case ==== 617 C =================================================================== 618 QQ=PAA(4)**2-PAA(3)**2-PAA(2)**2-PAA(1)**2 620 C --- loop over thre contribution of the non-omega current 621 SK=(PP(K,4)+PIM4(4))**2-(PP(K,3)+PIM4(3))**2 622 $ -(PP(K,2)+PIM4(2))**2-(PP(K,1)+PIM4(1))**2 623 C -- definition of AA matrix 630 C ... and the rest ... 633 DENOM=(PAA(4)-PP(L,4))**2-(PAA(3)-PP(L,3))**2 634 $ -(PAA(2)-PP(L,2))**2-(PAA(1)-PP(L,1))**2 640 $ -SIG*(PAA(I)-2.0*PP(L,I))*(PAA(J)-PP(L,J))/DENOM 644 C --- lets add something to HADCURR 645 FORM1= FPIKM(SQRT(SK),AMPI,AMPI) *FPIKM(SQRT(QQ),AMPI,AMPI) 646 C FORM1= FPIKM(SQRT(SK),AMPI,AMPI) *FPIKMD(SQRT(QQ),AMPI,AMPI) 647 CCCCCCCCCCCCC FORM1=WIGFOR(SK,AMRO,GAMRO) (tests) 651 $ HADCUR(I)+CMPLX(COEF1)*FORM1*AA(I,J)*(PP(K,J)-PP(4,J)) 653 C --- end of the non omega current (3 possibilities) 657 FUNCTION WIGFOR(S,XM,XGAM) 658 COMPLEX WIGFOR,WIGNOR 659 WIGNOR=CMPLX(-XM**2,XM*XGAM) 660 WIGFOR=WIGNOR/CMPLX(S-XM**2,XM*XGAM) 663 C HERE the form factors of M. Finkemeier et al. start 664 C it ends with the string: M. Finkemeier et al. END 665 COMMON /INOUT/ INUT, IOUT 666 WRITE (UNIT = IOUT,FMT = 99) 667 WRITE (UNIT = IOUT,FMT = 98) 668 c print *, 'here is curinf
' 670 . /, ' ***************************************************
', 671 . /, ' you are using the 4 pion decay mode form factors
', 672 . /, ' which have been described in:
', 673 . /, ' r. decker, m. finkemeier, p. heiliger and h.h. jonsson
', 674 . /, ' "TAU DECAYS INTO FOUR PIONS" ', 675 . /, ' universitaet karlsruhe preprint ttp 94-13 (1994);
', 676 . /, ' lnf-94/066(ir); hep-ph/9410260
', 678 . /, ' please note that this routine is using parameters
', 679 . /, ' related to the 3 pion decay mode(a1 mode), such as
', 680 . /, ' the a1 mass and width(taken from the
COMMON /parmas/)
', 681 . /, ' and the 2 pion vector resonance form factor(by using
', 682 . /, ' the routine fpikm)
' , 683 . /, ' thus
IF you decide to change any of these, you will
' , 684 . /, ' have to refit the 4 pion parameters in the common
' ) 686 . ' block /tau4pi/, or you might get a bad discription
' , 687 . /, ' of tau -> 4 pions
' , 688 . /, ' for these formfactors set in routine choice for
', 689 . /, ' mnum.eq.102 -- amrx=1.42 and gamrx=.21
', 690 . /, ' mnum.eq.101 -- amrx=1.3 and gamrx=.46 prob1,prob2=0.2
', 691 . /, ' to optimize phase space parametrization
', 692 . /, ' ***************************************************
', 693 . /, ' coded by m. finkemeier and p. heiliger, 29. sept. 1994
', 694 . /, ' incorporated to tauola by z. was 17. jan. 1995
', 695 c . /, ' fitted on(day/month/year) by ...
', 696 c . /, ' to ....
data ', 697 . /, ' changed by: z. was on 17.01.95
', 698 . /, ' changes by: m. finkemeier on 30.01.95
' ) 702 COMMON /TAU4PI/ GOMEGA,GAMMA1,GAMMA2,ROM1,ROG1,BETA1, 704 REAL*4 GOMEGA,GAMMA1,GAMMA2,ROM1,ROG1,BETA1, 716 COMPLEX FUNCTION BWIGA1(QA) 717 C ================================================================ 718 C breit-wigner enhancement of a1 719 C ================================================================ 721 COMMON / PARMAS/ AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU, 722 % AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1, 723 % AMK,AMKZ,AMKST,GAMKST 726 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU, 727 % AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1, 728 % AMK,AMKZ,AMKST,GAMKST 730 WIGNER(A,B,C)=CMPLX(1.0,0.0)/CMPLX(A-B**2,B*C) 731 GAMAX=GAMA1*GFUN(QA)/GFUN(AMA1**2) 732 BWIGA1=-AMA1**2*WIGNER(QA,AMA1,GAMAX) 735 COMPLEX FUNCTION BWIGEPS(QEPS) 736 C ============================================================= 737 C breit-wigner enhancement of epsilon 738 C ============================================================= 742 BWIGEPS=CMPLX(MEPS**2,-MEPS*GEPS)/ 743 % CMPLX(MEPS**2-QEPS,-MEPS*GEPS) 746 COMPLEX FUNCTION FRHO4(W,XM1,XM2) 747 C =========================================================== 748 C rho-type resonance factor with higher radials, to be used 749 C by CURR for the four pion mode 750 C =========================================================== 752 COMMON /TAU4PI/ GOMEGA,GAMMA1,GAMMA2,ROM1,ROG1,BETA1, 754 REAL*4 GOMEGA,GAMMA1,GAMMA2,ROM1,ROG1,BETA1, 756 REAL ROM,ROG,PI,PIM,S,W 760 C ------------ PARAMETERS -------------------- 761 .EQ.
IF (INIT0 ) THEN 768 C ----------------------------------------------- 770 c print *,'rom2,rog2 =
',rom2,rog2 771 FRHO4=(BWIGM(S,ROM,ROG,XM1,XM2)+BETA1*BWIGM(S,ROM1,ROG1,XM1,XM2) 772 & +BETA2*BWIGM(S,ROM2,ROG2,XM1,XM2)) 776 SUBROUTINE CURR(MNUM,PIM1,PIM2,PIM3,PIM4,HADCUR) 777 C ================================================================== 778 C Hadronic current for 4 pi final state, according to: 779 C R. Decker, M. Finkemeier, P. Heiliger, H.H.Jonsson, TTP94-13 782 C R. Fisher, J. Wess and F. Wagner Z. Phys C3 (1980) 313 783 C R. Decker Z. Phys C36 (1987) 487. 784 C M. Gell-Mann, D. Sharp, W. Wagner Phys. Rev. Lett 8 (1962) 261. 785 C ================================================================== 787 COMMON /TAU4PI/ GOMEGA,GAMMA1,GAMMA2,ROM1,ROG1,BETA1, 789 REAL*4 GOMEGA,GAMMA1,GAMMA2,ROM1,ROG1,BETA1, 791 COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU 792 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 793 * ,AMK,AMKZ,AMKST,GAMKST 795 REAL*4 AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU 796 * ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1 797 * ,AMK,AMKZ,AMKST,GAMKST 798 COMMON / DECPAR / GFERMI,GV,GA,CCABIB,SCABIB,GAMEL 799 REAL*4 GFERMI,GV,GA,CCABIB,SCABIB,GAMEL 800 REAL PIM1(4),PIM2(4),PIM3(4),PIM4(4),PAA(4) 801 COMPLEX HADCUR(4),FORM1,FORM2,FORM3,FPIKM 803 COMPLEX BWIGEPS,BWIGA1 804 COMPLEX HCOMP1(4),HCOMP2(4),HCOMP3(4),HCOMP4(4) 806 COMPLEX T243,T213,T143,T123,T341,T342 807 COMPLEX T124,T134,T214,T234,T314,T324 808 COMPLEX S2413,S2314,S1423,S1324,S34 810 COMPLEX BRACK1,BRACK2,BRACK3,BRACK4A,BRACK4B,BRACK4 812 REAL QMP1,QMP2,QMP3,QMP4 813 REAL PS43,PS41,PS42,PS34,PS14,PS13,PS24,PS23 816 REAL PD243,PD241,PD213,PD143,PD142 817 REAL PD123,PD341,PD342,PD413,PD423 818 REAL PD124,PD134,PD214,PD234,PD314,PD324 823 DATA PI /3.141592653589793238462643/ 826 BWIGN(A,XM,XG)=1.0/CMPLX(A-XM**2,XM*XG) 834 C --- MASSES AND CONSTANTS 847 COEF1=2.0*SQRT(3.0)/FPI**2*ARFLAT 849 C --- INITIALIZATION OF FOUR VECTORS 854 PAA(K)=PIM1(K)+PIM2(K)+PIM3(K)+PIM4(K) 861 C =================================================================== 862 C PI- PI- P0 PI+ CASE ==== 863 C =================================================================== 864 QQ=PAA(4)**2-PAA(3)**2-PAA(2)**2-PAA(1)**2 866 C FIRST DEFINITION OF SCALAR PRODUCTS OF MOMENTUM VECTORS 868 C DEFINE (Q-PI)**2 AS QPI: 870 QMP1=(PIM2(4)+PIM3(4)+PIM4(4))**2-(PIM2(3)+PIM3(3)+PIM4(3))**2 871 % -(PIM2(2)+PIM3(2)+PIM4(2))**2-(PIM2(1)+PIM3(1)+PIM4(1))**2 873 QMP2=(PIM1(4)+PIM3(4)+PIM4(4))**2-(PIM1(3)+PIM3(3)+PIM4(3))**2 874 % -(PIM1(2)+PIM3(2)+PIM4(2))**2-(PIM1(1)+PIM3(1)+PIM4(1))**2 876 QMP3=(PIM1(4)+PIM2(4)+PIM4(4))**2-(PIM1(3)+PIM2(3)+PIM4(3))**2 877 % -(PIM1(2)+PIM2(2)+PIM4(2))**2-(PIM1(1)+PIM2(1)+PIM4(1))**2 879 QMP4=(PIM1(4)+PIM2(4)+PIM3(4))**2-(PIM1(3)+PIM2(3)+PIM3(3))**2 880 % -(PIM1(2)+PIM2(2)+PIM3(2))**2-(PIM1(1)+PIM2(1)+PIM3(1))**2 883 C DEFINE (PI+PK)**2 AS PSIK: 885 PS43=(PIM4(4)+PIM3(4))**2-(PIM4(3)+PIM3(3))**2 886 % -(PIM4(2)+PIM3(2))**2-(PIM4(1)+PIM3(1))**2 888 PS41=(PIM4(4)+PIM1(4))**2-(PIM4(3)+PIM1(3))**2 889 % -(PIM4(2)+PIM1(2))**2-(PIM4(1)+PIM1(1))**2 891 PS42=(PIM4(4)+PIM2(4))**2-(PIM4(3)+PIM2(3))**2 892 % -(PIM4(2)+PIM2(2))**2-(PIM4(1)+PIM2(1))**2 898 PS13=(PIM1(4)+PIM3(4))**2-(PIM1(3)+PIM3(3))**2 899 % -(PIM1(2)+PIM3(2))**2-(PIM1(1)+PIM3(1))**2 903 PS23=(PIM2(4)+PIM3(4))**2-(PIM2(3)+PIM3(3))**2 904 % -(PIM2(2)+PIM3(2))**2-(PIM2(1)+PIM3(1))**2 906 PD243=PIM2(4)*(PIM4(4)-PIM3(4))-PIM2(3)*(PIM4(3)-PIM3(3)) 907 % -PIM2(2)*(PIM4(2)-PIM3(2))-PIM2(1)*(PIM4(1)-PIM3(1)) 909 PD241=PIM2(4)*(PIM4(4)-PIM1(4))-PIM2(3)*(PIM4(3)-PIM1(3)) 910 % -PIM2(2)*(PIM4(2)-PIM1(2))-PIM2(1)*(PIM4(1)-PIM1(1)) 912 PD213=PIM2(4)*(PIM1(4)-PIM3(4))-PIM2(3)*(PIM1(3)-PIM3(3)) 913 % -PIM2(2)*(PIM1(2)-PIM3(2))-PIM2(1)*(PIM1(1)-PIM3(1)) 915 PD143=PIM1(4)*(PIM4(4)-PIM3(4))-PIM1(3)*(PIM4(3)-PIM3(3)) 916 % -PIM1(2)*(PIM4(2)-PIM3(2))-PIM1(1)*(PIM4(1)-PIM3(1)) 918 PD142=PIM1(4)*(PIM4(4)-PIM2(4))-PIM1(3)*(PIM4(3)-PIM2(3)) 919 % -PIM1(2)*(PIM4(2)-PIM2(2))-PIM1(1)*(PIM4(1)-PIM2(1)) 921 PD123=PIM1(4)*(PIM2(4)-PIM3(4))-PIM1(3)*(PIM2(3)-PIM3(3)) 922 % -PIM1(2)*(PIM2(2)-PIM3(2))-PIM1(1)*(PIM2(1)-PIM3(1)) 924 PD341=PIM3(4)*(PIM4(4)-PIM1(4))-PIM3(3)*(PIM4(3)-PIM1(3)) 925 % -PIM3(2)*(PIM4(2)-PIM1(2))-PIM3(1)*(PIM4(1)-PIM1(1)) 927 PD342=PIM3(4)*(PIM4(4)-PIM2(4))-PIM3(3)*(PIM4(3)-PIM2(3)) 928 % -PIM3(2)*(PIM4(2)-PIM2(2))-PIM3(1)*(PIM4(1)-PIM2(1)) 930 PD413=PIM4(4)*(PIM1(4)-PIM3(4))-PIM4(3)*(PIM1(3)-PIM3(3)) 931 % -PIM4(2)*(PIM1(2)-PIM3(2))-PIM4(1)*(PIM1(1)-PIM3(1)) 933 PD423=PIM4(4)*(PIM2(4)-PIM3(4))-PIM4(3)*(PIM2(3)-PIM3(3)) 934 % -PIM4(2)*(PIM2(2)-PIM3(2))-PIM4(1)*(PIM2(1)-PIM3(1)) 938 QP1=PIM1(4)*(PIM1(4)+PIM2(4)+PIM3(4)+PIM4(4)) 939 % -PIM1(3)*(PIM1(3)+PIM2(3)+PIM3(3)+PIM4(3)) 940 % -PIM1(2)*(PIM1(2)+PIM2(2)+PIM3(2)+PIM4(2)) 941 % -PIM1(1)*(PIM1(1)+PIM2(1)+PIM3(1)+PIM4(1)) 943 QP2=PIM2(4)*(PIM1(4)+PIM2(4)+PIM3(4)+PIM4(4)) 944 % -PIM2(3)*(PIM1(3)+PIM2(3)+PIM3(3)+PIM4(3)) 945 % -PIM2(2)*(PIM1(2)+PIM2(2)+PIM3(2)+PIM4(2)) 946 % -PIM2(1)*(PIM1(1)+PIM2(1)+PIM3(1)+PIM4(1)) 948 QP3=PIM3(4)*(PIM1(4)+PIM2(4)+PIM3(4)+PIM4(4)) 949 % -PIM3(3)*(PIM1(3)+PIM2(3)+PIM3(3)+PIM4(3)) 950 % -PIM3(2)*(PIM1(2)+PIM2(2)+PIM3(2)+PIM4(2)) 951 % -PIM3(1)*(PIM1(1)+PIM2(1)+PIM3(1)+PIM4(1)) 953 QP4=PIM4(4)*(PIM1(4)+PIM2(4)+PIM3(4)+PIM4(4)) 954 % -PIM4(3)*(PIM1(3)+PIM2(3)+PIM3(3)+PIM4(3)) 955 % -PIM4(2)*(PIM1(2)+PIM2(2)+PIM3(2)+PIM4(2)) 956 % -PIM4(1)*(PIM1(1)+PIM2(1)+PIM3(1)+PIM4(1)) 960 C DEFINE T(PI;PJ,PK)= TIJK: 962 T243=BWIGA1(QMP2)*FPIKM(SQRT(PS43),AMPI,AMPI)*GAMMA1 963 T213=BWIGA1(QMP2)*FPIKM(SQRT(PS13),AMPI,AMPI)*GAMMA1 964 T143=BWIGA1(QMP1)*FPIKM(SQRT(PS43),AMPI,AMPI)*GAMMA1 965 T123=BWIGA1(QMP1)*FPIKM(SQRT(PS23),AMPI,AMPI)*GAMMA1 966 T341=BWIGA1(QMP3)*FPIKM(SQRT(PS41),AMPI,AMPI)*GAMMA1 967 T342=BWIGA1(QMP3)*FPIKM(SQRT(PS42),AMPI,AMPI)*GAMMA1 969 C DEFINE S(I,J;K,L)= SIJKL: 971 S2413=FRHO4(SQRT(PS24),AMPI,AMPI)*GAMMA2 972 S2314=FRHO4(SQRT(PS23),AMPI,AMPI)*BWIGEPS(PS14)*GAMMA2 973 S1423=FRHO4(SQRT(PS14),AMPI,AMPI)*GAMMA2 974 S1324=FRHO4(SQRT(PS13),AMPI,AMPI)*BWIGEPS(PS24)*GAMMA2 975 S34=FRHO4(SQRT(PS34),AMPI,AMPI)*GAMMA2 977 C DEFINITION OF AMPLITUDE, FIRST THE [] BRACKETS: 979 BRACK1=2.*T143+2.*T243+T123+T213 980 % +T341*(PD241/QMP3-1.)+T342*(PD142/QMP3-1.) 981 % +3./4.*(S1423+S2413-S2314-S1324)-3.*S34 983 BRACK2=2.*T143*PD243/QMP1+3.*T213 984 % +T123*(2.*PD423/QMP1+1.)+T341*(PD241/QMP3+3.) 985 % +T342*(PD142/QMP3+1.) 986 % -3./4.*(S2314+3.*S1324+3.*S1423+S2413) 988 BRACK3=2.*T243*PD143/QMP2+3.*T123 989 % +T213*(2.*PD413/QMP2+1.)+T341*(PD241/QMP3+1.) 990 % +T342*(PD142/QMP3+3.) 991 % -3./4.*(3.*S2314+S1324+S1423+3.*S2413) 993 BRACK4A=2.*T143*(PD243/QQ*(QP1/QMP1+1.)+PD143/QQ) 994 % +2.*T243*(PD143/QQ*(QP2/QMP2+1.)+PD243/QQ) 996 % +2.*T123*(PD423/QQ*(QP1/QMP1+1.)+PD123/QQ) 997 % +2.*T213*(PD413/QQ*(QP2/QMP2+1.)+PD213/QQ) 998 % +T341*(PD241/QMP3+1.-2.*PD241/QQ*(QP3/QMP3+1.) 1000 % +T342*(PD142/QMP3+1.-2.*PD142/QQ*(QP3/QMP3+1.) 1003 BRACK4B=-3./4.*(S2314*(2.*(QP2-QP3)/QQ+1.) 1004 % +S1324*(2.*(QP1-QP3)/QQ+1.) 1005 % +S1423*(2.*(QP1-QP4)/QQ+1.) 1006 % +S2413*(2.*(QP2-QP4)/QQ+1.) 1007 % +4.*S34*(QP4-QP3)/QQ) 1009 BRACK4=BRACK4A+BRACK4B 1013 HCOMP1(K)=(PIM3(K)-PIM4(K))*BRACK1 1014 HCOMP2(K)=PIM1(K)*BRACK2 1015 HCOMP3(K)=PIM2(K)*BRACK3 1016 HCOMP4(K)=(PIM1(K)+PIM2(K)+PIM3(K)+PIM4(K))*BRACK4 1022 HADCUR(I)=HCOMP1(I)-HCOMP2(I)-HCOMP3(I)+HCOMP4(I) 1023 HADCUR(I)=-COEF1*FRHO4(SQRT(QQ),AMPI,AMPI)*HADCUR(I) 1028 C --- END OF THE NON OMEGA CURRENT (3 POSSIBILITIES) 1032 C --- THERE ARE TWO POSSIBILITIES FOR OMEGA CURRENT 1033 C --- PA PB ARE CORRESPONDING FIRST AND SECOND PI-S 1039 C --- LORENTZ INVARIANTS 1052 .EQ.
IF (K4) SIGN= 1.0 1053 QQA=QQA+SIGN*(PAA(K)-PA(K))**2 1054 SS23=SS23+SIGN*(PB(K) +PIM3(K))**2 1055 SS24=SS24+SIGN*(PB(K) +PIM4(K))**2 1056 SS34=SS34+SIGN*(PIM3(K)+PIM4(K))**2 1057 QP1P2=QP1P2+SIGN*(PAA(K)-PA(K))*PB(K) 1058 QP1P3=QP1P3+SIGN*(PAA(K)-PA(K))*PIM3(K) 1059 QP1P4=QP1P4+SIGN*(PAA(K)-PA(K))*PIM4(K) 1060 P1P2=P1P2+SIGN*PA(K)*PB(K) 1061 P1P3=P1P3+SIGN*PA(K)*PIM3(K) 1062 P1P4=P1P4+SIGN*PA(K)*PIM4(K) 1065 FORM2=COEF2*(BWIGN(QQ,AMRO,GAMRO)+ELPHA*BWIGN(QQ,AMROP,GAMROP)) 1066 C FORM3=BWIGN(QQA,AMOM,GAMOM)*(BWIGN(SS23,AMRO,GAMRO)+ 1067 C $ BWIGN(SS24,AMRO,GAMRO)+BWIGN(SS34,AMRO,GAMRO)) 1068 FORM3=BWIGN(QQA,AMOM,GAMOM) 1071 HADCUR(K)=HADCUR(K)+FORM2*FORM3*( 1072 $ PB (K)*(QP1P3*P1P4-QP1P4*P1P3) 1073 $ +PIM3(K)*(QP1P4*P1P2-QP1P2*P1P4) 1074 $ +PIM4(K)*(QP1P2*P1P3-QP1P3*P1P2) ) 1079 C =================================================================== 1080 C PI0 PI0 P0 PI- CASE ==== 1081 C =================================================================== 1082 QQ=PAA(4)**2-PAA(3)**2-PAA(2)**2-PAA(1)**2 1085 C FIRST DEFINITION OF SCALAR PRODUCTS OF MOMENTUM VECTORS 1087 C DEFINE (Q-PI)**2 AS QPI: 1089 QMP1=(PIM2(4)+PIM3(4)+PIM4(4))**2-(PIM2(3)+PIM3(3)+PIM4(3))**2 1090 % -(PIM2(2)+PIM3(2)+PIM4(2))**2-(PIM2(1)+PIM3(1)+PIM4(1))**2 1092 QMP2=(PIM1(4)+PIM3(4)+PIM4(4))**2-(PIM1(3)+PIM3(3)+PIM4(3))**2 1093 % -(PIM1(2)+PIM3(2)+PIM4(2))**2-(PIM1(1)+PIM3(1)+PIM4(1))**2 1095 QMP3=(PIM1(4)+PIM2(4)+PIM4(4))**2-(PIM1(3)+PIM2(3)+PIM4(3))**2 1096 % -(PIM1(2)+PIM2(2)+PIM4(2))**2-(PIM1(1)+PIM2(1)+PIM4(1))**2 1098 QMP4=(PIM1(4)+PIM2(4)+PIM3(4))**2-(PIM1(3)+PIM2(3)+PIM3(3))**2 1099 % -(PIM1(2)+PIM2(2)+PIM3(2))**2-(PIM1(1)+PIM2(1)+PIM3(1))**2 1102 C DEFINE (PI+PK)**2 AS PSIK: 1104 PS14=(PIM1(4)+PIM4(4))**2-(PIM1(3)+PIM4(3))**2 1105 % -(PIM1(2)+PIM4(2))**2-(PIM1(1)+PIM4(1))**2 1107 PS21=(PIM2(4)+PIM1(4))**2-(PIM2(3)+PIM1(3))**2 1108 % -(PIM2(2)+PIM1(2))**2-(PIM2(1)+PIM1(1))**2 1110 PS23=(PIM2(4)+PIM3(4))**2-(PIM2(3)+PIM3(3))**2 1111 % -(PIM2(2)+PIM3(2))**2-(PIM2(1)+PIM3(1))**2 1113 PS24=(PIM2(4)+PIM4(4))**2-(PIM2(3)+PIM4(3))**2 1114 % -(PIM2(2)+PIM4(2))**2-(PIM2(1)+PIM4(1))**2 1116 PS31=(PIM3(4)+PIM1(4))**2-(PIM3(3)+PIM1(3))**2 1117 % -(PIM3(2)+PIM1(2))**2-(PIM3(1)+PIM1(1))**2 1119 PS34=(PIM3(4)+PIM4(4))**2-(PIM3(3)+PIM4(3))**2 1120 % -(PIM3(2)+PIM4(2))**2-(PIM3(1)+PIM4(1))**2 1124 PD324=PIM3(4)*(PIM2(4)-PIM4(4))-PIM3(3)*(PIM2(3)-PIM4(3)) 1125 % -PIM3(2)*(PIM2(2)-PIM4(2))-PIM3(1)*(PIM2(1)-PIM4(1)) 1127 PD314=PIM3(4)*(PIM1(4)-PIM4(4))-PIM3(3)*(PIM1(3)-PIM4(3)) 1128 % -PIM3(2)*(PIM1(2)-PIM4(2))-PIM3(1)*(PIM1(1)-PIM4(1)) 1130 PD234=PIM2(4)*(PIM3(4)-PIM4(4))-PIM2(3)*(PIM3(3)-PIM4(3)) 1131 % -PIM2(2)*(PIM3(2)-PIM4(2))-PIM2(1)*(PIM3(1)-PIM4(1)) 1133 PD214=PIM2(4)*(PIM1(4)-PIM4(4))-PIM2(3)*(PIM1(3)-PIM4(3)) 1134 % -PIM2(2)*(PIM1(2)-PIM4(2))-PIM2(1)*(PIM1(1)-PIM4(1)) 1136 PD134=PIM1(4)*(PIM3(4)-PIM4(4))-PIM1(3)*(PIM3(3)-PIM4(3)) 1137 % -PIM1(2)*(PIM3(2)-PIM4(2))-PIM1(1)*(PIM3(1)-PIM4(1)) 1139 PD124=PIM1(4)*(PIM2(4)-PIM4(4))-PIM1(3)*(PIM2(3)-PIM4(3)) 1140 % -PIM1(2)*(PIM2(2)-PIM4(2))-PIM1(1)*(PIM2(1)-PIM4(1)) 1142 C DEFINE Q*PI = QPI: 1144 QP1=PIM1(4)*(PIM1(4)+PIM2(4)+PIM3(4)+PIM4(4)) 1145 % -PIM1(3)*(PIM1(3)+PIM2(3)+PIM3(3)+PIM4(3)) 1146 % -PIM1(2)*(PIM1(2)+PIM2(2)+PIM3(2)+PIM4(2)) 1147 % -PIM1(1)*(PIM1(1)+PIM2(1)+PIM3(1)+PIM4(1)) 1149 QP2=PIM2(4)*(PIM1(4)+PIM2(4)+PIM3(4)+PIM4(4)) 1150 % -PIM2(3)*(PIM1(3)+PIM2(3)+PIM3(3)+PIM4(3)) 1151 % -PIM2(2)*(PIM1(2)+PIM2(2)+PIM3(2)+PIM4(2)) 1152 % -PIM2(1)*(PIM1(1)+PIM2(1)+PIM3(1)+PIM4(1)) 1154 QP3=PIM3(4)*(PIM1(4)+PIM2(4)+PIM3(4)+PIM4(4)) 1155 % -PIM3(3)*(PIM1(3)+PIM2(3)+PIM3(3)+PIM4(3)) 1156 % -PIM3(2)*(PIM1(2)+PIM2(2)+PIM3(2)+PIM4(2)) 1157 % -PIM3(1)*(PIM1(1)+PIM2(1)+PIM3(1)+PIM4(1)) 1159 QP4=PIM4(4)*(PIM1(4)+PIM2(4)+PIM3(4)+PIM4(4)) 1160 % -PIM4(3)*(PIM1(3)+PIM2(3)+PIM3(3)+PIM4(3)) 1161 % -PIM4(2)*(PIM1(2)+PIM2(2)+PIM3(2)+PIM4(2)) 1162 % -PIM4(1)*(PIM1(1)+PIM2(1)+PIM3(1)+PIM4(1)) 1165 C DEFINE T(PI;PJ,PK)= TIJK: 1167 T324=BWIGA1(QMP3)*FPIKM(SQRT(PS24),AMPI,AMPI)*GAMMA1 1168 T314=BWIGA1(QMP3)*FPIKM(SQRT(PS14),AMPI,AMPI)*GAMMA1 1169 T234=BWIGA1(QMP2)*FPIKM(SQRT(PS34),AMPI,AMPI)*GAMMA1 1170 T214=BWIGA1(QMP2)*FPIKM(SQRT(PS14),AMPI,AMPI)*GAMMA1 1171 T134=BWIGA1(QMP1)*FPIKM(SQRT(PS34),AMPI,AMPI)*GAMMA1 1172 T124=BWIGA1(QMP1)*FPIKM(SQRT(PS24),AMPI,AMPI)*GAMMA1 1174 C DEFINE S(I,J;K,L)= SIJKL: 1176 S1423=FRHO4(SQRT(PS14),AMPI,AMPI)*BWIGEPS(PS23)*GAMMA2 1177 S2431=FRHO4(SQRT(PS24),AMPI,AMPI)*BWIGEPS(PS31)*GAMMA2 1178 S3421=FRHO4(SQRT(PS34),AMPI,AMPI)*BWIGEPS(PS21)*GAMMA2 1181 C DEFINITION OF AMPLITUDE, FIRST THE [] BRACKETS: 1183 BRACK1=T234+T324+2.*T314+T134+2.*T214+T124 1184 % +T134*PD234/QMP1+T124*PD324/QMP1 1185 % -3./2.*(S3421+S2431+2.*S1423) 1188 BRACK2=T234*(1.+2.*PD134/QMP2)+3.*T324+3.*T124 1189 % +T134*(1.-PD234/QMP1)+2.*T214*PD314/QMP2 1191 % -3./2.*(S3421+3.*S2431) 1193 BRACK3=T324*(1.+2.*PD124/QMP3)+3.*T234+3.*T134 1194 % +T124*(1.-PD324/QMP1)+2.*T314*PD214/QMP3 1196 % -3./2.*(3.*S3421+S2431) 1198 BRACK4A=2.*T234*(1./2.+PD134/QQ*(QP2/QMP2+1.)+PD234/QQ) 1199 % +2.*T324*(1./2.+PD124/QQ*(QP3/QMP3+1.)+PD324/QQ) 1200 % +2.*T134*(1./2.+PD234/QQ*(QP1/QMP1+1.) 1201 % -1./2.*PD234/QMP1+PD134/QQ) 1202 % +2.*T124*(1./2.+PD324/QQ*(QP1/QMP1+1.) 1203 % -1./2.*PD324/QMP1+PD124/QQ) 1204 % +2.*T214*(PD314/QQ*(QP2/QMP2+1.)+PD214/QQ) 1205 % +2.*T314*(PD214/QQ*(QP3/QMP3+1.)+PD314/QQ) 1207 BRACK4B=-3./2.*(S3421*(2.*(QP3-QP4)/QQ+1.) 1208 % +S2431*(2.*(QP2-QP4)/QQ+1.) 1209 % +S1423*2.*(QP1-QP4)/QQ) 1212 BRACK4=BRACK4A+BRACK4B 1216 HCOMP1(K)=(PIM1(K)-PIM4(K))*BRACK1 1217 HCOMP2(K)=PIM2(K)*BRACK2 1218 HCOMP3(K)=PIM3(K)*BRACK3 1219 HCOMP4(K)=(PIM1(K)+PIM2(K)+PIM3(K)+PIM4(K))*BRACK4 1225 HADCUR(I)=HCOMP1(I)+HCOMP2(I)+HCOMP3(I)-HCOMP4(I) 1226 HADCUR(I)=COEF1*FRHO4(SQRT(QQ),AMPI,AMPI)*HADCUR(I) 1232 C M. Finkemeier et al. END