First commit.
[u/mrichter/AliRoot.git] / ISAJET / isatape / itrans.F
1 #include "isajet/pilot.h"
2       INTEGER FUNCTION ITRANS(ID,MCONV)
3 C
4 C...convert (MCONV=1) from ISAJET numbering to PDG numbering
5 C...     or (MCONV=2) from PDG  numbering to ISAJET numbering
6 C...
7 C...Ver 7.21: add extra mesons with IABS(ID) > 10000; these only occur
8 C...          in a few B decays.
9 C
10 C...Thanks to Lynn Garren, Fermilab.
11 C
12 #if defined(CERNLIB_IMPNONE)
13       IMPLICIT NONE
14 #endif
15 #include "isajet/itapes.inc"
16 C
17       INTEGER ID,MCONV
18       INTEGER I2,I3,J,IDA,IF1,IF2,IND,ITMP,IF3,JS,J1,IS1,IS2,IS3,I4,I1
19 C
20 C... ITABI(I) converts miscellaneous ISAJET particle ID's to standard 
21 C... scheme
22       INTEGER ITABI(99,2), NOANT(15)
23       SAVE ITABI,NOANT
24       DATA ITABI/2,1,3,4,5,6,7,8,21,22,
25      1           12,11,14,13,16,15,0,0,0,310,
26      2           42,41,43,44,45,46,0,0,47,67,
27      3           52,51,54,53,56,55,0,0,77,68,
28      4           62,61,63,64,65,66,0,0,78,69,
29      5           72,71,74,73,76,75,0,0,0,70,
30      6           0,0,0,0,0,0,0,0,0,0,
31      7           0,0,0,0,0,0,0,0,0,24,
32      8           25,57,58,59,40,33,37,34,38,23,
33      9           0,0,0,0,0,0,0,0,0,
34      *           2,1,3,4,5,6,7,8,0,0,
35      1           12,11,14,13,16,15,0,0,0,0,
36      2           9,10,90,80,81,0,0,0,0,0,
37      3           0,82,86,88,0,83,87,89,84,85,
38      4           22,21,23,24,25,26,29,0,0,0,
39      5           32,31,34,33,36,35,82,83,84,0,
40      6           42,41,43,44,45,46,30,40,50,60,
41      7           52,51,54,53,56,55,39,49,0,0,
42      8           0,0,0,0,0,0,0,0,0,0,
43      9           0,0,0,0,0,0,0,0,0/
44       DATA NOANT/-21,-22,-23,-25,-30,-35,-47,-48,-57,-58,-59,
45      1           -67,-68,-69,-70/
46 C
47       IDA=IABS(ID)
48       ITRANS=0
49       IF(MCONV.NE.1) GO TO 200
50 C...ISAJET algorithm routine
51       CALL FLAVOR(ID,IF1,IF2,IF3,JS,IND)
52       IF(IDA.EQ.0) THEN
53         WRITE(ITLIS,*) ' ITRANS: particle ID is zero'
54       ELSEIF(IDA.LT.100) THEN
55         ITRANS=ISIGN(ITABI(IDA,1),ID)
56         IF(ID.EQ.-20) ITRANS=130
57 C...check for illegal antiparticles
58         ITMP=ITRANS
59         IF(ITMP.LT.0) THEN
60           DO 101 J=1,15
61             IF(ITMP.EQ.NOANT(J)) ITRANS=0
62  101      CONTINUE
63         ENDIF
64       ELSEIF(IND.NE.0.AND.IDA.LT.10000) THEN
65         IS1=IABS(IF1)
66         IS2=IABS(IF2)
67         IS3=IABS(IF3)
68 C...mesons
69         IF(IS1.EQ.0) THEN
70           IF(IS2.LE.2 .AND. IS3.LE.2) THEN
71 C...         don't change
72           ELSE
73 C...         u and d have opposite definitions
74             IF(IS2.LE.2) IS2=ITABI(IS2,1)
75             IF(IS3.LE.2) IS3=ITABI(IS3,1)
76           ENDIF
77           ITRANS=IS3*100 + IS2*10 + 2*JS+1
78           ITRANS=ISIGN(ITRANS,ID)
79 C...         charmed and top mesons have wrong sign
80           IF(IS3.EQ.4 .AND. IS2.NE.4) ITRANS=-ITRANS
81           IF(IS3.EQ.6 .AND. IS2.NE.6 .AND. IS2.NE.4) ITRANS=-ITRANS
82 C...check for illegal antiparticles
83           IF(IS2.EQ.IS3 .AND. ID.LT.0) ITRANS=0
84 C...diquarks
85         ELSEIF(IS3.EQ.0) THEN
86 C...         u and d have opposite definitions
87           IF(IS1.LE.2) IS1=ITABI(IS1,1)
88           IF(IS2.LE.2) IS2=ITABI(IS2,1)
89           IF(IS2.LT.IS1) THEN
90             ITRANS=IS1*1000 + IS2*100 + 2*JS+1
91           ELSE
92             ITRANS=IS2*1000 + IS1*100 + 2*JS+1
93           ENDIF
94           ITRANS=ISIGN(ITRANS,ID)
95 C...         charmed and top mesons have wrong sign
96           IF(IS2.EQ.4 .AND. IS1.NE.4) ITRANS=-ITRANS
97           IF(IS2.EQ.6 .AND. IS1.NE.6 .AND. IS1.NE.4) ITRANS=-ITRANS
98 C...baryons
99         ELSE
100 C...         u and d have opposite definitions
101           IF(IS1.LE.2) IS1=ITABI(IS1,1)
102           IF(IS2.LE.2) IS2=ITABI(IS2,1)
103           IF(IS3.LE.2) IS3=ITABI(IS3,1)
104           IF(IS3.LE.2) THEN
105             ITRANS=IS1*1000 + IS2*100 + IS3*10 + 2*JS+2
106           ELSEIF(IS1.LE.2 .AND. IS2.LE.2) THEN
107             ITRANS=IS3*1000 + IS1*100 + IS2*10 + 2*JS+2
108           ELSE
109             ITRANS=IS3*1000 + IS2*100 + IS1*10 + 2*JS+2
110           ENDIF
111           ITRANS=ISIGN(ITRANS,ID)
112         ENDIF
113       ELSEIF(IND.GT.0.AND.IDA.GT.10000) THEN
114 C...Special mesons. 
115         IF(ID.EQ.10121) THEN
116           ITRANS=20213
117         ELSEIF(ID.EQ.10111) THEN
118           ITRANS=20113
119         ELSEIF(ID.EQ.10131) THEN
120           ITRANS=10323
121         ELSEIF(ID.EQ.10231) THEN
122           ITRANS=10313
123         ELSEIF(ID.EQ.30131) THEN
124           ITRANS=30323
125         ELSEIF(ID.EQ.30231) THEN
126           ITRANS=30313
127         ELSEIF(ID.EQ.10110) THEN
128           ITRANS=10221
129         ELSEIF(ID.EQ.10441) THEN
130           ITRANS=20443
131         ELSEIF(ID.EQ.20440) THEN
132           ITRANS=10441
133         ELSEIF(ID.EQ.20441) THEN
134           ITRANS=10443
135         ELSEIF(ID.EQ.20442) THEN
136           ITRANS=445
137         ELSE
138           ITRANS=ID
139         ENDIF
140       ENDIF
141       GO TO 300
142 C
143  200  IF(MCONV.NE.2) GO TO 300
144       J1=MOD(IDA,10)
145       I1=MOD(IDA/10,10)
146       I2=MOD(IDA/100,10)
147       I3=MOD(IDA/1000,10)
148       I4=MOD(IDA/10000,10)
149       IF(IDA.EQ.0) THEN
150         WRITE(ITLIS,*) ' ITRANS: particle ID is zero'
151 C...elementary particles
152       ELSEIF(IDA.LT.100) THEN
153         ITRANS=ISIGN(ITABI(IDA,2),ID)
154 C...check for illegal antiparticles
155         IF(ID.LT.0) THEN
156           DO 201 J=1,15
157             IF(ID.EQ.NOANT(J)) ITRANS=0
158  201      CONTINUE
159         ENDIF
160 C...K short and K long
161       ELSEIF(ID.EQ.130) THEN
162         ITRANS=-20
163       ELSEIF(ID.EQ.310) THEN
164         ITRANS=20
165 C...mesons
166       ELSEIF(I3.EQ.0) THEN
167           IF(I1.LE.2 .AND. I2.LE.2) THEN
168 C...         don't change
169           ELSE
170 C...         u and d have opposite definitions
171             IF(I1.LE.2) I1=ITABI(I1,2)
172             IF(I2.LE.2) I2=ITABI(I2,2)
173           ENDIF
174           ITRANS=I1*100 + I2*10 + (J1-1)/2
175           ITRANS=ISIGN(ITRANS,ID)
176 C...         charmed and top mesons have wrong sign
177           IF(I2.EQ.4 .AND. I1.NE.4) ITRANS=-ITRANS
178           IF(I2.EQ.6 .AND. I1.NE.6 .AND. I1.NE.4) ITRANS=-ITRANS
179 C...check for illegal antiparticles
180           IF(I2.EQ.I1 .AND. ID.LT.0) ITRANS=0
181 C...diquarks
182       ELSEIF(I1.EQ.0) THEN
183 C...         u and d have opposite definitions
184           IF(I3.LE.2) I3=ITABI(I3,2)
185           IF(I2.LE.2) I2=ITABI(I2,2)
186           IF(I3.LT.I2) THEN
187             ITRANS=I3*1000 + I2*100 + (J1-1)/2
188           ELSE
189             ITRANS=I2*1000 + I3*100 + (J1-1)/2
190           ENDIF
191           ITRANS=ISIGN(ITRANS,ID)
192 C...         charmed and top mesons have wrong sign
193           IF(I2.EQ.4 .AND. I3.NE.4) ITRANS=-ITRANS
194           IF(I2.EQ.6 .AND. I3.NE.6 .AND. I3.NE.4) ITRANS=-ITRANS
195 C...baryons
196       ELSE
197 C...         u and d have opposite definitions
198           IF(I3.LE.2) I3=ITABI(I3,2)
199           IF(I2.LE.2) I2=ITABI(I2,2)
200           IF(I1.LE.2) I1=ITABI(I1,2)
201           IF(I3.LE.2) THEN
202             ITRANS=I3*1000 + I2*100 + I1*10 + (J1-2)/2
203           ELSEIF(I1.LE.2 .AND. I2.LE.2) THEN
204             ITRANS=I2*1000 + I1*100 + I3*10 + (J1-2)/2
205           ELSE
206             ITRANS=I1*1000 + I2*100 + I3*10 + (J1-2)/2
207           ENDIF
208           ITRANS=ISIGN(ITRANS,ID)
209       ENDIF
210
211  300  RETURN
212       END