hijing/src/luonia.f

0001
0002 C*********************************************************************
0003
0004       SUBROUTINE LUONIA(KFL,ECM)
0005
0006 C...Purpose: to generate Upsilon and toponium decays into three
0007 C...gluons or two gluons and a photon.
0008       COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
0009       SAVE /LUJETS/
0010       COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0011       SAVE /LUDAT1/
0012       COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
0013       SAVE /LUDAT2/
0014
0015 C...Printout. Check input parameters.
0016       IF(MSTU(12).GE.1) CALL LULIST(0)
0017       IF(KFL.LT.0.OR.KFL.GT.8) THEN
0018         CALL LUERRM(16,'(LUONIA:) called with unknown flavour code')
0019         IF(MSTU(21).GE.1) RETURN
0020       ENDIF
0021       IF(ECM.LT.PARJ(127)+2.02*PARF(101)) THEN
0022         CALL LUERRM(16,'(LUONIA:) called with too small CM energy')
0023         IF(MSTU(21).GE.1) RETURN
0024       ENDIF
0025
0026 C...Initial e+e- and onium state (optional).
0027       NC=0
0028       IF(MSTJ(115).GE.2) THEN
0029         NC=NC+2
0030         CALL LU1ENT(NC-1,11,0.5*ECM,0.,0.)
0031         K(NC-1,1)=21
0032         CALL LU1ENT(NC,-11,0.5*ECM,PARU(1),0.)
0033         K(NC,1)=21
0034       ENDIF
0035       KFLC=IABS(KFL)
0036       IF(MSTJ(115).GE.3.AND.KFLC.GE.5) THEN
0037         NC=NC+1
0038         KF=110*KFLC+3
0039         MSTU10=MSTU(10)
0040         MSTU(10)=1
0041         P(NC,5)=ECM
0042         CALL LU1ENT(NC,KF,ECM,0.,0.)
0043         K(NC,1)=21
0044         K(NC,3)=1
0045         MSTU(10)=MSTU10
0046       ENDIF
0047
0048 C...Choose x1 and x2 according to matrix element.
0049       NTRY=0
0050   100 X1=RLU(0)
0051       X2=RLU(0)
0052       X3=2.-X1-X2
0053       IF(X3.GE.1..OR.((1.-X1)/(X2*X3))**2+((1.-X2)/(X1*X3))**2+
0054      &((1.-X3)/(X1*X2))**2.LE.2.*RLU(0)) GOTO 100
0055       NTRY=NTRY+1
0056       NJET=3
0057       IF(MSTJ(101).LE.4) CALL LU3ENT(NC+1,21,21,21,ECM,X1,X3)
0058       IF(MSTJ(101).GE.5) CALL LU3ENT(-(NC+1),21,21,21,ECM,X1,X3)
0059
0060 C...Photon-gluon-gluon events. Small system modifications. Jet origin.
0061       MSTU(111)=MSTJ(108)
0062       IF(MSTJ(108).EQ.2.AND.(MSTJ(101).EQ.0.OR.MSTJ(101).EQ.1))
0063      &MSTU(111)=1
0064       PARU(112)=PARJ(121)
0065       IF(MSTU(111).EQ.2) PARU(112)=PARJ(122)
0066       QF=0.
0067       IF(KFLC.NE.0) QF=KCHG(KFLC,1)/3.
0068       RGAM=7.2*QF**2*PARU(101)/ULALPS(ECM**2)
0069       MK=0
0070       ECMC=ECM
0071       IF(RLU(0).GT.RGAM/(1.+RGAM)) THEN
0072         IF(1.-MAX(X1,X2,X3).LE.MAX((PARJ(126)/ECM)**2,PARJ(125)))
0073      &  NJET=2
0074         IF(NJET.EQ.2.AND.MSTJ(101).LE.4) CALL LU2ENT(NC+1,21,21,ECM)
0075         IF(NJET.EQ.2.AND.MSTJ(101).GE.5) CALL LU2ENT(-(NC+1),21,21,ECM)
0076       ELSE
0077         MK=1
0078         ECMC=SQRT(1.-X1)*ECM
0079         IF(ECMC.LT.2.*PARJ(127)) GOTO 100
0080         K(NC+1,1)=1
0081         K(NC+1,2)=22
0082         K(NC+1,4)=0
0083         K(NC+1,5)=0
0084         IF(MSTJ(101).GE.5) K(NC+2,4)=MSTU(5)*(NC+3)
0085         IF(MSTJ(101).GE.5) K(NC+2,5)=MSTU(5)*(NC+3)
0086         IF(MSTJ(101).GE.5) K(NC+3,4)=MSTU(5)*(NC+2)
0087         IF(MSTJ(101).GE.5) K(NC+3,5)=MSTU(5)*(NC+2)
0088         NJET=2
0089         IF(ECMC.LT.4.*PARJ(127)) THEN
0090           MSTU10=MSTU(10)
0091           MSTU(10)=1
0092           P(NC+2,5)=ECMC
0093           CALL LU1ENT(NC+2,83,0.5*(X2+X3)*ECM,PARU(1),0.)
0094           MSTU(10)=MSTU10
0095           NJET=0
0096         ENDIF
0097       ENDIF
0098       DO 110 IP=NC+1,N
0099   110 K(IP,3)=K(IP,3)+(MSTJ(115)/2)+(KFLC/5)*(MSTJ(115)/3)*(NC-1)
0100
0101 C...Differential cross-sections. Upper limit for cross-section.
0102       IF(MSTJ(106).EQ.1) THEN
0103         SQ2=SQRT(2.)
0104         HF1=1.-PARJ(131)*PARJ(132)
0105         HF3=PARJ(133)**2
0106         CT13=(X1*X3-2.*X1-2.*X3+2.)/(X1*X3)
0107         ST13=SQRT(1.-CT13**2)
0108         SIGL=0.5*X3**2*((1.-X2)**2+(1.-X3)**2)*ST13**2
0109         SIGU=(X1*(1.-X1))**2+(X2*(1.-X2))**2+(X3*(1.-X3))**2-SIGL
0110         SIGT=0.5*SIGL
0111         SIGI=(SIGL*CT13/ST13+0.5*X1*X3*(1.-X2)**2*ST13)/SQ2
0112         SIGMAX=(2.*HF1+HF3)*ABS(SIGU)+2.*(HF1+HF3)*ABS(SIGL)+2.*(HF1+
0113      &  2.*HF3)*ABS(SIGT)+2.*SQ2*(HF1+2.*HF3)*ABS(SIGI)
0114
0115 C...Angular orientation of event.
0116   120   CHI=PARU(2)*RLU(0)
0117         CTHE=2.*RLU(0)-1.
0118         PHI=PARU(2)*RLU(0)
0119         CCHI=COS(CHI)
0120         SCHI=SIN(CHI)
0121         C2CHI=COS(2.*CHI)
0122         S2CHI=SIN(2.*CHI)
0123         THE=ACOS(CTHE)
0124         STHE=SIN(THE)
0125         C2PHI=COS(2.*(PHI-PARJ(134)))
0126         S2PHI=SIN(2.*(PHI-PARJ(134)))
0127         SIG=((1.+CTHE**2)*HF1+STHE**2*C2PHI*HF3)*SIGU+2.*(STHE**2*HF1-
0128      &  STHE**2*C2PHI*HF3)*SIGL+2.*(STHE**2*C2CHI*HF1+((1.+CTHE**2)*
0129      &  C2CHI*C2PHI-2.*CTHE*S2CHI*S2PHI)*HF3)*SIGT-2.*SQ2*(2.*STHE*CTHE*
0130      &  CCHI*HF1-2.*STHE*(CTHE*CCHI*C2PHI-SCHI*S2PHI)*HF3)*SIGI
0131         IF(SIG.LT.SIGMAX*RLU(0)) GOTO 120
0132         CALL LUDBRB(NC+1,N,0.,CHI,0D0,0D0,0D0)
0133         CALL LUDBRB(NC+1,N,THE,PHI,0D0,0D0,0D0)
0134       ENDIF
0135
0136 C...Generate parton shower. Rearrange along strings and check.
0137       IF(MSTJ(101).GE.5.AND.NJET.GE.2) THEN
0138         CALL LUSHOW(NC+MK+1,-NJET,ECMC)
0139         MSTJ14=MSTJ(14)
0140         IF(MSTJ(105).EQ.-1) MSTJ(14)=0
0141         IF(MSTJ(105).GE.0) MSTU(28)=0
0142         CALL LUPREP(0)
0143         MSTJ(14)=MSTJ14
0144         IF(MSTJ(105).GE.0.AND.MSTU(28).NE.0) GOTO 100
0145       ENDIF
0146
0147 C...Generate fragmentation. Information for LUTABU:
0148       IF(MSTJ(105).EQ.1) CALL LUEXEC
0149       MSTU(161)=110*KFLC+3
0150       MSTU(162)=0
0151
0152       RETURN
0153       END