hijing/src/luhepc.f

0001
0002 C*********************************************************************
0003
0004       SUBROUTINE LUHEPC(MCONV)
0005
0006 C...Purpose: to convert JETSET event record contents to or from
0007 C...the standard event record commonblock.
0008       PARAMETER (NMXHEP=10000)
0009       COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP),
0010      &JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP)
0011       DOUBLE PRECISION PHEP,VHEP
0012       SAVE /HEPEVT/
0013       COMMON/LUJETS/N,K(9000,5),P(9000,5),V(9000,5)
0014       SAVE /LUJETS/
0015       COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
0016       SAVE /LUDAT1/
0017       COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
0018       SAVE /LUDAT2/
0019
0020 C...Conversion from JETSET to standard, the easy part.
0021       IF(MCONV.EQ.1) THEN
0022         NEVHEP=0
0023         IF(N.GT.NMXHEP) CALL LUERRM(8,
0024      &  '(LUHEPC:) no more space in /HEPEVT/')
0025         NHEP=MIN(N,NMXHEP)
0026         DO 140 I=1,NHEP
0027         ISTHEP(I)=0
0028         IF(K(I,1).GE.1.AND.K(I,1).LE.10) ISTHEP(I)=1
0029         IF(K(I,1).GE.11.AND.K(I,1).LE.20) ISTHEP(I)=2
0030         IF(K(I,1).GE.21.AND.K(I,1).LE.30) ISTHEP(I)=3
0031         IF(K(I,1).GE.31.AND.K(I,1).LE.100) ISTHEP(I)=K(I,1)
0032         IDHEP(I)=K(I,2)
0033         JMOHEP(1,I)=K(I,3)
0034         JMOHEP(2,I)=0
0035         IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) THEN
0036           JDAHEP(1,I)=K(I,4)
0037           JDAHEP(2,I)=K(I,5)
0038         ELSE
0039           JDAHEP(1,I)=0
0040           JDAHEP(2,I)=0
0041         ENDIF
0042         DO 100 J=1,5
0043   100   PHEP(J,I)=P(I,J)
0044         DO 110 J=1,4
0045   110   VHEP(J,I)=V(I,J)
0046
0047 C...Fill in missing mother information.
0048         IF(K(I,2).GE.91.AND.K(I,2).LE.93) THEN
0049           I1=K(I,3)-1
0050   120     I1=I1+1
0051           IF(I1.GE.I) CALL LUERRM(8,
0052      &    '(LUHEPC:) translation of inconsistent event history')
0053           IF(I1.LT.I.AND.K(I1,1).NE.1.AND.K(I1,1).NE.11) GOTO 120
0054           KC=LUCOMP(K(I1,2))
0055           IF(I1.LT.I.AND.KC.EQ.0) GOTO 120
0056           IF(I1.LT.I.AND.KCHG(KC,2).EQ.0) GOTO 120
0057           JMOHEP(2,I)=I1
0058         ELSEIF(K(I,2).EQ.94) THEN
0059           NJET=2
0060           IF(NHEP.GE.I+3.AND.K(I+3,3).LE.I) NJET=3
0061           IF(NHEP.GE.I+4.AND.K(I+4,3).LE.I) NJET=4
0062           JMOHEP(2,I)=MOD(K(I+NJET,4)/MSTU(5),MSTU(5))
0063           IF(JMOHEP(2,I).EQ.JMOHEP(1,I)) JMOHEP(2,I)=
0064      &    MOD(K(I+1,4)/MSTU(5),MSTU(5))
0065         ENDIF
0066
0067 C...Fill in missing daughter information.
0068         IF(K(I,2).EQ.94.AND.MSTU(16).NE.2) THEN
0069           DO 130 I1=JDAHEP(1,I),JDAHEP(2,I)
0070           I2=MOD(K(I1,4)/MSTU(5),MSTU(5))
0071   130     JDAHEP(1,I2)=I
0072         ENDIF
0073         IF(K(I,2).GE.91.AND.K(I,2).LE.94) GOTO 140
0074         I1=JMOHEP(1,I)
0075         IF(I1.LE.0.OR.I1.GT.NHEP) GOTO 140
0076         IF(K(I1,1).NE.13.AND.K(I1,1).NE.14) GOTO 140
0077         IF(JDAHEP(1,I1).EQ.0) THEN
0078           JDAHEP(1,I1)=I
0079         ELSE
0080           JDAHEP(2,I1)=I
0081         ENDIF
0082   140   CONTINUE
0083         DO 150 I=1,NHEP
0084         IF(K(I,1).NE.13.AND.K(I,1).NE.14) GOTO 150
0085         IF(JDAHEP(2,I).EQ.0) JDAHEP(2,I)=JDAHEP(1,I)
0086   150   CONTINUE
0087
0088 C...Conversion from standard to JETSET, the easy part.
0089       ELSE
0090         IF(NHEP.GT.MSTU(4)) CALL LUERRM(8,
0091      &  '(LUHEPC:) no more space in /LUJETS/')
0092         N=MIN(NHEP,MSTU(4))
0093         NKQ=0
0094         KQSUM=0
0095         DO 180 I=1,N
0096         K(I,1)=0
0097         IF(ISTHEP(I).EQ.1) K(I,1)=1
0098         IF(ISTHEP(I).EQ.2) K(I,1)=11
0099         IF(ISTHEP(I).EQ.3) K(I,1)=21
0100         K(I,2)=IDHEP(I)
0101         K(I,3)=JMOHEP(1,I)
0102         K(I,4)=JDAHEP(1,I)
0103         K(I,5)=JDAHEP(2,I)
0104         DO 160 J=1,5
0105   160   P(I,J)=PHEP(J,I)
0106         DO 170 J=1,4
0107   170   V(I,J)=VHEP(J,I)
0108         V(I,5)=0.
0109         IF(ISTHEP(I).EQ.2.AND.PHEP(4,I).GT.PHEP(5,I)) THEN
0110           I1=JDAHEP(1,I)
0111           IF(I1.GT.0.AND.I1.LE.NHEP) V(I,5)=(VHEP(4,I1)-VHEP(4,I))*
0112      &    PHEP(5,I)/PHEP(4,I)
0113         ENDIF
0114
0115 C...Fill in missing information on colour connection in jet systems.
0116         IF(ISTHEP(I).EQ.1) THEN
0117           KC=LUCOMP(K(I,2))
0118           KQ=0
0119           IF(KC.NE.0) KQ=KCHG(KC,2)*ISIGN(1,K(I,2))
0120           IF(KQ.NE.0) NKQ=NKQ+1
0121           IF(KQ.NE.2) KQSUM=KQSUM+KQ
0122           IF(KQ.NE.0.AND.KQSUM.NE.0) THEN
0123             K(I,1)=2
0124           ELSEIF(KQ.EQ.2.AND.I.LT.N) THEN
0125             IF(K(I+1,2).EQ.21) K(I,1)=2
0126           ENDIF
0127         ENDIF
0128   180   CONTINUE
0129         IF(NKQ.EQ.1.OR.KQSUM.NE.0) CALL LUERRM(8,
0130      &  '(LUHEPC:) input parton configuration not colour singlet')
0131       ENDIF
0132
0133       END