* $Id$ C********************************************************************* SUBROUTINE LULIST_HIJING(MLIST) C...Purpose: to give program heading, or list an event, or particle C...data, or current parameter values. #include "lujets_hijing.inc" #include "ludat1_hijing.inc" #include "ludat2_hijing.inc" #include "ludat3_hijing.inc" CHARACTER CHAP*16,CHAC*16,CHAN*16,CHAD(5)*16,CHMO(12)*3,CHDL(7)*4 DIMENSION PS(6) DATA CHMO/'Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep', &'Oct','Nov','Dec'/,CHDL/'(())',' ','()','!!','<>','==','(==)'/ C...Initialization printout: version number and date of last change. C IF(MLIST.EQ.0.OR.MSTU(12).EQ.1) THEN C WRITE(MSTU(11),1000) MSTU(181),MSTU(182),MSTU(185), C & CHMO(MSTU(184)),MSTU(183) C MSTU(12)=0 C IF(MLIST.EQ.0) RETURN C ENDIF C...List event data, including additional lines after N. IF(MLIST.GE.1.AND.MLIST.LE.3) THEN IF(MLIST.EQ.1) WRITE(MSTU(11),1100) IF(MLIST.EQ.2) WRITE(MSTU(11),1200) IF(MLIST.EQ.3) WRITE(MSTU(11),1300) LMX=12 IF(MLIST.GE.2) LMX=16 ISTR=0 IMAX=N IF(MSTU(2).GT.0) IMAX=MSTU(2) DO 120 I=MAX(1,MSTU(1)),MAX(IMAX,N+MAX(0,MSTU(3))) IF((I.GT.IMAX.AND.I.LE.N).OR.K(I,1).LT.0) GOTO 120 C...Get particle name, pad it and check it is not too long. CALL LUNAME_HIJING(K(I,2),CHAP) LEN=0 DO 100 LEM=1,16 100 IF(CHAP(LEM:LEM).NE.' ') LEN=LEM MDL=(K(I,1)+19)/10 LDL=0 IF(MDL.EQ.2.OR.MDL.GE.8) THEN CHAC=CHAP IF(LEN.GT.LMX) CHAC(LMX:LMX)='?' ELSE LDL=1 IF(MDL.EQ.1.OR.MDL.EQ.7) LDL=2 IF(LEN.EQ.0) THEN CHAC=CHDL(MDL)(1:2*LDL)//' ' ELSE CHAC=CHDL(MDL)(1:LDL)//CHAP(1:MIN(LEN,LMX-2*LDL))// & CHDL(MDL)(LDL+1:2*LDL)//' ' IF(LEN+2*LDL.GT.LMX) CHAC(LMX:LMX)='?' ENDIF ENDIF C...Add information on string connection. IF(K(I,1).EQ.1.OR.K(I,1).EQ.2.OR.K(I,1).EQ.11.OR.K(I,1).EQ.12) & THEN KC=LUCOMP_HIJING(K(I,2)) KCC=0 IF(KC.NE.0) KCC=KCHG(KC,2) IF(KCC.NE.0.AND.ISTR.EQ.0) THEN ISTR=1 IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='A' ELSEIF(KCC.NE.0.AND.(K(I,1).EQ.2.OR.K(I,1).EQ.12)) THEN IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='I' ELSEIF(KCC.NE.0) THEN ISTR=0 IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='V' ENDIF ENDIF C...Write data for particle/jet. IF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.9999.) THEN WRITE(MSTU(11),1400) I,CHAC(1:12),(K(I,J1),J1=1,3), & (P(I,J2),J2=1,5) ELSEIF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.99999.) THEN WRITE(MSTU(11),1500) I,CHAC(1:12),(K(I,J1),J1=1,3), & (P(I,J2),J2=1,5) ELSEIF(MLIST.EQ.1) THEN WRITE(MSTU(11),1600) I,CHAC(1:12),(K(I,J1),J1=1,3), & (P(I,J2),J2=1,5) ELSEIF(MSTU(5).EQ.10000.AND.(K(I,1).EQ.3.OR.K(I,1).EQ.13.OR. & K(I,1).EQ.14)) THEN WRITE(MSTU(11),1700) I,CHAC,(K(I,J1),J1=1,3), & K(I,4)/100000000,MOD(K(I,4)/10000,10000),MOD(K(I,4),10000), & K(I,5)/100000000,MOD(K(I,5)/10000,10000),MOD(K(I,5),10000), & (P(I,J2),J2=1,5) ELSE WRITE(MSTU(11),1800) I,CHAC,(K(I,J1),J1=1,5),(P(I,J2),J2=1,5) ENDIF IF(MLIST.EQ.3) WRITE(MSTU(11),1900) (V(I,J),J=1,5) C...Insert extra separator lines specified by user. IF(MSTU(70).GE.1) THEN ISEP=0 DO 110 J=1,MIN(10,MSTU(70)) 110 IF(I.EQ.MSTU(70+J)) ISEP=1 IF(ISEP.EQ.1.AND.MLIST.EQ.1) WRITE(MSTU(11),2000) IF(ISEP.EQ.1.AND.MLIST.GE.2) WRITE(MSTU(11),2100) ENDIF 120 CONTINUE C...Sum of charges and momenta. DO 130 J=1,6 130 PS(J)=PLU_HIJING(0,J) IF(MLIST.EQ.1.AND.ABS(PS(4)).LT.9999.) THEN WRITE(MSTU(11),2200) PS(6),(PS(J),J=1,5) ELSEIF(MLIST.EQ.1.AND.ABS(PS(4)).LT.99999.) THEN WRITE(MSTU(11),2300) PS(6),(PS(J),J=1,5) ELSEIF(MLIST.EQ.1) THEN WRITE(MSTU(11),2400) PS(6),(PS(J),J=1,5) ELSE WRITE(MSTU(11),2500) PS(6),(PS(J),J=1,5) ENDIF C...Give simple list of KF codes defined in program. ELSEIF(MLIST.EQ.11) THEN WRITE(MSTU(11),2600) DO 140 KF=1,40 CALL LUNAME_HIJING(KF,CHAP) CALL LUNAME_HIJING(-KF,CHAN) IF(CHAP.NE.' '.AND.CHAN.EQ.' ') WRITE(MSTU(11),2700) KF,CHAP 140 IF(CHAN.NE.' ') WRITE(MSTU(11),2700) KF,CHAP,-KF,CHAN DO 150 KFLS=1,3,2 DO 150 KFLA=1,8 DO 150 KFLB=1,KFLA-(3-KFLS)/2 KF=1000*KFLA+100*KFLB+KFLS CALL LUNAME_HIJING(KF,CHAP) CALL LUNAME_HIJING(-KF,CHAN) 150 WRITE(MSTU(11),2700) KF,CHAP,-KF,CHAN DO 170 KMUL=0,5 KFLS=3 IF(KMUL.EQ.0.OR.KMUL.EQ.3) KFLS=1 IF(KMUL.EQ.5) KFLS=5 KFLR=0 IF(KMUL.EQ.2.OR.KMUL.EQ.3) KFLR=1 IF(KMUL.EQ.4) KFLR=2 DO 170 KFLB=1,8 DO 160 KFLC=1,KFLB-1 KF=10000*KFLR+100*KFLB+10*KFLC+KFLS CALL LUNAME_HIJING(KF,CHAP) CALL LUNAME_HIJING(-KF,CHAN) 160 WRITE(MSTU(11),2700) KF,CHAP,-KF,CHAN KF=10000*KFLR+110*KFLB+KFLS CALL LUNAME_HIJING(KF,CHAP) 170 WRITE(MSTU(11),2700) KF,CHAP KF=130 CALL LUNAME_HIJING(KF,CHAP) WRITE(MSTU(11),2700) KF,CHAP KF=310 CALL LUNAME_HIJING(KF,CHAP) WRITE(MSTU(11),2700) KF,CHAP DO 190 KFLSP=1,3 KFLS=2+2*(KFLSP/3) DO 190 KFLA=1,8 DO 190 KFLB=1,KFLA DO 180 KFLC=1,KFLB IF(KFLSP.EQ.1.AND.(KFLA.EQ.KFLB.OR.KFLB.EQ.KFLC)) GOTO 180 IF(KFLSP.EQ.2.AND.KFLA.EQ.KFLC) GOTO 180 IF(KFLSP.EQ.1) KF=1000*KFLA+100*KFLC+10*KFLB+KFLS IF(KFLSP.GE.2) KF=1000*KFLA+100*KFLB+10*KFLC+KFLS CALL LUNAME_HIJING(KF,CHAP) CALL LUNAME_HIJING(-KF,CHAN) WRITE(MSTU(11),2700) KF,CHAP,-KF,CHAN 180 CONTINUE 190 CONTINUE C...List parton/particle data table. Check whether to be listed. ELSEIF(MLIST.EQ.12) THEN WRITE(MSTU(11),2800) MSTJ24=MSTJ(24) MSTJ(24)=0 KFMAX=20883 IF(MSTU(2).NE.0) KFMAX=MSTU(2) DO 220 KF=MAX(1,MSTU(1)),KFMAX KC=LUCOMP_HIJING(KF) IF(KC.EQ.0) GOTO 220 IF(MSTU(14).EQ.0.AND.KF.GT.100.AND.KC.LE.100) GOTO 220 IF(MSTU(14).GT.0.AND.KF.GT.100.AND.MAX(MOD(KF/1000,10), & MOD(KF/100,10)).GT.MSTU(14)) GOTO 220 C...Find particle name and mass. Print information. CALL LUNAME_HIJING(KF,CHAP) IF(KF.LE.100.AND.CHAP.EQ.' '.AND.MDCY(KC,2).EQ.0) GOTO 220 CALL LUNAME_HIJING(-KF,CHAN) PM=ULMASS_HIJING(KF) WRITE(MSTU(11),2900) KF,KC,CHAP,CHAN,KCHG(KC,1),KCHG(KC,2), & KCHG(KC,3),PM,PMAS(KC,2),PMAS(KC,3),PMAS(KC,4),MDCY(KC,1) C...Particle decay: channel number, branching ration, matrix element, C...decay products. IF(KF.GT.100.AND.KC.LE.100) GOTO 220 DO 210 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1 DO 200 J=1,5 200 CALL LUNAME_HIJING(KFDP(IDC,J),CHAD(J)) 210 WRITE(MSTU(11),3000) IDC,MDME(IDC,1),MDME(IDC,2),BRAT(IDC), & (CHAD(J),J=1,5) 220 CONTINUE MSTJ(24)=MSTJ24 C...List parameter value table. ELSEIF(MLIST.EQ.13) THEN WRITE(MSTU(11),3100) DO 230 I=1,200 230 WRITE(MSTU(11),3200) I,MSTU(I),PARU(I),MSTJ(I),PARJ(I),PARF(I) ENDIF C...Format statements for output on unit MSTU(11) (by default 6). 1000 FORMAT(///20X,'The Lund Monte Carlo - JETSET version ',I1,'.',I1/ &20X,'** Last date of change: ',I2,1X,A3,1X,I4,' **'/) 1100 FORMAT(///28X,'Event listing (summary)'//4X,'I particle/jet KS', &5X,'KF orig p_x p_y p_z E m'/) 1200 FORMAT(///28X,'Event listing (standard)'//4X,'I particle/jet', &' K(I,1) K(I,2) K(I,3) K(I,4) K(I,5) P(I,1)', &' P(I,2) P(I,3) P(I,4) P(I,5)'/) 1300 FORMAT(///28X,'Event listing (with vertices)'//4X,'I particle/j', &'et K(I,1) K(I,2) K(I,3) K(I,4) K(I,5) P(I,1)', &' P(I,2) P(I,3) P(I,4) P(I,5)'/73X, &'V(I,1) V(I,2) V(I,3) V(I,4) V(I,5)'/) 1400 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.3) 1500 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.2) 1600 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.1) 1700 FORMAT(1X,I4,2X,A16,1X,I3,1X,I8,2X,I4,2(3X,I1,2I4),5F13.5) 1800 FORMAT(1X,I4,2X,A16,1X,I3,1X,I8,2X,I4,2(3X,I9),5F13.5) 1900 FORMAT(66X,5(1X,F12.3)) 2000 FORMAT(1X,78('=')) 2100 FORMAT(1X,130('=')) 2200 FORMAT(19X,'sum:',F6.2,5X,5F9.3) 2300 FORMAT(19X,'sum:',F6.2,5X,5F9.2) 2400 FORMAT(19X,'sum:',F6.2,5X,5F9.1) 2500 FORMAT(19X,'sum charge:',F6.2,3X,'sum momentum and inv. mass:', &5F13.5) 2600 FORMAT(///20X,'List of KF codes in program'/) 2700 FORMAT(4X,I6,4X,A16,6X,I6,4X,A16) 2800 FORMAT(///30X,'Particle/parton data table'//5X,'KF',5X,'KC',4X, &'particle',8X,'antiparticle',6X,'chg col anti',8X,'mass',7X, &'width',7X,'w-cut',5X,'lifetime',1X,'decay'/11X,'IDC',1X,'on/off', &1X,'ME',3X,'Br.rat.',4X,'decay products') 2900 FORMAT(/1X,I6,3X,I4,4X,A16,A16,3I5,1X,F12.5,2(1X,F11.5), &2X,F12.5,3X,I2) 3000 FORMAT(10X,I4,2X,I3,2X,I3,2X,F8.5,4X,5A16) 3100 FORMAT(///20X,'Parameter value table'//4X,'I',3X,'MSTU(I)', &8X,'PARU(I)',3X,'MSTJ(I)',8X,'PARJ(I)',8X,'PARF(I)') 3200 FORMAT(1X,I4,1X,I9,1X,F14.5,1X,I9,1X,F14.5,1X,F14.5) RETURN END