Back to home page

sPhenix code displayed by LXR

 
 

    


File indexing completed on 2025-08-05 08:21:12

0001  
0002 C*********************************************************************
0003  
0004 C...PYK
0005 C...Provides various integer-valued event related data.
0006  
0007       FUNCTION PYK(I,J)
0008  
0009 C...Double precision and integer declarations.
0010       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0011       IMPLICIT INTEGER(I-N)
0012       INTEGER PYK,PYCHGE,PYCOMP
0013 C...Commonblocks.
0014       COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5)
0015       COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0016       COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
0017       SAVE /PYJETS/,/PYDAT1/,/PYDAT2/
0018  
0019 C...Default value. For I=0 number of entries, number of stable entries
0020 C...or 3 times total charge.
0021       PYK=0
0022       IF(I.LT.0.OR.I.GT.MSTU(4).OR.J.LE.0) THEN
0023       ELSEIF(I.EQ.0.AND.J.EQ.1) THEN
0024         PYK=N
0025       ELSEIF(I.EQ.0.AND.(J.EQ.2.OR.J.EQ.6)) THEN
0026         DO 100 I1=1,N
0027           IF(J.EQ.2.AND.K(I1,1).GE.1.AND.K(I1,1).LE.10) PYK=PYK+1
0028           IF(J.EQ.6.AND.K(I1,1).GE.1.AND.K(I1,1).LE.10) PYK=PYK+
0029      &    PYCHGE(K(I1,2))
0030   100   CONTINUE
0031       ELSEIF(I.EQ.0) THEN
0032  
0033 C...For I > 0 direct readout of K matrix or charge.
0034       ELSEIF(J.LE.5) THEN
0035         PYK=K(I,J)
0036       ELSEIF(J.EQ.6) THEN
0037         PYK=PYCHGE(K(I,2))
0038  
0039 C...Status (existing/fragmented/decayed), parton/hadron separation.
0040       ELSEIF(J.LE.8) THEN
0041         IF(K(I,1).GE.1.AND.K(I,1).LE.10) PYK=1
0042         IF(J.EQ.8) PYK=PYK*K(I,2)
0043       ELSEIF(J.LE.12) THEN
0044         KFA=IABS(K(I,2))
0045         KC=PYCOMP(KFA)
0046         KQ=0
0047         IF(KC.NE.0) KQ=KCHG(KC,2)
0048         IF(J.EQ.9.AND.KC.NE.0.AND.KQ.NE.0) PYK=K(I,2)
0049         IF(J.EQ.10.AND.KC.NE.0.AND.KQ.EQ.0) PYK=K(I,2)
0050         IF(J.EQ.11) PYK=KC
0051         IF(J.EQ.12) PYK=KQ*ISIGN(1,K(I,2))
0052  
0053 C...Heaviest flavour in hadron/diquark.
0054       ELSEIF(J.EQ.13) THEN
0055         KFA=IABS(K(I,2))
0056         PYK=MOD(KFA/100,10)*(-1)**MOD(KFA/100,10)
0057         IF(KFA.LT.10) PYK=KFA
0058         IF(MOD(KFA/1000,10).NE.0) PYK=MOD(KFA/1000,10)
0059         PYK=PYK*ISIGN(1,K(I,2))
0060  
0061 C...Particle history: generation, ancestor, rank.
0062       ELSEIF(J.LE.15) THEN
0063         I2=I
0064         I1=I
0065   110   PYK=PYK+1
0066         I2=I1
0067         I1=K(I1,3)
0068         IF(I1.GT.0) THEN
0069           IF(K(I1,1).GT.0.AND.K(I1,1).LE.20) GOTO 110
0070         ENDIF
0071         IF(J.EQ.15) PYK=I2
0072       ELSEIF(J.EQ.16) THEN
0073         KFA=IABS(K(I,2))
0074         IF(K(I,1).LE.20.AND.((KFA.GE.11.AND.KFA.LE.20).OR.KFA.EQ.22.OR.
0075      &  (KFA.GT.100.AND.MOD(KFA/10,10).NE.0))) THEN
0076           I1=I
0077   120     I2=I1
0078           I1=K(I1,3)
0079           IF(I1.GT.0) THEN
0080             KFAM=IABS(K(I1,2))
0081             ILP=1
0082             IF(KFAM.NE.0.AND.KFAM.LE.10) ILP=0
0083             IF(KFAM.EQ.21.OR.KFAM.EQ.91.OR.KFAM.EQ.92.OR.KFAM.EQ.93)
0084      &      ILP=0
0085             IF(KFAM.GT.100.AND.MOD(KFAM/10,10).EQ.0) ILP=0
0086             IF(ILP.EQ.1) GOTO 120
0087           ENDIF
0088           IF(K(I1,1).EQ.12) THEN
0089             DO 130 I3=I1+1,I2
0090               IF(K(I3,3).EQ.K(I2,3).AND.K(I3,2).NE.91.AND.K(I3,2).NE.92
0091      &        .AND.K(I3,2).NE.93) PYK=PYK+1
0092   130       CONTINUE
0093           ELSE
0094             I3=I2
0095   140       PYK=PYK+1
0096             I3=I3+1
0097             IF(I3.LT.N.AND.K(I3,3).EQ.K(I2,3)) GOTO 140
0098           ENDIF
0099         ENDIF
0100  
0101 C...Particle coming from collapsing jet system or not.
0102       ELSEIF(J.EQ.17) THEN
0103         I1=I
0104   150   PYK=PYK+1
0105         I3=I1
0106         I1=K(I1,3)
0107         I0=MAX(1,I1)
0108         KC=PYCOMP(K(I0,2))
0109         IF(I1.EQ.0.OR.K(I0,1).LE.0.OR.K(I0,1).GT.20.OR.KC.EQ.0) THEN
0110           IF(PYK.EQ.1) PYK=-1
0111           IF(PYK.GT.1) PYK=0
0112           RETURN
0113         ENDIF
0114         IF(KCHG(KC,2).EQ.0) GOTO 150
0115         IF(K(I1,1).NE.12) PYK=0
0116         IF(K(I1,1).NE.12) RETURN
0117         I2=I1
0118   160   I2=I2+1
0119         IF(I2.LT.N.AND.K(I2,1).NE.11) GOTO 160
0120         K3M=K(I3-1,3)
0121         IF(K3M.GE.I1.AND.K3M.LE.I2) PYK=0
0122         K3P=K(I3+1,3)
0123         IF(I3.LT.N.AND.K3P.GE.I1.AND.K3P.LE.I2) PYK=0
0124  
0125 C...Number of decay products. Colour flow.
0126       ELSEIF(J.EQ.18) THEN
0127         IF(K(I,1).EQ.11.OR.K(I,1).EQ.12) PYK=MAX(0,K(I,5)-K(I,4)+1)
0128         IF(K(I,4).EQ.0.OR.K(I,5).EQ.0) PYK=0
0129       ELSEIF(J.LE.22) THEN
0130         IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) RETURN
0131         IF(J.EQ.19) PYK=MOD(K(I,4)/MSTU(5),MSTU(5))
0132         IF(J.EQ.20) PYK=MOD(K(I,5)/MSTU(5),MSTU(5))
0133         IF(J.EQ.21) PYK=MOD(K(I,4),MSTU(5))
0134         IF(J.EQ.22) PYK=MOD(K(I,5),MSTU(5))
0135       ELSE
0136       ENDIF
0137  
0138       RETURN
0139       END