tauola-F/prod/curr_cleo.f

00001 
00002 
00003 *AJW 1 version of CURR from KORALB.
00004       SUBROUTINE CURR_CLEO(MNUM,PIM1,PIM2,PIM3,PIM4,HADCUR)
00005 C     ==================================================================
00006 C AJW, 11/97 - based on original CURR from TAUOLA:
00007 C     hadronic current for 4 pi final state
00008 C     R. Fisher, J. Wess and F. Wagner Z. Phys C3 (1980) 313
00009 C     R. Decker Z. Phys C36 (1987) 487.
00010 C     M. Gell-Mann, D. Sharp, W. Wagner Phys. Rev. Lett 8 (1962) 261.
00011 C BUT, rewritten to be more general and less "theoretical",
00012 C  using parameters tuned by Vasia and DSC.
00013 C     ==================================================================
00014  
00015       COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00016      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00017      *                 ,AMK,AMKZ,AMKST,GAMKST
00018 C
00019       REAL*4            AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
00020      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
00021      *                 ,AMK,AMKZ,AMKST,GAMKST
00022 C
00023       REAL  PIM1(4),PIM2(4),PIM3(4),PIM4(4)
00024       COMPLEX HADCUR(4)
00025 
00026       INTEGER K,L,MNUM,K1,K2,IRO,I,J,KK
00027       REAL PA(4),PB(4),PAA(4)
00028       REAL AA(4,4),PP(4,4)
00029       REAL A,XM,XG,G1,G2,G,AMRO2,GAMRO2,AMRO3,GAMRO3,AMOM,GAMOM
00030       REAL FRO,COEF1,FPI,COEF2,QQ,SK,DENOM,SIG,QQA,SS23,SS24,SS34,QP1P2
00031       REAL QP1P3,QP1P4,P1P2,P1P3,P1P4,SIGN
00032       REAL PKORB,AMPA
00033       COMPLEX ALF0,ALF1,ALF2,ALF3
00034       COMPLEX LAM0,LAM1,LAM2,LAM3
00035       COMPLEX BET1,BET2,BET3
00036       COMPLEX FORM1,FORM2,FORM3,FORM4,FORM2PI
00037       COMPLEX BWIGM,WIGFOR,FPIKM,FPIKMD
00038       COMPLEX AMPL(7),AMPR
00039       COMPLEX BWIGN
00040 C
00041       BWIGN(A,XM,XG)=1.0/CMPLX(A-XM**2,XM*XG)
00042 C*******************************************************************************
00043 C
00044 C --- masses and constants
00045       IF (G1.NE.12.924) THEN
00046       G1=12.924
00047       G2=1475.98
00048       FPI=93.3E-3
00049       G =G1*G2
00050       FRO=0.266*AMRO**2
00051       COEF1=2.0*SQRT(3.0)/FPI**2
00052       COEF2=FRO*G ! overall constant for the omega current
00053       COEF2= COEF2*0.56  ! factor 0.56 reduces contribution of omega from 68% to 40 %
00054 
00055 C masses and widths for for rho-prim and rho-bis:
00056       AMRO2 = 1.465
00057       GAMRO2= 0.310
00058       AMRO3=1.700
00059       GAMRO3=0.235
00060 C
00061       AMOM  = PKORB(1,14)
00062       GAMOM = PKORB(2,14)
00063       AMRO2 = PKORB(1,21)
00064       GAMRO2= PKORB(2,21)
00065       AMRO3 = PKORB(1,22)
00066       GAMRO3= PKORB(2,22)
00067 C
00068 C Amplitudes for (pi-pi-pi0pi+) -> PS, rho0, rho-, rho+, omega.
00069       AMPL(1) = CMPLX(PKORB(3,31)*COEF1,0.)
00070       AMPL(2) = CMPLX(PKORB(3,32)*COEF1,0.)*CEXP(CMPLX(0.,PKORB(3,42)))
00071       AMPL(3) = CMPLX(PKORB(3,33)*COEF1,0.)*CEXP(CMPLX(0.,PKORB(3,43)))
00072       AMPL(4) = CMPLX(PKORB(3,34)*COEF1,0.)*CEXP(CMPLX(0.,PKORB(3,44)))
00073       AMPL(5) = CMPLX(PKORB(3,35)*COEF2,0.)*CEXP(CMPLX(0.,PKORB(3,45)))
00074 C Amplitudes for (pi0pi0pi0pi-) -> PS, rho-.
00075       AMPL(6) = CMPLX(PKORB(3,36)*COEF1)
00076       AMPL(7) = CMPLX(PKORB(3,37)*COEF1)
00077 C
00078 C rho' contributions to rho' -> pi-omega:
00079       ALF0 = CMPLX(PKORB(3,51),0.0)
00080       ALF1 = CMPLX(PKORB(3,52)*AMRO**2,0.0)
00081       ALF2 = CMPLX(PKORB(3,53)*AMRO2**2,0.0)
00082       ALF3 = CMPLX(PKORB(3,54)*AMRO3**2,0.0)
00083 C rho' contribtions to rho' -> rhopipi:
00084       LAM0 = CMPLX(PKORB(3,55),0.0)
00085       LAM1 = CMPLX(PKORB(3,56)*AMRO**2,0.0)
00086       LAM2 = CMPLX(PKORB(3,57)*AMRO2**2,0.0)
00087       LAM3 = CMPLX(PKORB(3,58)*AMRO3**2,0.0)
00088 C rho contributions to rhopipi, rho -> 2pi:
00089       BET1 = CMPLX(PKORB(3,59)*AMRO**2,0.0)
00090       BET2 = CMPLX(PKORB(3,60)*AMRO2**2,0.0)
00091       BET3 = CMPLX(PKORB(3,61)*AMRO3**2,0.0)
00092 C
00093       END IF
00094 C**************************************************
00095 C
00096 C --- initialization of four vectors
00097       DO 7 K=1,4
00098       DO 8 L=1,4
00099  8    AA(K,L)=0.0
00100       HADCUR(K)=CMPLX(0.0)
00101       PAA(K)=PIM1(K)+PIM2(K)+PIM3(K)+PIM4(K)
00102       PP(1,K)=PIM1(K)
00103       PP(2,K)=PIM2(K)
00104       PP(3,K)=PIM3(K)
00105  7    PP(4,K)=PIM4(K)
00106 C
00107       IF (MNUM.EQ.1) THEN
00108 C ===================================================================
00109 C pi- pi- p0 pi+ case                                            ====
00110 C ===================================================================
00111        QQ=PAA(4)**2-PAA(3)**2-PAA(2)**2-PAA(1)**2
00112 
00113 C  Add M(4pi)-dependence to rhopipi channels:
00114        FORM4= LAM0+LAM1*BWIGN(QQ,AMRO,GAMRO)
00115      *            +LAM2*BWIGN(QQ,AMRO2,GAMRO2)
00116      *            +LAM3*BWIGN(QQ,AMRO3,GAMRO3)
00117 
00118 C --- loop over five contributions of the rho-pi-pi
00119        DO 201 K1=1,3
00120        DO 201 K2=3,4
00121 C
00122          IF (K2.EQ.K1) THEN
00123            GOTO 201
00124          ELSEIF (K2.EQ.3) THEN
00125 C rho-
00126             AMPR = AMPL(3)
00127             AMPA = AMPIZ
00128          ELSEIF (K1.EQ.3) THEN
00129 C rho+
00130             AMPR = AMPL(4)
00131             AMPA = AMPIZ
00132          ELSE
00133 C rho0
00134             AMPR = AMPL(2)
00135             AMPA = AMPI
00136          END IF
00137 C
00138          SK=(PP(K1,4)+PP(K2,4))**2-(PP(K1,3)+PP(K2,3))**2
00139      $     -(PP(K1,2)+PP(K2,2))**2-(PP(K1,1)+PP(K2,1))**2
00140 
00141 C -- definition of AA matrix
00142 C -- cronecker delta
00143         DO 202 I=1,4
00144          DO 203 J=1,4
00145  203     AA(I,J)=0.0
00146  202    AA(I,I)=1.0
00147 C ... and the rest ...
00148         DO 204 L=1,4
00149          IF (L.NE.K1.AND.L.NE.K2) THEN
00150           DENOM=(PAA(4)-PP(L,4))**2-(PAA(3)-PP(L,3))**2
00151      $         -(PAA(2)-PP(L,2))**2-(PAA(1)-PP(L,1))**2
00152           DO 205 I=1,4
00153           DO 205 J=1,4
00154                       SIG= 1.0
00155            IF(J.NE.4) SIG=-SIG
00156            AA(I,J)=AA(I,J)
00157      $            -SIG*(PAA(I)-2.0*PP(L,I))*(PAA(J)-PP(L,J))/DENOM
00158  205      CONTINUE
00159          ENDIF
00160  204    CONTINUE
00161 C
00162 C --- lets add something to HADCURR
00163 C        FORM1= FPIKM(SQRT(SK),AMPI,AMPI) *FPIKM(SQRT(QQ),AMPI,AMPI)
00164 C        FORM1= AMPL(1)+AMPR*FPIKM(SQRT(SK),AMPI,AMPI)
00165 
00166         FORM2PI= BET1*BWIGM(SK,AMRO,GAMRO,AMPA,AMPI)
00167      1          +BET2*BWIGM(SK,AMRO2,GAMRO2,AMPA,AMPI)
00168      2          +BET3*BWIGM(SK,AMRO3,GAMRO3,AMPA,AMPI)
00169         FORM1= AMPL(1)+AMPR*FORM2PI
00170 C
00171        DO 206 I=1,4
00172        DO 206 J=1,4
00173         HADCUR(I)=HADCUR(I)+FORM1*FORM4*AA(I,J)*(PP(K1,J)-PP(K2,J))
00174  206   CONTINUE
00175 C --- end of the rho-pi-pi current (5 possibilities)
00176  201   CONTINUE
00177 C
00178 C ===================================================================
00179 C Now modify the coefficient for the omega-pi current:              =
00180 C ===================================================================
00181        IF (AMPL(5).EQ.CMPLX(0.,0.)) GOTO 311
00182 
00183 C Overall rho+rhoprime for the 4pi system:
00184 C       FORM2=AMPL(5)*(BWIGN(QQ,AMRO,GAMRO)+ELPHA*BWIGN(QQ,AMROP,GAMROP))
00185 C Modified M(4pi)-dependence:
00186        FORM2=AMPL(5)*(ALF0+ALF1*BWIGN(QQ,AMRO,GAMRO)
00187      *                    +ALF2*BWIGN(QQ,AMRO2,GAMRO2)
00188      *                    +ALF3*BWIGN(QQ,AMRO3,GAMRO3))
00189 C
00190 C --- there are two possibilities for omega current
00191 C --- PA PB are corresponding first and second pi-s
00192        DO 301 KK=1,2
00193         DO 302 I=1,4
00194          PA(I)=PP(KK,I)
00195          PB(I)=PP(3-KK,I)
00196  302    CONTINUE
00197 C --- lorentz invariants
00198          QQA=0.0
00199          SS23=0.0
00200          SS24=0.0
00201          SS34=0.0
00202          QP1P2=0.0
00203          QP1P3=0.0
00204          QP1P4=0.0
00205          P1P2 =0.0
00206          P1P3 =0.0
00207          P1P4 =0.0
00208         DO 303 K=1,4
00209                      SIGN=-1.0
00210          IF (K.EQ.4) SIGN= 1.0
00211          QQA=QQA+SIGN*(PAA(K)-PA(K))**2
00212          SS23=SS23+SIGN*(PB(K)  +PIM3(K))**2
00213          SS24=SS24+SIGN*(PB(K)  +PIM4(K))**2
00214          SS34=SS34+SIGN*(PIM3(K)+PIM4(K))**2
00215          QP1P2=QP1P2+SIGN*(PAA(K)-PA(K))*PB(K)
00216          QP1P3=QP1P3+SIGN*(PAA(K)-PA(K))*PIM3(K)
00217          QP1P4=QP1P4+SIGN*(PAA(K)-PA(K))*PIM4(K)
00218          P1P2=P1P2+SIGN*PA(K)*PB(K)
00219          P1P3=P1P3+SIGN*PA(K)*PIM3(K)
00220          P1P4=P1P4+SIGN*PA(K)*PIM4(K)
00221  303    CONTINUE
00222 C
00223 C omega -> rho pi for the 3pi system:
00224 C       FORM3=BWIGN(QQA,AMOM,GAMOM)*(BWIGN(SS23,AMRO,GAMRO)+
00225 C     $        BWIGN(SS24,AMRO,GAMRO)+BWIGN(SS34,AMRO,GAMRO))
00226 C No omega -> rho pi; just straight omega:
00227         FORM3=BWIGN(QQA,AMOM,GAMOM)
00228 C
00229         DO 304 K=1,4
00230          HADCUR(K)=HADCUR(K)+FORM2*FORM3*(
00231      $             PB  (K)*(QP1P3*P1P4-QP1P4*P1P3)
00232      $            +PIM3(K)*(QP1P4*P1P2-QP1P2*P1P4)
00233      $            +PIM4(K)*(QP1P2*P1P3-QP1P3*P1P2) )
00234  304    CONTINUE
00235  301   CONTINUE
00236  311   CONTINUE
00237 C
00238       ELSE
00239 C ===================================================================
00240 C pi0 pi0 p0 pi- case                                            ====
00241 C ===================================================================
00242        QQ=PAA(4)**2-PAA(3)**2-PAA(2)**2-PAA(1)**2
00243 
00244 C --- loop over three contribution of the non-omega current
00245        DO 101 K=1,3
00246         SK=(PP(K,4)+PIM4(4))**2-(PP(K,3)+PIM4(3))**2
00247      $    -(PP(K,2)+PIM4(2))**2-(PP(K,1)+PIM4(1))**2
00248 
00249 C -- definition of AA matrix
00250 C -- cronecker delta
00251         DO 102 I=1,4
00252          DO 103 J=1,4
00253  103     AA(I,J)=0.0
00254  102    AA(I,I)=1.0
00255 C
00256 C ... and the rest ...
00257         DO 104 L=1,3
00258          IF (L.NE.K) THEN
00259           DENOM=(PAA(4)-PP(L,4))**2-(PAA(3)-PP(L,3))**2
00260      $         -(PAA(2)-PP(L,2))**2-(PAA(1)-PP(L,1))**2
00261           DO 105 I=1,4
00262           DO 105 J=1,4
00263                       SIG=1.0
00264            IF(J.NE.4) SIG=-SIG
00265            AA(I,J)=AA(I,J)
00266      $            -SIG*(PAA(I)-2.0*PP(L,I))*(PAA(J)-PP(L,J))/DENOM
00267  105      CONTINUE
00268          ENDIF
00269  104    CONTINUE
00270 
00271 C --- lets add something to HADCURR
00272 C       FORM1= FPIKM(SQRT(SK),AMPI,AMPI) *FPIKMD(SQRT(QQ),AMPI,AMPI)
00273 CCCCCCCCCCCCC       FORM1=WIGFOR(SK,AMRO,GAMRO)        (tests)
00274 C       FORM1= FPIKM(SQRT(SK),AMPI,AMPI) *FPIKM(SQRT(QQ),AMPI,AMPI)
00275        FORM1 = AMPL(6)+AMPL(7)*FPIKM(SQRT(SK),AMPI,AMPI)
00276 
00277         DO 106 I=1,4
00278         DO 106 J=1,4
00279          HADCUR(I)=HADCUR(I)+FORM1*AA(I,J)*(PP(K,J)-PP(4,J))
00280  106    CONTINUE
00281 C --- end of the non omega current (3 possibilities)
00282  101   CONTINUE
00283 
00284       ENDIF
00285       END
00286  
00287 
00288