TEvtGen/Tauola/tauola-fortran/pkorb.f

   1
   2
   3       REAL FUNCTION PKORB(IF1,IF2)
   4 **********************************************************************
   5 *
   6 * This function returns a real value
   7 * needed in the 1 version of KORALB/TAUOLA
   8 * corresponding to a mass, width, mixing amplitude, or branching fraction
   9 * depending on whether IF1 = 1, 2, 3, 4 respectively.
  10 * The idea is to make minimal mods to the 3-rd party KORALB/TAUOLA code,
  11 * so this function supplies all the 1-specific parameters.
  12 *
  13 *  Alan Weinstein, ajw, 11/97
  14 **********************************************************************
  15
  16 * Arguments:
  17       INTEGER IF1   ! input, flag for type of data required
  18       INTEGER IF2   ! input, flag for type of data required
  19
  20 * MC info
  21 *#include "seq/clinc/qqpars.inc"
  22 *#include "seq/clinc/qqprop.inc"
  23 *#include "qqlib/seq/qqbrat.inc"
  24
  25       INTEGER            JAK1,JAK2,JAKP,JAKM,KTOM
  26       COMMON / JAKI   /  JAK1,JAK2,JAKP,JAKM,KTOM
  27       REAL*4 RRR(1)
  28       REAL PARM(4,100)
  29       integer imixpp(300)
  30       INTEGER INIT,I,J
  31       REAL C1270,C1402,A1270_KSPI,A1270_KRHO,A1402_KSPI,A1402_KRHO
  32       REAL CG1,CG2,R,BRA1,BRKS
  33       SAVE INIT,PARM
  34       DATA INIT/0/
  35
  36 **********************************************************************
  37 * Initialize return variable:
  38       PKORB = 0.
  39
  40 **********************************************************************
  41 * Initialize:
  42       IF (INIT.EQ.0) THEN
  43         INIT = 1
  44
  45 C        CALL VZERO(PARM,400)
  46         DO I=1,4
  47         DO J=1,100
  48           PARM(I,J) = 0
  49         END DO
  50         END DO
  51
  52 C Youd better be using korb.dec, NOT decay.dec!!!!
  53 C masses (needed in dist/inimas, formf/form*, etc)
  54         PARM(1, 1) = 1.777000   ! TAU
  55         PARM(1, 2) = 0.         ! NUTA
  56         PARM(1, 3) = 0.000511   ! EL
  57         PARM(1, 4) = 0.         ! NUEL
  58         PARM(1, 5) = 0.105658   ! MU
  59         PARM(1, 6) = 0.         ! NUMU
  60         PARM(1, 7) = 0.134976   ! PIZ
  61         PARM(1, 8) = 0.139570   ! PI+
  62         PARM(1, 9) = 0.769900   ! RHO+
  63         PARM(1,10) = 1.275000   ! A1+
  64         PARM(1,11) = 0.493677   ! K+
  65         PARM(1,12) = 0.497670   ! KZ
  66         PARM(1,13) = 0.891590   ! K*+
  67         PARM(1,14) = 0.781940   ! OMEG
  68         PARM(1,15) = 1.370000   ! RHOP+
  69         PARM(1,16) = 1.700000   ! K*P+
  70         PARM(1,17) = 1.461000   ! A1P+
  71         PARM(1,18) = 1.300000   ! PIP+
  72         PARM(1,19) = 1.270000   ! K1A+
  73         PARM(1,20) = 1.402000   ! K1B+
  74         PARM(1,21) = 1.465000   ! RHOPP+
  75         PARM(1,22) = 1.700000   ! RHOPPP+
  76
  77 C widths (needed in dist/inimas, formf/form*, etc)
  78         PARM(2, 1) = 0.          ! TAU
  79         PARM(2, 2) = 0.          ! NUTA
  80         PARM(2, 3) = 0.          ! EL
  81         PARM(2, 4) = 0.          ! NUEL
  82         PARM(2, 5) = 0.          ! MU
  83         PARM(2, 6) = 0.          ! NUMU
  84         PARM(2, 7) = 0.          ! PIZ
  85         PARM(2, 8) = 0.          ! PI+
  86         PARM(2, 9) = 0.1512      ! RHO+
  87         PARM(2,10) = 0.700       ! A1+
  88         PARM(2,11) = 0.          ! K+
  89         PARM(2,12) = 0.          ! KZ
  90         PARM(2,13) = 0.0498      ! K*+
  91         PARM(2,14) = 0.00843     ! OMEG
  92         PARM(2,15) = 0.510       ! RHOP+
  93         PARM(2,16) = 0.235       ! K*P+
  94         PARM(2,17) = 0.250       ! A1P+
  95         PARM(2,18) = 0.400       ! PIP+
  96         PARM(2,19) = 0.090       ! K1A+
  97         PARM(2,20) = 0.174       ! K1B+
  98         PARM(2,21) = 0.310       ! RHOPP+
  99         PARM(2,22) = 0.235       ! RHOPPP+
 100
 101 C Now store mixing parameters for 2pi and 4pi FFs
 102 C needed in tauola/fpik, tauola/bwigs, formf/form* , formf/curr :
 103
 104         PARM(3,15) = -0.145
 105
 106         IMIXPP(205)=1
 107         IMIXPP(207)=1
 108         IMIXPP(209)=1
 109         IMIXPP(211)=1
 110         IMIXPP(201)=1
 111         IMIXPP(203)=1
 112         IMIXPP(213)=1
 113         IMIXPP(215)=1
 114
 115
 116         IF (IMIXPP(205).NE.0) PARM(3,15) = -0.110
 117         IF (IMIXPP(207).NE.0) PARM(3,16) = -0.038
 118         IF (IMIXPP(209).NE.0) PARM(3,17) = 0.00
 119         IF (IMIXPP(211).NE.0) PARM(3,18) = 0.00
 120         IF (IMIXPP(201).NE.0) PARM(3,19) = 1.0
 121         IF (IMIXPP(203).NE.0) PARM(3,20) = 0.8
 122         IF (IMIXPP(213).NE.0) PARM(3,21) = -0.110
 123         IF (IMIXPP(215).NE.0) PARM(3,22) = -0.110
 124
 125         PRINT *,' KORB: rho/rhop -> pi-pi0 mixing:'
 126         PRINT *,' KORB: rho   =',PARM(1,9) ,PARM(2,9)
 127         PRINT *,' KORB: rhop  =',PARM(1,15),PARM(2,15),PARM(3,15)
 128         PRINT *,' KORB: K*/K*prime -> Kpi mixing:'
 129         PRINT *,' KORB: kstp  =',PARM(1,16),PARM(2,16),PARM(3,16)
 130         PRINT *,' KORB: a1/a1prime -> 3pi, KKpi mixing:'
 131         PRINT *,' KORB: a1    =',PARM(1,10),PARM(2,10)
 132         PRINT *,' KORB: a1prim=',PARM(1,17),PARM(2,17),PARM(3,17)
 133         PRINT *,' KORB: K1A/K1B -> Kpipi mixing:'
 134         PRINT *,' KORB: K1A   =',PARM(1,19),PARM(2,19),PARM(3,19)
 135         PRINT *,' KORB: K1B   =',PARM(1,20),PARM(2,20),PARM(3,20)
 136         PRINT *,' KORB: rho/rhop/rhopp -> 4pi mixing:'
 137         PRINT *,' KORB: rho   =',PARM(1,9) ,PARM(2,9)
 138         PRINT *,' KORB: rhopp =',PARM(1,21),PARM(2,21),PARM(3,21)
 139         PRINT *,' KORB: rhoppp=',PARM(1,22),PARM(2,22),PARM(3,22)
 140
 141 C amplitudes for curr_cleo.F:
 142 C for (3pi)-pi0: 4pi phase space; rho0pi-pi0; rho-pi+pi-; rho+pi-pi-; pi-omega
 143         PARM(3,31) = 0.
 144         PARM(3,32) = 0.1242
 145         PARM(3,33) = 0.1604
 146         PARM(3,34) = 0.2711
 147         PARM(3,35) = 0.4443
 148 C for pi-3pi0: 4pi phase space; rho-pi0pi0
 149         PARM(3,36) = 0.
 150         PARM(3,37) = 1.0
 151
 152 C Modify amplitudes for 4pi form-factor in formf/curr, from korb.dec:
 153 CCC        IF (IPLIST(2,282).EQ.5) THEN
 154         IPLIST=0
 155         IF (IPLIST.EQ.5) THEN
 156         PARM(3,31) = 0.0000
 157         PARM(3,32) = 0.1242
 158         PARM(3,33) = 0.1604
 159         PARM(3,34) = 0.2711
 160         PARM(3,35) = 0.4443
 161         PARM(3,36) = 0.0000
 162         PARM(3,37) = 1.0000
 163         END IF
 164
 165         PRINT *,' KORB: 3PI-PI0 PARAMS:',(PARM(3,I),I=31,35)
 166         PRINT *,' KORB: PI-3PI0 PARAMS:',(PARM(3,I),I=36,37)
 167
 168 C The 4pi models are the most complicated in TAUOLA.
 169 C If the user has not modified any parameters of the 4pi model,
 170 C we can use the WTMAX determined with many trials.
 171         IF (ABS(PARM(3,31)-0.0000).GT.0.0001 .OR.
 172      1      ABS(PARM(3,32)-0.1242).GT.0.0001 .OR.
 173      1      ABS(PARM(3,33)-0.1604).GT.0.0001 .OR.
 174      1      ABS(PARM(3,34)-0.2711).GT.0.0001 .OR.
 175      1      ABS(PARM(3,35)-0.4443).GT.0.0001 ) THEN
 176            PARM(3,38) = -1.
 177         ELSE
 178            PARM(3,38) = 6.9673671E-14
 179         END IF
 180
 181         IF (ABS(PARM(3,36)-0.0000).GT.0.0001 .OR.
 182      1      ABS(PARM(3,37)-1.0000).GT.0.0001 ) THEN
 183            PARM(3,39) = -1.
 184         ELSE
 185            PARM(3,39) = 3.5374880E-13
 186         END IF
 187
 188
 189 C phases for curr_cleo.F:
 190         PARM(3,42) = -0.40
 191         PARM(3,43) =  0.00
 192         PARM(3,44) = -0.20+3.1416
 193         PARM(3,45) = -1.50
 194
 195 C rho' contributions to rho' -> pi-omega:
 196         PARM(3,51) = -0.10
 197         PARM(3,52) =  1.00
 198         PARM(3,53) = -0.10
 199         PARM(3,54) = -0.04
 200
 201 C rho' contribtions to rho' -> rhopipi:
 202         PARM(3,55) =  1.00
 203         PARM(3,56) =  0.14
 204         PARM(3,57) = -0.05
 205         PARM(3,58) = -0.05
 206
 207 C rho contributions to rhopipi, rho -> 2pi:
 208         PARM(3,59) =  1.000
 209         PARM(3,60) = -0.145
 210         PARM(3,61) =  0.000
 211
 212 C Set the BRs for (A1+ -> rho+ pi0) and (K*+ -> K0 pi+)
 213 C needed in dist/taurdf:
 214         PARM(4,1) = 0.4920                 ! BRA1+
 215         PARM(4,2) = 0.4920                 ! BRA1-
 216         PARM(4,3) = 0.6660                 ! BRKS+
 217         PARM(4,4) = 0.6660                 ! BRKS-
 218         PARM(4,5) = 0.5                    ! BRK0
 219         PARM(4,6) = 0.5                    ! BRK0B
 220
 221 C amplitude coefficients for tau -> K1(1270) / K1(1402)
 222         C1270 = PARM(3,19)
 223         C1402 = PARM(3,20)
 224         IF (C1270.EQ.0.AND.C1402.EQ.0.) THEN
 225            C1270 = 1.
 226            C1402 = 0.6
 227         END IF
 228 C From PDG96, square roots of branching fractions:
 229         A1270_KSPI = SQRT(0.16)
 230         A1270_KRHO = SQRT(0.42)
 231         A1402_KSPI = SQRT(0.94)
 232         A1402_KRHO = SQRT(0.03)
 233 C C-G coefficients for K1- -> CG1 * |K- pi0> + CG2 * |K0bar pi->
 234         CG1 = -SQRT(2./3.)
 235         CG2 =  SQRT(1./3.)
 236 C and the resulting amplitudes (times normalized FF):
 237         PARM(3,81) = C1270*A1270_KSPI*CG1  ! K1270 -> K*0B pi-
 238         PARM(3,82) = C1402*A1402_KSPI*CG1  ! K1402 -> K*0B pi-
 239         PARM(3,83) = C1270*A1270_KRHO*CG1  ! K1270 -> K0B rho-
 240         PARM(3,84) = C1402*A1402_KRHO*CG1  ! K1402 -> K0B rho-
 241         PARM(3,85) = C1270*A1270_KSPI*CG2  ! K1270 -> K*- pi0
 242         PARM(3,86) = C1402*A1402_KSPI*CG2  ! K1402 -> K*- pi0
 243         PARM(3,87) = C1270*A1270_KRHO*CG2  ! K1270 -> K- rho0
 244         PARM(3,88) = C1402*A1402_KRHO*CG2  ! K1402 -> K- rho0
 245
 246       END IF
 247 **********************************************************************
 248
 249       R = 0.
 250       IF (IF1.GE.1 .AND. IF1.LE.4 .AND. IF2.GE.1 .AND. IF2.LE.100) THEN
 251          R = PARM(IF1,IF2)
 252
 253 CAJW 4/4/94  Better to decide on A1 br now, avoid DADMAA/DPHSAA problem.
 254         IF (IF1.EQ.4.AND.JAK1.EQ.5) THEN
 255           IF (IF2.EQ.11) THEN
 256 C Return the BR used in the last call:
 257              R = BRA1
 258           ELSE IF (IF2.EQ.1) THEN
 259             BRA1 = R
 260             CALL RANMAR(RRR,1)
 261             IF (RRR(1).LT.BRA1) THEN
 262               R = 1.     ! 3pi
 263             ELSE
 264               R = 0.     ! pi-2pi0
 265             END IF
 266             BRA1 = R
 267           END IF
 268         ELSEIF (IF1.EQ.4.AND.JAK1.EQ.7) THEN
 269           IF (IF2.EQ.13) THEN
 270 C Return the BR used in the last call:
 271              R = BRKS
 272           ELSE IF (IF2.EQ.3) THEN
 273             BRKS = R
 274             CALL RANMAR(RRR,1)
 275             IF (RRR(1).LT.BRKS) THEN
 276               R = 1.     ! K0 pi-
 277             ELSE
 278               R = 0.     ! K- pi0
 279             END IF
 280             BRKS = R
 281           END IF
 282         END IF
 283
 284       END IF
 285
 286       PKORB = R
 287       RETURN
 288       END