PYTHIA/jetset/luhepc.F

   1
   2 C*********************************************************************
   3
   4       SUBROUTINE LUHEPC(MCONV)
   5
   6 C...Purpose: to convert JETSET event record contents to or from
   7 C...the standard event record commonblock.
   8 C...Note that HEPEVT is in double precision according to LEP 2 standard.
   9       PARAMETER (NMXHEP=2000)
  10       COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP),
  11      &JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP)
  12       DOUBLE PRECISION PHEP,VHEP
  13       COMMON/LUJETS/N,K(4000,5),P(4000,5),V(4000,5)
  14       COMMON/LUDAT1/MSTU(200),PARU(200),MSTJ(200),PARJ(200)
  15       COMMON/LUDAT2/KCHG(500,3),PMAS(500,4),PARF(2000),VCKM(4,4)
  16       SAVE /HEPEVT/
  17       SAVE /LUJETS/,/LUDAT1/,/LUDAT2/
  18
  19 C...Conversion from JETSET to standard, the easy part.
  20       IF(MCONV.EQ.1) THEN
  21         NEVHEP=0
  22         IF(N.GT.NMXHEP) CALL LUERRM(8,
  23      &  '(LUHEPC:) no more space in /HEPEVT/')
  24         NHEP=MIN(N,NMXHEP)
  25         DO 140 I=1,NHEP
  26         ISTHEP(I)=0
  27         IF(K(I,1).GE.1.AND.K(I,1).LE.10) ISTHEP(I)=1
  28         IF(K(I,1).GE.11.AND.K(I,1).LE.20) ISTHEP(I)=2
  29         IF(K(I,1).GE.21.AND.K(I,1).LE.30) ISTHEP(I)=3
  30         IF(K(I,1).GE.31.AND.K(I,1).LE.100) ISTHEP(I)=K(I,1)
  31         IDHEP(I)=K(I,2)
  32         JMOHEP(1,I)=K(I,3)
  33         JMOHEP(2,I)=0
  34         IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) THEN
  35           JDAHEP(1,I)=K(I,4)
  36           JDAHEP(2,I)=K(I,5)
  37         ELSE
  38           JDAHEP(1,I)=0
  39           JDAHEP(2,I)=0
  40         ENDIF
  41         DO 100 J=1,5
  42         PHEP(J,I)=P(I,J)
  43   100   CONTINUE
  44         DO 110 J=1,4
  45         VHEP(J,I)=V(I,J)
  46   110   CONTINUE
  47
  48 C...Check if new event (from pileup).
  49         IF(I.EQ.1) THEN
  50           INEW=1
  51         ELSE
  52           IF(K(I,1).EQ.21.AND.K(I-1,1).NE.21) INEW=I
  53         ENDIF
  54
  55 C...Fill in missing mother information.
  56         IF(I.GE.INEW+2.AND.K(I,1).EQ.21.AND.K(I,3).EQ.0) THEN
  57           IMO1=I-2
  58           IF(I.GE.INEW+3.AND.K(I-1,1).EQ.21.AND.K(I-1,3).EQ.0)
  59      &    IMO1=IMO1-1
  60           JMOHEP(1,I)=IMO1
  61           JMOHEP(2,I)=IMO1+1
  62         ELSEIF(K(I,2).GE.91.AND.K(I,2).LE.93) THEN
  63           I1=K(I,3)-1
  64   120     I1=I1+1
  65           IF(I1.GE.I) CALL LUERRM(8,
  66      &    '(LUHEPC:) translation of inconsistent event history')
  67           IF(I1.LT.I.AND.K(I1,1).NE.1.AND.K(I1,1).NE.11) GOTO 120
  68           KC=LUCOMP(K(I1,2))
  69           IF(I1.LT.I.AND.KC.EQ.0) GOTO 120
  70           IF(I1.LT.I.AND.KCHG(KC,2).EQ.0) GOTO 120
  71           JMOHEP(2,I)=I1
  72         ELSEIF(K(I,2).EQ.94) THEN
  73           NJET=2
  74           IF(NHEP.GE.I+3.AND.K(I+3,3).LE.I) NJET=3
  75           IF(NHEP.GE.I+4.AND.K(I+4,3).LE.I) NJET=4
  76           JMOHEP(2,I)=MOD(K(I+NJET,4)/MSTU(5),MSTU(5))
  77           IF(JMOHEP(2,I).EQ.JMOHEP(1,I)) JMOHEP(2,I)=
  78      &    MOD(K(I+1,4)/MSTU(5),MSTU(5))
  79         ENDIF
  80
  81 C...Fill in missing daughter information.
  82         IF(K(I,2).EQ.94.AND.MSTU(16).NE.2) THEN
  83           DO 130 I1=JDAHEP(1,I),JDAHEP(2,I)
  84           I2=MOD(K(I1,4)/MSTU(5),MSTU(5))
  85           JDAHEP(1,I2)=I
  86   130     CONTINUE
  87         ENDIF
  88         IF(K(I,2).GE.91.AND.K(I,2).LE.94) GOTO 140
  89         I1=JMOHEP(1,I)
  90         IF(I1.LE.0.OR.I1.GT.NHEP) GOTO 140
  91         IF(K(I1,1).NE.13.AND.K(I1,1).NE.14) GOTO 140
  92         IF(JDAHEP(1,I1).EQ.0) THEN
  93           JDAHEP(1,I1)=I
  94         ELSE
  95           JDAHEP(2,I1)=I
  96         ENDIF
  97   140   CONTINUE
  98         DO 150 I=1,NHEP
  99         IF(K(I,1).NE.13.AND.K(I,1).NE.14) GOTO 150
 100         IF(JDAHEP(2,I).EQ.0) JDAHEP(2,I)=JDAHEP(1,I)
 101   150   CONTINUE
 102
 103 C...Conversion from standard to JETSET, the easy part.
 104       ELSE
 105         IF(NHEP.GT.MSTU(4)) CALL LUERRM(8,
 106      &  '(LUHEPC:) no more space in /LUJETS/')
 107         N=MIN(NHEP,MSTU(4))
 108         NKQ=0
 109         KQSUM=0
 110         DO 180 I=1,N
 111         K(I,1)=0
 112         IF(ISTHEP(I).EQ.1) K(I,1)=1
 113         IF(ISTHEP(I).EQ.2) K(I,1)=11
 114         IF(ISTHEP(I).EQ.3) K(I,1)=21
 115         K(I,2)=IDHEP(I)
 116         K(I,3)=JMOHEP(1,I)
 117         K(I,4)=JDAHEP(1,I)
 118         K(I,5)=JDAHEP(2,I)
 119         DO 160 J=1,5
 120         P(I,J)=PHEP(J,I)
 121   160   CONTINUE
 122         DO 170 J=1,4
 123         V(I,J)=VHEP(J,I)
 124   170   CONTINUE
 125         V(I,5)=0.
 126         IF(ISTHEP(I).EQ.2.AND.PHEP(4,I).GT.PHEP(5,I)) THEN
 127           I1=JDAHEP(1,I)
 128           IF(I1.GT.0.AND.I1.LE.NHEP) V(I,5)=(VHEP(4,I1)-VHEP(4,I))*
 129      &    PHEP(5,I)/PHEP(4,I)
 130         ENDIF
 131
 132 C...Fill in missing information on colour connection in jet systems.
 133         IF(ISTHEP(I).EQ.1) THEN
 134           KC=LUCOMP(K(I,2))
 135           KQ=0
 136           IF(KC.NE.0) KQ=KCHG(KC,2)*ISIGN(1,K(I,2))
 137           IF(KQ.NE.0) NKQ=NKQ+1
 138           IF(KQ.NE.2) KQSUM=KQSUM+KQ
 139           IF(KQ.NE.0.AND.KQSUM.NE.0) THEN
 140             K(I,1)=2
 141           ELSEIF(KQ.EQ.2.AND.I.LT.N) THEN
 142             IF(K(I+1,2).EQ.21) K(I,1)=2
 143           ENDIF
 144         ENDIF
 145   180   CONTINUE
 146         IF(NKQ.EQ.1.OR.KQSUM.NE.0) CALL LUERRM(8,
 147      &  '(LUHEPC:) input parton configuration not colour singlet')
 148       ENDIF
 149
 150       END