Analysis Software
Documentation for sPHENIX simulation software
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
luhepc.f
Go to the documentation of this file. Or view the newest version in sPHENIX GitHub for file luhepc.f
1 
2 C*********************************************************************
3 
4  SUBROUTINE luhepc(MCONV)
5 
6 C...Purpose: to convert JETSET event record contents to or from
7 C...the standard event record commonblock.
8  parameter(nmxhep=10000)
9  common/hepevt/nevhep,nhep,isthep(nmxhep),idhep(nmxhep),
10  &jmohep(2,nmxhep),jdahep(2,nmxhep),phep(5,nmxhep),vhep(4,nmxhep)
11  DOUBLE PRECISION phep,vhep
12  SAVE /hepevt/
13  common/lujets/n,k(9000,5),p(9000,5),v(9000,5)
14  SAVE /lujets/
15  common/ludat1/mstu(200),paru(200),mstj(200),parj(200)
16  SAVE /ludat1/
17  common/ludat2/kchg(500,3),pmas(500,4),parf(2000),vckm(4,4)
18  SAVE /ludat2/
19 
20 C...Conversion from JETSET to standard, the easy part.
21  IF(mconv.EQ.1) THEN
22  nevhep=0
23  IF(n.GT.nmxhep) CALL luerrm(8,
24  & '(LUHEPC:) no more space in /HEPEVT/')
25  nhep=min(n,nmxhep)
26  DO 140 i=1,nhep
27  isthep(i)=0
28  IF(k(i,1).GE.1.AND.k(i,1).LE.10) isthep(i)=1
29  IF(k(i,1).GE.11.AND.k(i,1).LE.20) isthep(i)=2
30  IF(k(i,1).GE.21.AND.k(i,1).LE.30) isthep(i)=3
31  IF(k(i,1).GE.31.AND.k(i,1).LE.100) isthep(i)=k(i,1)
32  idhep(i)=k(i,2)
33  jmohep(1,i)=k(i,3)
34  jmohep(2,i)=0
35  IF(k(i,1).NE.3.AND.k(i,1).NE.13.AND.k(i,1).NE.14) THEN
36  jdahep(1,i)=k(i,4)
37  jdahep(2,i)=k(i,5)
38  ELSE
39  jdahep(1,i)=0
40  jdahep(2,i)=0
41  ENDIF
42  DO 100 j=1,5
43  100 phep(j,i)=p(i,j)
44  DO 110 j=1,4
45  110 vhep(j,i)=v(i,j)
46 
47 C...Fill in missing mother information.
48  IF(k(i,2).GE.91.AND.k(i,2).LE.93) THEN
49  i1=k(i,3)-1
50  120 i1=i1+1
51  IF(i1.GE.i) CALL luerrm(8,
52  & '(LUHEPC:) translation of inconsistent event history')
53  IF(i1.LT.i.AND.k(i1,1).NE.1.AND.k(i1,1).NE.11) goto 120
54  kc=lucomp(k(i1,2))
55  IF(i1.LT.i.AND.kc.EQ.0) goto 120
56  IF(i1.LT.i.AND.kchg(kc,2).EQ.0) goto 120
57  jmohep(2,i)=i1
58  ELSEIF(k(i,2).EQ.94) THEN
59  njet=2
60  IF(nhep.GE.i+3.AND.k(i+3,3).LE.i) njet=3
61  IF(nhep.GE.i+4.AND.k(i+4,3).LE.i) njet=4
62  jmohep(2,i)=mod(k(i+njet,4)/mstu(5),mstu(5))
63  IF(jmohep(2,i).EQ.jmohep(1,i)) jmohep(2,i)=
64  & mod(k(i+1,4)/mstu(5),mstu(5))
65  ENDIF
66 
67 C...Fill in missing daughter information.
68  IF(k(i,2).EQ.94.AND.mstu(16).NE.2) THEN
69  DO 130 i1=jdahep(1,i),jdahep(2,i)
70  i2=mod(k(i1,4)/mstu(5),mstu(5))
71  130 jdahep(1,i2)=i
72  ENDIF
73  IF(k(i,2).GE.91.AND.k(i,2).LE.94) goto 140
74  i1=jmohep(1,i)
75  IF(i1.LE.0.OR.i1.GT.nhep) goto 140
76  IF(k(i1,1).NE.13.AND.k(i1,1).NE.14) goto 140
77  IF(jdahep(1,i1).EQ.0) THEN
78  jdahep(1,i1)=i
79  ELSE
80  jdahep(2,i1)=i
81  ENDIF
82  140 CONTINUE
83  DO 150 i=1,nhep
84  IF(k(i,1).NE.13.AND.k(i,1).NE.14) goto 150
85  IF(jdahep(2,i).EQ.0) jdahep(2,i)=jdahep(1,i)
86  150 CONTINUE
87 
88 C...Conversion from standard to JETSET, the easy part.
89  ELSE
90  IF(nhep.GT.mstu(4)) CALL luerrm(8,
91  & '(LUHEPC:) no more space in /LUJETS/')
92  n=min(nhep,mstu(4))
93  nkq=0
94  kqsum=0
95  DO 180 i=1,n
96  k(i,1)=0
97  IF(isthep(i).EQ.1) k(i,1)=1
98  IF(isthep(i).EQ.2) k(i,1)=11
99  IF(isthep(i).EQ.3) k(i,1)=21
100  k(i,2)=idhep(i)
101  k(i,3)=jmohep(1,i)
102  k(i,4)=jdahep(1,i)
103  k(i,5)=jdahep(2,i)
104  DO 160 j=1,5
105  160 p(i,j)=phep(j,i)
106  DO 170 j=1,4
107  170 v(i,j)=vhep(j,i)
108  v(i,5)=0.
109  IF(isthep(i).EQ.2.AND.phep(4,i).GT.phep(5,i)) THEN
110  i1=jdahep(1,i)
111  IF(i1.GT.0.AND.i1.LE.nhep) v(i,5)=(vhep(4,i1)-vhep(4,i))*
112  & phep(5,i)/phep(4,i)
113  ENDIF
114 
115 C...Fill in missing information on colour connection in jet systems.
116  IF(isthep(i).EQ.1) THEN
117  kc=lucomp(k(i,2))
118  kq=0
119  IF(kc.NE.0) kq=kchg(kc,2)*isign(1,k(i,2))
120  IF(kq.NE.0) nkq=nkq+1
121  IF(kq.NE.2) kqsum=kqsum+kq
122  IF(kq.NE.0.AND.kqsum.NE.0) THEN
123  k(i,1)=2
124  ELSEIF(kq.EQ.2.AND.i.LT.n) THEN
125  IF(k(i+1,2).EQ.21) k(i,1)=2
126  ENDIF
127  ENDIF
128  180 CONTINUE
129  IF(nkq.EQ.1.OR.kqsum.NE.0) CALL luerrm(8,
130  & '(LUHEPC:) input parton configuration not colour singlet')
131  ENDIF
132 
133  END