2 C*********************************************************************
4 SUBROUTINE LUONIA(KFL,ECM)
6 C...Purpose: to generate Upsilon and toponium decays into three
7 C...gluons or two gluons and a photon.
8 COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
9 COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
10 COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
11 SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
13 C...Printout. Check input parameters.
14 IF(MSTU(12).GE.1) CALL LULIST(0)
15 IF(KFL.LT.0.OR.KFL.GT.8) THEN
16 CALL LUERRM(16,'(LUONIA:) called with unknown flavour code')
17 IF(MSTU(21).GE.1) RETURN
19 IF(ECM.LT.PARJ(127)+2.02*PARF(101)) THEN
20 CALL LUERRM(16,'(LUONIA:) called with too small CM energy')
21 IF(MSTU(21).GE.1) RETURN
24 C...Initial e+e- and onium state (optional).
26 IF(MSTJ(115).GE.2) THEN
28 CALL LU1ENT(NC-1,11,0.5*ECM,0.,0.)
30 CALL LU1ENT(NC,-11,0.5*ECM,PARU(1),0.)
34 IF(MSTJ(115).GE.3.AND.KFLC.GE.5) THEN
40 CALL LU1ENT(NC,KF,ECM,0.,0.)
46 C...Choose x1 and x2 according to matrix element.
51 IF(X3.GE.1..OR.((1.-X1)/(X2*X3))**2+((1.-X2)/(X1*X3))**2+
52 &((1.-X3)/(X1*X2))**2.LE.2.*RLU(0)) GOTO 100
55 IF(MSTJ(101).LE.4) CALL LU3ENT(NC+1,21,21,21,ECM,X1,X3)
56 IF(MSTJ(101).GE.5) CALL LU3ENT(-(NC+1),21,21,21,ECM,X1,X3)
58 C...Photon-gluon-gluon events. Small system modifications. Jet origin.
60 IF(MSTJ(108).EQ.2.AND.(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.1))
63 IF(MSTU(111).EQ.2) PARU(112)=PARJ(122)
65 IF(KFLC.NE.0) QF=KCHG(KFLC,1)/3.
66 RGAM=7.2*QF**2*PARU(101)/ULALPS(ECM**2)
69 IF(RLU(0).GT.RGAM/(1.+RGAM)) THEN
70 IF(1.-MAX(X1,X2,X3).LE.MAX((PARJ(126)/ECM)**2,PARJ(125)))
72 IF(NJET.EQ.2.AND.MSTJ(101).LE.4) CALL LU2ENT(NC+1,21,21,ECM)
73 IF(NJET.EQ.2.AND.MSTJ(101).GE.5) CALL LU2ENT(-(NC+1),21,21,ECM)
77 IF(ECMC.LT.2.*PARJ(127)) GOTO 100
82 IF(MSTJ(101).GE.5) K(NC+2,4)=MSTU(5)*(NC+3)
83 IF(MSTJ(101).GE.5) K(NC+2,5)=MSTU(5)*(NC+3)
84 IF(MSTJ(101).GE.5) K(NC+3,4)=MSTU(5)*(NC+2)
85 IF(MSTJ(101).GE.5) K(NC+3,5)=MSTU(5)*(NC+2)
87 IF(ECMC.LT.4.*PARJ(127)) THEN
91 CALL LU1ENT(NC+2,83,0.5*(X2+X3)*ECM,PARU(1),0.)
97 K(IP,3)=K(IP,3)+(MSTJ(115)/2)+(KFLC/5)*(MSTJ(115)/3)*(NC-1)
100 C...Differential cross-sections. Upper limit for cross-section.
101 IF(MSTJ(106).EQ.1) THEN
103 HF1=1.-PARJ(131)*PARJ(132)
105 CT13=(X1*X3-2.*X1-2.*X3+2.)/(X1*X3)
106 ST13=SQRT(1.-CT13**2)
107 SIGL=0.5*X3**2*((1.-X2)**2+(1.-X3)**2)*ST13**2
108 SIGU=(X1*(1.-X1))**2+(X2*(1.-X2))**2+(X3*(1.-X3))**2-SIGL
110 SIGI=(SIGL*CT13/ST13+0.5*X1*X3*(1.-X2)**2*ST13)/SQ2
111 SIGMAX=(2.*HF1+HF3)*ABS(SIGU)+2.*(HF1+HF3)*ABS(SIGL)+2.*(HF1+
112 & 2.*HF3)*ABS(SIGT)+2.*SQ2*(HF1+2.*HF3)*ABS(SIGI)
114 C...Angular orientation of event.
115 120 CHI=PARU(2)*RLU(0)
124 C2PHI=COS(2.*(PHI-PARJ(134)))
125 S2PHI=SIN(2.*(PHI-PARJ(134)))
126 SIG=((1.+CTHE**2)*HF1+STHE**2*C2PHI*HF3)*SIGU+2.*(STHE**2*HF1-
127 & STHE**2*C2PHI*HF3)*SIGL+2.*(STHE**2*C2CHI*HF1+((1.+CTHE**2)*
128 & C2CHI*C2PHI-2.*CTHE*S2CHI*S2PHI)*HF3)*SIGT-2.*SQ2*(2.*STHE*CTHE*
129 & CCHI*HF1-2.*STHE*(CTHE*CCHI*C2PHI-SCHI*S2PHI)*HF3)*SIGI
130 IF(SIG.LT.SIGMAX*RLU(0)) GOTO 120
131 CALL LUDBRB(NC+1,N,0.,CHI,0D0,0D0,0D0)
132 CALL LUDBRB(NC+1,N,THE,PHI,0D0,0D0,0D0)
135 C...Generate parton shower. Rearrange along strings and check.
136 IF(MSTJ(101).GE.5.AND.NJET.GE.2) THEN
137 CALL LUSHOW(NC+MK+1,-NJET,ECMC)
139 IF(MSTJ(105).EQ.-1) MSTJ(14)=-1
140 IF(MSTJ(105).GE.0) MSTU(28)=0
143 IF(MSTJ(105).GE.0.AND.MSTU(28).NE.0) GOTO 100
146 C...Generate fragmentation. Information for LUTABU:
147 IF(MSTJ(105).EQ.1) CALL LUEXEC