HERWIG/hwlhin.f

   1 C Collects all of the Les Houches interface routines, plus utilities
   2 C for colour codes
   3 C
   4 C----------------------------------------------------------------------
   5       SUBROUTINE UPEVNT_GUP
   6 C----------------------------------------------------------------------
   7 C  Reads MC@NLO input files and fills Les Houches event common HEPEUP
   8 C----------------------------------------------------------------------
   9       INCLUDE 'HERWIG65.INC'
  10 C---Les Houches Event Common Block
  11       INTEGER MAXNUP
  12       PARAMETER (MAXNUP=500)
  13       INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP
  14       DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP,
  15      & XMP2,XMA2,XMB2,BETA,VA,VB,SIGMA,DELTA,S2,XKA,XKB,PTF,E,PL
  16       COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,
  17      &              IDUP(MAXNUP),ISTUP(MAXNUP),MOTHUP(2,MAXNUP),
  18      &              ICOLUP(2,MAXNUP),PUP(5,MAXNUP),VTIMUP(MAXNUP),
  19      &              SPINUP(MAXNUP)
  20       DOUBLE PRECISION PCM(5),PTR,XMTR,HWULDO
  21       INTEGER I,J,IC,JPR,IHVY,MQQ,NQQ,IUNIT,ISCALE,I1HPRO,IBOS,
  22      & ID,IA,IB,ICOL4(4,4),ICOL5(5,18)
  23       PARAMETER (IUNIT=61)
  24       LOGICAL BOPRO,REMIT
  25       COMMON/NQQCOM/MQQ,NQQ
  26 C---Colour flows for heavy quark pair production
  27       DATA ICOL4/
  28      & 10,02,10,02,01,20,20,01,12,23,10,03,12,31,30,02/
  29       DATA ICOL5/
  30      & 10,02,13,30,02, 10,02,32,10,03,
  31      & 10,21,30,20,03, 10,23,20,10,03,
  32      & 01,20,23,30,01, 01,20,31,20,03,
  33      & 01,23,03,20,01, 01,12,03,30,02,
  34      & 12,20,30,10,03, 12,30,10,30,02,
  35      & 12,03,02,10,03, 12,01,03,30,02,
  36      & 12,23,14,40,03, 12,34,32,10,04,
  37      & 12,23,43,10,04, 12,31,34,40,02,
  38      & 12,34,14,30,02, 12,31,42,30,04/
  39       IF (IERROR.NE.0) RETURN
  40 C---READ AN EVENT
  41 !       PRINT*,'NQQ= ',NQQ,' MQQ=',MQQ
  42       IF(NQQ.GE.MQQ)CALL HWWARN('UPEVNT',201,*999)
  43       NQQ=NQQ+1
  44       NUP=5
  45 C---CHECK PROCESS CODE
  46       JPR=MOD(IDPRUP,10000)/100
  47       BOPRO=JPR.EQ.13.OR.JPR.EQ.14.OR.JPR.EQ.16.OR.JPR.EQ.36
  48       IF (BOPRO) THEN
  49 C----------------------------------------------------------------------
  50 C   SINGLE GAUGE OR HIGGS BOSON PRODUCTION
  51 C   B = Z/gamma, W or H (SM or any MSSM neutral Higgs)
  52 C-----------------------------------------------------------------------
  53 C I1HPRO IDENTIFIES THE PARTONIC SUBPROCESS, WITH THE FOLLOWING CONVENTIONS:
  54 C   I1HPRO         PROCESS
  55 C    401        q qbar -> g B
  56 C    402        q g    -> q B
  57 C    403        qbar q -> g B
  58 C    404        qbar g -> qbar B
  59 C    405        g q    -> q B
  60 C    406        g qbar -> qbar B
  61 C    407        g g    -> g B
  62 C-----------------------------------------------------------------------
  63          NUP=4
  64          READ(IUNIT,901) I1HPRO,(IDUP(I),I=1,3)
  65          IHPRO=I1HPRO-400
  66          ISCALE=0
  67          IF(JPR.EQ.16)ISCALE=2
  68       ELSEIF (JPR.EQ.17) THEN
  69 C----------------------------------------------------------------------
  70 C   HEAVY Q QBAR PRODUCTION
  71 C   IPROC=-1705,-1706 for Q=b,t
  72 C-----------------------------------------------------------------------
  73 C I1HPRO IDENTIFIES THE PARTONIC SUBPROCESS, WITH THE FOLLOWING CONVENTIONS:
  74 C   I1HPRO         PROCESS
  75 C    401        q qbar -> g Q Qbar
  76 C    402        q g    -> q Q Qbar
  77 C    403        qbar q -> g Q Qbar
  78 C    404        qbar g -> qbar Q Qbar
  79 C    405        g q    -> q Q Qbar
  80 C    406        g qbar -> qbar Q Qbar
  81 C    407        g g    -> g Q Qbar
  82 C-----------------------------------------------------------------------
  83 C IC SPECIFIES THE COLOUR CONNECTION (NOW IN INPUT FILE)
  84 C-----------------------------------------------------------------------
  85          READ(IUNIT,901) I1HPRO,(IDUP(I),I=1,3),IC
  86 C---SET IHPRO AS FOR DIRECT PHOTON (IPROC=1800)
  87          IHPRO=I1HPRO-360
  88          ISCALE=0
  89          IF(ABS(IPROC).EQ.1705.OR.ABS(IPROC).EQ.11705)ISCALE=5
  90       ELSEIF (JPR.EQ.28) THEN
  91 C----------------------------------------------------------------------
  92 C   GAUGE BOSON PAIR PRODUCTION
  93 C   VV=WW,ZZ,ZW+,ZW- FOR IPROC=-2850,-2860,-2870,-2880
  94 C-----------------------------------------------------------------------
  95 C I1HPRO IDENTIFIES THE PARTONIC SUBPROCESS, WITH THE FOLLOWING CONVENTIONS:
  96 C   I1HPRO         PROCESS
  97 C    401        q qbar -> g V V
  98 C    402        q g    -> q V V
  99 C    403        qbar q -> g V V
 100 C    404        qbar g -> qbar V V
 101 C    405        g q    -> q V V
 102 C    406        g qbar -> qbar V V
 103 C-----------------------------------------------------------------------
 104          READ(IUNIT,901) I1HPRO,(IDUP(I),I=1,3)
 105          IHPRO=I1HPRO-400
 106          ISCALE=0
 107       ELSE
 108          CALL HWWARN('UPEVNT',202,*999)
 109       ENDIF
 110       READ(IUNIT,902) XWGTUP
 111 C---Les Houches expects mean weight to be the cross section in pb
 112       XWGTUP= XWGTUP*MQQ
 113       READ(IUNIT,903) ((PUP(J,I),J=1,4),I=1,2)
 114       READ(IUNIT,904) ((PUP(J,I),J=1,4),I=3,NUP)
 115       DO I=1,NUP
 116          CALL HWUMAS(PUP(1,I))
 117       ENDDO
 118       CALL HWVSUM(4,PUP(1,1),PUP(1,2),PCM)
 119       CALL HWUMAS(PCM)
 120 C---HARD SCALE
 121       SCALUP=PCM(5)
 122 C---REMIT MEANS A REAL PARTON EMISSION OCCURRED
 123       REMIT=PUP(4,3).NE.ZERO
 124       IF (REMIT) THEN
 125          IF (ISCALE.EQ.0) THEN
 126             PTR=SQRT(PUP(1,3)**2+PUP(2,3)**2)
 127             SCALUP=PCM(5)-2.*PTR
 128          ELSEIF(ISCALE.EQ.1)THEN
 129             SCALUP=PCM(5)
 130          ELSEIF (ISCALE.EQ.2) THEN
 131             SCALUP=SQRT(PUP(1,3)**2+PUP(2,3)**2)
 132          ELSEIF (ISCALE.EQ.3.OR.ISCALE.EQ.4.OR.ISCALE.EQ.5) THEN
 133             PTR=SQRT(PUP(1,3)**2+PUP(2,3)**2)
 134             IA=4
 135             IB=5
 136             XMP2=PUP(5,3)**2
 137             XMA2=PUP(5,IA)**2
 138             XMB2=PUP(5,IB)**2
 139             S2=XMA2+XMB2+2*HWULDO(PUP(1,IA),PUP(1,IB))
 140             SIGMA=XMA2+XMB2
 141             DELTA=XMA2-XMB2
 142             BETA=SQRT(1-2*SIGMA/S2+(DELTA/S2)**2)
 143             VA=BETA/(1+DELTA/S2)
 144             VB=BETA/(1-DELTA/S2)
 145             XKA=HWULDO(PUP(1,3),PUP(1,IA))
 146             XKB=HWULDO(PUP(1,3),PUP(1,IB))
 147             E=(XKA+XKB)/SQRT(S2)
 148             PL=-2.0/((VA+VB)*BETA*SQRT(S2))*(VA*XKA-VB*XKB)
 149             PTF=E**2-PL**2-XMP2
 150             PTF=SQRT(PTF)
 151             IF(ISCALE.EQ.3)THEN
 152               SCALUP=PCM(5)-2.*MIN(PTR,PTF)
 153             ELSEIF(ISCALE.EQ.4)THEN
 154               SCALUP=MIN(PTR,PTF)
 155             ELSE
 156               SCALUP=(MIN(PTR,PTF))**2+(XMA2+XMB2)/2.D0
 157               SCALUP=SQRT(SCALUP)
 158             ENDIF
 159             IF (SCALUP.LE.ZERO) CALL HWWARN('UPEVNT',100,*999)
 160          ELSEIF (ISCALE.EQ.6) THEN
 161             XMTR=SQRT(PUP(5,4)**2+PUP(1,4)**2+PUP(2,4)**2)
 162             PTR=SQRT(PUP(1,3)**2+PUP(2,3)**2)
 163             SCALUP=PCM(5)-PTR-XMTR
 164             IF (SCALUP.LE.ZERO) CALL HWWARN('UPEVNT',100,*999)
 165          ELSEIF (ISCALE.EQ.7) THEN
 166             SCALUP=SQRT(PUP(5,4)**2+PUP(1,4)**2+PUP(2,4)**2)
 167          ELSE
 168             CALL HWWARN('UPEVNT',501,*999)
 169          ENDIF
 170       ELSE
 171          NUP=NUP-1
 172       ENDIF
 173 C---INITIAL STATE
 174       DO I=1,2
 175          ISTUP(I)=-1
 176          MOTHUP(1,I)=0
 177          MOTHUP(2,I)=0
 178       ENDDO
 179 C---FINAL STATE
 180       DO I=3,NUP
 181          ISTUP(I)=1
 182          MOTHUP(1,I)=1
 183          MOTHUP(2,I)=2
 184       ENDDO
 185       IF (BOPRO) THEN
 186 C---SINGLE BOSON
 187          IF (REMIT) THEN
 188 C---SET COLOUR CONNECTIONS
 189             DO I=1,3
 190                ICOLUP(1,I)=501
 191                ICOLUP(2,I)=502
 192             ENDDO
 193             IF (IHPRO.EQ.1) THEN
 194                ICOLUP(2,1)=0
 195                ICOLUP(1,2)=0
 196             ELSEIF (IHPRO.EQ.2) THEN
 197                ICOLUP(1,1)=502
 198                ICOLUP(2,1)=0
 199                ICOLUP(2,3)=0
 200             ELSEIF (IHPRO.EQ.3) THEN
 201                ICOLUP(1,1)=0
 202                ICOLUP(2,2)=0
 203             ELSEIF (IHPRO.EQ.4) THEN
 204                ICOLUP(1,1)=0
 205                ICOLUP(2,1)=501
 206                ICOLUP(1,3)=0
 207             ELSEIF (IHPRO.EQ.5) THEN
 208                ICOLUP(1,2)=502
 209                ICOLUP(2,2)=0
 210                ICOLUP(2,3)=0
 211             ELSEIF (IHPRO.EQ.6) THEN
 212                ICOLUP(1,2)=0
 213                ICOLUP(2,2)=501
 214                ICOLUP(1,3)=0
 215             ELSEIF (IHPRO.EQ.7) THEN
 216                ICOLUP(1,2)=502
 217                ICOLUP(2,2)=503
 218                ICOLUP(2,3)=503
 219             ELSE
 220                CALL HWWARN('UPEVT',101,*999)
 221             ENDIF
 222          ELSE
 223             CALL HWVEQU(5,PUP(1,4),PUP(1,3))
 224 C---SET COLOUR CONNECTIONS
 225             DO I=1,2
 226                ICOLUP(1,I)=0
 227                ICOLUP(2,I)=0
 228             ENDDO
 229             IF (IDUP(1).GT.0) THEN
 230                ICOLUP(1,1)=501
 231                ICOLUP(2,2)=501
 232                IF (IDUP(1).GT.0) THEN
 233 C---GG FUSION
 234                   ICOLUP(2,1)=502
 235                   ICOLUP(1,2)=502
 236                ENDIF
 237             ELSE
 238 C---QBAR Q
 239                ICOLUP(2,1)=501
 240                ICOLUP(1,2)=501
 241             ENDIF
 242          ENDIF
 243          ICOLUP(1,NUP)=0
 244          ICOLUP(2,NUP)=0
 245 C---LOAD BOSON DATA
 246          IF (JPR.EQ.13) THEN
 247             IDUP(NUP)=23
 248          ELSEIF (JPR.EQ.16) THEN
 249             IDUP(NUP)=25
 250          ELSEIF (JPR.EQ.36) THEN
 251             IBOS=MOD(IDPRUP,100)
 252             IF (IBOS.EQ.10) THEN
 253                IDUP(NUP)=26
 254             ELSEIF (IBOS.EQ.20) THEN
 255                IDUP(NUP)=35
 256             ELSEIF (IBOS.EQ.30) THEN
 257                IDUP(NUP)=36
 258             ELSE
 259                CALL HWWARN('UPEVNT',502,*999)
 260             ENDIF
 261          ELSEIF (JPR.EQ.14) THEN
 262             IBOS=0
 263             DO I=1,NUP-1
 264                ID=IDUP(I)
 265                IF (ID.EQ.21) THEN
 266                   IC=0
 267                ELSEIF (ID.GT.0) THEN
 268                   IC=ICHRG(ID)
 269                ELSE
 270                   IC=ICHRG(6-ID)
 271                ENDIF
 272                IBOS=IBOS+IC
 273             ENDDO
 274             IF (REMIT) IBOS=IBOS-2*IC
 275             IF (ABS(IBOS).NE.3) CALL  HWWARN('UPEVNT',503,*999)
 276             IDUP(NUP)=8*IBOS
 277          ENDIF
 278       ELSEIF (JPR.EQ.17) THEN
 279 C---HEAVY QUARKS
 280          IF (REMIT) THEN
 281 C---3-BODY FINAL STATE
 282 C---SET COLOUR CONNECTIONS
 283             IF (IC.LE.18) THEN
 284                DO I=1,5
 285                   CALL UPCODE(ICOL5(I,IC),ICOLUP(1,I))
 286                ENDDO
 287             ELSE
 288                CALL HWWARN('UPEVNT',105,*999)
 289             ENDIF
 290          ELSE
 291 C---2-BODY FINAL STATE
 292             CALL HWVEQU(5,PUP(1,4),PUP(1,3))
 293             CALL HWVEQU(5,PUP(1,5),PUP(1,4))
 294 C---SET COLOUR CONNECTIONS
 295             IF (IC.LE.4) THEN
 296                DO I=1,4
 297                   CALL UPCODE(ICOL4(I,IC),ICOLUP(1,I))
 298                ENDDO
 299             ELSE
 300                CALL HWWARN('UPEVNT',104,*999)
 301             ENDIF
 302          ENDIF
 303          IHVY=MOD(IDPRUP,100)
 304          IDUP(NUP-1)=IHVY
 305          IDUP(NUP)=-IHVY
 306       ELSE
 307 C---GAUGE BOSON PAIR
 308          IF (REMIT) THEN
 309 C---ADD DIBOSON TO EVENT RECORD (TO FIX ITS MASS)
 310             NUP=6
 311             CALL HWVEQU(5,PUP(1,5),PUP(1,6))
 312             CALL HWVEQU(5,PUP(1,4),PUP(1,5))
 313             CALL HWVSUM(4,PUP(1,5),PUP(1,6),PUP(1,4))
 314             CALL HWUMAS(PUP(1,4))
 315             ISTUP(3)=1
 316             ISTUP(4)=2
 317             ISTUP(5)=1
 318             ISTUP(6)=1
 319             IDUP(4)=0
 320             MOTHUP(1,3)=1
 321             MOTHUP(2,3)=2
 322             MOTHUP(1,4)=1
 323             MOTHUP(2,4)=2
 324             MOTHUP(1,5)=4
 325             MOTHUP(2,5)=4
 326             MOTHUP(1,6)=4
 327             MOTHUP(2,6)=4
 328 C---SET COLOUR CONNECTIONS
 329             DO I=1,3
 330                ICOLUP(1,I)=501
 331                ICOLUP(2,I)=502
 332             ENDDO
 333             IF (IHPRO.EQ.1) THEN
 334                ICOLUP(2,1)=0
 335                ICOLUP(1,2)=0
 336             ELSEIF (IHPRO.EQ.2) THEN
 337                ICOLUP(1,1)=502
 338                ICOLUP(2,1)=0
 339                ICOLUP(2,3)=0
 340             ELSEIF (IHPRO.EQ.3) THEN
 341                ICOLUP(1,1)=0
 342                ICOLUP(2,2)=0
 343             ELSEIF (IHPRO.EQ.4) THEN
 344                ICOLUP(1,1)=0
 345                ICOLUP(2,1)=501
 346                ICOLUP(1,3)=0
 347             ELSEIF (IHPRO.EQ.5) THEN
 348                ICOLUP(1,2)=502
 349                ICOLUP(2,2)=0
 350                ICOLUP(2,3)=0
 351             ELSEIF (IHPRO.EQ.6) THEN
 352                ICOLUP(1,2)=0
 353                ICOLUP(2,2)=501
 354                ICOLUP(1,3)=0
 355             ELSE
 356                CALL HWWARN('UPEVT',101,*999)
 357             ENDIF
 358             DO I=4,6
 359                ICOLUP(1,I)=0
 360                ICOLUP(2,I)=0
 361             ENDDO
 362          ELSE
 363             CALL HWVEQU(5,PUP(1,4),PUP(1,3))
 364             CALL HWVEQU(5,PUP(1,5),PUP(1,4))
 365 C---SET COLOUR CONNECTIONS
 366             DO I=1,4
 367                ICOLUP(1,I)=0
 368                ICOLUP(2,I)=0
 369             ENDDO
 370             IF (IDUP(1).GT.0) THEN
 371                ICOLUP(1,1)=501
 372                ICOLUP(2,2)=501
 373             ELSE
 374                ICOLUP(2,1)=501
 375                ICOLUP(1,2)=501
 376             ENDIF
 377          ENDIF
 378          IBOS=MOD(IDPRUP,100)
 379 C---LOAD BOSON DATA
 380          I=NUP-1
 381          J=NUP
 382          IF (IBOS.EQ.50) THEN
 383             IDUP(I)=24
 384             IDUP(J)=-24
 385          ELSEIF (IBOS.EQ.60) THEN
 386             IDUP(I)=23
 387             IDUP(J)=23
 388          ELSEIF (IBOS.EQ.70) THEN
 389             IDUP(I)=24
 390             IDUP(J)=23
 391          ELSEIF (IBOS.EQ.80) THEN
 392             IDUP(I)=-24
 393             IDUP(J)=23
 394          ELSE
 395             CALL HWWARN('UPEVNT',505,*999)
 396          ENDIF
 397       ENDIF
 398  901  FORMAT(1X,I3,4(1X,I2))
 399  902  FORMAT(1X,D14.8)
 400  903  FORMAT(8(1X,D14.8))
 401  904  FORMAT(12(1X,D14.8))
 402  999  END
 403 C----------------------------------------------------------------------
 404       SUBROUTINE UPCODE(ICODE,ICOL)
 405 C--DECODES COLOUR CONNECTIONS
 406 C----------------------------------------------------------------------
 407       IMPLICIT NONE
 408       INTEGER ICODE,ICOL(2)
 409       ICOL(1)=ICODE/10
 410       IF (ICOL(1).NE.0) ICOL(1)=ICOL(1)+500
 411       ICOL(2)=MOD(ICODE,10)
 412       IF (ICOL(2).NE.0) ICOL(2)=ICOL(2)+500
 413       END
 414 C----------------------------------------------------------------------
 415       SUBROUTINE UPINIT_GUP
 416 C----------------------------------------------------------------------
 417 C  Reads MC@NLO input headers for heavy quark and gauge boson pair
 418 C  production and fills Les Houches run common HEPRUP
 419 C----------------------------------------------------------------------
 420       INCLUDE 'HERWIG65.INC'
 421 C--Les Houches Common Blocks
 422       INTEGER MAXPUP
 423       PARAMETER(MAXPUP=100)
 424       INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
 425       DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
 426       COMMON /HEPRUP/ IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
 427      &                IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),
 428      &                XMAXUP(MAXPUP),LPRUP(MAXPUP)
 429       INTEGER MAXNUP
 430       PARAMETER (MAXNUP=500)
 431       INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP
 432       DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP
 433       COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,
 434      &              IDUP(MAXNUP),ISTUP(MAXNUP),MOTHUP(2,MAXNUP),
 435      &              ICOLUP(2,MAXNUP),PUP(5,MAXNUP),VTIMUP(MAXNUP),
 436      &              SPINUP(MAXNUP)
 437       DOUBLE PRECISION XCKECM,XTMP1,XTMP2,XTMP3,XTMP4,XMT,XMW,XMZ,
 438      & XMH,XMV,XM1,XM2,XM3,XM4,XM5,XM21,XLAM,GAH,TINY
 439       INTEGER IVVCODE,IFAIL,MQQ,NQQ,IHW,I,NDNS,JPR,JPR0,IH
 440       CHARACTER*60 TMPSTR
 441       CHARACTER*4 STRP1,STRP2
 442       CHARACTER*8 STRGRP
 443       CHARACTER*2 STRSCH
 444       CHARACTER*50 QQIN
 445       LOGICAL FK88STRNOEQ
 446       DATA TINY/1.D-3/
 447       COMMON/NQQCOM/MQQ,NQQ
 448       COMMON/VVJIN/QQIN
 449 C
 450       PRINT*,'UPINIT'
 451 C
 452       IF (IERROR.NE.0) RETURN
 453 C--SET UP INPUT FILES
 454       OPEN(UNIT=61,FILE=QQIN,STATUS='UNKNOWN')
 455
 456       PRINT*,'OPENED ',QQIN
 457
 458 C--READ HEADERS OF EVENT FILE
 459       READ(61,801)XCKECM,XTMP1,XTMP2,XTMP3,XTMP4,TMPSTR
 460
 461       PRINT*,'READ'
 462
 463       READ(61,802)IVVCODE,TMPSTR
 464       IVVCODE=MOD(IVVCODE,10000)
 465 C---CHECK PROCESS CODE
 466       JPR0=MOD(ABS(IPROC),10000)
 467       JPR=JPR0/100
 468       IF (JPR.NE.IVVCODE/100) CALL HWWARN('UPINIT',500,*999)
 469       IF ((JPR.EQ.17.OR.JPR.EQ.28.OR.JPR.EQ.36).AND.
 470      & IVVCODE.NE.MOD(ABS(IPROC),10000)) CALL HWWARN('UPINIT',501,*999)
 471       IF (JPR.EQ.13.OR.JPR.EQ.14) THEN
 472          IF(JPR0.EQ.1396)THEN
 473            READ(61,808)EMMIN,EMMAX,TMPSTR
 474          ELSE
 475            READ(61,809)XMV,GAH,GAMMAX,TMPSTR
 476          ENDIF
 477 C-- CHECK VECTOR BOSON MASS
 478          IF( (IVVCODE.EQ.1397.AND.ABS(XMV-RMASS(200)).GT.TINY) .OR.
 479      #       (IVVCODE.EQ.1497.AND.ABS(XMV-RMASS(198)).GT.TINY) .OR.
 480      #       (IVVCODE.EQ.1498.AND.ABS(XMV-RMASS(199)).GT.TINY) )
 481      #      CALL HWWARN('UPINIT',502,*999)
 482       ELSEIF (JPR.EQ.28) THEN
 483          READ(61,808)XMW,XMZ,TMPSTR
 484 C-- CHECK VECTOR BOSON MASSES
 485          IF(ABS(XMW-RMASS(198)).GT.TINY .OR.
 486      #      ABS(XMZ-RMASS(200)).GT.TINY) CALL HWWARN('UPINIT',502,*999)
 487       ELSEIF (JPR.EQ.16.OR.JPR.EQ.36) THEN
 488          READ(61,809)XMH,GAH,XMT,TMPSTR
 489 C-- CHECK HIGGS AND TOP MASSES
 490          IH=201
 491          IF (JPR.EQ.36) IH=IVVCODE/10-158
 492          IF(ABS(XMH-RMASS(IH)).GT.TINY) CALL HWWARN('UPINIT',503,*999)
 493          IF(ABS(XMT-RMASS(6)) .GT.TINY) CALL HWWARN('UPINIT',504,*999)
 494       ELSEIF (JPR.EQ.17) THEN
 495          READ(61,803)XMT,TMPSTR
 496 C-- CHECK HEAVY QUARK MASS
 497          IF( (IVVCODE.EQ.1706.AND.ABS(XMT-RMASS(6)).GT.TINY) .OR.
 498      #       (IVVCODE.EQ.1705.AND.ABS(XMT-RMASS(5)).GT.TINY) .OR.
 499      #       (IVVCODE.EQ.1704.AND.ABS(XMT-RMASS(4)).GT.TINY) ) then
 500             print*,' XMT=',XMT
 501             print*,' RMASS(5)', RMASS(5)
 502             CALL HWWARN('UPINIT',505,*999)
 503          endif
 504       ELSE
 505          CALL HWWARN('UPINIT',506,*999)
 506       ENDIF
 507       READ(61,804)XM1,XM2,XM3,XM4,XM5,XM21,TMPSTR
 508       READ(61,805)STRP1,STRP2,TMPSTR
 509       READ(61,806)STRGRP,NDNS,TMPSTR
 510       READ(61,807)XLAM,STRSCH,TMPSTR
 511 C--CHECK THAT EVENT FILE HAS BEEN GENERATED CONSISTENTLY WITH
 512 C--HERWIG PARAMETERS ADOPTED HERE
 513       IFAIL=0
 514 C-- CM ENERGY
 515       IF( ABS(XCKECM-PBEAM1-PBEAM2).GT.TINY .OR.
 516 C-- QUARK AND GLUON MASSES
 517      #     ABS(XM1-RMASS(1)).GT.TINY .OR.
 518      #     ABS(XM2-RMASS(2)).GT.TINY .OR.
 519      #     ABS(XM3-RMASS(3)).GT.TINY .OR.
 520      #     ABS(XM4-RMASS(4)).GT.TINY .OR.
 521      #     ABS(XM5-RMASS(5)).GT.TINY .OR.
 522      #     ABS(XM21-RMASS(13)).GT.TINY .OR.
 523 C-- LAMBDA_QCD: NOW REMOVED TO ALLOW MORE FLEXIBILITY (NNLO EFFECT ANYHOW)
 524 C     #     ABS(XLAM-QCDLAM).GT.TINY .OR.
 525 C-- REPLACE THE FOLLOWING WITH A CONDITION ON STRSCH, IF CONSISTENT
 526 C-- INFORMATION ON PDF SCHEME WILL BE AVAILABLE FROM PDF LIBRARIES AND HERWIG
 527 C-- COLLIDING PARTICLE TYPE
 528      #     FK88STRNOEQ(STRP1,PART1) .OR.
 529      #     FK88STRNOEQ(STRP2,PART2) )IFAIL=1
 530 C--IF PDF LIBRARY IS USED, CHECK PDF CONSISTENCY
 531       IF( IFAIL.EQ.0 .AND. MODPDF(1).NE.-1)THEN
 532             IF(
 533      #          FK88STRNOEQ(STRGRP,AUTPDF(1)) .OR.
 534      #          FK88STRNOEQ(STRGRP,AUTPDF(2)) .OR.
 535      #          ABS(NDNS-MODPDF(1)).GT.TINY .OR.
 536      #          ABS(NDNS-MODPDF(2)).GT.TINY )IFAIL=1
 537       ENDIF
 538       IF(IFAIL.EQ.1) CALL HWWARN('UPINIT',507,*999)
 539       CALL HWUIDT(3,IDBMUP(1),IHW,PART1)
 540       CALL HWUIDT(3,IDBMUP(2),IHW,PART2)
 541       DO I=1,2
 542          EBMUP(I)=HALF*XCKECM
 543          PDFGUP(I)=-1
 544          PDFSUP(I)=-1
 545       ENDDO
 546       IDWTUP=-4
 547       NPRUP=1
 548       LPRUP(1)=IVVCODE
 549       READ(61,900) MQQ
 550       NQQ=0
 551       NUP=6
 552       AQEDUP=ZERO
 553       AQCDUP=ZERO
 554       DO I=1,NUP
 555          VTIMUP(I)=ZERO
 556          SPINUP(I)=9.
 557       ENDDO
 558
 559       PRINT*,'END OF UPINIT'
 560
 561       PRINT*,'PDFGUP(1)=',PDFGUP(1)
 562       PRINT*,'PDFGUP(2)=',PDFGUP(2)
 563
 564
 565  801  FORMAT(5(1X,D10.4),1X,A)
 566  802  FORMAT(1X,I6,1X,A)
 567  803  FORMAT(1X,D10.4,1X,A)
 568  804  FORMAT(6(1X,D10.4),1X,A)
 569  805  FORMAT(2(1X,A4),1X,A)
 570  806  FORMAT(1X,A8,1X,I4,1X,A)
 571  807  FORMAT(1X,D10.4,1X,A2,1X,A)
 572  808  FORMAT(2(1X,D10.4),1X,A)
 573  809  FORMAT(3(1X,D10.4),1X,A)
 574  900  FORMAT(I9)
 575  999  END
 576
 577