New functions and constructors added and some other fixes.
[u/mrichter/AliRoot.git] / PYTHIA / jetset / lu2ent.F
1  
2 C********************************************************************* 
3  
4       SUBROUTINE LU2ENT(IP,KF1,KF2,PECM) 
5  
6 C...Purpose: to store two partons/particles in their CM frame, 
7 C...with the first along the +z axis. 
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/ 
12  
13 C...Standard checks. 
14       MSTU(28)=0 
15       IF(MSTU(12).GE.1) CALL LULIST(0) 
16       IPA=MAX(1,IABS(IP)) 
17       IF(IPA.GT.MSTU(4)-1) CALL LUERRM(21, 
18      &'(LU2ENT:) writing outside LUJETS memory') 
19       KC1=LUCOMP(KF1) 
20       KC2=LUCOMP(KF2) 
21       IF(KC1.EQ.0.OR.KC2.EQ.0) CALL LUERRM(12, 
22      &'(LU2ENT:) unknown flavour code') 
23  
24 C...Find masses. Reset K, P and V vectors. 
25       PM1=0. 
26       IF(MSTU(10).EQ.1) PM1=P(IPA,5) 
27       IF(MSTU(10).GE.2) PM1=ULMASS(KF1) 
28       PM2=0. 
29       IF(MSTU(10).EQ.1) PM2=P(IPA+1,5) 
30       IF(MSTU(10).GE.2) PM2=ULMASS(KF2) 
31       DO 110 I=IPA,IPA+1 
32       DO 100 J=1,5 
33       K(I,J)=0 
34       P(I,J)=0. 
35       V(I,J)=0. 
36   100 CONTINUE 
37   110 CONTINUE 
38  
39 C...Check flavours. 
40       KQ1=KCHG(KC1,2)*ISIGN(1,KF1) 
41       KQ2=KCHG(KC2,2)*ISIGN(1,KF2) 
42       IF(MSTU(19).EQ.1) THEN 
43         MSTU(19)=0 
44       ELSE 
45         IF(KQ1+KQ2.NE.0.AND.KQ1+KQ2.NE.4) CALL LUERRM(2, 
46      &  '(LU2ENT:) unphysical flavour combination') 
47       ENDIF 
48       K(IPA,2)=KF1 
49       K(IPA+1,2)=KF2 
50  
51 C...Store partons/particles in K vectors for normal case. 
52       IF(IP.GE.0) THEN 
53         K(IPA,1)=1 
54         IF(KQ1.NE.0.AND.KQ2.NE.0) K(IPA,1)=2 
55         K(IPA+1,1)=1 
56  
57 C...Store partons in K vectors for parton shower evolution. 
58       ELSE 
59         K(IPA,1)=3 
60         K(IPA+1,1)=3 
61         K(IPA,4)=MSTU(5)*(IPA+1) 
62         K(IPA,5)=K(IPA,4) 
63         K(IPA+1,4)=MSTU(5)*IPA 
64         K(IPA+1,5)=K(IPA+1,4) 
65       ENDIF 
66  
67 C...Check kinematics and store partons/particles in P vectors. 
68       IF(PECM.LE.PM1+PM2) CALL LUERRM(13, 
69      &'(LU2ENT:) energy smaller than sum of masses') 
70       PA=SQRT(MAX(0.,(PECM**2-PM1**2-PM2**2)**2-(2.*PM1*PM2)**2))/ 
71      &(2.*PECM) 
72       P(IPA,3)=PA 
73       P(IPA,4)=SQRT(PM1**2+PA**2) 
74       P(IPA,5)=PM1 
75       P(IPA+1,3)=-PA 
76       P(IPA+1,4)=SQRT(PM2**2+PA**2) 
77       P(IPA+1,5)=PM2 
78  
79 C...Set N. Optionally fragment/decay. 
80       N=IPA+1 
81       IF(IP.EQ.0) CALL LUEXEC 
82  
83       RETURN 
84       END