--- /dev/null
+C Collects all of the Les Houches interface routines, plus utilities
+C for colour codes
+C
+C----------------------------------------------------------------------
+ SUBROUTINE UPEVNT_GUP
+C----------------------------------------------------------------------
+C Reads MC@NLO input files and fills Les Houches event common HEPEUP
+C----------------------------------------------------------------------
+ INCLUDE 'HERWIG65.INC'
+C---Les Houches Event Common Block
+ INTEGER MAXNUP
+ PARAMETER (MAXNUP=500)
+ INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP
+ DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP,
+ & XMP2,XMA2,XMB2,BETA,VA,VB,SIGMA,DELTA,S2,XKA,XKB,PTF,E,PL
+ COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,
+ & 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)
+ PARAMETER (IUNIT=61)
+ LOGICAL BOPRO,REMIT
+ COMMON/NQQCOM/MQQ,NQQ
+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/
+ DATA ICOL5/
+ & 10,02,13,30,02, 10,02,32,10,03,
+ & 10,21,30,20,03, 10,23,20,10,03,
+ & 01,20,23,30,01, 01,20,31,20,03,
+ & 01,23,03,20,01, 01,12,03,30,02,
+ & 12,20,30,10,03, 12,30,10,30,02,
+ & 12,03,02,10,03, 12,01,03,30,02,
+ & 12,23,14,40,03, 12,34,32,10,04,
+ & 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
+ IF(NQQ.GE.MQQ)CALL HWWARN('UPEVNT',201,*999)
+ NQQ=NQQ+1
+ NUP=5
+C---CHECK PROCESS CODE
+ JPR=MOD(IDPRUP,10000)/100
+ BOPRO=JPR.EQ.13.OR.JPR.EQ.14.OR.JPR.EQ.16.OR.JPR.EQ.36
+ IF (BOPRO) THEN
+C----------------------------------------------------------------------
+C SINGLE GAUGE OR HIGGS BOSON PRODUCTION
+C B = Z/gamma, W or H (SM or any MSSM neutral Higgs)
+C-----------------------------------------------------------------------
+C I1HPRO IDENTIFIES THE PARTONIC SUBPROCESS, WITH THE FOLLOWING CONVENTIONS:
+C I1HPRO PROCESS
+C 401 q qbar -> g B
+C 402 q g -> q B
+C 403 qbar q -> g B
+C 404 qbar g -> qbar B
+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)
+ IHPRO=I1HPRO-400
+ ISCALE=0
+ IF(JPR.EQ.16)ISCALE=2
+ ELSEIF (JPR.EQ.17) THEN
+C----------------------------------------------------------------------
+C HEAVY Q QBAR PRODUCTION
+C IPROC=-1705,-1706 for Q=b,t
+C-----------------------------------------------------------------------
+C I1HPRO IDENTIFIES THE PARTONIC SUBPROCESS, WITH THE FOLLOWING CONVENTIONS:
+C I1HPRO PROCESS
+C 401 q qbar -> g Q Qbar
+C 402 q g -> q Q Qbar
+C 403 qbar q -> g Q Qbar
+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-----------------------------------------------------------------------
+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
+ IF(ABS(IPROC).EQ.1705.OR.ABS(IPROC).EQ.11705)ISCALE=5
+ ELSEIF (JPR.EQ.28) THEN
+C----------------------------------------------------------------------
+C GAUGE BOSON PAIR PRODUCTION
+C VV=WW,ZZ,ZW+,ZW- FOR IPROC=-2850,-2860,-2870,-2880
+C-----------------------------------------------------------------------
+C I1HPRO IDENTIFIES THE PARTONIC SUBPROCESS, WITH THE FOLLOWING CONVENTIONS:
+C I1HPRO PROCESS
+C 401 q qbar -> g V V
+C 402 q g -> q V V
+C 403 qbar q -> g V V
+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
+ 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)
+ SCALUP=PCM(5)-2.*PTR
+ ELSEIF(ISCALE.EQ.1)THEN
+ SCALUP=PCM(5)
+ ELSEIF (ISCALE.EQ.2) THEN
+ SCALUP=SQRT(PUP(1,3)**2+PUP(2,3)**2)
+ ELSEIF (ISCALE.EQ.3.OR.ISCALE.EQ.4.OR.ISCALE.EQ.5) THEN
+ PTR=SQRT(PUP(1,3)**2+PUP(2,3)**2)
+ IA=4
+ IB=5
+ XMP2=PUP(5,3)**2
+ XMA2=PUP(5,IA)**2
+ XMB2=PUP(5,IB)**2
+ S2=XMA2+XMB2+2*HWULDO(PUP(1,IA),PUP(1,IB))
+ SIGMA=XMA2+XMB2
+ DELTA=XMA2-XMB2
+ BETA=SQRT(1-2*SIGMA/S2+(DELTA/S2)**2)
+ VA=BETA/(1+DELTA/S2)
+ VB=BETA/(1-DELTA/S2)
+ XKA=HWULDO(PUP(1,3),PUP(1,IA))
+ XKB=HWULDO(PUP(1,3),PUP(1,IB))
+ E=(XKA+XKB)/SQRT(S2)
+ PL=-2.0/((VA+VB)*BETA*SQRT(S2))*(VA*XKA-VB*XKB)
+ PTF=E**2-PL**2-XMP2
+ PTF=SQRT(PTF)
+ IF(ISCALE.EQ.3)THEN
+ SCALUP=PCM(5)-2.*MIN(PTR,PTF)
+ ELSEIF(ISCALE.EQ.4)THEN
+ SCALUP=MIN(PTR,PTF)
+ ELSE
+ SCALUP=(MIN(PTR,PTF))**2+(XMA2+XMB2)/2.D0
+ SCALUP=SQRT(SCALUP)
+ ENDIF
+ IF (SCALUP.LE.ZERO) CALL HWWARN('UPEVNT',100,*999)
+ ELSEIF (ISCALE.EQ.6) THEN
+ XMTR=SQRT(PUP(5,4)**2+PUP(1,4)**2+PUP(2,4)**2)
+ PTR=SQRT(PUP(1,3)**2+PUP(2,3)**2)
+ SCALUP=PCM(5)-PTR-XMTR
+ IF (SCALUP.LE.ZERO) CALL HWWARN('UPEVNT',100,*999)
+ ELSEIF (ISCALE.EQ.7) THEN
+ SCALUP=SQRT(PUP(5,4)**2+PUP(1,4)**2+PUP(2,4)**2)
+ ELSE
+ CALL HWWARN('UPEVNT',501,*999)
+ ENDIF
+ ELSE
+ NUP=NUP-1
+ ENDIF
+C---INITIAL STATE
+ DO I=1,2
+ ISTUP(I)=-1
+ MOTHUP(1,I)=0
+ MOTHUP(2,I)=0
+ ENDDO
+C---FINAL STATE
+ DO I=3,NUP
+ ISTUP(I)=1
+ MOTHUP(1,I)=1
+ MOTHUP(2,I)=2
+ ENDDO
+ IF (BOPRO) THEN
+C---SINGLE BOSON
+ IF (REMIT) THEN
+C---SET COLOUR CONNECTIONS
+ DO I=1,3
+ ICOLUP(1,I)=501
+ ICOLUP(2,I)=502
+ ENDDO
+ IF (IHPRO.EQ.1) THEN
+ ICOLUP(2,1)=0
+ ICOLUP(1,2)=0
+ ELSEIF (IHPRO.EQ.2) THEN
+ ICOLUP(1,1)=502
+ ICOLUP(2,1)=0
+ ICOLUP(2,3)=0
+ ELSEIF (IHPRO.EQ.3) THEN
+ ICOLUP(1,1)=0
+ ICOLUP(2,2)=0
+ ELSEIF (IHPRO.EQ.4) THEN
+ ICOLUP(1,1)=0
+ ICOLUP(2,1)=501
+ ICOLUP(1,3)=0
+ ELSEIF (IHPRO.EQ.5) THEN
+ ICOLUP(1,2)=502
+ ICOLUP(2,2)=0
+ ICOLUP(2,3)=0
+ ELSEIF (IHPRO.EQ.6) THEN
+ ICOLUP(1,2)=0
+ ICOLUP(2,2)=501
+ ICOLUP(1,3)=0
+ ELSEIF (IHPRO.EQ.7) THEN
+ ICOLUP(1,2)=502
+ ICOLUP(2,2)=503
+ ICOLUP(2,3)=503
+ ELSE
+ CALL HWWARN('UPEVT',101,*999)
+ ENDIF
+ ELSE
+ CALL HWVEQU(5,PUP(1,4),PUP(1,3))
+C---SET COLOUR CONNECTIONS
+ DO I=1,2
+ ICOLUP(1,I)=0
+ ICOLUP(2,I)=0
+ ENDDO
+ IF (IDUP(1).GT.0) THEN
+ ICOLUP(1,1)=501
+ ICOLUP(2,2)=501
+ IF (IDUP(1).GT.0) THEN
+C---GG FUSION
+ ICOLUP(2,1)=502
+ ICOLUP(1,2)=502
+ ENDIF
+ ELSE
+C---QBAR Q
+ ICOLUP(2,1)=501
+ ICOLUP(1,2)=501
+ ENDIF
+ ENDIF
+ ICOLUP(1,NUP)=0
+ ICOLUP(2,NUP)=0
+C---LOAD BOSON DATA
+ 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)
+ IF (IBOS.EQ.10) THEN
+ IDUP(NUP)=26
+ ELSEIF (IBOS.EQ.20) THEN
+ IDUP(NUP)=35
+ ELSEIF (IBOS.EQ.30) THEN
+ IDUP(NUP)=36
+ ELSE
+ CALL HWWARN('UPEVNT',502,*999)
+ ENDIF
+ ELSEIF (JPR.EQ.14) THEN
+ IBOS=0
+ DO I=1,NUP-1
+ ID=IDUP(I)
+ IF (ID.EQ.21) THEN
+ IC=0
+ ELSEIF (ID.GT.0) THEN
+ IC=ICHRG(ID)
+ ELSE
+ IC=ICHRG(6-ID)
+ ENDIF
+ IBOS=IBOS+IC
+ ENDDO
+ IF (REMIT) IBOS=IBOS-2*IC
+ IF (ABS(IBOS).NE.3) CALL HWWARN('UPEVNT',503,*999)
+ IDUP(NUP)=8*IBOS
+ ENDIF
+ ELSEIF (JPR.EQ.17) THEN
+C---HEAVY QUARKS
+ IF (REMIT) THEN
+C---3-BODY FINAL STATE
+C---SET COLOUR CONNECTIONS
+ IF (IC.LE.18) THEN
+ DO I=1,5
+ CALL UPCODE(ICOL5(I,IC),ICOLUP(1,I))
+ ENDDO
+ ELSE
+ CALL HWWARN('UPEVNT',105,*999)
+ ENDIF
+ ELSE
+C---2-BODY FINAL STATE
+ CALL HWVEQU(5,PUP(1,4),PUP(1,3))
+ CALL HWVEQU(5,PUP(1,5),PUP(1,4))
+C---SET COLOUR CONNECTIONS
+ IF (IC.LE.4) THEN
+ DO I=1,4
+ CALL UPCODE(ICOL4(I,IC),ICOLUP(1,I))
+ ENDDO
+ ELSE
+ CALL HWWARN('UPEVNT',104,*999)
+ ENDIF
+ ENDIF
+ IHVY=MOD(IDPRUP,100)
+ IDUP(NUP-1)=IHVY
+ IDUP(NUP)=-IHVY
+ ELSE
+C---GAUGE BOSON PAIR
+ IF (REMIT) THEN
+C---ADD DIBOSON TO EVENT RECORD (TO FIX ITS MASS)
+ 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
+C---SET COLOUR CONNECTIONS
+ DO I=1,3
+ ICOLUP(1,I)=501
+ ICOLUP(2,I)=502
+ ENDDO
+ IF (IHPRO.EQ.1) THEN
+ ICOLUP(2,1)=0
+ ICOLUP(1,2)=0
+ ELSEIF (IHPRO.EQ.2) THEN
+ ICOLUP(1,1)=502
+ ICOLUP(2,1)=0
+ ICOLUP(2,3)=0
+ ELSEIF (IHPRO.EQ.3) THEN
+ ICOLUP(1,1)=0
+ ICOLUP(2,2)=0
+ ELSEIF (IHPRO.EQ.4) THEN
+ ICOLUP(1,1)=0
+ ICOLUP(2,1)=501
+ ICOLUP(1,3)=0
+ ELSEIF (IHPRO.EQ.5) THEN
+ ICOLUP(1,2)=502
+ ICOLUP(2,2)=0
+ ICOLUP(2,3)=0
+ ELSEIF (IHPRO.EQ.6) THEN
+ ICOLUP(1,2)=0
+ ICOLUP(2,2)=501
+ ICOLUP(1,3)=0
+ ELSE
+ CALL HWWARN('UPEVT',101,*999)
+ ENDIF
+ DO I=4,6
+ 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))
+C---SET COLOUR CONNECTIONS
+ DO I=1,4
+ ICOLUP(1,I)=0
+ ICOLUP(2,I)=0
+ ENDDO
+ IF (IDUP(1).GT.0) THEN
+ ICOLUP(1,1)=501
+ ICOLUP(2,2)=501
+ ELSE
+ ICOLUP(2,1)=501
+ 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)
+ 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
+C----------------------------------------------------------------------
+ SUBROUTINE UPCODE(ICODE,ICOL)
+C--DECODES COLOUR CONNECTIONS
+C----------------------------------------------------------------------
+ IMPLICIT NONE
+ INTEGER ICODE,ICOL(2)
+ ICOL(1)=ICODE/10
+ IF (ICOL(1).NE.0) ICOL(1)=ICOL(1)+500
+ ICOL(2)=MOD(ICODE,10)
+ IF (ICOL(2).NE.0) ICOL(2)=ICOL(2)+500
+ END
+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----------------------------------------------------------------------
+ INCLUDE 'HERWIG65.INC'
+C--Les Houches Common Blocks
+ INTEGER MAXPUP
+ PARAMETER(MAXPUP=100)
+ INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
+ DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
+ COMMON /HEPRUP/ IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
+ & IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),
+ & XMAXUP(MAXPUP),LPRUP(MAXPUP)
+ INTEGER MAXNUP
+ PARAMETER (MAXNUP=500)
+ INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP
+ DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP
+ COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,
+ & IDUP(MAXNUP),ISTUP(MAXNUP),MOTHUP(2,MAXNUP),
+ & ICOLUP(2,MAXNUP),PUP(5,MAXNUP),VTIMUP(MAXNUP),
+ & 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
+ CHARACTER*60 TMPSTR
+ CHARACTER*4 STRP1,STRP2
+ CHARACTER*8 STRGRP
+ CHARACTER*2 STRSCH
+ CHARACTER*50 QQIN
+ LOGICAL FK88STRNOEQ
+ DATA TINY/1.D-3/
+ COMMON/NQQCOM/MQQ,NQQ
+ COMMON/VVJIN/QQIN
+C
+ PRINT*,'UPINIT'
+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
+ JPR0=MOD(ABS(IPROC),10000)
+ JPR=JPR0/100
+ IF (JPR.NE.IVVCODE/100) CALL HWWARN('UPINIT',500,*999)
+ 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
+ READ(61,808)EMMIN,EMMAX,TMPSTR
+ ELSE
+ READ(61,809)XMV,GAH,GAMMAX,TMPSTR
+ ENDIF
+C-- CHECK VECTOR BOSON MASS
+ IF( (IVVCODE.EQ.1397.AND.ABS(XMV-RMASS(200)).GT.TINY) .OR.
+ # (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.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)
+ ELSEIF (JPR.EQ.16.OR.JPR.EQ.36) THEN
+ READ(61,809)XMH,GAH,XMT,TMPSTR
+C-- CHECK HIGGS AND TOP MASSES
+ IH=201
+ IF (JPR.EQ.36) IH=IVVCODE/10-158
+ IF(ABS(XMH-RMASS(IH)).GT.TINY) CALL HWWARN('UPINIT',503,*999)
+ IF(ABS(XMT-RMASS(6)) .GT.TINY) CALL HWWARN('UPINIT',504,*999)
+ ELSEIF (JPR.EQ.17) THEN
+ READ(61,803)XMT,TMPSTR
+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
+ ELSE
+ CALL HWWARN('UPINIT',506,*999)
+ ENDIF
+ READ(61,804)XM1,XM2,XM3,XM4,XM5,XM21,TMPSTR
+ 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--HERWIG PARAMETERS ADOPTED HERE
+ IFAIL=0
+C-- CM ENERGY
+ IF( ABS(XCKECM-PBEAM1-PBEAM2).GT.TINY .OR.
+C-- QUARK AND GLUON MASSES
+ # ABS(XM1-RMASS(1)).GT.TINY .OR.
+ # ABS(XM2-RMASS(2)).GT.TINY .OR.
+ # ABS(XM3-RMASS(3)).GT.TINY .OR.
+ # ABS(XM4-RMASS(4)).GT.TINY .OR.
+ # ABS(XM5-RMASS(5)).GT.TINY .OR.
+ # 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-- 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
+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
+ ENDIF
+ IF(IFAIL.EQ.1) CALL HWWARN('UPINIT',507,*999)
+ CALL HWUIDT(3,IDBMUP(1),IHW,PART1)
+ CALL HWUIDT(3,IDBMUP(2),IHW,PART2)
+ DO I=1,2
+ EBMUP(I)=HALF*XCKECM
+ PDFGUP(I)=-1
+ PDFSUP(I)=-1
+ ENDDO
+ IDWTUP=-4
+ NPRUP=1
+ LPRUP(1)=IVVCODE
+ READ(61,900) MQQ
+ NQQ=0
+ NUP=6
+ 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)
+ 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)
+ 900 FORMAT(I9)
+ 999 END
+
+
git://git.uio.no / u / mrichter / AliRoot.git / blobdiff