Back to home page

sPhenix code displayed by LXR
 
 

    

File indexing completed on 2025-08-05 08:15:43 

0001     
0002 C*********************************************************************  
0003     
0004       SUBROUTINE LULIST(MLIST)  
0005     
0006 C...Purpose: to give program heading, or list an event, or particle 
0007 C...data, or current parameter values.  
0008       COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
0009       SAVE /LUJETS/ 
0010       COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200) 
0011       SAVE /LUDAT1/ 
0012       COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)    
0013       SAVE /LUDAT2/ 
0014       COMMON/LUDAT3/MDCY(500,3),MDME(2000,2),BRAT(2000),KFDP(2000,5)    
0015       SAVE /LUDAT3/ 
0016       CHARACTER CHAP*16,CHAC*16,CHAN*16,CHAD(5)*16,CHMO(12)*3,CHDL(7)*4 
0017       DIMENSION PS(6)   
0018       DATA CHMO/'Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep',  
0019      &'Oct','Nov','Dec'/,CHDL/'(())',' ','()','!!','<>','==','(==)'/    
0020     
0021 C...Initialization printout: version number and date of last change.    
0022 C      IF(MLIST.EQ.0.OR.MSTU(12).EQ.1) THEN  
0023 C        WRITE(MSTU(11),1000) MSTU(181),MSTU(182),MSTU(185), 
0024 C     &  CHMO(MSTU(184)),MSTU(183)   
0025 C        MSTU(12)=0  
0026 C        IF(MLIST.EQ.0) RETURN   
0027 C      ENDIF 
0028     
0029 C...List event data, including additional lines after N.    
0030       IF(MLIST.GE.1.AND.MLIST.LE.3) THEN    
0031         IF(MLIST.EQ.1) WRITE(MSTU(11),1100) 
0032         IF(MLIST.EQ.2) WRITE(MSTU(11),1200) 
0033         IF(MLIST.EQ.3) WRITE(MSTU(11),1300) 
0034         LMX=12  
0035         IF(MLIST.GE.2) LMX=16   
0036         ISTR=0  
0037         IMAX=N  
0038         IF(MSTU(2).GT.0) IMAX=MSTU(2)   
0039         DO 120 I=MAX(1,MSTU(1)),MAX(IMAX,N+MAX(0,MSTU(3)))  
0040         IF((I.GT.IMAX.AND.I.LE.N).OR.K(I,1).LT.0) GOTO 120  
0041     
0042 C...Get particle name, pad it and check it is not too long. 
0043         CALL LUNAME(K(I,2),CHAP)    
0044         LEN=0   
0045         DO 100 LEM=1,16 
0046   100   IF(CHAP(LEM:LEM).NE.' ') LEN=LEM    
0047         MDL=(K(I,1)+19)/10  
0048         LDL=0   
0049         IF(MDL.EQ.2.OR.MDL.GE.8) THEN   
0050           CHAC=CHAP 
0051           IF(LEN.GT.LMX) CHAC(LMX:LMX)='?'  
0052         ELSE    
0053           LDL=1 
0054           IF(MDL.EQ.1.OR.MDL.EQ.7) LDL=2    
0055           IF(LEN.EQ.0) THEN 
0056             CHAC=CHDL(MDL)(1:2*LDL)//' '    
0057           ELSE  
0058             CHAC=CHDL(MDL)(1:LDL)//CHAP(1:MIN(LEN,LMX-2*LDL))// 
0059      &      CHDL(MDL)(LDL+1:2*LDL)//' ' 
0060             IF(LEN+2*LDL.GT.LMX) CHAC(LMX:LMX)='?'  
0061           ENDIF 
0062         ENDIF   
0063     
0064 C...Add information on string connection.   
0065         IF(K(I,1).EQ.1.OR.K(I,1).EQ.2.OR.K(I,1).EQ.11.OR.K(I,1).EQ.12)  
0066      &  THEN    
0067           KC=LUCOMP(K(I,2)) 
0068           KCC=0 
0069           IF(KC.NE.0) KCC=KCHG(KC,2)    
0070           IF(KCC.NE.0.AND.ISTR.EQ.0) THEN   
0071             ISTR=1  
0072             IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='A'    
0073           ELSEIF(KCC.NE.0.AND.(K(I,1).EQ.2.OR.K(I,1).EQ.12)) THEN   
0074             IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='I'    
0075           ELSEIF(KCC.NE.0) THEN 
0076             ISTR=0  
0077             IF(LEN+2*LDL+3.LE.LMX) CHAC(LMX-1:LMX-1)='V'    
0078           ENDIF 
0079         ENDIF   
0080     
0081 C...Write data for particle/jet.    
0082         IF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.9999.) THEN    
0083           WRITE(MSTU(11),1400) I,CHAC(1:12),(K(I,J1),J1=1,3),   
0084      &    (P(I,J2),J2=1,5)  
0085         ELSEIF(MLIST.EQ.1.AND.ABS(P(I,4)).LT.99999.) THEN   
0086           WRITE(MSTU(11),1500) I,CHAC(1:12),(K(I,J1),J1=1,3),   
0087      &    (P(I,J2),J2=1,5)  
0088         ELSEIF(MLIST.EQ.1) THEN 
0089           WRITE(MSTU(11),1600) I,CHAC(1:12),(K(I,J1),J1=1,3),   
0090      &    (P(I,J2),J2=1,5)  
0091         ELSEIF(MSTU(5).EQ.10000.AND.(K(I,1).EQ.3.OR.K(I,1).EQ.13.OR.    
0092      &  K(I,1).EQ.14)) THEN 
0093           WRITE(MSTU(11),1700) I,CHAC,(K(I,J1),J1=1,3), 
0094      &    K(I,4)/100000000,MOD(K(I,4)/10000,10000),MOD(K(I,4),10000),   
0095      &    K(I,5)/100000000,MOD(K(I,5)/10000,10000),MOD(K(I,5),10000),   
0096      &    (P(I,J2),J2=1,5)  
0097         ELSE    
0098           WRITE(MSTU(11),1800) I,CHAC,(K(I,J1),J1=1,5),(P(I,J2),J2=1,5) 
0099         ENDIF   
0100         IF(MLIST.EQ.3) WRITE(MSTU(11),1900) (V(I,J),J=1,5)  
0101     
0102 C...Insert extra separator lines specified by user. 
0103         IF(MSTU(70).GE.1) THEN  
0104           ISEP=0    
0105           DO 110 J=1,MIN(10,MSTU(70))   
0106   110     IF(I.EQ.MSTU(70+J)) ISEP=1    
0107           IF(ISEP.EQ.1.AND.MLIST.EQ.1) WRITE(MSTU(11),2000) 
0108           IF(ISEP.EQ.1.AND.MLIST.GE.2) WRITE(MSTU(11),2100) 
0109         ENDIF   
0110   120   CONTINUE    
0111     
0112 C...Sum of charges and momenta. 
0113         DO 130 J=1,6    
0114   130   PS(J)=PLU(0,J)  
0115         IF(MLIST.EQ.1.AND.ABS(PS(4)).LT.9999.) THEN 
0116           WRITE(MSTU(11),2200) PS(6),(PS(J),J=1,5)  
0117         ELSEIF(MLIST.EQ.1.AND.ABS(PS(4)).LT.99999.) THEN    
0118           WRITE(MSTU(11),2300) PS(6),(PS(J),J=1,5)  
0119         ELSEIF(MLIST.EQ.1) THEN 
0120           WRITE(MSTU(11),2400) PS(6),(PS(J),J=1,5)  
0121         ELSE    
0122           WRITE(MSTU(11),2500) PS(6),(PS(J),J=1,5)  
0123         ENDIF   
0124     
0125 C...Give simple list of KF codes defined in program.    
0126       ELSEIF(MLIST.EQ.11) THEN  
0127         WRITE(MSTU(11),2600)    
0128         DO 140 KF=1,40  
0129         CALL LUNAME(KF,CHAP)    
0130         CALL LUNAME(-KF,CHAN)   
0131         IF(CHAP.NE.' '.AND.CHAN.EQ.' ') WRITE(MSTU(11),2700) KF,CHAP    
0132   140   IF(CHAN.NE.' ') WRITE(MSTU(11),2700) KF,CHAP,-KF,CHAN   
0133         DO 150 KFLS=1,3,2   
0134         DO 150 KFLA=1,8 
0135         DO 150 KFLB=1,KFLA-(3-KFLS)/2   
0136         KF=1000*KFLA+100*KFLB+KFLS  
0137         CALL LUNAME(KF,CHAP)    
0138         CALL LUNAME(-KF,CHAN)   
0139   150   WRITE(MSTU(11),2700) KF,CHAP,-KF,CHAN   
0140         DO 170 KMUL=0,5 
0141         KFLS=3  
0142         IF(KMUL.EQ.0.OR.KMUL.EQ.3) KFLS=1   
0143         IF(KMUL.EQ.5) KFLS=5    
0144         KFLR=0  
0145         IF(KMUL.EQ.2.OR.KMUL.EQ.3) KFLR=1   
0146         IF(KMUL.EQ.4) KFLR=2    
0147         DO 170 KFLB=1,8 
0148         DO 160 KFLC=1,KFLB-1    
0149         KF=10000*KFLR+100*KFLB+10*KFLC+KFLS 
0150         CALL LUNAME(KF,CHAP)    
0151         CALL LUNAME(-KF,CHAN)   
0152   160   WRITE(MSTU(11),2700) KF,CHAP,-KF,CHAN   
0153         KF=10000*KFLR+110*KFLB+KFLS 
0154         CALL LUNAME(KF,CHAP)    
0155   170   WRITE(MSTU(11),2700) KF,CHAP    
0156         KF=130  
0157         CALL LUNAME(KF,CHAP)    
0158         WRITE(MSTU(11),2700) KF,CHAP    
0159         KF=310  
0160         CALL LUNAME(KF,CHAP)    
0161         WRITE(MSTU(11),2700) KF,CHAP    
0162         DO 190 KFLSP=1,3    
0163         KFLS=2+2*(KFLSP/3)  
0164         DO 190 KFLA=1,8 
0165         DO 190 KFLB=1,KFLA  
0166         DO 180 KFLC=1,KFLB  
0167         IF(KFLSP.EQ.1.AND.(KFLA.EQ.KFLB.OR.KFLB.EQ.KFLC)) GOTO 180  
0168         IF(KFLSP.EQ.2.AND.KFLA.EQ.KFLC) GOTO 180    
0169         IF(KFLSP.EQ.1) KF=1000*KFLA+100*KFLC+10*KFLB+KFLS   
0170         IF(KFLSP.GE.2) KF=1000*KFLA+100*KFLB+10*KFLC+KFLS   
0171         CALL LUNAME(KF,CHAP)    
0172         CALL LUNAME(-KF,CHAN)   
0173         WRITE(MSTU(11),2700) KF,CHAP,-KF,CHAN   
0174   180   CONTINUE    
0175   190   CONTINUE    
0176     
0177 C...List parton/particle data table. Check whether to be listed.    
0178       ELSEIF(MLIST.EQ.12) THEN  
0179         WRITE(MSTU(11),2800)    
0180         MSTJ24=MSTJ(24) 
0181         MSTJ(24)=0  
0182         KFMAX=20883 
0183         IF(MSTU(2).NE.0) KFMAX=MSTU(2)  
0184         DO 220 KF=MAX(1,MSTU(1)),KFMAX  
0185         KC=LUCOMP(KF)   
0186         IF(KC.EQ.0) GOTO 220    
0187         IF(MSTU(14).EQ.0.AND.KF.GT.100.AND.KC.LE.100) GOTO 220  
0188         IF(MSTU(14).GT.0.AND.KF.GT.100.AND.MAX(MOD(KF/1000,10), 
0189      &  MOD(KF/100,10)).GT.MSTU(14)) GOTO 220   
0190     
0191 C...Find particle name and mass. Print information. 
0192         CALL LUNAME(KF,CHAP)    
0193         IF(KF.LE.100.AND.CHAP.EQ.' '.AND.MDCY(KC,2).EQ.0) GOTO 220  
0194         CALL LUNAME(-KF,CHAN)   
0195         PM=ULMASS(KF)   
0196         WRITE(MSTU(11),2900) KF,KC,CHAP,CHAN,KCHG(KC,1),KCHG(KC,2), 
0197      &  KCHG(KC,3),PM,PMAS(KC,2),PMAS(KC,3),PMAS(KC,4),MDCY(KC,1)   
0198     
0199 C...Particle decay: channel number, branching ration, matrix element,   
0200 C...decay products. 
0201         IF(KF.GT.100.AND.KC.LE.100) GOTO 220    
0202         DO 210 IDC=MDCY(KC,2),MDCY(KC,2)+MDCY(KC,3)-1   
0203         DO 200 J=1,5    
0204   200   CALL LUNAME(KFDP(IDC,J),CHAD(J))    
0205   210   WRITE(MSTU(11),3000) IDC,MDME(IDC,1),MDME(IDC,2),BRAT(IDC), 
0206      &  (CHAD(J),J=1,5) 
0207   220   CONTINUE    
0208         MSTJ(24)=MSTJ24 
0209     
0210 C...List parameter value table. 
0211       ELSEIF(MLIST.EQ.13) THEN  
0212         WRITE(MSTU(11),3100)    
0213         DO 230 I=1,200  
0214   230   WRITE(MSTU(11),3200) I,MSTU(I),PARU(I),MSTJ(I),PARJ(I),PARF(I)  
0215       ENDIF 
0216     
0217 C...Format statements for output on unit MSTU(11) (by default 6).   
0218  1000 FORMAT(///20X,'The Lund Monte Carlo - JETSET version ',I1,'.',I1/ 
0219      &20X,'**  Last date of change:  ',I2,1X,A3,1X,I4,'  **'/)  
0220  1100 FORMAT(///28X,'Event listing (summary)'//4X,'I  particle/jet KS', 
0221      &5X,'KF orig    p_x      p_y      p_z       E        m'/)  
0222  1200 FORMAT(///28X,'Event listing (standard)'//4X,'I  particle/jet',   
0223      &'  K(I,1)   K(I,2) K(I,3)     K(I,4)      K(I,5)       P(I,1)',   
0224      &'       P(I,2)       P(I,3)       P(I,4)       P(I,5)'/)  
0225  1300 FORMAT(///28X,'Event listing (with vertices)'//4X,'I  particle/j',    
0226      &'et  K(I,1)   K(I,2) K(I,3)     K(I,4)      K(I,5)       P(I,1)', 
0227      &'       P(I,2)       P(I,3)       P(I,4)       P(I,5)'/73X,   
0228      &'V(I,1)       V(I,2)       V(I,3)       V(I,4)       V(I,5)'/)    
0229  1400 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.3)  
0230  1500 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.2)  
0231  1600 FORMAT(1X,I4,2X,A12,1X,I2,1X,I6,1X,I4,5F9.1)  
0232  1700 FORMAT(1X,I4,2X,A16,1X,I3,1X,I8,2X,I4,2(3X,I1,2I4),5F13.5)    
0233  1800 FORMAT(1X,I4,2X,A16,1X,I3,1X,I8,2X,I4,2(3X,I9),5F13.5)    
0234  1900 FORMAT(66X,5(1X,F12.3))   
0235  2000 FORMAT(1X,78('='))    
0236  2100 FORMAT(1X,130('='))   
0237  2200 FORMAT(19X,'sum:',F6.2,5X,5F9.3)  
0238  2300 FORMAT(19X,'sum:',F6.2,5X,5F9.2)  
0239  2400 FORMAT(19X,'sum:',F6.2,5X,5F9.1)  
0240  2500 FORMAT(19X,'sum charge:',F6.2,3X,'sum momentum and inv. mass:',   
0241      &5F13.5)   
0242  2600 FORMAT(///20X,'List of KF codes in program'/) 
0243  2700 FORMAT(4X,I6,4X,A16,6X,I6,4X,A16) 
0244  2800 FORMAT(///30X,'Particle/parton data table'//5X,'KF',5X,'KC',4X,   
0245      &'particle',8X,'antiparticle',6X,'chg  col  anti',8X,'mass',7X,    
0246      &'width',7X,'w-cut',5X,'lifetime',1X,'decay'/11X,'IDC',1X,'on/off',    
0247      &1X,'ME',3X,'Br.rat.',4X,'decay products') 
0248  2900 FORMAT(/1X,I6,3X,I4,4X,A16,A16,3I5,1X,F12.5,2(1X,F11.5),  
0249      &2X,F12.5,3X,I2)   
0250  3000 FORMAT(10X,I4,2X,I3,2X,I3,2X,F8.5,4X,5A16)    
0251  3100 FORMAT(///20X,'Parameter value table'//4X,'I',3X,'MSTU(I)',   
0252      &8X,'PARU(I)',3X,'MSTJ(I)',8X,'PARJ(I)',8X,'PARF(I)')  
0253  3200 FORMAT(1X,I4,1X,I9,1X,F14.5,1X,I9,1X,F14.5,1X,F14.5)  
0254     
0255       RETURN    
0256       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated by the 2.3.7 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!