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