Pythia6Interface/src/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 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 init variable(s)
0030       inew = 1
0031
0032 C...Conversion from PYTHIA to standard, the easy part.
0033       IF(MCONV.EQ.1) THEN
0034         NEVHEP=0
0035         IF(N.GT.NMXHEP) CALL PYERRM(8,
0036      &  '(PYHEPC:) no more space in /HEPEVT/')
0037         NHEP=MIN(N,NMXHEP)
0038         DO 150 I=1,NHEP
0039           ISTHEP(I)=0
0040           IF(K(I,1).GE.1.AND.K(I,1).LE.10) ISTHEP(I)=1
0041           IF(K(I,1).GE.11.AND.K(I,1).LE.20) ISTHEP(I)=2
0042           IF(K(I,1).GE.21.AND.K(I,1).LE.30) ISTHEP(I)=3
0043           IF(K(I,1).GE.31.AND.K(I,1).LE.100) ISTHEP(I)=K(I,1)
0044           IDHEP(I)=K(I,2)
0045           JMOHEP(1,I)=K(I,3)
0046           JMOHEP(2,I)=0
0047           IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) THEN
0048             JDAHEP(1,I)=K(I,4)
0049             JDAHEP(2,I)=K(I,5)
0050           ELSE
0051             JDAHEP(1,I)=0
0052             JDAHEP(2,I)=0
0053           ENDIF
0054           DO 100 J=1,5
0055             PHEP(J,I)=P(I,J)
0056   100     CONTINUE
0057           DO 110 J=1,4
0058             VHEP(J,I)=V(I,J)
0059   110     CONTINUE
0060
0061 C...Check if new event (from pileup).
0062           IF(I.EQ.1) THEN
0063             INEW=1
0064           ELSE
0065             IF(K(I,1).EQ.21.AND.K(I-1,1).NE.21) INEW=I
0066           ENDIF
0067
0068 C...Fill in missing mother information.
0069           IF(I.GE.INEW+2.AND.K(I,1).EQ.21.AND.K(I,3).EQ.0) THEN
0070             IMO1=I-2
0071   120       IF(IMO1.GT.INEW.AND.K(IMO1+1,1).EQ.21.AND.K(IMO1+1,3).EQ.0)
0072      &      THEN
0073               IMO1=IMO1-1
0074               GOTO 120
0075             ENDIF
0076             JMOHEP(1,I)=IMO1
0077             JMOHEP(2,I)=IMO1+1
0078           ELSEIF(K(I,2).GE.91.AND.K(I,2).LE.93) THEN
0079             I1=K(I,3)-1
0080   130       I1=I1+1
0081             IF(I1.GE.I) CALL PYERRM(8,
0082      &      '(PYHEPC:) translation of inconsistent event history')
0083             IF(I1.LT.I.AND.K(I1,1).NE.1.AND.K(I1,1).NE.11) GOTO 130
0084             KC=PYCOMP(K(I1,2))
0085             IF(I1.LT.I.AND.KC.EQ.0) GOTO 130
0086             IF(I1.LT.I.AND.KCHG(KC,2).EQ.0) GOTO 130
0087             JMOHEP(2,I)=I1
0088           ELSEIF(K(I,2).EQ.94) THEN
0089             NJET=2
0090             IF(NHEP.GE.I+3.AND.K(I+3,3).LE.I) NJET=3
0091             IF(NHEP.GE.I+4.AND.K(I+4,3).LE.I) NJET=4
0092             JMOHEP(2,I)=MOD(K(I+NJET,4)/MSTU(5),MSTU(5))
0093             IF(JMOHEP(2,I).EQ.JMOHEP(1,I)) JMOHEP(2,I)=
0094      &      MOD(K(I+1,4)/MSTU(5),MSTU(5))
0095           ENDIF
0096
0097 C...Fill in missing daughter information.
0098           IF(K(I,2).EQ.94.AND.MSTU(16).NE.2) THEN
0099             DO 140 I1=JDAHEP(1,I),JDAHEP(2,I)
0100               I2=MOD(K(I1,4)/MSTU(5),MSTU(5))
0101               JDAHEP(1,I2)=I
0102   140       CONTINUE
0103           ENDIF
0104           IF(K(I,2).GE.91.AND.K(I,2).LE.94) GOTO 150
0105           I1=JMOHEP(1,I)
0106           IF(I1.LE.0.OR.I1.GT.NHEP) GOTO 150
0107           IF(K(I1,1).NE.13.AND.K(I1,1).NE.14) GOTO 150
0108           IF(JDAHEP(1,I1).EQ.0) THEN
0109             JDAHEP(1,I1)=I
0110           ELSE
0111             JDAHEP(2,I1)=I
0112           ENDIF
0113   150   CONTINUE
0114         DO 160 I=1,NHEP
0115           IF(K(I,1).NE.13.AND.K(I,1).NE.14) GOTO 160
0116           IF(JDAHEP(2,I).EQ.0) JDAHEP(2,I)=JDAHEP(1,I)
0117   160   CONTINUE
0118
0119 C...Conversion from standard to PYTHIA, the easy part.
0120       ELSE
0121         IF(NHEP.GT.MSTU(4)) CALL PYERRM(8,
0122      &  '(PYHEPC:) no more space in /PYJETS/')
0123         N=MIN(NHEP,MSTU(4))
0124         NKQ=0
0125         KQSUM=0
0126         DO 190 I=1,N
0127           K(I,1)=0
0128           IF(ISTHEP(I).EQ.1) K(I,1)=1
0129           IF(ISTHEP(I).EQ.2) THEN
0130              K(I,1)=11
0131              IF(K(I,4).GT.0.AND.(K(I,4).EQ.K(I,5)).AND.
0132      $ (K(K(I,4),2).GE.91.AND.K(K(I,4),2).LE.93).AND.
0133      $ (I.LT.N).AND.(K(I,4).EQ.K(I+1,4))) K(I,1)=12
0134           ENDIF
0135           IF(ISTHEP(I).EQ.3) K(I,1)=21
0136           K(I,2)=IDHEP(I)
0137           K(I,3)=JMOHEP(1,I)
0138           K(I,4)=JDAHEP(1,I)
0139           K(I,5)=JDAHEP(2,I)
0140           DO 170 J=1,5
0141             P(I,J)=PHEP(J,I)
0142   170     CONTINUE
0143           DO 180 J=1,4
0144             V(I,J)=VHEP(J,I)
0145   180     CONTINUE
0146           V(I,5)=0D0
0147           IF(ISTHEP(I).EQ.2.AND.PHEP(4,I).GT.PHEP(5,I)) THEN
0148             I1=JDAHEP(1,I)
0149             IF(I1.GT.0.AND.I1.LE.NHEP) V(I,5)=(VHEP(4,I1)-VHEP(4,I))*
0150      &      PHEP(5,I)/PHEP(4,I)
0151           ENDIF
0152
0153 C...Fill in missing information on colour connection in jet systems.
0154           IF(ISTHEP(I).EQ.1) THEN
0155             KC=PYCOMP(K(I,2))
0156             KQ=0
0157             IF(KC.NE.0) KQ=KCHG(KC,2)*ISIGN(1,K(I,2))
0158             IF(KQ.NE.0) NKQ=NKQ+1
0159             IF(KQ.NE.2) KQSUM=KQSUM+KQ
0160             IF(KQ.NE.0.AND.KQSUM.NE.0) THEN
0161               K(I,1)=2
0162             ELSEIF(KQ.EQ.2.AND.I.LT.N) THEN
0163               IF(K(I+1,2).EQ.21) K(I,1)=2
0164             ENDIF
0165           ENDIF
0166   190   CONTINUE
0167         IF(NKQ.EQ.1.OR.KQSUM.NE.0) CALL PYERRM(8,
0168      &  '(PYHEPC:) input parton configuration not colour singlet')
0169       ENDIF
0170
0171       END