hijing/src/lu2ent.f

0001
0002 C*********************************************************************
0003
0004       SUBROUTINE LU2ENT(IP,KF1,KF2,PECM)
0005
0006 C...Purpose: to store two partons/particles in their CM frame,
0007 C...with the first along the +z axis.
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...Standard checks.
0016       MSTU(28)=0
0017       IF(MSTU(12).GE.1) CALL LULIST(0)
0018       IPA=MAX(1,IABS(IP))
0019       IF(IPA.GT.MSTU(4)-1) CALL LUERRM(21,
0020      &'(LU2ENT:) writing outside LUJETS memory')
0021       KC1=LUCOMP(KF1)
0022       KC2=LUCOMP(KF2)
0023       IF(KC1.EQ.0.OR.KC2.EQ.0) CALL LUERRM(12,
0024      &'(LU2ENT:) unknown flavour code')
0025
0026 C...Find masses. Reset K, P and V vectors.
0027       PM1=0.
0028       IF(MSTU(10).EQ.1) PM1=P(IPA,5)
0029       IF(MSTU(10).GE.2) PM1=ULMASS(KF1)
0030       PM2=0.
0031       IF(MSTU(10).EQ.1) PM2=P(IPA+1,5)
0032       IF(MSTU(10).GE.2) PM2=ULMASS(KF2)
0033       DO 100 I=IPA,IPA+1
0034       DO 100 J=1,5
0035       K(I,J)=0
0036       P(I,J)=0.
0037   100 V(I,J)=0.
0038
0039 C...Check flavours.
0040       KQ1=KCHG(KC1,2)*ISIGN(1,KF1)
0041       KQ2=KCHG(KC2,2)*ISIGN(1,KF2)
0042       IF(KQ1+KQ2.NE.0.AND.KQ1+KQ2.NE.4) CALL LUERRM(2,
0043      &'(LU2ENT:) unphysical flavour combination')
0044       K(IPA,2)=KF1
0045       K(IPA+1,2)=KF2
0046
0047 C...Store partons/particles in K vectors for normal case.
0048       IF(IP.GE.0) THEN
0049         K(IPA,1)=1
0050         IF(KQ1.NE.0.AND.KQ2.NE.0) K(IPA,1)=2
0051         K(IPA+1,1)=1
0052
0053 C...Store partons in K vectors for parton shower evolution.
0054       ELSE
0055         IF(KQ1.EQ.0.OR.KQ2.EQ.0) CALL LUERRM(2,
0056      &  '(LU2ENT:) requested flavours can not develop parton shower')
0057         K(IPA,1)=3
0058         K(IPA+1,1)=3
0059         K(IPA,4)=MSTU(5)*(IPA+1)
0060         K(IPA,5)=K(IPA,4)
0061         K(IPA+1,4)=MSTU(5)*IPA
0062         K(IPA+1,5)=K(IPA+1,4)
0063       ENDIF
0064
0065 C...Check kinematics and store partons/particles in P vectors.
0066       IF(PECM.LE.PM1+PM2) CALL LUERRM(13,
0067      &'(LU2ENT:) energy smaller than sum of masses')
0068       PA=SQRT(MAX(0.,(PECM**2-PM1**2-PM2**2)**2-(2.*PM1*PM2)**2))/
0069      &(2.*PECM)
0070       P(IPA,3)=PA
0071       P(IPA,4)=SQRT(PM1**2+PA**2)
0072       P(IPA,5)=PM1
0073       P(IPA+1,3)=-PA
0074       P(IPA+1,4)=SQRT(PM2**2+PA**2)
0075       P(IPA+1,5)=PM2
0076
0077 C...Set N. Optionally fragment/decay.
0078       N=IPA+1
0079       IF(IP.EQ.0) CALL LUEXEC
0080
0081       RETURN
0082       END