*
* $Id: readtb.F,v 1.1.1.1 1996/01/11 14:14:41 mclareni Exp $
*
* $Log: readtb.F,v $
* Revision 1.1.1.1  1996/01/11 14:14:41  mclareni
* Cojets
*
*
#include "cojets/pilot.h"
      SUBROUTINE READTB
C     *****************
C-- READS PARTICLE LABELS, MASSES, CHARGES AND DECAY MODES FROM TABLE FI
C-- CREATED: 88/04/27.
#if defined(CERNLIB_SINGLE)
      IMPLICIT REAL (A-H,O-Z)
#endif
#if defined(CERNLIB_DOUBLE)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
#endif
#include "cojets/data1.inc"
#include "cojets/data2.inc"
#include "cojets/data3.inc"
#include "cojets/decpar.inc"
#include "cojets/itapes.inc"
#include "cojets/maxn.inc"
      DIMENSION LDEC(6)
      CHARACTER*5 CHALAB,GLUON
      CHARACTER*6 PRBEG,DCBEG,XX
      DATA PRBEG,DCBEG/'$PRBEG','$DCBEG'/,GLUON/'GL   '/
C
      ITABLE=ABS(ITDKY)
C
C-- LOOK FOR $PRBEG
      LC=0
1     READ(ITABLE,2) XX
      LC=LC+1
      IF(LC.GT.1000) GO TO 521
2     FORMAT(A6)
      IF(XX.NE.PRBEG) GO TO 1
C-- READ PARTICLE DATA
10    READ(ITABLE,11) ID,CHALAB,AMASS,CHARGP
11    FORMAT(6X,I5,5X,A5,3X,E12.5,4X,F6.2)
      IF(ID.EQ.99999) GO TO 20
      IDA=ABS(ID)
      IF(IDA.EQ.0) GO TO 10
      INTC=INTID(ID)
      IF(INTC.EQ.0) GO TO 12
      CHA2(INTC)=CHALAB
      IF(PMAS(INTC).LT.1.E-30) PMAS(INTC)=AMASS
      LCHARG(INTC)=CHARGP
      IDENTF(INTC)=ID
      GO TO 10
C-- QUARKS, GLUON ID
12    IF(IDA.LE.6) THEN
        IF(QMAS(IDA).LT.1.E-30) QMAS(IDA)=AMASS
        CHA4(IDA,1+(1-SIGN(1,ID))/2)=CHALAB
      ELSEIF(CHALAB.EQ.GLUON) THEN
        CHAGL=CHALAB
        IDGL=ID
      ENDIF
      GO TO 10
C-- LOOK FOR $DCBEG
20    LC=0
21    READ(ITABLE,2) XX
      LC=LC+1
      IF(LC.GT.1000) GO TO 523
      IF(XX.NE.DCBEG) GO TO 21
C-- READ DECAY DATA
30    KDC=18
      IDL=0
      IFLAG=0
31    READ(ITABLE,*) ID,LEH,CBRC,(LDEC(I),I=1,5)
      IF(ID.EQ.0) GO TO 40
      KDC=KDC+1
      IF(KDC.GT.MAXDEC) GO TO 513
      LDEC(6)=ID
      CALL REORSL(LDEC,IFLAG)
      DO 32 L=1,6
      IF(L.EQ.6.AND.ID.EQ.IDL) GO TO 34
      INTC=0
      IF(LDEC(L).EQ.0) GO TO 33
      INTC=INTID(LDEC(L))
      IF(INTC.NE.0) GO TO 33
      IF(ABS(LDEC(L)).LE.6) THEN
C-- QUARKS
        INTC=LDEC(L)*1000
        GO TO 33
      ENDIF
      IF(MOD(LDEC(L),100).EQ.0) THEN
C-- DIQUARKS
        INTC=LDEC(L)*10
        GO TO 33
      ENDIF
C-- ERROR IN INPUT
      GO TO 511
33    IF(L.LE.5) KDP(KDC,L)=INTC
      IF(L.EQ.6) IDINT=INTC
32    CONTINUE
      IDB(IDINT)=KDC
      IF(MOD(ABS(ID),100).EQ.60) IDB(IDINT)=-KDC
      IDINTM=INTID(-ID)
      IF(IDINTM.NE.0) THEN
        IDB(IDINTM)=KDC
        IF(MOD(ABS(ID),100).EQ.60) IDB(IDINTM)=-KDC
      ENDIF
34    CBR(KDC)=CBRC
      IDL=ID
      GO TO 31
C-- EXIT
40    MNDEC=KDC
      IF(IFLAG.GT.0) GO TO 525
      RETURN
C
C-- ABNORMAL EXIT
511   WRITE(ITLIS,512) LDEC(L),ID,LEH,CBRC,(LDEC(L1),L1=1,5)
512   FORMAT(5(/),1X,'INCORRECT INPUT ',I10,' IN DECAY DATA TABLE'
     1,' AT LINE'/1X,8I10/1X,'EXECUTION TERMINATED'/)
      STOP
513   WRITE(ITLIS,514) MAXDEC
514   FORMAT(5(/),1X,'NO. OF DECAY CHANNELS FOUND WHILE READING DECAY '
     1,'DATA TABLE EXCEEDS ',I10
     3/1X,'INCREASE MAXDEC'
     4/1X,'EXECUTION TERMINATED')
      STOP
521   WRITE(ITLIS,522)
522   FORMAT(5(/),1X,'ERROR IN THE DATA TABLE FILE'
     1/1X,'SET LINE WITH $PRBEG, LEFT ADJUSTED, IMMEDIATELY BEFORE'
     2,' BEGINNING OF PARTICLE PARAMETER DATA'
     3/1X,'EXECUTION TERMINATED')
      STOP
523   WRITE(ITLIS,524)
524   FORMAT(5(/),1X,'ERROR IN THE DATA TABLE FILE'
     1/1X,'SET LINE WITH $DCBEG, LEFT ADJUSTED, IMMEDIATELY BEFORE'
     2,' BEGINNING OF PARTICLE DECAY DATA'
     3/1X,'EXECUTION TERMINATED')
      STOP
525   WRITE(ITLIS,526)
526   FORMAT(/' $$$JOB ABORTED')
      STOP
      END
