Merging the VirtualMC branch to the main development branch (HEAD)
[u/mrichter/AliRoot.git] / HIJING / hipyset1_35 / luonia_hijing.F
CommitLineData
e74335a4 1* $Id$
2
3C*********************************************************************
4
5 SUBROUTINE LUONIA_HIJING(KFL,ECM)
6
7C...Purpose: to generate Upsilon and toponium decays into three
8C...gluons or two gluons and a photon.
9#include "lujets_hijing.inc"
10#include "ludat1_hijing.inc"
11#include "ludat2_hijing.inc"
12
13C...Printout. Check input parameters.
14 IF(MSTU(12).GE.1) CALL LULIST_HIJING(0)
15 IF(KFL.LT.0.OR.KFL.GT.8) THEN
16 CALL LUERRM_HIJING(16
17 $ ,'(LUONIA_HIJING:) called with unknown flavour code')
18 IF(MSTU(21).GE.1) RETURN
19 ENDIF
20 IF(ECM.LT.PARJ(127)+2.02*PARF(101)) THEN
21 CALL LUERRM_HIJING(16
22 $ ,'(LUONIA_HIJING:) called with too small CM energy')
23 IF(MSTU(21).GE.1) RETURN
24 ENDIF
25
26C...Initial e+e- and onium state (optional).
27 NC=0
28 IF(MSTJ(115).GE.2) THEN
29 NC=NC+2
30 CALL LU1ENT_HIJING(NC-1,11,0.5*ECM,0.,0.)
31 K(NC-1,1)=21
32 CALL LU1ENT_HIJING(NC,-11,0.5*ECM,PARU(1),0.)
33 K(NC,1)=21
34 ENDIF
35 KFLC=IABS(KFL)
36 IF(MSTJ(115).GE.3.AND.KFLC.GE.5) THEN
37 NC=NC+1
38 KF=110*KFLC+3
39 MSTU10=MSTU(10)
40 MSTU(10)=1
41 P(NC,5)=ECM
42 CALL LU1ENT_HIJING(NC,KF,ECM,0.,0.)
43 K(NC,1)=21
44 K(NC,3)=1
45 MSTU(10)=MSTU10
46 ENDIF
47
48C...Choose x1 and x2 according to matrix element.
49 NTRY=0
50 100 X1=RLU_HIJING(0)
51 X2=RLU_HIJING(0)
52 X3=2.-X1-X2
53 IF(X3.GE.1..OR.((1.-X1)/(X2*X3))**2+((1.-X2)/(X1*X3))**2+
54 &((1.-X3)/(X1*X2))**2.LE.2.*RLU_HIJING(0)) GOTO 100
55 NTRY=NTRY+1
56 NJET=3
57 IF(MSTJ(101).LE.4) CALL LU3ENT_HIJING(NC+1,21,21,21,ECM,X1,X3)
58 IF(MSTJ(101).GE.5) CALL LU3ENT_HIJING(-(NC+1),21,21,21,ECM,X1,X3)
59
60C...Photon-gluon-gluon events. Small system modifications. Jet origin.
61 MSTU(111)=MSTJ(108)
62 IF(MSTJ(108).EQ.2.AND.(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.1))
63 &MSTU(111)=1
64 PARU(112)=PARJ(121)
65 IF(MSTU(111).EQ.2) PARU(112)=PARJ(122)
66 QF=0.
67 IF(KFLC.NE.0) QF=KCHG(KFLC,1)/3.
68 RGAM=7.2*QF**2*PARU(101)/ULALPS_HIJING(ECM**2)
69 MK=0
70 ECMC=ECM
71 IF(RLU_HIJING(0).GT.RGAM/(1.+RGAM)) THEN
72 IF(1.-MAX(X1,X2,X3).LE.MAX((PARJ(126)/ECM)**2,PARJ(125)))
73 & NJET=2
74 IF(NJET.EQ.2.AND.MSTJ(101).LE.4) CALL LU2ENT_HIJING(NC+1,21,21
75 $ ,ECM)
76 IF(NJET.EQ.2.AND.MSTJ(101).GE.5) CALL LU2ENT_HIJING(-(NC+1),21
77 $ ,21,ECM)
78 ELSE
79 MK=1
80 ECMC=SQRT(1.-X1)*ECM
81 IF(ECMC.LT.2.*PARJ(127)) GOTO 100
82 K(NC+1,1)=1
83 K(NC+1,2)=22
84 K(NC+1,4)=0
85 K(NC+1,5)=0
86 IF(MSTJ(101).GE.5) K(NC+2,4)=MSTU(5)*(NC+3)
87 IF(MSTJ(101).GE.5) K(NC+2,5)=MSTU(5)*(NC+3)
88 IF(MSTJ(101).GE.5) K(NC+3,4)=MSTU(5)*(NC+2)
89 IF(MSTJ(101).GE.5) K(NC+3,5)=MSTU(5)*(NC+2)
90 NJET=2
91 IF(ECMC.LT.4.*PARJ(127)) THEN
92 MSTU10=MSTU(10)
93 MSTU(10)=1
94 P(NC+2,5)=ECMC
95 CALL LU1ENT_HIJING(NC+2,83,0.5*(X2+X3)*ECM,PARU(1),0.)
96 MSTU(10)=MSTU10
97 NJET=0
98 ENDIF
99 ENDIF
100 DO 110 IP=NC+1,N
101 110 K(IP,3)=K(IP,3)+(MSTJ(115)/2)+(KFLC/5)*(MSTJ(115)/3)*(NC-1)
102
103C...Differential cross-sections. Upper limit for cross-section.
104 IF(MSTJ(106).EQ.1) THEN
105 SQ2=SQRT(2.)
106 HF1=1.-PARJ(131)*PARJ(132)
107 HF3=PARJ(133)**2
108 CT13=(X1*X3-2.*X1-2.*X3+2.)/(X1*X3)
109 ST13=SQRT(1.-CT13**2)
110 SIGL=0.5*X3**2*((1.-X2)**2+(1.-X3)**2)*ST13**2
111 SIGU=(X1*(1.-X1))**2+(X2*(1.-X2))**2+(X3*(1.-X3))**2-SIGL
112 SIGT=0.5*SIGL
113 SIGI=(SIGL*CT13/ST13+0.5*X1*X3*(1.-X2)**2*ST13)/SQ2
114 SIGMAX=(2.*HF1+HF3)*ABS(SIGU)+2.*(HF1+HF3)*ABS(SIGL)+2.*(HF1+
115 & 2.*HF3)*ABS(SIGT)+2.*SQ2*(HF1+2.*HF3)*ABS(SIGI)
116
117C...Angular orientation of event.
118 120 CHI=PARU(2)*RLU_HIJING(0)
119 CTHE=2.*RLU_HIJING(0)-1.
120 PHI=PARU(2)*RLU_HIJING(0)
121 CCHI=COS(CHI)
122 SCHI=SIN(CHI)
123 C2CHI=COS(2.*CHI)
124 S2CHI=SIN(2.*CHI)
125 THE=ACOS(CTHE)
126 STHE=SIN(THE)
127 C2PHI=COS(2.*(PHI-PARJ(134)))
128 S2PHI=SIN(2.*(PHI-PARJ(134)))
129 SIG=((1.+CTHE**2)*HF1+STHE**2*C2PHI*HF3)*SIGU+2.*(STHE**2*HF1-
130 & STHE**2*C2PHI*HF3)*SIGL+2.*(STHE**2*C2CHI*HF1+((1.+CTHE**2)*
131 & C2CHI*C2PHI-2.*CTHE*S2CHI*S2PHI)*HF3)*SIGT-2.*SQ2*(2.*STHE*CTHE*
132 & CCHI*HF1-2.*STHE*(CTHE*CCHI*C2PHI-SCHI*S2PHI)*HF3)*SIGI
133 IF(SIG.LT.SIGMAX*RLU_HIJING(0)) GOTO 120
134 CALL LUDBRB_HIJING(NC+1,N,0.,CHI,0D0,0D0,0D0)
135 CALL LUDBRB_HIJING(NC+1,N,THE,PHI,0D0,0D0,0D0)
136 ENDIF
137
138C...Generate parton shower. Rearrange along strings and check.
139 IF(MSTJ(101).GE.5.AND.NJET.GE.2) THEN
140 CALL LUSHOW_HIJING(NC+MK+1,-NJET,ECMC)
141 MSTJ14=MSTJ(14)
142 IF(MSTJ(105).EQ.-1) MSTJ(14)=0
143 IF(MSTJ(105).GE.0) MSTU(28)=0
144 CALL LUPREP_HIJING(0)
145 MSTJ(14)=MSTJ14
146 IF(MSTJ(105).GE.0.AND.MSTU(28).NE.0) GOTO 100
147 ENDIF
148
149C...Generate fragmentation. Information for LUTABU_HIJING:
150 IF(MSTJ(105).EQ.1) CALL LUEXEC_HIJING
151 MSTU(161)=110*KFLC+3
152 MSTU(162)=0
153
154 RETURN
155 END