PHOS/shaker/lueevt.f

   1 *CMZ :          17/07/98  15.44.35  by  Federico Carminati
   2 *-- Author :
   3 C*********************************************************************
   4
   5       SUBROUTINE LUEEVT(KFL,ECM)
   6
   7 C...Purpose: to handle the generation of an e+e- annihilation jet event.
   8       IMPLICIT DOUBLE PRECISION(D)
   9 *KEEP,LUJETS.
  10       COMMON /LUJETS/ N,K(200000,5),P(200000,5),V(200000,5)
  11       SAVE /LUJETS/
  12 *KEEP,LUDAT1.
  13       COMMON /LUDAT1/ MSTU(200),PARU(200),MSTJ(200),PARJ(200)
  14       SAVE /LUDAT1/
  15 *KEEP,LUDAT2.
  16       COMMON /LUDAT2/ KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
  17       SAVE /LUDAT2/
  18 *KEND.
  19
  20 C...Check input parameters.
  21       IF(MSTU(12).GE.1) CALL LULIST(0)
  22       IF(KFL.LT.0.OR.KFL.GT.8) THEN
  23         CALL LUERRM(16,'(LUEEVT:) called with unknown flavour code')
  24         IF(MSTU(21).GE.1) RETURN
  25       ENDIF
  26       IF(KFL.LE.5) ECMMIN=PARJ(127)+2.02*PARF(100+MAX(1,KFL))
  27       IF(KFL.GE.6) ECMMIN=PARJ(127)+2.02*PMAS(KFL,1)
  28       IF(ECM.LT.ECMMIN) THEN
  29         CALL LUERRM(16,'(LUEEVT:) called with too small CM energy')
  30         IF(MSTU(21).GE.1) RETURN
  31       ENDIF
  32
  33 C...Check consistency of MSTJ options set.
  34       IF(MSTJ(109).EQ.2.AND.MSTJ(110).NE.1) THEN
  35         CALL LUERRM(6,
  36      &  '(LUEEVT:) MSTJ(109) value requires MSTJ(110) = 1')
  37         MSTJ(110)=1
  38       ENDIF
  39       IF(MSTJ(109).EQ.2.AND.MSTJ(111).NE.0) THEN
  40         CALL LUERRM(6,
  41      &  '(LUEEVT:) MSTJ(109) value requires MSTJ(111) = 0')
  42         MSTJ(111)=0
  43       ENDIF
  44
  45 C...Initialize alpha_strong and total cross-section.
  46       MSTU(111)=MSTJ(108)
  47       IF(MSTJ(108).EQ.2.AND.(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.1))
  48      &MSTU(111)=1
  49       PARU(112)=PARJ(121)
  50       IF(MSTU(111).EQ.2) PARU(112)=PARJ(122)
  51       IF(MSTJ(116).GT.0.AND.(MSTJ(116).GE.2.OR.ABS(ECM-PARJ(151)).GE.
  52      &PARJ(139).OR.10*MSTJ(102)+KFL.NE.MSTJ(119))) CALL LUXTOT(KFL,ECM,
  53      &XTOT)
  54       IF(MSTJ(116).GE.3) MSTJ(116)=1
  55
  56 C...Add initial e+e- to event record (documentation only).
  57       NTRY=0
  58   100 NTRY=NTRY+1
  59       IF(NTRY.GT.100) THEN
  60         CALL LUERRM(14,'(LUEEVT:) caught in an infinite loop')
  61         RETURN
  62       ENDIF
  63       NC=0
  64       IF(MSTJ(115).GE.2) THEN
  65         NC=NC+2
  66         CALL LU1ENT(NC-1,11,0.5*ECM,0.,0.)
  67         K(NC-1,1)=21
  68         CALL LU1ENT(NC,-11,0.5*ECM,PARU(1),0.)
  69         K(NC,1)=21
  70       ENDIF
  71
  72 C...Radiative photon (in initial state).
  73       MK=0
  74       ECMC=ECM
  75       IF(MSTJ(107).GE.1.AND.MSTJ(116).GE.1) CALL LURADK(ECM,MK,PAK,
  76      &THEK,PHIK,ALPK)
  77       IF(MK.EQ.1) ECMC=SQRT(ECM*(ECM-2.*PAK))
  78       IF(MSTJ(115).GE.1.AND.MK.EQ.1) THEN
  79         NC=NC+1
  80         CALL LU1ENT(NC,22,PAK,THEK,PHIK)
  81         K(NC,3)=MIN(MSTJ(115)/2,1)
  82       ENDIF
  83
  84 C...Virtual exchange boson (gamma or Z0).
  85       IF(MSTJ(115).GE.3) THEN
  86         NC=NC+1
  87         KF=22
  88         IF(MSTJ(102).EQ.2) KF=23
  89         MSTU10=MSTU(10)
  90         MSTU(10)=1
  91         P(NC,5)=ECMC
  92         CALL LU1ENT(NC,KF,ECMC,0.,0.)
  93         K(NC,1)=21
  94         K(NC,3)=1
  95         MSTU(10)=MSTU10
  96       ENDIF
  97
  98 C...Choice of flavour and jet configuration.
  99       CALL LUXKFL(KFL,ECM,ECMC,KFLC)
 100       IF(KFLC.EQ.0) GOTO 100
 101       CALL LUXJET(ECMC,NJET,CUT)
 102       KFLN=21
 103       IF(NJET.EQ.4) CALL LUX4JT(NJET,CUT,KFLC,ECMC,KFLN,X1,X2,X4,
 104      &X12,X14)
 105       IF(NJET.EQ.3) CALL LUX3JT(NJET,CUT,KFLC,ECMC,X1,X3)
 106       IF(NJET.EQ.2) MSTJ(120)=1
 107
 108 C...Fill jet configuration and origin.
 109       IF(NJET.EQ.2.AND.MSTJ(101).NE.5) CALL LU2ENT(NC+1,KFLC,-KFLC,ECMC)
 110       IF(NJET.EQ.2.AND.MSTJ(101).EQ.5) CALL LU2ENT(-(NC+1),KFLC,-KFLC,
 111      &ECMC)
 112       IF(NJET.EQ.3) CALL LU3ENT(NC+1,KFLC,21,-KFLC,ECMC,X1,X3)
 113       IF(NJET.EQ.4.AND.KFLN.EQ.21) CALL LU4ENT(NC+1,KFLC,KFLN,KFLN,
 114      &-KFLC,ECMC,X1,X2,X4,X12,X14)
 115       IF(NJET.EQ.4.AND.KFLN.NE.21) CALL LU4ENT(NC+1,KFLC,-KFLN,KFLN,
 116      &-KFLC,ECMC,X1,X2,X4,X12,X14)
 117       DO 110 IP=NC+1,N
 118   110 K(IP,3)=K(IP,3)+MIN(MSTJ(115)/2,1)+(MSTJ(115)/3)*(NC-1)
 119
 120 C...Angular orientation according to matrix element.
 121       IF(MSTJ(106).EQ.1) THEN
 122         CALL LUXDIF(NC,NJET,KFLC,ECMC,CHI,THE,PHI)
 123         CALL LUDBRB(NC+1,N,0.,CHI,0D0,0D0,0D0)
 124         CALL LUDBRB(NC+1,N,THE,PHI,0D0,0D0,0D0)
 125       ENDIF
 126
 127 C...Rotation and boost from radiative photon.
 128       IF(MK.EQ.1) THEN
 129         DBEK=-PAK/(ECM-PAK)
 130         NMIN=NC+1-MSTJ(115)/3
 131         CALL LUDBRB(NMIN,N,0.,-PHIK,0D0,0D0,0D0)
 132         CALL LUDBRB(NMIN,N,ALPK,0.,DBEK*SIN(THEK),0D0,DBEK*COS(THEK))
 133         CALL LUDBRB(NMIN,N,0.,PHIK,0D0,0D0,0D0)
 134       ENDIF
 135
 136 C...Generate parton shower. Rearrange along strings and check.
 137       IF(MSTJ(101).EQ.5) THEN
 138         CALL LUSHOW(N-1,N,ECMC)
 139         MSTJ14=MSTJ(14)
 140         IF(MSTJ(105).EQ.-1) MSTJ(14)=0
 141         IF(MSTJ(105).GE.0) MSTU(28)=0
 142         CALL LUPREP(0)
 143         MSTJ(14)=MSTJ14
 144         IF(MSTJ(105).GE.0.AND.MSTU(28).NE.0) GOTO 100
 145       ENDIF
 146
 147 C...Fragmentation/decay generation. Information for LUTABU.
 148       IF(MSTJ(105).EQ.1) CALL LUEXEC
 149       MSTU(161)=KFLC
 150       MSTU(162)=-KFLC
 151
 152       RETURN
 153       END