GEANT321/fluka/flavor.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1999/05/18 15:55:15  fca
   6 * AliRoot sources
   7 *
   8 * Revision 1.1.1.1  1995/10/24 10:19:56  cernlib
   9 * Geant
  10 *
  11 *
  12 #include "geant321/pilot.h"
  13 #if defined(CERNLIB_OLDNAME)
  14 *CMZ :  3.21/02 29/03/94  15.41.42  by  S.Giani
  15 *-- Author :
  16 *=== flavor ===========================================================*
  17 *
  18       SUBROUTINE FLAVOR(IT,LT,LL,E0,IV,RE,KFR1,KFR2,ISU,BETE,KFA1,KFA2,
  19      &                  KFA3,KFA4,IOPT)
  20
  21 #include "geant321/dblprc.inc"
  22 #include "geant321/dimpar.inc"
  23 #include "geant321/iounit.inc"
  24 *
  25 *----------------------------------------------------------------------*
  26 *                                                                      *
  27 *     New version from A. Ferrari ( 22 august 1990 ): it is almost the *
  28 *     the same as before, but with a few corrections important for isu *
  29 *     2 and 3 and also for isu=4 if it switchs to 100 continue         *
  30 *                                                                      *
  31 *----------------------------------------------------------------------*
  32 #include "geant321/part.inc"
  33 *
  34 *   The following are the masses of the quarks: the d quark mass is
  35 *   assumed to be the same as the u one. They are quite different from
  36 *   the last values from the particle data group, but any change
  37 *   can imply a change also in the BET parameter in common INPDAT
  38       PARAMETER ( UQUARM = 0.3D+00 )
  39       PARAMETER ( SQUARM = 0.5D+00 )
  40       PARAMETER ( CQUARM = 2.1D+00 )
  41       PARAMETER ( BQUARM = 5.0D+00 )
  42 *
  43       DIMENSION RE(*),KFR1(*),KFR2(*),IV(*)
  44       REAL RNDM(2)
  45 *
  46 C     CHOICE OF THE QUARK FLAVOUR
  47       IF (LT.EQ.1)WRITE(LUNOUT,288)IT,LT,LL,E0,ISU,BETE,KFA1,KFA2
  48   288 FORMAT(3I5,E12.4,I5,E12.4,2I5
  49      *,' FLAVOR IT,LT,LL,E0,ISU,BETE,KFA1,KFA2')
  50       I=IT
  51       J=IT-1
  52       IVA=1
  53       IVX=IV(I)
  54       IF (I .LE. 1) THEN
  55          IF (IOPT.EQ.2) THEN
  56             KX1 = KFA1
  57             KX2 = KFA2
  58          ELSE IF (IOPT.EQ.3.AND.LL.EQ.1) THEN
  59             KX1=KFA2
  60             KX2=0
  61          ELSE IF (IOPT.EQ.4 .AND. KFA1.LE.6 .AND. LL.EQ.1) THEN
  62             KX1=KFA2
  63             KX2=KFA3
  64          ELSE IF (IOPT.EQ.4 .AND. KFA1.GT.6 .AND. LL.EQ.0) THEN
  65             KX1=KFA2
  66             KX2=KFA3
  67          ELSE IF (IOPT.EQ.5 .AND. LL.EQ.0) THEN
  68             KX1=KFA3
  69             KX2=KFA4
  70          ELSE IF (IOPT.EQ.5 .AND. LL.EQ.1) THEN
  71             KX1=KFA1
  72             KX2=KFA2
  73          ELSE
  74             KX1=KFA1
  75             KX2=0
  76          END IF
  77          RX = E0
  78       ELSE
  79          KX1=KFR1(J)
  80          KX2=KFR2(J)
  81          RX =RE(J)
  82       END IF
  83       IF (KX1.GT.0.AND.KX2.GT.0) THEN
  84          BET=10.D+00
  85       ELSE
  86          BET=BETE
  87       END IF
  88       CALL GRNDM(RNDM,2)
  89       Z1=RNDM(1)
  90       Z2=RNDM(2)
  91       IF(ISU.EQ.4) GO TO 300
  92       IF(ISU.EQ.3) GO TO 200
  93       IF(ISU.EQ.2) GO TO 100
  94 C     U FLAVOUR
  95          KF1=1
  96          KF2=1
  97       GO TO 20
  98 C     U/D FLAVOURS
  99   100 CONTINUE
 100          IF (KX1.EQ.1.OR.KX1.EQ.7) THEN
 101             IIAA=1
 102          ELSE IF (KX1.EQ.2.OR.KX1.EQ.8) THEN
 103             IIAA=2
 104          ELSE
 105             IIAA=0
 106          END IF
 107   110 CONTINUE
 108          IF (IIAA .EQ. 1) THEN
 109             PD=0.6666666666666667D+00
 110             PU=0.3333333333333333D+00
 111          ELSE IF (IIAA .EQ. 2) THEN
 112             PU=0.6666666666666667D+00
 113             PD=0.3333333333333333D+00
 114          ELSE
 115             PU=0.5D+00
 116             PD=0.5D+00
 117          END IF
 118          PS=0.D+00
 119          PC=0.D+00
 120          IF (Z1 .LE. PD) THEN
 121             KF1=2
 122          ELSE
 123             KF1=1
 124          END IF
 125          IF (Z2 .LE. PD) THEN
 126             KF2=2
 127          ELSE
 128             KF2=1
 129          END IF
 130       GO TO 20
 131 C     U/D/S FLAVOURS
 132   200 CONTINUE
 133          IF (KX1.EQ.1.OR.KX1.EQ.7) THEN
 134             IIAA=1
 135          ELSE IF (KX1.EQ.2.OR.KX1.EQ.8) THEN
 136             IIAA=2
 137          ELSE
 138             IIAA=0
 139          END IF
 140   210 CONTINUE
 141          IF (RX .LE. 1.019D+00 ) GO TO 110
 142          X1=RX
 143          X2=UQUARM
 144          PU=BETA(X1,X2,BET)
 145          X2=SQUARM
 146          PS=BETA(X1,X2,BET)
 147          PTOT=2.D+00*PU+PS
 148          PU1=PU/PTOT
 149          PS =PS/PTOT
 150          PC=0.D+00
 151          IF (IIAA .EQ. 1) THEN
 152             PU=0.6666666666666667D+00*PU1
 153             PD=2.D+00*PU1-PU
 154          ELSE IF (IIAA .EQ. 2) THEN
 155             PD=0.6666666666666667D+00*PU1
 156             PU=2.D+00*PU1-PD
 157          ELSE
 158             PU=PU1
 159             PD=PU
 160          END IF
 161          IF (Z1 .LE. PU) THEN
 162             KF1 = 1
 163          ELSE IF ( Z1 .LE. PU + PD ) THEN
 164             KF1 = 2
 165          ELSE
 166             KF1 = 3
 167          END IF
 168          IF (Z2 .LE. PU) THEN
 169             KF2 = 1
 170          ELSE IF ( Z2 .LE. PU + PD ) THEN
 171             KF2 = 2
 172          ELSE
 173             KF2 = 3
 174          END IF
 175       GO TO 20
 176 C     U/D/S/C FLAVOUR
 177   300 CONTINUE
 178          GO TO (11,12,13,14,14,11,12,13,14,14),IVX
 179    11    CONTINUE
 180             IF (KX1.EQ.4.OR.KX1.EQ.10) THEN
 181                GM=AM(129)
 182             ELSE
 183                GM=AM(127)
 184             END IF
 185             IF (KX1.EQ.1.OR.KX1.EQ.7) THEN
 186                IIAA=1
 187             ELSE IF (KX1.EQ.2.OR.KX1.EQ.8) THEN
 188                IIAA=2
 189             ELSE
 190                IIAA=0
 191             END IF
 192          GO TO 15
 193    12    CONTINUE
 194             IF (KX1.EQ.4.OR.KX1.EQ.10) THEN
 195                GM=AM(170)
 196             ELSE
 197                GM=AM(127)
 198             END IF
 199             IIAA=0
 200          GO TO 15
 201    13    CONTINUE
 202 *  |  |  +-------------------------------------------------------------*
 203 *  |  |  | The following if replaces the cards:
 204 *  |  |  |      GM=3.85D0
 205 *  |  |  |      IF(KX1.EQ.4.AND.KX2.EQ.4) GM=4.89D0
 206 *  |  |  |      IF(KX1.NE.4.AND.KX2.NE.4) GM=2.770D0
 207 *  |  |  |      IF(KX1.EQ.10.AND.KX2.EQ.10) GM=4.89D0
 208 *  |  |  |      IF(KX1.NE.10.AND.KX2.NE.10) GM=2.770D0
 209 *  |  |  | It is completely equivalent except for the combination
 210 *  |  |  | 4-4 which now gives GM = 4.89, while in the original
 211 *  |  |  | coding gave GM = 2.77, because of the last condition
 212 *  |  |  | always overrides the first one (it seems to be a mistake)
 213             IF (KX1 .EQ. 4 .OR. KX1 .EQ. 10 ) THEN
 214                IF ( KX2 .EQ. KX1 ) THEN
 215                   GM = AM(170)
 216                ELSE
 217                   GM = AM(169)
 218                END IF
 219             ELSE IF (KX2 .EQ. 4 .OR. KX2 .EQ. 10 ) THEN
 220                GM = AM(169)
 221             ELSE
 222                GM = AM(166)
 223             END IF
 224             IIAA=0
 225          GO TO 15
 226    14    CONTINUE
 227 *  |  |  +-------------------------------------------------------------*
 228 *  |  |  | The following if replaces the cards:
 229 *  |  |  |      GM=3.684D0
 230 *  |  |  |      IF(KX1.NE.4.AND.KX2.NE.4) GM=2.140D0
 231 *  |  |  |      IF(KX1.NE.10.AND.KX2.NE.10) GM=2.140D0
 232 *  |  |  | It is equivalent: only for the combinations
 233 *  |  |  | 4-10 and 10-4 we get GM = 3.684
 234 *  |  |  | It is not clear if it is correct since 4-x,x-4 (x.ne.10),
 235 *  |  |  | 10-x,x-10 (x.ne.4) give GM = 2.14
 236             IF ((KX1.EQ.4.AND.KX2.EQ.10).OR.(KX1.EQ.10.AND.KX2.EQ.4))
 237      &         THEN
 238                GM = AM(129)
 239             ELSE
 240                GM = AM(127)
 241             END IF
 242             IF (IVX.EQ.4.OR.IVX.EQ.9) THEN
 243                KAXI=KX1
 244             ELSE IF (IVX.EQ.5.OR.IVX.EQ.10) THEN
 245                KAXI=KX2
 246             ELSE
 247 *  |  |  |   Kaxi = 0 added for completeness, maybe it is useless
 248                KAXI=0
 249             END IF
 250             IF (KAXI.EQ.1.OR.KAXI.EQ.7) THEN
 251                IIAA=1
 252             ELSE IF (KAXI.EQ.2.OR.KAXI.EQ.8) THEN
 253                IIAA=2
 254             ELSE
 255                IIAA=0
 256             END IF
 257          GO TO 15
 258    15    CONTINUE
 259          IF (RX .LE. GM) GO TO 200
 260          X1=RX
 261          X2=UQUARM
 262          PU=BETA(X1,X2,BET)
 263          X2=SQUARM
 264          PS=BETA(X1,X2,BET)
 265          X2=CQUARM
 266          PC=BETA(X1,X2,BET)
 267          PTOT=2.D+00*PU+PS+PC
 268          PU1=PU/PTOT
 269          PS=PS/PTOT
 270          PC=PC/PTOT
 271          IF (IIAA .EQ. 1) THEN
 272             PU=0.6666666666666667D+00*PU1
 273             PD=2.D+00*PU1-PU
 274          ELSE IF (IIAA .EQ. 2) THEN
 275             PD=0.6666666666666667D+00*PU1
 276             PU=2.D+00*PU1-PD
 277          ELSE
 278             PU=PU1
 279             PD=PU
 280          END IF
 281          IF (Z1 .LE. PU) THEN
 282             KF1 = 1
 283          ELSE IF ( Z1 .LE. PU + PD ) THEN
 284             KF1 = 2
 285          ELSE IF ( Z1 .LE. PU + PD + PS ) THEN
 286             KF1 = 3
 287          ELSE
 288             KF1 = 4
 289          END IF
 290          IF (Z2 .LE. PU) THEN
 291             KF2 = 1
 292          ELSE IF ( Z2 .LE. PU + PD ) THEN
 293             KF2 = 2
 294          ELSE IF ( Z2 .LE. PU + PD + PS ) THEN
 295             KF2 = 3
 296          ELSE
 297             KF2 = 4
 298          END IF
 299       GO TO 20
 300    20 CONTINUE
 301 C*****CHOICE OF THE QUARKFLAVOURS IN DEPENDENCE OF THE VERTEX IV
 302       IVX=IV(I)
 303       GO TO (1,2,3,4,5,1,2,3,4,5),IVX
 304     1 CONTINUE
 305          IF (LL.EQ.1) THEN
 306             KFR1(I)=KF1+6
 307          ELSE
 308             KFR1(I)=KF1
 309          END IF
 310          KFR2(I)=0
 311       GO TO 30
 312     2 CONTINUE
 313          IF (LL.EQ.1) THEN
 314             KFR1(I)=KF1
 315             KFR2(I)=KF2
 316          ELSE
 317             KFR1(I)=KF1+6
 318             KFR2(I)=KF2+6
 319          END IF
 320       GO TO 30
 321     3 CONTINUE
 322          KFR2(I)=0
 323          IF (LL.EQ.1) THEN
 324             KFR1(I)=KF1+6
 325          ELSE
 326             KFR1(I)=KF1
 327          END IF
 328       GO TO 30
 329     4 CONTINUE
 330          IF (LL.EQ.1) THEN
 331             KFR1(I)=KF1
 332          ELSE
 333             KFR1(I)=KF1+6
 334          END IF
 335          KFR2(I)=KX2
 336       GO TO 30
 337     5 CONTINUE
 338          KFR1(I)=KX1
 339          IF (LL.EQ.1) THEN
 340             KFR2(I)=KF2
 341          ELSE
 342             KFR2(I)=KF2+6
 343          END IF
 344       GO TO 30
 345    30 CONTINUE
 346       IF(LT.EQ.0) GO TO 80
 347       WRITE(LUNOUT,6)PU,PD,PS,PC,KX1,KX2
 348     6 FORMAT(1H0,' FLAVOR PU,PD,PS,PC,KX1,KX2',4F8.4,2I5)
 349       IF(I.EQ.1) GO TO 40
 350       WRITE(LUNOUT,60)IV(I),LL,KFR1(J),KFR2(J),KFR1(I),KFR2(I)
 351       GO TO 50
 352    40 WRITE(LUNOUT,70)IV(I),LL,KFA1,KFA2,KFR1(I),KFR2(I)
 353    50 CONTINUE
 354    60 FORMAT(1H0,22HIV,LL,Q1A,Q2A,Q1N,Q2N=,6I3)
 355    70 FORMAT(1H0,'IV(I),LL,KFA1,KFA2,KFR1(I),KFR2(I)=',6I3 )
 356    80 CONTINUE
 357       RETURN
 358       END
 359 #else
 360       SUBROUTINE FLAVOR_DUMMY
 361       END
 362 #endif