pythiaeRHIC/pythia/pyhepc.f

0001
0002 C*********************************************************************
0003
0004 C...PYHEPC
0005 C...Converts PYTHIA event record contents to or from
0006 C...the standard event record commonblock.
0007
0008       SUBROUTINE PYHEPC(MCONV)
0009
0010 C...Double precision and integer declarations.
0011       IMPLICIT DOUBLE PRECISION(A-H, O-Z)
0012       IMPLICIT INTEGER(I-N)
0013       INTEGER PYK,PYCHGE,PYCOMP
0014 C...Commonblocks.
0015       COMMON/PYJETS/N,NPAD,K(4000,5),P(4000,5),V(4000,5)
0016       COMMON/PYDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0017       COMMON/PYDAT2/KCHG(500,4),PMAS(500,4),PARF(2000),VCKM(4,4)
0018       SAVE /PYJETS/,/PYDAT1/,/PYDAT2/
0019 C...HEPEVT commonblock.
0020       PARAMETER (NMXHEP=4000)
0021       COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP),
0022      &JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP)
0023       DOUBLE PRECISION PHEP,VHEP
0024       SAVE /HEPEVT/
0025
0026 C...Store HEPEVT commonblock size (for interfacing issues).
0027       MSTU(8)=NMXHEP
0028
0029 C...Conversion from PYTHIA to standard, the easy part.
0030       IF(MCONV.EQ.1) THEN
0031         NEVHEP=0
0032         IF(N.GT.NMXHEP) CALL PYERRM(8,
0033      &  '(PYHEPC:) no more space in /HEPEVT/')
0034         NHEP=MIN(N,NMXHEP)
0035         DO 150 I=1,NHEP
0036           ISTHEP(I)=0
0037           IF(K(I,1).GE.1.AND.K(I,1).LE.10) ISTHEP(I)=1
0038           IF(K(I,1).GE.11.AND.K(I,1).LE.20) ISTHEP(I)=2
0039           IF(K(I,1).GE.21.AND.K(I,1).LE.30) ISTHEP(I)=3
0040           IF(K(I,1).GE.31.AND.K(I,1).LE.100) ISTHEP(I)=K(I,1)
0041           IDHEP(I)=K(I,2)
0042           JMOHEP(1,I)=K(I,3)
0043           JMOHEP(2,I)=0
0044           IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) THEN
0045             JDAHEP(1,I)=K(I,4)
0046             JDAHEP(2,I)=K(I,5)
0047           ELSE
0048             JDAHEP(1,I)=0
0049             JDAHEP(2,I)=0
0050           ENDIF
0051           DO 100 J=1,5
0052             PHEP(J,I)=P(I,J)
0053   100     CONTINUE
0054           DO 110 J=1,4
0055             VHEP(J,I)=V(I,J)
0056   110     CONTINUE
0057
0058 C...Check if new event (from pileup).
0059           IF(I.EQ.1) THEN
0060             INEW=1
0061           ELSE
0062             IF(K(I,1).EQ.21.AND.K(I-1,1).NE.21) INEW=I
0063           ENDIF
0064
0065 C...Fill in missing mother information.
0066           IF(I.GE.INEW+2.AND.K(I,1).EQ.21.AND.K(I,3).EQ.0) THEN
0067             IMO1=I-2
0068   120       IF(IMO1.GT.INEW.AND.K(IMO1+1,1).EQ.21.AND.K(IMO1+1,3).EQ.0)
0069      &      THEN
0070               IMO1=IMO1-1
0071               GOTO 120
0072             ENDIF
0073             JMOHEP(1,I)=IMO1
0074             JMOHEP(2,I)=IMO1+1
0075           ELSEIF(K(I,2).GE.91.AND.K(I,2).LE.93) THEN
0076             I1=K(I,3)-1
0077   130       I1=I1+1
0078             IF(I1.GE.I) CALL PYERRM(8,
0079      &      '(PYHEPC:) translation of inconsistent event history')
0080             IF(I1.LT.I.AND.K(I1,1).NE.1.AND.K(I1,1).NE.11) GOTO 130
0081             KC=PYCOMP(K(I1,2))
0082             IF(I1.LT.I.AND.KC.EQ.0) GOTO 130
0083             IF(I1.LT.I.AND.KCHG(KC,2).EQ.0) GOTO 130
0084             JMOHEP(2,I)=I1
0085           ELSEIF(K(I,2).EQ.94) THEN
0086             NJET=2
0087             IF(NHEP.GE.I+3.AND.K(I+3,3).LE.I) NJET=3
0088             IF(NHEP.GE.I+4.AND.K(I+4,3).LE.I) NJET=4
0089             JMOHEP(2,I)=MOD(K(I+NJET,4)/MSTU(5),MSTU(5))
0090             IF(JMOHEP(2,I).EQ.JMOHEP(1,I)) JMOHEP(2,I)=
0091      &      MOD(K(I+1,4)/MSTU(5),MSTU(5))
0092           ENDIF
0093
0094 C...Fill in missing daughter information.
0095           IF(K(I,2).EQ.94.AND.MSTU(16).NE.2) THEN
0096             DO 140 I1=JDAHEP(1,I),JDAHEP(2,I)
0097               I2=MOD(K(I1,4)/MSTU(5),MSTU(5))
0098               JDAHEP(1,I2)=I
0099   140       CONTINUE
0100           ENDIF
0101           IF(K(I,2).GE.91.AND.K(I,2).LE.94) GOTO 150
0102           I1=JMOHEP(1,I)
0103           IF(I1.LE.0.OR.I1.GT.NHEP) GOTO 150
0104           IF(K(I1,1).NE.13.AND.K(I1,1).NE.14) GOTO 150
0105           IF(JDAHEP(1,I1).EQ.0) THEN
0106             JDAHEP(1,I1)=I
0107           ELSE
0108             JDAHEP(2,I1)=I
0109           ENDIF
0110   150   CONTINUE
0111         DO 160 I=1,NHEP
0112           IF(K(I,1).NE.13.AND.K(I,1).NE.14) GOTO 160
0113           IF(JDAHEP(2,I).EQ.0) JDAHEP(2,I)=JDAHEP(1,I)
0114   160   CONTINUE
0115
0116 C...Conversion from standard to PYTHIA, the easy part.
0117       ELSE
0118         IF(NHEP.GT.MSTU(4)) CALL PYERRM(8,
0119      &  '(PYHEPC:) no more space in /PYJETS/')
0120         N=MIN(NHEP,MSTU(4))
0121         NKQ=0
0122         KQSUM=0
0123         DO 190 I=1,N
0124           K(I,1)=0
0125           IF(ISTHEP(I).EQ.1) K(I,1)=1
0126           IF(ISTHEP(I).EQ.2) K(I,1)=11
0127           IF(ISTHEP(I).EQ.3) K(I,1)=21
0128           K(I,2)=IDHEP(I)
0129           K(I,3)=JMOHEP(1,I)
0130           K(I,4)=JDAHEP(1,I)
0131           K(I,5)=JDAHEP(2,I)
0132           DO 170 J=1,5
0133             P(I,J)=PHEP(J,I)
0134   170     CONTINUE
0135           DO 180 J=1,4
0136             V(I,J)=VHEP(J,I)
0137   180     CONTINUE
0138           V(I,5)=0D0
0139           IF(ISTHEP(I).EQ.2.AND.PHEP(4,I).GT.PHEP(5,I)) THEN
0140             I1=JDAHEP(1,I)
0141             IF(I1.GT.0.AND.I1.LE.NHEP) V(I,5)=(VHEP(4,I1)-VHEP(4,I))*
0142      &      PHEP(5,I)/PHEP(4,I)
0143           ENDIF
0144
0145 C...Fill in missing information on colour connection in jet systems.
0146           IF(ISTHEP(I).EQ.1) THEN
0147             KC=PYCOMP(K(I,2))
0148             KQ=0
0149             IF(KC.NE.0) KQ=KCHG(KC,2)*ISIGN(1,K(I,2))
0150             IF(KQ.NE.0) NKQ=NKQ+1
0151             IF(KQ.NE.2) KQSUM=KQSUM+KQ
0152             IF(KQ.NE.0.AND.KQSUM.NE.0) THEN
0153               K(I,1)=2
0154             ELSEIF(KQ.EQ.2.AND.I.LT.N) THEN
0155               IF(K(I+1,2).EQ.21) K(I,1)=2
0156             ENDIF
0157           ENDIF
0158   190   CONTINUE
0159         IF(NKQ.EQ.1.OR.KQSUM.NE.0) CALL PYERRM(8,
0160      &  '(PYHEPC:) input parton configuration not colour singlet')
0161       ENDIF
0162
0163       END