TEvtGen/Tauola/tauola-fortran/curr_cleo.f

   1
   2
   3 *AJW 1 version of CURR from KORALB.
   4       SUBROUTINE CURR_CLEO(MNUM,PIM1,PIM2,PIM3,PIM4,HADCUR)
   5 C     ==================================================================
   6 C AJW, 11/97 - based on original CURR from TAUOLA:
   7 C     hadronic current for 4 pi final state
   8 C     R. Fisher, J. Wess and F. Wagner Z. Phys C3 (1980) 313
   9 C     R. Decker Z. Phys C36 (1987) 487.
  10 C     M. Gell-Mann, D. Sharp, W. Wagner Phys. Rev. Lett 8 (1962) 261.
  11 C BUT, rewritten to be more general and less "theoretical",
  12 C  using parameters tuned by Vasia and DSC.
  13 C     ==================================================================
  14
  15       COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
  16      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
  17      *                 ,AMK,AMKZ,AMKST,GAMKST
  18 C
  19       REAL*4            AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
  20      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
  21      *                 ,AMK,AMKZ,AMKST,GAMKST
  22 C
  23       REAL  PIM1(4),PIM2(4),PIM3(4),PIM4(4)
  24       COMPLEX HADCUR(4)
  25
  26       INTEGER K,L,MNUM,K1,K2,IRO,I,J,KK
  27       REAL PA(4),PB(4),PAA(4)
  28       REAL AA(4,4),PP(4,4)
  29       REAL A,XM,XG,G1,G2,G,AMRO2,GAMRO2,AMRO3,GAMRO3,AMOM,GAMOM
  30       REAL FRO,COEF1,FPI,COEF2,QQ,SK,DENOM,SIG,QQA,SS23,SS24,SS34,QP1P2
  31       REAL QP1P3,QP1P4,P1P2,P1P3,P1P4,SIGN
  32       REAL PKORB,AMPA
  33       COMPLEX ALF0,ALF1,ALF2,ALF3
  34       COMPLEX LAM0,LAM1,LAM2,LAM3
  35       COMPLEX BET1,BET2,BET3
  36       COMPLEX FORM1,FORM2,FORM3,FORM4,FORM2PI
  37       COMPLEX BWIGM,WIGFOR,FPIKM,FPIKMD
  38       COMPLEX AMPL(7),AMPR
  39       COMPLEX BWIGN
  40 C
  41       BWIGN(A,XM,XG)=1.0/CMPLX(A-XM**2,XM*XG)
  42 C*******************************************************************************
  43 C
  44 C --- masses and constants
  45       IF (G1.NE.12.924) THEN
  46       G1=12.924
  47       G2=1475.98
  48       FPI=93.3E-3
  49       G =G1*G2
  50       FRO=0.266*AMRO**2
  51       COEF1=2.0*SQRT(3.0)/FPI**2
  52       COEF2=FRO*G ! overall constant for the omega current
  53       COEF2= COEF2*0.56  ! factor 0.56 reduces contribution of omega from 68% to 40 %
  54
  55 C masses and widths for for rho-prim and rho-bis:
  56       AMRO2 = 1.465
  57       GAMRO2= 0.310
  58       AMRO3=1.700
  59       GAMRO3=0.235
  60 C
  61       AMOM  = PKORB(1,14)
  62       GAMOM = PKORB(2,14)
  63       AMRO2 = PKORB(1,21)
  64       GAMRO2= PKORB(2,21)
  65       AMRO3 = PKORB(1,22)
  66       GAMRO3= PKORB(2,22)
  67 C
  68 C Amplitudes for (pi-pi-pi0pi+) -> PS, rho0, rho-, rho+, omega.
  69       AMPL(1) = CMPLX(PKORB(3,31)*COEF1,0.)
  70       AMPL(2) = CMPLX(PKORB(3,32)*COEF1,0.)*CEXP(CMPLX(0.,PKORB(3,42)))
  71       AMPL(3) = CMPLX(PKORB(3,33)*COEF1,0.)*CEXP(CMPLX(0.,PKORB(3,43)))
  72       AMPL(4) = CMPLX(PKORB(3,34)*COEF1,0.)*CEXP(CMPLX(0.,PKORB(3,44)))
  73       AMPL(5) = CMPLX(PKORB(3,35)*COEF2,0.)*CEXP(CMPLX(0.,PKORB(3,45)))
  74 C Amplitudes for (pi0pi0pi0pi-) -> PS, rho-.
  75       AMPL(6) = CMPLX(PKORB(3,36)*COEF1)
  76       AMPL(7) = CMPLX(PKORB(3,37)*COEF1)
  77 C
  78 C rho' contributions to rho' -> pi-omega:
  79       ALF0 = CMPLX(PKORB(3,51),0.0)
  80       ALF1 = CMPLX(PKORB(3,52)*AMRO**2,0.0)
  81       ALF2 = CMPLX(PKORB(3,53)*AMRO2**2,0.0)
  82       ALF3 = CMPLX(PKORB(3,54)*AMRO3**2,0.0)
  83 C rho' contribtions to rho' -> rhopipi:
  84       LAM0 = CMPLX(PKORB(3,55),0.0)
  85       LAM1 = CMPLX(PKORB(3,56)*AMRO**2,0.0)
  86       LAM2 = CMPLX(PKORB(3,57)*AMRO2**2,0.0)
  87       LAM3 = CMPLX(PKORB(3,58)*AMRO3**2,0.0)
  88 C rho contributions to rhopipi, rho -> 2pi:
  89       BET1 = CMPLX(PKORB(3,59)*AMRO**2,0.0)
  90       BET2 = CMPLX(PKORB(3,60)*AMRO2**2,0.0)
  91       BET3 = CMPLX(PKORB(3,61)*AMRO3**2,0.0)
  92 C
  93       END IF
  94 C**************************************************
  95 C
  96 C --- initialization of four vectors
  97       DO 7 K=1,4
  98       DO 8 L=1,4
  99  8    AA(K,L)=0.0
 100       HADCUR(K)=CMPLX(0.0)
 101       PAA(K)=PIM1(K)+PIM2(K)+PIM3(K)+PIM4(K)
 102       PP(1,K)=PIM1(K)
 103       PP(2,K)=PIM2(K)
 104       PP(3,K)=PIM3(K)
 105  7    PP(4,K)=PIM4(K)
 106 C
 107       IF (MNUM.EQ.1) THEN
 108 C ===================================================================
 109 C pi- pi- p0 pi+ case                                            ====
 110 C ===================================================================
 111        QQ=PAA(4)**2-PAA(3)**2-PAA(2)**2-PAA(1)**2
 112
 113 C  Add M(4pi)-dependence to rhopipi channels:
 114        FORM4= LAM0+LAM1*BWIGN(QQ,AMRO,GAMRO)
 115      *            +LAM2*BWIGN(QQ,AMRO2,GAMRO2)
 116      *            +LAM3*BWIGN(QQ,AMRO3,GAMRO3)
 117
 118 C --- loop over five contributions of the rho-pi-pi
 119        DO 201 K1=1,3
 120        DO 201 K2=3,4
 121 C
 122          IF (K2.EQ.K1) THEN
 123            GOTO 201
 124          ELSEIF (K2.EQ.3) THEN
 125 C rho-
 126             AMPR = AMPL(3)
 127             AMPA = AMPIZ
 128          ELSEIF (K1.EQ.3) THEN
 129 C rho+
 130             AMPR = AMPL(4)
 131             AMPA = AMPIZ
 132          ELSE
 133 C rho0
 134             AMPR = AMPL(2)
 135             AMPA = AMPI
 136          END IF
 137 C
 138          SK=(PP(K1,4)+PP(K2,4))**2-(PP(K1,3)+PP(K2,3))**2
 139      $     -(PP(K1,2)+PP(K2,2))**2-(PP(K1,1)+PP(K2,1))**2
 140
 141 C -- definition of AA matrix
 142 C -- cronecker delta
 143         DO 202 I=1,4
 144          DO 203 J=1,4
 145  203     AA(I,J)=0.0
 146  202    AA(I,I)=1.0
 147 C ... and the rest ...
 148         DO 204 L=1,4
 149          IF (L.NE.K1.AND.L.NE.K2) THEN
 150           DENOM=(PAA(4)-PP(L,4))**2-(PAA(3)-PP(L,3))**2
 151      $         -(PAA(2)-PP(L,2))**2-(PAA(1)-PP(L,1))**2
 152           DO 205 I=1,4
 153           DO 205 J=1,4
 154                       SIG= 1.0
 155            IF(J.NE.4) SIG=-SIG
 156            AA(I,J)=AA(I,J)
 157      $            -SIG*(PAA(I)-2.0*PP(L,I))*(PAA(J)-PP(L,J))/DENOM
 158  205      CONTINUE
 159          ENDIF
 160  204    CONTINUE
 161 C
 162 C --- lets add something to HADCURR
 163 C        FORM1= FPIKM(SQRT(SK),AMPI,AMPI) *FPIKM(SQRT(QQ),AMPI,AMPI)
 164 C        FORM1= AMPL(1)+AMPR*FPIKM(SQRT(SK),AMPI,AMPI)
 165
 166         FORM2PI= BET1*BWIGM(SK,AMRO,GAMRO,AMPA,AMPI)
 167      1          +BET2*BWIGM(SK,AMRO2,GAMRO2,AMPA,AMPI)
 168      2          +BET3*BWIGM(SK,AMRO3,GAMRO3,AMPA,AMPI)
 169         FORM1= AMPL(1)+AMPR*FORM2PI
 170 C
 171        DO 206 I=1,4
 172        DO 206 J=1,4
 173         HADCUR(I)=HADCUR(I)+FORM1*FORM4*AA(I,J)*(PP(K1,J)-PP(K2,J))
 174  206   CONTINUE
 175 C --- end of the rho-pi-pi current (5 possibilities)
 176  201   CONTINUE
 177 C
 178 C ===================================================================
 179 C Now modify the coefficient for the omega-pi current:              =
 180 C ===================================================================
 181        IF (AMPL(5).EQ.CMPLX(0.,0.)) GOTO 311
 182
 183 C Overall rho+rhoprime for the 4pi system:
 184 C       FORM2=AMPL(5)*(BWIGN(QQ,AMRO,GAMRO)+ELPHA*BWIGN(QQ,AMROP,GAMROP))
 185 C Modified M(4pi)-dependence:
 186        FORM2=AMPL(5)*(ALF0+ALF1*BWIGN(QQ,AMRO,GAMRO)
 187      *                    +ALF2*BWIGN(QQ,AMRO2,GAMRO2)
 188      *                    +ALF3*BWIGN(QQ,AMRO3,GAMRO3))
 189 C
 190 C --- there are two possibilities for omega current
 191 C --- PA PB are corresponding first and second pi-s
 192        DO 301 KK=1,2
 193         DO 302 I=1,4
 194          PA(I)=PP(KK,I)
 195          PB(I)=PP(3-KK,I)
 196  302    CONTINUE
 197 C --- lorentz invariants
 198          QQA=0.0
 199          SS23=0.0
 200          SS24=0.0
 201          SS34=0.0
 202          QP1P2=0.0
 203          QP1P3=0.0
 204          QP1P4=0.0
 205          P1P2 =0.0
 206          P1P3 =0.0
 207          P1P4 =0.0
 208         DO 303 K=1,4
 209                      SIGN=-1.0
 210          IF (K.EQ.4) SIGN= 1.0
 211          QQA=QQA+SIGN*(PAA(K)-PA(K))**2
 212          SS23=SS23+SIGN*(PB(K)  +PIM3(K))**2
 213          SS24=SS24+SIGN*(PB(K)  +PIM4(K))**2
 214          SS34=SS34+SIGN*(PIM3(K)+PIM4(K))**2
 215          QP1P2=QP1P2+SIGN*(PAA(K)-PA(K))*PB(K)
 216          QP1P3=QP1P3+SIGN*(PAA(K)-PA(K))*PIM3(K)
 217          QP1P4=QP1P4+SIGN*(PAA(K)-PA(K))*PIM4(K)
 218          P1P2=P1P2+SIGN*PA(K)*PB(K)
 219          P1P3=P1P3+SIGN*PA(K)*PIM3(K)
 220          P1P4=P1P4+SIGN*PA(K)*PIM4(K)
 221  303    CONTINUE
 222 C
 223 C omega -> rho pi for the 3pi system:
 224 C       FORM3=BWIGN(QQA,AMOM,GAMOM)*(BWIGN(SS23,AMRO,GAMRO)+
 225 C     $        BWIGN(SS24,AMRO,GAMRO)+BWIGN(SS34,AMRO,GAMRO))
 226 C No omega -> rho pi; just straight omega:
 227         FORM3=BWIGN(QQA,AMOM,GAMOM)
 228 C
 229         DO 304 K=1,4
 230          HADCUR(K)=HADCUR(K)+FORM2*FORM3*(
 231      $             PB  (K)*(QP1P3*P1P4-QP1P4*P1P3)
 232      $            +PIM3(K)*(QP1P4*P1P2-QP1P2*P1P4)
 233      $            +PIM4(K)*(QP1P2*P1P3-QP1P3*P1P2) )
 234  304    CONTINUE
 235  301   CONTINUE
 236  311   CONTINUE
 237 C
 238       ELSE
 239 C ===================================================================
 240 C pi0 pi0 p0 pi- case                                            ====
 241 C ===================================================================
 242        QQ=PAA(4)**2-PAA(3)**2-PAA(2)**2-PAA(1)**2
 243
 244 C --- loop over three contribution of the non-omega current
 245        DO 101 K=1,3
 246         SK=(PP(K,4)+PIM4(4))**2-(PP(K,3)+PIM4(3))**2
 247      $    -(PP(K,2)+PIM4(2))**2-(PP(K,1)+PIM4(1))**2
 248
 249 C -- definition of AA matrix
 250 C -- cronecker delta
 251         DO 102 I=1,4
 252          DO 103 J=1,4
 253  103     AA(I,J)=0.0
 254  102    AA(I,I)=1.0
 255 C
 256 C ... and the rest ...
 257         DO 104 L=1,3
 258          IF (L.NE.K) THEN
 259           DENOM=(PAA(4)-PP(L,4))**2-(PAA(3)-PP(L,3))**2
 260      $         -(PAA(2)-PP(L,2))**2-(PAA(1)-PP(L,1))**2
 261           DO 105 I=1,4
 262           DO 105 J=1,4
 263                       SIG=1.0
 264            IF(J.NE.4) SIG=-SIG
 265            AA(I,J)=AA(I,J)
 266      $            -SIG*(PAA(I)-2.0*PP(L,I))*(PAA(J)-PP(L,J))/DENOM
 267  105      CONTINUE
 268          ENDIF
 269  104    CONTINUE
 270
 271 C --- lets add something to HADCURR
 272 C       FORM1= FPIKM(SQRT(SK),AMPI,AMPI) *FPIKMD(SQRT(QQ),AMPI,AMPI)
 273 CCCCCCCCCCCCC       FORM1=WIGFOR(SK,AMRO,GAMRO)        (tests)
 274 C       FORM1= FPIKM(SQRT(SK),AMPI,AMPI) *FPIKM(SQRT(QQ),AMPI,AMPI)
 275        FORM1 = AMPL(6)+AMPL(7)*FPIKM(SQRT(SK),AMPI,AMPI)
 276
 277         DO 106 I=1,4
 278         DO 106 J=1,4
 279          HADCUR(I)=HADCUR(I)+FORM1*AA(I,J)*(PP(K,J)-PP(4,J))
 280  106    CONTINUE
 281 C --- end of the non omega current (3 possibilities)
 282  101   CONTINUE
 283
 284       ENDIF
 285       END
 286
 287
 288