Update to 6.5-10
authormorsch <morsch@f7af4fe6-9843-0410-8265-dc069ae4e863>
Mon, 2 Oct 2006 10:59:30 +0000 (10:59 +0000)
committermorsch <morsch@f7af4fe6-9843-0410-8265-dc069ae4e863>
Mon, 2 Oct 2006 10:59:30 +0000 (10:59 +0000)
HERWIG/hwlhin.f

index 83db9f1..50c4bd8 100644 (file)
@@ -17,12 +17,13 @@ C---Les Houches Event Common Block
      &              IDUP(MAXNUP),ISTUP(MAXNUP),MOTHUP(2,MAXNUP),
      &              ICOLUP(2,MAXNUP),PUP(5,MAXNUP),VTIMUP(MAXNUP),
      &              SPINUP(MAXNUP)
-      DOUBLE PRECISION PCM(5),PTR,XMTR,HWULDO
-      INTEGER I,J,IC,JPR,IHVY,MQQ,NQQ,IUNIT,ISCALE,I1HPRO,IBOS,
-     & ID,IA,IB,ICOL4(4,4),ICOL5(5,18)
+      DOUBLE PRECISION PCM(5),PTR,XMTR,HWVDOT,HWULDO,PDB(5)
+      INTEGER I,J,IC,JPR,MQQ,NQQ,IUNIT,ISCALE,I1HPRO,IBOS,NP,IG,
+     & ILEP,ID,IA,IB,ICOL4(4,4),ICOL5(5,18),JJPROC,IVHVEC,IVHLEP,MUP
       PARAMETER (IUNIT=61)
-      LOGICAL BOPRO,REMIT
+      LOGICAL BOPRO,NODEC,REMIT
       COMMON/NQQCOM/MQQ,NQQ
+      COMMON/VHLIN/IVHVEC,IVHLEP
 C---Colour flows for heavy quark pair production
       DATA ICOL4/
      & 10,02,10,02,01,20,20,01,12,23,10,03,12,31,30,02/
@@ -37,13 +38,31 @@ C---Colour flows for heavy quark pair production
      & 12,23,43,10,04, 12,31,34,40,02,
      & 12,34,14,30,02, 12,31,42,30,04/
       IF (IERROR.NE.0) RETURN
-C---READ AN EVENT 
-!       PRINT*,'NQQ= ',NQQ,' MQQ=',MQQ
+C---READ AN EVENT
       IF(NQQ.GE.MQQ)CALL HWWARN('UPEVNT',201,*999)
+      READ(IUNIT,901) I1HPRO,IC,NP
+      READ(IUNIT,902) (IDUP(I),I=1,NP)
+      READ(IUNIT,903) XWGTUP
+C---Les Houches expects mean weight to be the cross section in pb
+      XWGTUP= XWGTUP*MQQ
+      READ(IUNIT,904) ((PUP(J,I),J=1,4),I=1,NP)
       NQQ=NQQ+1
-      NUP=5
+C---Input format is now (px,py,pz,m)
+      DO I=1,NP
+         E=SQRT(HWVDOT(4,PUP(1,I),PUP(1,I)))
+         PUP(5,I)=PUP(4,I)
+         PUP(4,I)=E
+      ENDDO
+      CALL HWVSUM(4,PUP(1,1),PUP(1,2),PCM)
+      CALL HWUMAS(PCM)
+C---REMIT MEANS A REAL PARTON EMISSION OCCURRED
+      REMIT=PUP(4,3).NE.ZERO
+C---NODEC MEANS DECAYS NOT YET DONE
+      NODEC=NP.EQ.5
+      NUP=NP
 C---CHECK PROCESS CODE
-      JPR=MOD(IDPRUP,10000)/100
+      JJPROC=MOD(ABS(IPROC),10000)
+      JPR=JJPROC/100
       BOPRO=JPR.EQ.13.OR.JPR.EQ.14.OR.JPR.EQ.16.OR.JPR.EQ.36
       IF (BOPRO) THEN
 C----------------------------------------------------------------------
@@ -60,15 +79,16 @@ C    405        g q    -> q B
 C    406        g qbar -> qbar B
 C    407        g g    -> g B
 C-----------------------------------------------------------------------
-         NUP=4
-         READ(IUNIT,901) I1HPRO,(IDUP(I),I=1,3)
+C---NODEC=.TRUE. FOR HIGGS AND UNDECAYED EW BOSON
+         NODEC=NP.EQ.4
          IHPRO=I1HPRO-400
          ISCALE=0
          IF(JPR.EQ.16)ISCALE=2
-      ELSEIF (JPR.EQ.17) THEN
+      ELSEIF (JPR.EQ.17.OR.JPR.EQ.20) THEN
 C----------------------------------------------------------------------
-C   HEAVY Q QBAR PRODUCTION
+C   HEAVY Q and/or QBAR PRODUCTION
 C   IPROC=-1705,-1706 for Q=b,t
+C   IPROC=-2000 for single top
 C-----------------------------------------------------------------------
 C I1HPRO IDENTIFIES THE PARTONIC SUBPROCESS, WITH THE FOLLOWING CONVENTIONS:
 C   I1HPRO         PROCESS
@@ -79,10 +99,11 @@ C    404        qbar g -> qbar Q Qbar
 C    405        g q    -> q Q Qbar
 C    406        g qbar -> qbar Q Qbar
 C    407        g g    -> g Q Qbar
+C    408        q q    -> g t q
+C    409        qbar qbar -> g tbar qbar
 C-----------------------------------------------------------------------
 C IC SPECIFIES THE COLOUR CONNECTION (NOW IN INPUT FILE)
 C-----------------------------------------------------------------------
-         READ(IUNIT,901) I1HPRO,(IDUP(I),I=1,3),IC
 C---SET IHPRO AS FOR DIRECT PHOTON (IPROC=1800)
          IHPRO=I1HPRO-360
          ISCALE=0
@@ -101,26 +122,21 @@ C    404        qbar g -> qbar V V
 C    405        g q    -> q V V
 C    406        g qbar -> qbar V V
 C-----------------------------------------------------------------------
-         READ(IUNIT,901) I1HPRO,(IDUP(I),I=1,3)
+         IHPRO=I1HPRO-400
+         ISCALE=0
+      ELSEIF (JPR.EQ.26.OR.JPR.EQ.27) THEN
+C----------------------------------------------------------------------
+C   GAUGE BOSON PLUS HIGGS PRODUCTION
+C   VH=WH,ZH FOR IPROC=-2600-ID,-2700-ID
+C   WHERE ID CONTROLS HIGGS DECAY AS IN STANDARD HERWIG
+C-----------------------------------------------------------------------
          IHPRO=I1HPRO-400
          ISCALE=0
       ELSE
          CALL HWWARN('UPEVNT',202,*999)
       ENDIF
-      READ(IUNIT,902) XWGTUP
-C---Les Houches expects mean weight to be the cross section in pb
-      XWGTUP= XWGTUP*MQQ
-      READ(IUNIT,903) ((PUP(J,I),J=1,4),I=1,2)
-      READ(IUNIT,904) ((PUP(J,I),J=1,4),I=3,NUP)
-      DO I=1,NUP
-         CALL HWUMAS(PUP(1,I))
-      ENDDO
-      CALL HWVSUM(4,PUP(1,1),PUP(1,2),PCM)
-      CALL HWUMAS(PCM)
 C---HARD SCALE
       SCALUP=PCM(5)
-C---REMIT MEANS A REAL PARTON EMISSION OCCURRED
-      REMIT=PUP(4,3).NE.ZERO
       IF (REMIT) THEN
          IF (ISCALE.EQ.0) THEN
             PTR=SQRT(PUP(1,3)**2+PUP(2,3)**2)
@@ -147,6 +163,7 @@ C---REMIT MEANS A REAL PARTON EMISSION OCCURRED
             E=(XKA+XKB)/SQRT(S2)
             PL=-2.0/((VA+VB)*BETA*SQRT(S2))*(VA*XKA-VB*XKB)
             PTF=E**2-PL**2-XMP2
+            IF (PTF.LE.ZERO) CALL HWWARN('UPEVNT',103,*999)
             PTF=SQRT(PTF)
             IF(ISCALE.EQ.3)THEN
               SCALUP=PCM(5)-2.*MIN(PTR,PTF)
@@ -182,8 +199,8 @@ C---FINAL STATE
          MOTHUP(1,I)=1
          MOTHUP(2,I)=2
       ENDDO
-      IF (BOPRO) THEN
-C---SINGLE BOSON
+      IF (BOPRO.AND.NODEC) THEN
+C---SINGLE BOSON (UNDECAYED)
          IF (REMIT) THEN
 C---SET COLOUR CONNECTIONS
             DO I=1,3
@@ -217,7 +234,7 @@ C---SET COLOUR CONNECTIONS
                ICOLUP(2,2)=503
                ICOLUP(2,3)=503
             ELSE
-               CALL HWWARN('UPEVT',101,*999)
+               CALL HWWARN('UPEVNT',101,*999)
             ENDIF
          ELSE
             CALL HWVEQU(5,PUP(1,4),PUP(1,3))
@@ -242,21 +259,21 @@ C---QBAR Q
          ENDIF
          ICOLUP(1,NUP)=0
          ICOLUP(2,NUP)=0
-C---LOAD BOSON DATA
+C---LOAD BOSON ID
          IF (JPR.EQ.13) THEN
             IDUP(NUP)=23
          ELSEIF (JPR.EQ.16) THEN
             IDUP(NUP)=25
          ELSEIF (JPR.EQ.36) THEN
-            IBOS=MOD(IDPRUP,100)
+            IBOS=MOD(JJPROC,100)
             IF (IBOS.EQ.10) THEN
                IDUP(NUP)=26
             ELSEIF (IBOS.EQ.20) THEN
                IDUP(NUP)=35
             ELSEIF (IBOS.EQ.30) THEN
-               IDUP(NUP)=36 
+               IDUP(NUP)=36
             ELSE
-               CALL HWWARN('UPEVNT',502,*999)            
+               CALL HWWARN('UPEVNT',502,*999)
             ENDIF
          ELSEIF (JPR.EQ.14) THEN
             IBOS=0
@@ -289,6 +306,8 @@ C---SET COLOUR CONNECTIONS
             ENDIF
          ELSE
 C---2-BODY FINAL STATE
+            IDUP(3)=IDUP(4)
+            IDUP(4)=IDUP(5)
             CALL HWVEQU(5,PUP(1,4),PUP(1,3))
             CALL HWVEQU(5,PUP(1,5),PUP(1,4))
 C---SET COLOUR CONNECTIONS
@@ -300,31 +319,143 @@ C---SET COLOUR CONNECTIONS
                CALL HWWARN('UPEVNT',104,*999)
             ENDIF
          ENDIF
-         IHVY=MOD(IDPRUP,100)
-         IDUP(NUP-1)=IHVY
-         IDUP(NUP)=-IHVY
-      ELSE
-C---GAUGE BOSON PAIR
+      ELSEIF (JPR.EQ.20) THEN
+C---SINGLE TOP: IA,IB ARE THE QUARKS THAT ARE COLOUR CONNECTED
+C   I.E. (FOR H EVENTS) THOSE THAT ARE NOT CONNECTED TO GLUON
+         IA=IC/10
+         IB=IC-10*IA
+         IF (IA.LT.1.OR.IA.GT.5) CALL HWWARN('UPEVNT',108,*999)
+         IF (IB.LT.1.OR.IB.GT.5) CALL HWWARN('UPEVNT',109,*999)
+         IF (IA.EQ.IB) CALL HWWARN('UPEVNT',110,*999)
+         DO I=1,5
+            IF (I.EQ.IA.OR.I.EQ.IB) THEN
+               IF (IDUP(I).GT.0) THEN
+                  ICOLUP(1,I)=501
+                  ICOLUP(2,I)=0
+               ELSE
+                  ICOLUP(1,I)=0
+                  ICOLUP(2,I)=501
+               ENDIF
+            ELSEIF (IDUP(I).EQ.21) THEN
+               IG=I
+               ICOLUP(1,I)=502
+               ICOLUP(2,I)=503
+            ELSEIF (IDUP(I).GT.0) THEN
+               ICOLUP(1,I)=502
+               ICOLUP(2,I)=0
+            ELSE
+               ICOLUP(1,I)=0
+               ICOLUP(2,I)=502
+            ENDIF
+         ENDDO
          IF (REMIT) THEN
-C---ADD DIBOSON TO EVENT RECORD (TO FIX ITS MASS)
+C---3-BODY FINAL STATE
+C---COMPLETE GLUON COLOUR CONNECTIONS
+            DO I=1,5
+               IF (I.NE.IA.AND.I.NE.IB.AND.I.NE.IG) THEN
+                  IF (IDUP(I).GT.0) THEN
+                     IF((I.LT.3.AND.IG.LT.3)
+     &              .OR.(I.GT.2.AND.IG.GT.2)) ICOLUP(1,I)=503
+                  ELSE
+                     IF((I.LT.3.AND.IG.GT.2)
+     &              .OR.(I.GT.2.AND.IG.LT.3)) ICOLUP(2,I)=503
+                  ENDIF
+               ENDIF
+            ENDDO
+         ELSE
+C---2-BODY FINAL STATE
+            IDUP(3)=IDUP(4)
+            IDUP(4)=IDUP(5)
+            ICOLUP(1,3)=ICOLUP(1,4)
+            ICOLUP(2,3)=ICOLUP(2,4)
+            ICOLUP(1,4)=ICOLUP(1,5)
+            ICOLUP(2,4)=ICOLUP(2,5)
+            CALL HWVEQU(5,PUP(1,4),PUP(1,3))
+            CALL HWVEQU(5,PUP(1,5),PUP(1,4))
+         ENDIF
+      ELSE
+C---BOSON PAIR OR LEPTON PAIR
+         IF (BOPRO.OR.NODEC) THEN
             NUP=6
-            CALL HWVEQU(5,PUP(1,5),PUP(1,6))
-            CALL HWVEQU(5,PUP(1,4),PUP(1,5))
-            CALL HWVSUM(4,PUP(1,5),PUP(1,6),PUP(1,4))
-            CALL HWUMAS(PUP(1,4))
-            ISTUP(3)=1
-            ISTUP(4)=2
-            ISTUP(5)=1
-            ISTUP(6)=1
-            IDUP(4)=0
-            MOTHUP(1,3)=1
-            MOTHUP(2,3)=2
-            MOTHUP(1,4)=1
-            MOTHUP(2,4)=2
-            MOTHUP(1,5)=4
-            MOTHUP(2,5)=4
-            MOTHUP(1,6)=4
-            MOTHUP(2,6)=4
+            DO I=6,5,-1
+               CALL HWVEQU(5,PUP(1,I-1),PUP(1,I))
+               IDUP(I)=IDUP(I-1)
+               ISTUP(I)=1
+            ENDDO
+         ELSE
+C---BOSON PAIR: ONE OR BOTH DECAYED
+C---ADD BOSON(S) TO EVENT RECORD
+            IF (ABS(IDUP(6)).LT.20) THEN
+               NUP=8
+               I=2
+               IF (ABS(IDUP(4)).LT.20) THEN
+                  NUP=10
+                  I=3
+               ENDIF
+               MUP=NUP-1
+               CALL HWVEQU(5,PUP(1,MUP-I),PUP(1,MUP))
+               CALL HWVEQU(5,PUP(1,NUP-I),PUP(1,NUP))
+               CALL HWVSUM(4,PUP(1,MUP),PUP(1,NUP),PUP(1,6))
+               CALL HWUMAS(PUP(1,6))
+               IDUP(MUP)=IDUP(MUP-I)
+               IDUP(NUP)=IDUP(NUP-I)
+               ISTUP(MUP)=1
+               ISTUP(NUP)=1
+               MOTHUP(1,MUP)=6
+               MOTHUP(2,MUP)=6
+               MOTHUP(1,NUP)=6
+               MOTHUP(2,NUP)=6
+               ISTUP(6)=2
+               ID=IDUP(MUP)+IDUP(NUP)
+               IF (ID.EQ.0) THEN
+                  IDUP(6)=23
+               ELSEIF (ABS(ID).EQ.1) THEN
+                  IDUP(6)=24*ID
+               ELSE
+                  CALL HWWARN('UPEVNT',106,*999)
+               ENDIF
+            ENDIF
+            IF (ABS(IDUP(4)).LT.20) THEN
+               CALL HWVZRO(4,PDB)
+               DO I=8,7,-1
+                  CALL HWVEQU(5,PUP(1,I-3),PUP(1,I))
+                  CALL HWVSUM(4,PUP(1,I),PDB,PDB)
+                  IDUP(I)=IDUP(I-3)
+                  ISTUP(I)=1
+                  MOTHUP(1,I)=5
+                  MOTHUP(2,I)=5
+               ENDDO
+               CALL HWUMAS(PDB)
+               CALL HWVEQU(5,PDB,PUP(1,5))
+               ISTUP(5)=2
+               ID=IDUP(7)+IDUP(8)
+               IF (ID.EQ.0) THEN
+                  IDUP(5)=23
+               ELSEIF (ABS(ID).EQ.1) THEN
+                  IDUP(5)=24*ID
+               ELSE
+                  CALL HWWARN('UPEVNT',107,*999)
+               ENDIF
+            ELSE
+               CALL HWVEQU(5,PUP(1,4),PUP(1,5))
+               IDUP(5)=IDUP(4)
+               ISTUP(5)=1
+               MOTHUP(1,5)=4
+               MOTHUP(2,5)=4
+            ENDIF
+         ENDIF
+C---ADD DIBOSON OR DILEPTON TO EVENT RECORD (TO FIX ITS MASS)
+         CALL HWVZRO(4,PDB)
+         DO I=6,5,-1
+            CALL HWVSUM(4,PUP(1,I),PDB,PDB)
+            MOTHUP(1,I)=4
+            MOTHUP(2,I)=4
+         ENDDO
+         CALL HWUMAS(PDB)
+         CALL HWVEQU(5,PDB,PUP(1,4))
+         ISTUP(4)=2
+         IDUP(4)=0
+         IF (REMIT) THEN
 C---SET COLOUR CONNECTIONS
             DO I=1,3
                ICOLUP(1,I)=501
@@ -353,17 +484,25 @@ C---SET COLOUR CONNECTIONS
                ICOLUP(2,2)=501
                ICOLUP(1,3)=0
             ELSE
-               CALL HWWARN('UPEVT',101,*999)
+               CALL HWWARN('UPEVNT',102,*999)
             ENDIF
-            DO I=4,6
+            DO I=4,NUP
                ICOLUP(1,I)=0
                ICOLUP(2,I)=0
             ENDDO
          ELSE
-            CALL HWVEQU(5,PUP(1,4),PUP(1,3))
-            CALL HWVEQU(5,PUP(1,5),PUP(1,4))
+            DO I=5,NUP
+               CALL HWVEQU(5,PUP(1,I),PUP(1,I-2))
+               IDUP(I-2)=IDUP(I)
+               ISTUP(I-2)=ISTUP(I)
+               MOTHUP(1,I-2)=MOTHUP(1,I)-2
+               MOTHUP(2,I-2)=MOTHUP(1,I)-2
+            ENDDO
+            MOTHUP(1,3)=1
+            MOTHUP(1,4)=1
+            NUP=NUP-2
 C---SET COLOUR CONNECTIONS
-            DO I=1,4
+            DO I=1,NUP
                ICOLUP(1,I)=0
                ICOLUP(2,I)=0
             ENDDO
@@ -375,31 +514,52 @@ C---SET COLOUR CONNECTIONS
                ICOLUP(1,2)=501
             ENDIF
          ENDIF
-         IBOS=MOD(IDPRUP,100)
-C---LOAD BOSON DATA
-         I=NUP-1
-         J=NUP
-         IF (IBOS.EQ.50) THEN
-            IDUP(I)=24
-            IDUP(J)=-24
-         ELSEIF (IBOS.EQ.60) THEN
-            IDUP(I)=23
-            IDUP(J)=23
-         ELSEIF (IBOS.EQ.70) THEN
-            IDUP(I)=24
-            IDUP(J)=23
-         ELSEIF (IBOS.EQ.80) THEN
-            IDUP(I)=-24
-            IDUP(J)=23
-         ELSE
-            CALL HWWARN('UPEVNT',505,*999)
+         IF (BOPRO) THEN
+C---DILEPTON PRODUCTION
+            IBOS=MOD(JJPROC,100)
+            ILEP=MOD(JJPROC,10)
+            IBOS=IBOS-ILEP
+C---LOAD LEPTON AND BOSON ID
+            I=NUP-1
+            J=NUP
+            IF ( IBOS.EQ.50 .OR.
+     #          (IBOS.EQ.60.AND.JPR.EQ.13) .OR.
+     #          (IBOS.EQ.70.AND.JPR.EQ.13) ) THEN
+               IDUP(I)=-ILEP-10
+               IDUP(J)=-IDUP(I)
+               IF (REMIT) IDUP(4)=23
+            ELSEIF (IBOS.EQ.60.AND.JPR.EQ.14) THEN
+               IDUP(I)=-9-2*ILEP
+               IDUP(J)=1-IDUP(I)
+               IF (REMIT) IDUP(4)=24
+            ELSEIF (IBOS.EQ.70.AND.JPR.EQ.14) THEN
+               IDUP(I)=-10-2*ILEP
+               IDUP(J)=-1-IDUP(I)
+               IF (REMIT) IDUP(4)=-24
+            ELSE
+               CALL HWWARN('UPEVNT',504,*999)
+            ENDIF
          ENDIF
       ENDIF
- 901  FORMAT(1X,I3,4(1X,I2))
- 902  FORMAT(1X,D14.8)
- 903  FORMAT(8(1X,D14.8))
- 904  FORMAT(12(1X,D14.8))
- 999  END
+ 999  CONTINUE
+      IF(IERROR.LT.100) RETURN
+      PRINT *
+      DO I=1,NUP
+         PRINT '(4I4,3F8.2)',IDUP(I),ISTUP(I),(ICOLUP(J,I),J=1,2),
+     &        (PUP(J,I),J=1,3)
+      ENDDO
+c       IPR, IC, NP
+ 901  FORMAT(1X,I3,2(1X,I2))
+c      (ID(I),I=1,NP)
+ 902  FORMAT(7(1X,I3))
+c       XEVWGT
+ 903  FORMAT(1X,D14.8)
+c      ((P(J,I),J=1,4),I=1,NP)
+ 904  FORMAT(28(1X,D14.8))
+c 901  FORMAT(1X,I3,4(1X,I2))
+c 902  FORMAT(1X,D14.8)
+c 903  FORMAT(16(1X,D14.8))
+      END
 C----------------------------------------------------------------------
       SUBROUTINE UPCODE(ICODE,ICOL)
 C--DECODES COLOUR CONNECTIONS
@@ -414,8 +574,7 @@ C----------------------------------------------------------------------
 C----------------------------------------------------------------------
       SUBROUTINE UPINIT_GUP
 C----------------------------------------------------------------------
-C  Reads MC@NLO input headers for heavy quark and gauge boson pair
-C  production and fills Les Houches run common HEPRUP
+C  Reads MC@NLO input headers and fills Les Houches run common HEPRUP
 C----------------------------------------------------------------------
       INCLUDE 'HERWIG65.INC'
 C--Les Houches Common Blocks
@@ -436,30 +595,27 @@ C--Les Houches Common Blocks
      &              SPINUP(MAXNUP)
       DOUBLE PRECISION XCKECM,XTMP1,XTMP2,XTMP3,XTMP4,XMT,XMW,XMZ,
      & XMH,XMV,XM1,XM2,XM3,XM4,XM5,XM21,XLAM,GAH,TINY
-      INTEGER IVVCODE,IFAIL,MQQ,NQQ,IHW,I,NDNS,JPR,JPR0,IH
+      DOUBLE PRECISION XMV1,GAV1,GAMAX1,XMV2,GAV2,GAMAX2
+      INTEGER IVVCODE,IFAIL,MQQ,NQQ,IHW,I,NDNS,JPR,JPR0,IH,
+     & IVHVEC,IVHLEP,IVLEP1,IVLEP2
       CHARACTER*60 TMPSTR
       CHARACTER*4 STRP1,STRP2
       CHARACTER*8 STRGRP
       CHARACTER*2 STRSCH
+      CHARACTER*3 STRFMT
       CHARACTER*50 QQIN
       LOGICAL FK88STRNOEQ
       DATA TINY/1.D-3/
       COMMON/NQQCOM/MQQ,NQQ
       COMMON/VVJIN/QQIN
-C 
-      PRINT*,'UPINIT'
+      COMMON/VHLIN/IVHVEC,IVHLEP
+      COMMON/VVLIN/IVLEP1,IVLEP2
 C
       IF (IERROR.NE.0) RETURN
 C--SET UP INPUT FILES
       OPEN(UNIT=61,FILE=QQIN,STATUS='UNKNOWN')
-
-      PRINT*,'OPENED ',QQIN
-
 C--READ HEADERS OF EVENT FILE
       READ(61,801)XCKECM,XTMP1,XTMP2,XTMP3,XTMP4,TMPSTR
-
-      PRINT*,'READ'
-
       READ(61,802)IVVCODE,TMPSTR
       IVVCODE=MOD(IVVCODE,10000)
 C---CHECK PROCESS CODE
@@ -469,7 +625,8 @@ C---CHECK PROCESS CODE
       IF ((JPR.EQ.17.OR.JPR.EQ.28.OR.JPR.EQ.36).AND.
      & IVVCODE.NE.MOD(ABS(IPROC),10000)) CALL HWWARN('UPINIT',501,*999)
       IF (JPR.EQ.13.OR.JPR.EQ.14) THEN
-         IF(JPR0.EQ.1396)THEN
+         IF(JPR0.EQ.1396.OR.JPR0.EQ.1371.OR.
+     #      JPR0.EQ.1372.OR.JPR0.EQ.1373)THEN
            READ(61,808)EMMIN,EMMAX,TMPSTR
          ELSE
            READ(61,809)XMV,GAH,GAMMAX,TMPSTR
@@ -479,11 +636,22 @@ C-- CHECK VECTOR BOSON MASS
      #       (IVVCODE.EQ.1497.AND.ABS(XMV-RMASS(198)).GT.TINY) .OR.
      #       (IVVCODE.EQ.1498.AND.ABS(XMV-RMASS(199)).GT.TINY) )
      #      CALL HWWARN('UPINIT',502,*999)
+      ELSEIF (JPR.EQ.26.OR.JPR.EQ.27) THEN
+         READ(61,810)IVHVEC,IVHLEP,TMPSTR
+         READ(61,809)XMV,GAH,GAMMAX,TMPSTR
+         READ(61,809)XMH,GAH,GAMMAX,TMPSTR
+         IF( (JPR.EQ.26.AND.ABS(XMV-RMASS(199)).GT.TINY) .OR.
+     #       (JPR.EQ.27.AND.ABS(XMV-RMASS(200)).GT.TINY) )
+     #      CALL HWWARN('UPINIT',508,*999)
+         IF(ABS(XMH-RMASS(201)).GT.TINY) CALL HWWARN('UPINIT',509,*999)
       ELSEIF (JPR.EQ.28) THEN
          READ(61,808)XMW,XMZ,TMPSTR
 C-- CHECK VECTOR BOSON MASSES
          IF(ABS(XMW-RMASS(198)).GT.TINY .OR.
      #      ABS(XMZ-RMASS(200)).GT.TINY) CALL HWWARN('UPINIT',502,*999)
+         READ(61,810)IVLEP1,IVLEP2,TMPSTR
+         READ(61,809)XMV1,GAV1,GAMAX1,TMPSTR
+         READ(61,809)XMV2,GAV2,GAMAX2,TMPSTR
       ELSEIF (JPR.EQ.16.OR.JPR.EQ.36) THEN
          READ(61,809)XMH,GAH,XMT,TMPSTR
 C-- CHECK HIGGS AND TOP MASSES
@@ -496,11 +664,12 @@ C-- CHECK HIGGS AND TOP MASSES
 C-- CHECK HEAVY QUARK MASS
          IF( (IVVCODE.EQ.1706.AND.ABS(XMT-RMASS(6)).GT.TINY) .OR.
      #       (IVVCODE.EQ.1705.AND.ABS(XMT-RMASS(5)).GT.TINY) .OR.
-     #       (IVVCODE.EQ.1704.AND.ABS(XMT-RMASS(4)).GT.TINY) ) then
-            print*,' XMT=',XMT
-            print*,' RMASS(5)', RMASS(5)
-            CALL HWWARN('UPINIT',505,*999)
-         endif
+     #       (IVVCODE.EQ.1704.AND.ABS(XMT-RMASS(4)).GT.TINY) )
+     #   CALL HWWARN('UPINIT',505,*999)
+      ELSEIF (JPR.EQ.20) THEN
+         READ(61,803)XMT,TMPSTR
+C-- CHECK HEAVY QUARK MASS
+         IF(ABS(XMT-RMASS(6)).GT.TINY) CALL HWWARN('UPINIT',511,*999)
       ELSE
          CALL HWWARN('UPINIT',506,*999)
       ENDIF
@@ -508,7 +677,7 @@ C-- CHECK HEAVY QUARK MASS
       READ(61,805)STRP1,STRP2,TMPSTR
       READ(61,806)STRGRP,NDNS,TMPSTR
       READ(61,807)XLAM,STRSCH,TMPSTR
-C--CHECK THAT EVENT FILE HAS BEEN GENERATED CONSISTENTLY WITH 
+C--CHECK THAT EVENT FILE HAS BEEN GENERATED CONSISTENTLY WITH
 C--HERWIG PARAMETERS ADOPTED HERE
       IFAIL=0
 C-- CM ENERGY
@@ -522,18 +691,24 @@ C-- QUARK AND GLUON MASSES
      #     ABS(XM21-RMASS(13)).GT.TINY .OR.
 C-- LAMBDA_QCD: NOW REMOVED TO ALLOW MORE FLEXIBILITY (NNLO EFFECT ANYHOW)
 C     #     ABS(XLAM-QCDLAM).GT.TINY .OR.
-C-- REPLACE THE FOLLOWING WITH A CONDITION ON STRSCH, IF CONSISTENT 
+C-- REPLACE THE FOLLOWING WITH A CONDITION ON STRSCH, IF CONSISTENT
 C-- INFORMATION ON PDF SCHEME WILL BE AVAILABLE FROM PDF LIBRARIES AND HERWIG
 C-- COLLIDING PARTICLE TYPE
      #     FK88STRNOEQ(STRP1,PART1) .OR.
-     #     FK88STRNOEQ(STRP2,PART2) )IFAIL=1
+     #     FK88STRNOEQ(STRP2,PART2) ) IFAIL=1
 C--IF PDF LIBRARY IS USED, CHECK PDF CONSISTENCY
       IF( IFAIL.EQ.0 .AND. MODPDF(1).NE.-1)THEN
-            IF( 
-     #          FK88STRNOEQ(STRGRP,AUTPDF(1)) .OR.
-     #          FK88STRNOEQ(STRGRP,AUTPDF(2)) .OR.
-     #          ABS(NDNS-MODPDF(1)).GT.TINY .OR.
-     #          ABS(NDNS-MODPDF(2)).GT.TINY )IFAIL=1
+         IF( ABS(NDNS-MODPDF(1)).GT.TINY .OR.
+     #       ABS(NDNS-MODPDF(2)).GT.TINY .OR.
+C--IF LHAPDF IS USED, STRGRP AND AUTPDF ARE DIFFERENT
+     #       STRGRP.NE.'LHAPDF'.AND.FK88STRNOEQ(STRGRP,AUTPDF(1)))THEN
+                IFAIL=0
+      ENDIF
+C--WHEN LHAPDF IS LINKED, AUTPDF() IS A MC@NLO-DEFINED STRING
+         IF(AUTPDF(1).EQ.'HWLHAPDF'.OR.AUTPDF(1).EQ.'LHAEXT')THEN
+            AUTPDF(1)='DEFAULT'
+            AUTPDF(2)='DEFAULT'
+         ENDIF
       ENDIF
       IF(IFAIL.EQ.1) CALL HWWARN('UPINIT',507,*999)
       CALL HWUIDT(3,IDBMUP(1),IHW,PART1)
@@ -546,32 +721,29 @@ C--IF PDF LIBRARY IS USED, CHECK PDF CONSISTENCY
       IDWTUP=-4
       NPRUP=1
       LPRUP(1)=IVVCODE
+C-- TEST FOR NEW FORMAT INPUT MOMENTA: (PX,PY,PZ,M)
+      READ(61,811) STRFMT,TMPSTR
+      IF (STRFMT.NE.'P,M') CALL HWWARN('UPINIT',510,*999)
       READ(61,900) MQQ
       NQQ=0
-      NUP=6
+C-- LARGEST EXPECTED NUMBER OF LEGS
+      NUP=10
       AQEDUP=ZERO
       AQCDUP=ZERO
       DO I=1,NUP
          VTIMUP(I)=ZERO
          SPINUP(I)=9.
       ENDDO
-
-      PRINT*,'END OF UPINIT'
-
-      PRINT*,'PDFGUP(1)=',PDFGUP(1)
-      PRINT*,'PDFGUP(2)=',PDFGUP(2)
-
-
  801  FORMAT(5(1X,D10.4),1X,A)
  802  FORMAT(1X,I6,1X,A)
  803  FORMAT(1X,D10.4,1X,A)
  804  FORMAT(6(1X,D10.4),1X,A)
  805  FORMAT(2(1X,A4),1X,A)
- 806  FORMAT(1X,A8,1X,I4,1X,A)
+ 806  FORMAT(1X,A8,1X,I6,1X,A)
  807  FORMAT(1X,D10.4,1X,A2,1X,A)
  808  FORMAT(2(1X,D10.4),1X,A)
  809  FORMAT(3(1X,D10.4),1X,A)
+ 810  FORMAT(2(1X,I2),1X,A)
+ 811  FORMAT(1X,A3,1X,A)
  900  FORMAT(I9)
  999  END
-
-