tauola-F/curr_cleo.F

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