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

#include "isajet/pilot.h"
      SUBROUTINE PRTLST(JTLIS,AMY,AMX)
C
C          List defined particles. AMY, AMX are the masses of the 
C          fourth generation quarks. If a negative mass is given,
C          then these are not listed.
C          This must be linked with ISAJET, including ALDATA.
C
#if defined(CERNLIB_IMPNONE)
      IMPLICIT NONE
#endif
#include "isajet/qlmass.inc"
#include "isajet/wcon.inc"
      INTEGER JTLIS
      REAL AMY,AMX
      INTEGER IFL1,IFL2,IFL3,JSPIN,INDEX,I,ID
      REAL AM,CG,AMASS,CHARGE
      CHARACTER*8 LB,LABEL
C
C          Initialize SUSY masses to 0. Remember offset of 1 from KL.
C
      DO 100 I=22,NQLEP
        AMLEP(I)=0.
100   CONTINUE
      AMLEP(7)=AMY
      AMLEP(8)=AMX
      CALL FLAVOR(80,IFL1,IFL2,IFL3,JSPIN,INDEX)
      AMLEP(INDEX)=WMASS(2)
      CALL FLAVOR(90,IFL1,IFL2,IFL3,JSPIN,INDEX)
      AMLEP(INDEX)=WMASS(4)
      WRITE(JTLIS,101) AMY,AMX
C
C          Loop over IDENT's
C
      DO 200 I=1,40000
        ID = I
        CALL FLAVOR(ID,IFL1,IFL2,IFL3,JSPIN,INDEX)
        IF(AMX.LT.0..OR.AMY.LT.0.) THEN
          IF(IABS(IFL1).GT.6.OR.IABS(IFL2).GT.6.OR.IABS(IFL3).GT.6)
     $    GO TO 200
        ENDIF
        IF(INDEX.GT.0) THEN
          LB = LABEL(ID)
          IF(LB.NE.'ERR') THEN
            AM = AMASS(ID)
            CG = CHARGE(ID)
            WRITE(JTLIS,102) ID,LB,AM,CG,IFL1,IFL2,IFL3,JSPIN,INDEX
          ENDIF
        ENDIF
        ID = -I
        CALL FLAVOR(ID,IFL1,IFL2,IFL3,JSPIN,INDEX)
C          Eliminate bad ID's:
        IF(INDEX.GT.0) THEN
          LB = LABEL(ID)
          IF(LB.NE.'ERR') THEN
            AM = AMASS(ID)
            CG = CHARGE(ID)
            WRITE(JTLIS,102) ID,LB,AM,CG,IFL1,IFL2,IFL3,JSPIN,INDEX
          ENDIF
        ENDIF
 200  CONTINUE
      RETURN
 101  FORMAT(10X,'ISAJET PARTICLES, M(Y) =',F10.3,'  M(X) =',F10.3//
     1 5X,'ID',4X,'PARTICLE',8X,'MASS',4X,'CHARGE',
     2 4X,'---FLAVOR---',4X,'SPIN',4X,'INDEX')
 102  FORMAT(1X,I6,4X,A8,F12.6,F10.2,4X,3I4,I8,I9)
      END
Commit	Line	Data
0795afa3	1	#include "isajet/pilot.h"
	2	SUBROUTINE PRTLST(JTLIS,AMY,AMX)
	3	C
	4	C List defined particles. AMY, AMX are the masses of the
	5	C fourth generation quarks. If a negative mass is given,
	6	C then these are not listed.
	7	C This must be linked with ISAJET, including ALDATA.
	8	C
	9	#if defined(CERNLIB_IMPNONE)
	10	IMPLICIT NONE
	11	#endif
	12	#include "isajet/qlmass.inc"
	13	#include "isajet/wcon.inc"
	14	INTEGER JTLIS
	15	REAL AMY,AMX
	16	INTEGER IFL1,IFL2,IFL3,JSPIN,INDEX,I,ID
	17	REAL AM,CG,AMASS,CHARGE
	18	CHARACTER*8 LB,LABEL
	19	C
	20	C Initialize SUSY masses to 0. Remember offset of 1 from KL.
	21	C
	22	DO 100 I=22,NQLEP
	23	AMLEP(I)=0.
	24	100 CONTINUE
	25	AMLEP(7)=AMY
	26	AMLEP(8)=AMX
	27	CALL FLAVOR(80,IFL1,IFL2,IFL3,JSPIN,INDEX)
	28	AMLEP(INDEX)=WMASS(2)
	29	CALL FLAVOR(90,IFL1,IFL2,IFL3,JSPIN,INDEX)
	30	AMLEP(INDEX)=WMASS(4)
	31	WRITE(JTLIS,101) AMY,AMX
	32	C
	33	C Loop over IDENT's
	34	C
	35	DO 200 I=1,40000
	36	ID = I
	37	CALL FLAVOR(ID,IFL1,IFL2,IFL3,JSPIN,INDEX)
	38	IF(AMX.LT.0..OR.AMY.LT.0.) THEN
	39	IF(IABS(IFL1).GT.6.OR.IABS(IFL2).GT.6.OR.IABS(IFL3).GT.6)
	40	$ GO TO 200
	41	ENDIF
	42	IF(INDEX.GT.0) THEN
	43	LB = LABEL(ID)
	44	IF(LB.NE.'ERR') THEN
	45	AM = AMASS(ID)
	46	CG = CHARGE(ID)
	47	WRITE(JTLIS,102) ID,LB,AM,CG,IFL1,IFL2,IFL3,JSPIN,INDEX
	48	ENDIF
	49	ENDIF
	50	ID = -I
	51	CALL FLAVOR(ID,IFL1,IFL2,IFL3,JSPIN,INDEX)
	52	C Eliminate bad ID's:
	53	IF(INDEX.GT.0) THEN
	54	LB = LABEL(ID)
	55	IF(LB.NE.'ERR') THEN
	56	AM = AMASS(ID)
	57	CG = CHARGE(ID)
	58	WRITE(JTLIS,102) ID,LB,AM,CG,IFL1,IFL2,IFL3,JSPIN,INDEX
	59	ENDIF
	60	ENDIF
	61	200 CONTINUE
	62	RETURN
	63	101 FORMAT(10X,'ISAJET PARTICLES, M(Y) =',F10.3,' M(X) =',F10.3//
	64	1 5X,'ID',4X,'PARTICLE',8X,'MASS',4X,'CHARGE',
65	2 4X,'---FLAVOR---',4X,'SPIN',4X,'INDEX')
66	102 FORMAT(1X,I6,4X,A8,F12.6,F10.2,4X,3I4,I8,I9)
67	END