tauola-BBB/prod/formf.f

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