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

#include "isajet/pilot.h"
      INTEGER FUNCTION ITRANS(ID,MCONV)
C
C...convert (MCONV=1) from ISAJET numbering to PDG numbering
C...     or (MCONV=2) from PDG  numbering to ISAJET numbering
C...
C...Ver 7.21: add extra mesons with IABS(ID) > 10000; these only occur
C...          in a few B decays.
C
C...Thanks to Lynn Garren, Fermilab.
C
#if defined(CERNLIB_IMPNONE)
      IMPLICIT NONE
#endif
#include "isajet/itapes.inc"
C
      INTEGER ID,MCONV
      INTEGER I2,I3,J,IDA,IF1,IF2,IND,ITMP,IF3,JS,J1,IS1,IS2,IS3,I4,I1
C
C... ITABI(I) converts miscellaneous ISAJET particle ID's to standard 
C... scheme
      INTEGER ITABI(99,2), NOANT(15)
      SAVE ITABI,NOANT
      DATA ITABI/2,1,3,4,5,6,7,8,21,22,
     1           12,11,14,13,16,15,0,0,0,310,
     2           42,41,43,44,45,46,0,0,47,67,
     3           52,51,54,53,56,55,0,0,77,68,
     4           62,61,63,64,65,66,0,0,78,69,
     5           72,71,74,73,76,75,0,0,0,70,
     6           0,0,0,0,0,0,0,0,0,0,
     7           0,0,0,0,0,0,0,0,0,24,
     8           25,57,58,59,40,33,37,34,38,23,
     9           0,0,0,0,0,0,0,0,0,
     *           2,1,3,4,5,6,7,8,0,0,
     1           12,11,14,13,16,15,0,0,0,0,
     2           9,10,90,80,81,0,0,0,0,0,
     3           0,82,86,88,0,83,87,89,84,85,
     4           22,21,23,24,25,26,29,0,0,0,
     5           32,31,34,33,36,35,82,83,84,0,
     6           42,41,43,44,45,46,30,40,50,60,
     7           52,51,54,53,56,55,39,49,0,0,
     8           0,0,0,0,0,0,0,0,0,0,
     9           0,0,0,0,0,0,0,0,0/
      DATA NOANT/-21,-22,-23,-25,-30,-35,-47,-48,-57,-58,-59,
     1           -67,-68,-69,-70/
C
      IDA=IABS(ID)
      ITRANS=0
      IF(MCONV.NE.1) GO TO 200
C...ISAJET algorithm routine
      CALL FLAVOR(ID,IF1,IF2,IF3,JS,IND)
      IF(IDA.EQ.0) THEN
        WRITE(ITLIS,*) ' ITRANS: particle ID is zero'
      ELSEIF(IDA.LT.100) THEN
        ITRANS=ISIGN(ITABI(IDA,1),ID)
        IF(ID.EQ.-20) ITRANS=130
C...check for illegal antiparticles
        ITMP=ITRANS
        IF(ITMP.LT.0) THEN
          DO 101 J=1,15
            IF(ITMP.EQ.NOANT(J)) ITRANS=0
 101      CONTINUE
        ENDIF
      ELSEIF(IND.NE.0.AND.IDA.LT.10000) THEN
        IS1=IABS(IF1)
        IS2=IABS(IF2)
        IS3=IABS(IF3)
C...mesons
        IF(IS1.EQ.0) THEN
          IF(IS2.LE.2 .AND. IS3.LE.2) THEN
C...         don't change
          ELSE
C...         u and d have opposite definitions
            IF(IS2.LE.2) IS2=ITABI(IS2,1)
            IF(IS3.LE.2) IS3=ITABI(IS3,1)
          ENDIF
          ITRANS=IS3*100 + IS2*10 + 2*JS+1
          ITRANS=ISIGN(ITRANS,ID)
C...         charmed and top mesons have wrong sign
          IF(IS3.EQ.4 .AND. IS2.NE.4) ITRANS=-ITRANS
          IF(IS3.EQ.6 .AND. IS2.NE.6 .AND. IS2.NE.4) ITRANS=-ITRANS
C...check for illegal antiparticles
          IF(IS2.EQ.IS3 .AND. ID.LT.0) ITRANS=0
C...diquarks
        ELSEIF(IS3.EQ.0) THEN
C...         u and d have opposite definitions
          IF(IS1.LE.2) IS1=ITABI(IS1,1)
          IF(IS2.LE.2) IS2=ITABI(IS2,1)
          IF(IS2.LT.IS1) THEN
            ITRANS=IS1*1000 + IS2*100 + 2*JS+1
          ELSE
            ITRANS=IS2*1000 + IS1*100 + 2*JS+1
          ENDIF
          ITRANS=ISIGN(ITRANS,ID)
C...         charmed and top mesons have wrong sign
          IF(IS2.EQ.4 .AND. IS1.NE.4) ITRANS=-ITRANS
          IF(IS2.EQ.6 .AND. IS1.NE.6 .AND. IS1.NE.4) ITRANS=-ITRANS
C...baryons
        ELSE
C...         u and d have opposite definitions
          IF(IS1.LE.2) IS1=ITABI(IS1,1)
          IF(IS2.LE.2) IS2=ITABI(IS2,1)
          IF(IS3.LE.2) IS3=ITABI(IS3,1)
          IF(IS3.LE.2) THEN
            ITRANS=IS1*1000 + IS2*100 + IS3*10 + 2*JS+2
          ELSEIF(IS1.LE.2 .AND. IS2.LE.2) THEN
            ITRANS=IS3*1000 + IS1*100 + IS2*10 + 2*JS+2
          ELSE
            ITRANS=IS3*1000 + IS2*100 + IS1*10 + 2*JS+2
          ENDIF
          ITRANS=ISIGN(ITRANS,ID)
        ENDIF
      ELSEIF(IND.GT.0.AND.IDA.GT.10000) THEN
C...Special mesons. 
        IF(ID.EQ.10121) THEN
          ITRANS=20213
        ELSEIF(ID.EQ.10111) THEN
          ITRANS=20113
        ELSEIF(ID.EQ.10131) THEN
          ITRANS=10323
        ELSEIF(ID.EQ.10231) THEN
          ITRANS=10313
        ELSEIF(ID.EQ.30131) THEN
          ITRANS=30323
        ELSEIF(ID.EQ.30231) THEN
          ITRANS=30313
        ELSEIF(ID.EQ.10110) THEN
          ITRANS=10221
        ELSEIF(ID.EQ.10441) THEN
          ITRANS=20443
        ELSEIF(ID.EQ.20440) THEN
          ITRANS=10441
        ELSEIF(ID.EQ.20441) THEN
          ITRANS=10443
        ELSEIF(ID.EQ.20442) THEN
          ITRANS=445
        ELSE
          ITRANS=ID
        ENDIF
      ENDIF
      GO TO 300
C
 200  IF(MCONV.NE.2) GO TO 300
      J1=MOD(IDA,10)
      I1=MOD(IDA/10,10)
      I2=MOD(IDA/100,10)
      I3=MOD(IDA/1000,10)
      I4=MOD(IDA/10000,10)
      IF(IDA.EQ.0) THEN
        WRITE(ITLIS,*) ' ITRANS: particle ID is zero'
C...elementary particles
      ELSEIF(IDA.LT.100) THEN
        ITRANS=ISIGN(ITABI(IDA,2),ID)
C...check for illegal antiparticles
        IF(ID.LT.0) THEN
          DO 201 J=1,15
            IF(ID.EQ.NOANT(J)) ITRANS=0
 201      CONTINUE
        ENDIF
C...K short and K long
      ELSEIF(ID.EQ.130) THEN
        ITRANS=-20
      ELSEIF(ID.EQ.310) THEN
        ITRANS=20
C...mesons
      ELSEIF(I3.EQ.0) THEN
          IF(I1.LE.2 .AND. I2.LE.2) THEN
C...         don't change
          ELSE
C...         u and d have opposite definitions
            IF(I1.LE.2) I1=ITABI(I1,2)
            IF(I2.LE.2) I2=ITABI(I2,2)
          ENDIF
          ITRANS=I1*100 + I2*10 + (J1-1)/2
          ITRANS=ISIGN(ITRANS,ID)
C...         charmed and top mesons have wrong sign
          IF(I2.EQ.4 .AND. I1.NE.4) ITRANS=-ITRANS
          IF(I2.EQ.6 .AND. I1.NE.6 .AND. I1.NE.4) ITRANS=-ITRANS
C...check for illegal antiparticles
          IF(I2.EQ.I1 .AND. ID.LT.0) ITRANS=0
C...diquarks
      ELSEIF(I1.EQ.0) THEN
C...         u and d have opposite definitions
          IF(I3.LE.2) I3=ITABI(I3,2)
          IF(I2.LE.2) I2=ITABI(I2,2)
          IF(I3.LT.I2) THEN
            ITRANS=I3*1000 + I2*100 + (J1-1)/2
          ELSE
            ITRANS=I2*1000 + I3*100 + (J1-1)/2
          ENDIF
          ITRANS=ISIGN(ITRANS,ID)
C...         charmed and top mesons have wrong sign
          IF(I2.EQ.4 .AND. I3.NE.4) ITRANS=-ITRANS
          IF(I2.EQ.6 .AND. I3.NE.6 .AND. I3.NE.4) ITRANS=-ITRANS
C...baryons
      ELSE
C...         u and d have opposite definitions
          IF(I3.LE.2) I3=ITABI(I3,2)
          IF(I2.LE.2) I2=ITABI(I2,2)
          IF(I1.LE.2) I1=ITABI(I1,2)
          IF(I3.LE.2) THEN
            ITRANS=I3*1000 + I2*100 + I1*10 + (J1-2)/2
          ELSEIF(I1.LE.2 .AND. I2.LE.2) THEN
            ITRANS=I2*1000 + I1*100 + I3*10 + (J1-2)/2
          ELSE
            ITRANS=I1*1000 + I2*100 + I3*10 + (J1-2)/2
          ENDIF
          ITRANS=ISIGN(ITRANS,ID)
      ENDIF

 300  RETURN
      END
Commit	Line	Data
0795afa3	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=IS3100 + IS210 + 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=IS11000 + IS2100 + 2*JS+1
91	ELSE
92	ITRANS=IS21000 + IS1100 + 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=IS11000 + IS2100 + IS310 + 2JS+2
106	ELSEIF(IS1.LE.2 .AND. IS2.LE.2) THEN
107	ITRANS=IS31000 + IS1100 + IS210 + 2JS+2
108	ELSE
109	ITRANS=IS31000 + IS2100 + IS110 + 2JS+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=I1100 + I210 + (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=I31000 + I2100 + (J1-1)/2
188	ELSE
189	ITRANS=I21000 + I3100 + (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=I31000 + I2100 + I1*10 + (J1-2)/2
203	ELSEIF(I1.LE.2 .AND. I2.LE.2) THEN
204	ITRANS=I21000 + I1100 + I3*10 + (J1-2)/2
205	ELSE
206	ITRANS=I11000 + I2100 + I3*10 + (J1-2)/2
207	ENDIF
208	ITRANS=ISIGN(ITRANS,ID)
209	ENDIF
210
211	300 RETURN
212	END