[u/mrichter/AliRoot.git] / ISAJET / isatape / isahep.F

#include "isajet/pilot.h"
      SUBROUTINE ISAHEP(MCONV)
C
C...Purpose: to convert ISAJET event record contents to or from
C...the standard event record common block.
C
C   Thanks to Lynn Garren, Fermilab.
C
#if defined(CERNLIB_IMPNONE)
      IMPLICIT NONE
#endif
#include "isajet/hepevt.inc"
C
C...for event number
#include "isajet/idrun.inc"
C...initial partons
#include "isajet/pjets.inc"
#include "isajet/primar.inc"
C...partons created during decay
#include "isajet/jetset.inc"
C...particles created in the decay, including final state particles
#include "isajet/partcl.inc"
C
      INTEGER MCONV
      INTEGER ITRANS
      INTEGER I1,IHP,MPART,JET,NPOFF,NJHEP,NWHEP,IMO,IJT
      INTEGER JPMO(2,MXJSET),JPDA(2,MXJSET),JMX(MXJSET),JMN(MXJSET)
      INTEGER JTMO(2,MXPTCL),JTDA(2,MXPTCL)
      INTEGER IP,IJ3,IJ2,IJ1,NSUM2,NSUM1,IPT,I,J,KST,KND,K
C
C
C...Conversion from ISAJET to standard
C
      IF(MCONV.EQ.1) THEN
        NEVHEP = IEVT
C...initial jets
        NHEP = 0
C... W or Z
        IF(IDENTW.NE.0)THEN
          NHEP = NHEP + 1
          ISTHEP(NHEP)=12
          JMOHEP(1,NHEP)=0
          JMOHEP(2,NHEP)=0
          JDAHEP(1,NHEP)= 2
          JDAHEP(2,NHEP)= NJET + 1
          IDHEP(NHEP) = ITRANS(IDENTW,1)
          DO 100 J=1,5
 100        PHEP(J,NHEP) = QWJET(J)
        ENDIF
        NWHEP = NHEP
C... jets
        IF(NJET.GT.0)THEN
          DO 120 I=1,NJET
            NHEP = NHEP + 1
            ISTHEP(NHEP)=11
            JMOHEP(1,NHEP)=0
            IF(IDENTW.NE.0) JMOHEP(1,NHEP) = 1
            JMOHEP(2,NHEP)= I
            JDAHEP(1,NHEP)=0
            JDAHEP(2,NHEP)=0
            IDHEP(NHEP) = ITRANS(IDJETS(I),1)
            DO 110 J=1,5
 110          PHEP(J,NHEP) = PJETS(J,I)
 120      CONTINUE
        ENDIF
        NJHEP = NHEP
C... pairs
        IF(NPAIR.GT.0)THEN
          DO 150 I=1,NPAIR
            NHEP = NHEP + 1
            ISTHEP(NHEP)=13
            JMOHEP(1,NHEP)= JPAIR(I) + NWHEP
            JMOHEP(2,NHEP)= JPAIR(I)
            JDAHEP(1,NHEP)=0
            JDAHEP(2,NHEP)=0
            IDHEP(NHEP) = ITRANS(IDPAIR(I),1)
            DO 140 J=1,5
 140          PHEP(J,NHEP) = PPAIR(J,I)
 150      CONTINUE
        ENDIF
        DO 160 I=1,NHEP
          DO 160 J=1,4
 160        VHEP(J,I) = 0.
C...save offset into hep list
        NPOFF = NHEP
C...partons
        DO 200 I=1,NJSET
          IHP = NHEP + I
C...use JMX and JMN to find daughters in hadron list
          JMX(I) = 0
          JMN(I) = NHEP + NPTCL + 1
          IDHEP(IHP) = ITRANS(JTYPE(I),1)
          MPART=MOD(JORIG(I),JPACK)
          JMOHEP(1,IHP)=0
          IJT = JORIG(I)/JPACK
          IF(MPART.NE.0)THEN
            JMOHEP(1,IHP)=MPART+NHEP
          ELSEIF(MPART.EQ.0 .AND. IJT.LT.10)THEN
C...find mother in jet/pair list
            IMO = IJT + NWHEP
            IF(NJHEP.LT.NPOFF)THEN
              KST = NJHEP + 1
              DO 170 K=KST,NPOFF
                IF(IDHEP(K).EQ.IDHEP(IHP)) IMO=K
 170          CONTINUE
            ENDIF
            JMOHEP(1,IHP)= IMO
            IF(JDAHEP(1,IMO).EQ.0) JDAHEP(1,IMO)=IHP
            JDAHEP(1,IMO) = MIN(IHP,JDAHEP(1,IMO))
            JDAHEP(2,IMO) = MAX(IHP,JDAHEP(2,IMO))
C...amend information if a parton thinks this is it's daughter
            KND = IHP-1
            DO 175 K=NPOFF,KND
              IF(IHP.GE.JDAHEP(1,K) .AND. IHP.LE.JDAHEP(2,K))
     1             JMOHEP(1,IHP)=K
 175        CONTINUE
          ENDIF
          JMOHEP(2,IHP)= IJT
          IF(JDCAY(I).EQ.0)THEN
            ISTHEP(IHP) = 21
            JDAHEP(1,IHP)=0
            JDAHEP(2,IHP)=0
          ELSE
            ISTHEP(IHP) = 22
            JDAHEP(1,IHP) = JDCAY(I)/JPACK + NHEP
            JDAHEP(2,IHP) = MOD(JDCAY(I),JPACK) + NHEP
          ENDIF
          DO 180 J=1,5
 180        PHEP(J,IHP) = PJSET(J,I)
          DO 190 J=1,4
 190        VHEP(J,IHP) = 0.
 200    CONTINUE
        NHEP = NHEP + NJSET
C...hadrons
        DO 250 I=1,NPTCL
          IHP = NHEP + I
          IDHEP(IHP) = ITRANS(IDENT(I),1)
          I1 = MOD(IABS(IORIG(I)),IPACK)
          JMOHEP(1,IHP)=0
          JMOHEP(2,IHP)=IABS(IORIG(I))/IPACK
C...mother is pomeron
          IF(I1.EQ.0)THEN
C...mother is in parton list
          ELSEIF(IORIG(I).LT.0)THEN
            JMOHEP(1,IHP) = I1 + NPOFF
            JMN(I1) = MIN(JMN(I1),I)
            JMX(I1) = MAX(JMX(I1),I)
C...mother is in hadron list
          ELSEIF(IORIG(I).GT.0)THEN
            JMOHEP(1,IHP) = I1 + NHEP
          ENDIF
          IF(IDCAY(I).EQ.0)THEN
            ISTHEP(IHP) = 1
            JDAHEP(1,IHP)=0
            JDAHEP(2,IHP)=0
          ELSE
            ISTHEP(IHP) = 2
            JDAHEP(1,IHP) = IDCAY(I)/IPACK + NHEP
            JDAHEP(2,IHP) = MOD(IDCAY(I),IPACK) + NHEP
          ENDIF
          DO 210 J=1,5
 210        PHEP(J,IHP) = PPTCL(J,I)
          DO 220 J=1,4
 220        VHEP(J,IHP) = 0.
 250    CONTINUE
        NHEP = NHEP + NPTCL
C...fill in missing daughter info for partons
        DO 270 I=1,NJSET
          IF(JMX(I).NE.0)THEN
            JDAHEP(1,I+NPOFF) = JMN(I) + NPOFF + NJSET
            JDAHEP(2,I+NPOFF) = JMX(I) + NPOFF + NJSET
          ENDIF
 270    CONTINUE
C
C...Conversion from standard to ISAJET
C
      ELSEIF(MCONV.EQ.2)THEN
        IEVT = NEVHEP
C...        missing information
        IDENTW = 0
        NPAIR = 0
        DO 330 I=1,5
          QWJET(I) = 0.
          DO 330 J=1,4
            PPAIR(I,J) = 0.
 330    CONTINUE
        DO 340 I=1,4
          IDPAIR(I) = 0
 340      JPAIR(I) = 0
C...zero counters
        IJ1 = 0
        IJ2 = 0
        IJ3 = 0
        IP = 0
        IPT = 0
        DO 500 I=1,NHEP
C...initial jets
C... jets
          IF(ISTHEP(I).EQ.11)THEN
            IJ1 = IJ1 + 1
            IDJETS(IJ1) = ITRANS(IDHEP(I),2)
            DO 410 J=1,5
 410          PJETS(J,IJ1) = PHEP(J,I)
C... W
          ELSEIF(ISTHEP(I).EQ.12)THEN
            IJ2 = IJ2 + 1
            IDENTW = ITRANS(IDHEP(I),2)
            DO 420 J=1,5
 420          QWJET(J) = PHEP(J,I)
C... pairs
          ELSEIF(ISTHEP(I).EQ.13)THEN
            IJ3 = IJ3 + 1
            IDPAIR(IJ3) = ITRANS(IDHEP(I),2)
            JPAIR(IJ3) = JMOHEP(2,I)
            DO 430 J=1,5
 430          PPAIR(J,IJ3) = PHEP(J,I)
C...partons
          ELSEIF(ISTHEP(I).EQ.21 .OR. ISTHEP(I).EQ.22)THEN
            IP = IP + 1
            JTYPE(IP) = ITRANS(IDHEP(I),2)
            DO 440 J=1,5
 440          PJSET(J,IP) = PHEP(J,I)
C...      temporary storage until have counts
            JPMO(1,IP) = JMOHEP(1,I)
            JPMO(2,IP) = JMOHEP(2,I)
            JPDA(1,IP) = JDAHEP(1,I)
            JPDA(2,IP) = JDAHEP(2,I)
C...hadrons
          ELSE
            IPT = IPT + 1
            IDENT(IPT) = ITRANS(IDHEP(I),2)
            DO 450 J=1,5
 450          PPTCL(J,IPT) = PHEP(J,I)
C...      temporary storage until have counts
            JTMO(1,IPT) = JMOHEP(1,I)
            JTMO(2,IPT) = JMOHEP(2,I)
            JTDA(1,IPT) = JDAHEP(1,I)
            JTDA(2,IPT) = JDAHEP(2,I)
          ENDIF
 500    CONTINUE
C...completed counts
        NJET = IJ1
        NPAIR = IJ3
        NJSET = IP
        NPTCL = IPT
C...get mother/daughter information
        NSUM1 = NJET + IJ2 + NPAIR
        NSUM2 = NSUM1 + NJSET
        DO 520 I=1,NJSET
          IF(JPDA(1,I).EQ.0)THEN
            JDCAY(I) = 0
          ELSEIF(JPDA(1,I).GT.NSUM2)THEN
            JDCAY(I) = 0
          ELSE
            JDCAY(I) = JPACK*(JPDA(1,I)-NSUM1) + JPDA(2,I)-NSUM1
          ENDIF
          IF(JPMO(1,I).LE.NSUM1)THEN
            JORIG(I) = JPACK*JPMO(2,I)
          ELSE
            JORIG(I) = JPACK*JPMO(2,I) + JPMO(1,I)-NSUM1
          ENDIF
 520    CONTINUE
        DO 550 I=1,NPTCL
          IF(JTDA(1,I).EQ.0)THEN
            IDCAY(I) = 0
          ELSE
            IDCAY(I) = IPACK*(JTDA(1,I)-NSUM2) + JTDA(2,I)-NSUM2
          ENDIF
          IF(JTMO(1,I).LE.NSUM1)THEN
            IORIG(I) = JTMO(2,I)*IPACK + 0
          ELSEIF(JTMO(1,I).LE.NSUM2)THEN
            IORIG(I) = -(JTMO(2,I)*IPACK + JTMO(1,I)-NSUM1)
          ELSE
            IORIG(I) = JTMO(2,I)*IPACK + JTMO(1,I)-NSUM2
          ENDIF
 550    CONTINUE
      ENDIF
      RETURN
      END
Commit	Line	Data
0795afa3	1	#include "isajet/pilot.h"
	2	SUBROUTINE ISAHEP(MCONV)
	3	C
	4	C...Purpose: to convert ISAJET event record contents to or from
	5	C...the standard event record common block.
	6	C
	7	C Thanks to Lynn Garren, Fermilab.
	8	C
	9	#if defined(CERNLIB_IMPNONE)
	10	IMPLICIT NONE
	11	#endif
	12	#include "isajet/hepevt.inc"
	13	C
	14	C...for event number
	15	#include "isajet/idrun.inc"
	16	C...initial partons
	17	#include "isajet/pjets.inc"
	18	#include "isajet/primar.inc"
	19	C...partons created during decay
	20	#include "isajet/jetset.inc"
	21	C...particles created in the decay, including final state particles
	22	#include "isajet/partcl.inc"
	23	C
	24	INTEGER MCONV
	25	INTEGER ITRANS
	26	INTEGER I1,IHP,MPART,JET,NPOFF,NJHEP,NWHEP,IMO,IJT
	27	INTEGER JPMO(2,MXJSET),JPDA(2,MXJSET),JMX(MXJSET),JMN(MXJSET)
	28	INTEGER JTMO(2,MXPTCL),JTDA(2,MXPTCL)
	29	INTEGER IP,IJ3,IJ2,IJ1,NSUM2,NSUM1,IPT,I,J,KST,KND,K
	30	C
	31	C
	32	C...Conversion from ISAJET to standard
	33	C
	34	IF(MCONV.EQ.1) THEN
	35	NEVHEP = IEVT
	36	C...initial jets
	37	NHEP = 0
	38	C... W or Z
	39	IF(IDENTW.NE.0)THEN
	40	NHEP = NHEP + 1
	41	ISTHEP(NHEP)=12
	42	JMOHEP(1,NHEP)=0
	43	JMOHEP(2,NHEP)=0
	44	JDAHEP(1,NHEP)= 2
	45	JDAHEP(2,NHEP)= NJET + 1
	46	IDHEP(NHEP) = ITRANS(IDENTW,1)
	47	DO 100 J=1,5
	48	100 PHEP(J,NHEP) = QWJET(J)
	49	ENDIF
	50	NWHEP = NHEP
	51	C... jets
	52	IF(NJET.GT.0)THEN
	53	DO 120 I=1,NJET
	54	NHEP = NHEP + 1
	55	ISTHEP(NHEP)=11
	56	JMOHEP(1,NHEP)=0
	57	IF(IDENTW.NE.0) JMOHEP(1,NHEP) = 1
	58	JMOHEP(2,NHEP)= I
	59	JDAHEP(1,NHEP)=0
	60	JDAHEP(2,NHEP)=0
	61	IDHEP(NHEP) = ITRANS(IDJETS(I),1)
	62	DO 110 J=1,5
	63	110 PHEP(J,NHEP) = PJETS(J,I)
	64	120 CONTINUE
65	ENDIF
66	NJHEP = NHEP
67	C... pairs
68	IF(NPAIR.GT.0)THEN
69	DO 150 I=1,NPAIR
70	NHEP = NHEP + 1
71	ISTHEP(NHEP)=13
72	JMOHEP(1,NHEP)= JPAIR(I) + NWHEP
73	JMOHEP(2,NHEP)= JPAIR(I)
74	JDAHEP(1,NHEP)=0
75	JDAHEP(2,NHEP)=0
76	IDHEP(NHEP) = ITRANS(IDPAIR(I),1)
77	DO 140 J=1,5
78	140 PHEP(J,NHEP) = PPAIR(J,I)
79	150 CONTINUE
80	ENDIF
81	DO 160 I=1,NHEP
82	DO 160 J=1,4
83	160 VHEP(J,I) = 0.
84	C...save offset into hep list
85	NPOFF = NHEP
86	C...partons
87	DO 200 I=1,NJSET
88	IHP = NHEP + I
89	C...use JMX and JMN to find daughters in hadron list
90	JMX(I) = 0
91	JMN(I) = NHEP + NPTCL + 1
92	IDHEP(IHP) = ITRANS(JTYPE(I),1)
93	MPART=MOD(JORIG(I),JPACK)
94	JMOHEP(1,IHP)=0
95	IJT = JORIG(I)/JPACK
96	IF(MPART.NE.0)THEN
97	JMOHEP(1,IHP)=MPART+NHEP
98	ELSEIF(MPART.EQ.0 .AND. IJT.LT.10)THEN
99	C...find mother in jet/pair list
100	IMO = IJT + NWHEP
101	IF(NJHEP.LT.NPOFF)THEN
102	KST = NJHEP + 1
103	DO 170 K=KST,NPOFF
104	IF(IDHEP(K).EQ.IDHEP(IHP)) IMO=K
105	170 CONTINUE
106	ENDIF
107	JMOHEP(1,IHP)= IMO
108	IF(JDAHEP(1,IMO).EQ.0) JDAHEP(1,IMO)=IHP
109	JDAHEP(1,IMO) = MIN(IHP,JDAHEP(1,IMO))
110	JDAHEP(2,IMO) = MAX(IHP,JDAHEP(2,IMO))
111	C...amend information if a parton thinks this is it's daughter
112	KND = IHP-1
113	DO 175 K=NPOFF,KND
114	IF(IHP.GE.JDAHEP(1,K) .AND. IHP.LE.JDAHEP(2,K))
115	1 JMOHEP(1,IHP)=K
116	175 CONTINUE
117	ENDIF
118	JMOHEP(2,IHP)= IJT
119	IF(JDCAY(I).EQ.0)THEN
120	ISTHEP(IHP) = 21
121	JDAHEP(1,IHP)=0
122	JDAHEP(2,IHP)=0
123	ELSE
124	ISTHEP(IHP) = 22
125	JDAHEP(1,IHP) = JDCAY(I)/JPACK + NHEP
126	JDAHEP(2,IHP) = MOD(JDCAY(I),JPACK) + NHEP
127	ENDIF
128	DO 180 J=1,5
129	180 PHEP(J,IHP) = PJSET(J,I)
130	DO 190 J=1,4
131	190 VHEP(J,IHP) = 0.
132	200 CONTINUE
133	NHEP = NHEP + NJSET
134	C...hadrons
135	DO 250 I=1,NPTCL
136	IHP = NHEP + I
137	IDHEP(IHP) = ITRANS(IDENT(I),1)
138	I1 = MOD(IABS(IORIG(I)),IPACK)
139	JMOHEP(1,IHP)=0
140	JMOHEP(2,IHP)=IABS(IORIG(I))/IPACK
141	C...mother is pomeron
142	IF(I1.EQ.0)THEN
143	C...mother is in parton list
144	ELSEIF(IORIG(I).LT.0)THEN
145	JMOHEP(1,IHP) = I1 + NPOFF
146	JMN(I1) = MIN(JMN(I1),I)
147	JMX(I1) = MAX(JMX(I1),I)
148	C...mother is in hadron list
149	ELSEIF(IORIG(I).GT.0)THEN
150	JMOHEP(1,IHP) = I1 + NHEP
151	ENDIF
152	IF(IDCAY(I).EQ.0)THEN
153	ISTHEP(IHP) = 1
154	JDAHEP(1,IHP)=0
155	JDAHEP(2,IHP)=0
156	ELSE
157	ISTHEP(IHP) = 2
158	JDAHEP(1,IHP) = IDCAY(I)/IPACK + NHEP
159	JDAHEP(2,IHP) = MOD(IDCAY(I),IPACK) + NHEP
160	ENDIF
161	DO 210 J=1,5
162	210 PHEP(J,IHP) = PPTCL(J,I)
163	DO 220 J=1,4
164	220 VHEP(J,IHP) = 0.
165	250 CONTINUE
166	NHEP = NHEP + NPTCL
167	C...fill in missing daughter info for partons
168	DO 270 I=1,NJSET
169	IF(JMX(I).NE.0)THEN
170	JDAHEP(1,I+NPOFF) = JMN(I) + NPOFF + NJSET
171	JDAHEP(2,I+NPOFF) = JMX(I) + NPOFF + NJSET
172	ENDIF
173	270 CONTINUE
174	C
175	C...Conversion from standard to ISAJET
176	C
177	ELSEIF(MCONV.EQ.2)THEN
178	IEVT = NEVHEP
179	C... missing information
180	IDENTW = 0
181	NPAIR = 0
182	DO 330 I=1,5
183	QWJET(I) = 0.
184	DO 330 J=1,4
185	PPAIR(I,J) = 0.
186	330 CONTINUE
187	DO 340 I=1,4
188	IDPAIR(I) = 0
189	340 JPAIR(I) = 0
190	C...zero counters
191	IJ1 = 0
192	IJ2 = 0
193	IJ3 = 0
194	IP = 0
195	IPT = 0
196	DO 500 I=1,NHEP
197	C...initial jets
198	C... jets
199	IF(ISTHEP(I).EQ.11)THEN
200	IJ1 = IJ1 + 1
201	IDJETS(IJ1) = ITRANS(IDHEP(I),2)
202	DO 410 J=1,5
203	410 PJETS(J,IJ1) = PHEP(J,I)
204	C... W
205	ELSEIF(ISTHEP(I).EQ.12)THEN
206	IJ2 = IJ2 + 1
207	IDENTW = ITRANS(IDHEP(I),2)
208	DO 420 J=1,5
209	420 QWJET(J) = PHEP(J,I)
210	C... pairs
211	ELSEIF(ISTHEP(I).EQ.13)THEN
212	IJ3 = IJ3 + 1
213	IDPAIR(IJ3) = ITRANS(IDHEP(I),2)
214	JPAIR(IJ3) = JMOHEP(2,I)
215	DO 430 J=1,5
216	430 PPAIR(J,IJ3) = PHEP(J,I)
217	C...partons
218	ELSEIF(ISTHEP(I).EQ.21 .OR. ISTHEP(I).EQ.22)THEN
219	IP = IP + 1
220	JTYPE(IP) = ITRANS(IDHEP(I),2)
221	DO 440 J=1,5
222	440 PJSET(J,IP) = PHEP(J,I)
223	C... temporary storage until have counts
224	JPMO(1,IP) = JMOHEP(1,I)
225	JPMO(2,IP) = JMOHEP(2,I)
226	JPDA(1,IP) = JDAHEP(1,I)
227	JPDA(2,IP) = JDAHEP(2,I)
228	C...hadrons
229	ELSE
230	IPT = IPT + 1
231	IDENT(IPT) = ITRANS(IDHEP(I),2)
232	DO 450 J=1,5
233	450 PPTCL(J,IPT) = PHEP(J,I)
234	C... temporary storage until have counts
235	JTMO(1,IPT) = JMOHEP(1,I)
236	JTMO(2,IPT) = JMOHEP(2,I)
237	JTDA(1,IPT) = JDAHEP(1,I)
238	JTDA(2,IPT) = JDAHEP(2,I)
239	ENDIF
240	500 CONTINUE
241	C...completed counts
242	NJET = IJ1
243	NPAIR = IJ3
244	NJSET = IP
245	NPTCL = IPT
246	C...get mother/daughter information
247	NSUM1 = NJET + IJ2 + NPAIR
248	NSUM2 = NSUM1 + NJSET
249	DO 520 I=1,NJSET
250	IF(JPDA(1,I).EQ.0)THEN
251	JDCAY(I) = 0
252	ELSEIF(JPDA(1,I).GT.NSUM2)THEN
253	JDCAY(I) = 0
254	ELSE
255	JDCAY(I) = JPACK*(JPDA(1,I)-NSUM1) + JPDA(2,I)-NSUM1
256	ENDIF
257	IF(JPMO(1,I).LE.NSUM1)THEN
258	JORIG(I) = JPACK*JPMO(2,I)
259	ELSE
260	JORIG(I) = JPACK*JPMO(2,I) + JPMO(1,I)-NSUM1
261	ENDIF
262	520 CONTINUE
263	DO 550 I=1,NPTCL
264	IF(JTDA(1,I).EQ.0)THEN
265	IDCAY(I) = 0
266	ELSE
267	IDCAY(I) = IPACK*(JTDA(1,I)-NSUM2) + JTDA(2,I)-NSUM2
268	ENDIF
269	IF(JTMO(1,I).LE.NSUM1)THEN
270	IORIG(I) = JTMO(2,I)*IPACK + 0
271	ELSEIF(JTMO(1,I).LE.NSUM2)THEN
272	IORIG(I) = -(JTMO(2,I)*IPACK + JTMO(1,I)-NSUM1)
273	ELSE
274	IORIG(I) = JTMO(2,I)*IPACK + JTMO(1,I)-NSUM2
275	ENDIF
276	550 CONTINUE
277	ENDIF
278	RETURN
279	END