hijing/src/lu1ent.f

0001 C
0002 C
0003 C
0004 C     Modified for HIJING program
0005 c
0006 c    modification July 22, 1997  In pyremnn put an upper limit
0007 c     on the total pt kick the parton can accumulate via multiple
0008 C     scattering. Set the upper limit to be the sqrt(s)/2,
0009 c     this is fix cronin bug for Pb+Pb events at SPS energy.
0010 c
0011 C
0012 C Last modification Oct. 1993 to comply with non-vax
0013 C machines' compiler
0014 C
0015 C
0016       SUBROUTINE LU1ENT(IP,KF,PE,THE,PHI)
0017
0018 C...Purpose: to store one parton/particle in commonblock LUJETS.
0019       COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
0020       SAVE /LUJETS/
0021       COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0022       SAVE /LUDAT1/
0023       COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
0024       SAVE /LUDAT2/
0025
0026 C...Standard checks.
0027       MSTU(28)=0
0028       IF(MSTU(12).GE.1) CALL LULIST(0)
0029       IPA=MAX(1,IABS(IP))
0030       IF(IPA.GT.MSTU(4)) CALL LUERRM(21,
0031      &'(LU1ENT:) writing outside LUJETS memory')
0032       KC=LUCOMP(KF)
0033       IF(KC.EQ.0) CALL LUERRM(12,'(LU1ENT:) unknown flavour code')
0034
0035 C...Find mass. Reset K, P and V vectors.
0036       PM=0.
0037       IF(MSTU(10).EQ.1) PM=P(IPA,5)
0038       IF(MSTU(10).GE.2) PM=ULMASS(KF)
0039       DO 100 J=1,5
0040       K(IPA,J)=0
0041       P(IPA,J)=0.
0042   100 V(IPA,J)=0.
0043
0044 C...Store parton/particle in K and P vectors.
0045       K(IPA,1)=1
0046       IF(IP.LT.0) K(IPA,1)=2
0047       K(IPA,2)=KF
0048       P(IPA,5)=PM
0049       P(IPA,4)=MAX(PE,PM)
0050       PA=SQRT(P(IPA,4)**2-P(IPA,5)**2)
0051       P(IPA,1)=PA*SIN(THE)*COS(PHI)
0052       P(IPA,2)=PA*SIN(THE)*SIN(PHI)
0053       P(IPA,3)=PA*COS(THE)
0054
0055 C...Set N. Optionally fragment/decay.
0056       N=IPA
0057       IF(IP.EQ.0) CALL LUEXEC
0058
0059       RETURN
0060       END