tauola-F/prod/formf.f

00001 
00002 
00003       FUNCTION FORMOM(XMAA,XMOM)
00004 C     ==================================================================
00005 C     formfactorfor pi-pi0 gamma final state
00006 C      R. Decker, Z. Phys C36 (1987) 487.
00007 C     ==================================================================
00008       COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00009      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00010      *                 ,AMK,AMKZ,AMKST,GAMKST
00011 C
00012       REAL*4            AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00013      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00014      *                 ,AMK,AMKZ,AMKST,GAMKST
00015       COMMON / DECPAR / GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
00016       REAL*4            GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
00017       COMMON /TESTA1/ KEYA1
00018       COMPLEX BWIGN,FORMOM
00019       DATA ICONT /1/
00020 * THIS INLINE FUNCT. CALCULATES THE SCALAR PART OF THE PROPAGATOR
00021       BWIGN(XM,AM,GAMMA)=1./CMPLX(XM**2-AM**2,GAMMA*AM)
00022 * HADRON CURRENT
00023       FRO  =0.266*AMRO**2
00024       ELPHA=- 0.1
00025       AMROP = 1.7
00026       GAMROP= 0.26
00027       AMOM  =0.782
00028       GAMOM =0.0085
00029       AROMEG= 1.0
00030       GCOUP=12.924
00031       GCOUP=GCOUP*AROMEG
00032       FQED  =SQRT(4.0*3.1415926535/137.03604)
00033       FORMOM=FQED*FRO**2/SQRT(2.0)*GCOUP**2*BWIGN(XMOM,AMOM,GAMOM)
00034      $     *(BWIGN(XMAA,AMRO,GAMRO)+ELPHA*BWIGN(XMAA,AMROP,GAMROP))
00035      $     *(BWIGN( 0.0,AMRO,GAMRO)+ELPHA*BWIGN( 0.0,AMROP,GAMROP))
00036       END
00037 
00038 
00039 
00040 C=======================================================================
00041       COMPLEX FUNCTION FK1AB(XMSQ,INDX)
00042 C     ==================================================================
00043 C     complex form-factor for a1+a1prime.                       AJW 1/98
00044 C     ==================================================================
00045 
00046       COMPLEX F1,F2,AMPA,AMPB
00047       INTEGER IFIRST,INDX
00048       DATA IFIRST/0/
00049 
00050       IF (IFIRST.EQ.0) THEN
00051         IFIRST = 1
00052         XM1 = PKORB(1,19)
00053         XG1 = PKORB(2,19)
00054         XM2 = PKORB(1,20)
00055         XG2 = PKORB(2,20)
00056 
00057         XM1SQ = XM1*XM1
00058         GF1 = GFUN(XM1SQ)
00059         GG1 = XM1*XG1/GF1
00060         XM2SQ = XM2*XM2
00061         GF2 = GFUN(XM2SQ)
00062         GG2 = XM2*XG2/GF2
00063       END IF
00064 
00065       IF (INDX.EQ.1) THEN
00066         AMPA = CMPLX(PKORB(3,81),0.)
00067         AMPB = CMPLX(PKORB(3,82),0.)
00068       ELSE IF (INDX.EQ.2) THEN
00069         AMPA = CMPLX(PKORB(3,83),0.)
00070         AMPB = CMPLX(PKORB(3,84),0.)
00071       ELSEIF (INDX.EQ.3) THEN
00072         AMPA = CMPLX(PKORB(3,85),0.)
00073         AMPB = CMPLX(PKORB(3,86),0.)
00074       ELSEIF (INDX.EQ.4) THEN
00075         AMPA = CMPLX(PKORB(3,87),0.)
00076         AMPB = CMPLX(PKORB(3,88),0.)
00077       END IF
00078 
00079       GF = GFUN(XMSQ)
00080       FG1 = GG1*GF
00081       FG2 = GG2*GF
00082       F1 = CMPLX(-XM1SQ,0.0)/CMPLX(XMSQ-XM1SQ,FG1)
00083       F2 = CMPLX(-XM2SQ,0.0)/CMPLX(XMSQ-XM2SQ,FG2)
00084       FK1AB = AMPA*F1+AMPB*F2
00085 
00086       RETURN
00087       END
00088 
00089       FUNCTION FORM1(MNUM,QQ,S1,SDWA)
00090 C     ==================================================================
00091 C     formfactorfor F1 for 3 scalar final state
00092 C     R. Fisher, J. Wess and F. Wagner Z. Phys C3 (1980) 313
00093 C     H. Georgi, Weak interactions and modern particle theory,
00094 C     The Benjamin/Cummings Pub. Co., Inc. 1984.
00095 C     R. Decker, E. Mirkes, R. Sauer, Z. Was Karlsruhe preprint TTP92-25
00096 C     and erratum !!!!!!
00097 C     ==================================================================
00098 C
00099       COMPLEX FORM1,WIGNER,WIGFOR,FPIKM,BWIGM
00100       COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00101      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00102      *                 ,AMK,AMKZ,AMKST,GAMKST
00103 C
00104       REAL*4            AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00105      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00106      *                 ,AMK,AMKZ,AMKST,GAMKST
00107 
00108       COMPLEX FORMA1,FORMK1,FORMRO,FORMKS
00109       COMPLEX FA1A1P,FK1AB,F3PI
00110 C
00111       IF     (MNUM.EQ.0) THEN
00112 C ------------  3 pi hadronic state (a1)
00113 C       FORMRO = FPIKM(SQRT(S1),AMPI,AMPI)
00114 C       FORMRO = F3PI(1,QQ,S1,SDWA)
00115 C       FORMA1 = FA1A1P(QQ)
00116 C       FORM1 = FORMA1*FORMRO
00117        FORM1 = F3PI(1,QQ,S1,SDWA)
00118 
00119       ELSEIF (MNUM.EQ.1) THEN
00120 C ------------ K- pi- K+ (K*0 K-)
00121        FORMKS = BWIGM(S1,AMKST,GAMKST,AMPI,AMK)
00122        FORMA1 = FA1A1P(QQ)
00123        FORM1 = FORMA1*FORMKS
00124 
00125       ELSEIF (MNUM.EQ.2) THEN
00126 C ------------ K0 pi- K0B (K*- K0)
00127        FORMKS = BWIGM(S1,AMKST,GAMKST,AMPI,AMK)
00128        FORMA1 = FA1A1P(QQ)
00129        FORM1 = FORMA1*FORMKS
00130 
00131       ELSEIF (MNUM.EQ.3) THEN
00132 C ------------ K- pi0 K0 (K*0 K-)
00133        FORMKS = BWIGM(S1,AMKST,GAMKST,AMPI,AMK)
00134        FORMA1 = FA1A1P(QQ)
00135        FORM1 = FORMA1*FORMKS
00136 
00137       ELSEIF (MNUM.EQ.4) THEN
00138 C ------------ pi0 pi0 K-  (K*-pi0)
00139        FORMKS = BWIGM(S1,AMKST,GAMKST,AMPI,AMK)
00140        FORMK1 = FK1AB(QQ,3)
00141        FORM1 = FORMK1*FORMKS
00142 
00143       ELSEIF (MNUM.EQ.5) THEN
00144 C ------------ K- pi- pi+ (rho0 K-)
00145        FORMK1 = FK1AB(QQ,4)
00146        FORMRO = FPIKM(SQRT(S1),AMPI,AMPI)
00147        FORM1 = FORMK1*FORMRO
00148 
00149       ELSEIF (MNUM.EQ.6) THEN
00150 C ------------ pi- K0B pi0 (pi- K*0B)
00151        FORMK1 = FK1AB(QQ,1)
00152        FORMKS = BWIGM(S1,AMKST,GAMKST,AMK,AMPI)
00153        FORM1 = FORMK1*FORMKS
00154 
00155       ELSEIF (MNUM.EQ.7) THEN
00156 C -------------- eta pi- pi0 final state
00157        FORM1=0.0
00158       ENDIF
00159       END
00160       FUNCTION FORM2(MNUM,QQ,S1,SDWA)
00161 C     ==================================================================
00162 C     formfactorfor F2 for 3 scalar final state
00163 C     R. Fisher, J. Wess and F. Wagner Z. Phys C3 (1980) 313
00164 C     H. Georgi, Weak interactions and modern particle theory,
00165 C     The Benjamin/Cummings Pub. Co., Inc. 1984.
00166 C     R. Decker, E. Mirkes, R. Sauer, Z. Was Karlsruhe preprint TTP92-25
00167 C     and erratum !!!!!!
00168 C     ==================================================================
00169 C
00170       COMPLEX FORM2,WIGNER,WIGFOR,FPIKM,BWIGM
00171       COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00172      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00173      *                 ,AMK,AMKZ,AMKST,GAMKST
00174 C
00175       REAL*4            AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00176      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00177      *                 ,AMK,AMKZ,AMKST,GAMKST
00178       COMPLEX FORMA1,FORMK1,FORMRO,FORMKS
00179       COMPLEX FA1A1P,FK1AB,F3PI
00180 
00181       IF     (MNUM.EQ.0) THEN
00182 C ------------  3 pi hadronic state (a1)
00183 C       FORMRO = FPIKM(SQRT(S1),AMPI,AMPI)
00184 C       FORMRO = F3PI(2,QQ,S1,SDWA)
00185 C       FORMA1 = FA1A1P(QQ)
00186 C       FORM2 = FORMA1*FORMRO
00187        FORM2 = F3PI(2,QQ,S1,SDWA)
00188 
00189       ELSEIF (MNUM.EQ.1) THEN
00190 C ------------ K- pi- K+ (rho0 pi-)
00191        FORMRO = FPIKM(SQRT(S1),AMK,AMK)
00192        FORMA1 = FA1A1P(QQ)
00193        FORM2 = FORMA1*FORMRO
00194 
00195       ELSEIF (MNUM.EQ.2) THEN
00196 C ------------ K0 pi- K0B (rho0 pi-)
00197        FORMRO = FPIKM(SQRT(S1),AMK,AMK)
00198        FORMA1 = FA1A1P(QQ)
00199        FORM2 = FORMA1*FORMRO
00200 
00201       ELSEIF (MNUM.EQ.3) THEN
00202 C ------------ K- pi0 K0 (rho- pi0)
00203        FORMRO = FPIKM(SQRT(S1),AMK,AMK)
00204        FORMA1 = FA1A1P(QQ)
00205        FORM2 = FORMA1*FORMRO
00206 
00207       ELSEIF (MNUM.EQ.4) THEN
00208 C ------------ pi0 pi0 K-  (K*-pi0)
00209        FORMKS = BWIGM(S1,AMKST,GAMKST,AMPI,AMK)
00210        FORMK1 = FK1AB(QQ,3)
00211        FORM2 = FORMK1*FORMKS
00212 
00213       ELSEIF (MNUM.EQ.5) THEN
00214 C ------------ K- pi- pi+  (K*0B pi-)
00215        FORMKS = BWIGM(S1,AMKST,GAMKST,AMPI,AMK)
00216        FORMK1 = FK1AB(QQ,1)
00217        FORM2 = FORMK1*FORMKS
00218 C
00219       ELSEIF (MNUM.EQ.6) THEN
00220 C ------------ pi- K0B pi0 (rho- K0B)
00221        FORMRO = FPIKM(SQRT(S1),AMPI,AMPI)
00222        FORMK1 = FK1AB(QQ,2)
00223        FORM2 = FORMK1*FORMRO
00224 C
00225       ELSEIF (MNUM.EQ.7) THEN
00226 C -------------- eta pi- pi0 final state
00227        FORM2=0.0
00228       ENDIF
00229 C
00230       END
00231       COMPLEX FUNCTION BWIGM(S,M,G,XM1,XM2)
00232 C **********************************************************
00233 C     P-WAVE BREIT-WIGNER  FOR RHO
00234 C **********************************************************
00235       REAL S,M,G,XM1,XM2
00236       REAL PI,QS,QM,W,GS
00237       DATA INIT /0/
00238 C ------------ PARAMETERS --------------------
00239       IF (INIT.EQ.0) THEN
00240       INIT=1
00241       PI=3.141592654
00242 C -------  BREIT-WIGNER -----------------------
00243          ENDIF
00244        IF (S.GT.(XM1+XM2)**2) THEN
00245          QS=SQRT(ABS((S   -(XM1+XM2)**2)*(S   -(XM1-XM2)**2)))/SQRT(S)
00246          QM=SQRT(ABS((M**2-(XM1+XM2)**2)*(M**2-(XM1-XM2)**2)))/M
00247          W=SQRT(S)
00248          GS=G*(M/W)**2*(QS/QM)**3
00249        ELSE
00250          GS=0.0
00251        ENDIF
00252          BWIGM=M**2/CMPLX(M**2-S,-SQRT(S)*GS)
00253       RETURN
00254       END
00255       COMPLEX FUNCTION FPIKM(W,XM1,XM2)
00256 C **********************************************************
00257 C     PION FORM FACTOR
00258 C **********************************************************
00259       COMPLEX BWIGM
00260       REAL ROM,ROG,ROM1,ROG1,BETA1,PI,PIM,S,W
00261       EXTERNAL BWIG
00262       DATA  INIT /0/
00263 C
00264 C ------------ PARAMETERS --------------------
00265       IF (INIT.EQ.0 ) THEN
00266       INIT=1
00267       PI=3.141592654
00268       PIM=.140
00269       ROM=0.773
00270       ROG=0.145
00271       ROM1=1.370
00272       ROG1=0.510
00273       BETA1=-0.145
00274       ENDIF
00275 C -----------------------------------------------
00276       S=W**2
00277       FPIKM=(BWIGM(S,ROM,ROG,XM1,XM2)+BETA1*BWIGM(S,ROM1,ROG1,XM1,XM2))
00278      & /(1+BETA1)
00279       RETURN
00280       END
00281       COMPLEX FUNCTION FPIKMD(W,XM1,XM2)
00282 C **********************************************************
00283 C     PION FORM FACTOR
00284 C **********************************************************
00285       COMPLEX BWIGM
00286       REAL ROM,ROG,ROM1,ROG1,PI,PIM,S,W
00287       EXTERNAL BWIG
00288       DATA  INIT /0/
00289 C
00290 C ------------ PARAMETERS --------------------
00291       IF (INIT.EQ.0 ) THEN
00292       INIT=1
00293       PI=3.141592654
00294       PIM=.140
00295       ROM=0.773
00296       ROG=0.145
00297       ROM1=1.500
00298       ROG1=0.220
00299       ROM2=1.750
00300       ROG2=0.120
00301       BETA=6.5
00302       DELTA=-26.0
00303       ENDIF
00304 C -----------------------------------------------
00305       S=W**2
00306       FPIKMD=(DELTA*BWIGM(S,ROM,ROG,XM1,XM2)
00307      $      +BETA*BWIGM(S,ROM1,ROG1,XM1,XM2)
00308      $      +     BWIGM(S,ROM2,ROG2,XM1,XM2))
00309      & /(1+BETA+DELTA)
00310       RETURN
00311       END
00312  
00313       FUNCTION FORM3(MNUM,QQ,S1,SDWA)
00314 C     ==================================================================
00315 C     formfactorfor F3 for 3 scalar final state
00316 C     R. Fisher, J. Wess and F. Wagner Z. Phys C3 (1980) 313
00317 C     H. Georgi, Weak interactions and modern particle theory,
00318 C     The Benjamin/Cummings Pub. Co., Inc. 1984.
00319 C     R. Decker, E. Mirkes, R. Sauer, Z. Was Karlsruhe preprint TTP92-25
00320 C     and erratum !!!!!!
00321 C     ==================================================================
00322 C
00323       COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00324      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00325      *                 ,AMK,AMKZ,AMKST,GAMKST
00326 C
00327       REAL*4            AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00328      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00329      *                 ,AMK,AMKZ,AMKST,GAMKST
00330       COMPLEX FORM3,BWIGM
00331       COMPLEX FORMA1,FORMK1,FORMRO,FORMKS
00332       COMPLEX FA1A1P,FK1AB,F3PI
00333 C
00334       IF (MNUM.EQ.0) THEN
00335 C ------------  3 pi hadronic state (a1)
00336 C       FORMRO = FPIKM(SQRT(S1),AMPI,AMPI)
00337 C       FORMRO = F3PI(3,QQ,S1,SDWA)
00338 C       FORMA1 = FA1A1P(QQ)
00339 C       FORM3 = FORMA1*FORMRO
00340        FORM3 = F3PI(3,QQ,S1,SDWA)
00341 
00342       ELSEIF (MNUM.EQ.3) THEN
00343 C ------------ K- pi0 K0  (K*- K0)
00344        FORMKS = BWIGM(S1,AMKST,GAMKST,AMPIZ,AMK)
00345        FORMA1 = FA1A1P(QQ)
00346        FORM3 = FORMA1*FORMKS
00347 
00348       ELSEIF (MNUM.EQ.6) THEN
00349 C ------------ pi- K0B pi0 (K*- pi0)
00350        FORMKS = BWIGM(S1,AMKST,GAMKST,AMK,AMPI)
00351        FORMK1 = FK1AB(QQ,3)
00352        FORM3 = FORMK1*FORMKS
00353 
00354       ELSE
00355        FORM3=CMPLX(0.,0.)
00356       ENDIF
00357       END
00358       FUNCTION FORM4(MNUM,QQ,S1,S2,S3)
00359 C     ==================================================================
00360 C     formfactorfor F4 for 3 scalar final state
00361 C     R. Decker, in preparation
00362 C     R. Decker, E. Mirkes, R. Sauer, Z. Was Karlsruhe preprint TTP92-25
00363 C     and erratum !!!!!!
00364 C     ==================================================================
00365 C
00366       COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00367      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00368      *                 ,AMK,AMKZ,AMKST,GAMKST
00369 C
00370       REAL*4            AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00371      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00372      *                 ,AMK,AMKZ,AMKST,GAMKST
00373       COMPLEX FORM4,WIGNER,FPIKM
00374       REAL*4 M
00375 C ---- this formfactor is switched off .. .
00376        FORM4=CMPLX(0.0,0.0)
00377       END
00378       FUNCTION FORM5(MNUM,QQ,S1,S2)
00379 C     ==================================================================
00380 C     formfactorfor F5 for 3 scalar final state
00381 C     G. Kramer, W. Palmer, S. Pinsky, Phys. Rev. D30 (1984) 89.
00382 C     G. Kramer, W. Palmer             Z. Phys. C25 (1984) 195.
00383 C     R. Decker, E. Mirkes, R. Sauer, Z. Was Karlsruhe preprint TTP92-25
00384 C     and erratum !!!!!!
00385 C     ==================================================================
00386 C
00387       COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00388      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00389      *                 ,AMK,AMKZ,AMKST,GAMKST
00390 C
00391       REAL*4            AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00392      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00393      *                 ,AMK,AMKZ,AMKST,GAMKST
00394       COMPLEX FORM5,WIGNER,FPIKM,FPIKMD,BWIGM
00395       IF     (MNUM.EQ.0) THEN
00396 C ------------  3 pi hadronic state (a1)
00397         FORM5=0.0
00398       ELSEIF (MNUM.EQ.1) THEN
00399 C ------------ K- pi- K+
00400          ELPHA=-0.2
00401          FORM5=FPIKMD(SQRT(QQ),AMPI,AMPI)/(1+ELPHA)
00402      $        *(       FPIKM(SQRT(S2),AMPI,AMPI)
00403      $          +ELPHA*BWIGM(S1,AMKST,GAMKST,AMPI,AMK))
00404       ELSEIF (MNUM.EQ.2) THEN
00405 C ------------ K0 pi- K0B
00406          ELPHA=-0.2
00407          FORM5=FPIKMD(SQRT(QQ),AMPI,AMPI)/(1+ELPHA)
00408      $        *(       FPIKM(SQRT(S2),AMPI,AMPI)
00409      $          +ELPHA*BWIGM(S1,AMKST,GAMKST,AMPI,AMK))
00410       ELSEIF (MNUM.EQ.3) THEN
00411 C ------------ K- K0 pi0
00412         FORM5=0.0
00413       ELSEIF (MNUM.EQ.4) THEN
00414 C ------------ pi0 pi0 K-
00415         FORM5=0.0
00416       ELSEIF (MNUM.EQ.5) THEN
00417 C ------------ K- pi- pi+
00418         ELPHA=-0.2
00419         FORM5=BWIGM(QQ,AMKST,GAMKST,AMPI,AMK)/(1+ELPHA)
00420      $       *(       FPIKM(SQRT(S1),AMPI,AMPI)
00421      $         +ELPHA*BWIGM(S2,AMKST,GAMKST,AMPI,AMK))
00422       ELSEIF (MNUM.EQ.6) THEN
00423 C ------------ pi- K0B pi0
00424         ELPHA=-0.2
00425         FORM5=BWIGM(QQ,AMKST,GAMKST,AMPI,AMKZ)/(1+ELPHA)
00426      $       *(       FPIKM(SQRT(S2),AMPI,AMPI)
00427      $         +ELPHA*BWIGM(S1,AMKST,GAMKST,AMPI,AMK))
00428       ELSEIF (MNUM.EQ.7) THEN
00429 C -------------- eta pi- pi0 final state
00430        FORM5=FPIKMD(SQRT(QQ),AMPI,AMPI)*FPIKM(SQRT(S1),AMPI,AMPI)
00431       ENDIF
00432 C
00433       END
00434       SUBROUTINE CURRX(MNUM,PIM1,PIM2,PIM3,PIM4,HADCUR)
00435 C     ==================================================================
00436 C     hadronic current for 4 pi final state
00437 C     R. Fisher, J. Wess and F. Wagner Z. Phys C3 (1980) 313
00438 C     R. Decker Z. Phys C36 (1987) 487.
00439 C     M. Gell-Mann, D. Sharp, W. Wagner Phys. Rev. Lett 8 (1962) 261.
00440 C     ==================================================================
00441  
00442       COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00443      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00444      *                 ,AMK,AMKZ,AMKST,GAMKST
00445 C
00446       REAL*4            AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00447      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00448      *                 ,AMK,AMKZ,AMKST,GAMKST
00449       COMMON / DECPAR / GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
00450       REAL*4            GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
00451 C ARBITRARY FIXING OF THE FOUR PI X-SECTION NORMALIZATION
00452       COMMON /ARBIT/ ARFLAT,AROMEG
00453       REAL  PIM1(4),PIM2(4),PIM3(4),PIM4(4),PAA(4)
00454       COMPLEX HADCUR(4),FORM1,FORM2,FORM3,FPIKM
00455       COMPLEX BWIGN
00456       REAL PA(4),PB(4)
00457       REAL AA(4,4),PP(4,4)
00458       DATA PI /3.141592653589793238462643/
00459       DATA  FPI /93.3E-3/
00460       BWIGN(A,XM,XG)=1.0/CMPLX(A-XM**2,XM*XG)
00461 C
00462 C --- masses and constants
00463       G1=12.924
00464       G2=1475.98
00465       G =G1*G2
00466       ELPHA=-.1
00467       AMROP=1.7
00468       GAMROP=0.26
00469       AMOM=.782
00470       GAMOM=0.0085
00471       ARFLAT=1.0
00472       AROMEG=1.0
00473 C
00474       FRO=0.266*AMRO**2
00475       COEF1=2.0*SQRT(3.0)/FPI**2*ARFLAT
00476       COEF2=FRO*G*AROMEG
00477 C --- initialization of four vectors
00478       DO 7 K=1,4
00479       DO 8 L=1,4
00480  8    AA(K,L)=0.0
00481       HADCUR(K)=CMPLX(0.0)
00482       PAA(K)=PIM1(K)+PIM2(K)+PIM3(K)+PIM4(K)
00483       PP(1,K)=PIM1(K)
00484       PP(2,K)=PIM2(K)
00485       PP(3,K)=PIM3(K)
00486  7    PP(4,K)=PIM4(K)
00487 C
00488       IF (MNUM.EQ.1) THEN
00489 C ===================================================================
00490 C pi- pi- p0 pi+ case                                            ====
00491 C ===================================================================
00492        QQ=PAA(4)**2-PAA(3)**2-PAA(2)**2-PAA(1)**2
00493 C --- loop over thre contribution of the non-omega current
00494        DO 201 K=1,3
00495         SK=(PP(K,4)+PIM4(4))**2-(PP(K,3)+PIM4(3))**2
00496      $    -(PP(K,2)+PIM4(2))**2-(PP(K,1)+PIM4(1))**2
00497 C -- definition of AA matrix
00498 C -- cronecker delta
00499         DO 202 I=1,4
00500          DO 203 J=1,4
00501  203     AA(I,J)=0.0
00502  202    AA(I,I)=1.0
00503 C ... and the rest ...
00504         DO 204 L=1,3
00505          IF (L.NE.K) THEN
00506           DENOM=(PAA(4)-PP(L,4))**2-(PAA(3)-PP(L,3))**2
00507      $         -(PAA(2)-PP(L,2))**2-(PAA(1)-PP(L,1))**2
00508           DO 205 I=1,4
00509           DO 205 J=1,4
00510                       SIG= 1.0
00511            IF(J.NE.4) SIG=-SIG
00512            AA(I,J)=AA(I,J)
00513      $            -SIG*(PAA(I)-2.0*PP(L,I))*(PAA(J)-PP(L,J))/DENOM
00514  205      CONTINUE
00515          ENDIF
00516  204    CONTINUE
00517 C --- lets add something to HADCURR
00518        FORM1= FPIKM(SQRT(SK),AMPI,AMPI) *FPIKM(SQRT(QQ),AMPI,AMPI)
00519 C       FORM1= FPIKM(SQRT(SK),AMPI,AMPI) *FPIKMD(SQRT(QQ),AMPI,AMPI)
00520 CCCCCCCCCCCCCCCCC       FORM1=WIGFOR(SK,AMRO,GAMRO)      (tests)
00521 C
00522        FIX=1.0
00523        IF (K.EQ.3) FIX=-2.0
00524        DO 206 I=1,4
00525        DO 206 J=1,4
00526         HADCUR(I)=
00527      $  HADCUR(I)+CMPLX(FIX*COEF1)*FORM1*AA(I,J)*(PP(K,J)-PP(4,J))
00528  206   CONTINUE
00529 C --- end of the non omega current (3 possibilities)
00530  201   CONTINUE
00531 C
00532 C
00533 C --- there are two possibilities for omega current
00534 C --- PA PB are corresponding first and second pi-s
00535        DO 301 KK=1,2
00536         DO 302 I=1,4
00537          PA(I)=PP(KK,I)
00538          PB(I)=PP(3-KK,I)
00539  302    CONTINUE
00540 C --- lorentz invariants
00541          QQA=0.0
00542          SS23=0.0
00543          SS24=0.0
00544          SS34=0.0
00545          QP1P2=0.0
00546          QP1P3=0.0
00547          QP1P4=0.0
00548          P1P2 =0.0
00549          P1P3 =0.0
00550          P1P4 =0.0
00551         DO 303 K=1,4
00552                      SIGN=-1.0
00553          IF (K.EQ.4) SIGN= 1.0
00554          QQA=QQA+SIGN*(PAA(K)-PA(K))**2
00555          SS23=SS23+SIGN*(PB(K)  +PIM3(K))**2
00556          SS24=SS24+SIGN*(PB(K)  +PIM4(K))**2
00557          SS34=SS34+SIGN*(PIM3(K)+PIM4(K))**2
00558          QP1P2=QP1P2+SIGN*(PAA(K)-PA(K))*PB(K)
00559          QP1P3=QP1P3+SIGN*(PAA(K)-PA(K))*PIM3(K)
00560          QP1P4=QP1P4+SIGN*(PAA(K)-PA(K))*PIM4(K)
00561          P1P2=P1P2+SIGN*PA(K)*PB(K)
00562          P1P3=P1P3+SIGN*PA(K)*PIM3(K)
00563          P1P4=P1P4+SIGN*PA(K)*PIM4(K)
00564  303    CONTINUE
00565 C
00566         FORM2=COEF2*(BWIGN(QQ,AMRO,GAMRO)+ELPHA*BWIGN(QQ,AMROP,GAMROP))
00567 C        FORM3=BWIGN(QQA,AMOM,GAMOM)*(BWIGN(SS23,AMRO,GAMRO)+
00568 C     $        BWIGN(SS24,AMRO,GAMRO)+BWIGN(SS34,AMRO,GAMRO))
00569         FORM3=BWIGN(QQA,AMOM,GAMOM)
00570 C
00571         DO 304 K=1,4
00572          HADCUR(K)=HADCUR(K)+FORM2*FORM3*(
00573      $             PB  (K)*(QP1P3*P1P4-QP1P4*P1P3)
00574      $            +PIM3(K)*(QP1P4*P1P2-QP1P2*P1P4)
00575      $            +PIM4(K)*(QP1P2*P1P3-QP1P3*P1P2) )
00576  304    CONTINUE
00577  301   CONTINUE
00578 C
00579       ELSE
00580 C ===================================================================
00581 C pi0 pi0 p0 pi- case                                            ====
00582 C ===================================================================
00583        QQ=PAA(4)**2-PAA(3)**2-PAA(2)**2-PAA(1)**2
00584        DO 101 K=1,3
00585 C --- loop over thre contribution of the non-omega current
00586         SK=(PP(K,4)+PIM4(4))**2-(PP(K,3)+PIM4(3))**2
00587      $    -(PP(K,2)+PIM4(2))**2-(PP(K,1)+PIM4(1))**2
00588 C -- definition of AA matrix
00589 C -- cronecker delta
00590         DO 102 I=1,4
00591          DO 103 J=1,4
00592  103     AA(I,J)=0.0
00593  102    AA(I,I)=1.0
00594 C
00595 C ... and the rest ...
00596         DO 104 L=1,3
00597          IF (L.NE.K) THEN
00598           DENOM=(PAA(4)-PP(L,4))**2-(PAA(3)-PP(L,3))**2
00599      $         -(PAA(2)-PP(L,2))**2-(PAA(1)-PP(L,1))**2
00600           DO 105 I=1,4
00601           DO 105 J=1,4
00602                       SIG=1.0
00603            IF(J.NE.4) SIG=-SIG
00604            AA(I,J)=AA(I,J)
00605      $            -SIG*(PAA(I)-2.0*PP(L,I))*(PAA(J)-PP(L,J))/DENOM
00606  105      CONTINUE
00607          ENDIF
00608  104    CONTINUE
00609 C --- lets add something to HADCURR
00610        FORM1= FPIKM(SQRT(SK),AMPI,AMPI) *FPIKM(SQRT(QQ),AMPI,AMPI)
00611 C       FORM1= FPIKM(SQRT(SK),AMPI,AMPI) *FPIKMD(SQRT(QQ),AMPI,AMPI)
00612 CCCCCCCCCCCCC       FORM1=WIGFOR(SK,AMRO,GAMRO)        (tests)
00613         DO 106 I=1,4
00614         DO 106 J=1,4
00615          HADCUR(I)=
00616      $   HADCUR(I)+CMPLX(COEF1)*FORM1*AA(I,J)*(PP(K,J)-PP(4,J))
00617  106    CONTINUE
00618 C --- end of the non omega current (3 possibilities)
00619  101   CONTINUE
00620       ENDIF
00621       END
00622       FUNCTION WIGFOR(S,XM,XGAM)
00623       COMPLEX WIGFOR,WIGNOR
00624       WIGNOR=CMPLX(-XM**2,XM*XGAM)
00625       WIGFOR=WIGNOR/CMPLX(S-XM**2,XM*XGAM)
00626       END
00627       SUBROUTINE CURINF
00628 C HERE the form factors of M. Finkemeier et al. start
00629 C it ends with the string:  M. Finkemeier et al. END
00630       COMMON /INOUT/ INUT, IOUT
00631       WRITE (UNIT = IOUT,FMT = 99)
00632       WRITE (UNIT = IOUT,FMT = 98)
00633 c                    print *, 'here is curinf'
00634  99   FORMAT(
00635      . /,   ' *************************************************** ',
00636      . /,   '   YOU ARE USING THE 4 PION DECAY MODE FORM FACTORS    ',
00637      . /,   '   WHICH HAVE BEEN DESCRIBED IN:',
00638      . /,   '   R. DECKER, M. FINKEMEIER, P. HEILIGER AND H.H. JONSSON',
00639      . /,   '   "TAU DECAYS INTO FOUR PIONS" ',
00640      . /,   '   UNIVERSITAET KARLSRUHE PREPRINT TTP 94-13 (1994);',
00641      . /,   '                    LNF-94/066(IR); HEP-PH/9410260  ',
00642      . /,   '  ',
00643      . /,   ' PLEASE NOTE THAT THIS ROUTINE IS USING PARAMETERS',
00644      . /,   ' RELATED TO THE 3 PION DECAY MODE (A1 MODE), SUCH AS',
00645      . /,   ' THE A1 MASS AND WIDTH (TAKEN FROM THE COMMON /PARMAS/)',
00646      . /,   ' AND THE 2 PION VECTOR RESONANCE FORM FACTOR (BY USING',
00647      . /,   ' THE ROUTINE FPIKM)'                                   ,
00648      . /,   ' THUS IF YOU DECIDE TO CHANGE ANY OF THESE, YOU WILL'  ,
00649      . /,   ' HAVE TO REFIT THE 4 PION PARAMETERS IN THE COMMON'    )
00650    98   FORMAT(
00651      .      ' BLOCK /TAU4PI/, OR YOU MIGHT GET A BAD DISCRIPTION'   ,
00652      . /,   ' OF TAU -> 4 PIONS'       ,
00653      . /,   ' for these formfactors set in routine CHOICE for',
00654      . /,  ' mnum.eq.102 -- AMRX=1.42 and GAMRX=.21',
00655      . /,  ' mnum.eq.101 -- AMRX=1.3 and GAMRX=.46 PROB1,PROB2=0.2',
00656      . /,  ' to optimize phase space parametrization',
00657      . /,   ' *************************************************** ',
00658      . /,   ' coded by M. Finkemeier and P. Heiliger, 29. sept. 1994',
00659      . /,   ' incorporated to TAUOLA by Z. Was      17. jan. 1995',
00660 c     . /,   ' fitted on (day/month/year) by ...  ',
00661 c     . /,   ' to .... data ',
00662      . /,   ' changed by: Z. Was on 17.01.95',
00663      . /,   ' changes by: M. Finkemeier on 30.01.95' )
00664       END
00665 C
00666       SUBROUTINE CURINI
00667       COMMON /TAU4PI/ GOMEGA,GAMMA1,GAMMA2,ROM1,ROG1,BETA1,
00668      .                ROM2,ROG2,BETA2
00669       REAL*4          GOMEGA,GAMMA1,GAMMA2,ROM1,ROG1,BETA1,
00670      .                ROM2,ROG2,BETA2
00671       GOMEGA = 1.4
00672       GAMMA1 = 0.38
00673       GAMMA2 = 0.38
00674       ROM1   = 1.35
00675       ROG1   = 0.3
00676       BETA1  = 0.08
00677       ROM2   = 1.70
00678       ROG2   = 0.235
00679       BETA2  = -0.0075                          
00680       END                                               
00681       COMPLEX FUNCTION BWIGA1(QA)
00682 C     ================================================================
00683 C     breit-wigner enhancement of a1
00684 C     ================================================================
00685       COMPLEX WIGNER
00686       COMMON / PARMAS/ AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU,
00687      %                 AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1,
00688      %                 AMK,AMKZ,AMKST,GAMKST
00689  
00690 C
00691       REAL*4           AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU,
00692      %                 AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1,
00693      %                 AMK,AMKZ,AMKST,GAMKST
00694  
00695       WIGNER(A,B,C)=CMPLX(1.0,0.0)/CMPLX(A-B**2,B*C)
00696       GAMAX=GAMA1*GFUN(QA)/GFUN(AMA1**2)
00697       BWIGA1=-AMA1**2*WIGNER(QA,AMA1,GAMAX)
00698       RETURN
00699       END
00700       COMPLEX FUNCTION BWIGEPS(QEPS)
00701 C     =============================================================
00702 C     breit-wigner enhancement of epsilon
00703 C     =============================================================
00704       REAL QEPS,MEPS,GEPS
00705       MEPS=1.300
00706       GEPS=.600
00707       BWIGEPS=CMPLX(MEPS**2,-MEPS*GEPS)/
00708      %        CMPLX(MEPS**2-QEPS,-MEPS*GEPS)
00709       RETURN
00710       END
00711       COMPLEX FUNCTION FRHO4(W,XM1,XM2)
00712 C     ===========================================================
00713 C     rho-type resonance factor with higher radials, to be used
00714 C     by CURR for the four pion mode
00715 C     ===========================================================
00716       COMPLEX BWIGM
00717       COMMON /TAU4PI/ GOMEGA,GAMMA1,GAMMA2,ROM1,ROG1,BETA1,
00718      .                ROM2,ROG2,BETA2
00719       REAL*4          GOMEGA,GAMMA1,GAMMA2,ROM1,ROG1,BETA1,
00720      .                ROM2,ROG2,BETA2
00721       REAL ROM,ROG,PI,PIM,S,W
00722       EXTERNAL BWIG
00723       DATA  INIT /0/
00724 C
00725 C ------------ PARAMETERS --------------------
00726       IF (INIT.EQ.0 ) THEN
00727       INIT=1
00728       PI=3.141592654
00729       PIM=.140
00730       ROM=0.773
00731       ROG=0.145
00732       ENDIF
00733 C -----------------------------------------------
00734       S=W**2
00735 c              print *,'rom2,rog2 =',rom2,rog2
00736       FRHO4=(BWIGM(S,ROM,ROG,XM1,XM2)+BETA1*BWIGM(S,ROM1,ROG1,XM1,XM2)
00737      & +BETA2*BWIGM(S,ROM2,ROG2,XM1,XM2))
00738      & /(1+BETA1+BETA2)
00739       RETURN
00740       END
00741       SUBROUTINE CURR(MNUM,PIM1,PIM2,PIM3,PIM4,HADCUR)
00742 C     ==================================================================
00743 C     Hadronic current for 4 pi final state, according to:
00744 C     R. Decker, M. Finkemeier, P. Heiliger, H.H.Jonsson, TTP94-13
00745 C
00746 C     See also:
00747 C     R. Fisher, J. Wess and F. Wagner Z. Phys C3 (1980) 313
00748 C     R. Decker Z. Phys C36 (1987) 487.
00749 C     M. Gell-Mann, D. Sharp, W. Wagner Phys. Rev. Lett 8 (1962) 261.
00750 C     ==================================================================
00751  
00752       COMMON /TAU4PI/ GOMEGA,GAMMA1,GAMMA2,ROM1,ROG1,BETA1,
00753      .                ROM2,ROG2,BETA2
00754       REAL*4          GOMEGA,GAMMA1,GAMMA2,ROM1,ROG1,BETA1,
00755      .                ROM2,ROG2,BETA2
00756       COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00757      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00758      *                 ,AMK,AMKZ,AMKST,GAMKST
00759 C
00760       REAL*4            AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00761      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00762      *                 ,AMK,AMKZ,AMKST,GAMKST
00763       COMMON / DECPAR / GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
00764       REAL*4            GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
00765       REAL  PIM1(4),PIM2(4),PIM3(4),PIM4(4),PAA(4)
00766       COMPLEX HADCUR(4),FORM1,FORM2,FORM3,FPIKM
00767       COMPLEX BWIGN,FRHO4
00768       COMPLEX BWIGEPS,BWIGA1
00769       COMPLEX HCOMP1(4),HCOMP2(4),HCOMP3(4),HCOMP4(4)
00770  
00771       COMPLEX T243,T213,T143,T123,T341,T342
00772       COMPLEX T124,T134,T214,T234,T314,T324
00773       COMPLEX S2413,S2314,S1423,S1324,S34
00774       COMPLEX S2431,S3421
00775       COMPLEX BRACK1,BRACK2,BRACK3,BRACK4A,BRACK4B,BRACK4
00776  
00777       REAL QMP1,QMP2,QMP3,QMP4
00778       REAL PS43,PS41,PS42,PS34,PS14,PS13,PS24,PS23
00779       REAL PS21,PS31
00780  
00781       REAL PD243,PD241,PD213,PD143,PD142
00782       REAL PD123,PD341,PD342,PD413,PD423
00783       REAL PD124,PD134,PD214,PD234,PD314,PD324
00784       REAL QP1,QP2,QP3,QP4
00785  
00786       REAL PA(4),PB(4)
00787       REAL AA(4,4),PP(4,4)
00788       DATA PI /3.141592653589793238462643/
00789       DATA  FPI /93.3E-3/
00790       DATA INIT /0/     
00791       BWIGN(A,XM,XG)=1.0/CMPLX(A-XM**2,XM*XG)
00792 C
00793       IF (INIT.EQ.0) THEN
00794         CALL CURINI
00795         CALL CURINF
00796         INIT = 1
00797       ENDIF                     
00798 C
00799 C --- MASSES AND CONSTANTS
00800       G1=12.924
00801       G2=1475.98 * GOMEGA
00802       G =G1*G2
00803       ELPHA=-.1
00804       AMROP=1.7
00805       GAMROP=0.26
00806       AMOM=.782
00807       GAMOM=0.0085
00808       ARFLAT=1.0
00809       AROMEG=1.0
00810 C
00811       FRO=0.266*AMRO**2
00812       COEF1=2.0*SQRT(3.0)/FPI**2*ARFLAT
00813       COEF2=FRO*G*AROMEG
00814 C --- INITIALIZATION OF FOUR VECTORS
00815       DO 7 K=1,4
00816       DO 8 L=1,4
00817  8    AA(K,L)=0.0
00818       HADCUR(K)=CMPLX(0.0)
00819       PAA(K)=PIM1(K)+PIM2(K)+PIM3(K)+PIM4(K)
00820       PP(1,K)=PIM1(K)
00821       PP(2,K)=PIM2(K)
00822       PP(3,K)=PIM3(K)
00823  7    PP(4,K)=PIM4(K)
00824 C
00825       IF (MNUM.EQ.1) THEN
00826 C ===================================================================
00827 C PI- PI- P0 PI+ CASE                                            ====
00828 C ===================================================================
00829        QQ=PAA(4)**2-PAA(3)**2-PAA(2)**2-PAA(1)**2
00830  
00831 C FIRST DEFINITION OF SCALAR PRODUCTS OF MOMENTUM VECTORS
00832  
00833 C DEFINE (Q-PI)**2 AS QPI:
00834  
00835       QMP1=(PIM2(4)+PIM3(4)+PIM4(4))**2-(PIM2(3)+PIM3(3)+PIM4(3))**2
00836      %   -(PIM2(2)+PIM3(2)+PIM4(2))**2-(PIM2(1)+PIM3(1)+PIM4(1))**2
00837  
00838       QMP2=(PIM1(4)+PIM3(4)+PIM4(4))**2-(PIM1(3)+PIM3(3)+PIM4(3))**2
00839      %   -(PIM1(2)+PIM3(2)+PIM4(2))**2-(PIM1(1)+PIM3(1)+PIM4(1))**2
00840  
00841       QMP3=(PIM1(4)+PIM2(4)+PIM4(4))**2-(PIM1(3)+PIM2(3)+PIM4(3))**2
00842      %   -(PIM1(2)+PIM2(2)+PIM4(2))**2-(PIM1(1)+PIM2(1)+PIM4(1))**2
00843  
00844       QMP4=(PIM1(4)+PIM2(4)+PIM3(4))**2-(PIM1(3)+PIM2(3)+PIM3(3))**2
00845      %   -(PIM1(2)+PIM2(2)+PIM3(2))**2-(PIM1(1)+PIM2(1)+PIM3(1))**2
00846  
00847  
00848 C DEFINE (PI+PK)**2 AS PSIK:
00849  
00850       PS43=(PIM4(4)+PIM3(4))**2-(PIM4(3)+PIM3(3))**2
00851      %    -(PIM4(2)+PIM3(2))**2-(PIM4(1)+PIM3(1))**2
00852  
00853       PS41=(PIM4(4)+PIM1(4))**2-(PIM4(3)+PIM1(3))**2
00854      %    -(PIM4(2)+PIM1(2))**2-(PIM4(1)+PIM1(1))**2
00855  
00856       PS42=(PIM4(4)+PIM2(4))**2-(PIM4(3)+PIM2(3))**2
00857      %    -(PIM4(2)+PIM2(2))**2-(PIM4(1)+PIM2(1))**2
00858  
00859       PS34=PS43
00860  
00861       PS14=PS41
00862  
00863       PS13=(PIM1(4)+PIM3(4))**2-(PIM1(3)+PIM3(3))**2
00864      %    -(PIM1(2)+PIM3(2))**2-(PIM1(1)+PIM3(1))**2
00865  
00866       PS24=PS42
00867  
00868       PS23=(PIM2(4)+PIM3(4))**2-(PIM2(3)+PIM3(3))**2
00869      %    -(PIM2(2)+PIM3(2))**2-(PIM2(1)+PIM3(1))**2
00870  
00871       PD243=PIM2(4)*(PIM4(4)-PIM3(4))-PIM2(3)*(PIM4(3)-PIM3(3))
00872      %     -PIM2(2)*(PIM4(2)-PIM3(2))-PIM2(1)*(PIM4(1)-PIM3(1))
00873  
00874       PD241=PIM2(4)*(PIM4(4)-PIM1(4))-PIM2(3)*(PIM4(3)-PIM1(3))
00875      %     -PIM2(2)*(PIM4(2)-PIM1(2))-PIM2(1)*(PIM4(1)-PIM1(1))
00876  
00877       PD213=PIM2(4)*(PIM1(4)-PIM3(4))-PIM2(3)*(PIM1(3)-PIM3(3))
00878      %     -PIM2(2)*(PIM1(2)-PIM3(2))-PIM2(1)*(PIM1(1)-PIM3(1))
00879  
00880       PD143=PIM1(4)*(PIM4(4)-PIM3(4))-PIM1(3)*(PIM4(3)-PIM3(3))
00881      %     -PIM1(2)*(PIM4(2)-PIM3(2))-PIM1(1)*(PIM4(1)-PIM3(1))
00882  
00883       PD142=PIM1(4)*(PIM4(4)-PIM2(4))-PIM1(3)*(PIM4(3)-PIM2(3))
00884      %     -PIM1(2)*(PIM4(2)-PIM2(2))-PIM1(1)*(PIM4(1)-PIM2(1))
00885  
00886       PD123=PIM1(4)*(PIM2(4)-PIM3(4))-PIM1(3)*(PIM2(3)-PIM3(3))
00887      %     -PIM1(2)*(PIM2(2)-PIM3(2))-PIM1(1)*(PIM2(1)-PIM3(1))
00888  
00889       PD341=PIM3(4)*(PIM4(4)-PIM1(4))-PIM3(3)*(PIM4(3)-PIM1(3))
00890      %     -PIM3(2)*(PIM4(2)-PIM1(2))-PIM3(1)*(PIM4(1)-PIM1(1))
00891  
00892       PD342=PIM3(4)*(PIM4(4)-PIM2(4))-PIM3(3)*(PIM4(3)-PIM2(3))
00893      %     -PIM3(2)*(PIM4(2)-PIM2(2))-PIM3(1)*(PIM4(1)-PIM2(1))
00894  
00895       PD413=PIM4(4)*(PIM1(4)-PIM3(4))-PIM4(3)*(PIM1(3)-PIM3(3))
00896      %     -PIM4(2)*(PIM1(2)-PIM3(2))-PIM4(1)*(PIM1(1)-PIM3(1))
00897  
00898       PD423=PIM4(4)*(PIM2(4)-PIM3(4))-PIM4(3)*(PIM2(3)-PIM3(3))
00899      %     -PIM4(2)*(PIM2(2)-PIM3(2))-PIM4(1)*(PIM2(1)-PIM3(1))
00900  
00901 C DEFINE Q*PI = QPI:
00902  
00903       QP1=PIM1(4)*(PIM1(4)+PIM2(4)+PIM3(4)+PIM4(4))
00904      %   -PIM1(3)*(PIM1(3)+PIM2(3)+PIM3(3)+PIM4(3))
00905      %   -PIM1(2)*(PIM1(2)+PIM2(2)+PIM3(2)+PIM4(2))
00906      %   -PIM1(1)*(PIM1(1)+PIM2(1)+PIM3(1)+PIM4(1))
00907  
00908       QP2=PIM2(4)*(PIM1(4)+PIM2(4)+PIM3(4)+PIM4(4))
00909      %   -PIM2(3)*(PIM1(3)+PIM2(3)+PIM3(3)+PIM4(3))
00910      %   -PIM2(2)*(PIM1(2)+PIM2(2)+PIM3(2)+PIM4(2))
00911      %   -PIM2(1)*(PIM1(1)+PIM2(1)+PIM3(1)+PIM4(1))
00912  
00913       QP3=PIM3(4)*(PIM1(4)+PIM2(4)+PIM3(4)+PIM4(4))
00914      %   -PIM3(3)*(PIM1(3)+PIM2(3)+PIM3(3)+PIM4(3))
00915      %   -PIM3(2)*(PIM1(2)+PIM2(2)+PIM3(2)+PIM4(2))
00916      %   -PIM3(1)*(PIM1(1)+PIM2(1)+PIM3(1)+PIM4(1))
00917  
00918       QP4=PIM4(4)*(PIM1(4)+PIM2(4)+PIM3(4)+PIM4(4))
00919      %   -PIM4(3)*(PIM1(3)+PIM2(3)+PIM3(3)+PIM4(3))
00920      %   -PIM4(2)*(PIM1(2)+PIM2(2)+PIM3(2)+PIM4(2))
00921      %   -PIM4(1)*(PIM1(1)+PIM2(1)+PIM3(1)+PIM4(1))
00922  
00923  
00924  
00925 C DEFINE T(PI;PJ,PK)= TIJK:
00926  
00927       T243=BWIGA1(QMP2)*FPIKM(SQRT(PS43),AMPI,AMPI)*GAMMA1
00928       T213=BWIGA1(QMP2)*FPIKM(SQRT(PS13),AMPI,AMPI)*GAMMA1
00929       T143=BWIGA1(QMP1)*FPIKM(SQRT(PS43),AMPI,AMPI)*GAMMA1
00930       T123=BWIGA1(QMP1)*FPIKM(SQRT(PS23),AMPI,AMPI)*GAMMA1
00931       T341=BWIGA1(QMP3)*FPIKM(SQRT(PS41),AMPI,AMPI)*GAMMA1
00932       T342=BWIGA1(QMP3)*FPIKM(SQRT(PS42),AMPI,AMPI)*GAMMA1
00933  
00934 C DEFINE S(I,J;K,L)= SIJKL:
00935  
00936       S2413=FRHO4(SQRT(PS24),AMPI,AMPI)*GAMMA2
00937       S2314=FRHO4(SQRT(PS23),AMPI,AMPI)*BWIGEPS(PS14)*GAMMA2
00938       S1423=FRHO4(SQRT(PS14),AMPI,AMPI)*GAMMA2
00939       S1324=FRHO4(SQRT(PS13),AMPI,AMPI)*BWIGEPS(PS24)*GAMMA2
00940       S34=FRHO4(SQRT(PS34),AMPI,AMPI)*GAMMA2
00941  
00942 C DEFINITION OF AMPLITUDE, FIRST THE [] BRACKETS:
00943  
00944       BRACK1=2.*T143+2.*T243+T123+T213
00945      %    +T341*(PD241/QMP3-1.)+T342*(PD142/QMP3-1.)
00946      %    +3./4.*(S1423+S2413-S2314-S1324)-3.*S34
00947  
00948       BRACK2=2.*T143*PD243/QMP1+3.*T213
00949      %    +T123*(2.*PD423/QMP1+1.)+T341*(PD241/QMP3+3.)
00950      %    +T342*(PD142/QMP3+1.)
00951      %    -3./4.*(S2314+3.*S1324+3.*S1423+S2413)
00952  
00953       BRACK3=2.*T243*PD143/QMP2+3.*T123
00954      %    +T213*(2.*PD413/QMP2+1.)+T341*(PD241/QMP3+1.)
00955      %    +T342*(PD142/QMP3+3.)
00956      %    -3./4.*(3.*S2314+S1324+S1423+3.*S2413)
00957  
00958       BRACK4A=2.*T143*(PD243/QQ*(QP1/QMP1+1.)+PD143/QQ)
00959      %     +2.*T243*(PD143/QQ*(QP2/QMP2+1.)+PD243/QQ)
00960      %     +T123+T213
00961      %     +2.*T123*(PD423/QQ*(QP1/QMP1+1.)+PD123/QQ)
00962      %     +2.*T213*(PD413/QQ*(QP2/QMP2+1.)+PD213/QQ)
00963      %     +T341*(PD241/QMP3+1.-2.*PD241/QQ*(QP3/QMP3+1.)
00964      %           -2.*PD341/QQ)
00965      %     +T342*(PD142/QMP3+1.-2.*PD142/QQ*(QP3/QMP3+1.)
00966      %           -2.*PD342/QQ)
00967  
00968       BRACK4B=-3./4.*(S2314*(2.*(QP2-QP3)/QQ+1.)
00969      %             +S1324*(2.*(QP1-QP3)/QQ+1.)
00970      %             +S1423*(2.*(QP1-QP4)/QQ+1.)
00971      %             +S2413*(2.*(QP2-QP4)/QQ+1.)
00972      %             +4.*S34*(QP4-QP3)/QQ)
00973  
00974       BRACK4=BRACK4A+BRACK4B
00975  
00976       DO 208 K=1,4
00977  
00978       HCOMP1(K)=(PIM3(K)-PIM4(K))*BRACK1
00979       HCOMP2(K)=PIM1(K)*BRACK2
00980       HCOMP3(K)=PIM2(K)*BRACK3
00981       HCOMP4(K)=(PIM1(K)+PIM2(K)+PIM3(K)+PIM4(K))*BRACK4
00982  
00983  208  CONTINUE
00984  
00985       DO 209 I=1,4
00986  
00987       HADCUR(I)=HCOMP1(I)-HCOMP2(I)-HCOMP3(I)+HCOMP4(I)
00988       HADCUR(I)=-COEF1*FRHO4(SQRT(QQ),AMPI,AMPI)*HADCUR(I)
00989  
00990  209  CONTINUE
00991  
00992  
00993 C --- END OF THE NON OMEGA CURRENT (3 POSSIBILITIES)
00994  201   CONTINUE
00995 C
00996 C
00997 C --- THERE ARE TWO POSSIBILITIES FOR OMEGA CURRENT
00998 C --- PA PB ARE CORRESPONDING FIRST AND SECOND PI-S
00999        DO 301 KK=1,2
01000         DO 302 I=1,4
01001          PA(I)=PP(KK,I)
01002          PB(I)=PP(3-KK,I)
01003  302    CONTINUE
01004 C --- LORENTZ INVARIANTS
01005          QQA=0.0
01006          SS23=0.0
01007          SS24=0.0
01008          SS34=0.0
01009          QP1P2=0.0
01010          QP1P3=0.0
01011          QP1P4=0.0
01012          P1P2 =0.0
01013          P1P3 =0.0
01014          P1P4 =0.0
01015         DO 303 K=1,4
01016                      SIGN=-1.0
01017          IF (K.EQ.4) SIGN= 1.0
01018          QQA=QQA+SIGN*(PAA(K)-PA(K))**2
01019          SS23=SS23+SIGN*(PB(K)  +PIM3(K))**2
01020          SS24=SS24+SIGN*(PB(K)  +PIM4(K))**2
01021          SS34=SS34+SIGN*(PIM3(K)+PIM4(K))**2
01022          QP1P2=QP1P2+SIGN*(PAA(K)-PA(K))*PB(K)
01023          QP1P3=QP1P3+SIGN*(PAA(K)-PA(K))*PIM3(K)
01024          QP1P4=QP1P4+SIGN*(PAA(K)-PA(K))*PIM4(K)
01025          P1P2=P1P2+SIGN*PA(K)*PB(K)
01026          P1P3=P1P3+SIGN*PA(K)*PIM3(K)
01027          P1P4=P1P4+SIGN*PA(K)*PIM4(K)
01028  303    CONTINUE
01029 C
01030         FORM2=COEF2*(BWIGN(QQ,AMRO,GAMRO)+ELPHA*BWIGN(QQ,AMROP,GAMROP))
01031 C        FORM3=BWIGN(QQA,AMOM,GAMOM)*(BWIGN(SS23,AMRO,GAMRO)+
01032 C     $        BWIGN(SS24,AMRO,GAMRO)+BWIGN(SS34,AMRO,GAMRO))
01033         FORM3=BWIGN(QQA,AMOM,GAMOM)
01034 C
01035         DO 304 K=1,4
01036           HADCUR(K)=HADCUR(K)+FORM2*FORM3*(
01037      $              PB  (K)*(QP1P3*P1P4-QP1P4*P1P3)
01038      $             +PIM3(K)*(QP1P4*P1P2-QP1P2*P1P4)
01039      $             +PIM4(K)*(QP1P2*P1P3-QP1P3*P1P2) )
01040  304    CONTINUE
01041  301   CONTINUE
01042 C
01043       ELSE
01044 C ===================================================================
01045 C PI0 PI0 P0 PI- CASE                                            ====
01046 C ===================================================================
01047        QQ=PAA(4)**2-PAA(3)**2-PAA(2)**2-PAA(1)**2
01048  
01049  
01050 C FIRST DEFINITION OF SCALAR PRODUCTS OF MOMENTUM VECTORS
01051  
01052 C DEFINE (Q-PI)**2 AS QPI:
01053  
01054       QMP1=(PIM2(4)+PIM3(4)+PIM4(4))**2-(PIM2(3)+PIM3(3)+PIM4(3))**2
01055      %   -(PIM2(2)+PIM3(2)+PIM4(2))**2-(PIM2(1)+PIM3(1)+PIM4(1))**2
01056  
01057       QMP2=(PIM1(4)+PIM3(4)+PIM4(4))**2-(PIM1(3)+PIM3(3)+PIM4(3))**2
01058      %   -(PIM1(2)+PIM3(2)+PIM4(2))**2-(PIM1(1)+PIM3(1)+PIM4(1))**2
01059  
01060       QMP3=(PIM1(4)+PIM2(4)+PIM4(4))**2-(PIM1(3)+PIM2(3)+PIM4(3))**2
01061      %   -(PIM1(2)+PIM2(2)+PIM4(2))**2-(PIM1(1)+PIM2(1)+PIM4(1))**2
01062  
01063       QMP4=(PIM1(4)+PIM2(4)+PIM3(4))**2-(PIM1(3)+PIM2(3)+PIM3(3))**2
01064      %   -(PIM1(2)+PIM2(2)+PIM3(2))**2-(PIM1(1)+PIM2(1)+PIM3(1))**2
01065  
01066  
01067 C DEFINE (PI+PK)**2 AS PSIK:
01068  
01069       PS14=(PIM1(4)+PIM4(4))**2-(PIM1(3)+PIM4(3))**2
01070      %    -(PIM1(2)+PIM4(2))**2-(PIM1(1)+PIM4(1))**2
01071  
01072       PS21=(PIM2(4)+PIM1(4))**2-(PIM2(3)+PIM1(3))**2
01073      %    -(PIM2(2)+PIM1(2))**2-(PIM2(1)+PIM1(1))**2
01074  
01075       PS23=(PIM2(4)+PIM3(4))**2-(PIM2(3)+PIM3(3))**2
01076      %    -(PIM2(2)+PIM3(2))**2-(PIM2(1)+PIM3(1))**2
01077  
01078       PS24=(PIM2(4)+PIM4(4))**2-(PIM2(3)+PIM4(3))**2
01079      %    -(PIM2(2)+PIM4(2))**2-(PIM2(1)+PIM4(1))**2
01080  
01081       PS31=(PIM3(4)+PIM1(4))**2-(PIM3(3)+PIM1(3))**2
01082      %    -(PIM3(2)+PIM1(2))**2-(PIM3(1)+PIM1(1))**2
01083  
01084       PS34=(PIM3(4)+PIM4(4))**2-(PIM3(3)+PIM4(3))**2
01085      %    -(PIM3(2)+PIM4(2))**2-(PIM3(1)+PIM4(1))**2
01086  
01087  
01088  
01089       PD324=PIM3(4)*(PIM2(4)-PIM4(4))-PIM3(3)*(PIM2(3)-PIM4(3))
01090      %     -PIM3(2)*(PIM2(2)-PIM4(2))-PIM3(1)*(PIM2(1)-PIM4(1))
01091  
01092       PD314=PIM3(4)*(PIM1(4)-PIM4(4))-PIM3(3)*(PIM1(3)-PIM4(3))
01093      %     -PIM3(2)*(PIM1(2)-PIM4(2))-PIM3(1)*(PIM1(1)-PIM4(1))
01094  
01095       PD234=PIM2(4)*(PIM3(4)-PIM4(4))-PIM2(3)*(PIM3(3)-PIM4(3))
01096      %     -PIM2(2)*(PIM3(2)-PIM4(2))-PIM2(1)*(PIM3(1)-PIM4(1))
01097  
01098       PD214=PIM2(4)*(PIM1(4)-PIM4(4))-PIM2(3)*(PIM1(3)-PIM4(3))
01099      %     -PIM2(2)*(PIM1(2)-PIM4(2))-PIM2(1)*(PIM1(1)-PIM4(1))
01100  
01101       PD134=PIM1(4)*(PIM3(4)-PIM4(4))-PIM1(3)*(PIM3(3)-PIM4(3))
01102      %     -PIM1(2)*(PIM3(2)-PIM4(2))-PIM1(1)*(PIM3(1)-PIM4(1))
01103  
01104       PD124=PIM1(4)*(PIM2(4)-PIM4(4))-PIM1(3)*(PIM2(3)-PIM4(3))
01105      %     -PIM1(2)*(PIM2(2)-PIM4(2))-PIM1(1)*(PIM2(1)-PIM4(1))
01106  
01107 C DEFINE Q*PI = QPI:
01108  
01109       QP1=PIM1(4)*(PIM1(4)+PIM2(4)+PIM3(4)+PIM4(4))
01110      %   -PIM1(3)*(PIM1(3)+PIM2(3)+PIM3(3)+PIM4(3))
01111      %   -PIM1(2)*(PIM1(2)+PIM2(2)+PIM3(2)+PIM4(2))
01112      %   -PIM1(1)*(PIM1(1)+PIM2(1)+PIM3(1)+PIM4(1))
01113  
01114       QP2=PIM2(4)*(PIM1(4)+PIM2(4)+PIM3(4)+PIM4(4))
01115      %   -PIM2(3)*(PIM1(3)+PIM2(3)+PIM3(3)+PIM4(3))
01116      %   -PIM2(2)*(PIM1(2)+PIM2(2)+PIM3(2)+PIM4(2))
01117      %   -PIM2(1)*(PIM1(1)+PIM2(1)+PIM3(1)+PIM4(1))
01118  
01119       QP3=PIM3(4)*(PIM1(4)+PIM2(4)+PIM3(4)+PIM4(4))
01120      %   -PIM3(3)*(PIM1(3)+PIM2(3)+PIM3(3)+PIM4(3))
01121      %   -PIM3(2)*(PIM1(2)+PIM2(2)+PIM3(2)+PIM4(2))
01122      %   -PIM3(1)*(PIM1(1)+PIM2(1)+PIM3(1)+PIM4(1))
01123  
01124       QP4=PIM4(4)*(PIM1(4)+PIM2(4)+PIM3(4)+PIM4(4))
01125      %   -PIM4(3)*(PIM1(3)+PIM2(3)+PIM3(3)+PIM4(3))
01126      %   -PIM4(2)*(PIM1(2)+PIM2(2)+PIM3(2)+PIM4(2))
01127      %   -PIM4(1)*(PIM1(1)+PIM2(1)+PIM3(1)+PIM4(1))
01128  
01129  
01130 C DEFINE T(PI;PJ,PK)= TIJK:
01131  
01132       T324=BWIGA1(QMP3)*FPIKM(SQRT(PS24),AMPI,AMPI)*GAMMA1
01133       T314=BWIGA1(QMP3)*FPIKM(SQRT(PS14),AMPI,AMPI)*GAMMA1
01134       T234=BWIGA1(QMP2)*FPIKM(SQRT(PS34),AMPI,AMPI)*GAMMA1
01135       T214=BWIGA1(QMP2)*FPIKM(SQRT(PS14),AMPI,AMPI)*GAMMA1
01136       T134=BWIGA1(QMP1)*FPIKM(SQRT(PS34),AMPI,AMPI)*GAMMA1
01137       T124=BWIGA1(QMP1)*FPIKM(SQRT(PS24),AMPI,AMPI)*GAMMA1
01138  
01139 C DEFINE S(I,J;K,L)= SIJKL:
01140  
01141       S1423=FRHO4(SQRT(PS14),AMPI,AMPI)*BWIGEPS(PS23)*GAMMA2
01142       S2431=FRHO4(SQRT(PS24),AMPI,AMPI)*BWIGEPS(PS31)*GAMMA2
01143       S3421=FRHO4(SQRT(PS34),AMPI,AMPI)*BWIGEPS(PS21)*GAMMA2
01144  
01145  
01146 C DEFINITION OF AMPLITUDE, FIRST THE [] BRACKETS:
01147  
01148       BRACK1=T234+T324+2.*T314+T134+2.*T214+T124
01149      %    +T134*PD234/QMP1+T124*PD324/QMP1
01150      %    -3./2.*(S3421+S2431+2.*S1423)
01151  
01152  
01153       BRACK2=T234*(1.+2.*PD134/QMP2)+3.*T324+3.*T124
01154      %    +T134*(1.-PD234/QMP1)+2.*T214*PD314/QMP2
01155      %    -T124*PD324/QMP1
01156      %    -3./2.*(S3421+3.*S2431)
01157  
01158       BRACK3=T324*(1.+2.*PD124/QMP3)+3.*T234+3.*T134
01159      %    +T124*(1.-PD324/QMP1)+2.*T314*PD214/QMP3
01160      %    -T134*PD234/QMP1
01161      %    -3./2.*(3.*S3421+S2431)
01162  
01163       BRACK4A=2.*T234*(1./2.+PD134/QQ*(QP2/QMP2+1.)+PD234/QQ)
01164      %     +2.*T324*(1./2.+PD124/QQ*(QP3/QMP3+1.)+PD324/QQ)
01165      %     +2.*T134*(1./2.+PD234/QQ*(QP1/QMP1+1.)
01166      %              -1./2.*PD234/QMP1+PD134/QQ)
01167      %     +2.*T124*(1./2.+PD324/QQ*(QP1/QMP1+1.)
01168      %              -1./2.*PD324/QMP1+PD124/QQ)
01169      %     +2.*T214*(PD314/QQ*(QP2/QMP2+1.)+PD214/QQ)
01170      %     +2.*T314*(PD214/QQ*(QP3/QMP3+1.)+PD314/QQ)
01171  
01172       BRACK4B=-3./2.*(S3421*(2.*(QP3-QP4)/QQ+1.)
01173      %             +S2431*(2.*(QP2-QP4)/QQ+1.)
01174      %             +S1423*2.*(QP1-QP4)/QQ)
01175  
01176  
01177       BRACK4=BRACK4A+BRACK4B
01178  
01179       DO 308 K=1,4
01180  
01181       HCOMP1(K)=(PIM1(K)-PIM4(K))*BRACK1
01182       HCOMP2(K)=PIM2(K)*BRACK2
01183       HCOMP3(K)=PIM3(K)*BRACK3
01184       HCOMP4(K)=(PIM1(K)+PIM2(K)+PIM3(K)+PIM4(K))*BRACK4
01185  
01186  308  CONTINUE
01187  
01188       DO 309 I=1,4
01189  
01190       HADCUR(I)=HCOMP1(I)+HCOMP2(I)+HCOMP3(I)-HCOMP4(I)
01191       HADCUR(I)=COEF1*FRHO4(SQRT(QQ),AMPI,AMPI)*HADCUR(I)
01192  
01193  309  CONTINUE
01194  
01195  101   CONTINUE
01196       ENDIF
01197 C M. Finkemeier et al. END
01198       END