TEvtGen/Tauola/tauola-fortran/new-currents/RChL-currents/rcht_common/ffwid3pi.f

   1       DOUBLE PRECISION FUNCTION FFWID3PI(QQ,S1,S3)
   2       IMPLICIT NONE
   3       DOUBLE PRECISION                   QQ,S1,S3
   4 C **************************************************************
   5 C     Input:  QQ S1 S3   ! mpi-pi-pi+**2   mpi-pi+**2  mpi-pi-**2
   6 C     Calls: functions FORM1, FORM2, FORM4
   7 C     Uses constants: tau mass, pi mass, normalization constant.
   8 C     Load: Initialized tauola library,
   9 C     Output:  d\Gamma(tau --> 3pi nu)/(dQQ dS1 dS3)
  10 C     Remark: If QQ S1 S3 are outside of the phase space
  11 C             function FFWID3PI returns zero.
  12 C **************************************************************
  13       COMPLEX F1,F2,F4, FORM1,FORM2, FORM4
  14       DOUBLE PRECISION V11,V12,V22,GGF2,VUD2,ABS1,QQMIN,
  15      &                 QQMAX,S3MAX,S3MIN,S1MIN,S1MAX
  16       REAL XQQ,XS1,XS3, XS2,RQQ
  17       COMMON / DECPAR / GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
  18       REAL*4            GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
  19       COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
  20      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
  21      *                 ,AMK,AMKZ,AMKST,GAMKST
  22       DOUBLE PRECISION  XLAM,X,Y,Z
  23       DOUBLE PRECISION  XAMPI2
  24       DOUBLE PRECISION  GETFPIRPT
  25       REAL*4            AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
  26      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
  27      *                 ,AMK,AMKZ,AMKST,GAMKST
  28       DOUBLE PRECISION        PI
  29       DATA                    PI /3.141592653589793238462643D0/
  30       INTEGER  IMODE,IDUM,IFRCHL
  31       REAL RRQ,RCHLWIDA1PI
  32
  33
  34       XLAM(X,Y,Z)= sqrt(abs((x-y-z)**2 - 4.*y*z))
  35
  36       ABS1 = 1.d-5
  37
  38
  39       GGF2 = GFERMI**2
  40       VUD2 = CCABIB**2
  41
  42
  43 C     TO CHANGE THE VARIABLES TO SINGLE PRECISION
  44 C     INPUT FOR FORM1,FORM2,FORM4 IS SINGLE PRECISION
  45
  46       XQQ = QQ
  47       XS1 = S1
  48       XS2 = QQ -S1-S3 + 3.*AMPI**2
  49       XS3 = S3
  50       XAMPI2 = AMPI**2
  51 C     Limits for PHASE SPACE
  52 C     Limits for QQ
  53       QQMIN = 9.D0*AMPI**2
  54       QQMAX  = (AMTAU-AMNUTA)**2
  55
  56 C     Limits for S1
  57       S1MAX=(DSQRT(QQ) - AMPI)**2 -ABS1
  58       S1MIN=4.D0*AMPI**2 +ABS1
  59
  60 C    LIMIT FOR XS3
  61       S3MAX = (QQ - AMPI**2)**2 -
  62      &    ( XLAM(QQ,S1,XAMPI2)
  63      &         - XLAM(S1,XAMPI2,XAMPI2) )**2
  64       S3MIN = (QQ - AMPI**2)**2 -
  65      &    (XLAM(QQ,S1,XAMPI2)
  66      &          + XLAM(S1,XAMPI2,XAMPI2) )**2
  67
  68       S3MAX = S3MAX/4./S1
  69       S3MIN = S3MIN/4./S1
  70
  71 C     Check on PHASE SPACE
  72 C
  73       IF((XS2.LE.0.) .OR.(S3MAX.LE.S3MIN)
  74      &   .OR.(XS1.LE.S1MIN).OR.(XS1.GE.S1MAX)
  75      &   .OR.(XS3.LE.S3MIN).OR.(XS3.GE.S3MAX)
  76      &   .OR.(QQ.LE.QQMIN).OR.(QQ.GE.QQMAX)
  77      &    )  THEN
  78         FFWID3PI = 0.D0
  79         RETURN
  80       ENDIF
  81
  82 C
  83       V11 = -XS1+4.D0*AMPI**2 -(XS2-XS3)**2/(4.D0*XQQ)
  84       V22 = -XS2+4.D0*AMPI**2 - (XS3-XS1)**2/(4.D0*XQQ)
  85       V12 = 0.5D0*(XS3-XS1-XS2+4.D0*AMPI**2)-0.25D0*(XS3-XS2)*(XS3-XS1)/XQQ
  86
  87
  88       F1 = FORM1(0,XQQ,XS1,XS2)
  89       F2 = FORM2(0,XQQ,XS2,XS1)
  90       F4 = FORM4(0,XQQ,XS2,XS1,XS3)
  91
  92 C formula 3.46 of [3]
  93       FFWID3PI = ABS(F1*CONJG(F1))*V11+ABS(F2*CONJG(F2))*V22+
  94      $       2.D0*REAL(F1*CONJG(F2))*V12
  95
  96       CALL IFGFACT(2,IMODE,IDUM)
  97       CALL INIRChLget(IFRCHL)
  98       IF (IMODE.EQ.0) THEN
  99 C      VERSION A: The 3 pion contribution to the a1 width
 100 C      factor of a1 phase space and zeroing a1 propagator etc.is
 101 C      done in RCHLWIDA1PI
 102        RQQ=QQ
 103        IF (IFRCHL.EQ.1) THEN
 104 C       CASE OF RCHL
 105         FFWID3PI   = RCHLWIDA1PI(RQQ,FFWID3PI)
 106        ELSE
 107 C       NOT READY YET
 108         WRITE(*,*) 'FFWID3PI is not ready for non rchl currents'
 109         STOP
 110        ENDIF
 111 C      to get the total a1 width the contribution from (KKPI)- and K-K0pi0
 112 C      channels have to be added
 113       ELSE
 114 C      VERSION B: calculation of 3 pion spectra in tau to 3pi nu channel.
 115
 116 C      factor for phase space of tau to XQQ nu decay and contribution from F4
 117 C      (formula 3.21 of [3])
 118
 119       FFWID3PI = (- FFWID3PI/3.D0*(1.D0+2.D0*XQQ/(AMTAU**2))+
 120      $       XQQ*ABS(F4*CONJG(F4)))*(AMTAU**2/XQQ-1.D0)**2
 121
 122 C Flux factor and normalization const.
 123         FFWID3PI =
 124      &       GGF2*VUD2/(128.D0*(2.D0*PI)**5*AMTAU)/2.d0
 125      &            *FFWID3PI
 126        IF (IFRCHL.EQ.1) THEN
 127 C       CASE OF RCHL
 128 C RChL normalization constant
 129         FFWID3PI =FFWID3PI/GETFPIRPT(1)**2
 130        ELSE
 131 C       NOT READY YET
 132         WRITE(*,*) 'FFWID3PI is not ready for non rchl currents'
 133         STOP
 134        ENDIF
 135
 136       ENDIF
 137
 138       RETURN
 139       END
 140
 141       REAL FUNCTION RCHLWIDA1PI(RQQ,FFWID3PI)
 142 C The 3 pion contribution to the a1 width
 143 C (in [3] simple pretabulation is used through formula 3.48)
 144 C for calculation of g(QQ) of 3.45 3.46 of [3] in RChL style
 145 C a1 propagator has to be taken with the zero width.
 146
 147       IMPLICIT NONE
 148       COMPLEX FA1RCHL
 149       REAL RQQ
 150       DOUBLE PRECISION FFWID3PI
 151       COMMON / DECPAR / GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
 152       REAL*4            GFERMI,GV,GA,CCABIB,SCABIB,GAMEL
 153       COMMON / PARMAS / AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
 154      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
 155      *                 ,AMK,AMKZ,AMKST,GAMKST
 156       DOUBLE PRECISION  XLAM,X,Y,Z
 157       DOUBLE PRECISION  XAMPI2
 158       DOUBLE PRECISION  GETFPIRPT
 159       REAL*4            AMTAU,AMNUTA,AMEL,AMNUE,AMMU,AMNUMU
 160      *                 ,AMPIZ,AMPI,AMRO,GAMRO,AMA1,GAMA1
 161      *                 ,AMK,AMKZ,AMKST,GAMKST
 162
 163       COMMON/RCHT_3PI/        FPI_RPT,FV_RPT,GV_RPT,FA_RPT,BETA_RHO,FK_RPT
 164      &                       ,FV1_RPT,GV1_RPT
 165       DOUBLE PRECISION        FPI_RPT,FV_RPT,GV_RPT,FA_RPT,BETA_RHO,FK_RPT
 166      &                       ,FV1_RPT,GV1_RPT
 167       DOUBLE PRECISION        PI
 168       DATA                    PI /3.141592653589793238462643D0/
 169
 170 C     AMA1 should be replaced by variable from the rchl namespace.
 171       RCHLWIDA1PI=- 1.0/REAL(FA1RCHL(RQQ)*CONJG(FA1RCHL(RQQ)))/RQQ**2
 172      $            /(96.D0*8.D0*PI**3*AMA1)/(FA_RPT**2*FPI_RPT**2)
 173      $            *FFWID3PI/2.d0
 174       END
 175
 176       DOUBLE PRECISION FUNCTION  GETFPIRPT(I)
 177       IMPLICIT NONE
 178       COMMON/RCHT_3PI/        FPI_RPT,FV_RPT,GV_RPT,FA_RPT,BETA_RHO,FK_RPT
 179      &                       ,FV1_RPT,GV1_RPT
 180       DOUBLE PRECISION        FPI_RPT,FV_RPT,GV_RPT,FA_RPT,BETA_RHO,FK_RPT
 181      &                       ,FV1_RPT,GV1_RPT
 182       INTEGER I
 183       GETFPIRPT=FPI_RPT
 184       END