HIJING/hipyset1_35/luhepc_hijing.F

   1 * $Id$
   2
   3 C*********************************************************************
   4
   5       SUBROUTINE LUHEPC_HIJING(MCONV)
   6
   7 C...Purpose: to convert JETSET event record contents to or from
   8 C...the standard event record commonblock.
   9 #include "hepevt_hijing.inc"
  10 #include "lujets_hijing.inc"
  11 #include "ludat1_hijing.inc"
  12 #include "ludat2_hijing.inc"
  13
  14 C...Conversion from JETSET to standard, the easy part.
  15       IF(MCONV.EQ.1) THEN
  16         NEVHEP=0
  17         IF(N.GT.NMXHEP) CALL LUERRM_HIJING(8,
  18      &  '(LUHEPC_HIJING:) no more space in /HEPEVT_HIJING/')
  19         NHEP=MIN(N,NMXHEP)
  20         DO 140 I=1,NHEP
  21         ISTHEP(I)=0
  22         IF(K(I,1).GE.1.AND.K(I,1).LE.10) ISTHEP(I)=1
  23         IF(K(I,1).GE.11.AND.K(I,1).LE.20) ISTHEP(I)=2
  24         IF(K(I,1).GE.21.AND.K(I,1).LE.30) ISTHEP(I)=3
  25         IF(K(I,1).GE.31.AND.K(I,1).LE.100) ISTHEP(I)=K(I,1)
  26         IDHEP(I)=K(I,2)
  27         JMOHEP(1,I)=K(I,3)
  28         JMOHEP(2,I)=0
  29         IF(K(I,1).NE.3.AND.K(I,1).NE.13.AND.K(I,1).NE.14) THEN
  30           JDAHEP(1,I)=K(I,4)
  31           JDAHEP(2,I)=K(I,5)
  32         ELSE
  33           JDAHEP(1,I)=0
  34           JDAHEP(2,I)=0
  35         ENDIF
  36         DO 100 J=1,5
  37   100   PHEP(J,I)=P(I,J)
  38         DO 110 J=1,4
  39   110   VHEP(J,I)=V(I,J)
  40
  41 C...Fill in missing mother information.
  42         IF(K(I,2).GE.91.AND.K(I,2).LE.93) THEN
  43           I1=K(I,3)-1
  44   120     I1=I1+1
  45           IF(I1.GE.I) CALL LUERRM_HIJING(8,
  46      &    '(LUHEPC_HIJING:) translation of inconsistent event history')
  47           IF(I1.LT.I.AND.K(I1,1).NE.1.AND.K(I1,1).NE.11) GOTO 120
  48           KC=LUCOMP_HIJING(K(I1,2))
  49           IF(I1.LT.I.AND.KC.EQ.0) GOTO 120
  50           IF(I1.LT.I.AND.KCHG(KC,2).EQ.0) GOTO 120
  51           JMOHEP(2,I)=I1
  52         ELSEIF(K(I,2).EQ.94) THEN
  53           NJET=2
  54           IF(NHEP.GE.I+3.AND.K(I+3,3).LE.I) NJET=3
  55           IF(NHEP.GE.I+4.AND.K(I+4,3).LE.I) NJET=4
  56           JMOHEP(2,I)=MOD(K(I+NJET,4)/MSTU(5),MSTU(5))
  57           IF(JMOHEP(2,I).EQ.JMOHEP(1,I)) JMOHEP(2,I)=
  58      &    MOD(K(I+1,4)/MSTU(5),MSTU(5))
  59         ENDIF
  60
  61 C...Fill in missing daughter information.
  62         IF(K(I,2).EQ.94.AND.MSTU(16).NE.2) THEN
  63           DO 130 I1=JDAHEP(1,I),JDAHEP(2,I)
  64           I2=MOD(K(I1,4)/MSTU(5),MSTU(5))
  65   130     JDAHEP(1,I2)=I
  66         ENDIF
  67         IF(K(I,2).GE.91.AND.K(I,2).LE.94) GOTO 140
  68         I1=JMOHEP(1,I)
  69         IF(I1.LE.0.OR.I1.GT.NHEP) GOTO 140
  70         IF(K(I1,1).NE.13.AND.K(I1,1).NE.14) GOTO 140
  71         IF(JDAHEP(1,I1).EQ.0) THEN
  72           JDAHEP(1,I1)=I
  73         ELSE
  74           JDAHEP(2,I1)=I
  75         ENDIF
  76   140   CONTINUE
  77         DO 150 I=1,NHEP
  78         IF(K(I,1).NE.13.AND.K(I,1).NE.14) GOTO 150
  79         IF(JDAHEP(2,I).EQ.0) JDAHEP(2,I)=JDAHEP(1,I)
  80   150   CONTINUE
  81
  82 C...Conversion from standard to JETSET, the easy part.
  83       ELSE
  84         IF(NHEP.GT.MSTU(4)) CALL LUERRM_HIJING(8,
  85      &  '(LUHEPC_HIJING:) no more space in /LUJETS_HIJING/')
  86         N=MIN(NHEP,MSTU(4))
  87         NKQ=0
  88         KQSUM=0
  89         DO 180 I=1,N
  90         K(I,1)=0
  91         IF(ISTHEP(I).EQ.1) K(I,1)=1
  92         IF(ISTHEP(I).EQ.2) K(I,1)=11
  93         IF(ISTHEP(I).EQ.3) K(I,1)=21
  94         K(I,2)=IDHEP(I)
  95         K(I,3)=JMOHEP(1,I)
  96         K(I,4)=JDAHEP(1,I)
  97         K(I,5)=JDAHEP(2,I)
  98         DO 160 J=1,5
  99   160   P(I,J)=PHEP(J,I)
 100         DO 170 J=1,4
 101   170   V(I,J)=VHEP(J,I)
 102         V(I,5)=0.
 103         IF(ISTHEP(I).EQ.2.AND.PHEP(4,I).GT.PHEP(5,I)) THEN
 104           I1=JDAHEP(1,I)
 105           IF(I1.GT.0.AND.I1.LE.NHEP) V(I,5)=(VHEP(4,I1)-VHEP(4,I))*
 106      &    PHEP(5,I)/PHEP(4,I)
 107         ENDIF
 108
 109 C...Fill in missing information on colour connection in jet systems.
 110         IF(ISTHEP(I).EQ.1) THEN
 111           KC=LUCOMP_HIJING(K(I,2))
 112           KQ=0
 113           IF(KC.NE.0) KQ=KCHG(KC,2)*ISIGN(1,K(I,2))
 114           IF(KQ.NE.0) NKQ=NKQ+1
 115           IF(KQ.NE.2) KQSUM=KQSUM+KQ
 116           IF(KQ.NE.0.AND.KQSUM.NE.0) THEN
 117             K(I,1)=2
 118           ELSEIF(KQ.EQ.2.AND.I.LT.N) THEN
 119             IF(K(I+1,2).EQ.21) K(I,1)=2
 120           ENDIF
 121         ENDIF
 122   180   CONTINUE
 123         IF(NKQ.EQ.1.OR.KQSUM.NE.0) CALL LUERRM_HIJING(8,
 124      &       '(LUHEPC_HIJING:) input parton configuration '/
 125      $       /'not colour singlet')
 126       ENDIF
 127
 128       END