Obsolete version removed
authormorsch <morsch@f7af4fe6-9843-0410-8265-dc069ae4e863>
Mon, 26 Jun 2006 12:19:21 +0000 (12:19 +0000)
committermorsch <morsch@f7af4fe6-9843-0410-8265-dc069ae4e863>
Mon, 26 Jun 2006 12:19:21 +0000 (12:19 +0000)
123 files changed:
HERWIG/src/decadd.f [deleted file]
HERWIG/src/eudini.f [deleted file]
HERWIG/src/fragmt.f [deleted file]
HERWIG/src/hvcbvi.f [deleted file]
HERWIG/src/hvhbvi.f [deleted file]
HERWIG/src/hwbazf.f [deleted file]
HERWIG/src/hwbcon.f [deleted file]
HERWIG/src/hwbfin.f [deleted file]
HERWIG/src/hwbran.f [deleted file]
HERWIG/src/hwbrc2.f [deleted file]
HERWIG/src/hwbspa.f [deleted file]
HERWIG/src/hwbspn.f [deleted file]
HERWIG/src/hwbsu1.f [deleted file]
HERWIG/src/hwbsu2.f [deleted file]
HERWIG/src/hwbsud.f [deleted file]
HERWIG/src/hwbsul.f [deleted file]
HERWIG/src/hwbtim.f [deleted file]
HERWIG/src/hwcbct.f [deleted file]
HERWIG/src/hwccut.f [deleted file]
HERWIG/src/hwcfor.f [deleted file]
HERWIG/src/hwdcle.f [deleted file]
HERWIG/src/hwdhgf.f [deleted file]
HERWIG/src/hwdhig.f [deleted file]
HERWIG/src/hwdpwt.f [deleted file]
HERWIG/src/hwdrm3.f [deleted file]
HERWIG/src/hwdrm4.f [deleted file]
HERWIG/src/hwdrm5.f [deleted file]
HERWIG/src/hwdthr.f [deleted file]
HERWIG/src/hwdtwo.f [deleted file]
HERWIG/src/hwdwwt.f [deleted file]
HERWIG/src/hwdxlm.f [deleted file]
HERWIG/src/hwegam.f [deleted file]
HERWIG/src/hwhbgf.f [deleted file]
HERWIG/src/hwhbsg.f [deleted file]
HERWIG/src/hwhdis.f [deleted file]
HERWIG/src/hwhew1.f [deleted file]
HERWIG/src/hwhew2.f [deleted file]
HERWIG/src/hwhew3.f [deleted file]
HERWIG/src/hwhew4.f [deleted file]
HERWIG/src/hwhew5.f [deleted file]
HERWIG/src/hwheww.f [deleted file]
HERWIG/src/hwhiga.f [deleted file]
HERWIG/src/hwhigb.f [deleted file]
HERWIG/src/hwhigj.f [deleted file]
HERWIG/src/hwhigw.f [deleted file]
HERWIG/src/hwhigz.f [deleted file]
HERWIG/src/hwhppe.f [deleted file]
HERWIG/src/hwhqpm.f [deleted file]
HERWIG/src/hwhrbb.f [deleted file]
HERWIG/src/hwhss1.f [deleted file]
HERWIG/src/hwhssg.f [deleted file]
HERWIG/src/hwhssq.f [deleted file]
HERWIG/src/hwhv1j.f [deleted file]
HERWIG/src/hwissp.f [deleted file]
HERWIG/src/hwmodk.f [deleted file]
HERWIG/src/hwmult.f [deleted file]
HERWIG/src/hwrexp.f [deleted file]
HERWIG/src/hwrexq.f [deleted file]
HERWIG/src/hwrext.f [deleted file]
HERWIG/src/hwrgau.f [deleted file]
HERWIG/src/hwrgen.f [deleted file]
HERWIG/src/hwrint.f [deleted file]
HERWIG/src/hwrlog.f [deleted file]
HERWIG/src/hwrpip.f [deleted file]
HERWIG/src/hwrpow.f [deleted file]
HERWIG/src/hwruni.f [deleted file]
HERWIG/src/hwsbrn.f [deleted file]
HERWIG/src/hwsdgq.f [deleted file]
HERWIG/src/hwsfbr.f [deleted file]
HERWIG/src/hwsgen.f [deleted file]
HERWIG/src/hwsgqq.f [deleted file]
HERWIG/src/hwsspc.f [deleted file]
HERWIG/src/hwstab.f [deleted file]
HERWIG/src/hwsval.f [deleted file]
HERWIG/src/hwuaer.f [deleted file]
HERWIG/src/hwualf.f [deleted file]
HERWIG/src/hwuant.f [deleted file]
HERWIG/src/hwuats.f [deleted file]
HERWIG/src/hwubpr.f [deleted file]
HERWIG/src/hwubst.f [deleted file]
HERWIG/src/hwucff.f [deleted file]
HERWIG/src/hwuci2.f [deleted file]
HERWIG/src/hwudat.f [deleted file]
HERWIG/src/hwudkl.f [deleted file]
HERWIG/src/hwudks.f [deleted file]
HERWIG/src/hwudpr.f [deleted file]
HERWIG/src/hwuecm.f [deleted file]
HERWIG/src/hwuedt.f [deleted file]
HERWIG/src/hwueec.f [deleted file]
HERWIG/src/hwufne.f [deleted file]
HERWIG/src/hwuldo.f [deleted file]
HERWIG/src/hwulf4.f [deleted file]
HERWIG/src/hwuli2.f [deleted file]
HERWIG/src/hwulob.f [deleted file]
HERWIG/src/hwulof.f [deleted file]
HERWIG/src/hwulor.f [deleted file]
HERWIG/src/hwumas.f [deleted file]
HERWIG/src/hwumbw.f [deleted file]
HERWIG/src/hwunst.f [deleted file]
HERWIG/src/hwupcm.f [deleted file]
HERWIG/src/hwurap.f [deleted file]
HERWIG/src/hwures.f [deleted file]
HERWIG/src/hwurof.f [deleted file]
HERWIG/src/hwurot.f [deleted file]
HERWIG/src/hwusor.f [deleted file]
HERWIG/src/hwusta.f [deleted file]
HERWIG/src/hwvdif.f [deleted file]
HERWIG/src/hwvdot.f [deleted file]
HERWIG/src/hwvequ.f [deleted file]
HERWIG/src/hwvsca.f [deleted file]
HERWIG/src/hwvsum.f [deleted file]
HERWIG/src/hwvzri.f [deleted file]
HERWIG/src/hwvzro.f [deleted file]
HERWIG/src/hwwarn.f [deleted file]
HERWIG/src/ieupdg.f [deleted file]
HERWIG/src/ipdgeu.f [deleted file]
HERWIG/src/qqinit.f [deleted file]
HERWIG/src/qqlmat.f [deleted file]
HERWIG/src/sasano.f [deleted file]
HERWIG/src/sasbeh.f [deleted file]
HERWIG/src/sasdir.f [deleted file]
HERWIG/src/sasgam.f [deleted file]
HERWIG/src/sasvmd.f [deleted file]

diff --git a/HERWIG/src/decadd.f b/HERWIG/src/decadd.f
deleted file mode 100644 (file)
index f1f2040..0000000
+++ /dev/null
@@ -1,113 +0,0 @@
-C-----------------------------------------------------------------------
-
-C                           H E R W I G
-
-C
-
-C            a Monte Carlo event generator for simulating
-
-C        +---------------------------------------------------+
-
-C        | Hadron Emission Reactions With Interfering Gluons |
-
-C        +---------------------------------------------------+
-
-C I.G. Knowles(*), G. Marchesini(+), M.H. Seymour($) and B.R. Webber(#)
-
-C-----------------------------------------------------------------------
-
-C with Minimal Supersymmetric Standard Model Matrix Elements by
-
-C                  S. Moretti($) and K. Odagiri($)
-
-C-----------------------------------------------------------------------
-
-C R parity violating Supersymmetric Decays and Matrix Elements by
-
-C                          P. Richardson(&)
-
-C-----------------------------------------------------------------------
-
-C matrix element corrections to top decay and Drell-Yan type processes
-
-C                         by G. Corcella(+)
-
-C-----------------------------------------------------------------------
-
-C Deep Inelastic Scattering and Heavy Flavour Electroproduction by
-
-C                  G. Abbiendi(@) and L. Stanco(%)
-
-C-----------------------------------------------------------------------
-
-C and Jet Photoproduction in Lepton-Hadron Collisions by J. Chyla(~)
-
-C-----------------------------------------------------------------------
-
-C(*)  Department of Physics & Astronomy, University of Edinburgh
-
-C(+)  Dipartimento di Fisica, Universita di Milano
-
-C($)  Rutherford Appleton Laboratory
-
-C(#)  Cavendish Laboratory, Cambridge
-
-C(&)  Department of Physics, University of Oxford
-
-C(@)  Dipartimento di Fisica, Universita di Bologna
-
-C(%)  Dipartimento di Fisica, Universita di Padova
-
-C(~)  Institute of Physics, Prague
-
-C-----------------------------------------------------------------------
-
-C                  Version 6.100 - 16th December 1999
-
-C-----------------------------------------------------------------------
-
-C Main reference:
-
-C    G.Marchesini,  B.R.Webber,  G.Abbiendi,  I.G.Knowles,  M.H.Seymour,
-
-C    and L.Stanco, Computer Physics Communications 67 (1992) 465.
-
-C-----------------------------------------------------------------------
-
-C Please send e-mail about  this program  to one of the  authors at the
-
-C following Internet addresses:
-
-C    I.Knowles@ed.ac.uk        Giuseppe.Marchesini@mi.infn.it
-
-C    M.Seymour@rl.ac.uk        webber@hep.phy.cam.ac.uk
-
-C-----------------------------------------------------------------------
-
-CDECK  ID>, DECADD.
-
-*CMZ :-        -28/01/92  12.34.44  by  Mike Seymour
-
-*-- Author :    Luca Stanco
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE DECADD(LOGI)
-
-C-----------------------------------------------------------------------
-
-C     DUMMY SUBROUTINE: DELETE AND SET BDECAY='CLEO'
-
-C     IN MAIN PROGRAM IF YOU USE CLEO DECAY PACKAGE
-
-C-----------------------------------------------------------------------
-
-      LOGICAL LOGI
-
-      WRITE (6,10)
-
-   10 FORMAT(/10X,'DECADD CALLED BUT NOT LINKED')
-
-      STOP
-
-      END
diff --git a/HERWIG/src/eudini.f b/HERWIG/src/eudini.f
deleted file mode 100644 (file)
index 94ba989..0000000
+++ /dev/null
@@ -1,26 +0,0 @@
-
-CDECK  ID>, EUDINI.
-
-*CMZ :-        -28/01/92  12.34.44  by  Mike Seymour
-
-*-- Author :    Luca Stanco
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE EUDINI
-
-C-----------------------------------------------------------------------
-
-C     DUMMY SUBROUTINE: DELETE AND SET BDECAY='EURO'
-
-C     IN MAIN PROGRAM IF YOU USE EURODEC DECAY PACKAGE
-
-C-----------------------------------------------------------------------
-
-      WRITE (6,10)
-
-   10 FORMAT(/10X,'EUDINI CALLED BUT NOT LINKED')
-
-      STOP
-
-      END
diff --git a/HERWIG/src/fragmt.f b/HERWIG/src/fragmt.f
deleted file mode 100644 (file)
index 92bd17a..0000000
+++ /dev/null
@@ -1,28 +0,0 @@
-
-CDECK  ID>, FRAGMT.
-
-*CMZ :-        -28/01/92  12.34.44  by  Mike Seymour
-
-*-- Author :    Luca Stanco
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE FRAGMT(I,J,K)
-
-C-----------------------------------------------------------------------
-
-C     DUMMY SUBROUTINE: DELETE AND SET BDECAY='EURO'
-
-C     IN MAIN PROGRAM IF YOU USE EURODEC DECAY PACKAGE
-
-C-----------------------------------------------------------------------
-
-      INTEGER I,J,K
-
-      WRITE (6,10)
-
-   10 FORMAT(/10X,'FRAGMT CALLED BUT NOT LINKED')
-
-      STOP
-
-      END
diff --git a/HERWIG/src/hvcbvi.f b/HERWIG/src/hvcbvi.f
deleted file mode 100644 (file)
index 1067828..0000000
+++ /dev/null
@@ -1,24 +0,0 @@
-
-CDECK  ID>, HVCBVI.
-
-*CMZ :-        -28/01/92  12.34.44  by  Mike Seymour
-
-*-- Author :    Mike Seymour
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HVCBVI
-
-C-----------------------------------------------------------------------
-
-C     DUMMY ROUTINE: DELETE IF YOU LINK TO BARYON NUMBER VIOLATN PACKAGE
-
-C-----------------------------------------------------------------------
-
-      WRITE (6,10)
-
-   10 FORMAT(/10X,'HVCBVI CALLED BUT NOT LINKED')
-
-      STOP
-
-      END
diff --git a/HERWIG/src/hvhbvi.f b/HERWIG/src/hvhbvi.f
deleted file mode 100644 (file)
index 94f3821..0000000
+++ /dev/null
@@ -1,24 +0,0 @@
-
-CDECK  ID>, HVHBVI.
-
-*CMZ :-        -28/01/92  12.34.44  by  Mike Seymour
-
-*-- Author :    Mike Seymour
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HVHBVI
-
-C-----------------------------------------------------------------------
-
-C     DUMMY ROUTINE: DELETE IF YOU LINK TO BARYON NUMBER VIOLATN PACKAGE
-
-C-----------------------------------------------------------------------
-
-      WRITE (6,10)
-
-   10 FORMAT(/10X,'HERBVI CALLED BUT NOT LINKED')
-
-      STOP
-
-      END
diff --git a/HERWIG/src/hwbazf.f b/HERWIG/src/hwbazf.f
deleted file mode 100644 (file)
index 9449ab3..0000000
+++ /dev/null
@@ -1,142 +0,0 @@
-
-CDECK  ID>, HWBAZF.
-
-*CMZ :-        -26/04/91  11.11.54  by  Bryan Webber
-
-*-- Author :    Ian Knowles
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWBAZF(IPAR,JPAR,VEC1,VEC2,VEC3,VEC)
-
-C-----------------------------------------------------------------------
-
-C     Azimuthal correlation functions for Collins' algorithm,
-
-C     see I.G.Knowles, Comp. Phys. Comm. 58 (90) 271 for notation.
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      DOUBLE PRECISION Z1,Z2,DOT12,DOT23,DOT31,TR,FN(7),VEC1(2),VEC2(2),
-
-     & VEC3(2),VEC(2)
-
-      INTEGER IPAR,JPAR
-
-      LOGICAL GLUI,GLUJ
-
-      IF (.NOT.AZSPIN) RETURN
-
-      Z1=PPAR(4,JPAR)/PPAR(4,IPAR)
-
-      Z2=1.-Z1
-
-      GLUI=IDPAR(IPAR).EQ.13
-
-      GLUJ=IDPAR(JPAR).EQ.13
-
-      IF (GLUI) THEN
-
-         IF (GLUJ) THEN
-
-C           Branching: g--->gg
-
-            FN(2)=Z2/Z1
-
-            FN(3)=1./FN(2)
-
-            FN(4)=Z1*Z2
-
-            FN(1)=FN(2)+FN(3)+FN(4)
-
-            FN(5)=FN(2)+2.*Z1
-
-            FN(6)=FN(3)+2.*Z2
-
-            FN(7)=FN(4)-2.
-
-         ELSE
-
-C           Branching: g--->qqbar
-
-            FN(1)=(Z1*Z1+Z2*Z2)/2.
-
-            FN(2)=0.
-
-            FN(3)=0.
-
-            FN(4)=-Z1*Z2
-
-            FN(5)=-(2.*Z1-1.)/2.
-
-            FN(6)=-FN(5)
-
-            FN(7)=FN(1)
-
-         ENDIF
-
-      ELSE
-
-         IF (GLUJ) THEN
-
-C           Branching: q--->gq
-
-            FN(1)=(1.+Z2*Z2)/(2.*Z1)
-
-            FN(2)=Z2/Z1
-
-            FN(3)=0.
-
-            FN(4)=0.
-
-            FN(5)=FN(1)
-
-            FN(6)=(1.+Z2)/2.
-
-            FN(7)=-FN(6)
-
-         ELSE
-
-C           Branching: q--->qg
-
-            FN(1)=(1.+Z1*Z1)/(2.*Z2)
-
-            FN(2)=0.
-
-            FN(3)=Z1/Z2
-
-            FN(4)=0.
-
-            FN(5)=(1.+Z1)/2.
-
-            FN(6)=FN(1)
-
-            FN(7)=-FN(5)
-
-         ENDIF
-
-      ENDIF
-
-      DOT12=VEC1(1)*VEC2(1)+VEC1(2)*VEC2(2)
-
-      DOT23=VEC2(1)*VEC3(1)+VEC2(2)*VEC3(2)
-
-      DOT31=VEC3(1)*VEC1(1)+VEC3(2)*VEC1(2)
-
-      TR=1./(FN(1)+FN(2)*DOT23+FN(3)*DOT31+FN(4)*DOT12)
-
-      VEC(1)=((FN(2)+FN(5)*DOT23)*VEC1(1)
-
-     &       +(FN(3)+FN(6)*DOT31)*VEC2(1)
-
-     &       +(FN(4)+FN(7)*DOT12)*VEC3(1))*TR
-
-      VEC(2)=((FN(2)+FN(5)*DOT23)*VEC1(2)
-
-     &       +(FN(3)+FN(6)*DOT31)*VEC2(2)
-
-     &       +(FN(4)+FN(7)*DOT12)*VEC3(2))*TR
-
-      END
diff --git a/HERWIG/src/hwbcon.f b/HERWIG/src/hwbcon.f
deleted file mode 100644 (file)
index 6e09842..0000000
+++ /dev/null
@@ -1,2854 +0,0 @@
-
-CDECK  ID>, HWBCON.
-
-*CMZ :-        -26/04/91  10.18.56  by  Bryan Webber
-
-*-- Author :    Bryan Webber
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWBCON
-
-C-----------------------------------------------------------------------
-
-C     MAKES COLOUR CONNECTIONS BETWEEN JETS
-
-C     MODIFIED 12/10/97 BY BRW FOR SUSY PROCESSES
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      INTEGER IHEP,IST,ID,JC,KC,JD,JHEP,LHEP,ID2
-
-      IF (IERROR.NE.0) RETURN
-
-      IF(.NOT.RPARTY) THEN
-
-        CALL HWBRCN
-
-        RETURN
-
-      ENDIF
-
-      DO 20 IHEP=1,NHEP
-
-      IST=ISTHEP(IHEP)
-
-C---LOOK FOR PARTONS WITHOUT COLOUR MOTHERS
-
-      IF (IST.LT.145.OR.IST.GT.152) GOTO 20
-
-      IF (JMOHEP(2,IHEP).EQ.0) THEN
-
-C---FIND COLOUR-CONNECTED PARTON
-
-        JC=JMOHEP(1,IHEP)
-
-        IF (IST.NE.152) JC=JMOHEP(1,JC)
-
-        JC =JMOHEP(2,JC)
-
-        IF (JC.EQ.0) CALL HWWARN('HWBCON',51,*20)
-
-C---FIND SPECTATOR WHEN JC IS DECAYED HEAVY QUARK OR SUSY PARTICLE
-
-        IF (ISTHEP(JC).EQ.155) THEN
-
-          IF (IDHEP(JMOHEP(1,JC)).EQ.94) THEN
-
-C---DECAYED BEFORE HADRONIZING
-
-            JHEP=JMOHEP(2,JC)
-
-            IF (JHEP.EQ.0) GO TO 20
-
-            ID=IDHW(JHEP)
-
-            IF (ISTHEP(JHEP).EQ.155) THEN
-
-C---SPECIAL FOR GLUINO DECAYS
-
-              IF (ID.EQ.449) THEN
-
-                ID=IDHW(JC)
-
-C---N.B. WILL NEED MODS WHEN SUSY PARTICLES CAN SHOWER
-
-                IF (ID.EQ.449.OR.ID.EQ.13.OR.
-
-     &             (ID.GE.401.AND.ID.LE.406).OR.
-
-     &             (ID.GE.413.AND.ID.LE.418).OR.
-
-     &             ID.LE.6.OR.(ID.GE.115.AND.ID.LE.120)) THEN
-
-C---LOOK FOR ANTI(S)QUARK OR GLUON
-
-                  DO KC=JDAHEP(1,JHEP),JDAHEP(2,JHEP)
-
-                    ID=IDHW(KC)
-
-                    IF ((ID.GE.  7.AND.ID.LE. 13).OR.
-
-     &                  (ID.GE.407.AND.ID.LE.412).OR.
-
-     &                  (ID.GE.419.AND.ID.LE.424)) GOTO 5
-
-                  ENDDO
-
-                ELSE
-
-C---LOOK FOR (S)QUARK OR GLUON
-
-                  DO KC=JDAHEP(1,JHEP),JDAHEP(2,JHEP)
-
-                    ID=IDHW(KC)
-
-                    IF (ID.LE.  6.OR. ID.EQ. 13.OR.
-
-     &                 (ID.GE.401.AND.ID.LE.406).OR.
-
-     &                 (ID.GE.413.AND.ID.LE.418)) GOTO 5
-
-                  ENDDO
-
-                ENDIF
-
-C---COULDNT FIND ONE
-
-                CALL HWWARN('HWBCON',101,*999)
-
-    5           JC=KC
-
-              ELSE
-
-C--PR MOD 30/6/99 should fix HWCFOR 104 errors
-
-                ID2 = IDHW(IHEP)
-
-                IF(IDHW(JDAHEP(1,JHEP)).EQ.449.AND.
-
-     &             (ID2.LE.6.OR.(ID2.GE.115.AND.ID2.LE.120).OR.
-
-     &             (ID2.GE.401.AND.ID2.LE.406).OR.ID2.EQ.13.OR.
-
-     &             (ID2.GE.413.AND.ID2.LE.418).OR.ID2.EQ.449)) THEN
-
-                  JC = JDAHEP(1,JHEP)
-
-                ELSE
-
-                  JC=JDAHEP(2,JHEP)
-
-                ENDIF
-
-              ENDIF
-
-            ELSEIF (ID.EQ.6.OR.ID.EQ.12.OR.
-
-     &      (ID.GE.209.AND.ID.LE.218).OR.
-
-     &      (ID.GE.401.AND.ID.LE.424).OR.ID.EQ.449) THEN
-
-C Wait for partner heavy quark to decay
-
-C              RETURN
-
-C---N.B. MAY BE A PROBLEM HERE
-
-              GOTO 20
-
-            ELSE
-
-              JMOHEP(2,IHEP)=JHEP
-
-              JDAHEP(2,JHEP)=IHEP
-
-              GOTO 20
-
-            ENDIF
-
-          ELSE
-
-            JC=JMOHEP(2,JC)
-
-          ENDIF
-
-        ENDIF
-
-        JC=JDAHEP(1,JC)
-
-        JD=JDAHEP(2,JC)
-
-C---SEARCH IN CORRESPONDING JET
-
-        IF (JD.LT.JC) JD=JC
-
-        LHEP=0
-
-        DO 10 JHEP=JC,JD
-
-        IF (ISTHEP(JHEP).LT.145.OR.ISTHEP(JHEP).GT.152) GOTO 10
-
-        IF (JDAHEP(2,JHEP).EQ.IHEP) LHEP=JHEP
-
-        IF (JDAHEP(2,JHEP).NE.0) GOTO 10
-
-C---JOIN IHEP AND JHEP
-
-        JMOHEP(2,IHEP)=JHEP
-
-        JDAHEP(2,JHEP)=IHEP
-
-        GOTO 20
-
-   10   CONTINUE
-
-        IF (LHEP.NE.0) THEN
-
-          JMOHEP(2,IHEP)=LHEP
-
-C        ELSE
-
-C---DIDN'T FIND PARTNER OF IHEP YET
-
-C          CALL HWWARN('HWBCON',52,*20)
-
-        ENDIF
-
-      ENDIF
-
-  20  CONTINUE
-
-C---BREAK COLOUR CONNECTIONS WITH PHOTONS
-
-      IHEP=1
-
-  30  IF (IHEP.LE.NHEP) THEN
-
-        IF (IDHW(IHEP).EQ.59 .AND. ISTHEP(IHEP).EQ.149) THEN
-
-C  BRW FIX 13/03/99
-
-          IF (JMOHEP(2,IHEP).NE.0) THEN
-
-            IF (JDAHEP(2,JMOHEP(2,IHEP)).EQ.IHEP)
-
-     &        JDAHEP(2,JMOHEP(2,IHEP))=JDAHEP(2,IHEP)
-
-          ENDIF
-
-C  END FIX
-
-          IF (JDAHEP(2,IHEP).NE.0) THEN
-
-            IF (JMOHEP(2,JDAHEP(2,IHEP)).EQ.IHEP)
-
-     &        JMOHEP(2,JDAHEP(2,IHEP))=JMOHEP(2,IHEP)
-
-          ENDIF
-
-          JMOHEP(2,IHEP)=IHEP
-
-          JDAHEP(2,IHEP)=IHEP
-
-        ENDIF
-
-        IHEP=IHEP+1
-
-        GOTO 30
-
-      ENDIF
-
-  999 END
-
-CDECK  ID>, HWBDED.
-
-*CMZ :-        -22/04/96  13.54.08  by  Mike Seymour
-
-*-- Author :    Mike Seymour
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWBDED(IOPT)
-
-C     FILL MISSING AREA OF DALITZ PLOT WITH 3-JET AND 2-JET+GAMMA EVENTS
-
-C     IF (IOPT.EQ.1) SET UP EVENT RECORD
-
-C     IF (IOPT.EQ.2) CLEAN UP EVENT RECORD AFTER SHOWERING
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      DOUBLE PRECISION HWBVMC,HWR,HWUALF,HWUSQR,X(3),W,WMAX,WSUM,
-
-     & X1MIN,X1MAX,X2MIN,X2MAX,QSCALE,GAMFAC,GLUFAC,R(3,3),CS,SN,M(3),
-
-     & E(3),LAMBDA,A,B,C,PTSQ,EM,P1(5),P2(5),PVRT(4),EPS,MASDEP
-
-      INTEGER ID,ID3,EMIT,NOEMIT,IEVT,IHEP,JHEP,KHEP,ICMF,IOPT,IEDT(3),
-
-     & I,NDEL
-
-      EXTERNAL HWBVMC,HWR,HWUALF,HWUSQR
-
-      SAVE X,WMAX
-
-      DATA WSUM,WMAX,X1MIN,X1MAX,EMIT,ICMF,IEVT
-
-     & /0.994651,1.84096,0,0.773459,3*0/
-
-      LAMBDA(A,B,C)=(A**2+B**2+C**2-2*A*B-2*B*C-2*C*A)/(4*A)
-
-      IF (IOPT.EQ.1) THEN
-
-C---FIND AN UNTREATED CMF
-
-        IF (IEVT.EQ.NEVHEP+NWGTS) RETURN
-
-        IEVT=0
-
-        ICMF=0
-
-        DO 10 IHEP=1,NHEP
-
- 10       IF (ICMF.EQ.0 .AND. ISTHEP(IHEP).EQ.110 .AND.
-
-     &    JDAHEP(2,IHEP).EQ.JDAHEP(1,IHEP)+1) ICMF=IHEP
-
-        IF (ICMF.EQ.0) RETURN
-
-        EM=PHEP(5,ICMF)
-
-        IF (EM.LT.2*HWBVMC(1)) RETURN
-
-C---GENERATE X1,X2 ACCORDING TO 1/((1-X1)*(1-X2))
-
- 100    CONTINUE
-
-C---CHOOSE X1
-
-        X(1)=1-(1-X1MAX)*((1-X1MIN)/(1-X1MAX))**HWR()
-
-C---CHOOSE X2
-
-        X2MIN=MAX(X(1),1-X(1))
-
-        X2MAX=(4*X(1)-3+2*REAL(  CMPLX(  X(1)**3+135*(X(1)-1)**3,
-
-     &    3*HWUSQR(3*(128*X(1)**4-368*X(1)**3+405*X(1)**2-216*X(1)+54))*
-
-     &    (X(1)-1)  )**(1./3)  ))/3
-
-        IF (X2MAX.GE.ONE.OR.X2MIN.GE.ONE.OR.X2MAX.LE.X2MIN) GOTO 100
-
-        X(2)=1-(1-X2MAX)*((1-X2MIN)/(1-X2MAX))**HWR()
-
-C---CALCULATE WEIGHT
-
-        W=2 * LOG((1-X1MIN)/(1-X1MAX))*LOG((1-X2MIN)/(1-X2MAX)) *
-
-     &    (X(1)**2+X(2)**2)
-
-C---GENERATE UNWEIGHTED (X1,X2) PAIRS (EFFICIENCY IS ~50%)
-
-        IF (WMAX*HWR().GT.W) GOTO 100
-
-C---SYMMETRIZE X1,X2
-
-        X(3)=2-X(1)-X(2)
-
-        IF (HWR().GT.HALF) THEN
-
-          X(1)=X(2)
-
-          X(2)=2-X(3)-X(1)
-
-        ENDIF
-
-C---CHOOSE WHICH PARTON WILL EMIT
-
-        EMIT=1
-
-        IF (HWR().LT.X(1)**2/(X(1)**2+X(2)**2)) EMIT=2
-
-        NOEMIT=3-EMIT
-
-        IHEP=JDAHEP(  EMIT,ICMF)
-
-        JHEP=JDAHEP(NOEMIT,ICMF)
-
-C---PREFACTORS FOR GAMMA AND GLUON CASES
-
-        QSCALE=HWUSQR((1-X(1))*(1-X(2))*(1-X(3)))*EM/X(NOEMIT)
-
-        ID=IDHW(JDAHEP(1,ICMF))
-
-        GAMFAC=ALPFAC*ALPHEM*ICHRG(ID)**2/(18*PIFAC)
-
-        GLUFAC=0
-
-        IF (QSCALE.GT.HWBVMC(13))
-
-     &    GLUFAC=CFFAC/(2*PIFAC)*HWUALF(1,QSCALE)
-
-C---IN FRACTION FAC*WSUM OF EVENTS ADD A GAMMA/GLUON
-
-        IF     (GAMFAC*WSUM .GT. HWR()) THEN
-
-          ID3=59
-
-        ELSEIF (GLUFAC*WSUM .GT. HWR()) THEN
-
-          ID3=13
-
-        ELSE
-
-          EMIT=0
-
-          RETURN
-
-        ENDIF
-
-C---CHECK INFRA-RED CUT-OFF FOR GAMMA/GLUON
-
-        M(1)=HWBVMC(ID)
-
-        M(2)=HWBVMC(ID)
-
-        M(3)=HWBVMC(ID3)
-
-        E(1)=HALF*EM*(X(1)+(M(1)**2-M(2)**2-M(3)**2)/EM**2)
-
-        E(2)=HALF*EM*(X(2)+(M(2)**2-M(3)**2-M(1)**2)/EM**2)
-
-        E(3)=EM-E(1)-E(2)
-
-        PTSQ=-LAMBDA(E(NOEMIT)**2-M(NOEMIT)**2,E(3)**2-M(3)**2,
-
-     &    E(EMIT)**2-M(EMIT)**2)
-
-        IF (PTSQ.LE.ZERO .OR.
-
-     $       E(1).LE.M(1).OR.E(2).LE.M(2).OR.E(3).LE.M(3)) THEN
-
-          EMIT=0
-
-          RETURN
-
-        ENDIF
-
-C---CALCULATE MASS-DEPENDENT SUPRESSION
-
-        IF (MOD(IPROC,10).GT.0) THEN
-
-          EPS=(RMASS(ID)/EM)**2
-
-          MASDEP=X(1)**2+X(2)**2
-
-     $         -4*EPS*X(3)-2*EPS*((1-X(2))/(1-X(1))+(1-X(1))/(1-X(2)))
-
-     $         -4*EPS**2*X(3)**2/((1-X(1))*(1-X(2)))
-
-          IF (MASDEP.LT.HWR()*(X(1)**2+X(2)**2)) THEN
-
-            EMIT=0
-
-            RETURN
-
-          ENDIF
-
-        ENDIF
-
-C---STORE OLD MOMENTA
-
-        CALL HWVEQU(5,PHEP(1,JDAHEP(1,ICMF)),P1)
-
-        CALL HWVEQU(5,PHEP(1,JDAHEP(2,ICMF)),P2)
-
-C---GET THE NON-EMITTING PARTON'S CMF DIRECTION
-
-        CALL HWULOF(PHEP(1,ICMF),PHEP(1,JHEP),PHEP(1,JHEP))
-
-        CALL HWRAZM(ONE,CS,SN)
-
-        CALL HWUROT(PHEP(1,JHEP),CS,SN,R)
-
-        M(1)=PHEP(5,IHEP)
-
-        M(2)=PHEP(5,JHEP)
-
-        M(3)=RMASS(ID3)
-
-C---REORDER ENTRIES: IHEP=EMITTER, JHEP=NON-EMITTER, KHEP=EMITTED
-
-        NHEP=NHEP+1
-
-        IF (IDHW(IHEP).LT.IDHW(JHEP)) THEN
-
-          IHEP=JDAHEP(1,ICMF)
-
-          JHEP=NHEP
-
-        ELSE
-
-          IHEP=NHEP
-
-          JHEP=JDAHEP(1,ICMF)
-
-        ENDIF
-
-        KHEP=JDAHEP(2,ICMF)
-
-C---SET UP MOMENTA
-
-        PHEP(5,JHEP)=M(NOEMIT)
-
-        PHEP(5,IHEP)=M(EMIT)
-
-        PHEP(5,KHEP)=M(3)
-
-        PHEP(4,JHEP)=HALF*EM*(X(NOEMIT)+
-
-     &                  (M(NOEMIT)**2-M(EMIT)**2-M(3)**2)/EM**2)
-
-        PHEP(4,IHEP)=HALF*EM*(X(EMIT)+
-
-     &                  (M(EMIT)**2-M(NOEMIT)**2-M(3)**2)/EM**2)
-
-        PHEP(4,KHEP)=EM-PHEP(4,IHEP)-PHEP(4,JHEP)
-
-        PHEP(3,JHEP)=HWUSQR(PHEP(4,JHEP)**2-PHEP(5,JHEP)**2)
-
-        PHEP(3,IHEP)=( (PHEP(4,KHEP)**2-PHEP(5,KHEP)**2) -
-
-     &    (PHEP(4,IHEP)**2-PHEP(5,IHEP)**2) -
-
-     &    (PHEP(3,JHEP)**2) )*HALF/PHEP(3,JHEP)
-
-        PHEP(3,KHEP)=-PHEP(3,IHEP)-PHEP(3,JHEP)
-
-        PHEP(2,JHEP)=0
-
-        PHEP(2,IHEP)=0
-
-        PHEP(2,KHEP)=0
-
-        PHEP(1,JHEP)=0
-
-        PHEP(1,IHEP)=HWUSQR(PHEP(4,IHEP)**2-
-
-     &    PHEP(3,IHEP)**2-PHEP(5,IHEP)**2)
-
-        PHEP(1,KHEP)=-PHEP(1,IHEP)
-
-C---ORIENT IN CMF, THEN BOOST TO LAB
-
-        CALL HWUROB(R,PHEP(1,IHEP),PHEP(1,IHEP))
-
-        CALL HWUROB(R,PHEP(1,JHEP),PHEP(1,JHEP))
-
-        CALL HWUROB(R,PHEP(1,KHEP),PHEP(1,KHEP))
-
-        CALL HWULOB(PHEP(1,ICMF),PHEP(1,IHEP),PHEP(1,IHEP))
-
-        CALL HWULOB(PHEP(1,ICMF),PHEP(1,JHEP),PHEP(1,JHEP))
-
-        CALL HWULOB(PHEP(1,ICMF),PHEP(1,KHEP),PHEP(1,KHEP))
-
-C---CALCULATE PRODUCTION VERTICES
-
-        CALL HWVZRO(4,VHEP(1,JHEP))
-
-        CALL HWVSUM(4,PHEP(1,IHEP),PHEP(1,KHEP),PVRT)
-
-        CALL HWUDKL(ID,PVRT,VHEP(1,KHEP))
-
-        CALL HWVEQU(4,VHEP(1,KHEP),VHEP(1,IHEP))
-
-C---REORDER ENTRIES: IHEP=QUARK, JHEP=ANTI-QUARK, KHEP=EMITTED
-
-        IF (IHEP.EQ.NHEP) THEN
-
-          IHEP=JHEP
-
-          JHEP=NHEP
-
-        ENDIF
-
-C---STATUS, ID AND POINTERS
-
-        ISTHEP(JHEP)=114
-
-        IDHW(JHEP)=IDHW(KHEP)
-
-        IDHEP(JHEP)=IDHEP(KHEP)
-
-        IDHW(KHEP)=ID3
-
-        IDHEP(KHEP)=IDPDG(ID3)
-
-        JDAHEP(2,ICMF)=JHEP
-
-        JMOHEP(1,JHEP)=ICMF
-
-        JDAHEP(1,JHEP)=0
-
-C---COLOUR CONNECTIONS AND GLUON POLARIZATION
-
-        JMOHEP(2,JHEP)=IHEP
-
-        JDAHEP(2,IHEP)=JHEP
-
-        IF (ID3.EQ.13) THEN
-
-          JMOHEP(2,IHEP)=KHEP
-
-          JMOHEP(2,KHEP)=JHEP
-
-          JDAHEP(2,JHEP)=KHEP
-
-          JDAHEP(2,KHEP)=IHEP
-
-          GPOLN=((1-X(1))**2+(1-X(2))**2)/(4*(1-X(3)))
-
-          GPOLN=1/(1+GPOLN)
-
-        ELSE
-
-          JMOHEP(2,IHEP)=JHEP
-
-          JMOHEP(2,KHEP)=KHEP
-
-          JDAHEP(2,JHEP)=IHEP
-
-          JDAHEP(2,KHEP)=KHEP
-
-        ENDIF
-
-        IEVT=NEVHEP+NWGTS
-
-      ELSEIF (IOPT.EQ.2) THEN
-
-C---MAKE THREE-JET EVENTS FROM THE `DEAD-ZONE' LOOK LIKE TWO-JET EVENTS
-
-        IF (EMIT.EQ.0.OR.IEVT.NE.NEVHEP+NWGTS) THEN
-
-          RETURN
-
-        ELSEIF (EMIT.EQ.1) THEN
-
-          IHEP=JDAHEP(1,JDAHEP(1,ICMF)+1)
-
-          JHEP=JDAHEP(1,JDAHEP(1,ICMF))
-
-        ELSE
-
-          IHEP=JDAHEP(1,JDAHEP(2,ICMF))
-
-          JHEP=JDAHEP(1,JDAHEP(1,ICMF)+1)
-
-          JDAHEP(1,JDAHEP(2,ICMF))=JHEP
-
-          IDHW(JHEP)=IDHW(IHEP)
-
-          IF (ISTHEP(IHEP+1).EQ.100 .AND. ISTHEP(JHEP+1).EQ.100)
-
-     &      CALL HWVEQU(5,PHEP(1,IHEP+1),PHEP(1,JHEP+1))
-
-        ENDIF
-
-        JMOHEP(2,JDAHEP(1,ICMF))=JDAHEP(2,ICMF)
-
-        JDAHEP(2,JDAHEP(1,ICMF))=JDAHEP(2,ICMF)
-
-        JMOHEP(2,JDAHEP(2,ICMF))=JDAHEP(1,ICMF)
-
-        JDAHEP(2,JDAHEP(2,ICMF))=JDAHEP(1,ICMF)
-
-        CALL HWVEQU(5,P1,PHEP(1,JDAHEP(1,ICMF)))
-
-        CALL HWVEQU(5,P2,PHEP(1,JDAHEP(2,ICMF)))
-
-        CALL HWVSUM(4,PHEP(1,IHEP),PHEP(1,JHEP),PHEP(1,JHEP))
-
-        CALL HWUMAS(PHEP(1,JHEP))
-
-        JDAHEP(2,JHEP)=JDAHEP(2,IHEP)
-
-        IEDT(1)=JDAHEP(1,ICMF)+1
-
-        IEDT(2)=IHEP
-
-        IEDT(3)=IHEP+1
-
-        NDEL=3
-
-        IF (ISTHEP(IHEP+1).NE.100) NDEL=2
-
-        CALL HWUEDT(NDEL,IEDT)
-
-        DO 410 I=1,2
-
-          IHEP=JDAHEP(1,JDAHEP(I,ICMF))
-
-          JMOHEP(1,IHEP)=JDAHEP(I,ICMF)
-
-          IF (ISTHEP(IHEP+1).EQ.100) THEN
-
-            JMOHEP(1,IHEP+1)=JMOHEP(1,IHEP)
-
-            JMOHEP(2,IHEP+1)=JMOHEP(2,JMOHEP(1,IHEP))
-
-          ENDIF
-
-          DO 400 JHEP=JDAHEP(1,IHEP),JDAHEP(2,IHEP)
-
-            JMOHEP(1,JHEP)=IHEP
-
- 400      CONTINUE
-
-          CALL HWVZRO(4,VHEP(1,JDAHEP(I,ICMF)))
-
-          CALL HWVZRO(4,VHEP(1,IHEP))
-
-          IF (ISTHEP(IHEP+1).EQ.100) CALL HWVZRO(4,VHEP(1,IHEP+1))
-
- 410    CONTINUE
-
-        EMIT=0
-
-        IEVT=0
-
-      ELSE
-
-        CALL HWWARN('HWBDED',500,*999)
-
-      ENDIF
-
- 999  END
-
-CDECK  ID>, HWBDIS.
-
-*CMZ :-        -17/05/94  09.33.08  by  Mike Seymour
-
-*-- Author :    Mike Seymour
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWBDIS(IOPT)
-
-C-----------------------------------------------------------------------
-
-C     FILL MISSING AREA OF DIS PHASE-SPACE WITH 2+1-JET EVENTS
-
-C     IF (IOPT.EQ.1) SET UP EVENT RECORD
-
-C     IF (IOPT.EQ.2) CLEAN UP EVENT RECORD AFTER SHOWERING
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      DOUBLE PRECISION HWR,HWBVMC,HWUALF,HWULDO,P1(5),P2(5),P3(5),
-
-     & PCMF(5),L(5),R(3,3),Q,XBJ,RN,XPMIN,XPMAX,XP,ZPMIN,ZPMAX,ZP,FAC,
-
-     & X1,X2,XTSQ,XT,PTSQ,SIN1,SIN2,W1,W2,CFAC,PDFOLD(13),PDFNEW(13),
-
-     & PHI,SCALE,Q1(5),Q2(5),DIR1,DIR2,DIR,PM(5),POLD,PNEW,COMINT,
-
-     & BGFINT,COMWGT,C1,C2,CM,B1,B2,BM,PVRT(4)
-
-      INTEGER IOPT,EMIT,ICMF,IHEP,JHEP,IIN,IOUT,ILEP,IHAD,ID,IDNEW,
-
-     & IEDT(3),NDEL,NTRY,ITEMP
-
-      LOGICAL BGF
-
-      EXTERNAL HWR,HWBVMC,HWUALF,HWULDO
-
-      SAVE BGF,IIN,IOUT,ICMF,ID,Q1,Q2,XP,XBJ
-
-      DATA EMIT,COMINT,BGFINT,COMWGT/0,3.9827,1.2462,0.3/
-
-      DATA C1,C2,CM,B1,B2,BM/0.56,0.20,10,0.667,0.167,3/
-
-      IF (IERROR.NE.0) RETURN
-
-      IF (IOPT.EQ.1) THEN
-
-C---FIND AN UNTREATED CMF
-
-        IF (EMIT.EQ.NEVHEP+NWGTS) RETURN
-
-        ICMF=0
-
-        DO 10 IHEP=1,NHEP
-
- 10       IF (ICMF.EQ.0 .AND. ISTHEP(IHEP).EQ.110 .AND.
-
-     &    JDAHEP(2,IHEP).EQ.JDAHEP(1,IHEP)+1) ICMF=IHEP
-
-        IF (ICMF.EQ.0) RETURN
-
-        IIN=JMOHEP(2,ICMF)
-
-        IOUT=JDAHEP(2,ICMF)
-
-        ILEP=JMOHEP(1,ICMF)
-
-        CALL HWVEQU(5,PHEP(1,IIN),P1)
-
-        CALL HWVEQU(5,PHEP(1,IOUT),P2)
-
-        CALL HWVEQU(5,PHEP(1,ILEP),L)
-
-        IHAD=2
-
-        IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD)
-
-        ID=IDHW(IIN)
-
-C---STORE OLD MOMENTA
-
-        CALL HWVEQU(5,P1,Q1)
-
-        CALL HWVEQU(5,P2,Q2)
-
-C---BOOST AND ROTATE THE MOMENTA TO THE BREIT FRAME
-
-        CALL HWVDIF(4,P2,P1,PCMF)
-
-        CALL HWUMAS(PCMF)
-
-        CALL HWVEQU(5,PHEP(1,IHAD),PM)
-
-        Q=-PCMF(5)
-
-        XBJ=HALF*Q**2/HWULDO(PM,PCMF)
-
-        CALL HWVSCA(4,HALF/XBJ,PCMF,PCMF)
-
-        CALL HWVSUM(4,PM,PCMF,PCMF)
-
-        CALL HWUMAS(PCMF)
-
-        CALL HWULOF(PCMF,L,L)
-
-        CALL HWULOF(PCMF,PM,PM)
-
-        CALL HWUROT(PM,ONE,ZERO,R)
-
-        CALL HWUROF(R,L,L)
-
-        PHI=ATAN2(L(2),L(1))
-
-        CALL HWUROT(PM,COS(PHI),SIN(PHI),R)
-
-C---CHOOSE THE HADRONIC-PLANE CONFIGURATION, XP,ZP
-
-        IF (HWR().LT.COMWGT) THEN
-
-C-----CONSIDER GENERATING A QCD COMPTON EVENT
-
-          BGF=.FALSE.
-
-          P3(5)=RMASS(13)
-
- 100      RN=HWR()
-
-          IF (RN.LT.C1) THEN
-
-            ZP=HWR()
-
-            XPMAX=MIN(ZP,1-ZP)
-
-            XP=HWR()*XPMAX
-
-            FAC=1/C1*2*XPMAX/((1-XP)*(1-ZP))*
-
-     $           (1+(1-XP-ZP+2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP)
-
-            IF (HWR().LT.HALF) THEN
-
-              ZPMAX=ZP
-
-              ZP=XP
-
-              XP=ZPMAX
-
-            ENDIF
-
-          ELSEIF (RN.LT.C1+C2) THEN
-
-            XPMAX=0.83
-
-            XP=XPMAX*HWR()
-
-            ZPMIN=MAX(XP,1-XP)
-
-            ZPMAX=1-2./3.*XP*(1+REAL( CMPLX(10-45*XP+18*XP**2,3*SQRT(
-
-     $         3*(9+66*XP-93*XP**2+12*XP**3-8*XP**4+24*XP**5-8*XP**6)))
-
-     $         **(1./3.) * CMPLX(0.5,0.8660254) ))
-
-            ZP=1-((1-ZPMIN)/(1-ZPMAX))**HWR()*(1-ZPMAX)
-
-            FAC=1/C2*XPMAX*LOG((1-ZPMIN)/(1-ZPMAX))/(1-XP)*
-
-     $           (1+(1-XP-ZP+2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP)
-
-          ELSE
-
-            ZPMAX=0.85
-
-            ZP=ZPMAX*HWR()
-
-            XPMIN=MAX(ZP,1-ZP)
-
-            XPMAX=(1+4*ZP*(1-ZP))/(1+6*ZP*(1-ZP))
-
-            XP=1-((1-XPMIN)/(1-XPMAX))**HWR()*(1-XPMAX)
-
-            FAC=1/(1-C1-C2)*ZPMAX*LOG((1-XPMIN)/(1-XPMAX))/(1-ZP)*
-
-     $           (1+(1-XP-ZP+2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP)
-
-          ENDIF
-
-          XPMAX=(1+4*ZP*(1-ZP))/(1+6*ZP*(1-ZP))
-
-          ZPMAX=1-2./3.*XP*(1+REAL( CMPLX(10-45*XP+18*XP**2,3*SQRT(
-
-     $         3*(9+66*XP-93*XP**2+12*XP**3-8*XP**4+24*XP**5-8*XP**6)))
-
-     $         **(1./3.) * CMPLX(0.5,0.8660254) ))
-
-          IF (XP.GT.XPMAX.OR.ZP.GT.ZPMAX.OR.CM*HWR().GT.FAC)
-
-     $         GOTO 100
-
-        ELSE
-
-C-----CONSIDER GENERATING A BGF EVENT
-
-          BGF=.TRUE.
-
-          P3(5)=P1(5)
-
-          P1(5)=RMASS(13)
-
- 110      RN=HWR()
-
-          IF (RN.LT.B1) THEN
-
-            ZP=HWR()
-
-            XPMAX=MIN(ZP,1-ZP)
-
-            XP=HWR()*XPMAX
-
-            FAC=1/B1*2*XPMAX/(1-ZP)*
-
-     $           ((  XP+ZP-2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP
-
-     $           +(1-XP-ZP+2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP)
-
-            IF (HWR().LT.HALF) XP=1-XP
-
-          ELSEIF (RN.LT.B1+B2) THEN
-
-            XPMAX=0.83
-
-            XP=XPMAX*HWR()
-
-            ZPMIN=MAX(XP,1-XP)
-
-            ZPMAX=1-2./3.*XP*(1+REAL( CMPLX(10-45*XP+18*XP**2,3*SQRT(
-
-     $         3*(9+66*XP-93*XP**2+12*XP**3-8*XP**4+24*XP**5-8*XP**6)))
-
-     $         **(1./3.) * CMPLX(0.5,0.8660254) ))
-
-            ZP=1-((1-ZPMIN)/(1-ZPMAX))**HWR()*(1-ZPMAX)
-
-            FAC=1/B2*XPMAX*LOG((1-ZPMIN)/(1-ZPMAX))*
-
-     $           ((  XP+ZP-2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP
-
-     $           +(1-XP-ZP+2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP)
-
-          ELSE
-
-            XPMAX=0.83
-
-            XP=XPMAX*HWR()
-
-            ZPMAX=MIN(XP,1-XP)
-
-            ZPMIN=2./3.*XP*(1+REAL( CMPLX(10-45*XP+18*XP**2,3*SQRT(
-
-     $         3*(9+66*XP-93*XP**2+12*XP**3-8*XP**4+24*XP**5-8*XP**6)))
-
-     $         **(1./3.) * CMPLX(0.5,0.8660254) ))
-
-            ZP=(ZPMAX-ZPMIN)*HWR()+ZPMIN
-
-            FAC=1/(1-B1-B2)*XPMAX*(ZPMAX-ZPMIN)/(1-ZP)*
-
-     $           ((  XP+ZP-2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP
-
-     $           +(1-XP-ZP+2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP)
-
-          ENDIF
-
-          ZPMAX=1-2./3.*XP*(1+REAL( CMPLX(10-45*XP+18*XP**2,3*SQRT(
-
-     $         3*(9+66*XP-93*XP**2+12*XP**3-8*XP**4+24*XP**5-8*XP**6)))
-
-     $         **(1./3.) * CMPLX(0.5,0.8660254) ))
-
-          IF (ZP.GT.ZPMAX.OR.ZP.LT.ONE-ZPMAX.OR.BM*HWR().GT.FAC)
-
-     $         GOTO 110
-
-        ENDIF
-
-C---CALCULATE THE ADDITIONAL FACTORS IN THE WEIGHT
-
-        IF (BGF) THEN
-
-          IDNEW=13
-
-          CFAC=1./2
-
-          FAC=BGFINT/(1-COMWGT)
-
-        ELSE
-
-          IDNEW=ID
-
-          CFAC=4./3
-
-          FAC=COMINT/COMWGT
-
-        ENDIF
-
-        SCALE=Q*SQRT((1-XP)*(1-ZP)*ZP/XP+1)
-
-        ITEMP=ISTAT
-
-        ISTAT=7
-
-        CALL HWSFUN(XBJ,Q,IDHW(IHAD),NSTRU,PDFOLD,2)
-
-        ISTAT=ITEMP
-
-        IF (PDFOLD(ID).LE.ZERO) CALL HWWARN('HWBDIS',100,*999)
-
-        IF (XP.GT.XBJ) THEN
-
-          CALL HWSFUN(XBJ/XP,SCALE,IDHW(IHAD),NSTRU,PDFNEW,2)
-
-          FAC=CFAC/(2*PIFAC) * HWUALF(1,SCALE) * FAC *
-
-     $         PDFNEW(IDNEW)/PDFOLD(ID)
-
-        ELSE
-
-          FAC=0
-
-        ENDIF
-
-C---FOR PHOTON BEAMS, INCLUDE DIRECT PHOTON COUPLING
-
-        IF (IDHW(IHAD).EQ.59) THEN
-
-          ZPMIN=2./3.*XBJ*(1+REAL( CMPLX(10-45*XBJ+18*XBJ**2,3*SQRT(
-
-     $         3*(9+66*XBJ-93*XBJ**2+12*XBJ**3-8*XBJ**4+24*XBJ**5
-
-     $         -8*XBJ**6)))**(1./3.) * CMPLX(0.5,0.8660254) ))
-
-          ZPMAX=1-ZPMIN
-
-          DIR1=(XBJ**2+(1-XBJ)**2)*(LOG(ZPMAX/ZPMIN)-(ZPMAX-ZPMIN))
-
-          DIR2=4*XBJ*(1-XBJ)*(ZPMAX-ZPMIN)
-
-          DIR=QFCH(MOD(ID-1,6)+1)**2*ALPHEM/(2*PIFAC*PDFOLD(ID))*XBJ
-
-     $         *(DIR1+DIR2)
-
-        ELSE
-
-          DIR=0
-
-        ENDIF
-
-C---DECIDE WHETHER TO MAKE AN EVENT HERE
-
-        IF (HWR().GT.FAC+DIR) RETURN
-
-C---FOR DIRECT COUPLING, CHOOSE ZP VALUE
-
-        IF ((FAC+DIR)*HWR().GT.FAC) THEN
-
-          IF ((DIR1+DIR2)*HWR().LT.DIR1) THEN
-
-            NTRY=0
-
- 120        NTRY=NTRY+2
-
-            ZP=1-(ZPMAX/ZPMIN)**HWR()*ZPMIN
-
-            IF ((ZPMIN**2+(1-ZPMIN)**2)*HWR().GT.ZP**2+(1-ZP)**2)
-
-     $           GOTO 120
-
-          ELSE
-
-            ZP=SQRT((ZPMAX-ZPMIN)*HWR()+ZPMIN**2)
-
-          ENDIF
-
-          XP=XBJ
-
-          BGF=.TRUE.
-
-          P3(5)=P2(5)
-
-          P1(5)=0
-
-        ENDIF
-
-        X1=1-   ZP /XP
-
-        X2=1-(1-ZP)/XP
-
-        XTSQ=4*(1-XP)*(1-ZP)*ZP/XP
-
-        XT=SQRT(XTSQ)
-
-        SIN1=XT/SQRT(X1**2+XTSQ)
-
-        SIN2=XT/SQRT(X2**2+XTSQ)
-
-C---CHOOSE THE AZIMUTH BETWEEN THE TWO PLANES
-
-        IF (BGF) THEN
-
-          W1=XP**2*(X1**2+1.5*XTSQ)
-
-        ELSE
-
-          W1=1
-
-        ENDIF
-
-        W2=XP**2*(X2**2+1.5*XTSQ)
-
-        IF (HWR()*(W1+W2).GT.W2) THEN
-
-          IF (BGF) THEN
-
-C-----WEIGHTED BY (1+SIN1*COS(PHI))**2
-
- 200        PHI=(2*HWR()-1)*PIFAC
-
-            IF (HWR()*(1+SIN1)**2.GT.(1+SIN1*COS(PHI))**2) GOTO 200
-
-          ELSE
-
-C-----UNIFORMLY
-
-            PHI=(2*HWR()-1)*PIFAC
-
-          ENDIF
-
-        ELSE
-
-C-----WEIGHTED BY (1-SIN2*COS(PHI))**2
-
- 210      PHI=(2*HWR()-1)*PIFAC
-
-          IF (HWR()*(1+SIN2)**2.GT.(1-SIN2*COS(PHI))**2) GOTO 210
-
-        ENDIF
-
-C---RECONSTRUCT MOMENTA AND BOOST BACK TO LAB
-
-        P1(1)=0
-
-        P1(2)=0
-
-        P1(3)=HALF*Q/XP
-
-        P1(4)=SQRT(P1(3)**2+P1(5)**2)
-
-        PTSQ=((ZP*Q*(P1(4)+P1(3)-Q)-P2(5)**2)*(P1(4)-P1(3)+(1-ZP)*Q)
-
-     $       -P3(5)**2*ZP*Q)/(P1(4)-P1(3)+Q)
-
-C---CHECK INFRARED CUTOFF FOR THIS PARTON TYPE
-
-        IF (PTSQ.LT.MAX(HWBVMC(ID),HWBVMC(IDHW(IOUT)))**2) RETURN
-
-        P2(1)=SQRT(PTSQ)*COS(PHI)
-
-        P2(2)=SQRT(PTSQ)*SIN(PHI)
-
-        P2(3)=-0.5*(ZP*Q-(PTSQ+P2(5)**2)/(ZP*Q))
-
-        P2(4)= 0.5*(ZP*Q+(PTSQ+P2(5)**2)/(ZP*Q))
-
-        P3(1)=P1(1)-P2(1)
-
-        P3(2)=P1(2)-P2(2)
-
-        P3(3)=P1(3)-P2(3)-Q
-
-        P3(4)=P1(4)-P2(4)
-
-        CALL HWUROB(R,P1,P1)
-
-        CALL HWUROB(R,P2,P2)
-
-        CALL HWUROB(R,P3,P3)
-
-        CALL HWULOB(PCMF,P1,P1)
-
-        CALL HWULOB(PCMF,P2,P2)
-
-        CALL HWULOB(PCMF,P3,P3)
-
-C---SPECIAL CASE FOR DIRECT PHOTON - COPY THE EXACT BEAM MOMENTUM
-
-C---SHARE THE MISMATCH EQUALLY BETWEEN THE OUTGOING PARTONS
-
-C---AND PUT THEM BACK ON SHELL
-
-        IF (XP.EQ.XBJ) THEN
-
-          CALL HWVDIF(4,PHEP(1,IHAD),P1,PM)
-
-          CALL HWVSCA(4,HALF,PM,PM)
-
-          CALL HWVSUM(4,PM,P2,P2)
-
-          CALL HWVSUM(4,PM,P3,P3)
-
-          CALL HWUMAS(P2)
-
-          CALL HWUMAS(P3)
-
-          CALL HWVEQU(5,PHEP(1,IHAD),P1)
-
-          CALL HWVSUM(4,P2,P3,PCMF)
-
-          CALL HWUMAS(PCMF)
-
-          POLD=HWULDO(P2,PCMF)**2/PCMF(5)**2-SIGN(P2(5)**2,P2(5))
-
-          PNEW=PCMF(5)**2/4-RMASS(ID)**2
-
-          IF (PCMF(5).LE.ZERO.OR.POLD.LE.ZERO.OR.PNEW.LE.ZERO) RETURN
-
-          CALL HWVSCA(4,SQRT(PNEW/POLD),P2,P2)
-
-          CALL HWVSCA(4,HALF-HWULDO(P2,PCMF)/PCMF(5)**2,PCMF,PM)
-
-          CALL HWVSUM(4,PM,P2,P2)
-
-          CALL HWUMAS(P2)
-
-          CALL HWVDIF(4,PCMF,P2,P3)
-
-          CALL HWUMAS(P3)
-
-        ENDIF
-
-        NHEP=NHEP+1
-
-        CALL HWVEQU(5,P1,PHEP(1,IIN))
-
-        IF (BGF.AND.ID.GT.6.OR..NOT.BGF.AND.ID.LT.7) THEN
-
-          CALL HWVEQU(5,P2,PHEP(1,IOUT))
-
-          CALL HWVEQU(5,P3,PHEP(1,NHEP))
-
-        ELSE
-
-          CALL HWVEQU(5,P3,PHEP(1,IOUT))
-
-          CALL HWVEQU(5,P2,PHEP(1,NHEP))
-
-        ENDIF
-
-        CALL HWVSUM(4,PHEP(1,ILEP),PHEP(1,IIN),PHEP(1,ICMF))
-
-        CALL HWUMAS(PHEP(1,ICMF))
-
-C Decide which quark radiated and assign production vertices
-
-        IF (BGF) THEN
-
-C Boson-Gluon fusion case
-
-          IF (1-ZP.LT.HWR()) THEN
-
-C Gluon splitting to quark
-
-            CALL HWVZRO(4,VHEP(1,NHEP-1))
-
-            CALL HWVDIF(4,PHEP(1,NHEP-4),PHEP(1,NHEP),PVRT)
-
-            CALL HWUDKL(ID,PVRT,VHEP(1,NHEP))
-
-            CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,NHEP-4))
-
-          ELSE
-
-C Gluon splitting to antiquark
-
-            CALL HWVZRO(4,VHEP(1,NHEP))
-
-            CALL HWVDIF(4,PHEP(1,NHEP-4),PHEP(1,NHEP-1),PVRT)
-
-            CALL HWUDKL(ID,PVRT,VHEP(1,NHEP-1))
-
-            CALL HWVEQU(4,VHEP(1,NHEP-1),VHEP(1,NHEP-4))
-
-          ENDIF
-
-        ELSE
-
-C QCD Compton case
-
-          IF (1.LT.HWR()*(1+(1-XP-ZP)**2+6*XP*(1-XP)*ZP*(1-ZP)))THEN
-
-C Incoming quark radiated the gluon
-
-            CALL HWVZRO(4,VHEP(1,NHEP-1))
-
-            CALL HWVDIF(4,PHEP(1,NHEP-4),PHEP(1,NHEP),PVRT)
-
-            CALL HWUDKL(ID,PVRT,VHEP(1,NHEP))
-
-            CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,NHEP-4))
-
-          ELSE
-
-C Outgoing quark radiated the gluon
-
-            CALL HWVZRO(4,VHEP(1,NHEP-4))
-
-            CALL HWVSUM(4,PHEP(1,NHEP-1),PHEP(1,NHEP),PVRT)
-
-            CALL HWUDKL(ID,PVRT,VHEP(1,NHEP))
-
-            CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,NHEP-1))
-
-          ENDIF
-
-        ENDIF
-
-C---STATUS, ID AND POINTERS
-
-        ISTHEP(NHEP)=114
-
-        IF (BGF) THEN
-
-          IF (XP.EQ.XBJ) THEN
-
-            IDHW(IIN)=59
-
-            IDHEP(IIN)=IDPDG(59)
-
-          ELSE
-
-            IDHW(IIN)=13
-
-            IDHEP(IIN)=IDPDG(13)
-
-          ENDIF
-
-          IF (ID.LT.7) THEN
-
-            IDHW(NHEP)=IDHW(IOUT)
-
-            IDHEP(NHEP)=IDHEP(IOUT)
-
-            IDHW(IOUT)=MOD(ID,6)+6
-
-            IDHEP(IOUT)=IDPDG(IDHW(IOUT))
-
-          ELSE
-
-            IDHW(NHEP)=MOD(ID,6)
-
-            IDHEP(NHEP)=IDPDG(IDHW(NHEP))
-
-          ENDIF
-
-        ELSEIF (ID.LT.7) THEN
-
-          IDHW(NHEP)=13
-
-          IDHEP(NHEP)=IDPDG(13)
-
-        ELSE
-
-          IDHW(NHEP)=IDHW(IOUT)
-
-          IDHEP(NHEP)=IDHEP(IOUT)
-
-          IDHW(IOUT)=13
-
-          IDHEP(IOUT)=IDPDG(13)
-
-        ENDIF
-
-        JDAHEP(2,ICMF)=NHEP
-
-        JMOHEP(1,NHEP)=ICMF
-
-C---COLOUR CONNECTIONS
-
-        IF (XP.EQ.XBJ) THEN
-
-          JMOHEP(2,IIN)=IIN
-
-          JDAHEP(2,IIN)=IIN
-
-          JMOHEP(2,IOUT)=NHEP
-
-          JDAHEP(2,IOUT)=NHEP
-
-          JMOHEP(2,NHEP)=IOUT
-
-          JDAHEP(2,NHEP)=IOUT
-
-        ELSE
-
-          JDAHEP(2,IIN)=NHEP
-
-          JDAHEP(2,NHEP)=IOUT
-
-          JMOHEP(2,IOUT)=NHEP
-
-          JMOHEP(2,NHEP)=IIN
-
-        ENDIF
-
-C---FACTORISATION SCALE
-
-        EMSCA=SCALE
-
-        EMIT=NEVHEP+NWGTS
-
-      ELSEIF (IOPT.EQ.2) THEN
-
-C---MAKE TWO-JET EVENTS LOOK LIKE ONE-JET EVENTS
-
-        IF (EMIT.NE.NEVHEP+NWGTS .OR. XP.EQ.XBJ) RETURN
-
-        IF (.NOT.BGF) THEN
-
-          CALL HWVEQU(5,Q1,PHEP(1,IIN))
-
-          CALL HWVEQU(5,Q2,PHEP(1,IOUT))
-
-          JMOHEP(2,IIN)=IOUT
-
-          JDAHEP(2,IIN)=IOUT
-
-          JMOHEP(2,IOUT)=IIN
-
-          JDAHEP(2,IOUT)=IIN
-
-          JDAHEP(2,ICMF)=IOUT
-
-          IHEP=JDAHEP(1,IOUT)
-
-          JHEP=JDAHEP(1,IOUT+1)
-
-          CALL HWVSUM(4,PHEP(1,IHEP),PHEP(1,JHEP),PHEP(1,IHEP))
-
-          CALL HWUMAS(PHEP(1,IHEP))
-
-          JDAHEP(2,IHEP)=JDAHEP(2,JHEP)
-
-          IEDT(1)=IOUT+1
-
-          IEDT(2)=JHEP
-
-          IEDT(3)=JHEP+1
-
-          NDEL=3
-
-          IF (ISTHEP(JHEP+1).NE.100) NDEL=2
-
-          IHEP=JDAHEP(1,IOUT)
-
-          JMOHEP(1,IHEP)=IOUT
-
-          IF (ISTHEP(IHEP+1).EQ.100) THEN
-
-            JMOHEP(1,IHEP+1)=IOUT
-
-            JMOHEP(2,IHEP+1)=IIN
-
-          ENDIF
-
-          DO 300 JHEP=JDAHEP(1,IHEP),JDAHEP(2,IHEP)
-
-            JMOHEP(1,JHEP)=IHEP
-
- 300      CONTINUE
-
-          IF (IDHW(IOUT).EQ.13) IDHW(IOUT)=IDHW(IOUT+1)
-
-          IDHEP(IOUT)=IDPDG(IDHW(IOUT))
-
-          IDHW(IHEP)=IDHW(IOUT)
-
-          CALL HWUEDT(NDEL,IEDT)
-
-        ELSEIF (ID.LT.7) THEN
-
-          CALL HWVEQU(5,Q1,PHEP(1,IIN))
-
-          CALL HWVEQU(5,Q2,PHEP(1,IOUT+1))
-
-          JMOHEP(2,IIN)=IOUT+1
-
-          JDAHEP(2,IIN)=IOUT+1
-
-          JMOHEP(2,IOUT+1)=IIN
-
-          JDAHEP(2,IOUT+1)=IIN
-
-          JDAHEP(2,ICMF)=IOUT+1
-
-          IHEP=JDAHEP(1,IIN)
-
-          JHEP=JDAHEP(1,IOUT)
-
-          CALL HWVDIF(4,PHEP(1,IHEP),PHEP(1,JHEP),PHEP(1,IHEP))
-
-          CALL HWUMAS(PHEP(1,IHEP))
-
-          CALL HWVDIF(4,PHEP(1,ICMF),PHEP(1,JHEP),PHEP(1,ICMF))
-
-          CALL HWUMAS(PHEP(1,ICMF))
-
-          CALL HWUEMV(JDAHEP(2,JHEP)-JDAHEP(1,JHEP)+1,
-
-     $         JDAHEP(1,JHEP),JDAHEP(2,IHEP))
-
-          JHEP=JDAHEP(1,IOUT)
-
-          JDAHEP(2,IHEP)=JDAHEP(2,JHEP)
-
-          IEDT(1)=IOUT
-
-          IEDT(2)=JHEP
-
-          IEDT(3)=JHEP+1
-
-          NDEL=3
-
-          IF (ISTHEP(JHEP+1).NE.100) NDEL=2
-
-          CALL HWUEDT(NDEL,IEDT)
-
-          IHEP=JDAHEP(1,IIN)
-
-          DO 400 JHEP=JDAHEP(1,IHEP),JDAHEP(2,IHEP)
-
-            JMOHEP(1,JHEP)=IHEP
-
- 400      CONTINUE
-
-          IDHW(IIN)=ID
-
-          IDHEP(IIN)=IDPDG(ID)
-
-          IDHW(IHEP)=ID
-
-        ELSE
-
-          CALL HWVEQU(5,Q1,PHEP(1,IIN))
-
-          CALL HWVEQU(5,Q2,PHEP(1,IOUT))
-
-          JMOHEP(2,IIN)=IOUT
-
-          JDAHEP(2,IIN)=IOUT
-
-          JMOHEP(2,IOUT)=IIN
-
-          JDAHEP(2,IOUT)=IIN
-
-          JDAHEP(2,ICMF)=IOUT
-
-          IHEP=JDAHEP(1,IIN)
-
-          JHEP=JDAHEP(1,IOUT+1)
-
-          CALL HWVDIF(4,PHEP(1,IHEP),PHEP(1,JHEP),PHEP(1,IHEP))
-
-          CALL HWUMAS(PHEP(1,IHEP))
-
-          CALL HWVDIF(4,PHEP(1,ICMF),PHEP(1,JHEP),PHEP(1,ICMF))
-
-          CALL HWUMAS(PHEP(1,ICMF))
-
-          CALL HWUEMV(JDAHEP(2,JHEP)-JDAHEP(1,JHEP)+1,
-
-     $         JDAHEP(1,JHEP),JDAHEP(1,IHEP)-1)
-
-          JHEP=JDAHEP(1,IOUT+1)
-
-          JDAHEP(1,IHEP)=JDAHEP(1,JHEP)
-
-          IEDT(1)=IOUT+1
-
-          IEDT(2)=JHEP
-
-          IEDT(3)=JHEP+1
-
-          NDEL=3
-
-          IF (ISTHEP(JHEP+1).NE.100.OR.JHEP.EQ.NHEP) NDEL=2
-
-          CALL HWUEDT(NDEL,IEDT)
-
-          IHEP=JDAHEP(1,IIN)
-
-          DO 500 JHEP=JDAHEP(1,IHEP),JDAHEP(2,IHEP)
-
-            JMOHEP(1,JHEP)=IHEP
-
- 500      CONTINUE
-
-          IDHW(IIN)=ID
-
-          IDHEP(IIN)=IDPDG(ID)
-
-          IDHW(IHEP)=ID
-
-        ENDIF
-
-        CALL HWVZRO(4,VHEP(1,IIN))
-
-        CALL HWVZRO(4,VHEP(1,JDAHEP(1,IIN)))
-
-        IF (ISTHEP(JDAHEP(1,IIN)+1).EQ.100)
-
-     $       CALL HWVZRO(4,VHEP(1,JDAHEP(1,IIN)+1))
-
-        CALL HWVZRO(4,VHEP(1,IOUT))
-
-        CALL HWVZRO(4,VHEP(1,JDAHEP(1,IOUT)))
-
-        IF (ISTHEP(JDAHEP(1,IOUT)+1).EQ.100)
-
-     $       CALL HWVZRO(4,VHEP(1,JDAHEP(1,IOUT)+1))
-
-        EMIT=0
-
-      ELSE
-
-        CALL HWWARN('HWBDIS',500,*999)
-
-      ENDIF
-
- 999  END
-
-CDECK  ID>, HWBDYP.
-
-*CMZ :-        -26/10/99  17.46.56  by  Mike Seymour
-
-*-- Author :    Gennaro Corcella
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWBDYP(IOPT)
-
-C     MATRIX ELEMENT CORRECTIONS TO DRELL-YAN PROCESSES
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      DOUBLE PRECISION HWBVMC,HWR,HWUALF,HWUSQR,PMODK,AZ,CZ,
-
-     & T,U,S,EM,TMIN,TMAX,PMOD2,GLUFAC,SMIN,SMAX,SZ,TEST,
-
-     & JAC,M(3),W1,W,PMOD3,SCAPR,CPHI,SPHI,SCALE,XI1,XI2,
-
-     & PDFOLD1(13),PDFOLD2(13),PDFNEW1(13),PDFNEW2(13),ETA1,ETA2,Y,
-
-     & COMWGT1,COMWGT2,WW,COS3,MODP,RN,BETA1,SIN3,R3(3,3),CTH,STH,M1,
-
-     & M2,M3,GAMMA1,R5(3,3),CW,SW,R4(3,3),SCALE1,X1,X2,X3,MM,
-
-     & PHAD1(5),PHAD2(5),P1(5),P2(5),P3(5),P4(5),PF(5),PV(5),PK(5),
-
-     & PR(5),PNE(5),PE(5),PP1(5),PP2(5),PZ(5),PS(5),PD(5),P2N(5),
-
-     & PBOS(5),PLAB(5),PTOT(5),P3N(5),SVNTN
-
-      LOGICAL GLUIN,GP
-
-      INTEGER EMIT,NOEMIT,IHEP,JHEP,KHEP,ICMF,IOPT,CHEP,
-
-     & ID2,ID1,K,ID4,ID5,IDBOS,IHAD1,IHAD2,NTMP
-
-      EXTERNAL HWBVMC,HWR,HWUALF,HWUSQR
-
-      SAVE ICMF,ID4,ID5
-
-      DATA EMIT,NTMP/2*0/
-
-      IF (IOPT.EQ.1) THEN
-
-        EMIT=0
-
-        NTMP=0
-
-C-----CHOOSE WEIGHTS
-
-        COMWGT1=0.1
-
-        COMWGT2=0.55
-
-C---FIND AN UNTREATED CMF
-
-        ICMF=0
-
-        DO 10 IHEP=1,NHEP
-
- 10     IF (ICMF.EQ.0 .AND. ISTHEP(IHEP).EQ.110.AND.
-
-     &         JDAHEP(2,IHEP).EQ.JDAHEP(1,IHEP)+1) ICMF=IHEP
-
-        IF (ICMF.EQ.0) RETURN
-
-        EM=PHEP(5,ICMF)
-
-C-----SET THE VECTOR BOSON RAPIDITY
-
-        Y=HALF*LOG((PHEP(4,ICMF)+PHEP(3,ICMF))/
-
-     &       (PHEP(4,ICMF)-PHEP(3,ICMF)))
-
-C------SET PARTICLE IDENTIES
-
-c------ID1=QUARK, ID2=ANTIQUARK, IDBOS=VECTOR BOSON, ID4-5 BOSON DECAY
-
-        IDBOS=IDHW(ICMF)
-
-        ID1=IDHW(JMOHEP(1,ICMF))
-
-        ID2=IDHW(JMOHEP(2,ICMF))
-
-        ID4=IDHW(JDAHEP(1,ICMF))
-
-        ID5=IDHW(JDAHEP(2,ICMF))
-
-        M1=RMASS(ID1)
-
-        M2=RMASS(ID2)
-
-        M3=RMASS(13)
-
-C---STORE OLD MOMENTA
-
-C------VECTOR BOSON MOMENTUM
-
-        CALL HWVEQU(5,PHEP(1,ICMF),PBOS)
-
-C----QUARK MOMENTUM
-
-        CALL HWVEQU(5,PHEP(1,JMOHEP(1,ICMF)),P1)
-
-C------ANTIQUARK MOMENTUM
-
-        CALL HWVEQU(5,PHEP(1,JMOHEP(2,ICMF)),P2)
-
-C-------VECTOR DECAY (LEPTON) PRODUCT MOMENTA
-
-        CALL HWVEQU(5,PHEP(1,JDAHEP(1,ICMF)),P3)
-
-        CALL HWVEQU(5,PHEP(1,JDAHEP(2,ICMF)),P4)
-
-C------LEPTON MOMENTA IN THE BOSON REST FRAME
-
-        CALL HWULOF(PHEP(1,ICMF),P2,P2N)
-
-        CALL HWULOF(PHEP(1,ICMF),P3,P3N)
-
-C------AZ=AZIMUTHAL ANGLE OF P3N
-
-        AZ=ATAN2(P3N(2),P3N(1))
-
-        CZ=COS(AZ)
-
-        SZ=SIN(AZ)
-
-C------PHI=ANGLE BETWEEN P2N AND P3N
-
-        SCAPR=P2N(1)*P3N(1)+P2N(2)*P3N(2)+P2N(3)*P3N(3)
-
-        PMOD2=SQRT(P2N(1)**2+P2N(2)**2+P2N(3)**2)
-
-        PMOD3=SQRT(P3N(1)**2+P3N(2)**2+P3N(3)**2)
-
-        CPHI=SCAPR/(PMOD3*PMOD2)
-
-        SPHI=SQRT(1-CPHI**2)
-
-C------HADRON MOMENTA
-
-        IHAD1=1
-
-        IHAD2=2
-
-        IF (JDAHEP(1,IHAD1).NE.0) IHAD1=JDAHEP(1,IHAD1)
-
-        IF (JDAHEP(1,IHAD2).NE.0) IHAD2=JDAHEP(1,IHAD2)
-
-        CALL HWVEQU(5,PHEP(1,IHAD1),PHAD1)
-
-        CALL HWVEQU(5,PHEP(1,IHAD2),PHAD2)
-
-        CALL HWVSUM(4,PHAD1,PHAD2,PTOT)
-
-        CALL HWUMAS(PTOT)
-
-C------ Q - QBAR ENERGY FRACTIONS (BORN PROCESS)
-
-        ETA1=P1(4)/PHAD1(4)
-
-        ETA2=P2(4)/PHAD2(4)
-
-C------ PDFs FOR THE BORN PROCESS
-
-        CALL HWSFUN(ETA1,EM,IDHW(IHAD1),NSTRU,PDFOLD1,1)
-
-        CALL HWSFUN(ETA2,EM,IDHW(IHAD2),NSTRU,PDFOLD2,2)
-
-C-------CONSIDER Q(QBAR) IN THE INITIAL STATE
-
-        RN=HWR()
-
-        IF (RN.LT.COMWGT1) THEN
-
-C-------NO GLUON IN THE INITIAL STATE
-
-          GLUIN=.FALSE.
-
-C---CHOOSE S ACCORDING TO 1/S**2
-
-          SVNTN=17
-
-          SMIN=HALF*EM**2*(7-SQRT(SVNTN))
-
-          SMAX=PTOT(5)**2
-
-          IF (SMAX.LE.SMIN) RETURN
-
-          S=SMIN*SMAX/(SMIN+HWR()*(SMAX-SMIN))
-
-          JAC=S**2*(1/SMIN-1/SMAX)
-
-C---CHOOSE T ACCORDING TO (S-EM**2)/(T*U)=1/T+1/U
-
-          TMAX=-HALF*EM**2*(3-HWUSQR(1+8*EM**2/S))
-
-          TMIN=EM**2-S-TMAX
-
-          IF (TMAX.LE.TMIN) RETURN
-
-          T=TMAX*(TMIN/TMAX)**HWR()
-
-          IF (HWR().GT.HALF) T=EM**2-S-T
-
-          U=EM**2-S-T
-
-          JAC=JAC*2*T*U/(S-EM**2)*LOG(TMIN/TMAX)
-
-          SCALE=SQRT(U*T/S)
-
-          SCALE1=SQRT(U*T/S+EM**2)
-
-          GLUFAC=0
-
-          IF (SCALE1.GT.HWBVMC(13)) GLUFAC=HWUALF(1,SCALE1)/(2*PIFAC)
-
-C----Q-QBAR ENERGY FRACTIONS FOR Q QBAR-> VG
-
-          XI1=(HALF/PHAD1(4))*EXP(Y)*SQRT(S*(S+T)/(S+U))
-
-          XI2=S/(4*XI1*PHAD1(4)*PHAD2(4))
-
-          IF (XI1.GE.1.OR.XI2.GE.1) RETURN
-
-C-----PDFs WITH AN EMITTED GLUON
-
-          CALL HWSFUN(XI1,SCALE,IDHW(IHAD1),NSTRU,PDFNEW1,1)
-
-          CALL HWSFUN(XI2,SCALE,IDHW(IHAD2),NSTRU,PDFNEW2,2)
-
-C------CALCULATE WEIGHT
-
-          W=JAC*((EM**2-T)**2+(EM**2-U)**2)/(S**2*T*U)
-
-          W1=(GLUFAC/COMWGT1)*W*PDFNEW1(ID1)*PDFNEW2(ID2)/(PDFOLD1(ID1)*
-
-     &         PDFOLD2(ID2))*(CFFAC*ETA1*ETA2/(XI1*XI2))
-
-C-------CHOOSE WHICH PARTON WILL EMIT
-
-          EMIT=1
-
-          IF (HWR().LT.(EM**2-U)**2/((EM**2-U)**2+(EM**2-T)**2))
-
-     &         EMIT=2
-
-          NOEMIT=3-EMIT
-
-        ELSE
-
-C--------GLUON IN THE INITIAL STATE
-
-          GLUIN=.TRUE.
-
-C---CHOOSE S ACCORDING TO 1/S**2
-
-          SMIN=EM**2
-
-          SMAX=PTOT(5)**2
-
-          IF (SMAX.LE.SMIN) RETURN
-
-          S=SMIN*SMAX/(SMIN+HWR()*(SMAX-SMIN))
-
-          JAC=S**2*(1/SMIN-1/SMAX)
-
-C---CHOOSE T ACCORDING TO 1/T
-
-          TMAX=-HALF*EM**2*(3-HWUSQR(1+8*EM**2/S))
-
-          TMIN=EM**2-S
-
-          IF (TMAX.LE.TMIN) RETURN
-
-          T=TMAX*(TMIN/TMAX)**HWR()
-
-          JAC=JAC*T*LOG(TMAX/TMIN)
-
-          U=EM**2-S-T
-
-          SCALE=SQRT(U*T/S)
-
-          SCALE1=SQRT(U*T/S+EM**2)
-
-          GLUFAC=0
-
-          IF (SCALE1.GT.HWBVMC(13)) GLUFAC=HWUALF(1,SCALE1)/(2*PIFAC)
-
-C--------INITIAL STATE GLUON COMING FROM HADRON 1
-
-          IF (RN.LE.COMWGT2) THEN
-
-            GP=.TRUE.
-
-C--------ENERGY FRACTIONS and PDFs
-
-            XI1=(HALF/PHAD1(4))*EXP(Y)*SQRT(S*(S+U)/(S+T))
-
-            XI2=S/(4*XI1*PHAD1(4)*PHAD2(4))
-
-            IF (XI1.GE.1.OR.XI2.GE.1) RETURN
-
-            CALL HWSFUN(XI1,SCALE,IDHW(IHAD1),NSTRU,PDFNEW1,1)
-
-            CALL HWSFUN(XI2,SCALE,IDHW(IHAD2),NSTRU,PDFNEW2,2)
-
-            WW=PDFNEW1(13)*PDFNEW2(ID2)/((COMWGT2-COMWGT1)*
-
-     &           PDFOLD1(ID1)*PDFOLD2(ID2))
-
-          ELSE
-
-C-------INITIAL STATE GLUON COMING FROM HADRON 2
-
-            GP=.FALSE.
-
-C-------ENERGY FRACTIONS AND PDFs
-
-            XI1=(HALF/PHAD1(4))*EXP(Y)*SQRT(S*(S+T)/(S+U))
-
-            XI2=S/(4*XI1*PHAD1(4)*PHAD2(4))
-
-            IF (XI1.GE.1.OR.XI2.GE.1) RETURN
-
-            CALL HWSFUN(XI1,SCALE,IDHW(IHAD1),NSTRU,PDFNEW1,1)
-
-            CALL HWSFUN(XI2,SCALE,IDHW(IHAD2),NSTRU,PDFNEW2,2)
-
-            WW=PDFNEW1(ID1)*PDFNEW2(13)/((1-COMWGT2)*
-
-     &           PDFOLD1(ID1)*PDFOLD2(ID2))
-
-          ENDIF
-
-          W=-HALF*JAC*((EM**2-T)**2+(EM**2-S)**2)/(S**3*T)
-
-C-------CHOOSE WHICH PARTON WILL EMIT
-
-          EMIT=1
-
-          IF (HWR().LT.(EM**2-S)**2/((EM**2-S)**2+(EM**2-T)**2))
-
-     &         EMIT=2
-
-          NOEMIT=3-EMIT
-
-C-------FINAL WEIGHT FOR ALL THE CONSIDERED OPTIONS
-
-          W1=GLUFAC*W*WW*ETA1*ETA2/(XI1*XI2)
-
-        ENDIF
-
-C--------ADD ONE MORE GLUON
-
-        IF (W1.GT.HWR()) THEN
-
-          NTMP=NEVHEP+NWGTS
-
-        ELSE
-
-          RETURN
-
-        ENDIF
-
-C---------INCLUDE MASSES
-
-        S=S+M1**2+M2**2+M3**2
-
-        IF (.NOT.GLUIN) THEN
-
-          TEST=((S+M1**2-M2**2)*(S+M3**2-EM**2)-2*S*(M1**2+M3**2-T))**2
-
-     $         -((S-M1**2-M2**2)**2-4*M1**2*M2**2)*
-
-     $         ((S-M3**2-EM**2)**2-4*M3**2*EM**2)
-
-        ELSEIF (GP) THEN
-
-          TEST=((S+M3**2-M2**2)*(S+M1**2-EM**2)-2*S*(M3**2+M1**2-T))**2
-
-     $         -((S-M3**2-M2**2)**2-4*M3**2*M2**2)*
-
-     $         ((S-M1**2-EM**2)**2-4*M1**2*EM**2)
-
-        ELSE
-
-          TEST=((S+M3**2-M1**2)*(S+M2**2-EM**2)-2*S*(M3**2+M2**2-T))**2
-
-     $         -((S-M3**2-M1**2)**2-4*M3**2*M1**2)*
-
-     $         ((S-M2**2-EM**2)**2-4*M2**2*EM**2)
-
-        ENDIF
-
-        IF (TEST.GE.0) THEN
-
-          EMIT=0
-
-          RETURN
-
-        ENDIF
-
-        M(1)=M1
-
-        M(2)=M2
-
-        M(3)=M3
-
-C----MOMENTA IN THE V-REST FRAME WITH NON EMITTER ALONG THE Z AXIS
-
-C----V=BOSON,K=GLUON,E=EMITTER,NE=NON-EMITTER
-
-        PV(1)=0
-
-        PV(2)=0
-
-        PV(3)=0
-
-        PV(4)=EM
-
-        PV(5)=EM
-
-        PNE(2)=0
-
-        PNE(1)=0
-
-        IF (.NOT.GLUIN) THEN
-
-          PK(4)=(S-M(3)**2-EM**2)/(2*EM)
-
-          PMODK=SQRT(PK(4)**2-M(3)**2)
-
-          IF (EMIT.EQ.1) THEN
-
-            MM=M(1)
-
-            X1=T
-
-            X2=U
-
-            X3=-1
-
-          ELSE
-
-            MM=M(2)
-
-            X1=U
-
-            X2=T
-
-            X3=+1
-
-          ENDIF
-
-          PNE(4)=(EM**2+MM**2-X1)/(2*EM)
-
-          PNE(3)=X3*SQRT(PNE(4)**2-MM**2)
-
-          COS3=HALF*(X2-MM**2-M(3)**2+2*PNE(4)*PK(4))/(PNE(3)*PMODK)
-
-        ELSE
-
-          PK(4)=(EM**2+M(3)**2-U)/(2*EM)
-
-          PMODK=SQRT(PK(4)**2-M(3)**2)
-
-          IF (EMIT.EQ.1) THEN
-
-            IF (GP) THEN
-
-              MM=M(1)
-
-              X3=+1
-
-            ELSE
-
-              MM=M(2)
-
-              X3=-1
-
-            ENDIF
-
-            PNE(4)=(S-MM**2-EM**2)/(2*EM)
-
-            PNE(3)=X3*SQRT(PNE(4)**2-MM**2)
-
-            COS3=HALF*(T-MM**2-M(3)**2+2*PNE(4)*PK(4))/(PNE(3)*PMODK)
-
-          ELSE
-
-            IF (GP) THEN
-
-              MM=M(2)
-
-              X3=-1
-
-            ELSE
-
-              MM=M(1)
-
-              X3=+1
-
-            ENDIF
-
-            PNE(4)=(EM**2+MM**2-T)/(2*EM)
-
-            PNE(3)=X3*SQRT(PNE(4)**2-MM**2)
-
-            COS3=HALF*(MM**2+M(3)**2-S+2*PNE(4)*PK(4))/(PNE(3)*PMODK)
-
-          ENDIF
-
-        ENDIF
-
-        CALL HWUMAS(PNE)
-
-        SIN3=SQRT(1-COS3**2)
-
-C---------DEFINE A RANDOM ROTATION AROUND THE Z-AXIS
-
-        CALL HWRAZM(PMODK*SIN3,PK(1),PK(2))
-
-        PK(3)=PMODK*COS3
-
-        CALL HWUMAS(PK)
-
-        DO K=1,4
-
-          IF (.NOT.GLUIN) THEN
-
-            PE(K)=PV(K)+PK(K)-PNE(K)
-
-          ELSE
-
-            IF (EMIT.EQ.1) THEN
-
-              PE(K)=PV(K)+PNE(K)-PK(K)
-
-            ELSE
-
-              PE(K)=PNE(K)+PK(K)-PV(K)
-
-            ENDIF
-
-          ENDIF
-
-        ENDDO
-
-        CALL HWUMAS(PE)
-
-c------LEPTON MOMENTA IN THE BOSON REST FRAME, WITH THE DIRECTION
-
-C------TAKEN FROM THE BORN PROCESS
-
-        PS(5)=P3(5)
-
-        PS(4)=(EM**2+P3(5)**2-P4(5)**2)/(2*EM)
-
-        PS(3)=-SQRT(PS(4)**2-P3(5)**2)*CPHI
-
-        PS(2)=SQRT(PS(4)**2-P3(5)**2)*SPHI*SZ
-
-        PS(1)=SQRT(PS(4)**2-P3(5)**2)*SPHI*CZ
-
-        PF(5)=P4(5)
-
-        PF(4)=(EM**2+P4(5)**2-P3(5)**2)/(2*EM)
-
-        PF(3)=-PS(3)
-
-        PF(2)=-PS(2)
-
-        PF(1)=-PS(1)
-
-C----FIND A STATIONARY VECTOR PLAB IN THE LAB FRAME
-
-        IF (.NOT.GLUIN) THEN
-
-          IF (EMIT.EQ.1) THEN
-
-            CALL HWVEQU(5,PE,PP1)
-
-            CALL HWVEQU(5,PNE,PP2)
-
-          ELSE
-
-            CALL HWVEQU(5,PNE,PP1)
-
-            CALL HWVEQU(5,PE,PP2)
-
-          ENDIF
-
-        ELSE
-
-          IF (GP) THEN
-
-            CALL HWVEQU(5,PK,PP1)
-
-            IF (EMIT.EQ.1) THEN
-
-              CALL HWVEQU(5,PE,PP2)
-
-            ELSE
-
-              CALL HWVEQU(5,PNE,PP2)
-
-            ENDIF
-
-          ELSE
-
-            CALL HWVEQU(5,PK,PP2)
-
-            IF (EMIT.EQ.1) THEN
-
-              CALL HWVEQU(5,PE,PP1)
-
-            ELSE
-
-              CALL HWVEQU(5,PNE,PP1)
-
-            ENDIF
-
-          ENDIF
-
-        ENDIF
-
-        CALL HWVSCA(4,1/XI1,PP1,PP1)
-
-        CALL HWVSCA(4,1/XI2,PP2,PP2)
-
-        CALL HWVSUM(4,PP1,PP2,PLAB)
-
-        CALL HWUMAS(PLAB)
-
-C------BOOST TO PLAB REST FRAME
-
-        CALL HWULOF(PLAB,PE,PE)
-
-        CALL HWULOF(PLAB,PNE,PNE)
-
-        CALL HWULOF(PLAB,PK,PK)
-
-        CALL HWULOF(PLAB,PS,PS)
-
-        CALL HWULOF(PLAB,PF,PF)
-
-        CALL HWULOF(PLAB,PV,PV)
-
-C----PUT THE INITIAL PARTON BELONGING TO HADRON 1 ON THE Z-AXIS
-
-        IF (.NOT.GLUIN) THEN
-
-          IF (EMIT.EQ.1) THEN
-
-            CALL HWVEQU(5,PE,PZ)
-
-          ELSE
-
-            CALL HWVEQU(5,PNE,PZ)
-
-          ENDIF
-
-        ELSE
-
-          IF (GP) THEN
-
-            CALL HWVEQU(5,PK,PZ)
-
-          ELSE
-
-            IF (EMIT.EQ.1) THEN
-
-              CALL HWVEQU(5,PE,PZ)
-
-            ELSE
-
-              CALL HWVEQU(5,PNE,PZ)
-
-            ENDIF
-
-          ENDIF
-
-        ENDIF
-
-        MODP=SQRT(PZ(1)**2+PZ(2)**2)
-
-        CTH=PZ(1)/MODP
-
-        STH=PZ(2)/MODP
-
-        CALL HWUROT(PZ,CTH,STH,R3)
-
-C-----ROTATE EVERYTHING BY R3
-
-        CALL HWUROF(R3,PE,PE)
-
-        CALL HWUROF(R3,PNE,PNE)
-
-        CALL HWUROF(R3,PV,PV)
-
-        CALL HWUROF(R3,PK,PK)
-
-        CALL HWUROF(R3,PS,PS)
-
-        CALL HWUROF(R3,PF,PF)
-
-C--REORDER ENTRIES:--IHEP=EMITTER,JHEP=NON-EMITTER,KHEP=EMITTED
-
-        IF (.NOT.GLUIN) THEN
-
-          IHEP=JMOHEP(EMIT,ICMF)
-
-          JHEP=JMOHEP(NOEMIT,ICMF)
-
-        ENDIF
-
-        CHEP=ICMF
-
-        IDHW(CHEP)=15
-
-        IDHEP(CHEP)=IDPDG(15)
-
-        ICMF=ICMF+1
-
-        IDHW(ICMF)=IDBOS
-
-        IDHEP(ICMF)=IDPDG(IDBOS)
-
-C-----NO GLUON IN THE INITIAL STATE: JUST ADD IT AFTER THE VECTOR BOSON
-
-        IF (.NOT.GLUIN) THEN
-
-          KHEP=ICMF+1
-
-          ISTHEP(KHEP)=114
-
-C---STATUS OF EMITTER/NON EMITTER
-
-          ISTHEP(IHEP)=110+EMIT
-
-          ISTHEP(JHEP)=110+NOEMIT
-
-        ELSE
-
-C-----GLUON COMING FROM THE 1ST HADRON
-
-          IF (GP) THEN
-
-            KHEP=CHEP-2
-
-            ISTHEP(KHEP)=111
-
-C----EMIT=1
-
-            IF (EMIT.EQ.1) THEN
-
-              IHEP=KHEP+1
-
-              ISTHEP(IHEP)=112
-
-              JHEP=ICMF+1
-
-              ISTHEP(JHEP)=114
-
-              IDHW(IHEP)=ID2
-
-              IF (ID1.LE.6) THEN
-
-                IDHW(JHEP)=ID1+6
-
-              ELSE
-
-                IDHW(JHEP)=ID1-6
-
-              ENDIF
-
-            ELSE
-
-C-------EMIT=2
-
-              JHEP=KHEP+1
-
-              ISTHEP(JHEP)=112
-
-              IDHW(JHEP)=ID2
-
-              IHEP=ICMF+1
-
-              ISTHEP(IHEP)=114
-
-              IF (ID1.LE.6) THEN
-
-                IDHW(IHEP)=ID1+6
-
-              ELSE
-
-                IDHW(IHEP)=ID1-6
-
-              ENDIF
-
-            ENDIF
-
-          ENDIF
-
-C------GLUON COMING FROM THE HADRON 2
-
-          IF (.NOT.GP) THEN
-
-            KHEP=CHEP-1
-
-            ISTHEP(KHEP)=112
-
-C-------EMIT=1
-
-            IF (EMIT.EQ.1) THEN
-
-              IHEP=KHEP-1
-
-              ISTHEP(IHEP)=111
-
-              IDHW(IHEP)=ID1
-
-              JHEP=ICMF+1
-
-              ISTHEP(JHEP)=114
-
-              IF (ID2.LE.6) THEN
-
-                IDHW(JHEP)=ID2+6
-
-              ELSE
-
-                IDHW(JHEP)=ID2-6
-
-              ENDIF
-
-            ELSE
-
-C-------EMIT=2
-
-              JHEP=KHEP-1
-
-              ISTHEP(JHEP)=111
-
-              IDHW(JHEP)=ID1
-
-              IHEP=ICMF+1
-
-              ISTHEP(IHEP)=114
-
-              IF (ID2.LE.6) THEN
-
-                IDHW(IHEP)=ID2+6
-
-              ELSE
-
-                IDHW(IHEP)=ID2-6
-
-              ENDIF
-
-            ENDIF
-
-          ENDIF
-
-        ENDIF
-
-        IDHEP(IHEP)=IDPDG(IDHW(IHEP))
-
-        IDHEP(JHEP)=IDPDG(IDHW(JHEP))
-
-        ISTHEP(ICMF)=113
-
-        ISTHEP(CHEP)=110
-
-        IDHW(KHEP)=13
-
-        IDHEP(KHEP)=IDPDG(13)
-
-C---------DEFINE MOMENTA IN THE LAB FRAME
-
-        CALL HWVEQU(5,PV,PHEP(1,ICMF))
-
-        CALL HWVEQU(5,PK,PHEP(1,KHEP))
-
-        CALL HWVEQU(5,PNE,PHEP(1,JHEP))
-
-        CALL HWVEQU(5,PE,PHEP(1,IHEP))
-
-        IF (.NOT.GLUIN) THEN
-
-          CALL HWVSUM(4,PHEP(1,IHEP),PHEP(1,JHEP),PHEP(1,CHEP))
-
-        ELSE
-
-          IF (EMIT.EQ.1) THEN
-
-            CALL HWVSUM(4,PHEP(1,IHEP),PHEP(1,KHEP),PHEP(1,CHEP))
-
-          ELSE
-
-            CALL HWVSUM(4,PHEP(1,KHEP),PHEP(1,JHEP),PHEP(1,CHEP))
-
-          ENDIF
-
-        ENDIF
-
-        CALL HWUMAS(PHEP(1,CHEP))
-
-        IF (.NOT.GLUIN) THEN
-
-          JMOHEP(1,JHEP)=CHEP
-
-          JMOHEP(1,IHEP)=CHEP
-
-          JDAHEP(1,JHEP)=CHEP
-
-          JDAHEP(1,IHEP)=CHEP
-
-          JMOHEP(1,KHEP)=CHEP
-
-          JDAHEP(1,KHEP)=0
-
-          JMOHEP(1,ICMF)=CHEP
-
-          JMOHEP(2,ICMF)=ICMF
-
-          JDAHEP(1,ICMF)=0
-
-          JDAHEP(2,ICMF)=ICMF
-
-        ENDIF
-
-        IF (GLUIN) THEN
-
-          JMOHEP(2,ICMF)=ICMF
-
-          JDAHEP(2,ICMF)=ICMF
-
-          JMOHEP(1,KHEP)=CHEP
-
-          JDAHEP(1,KHEP)=CHEP
-
-          JMOHEP(1,IHEP)=CHEP
-
-          JMOHEP(1,JHEP)=CHEP
-
-          IF (EMIT.EQ.1) THEN
-
-            JDAHEP(1,IHEP)=CHEP
-
-            JDAHEP(1,JHEP)=0
-
-          ELSE
-
-            JDAHEP(1,JHEP)=CHEP
-
-            JDAHEP(1,IHEP)=0
-
-          ENDIF
-
-        ENDIF
-
-C---COLOUR CONNECTIONS
-
-        IF (.NOT.GLUIN) THEN
-
-          IF (IDHW(IHEP).LT.IDHW(JHEP)) THEN
-
-            JMOHEP(2,KHEP)=IHEP
-
-            JDAHEP(2,KHEP)=JHEP
-
-            JMOHEP(2,IHEP)=JHEP
-
-            JDAHEP(2,IHEP)=KHEP
-
-            JDAHEP(2,JHEP)=IHEP
-
-            JMOHEP(2,JHEP)=KHEP
-
-          ELSE
-
-            JMOHEP(2,KHEP)=JHEP
-
-            JDAHEP(2,KHEP)=IHEP
-
-            JMOHEP(2,JHEP)=IHEP
-
-            JDAHEP(2,JHEP)=KHEP
-
-            JDAHEP(2,IHEP)=JHEP
-
-            JMOHEP(2,IHEP)=KHEP
-
-          ENDIF
-
-        ENDIF
-
-        IF (GLUIN) THEN
-
-          IF (EMIT.EQ.1) THEN
-
-            IF (IDHEP(IHEP).GT.0) THEN
-
-              JMOHEP(2,IHEP)=JHEP
-
-              JDAHEP(2,IHEP)=KHEP
-
-              JMOHEP(2,JHEP)=KHEP
-
-              JDAHEP(2,JHEP)=IHEP
-
-              JMOHEP(2,KHEP)=IHEP
-
-              JDAHEP(2,KHEP)=JHEP
-
-            ELSE
-
-              JMOHEP(2,IHEP)=KHEP
-
-              JDAHEP(2,IHEP)=JHEP
-
-              JMOHEP(2,JHEP)=IHEP
-
-              JDAHEP(2,JHEP)=KHEP
-
-              JMOHEP(2,KHEP)=JHEP
-
-              JDAHEP(2,KHEP)=IHEP
-
-            ENDIF
-
-          ELSE
-
-            IF (IDHEP(JHEP).GT.0) THEN
-
-              JMOHEP(2,JHEP)=IHEP
-
-              JDAHEP(2,JHEP)=KHEP
-
-              JMOHEP(2,IHEP)=KHEP
-
-              JDAHEP(2,IHEP)=JHEP
-
-              JMOHEP(2,KHEP)=JHEP
-
-              JDAHEP(2,KHEP)=IHEP
-
-            ELSE
-
-              JMOHEP(2,JHEP)=KHEP
-
-              JDAHEP(2,JHEP)=IHEP
-
-              JMOHEP(2,IHEP)=JHEP
-
-              JDAHEP(2,IHEP)=KHEP
-
-              JMOHEP(2,KHEP)=IHEP
-
-              JDAHEP(2,KHEP)=JHEP
-
-            ENDIF
-
-          ENDIF
-
-        ENDIF
-
-        EMSCA=SQRT(EM**2+PHEP(1,ICMF)**2+PHEP(2,ICMF)**2)
-
-C--------SET STATUS AND LEPTON MOMENTA AFTER THE PARTON SHOWER
-
-      ELSEIF (IOPT.EQ.2) THEN
-
-        IF (EMIT.EQ.0.OR.NEVHEP+NWGTS.NE.NTMP) RETURN
-
-        ISTHEP(JDAHEP(1,ICMF))=195
-
-        IDHW(NHEP+1)=ID4
-
-        IDHW(NHEP+2)=ID5
-
-        IDHEP(NHEP+1)=IDPDG(ID4)
-
-        IDHEP(NHEP+2)=IDPDG(ID5)
-
-        ISTHEP(NHEP+1)=113
-
-        ISTHEP(NHEP+2)=114
-
-        CW=PHEP(3,ICMF)/SQRT(PHEP(1,ICMF)**2+PHEP(2,ICMF)**2+
-
-     &       PHEP(3,ICMF)**2)
-
-        SW=SQRT(1-CW**2)
-
-        CALL HWUROT(PHEP(1,ICMF),CW,SW,R4)
-
-        CALL HWUROF(R4,PHEP(1,ICMF),PR)
-
-        PR(4)=PHEP(4,ICMF)
-
-        CALL HWUMAS(PR)
-
-        CALL HWUROF(R4,PS,PS)
-
-        CALL HWUROF(R4,PF,PF)
-
-        CALL HWUMAS(PS)
-
-        CALL HWUMAS(PF)
-
-        CALL HWUROT(PHEP(1,JDAHEP(1,ICMF)),CW,SW,R5)
-
-        CALL HWUROF(R5,PHEP(1,JDAHEP(1,ICMF)),PD)
-
-        PD(4)=PHEP(4,JDAHEP(1,ICMF))
-
-        CALL HWUMAS(PD)
-
-        BETA1=(PR(4)*PR(3)-SQRT(PR(4)**2*PD(3)**2-PR(3)**2*PD(3)**2+
-
-     &       PD(3)**4))/(PD(3)**2+PR(4)**2)
-
-        GAMMA1=1/SQRT(1-BETA1**2)
-
-        PHEP(4,NHEP+1)=GAMMA1*PS(4)-BETA1*GAMMA1*PS(3)
-
-        PHEP(3,NHEP+1)=-BETA1*GAMMA1*PS(4)+GAMMA1*PS(3)
-
-        PHEP(4,NHEP+2)=GAMMA1*PF(4)-BETA1*GAMMA1*PF(3)
-
-        PHEP(3,NHEP+2)=-BETA1*GAMMA1*PF(4)+GAMMA1*PF(3)
-
-        PHEP(1,NHEP+1)=PS(1)
-
-        PHEP(2,NHEP+1)=PS(2)
-
-        PHEP(1,NHEP+2)=PF(1)
-
-        PHEP(2,NHEP+2)=PF(2)
-
-        CALL HWUMAS(PHEP(1,NHEP+1))
-
-        CALL HWUMAS(PHEP(1,NHEP+2))
-
-        CALL HWUROB(R5,PHEP(1,NHEP+1),PHEP(1,NHEP+1))
-
-        CALL HWUROB(R5,PHEP(1,NHEP+2),PHEP(1,NHEP+2))
-
-        JDAHEP(1,JDAHEP(1,ICMF))=NHEP+1
-
-        JDAHEP(2,JDAHEP(1,ICMF))=NHEP+2
-
-        JMOHEP(1,NHEP+1)=JDAHEP(1,ICMF)
-
-        JMOHEP(1,NHEP+2)=JDAHEP(1,ICMF)
-
-        JMOHEP(2,NHEP+1)=NHEP+2
-
-        JDAHEP(2,NHEP+1)=NHEP+2
-
-        JMOHEP(2,NHEP+2)=NHEP+1
-
-        JDAHEP(2,NHEP+2)=NHEP+1
-
-        NHEP=NHEP+2
-
-        EMIT=0
-
-      ENDIF
-
-      END
diff --git a/HERWIG/src/hwbfin.f b/HERWIG/src/hwbfin.f
deleted file mode 100644 (file)
index c182a5b..0000000
+++ /dev/null
@@ -1,1792 +0,0 @@
-
-CDECK  ID>, HWBFIN.
-
-*CMZ :-        -26/04/91  10.18.56  by  Bryan Webber
-
-*-- Author :    Bryan Webber
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWBFIN(IHEP)
-
-C-----------------------------------------------------------------------
-
-C     DELETES INTERNAL LINES FROM SHOWER, MAKES COLOUR CONNECTION INDEX
-
-C     AND COPIES INTO /HEPEVT/ IN COLOUR ORDER.
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      INTEGER IHEP,ID,IJET,KHEP,IPAR,JPAR,NXPAR,IP,JP
-
-      IF (IERROR.NE.0) RETURN
-
-C---SAVE VIRTUAL PARTON DATA
-
-      NHEP=NHEP+1
-
-      IF(NHEP.GT.NMXHEP) CALL HWWARN('HWBFIN',100,*999)
-
-      ID=IDPAR(2)
-
-      IDHW(NHEP)=ID
-
-      IDHEP(NHEP)=IDPDG(ID)
-
-      ISTHEP(NHEP)=ISTHEP(IHEP)+20
-
-      JMOHEP(1,NHEP)=IHEP
-
-      JMOHEP(2,NHEP)=JMOHEP(1,IHEP)
-
-      JDAHEP(1,IHEP)=NHEP
-
-      JDAHEP(1,NHEP)=0
-
-      JDAHEP(2,NHEP)=0
-
-      CALL HWVEQU(5,PPAR(1,2),PHEP(1,NHEP))
-
-      CALL HWVEQU(4,VPAR(1,2),VHEP(1,NHEP))
-
-C---FINISHED FOR SPECTATOR OR NON-PARTON JETS
-
-      IF (ISTHEP(NHEP).GT.136) RETURN
-
-      IF (ID.GT.13.AND.ID.LT.209 .AND. ID.NE.59) RETURN
-
-      IF (ID.GT.220.AND.ABS(IDPDG(ID)).LT.1000000) RETURN
-
-      IF (ID.GT.424.AND.ID.NE.449) RETURN
-
-      IF (.NOT.TMPAR(2).AND.ID.EQ.59) RETURN
-
-      IDHEP(NHEP)=94
-
-      IJET=NHEP
-
-      IF (NPAR.GT.2) THEN
-
-C---SAVE CONE DATA
-
-        NHEP=NHEP+1
-
-        IF(NHEP.GT.NMXHEP) CALL HWWARN('HWBFIN',101,*999)
-
-        IDHW(NHEP)=IDPAR(1)
-
-        IDHEP(NHEP)=0
-
-        ISTHEP(NHEP)=100
-
-        JMOHEP(1,NHEP)=IHEP
-
-        JMOHEP(2,NHEP)=JCOPAR(1,1)
-
-        JDAHEP(1,NHEP)=0
-
-        JDAHEP(2,NHEP)=0
-
-        CALL HWVEQU(5,PPAR,PHEP(1,NHEP))
-
-        CALL HWVEQU(4,VPAR(1,2),VHEP(1,NHEP))
-
-      ENDIF
-
-      KHEP=NHEP
-
-C---START WITH ANTICOLOUR DAUGHTER OF HARDEST PARTON
-
-      IPAR=2
-
-      JPAR=JCOPAR(4,IPAR)
-
-      NXPAR=NPAR/2
-
-      DO 20 IP=1,NXPAR
-
-      DO 10 JP=1,NXPAR
-
-      IF (JPAR.EQ.0) GOTO 15
-
-      IF (JCOPAR(2,JPAR).EQ.IPAR) THEN
-
-        IPAR=JPAR
-
-        JPAR=JCOPAR(4,IPAR)
-
-      ELSE
-
-        IPAR=JPAR
-
-        JPAR=JCOPAR(1,IPAR)
-
-      ENDIF
-
-   10 CONTINUE
-
-C---COULDN'T FIND COLOUR PARTNER
-
-      CALL HWWARN('HWBFIN',1,*999)
-
-   15 JPAR=JCOPAR(1,IPAR)
-
-      KHEP=KHEP+1
-
-      IF(KHEP.GT.NMXHEP) CALL HWWARN('HWBFIN',102,*999)
-
-      ID=IDPAR(IPAR)
-
-      IF (TMPAR(IPAR)) THEN
-
-        IF (ID.LT.14) THEN
-
-          ISTHEP(KHEP)=139
-
-        ELSEIF (ID.EQ.59) THEN
-
-          ISTHEP(KHEP)=139
-
-        ELSEIF (ID.LT.109) THEN
-
-          ISTHEP(KHEP)=130
-
-        ELSEIF (ID.LT.120) THEN
-
-          ISTHEP(KHEP)=139
-
-        ELSEIF (ABS(IDPDG(ID)).LT.1000000) THEN
-
-          ISTHEP(KHEP)=130
-
-        ELSEIF (ID.LT.425) THEN
-
-          ISTHEP(KHEP)=139
-
-        ELSEIF (ID.EQ.449) THEN
-
-          ISTHEP(KHEP)=139
-
-        ELSE
-
-          ISTHEP(KHEP)=130
-
-        ENDIF
-
-      ELSE
-
-        ISTHEP(KHEP)=ISTHEP(IHEP)+24
-
-      ENDIF
-
-      IDHW(KHEP)=ID
-
-      IDHEP(KHEP)=IDPDG(ID)
-
-      CALL HWVEQU(5,PPAR(1,IPAR),PHEP(1,KHEP))
-
-      CALL HWVEQU(4,VPAR(1,IPAR),VHEP(1,KHEP))
-
-      JMOHEP(1,KHEP)=IJET
-
-      JMOHEP(2,KHEP)=KHEP+1
-
-      JDAHEP(1,KHEP)=0
-
-      JDAHEP(2,KHEP)=KHEP-1
-
-   20 CONTINUE
-
-      JMOHEP(2,KHEP)=0
-
-      JDAHEP(2,NHEP+1)=0
-
-      JDAHEP(1,IJET)=NHEP+1
-
-      JDAHEP(2,IJET)=KHEP
-
-      NHEP=KHEP
-
-  999 END
-
-CDECK  ID>, HWBGEN.
-
-*CMZ :-        -14/10/99  18.04.56  by  Mike Seymour
-
-*-- Author :    Bryan Webber
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWBGEN
-
-C-----------------------------------------------------------------------
-
-C     BRANCHING GENERATOR WITH INTERFERING GLUONS
-
-C     HWBGEN EVOLVES QCD JETS ACCORDING TO THE METHOD OF
-
-C     G.MARCHESINI & B.R.WEBBER, NUCL. PHYS. B238(1984)1
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      DOUBLE PRECISION HWULDO,HWRGAU,EINHEP,ERTXI,RTXI,XF
-
-      INTEGER NTRY,LASHEP,IHEP,NRHEP,ID,IST,JHEP,KPAR,I,J,IRHEP(NMXJET),
-
-     & IRST(NMXJET)
-
-      LOGICAL HWRLOG
-
-      EXTERNAL HWULDO,HWRGAU
-
-      IF (IERROR.NE.0) RETURN
-
-      IF (IPRO.EQ.80) RETURN
-
-C---CHECK THAT EMSCA IS SET
-
-      IF (EMSCA.LE.ZERO) CALL HWWARN('HWBGEN',200,*999)
-
-      IF (HARDME) THEN
-
-C---FORCE A BRANCH INTO THE `DEAD ZONE' IN E+E-
-
-        IF (IPROC/10.EQ.10) CALL HWBDED(1)
-
-C---FORCE A BRANCH INTO THE `DEAD ZONE' IN DIS
-
-        IF (IPRO.EQ.90) CALL HWBDIS(1)
-
-C---FORCE A BRANCH INTO THE `DEAD ZONE' IN DRELL-YAN PROCESSES
-
-        IF (IPRO.EQ.13.OR.IPRO.EQ.14) CALL HWBDYP(1)
-
-C---FORCE A BRANCH INTO THE `DEAD ZONE' IN TOP DECAYS
-
-        CALL HWBTOP
-
-      ENDIF
-
-C---GENERATE INTRINSIC PT ONCE AND FOR ALL
-
-      DO 5 JNHAD=1,2
-
-        IF (PTRMS.NE.0.) THEN
-
-          PTINT(1,JNHAD)=HWRGAU(1,ZERO,PXRMS)
-
-          PTINT(2,JNHAD)=HWRGAU(2,ZERO,PXRMS)
-
-          PTINT(3,JNHAD)=PTINT(1,JNHAD)**2+PTINT(2,JNHAD)**2
-
-        ELSE
-
-          CALL HWVZRO(3,PTINT(1,JNHAD))
-
-        ENDIF
-
- 5    CONTINUE
-
-      NTRY=0
-
-      LASHEP=NHEP
-
- 10   NTRY=NTRY+1
-
-      IF (NTRY.GT.NETRY) CALL HWWARN('HWBGEN',ISLENT*100,*999)
-
-      NRHEP=0
-
-      NHEP=LASHEP
-
-      FROST=.FALSE.
-
-      DO 100 IHEP=1,LASHEP
-
-      IST=ISTHEP(IHEP)
-
-      IF (IST.GE.111.AND.IST.LE.115) THEN
-
-       NRHEP=NRHEP+1
-
-       IRHEP(NRHEP)=IHEP
-
-       IRST(NRHEP)=IST
-
-       ID=IDHW(IHEP)
-
-       IF (IST.NE.115) THEN
-
-C---FOUND A PARTON TO EVOLVE
-
-        NEVPAR=IHEP
-
-        NPAR=2
-
-        IDPAR(1)=17
-
-        IDPAR(2)=ID
-
-        TMPAR(1)=.TRUE.
-
-        PPAR(2,1)=0.
-
-        PPAR(4,1)=1.
-
-        DO 15 J=1,2
-
-        DO 15 I=1,2
-
-        JMOPAR(I,J)=0
-
- 15     JCOPAR(I,J)=0
-
-C---SET UP EVOLUTION SCALE AND FRAME
-
-        JHEP=JMOHEP(2,IHEP)
-
-        IF (ID.EQ.13) THEN
-
-          IF (HWRLOG(HALF)) JHEP=JDAHEP(2,IHEP)
-
-        ELSEIF (IST.GT.112) THEN
-
-          IF ((ID.GT.6.AND.ID.LT.13).OR.
-
-     &        (ID.GT.214.AND.ID.LT.221)) JHEP=JDAHEP(2,IHEP)
-
-        ELSE
-
-          IF (ID.LT.7.OR.(ID.GT.208.AND.ID.LT.215)) JHEP=JDAHEP(2,IHEP)
-
-        ENDIF
-
-        IF (JHEP.LE.0.OR.JHEP.GT.NHEP) THEN
-
-          CALL HWWARN('HWBGEN',1,*999)
-
-          JHEP=IHEP
-
-        ENDIF
-
-        JCOPAR(1,1)=JHEP
-
-        EINHEP=PHEP(4,IHEP)
-
-        ERTXI=HWULDO(PHEP(1,IHEP),PHEP(1,JHEP))
-
-        IF (ERTXI.LT.ZERO) ERTXI=0.
-
-        IF (IST.LE.112.AND.IHEP.EQ.JHEP) ERTXI=0.
-
-        IF (ISTHEP(JHEP).EQ.155) THEN
-
-          ERTXI=ERTXI/PHEP(5,JHEP)
-
-          RTXI=1.
-
-        ELSE
-
-          ERTXI=SQRT(ERTXI)
-
-          RTXI=ERTXI/EINHEP
-
-        ENDIF
-
-        IF (RTXI.EQ.ZERO) THEN
-
-          XF=1.
-
-          PPAR(1,1)=0.
-
-          PPAR(3,1)=1.
-
-          PPAR(1,2)=EINHEP
-
-          PPAR(2,2)=0.
-
-          PPAR(4,2)=EINHEP
-
-        ELSE
-
-          XF=1./RTXI
-
-          PPAR(1,1)=1.
-
-          PPAR(3,1)=0.
-
-          PPAR(1,2)=ERTXI
-
-          PPAR(2,2)=1.
-
-          PPAR(4,2)=ERTXI
-
-        ENDIF
-
-        IF (PPAR(4,2).LT.PHEP(5,IHEP)) PPAR(4,2)=PHEP(5,IHEP)
-
-C---STORE MASS
-
-        PPAR(5,2)=PHEP(5,IHEP)
-
-        CALL HWVZRO(4,VPAR(1,1))
-
-        CALL HWVZRO(4,VPAR(1,2))
-
-        IF (IST.GT.112) THEN
-
-          TMPAR(2)=.TRUE.
-
-          INHAD=0
-
-          JNHAD=0
-
-          XFACT=0.
-
-        ELSE
-
-          TMPAR(2)=.FALSE.
-
-          JNHAD=IST-110
-
-          INHAD=JNHAD
-
-          IF (JDAHEP(1,JNHAD).NE.0) INHAD=JDAHEP(1,JNHAD)
-
-          XFACT=XF/PHEP(4,INHAD)
-
-          ANOMSC(1,JNHAD)=ZERO
-
-          ANOMSC(2,JNHAD)=ZERO
-
-        ENDIF
-
-C---FOR QUARKS IN A COLOUR SINGLET, ALLOW SOFT MATRIX-ELEMENT CORRECTION
-
-        HARDST=PPAR(4,2)
-
-        IF (SOFTME.AND.IDHW(IHEP).LT.13.AND.
-
-     $       ((JMOHEP(2,JHEP).EQ.IHEP.AND.JDAHEP(2,JHEP).EQ.IHEP).OR.
-
-     $       ISTHEP(JHEP).EQ.155)) HARDST=0
-
-C---CREATE BRANCHES AND COMPUTE ENERGIES
-
-        DO 20 KPAR=2,NMXPAR
-
-        IF (TMPAR(KPAR)) THEN
-
-          CALL HWBRAN(KPAR)
-
-        ELSE
-
-          CALL HWSBRN(KPAR)
-
-        ENDIF
-
-        IF (IERROR.NE.0) RETURN
-
-        IF (FROST) GOTO 100
-
-        IF (KPAR.EQ.NPAR) GOTO 30
-
- 20     CONTINUE
-
-C---COMPUTE MASSES AND 3-MOMENTA
-
- 30     CONTINUE
-
-        CALL HWBMAS
-
-        IF (AZSPIN) CALL HWBSPN
-
-        IF (TMPAR(2)) THEN
-
-           CALL HWBTIM(2,1)
-
-        ELSE
-
-           CALL HWBSPA
-
-        ENDIF
-
-C---ENTER PARTON JET IN /HEPEVT/
-
-        CALL HWBFIN(IHEP)
-
-       ELSE
-
-C---COPY SPECTATOR
-
-        NHEP=NHEP+1
-
-        IF (ID.GT.120.AND.ID.LT.133 .OR. ID.GE.198.AND.ID.LE.201) THEN
-
-          ISTHEP(NHEP)=190
-
-        ELSE
-
-          ISTHEP(NHEP)=152
-
-        ENDIF
-
-        IDHW(NHEP)=ID
-
-        IDHEP(NHEP)=IDPDG(ID)
-
-        JMOHEP(1,NHEP)=IHEP
-
-        JMOHEP(2,NHEP)=0
-
-        JDAHEP(2,NHEP)=0
-
-        JDAHEP(1,IHEP)=NHEP
-
-        CALL HWVEQU(5,PHEP(1,IHEP),PHEP(1,NHEP))
-
-       ENDIF
-
-       ISTHEP(IHEP)=ISTHEP(IHEP)+10
-
-      ENDIF
-
- 100  CONTINUE
-
-      IF (.NOT.FROST) THEN
-
-C---COMBINE JETS
-
-        ISTAT=20
-
-        CALL HWBJCO
-
-      ENDIF
-
-      IF (.NOT.FROST) THEN
-
-C---ATTACH SPECTATORS
-
-        ISTAT=30
-
-        CALL HWSSPC
-
-      ENDIF
-
-      IF (FROST) THEN
-
-C---BAD JET: RESTORE PARTONS AND RE-EVOLVE
-
-         DO 120 I=1,NRHEP
-
- 120     ISTHEP(IRHEP(I))=IRST(I)
-
-         GOTO 10
-
-      ENDIF
-
-C---CONNECT COLOURS
-
-      CALL HWBCON
-
-      ISTAT=40
-
-      LASHEP=NHEP
-
-      IF (HARDME) THEN
-
-C---CLEAN UP IF THERE WAS A BRANCH IN THE `DEAD ZONE' IN E+E-
-
-        IF (IPROC/10.EQ.10) CALL HWBDED(2)
-
-C---CLEAN UP IF THERE WAS A BRANCH IN THE `DEAD ZONE' IN DIS
-
-        IF (IPRO.EQ.90) CALL HWBDIS(2)
-
-C---CLEAN UP IF THERE WAS A BRANCH IN THE `DEAD ZONE' IN DRELL-YAN PROC
-
-        IF (IPRO.EQ.13.OR.IPRO.EQ.14) CALL HWBDYP(2)
-
-      ENDIF
-
-C---IF THE CLEAN-UP OPERATION ADDED ANY PARTONS TO THE EVENT RECORD
-
-C   IT MIGHT NEED RESHOWERING
-
-      IF (NHEP.GT.LASHEP) THEN
-
-        LASHEP=NHEP
-
-        GOTO 10
-
-      ENDIF
-
- 999  END
-
-CDECK  ID>, HWBJCO.
-
-*CMZ :-        -26/04/91  14.25.31  by  Federico Carminati
-
-*-- Author :    Bryan Webber
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWBJCO
-
-C-----------------------------------------------------------------------
-
-C     COMBINES JETS WITH REQUIRED KINEMATICS
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      DOUBLE PRECISION HWULDO,EPS,PTX,PTY,PF,PTINF,PTCON,CN,CP,SP,PP0,
-
-     & PM0,ET0,DET,ECM,EMJ,EMP,EMS,DMS,ES,DPF,ALF,AL(2),ET(2),PP(2),
-
-     & PT(3),PB(5),PC(5),PQ(5),PR(5),PS(5),RR(3,3),RS(3,3),ETC,
-
-     & PJ(NMXJET),PM(NMXJET),PBR(5),RBR(3,3),DISP(4)
-
-      INTEGER LJET,IJ1,IST,IP,ICM,IP1,IP2,NP,IHEP,MHEP,JP,KP,LP,KHEP,
-
-     & JHEP,NE,IJT,IEND(2),IJET(NMXJET),IPAR(NMXJET)
-
-      LOGICAL AZCOR,JETRAD,DISPRO,DISLOW
-
-      EXTERNAL HWULDO
-
-      PARAMETER (EPS=1.D-4)
-
-      IF (IERROR.NE.0) RETURN
-
-      AZCOR=AZSOFT.OR.AZSPIN
-
-C---FIRST LOOK FOR SPACELIKE JETS
-
-      LJET=131
-
-  10  IJET(1)=1
-
-  20  IJ1=IJET(1)
-
-      DO 40 IHEP=IJ1,NHEP
-
-      IST=ISTHEP(IHEP)
-
-      IF (IST.EQ.137.OR.IST.EQ.138) IST=133
-
-      IF (IST.EQ.LJET) THEN
-
-C---FOUND AN UNBOOSTED JET - FIND PARTNERS
-
-        IP=JMOHEP(1,IHEP)
-
-        ICM=JMOHEP(1,IP)
-
-        DISPRO=IPRO/10.EQ.9.AND.IDHW(ICM).EQ.15
-
-        DISLOW=DISPRO.AND.JDAHEP(1,ICM).EQ.JDAHEP(2,ICM)-1
-
-        IF (IST.EQ.131) THEN
-
-          IP1=JMOHEP(1,ICM)
-
-          IP2=JMOHEP(2,ICM)
-
-        ELSE
-
-          IP1=JDAHEP(1,ICM)
-
-          IP2=JDAHEP(2,ICM)
-
-        ENDIF
-
-        IF (IP1.NE.IP) CALL HWWARN('HWBJCO',100,*999)
-
-        NP=0
-
-        DO 30 JHEP=IP1,IP2
-
-        NP=NP+1
-
-        IPAR(NP)=JHEP
-
-  30    IJET(NP)=JDAHEP(1,JHEP)
-
-        GOTO 50
-
-      ENDIF
-
-  40  CONTINUE
-
-C---NO MORE JETS?
-
-      IF (LJET.EQ.131) THEN
-
-        LJET=133
-
-        GOTO 10
-
-      ENDIF
-
-      RETURN
-
-  50  IF (LJET.EQ.131) THEN
-
-C---SPACELIKE JETS: FIND SPACELIKE PARTONS
-
-        IF (NP.NE.2) CALL HWWARN('HWBJCO',103,*999)
-
-C---special for DIS: FIND BOOST AND ROTATION FROM LAB TO BREIT FRAME
-
-        IF (DISPRO.AND.BREIT) THEN
-
-          IP=2
-
-          IF (JDAHEP(1,IP).NE.0) IP=JDAHEP(1,IP)
-
-          CALL HWVDIF(4,PHEP(1,JMOHEP(1,ICM)),PHEP(1,JDAHEP(1,ICM)),PB)
-
-          CALL HWUMAS(PB)
-
-C---IF Q**2<10**-2, SOMETHING MUST HAVE ALREADY GONE WRONG
-
-          IF (PB(5)**2.LT.1.D-2) CALL HWWARN('HWBJCO',102,*999)
-
-          CALL HWVSCA(4,PB(5)**2/HWULDO(PHEP(1,IP),PB),PHEP(1,IP),PBR)
-
-          CALL HWVSUM(4,PB,PBR,PBR)
-
-          CALL HWUMAS(PBR)
-
-          CALL HWULOF(PBR,PB,PB)
-
-          CALL HWUROT(PB,ONE,ZERO,RBR)
-
-        ENDIF
-
-        PTX=0.
-
-        PTY=0.
-
-        PF=1.D0
-
-        DO 90 IP=1,2
-
-        MHEP=IJET(IP)
-
-        IF (JDAHEP(1,MHEP).EQ.0) THEN
-
-C---SPECIAL FOR NON-PARTON JETS
-
-          IHEP=MHEP
-
-          GOTO 70
-
-        ELSE
-
-          IST=134+IP
-
-          DO 60 IHEP=MHEP,NHEP
-
-  60      IF (ISTHEP(IHEP).EQ.IST) GOTO 70
-
-C---COULDN'T FIND SPACELIKE PARTON
-
-          CALL HWWARN('HWBJCO',101,*999)
-
-        ENDIF
-
-  70    CALL HWVSCA(3,PF,PHEP(1,IHEP),PS)
-
-        IF (PTINT(3,IP).GT.ZERO) THEN
-
-C---ADD INTRINSIC PT
-
-          PT(1)=PTINT(1,IP)
-
-          PT(2)=PTINT(2,IP)
-
-          PT(3)=0.
-
-          CALL HWUROT(PS, ONE,ZERO,RS)
-
-          CALL HWUROB(RS,PT,PT)
-
-          CALL HWVSUM(3,PS,PT,PS)
-
-        ENDIF
-
-        JP=IJET(IP)+1
-
-        IF (AZCOR.AND.JP.LE.NHEP.AND.IDHW(JP).EQ.17) THEN
-
-C---ALIGN CONE WITH INTERFERING PARTON
-
-          CALL HWUROT(PS, ONE,ZERO,RS)
-
-          CALL HWUROF(RS,PHEP(1,JP),PR)
-
-          PTCON=PR(1)**2+PR(2)**2
-
-          KP=JMOHEP(2,JP)
-
-          IF (KP.EQ.0) THEN
-
-            CALL HWWARN('HWBJCO',1,*999)
-
-            PTINF=0.
-
-          ELSE
-
-            CALL HWVEQU(4,PHEP(1,KP),PB)
-
-            IF (DISPRO.AND.BREIT) THEN
-
-              CALL HWULOF(PBR,PB,PB)
-
-              CALL HWUROF(RBR,PB,PB)
-
-            ENDIF
-
-            PTINF=PB(1)**2+PB(2)**2
-
-            IF (PTINF.LT.EPS) THEN
-
-C---COLLINEAR JETS: ALIGN CONES
-
-              KP=JDAHEP(1,KP)+1
-
-              IF (ISTHEP(KP).EQ.100.AND.ISTHEP(KP-1)/10.EQ.14) THEN
-
-                CALL HWVEQU(4,PHEP(1,KP),PB)
-
-                IF (DISPRO.AND.BREIT) THEN
-
-                  CALL HWULOF(PBR,PB,PB)
-
-                  CALL HWUROF(RBR,PB,PB)
-
-                ENDIF
-
-                PTINF=PB(1)**2+PB(2)**2
-
-              ELSE
-
-                PTINF=0.
-
-              ENDIF
-
-            ENDIF
-
-          ENDIF
-
-          IF (PTCON.NE.ZERO.AND.PTINF.NE.ZERO) THEN
-
-            CN=1./SQRT(PTINF*PTCON)
-
-            CP=CN*(PR(1)*PB(1)+PR(2)*PB(2))
-
-            SP=CN*(PR(1)*PB(2)-PR(2)*PB(1))
-
-          ELSE
-
-            CALL HWRAZM( ONE,CP,SP)
-
-          ENDIF
-
-        ELSE
-
-          CALL HWRAZM( ONE,CP,SP)
-
-        ENDIF
-
-C---ROTATE SO SPACELIKE IS ALONG AXIS (APART FROM INTRINSIC PT)
-
-        CALL HWUROT(PS,CP,SP,RS)
-
-        IHEP=IJET(IP)
-
-        KHEP=JDAHEP(2,IHEP)
-
-        IF (KHEP.LT.IHEP) KHEP=IHEP
-
-        IEND(IP)=KHEP
-
-        DO 80 JHEP=IHEP,KHEP
-
-        CALL HWUROF(RS,PHEP(1,JHEP),PHEP(1,JHEP))
-
-  80    CALL HWUROF(RS,VHEP(1,JHEP),VHEP(1,JHEP))
-
-        PP(IP)=PHEP(4,IHEP)+PF*PHEP(3,IHEP)
-
-        ET(IP)=PHEP(1,IHEP)**2+PHEP(2,IHEP)**2-PHEP(5,IHEP)**2
-
-C---REDEFINE HARD CM
-
-        PTX=PTX+PHEP(1,IHEP)
-
-        PTY=PTY+PHEP(2,IHEP)
-
-  90    PF=-PF
-
-        PHEP(1,ICM)=PTX
-
-        PHEP(2,ICM)=PTY
-
-C---special for DIS: keep lepton momenta fixed
-
-        IF (DISPRO) THEN
-
-          IP1=JMOHEP(1,ICM)
-
-          IP2=JDAHEP(1,ICM)
-
-          IJT=IJET(1)
-
-C---IJT will be used to store lepton momentum transfer
-
-          CALL HWVDIF(4,PHEP(1,IP1),PHEP(1,IP2),PHEP(1,IJT))
-
-          CALL HWUMAS(PHEP(1,IJT))
-
-          IF (IDHEP(IP1).EQ.IDHEP(IP2)) THEN
-
-            IDHW(IJT)=200
-
-          ELSEIF (IDHEP(IP1).LT.IDHEP(IP2)) THEN
-
-            IDHW(IJT)=199
-
-          ELSE
-
-            IDHW(IJT)=198
-
-          ENDIF
-
-          IDHEP(IJT)=IDPDG(IDHW(IJT))
-
-          ISTHEP(IJT)=3
-
-C---calculate boost for struck parton
-
-C   PC is momentum of outgoing parton(s)
-
-          IP2=JDAHEP(2,ICM)
-
-          IF (.NOT.DISLOW) THEN
-
-C---FOR heavy QQbar PQ and PC are old and new QQbar momenta
-
-            CALL HWVSUM(4,PHEP(1,IP2-1),PHEP(1,IP2),PQ)
-
-            CALL HWUMAS(PQ)
-
-            PC(5)=PQ(5)
-
-          ELSE
-
-            PC(5)=PHEP(5,JDAHEP(1,IP2))
-
-          ENDIF
-
-          CALL HWVSUM(2,PHEP(1,IJT),PHEP(1,IJET(2)),PC)
-
-          ET(1)=ET(2)
-
-C---USE BREIT FRAME BOSON MOMENTUM IF NECESSARY
-
-          IF (BREIT) THEN
-
-            ET(2)=ET(1)+PC(5)**2+PHEP(5,IJET(2))**2
-
-            PM0=PHEP(5,IJT)
-
-            PP0=-PM0
-
-          ELSE
-
-            ET(2)=PC(1)**2+PC(2)**2+PC(5)**2
-
-            PP0=PHEP(4,IJT)+PHEP(3,IJT)
-
-            PM0=PHEP(4,IJT)-PHEP(3,IJT)
-
-          ENDIF
-
-          ET0=(PP0*PM0)+ET(1)-ET(2)
-
-          DET=ET0**2-4.*(PP0*PM0)*ET(1)
-
-          IF (DET.LT.ZERO) THEN
-
-            FROST=.TRUE.
-
-            RETURN
-
-          ENDIF
-
-          ALF=(SQRT(DET)-ET0)/(2.*PP0*PP(2))
-
-          PB(1)=0.
-
-          PB(2)=0.
-
-          PB(5)=2.D0
-
-          PB(3)=ALF-(1./ALF)
-
-          PB(4)=ALF+(1./ALF)
-
-          DO 100 IHEP=IJET(2),IEND(2)
-
-          CALL HWULOF(PB,PHEP(1,IHEP),PHEP(1,IHEP))
-
-          CALL HWULF4(PB,VHEP(1,IHEP),VHEP(1,IHEP))
-
-C---BOOST FROM BREIT FRAME IF NECESSARY
-
-          IF (BREIT) THEN
-
-            CALL HWUROB(RBR,PHEP(1,IHEP),PHEP(1,IHEP))
-
-            CALL HWULOB(PBR,PHEP(1,IHEP),PHEP(1,IHEP))
-
-            CALL HWUROB(RBR,VHEP(1,IHEP),VHEP(1,IHEP))
-
-            CALL HWULB4(PBR,VHEP(1,IHEP),VHEP(1,IHEP))
-
-          ENDIF
-
-  100     ISTHEP(IHEP)=ISTHEP(IHEP)+10
-
-          CALL HWVDIF(4,VHEP(1,IPAR(2)),VHEP(1,IJET(2)),DISP)
-
-          DO 110 IHEP=IJET(2),IEND(2)
-
-  110     CALL HWVSUM(4,DISP,VHEP(1,IHEP),VHEP(1,IHEP))
-
-          IF (IEND(2).GT.IJET(2)+1) ISTHEP(IJET(2)+1)=100
-
-          CALL HWVSUM(4,PHEP(1,IJT),PHEP(1,IJET(2)),PC)
-
-          CALL HWVSUM(4,PHEP(1,IP1),PHEP(1,IJET(2)),PHEP(1,ICM))
-
-          CALL HWUMAS(PHEP(1,ICM))
-
-        ELSEIF (IPRO/10.EQ.5) THEN
-
-C Special to preserve photon momentum
-
-           ETC=PTX**2+PTY**2+PHEP(5,ICM)**2
-
-           ET0=ETC+ET(1)-ET(2)
-
-           DET=ET0**2-4.*ETC*ET(1)
-
-           IF (DET.LT.ZERO) THEN
-
-              FROST=.TRUE.
-
-              RETURN
-
-           ENDIF
-
-           ALF=(SQRT(DET)+ET0-2.*ET(1))/(2.*PP(1)*PP(2))
-
-           PB(1)=0.
-
-           PB(2)=0.
-
-           PB(3)=ALF-1./ALF
-
-           PB(4)=ALF+1./ALF
-
-           PB(5)=2.
-
-           IJT=IJET(2)
-
-           DO 120 IHEP=IJT,IEND(2)
-
-           CALL HWULOF(PB,PHEP(1,IHEP),PHEP(1,IHEP))
-
-           CALL HWULF4(PB,VHEP(1,IHEP),VHEP(1,IHEP))
-
-  120      ISTHEP(IHEP)=ISTHEP(IHEP)+10
-
-           CALL HWVDIF(4,VHEP(1,IPAR(2)),VHEP(1,IJT),DISP)
-
-           DO 130 IHEP=IJT,IEND(2)
-
-  130      CALL HWVSUM(4,DISP,VHEP(1,IHEP),VHEP(1,IHEP))
-
-           IF (IEND(2).GT.IJT+1) ISTHEP(IJT+1)=100
-
-           ISTHEP(IJET(1))=ISTHEP(IJET(1))+10
-
-           CALL HWVSUM(2,PHEP(3,IPAR(1)),PHEP(3,IJT),PHEP(3,ICM))
-
-        ELSE
-
-          PHEP(4,ICM)=SQRT(PTX**2+PTY**2+PHEP(3,ICM)**2+PHEP(5,ICM)**2)
-
-C---NOW BOOST TO REQUIRED Q**2 AND X-F
-
-          PP0=PHEP(4,ICM)+PHEP(3,ICM)
-
-          PM0=PHEP(4,ICM)-PHEP(3,ICM)
-
-          ET0=(PP0*PM0)+ET(1)-ET(2)
-
-          DET=ET0**2-4.*(PP0*PM0)*ET(1)
-
-          IF (DET.LT.ZERO) THEN
-
-            FROST=.TRUE.
-
-            RETURN
-
-          ENDIF
-
-          DET=SQRT(DET)+ET0
-
-          AL(1)= 2.*PM0*PP(1)/DET
-
-          AL(2)=(PM0/PP(2))*(1.-2.*ET(1)/DET)
-
-          PB(1)=0.
-
-          PB(2)=0.
-
-          PB(5)=2.
-
-          DO 160 IP=1,2
-
-          PB(3)=AL(IP)-(1./AL(IP))
-
-          PB(4)=AL(IP)+(1./AL(IP))
-
-          IJT=IJET(IP)
-
-          DO 140 IHEP=IJT,IEND(IP)
-
-          CALL HWULOF(PB,PHEP(1,IHEP),PHEP(1,IHEP))
-
-          CALL HWULF4(PB,VHEP(1,IHEP),VHEP(1,IHEP))
-
-  140     ISTHEP(IHEP)=ISTHEP(IHEP)+10
-
-          CALL HWVDIF(4,VHEP(1,IPAR(IP)),VHEP(1,IJT),DISP)
-
-          DO 150 IHEP=IJT,IEND(IP)
-
-  150     CALL HWVSUM(4,DISP,VHEP(1,IHEP),VHEP(1,IHEP))
-
-          IF (IEND(IP).GT.IJT+1) THEN
-
-            ISTHEP(IJT+1)=100
-
-          ELSEIF (IEND(IP).EQ.IJT) THEN
-
-C---NON-PARTON JET
-
-            ISTHEP(IJT)=3
-
-          ENDIF
-
-  160     CONTINUE
-
-        ENDIF
-
-        ISTHEP(ICM)=120
-
-      ELSE
-
-C---TIMELIKE JETS
-
-C   special for DIS: preserve outgoing lepton momentum
-
-        IF (DISPRO) THEN
-
-          CALL HWVEQU(5,PHEP(1,IPAR(1)),PHEP(1,IJET(1)))
-
-          ISTHEP(IJET(1))=1
-
-          LP=2
-
-        ELSE
-
-          CALL HWVEQU(5,PHEP(1,ICM),PC)
-
-C--- PQ AND PC ARE OLD AND NEW PARTON CM
-
-          CALL HWVSUM(4,PHEP(1,IPAR(1)),PHEP(1,IPAR(2)),PQ)
-
-          PQ(5)=PHEP(5,ICM)
-
-          IF (NP.GT.2) THEN
-
-            DO 170 KP=3,NP
-
-  170       CALL HWVSUM(4,PHEP(1,IPAR(KP)),PQ,PQ)
-
-          ENDIF
-
-          LP=1
-
-        ENDIF
-
-        IF (.NOT.DISLOW) THEN
-
-C---FIND JET CM MOMENTA
-
-          ECM=PQ(5)
-
-          EMS=0.
-
-          JETRAD=.FALSE.
-
-          DO 180 KP=LP,NP
-
-          EMJ=PHEP(5,IJET(KP))
-
-          EMP=PHEP(5,IPAR(KP))
-
-          JETRAD=JETRAD.OR.EMJ.NE.EMP
-
-          EMS=EMS+EMJ
-
-          PM(KP)= EMJ**2
-
-C---N.B. ROUNDING ERRORS HERE AT HIGH ENERGIES
-
-          PJ(KP)=(HWULDO(PHEP(1,IPAR(KP)),PQ)/ECM)**2-EMP**2
-
-          IF (PJ(KP).LE.ZERO) CALL HWWARN('HWBJCO',104,*999)
-
-  180     CONTINUE
-
-          PF=1.
-
-          IF (JETRAD) THEN
-
-C---JETS DID RADIATE
-
-            IF (EMS.GE.ECM) THEN
-
-              FROST=.TRUE.
-
-              RETURN
-
-            ENDIF
-
-            DO 200 NE=1,NETRY
-
-            EMS=-ECM
-
-            DMS=0.
-
-            DO 190 KP=LP,NP
-
-            ES=SQRT(PF*PJ(KP)+PM(KP))
-
-            EMS=EMS+ES
-
-  190       DMS=DMS+PJ(KP)/ES
-
-            DPF=2.*EMS/DMS
-
-            IF (DPF.GT.PF) DPF=0.9*PF
-
-            PF=PF-DPF
-
-  200       IF (ABS(DPF).LT.EPS) GOTO 210
-
-            CALL HWWARN('HWBJCO',105,*999)
-
-          ENDIF
-
-  210     CONTINUE
-
-        ENDIF
-
-C---BOOST PC AND PQ TO BREIT FRAME IF NECESSARY
-
-        IF (DISPRO.AND.BREIT) THEN
-
-          CALL HWULOF(PBR,PC,PC)
-
-          CALL HWUROF(RBR,PC,PC)
-
-          IF (.NOT.DISLOW) THEN
-
-            CALL HWULOF(PBR,PQ,PQ)
-
-            CALL HWUROF(RBR,PQ,PQ)
-
-          ENDIF
-
-        ENDIF
-
-        DO 230 IP=LP,NP
-
-C---FIND CM ROTATION FOR JET IP
-
-        IF (.NOT.DISLOW) THEN
-
-          CALL HWVEQU(4,PHEP(1,IPAR(IP)),PR)
-
-          IF (DISPRO.AND.BREIT) THEN
-
-            CALL HWULOF(PBR,PR,PR)
-
-            CALL HWUROF(RBR,PR,PR)
-
-          ENDIF
-
-          CALL HWULOF(PQ,PR,PR)
-
-          CALL HWUROT(PR, ONE,ZERO,RR)
-
-          PR(1)=0.
-
-          PR(2)=0.
-
-          PR(3)=SQRT(PF*PJ(IP))
-
-          PR(4)=SQRT(PF*PJ(IP)+PM(IP))
-
-          PR(5)=PHEP(5,IJET(IP))
-
-          CALL HWUROB(RR,PR,PR)
-
-          CALL HWULOB(PC,PR,PR)
-
-        ELSE
-
-          CALL HWVEQU(5,PC,PR)
-
-        ENDIF
-
-C---NOW PR IS LAB/BREIT MOMENTUM OF JET IP
-
-        KP=IJET(IP)+1
-
-        IF (AZCOR.AND.KP.LE.NHEP.AND.IDHW(KP).EQ.17) THEN
-
-C---ALIGN CONE WITH INTERFERING PARTON
-
-          CALL HWUROT(PR, ONE,ZERO,RS)
-
-          JP=JMOHEP(2,KP)
-
-          IF (JP.EQ.0) THEN
-
-            CALL HWWARN('HWBJCO',2,*999)
-
-            PTINF=0.
-
-          ELSE
-
-            CALL HWVEQU(4,PHEP(1,JP),PS)
-
-            IF (DISPRO.AND.BREIT) THEN
-
-              CALL HWULOF(PBR,PS,PS)
-
-              CALL HWUROF(RBR,PS,PS)
-
-            ENDIF
-
-            CALL HWUROF(RS,PS,PS)
-
-            PTINF=PS(1)**2+PS(2)**2
-
-            IF (PTINF.LT.EPS) THEN
-
-C---COLLINEAR JETS: ALIGN CONES
-
-              JP=JDAHEP(1,JP)+1
-
-              IF (ISTHEP(JP).EQ.100.AND.ISTHEP(JP-1)/10.EQ.14) THEN
-
-                CALL HWVEQU(4,PHEP(1,JP),PS)
-
-                IF (DISPRO.AND.BREIT) THEN
-
-                  CALL HWULOF(PBR,PS,PS)
-
-                  CALL HWUROF(RBR,PS,PS)
-
-                ENDIF
-
-                CALL HWUROF(RS,PS,PS)
-
-                PTINF=PS(1)**2+PS(2)**2
-
-              ELSE
-
-                PTINF=0.
-
-              ENDIF
-
-            ENDIF
-
-          ENDIF
-
-          CALL HWVEQU(4,PHEP(1,KP),PB)
-
-          IF (DISPRO.AND.BREIT) THEN
-
-            CALL HWULOF(PBR,PB,PB)
-
-            CALL HWUROF(RBR,PB,PB)
-
-          ENDIF
-
-          PTCON=PB(1)**2+PB(2)**2
-
-          IF (PTCON.NE.ZERO.AND.PTINF.NE.ZERO) THEN
-
-            CN=1./SQRT(PTINF*PTCON)
-
-            CP=CN*(PS(1)*PB(1)+PS(2)*PB(2))
-
-            SP=CN*(PS(1)*PB(2)-PS(2)*PB(1))
-
-          ELSE
-
-            CALL HWRAZM( ONE,CP,SP)
-
-          ENDIF
-
-        ELSE
-
-          CALL HWRAZM( ONE,CP,SP)
-
-        ENDIF
-
-        CALL HWUROT(PR,CP,SP,RS)
-
-C---FIND BOOST FOR JET IP
-
-        ALF=(PHEP(3,IJET(IP))+PHEP(4,IJET(IP)))/
-
-     &      (PR(4)+SQRT((PR(4)+PR(5))*(PR(4)-PR(5))))
-
-        PB(1)=0.
-
-        PB(2)=0.
-
-        PB(3)=ALF-(1./ALF)
-
-        PB(4)=ALF+(1./ALF)
-
-        PB(5)=2.
-
-        IHEP=IJET(IP)
-
-        KHEP=JDAHEP(2,IHEP)
-
-        IF (KHEP.LT.IHEP) KHEP=IHEP
-
-        DO 220 JHEP=IHEP,KHEP
-
-        CALL HWULOF(PB,PHEP(1,JHEP),PHEP(1,JHEP))
-
-        CALL HWUROB(RS,PHEP(1,JHEP),PHEP(1,JHEP))
-
-        CALL HWULF4(PB,VHEP(1,JHEP),VHEP(1,JHEP))
-
-        CALL HWUROB(RS,VHEP(1,JHEP),VHEP(1,JHEP))
-
-C---BOOST FROM BREIT FRAME IF NECESSARY
-
-        IF (DISPRO.AND.BREIT) THEN
-
-          CALL HWUROB(RBR,PHEP(1,JHEP),PHEP(1,JHEP))
-
-          CALL HWULOB(PBR,PHEP(1,JHEP),PHEP(1,JHEP))
-
-          CALL HWUROB(RBR,VHEP(1,JHEP),VHEP(1,JHEP))
-
-          CALL HWULB4(PBR,VHEP(1,JHEP),VHEP(1,JHEP))
-
-        ENDIF
-
-        CALL HWVSUM(4,VHEP(1,JHEP),VHEP(1,IPAR(IP)),VHEP(1,JHEP))
-
-  220   ISTHEP(JHEP)=ISTHEP(JHEP)+10
-
-        IF (KHEP.GT.IHEP+1) THEN
-
-          ISTHEP(IHEP+1)=100
-
-        ELSEIF (KHEP.EQ.IHEP) THEN
-
-C---NON-PARTON JET
-
-          ISTHEP(IHEP)=190
-
-        ENDIF
-
-  230   CONTINUE
-
-        IF (ISTHEP(ICM).EQ.110) ISTHEP(ICM)=120
-
-      ENDIF
-
-      GOTO 20
-
-  999 END
-
-CDECK  ID>, HWBMAS.
-
-*CMZ :-        -26/04/91  11.11.54  by  Bryan Webber
-
-*-- Author :    Bryan Webber
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWBMAS
-
-C-----------------------------------------------------------------------
-
-C     Passes  backwards through a  jet cascade  calculating the masses
-
-C     and magnitudes of the longitudinal and transverse three momenta.
-
-C     Components given relative to direction of parent for a time-like
-
-C     vertex and with respect to z-axis for space-like vertices.
-
-C
-
-C     On input PPAR(1-5,*) contains:
-
-C     (E*sqrt(Xi),Xi,3-mom (if external),E,M-sq (if external))
-
-C
-
-C     On output PPAR(1-5,*) (if TMPAR(*)), containts:
-
-C     (P-trans,Xi or Xilast,P-long,E,M)
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      DOUBLE PRECISION HWUSQR,EXI,PISQ,PJPK,EJEK,PTSQ,Z,ZMIN,ZMAX,
-
-     $     EMI,EMJ,EMK,C,NQ,HWBVMC,RHO,POLD,PNEW,EOLD,ENEW,A,B
-
-      INTEGER IPAR,JPAR,KPAR,MPAR,I,J,K
-
-      EXTERNAL HWUSQR
-
-      IF (IERROR.NE.0) RETURN
-
-      IF (NPAR.GT.2) THEN
-
-        DO 30 MPAR=NPAR-1,3,-2
-
-         JPAR=MPAR
-
-C Find parent and partner of this branch
-
-         IPAR=JMOPAR(1,JPAR)
-
-         KPAR=JPAR+1
-
-C Determine type of branching
-
-         IF (TMPAR(IPAR)) THEN
-
-C Time-like branching
-
-C           Compute mass of parent
-
-            EXI=PPAR(1,JPAR)*PPAR(1,KPAR)
-
-            PPAR(5,IPAR)=PPAR(5,JPAR)+PPAR(5,KPAR)+2.*EXI
-
-C           Compute three momentum of parent
-
-            PISQ=PPAR(4,IPAR)*PPAR(4,IPAR)-PPAR(5,IPAR)
-
-            PPAR(3,IPAR)=HWUSQR(PISQ)
-
-C---SPECIAL FOR G-->QQBAR: READJUST ANGULAR DISTRIBUTION
-
-            IF (IDPAR(IPAR).EQ.13 .AND. IDPAR(JPAR).LT.13) THEN
-
-              Z=PPAR(4,JPAR)/PPAR(4,IPAR)
-
-              ZMIN=HWBVMC(IDPAR(JPAR))/PPAR(1,JPAR)*Z
-
-              RHO=(Z*(3-Z*(3-2*Z))-ZMIN*(3-ZMIN*(3-2*ZMIN)))
-
-     $             /(2*(1-2*ZMIN)*(1-ZMIN*(1-ZMIN)))
-
-              NQ=PPAR(3,IPAR)*(PPAR(3,IPAR)+PPAR(4,IPAR))
-
-              EMI=PPAR(5,IPAR)
-
-              EMJ=PPAR(5,JPAR)
-
-              EMK=PPAR(5,KPAR)
-
-              ZMIN=MAX((EMI+EMJ-EMK)/(2*(EMI+NQ)),
-
-     $           (EMI+EMJ-EMK-SQRT((EMI-EMJ-EMK)**2-4*EMJ*EMK))/(2*EMI))
-
-              ZMAX=1-MAX((EMI-EMJ+EMK)/(2*(EMI+NQ)),
-
-     $           (EMI-EMJ+EMK-SQRT((EMI-EMJ-EMK)**2-4*EMJ*EMK))/(2*EMI))
-
-              C=2*RMASS(IDPAR(JPAR))**2/EMI
-
-              Z=(4*ZMIN*(1.5*(1+C-ZMIN)+ZMIN**2)*(1-RHO)
-
-     $          +4*ZMAX*(1.5*(1+C-ZMAX)+ZMAX**2)*RHO-2-3*C)/(1+2*C)**1.5
-
-              Z=SQRT(1+2*C)*SINH(LOG(Z+SQRT(Z**2+1))/3)+0.5
-
-              Z=(Z*NQ+(EMI+EMJ-EMK)/2)/(NQ+EMI)
-
-              PPAR(4,JPAR)=Z*PPAR(4,IPAR)
-
-              PPAR(4,KPAR)=PPAR(4,IPAR)-PPAR(4,JPAR)
-
-              PPAR(3,JPAR)=HWUSQR(PPAR(4,JPAR)**2-EMJ)
-
-              PPAR(3,KPAR)=HWUSQR(PPAR(4,KPAR)**2-EMK)
-
-              PPAR(2,JPAR)=EXI/(PPAR(4,JPAR)*PPAR(4,KPAR))
-
-              IF(JDAPAR(2,JPAR).NE.0)PPAR(2,JDAPAR(2,JPAR))=PPAR(2,JPAR)
-
-              IF(JDAPAR(2,KPAR).NE.0)PPAR(2,JDAPAR(2,KPAR))=PPAR(2,JPAR)
-
-C---FIND DESCENDENTS OF THIS SPLITTING AND READJUST THEIR MOMENTA TOO
-
-              DO 20 J=JPAR+2,NPAR-1,2
-
-                I=J
-
- 10             I=JMOPAR(1,I)
-
-                IF (I.GT.IPAR) GOTO 10
-
-                IF (I.EQ.IPAR) THEN
-
-                  I=JMOPAR(1,J)
-
-                  K=J+1
-
-                  POLD=PPAR(3,J)+PPAR(3,K)
-
-                  EOLD=PPAR(4,J)+PPAR(4,K)
-
-                  PNEW=HWUSQR(PPAR(4,I)**2-PPAR(5,I))
-
-                  ENEW=PPAR(4,I)
-
-                  A=(ENEW*EOLD-PNEW*POLD)/PPAR(5,I)
-
-                  B=(PNEW*EOLD-ENEW*POLD)/PPAR(5,I)
-
-                  PPAR(3,J)=A*PPAR(3,J)+B*PPAR(4,J)
-
-                  PPAR(4,J)=(PPAR(4,J)+B*PPAR(3,J))/A
-
-                  PPAR(3,K)=PNEW-PPAR(3,J)
-
-                  PPAR(4,K)=ENEW-PPAR(4,J)
-
-                  PPAR(2,J)=1-(PPAR(3,J)*PPAR(3,K)+PPAR(1,J)*PPAR(1,K))
-
-     $                 /(PPAR(4,J)*PPAR(4,K))
-
-                  IF (JDAPAR(2,J).NE.0) PPAR(2,JDAPAR(2,J))=PPAR(2,J)
-
-                  IF (JDAPAR(2,K).NE.0) PPAR(2,JDAPAR(2,K))=PPAR(2,J)
-
-                ENDIF
-
- 20           CONTINUE
-
-            ENDIF
-
-C           Compute daughter' transverse and longitudinal momenta
-
-            PJPK=PPAR(3,JPAR)*PPAR(3,KPAR)
-
-            EJEK=PPAR(4,JPAR)*PPAR(4,KPAR)-EXI
-
-            PTSQ=(PJPK+EJEK)*(PJPK-EJEK)/PISQ
-
-            PPAR(1,JPAR)=HWUSQR(PTSQ)
-
-            PPAR(3,JPAR)=HWUSQR(PPAR(3,JPAR)*PPAR(3,JPAR)-PTSQ)
-
-            PPAR(1,KPAR)=-PPAR(1,JPAR)
-
-            PPAR(3,KPAR)= PPAR(3,IPAR)-PPAR(3,JPAR)
-
-         ELSE
-
-C Space-like branching
-
-C           Re-arrange such that JPAR is time-like
-
-            IF (TMPAR(KPAR)) THEN
-
-               KPAR=JPAR
-
-               JPAR=JPAR+1
-
-            ENDIF
-
-C           Compute time-like branch
-
-            PTSQ=(2.-PPAR(2,JPAR))*PPAR(1,JPAR)*PPAR(1,JPAR)
-
-     &          -PPAR(5,JPAR)
-
-            PPAR(1,JPAR)=HWUSQR(PTSQ)
-
-            PPAR(3,JPAR)=(1.-PPAR(2,JPAR))*PPAR(4,JPAR)
-
-            PPAR(3,IPAR)=PPAR(3,KPAR)-PPAR(3,JPAR)
-
-            PPAR(5,IPAR)=0.
-
-            PPAR(1,KPAR)=0.
-
-         ENDIF
-
-C Reset Xi to Xilast
-
-         PPAR(2,KPAR)=PPAR(2,IPAR)
-
- 30    CONTINUE
-
-      ENDIF
-
-      DO 40 IPAR=2,NPAR
-
- 40   PPAR(5,IPAR)=HWUSQR(PPAR(5,IPAR))
-
-      PPAR(1,2)=0.
-
-      PPAR(2,2)=0.
-
-      END
diff --git a/HERWIG/src/hwbran.f b/HERWIG/src/hwbran.f
deleted file mode 100644 (file)
index a582936..0000000
+++ /dev/null
@@ -1,2328 +0,0 @@
-
-CDECK  ID>, HWBRAN.
-
-*CMZ :-        -14/10/99  18.04.56  by  Mike Seymour
-
-*-- Author :    Bryan Webber & Mike Seymour
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWBRAN(KPAR)
-
-C-----------------------------------------------------------------------
-
-C     BRANCHES TIMELIKE PARTON KPAR INTO TWO, PUTS PRODUCTS
-
-C     INTO NPAR+1 AND NPAR+2, AND INCREASES NPAR BY TWO
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      DOUBLE PRECISION HWBVMC,HWR,HWUALF,HWUTAB,HWRUNI,HWULDO,PMOM,
-
-     & QNOW,QLST,QKTHR,RN,QQBAR,DQQ,QGTHR,SNOW,QSUD,ZMIN,ZMAX,ZRAT,WMIN,
-
-     & QLAM,Z1,Z2,ETEST,ZTEST,ENOW,XI,XIPREV,EPREV,QMAX,QGAM,SLST,SFNL,
-
-     & TARG,ALF,BETA0(3:6),BETAP(3:6),SQRK(4:6,5),REJFAC,Z,X1,X2,OTHXI,
-
-     & OTHZ,X3,FF,AW,XCUT,CC,JJ,HWUSQR
-
-      INTEGER HWRINT,KPAR,ID,JD,IS,NTRY,N,ID1,ID2,MPAR,ISUD(13),IHEP,
-
-     & JHEP,M,NF,NN,IREJ,NREJ,ITOP
-
-      EXTERNAL HWBVMC,HWR,HWUALF,HWUTAB,HWRUNI,HWULDO,HWRINT,HWUSQR
-
-      SAVE BETA0,BETAP,SQRK
-
-      DATA ISUD,BETA0/2,2,3,4,5,6,2,2,3,4,5,6,1,4*ZERO/
-
-      IF (IERROR.NE.0) RETURN
-
-C---SET SQRK(M,N) TO THE PROBABILITY THAT A GLUON WILL NOT PRODUCE A
-
-C   QUARK-ANTIQUARK PAIR BETWEEN SCALES RMASS(M) AND 2*HWBVMC(N)
-
-      IF (SUDORD.NE.1.AND.BETA0(3).EQ.ZERO) THEN
-
-        DO 100 M=3,6
-
-          BETA0(M)=(11.*CAFAC-2.*M)*0.5
-
- 100      BETAP(M)=(17.*CAFAC**2-(5.*CAFAC+3.*CFFAC)*M)
-
-     &            /BETA0(M)*0.25/PIFAC
-
-        DO 120 N=1,5
-
-          DO 110 M=4,6
-
-            IF (M.LE.N) THEN
-
-              SQRK(M,N)=ONE
-
-            ELSEIF (M.EQ.4.OR.M.EQ.N+1) THEN
-
-              NF=M
-
-              IF (2*HWBVMC(N).GT.RMASS(M)) NF=M+1
-
-              SQRK(M,N)=((BETAP(NF-1)+1/HWUALF(1,2*HWBVMC(N)))/
-
-     $             (BETAP(NF-1)+1/HWUALF(1,RMASS(M))))**(1/BETA0(NF-1))
-
-            ELSE
-
-              SQRK(M,N)=SQRK(M-1,N)*
-
-     $             ((BETAP(M-1)+1/HWUALF(1,RMASS(M-1)))/
-
-     $             (BETAP(M-1)+1/HWUALF(1,RMASS(M))))**(1/BETA0(M-1))
-
-            ENDIF
-
- 110      CONTINUE
-
- 120    CONTINUE
-
-      ENDIF
-
-      ID=IDPAR(KPAR)
-
-C--TEST FOR PARTON TYPE
-
-      IF (ID.LE.13) THEN
-
-        JD=ID
-
-        IS=ISUD(ID)
-
-      ELSEIF (ID.GE.209.AND.ID.LE.220) THEN
-
-        JD=ID-208
-
-        IS=7
-
-      ELSE
-
-        IS=0
-
-      END IF
-
-      QNOW=-1.
-
-      IF (IS.NE.0) THEN
-
-C--TIMELIKE PARTON BRANCHING
-
-        ENOW=PPAR(4,KPAR)
-
-        XIPREV=PPAR(2,KPAR)
-
-        IF (JMOPAR(1,KPAR).EQ.0) THEN
-
-          EPREV=PPAR(4,KPAR)
-
-        ELSE
-
-          EPREV=PPAR(4,JMOPAR(1,KPAR))
-
-        ENDIF
-
-C--IF THIS IS CHARGED & PHOTONS ARE ALLOWED, ANGLES MIGHT NOT BE ORDERED
-
-        QMAX=0
-
-        QLST=PPAR(1,KPAR)
-
-        IF (ICHRG(ID).NE.0 .AND. VPCUT.LT.PPAR(1,2)) THEN
-
-C--LOOK FOR A PREVIOUS G->QQBAR, IF ANY
-
-          MPAR=KPAR
-
- 1        IF (JMOPAR(1,MPAR).NE.0) THEN
-
-            IF (IDPAR(JMOPAR(1,MPAR)).EQ.ID) THEN
-
-              MPAR=JMOPAR(1,MPAR)
-
-              GOTO 1
-
-            ENDIF
-
-          ENDIF
-
-C--IF CLIMBED TO THE TOP OF THE LIST, FIND QED INTERFERENCE PARTNER
-
-          IF (MPAR.EQ.2) THEN
-
-            JHEP=0
-
-            IF (ID.LT.7) THEN
-
-              IHEP=JDAHEP(2,JCOPAR(1,1))
-
-              IF (IHEP.GT.0) JHEP=JDAHEP(2,IHEP)
-
-            ELSE
-
-              IHEP=JMOHEP(2,JCOPAR(1,1))
-
-              IF (IHEP.GT.0) JHEP=JMOHEP(2,IHEP)
-
-            ENDIF
-
-            IF (IHEP.GT.0.AND.JHEP.GT.0) THEN
-
-               QMAX=HWULDO(PHEP(1,IHEP),PHEP(1,JHEP))
-
-     &              *(ENOW/PPAR(4,2))**2
-
-            ELSE
-
-C--FIX AT HARD PROCESS SCALE IF POINTER NOT YET SET
-
-C  (CAN HAPPEN IN SUSY EVENTS)
-
-               QMAX=EMSCA**2
-
-            ENDIF
-
-          ELSE
-
-            QMAX=ENOW**2*PPAR(2,MPAR)
-
-          ENDIF
-
-C--IF PREVIOUS BRANCHING WAS Q->QGAMMA, LOOK FOR A QCD BRANCHING
-
-          MPAR=KPAR
-
- 2        IF (JMOPAR(1,MPAR).NE.0) THEN
-
-            IF (IDPAR(JDAPAR(1,JMOPAR(1,MPAR))).EQ.59 .OR.
-
-     &        IDPAR(JDAPAR(2,JMOPAR(1,MPAR))).EQ.59) THEN
-
-              MPAR=JMOPAR(1,MPAR)
-
-              GOTO 2
-
-            ENDIF
-
-          ENDIF
-
-          QLST=ENOW**2*PPAR(2,MPAR)
-
-          QMAX=SQRT(MAX(ZERO,MIN(
-
-     &         QMAX , EPREV**2*XIPREV , ENOW**2*XIPREV*(2-XIPREV))))
-
-          QLST=SQRT(MIN(
-
-     &         QLST , EPREV**2*XIPREV , ENOW**2*XIPREV*(2-XIPREV)))
-
-        ENDIF
-
-        NTRY=0
-
-    5   NTRY=NTRY+1
-
-        IF (NTRY.GT.NBTRY) CALL HWWARN('HWBRAN',100,*999)
-
-        IF (ID.EQ.13) THEN
-
-C--GLUON -> QUARK+ANTIQUARK OPTION
-
-          IF (QLST.GT.QCDL3) THEN
-
-            DO 8 N=1,NFLAV
-
-            QKTHR=2.*HWBVMC(N)
-
-            IF (QLST.GT.QKTHR) THEN
-
-              RN=HWR()
-
-              IF (SUDORD.NE.1) THEN
-
-C---FIND IN WHICH FLAVOUR INTERVAL THE UPPER LIMIT LIES
-
-                NF=3
-
-                DO 200 M=MAX(3,N),NFLAV
-
- 200              IF (QLST.GT.RMASS(M)) NF=M
-
-C---CALCULATE THE FORM FACTOR
-
-                IF (NF.EQ.MAX(3,N)) THEN
-
-                  SFNL=((BETAP(NF)+1/HWUALF(1,QKTHR))/
-
-     $                 (BETAP(NF)+1/HWUALF(1,QLST)))**(1/BETA0(NF))
-
-                  SLST=SFNL
-
-                ELSE
-
-                  SFNL=((BETAP(NF)+1/HWUALF(1,RMASS(NF)))/
-
-     $                 (BETAP(NF)+1/HWUALF(1,QLST)))**(1/BETA0(NF))
-
-                  SLST=SFNL*SQRK(NF,N)
-
-                ENDIF
-
-              ENDIF
-
-              IF (RN.GT.1.E-3) THEN
-
-                QQBAR=QCDL3*(QLST/QCDL3)**(RN**BETAF)
-
-              ELSE
-
-                QQBAR=QCDL3
-
-              ENDIF
-
-              IF (SUDORD.NE.1) THEN
-
-C---FIND IN WHICH FLAVOUR INTERVAL THE SOLUTION LIES
-
-                IF (RN.GE.SFNL) THEN
-
-                  NN=NF
-
-                ELSEIF (RN.GE.SLST) THEN
-
-                  NN=MAX(3,N)
-
-                  DO 210 M=MAX(3,N)+1,NF-1
-
- 210                IF (RN.GE.SLST/SQRK(M,N)) NN=M
-
-                ELSE
-
-                  NN=0
-
-                  QQBAR=QCDL3
-
-                ENDIF
-
-                IF (NN.GT.0) THEN
-
-                  IF (NN.EQ.NF) THEN
-
-                    TARG=HWUALF(1,QLST)
-
-                  ELSE
-
-                    TARG=HWUALF(1,RMASS(NN+1))
-
-                    RN=RN/SLST*SQRK(NN+1,N)
-
-                  ENDIF
-
-                  TARG=1/((BETAP(NN)+1/TARG)*RN**BETA0(NN)-BETAP(NN))
-
-C---NOW SOLVE HWUALF(1,QQBAR)=TARG FOR QQBAR ITERATIVELY
-
- 7                QQBAR=MAX(QQBAR,HALF*QKTHR)
-
-                  ALF=HWUALF(1,QQBAR)
-
-                  IF (ABS(ALF-TARG).GT.ACCUR) THEN
-
-                    NTRY=NTRY+1
-
-                    IF (NTRY.GT.NBTRY) CALL HWWARN('HWBRAN',101,*999)
-
-                    QQBAR=QQBAR*(1+3*PIFAC*(ALF-TARG)
-
-     $                   /(BETA0(NN)*ALF**2*(1+BETAP(NN)*ALF)))
-
-                    GOTO 7
-
-                  ENDIF
-
-                ENDIF
-
-              ENDIF
-
-              IF (QQBAR.GT.QNOW.AND.QQBAR.GT.QKTHR) THEN
-
-                QNOW=QQBAR
-
-                ID2=N
-
-              ENDIF
-
-            ELSE
-
-              GOTO 9
-
-            ENDIF
-
-    8       CONTINUE
-
-          ENDIF
-
-C--GLUON->DIQUARKS OPTION
-
-    9     IF (QLST.LT.QDIQK) THEN
-
-            IF (PDIQK.NE.ZERO) THEN
-
-              RN=HWR()
-
-              DQQ=QLST*EXP(-RN/PDIQK)
-
-              IF (DQQ.GT.QNOW) THEN
-
-                IF (DQQ.GT.2.*RMASS(115)) THEN
-
-                  QNOW=DQQ
-
-                  ID2=115
-
-                ENDIF
-
-              ENDIF
-
-            ENDIF
-
-          ENDIF
-
-        ENDIF
-
-C--ENHANCE GLUON AND PHOTON EMISSION BY A FACTOR OF TWO IF THIS BRANCH
-
-C  IS CAPABLE OF BEING THE HARDEST SO FAR
-
-        NREJ=1
-
-        IF (TMPAR(2).AND.0.25*MAX(QLST,QMAX).GT.HARDST) NREJ=2
-
-C--BRANCHING ID->ID+GLUON
-
-        QGTHR=HWBVMC(ID)+HWBVMC(13)
-
-        IF (QLST.GT.QGTHR) THEN
-
-         DO 300 IREJ=1,NREJ
-
-          RN=HWR()
-
-          SLST=HWUTAB(SUD(1,IS),QEV(1,IS),NQEV,QLST,INTER)
-
-          IF (RN.EQ.ZERO) THEN
-
-            SNOW=2.
-
-          ELSE
-
-            SNOW=SLST/RN
-
-          ENDIF
-
-          IF (SNOW.LT.ONE) THEN
-
-            QSUD=HWUTAB(QEV(1,IS),SUD(1,IS),NQEV,SNOW,INTER)
-
-C---IF FORM FACTOR DID NOT GET INVERTED CORRECTLY TRY LINEAR INSTEAD
-
-            IF (QSUD.GT.QLST) THEN
-
-              SNOW=HWUTAB(SUD(1,IS),QEV(1,IS),NQEV,QLST,1)/RN
-
-              QSUD=HWUTAB(QEV(1,IS),SUD(1,IS),NQEV,SNOW,1)
-
-              IF (QSUD.GT.QLST) THEN
-
-                CALL HWWARN('HWBRAN',1,*999)
-
-                QSUD=-1
-
-              ENDIF
-
-            ENDIF
-
-            IF (QSUD.GT.QGTHR.AND.QSUD.GT.QNOW) THEN
-
-              ID2=13
-
-              QNOW=QSUD
-
-            ENDIF
-
-          ENDIF
-
- 300     CONTINUE
-
-        ENDIF
-
-C--BRANCHING ID->ID+PHOTON
-
-        IF (ICHRG(ID).NE.0) THEN
-
-          QGTHR=MAX(HWBVMC(ID)+HWBVMC(59),HWBVMC(59)*EXP(0.75))
-
-          IF (QMAX.GT.QGTHR) THEN
-
-           DO 400 IREJ=1,NREJ
-
-            RN=HWR()
-
-            IF (RN.EQ.ZERO) THEN
-
-              QGAM=0
-
-            ELSE
-
-              QGAM=(LOG(QMAX/HWBVMC(59))-0.75)**2
-
-     &            +PIFAC*9/(ICHRG(ID)**2*ALPFAC*ALPHEM)*LOG(RN)
-
-              IF (QGAM.GT.ZERO) THEN
-
-                QGAM=HWBVMC(59)*EXP(0.75+SQRT(QGAM))
-
-              ELSE
-
-                QGAM=0
-
-              ENDIF
-
-            ENDIF
-
-            IF (QGAM.GT.QGTHR.AND.QGAM.GT.QNOW) THEN
-
-              ID2=59
-
-              QNOW=QGAM
-
-            ENDIF
-
- 400       CONTINUE
-
-          ENDIF
-
-        ENDIF
-
-        IF (QNOW.GT.ZERO) THEN
-
-C--BRANCHING HAS OCCURRED
-
-          ZMIN=HWBVMC(ID2)/QNOW
-
-          ZMAX=1.-ZMIN
-
-          IF (ID.EQ.13) THEN
-
-            IF (ID2.EQ.13) THEN
-
-C--GLUON -> GLUON + GLUON
-
-              ID1=13
-
-              WMIN=ZMIN*ZMAX
-
-              ETEST=(1.-WMIN)**2*HWUALF(5-SUDORD*2,QNOW*WMIN)
-
-              ZRAT=(ZMAX*(1-ZMIN))/(ZMIN*(1-ZMAX))
-
-C--CHOOSE Z1 DISTRIBUTED ON (ZMIN,ZMAX)
-
-C  ACCORDING TO GLUON BRANCHING FUNCTION
-
-   10         Z1=ZMAX/(ZMAX+(1-ZMAX)*ZRAT**HWR())
-
-              Z2=1.-Z1
-
-              ZTEST=(1.-(Z1*Z2))**2*HWUALF(5-SUDORD*2,QNOW*(Z1*Z2))
-
-              IF (ZTEST.LT.ETEST*HWR()) GOTO 10
-
-              Z=Z1
-
-            ELSEIF (ID2.NE.115) THEN
-
-C--GLUON -> QUARKS
-
-              ID1=ID2+6
-
-              ETEST=ZMIN**2+ZMAX**2
-
-   20         Z1=HWRUNI(0,ZMIN,ZMAX)
-
-              Z2=1.-Z1
-
-              ZTEST=Z1*Z1+Z2*Z2
-
-              IF (ZTEST.LT.ETEST*HWR()) GOTO 20
-
-            ELSE
-
-C--GLUON -> DIQUARKS
-
-              ID2=HWRINT(115,117)
-
-              ID1=ID2-6
-
-              Z1=HWRUNI(0,ZMIN,ZMAX)
-
-              Z2=1.-Z1
-
-            ENDIF
-
-          ELSE
-
-C--QUARK OR ANTIQUARK BRANCHING
-
-            IF (ID2.EQ.13) THEN
-
-C--TO GLUON
-
-              ZMAX=1.-HWBVMC(ID)/QNOW
-
-              WMIN=MIN(ZMIN*(1.-ZMIN),ZMAX*(1.-ZMAX))
-
-              ETEST=(1.+ZMAX**2)*HWUALF(5-SUDORD*2,QNOW*WMIN)
-
-              ZRAT=ZMAX/ZMIN
-
-   30         Z1=ZMIN*ZRAT**HWR()
-
-              Z2=1.-Z1
-
-              ZTEST=(1.+Z2*Z2)*HWUALF(5-SUDORD*2,QNOW*Z1*Z2)
-
-              IF (ZTEST.LT.ETEST*HWR()) GOTO 30
-
-            ELSE
-
-C--TO PHOTON
-
-              ZMIN=  HWBVMC(59)/QNOW
-
-              ZMAX=1-HWBVMC(ID)/QNOW
-
-              ZRAT=ZMAX/ZMIN
-
-              ETEST=1+(1-ZMIN)**2
-
-   40         Z1=ZMIN*ZRAT**HWR()
-
-              Z2=1-Z1
-
-              ZTEST=1+Z2*Z2
-
-              IF (ZTEST.LT.ETEST*HWR()) GOTO 40
-
-            ENDIF
-
-C--QUARKS EMIT ON LOWER SIDE, ANTIQUARKS ON UPPER SIDE
-
-            Z=Z1
-
-            IF (JD.LE.6) THEN
-
-              Z1=Z2
-
-              Z2=1.-Z2
-
-              ID1=ID
-
-            ELSE
-
-              ID1=ID2
-
-              ID2=ID
-
-            ENDIF
-
-          ENDIF
-
-C--UPDATE THIS BRANCH AND CREATE NEW BRANCHES
-
-          XI=(QNOW/ENOW)**2
-
-          IF (ID1.NE.59.AND.ID2.NE.59) THEN
-
-            IF (ID.EQ.13.AND.ID1.NE.13) THEN
-
-              QLAM=QNOW
-
-            ELSE
-
-              QLAM=QNOW*Z1*Z2
-
-            ENDIF
-
-            IF (SUDORD.EQ.1.AND.HWUALF(2,QLAM).LT.HWR() .OR.
-
-     &           (2.-XI)*(QNOW*Z1*Z2)**2.GT.EMSCA**2) THEN
-
-C--BRANCHING REJECTED: REDUCE Q AND REPEAT
-
-                QMAX=QNOW
-
-                QLST=QNOW
-
-                QNOW=-1.
-
-                GOTO 5
-
-            ENDIF
-
-          ENDIF
-
-C--IF THIS IS HARDEST EMISSION SO FAR, APPLY MATRIX-ELEMENT CORRECTION
-
-          IF (ID.NE.13.OR.ID1.EQ.13) THEN
-
-            QLAM=QNOW*Z1*Z2
-
-            REJFAC=1
-
-            IF (TMPAR(2).AND.QLAM.GT.HARDST) THEN
-
-C----SOFT MATRIX-ELEMENT CORRECTION TO TOP DECAYS
-
-              ITOP=JCOPAR(1,1)
-
-              IF (ISTHEP(ITOP).EQ.155.AND.(IDHW(ITOP).EQ.6
-
-     $             .OR.IDHW(ITOP).EQ.12)) THEN
-
-                AW=(PHEP(5,JDAHEP(1,ITOP))/PHEP(5,ITOP))**2
-
-                FF=0.5*(1-AW)*(1-2*AW+1/AW)
-
-                CC=0.25*(1-AW)**2
-
-                X1=1-2*CC*Z*(1-Z)*XI
-
-                X3=0.5*(1-AW+2*CC*Z*(1-Z)*XI-(1-2*Z)
-
-     &               *HWUSQR(((1+AW-2*CC*Z*(1-Z)*XI)**2-4*AW)
-
-     &               /(1-2*Z*(1-Z)*XI)))
-
-C-----JACOBIAN FACTOR
-
-                JJ=(1-X1)*(2-AW-X1-2*X3)*(1-2*Z*(1-Z)*XI)/(
-
-     $               4*CC**2*((X1+AW)**2-4*AW)*Z**2*(1-Z)**2*(1-2*Z)*XI)
-
-C-----REJECTION FACTOR
-
-                XCUT=2*GCUTME/PHEP(5,ITOP)
-
-                IF (X3.GT.XCUT) REJFAC=FF*JJ
-
-     &               *X3**2*(1-X1)*(1+(1-Z)**2)/(Z*XI)
-
-     &               /((1+1/AW-2*AW)*((1-AW)*X3-(1-X1)
-
-     &               *(1-X3)-X3**2)+(1+1/(2*AW))*X3*(X1+X3-1)**2
-
-     &               +2*X3**2*(1-X1))
-
-              ELSEIF (MOD(ISTHEP(JCOPAR(1,1)),10).GE.3) THEN
-
-C---COLOUR PARTNER IS ALSO OUTGOING
-
-                X1=1-Z*(1-Z)*XI
-
-                X2=0.5*(1+Z*(1-Z)*XI +
-
-     $               (1-Z*(1-Z)*XI)*(1-2*Z)/SQRT(1-2*Z*(1-Z)*XI))
-
-                REJFAC=SQRT(2*X1-1)/(X1*Z*(1-Z))
-
-     $               *(1+(1-Z)**2)/(Z*XI)
-
-     $               *(1-X1)*(1-X2)/(X1**2+X2**2)
-
-C---CHECK WHETHER IT IS IN THE OVERLAP REGION
-
-                OTHXI=4*(1-X2)*X2**2/(X2**2-(2*X2-1)*(2*X1+X2-2)**2)
-
-                IF (OTHXI.LT.ONE) THEN
-
-                  OTHZ=0.5*(1-SQRT(2*X2-1)/X2*(2*X1+X2-2))
-
-                  REJFAC=REJFAC+SQRT(2*X2-1)/(X2*OTHZ*(1-OTHZ))
-
-     $                 *(1+(1-OTHZ)**2)/(OTHZ*OTHXI)
-
-     $                 *(1-X2)*(1-X1)/(X2**2+X1**2)
-
-                ENDIF
-
-              ELSE
-
-C---COLOUR PARTNER IS INCOMING (X1=XP, X2=ZP)
-
-                X1=1/(1+Z*(1-Z)*XI)
-
-                X2=0.5*(1+(1-2*Z)/SQRT(1-2*Z*(1-Z)*XI))
-
-                REJFAC=SQRT(3-2/X1)/(X1**2*Z*(1-Z))
-
-     $               *(1+(1-Z)**2)/(Z*XI)
-
-     $               *(1-X1)*(1-X2)/
-
-     $               (1+(1-X1-X2+2*X1*X2)**2+2*(1-X1)*(1-X2)*X1*X2)
-
-C---CHECK WHETHER IT IS IN THE OVERLAP REGION
-
-                OTHXI=(SQRT(X1+2*(1-X2)*(1-X2+X1*X2))-SQRT(X1))**2/
-
-     $               (1+X1-X2-SQRT(X1*(X1+2*(1-X2)*(1-X2+X1*X2))))
-
-                OTHZ=(SQRT(X1*(X1+2*(1-X2)*(1-X2+X1*X2)))-X1)/(1-X2)
-
-                IF (OTHXI.LT.OTHZ**2) THEN
-
-                  REJFAC=REJFAC+OTHZ**3*(1-X1-X2+2*X1*X2)
-
-     $                 /(X1**2*(1-OTHZ)*(OTHZ+OTHXI*(1-OTHZ)))
-
-     $                 *(1+OTHZ**2)/((1-OTHZ)*OTHXI)
-
-     $                 *(1-X1)*(1-X2)/
-
-     $                 (1+(1-X1-X2+2*X1*X2)**2+2*(1-X1)*(1-X2)*X1*X2)
-
-                ENDIF
-
-              ENDIF
-
-            ENDIF
-
-            IF (NREJ*REJFAC*HWR().GT.ONE) THEN
-
-              QMAX=QNOW
-
-              QLST=QNOW
-
-              QNOW=-1.
-
-              GOTO 5
-
-            ENDIF
-
-            IF (QLAM.GT.HARDST) HARDST=QLAM
-
-          ENDIF
-
-          MPAR=NPAR+1
-
-          IDPAR(MPAR)=ID1
-
-          TMPAR(MPAR)=.TRUE.
-
-          PPAR(1,MPAR)=QNOW*Z1
-
-          PPAR(2,MPAR)=XI
-
-          PPAR(4,MPAR)=ENOW*Z1
-
-          NPAR=NPAR+2
-
-          IDPAR(NPAR)=ID2
-
-          TMPAR(NPAR)=.TRUE.
-
-          PPAR(1,NPAR)=QNOW*Z2
-
-          PPAR(2,NPAR)=XI
-
-          PPAR(4,NPAR)=ENOW*Z2
-
-C---NEW MOTHER-DAUGHTER RELATIONS
-
-          JDAPAR(1,KPAR)=MPAR
-
-          JDAPAR(2,KPAR)=NPAR
-
-          JMOPAR(1,MPAR)=KPAR
-
-          JMOPAR(1,NPAR)=KPAR
-
-C---NEW COLOUR CONNECTIONS
-
-          JCOPAR(3,KPAR)=NPAR
-
-          JCOPAR(4,KPAR)=MPAR
-
-          JCOPAR(1,MPAR)=NPAR
-
-          JCOPAR(2,MPAR)=KPAR
-
-          JCOPAR(1,NPAR)=KPAR
-
-          JCOPAR(2,NPAR)=MPAR
-
-C
-
-        ENDIF
-
-      ENDIF
-
-      IF (QNOW.LT.ZERO) THEN
-
-C--BRANCHING STOPS
-
-        IF (ID.EQ.IDPAR(2).AND.PPAR(5,2).GT.1D-6) THEN
-
-          PPAR(5,KPAR)=PPAR(5,2)**2
-
-        ELSE
-
-          PPAR(5,KPAR)=RMASS(ID)**2
-
-        ENDIF
-
-        PMOM=PPAR(4,KPAR)**2-PPAR(5,KPAR)
-
-        IF (PMOM.LT.-1E-6) CALL HWWARN('HWBRAN',104,*999)
-
-        IF (PMOM.LT.ZERO) PMOM=ZERO
-
-        PPAR(3,KPAR)=SQRT(PMOM)
-
-        JDAPAR(1,KPAR)=0
-
-        JDAPAR(2,KPAR)=0
-
-        JCOPAR(3,KPAR)=0
-
-        JCOPAR(4,KPAR)=0
-
-      ENDIF
-
-  999 END
-
-CDECK  ID>, HWBRCN.
-
-*CMZ :-        -20/07/99  10:56:12  by  Peter Richardson
-
-*-- Author :    Peter Richardson
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWBRCN
-
-C-----------------------------------------------------------------------
-
-C     SUBROUTINE TO REPLACE HWBCON IN RPARITY VIOLATING SUSY
-
-C     BASED ON HWBCON BY BRW
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      INTEGER IHEP,IST,ID,JC,JD,JHEP,IDP,IDM,IDP2,IDM2,
-
-     &        RHEP,IST2,ORG,ANTC,XHEP,IP,COLP
-
-      LOGICAL BVVUSE,BVVHRD,BVDEC1,BVDEC2,COLRD,ACOLRD,BVHRD,BVHRD2,
-
-     &        BVDEC3
-
-C--logical functions to decide if baryon number violating
-
-C--BVDEC1 DELTAB=+1
-
-      BVDEC1(IP) = ((IDHW(IP).GE.419.AND.IDHW(IP).LE.424).OR.
-
-     &              IDHW(IP).EQ.411.OR.IDHW(IP).EQ.412.OR.
-
-     &              IDHW(IP).EQ.449).AND.IDHW(JDAHEP(1,IP)).LE.6.
-
-     &              AND.IDHW(JDAHEP(1,IP)+1).LE.6.AND.
-
-     &              IDHW(JDAHEP(2,IP)).LE.6
-
-C--BVDEC2 DELTAB=-1
-
-      BVDEC2(IP) = ((IDHW(IP).GE.413.AND.IDHW(IP).LE.418).OR.
-
-     &              IDHW(IP).EQ.405.OR.IDHW(IP).EQ.406.OR.
-
-     &              IDHW(IP).EQ.449).AND.
-
-     &    IDHW(JDAHEP(1,IP)).GE.7.AND.IDHW(JDAHEP(1,IP)).LE.12.AND.
-
-     &    IDHW(JDAHEP(1,IP)+1).GE.7.AND.IDHW(JDAHEP(1,IP)+1).LE.12.AND.
-
-     &    IDHW(JDAHEP(2,IP)).GE.7.AND.IDHW(JDAHEP(2,IP)).LE.12
-
-C--Neutralino and Chargino Decays
-
-      BVDEC3(IP) = ((IDHW(IP).GE.450.AND.IDHW(IP).LE.457).AND.
-
-     &   (IDHW(JDAHEP(1,IP)).LE.12.AND.IDHW(JDAHEP(1,IP)+1).LE.12.
-
-     &    .AND.IDHW(JDAHEP(2,IP)).LE.12))
-
-C--Now the hard vertices
-
-      BVHRD(IP) = IDHW(IP).EQ.15.AND.IDHW(JMOHEP(1,IP)).LE.12.
-
-     &    AND.IDHW(JMOHEP(2,IP)).LE.12.AND.IDHW(JDAHEP(1,IP)).LE.12.
-
-     &    AND.IDHW(JDAHEP(2,IP)).GE.449.AND.IDHW(JDAHEP(2,IP)).LE.457
-
-      BVHRD2(IP) = IDHW(IP).EQ.15.AND.IDHW(JMOHEP(1,IP)).LE.12.
-
-     &    AND.IDHW(JMOHEP(2,IP)).LE.12.AND.IDHW(JDAHEP(1,IP)).GE.198.
-
-     &    AND.IDHW(JDAHEP(1,IP)).LE.207.
-
-     &    AND.ABS(IDHEP(JDAHEP(2,IP))).GT.1000000
-
-C--Those particles which are coloured
-
-      COLRD(IP) = IP.LE.6.OR.IP.EQ.13.OR.IP.EQ.449.OR.
-
-     &   (IP.GE.401.AND.IP.LE.406).OR.(IP.GE.413.AND.IP.LE.418).OR.
-
-     &   (IP.GE.115.AND.IP.LE.120).OR.IP.EQ.59
-
-C--Those particles which are anticoloured
-
-      ACOLRD(IP) = (IP.GE.7.AND.IP.LE.12).OR.IP.EQ.13.OR.IP.EQ.449.OR.
-
-     & (IP.GE.407.AND.IP.LE.412).OR.(IP.GE.419.AND.IP.LE.424).OR.
-
-     & (IP.GE.109.AND.IP.LE.114).OR.IP.EQ.59
-
-      IF (IERROR.NE.0) RETURN
-
-      COLP = 0
-
-      IF(COLUPD.AND.HRDCOL(1,3).NE.0) THEN
-
-        JD = 0
-
-        DO IHEP = HRDCOL(1,3),HRDCOL(1,3)+4
-
-          JD = JD+1
-
-          IF(JD.NE.3) THEN
-
-            JMOHEP(2,IHEP) = HRDCOL(1,JD)
-
-            JDAHEP(2,IHEP) = HRDCOL(2,JD)
-
-          ENDIF
-
-        ENDDO
-
-        COLUPD=.FALSE.
-
-        DO IHEP=1,5
-
-          DO JHEP=1,2
-
-            HRDCOL(JHEP,IHEP)=0
-
-          ENDDO
-
-        ENDDO
-
-      ELSEIF(COLUPD) THEN
-
-        RETURN
-
-      ENDIF
-
-      DO 110 IHEP=1,NHEP
-
-      IST=ISTHEP(IHEP)
-
-      JD =0
-
-      BVVUSE = .FALSE.
-
-      BVVHRD = .FALSE.
-
-C---LOOK FOR PARTONS WITHOUT COLOUR MOTHERS
-
-      IF ((IST.LT.145.OR.IST.GT.152).AND.IST.NE.155) GOTO 110
-
-      IF (JMOHEP(2,IHEP).EQ.0) THEN
-
-C---FIND COLOUR-CONNECTED PARTON
-
-        IF(IST.EQ.155.AND.ABS(IDHEP(IHEP)).EQ.6) THEN
-
-          JC = JMOHEP(1,IHEP)
-
-        ELSEIF(IST.EQ.155) THEN
-
-          GOTO 110
-
-        ELSE
-
-          JC=JMOHEP(1,IHEP)
-
-        ENDIF
-
-        IF (IST.NE.152) JC=JMOHEP(1,JC)
-
-C--Correction for BV
-
-        IF(HRDCOL(1,1).NE.0) THEN
-
-          IDP = IDHW(HRDCOL(1,1))
-
-          IDP2 = 0
-
-        ELSE
-
-          IDP  = 0
-
-          IDP2 = 0
-
-        ENDIF
-
-        IDM = JMOHEP(1,JC)
-
-        IF(BVDEC1(IDM).OR.BVDEC2(IDM)) THEN
-
-          IF(IDHW(IDM).EQ.449.AND.JDAHEP(1,IDM).EQ.JC) THEN
-
-            JC=JMOHEP(2,JC)
-
-          ELSE
-
-            JD = JMOHEP(2,JC)
-
-            JC = IDM
-
-            IF(JC.EQ.JD) JD= JDAHEP(2,JC-1)
-
-            BVVUSE = .TRUE.
-
-          ENDIF
-
-C--NEW FOR BV HARD PROCESS
-
-        ELSEIF(BVHRD(IDM)) THEN
-
-          IF(IDHW(JDAHEP(2,JMOHEP(1,JC))).EQ.449) THEN
-
-            JD   = JMOHEP(2,JC)
-
-            IDM2 = JDAHEP(2,HRDCOL(1,2))
-
-            IF(JD.EQ.IDM2) JD = HRDCOL(1,1)
-
-            IF(JC.EQ.JDAHEP(2,IDM2).AND.COLRD(IDHW(IHEP))) THEN
-
-              JC = JMOHEP(2,JC)
-
-            ELSEIF(JC.EQ.IDM2) THEN
-
-              IF(JDAHEP(2,JMOHEP(2,JC)).EQ.JC) THEN
-
-                JC = JMOHEP(2,JC)
-
-              ELSE
-
-              JMOHEP(2,IHEP)=JMOHEP(2,JC)
-
-              GOTO 110
-
-              ENDIF
-
-            ELSE
-
-              JC = HRDCOL(1,1)
-
-              BVVUSE = .TRUE.
-
-              BVVHRD = .TRUE.
-
-              IF(ACOLRD(IDHW(IHEP))) JC = JD
-
-              IF(JC.EQ.IDM2) GOTO 110
-
-            ENDIF
-
-          ELSE
-
-            JC =JMOHEP(2,JC)
-
-            BVVUSE = .TRUE.
-
-            BVVHRD = .TRUE.
-
-          ENDIF
-
-        ELSEIF(BVHRD2(IDM)) THEN
-
-          JD = JMOHEP(2,JC)
-
-            IF(JC.EQ.JDAHEP(2,HRDCOL(1,2))) THEN
-
-              JMOHEP(2,IHEP)=JMOHEP(2,JC)
-
-              GOTO 110
-
-            ENDIF
-
-          IF(JD.EQ.JDAHEP(2,HRDCOL(1,2))) JD = HRDCOL(1,1)
-
-          BVVUSE=.TRUE.
-
-          BVVHRD = .TRUE.
-
-          IF(JC.EQ.JDAHEP(2,HRDCOL(1,2))) THEN
-
-            JC = JMOHEP(2,JC)
-
-          ELSE
-
-            JC = HRDCOL(1,1)
-
-          ENDIF
-
-        ELSE
-
-          JC =JMOHEP(2,JC)
-
-        ENDIF
-
-        IF (JC.EQ.0) CALL HWWARN('HWBCON',51,*110)
-
-C---FIND SPECTATOR WHEN JC IS DECAYED HEAVY QUARK OR SUSY PARTICLE
-
-        IF (ISTHEP(JC).EQ.155) THEN
-
-          IF (IDHEP(JMOHEP(1,JC)).EQ.94) THEN
-
-C---DECAYED BEFORE HADRONIZING
-
-            IF(BVVHRD) THEN
-
-              JHEP = JC
-
-            ELSEIF(BVVUSE) THEN
-
-              JHEP=JDAHEP(2,JC-1)
-
-            ELSE
-
-              JHEP=JMOHEP(2,JC)
-
-            ENDIF
-
-            IF(JHEP.EQ.0.AND.ABS(IDHEP(JC)).EQ.6) THEN
-
-              JHEP = JMOHEP(1,JMOHEP(1,JC))
-
-              IF(BVDEC1(JMOHEP(1,JHEP)).OR.BVDEC2(JMOHEP(1,JHEP))) THEN
-
-                JC = JHEP
-
-                JHEP = JDAHEP(2,JC-1)
-
-              ELSE
-
-                JHEP = 0
-
-              ENDIF
-
-            ENDIF
-
-            IF(BVVUSE.AND.ABS(IDHEP(JHEP)).GT.1000000.AND.
-
-     &           ISTHEP(JHEP).NE.155.OR.JHEP.EQ.0) GOTO 110
-
-            ID=IDHW(JHEP)
-
-            IF (ISTHEP(JHEP).EQ.155) THEN
-
-C---SPECIAL FOR GLUINO DECAYS
-
-              IF (ID.EQ.449) THEN
-
-                ID=IDHW(JC)
-
-                IF(BVVUSE) THEN
-
-                  ID=IDHW(IHEP)
-
-                  IF(ID.LE.6.OR.ID.EQ.13.OR.
-
-     &               (ID.GE.115.AND.ID.LE.120)) THEN
-
-                    ID = 7
-
-                  ELSE
-
-                    ID = 1
-
-                  ENDIF
-
-                ENDIF
-
-                CALL HWBRC1(JC,ID,JHEP,.TRUE.,*999)
-
-                IF(BVVUSE.AND.JMOHEP(1,JC).EQ.JMOHEP(1,JD)) JC =JD
-
-              ELSE
-
-                JC=JDAHEP(2,JHEP)
-
-                IF(COLRD(IDHW(IHEP)).AND.IDHW(JDAHEP(1,JHEP)).EQ.449)
-
-     &             JC=JDAHEP(1,JHEP)
-
-                IF(BVVUSE.AND.JMOHEP(1,JC).EQ.JMOHEP(1,JD)) JC =JD
-
-              ENDIF
-
-            ELSE
-
-              IF(BVVUSE) THEN
-
-                IF(BVDEC2(JMOHEP(1,JHEP)).OR.JD.NE.JHEP.OR.
-
-     &            BVHRD(JMOHEP(1,JHEP)).OR.BVHRD2(JMOHEP(1,JHEP))) THEN
-
-                  JC = JD
-
-                  GOTO 100
-
-                ELSE
-
-                  JMOHEP(2,IHEP)=JHEP
-
-                  ID = IDHW(JHEP)
-
-                  IF((ID.GE.7.AND.ID.LE.12).OR.
-
-     &               (ID.GE.109.AND.ID.LE.114)) JMOHEP(2,JHEP)=IHEP
-
-                ENDIF
-
-              ELSE
-
-C--new for particles connected to BV
-
-                IDM = JMOHEP(1,JHEP)
-
-                IF(BVDEC1(IDM).OR.BVHRD(IDM).OR.BVHRD2(IDM)) THEN
-
-                  JC = JHEP
-
-                  IF(ABS(IDHEP(IHEP)).LT.1000000) GOTO 100
-
-                  JMOHEP(2,IHEP)=JHEP
-
-                  GOTO 110
-
-                ENDIF
-
-C--new for top's from BV
-
-                ID = IDHW(JC)
-
-                IDP  = JMOHEP(1,JMOHEP(1,JMOHEP(1,JC)))
-
-                IF((ID.EQ.6.AND.(BVDEC1(IDP))).
-
-     &              OR.(ID.EQ.12.AND.BVDEC2(IDP)).
-
-     &              OR.((ID.EQ.12.OR.ID.EQ.449).AND.BVHRD(IDP))) THEN
-
-                   JMOHEP(2,IHEP)=JHEP
-
-                   IF(JDAHEP(2,JHEP).EQ.JC) JDAHEP(2,JHEP)=IHEP
-
-                ELSE
-
-                  IF((IDHW(IHEP).GE.7.AND.IDHW(IHEP).LE.12.
-
-     &               AND.IDHW(JHEP).GE.7.AND.IDHW(JHEP).LE.12).OR.
-
-     &               (IDHW(IHEP).LE.6.AND.IDHW(JHEP).LE.6)) THEN
-
-                    JMOHEP(2,IHEP)=JHEP
-
-                  ELSE
-
-                    JMOHEP(2,IHEP)=JHEP
-
-                    IF((COLRD(IDHW(IHEP)).AND.ACOLRD(IDHW(JHEP))).OR.
-
-     &                (.NOT.COLRD(IDHW(IHEP)).AND.
-
-     &                .NOT.ACOLRD(IDHW(JHEP)))) THEN
-
-                      IF(JDAHEP(2,JHEP).EQ.0) THEN
-
-                        JDAHEP(2,JHEP)=IHEP
-
-                      ELSEIF(JMOHEP(2,JDAHEP(2,JHEP)).NE.JHEP) THEN
-
-                        JDAHEP(2,JHEP)=IHEP
-
-                      ENDIF
-
-                    ELSE
-
-                      IF(JMOHEP(2,JHEP).EQ.JC) JMOHEP(2,JHEP)=IHEP
-
-                    ENDIF
-
-                  ENDIF
-
-                ENDIF
-
-              ENDIF
-
-              GOTO 110
-
-            ENDIF
-
-          ELSE
-
-            JC=JMOHEP(2,JC)
-
-          ENDIF
-
-        ENDIF
-
- 100    CONTINUE
-
-        IF(BVVUSE.AND.ABS(IDHEP(JC)).LT.1000000.AND.JC.NE.JD
-
-     &     .AND.JD.NE.0.AND.JD.NE.JMOHEP(1,JC)) JC = JD
-
-        IF(BVVUSE.AND.ABS(IDHEP(JC)).GT.1000000) THEN
-
-          IF(COLRD(IDHW(IHEP)).AND..NOT.BVVHRD) GOTO 110
-
-        ENDIF
-
-        IF(BVVUSE.AND.ISTHEP(JC).EQ.149) JC=JMOHEP(1,JMOHEP(1,JC))
-
-C--SEARCH IN THE JET
-
-        IF((ISTHEP(JC).GT.145.AND.ISTHEP(JC).LT.152).AND.
-
-     &     ISTHEP(IHEP).EQ.155) THEN
-
-          JMOHEP(2,IHEP) = JC
-
-          GOTO 110
-
-        ENDIF
-
-        CALL HWBRC2(COLP,IHEP,JC,.TRUE.,BVVUSE,BVVHRD)
-
-        IF(COLP.NE.0) THEN
-
-          JMOHEP(2,IHEP) = COLP
-
-          IF(COLRD(IDHW(IHEP)).AND.ACOLRD(IDHW(COLP)).
-
-     &       AND.JDAHEP(2,COLP).EQ.0)
-
-     &      JDAHEP(2,COLP) = IHEP
-
-          IF((IDHW(IHEP).GE.7.AND.IDHW(IHEP).LE.12).AND.
-
-     &       (IDHW(COLP).GE.7.AND.IDHW(COLP).LE.12)) THEN
-
-             IF(JMOHEP(2,COLP).EQ.0) JMOHEP(2,COLP) = IHEP
-
-          ENDIF
-
-        ENDIF
-
-      ENDIF
-
-  110 CONTINUE
-
-C---BREAK COLOUR CONNECTIONS WITH PHOTONS modified for Rslash
-
-      IHEP=1
-
-  130 IF (IHEP.LE.NHEP) THEN
-
-        IF (IDHW(IHEP).EQ.59 .AND. ISTHEP(IHEP).EQ.149.AND.
-
-     &      (JMOHEP(2,IHEP).NE.IHEP.OR.JDAHEP(2,IHEP).NE.IHEP)) THEN
-
-          IF(JMOHEP(2,IHEP).NE.0) THEN
-
-          IF (JDAHEP(2,JMOHEP(2,IHEP)).EQ.IHEP)
-
-     &      JDAHEP(2,JMOHEP(2,IHEP))=JDAHEP(2,IHEP)
-
-          ENDIF
-
-          IF (JDAHEP(2,IHEP).NE.0) THEN
-
-            IF (JMOHEP(2,JDAHEP(2,IHEP)).EQ.IHEP)
-
-     &        JMOHEP(2,JDAHEP(2,IHEP))=JMOHEP(2,IHEP)
-
-          ENDIF
-
-          DO RHEP=1,NHEP
-
-            IST=ISTHEP(RHEP)
-
-            IF((IST.GE.147.AND.IST.LE.149).AND.JDAHEP(2,RHEP).EQ.IHEP)
-
-     &        JDAHEP(2,RHEP)=JMOHEP(2,IHEP)
-
-          ENDDO
-
-          DO RHEP=1,NHEP
-
-            IST=ISTHEP(RHEP)
-
-            IF((IST.GE.147.AND.IST.LE.149).AND.JMOHEP(2,RHEP).EQ.IHEP)
-
-     &        JMOHEP(2,RHEP) = JDAHEP(2,IHEP)
-
-          ENDDO
-
-          JMOHEP(2,IHEP)=IHEP
-
-          JDAHEP(2,IHEP)=IHEP
-
-        ENDIF
-
-        IHEP=IHEP+1
-
-        GOTO 130
-
-      ENDIF
-
-C--Update the BV anticolour corrections
-
-      DO 210 IHEP=1,NHEP+1
-
-      IF(IHEP.EQ.1) GOTO 210
-
-      IST2 = 0
-
-      IF(IHEP.EQ.NHEP+1) THEN
-
-        ANTC = HRDCOL(1,1)
-
-        IF(ANTC.EQ.0.OR.(IDHW(JMOHEP(1,HRDCOL(1,2))).LE.6)) GOTO 210
-
-        IST=155
-
-        XHEP=HRDCOL(1,2)
-
-        IF(ANTC.EQ.JDAHEP(2,XHEP)) ANTC=JDAHEP(1,JDAHEP(1,ANTC))
-
-        IF(ANTC.NE.0.AND.JDAHEP(1,ANTC).NE.0) IST2=ISTHEP(ANTC)
-
-      ELSE
-
-        ANTC = JDAHEP(2,IHEP-1)
-
-        IF(ANTC.NE.0) IST2=ISTHEP(ANTC)
-
-        IST=ISTHEP(IHEP)
-
-        IDM = IDHW(IHEP)
-
-        XHEP=IHEP
-
-      ENDIF
-
-      JC = 0
-
-      JHEP = 0
-
-      JD = 0
-
-      ORG = 0
-
-      IF(IST.EQ.155.AND.IST2.EQ.155) THEN
-
-        IDM = IDHW(XHEP)
-
-        ORG = ANTC
-
-        IF(BVDEC1(XHEP).OR.BVDEC2(XHEP).OR.BVHRD(XHEP).OR.
-
-     &     BVHRD2(XHEP)) THEN
-
-          JC=ANTC
-
-          ID = IDHW(JC)
-
-          JHEP = JC
-
-          IF(BVDEC1(JC).OR.BVDEC2(JC)) THEN
-
-            IF(IHEP.EQ.(NHEP+1)) ANTC=JDAHEP(1,JC)
-
-            GOTO 200
-
-          ENDIF
-
-          IF (ID.EQ.449) THEN
-
-C--SPECIAL FOR GLUINO DECAYS
-
-            ID=IDHW(XHEP)
-
-            IF(IHEP.EQ.NHEP+1) ID = 407
-
-            CALL HWBRC1(JC,ID,JHEP,.FALSE.,*999)
-
-          ELSE
-
-            IF(IDHW(JDAHEP(1,JHEP)).EQ.449) THEN
-
-              JC=JDAHEP(1,JHEP)
-
-            ELSE
-
-              JC=JDAHEP(2,JHEP)
-
-            ENDIF
-
-          ENDIF
-
-C--SEARCH IN JET
-
-          CALL HWBRC2(COLP,XHEP,JC,.FALSE.,BVVUSE,.FALSE.)
-
-          ANTC = COLP
-
-          IF(IHEP.LE.NHEP.AND.ACOLRD(IDHW(IHEP)).AND.
-
-     &       COLRD(IDHW(COLP)).AND.JMOHEP(2,COLP).EQ.0) THEN
-
-             JMOHEP(2,COLP) = IHEP
-
-          ELSEIF(IHEP.LE.NHEP.AND.IDHW(IHEP).LE.6.AND.
-
-     &       IDHW(COLP).LE.6.AND.JDAHEP(2,COLP).EQ.0) THEN
-
-             JDAHEP(2,COLP) = IHEP
-
-          ELSEIF(IHEP.GT.NHEP.AND.
-
-     &       ((BVHRD(XHEP).AND.COLRD(JDAHEP(1,XHEP))).
-
-     &       OR.(BVHRD2(XHEP).AND.ACOLRD(JDAHEP(2,XHEP)))).AND.
-
-     &       ACOLRD(IDHW(COLP)).AND.JDAHEP(2,COLP).EQ.0) THEN
-
-            JDAHEP(2,COLP) = IHEP
-
-          ENDIF
-
-        ENDIF
-
-      ENDIF
-
-  200 CONTINUE
-
-      IF(IHEP.EQ.NHEP+1) THEN
-
-        IF(HRDCOL(1,1).NE.ANTC.AND.ANTC.NE.0) THEN
-
-          HRDCOL(1,1)=ANTC
-
-        IF(JDAHEP(2,ANTC).EQ.IHEP) THEN
-
-          IF(JDAHEP(2,JMOHEP(1,HRDCOL(1,2))).EQ.JDAHEP(2,HRDCOL(1,2)).
-
-     &    AND.JMOHEP(2,JDAHEP(2,HRDCOL(1,2))).EQ.JMOHEP(1,HRDCOL(1,2)))
-
-     &      THEN
-
-            JDAHEP(2,ANTC) = JMOHEP(2,HRDCOL(1,2))
-
-          ELSE
-
-            JDAHEP(2,ANTC) = JMOHEP(1,HRDCOL(1,2))
-
-          ENDIF
-
-        ELSEIF(JMOHEP(2,ANTC).EQ.IHEP) THEN
-
-          JMOHEP(2,ANTC) = JMOHEP(1,HRDCOL(1,2))
-
-        ENDIF
-
-        ENDIF
-
-      ELSEIF(IHEP.NE.1) THEN
-
-        IF(JDAHEP(2,IHEP-1).NE.ANTC.AND.ANTC.NE.0) JDAHEP(2,IHEP-1)=ANTC
-
-      ENDIF
-
- 210  CONTINUE
-
-C--Update BV decaying particles connections
-
-      DO 310 IHEP=1,NHEP+1
-
-      IF(IHEP.EQ.1) GOTO 310
-
-      IF(IHEP.EQ.NHEP+1) THEN
-
-        ANTC=HRDCOL(1,1)
-
-        IF(ANTC.EQ.0.OR.IDHW(JDAHEP(1,HRDCOL(1,2))).LE.6) GOTO 310
-
-        IST=155
-
-        XHEP=HRDCOL(1,2)
-
-        IF(ANTC.EQ.JDAHEP(2,XHEP)) ANTC=JDAHEP(1,JDAHEP(1,ANTC))
-
-      ELSE
-
-        ANTC=JMOHEP(2,IHEP)
-
-        IST=ISTHEP(IHEP)
-
-        IDM = IDHW(IHEP)
-
-        XHEP=IHEP
-
-      ENDIF
-
-      IST2 = 0
-
-      JC = 0
-
-      JD = 0
-
-      IF(ANTC.NE.0.AND.IHEP.NE.NHEP+1) THEN
-
-        IF(JDAHEP(1,ANTC).NE.0) IST2 = ISTHEP(ANTC)
-
-      ELSEIF(ANTC.NE.0.AND.IHEP.EQ.NHEP+1) THEN
-
-        IST2=ISTHEP(ANTC)
-
-      ENDIF
-
-      IF(IST.EQ.155.AND.IST2.EQ.155) THEN
-
-        IF(BVDEC2(XHEP).OR.BVHRD(XHEP).OR.BVHRD2(XHEP)) THEN
-
-C--FIND COLOUR CONNECTED PARTON
-
-          JC = ANTC
-
-          ID=IDHW(JC)
-
-          JHEP = JC
-
-          IF(BVDEC2(JHEP)) THEN
-
-             ANTC=JC
-
-             GOTO 300
-
-          ENDIF
-
-          IF (ID.EQ.449) THEN
-
-            ID=IDHW(XHEP)
-
-            IF(IHEP.EQ.NHEP+1) ID = 401
-
-C--SPECIAL FOR GLUINO DECAYS
-
-            CALL HWBRC1(JC,ID,JHEP,.TRUE.,*999)
-
-          ELSE
-
-            IF(IDHW(JDAHEP(1,JHEP)).EQ.449) THEN
-
-              JC=JDAHEP(1,JHEP)
-
-            ELSE
-
-              JC=JDAHEP(2,JHEP)
-
-            ENDIF
-
-          ENDIF
-
-C--SEARCH IN JET
-
-          CALL HWBRC2(COLP,XHEP,JC,.TRUE.,BVVUSE,.FALSE.)
-
-          ANTC = COLP
-
-          IF(COLP.EQ.0) GOTO 300
-
-          IF(IHEP.LE.NHEP) THEN
-
-            IF(JDAHEP(2,COLP).EQ.0) THEN
-
-              JDAHEP(2,COLP) = JDAHEP(2,IHEP)
-
-            ELSEIF(JMOHEP(2,JDAHEP(2,COLP)).NE.COLP) THEN
-
-              JDAHEP(2,COLP) = JDAHEP(2,IHEP)
-
-            ENDIF
-
-          ELSEIF(IHEP.GT.NHEP.AND.
-
-     &       ((BVHRD(XHEP).AND.ACOLRD(JDAHEP(1,XHEP)).AND.
-
-     &       IDHW(JDAHEP(2,XHEP)).EQ.449).
-
-     &       OR.(BVHRD2(XHEP).AND.ACOLRD(JDAHEP(2,XHEP)))).AND.
-
-     &       ACOLRD(IDHW(COLP)).AND.JDAHEP(2,COLP).EQ.0) THEN
-
-            JDAHEP(2,COLP) = IHEP
-
-          ENDIF
-
-        ENDIF
-
-      ENDIF
-
-  300 CONTINUE
-
-      IF(IHEP.NE.NHEP+1.AND.IHEP.NE.1) THEN
-
-        IF(JMOHEP(2,IHEP).NE.ANTC.AND.ANTC.NE.0) JMOHEP(2,IHEP)=ANTC
-
-      ELSEIF(IHEP.GT.NHEP) THEN
-
-        IF(HRDCOL(1,1).NE.ANTC.AND.ANTC.NE.0) HRDCOL(1,1)=ANTC
-
-        IF(ANTC.EQ.0) GOTO 310
-
-        IF(JDAHEP(2,ANTC).EQ.IHEP) THEN
-
-          IF(JDAHEP(2,JMOHEP(1,HRDCOL(1,2))).EQ.JDAHEP(2,HRDCOL(1,2)).
-
-     &    AND.JMOHEP(2,JDAHEP(2,HRDCOL(1,2))).EQ.JMOHEP(1,HRDCOL(1,2)))
-
-     &      THEN
-
-            JDAHEP(2,ANTC) = JMOHEP(2,HRDCOL(1,2))
-
-          ELSE
-
-            JDAHEP(2,ANTC) = JMOHEP(1,HRDCOL(1,2))
-
-          ENDIF
-
-        ELSEIF(JMOHEP(2,ANTC).EQ.IHEP) THEN
-
-          JMOHEP(2,ANTC) = JMOHEP(1,HRDCOL(1,2))
-
-        ENDIF
-
-      ENDIF
-
- 310  CONTINUE
-
-C--Update partons connected to decaying SUSY particle
-
-      DO 400 IHEP=1,NHEP
-
-      IST=ISTHEP(IHEP)
-
-C--LOOK FOR PARTONS CONNECTED TO A DECAYING SUSY PARTICLE
-
-      IF (IST.LT.145.OR.IST.GT.152) GOTO 400
-
-      IF(JMOHEP(2,IHEP).EQ.0) GOTO 400
-
-      IF(ISTHEP(JMOHEP(2,IHEP)).EQ.155) THEN
-
-C--FIND THE COLOUR CONNECTED PARTON
-
-        JC=JMOHEP(2,IHEP)
-
-        ID=IDHW(JC)
-
-        JHEP = JC
-
-        IF(BVDEC2(JC).AND.IDHW(JC).NE.449) GOTO 400
-
-        IF (ID.EQ.449) THEN
-
-C--SPECIAL FOR GLUINO DECAYS
-
-          ID=IDHW(IHEP)
-
-          CALL HWBRC1(JC,ID,JHEP,.TRUE.,*999)
-
-        ELSE
-
-          ID=IDHW(IHEP)
-
-          IF(COLRD(ID).AND.IDHW(JDAHEP(1,JC)).EQ.449) THEN
-
-            JC=JDAHEP(1,JHEP)
-
-          ELSE
-
-            JC=JDAHEP(2,JHEP)
-
-          ENDIF
-
-        ENDIF
-
-C--SEARCH IN JET
-
-        CALL HWBRC2(COLP,IHEP,JC,.TRUE.,BVVUSE,.FALSE.)
-
-        JMOHEP(2,IHEP) = COLP
-
-      ENDIF
-
- 400  CONTINUE
-
-C--Update partons connected to decaying SUSY particle
-
-      DO 500 IHEP=1,NHEP
-
-      IST=ISTHEP(IHEP)
-
-C--LOOK FOR PARTONS CONNECTED TO A DECAYING SUSY PARTICLE
-
-      IF (IST.LT.145.OR.IST.GT.152) GOTO 500
-
-      IF(JDAHEP(2,IHEP).EQ.0) GOTO 500
-
-      IF(ISTHEP(JDAHEP(2,IHEP)).EQ.155) THEN
-
-C--FIND THE COLOUR CONNECTED PARTON
-
-        JC=JDAHEP(2,IHEP)
-
-        ID=IDHW(JC)
-
-        ID=IDHW(JC)
-
-        IF (ID.EQ.449) THEN
-
-          ID=IDHW(IHEP)
-
-C--SPECIAL FOR GLUINO DECAYS
-
-          JHEP = JC
-
-          CALL  HWBRC1(JC,ID,JHEP,.FALSE.,*999)
-
-        ELSE
-
-          IF(ACOLRD(IDHW(IHEP)).AND.IDHW(JDAHEP(1,JC)).EQ.449) THEN
-
-            JC = JDAHEP(1,JC)
-
-          ELSE
-
-            JC=JDAHEP(2,JC)
-
-          ENDIF
-
-        ENDIF
-
-C--SEARCH IN THE JET
-
-        CALL HWBRC2(COLP,IHEP,JC,.FALSE.,BVVUSE,.FALSE.)
-
-        IF(COLP.NE.0) JDAHEP(2,IHEP) = COLP
-
-      ENDIF
-
- 500  CONTINUE
-
-C--Flavour and anticolour connections in Rslash
-
-      DO 610 IHEP=1,NHEP
-
-        IST=ISTHEP(IHEP)
-
-        IF(IST.LT.145.OR.IST.GT.152.OR.JDAHEP(2,IHEP).NE.0) GOTO 610
-
-        JD = 0
-
-        BVVUSE = .FALSE.
-
-        JC = JMOHEP(1,IHEP)
-
-        IF(IST.NE.152) JC = JMOHEP(1,JC)
-
-        IF(JC.EQ.0) CALL HWWARN('HWBRCN',51,*610)
-
-C--For particles which came from a top decay
-
-        IF(ABS(IDHEP(JMOHEP(1,JC))).EQ.6) THEN
-
-          JD = JMOHEP(1,JMOHEP(1,JMOHEP(1,JC)))
-
-C--flavour connect to self if needed
-
-          IF(JDAHEP(2,JMOHEP(1,JC)-1).EQ.JMOHEP(1,JC)) THEN
-
-            JDAHEP(2,IHEP) = IHEP
-
-            GOTO 610
-
-          ELSEIF(JDAHEP(2,JMOHEP(1,JC)-1).NE.0) THEN
-
-            JDAHEP(2,IHEP) = JDAHEP(2,JMOHEP(1,JC)-1)
-
-            GOTO 610
-
-          ELSE
-
-            JC = JD
-
-          ENDIF
-
-        ENDIF
-
-C--Decide if this came from a BV decay
-
-        IDM = JMOHEP(1,JC)
-
-        IF(BVDEC1(IDM).OR.BVDEC2(IDM).OR.BVDEC3(IDM).
-
-     &     OR.BVHRD(IDM).OR.BVHRD2(IDM)) THEN
-
-C--Do BV piece
-
-          IF(JDAHEP(2,JC).EQ.JMOHEP(1,JC)) THEN
-
-           IF(IDHW(JMOHEP(1,JC)).EQ.449.AND.
-
-     &        JDAHEP(1,JMOHEP(1,JC)).EQ.JC) THEN
-
-              JC = JDAHEP(2,JMOHEP(1,JC)-1)
-
-            ELSE
-
-              JC = JMOHEP(2,JMOHEP(1,JC))
-
-            ENDIF
-
-            IF(ABS(IDHEP(JC)).LT.1000000) THEN
-
-              IF(JDAHEP(1,JC).EQ.0) THEN
-
-                JDAHEP(2,IHEP) = JC
-
-                GOTO 610
-
-              ELSE
-
-                GOTO 600
-
-              ENDIF
-
-            ELSEIF(ABS(IDHEP(JC)).GT.1000000
-
-     &        .AND.ISTHEP(JC).NE.155) THEN
-
-              GOTO 610
-
-            ENDIF
-
-            IF(ISTHEP(JC).EQ.155.AND.ACOLRD(IDHW(IHEP))) THEN
-
-              JC = JDAHEP(1,JC)
-
-            ELSE
-
-              IF(ISTHEP(JC).EQ.155.AND.IDHW(JDAHEP(1,JC)).NE.449) THEN
-
-                JC = JDAHEP(1,JC)
-
-              ELSE
-
-                JC = JDAHEP(2,JC)
-
-              ENDIF
-
-            ENDIF
-
-          ELSE
-
-C--For the hard process
-
-            IF(IDHW(IDM).EQ.15.AND.JC.EQ.JDAHEP(2,JMOHEP(1,JC))) THEN
-
-              JDAHEP(2,IHEP) = JDAHEP(2,JC)
-
-              GOTO 610
-
-            ELSEIF(IDHW(IDM).EQ.15.AND.IDHW(IHEP).NE.449) THEN
-
-              JD=HRDCOL(1,1)
-
-              IF(BVHRD(IDM).AND.IDHW(JDAHEP(2,IDM)).NE.449) THEN
-
-                JC = JDAHEP(2,JC)
-
-                GOTO 600
-
-              ELSEIF(JMOHEP(1,JDAHEP(2,JC)).EQ.JD) THEN
-
-                JC=JDAHEP(2,JC)
-
-                GOTO 600
-
-              ENDIF
-
-              IF(JDAHEP(2,JC).EQ.8) JC = JD
-
-            ELSE
-
-              JD=JMOHEP(2,JMOHEP(1,JC))
-
-            ENDIF
-
-            IF(COLRD(IDHW(IHEP)).AND..NOT.ACOLRD(IDHW(IHEP)).AND.
-
-     &      ABS(IDHEP(JD)).GT.1000000.AND.ISTHEP(JD).NE.155) THEN
-
-              JDAHEP(2,IHEP) = JD
-
-              IF(JDAHEP(2,JD).EQ.0) JDAHEP(2,JD) = IHEP
-
-            ENDIF
-
-            IF(ABS(IDHEP(JD)).GT.1000000
-
-     &        .AND.ISTHEP(JD).NE.155) GOTO 610
-
-            IF(ISTHEP(JC).EQ.149) THEN
-
-              JDAHEP(2,IHEP)=JC
-
-              GOTO 610
-
-            ENDIF
-
-          IF(ACOLRD(IDHW(IHEP)).AND.IDHW(JC).EQ.449.AND.BVDEC2(JC)) THEN
-
-              JC = JDAHEP(1,JC)
-
-            ELSE
-
-              JC = JDAHEP(2,JC)
-
-            ENDIF
-
-          ENDIF
-
-C--SEARCH IN THE JET
-
- 600      CALL HWBRC2(COLP,IHEP,JC,.FALSE.,BVVUSE,.FALSE.)
-
-          IF(COLP.NE.0) THEN
-
-            IF(ABS(IDHEP(COLP)).EQ.6.AND.JDAHEP(1,COLP).NE.0) THEN
-
-              IF(ISTHEP(COLP).EQ.155) THEN
-
-                JC = JDAHEP(2,COLP)
-
-              ELSE
-
-                JC = JDAHEP(2,JDAHEP(2,COLP))
-
-              ENDIF
-
-              GOTO 600
-
-            ENDIF
-
-            JDAHEP(2,IHEP) = COLP
-
-          ENDIF
-
-        ELSE
-
-C--check if it came from a top
-
-          IF(ABS(IDHEP(JC)).EQ.6) THEN
-
-C--start the analysis again
-
-            JC = JMOHEP(1,IHEP)
-
-            IF(IST.NE.152) JC = JMOHEP(1,JC)
-
-            JC = JDAHEP(2,JC)
-
-            IF(JC.EQ.0) CALL HWWARN('HWBRCN',52,*610)
-
-              IF(ISTHEP(JC).EQ.155) THEN
-
-                IF (IDHEP(JMOHEP(1,JC)).EQ.94) THEN
-
-C---DECAYED BEFORE HADRONIZING
-
-                  JHEP=JDAHEP(2,JC-1)
-
-                  IF (JHEP.EQ.0) GO TO 610
-
-                  ID=IDHW(JHEP)
-
-                  IF (ISTHEP(JHEP).EQ.155) THEN
-
-C---SPECIAL FOR GLUINO DECAYS
-
-                    IF (ID.EQ.449) THEN
-
-                      CALL HWBRC1(JC,ID,JHEP,.TRUE.,*999)
-
-                    ELSE
-
-                      JC=JDAHEP(2,JHEP)
-
-                    ENDIF
-
-                  ELSE
-
-                    IF(JMOHEP(2,JHEP).EQ.JC) JMOHEP(2,JHEP)=IHEP
-
-                    JDAHEP(2,IHEP) = JHEP
-
-                    GOTO 610
-
-                  ENDIF
-
-                ELSE
-
-                  JC=JDAHEP(2,JC-1)
-
-                ENDIF
-
-              ENDIF
-
-C--SEARCH IN JET
-
-              CALL HWBRC2(COLP,IHEP,JC,.FALSE.,BVVUSE,.FALSE.)
-
-              IF(COLP.NE.0) JDAHEP(2,IHEP) = COLP
-
-          ELSE
-
-            CALL HWWARN('HWBRCN',100,*610)
-
-          ENDIF
-
-        ENDIF
-
- 610  CONTINUE
-
- 999  END
-
-CDECK  ID>, HWBRC1.
-
-*CMZ :-        -20/07/99  10:56:12  by  Peter Richardson
-
-*-- Author :    PeterRichardson
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWBRC1(JC,ID,JHEP,COL,*)
-
-C-----------------------------------------------------------------------
-
-C--Function to find the right daugther of a decaying gluino
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      INTEGER ID,JHEP,KC,JC
-
-      LOGICAL COL
-
-C---N.B. WILL NEED MODS WHEN SUSY PARTICLES CAN SHOWER
-
-C--Rparity take the first daughther
-
-      IF(IDHW(JDAHEP(1,JHEP)).LE.12.AND.IDHW(JDAHEP(1,JHEP)+1).LE.12
-
-     &   .AND.IDHW(JDAHEP(2,JHEP)).LE.12) THEN
-
-        KC = JDAHEP(1,JHEP)
-
-        GOTO 20
-
-      ELSEIF ((COL.AND.(ID.EQ.449.OR.ID.EQ.13)).OR.
-
-     &        (ID.GE.401.AND.ID.LE.406).OR.
-
-     &       (ID.GE.413.AND.ID.LE.418).OR.ID.LE.6.OR.
-
-     &       (ID.GE.115.AND.ID.LE.120)) THEN
-
-C---LOOK FOR ANTI(S)QUARK OR GLUON
-
-        DO KC=JDAHEP(1,JHEP),JDAHEP(2,JHEP)
-
-          ID=IDHW(KC)
-
-          IF ((ID.GE.7.AND.ID.LE.13).OR.(ID.GE.407.AND.ID.LE.412).OR.
-
-     &       (ID.GE.419.AND.ID.LE.424)) GOTO 20
-
-        ENDDO
-
-      ELSE
-
-C---LOOK FOR (S)QUARK OR GLUON
-
-        DO KC=JDAHEP(1,JHEP),JDAHEP(2,JHEP)
-
-          ID=IDHW(KC)
-
-          IF (ID.LE.  6.OR. ID.EQ. 13.OR.(ID.GE.401.AND.ID.LE.406).OR.
-
-     &       (ID.GE.413.AND.ID.LE.418)) GOTO 20
-
-        ENDDO
-
-      ENDIF
-
-C---COULDNT FIND ONE
-
-      CALL HWWARN('HWBRC1',100,*10)
-
- 10   RETURN 1
-
- 20   JC=KC
-
-      END
diff --git a/HERWIG/src/hwbrc2.f b/HERWIG/src/hwbrc2.f
deleted file mode 100644 (file)
index f550b8f..0000000
+++ /dev/null
@@ -1,418 +0,0 @@
-
-CDECK  ID>, HWBRC2.
-
-*CMZ :-        -20/07/99  10:56:12  by  Peter Richardson
-
-*-- Author :    Peter Richardson
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWBRC2(COLP,IHEP,JC,CON,BVVUSE,BVVHRD)
-
-C-----------------------------------------------------------------------
-
-C--Function to search in the jet for the particle
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      INTEGER JC,JD,QHEP,LHEP,IHEP,JHEP,IDM,NCOUNT,ID,IP,IDM2,COLP
-
-      LOGICAL CON,BVVUSE,FLA,AFLA,BVVHRD
-
-      FLA(IP)  = (IP.LE.6.OR.(IP.GE.115.AND.IP.LE.120).
-
-     &           OR.(IP.GE.401.AND.IP.LE.406).
-
-     &           OR.(IP.GE.413.AND.IP.LE.418))
-
-      AFLA(IP) = ((IP.LE.12.AND.IP.GE.7).OR.(IP.GE.109.AND.IP.LE.114).
-
-     &           OR.(IP.GE.407.AND.IP.LE.412).
-
-     &           OR.(IP.GE.419.AND.IP.LE.424))
-
-      ID = IDHW(IHEP)
-
-      COLP = 0
-
-C--begining and end of jet
-
-      IF(JDAHEP(1,JC).NE.0) THEN
-
-        JC=JDAHEP(1,JC)
-
-        JD=JDAHEP(2,JC)
-
-      ELSE
-
-        COLP = JC
-
-        RETURN
-
-      ENDIF
-
-      IF (JD.LT.JC) JD=JC
-
-      LHEP=0
-
-      IF(CON) THEN
-
-C--SEARCH FOR A COLOUR PARTNER
-
-        DO 110 JHEP=JC,JD
-
-          IDM = IDHW(JHEP)
-
-        IF (ISTHEP(JHEP).LT.145.OR.ISTHEP(JHEP).GT.152) GOTO 110
-
-        IF(AFLA(ID).AND.IDM.EQ.13) GOTO 110
-
-        IF (JDAHEP(2,JHEP).EQ.IHEP) LHEP=JHEP
-
-        IF ((BVVUSE.AND.JMOHEP(2,JHEP).NE.0).OR.
-
-     &      (.NOT.BVVUSE.AND.JDAHEP(2,JHEP).NE.0)) GOTO 110
-
-        IF(BVVUSE.AND.ABS(IDHEP(JHEP)).GT.1000000) THEN
-
-          IF(BVVHRD.AND.AFLA(ID)) THEN
-
-            CONTINUE
-
-          ELSE
-
-            RETURN
-
-          ENDIF
-
-        ENDIF
-
-        IF(BVVUSE.AND.(
-
-     &      ((FLA(ID).OR.ID.EQ.13.OR.ID.EQ.449).AND.AFLA(IDM)).
-
-     &  OR.(AFLA(ID).AND.(FLA(IDM).OR.IDM.EQ.13.OR.IDM.EQ.449))))
-
-     &     GOTO 110
-
-        IF(AFLA(ID).AND.(IDM.EQ.59.OR.IDM.EQ.449.OR.IDM.EQ.13)) GOTO 110
-
-C---JOIN IHEP AND JHEP
-
-        COLP=JHEP
-
-        IF(BVVUSE.OR.(ID.GE.7.AND.ID.LE.12.
-
-     &     AND.((IDM.GE.7.AND.IDM.LE.12)))) RETURN
-
-        IF(IHEP.NE.HRDCOL(1,2).AND.
-
-     &     (((FLA(ID).OR.ID.EQ.13.OR.ID.EQ.449.OR.ID.EQ.59)
-
-     &       .AND.(AFLA(IDM).OR.IDM.EQ.13.OR.IDM.EQ.449.OR.IDM.EQ.59))
-
-     &     .OR.(AFLA(ID).AND.(FLA(IDM).OR.IDM.EQ.59))))
-
-     &    JDAHEP(2,JHEP)=IHEP
-
-        RETURN
-
- 110    CONTINUE
-
-        IF (LHEP.NE.0) COLP=LHEP
-
-C--Additional Baryon number violating piece
-
-        IF(COLP.EQ.0) THEN
-
-          IDM2= IDHW(JC)
-
-         IF(JMOHEP(1,JC).LT.6) THEN
-
-           IF(IDM2.LE.6) THEN
-
-             IDM2= IDM2+6
-
-           ELSEIF(IDM2.GT.6) THEN
-
-             IDM2=IDM2-6
-
-           ENDIF
-
-         ENDIF
-
-          IF(IHEP.EQ.HRDCOL(1,2).OR.
-
-     &     ((FLA(ID).OR.ID.EQ.13.OR.ID.EQ.449.OR.ID.EQ.15.OR.ID.EQ.59)
-
-     &       .AND.(AFLA(IDM2).OR.IDM2.EQ.13.OR.IDM2.EQ.13))) THEN
-
-              QHEP = JD+1
-
- 12           QHEP = QHEP-1
-
-              IF(IDHEP(QHEP).EQ.0) GOTO 12
-
-              IF(IDHW(QHEP).EQ.59) THEN
-
-              IF(JC.EQ.JD.AND.IDHW(JMOHEP(1,QHEP)).EQ.59) THEN
-
-                COLP = IHEP
-
-                RETURN
-
-              ELSE
-
-                GOTO 12
-
-              ENDIF
-
-              ENDIF
-
-              NCOUNT = 0
-
- 11           IF(JDAHEP(2,QHEP).NE.0) THEN
-
-                IF(JMOHEP(2,JDAHEP(2,QHEP)).EQ.QHEP.AND.
-
-     &             JDAHEP(2,QHEP).NE.QHEP) THEN
-
-                 IF(JDAHEP(2,QHEP).GE.JC.AND.JDAHEP(2,QHEP).LE.JD) THEN
-
-                   QHEP = JDAHEP(2,QHEP)
-
-                   NCOUNT = NCOUNT+1
-
-                   IF(NCOUNT.LT.NHEP) GOTO 11
-
-                 ENDIF
-
-                ENDIF
-
-              ENDIF
-
-            ELSE
-
-            QHEP = JC
-
- 13         QHEP = QHEP+1
-
-            IF(IDHEP(QHEP).EQ.0) GOTO 13
-
-            IF(IDHW(QHEP).EQ.59) THEN
-
-              IF(JC.EQ.JD.AND.IDHW(JMOHEP(1,QHEP)).EQ.59) THEN
-
-                COLP = IHEP
-
-                RETURN
-
-              ELSE
-
-                GOTO 13
-
-              ENDIF
-
-            ENDIF
-
-            NCOUNT = 0
-
- 9          IF(JMOHEP(2,QHEP).NE.0) THEN
-
-            IF(JDAHEP(2,JMOHEP(2,QHEP)).EQ.QHEP.AND.
-
-     &         JMOHEP(2,QHEP).NE.QHEP) THEN
-
-               IF(JMOHEP(2,QHEP).GE.JC.AND.JMOHEP(2,QHEP).LE.JD) THEN
-
-                 QHEP = JMOHEP(2,QHEP)
-
-                 NCOUNT = NCOUNT+1
-
-                 IF(NCOUNT.LT.NHEP) GOTO 9
-
-               ENDIF
-
-            ENDIF
-
-            ENDIF
-
-          ENDIF
-
-          IF(ABS(IDHEP(QHEP)).LT.1000000) COLP=QHEP
-
-        ENDIF
-
-      ELSE
-
-C--Search for an anticolour partner
-
-        DO 210 JHEP=JC,JD
-
-        IF (ISTHEP(JHEP).LT.145.OR.ISTHEP(JHEP).GT.152) GOTO 210
-
-        IF (JMOHEP(2,JHEP).EQ.IHEP) LHEP=JHEP
-
-        IF (JMOHEP(2,JHEP).NE.0) GOTO 210
-
-C---JOIN IHEP AND JHEP
-
-        COLP=JHEP
-
-        RETURN
-
- 210   CONTINUE
-
-       IF (LHEP.NE.0) COLP=LHEP
-
-C--New piece
-
-       IF(COLP.EQ.0) THEN
-
-         IDM2=IDHW(JC)
-
-         IF(JMOHEP(1,JC).LT.6) THEN
-
-           IF(IDM2.LE.6) THEN
-
-             IDM2= IDM2+6
-
-           ELSEIF(IDM2.GT.6) THEN
-
-             IDM2=IDM2-6
-
-           ENDIF
-
-         ENDIF
-
-C--Additional Baryon number violating piece
-
-        IF((FLA(ID).AND.AFLA(IDM2)).OR.
-
-     & ((AFLA(ID).OR.ID.EQ.13.OR.ID.EQ.449.OR.ID.EQ.15.OR.ID.EQ.59)
-
-     &    .AND.(FLA(IDM2).OR.IDM2.EQ.13.OR.IDM2.EQ.449))) THEN
-
-         QHEP = JC
-
- 211     QHEP = QHEP+1
-
-         IF(IDHEP(QHEP).EQ.0) GOTO 211
-
-         IF(IDHW(QHEP).EQ.59) THEN
-
-           IF(JC.EQ.JD.AND.IDHW(JMOHEP(1,QHEP)).EQ.59) THEN
-
-             COLP = IHEP
-
-             RETURN
-
-           ELSE
-
-             GOTO 211
-
-           ENDIF
-
-         ENDIF
-
-         NCOUNT = 0
-
- 209     IF(JMOHEP(2,QHEP).NE.0) THEN
-
-           IF(JDAHEP(2,JMOHEP(2,QHEP)).EQ.QHEP.AND.
-
-     &        JMOHEP(2,QHEP).NE.QHEP) THEN
-
-              IF(JMOHEP(2,QHEP).GE.JC.AND.JMOHEP(2,QHEP).LE.JD) THEN
-
-                QHEP = JMOHEP(2,QHEP)
-
-                NCOUNT = NCOUNT+1
-
-                IF(NCOUNT.LT.NHEP) GOTO 209
-
-              ENDIF
-
-           ENDIF
-
-         ENDIF
-
-        IF(QHEP.NE.0) COLP=QHEP
-
-        IF(JDAHEP(2,QHEP).EQ.0.AND.IHEP.NE.6) THEN
-
-          IDM2= IDHW(QHEP)
-
-          IF(FLA(IHEP).AND.FLA(QHEP).OR.
-
-     &       ((AFLA(IHEP).OR.ID.EQ.13.OR.ID.EQ.449).AND.
-
-     &        (AFLA(QHEP).OR.IDM2.EQ.13.OR.IDM2.EQ.449)))
-
-     &        JDAHEP(2,QHEP)=IHEP
-
-        ENDIF
-
-        ELSE
-
-         QHEP = JD+1
-
- 220     QHEP = QHEP-1
-
-         IF(IDHEP(QHEP).EQ.0) GOTO 220
-
-         IF(IDHW(QHEP).EQ.59) THEN
-
-           IF(JC.EQ.JD.AND.IDHW(JMOHEP(1,QHEP)).EQ.59) THEN
-
-             COLP = IHEP
-
-             RETURN
-
-           ELSE
-
-             GOTO 220
-
-           ENDIF
-
-         ENDIF
-
-          NCOUNT = 0
-
- 219       IF(JDAHEP(2,QHEP).NE.0) THEN
-
-            IF(JMOHEP(2,JDAHEP(2,QHEP)).EQ.QHEP) THEN
-
-              IF(JDAHEP(2,QHEP).GE.JC.AND.JDAHEP(2,QHEP).LE.JD) THEN
-
-                QHEP = JDAHEP(2,QHEP)
-
-                NCOUNT = NCOUNT+1
-
-                IF(NCOUNT.LT.200) GOTO 219
-
-              ENDIF
-
-            ENDIF
-
-          ENDIF
-
-        IF(QHEP.NE.0) COLP=QHEP
-
-        IDM2 = IDHW(QHEP)
-
-        IF(JDAHEP(2,QHEP).EQ.0.AND.
-
-     &     (((AFLA(ID).OR.ID.EQ.13).AND.(AFLA(IDM2).OR.IDM2.EQ.13)).OR.
-
-     &     (FLA(ID).AND.FLA(IDM2)))) JDAHEP(2,QHEP)=IHEP
-
-        ENDIF
-
-       ENDIF
-
-      ENDIF
-
-      END
diff --git a/HERWIG/src/hwbspa.f b/HERWIG/src/hwbspa.f
deleted file mode 100644 (file)
index fa2c67c..0000000
+++ /dev/null
@@ -1,228 +0,0 @@
-
-CDECK  ID>, HWBSPA.
-
-*CMZ :-        -26/04/91  14.26.44  by  Federico Carminati
-
-*-- Author :    Ian Knowles
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWBSPA
-
-C-----------------------------------------------------------------------
-
-C     Constructs time-like 4-momenta & production vertices in space-like
-
-C     jet started by parton no.2 interference partner 1 and spin density
-
-C     DECPAR(2). RHOPAR(2) gives the jet spin density matrix.
-
-C     See I.G. Knowles, Comp. Phys. Comm. 58 (90) 271.
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      DOUBLE PRECISION HWR,DMIN,PT,EIKON,EISCR,EINUM,EIDEN1,EIDEN2,
-
-     & WT,SPIN,Z1,Z2,TR,PRMAX,CX,SX,CAZ,ROHEP(3),RMAT(3,3),ZERO2(2)
-
-      INTEGER JPAR,KPAR,LPAR,MPAR
-
-      LOGICAL EICOR
-
-      EXTERNAL HWR
-
-      DATA ZERO2,DMIN/ZERO,ZERO,1.D-15/
-
-      IF (IERROR.NE.0) RETURN
-
-      JPAR=2
-
-      KPAR=1
-
-      IF (NPAR.EQ.2) THEN
-
-         CALL HWVZRO(2,RHOPAR(1,2))
-
-         RETURN
-
-      ENDIF
-
-C Generate azimuthal angle of JPAR's branching using an M-function
-
-C     Find the daughters of JPAR, with LPAR time-like
-
-  10  LPAR=JDAPAR(1,JPAR)
-
-      IF (TMPAR(LPAR)) THEN
-
-         MPAR=LPAR+1
-
-      ELSE
-
-         MPAR=LPAR
-
-         LPAR=MPAR+1
-
-      ENDIF
-
-C Soft correlations
-
-      CALL HWUROT(PPAR(1,JPAR), ONE,ZERO,RMAT)
-
-      CALL HWUROF(RMAT,PPAR(1,KPAR),ROHEP)
-
-      PT=MAX(SQRT(ROHEP(1)*ROHEP(1)+ROHEP(2)*ROHEP(2)),DMIN)
-
-      EIKON=1.
-
-      EICOR=AZSOFT.AND.IDPAR(LPAR).EQ.13
-
-      IF (EICOR) THEN
-
-         EISCR=1.-PPAR(5,MPAR)*PPAR(5,MPAR)/(MIN(PPAR(2,LPAR),
-
-     &   PPAR(2,MPAR))*PPAR(4,MPAR)*PPAR(4,MPAR))
-
-         EINUM=PPAR(4,KPAR)*PPAR(4,LPAR)*ABS(PPAR(2,LPAR)-PPAR(2,MPAR))
-
-         EIDEN1=PPAR(4,KPAR)*PPAR(4,LPAR)-ROHEP(3)*PPAR(3,LPAR)
-
-         EIDEN2=PT*ABS(PPAR(1,LPAR))
-
-         EIKON=MAX(EISCR+EINUM/MAX(EIDEN1-EIDEN2,DMIN),ZERO)
-
-      ENDIF
-
-C Spin correlations
-
-      WT=0.
-
-      SPIN=1.
-
-      IF (AZSPIN.AND.IDPAR(JPAR).EQ.13) THEN
-
-         Z1=PPAR(4,JPAR)/PPAR(4,MPAR)
-
-         Z2=1.-Z1
-
-         IF (IDPAR(MPAR).EQ.13) THEN
-
-            TR=Z1/Z2+Z2/Z1+Z1*Z2
-
-         ELSEIF (IDPAR(MPAR).LT.13) THEN
-
-            TR=(Z1*Z1+Z2*Z2)/2.
-
-         ENDIF
-
-         WT=Z2/(Z1*TR)
-
-      ENDIF
-
-C Assign the azimuthal angle
-
-      PRMAX=(1.+ABS(WT))*EIKON
-
-  50  CALL HWRAZM( ONE,CX,SX)
-
-      CALL HWUROT(PPAR(1,JPAR),CX,SX,RMAT)
-
-C Determine the angle between the branching planes
-
-      CALL HWUROF(RMAT,PPAR(1,KPAR),ROHEP)
-
-      CAZ=ROHEP(1)/PT
-
-      PHIPAR(1,JPAR)=2.*CAZ*CAZ-1.
-
-      PHIPAR(2,JPAR)=2.*CAZ*ROHEP(2)/PT
-
-      IF (EICOR) EIKON=MAX(EISCR+EINUM/MAX(EIDEN1-EIDEN2*CAZ,DMIN),ZERO)
-
-      IF (AZSPIN) SPIN=1.+WT*(DECPAR(1,JPAR)*PHIPAR(1,JPAR)
-
-     &                       +DECPAR(2,JPAR)*PHIPAR(2,JPAR))
-
-      IF (SPIN*EIKON.LT.HWR()*PRMAX) GOTO 50
-
-C Construct full 4-momentum of LPAR, sum P-trans of MPAR
-
-      PPAR(2,LPAR)=0.
-
-      PPAR(2,MPAR)=0.
-
-      CALL HWUROB(RMAT,PPAR(1,LPAR),PPAR(1,LPAR))
-
-      CALL HWVDIF(2,PPAR(1,2),PPAR(1,LPAR),PPAR(1,2))
-
-C Test for end of space-like branches
-
-      IF (JDAPAR(1,MPAR).EQ.0) GOTO 60
-
-C     Generate new Decay matrix
-
-      CALL HWBAZF(MPAR,JPAR,ZERO2,DECPAR(1,JPAR),
-
-     &            PHIPAR(1,JPAR),DECPAR(1,MPAR))
-
-C     Advance along the space-like branch
-
-      JPAR=MPAR
-
-      KPAR=LPAR
-
-      GOTO 10
-
-C Retreat along space-like line
-
-C     Assign initial spin density matrix
-
-  60  CALL HWVEQU(2,ZERO2,RHOPAR(1,MPAR))
-
-      CALL HWUMAS(PPAR(1,2))
-
-      CALL HWVZRO(4,VPAR(1,MPAR))
-
-  70  CALL HWVEQU(4,VPAR(1,MPAR),VPAR(1,LPAR))
-
-      IF (MPAR.EQ.2) RETURN
-
-C Construct spin density matrix for time-like branch
-
-      CALL HWBAZF(MPAR,JPAR,RHOPAR(1,MPAR),PHIPAR(1,JPAR),
-
-     &                      DECPAR(1,JPAR),RHOPAR(1,LPAR))
-
-C Evolve time-like side branch
-
-      CALL HWBTIM(LPAR,MPAR)
-
-C Construct spin density matrix for space-like branch
-
-      CALL HWBAZF(MPAR,JPAR,PHIPAR(1,JPAR),RHOPAR(1,MPAR),
-
-     &                      DECPAR(1,LPAR),RHOPAR(1,JPAR))
-
-C Assign production vertex to J
-
-      CALL HWVDIF(4,PPAR(1,MPAR),PPAR(1,LPAR),PPAR(1,JPAR))
-
-      CALL HWUDKL(IDPAR(JPAR),PPAR(1,JPAR),VPAR(1,JPAR))
-
-      CALL HWVSUM(4,VPAR(1,MPAR),VPAR(1,JPAR),VPAR(1,JPAR))
-
-C Find parent and partner of MPAR
-
-      MPAR=JPAR
-
-      JPAR=JMOPAR(1,MPAR)
-
-      LPAR=MPAR+1
-
-      IF (JMOPAR(1,LPAR).NE.JPAR) LPAR=MPAR-1
-
-      GOTO 70
-
-      END
diff --git a/HERWIG/src/hwbspn.f b/HERWIG/src/hwbspn.f
deleted file mode 100644 (file)
index 590b3f0..0000000
+++ /dev/null
@@ -1,132 +0,0 @@
-
-CDECK  ID>, HWBSPN.
-
-*CMZ :-        -26/04/91  11.11.54  by  Bryan Webber
-
-*-- Author :    Ian Knowles
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWBSPN
-
-C-----------------------------------------------------------------------
-
-C     Constructs appropriate spin density/decay matrix for parton
-
-C     in hard subprocess, othwise zero. Assignments based upon
-
-C     Comp. Phys. Comm. 58 (1990) 271.
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      DOUBLE PRECISION C,V12,V23,V13,TR,C1,C2,C3,R1(2),R2(2)
-
-      INTEGER IST
-
-      SAVE R1,R2,V12
-
-      IF (IERROR.NE.0) RETURN
-
-      IST=MOD(ISTHEP(NEVPAR),10)
-
-C Assumed partons processed in the order IST=1,2,3,4
-
-      IF (IPROC.GE.100.AND.IPROC.LE.116) THEN
-
-C  An e+e- ---> qqbar g event
-
-         IF (IDPAR(2).EQ.13) THEN
-
-            RHOPAR(1,2)=GPOLN
-
-            RHOPAR(2,2)=0.
-
-            RETURN
-
-         ENDIF
-
-      ELSEIF (IPRO.EQ.15.OR.IPRO.EQ.17) THEN
-
-         IF (IHPRO.EQ. 7.OR.IHPRO.EQ. 8.OR.
-
-     &       IHPRO.EQ.10.OR.IHPRO.EQ.11.OR.
-
-     &       IHPRO.EQ.15.OR.IHPRO.EQ.16.OR.
-
-     &      (IHPRO.GE.21.AND.IHPRO.LE.31)) THEN
-
-C A hard 2 --- > 2 QCD subprocess involving gluons
-
-            IF (IST.EQ.2) THEN
-
-               CALL HWVEQU(2,RHOPAR(1,2),R1(1))
-
-               C=GCOEF(2)/GCOEF(1)
-
-               DECPAR(1,2)=C*R1(1)
-
-               DECPAR(2,2)=C*R1(2)
-
-               RETURN
-
-            ELSEIF (IST.EQ.3) THEN
-
-               CALL HWVEQU(2,RHOPAR(1,2),R2(1))
-
-               V12=R1(1)*R2(1)+R1(2)*R2(2)
-
-               TR=1./(GCOEF(1)+GCOEF(2)*V12)
-
-               RHOPAR(1,2)= (GCOEF(3)*R1(1)+GCOEF(4)*R2(1))*TR
-
-               RHOPAR(2,2)=-(GCOEF(3)*R1(2)+GCOEF(4)*R2(2))*TR
-
-               RETURN
-
-            ELSEIF (IST.EQ.4) THEN
-
-               V13=R1(1)*DECPAR(1,2)+R1(2)*DECPAR(2,2)
-
-               V23=R2(1)*DECPAR(1,2)+R2(2)*DECPAR(2,2)
-
-               TR=1./(GCOEF(1)+GCOEF(2)*V12+GCOEF(3)*V13+GCOEF(4)*V23)
-
-               C1=(GCOEF(2)+GCOEF(5))*TR
-
-               C2=(GCOEF(3)+GCOEF(6))*TR
-
-               C3=(GCOEF(4)+GCOEF(6))*TR
-
-               RHOPAR(1,2)=C1*DECPAR(1,2)+C2*R2(1)+C3*R1(1)
-
-               RHOPAR(2,2)=C1*DECPAR(2,2)-C2*R1(2)-C3*R2(2)
-
-               RETURN
-
-            ENDIF
-
-         ENDIF
-
-      ELSEIF (IPRO.EQ.16) THEN
-
-C A gluon fusion ---> Higgs event
-
-         IF (IST.EQ.2) THEN
-
-            DECPAR(1,2)=RHOPAR(1,2)
-
-            DECPAR(2,2)=-RHOPAR(2,2)
-
-            RETURN
-
-         ENDIF
-
-      ENDIF
-
-      CALL HWVZRO(2,RHOPAR(1,2))
-
-      CALL HWVZRO(2,DECPAR(1,2))
-
-      END
diff --git a/HERWIG/src/hwbsu1.f b/HERWIG/src/hwbsu1.f
deleted file mode 100644 (file)
index d49e0fd..0000000
+++ /dev/null
@@ -1,30 +0,0 @@
-
-CDECK  ID>, HWBSU1.
-
-*CMZ :-        -13/07/92  20.15.54  by  Mike Seymour
-
-*-- Author :    Bryan Webber, modified by Mike Seymour
-
-C-----------------------------------------------------------------------
-
-      FUNCTION HWBSU1(ZLOG)
-
-C-----------------------------------------------------------------------
-
-C     Z TIMES THE INTEGRAND IN EXPONENT OF QUARK SUDAKOV FORM FACTOR.
-
-C     HWBSU1 IS FOR UPPER PART OF Z INTEGRATION REGION
-
-C-----------------------------------------------------------------------
-
-      DOUBLE PRECISION HWBSU1,HWBSUL,Z,ZLOG,U
-
-      EXTERNAL HWBSUL
-
-      Z=EXP(ZLOG)
-
-      U=1.-Z
-
-      HWBSU1=HWBSUL(Z)*(1.+U*U)
-
-      END
diff --git a/HERWIG/src/hwbsu2.f b/HERWIG/src/hwbsu2.f
deleted file mode 100644 (file)
index 82ee64a..0000000
+++ /dev/null
@@ -1,28 +0,0 @@
-
-CDECK  ID>, HWBSU2.
-
-*CMZ :-        -13/07/92  20.15.54  by  Mike Seymour
-
-*-- Author :    Bryan Webber, modified by Mike Seymour
-
-C-----------------------------------------------------------------------
-
-      FUNCTION HWBSU2(Z)
-
-C-----------------------------------------------------------------------
-
-C     INTEGRAND IN EXPONENT OF QUARK SUDAKOV FORM FACTOR.
-
-C     HWBSU2 IS FOR LOWER PART OF Z INTEGRATION REGION
-
-C-----------------------------------------------------------------------
-
-      DOUBLE PRECISION HWBSU2,HWBSUL,Z,U
-
-      EXTERNAL HWBSUL
-
-      U=1.-Z
-
-      HWBSU2=HWBSUL(Z)*(1.+Z*Z)/U
-
-      END
diff --git a/HERWIG/src/hwbsud.f b/HERWIG/src/hwbsud.f
deleted file mode 100644 (file)
index 8a9dcb8..0000000
+++ /dev/null
@@ -1,320 +0,0 @@
-
-CDECK  ID>, HWBSUD.
-
-*CMZ :-        -14/07/92  13.28.23  by  Mike Seymour
-
-*-- Author :    Bryan Webber
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWBSUD
-
-C-----------------------------------------------------------------------
-
-C     COMPUTES (OR READS) TABLES OF SUDAKOV FORM FACTORS
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      DOUBLE PRECISION HWUGAU,HWBVMC,HWBSUG,HWBSU1,HWBSU2,G1,G2,QRAT,
-
-     & QLAM,POWER,AFAC,QMIN,QFAC,QNOW,ZMIN,ZMAX,Q1,QCOLD,VGOLD,VQOLD,
-
-     & RMOLD(6),ACOLD,ZLO,ZHI
-
-      INTEGER IQ,IS,L1,L2,L,LL,I,INOLD,NQOLD,NSOLD,NCOLD,NFOLD,SDOLD
-
-      EXTERNAL HWUGAU,HWBVMC,HWBSUG,HWBSU1,HWBSU2
-
-      SAVE NQOLD,NSOLD,NCOLD,NFOLD,SDOLD,QCOLD,VGOLD,VQOLD,RMOLD,ACOLD
-
-      COMMON/HWSINT/QRAT,QLAM
-
-      IF (LRSUD.EQ.0) THEN
-
-        POWER=1./FLOAT(NQEV-1)
-
-        AFAC=6.*CAFAC/BETAF
-
-        QMIN=QG+QG
-
-        QFAC=(1.1*QLIM/QMIN)**POWER
-
-        SUD(1,1)=1.
-
-        QEV(1,1)=QMIN
-
-C--IS=1 FOR GLUON->GLUON+GLUON FORM FACTOR
-
-        DO 10 IQ=2,NQEV
-
-        QNOW=QFAC*QEV(IQ-1,1)
-
-        QLAM=QNOW/QCDL3
-
-        ZMIN=QG/QNOW
-
-        QRAT=1./ZMIN
-
-        G1=0
-
-        DO 5 I=3,6
-
-          ZLO=ZMIN
-
-          ZHI=HALF
-
-          IF (I.NE.6) ZLO=MAX(ZLO,QG/RMASS(I+1))
-
-          IF (I.NE.3) ZHI=MIN(ZHI,QG/RMASS(I))
-
-          IF (ZHI.GT.ZLO) G1=G1+HWUGAU(HWBSUG,LOG(ZLO),LOG(ZHI),ACCUR)
-
-    5   CONTINUE
-
-        SUD(IQ,1)=EXP(AFAC*G1)
-
-   10   QEV(IQ,1)=QNOW
-
-        AFAC=3.*CFFAC/BETAF
-
-C--QUARK FORM FACTORS.
-
-C--IS=2,3,4,5,6,7 FOR U/D,S,C,B,T,V
-
-        DO 15 IS=2,NSUD
-
-        Q1=HWBVMC(IS)
-
-        IF (IS.EQ.7) Q1=HWBVMC(209)
-
-        QMIN=Q1+QG
-
-        IF (QMIN.GT.QLIM) GOTO 15
-
-        QFAC=(1.1*QLIM/QMIN)**POWER
-
-        SUD(1,IS)=1.
-
-        QEV(1,IS)=QMIN
-
-        DO 14 IQ=2,NQEV
-
-        QNOW=QFAC*QEV(IQ-1,IS)
-
-        QLAM=QNOW/QCDL3
-
-        ZMIN=QG/QNOW
-
-        QRAT=1./ZMIN
-
-        ZMAX=QG/QMIN
-
-        G1=0
-
-        DO 12 I=3,6
-
-          ZLO=ZMIN
-
-          ZHI=ZMAX
-
-          IF (I.NE.6) ZLO=MAX(ZLO,QG/RMASS(I+1))
-
-          IF (I.NE.3) ZHI=MIN(ZHI,QG/RMASS(I))
-
-          IF (ZHI.GT.ZLO) G1=G1+HWUGAU(HWBSU1,LOG(ZLO),LOG(ZHI),ACCUR)
-
-   12   CONTINUE
-
-        ZMIN=Q1/QNOW
-
-        QRAT=1./ZMIN
-
-        ZMAX=Q1/QMIN
-
-        G2=0
-
-        DO 13 I=3,6
-
-          ZLO=ZMIN
-
-          ZHI=ZMAX
-
-          IF (I.NE.6) ZLO=MAX(ZLO,Q1/RMASS(I+1))
-
-          IF (I.NE.3) ZHI=MIN(ZHI,Q1/RMASS(I))
-
-          IF (ZHI.GT.ZLO) G2=G2+HWUGAU(HWBSU2,ZLO,ZHI,ACCUR)
-
-   13   CONTINUE
-
-        SUD(IQ,IS)=EXP(AFAC*(G1+G2))
-
-   14   QEV(IQ,IS)=QNOW
-
-   15   CONTINUE
-
-        QCOLD=QCDLAM
-
-        VGOLD=VGCUT
-
-        VQOLD=VQCUT
-
-        ACOLD=ACCUR
-
-        INOLD=INTER
-
-        NQOLD=NQEV
-
-        NSOLD=NSUD
-
-        NCOLD=NCOLO
-
-        NFOLD=NFLAV
-
-        SDOLD=SUDORD
-
-        DO 16 IS=1,NSUD
-
-   16   RMOLD(IS)=RMASS(IS)
-
-      ELSE
-
-        IF (LRSUD.GT.0) THEN
-
-          IF (IPRINT.NE.0) WRITE (6,17) LRSUD
-
-   17     FORMAT(10X,'READING SUDAKOV TABLE ON UNIT',I4)
-
-          OPEN(UNIT=LRSUD,FORM='UNFORMATTED',STATUS='UNKNOWN')
-
-          READ(UNIT=LRSUD) QCOLD,VGOLD,VQOLD,RMOLD,
-
-     &       ACOLD,QEV,SUD,INOLD,NQOLD,NSOLD,NCOLD,NFOLD,SDOLD
-
-          CLOSE(UNIT=LRSUD)
-
-        ENDIF
-
-C---CHECK THAT RELEVANT PARAMETERS ARE UNCHANGED
-
-        IF (QCDLAM.NE.QCOLD) CALL HWWARN('HWBSUD',501,*999)
-
-        IF (VGCUT .NE.VGOLD) CALL HWWARN('HWBSUD',502,*999)
-
-        IF (VQCUT .NE.VQOLD) CALL HWWARN('HWBSUD',503,*999)
-
-        IF (ACCUR .NE.ACOLD) CALL HWWARN('HWBSUD',504,*999)
-
-        IF (INTER .NE.INOLD) CALL HWWARN('HWBSUD',505,*999)
-
-        IF (NQEV  .NE.NQOLD) CALL HWWARN('HWBSUD',506,*999)
-
-        IF (NSUD  .NE.NSOLD) CALL HWWARN('HWBSUD',507,*999)
-
-        IF (NCOLO .NE.NCOLD) CALL HWWARN('HWBSUD',508,*999)
-
-        IF (NFLAV .NE.NFOLD) CALL HWWARN('HWBSUD',509,*999)
-
-        IF (SUDORD.NE.SDOLD) CALL HWWARN('HWBSUD',510,*999)
-
-C---CHECK MASSES AND THAT TABLES ARE BIG ENOUGH FOR THIS RUN
-
-        DO 18 IS=1,NSUD
-
-          IF (RMASS(IS).NE.RMOLD(IS))
-
-     &      CALL HWWARN('HWBSUD',510+IS,*999)
-
-          IF (QEV(NQEV,IS).LT.QLIM.AND.HWBVMC(IS)+QG.LT.QLIM)
-
-     &      CALL HWWARN('HWBSUD',500,*999)
-
-   18   CONTINUE
-
-      ENDIF
-
-      IF (LWSUD.GT.0) THEN
-
-        IF (IPRINT.NE.0) WRITE (6,19) LWSUD
-
-   19   FORMAT(10X,'WRITING SUDAKOV TABLE ON UNIT',I4)
-
-        OPEN (UNIT=LWSUD,FORM='UNFORMATTED',STATUS='UNKNOWN')
-
-        WRITE(UNIT=LWSUD)  QCDLAM,VGCUT,VQCUT,(RMASS(I),I=1,6),
-
-     &     ACCUR,QEV,SUD,INTER,NQEV,NSUD,NCOLO,NFLAV,SUDORD
-
-        CLOSE(UNIT=LWSUD)
-
-      ENDIF
-
-      IF (IPRINT.GT.2) THEN
-
-C--PRINT EXTRACTS FROM TABLES OF FORM FACTORS
-
-        DO 40 IS=1,NSUD
-
-        WRITE(6,20) IS,NQEV
-
-   20   FORMAT(1H1//10X,'EXTRACT FROM TABLE OF SUDAKOV FORM FACTOR NO.',
-
-     &  I2,' (',I5,' ACTUAL ENTRIES)'//10X,'SUD IS PROBABILITY THAT',
-
-     &  ' PARTON WITH GIVEN UPPER LIMIT ON Q WILL REACH THRESHOLD',
-
-     &  ' WITHOUT BRANCHING'///2X,8('      Q     SUD ')/)
-
-        L2=NQEV/8
-
-        L1=L2/32
-
-        IF (L1.LT.1) L1=1
-
-        DO 40 L=L1,L2,L1
-
-        LL=L+7*L2
-
-        WRITE(6,30) (QEV(I,IS),SUD(I,IS),I=L,LL,L2)
-
-   30   FORMAT(2X,8(F9.2,F7.4))
-
-   40   CONTINUE
-
-        WRITE(6,50)
-
-   50   FORMAT(1H1)
-
-      ENDIF
-
-  999 END
-
-CDECK  ID>, HWBSUG.
-
-*CMZ :-        -13/07/92  20.15.54  by  Mike Seymour
-
-*-- Author :    Bryan Webber, modified by Mike Seymour
-
-C-----------------------------------------------------------------------
-
-      FUNCTION HWBSUG(ZLOG)
-
-C-----------------------------------------------------------------------
-
-C     Z TIMES INTEGRAND IN EXPONENT OF GLUON SUDAKOV FORM FACTOR
-
-C-----------------------------------------------------------------------
-
-      DOUBLE PRECISION HWBSUG,HWBSUL,Z,ZLOG,W
-
-      EXTERNAL HWBSUL
-
-      Z=EXP(ZLOG)
-
-      W=Z*(1.-Z)
-
-      HWBSUG=HWBSUL(Z)*(W-2.+1./W)*Z
-
-      END
diff --git a/HERWIG/src/hwbsul.f b/HERWIG/src/hwbsul.f
deleted file mode 100644 (file)
index a7f2475..0000000
+++ /dev/null
@@ -1,158 +0,0 @@
-
-CDECK  ID>, HWBSUL.
-
-*CMZ :-        -13/07/92  20.15.54  by  Mike Seymour
-
-*-- Author :    Mike Seymour
-
-C-----------------------------------------------------------------------
-
-      FUNCTION HWBSUL(Z)
-
-C-----------------------------------------------------------------------
-
-C     LOGARITHMIC PART OF INTEGRAND IN EXPONENT OF SUDAKOV FORM FACTOR.
-
-C     THE SECOND ORDER ALPHAS CASE COMES FROM CONVERTING INTEGRAL OVER
-
-C     Q^2 INTO ONE OVER ALPHAS, WITH FLAVOUR THRESHOLDS.
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      DOUBLE PRECISION HWBSUL,HWUALF,Z,QRAT,QLAM,U,AL,BL,QNOW,QMIN,
-
-     & BET(6),BEP(6),MUMI(6),MUMA(6),ALMI(6),ALMA(6),FINT(6),ALFINT,
-
-     & MUMIN,MUMAX,ALMIN,ALMAX
-
-      INTEGER NF
-
-      LOGICAL FIRST
-
-      EXTERNAL HWUALF
-
-      SAVE FIRST,BET,BEP,MUMI,MUMA
-
-      COMMON/HWSINT/QRAT,QLAM
-
-      DATA FIRST/.TRUE./
-
-      ALFINT(AL,BL)=1/BET(NF)*
-
-     &        LOG(BL/(AL*(1+BEP(NF)*BL))*(1+BEP(NF)*AL))
-
-      HWBSUL=0
-
-      U=1.-Z
-
-      IF (SUDORD.EQ.1) THEN
-
-        AL=LOG(QRAT*Z)
-
-        BL=LOG(QLAM*U*Z)
-
-        HWBSUL=LOG(1.-AL/BL)
-
-      ELSE
-
-        IF (FIRST) THEN
-
-          DO 10 NF=3,6
-
-            BET(NF)=(11*CAFAC-2*NF)/(12*PIFAC)
-
-            BEP(NF)=(17*CAFAC**2-(5*CAFAC+3*CFFAC)*NF)/(24*PIFAC**2)
-
-     &              /BET(NF)
-
-            IF (NF.EQ.3) THEN
-
-              MUMI(3)=0
-
-              ALMI(3)=1D30
-
-            ELSE
-
-              MUMI(NF)=RMASS(NF)
-
-              ALMI(NF)=HWUALF(1,MUMI(NF))
-
-            ENDIF
-
-            IF (NF.EQ.6) THEN
-
-              MUMA(NF)=1D30
-
-              ALMA(NF)=0
-
-            ELSE
-
-              MUMA(NF)=RMASS(NF+1)
-
-              ALMA(NF)=HWUALF(1,MUMA(NF))
-
-            ENDIF
-
-            IF (NF.NE.3.AND.NF.NE.6) FINT(NF)=ALFINT(ALMI(NF),ALMA(NF))
-
- 10       CONTINUE
-
-          FIRST=.FALSE.
-
-        ENDIF
-
-        QNOW=QLAM*QCDL3
-
-        QMIN=QNOW/QRAT
-
-        MUMIN=  U*QMIN
-
-        MUMAX=Z*U*QNOW
-
-        IF (MUMAX.LE.MUMIN) RETURN
-
-        ALMIN=HWUALF(1,MUMIN)
-
-        ALMAX=HWUALF(1,MUMAX)
-
-        NF=3
-
- 20     IF (MUMIN.GT.MUMA(NF)) THEN
-
-          NF=NF+1
-
-          GOTO 20
-
-        ENDIF
-
-        IF (MUMAX.LT.MUMA(NF)) THEN
-
-          HWBSUL=ALFINT(ALMIN,ALMAX)
-
-        ELSE
-
-          HWBSUL=ALFINT(ALMIN,ALMA(NF))
-
-          NF=NF+1
-
- 30       IF (MUMAX.GT.MUMA(NF)) THEN
-
-            HWBSUL=HWBSUL+FINT(NF)
-
-            NF=NF+1
-
-            GOTO 30
-
-          ENDIF
-
-          HWBSUL=HWBSUL+ALFINT(ALMI(NF),ALMAX)
-
-        ENDIF
-
-        HWBSUL=HWBSUL*BET(5)
-
-      ENDIF
-
-      END
diff --git a/HERWIG/src/hwbtim.f b/HERWIG/src/hwbtim.f
deleted file mode 100644 (file)
index 62b9717..0000000
+++ /dev/null
@@ -1,628 +0,0 @@
-
-CDECK  ID>, HWBTIM.
-
-*CMZ :-        -26/04/91  14.27.17  by  Federico Carminati
-
-*-- Author :    Ian Knowles
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWBTIM(INITBR,INTERF)
-
-C-----------------------------------------------------------------------
-
-C     Constructs full 4-momentum & production vertices in time-like jet
-
-C     initiated by INITBR, interference partner INTERF and spin density
-
-C     RHOPAR(INITBR). DECPAR(INITBR) returns jet's spin density matrix.
-
-C     Includes azimuthal angular correlations between branching planes
-
-C     due to spin (if AZSPIN) using the algorithm of Knowles & Collins.
-
-C     Ses Nucl. Phys. B304 (1988) 794 & Comp. Phys. Comm. 58 (1990) 271.
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      DOUBLE PRECISION HWR,DMIN,PT,EIKON,EINUM,EIDEN1,EIDEN2,EISCR,
-
-     & WT,SPIN,Z1,Z2,PRMAX,CAZ,CX,SX,ROHEP(3),RMAT(3,3),ZERO2(2)
-
-      INTEGER INITBR,INTERF,IPAR,JPAR,KPAR,LPAR,MPAR,NTRY,JOLD
-
-      LOGICAL EICOR,SWAP
-
-      EXTERNAL HWR
-
-      DATA ZERO2,DMIN/ZERO,ZERO,1.D-15/
-
-      IF (IERROR.NE.0) RETURN
-
-      JPAR=INITBR
-
-      KPAR=INTERF
-
-      IF ((JDAPAR(1,JPAR).NE.0).OR.(IDPAR(JPAR).EQ.13)) GOTO 30
-
-C No branching, assign decay matrix
-
-      CALL HWVZRO(2,DECPAR(1,JPAR))
-
-      RETURN
-
-C Advance up the leader
-
-C     Find the parent and partner of J
-
-  10  IPAR=JMOPAR(1,JPAR)
-
-      KPAR=JPAR+1
-
-C Generate new Rho
-
-      IF (JMOPAR(1,KPAR).EQ.IPAR) THEN
-
-C        Generate Rho'
-
-         CALL HWBAZF(IPAR,JPAR,PHIPAR(1,IPAR),RHOPAR(1,IPAR),
-
-     &                                   ZERO2,RHOPAR(1,JPAR))
-
-      ELSE
-
-         KPAR=JPAR-1
-
-         IF (JMOPAR(1,KPAR).NE.IPAR)
-
-     &   CALL HWWARN('HWBTIM',100,*999)
-
-C        Generate Rho''
-
-         CALL HWBAZF(IPAR,KPAR,RHOPAR(1,IPAR),PHIPAR(1,IPAR),
-
-     &                         DECPAR(1,KPAR),RHOPAR(1,JPAR))
-
-      ENDIF
-
-C Generate azimuthal angle of J's branching
-
-  30  IF (JDAPAR(1,JPAR).EQ.0) THEN
-
-C        Final state gluon
-
-         CALL HWVZRO(2,DECPAR(1,JPAR))
-
-         IF (JPAR.EQ.INITBR) RETURN
-
-         GOTO 70
-
-      ELSE
-
-C Assign an angle to a branching using an M-function
-
-C        Find the daughters of J
-
-         LPAR=JDAPAR(1,JPAR)
-
-         MPAR=JDAPAR(2,JPAR)
-
-C Soft correlations
-
-         CALL HWUROT(PPAR(1,JPAR), ONE,ZERO,RMAT)
-
-         CALL HWUROF(RMAT,PPAR(1,KPAR),ROHEP)
-
-         PT=MAX(SQRT(ROHEP(1)*ROHEP(1)+ROHEP(2)*ROHEP(2)),DMIN)
-
-         EIKON=1.
-
-         SWAP=.FALSE.
-
-         EICOR=AZSOFT.AND.((IDPAR(LPAR).EQ.13).OR.(IDPAR(MPAR).EQ.13))
-
-         IF (EICOR) THEN
-
-C           Rearrange s.t. LPAR is the (softest) gluon
-
-            IF (IDPAR(MPAR).EQ.13) THEN
-
-               IF (IDPAR(LPAR).NE.13.OR.
-
-     &             PPAR(4,MPAR).LT.PPAR(4,LPAR)) THEN
-
-                  SWAP=.TRUE.
-
-                  LPAR=MPAR
-
-                  MPAR=LPAR-1
-
-               ENDIF
-
-            ENDIF
-
-            EINUM=(PPAR(4,KPAR)*PPAR(4,LPAR))
-
-     &        *ABS(PPAR(2,LPAR)-PPAR(2,MPAR))
-
-            EIDEN1=(PPAR(4,KPAR)*PPAR(4,LPAR))-ROHEP(3)*PPAR(3,LPAR)
-
-            EIDEN2=PT*ABS(PPAR(1,LPAR))
-
-            EISCR=1.-(PPAR(5,MPAR)/PPAR(4,MPAR))**2
-
-     &           /MIN(PPAR(2,LPAR),PPAR(2,MPAR))
-
-            EIKON=EISCR+EINUM/MAX(EIDEN1-EIDEN2,DMIN)
-
-         ENDIF
-
-C Spin correlations
-
-         WT=0.
-
-         SPIN=1.
-
-         IF (AZSPIN) THEN
-
-            Z1=PPAR(4,LPAR)/PPAR(4,JPAR)
-
-            Z2=1.-Z1
-
-            IF (IDPAR(JPAR).EQ.13.AND.IDPAR(LPAR).EQ.13) THEN
-
-               WT=Z1*Z2/(Z1/Z2+Z2/Z1+Z1*Z2)
-
-            ELSEIF (IDPAR(JPAR).EQ.13.AND.IDPAR(LPAR).LT.13) THEN
-
-               WT=-2.*Z1*Z2/(Z1*Z1+Z2*Z2)
-
-            ENDIF
-
-         ENDIF
-
-C Assign the azimuthal angle
-
-         PRMAX=(1.+ABS(WT))*EIKON
-
-         NTRY=0
-
-   50    NTRY=NTRY+1
-
-         IF (NTRY.GT.NBTRY) CALL HWWARN('HWBTIM',101,*999)
-
-         CALL HWRAZM( ONE,CX,SX)
-
-         CALL HWUROT(PPAR(1,JPAR),CX,SX,RMAT)
-
-C Determine the angle between the branching planes
-
-         CALL HWUROF(RMAT,PPAR(1,KPAR),ROHEP)
-
-         CAZ=ROHEP(1)/PT
-
-         PHIPAR(1,JPAR)=2.*CAZ*CAZ-1.
-
-         PHIPAR(2,JPAR)=2.*CAZ*ROHEP(2)/PT
-
-         IF (EICOR) EIKON=EISCR+EINUM/MAX(EIDEN1-EIDEN2*CAZ,DMIN)
-
-         IF (AZSPIN) SPIN=1.+WT*(RHOPAR(1,JPAR)*PHIPAR(1,JPAR)
-
-     &                          +RHOPAR(2,JPAR)*PHIPAR(2,JPAR))
-
-         IF (SPIN*EIKON.LT.HWR()*PRMAX) GOTO 50
-
-C Construct full 4-momentum of L and M
-
-         JOLD=JPAR
-
-         IF (SWAP) THEN
-
-           PPAR(1,LPAR)=-PPAR(1,LPAR)
-
-           PPAR(1,MPAR)=-PPAR(1,MPAR)
-
-           JPAR=MPAR
-
-         ELSE
-
-           JPAR=LPAR
-
-         ENDIF
-
-         PPAR(2,LPAR)=0.
-
-         CALL HWUROB(RMAT,PPAR(1,LPAR),PPAR(1,LPAR))
-
-         PPAR(2,MPAR)=0.
-
-         CALL HWUROB(RMAT,PPAR(1,MPAR),PPAR(1,MPAR))
-
-C Assign production vertex to L and M
-
-         CALL HWUDKL(IDPAR(JOLD),PPAR(1,JOLD),VPAR(1,LPAR))
-
-         CALL HWVSUM(4,VPAR(1,JOLD),VPAR(1,LPAR),VPAR(1,LPAR))
-
-         CALL HWVEQU(4,VPAR(1,LPAR),VPAR(1,MPAR))
-
-      ENDIF
-
-  60  IF (JDAPAR(1,JPAR).NE.0) GOTO 10
-
-C Assign decay matrix
-
-      CALL HWVZRO(2,DECPAR(1,JPAR))
-
-C Backtrack down the leader
-
-  70  IPAR=JMOPAR(1,JPAR)
-
-      KPAR=JDAPAR(1,IPAR)
-
-      IF (KPAR.EQ.JPAR) THEN
-
-C        Develop the side branch
-
-         JPAR=JDAPAR(2,IPAR)
-
-         GOTO 60
-
-      ELSE
-
-C        Construct decay matrix
-
-         CALL HWBAZF(IPAR,KPAR,DECPAR(1,JPAR),DECPAR(1,KPAR),
-
-     &                         PHIPAR(1,IPAR),DECPAR(1,IPAR))
-
-      ENDIF
-
-      IF (IPAR.EQ.INITBR) RETURN
-
-      JPAR=IPAR
-
-      GOTO 70
-
-  999 END
-
-CDECK  ID>, HWBTOP.
-
-*CMZ :-        -14/10/99  18.04.56  by  Mike Seymour
-
-*-- Author :    Gennaro Corcella
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWBTOP
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      DOUBLE PRECISION HWBVMC,HWR,HWUALF,HWUSQR,X(3),W,
-
-     & X3MIN,X3MAX,X1MIN,X1MAX,QSCALE,GLUFAC,R(3,3),M(3),
-
-     & E(3),AW,PTSQ,EM,EPS,MASDEP,A,B,C,GAMDEP,LAMBDA,
-
-     & PW(5),PT(5),PW1(5),CS,SN,EPG,QQ,RR,CC
-
-      INTEGER ID,ID3,IHEP,KHEP,WHEP,ICMF,K
-
-      EXTERNAL HWBVMC,HWUALF,HWUSQR,HWR
-
-      LAMBDA(A,B,C)=(A**2+B**2+C**2-2*A*B-2*B*C-2*C*A)/(4*A)
-
-C---FIND AN UNTREATED CMF
-
-      ICMF=0
-
-      DO 10 IHEP=1,NHEP
-
-C----FIND A DECAYING TOP QUARK
-
- 10     IF (ISTHEP(IHEP).EQ.155.AND.ISTHEP(JDAHEP(1,IHEP)).EQ.113
-
-     &       .AND.(IDHW(IHEP).EQ.6.OR.IDHW(IHEP).EQ.12))
-
-     &       ICMF=IHEP
-
-      IF (ICMF.EQ.0) RETURN
-
-      EM=PHEP(5,ICMF)
-
-      X3MIN=2*GCUTME/EM
-
-C---GENERATE X(1),X(3) ACCORDING TO 1/((1-X(1))*X(3)**2)
-
- 100  CONTINUE
-
-C-----AW=(MW/MT)**2
-
-      AW=(PHEP(5,JDAHEP(1,ICMF))/EM)**2
-
-C---CHOOSE X3
-
-      X3MAX=1-AW
-
-      X(3)=X3MIN*X3MAX/(X3MIN+(X3MAX-X3MIN)*HWR())
-
-C--CC, QQ AND RR ARE THE VARIABLE DEFINED IN OUR PAPER
-
-C--IN ORDER TO SOLVE THE CUBIC EQUATION
-
-      CC=(1-AW)**2/4
-
-      QQ=(AW**2-4*(1-X(3))*(2-CC-X(3))-2*AW*(3+2*X(3)))/3
-
-     &     -((3+2*AW-4*X(3))**2)/9
-
-      RR=((3+2*AW-4*X(3))*(AW**2-4*(1-X(3))*(2-CC-X(3))
-
-     &     -2*AW*(3+2*X(3)))-3*(AW*(4-AW)*(2-CC)+(1-CC)
-
-     &     *(2*(1-X(3))-AW)**2))/6-(ONE/27)*(3+2*AW-4*X(3))**3
-
-C---CHOOSE X1
-
-      X1MAX=2*(-QQ**3)**(ONE/6)*COS(ACOS(RR/SQRT(-QQ**3))/3)
-
-     &     -(3+2*AW-4*X(3))/3
-
-      X1MIN=1-X(3)+(AW*X(3))/(1-X(3))
-
-      IF (X1MAX.GE.1.OR.X1MIN.GE.1.OR.X1MAX.LE.X1MIN) GOTO 100
-
-      X(1)=1-(1-X1MAX)*((1-X1MIN)/(1-X1MAX))**HWR()
-
-C---CALCULATE WEIGHT
-
-      W=((1+1/AW-2*AW)*((1-AW)*X(3)-(1-X(1))*(1-X(3))-X(3)**2)
-
-     &     +(1+1/(2*AW))*X(3)*(X(1)+X(3)-1)**2+2*X(3)**2*(1-X(1)))
-
-     &     *(1/X3MIN-1/X3MAX)*LOG((1-X1MIN)/(1-X1MAX))
-
-C---QSCALE=DURHAM-LIKE TRANSVERSE MOMENTUM OF THE GLUON
-
-      QSCALE=EM*HWUSQR(X(3)*(1-X(1))/(2-X(1)-X(3)-AW))
-
-C---FACTOR FOR GLUON EMISSION
-
-      ID=IDHW(JDAHEP(2,ICMF))
-
-      GLUFAC=0
-
-      IF (QSCALE.GT.HWBVMC(13)) GLUFAC=CFFAC*HWUALF(1,QSCALE)
-
-     &     /(PIFAC*(1-AW)*(1-2*AW+1/AW))
-
-C---IN FRACTION GLUFAC*W OF EVENTS ADD A GLUON
-
-      IF (GLUFAC*W.GT.HWR()) THEN
-
-        ID3=13
-
-      ELSE
-
-        RETURN
-
-      ENDIF
-
-C---CHECK INFRA-RED CUT-OFF FOR GLUON
-
-      M(1)=PHEP(5,JDAHEP(1,ICMF))
-
-      M(2)=HWBVMC(ID)
-
-      M(3)=HWBVMC(ID3)
-
-      E(1)=HALF*EM*(X(1)+AW+(-M(2)**2-M(3)**2)/EM**2)
-
-      E(3)=HALF*EM*X(3)
-
-      E(2)=EM-E(1)-E(3)
-
-      PTSQ=-LAMBDA(E(1)**2-M(1)**2,E(3)**2-M(3)**2,
-
-     &     E(2)**2-M(2)**2)
-
-      IF (PTSQ.LE.0.OR.E(1).LE.M(1).OR.E(2).LE.M(2).OR.E(3).LE.M(3))
-
-     $     RETURN
-
-C---CALCULATE MASS-DEPENDENT SUPPRESSION
-
-      EPS=(RMASS(ID)/EM)**2
-
-      EPG=(RMASS(ID3)/EM)**2
-
-      GAMDEP=(1-AW)*(1+1/AW-2*AW)/(SQRT(1+AW**2+EPS**2
-
-     &     -2*AW-2*EPS-2*AW*EPS)*(1+EPS+(1-EPS)**2/AW-2*AW))
-
-      MASDEP=GAMDEP/(1-X(1))*((1+EPS+(1-EPS)**2/AW-2*AW)
-
-     &     *((1-AW+EPS)*X(3)*(1-X(1))-(1-X(1))**2*(1-X(3))
-
-     &     -X(3)**2*(1-X(1)+EPS))+(1+(1+EPS)/(2*AW))*X(3)
-
-     &     *(1-X(1))*(X(1)+X(3)-1)**2+2*X(3)**2*(1-X(1))**2)
-
-      IF (MASDEP.LT.HWR()*((1+1/AW-2*AW)*((1-AW)*X(3)
-
-     &     -(1-X(1))*(1-X(3))-X(3)**2)+(1+1/(2*AW))*X(3)
-
-     &     *(X(1)+X(3)-1)**2+2*X(3)**2*(1-X(1)))) RETURN
-
-C---STORE OLD MOMENTA
-
-c---PT = TOP MOMENTUM, PW= W MOMENTUM
-
-      CALL HWVEQU(5,PHEP(1,ICMF),PT)
-
-      CALL HWVEQU(5,PHEP(1,JDAHEP(1,ICMF)),PW)
-
-C--------GET THE NON-EMITTING PARTON CMF DIRECTION
-
-      CALL HWULOF(PHEP(1,ICMF),PW,PW)
-
-      CALL HWRAZM(ONE,CS,SN)
-
-      CALL HWUROT(PW,CS,SN,R)
-
-      CALL HWUROF(R,PW,PW)
-
-      CALL HWUMAS(PW)
-
-C---REORDER ENTRIES: IHEP=EMITTER,  KHEP=EMITTED
-
-      NHEP=NHEP+1
-
-      IHEP=JDAHEP(2,ICMF)
-
-      WHEP=JDAHEP(1,ICMF)
-
-      KHEP=NHEP
-
-C---SET UP MOMENTA IN TOP REST FRAME
-
-      PHEP(1,ICMF)=0
-
-      PHEP(2,ICMF)=0
-
-      PHEP(3,ICMF)=0
-
-      PHEP(4,ICMF)=EM
-
-      PHEP(5,ICMF)=EM
-
-      PHEP(4,IHEP)=HALF*EM*(2-X(1)-X(3)+EPS-AW+EPG)
-
-      PHEP(4,KHEP)=HALF*EM*X(3)
-
-      PHEP(5,IHEP)=RMASS(ID)
-
-      PHEP(5,KHEP)=RMASS(ID3)
-
-      PHEP(3,KHEP)=HALF*EM*((X(1)+AW-EPS-EPG)*X(3)-2*(1+EPS-AW
-
-     $     -EPG-(2+EPS+EPG-AW-X(1)-X(3))))/HWUSQR((X(1)+AW
-
-     $     -EPS-EPG)**2-4*AW)
-
-      PHEP(3,IHEP)=-PHEP(3,KHEP)-HALF*EM
-
-     $     *HWUSQR((X(1)+AW-EPS-EPG)**2-4*AW)
-
-      PHEP(2,IHEP)=0
-
-      PHEP(1,KHEP)=HWUSQR(PHEP(4,KHEP)**2-PHEP(5,KHEP)**2
-
-     $     -PHEP(3,KHEP)**2)
-
-      PHEP(1,IHEP)=-PHEP(1,KHEP)
-
-      PHEP(2,KHEP)=0
-
-      CALL HWVSUM(4,PHEP(1,IHEP),PHEP(1,KHEP),PW1)
-
-      CALL HWVDIF(4,PHEP(1,ICMF),PW1,PW1)
-
-      CALL HWUMAS(PW1)
-
-      DO K=1,5
-
-        PHEP(K,WHEP)=PW1(K)
-
-      ENDDO
-
-C---ORIENT IN CMF, THEN BOOST TO LAB
-
-      CALL HWUROB(R,PHEP(1,ICMF),PHEP(1,ICMF))
-
-      CALL HWUROB(R,PHEP(1,IHEP),PHEP(1,IHEP))
-
-      CALL HWUROB(R,PHEP(1,WHEP),PHEP(1,WHEP))
-
-      CALL HWUROB(R,PHEP(1,KHEP),PHEP(1,KHEP))
-
-      CALL HWULOB(PT,PHEP(1,IHEP),PHEP(1,IHEP))
-
-      CALL HWULOB(PT,PHEP(1,KHEP),PHEP(1,KHEP))
-
-      CALL HWULOB(PT,PHEP(1,ICMF),PHEP(1,ICMF))
-
-      CALL HWULOB(PT,PHEP(1,WHEP),PHEP(1,WHEP))
-
-C---STATUS AND COLOUR CONNECTION
-
-      ISTHEP(KHEP)=114
-
-      IDHW(KHEP)=ID3
-
-      IDHEP(KHEP)=IDPDG(ID3)
-
-      JDAHEP(2,ICMF)=KHEP
-
-      JMOHEP(1,KHEP)=ICMF
-
-      JMOHEP(1,IHEP)=ICMF
-
-      JDAHEP(1,KHEP)=0
-
-      JMOHEP(2,IHEP)=ICMF
-
-      JDAHEP(2,IHEP)=KHEP
-
-      JMOHEP(2,KHEP)=IHEP
-
-      JDAHEP(2,KHEP)=ICMF
-
- 999  END
-
-CDECK  ID>, HWBVMC.
-
-*CMZ :-        -26/04/91  11.11.54  by  Bryan Webber
-
-*-- Author :    Bryan Webber
-
-C-----------------------------------------------------------------------
-
-      FUNCTION HWBVMC(ID)
-
-C-----------------------------------------------------------------------
-
-C     VIRTUAL MASS CUTOFF FOR PARTON TYPE ID
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      DOUBLE PRECISION HWBVMC
-
-      INTEGER ID
-
-      IF (ID.EQ.13) THEN
-
-        HWBVMC=RMASS(ID)+VGCUT
-
-      ELSEIF (ID.LT.13) THEN
-
-        HWBVMC=RMASS(ID)+VQCUT
-
-      ELSEIF (ID.EQ.59) THEN
-
-        HWBVMC=RMASS(ID)+VPCUT
-
-      ELSE
-
-        HWBVMC=RMASS(ID)
-
-      ENDIF
-
-      END
diff --git a/HERWIG/src/hwcbct.f b/HERWIG/src/hwcbct.f
deleted file mode 100644 (file)
index 43c7f0a..0000000
+++ /dev/null
@@ -1,986 +0,0 @@
-
-CDECK  ID>, HWCBCT.
-
-*CMZ :-        -20/07/99  10:56:12  by  Peter Richardson
-
-*-- Author :    Peter Richardson
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWCBCT(JHEP,KHEP,THEP,PCL,SPLIT)
-
-C-----------------------------------------------------------------------
-
-C  Subroutine to split a baryonic cluster containing two heavy quarks
-
-C  Based on HWCCUT
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      DOUBLE PRECISION HWUPCM,HWR,HWVDOT,EMC,QM1,QM2,QM3,QM4,
-
-     &                 PXY,PCX,PCY,RCM,PCL(5),AX(5),PA(5),PB(5),PC(5),
-
-     &                 VCLUS(4),DQM,EMX,EMY,SKAPPA,RKAPPA,VTMP(4),
-
-     &                 DELTM,PDIQUK(5),AY(5)
-
-      INTEGER HWRINT,JHEP,KHEP,LHEP,MHEP,THEP,ID1,ID2,ID3,ID4,NTRY,
-
-     &        NTRYMX,J,IB
-
-      LOGICAL SPLIT
-
-      EXTERNAL HWUPCM,HWR,HWVDOT
-
-      PARAMETER(SKAPPA=1.,NTRYMX=100)
-
-      IF(IERROR.NE.0) RETURN
-
-      EMC=PCL(5)
-
-      ID1=IDHW(JHEP)
-
-      ID2=IDHW(KHEP)
-
-      ID3=IDHW(THEP)
-
-      QM1=RMASS(ID1)
-
-      QM2=RMASS(ID2)
-
-      QM3=RMASS(ID3)
-
-      SPLIT = .FALSE.
-
-      NTRY = 0
-
-C Decide if cluster contains a b-(anti)quark
-
-      IF (ID1.EQ.5.OR.ID1.EQ.11.OR.ID2.EQ.5.OR.ID2.EQ.11.OR.
-
-     &    ID3.EQ.5.OR.ID3.EQ.11) THEN
-
-        IB=2
-
-      ELSE
-
-        IB=1
-
-      ENDIF
-
-C-- Set the positon of the cluster to be that of the heavy quark
-
-      CALL HWVEQU(4,VHEP(1,THEP),VCLUS)
-
-C--SPLIT THE BARYONIC CLUSTER INTO A HEAVY FLAVOUR MESON AND A HEAVY
-
-C--FLAVOUR BARYON
-
-      PXY=EMC-QM1-QM2-QM3
-
- 20   NTRY=NTRY+1
-
-      IF(NTRY.GT.NTRYMX) RETURN
-
- 30   EMX=QM1+QM2+PXY*HWR()**PSPLT(IB)
-
-      EMY=    QM3+PXY*HWR()**PSPLT(IB)
-
-      IF(EMX+EMY.GE.EMC) GOTO 30
-
-C--PULL A LIGHT QUARK PAIR OUT OF THE VACUUM
-
- 40   ID4=HWRINT(1,3)
-
-      IF(QWT(ID4).LT.HWR()) GOTO 40
-
-      QM4=RMASS(ID4)
-
-C--Now combine particles 3 & 4 into a diquark
-
-C--If three also heavy this diquark doesn't exist in HERWIG
-
-C--just assume mass is sum of quark masses,as for other diquarks
-
-      DQM=QM3+QM4
-
-C--Now obtain the masses for the cluster splitting
-
-      PCX=HWUPCM(EMX,QM1,DQM)
-
-      IF(PCX.LT.ZERO) GOTO 20
-
-      PCY=HWUPCM(EMY,QM2,QM4)
-
-      IF(PCY.LT.ZERO) GOTO 20
-
-      SPLIT=.TRUE.
-
-C--Now we've decided which light quark to pull out of the vacuum
-
-C--Find the direction of the second heavy quark
-
-      CALL HWULOF(PCL,PHEP(1,THEP),AX)
-
-      RCM=1./SQRT(HWVDOT(3,AX,AX))
-
-      CALL HWVSCA(3,RCM,AX,AX)
-
-C--Construct the new CoM momenta(collinear)
-
-      PXY=HWUPCM(EMC,EMX,EMY)
-
-      CALL HWVSCA(3,PXY,AX,PC)
-
-C--pc is momenta of Y cluster along 2nd quark dirn in cluster frame
-
-      PC(4)=SQRT(PXY**2+EMY**2)
-
-      PC(5)=EMY
-
-C--pa is momenta of 2nd quark in Y frame
-
-      CALL HWVSCA(3,PCY,AX,PA)
-
-      PA(4)=SQRT(PCY**2+QM3**2)
-
-      PA(5)=QM3
-
-C--pb is momenta of 2nd quark in cluster frame,pa now momenta of antiquark
-
-      CALL HWULOB(PC,PA,PB)
-
-      CALL HWVDIF(4,PC,PB,PA)
-
-      PA(5)=QM4
-
-      LHEP=NHEP+1
-
-      MHEP=NHEP+2
-
-C--boost these momenta back to lab frame
-
-      CALL HWULOB(PCL,PB,PHEP(1,THEP))
-
-      CALL HWULOB(PCL,PA,PHEP(1,MHEP))
-
-C--pc now becomes momenta of X cluster in cluster frame
-
-      CALL HWVSCA(3,-ONE,PC,PC)
-
-      PC(4)=EMC-PC(4)
-
-      PC(5)=EMX
-
-C--find the dirn of the 1st heavy quark in the X frame
-
-C--transform to cluster frame
-
-      CALL HWULOF(PCL,PHEP(1,JHEP),AY)
-
-C--transform to X-frame
-
-      CALL HWULOF(PC,AY,AY)
-
-      RCM=1./SQRT(HWVDOT(3,AY,AY))
-
-      CALL HWVSCA(3,RCM,AY,AY)
-
-C--pa now momenta of 1st havy quark along this dirn
-
-      CALL HWVSCA(3,PCX,AY,PA)
-
-      PA(4)=SQRT(PCX**2+QM1**2)
-
-      PA(5)=QM1
-
-C--pb now momenta of 1st heavy quark in cluster frame then to lab
-
-      CALL HWULOB(PC,PA,PB)
-
-      CALL HWULOB(PCL,PB,PHEP(1,JHEP))
-
-C--now find the diquark momenta by momentum conservation
-
-      DO 50 J=1,4
-
- 50   PDIQUK(J)=PCL(J)-PHEP(J,THEP)-PHEP(J,MHEP)-PHEP(J,JHEP)
-
-      PDIQUK(5)=DQM
-
-C--Now obtain the quark momenta from the diquark
-
-      DO 60 J=1,3
-
- 60   PA(J) = 0
-
-      PA(4) = QM2
-
-      PA(5) = QM2
-
-      CALL HWULOB(PDIQUK,PA,PHEP(1,KHEP))
-
-      CALL HWVDIF(4,PDIQUK,PHEP(1,KHEP),PHEP(1,LHEP))
-
-C--Construct new vertex positions
-
-      RKAPPA=GEV2MM/SKAPPA
-
-      CALL HWVSCA(3,RKAPPA,AX,AX)
-
-      DELTM=(EMX-EMY)*(EMX+EMY)/(TWO*EMC)
-
-      CALL HWVSCA(3,DELTM,AX,VTMP)
-
-      VTMP(4)=(HALF*EMC-PXY)*RKAPPA
-
-      CALL HWULB4(PCL,VTMP,VTMP)
-
-      CALL HWVSUM(4,VTMP,VCLUS,VHEP(1,LHEP))
-
-      CALL HWVEQU(4,VHEP(1,LHEP),VHEP(1,MHEP))
-
-C--Relabel the colours of the quarks
-
-      IDHEP(LHEP) = IDPDG(ID4)
-
-      IDHEP(MHEP) = IDPDG(ID4)
-
-      IF(IDHEP(JHEP).GT.0) THEN
-
-        IDHW(LHEP)  = ID4+6
-
-        IDHEP(LHEP) = -IDHEP(LHEP)
-
-        IDHW(MHEP)  = ID4
-
-        JDAHEP(2,LHEP) = JHEP
-
-        JMOHEP(2,LHEP) = MHEP
-
-        JMOHEP(2,MHEP) = JMOHEP(2,JHEP)
-
-        JDAHEP(2,MHEP) = LHEP
-
-        JMOHEP(2,JHEP) = LHEP
-
-      ELSE
-
-        IDHW(LHEP)  = ID4
-
-        IDHW(MHEP)  = ID4+6
-
-        IDHEP(MHEP) = -IDHEP(MHEP)
-
-        JMOHEP(2,LHEP) = JHEP
-
-        JDAHEP(2,MHEP) = JDAHEP(2,JHEP)
-
-        JDAHEP(2,LHEP) = MHEP
-
-        JMOHEP(2,MHEP) = LHEP
-
-        JDAHEP(2,JHEP) = LHEP
-
-      ENDIF
-
-      ISTHEP(LHEP) = 151
-
-      ISTHEP(MHEP) = 151
-
-      JMOHEP(1,LHEP) = JMOHEP(1,KHEP)
-
-      JDAHEP(1,LHEP) = 0
-
-      JMOHEP(1,MHEP) = JMOHEP(1,JHEP)
-
-      JDAHEP(1,MHEP) = 0
-
-      NHEP = NHEP+2
-
- 999  END
-
-CDECK  ID>, HWCBVI.
-
-*CMZ :-
-
-*-- Author :    Mark Gibbs  modified by Peter Richardson
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWCBVI
-
-C-----------------------------------------------------------------------
-
-C FINDS UNPAIRED PARTONS AFTER BARYON-NUMBER VIOLATION
-
-C  MODIFIED FOR RPARITY VIOLATING SUSY
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      COMMON/HWBVIC/NBV,IBV(18)
-
-      DOUBLE PRECISION HWR,PDQ(5)
-
-      INTEGER NBV,IBV,JBV,KBV,LBV,IHEP,IP1,IP2,IP3,JP1,JP2,JP3,
-
-     & HWCBVT,NBR,MBV,IQ1,IQ2,IQ3,ID1,ID2,IDQ,IDIQK(3,3)
-
-      LOGICAL SPLIT,DUNBV(18)
-
-      DATA IDIQK/111,110,113,110,109,112,113,112,114/
-
-C---Check for errors
-
-      IF (IERROR.NE.0)  RETURN
-
-C---Correct colour connections are gluon splitting
-
-      CALL HWCCCC
-
-C---Reset bvi clustering flag
-
-      HVFCEN = .FALSE.
-
-C---LIST PARTONS WITH WRONG COLOUR PARTNERS-QUARKS ONLY
-
-    5 NBV=0
-
-      DO 10 IHEP=1,NHEP
-
-      IF (ISTHEP(IHEP).GT.149.AND.ISTHEP(IHEP).LT.155) THEN
-
-        IF (QORQQB(IDHW(IHEP))) THEN
-
-          IF (.NOT.QORQQB(IDHW(JMOHEP(2,IHEP))).
-
-     &        AND.JMOHEP(2,IHEP).GT.6) GOTO 10
-
-        ELSE
-
-C---Extra check for Gamma's
-
-          IF (IDHW(IHEP).EQ.59) GO TO 10
-
-C---End of bug fix.
-
-          IF (QORQQB(IDHW(JDAHEP(2,IHEP)))) GO TO 10
-
-          GO TO 10
-
-        ENDIF
-
-        IF(JMOHEP(2,IHEP).LT.6.AND.
-
-     &     .NOT.QBORQQ(IDHW(JMOHEP(2,IHEP)))) GOTO 10
-
-C--new for hard process
-
-        NBV=NBV+1
-
-        IF (NBV.GT.18) CALL HWWARN('HWCBVI',100,*999)
-
-        IBV(NBV)=IHEP
-
-        DUNBV(NBV)=.FALSE.
-
-      ENDIF
-
-   10 CONTINUE
-
-C--NOW FIND THE ANTIQUARKS WITH WRONG COLOUR CONNECTIONS
-
-      DO 11 IHEP=1,NHEP
-
-      IF(ISTHEP(IHEP).GT.149.AND.ISTHEP(IHEP).LT.155) THEN
-
-        IF(QBORQQ(IDHW(IHEP))) THEN
-
-          IF(.NOT.QBORQQ(IDHW(JDAHEP(2,IHEP))).AND.
-
-     &        JDAHEP(2,IHEP).GT.6) GO TO 11
-
-        ELSE
-
-C--Extra check for gamma's
-
-          IF(IDHW(IHEP).EQ.59) GO TO 11
-
-          IF(QBORQQ(IDHW(JMOHEP(2,IHEP)))) GO TO 11
-
-          GO TO 11
-
-        ENDIF
-
-        IF(JDAHEP(2,IHEP).LT.6.AND.
-
-     &    .NOT.QORQQB(IDHW(JDAHEP(2,IHEP)))) GOTO 11
-
-        NBV=NBV+1
-
-        IF(NBV.GT.18) CALL HWWARN('HWCBVI',100,*999)
-
-        IBV(NBV)=IHEP
-
-        DUNBV(NBV)=.FALSE.
-
-      ENDIF
-
- 11   CONTINUE
-
-      IF (NBV.EQ.0) RETURN
-
-      IF(MOD(NBV,3).NE.0) CALL HWWARN('HWCBVI',101,*999)
-
-C---PROCESS FOUND PARTONS, STARTING AT RANDOM POINT IN LIST
-
-      NBR=NBV*HWR()
-
-      DO 100 MBV=1,NBV
-
-      JBV=MBV+NBR
-
-      IF (JBV.GT.NBV) JBV=JBV-NBV
-
-      IF (.NOT.DUNBV(JBV)) THEN
-
-        DUNBV(JBV)=.TRUE.
-
-        IP1=IBV(JBV)
-
-        JP1=HWCBVT(IP1)
-
-C---FIND ASSOCIATED PARTONS
-
-        DO 20 KBV=1,NBV
-
-        IF (.NOT.DUNBV(KBV)) THEN
-
-          IP2=IBV(KBV)
-
-          JP2=HWCBVT(IP2)
-
-          IF (JP2.EQ.JP1) THEN
-
-            DUNBV(KBV)=.TRUE.
-
-            DO 15 LBV=1,NBV
-
-            IF (.NOT.DUNBV(LBV)) THEN
-
-              IP3=IBV(LBV)
-
-              JP3=HWCBVT(IP3)
-
-              IF (JP3.EQ.JP2) THEN
-
-                DUNBV(LBV)=.TRUE.
-
-                GO TO 25
-
-              ENDIF
-
-            ENDIF
-
-   15       CONTINUE
-
-          ENDIF
-
-        ENDIF
-
-   20   CONTINUE
-
-        CALL HWWARN('HWCBVI',102,*999)
-
-   25   IQ1=0
-
-C---LOOK FOR DIQUARK
-
-        IF (ABS(IDHEP(IP1)).GT.100) THEN
-
-          IQ1=IP1
-
-          IQ2=IP2
-
-          IQ3=IP3
-
-        ELSEIF (ABS(IDHEP(IP2)).GT.100) THEN
-
-          IQ1=IP2
-
-          IQ2=IP3
-
-          IQ3=IP1
-
-        ELSEIF (ABS(IDHEP(IP3)).GT.100) THEN
-
-          IQ1=IP3
-
-          IQ2=IP1
-
-          IQ3=IP2
-
-        ENDIF
-
-        IF (IQ1.EQ.0) THEN
-
-C---NO DIQUARKS: COMBINE TWO (ANTI)QUARKS
-
-          IF (ABS(IDHEP(IP1)).GT.3) THEN
-
-            IQ1=IP2
-
-            IQ2=IP3
-
-            IQ3=IP1
-
-          ELSEIF (ABS(IDHEP(IP2)).GT.3) THEN
-
-            IQ1=IP3
-
-            IQ2=IP1
-
-            IQ3=IP2
-
-          ELSE
-
-            IQ1=IP1
-
-            IQ2=IP2
-
-            IQ3=IP3
-
-          ENDIF
-
-          ID1=IDHEP(IQ1)
-
-          ID2=IDHEP(IQ2)
-
-C---CHECK FLAVOURS
-
-          IF (ID1.GT.0.AND.ID1.LT.4.AND.
-
-     &        ID2.GT.0.AND.ID2.LT.4) THEN
-
-            IDQ=IDIQK(ID1,ID2)
-
-          ELSEIF (ID1.LT.0.AND.ID1.GT.-4.AND.
-
-     &            ID1.LT.0.AND.ID2.GT.-4) THEN
-
-            IDQ=IDIQK(-ID1,-ID2)+6
-
-          ELSE
-
-C---CANT MAKE DIQUARKS WITH HEAVY QUARKS: TRY CLUSTER SPLITTING
-
-            CALL HWVSUM(4,PHEP(1,IQ1),PHEP(1,IQ2),PDQ)
-
-            CALL HWUMAS(PDQ)
-
-C--Use the original splitting procedure
-
-            CALL HWCCUT(IQ1,IQ2,PDQ,.FALSE.,SPLIT)
-
-            IF(SPLIT) GOTO 5
-
-C--If it fails try the new procedure
-
-            CALL HWVSUM(4,PDQ,PHEP(1,IQ3),PDQ)
-
-            CALL HWUMAS(PDQ)
-
-            IF(ABS(ID1).GT.3) THEN
-
-              CALL HWCBCT(IQ3,IQ2,IQ1,PDQ,SPLIT)
-
-            ELSEIF(ABS(ID2).GT.3) THEN
-
-              CALL HWCBCT(IQ3,IQ1,IQ2,PDQ,SPLIT)
-
-            ELSE
-
-              CALL HWWARN('HWCBVI',100,*999)
-
-            ENDIF
-
-            IF (SPLIT) GO TO 5
-
-C---Unable to form cluster; dispose of event
-
-            CALL HWWARN('HWCBVI',-3,*999)
-
-          ENDIF
-
-C---OVERWRITE FIRST AND CANCEL SECOND
-
-          IDHW(IQ1)=IDQ
-
-          IDHEP(IQ1)=IDPDG(IDQ)
-
-          CALL HWVSUM(4,PHEP(1,IQ1),PHEP(1,IQ2),PHEP(1,IQ1))
-
-          CALL HWUMAS(PHEP(1,IQ1))
-
-          ISTHEP(IQ2)=0
-
-C---REMAKE COLOUR CONNECTIONS
-
-          IF (QORQQB(IDQ)) THEN
-
-            JMOHEP(2,IQ1)=IQ3
-
-            JDAHEP(2,IQ3)=IQ1
-
-          ELSE
-
-            JDAHEP(2,IQ1)=IQ3
-
-            JMOHEP(2,IQ3)=IQ1
-
-          ENDIF
-
-        ELSE
-
-C---SPLIT A DIQUARK
-
-          NHEP=NHEP+1
-
-          CALL HWVSCA(5,HALF,PHEP(1,IQ1),PHEP(1,IQ1))
-
-          CALL HWVEQU(5,PHEP(1,IQ1),PHEP(1,NHEP))
-
-          ISTHEP(NHEP)=150
-
-          JMOHEP(1,NHEP)=JMOHEP(1,IQ1)
-
-          JDAHEP(1,NHEP)=0
-
-C---FIND FLAVOURS
-
-          IDQ=IDHW(IQ1)
-
-          DO 30 ID2=1,3
-
-          DO 30 ID1=1,3
-
-          IF (IDIQK(ID1,ID2).EQ.IDQ) THEN
-
-            IDHW(IQ1)=ID1
-
-            IDHW(NHEP)=ID2
-
-C---REMAKE COLOUR CONNECTIONS (DIQUARK)
-
-            JMOHEP(2,IQ1)=IQ2
-
-            JMOHEP(2,IQ2)=NHEP
-
-            JMOHEP(2,IQ3)=IQ1
-
-            JMOHEP(2,NHEP)=IQ3
-
-            JDAHEP(2,IQ1)=IQ3
-
-            JDAHEP(2,IQ2)=IQ1
-
-            JDAHEP(2,IQ3)=NHEP
-
-            JDAHEP(2,NHEP)=IQ2
-
-            GO TO 35
-
-          ELSEIF (IDIQK(ID1,ID2).EQ.IDQ-6) THEN
-
-            IDHW(IQ1)=ID1+6
-
-            IDHW(NHEP)=ID2+6
-
-C---REMAKE COLOUR CONNECTIONS (ANTIDIQUARK)
-
-            JMOHEP(2,IQ1)=IQ3
-
-            JMOHEP(2,IQ2)=IQ1
-
-            JMOHEP(2,IQ3)=NHEP
-
-            JMOHEP(2,NHEP)=IQ2
-
-            JDAHEP(2,IQ1)=IQ2
-
-            JDAHEP(2,IQ2)=NHEP
-
-            JDAHEP(2,IQ3)=IQ1
-
-            JDAHEP(2,NHEP)=IQ3
-
-            GO TO 35
-
-          ENDIF
-
-   30     CONTINUE
-
-          CALL HWWARN('HWCBVI',104,*999)
-
-   35     IDHEP(IQ1)=IDPDG(IDHW(IQ1))
-
-          IDHEP(NHEP)=IDPDG(IDHW(NHEP))
-
-        ENDIF
-
-      ENDIF
-
-  100 CONTINUE
-
-      RETURN
-
-  999 END
-
-CDECK  ID>, HWCBVT.
-
-*CMZ :-
-
-*-- Author :    Peter Richardson
-
-C-----------------------------------------------------------------------
-
-      FUNCTION HWCBVT(IP)
-
-C-----------------------------------------------------------------------
-
-C  Function to find the baryon number violating vertex a parton came from
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      INTEGER HWCBVT,IP,JP(2),KP,I,J,ID,TYPE,IDM,IDM2,IDM3,IDM4
-
-      JP(1) = IP
-
-      ID = IDHW(IP)
-
-      IF(ID.LE.6.OR.(ID.GE.115.AND.ID.LE.120)) THEN
-
-        JP(2) = JMOHEP(2,IP)
-
-      ELSE
-
-        JP(2) = JDAHEP(2,IP)
-
-      ENDIF
-
-      DO I=1,2
-
-        IDM = JMOHEP(1,JMOHEP(1,JMOHEP(1,JMOHEP(1,JP(I)))))
-
-        IF(IDHW(IDM).EQ.6.OR.IDHW(IDM).EQ.12) THEN
-
-          JP(I)=IDM
-
-        ENDIF
-
-      ENDDO
-
-      DO J=1,7
-
-        DO I=1,2
-
-          KP = JMOHEP(1,JP(I))
-
-          IDM = IDHW(KP)
-
-          IDM2 = IDHW(JDAHEP(1,KP))
-
-          IDM3 = IDHW(JDAHEP(2,KP))
-
-          IDM4 = IDHW(JDAHEP(1,KP)+1)
-
-          IF((ISTHEP(KP).EQ.155.AND.
-
-     &      ((IDM.GE.449.AND.IDM.LE.457.AND.IDM2.LE.12.AND.
-
-     &       IDM3.LE.12.AND.IDM4.LE.12).OR.
-
-     &      (((IDM.GE.411.AND.IDM.LE.424).OR.IDM.EQ.405.OR.IDM.EQ.406)
-
-     &      .AND.IDM2.LE.12.AND.IDM3.LE.12)))
-
-     &        .OR.(IDM.EQ.15.AND.IDM2.LE.12.AND.
-
-     &       IDHW(JMOHEP(1,KP)).LE.12.AND.
-
-     &       IDHW(JMOHEP(2,KP)).LE.12.AND.IDM3.GE.449.AND.
-
-     &       IDM3.LE.457).OR.
-
-     &         (IDM.EQ.15.AND.IDM2.GE.198.AND.IDM2.LE.200.
-
-     &          AND.ABS(IDPDG(IDM3)).GT.1000000)) THEN
-
-            IF(IDHW(KP).EQ.449.AND.JDAHEP(1,KP).EQ.JP(I)) THEN
-
-              KP = JMOHEP(1,KP)
-
-            ELSEIF(IDHW(KP).EQ.15) THEN
-
-              TYPE=IDHW(JDAHEP(1,KP))
-
-              IF(TYPE.GE.7.AND.TYPE.LE.12.AND.
-
-     &           JMOHEP(2,JDAHEP(2,KP)).EQ.JP(I)) THEN
-
-                KP=IP
-
-              ELSEIF(TYPE.LE.6.AND.
-
-     &           JDAHEP(2,JDAHEP(2,KP)).EQ.JP(I)) THEN
-
-                KP=IP
-
-              ELSE
-
-                HWCBVT = KP
-
-                RETURN
-
-              ENDIF
-
-            ELSE
-
-              HWCBVT = KP
-
-              RETURN
-
-            ENDIF
-
-          ENDIF
-
-          JP(I) =KP
-
-        ENDDO
-
-      ENDDO
-
-      HWCBVT = 0
-
- 999  END
-
-CDECK  ID>, HWCCCC.
-
-*CMZ :-
-
-*-- Author :    Peter Richardson
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWCCCC
-
-C-----------------------------------------------------------------------
-
-C  Subroutine to correct colour connections after the gluon splitting
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      INTEGER IHEP,STFSPT,LHEP,MHEP,RHEP
-
-      IF(IERROR.NE.0) RETURN
-
-C--Find the first particle in the event record with status 150
-
-      DO IHEP=1,NHEP
-
-        IF(ISTHEP(IHEP).GE.150.AND.ISTHEP(IHEP).LE.154) THEN
-
-          STFSPT = IHEP
-
-          GOTO 10
-
-        ENDIF
-
-      ENDDO
-
- 10   CONTINUE
-
-C--Now find any that are colour connected to earlier particles
-
-C--in the event record
-
-      DO IHEP=STFSPT,NHEP
-
-C--First the quarks and antidiquarks
-
-        IF(IDHW(IHEP).LT.6.OR.
-
-     &     (IDHW(IHEP).GE.115.AND.IDHW(IHEP).LE.120)) THEN
-
-          IF(JMOHEP(2,IHEP).LT.STFSPT) THEN
-
-            LHEP = IHEP
-
-            MHEP = JMOHEP(2,IHEP)
-
-            RHEP = MHEP
-
-            IF(MHEP.GT.6) RHEP = JDAHEP(1,MHEP)
-
-C--As from Rparity connect to particle not to antiparticle
-
-            IF(IDHW(MHEP).NE.13) THEN
-
-              JMOHEP(2,LHEP) = RHEP
-
-            ELSE
-
-              RHEP = RHEP+1
-
-              JMOHEP(2,LHEP) = RHEP
-
-            ENDIF
-
-          ENDIF
-
-        ENDIF
-
-C--Now the antiquarks
-
-        IF((IDHW(IHEP).GT.6.AND.IDHW(IHEP).LE.12).OR.
-
-     &     (IDHW(IHEP).GE.109.AND.IDHW(IHEP).LE.114)) THEN
-
-          IF(JDAHEP(2,IHEP).LT.STFSPT) THEN
-
-            LHEP = IHEP
-
-            MHEP = JDAHEP(2,IHEP)
-
-            RHEP = MHEP
-
-            IF(MHEP.GT.6) RHEP = JDAHEP(1,MHEP)
-
-C--As from Rparity connect to antiparticle not particle
-
-            IF(IDHW(MHEP).NE.13) THEN
-
-              JDAHEP(2,LHEP) = RHEP
-
-            ELSE
-
-              JDAHEP(2,LHEP) = RHEP
-
-            ENDIF
-
-          ENDIF
-
-        ENDIF
-
-      ENDDO
-
-      END
diff --git a/HERWIG/src/hwccut.f b/HERWIG/src/hwccut.f
deleted file mode 100644 (file)
index b25bfbd..0000000
+++ /dev/null
@@ -1,426 +0,0 @@
-
-CDECK  ID>, HWCCUT.
-
-*CMZ :-        -26/04/91  14.29.39  by  Federico Carminati
-
-*-- Author :    Bryan Webber
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWCCUT(JHEP,KHEP,PCL,BTCLUS,SPLIT)
-
-C-----------------------------------------------------------------------
-
-C     Cuts into 2 the cluster, momentum PCL, made of partons JHEP & KHEP
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      DOUBLE PRECISION HWREXQ,HWUPCM,HWR,HWVDOT,EMC,QM1,QM2,EMX,EMY,
-
-     & QM3,PXY,PCX,PCY,RCM,PCL(5),AX(5),PA(5),PB(5),PC(5),SKAPPA,DELTM,
-
-     & VSCA,VTMP(4),RKAPPA,VCLUS
-
-      INTEGER HWRINT,JHEP,KHEP,LHEP,MHEP,ID1,ID2,ID3,NTRY,NTRYMX,J,IB
-
-      LOGICAL BTCLUS,SPLIT
-
-      EXTERNAL HWREXQ,HWUPCM,HWR,HWVDOT,HWRINT
-
-      COMMON/HWCFRM/VCLUS(4,NMXHEP)
-
-      PARAMETER (SKAPPA=1.,NTRYMX=100)
-
-      IF (IERROR.NE.0) RETURN
-
-      EMC=PCL(5)
-
-      ID1=IDHW(JHEP)
-
-      ID2=IDHW(KHEP)
-
-      QM1=RMASS(ID1)
-
-      QM2=RMASS(ID2)
-
-      SPLIT=.FALSE.
-
-      NTRY=0
-
-C Decide if cluster contains a b-(anti)quark
-
-      IF (ID1.EQ.5.OR.ID1.EQ.11.OR.ID2.EQ.5.OR.ID2.EQ.11) THEN
-
-        IB=2
-
-      ELSE
-
-        IB=1
-
-      ENDIF
-
-      IF (BTCLUS) THEN
-
-C Split beam and target clusters as soft clusters
-
-C Both (remnant) children treated like soft clusters if IOPREM=0(1)
-
-  10    ID3=HWRINT(1,2)
-
-        QM3=RMASS(ID3)
-
-        IF (EMC.LE.QM1+QM2+2.*QM3) THEN
-
-          ID3=3-ID3
-
-          QM3=RMASS(ID3)
-
-          IF (EMC.LE.QM1+QM2+2.*QM3) RETURN
-
-        ENDIF
-
-        PXY=EMC-QM1-QM2-TWO*QM3
-
-        IF (ISTHEP(JHEP).EQ.153.OR.ISTHEP(JHEP).EQ.154.OR.
-
-     &      IOPREM.EQ.0) THEN
-
-          EMX=QM1+QM3+HWREXQ(BTCLM,PXY)
-
-        ELSE
-
-          EMX=QM1+QM3+PXY*HWR()**PSPLT(IB)
-
-        ENDIF
-
-        IF (ISTHEP(KHEP).EQ.153.OR.ISTHEP(KHEP).EQ.154.OR.
-
-     &      IOPREM.EQ.0) THEN
-
-          EMY=QM2+QM3+HWREXQ(BTCLM,PXY)
-
-        ELSE
-
-          EMY=QM2+QM3+PXY*HWR()**PSPLT(IB)
-
-        ENDIF
-
-        IF (EMX+EMY.GE.EMC) THEN
-
-          NTRY=NTRY+1
-
-          IF (NTRY.GT.NTRYMX) RETURN
-
-          GOTO 10
-
-        ENDIF
-
-        PCX=HWUPCM(EMX,QM1,QM3)
-
-        PCY=HWUPCM(EMY,QM2,QM3)
-
-      ELSE
-
-C Choose fragment masses for ordinary cluster
-
-        PXY=EMC-QM1-QM2
-
-  20    NTRY=NTRY+1
-
-        IF (NTRY.GT.NTRYMX) RETURN
-
-  30    EMX=QM1+PXY*HWR()**PSPLT(IB)
-
-        EMY=QM2+PXY*HWR()**PSPLT(IB)
-
-        IF (EMX+EMY.GE.EMC) GOTO 30
-
-C u,d,s pair production with weights QWT
-
-  40    ID3=HWRINT(1,3)
-
-        IF (QWT(ID3).LT.HWR()) GOTO 40
-
-        QM3=RMASS(ID3)
-
-        PCX=HWUPCM(EMX,QM1,QM3)
-
-        IF (PCX.LT.ZERO) GOTO 20
-
-        PCY=HWUPCM(EMY,QM2,QM3)
-
-        IF (PCY.LT.ZERO) GOTO 20
-
-        SPLIT=.TRUE.
-
-      ENDIF
-
-C Boost antiquark to CoM frame to find axis
-
-      CALL HWULOF(PCL,PHEP(1,KHEP),AX)
-
-      RCM=1./SQRT(HWVDOT(3,AX,AX))
-
-      CALL HWVSCA(3,RCM,AX,AX)
-
-C Construct new CoM momenta (collinear)
-
-      PXY=HWUPCM(EMC,EMX,EMY)
-
-      CALL HWVSCA(3,PXY,AX,PC)
-
-      PC(4)=SQRT(PXY**2+EMY**2)
-
-      PC(5)=EMY
-
-      CALL HWVSCA(3,PCY,AX,PA)
-
-      PA(4)=SQRT(PCY**2+QM2**2)
-
-      PA(5)=QM2
-
-      CALL HWULOB(PC,PA,PB)
-
-      CALL HWVDIF(4,PC,PB,PA)
-
-      PA(5)=QM3
-
-      LHEP=NHEP+1
-
-      MHEP=NHEP+2
-
-      CALL HWULOB(PCL,PB,PHEP(1,KHEP))
-
-      CALL HWULOB(PCL,PA,PHEP(1,MHEP))
-
-      CALL HWVSCA(3,-ONE,PC,PC)
-
-      PC(4)=EMC-PC(4)
-
-      PC(5)=EMX
-
-      CALL HWVSCA(3,PCX,AX,PA)
-
-      PA(4)=SQRT(PCX**2+QM3**2)
-
-      CALL HWULOB(PC,PA,PB)
-
-      CALL HWULOB(PCL,PB,PHEP(1,LHEP))
-
-      DO 50 J=1,4
-
-  50  PHEP(J,JHEP)=PCL(J)-PHEP(J,KHEP)-PHEP(J,LHEP)-PHEP(J,MHEP)
-
-      PHEP(5,JHEP)=QM1
-
-      CALL HWVEQU(4,VHEP(1,LHEP),VHEP(1,MHEP))
-
-C Construct new vertex positions
-
-      RKAPPA=GEV2MM/SKAPPA
-
-      CALL HWVSCA(3,RKAPPA,AX,AX)
-
-      DELTM=(EMX-EMY)*(EMX+EMY)/(TWO*EMC)
-
-      CALL HWVSCA(3,DELTM,AX,VTMP)
-
-      VTMP(4)=(HALF*EMC-PXY)*RKAPPA
-
-      CALL HWULB4(PCL,VTMP,VTMP)
-
-      CALL HWVSUM(4,VTMP,VCLUS(1,JHEP),VHEP(1,LHEP))
-
-      CALL HWVEQU(4,VHEP(1,LHEP),VHEP(1,MHEP))
-
-      VSCA=0.25*EMC+HALF*(PXY+DELTM)
-
-      CALL HWVSCA(3,VSCA,AX,VTMP)
-
-      VTMP(4)=(EMC-VSCA)*RKAPPA
-
-      CALL HWULB4(PCL,VTMP,VTMP)
-
-      CALL HWVSUM(4,VTMP,VCLUS(1,JHEP),VCLUS(1,MHEP))
-
-      VSCA=-0.25*EMC+HALF*(DELTM-PXY)
-
-      CALL HWVSCA(3,VSCA,AX,VTMP)
-
-      VTMP(4)=(EMC+VSCA)*RKAPPA
-
-      CALL HWULB4(PCL,VTMP,VTMP)
-
-      CALL HWVSUM(4,VTMP,VCLUS(1,JHEP),VCLUS(1,JHEP))
-
-C (Re-)label quarks
-
-      IDHW(LHEP)=ID3+6
-
-      IDHW(MHEP)=ID3
-
-      IDHEP(MHEP)= IDPDG(ID3)
-
-      IDHEP(LHEP)=-IDPDG(ID3)
-
-      ISTHEP(LHEP)=151
-
-      ISTHEP(MHEP)=151
-
-      JMOHEP(2,JHEP)=LHEP
-
-      JDAHEP(2,KHEP)=MHEP
-
-      JMOHEP(1,LHEP)=JMOHEP(1,KHEP)
-
-      JMOHEP(2,LHEP)=MHEP
-
-      JDAHEP(1,LHEP)=0
-
-      JDAHEP(2,LHEP)=JHEP
-
-      JMOHEP(1,MHEP)=JMOHEP(1,JHEP)
-
-      JMOHEP(2,MHEP)=KHEP
-
-      JDAHEP(1,MHEP)=0
-
-      JDAHEP(2,MHEP)=LHEP
-
-      NHEP=NHEP+2
-
-  999 END
-
-CDECK  ID>, HWCDEC.
-
-*CMZ :-        -26/04/91  10.18.56  by  Bryan Webber
-
-*-- Author :    Bryan Webber
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWCDEC
-
-C-----------------------------------------------------------------------
-
-C     DECAYS CLUSTERS INTO PRIMARY HADRONS
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      INTEGER JCL,KCL,IP,JP,KP,IST,ID1,ID2,ID3
-
-      IF (IERROR.NE.0) RETURN
-
-      IF (IPROC/1000.EQ.9.OR.IPROC/1000.EQ.5) THEN
-
-C---RELABEL CLUSTER CONNECTED TO REMNANT IN DIS
-
-        DO 10 JCL=2,NHEP
-
-        IF (ISTHEP(JCL).EQ.164) GOTO 20
-
-        IF (ISTHEP(JCL).EQ.165) THEN
-
-          IP=JMOHEP(1,JCL)
-
-          JP=JMOHEP(2,JCL)
-
-          KP=IP
-
-          IF (ISTHEP(IP).EQ.162) THEN
-
-            KP=JP
-
-            JP=IP
-
-          ENDIF
-
-          IF (JMOHEP(2,KP).NE.JP) THEN
-
-            IP=JMOHEP(2,KP)
-
-          ELSE
-
-            IP=JDAHEP(2,KP)
-
-          ENDIF
-
-          KCL=JDAHEP(1,IP)
-
-          IF (ISTHEP(KCL)/10.NE.16) CALL HWWARN('HWCDEC',100,*999)
-
-          ISTHEP(KCL)=164
-
-          GOTO 20
-
-        ENDIF
-
-   10   CONTINUE
-
-      ENDIF
-
-   20 CONTINUE
-
-      DO 30 JCL=1,NHEP
-
-      IST=ISTHEP(JCL)
-
-      IF (IST.GT.162.AND.IST.LT.166) THEN
-
-C---DON'T HADRONIZE BEAM/TARGET CLUSTERS
-
-        IF (IST.EQ.163.OR..NOT.GENSOF) THEN
-
-C---SET UP FLAVOURS FOR CLUSTER DECAY
-
-          CALL HWCFLA(IDHW(JMOHEP(1,JCL)),IDHW(JMOHEP(2,JCL)),ID1,ID3)
-
-          CALL HWCHAD(JCL,ID1,ID3,ID2)
-
-        ENDIF
-
-      ENDIF
-
-   30 CONTINUE
-
-      ISTAT=50
-
-  999 END
-
-CDECK  ID>, HWCFLA.
-
-*CMZ :-        -26/04/91  10.18.56  by  Bryan Webber
-
-*-- Author :    Bryan Webber
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWCFLA(JD1,JD2,ID1,ID2)
-
-C-----------------------------------------------------------------------
-
-C     SETS UP FLAVOURS FOR CLUSTER DECAY
-
-C-----------------------------------------------------------------------
-
-      INTEGER JD1,JD2,ID1,ID2,JD,JDEC(12)
-
-      DATA JDEC/1,2,3,10,11,12,4,5,6,7,8,9/
-
-      JD=JD1
-
-      IF (JD.GT.12) JD=JD-108
-
-      ID1=JDEC(JD)
-
-      JD=JD2
-
-      IF (JD.GT.12) JD=JD-96
-
-      ID2=JDEC(JD-6)
-
-      END
diff --git a/HERWIG/src/hwcfor.f b/HERWIG/src/hwcfor.f
deleted file mode 100644 (file)
index c1395e2..0000000
+++ /dev/null
@@ -1,2078 +0,0 @@
-
-CDECK  ID>, HWCFOR.
-
-*CMZ :-        -26/04/91  14.15.56  by  Federico Carminati
-
-*-- Author :    Bryan Webber
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWCFOR
-
-C-----------------------------------------------------------------------
-
-C     Converts colour-connected quark-antiquark pairs into clusters
-
-C     Modified by IGK to include BRW's colour rearrangement and
-
-C     MHS's cluster vertices
-
-C     MODIFIED 16/10/97 BY BRW FOR SUSY PROCESSES
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      DOUBLE PRECISION HWULDO,HWVDOT,HWR,HWUPCM,DCL0,DCL(4),DCL1,
-
-     & DFAC,DISP1(4),DISP2(4),DMAX,PCL(5),DOT1,DOT2,FAC,VCLUS,SCA1,SCA2,
-
-     & EM0,EM1,EM2,PC0,PC1
-
-      INTEGER HWRINT,MAP(120),IBHEP,IBCL,JBHEP,JHEP,
-
-     & KHEP,LHEP,LCL,IHEP,MCL,I,ISTJ,ISTK,JCL,ID1,ID3,L
-
-      LOGICAL HWRLOG,SPLIT
-
-      EXTERNAL HWULDO,HWVDOT,HWR,HWUPCM,HWRINT
-
-      COMMON/HWCFRM/VCLUS(4,NMXHEP)
-
-      DATA MAP/1,2,3,4,5,6,1,2,3,4,5,6,96*0,7,8,9,10,11,12,7,8,9,10,11,
-
-     & 12/
-
-      IF (IERROR.NE.0) RETURN
-
-C Split gluons
-
-      CALL HWCGSP
-
-C Find colour partners after baryon number violating event
-
-      IF (HVFCEN) THEN
-
-        IF(RPARTY) THEN
-
-          CALL HVCBVI
-
-        ELSE
-
-          CALL HWCBVI
-
-        ENDIF
-
-      ENDIF
-
-      IF (IERROR.NE.0) RETURN
-
-C Look for partons to cluster
-
-      DO 10 IBHEP=1,NHEP
-
-  10  IF (ISTHEP(IBHEP).GE.150.AND.ISTHEP(IBHEP).LE.154) GOTO 20
-
-      IBCL=1
-
-      GOTO 130
-
-  20  CONTINUE
-
-C--Final check for colour disconnections
-
-      DO 25 JHEP=IBHEP,NHEP
-
-        IF (ISTHEP(JHEP).GE.150.AND.ISTHEP(JHEP).LE.154.AND.
-
-     &      QORQQB(IDHW(JHEP))) THEN
-
-          KHEP=JMOHEP(2,JHEP)
-
-C BRW FIX 13/03/99
-
-          IF (KHEP.EQ.0.OR..NOT.(
-
-     &      ISTHEP(KHEP).GE.150.AND.ISTHEP(KHEP).LE.154.AND.
-
-     &      QBORQQ(IDHW(KHEP)))) THEN
-
-            DO KHEP=IBHEP,NHEP
-
-              IF (ISTHEP(KHEP).GE.150.AND.ISTHEP(KHEP).LE.154
-
-     &        .AND.QBORQQ(IDHW(KHEP))) THEN
-
-                LHEP=JDAHEP(2,KHEP)
-
-                IF (LHEP.EQ.0.OR..NOT.(
-
-     &          ISTHEP(LHEP).GE.150.AND.ISTHEP(LHEP).LE.154.AND.
-
-     &          QORQQB(IDHW(LHEP)))) THEN
-
-                  JMOHEP(2,JHEP)=KHEP
-
-                  JDAHEP(2,KHEP)=JHEP
-
-                  GOTO 25
-
-                ENDIF
-
-              ENDIF
-
-            ENDDO
-
-C END FIX
-
-            CALL HWWARN('HWCFOR',100,*999)
-
-          ENDIF
-
-        ENDIF
-
-  25  CONTINUE
-
-      IF (CLRECO) THEN
-
-C Allow for colour rearrangement of primary clusters
-
-        NRECO=0
-
-C Randomize starting point
-
-        JBHEP=HWRINT(IBHEP,NHEP)
-
-        JHEP=JBHEP
-
-  30    JHEP=JHEP+1
-
-        IF (JHEP.GT.NHEP) JHEP=IBHEP
-
-        IF (ISTHEP(JHEP).GE.150.AND.ISTHEP(JHEP).LE.154.AND.
-
-     &      QORQQB(IDHW(JHEP))) THEN
-
-C Find colour connected antiquark or diquark
-
-          KHEP=JMOHEP(2,JHEP)
-
-C Find partner antiquark or diquark
-
-          LHEP=JDAHEP(2,JHEP)
-
-C Find closest antiquark or diquark
-
-          DCL0=1.D15
-
-          LCL=0
-
-          DO 40 IHEP=IBHEP,NHEP
-
-          IF (ISTHEP(IHEP).GE.150.AND.ISTHEP(IHEP).LE.154.AND.
-
-     &        QBORQQ(IDHW(IHEP))) THEN
-
-C Check whether already reconnected
-
-            IF (JDAHEP(2,IHEP).GT.0.AND.IHEP.NE.LHEP) THEN
-
-              CALL HWVDIF(4,VHEP(1,IHEP),VHEP(1,JHEP),DCL)
-
-              DCL1=ABS(HWULDO(DCL,DCL))
-
-              IF (DCL1.LT.DCL0) THEN
-
-                DCL0=DCL1
-
-                LCL=IHEP
-
-              ENDIF
-
-            ENDIF
-
-          ENDIF
-
-  40      CONTINUE
-
-          IF (LCL.NE.0.AND.LCL.NE.KHEP) THEN
-
-            MCL=JDAHEP(2,LCL)
-
-            IF (JDAHEP(2,MCL).NE.KHEP) THEN
-
-C Pairwise reconnection is possible
-
-              CALL HWVDIF(4,VHEP(1,KHEP),VHEP(1,MCL ),DCL)
-
-              DCL0=DCL0+ABS(HWULDO(DCL,DCL))
-
-              CALL HWVDIF(4,VHEP(1,JHEP),VHEP(1,KHEP),DCL)
-
-              DCL1=ABS(HWULDO(DCL,DCL))
-
-              CALL HWVDIF(4,VHEP(1,LCL ),VHEP(1,MCL ),DCL)
-
-              DCL1=DCL1+ABS(HWULDO(DCL,DCL))
-
-              IF (DCL0.LT.DCL1.AND.HWRLOG(PRECO)) THEN
-
-C Reconnection occurs
-
-                JMOHEP(2,JHEP)= LCL
-
-                JDAHEP(2,LCL )=-JHEP
-
-                JMOHEP(2,MCL) = KHEP
-
-                JDAHEP(2,KHEP)=-MCL
-
-                NRECO=NRECO+1
-
-              ENDIF
-
-            ENDIF
-
-          ENDIF
-
-        ENDIF
-
-        IF (JHEP.NE.JBHEP) GOTO 30
-
-        IF (NRECO.NE.0) THEN
-
-          DO 50 IHEP=IBHEP,NHEP
-
-  50      JDAHEP(2,IHEP)=ABS(JDAHEP(2,IHEP))
-
-        ENDIF
-
-      ENDIF
-
-C Find (adjusted) cluster positions using MHS prescription
-
-      DFAC=10
-
-      DMAX=1D-10
-
-      DO 70 JHEP=IBHEP,NHEP
-
-      IF (ISTHEP(JHEP).GE.150.AND.ISTHEP(JHEP).LE.154.AND.
-
-     &    QORQQB(IDHW(JHEP))) THEN
-
-        KHEP=JMOHEP(2,JHEP)
-
-        CALL HWUDKL(IDHW(JHEP),PHEP(1,JHEP),DISP1)
-
-        CALL HWVSCA(4,DFAC,DISP1,DISP1)
-
-        CALL HWUDKL(IDHW(KHEP),PHEP(1,KHEP),DISP2)
-
-        CALL HWVSCA(4,DFAC,DISP2,DISP2)
-
-C Rescale the lengths of DISP1,DISP2 if too long
-
-        DOT1=HWVDOT(3,DISP1,DISP1)
-
-        DOT2=HWVDOT(3,DISP2,DISP2)
-
-        IF (MAX(DOT1,DOT2).GT.DMAX**2) THEN
-
-          CALL HWVSCA(4,DMAX/SQRT(DOT1),DISP1,DISP1)
-
-          CALL HWVSCA(4,DMAX/SQRT(DOT2),DISP2,DISP2)
-
-        ENDIF
-
-        CALL HWVSUM(4,PHEP(1,JHEP),PHEP(1,KHEP),PCL)
-
-        DOT1=HWVDOT(3,DISP1,PCL)
-
-        DOT2=HWVDOT(3,DISP2,PCL)
-
-C If PCL > 90^o from either quark, use a vector which isn't
-
-        IF (DOT1.LE.ZERO.OR. DOT2.LE.ZERO) THEN
-
-          CALL HWVSUM(4,DISP1,DISP2,PCL)
-
-          DOT1=HWVDOT(3,DISP1,PCL)
-
-          DOT2=HWVDOT(3,DISP2,PCL)
-
-        ENDIF
-
-C If vectors are exactly opposite each other this method cannot work
-
-        IF (DOT1.EQ.ZERO.OR.DOT2.EQ.ZERO) THEN
-
-C So use midpoint of quark constituents
-
-          CALL HWVSUM(4,VHEP(1,JHEP),VHEP(1,KHEP),VCLUS(1,JHEP))
-
-          CALL HWVSCA(4,HALF,VCLUS(1,JHEP),VCLUS(1,JHEP))
-
-          GOTO 70
-
-        ENDIF
-
-C Rescale DISP1 or DISP2 to give equal components in the PCL direction
-
-        FAC=DOT1/DOT2
-
-        IF (FAC.GT.ONE) THEN
-
-          CALL HWVSCA(4,    FAC,DISP2,DISP2)
-
-          DOT2=DOT1
-
-        ELSE
-
-          CALL HWVSCA(4,ONE/FAC,DISP1,DISP1)
-
-          DOT1=DOT2
-
-        ENDIF
-
-C Shift VHEP(1,JHEP) or VHEP(1,KHEP) s.t. their line is perp to PCL
-
-        FAC=(HWVDOT(3,PCL,VHEP(1,KHEP))
-
-     &      -HWVDOT(3,PCL,VHEP(1,JHEP)))/DOT1
-
-        SCA1=MAX(ONE,ONE+FAC)
-
-        SCA2=MAX(ONE,ONE-FAC)
-
-        DO 60 I=1,4
-
-  60    VCLUS(I,JHEP)=.5*(VHEP(I,JHEP)+VHEP(I,KHEP)
-
-     &                   +SCA1*DISP1(I)+SCA2*DISP2(I))
-
-      ENDIF
-
-  70  CONTINUE
-
-C First chop up beam/target clusters
-
-      DO 80 JHEP=IBHEP,NHEP
-
-      KHEP=JMOHEP(2,JHEP)
-
-      ISTJ=ISTHEP(JHEP)
-
-      ISTK=ISTHEP(KHEP)
-
-C--PR MOD here 8/7/99
-
-      IF (QORQQB(IDHW(JHEP)).AND.
-
-     &   (((ISTJ.EQ.153.OR.ISTJ.EQ.154).AND.ISTK.NE.151.AND.ISTK.NE.0)
-
-     &   .OR.((ISTK.EQ.153.OR.ISTK.EQ.154).
-
-     &   AND.ISTJ.NE.151.AND.ISTJ.NE.0))) THEN
-
-C--end
-
-        CALL HWVSUM(4,PHEP(1,JHEP),PHEP(1,KHEP),PCL)
-
-        CALL HWUMAS(PCL)
-
-        CALL HWCCUT(JHEP,KHEP,PCL,.TRUE.,SPLIT)
-
-      ENDIF
-
-  80  CONTINUE
-
-C Second chop up massive pairs
-
-      DO 100 JHEP=IBHEP,NMXHEP
-
-      IF (JHEP.GT.NHEP) GOTO 110
-
-      IF (ISTHEP(JHEP).GE.150.AND.ISTHEP(JHEP).LE.154.AND.
-
-     &    QORQQB(IDHW(JHEP))) THEN
-
-  90    KHEP=JMOHEP(2,JHEP)
-
-        CALL HWVSUM(4,PHEP(1,JHEP),PHEP(1,KHEP),PCL)
-
-        CALL HWUMAS(PCL)
-
-        IF (PCL(5).GT.CTHRPW(MAP(IDHW(JHEP)),MAP(IDHW(KHEP)))) THEN
-
-          CALL HWCCUT(JHEP,KHEP,PCL,.FALSE.,SPLIT)
-
-          IF (SPLIT) GOTO 90
-
-        ENDIF
-
-      ENDIF
-
-  100 CONTINUE
-
-C Third create clusters and store production vertex
-
-  110 IBCL=NHEP+1
-
-      JCL=NHEP
-
-      DO 120 JHEP=IBHEP,NHEP
-
-      IF (ISTHEP(JHEP).GE.150.AND.ISTHEP(JHEP).LE.154.AND.
-
-     &    QORQQB(IDHW(JHEP))) THEN
-
-        JCL=JCL+1
-
-        IF(JCL.GT.NMXHEP) CALL HWWARN('HWCFOR',105,*999)
-
-        IDHW(JCL)=19
-
-        IDHEP(JCL)=91
-
-        KHEP=JMOHEP(2,JHEP)
-
-        IF (KHEP.EQ.0.OR..NOT.(
-
-     &    ISTHEP(KHEP).GE.150.AND.ISTHEP(KHEP).LE.154.AND.
-
-     &    QBORQQ(IDHW(KHEP)))) CALL HWWARN('HWCFOR',104,*999)
-
-        CALL HWVSUM(4,PHEP(1,JHEP),PHEP(1,KHEP),PHEP(1,JCL))
-
-        CALL HWUMAS(PHEP(1,JCL))
-
-        IF (ISTHEP(JHEP).EQ.153.OR.ISTHEP(KHEP).EQ.153) THEN
-
-          ISTHEP(JCL)=164
-
-        ELSEIF (ISTHEP(JHEP).EQ.154.OR.ISTHEP(KHEP).EQ.154) THEN
-
-          ISTHEP(JCL)=165
-
-        ELSE
-
-          ISTHEP(JCL)=163
-
-        ENDIF
-
-        JMOHEP(1,JCL)=JHEP
-
-        JMOHEP(2,JCL)=KHEP
-
-        JDAHEP(1,JCL)=0
-
-        JDAHEP(2,JCL)=0
-
-        JDAHEP(1,JHEP)=JCL
-
-        JDAHEP(1,KHEP)=JCL
-
-        ISTHEP(JHEP)=ISTHEP(JHEP)+8
-
-        ISTHEP(KHEP)=ISTHEP(KHEP)+8
-
-        CALL HWVEQU(4,VCLUS(1,JHEP),VHEP(1,JCL))
-
-      ENDIF
-
-  120 CONTINUE
-
-      NHEP=JCL
-
-C Fix up momenta for single-hadron clusters
-
-  130 DO 150 JCL=IBCL,NHEP
-
-C Don't hadronize beam/target clusters
-
-      IF (ISTHEP(JCL).LT.163.OR.ISTHEP(JCL).GT.165) GOTO 150
-
-      IF (ISTHEP(JCL).NE.163.AND.GENSOF) GOTO 150
-
-C Set up flavours for cluster decay
-
-      CALL HWCFLA(IDHW(JMOHEP(1,JCL)),IDHW(JMOHEP(2,JCL)),ID1,ID3)
-
-      EM0=PHEP(5,JCL)
-
-      IF ((B1LIM.EQ.ZERO).OR.(ID1.NE.11.AND.ID3.NE.11)) THEN
-
-        IF (EM0.GT.RMIN(ID1,2)+RMIN(2,ID3)) GOTO 150
-
-      ELSE
-
-C Special for b clusters: allow 1-hadron decay above threshold
-
-        IF (B1LIM*HWR().LT.EM0/(RMIN(ID1,2)+RMIN(2,ID3))-1.)
-
-     &   GOTO 150
-
-      ENDIF
-
-      EM1=RMIN(ID1,ID3)
-
-      IF (ABS(EM0-EM1).LT.1.D-5) GOTO 150
-
-C Decide to go backward or forward to transfer 4-momentum
-
-      L=1-TWO*INT(HALF+HWR())
-
-      MCL=NHEP-IBCL+1
-
-      LCL=JCL
-
-      DO 140 I=1,MCL
-
-      LCL=LCL+L
-
-      IF (LCL.LT.IBCL) LCL=LCL+MCL
-
-      IF (LCL.GT.NHEP) LCL=LCL-MCL
-
-      IF (LCL.EQ.JCL) THEN
-
-        IF (EM0.GE.EM1+RMIN(1,1)) GOTO 150
-
-        CALL HWWARN('HWCFOR',101,*999)
-
-      ENDIF
-
-      IF (ISTHEP(LCL).LT.163.OR.ISTHEP(LCL).GT.165) GOTO 140
-
-C Rescale momenta in 2-cluster CoM
-
-      CALL HWVSUM(4,PHEP(1,JCL),PHEP(1,LCL),PCL)
-
-      CALL HWUMAS(PCL)
-
-      EM2=PHEP(5,LCL)
-
-      PC0=HWUPCM(PCL(5),EM0,EM2)
-
-      PC1=HWUPCM(PCL(5),EM1,EM2)
-
-      IF (PC1.LT.ZERO) THEN
-
-C Need to rescale other mass as well
-
-        CALL HWCFLA(IDHW(JMOHEP(1,LCL)),IDHW(JMOHEP(2,LCL)),ID1,ID3)
-
-        EM2=RMIN(ID1,ID3)
-
-        PC1=HWUPCM(PCL(5),EM1,EM2)
-
-        IF (PC1.LT.ZERO) GOTO 140
-
-        PHEP(5,LCL)=EM2
-
-      ENDIF
-
-      IF (PC0.GT.ZERO) THEN
-
-        PC0=PC1/PC0
-
-        CALL HWULOF(PCL,PHEP(1,JCL),PHEP(1,JCL))
-
-        CALL HWVSCA(3,PC0,PHEP(1,JCL),PHEP(1,JCL))
-
-        PHEP(4,JCL)=SQRT(PC1**2+EM1**2)
-
-        PHEP(5,JCL)=EM1
-
-        CALL HWULOB(PCL,PHEP(1,JCL),PHEP(1,JCL))
-
-        CALL HWVDIF(4,PCL,PHEP(1,JCL),PHEP(1,LCL))
-
-        GOTO 150
-
-      ELSEIF (PC0.EQ.ZERO) THEN
-
-        PHEP(5,JCL)=EM1
-
-        CALL HWDTWO(PCL,PHEP(1,JCL),PHEP(1,LCL),PC1,TWO,.TRUE.)
-
-        GOTO 150
-
-      ELSE
-
-        CALL HWWARN('HWCFOR',102,*999)
-
-      ENDIF
-
-  140 CONTINUE
-
-      CALL HWWARN('HWCFOR',103,*999)
-
-  150 CONTINUE
-
-      ISTAT=60
-
-C Non-partons labelled as partons (ie photons) should get copied
-
-      DO 160 IHEP=1,NHEP
-
-      IF (ISTHEP(IHEP).EQ.150) THEN
-
-        NHEP=NHEP+1
-
-        JDAHEP(1,IHEP)=NHEP
-
-        ISTHEP(IHEP)=157
-
-        ISTHEP(NHEP)=190
-
-        IDHW(NHEP)=IDHW(IHEP)
-
-        IDHEP(NHEP)=IDPDG(IDHW(IHEP))
-
-        CALL HWVEQU(5,PHEP(1,IHEP),PHEP(1,NHEP))
-
-        CALL HWVEQU(4,VHEP(1,IHEP),VHEP(1,NHEP))
-
-        JMOHEP(1,NHEP)=IHEP
-
-        JMOHEP(2,NHEP)=JMOHEP(1,IHEP)
-
-        JDAHEP(1,NHEP)=0
-
-        JDAHEP(2,NHEP)=0
-
-      ENDIF
-
-  160 CONTINUE
-
-  999 END
-
-CDECK  ID>, HWCGSP.
-
-*CMZ :-        -13/07/92  20.15.54  by  Mike Seymour
-
-*-- Author :    Bryan Webber
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWCGSP
-
-C-----------------------------------------------------------------------
-
-C     SPLITS ANY TIMELIKE GLUONS REMAINING AFTER PERTURBATIVE
-
-C     BRANCHING INTO LIGHT (I.E. U OR D) Q-QBAR PAIRS
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      DOUBLE PRECISION HWR,PF
-
-      INTEGER HWRINT,IHEP,JHEP,KHEP,LHEP,MHEP,ID,J,IST
-
-      EXTERNAL HWR,HWRINT
-
-      IF (NGSPL.EQ.0) CALL HWWARN('HWCGSP',400,*999)
-
-      LHEP=NHEP-1
-
-      MHEP=NHEP
-
-      DO 100 IHEP=1,NHEP
-
-      IF (ISTHEP(IHEP).GE.147.AND.ISTHEP(IHEP).LE.149) THEN
-
-        JHEP=JMOHEP(2,IHEP)
-
-C BRW FIX 12/03/99
-
-        IF (JHEP.LE.0) THEN
-
-          KHEP=0
-
-          DO JHEP=1,NHEP
-
-            IF (ISTHEP(JHEP).GE.147.AND.ISTHEP(JHEP).LE.149
-
-     &      .AND.JDAHEP(2,JHEP).LE.0) THEN
-
-              KHEP=KHEP+1
-
-              JMOHEP(2,IHEP)=JHEP
-
-              JDAHEP(2,JHEP)=IHEP
-
-            ENDIF
-
-          ENDDO
-
-          IF (KHEP.EQ.0) CALL HWWARN('HWCGSP',102,*999)
-
-          IF (KHEP.NE.1) CALL HWWARN('HWCGSP',103,*999)
-
-        ENDIF
-
-C END FIX
-
-C---CHECK FOR DECAYED HEAVY ANTIQUARKS
-
-        IF (ISTHEP(JHEP).EQ.155) THEN
-
-          JHEP=JDAHEP(1,JDAHEP(2,JHEP))
-
-          DO 10 J=JDAHEP(1,JHEP),JDAHEP(2,JHEP)
-
-  10      IF (ISTHEP(J).EQ.149.AND.JDAHEP(2,J).EQ.0) GOTO 20
-
-          CALL HWWARN('HWCGSP',100,*999)
-
-  20      JHEP=J
-
-        ENDIF
-
-        KHEP=JDAHEP(2,IHEP)
-
-C BRW FIX 12/03/99
-
-        IF (KHEP.LE.0) THEN
-
-          KHEP=0
-
-          DO JHEP=1,NHEP
-
-            IF (ISTHEP(JHEP).GE.147.AND.ISTHEP(JHEP).LE.149
-
-     &      .AND.JMOHEP(2,JHEP).LE.0) THEN
-
-              KHEP=KHEP+1
-
-              JDAHEP(2,IHEP)=JHEP
-
-              JMOHEP(2,JHEP)=IHEP
-
-            ENDIF
-
-          ENDDO
-
-          IF (KHEP.EQ.0) CALL HWWARN('HWCGSP',104,*999)
-
-          IF (KHEP.NE.1) CALL HWWARN('HWCGSP',105,*999)
-
-          KHEP=JDAHEP(2,IHEP)
-
-        ENDIF
-
-C END FIX
-
-C---CHECK FOR DECAYED HEAVY QUARKS
-
-        IF (ISTHEP(KHEP).EQ.155)  CALL HWWARN('HWCGSP',101,*999)
-
-        IF (IDHW(IHEP).EQ.13) THEN
-
-C---SPLIT A GLUON
-
-          LHEP=LHEP+2
-
-          MHEP=MHEP+2
-
-          IF(MHEP.GT.NMXHEP) CALL HWWARN('HWCGSP',106,*999)
-
-  30      ID=HWRINT(1,NGSPL)
-
-          IF (PGSPL(ID).LT.PGSMX*HWR()) GOTO 30
-
-          PHEP(5,LHEP)=RMASS(ID)
-
-          PHEP(5,MHEP)=RMASS(ID)
-
-C---ASSUME ISOTROPIC ANGULAR DISTRIBUTION
-
-          IF (PHEP(5,IHEP).GT.PHEP(5,LHEP)+PHEP(5,MHEP)) THEN
-
-            CALL HWDTWO(PHEP(1,IHEP),PHEP(1,LHEP),
-
-     &                  PHEP(1,MHEP),PGSPL(ID),TWO,.TRUE.)
-
-          ELSE
-
-            PF=HWR()
-
-            CALL HWVSCA(4,PF,PHEP(1,IHEP),PHEP(1,LHEP))
-
-            CALL HWVDIF(4,PHEP(1,IHEP),PHEP(1,LHEP),PHEP(1,MHEP))
-
-            PHEP(5,LHEP)=PF*PHEP(5,IHEP)
-
-            PHEP(5,MHEP)=PHEP(5,IHEP)-PHEP(5,LHEP)
-
-          ENDIF
-
-          CALL HWUDKL(13,PHEP(1,IHEP),VHEP(1,LHEP))
-
-          CALL HWVSUM(4,VHEP(1,IHEP),VHEP(1,LHEP),VHEP(1,LHEP))
-
-          CALL HWVEQU(4,VHEP(1,LHEP),VHEP(1,MHEP))
-
-          IDHW(LHEP)=ID+6
-
-          IDHW(MHEP)=ID
-
-          IDHEP(MHEP)= IDPDG(ID)
-
-          IDHEP(LHEP)=-IDPDG(ID)
-
-          ISTHEP(IHEP)=2
-
-          ISTHEP(LHEP)=150
-
-          ISTHEP(MHEP)=150
-
-C---NEW COLOUR CONNECTIONS
-
-          IF(RPARTY.OR.JMOHEP(2,KHEP).EQ.IHEP) JMOHEP(2,KHEP)=LHEP
-
-          IF(RPARTY.OR.JDAHEP(2,JHEP).EQ.IHEP) JDAHEP(2,JHEP)=MHEP
-
-          JMOHEP(1,LHEP)=JMOHEP(1,IHEP)
-
-          JMOHEP(2,LHEP)=MHEP
-
-          JMOHEP(1,MHEP)=JMOHEP(1,IHEP)
-
-          JMOHEP(2,MHEP)=JHEP
-
-          JDAHEP(1,LHEP)=0
-
-          JDAHEP(2,LHEP)=KHEP
-
-          JDAHEP(1,MHEP)=0
-
-          JDAHEP(2,MHEP)=LHEP
-
-          JDAHEP(1,IHEP)=LHEP
-
-          JDAHEP(2,IHEP)=MHEP
-
-        ELSE
-
-C---COPY A NON-GLUON
-
-          LHEP=LHEP+1
-
-          MHEP=MHEP+1
-
-          IF(MHEP.GT.NMXHEP) CALL HWWARN('HWCGSP',107,*999)
-
-          CALL HWVEQU(5,PHEP(1,IHEP),PHEP(1,MHEP))
-
-          CALL HWVEQU(4,VHEP(1,IHEP),VHEP(1,MHEP))
-
-          IDHW(MHEP)=IDHW(IHEP)
-
-          IDHEP(MHEP)=IDHEP(IHEP)
-
-          IST=ISTHEP(IHEP)
-
-          ISTHEP(IHEP)=2
-
-          IF (IST.EQ.149) THEN
-
-            ISTHEP(MHEP)=150
-
-          ELSE
-
-            ISTHEP(MHEP)=IST+6
-
-          ENDIF
-
-C---NEW COLOUR CONNECTIONS
-
-          IF(RPARTY.OR.JMOHEP(2,KHEP).EQ.IHEP)
-
-     &      JMOHEP(2,KHEP)=MHEP
-
-          IF(RPARTY.OR.(JHEP.NE.IHEP.AND.JDAHEP(2,JHEP).EQ.IHEP))
-
-     &      JDAHEP(2,JHEP)=MHEP
-
-          JMOHEP(1,MHEP)=JMOHEP(1,IHEP)
-
-          JMOHEP(2,MHEP)=JMOHEP(2,IHEP)
-
-          JDAHEP(1,MHEP)=0
-
-          JDAHEP(2,MHEP)=JDAHEP(2,IHEP)
-
-          JDAHEP(1,IHEP)=MHEP
-
-        ENDIF
-
-      ENDIF
-
-  100 CONTINUE
-
-      NHEP=MHEP
-
-  999 END
-
-CDECK  ID>, HWCHAD.
-
-*CMZ :-        -26/04/91  14.00.57  by  Federico Carminati
-
-*-- Author :    Bryan Webber
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWCHAD(JCL,ID1,ID3,ID2)
-
-C-----------------------------------------------------------------------
-
-C     HADRONIZES CLUSTER JCL, CONSISTING OF PARTONS ID1,ID3
-
-C     ID2 RETURNS PARTON-ANTIPARTON PAIR CREATED
-
-C     (IN SPECIAL CLUSTER CODE - SEE HWCFLA)
-
-C
-
-C MODIFIED 15/11/99 TO SMEAR POSITIONS OF HADRONS BY 1/(CLUSTER MASS)
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      DOUBLE PRECISION HWR,HWRGAU,HWVDOT,EM0,EM1,EM2,EMADU,EMSQ,
-
-     & PCMAX,PCM,PTEST,PCQK,PP(5),EMLOW,RMAT(3,3),CT,ST,CX,SX,HPSMR
-
-      INTEGER HWRINT,JCL,ID1,ID2,ID3,ID,IR1,IR2,NTRY,IDMIN,IMAX,I,MHEP,
-
-     & IM,JM,KM,IB
-
-      LOGICAL DIQK
-
-      EXTERNAL HWR,HWRINT
-
-      DIQK(ID)=ID.GT.3.AND.ID.LT.10
-
-      IF (IERROR.NE.0) RETURN
-
-      ID2=0
-
-      EM0=PHEP(5,JCL)
-
-      IR1=NCLDK(LOCN(ID1,ID3))
-
-      EM1=RMIN(ID1,ID3)
-
-      IF (ABS(EM0-EM1).LT.0.001) THEN
-
-C---SINGLE-HADRON CLUSTER
-
-        NHEP=NHEP+1
-
-        IF (NHEP.GT.NMXHEP) CALL HWWARN('HWCHAD',100,*999)
-
-        IDHW(NHEP)=IR1
-
-        IDHEP(NHEP)=IDPDG(IR1)
-
-        ISTHEP(NHEP)=191
-
-        JDAHEP(1,JCL)=NHEP
-
-        JDAHEP(2,JCL)=NHEP
-
-        CALL HWVEQU(5,PHEP(1,JCL),PHEP(1,NHEP))
-
-        CALL HWVSUM(4,VHEP(1,JCL),VTXPIP,VHEP(1,NHEP))
-
-      ELSE
-
-        NTRY=0
-
-        IDMIN=1
-
-        EMLOW=RMIN(ID1,1)+RMIN(1,ID3)
-
-        EMADU=RMIN(ID1,2)+RMIN(2,ID3)
-
-        IF (EMADU.LT.EMLOW) THEN
-
-          IDMIN=2
-
-          EMLOW=EMADU
-
-        ENDIF
-
-        EMSQ=EM0**2
-
-        PCMAX=EMSQ-EMLOW**2
-
-        IF (PCMAX.GE.ZERO) THEN
-
-C---SET UP TWO QUARK-ANTIQUARK PAIRS OR A
-
-C   QUARK-DIQUARK AND AN ANTIDIQUARK-ANTIQUARK
-
-          PCMAX=PCMAX*(EMSQ-(RMIN(ID1,IDMIN)-RMIN(IDMIN,ID3))**2)
-
-          IMAX=12
-
-          IF (DIQK(ID1).OR.DIQK(ID3)) IMAX=3
-
-          DO 10 I=3,IMAX
-
-          IF (EM0.LT.RMIN(ID1,I)+RMIN(I,ID3)) GOTO 20
-
-  10      CONTINUE
-
-          I=IMAX+1
-
-  20      ID2=HWRINT(1,I-1)
-
-          IF (PWT(ID2).NE.ONE) THEN
-
-            IF (PWT(ID2).LT.HWR()) GOTO 20
-
-          ENDIF
-
-C---PICK TWO PARTICLES WITH THESE QUANTUM NUMBERS
-
-          NTRY=NTRY+1
-
-  30      IR1=LOCN(ID1,ID2)+INT(RESN(ID1,ID2)*HWR())
-
-          IF (CLDKWT(IR1).LT.HWR()) GOTO 30
-
-          IR1=NCLDK(IR1)
-
-  40      IR2=LOCN(ID2,ID3)+INT(RESN(ID2,ID3)*HWR())
-
-          IF (CLDKWT(IR2).LT.HWR()) GOTO 40
-
-          IR2=NCLDK(IR2)
-
-          EM1=RMASS(IR1)
-
-          EM2=RMASS(IR2)
-
-          PCM=EMSQ-(EM1+EM2)**2
-
-          IF (PCM.GT.ZERO) GOTO 70
-
-  50      IF (NTRY.LE.NDTRY) GOTO 20
-
-C---CAN'T FIND A DECAY MODE - CHOOSE LIGHTEST
-
-  60      ID2=HWRINT(1,2)
-
-          IR1=NCLDK(LOCN(ID1,ID2))
-
-          IR2=NCLDK(LOCN(ID2,ID3))
-
-          EM1=RMASS(IR1)
-
-          EM2=RMASS(IR2)
-
-          PCM=EMSQ-(EM1+EM2)**2
-
-          IF (PCM.GT.ZERO) GOTO 70
-
-          NTRY=NTRY+1
-
-          IF (NTRY.LE.NDTRY+50) GOTO 60
-
-          CALL HWWARN('HWCHAD',101,*999)
-
-C---DECAY IS ALLOWED
-
-  70      PCM=PCM*(EMSQ-(EM1-EM2)**2)
-
-          IF (NTRY.GT.NCTRY) GOTO 80
-
-          PTEST=PCM*SWTEF(IR1)*SWTEF(IR2)
-
-          IF (PTEST.LT.PCMAX*HWR()**2) GOTO 20
-
-        ELSE
-
-C---ALLOW DECAY BY PI0 EMISSION IF ONLY POSSIBILITY
-
-          ID2=1
-
-          IR2=NCLDK(LOCN(1,1))
-
-          EM2=RMASS(IR2)
-
-          PCM=(EMSQ-(EM1+EM2)**2)*(EMSQ-(EM1-EM2)**2)
-
-        ENDIF
-
-C---DECAY IS CHOSEN.  GENERATE DECAY MOMENTA
-
-C   AND PUT PARTICLES IN /HEPEVT/
-
-  80    IF (PCM.LT.ZERO) CALL HWWARN('HWCHAD',102,*999)
-
-        PCM=0.5*SQRT(PCM)/EM0
-
-        MHEP=NHEP+1
-
-        NHEP=NHEP+2
-
-        IF (NHEP.GT.NMXHEP) CALL HWWARN('HWCHAD',103,*999)
-
-        PHEP(5,MHEP)=EM1
-
-        PHEP(5,NHEP)=EM2
-
-C Decide if cluster contains a b-(anti)quark or not
-
-        IF (ID1.EQ.11.OR.ID2.EQ.11.OR.ID3.EQ.11) THEN
-
-          IB=2
-
-        ELSE
-
-          IB=1
-
-        ENDIF
-
-        IF (CLDIR(IB).NE.0) THEN
-
-          DO 110 IM=1,2
-
-            JM=JMOHEP(IM,JCL)
-
-            IF (JM.EQ.0) GOTO 110
-
-            IF (ISTHEP(JM).NE.158) GOTO 110
-
-C   LOOK FOR PARENT PARTON
-
-            DO 100 KM=JMOHEP(1,JM)+1,JM
-
-              IF (ISTHEP(KM).EQ.2) THEN
-
-                IF (JDAHEP(1,KM).EQ.JM) THEN
-
-C   FOUND PARENT PARTON
-
-                  IF (IDHW(KM).NE.13) THEN
-
-C   FIND ITS DIRECTION IN CLUSTER CMF
-
-                   CALL HWULOF(PHEP(1,JCL),PHEP(1,KM),PP)
-
-                   PCQK=PP(1)**2+PP(2)**2+PP(3)**2
-
-                   IF (PCQK.GT.ZERO) THEN
-
-                    PCQK=SQRT(PCQK)
-
-                    IF (CLSMR(IB).GT.ZERO) THEN
-
-C   DO GAUSSIAN SMEARING OF DIRECTION
-
-  90                 CT=ONE+CLSMR(IB)*LOG(HWR())
-
-                     IF (CT.LT.-ONE) GOTO 90
-
-                     ST=ONE-CT*CT
-
-                     IF (ST.GT.ZERO) ST=SQRT(ST)
-
-                     CALL HWRAZM( ONE,CX,SX)
-
-                     CALL HWUROT(PP,CX,SX,RMAT)
-
-                     PP(1)=ZERO
-
-                     PP(2)=PCQK*ST
-
-                     PP(3)=PCQK*CT
-
-                     CALL HWUROB(RMAT,PP,PP)
-
-                    ENDIF
-
-                    PCQK=PCM/PCQK
-
-                    IF (IM.EQ.2) PCQK=-PCQK
-
-                    CALL HWVSCA(3,PCQK,PP,PHEP(1,MHEP))
-
-                    PHEP(4,MHEP)=SQRT(PHEP(5,MHEP)**2+PCM**2)
-
-                    CALL HWULOB(PHEP(1,JCL),PHEP(1,MHEP),PHEP(1,MHEP))
-
-                    CALL HWVDIF(4,PHEP(1,JCL),PHEP(1,MHEP),PHEP(1,NHEP))
-
-                    GOTO 130
-
-                   ENDIF
-
-                  ENDIF
-
-                  GOTO 120
-
-                ENDIF
-
-              ELSEIF (ISTHEP(KM).GT.140) THEN
-
-C   FINISHED THIS JET
-
-                GOTO 110
-
-              ENDIF
-
- 100        CONTINUE
-
- 110      CONTINUE
-
-        ENDIF
-
- 120    CALL HWDTWO(PHEP(1,JCL),PHEP(1,MHEP),PHEP(1,NHEP),
-
-     &              PCM,TWO,.TRUE.)
-
- 130    IDHW(MHEP)=IR1
-
-        IDHW(NHEP)=IR2
-
-        IDHEP(MHEP)=IDPDG(IR1)
-
-        IDHEP(NHEP)=IDPDG(IR2)
-
-        ISTHEP(MHEP)=192
-
-        ISTHEP(NHEP)=192
-
-        JMOHEP(1,MHEP)=JCL
-
-C---SECOND MOTHER OF HADRON IS JET
-
-        JMOHEP(2,MHEP)=JMOHEP(1,JMOHEP(1,JCL))
-
-        JDAHEP(1,JCL)=MHEP
-
-        JDAHEP(2,JCL)=NHEP
-
-C---SMEAR HADRON POSITIONS
-
-        HPSMR=GEV2MM/PHEP(5,JCL)
-
-        DO I=1,4
-
-          VHEP(I,MHEP)=HWRGAU(I,ZERO,HPSMR)
-
-        ENDDO
-
-        VHEP(4,MHEP)=ABS(VHEP(4,MHEP))
-
-     &           +SQRT(HWVDOT(3,VHEP(1,MHEP),VHEP(1,MHEP)))
-
-        CALL HWULB4(PHEP(1,JCL),VHEP(1,MHEP),VHEP(1,MHEP))
-
-        CALL HWVSUM(4,VHEP(1,JCL),VHEP(1,MHEP),VHEP(1,MHEP))
-
-        CALL HWVSUM(4,VTXPIP,VHEP(1,MHEP),VHEP(1,MHEP))
-
-        DO I=1,4
-
-          VHEP(I,NHEP)=HWRGAU(I,ZERO,HPSMR)
-
-        ENDDO
-
-        VHEP(4,NHEP)=ABS(VHEP(4,NHEP))
-
-     &           +SQRT(HWVDOT(3,VHEP(1,NHEP),VHEP(1,NHEP)))
-
-        CALL HWULB4(PHEP(1,JCL),VHEP(1,NHEP),VHEP(1,NHEP))
-
-        CALL HWVSUM(4,VHEP(1,JCL),VHEP(1,NHEP),VHEP(1,NHEP))
-
-        CALL HWVSUM(4,VTXPIP,VHEP(1,NHEP),VHEP(1,NHEP))
-
-      ENDIF
-
-      ISTHEP(JCL)=180+MOD(ISTHEP(JCL),10)
-
-      JMOHEP(1,NHEP)=JCL
-
-      JMOHEP(2,NHEP)=JMOHEP(1,JMOHEP(1,JCL))
-
-  999 END
-
-CDECK  ID>, HWDBOS.
-
-*CMZ :-        -23/05/96  18.34.17  by  Mike Seymour
-
-*-- Author :    Mike Seymour
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWDBOS(IBOSON)
-
-C-----------------------------------------------------------------------
-
-C     DECAY GAUGE BOSONS (ALREADY FOUND BY HWDHAD)
-
-C     USES SPIN DENSITY MATRIX IN RHOHEP (1ST CMPT=>-VE,2=>LONG,3=>+VE)
-
-C     IF BOSON CAME FROM HIGGS DECAY, GIVE BOTH THE SAME HELICITY (EPR)
-
-C     IF BOSON CAME FROM W+1JET, GIVE IT THE CORRECT DECAY CORRELATIONS
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      DOUBLE PRECISION HWR,HWRUNI,HWUPCM,HWULDO,R(3,3),CV,CA,BR,PCM,
-
-     & PBOS(5),PMAX,PROB,RRLL,RLLR
-
-      INTEGER HWRINT,IBOS,IBOSON,IPAIR,ICMF,IOPT,IHEL,IMOTH,
-
-     & I,IQRK,IANT,ID,IQ
-
-      LOGICAL QUARKS
-
-      EXTERNAL HWR,HWRUNI,HWUPCM,HWULDO,HWRINT
-
-      IBOS=IBOSON
-
-      IF (IDHW(IBOS).LT.198.OR.IDHW(IBOS).GT.200)
-
-     &  CALL HWWARN('HWDBOS',101,*999)
-
-      QUARKS=.FALSE.
-
-C---SEE IF IT IS PART OF A PAIR
-
-      IMOTH=JMOHEP(1,IBOS)
-
-      IPAIR=JMOHEP(2,IBOS)
-
-      ICMF=JMOHEP(1,IBOS)
-
-      IF (IDHW(ICMF).EQ.IDHW(IBOS).AND.ISTHEP(ICMF)/10.EQ.12)
-
-     &  ICMF=JMOHEP(1,ICMF)
-
-      IOPT=0
-
-      IF (IPAIR.NE.0) THEN
-
-        IF (JMOHEP(2,IPAIR).NE.IBOS.OR.
-
-     &    IDHW(IPAIR).LT.198.OR.IDHW(IPAIR).GT.200) IPAIR=0
-
-      ENDIF
-
-      IF (IPAIR.GT.0) IOPT=1
-
-C---SELECT DECAY PRODUCTS
-
-   10 CALL HWDBOZ(IDHW(IBOS),IDN(1),IDN(2),CV,CA,BR,IOPT)
-
-C---V + 1JET DECAYS ARE NOW HANDLED HERE !
-
-      IF (IPRO.EQ.21) THEN
-
-        IQRK=IDHW(JMOHEP(1,ICMF))
-
-        IANT=IDHW(JMOHEP(2,ICMF))
-
-        IF (IQRK.EQ.13 .AND. IANT.LE.6) THEN
-
-          IQRK=JMOHEP(2,ICMF)
-
-          IANT=JDAHEP(2,ICMF)
-
-        ELSEIF (IQRK.EQ.13) THEN
-
-          IQRK=JDAHEP(2,ICMF)
-
-          IANT=JMOHEP(2,ICMF)
-
-        ELSEIF (IANT.EQ.13 .AND. IQRK.LE.6) THEN
-
-          IQRK=JMOHEP(1,ICMF)
-
-          IANT=JDAHEP(2,ICMF)
-
-        ELSEIF (IANT.EQ.13) THEN
-
-          IQRK=JDAHEP(2,ICMF)
-
-          IANT=JMOHEP(1,ICMF)
-
-        ELSEIF (IQRK.GT.IANT) THEN
-
-          IQRK=JMOHEP(2,ICMF)
-
-          IANT=JMOHEP(1,ICMF)
-
-        ELSE
-
-          IQRK=JMOHEP(1,ICMF)
-
-          IANT=JMOHEP(2,ICMF)
-
-        ENDIF
-
-        PHEP(5,NHEP+1)=RMASS(IDN(1))
-
-        PHEP(5,NHEP+2)=RMASS(IDN(2))
-
-        PCM=HWUPCM(PHEP(5,IBOS),PHEP(5,NHEP+1),PHEP(5,NHEP+2))
-
-        IF (PCM.LT.ZERO) CALL HWWARN('HWDBOS',103,*999)
-
-        IF (IDHW(IBOS).EQ.200) THEN
-
-          ID=IDN(1)
-
-          IF (ID.GT.120) ID=ID-110
-
-          IQ=IDHW(IQRK)
-
-          IF (IQ.GT.6) IQ=IQ-6
-
-          RRLL=(VFCH(IQ,1)**2+AFCH(IQ,1)**2)*
-
-     $         (VFCH(ID,1)**2+AFCH(ID,1)**2)
-
-     $         +4*VFCH(IQ,1)*AFCH(IQ,1)*
-
-     $         VFCH(ID,1)*AFCH(ID,1)
-
-          RLLR=(VFCH(IQ,1)**2+AFCH(IQ,1)**2)*
-
-     $         (VFCH(ID,1)**2+AFCH(ID,1)**2)
-
-     $         -4*VFCH(IQ,1)*AFCH(IQ,1)*
-
-     $         VFCH(ID,1)*AFCH(ID,1)
-
-        ELSE
-
-          RRLL=1
-
-          RLLR=0
-
-        ENDIF
-
-        PMAX=(RRLL+RLLR)
-
-     &      *(HWULDO(PHEP(1,IANT),PHEP(1,IBOS))**2+
-
-     &        HWULDO(PHEP(1,IQRK),PHEP(1,IBOS))**2)
-
- 1      CALL HWDTWO(PHEP(1,IBOS),PHEP(1,NHEP+1),PHEP(1,NHEP+2),
-
-     &              PCM,TWO,.TRUE.)
-
-        PROB=RRLL*(HWULDO(PHEP(1,IANT),PHEP(1,NHEP+1))**2+
-
-     &             HWULDO(PHEP(1,IQRK),PHEP(1,NHEP+2))**2)+
-
-     &       RLLR*(HWULDO(PHEP(1,IANT),PHEP(1,NHEP+2))**2+
-
-     &             HWULDO(PHEP(1,IQRK),PHEP(1,NHEP+1))**2)
-
-        IF (PROB.GT.PMAX.OR.PROB.LT.ZERO)
-
-     &   CALL HWWARN('HWDBOS',104,*999)
-
-        IF (PMAX*HWR().GT.PROB) GOTO 1
-
-      ELSE
-
-C---SELECT HELICITY, UNLESS IT IS THE SECOND OF A HIGGS DECAY (EPR)
-
-      IF (IPAIR.NE.IBOS .OR. IDHW(ICMF).NE.201) THEN
-
-      IF (RHOHEP(1,IBOS)+RHOHEP(2,IBOS)+RHOHEP(3,IBOS).LE.ZERO) THEN
-
-C---COPY PARENT HELICITY IF IT WAS A GAUGE BOSON
-
-        IF (IDHW(IMOTH).GE.198.AND.IDHW(IMOTH).LE.200) THEN
-
-          CALL HWVEQU(3,RHOHEP(1,IMOTH),RHOHEP(1,IBOS))
-
-          IF (RHOHEP(1,IBOS)+RHOHEP(2,IBOS)+RHOHEP(3,IBOS).GT.ZERO)
-
-     &    GOTO 20
-
-C---MAY BE FROM A SUSY DECAY
-
-        ELSEIF (ABS(IDHEP(IMOTH)).LT.1000000) THEN
-
-          CALL HWWARN('HWDBOS',1,*999)
-
-        ENDIF
-
-        RHOHEP(1,IBOS)=1.
-
-        RHOHEP(2,IBOS)=1.
-
-        RHOHEP(3,IBOS)=1.
-
-      ENDIF
-
- 20   IHEL=HWRINT(1,3)
-
-      IF (HWR().GT.RHOHEP(IHEL,IBOS)) GOTO 20
-
-      ENDIF
-
-C---SELECT DIRECTION OF FERMION
-
- 30   COSTH=HWRUNI(0,-ONE,ONE)
-
-      IF (IHEL.EQ.1 .AND. (ONE+COSTH)**2.LT.HWR()*FOUR) GOTO 30
-
-      IF (IHEL.EQ.2 .AND. (ONE-COSTH**2).LT.HWR()     ) GOTO 30
-
-      IF (IHEL.EQ.3 .AND. (ONE-COSTH)**2.LT.HWR()*FOUR) GOTO 30
-
-C---GENERATE DECAY RELATIVE TO Z-AXIS
-
-      PHEP(5,NHEP+1)=RMASS(IDN(1))
-
-      PHEP(5,NHEP+2)=RMASS(IDN(2))
-
-      PCM=HWUPCM(PHEP(5,IBOS),PHEP(5,NHEP+1),PHEP(5,NHEP+2))
-
-      IF (PCM.LT.ZERO) CALL HWWARN('HWDBOS',102,*999)
-
-      CALL HWRAZM(PCM*SQRT(1-COSTH**2),PHEP(1,NHEP+1),PHEP(2,NHEP+1))
-
-      PHEP(3,NHEP+1)=PCM*COSTH
-
-      PHEP(4,NHEP+1)=SQRT(PHEP(5,NHEP+1)**2+PCM**2)
-
-C---ROTATE SO THAT Z-AXIS BECOMES BOSON'S DIRECTION IN ORIGINAL CM FRAME
-
-      CALL HWULOF(PHEP(1,ICMF),PHEP(1,IBOS),PBOS)
-
-      CALL HWUROT(PBOS, ONE,ZERO,R)
-
-      CALL HWUROB(R,PHEP(1,NHEP+1),PHEP(1,NHEP+1))
-
-C---BOOST BACK TO LAB
-
-      CALL HWULOB(PHEP(1,IBOS),PHEP(1,NHEP+1),PHEP(1,NHEP+1))
-
-      CALL HWVDIF(4,PHEP(1,IBOS),PHEP(1,NHEP+1),PHEP(1,NHEP+2))
-
-      ENDIF
-
-C---STATUS, IDs AND POINTERS
-
-      ISTHEP(IBOS)=195
-
-      DO 50 I=1,2
-
-        ISTHEP(NHEP+I)=193
-
-        IDHW(NHEP+I)=IDN(I)
-
-        IDHEP(NHEP+I)=IDPDG(IDN(I))
-
-        JDAHEP(I,IBOS)=NHEP+I
-
-        JMOHEP(1,NHEP+I)=IBOS
-
-        JMOHEP(2,NHEP+I)=JMOHEP(1,IBOS)
-
- 50   CONTINUE
-
-      NHEP=NHEP+2
-
-      IF (IDN(1).LE.12) THEN
-
-        ISTHEP(NHEP-1)=113
-
-        ISTHEP(NHEP)=114
-
-        JMOHEP(2,NHEP)=NHEP-1
-
-        JDAHEP(2,NHEP)=NHEP-1
-
-        JMOHEP(2,NHEP-1)=NHEP
-
-        JDAHEP(2,NHEP-1)=NHEP
-
-        QUARKS=.TRUE.
-
-      ENDIF
-
-C---IF FIRST OF A PAIR, DO SECOND DECAY
-
-      IF (IPAIR.NE.0 .AND. IPAIR.NE.IBOS) THEN
-
-        IBOS=IPAIR
-
-        GOTO 10
-
-      ENDIF
-
-C---IF QUARK DECAY, HADRONIZE
-
-      IF (QUARKS) THEN
-
-        EMSCA=PHEP(5,IBOS)
-
-        CALL HWBGEN
-
-        CALL HWDHOB
-
-        CALL HWCFOR
-
-        CALL HWCDEC
-
-      ENDIF
-
- 999  END
-
-CDECK  ID>, HWDBOZ.
-
-*CMZ :-        -29/04/91  18.00.03  by  Federico Carminati
-
-*-- Author :    Mike Seymour
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWDBOZ(IDBOS,IFER,IANT,CV,CA,BR,IOPT)
-
-C-----------------------------------------------------------------------
-
-C     CHOOSE DECAY MODE OF BOSON
-
-C     IOPT=2 TO RESET COUNTERS, 1 FOR BOSON PAIR, 0 FOR ANY OTHERS
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      DOUBLE PRECISION HWR,BRMODE(12,3),CV,CA,BR,BRLST,BRCOM,FACZ,
-
-     & FACW
-
-      INTEGER HWRINT,IDBOS,IDEC,IDMODE(2,12,3),IFER,IANT,IOPT,I1,I2,
-
-     & I1LST,I2LST,NWGLST,NUMDEC,NPAIR,MODTMP,JFER
-
-      LOGICAL GENLST
-
-      EXTERNAL HWR,HWRINT
-
-      SAVE FACW,FACZ,NWGLST,GENLST,NUMDEC,NPAIR,I1LST,I2LST,BRLST
-
-      DATA NWGLST,GENLST,NPAIR/-1,.FALSE.,0/
-
-C---STORE THE DECAY MODES (FERMION FIRST)
-
-      DATA IDMODE/  2,  7,  4,  9,  6, 11,  2,  9,  4,  7,
-
-     &            122,127,124,129,126,131,8*0,
-
-     &              1,  8,  3, 10,  5, 12,  3,  8,  1, 10,
-
-     &            121,128,123,130,125,132,8*0,
-
-     &              1,  7,  2,  8,  3,  9,  4, 10,  5, 11,  6, 12,
-
-     &            121,127,123,129,125,131,122,128,124,130,126,132/
-
-C---STORE THE BRANCHING RATIOS TO THESE MODES
-
-      DATA BRMODE/0.321,0.321,0.000,0.017,0.017,0.108,0.108,0.108,4*0.0,
-
-     &            0.321,0.321,0.000,0.017,0.017,0.108,0.108,0.108,4*0.0,
-
-     &            0.154,0.120,0.154,0.120,0.152,0.000,
-
-     &            0.033,0.033,0.033,0.067,0.067,0.067/
-
-C---FACTORS FOR CV AND CA FOR W AND Z
-
-      DATA FACW,FACZ/2*0.0/
-
-      IF (FACZ.EQ.ZERO) FACZ=SQRT(SWEIN)
-
-      IF (FACW.EQ.ZERO) FACW=0.5/SQRT(2D0)
-
-      IF (IDBOS.LT.198.OR.IDBOS.GT.200) CALL HWWARN('HWDBOZ',101,*999)
-
-C---IF THIS IS A NEW EVENT SINCE LAST TIME, ZERO COUNTERS
-
-      IF (NWGTS.NE.NWGLST .OR.(GENEV.NEQV.GENLST).OR. IOPT.EQ.2) THEN
-
-        NPAIR=0
-
-        NUMDEC=0
-
-        NWGLST=NWGTS
-
-        GENLST=GENEV
-
-        IF (IOPT.EQ.2) RETURN
-
-      ENDIF
-
-      NUMDEC=NUMDEC+1
-
-      IF (NUMDEC.GT.MODMAX) CALL HWWARN('HWDBOZ',102,*999)
-
-C---IF PAIR OPTION SPECIFIED FOR THE FIRST TIME, MAKE CHOICE
-
-      IF (IOPT.EQ.1) THEN
-
-        IF (NUMDEC.GT.MODMAX-1) CALL HWWARN('HWDBOZ',103,*999)
-
-        IF (NPAIR.EQ.0) THEN
-
-          IF (HWR().GT.HALF) THEN
-
-            MODTMP=MODBOS(NUMDEC+1)
-
-            MODBOS(NUMDEC+1)=MODBOS(NUMDEC)
-
-            MODBOS(NUMDEC)=MODTMP
-
-          ENDIF
-
-          NPAIR=NUMDEC
-
-        ELSE
-
-          NPAIR=0
-
-        ENDIF
-
-      ENDIF
-
-C---SELECT USER'S CHOICE
-
-      IF (IDBOS.EQ.200) THEN
-
-        IF (MODBOS(NUMDEC).EQ.1) THEN
-
-          I1=1
-
-          I2=6
-
-        ELSEIF (MODBOS(NUMDEC).EQ.2) THEN
-
-          I1=7
-
-          I2=7
-
-        ELSEIF (MODBOS(NUMDEC).EQ.3) THEN
-
-          I1=8
-
-          I2=8
-
-        ELSEIF (MODBOS(NUMDEC).EQ.4) THEN
-
-          I1=9
-
-          I2=9
-
-        ELSEIF (MODBOS(NUMDEC).EQ.5) THEN
-
-          I1=7
-
-          I2=8
-
-        ELSEIF (MODBOS(NUMDEC).EQ.6) THEN
-
-          I1=10
-
-          I2=12
-
-        ELSEIF (MODBOS(NUMDEC).EQ.7) THEN
-
-          I1=5
-
-          I2=5
-
-        ELSE
-
-          I1=1
-
-          I2=12
-
-        ENDIF
-
-      ELSE
-
-        IF (MODBOS(NUMDEC).EQ.1) THEN
-
-          I1=1
-
-          I2=5
-
-        ELSEIF (MODBOS(NUMDEC).EQ.2) THEN
-
-          I1=6
-
-          I2=6
-
-        ELSEIF (MODBOS(NUMDEC).EQ.3) THEN
-
-          I1=7
-
-          I2=7
-
-        ELSEIF (MODBOS(NUMDEC).EQ.4) THEN
-
-          I1=8
-
-          I2=8
-
-        ELSEIF (MODBOS(NUMDEC).EQ.5) THEN
-
-          I1=6
-
-          I2=7
-
-        ELSE
-
-          I1=1
-
-          I2=8
-
-        ENDIF
-
-      ENDIF
-
- 10   IDEC=HWRINT(I1,I2)
-
-      IF (HWR().GT.BRMODE(IDEC,IDBOS-197).AND.I1.NE.I2) GOTO 10
-
-      IFER=IDMODE(1,IDEC,IDBOS-197)
-
-      IANT=IDMODE(2,IDEC,IDBOS-197)
-
-C---CALCULATE BRANCHING RATIO
-
-C   (RESULT IS NOT WELL-DEFINED AFTER THE FIRST CALL OF A PAIR)
-
-      BR=0
-
-      DO 20 IDEC=I1,I2
-
- 20     BR=BR+BRMODE(IDEC,IDBOS-197)
-
-      IF (IOPT.EQ.1) THEN
-
-        IF (NPAIR.NE.0) THEN
-
-          I1LST=I1
-
-          I2LST=I2
-
-          BRLST=BR
-
-        ELSE
-
-          BRCOM=0
-
-          DO 30 IDEC=MAX(I1,I1LST),MIN(I2,I2LST)
-
- 30         BRCOM=BRCOM+BRMODE(IDEC,IDBOS-197)
-
-          BR=2*BR*BRLST - BRCOM**2
-
-        ENDIF
-
-      ENDIF
-
-C---SET UP VECTOR AND AXIAL VECTOR COUPLINGS (NORMALIZED TO THE
-
-C   CONVENTION WHERE THE WEAK CURRENT IS G*(CV-CA*GAM5) )
-
-      IF (IDBOS.EQ.200) THEN
-
-        IF (IFER.LE.6) THEN
-
-C Quark couplings
-
-           CV=VFCH(IFER,1)
-
-           CA=AFCH(IFER,1)
-
-        ELSE
-
-C lepton couplings
-
-           JFER=IFER-110
-
-           CV=VFCH(JFER,1)
-
-           CA=AFCH(JFER,1)
-
-        ENDIF
-
-        CV=CV * FACZ
-
-        CA=CA * FACZ
-
-      ELSE
-
-        CV=FACW
-
-        CA=FACW
-
-      ENDIF
-
- 999  END
-
-CDECK  ID>, HWDCHK.
-
-*CMZ :-        -27/07/99  13.33.03  by  Mike Seymour
-
-*-- Author :    Ian Knowles
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWDCHK(IDKY,L,*)
-
-C-----------------------------------------------------------------------
-
-C     Checks line L of decay table is compatible with decay of particle
-
-C     IDKY, tidies up the line and sets NPRODS.
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      DOUBLE PRECISION EPS,QS,Q,DM
-
-      INTEGER IDKY,L,IFAULT,I,ID,J
-
-      PARAMETER (EPS=1.D-6)
-
-      IF (VTOCDK(IDKY).AND.VTORDK(IDKY)) RETURN 1
-
-      IFAULT=0
-
-      QS=FLOAT(ICHRG(IDKY))
-
-      IF (IDKY.LE.12.OR.(IDKY.GE.109.AND.IDKY.LE.120)
-
-     &              .OR.(IDKY.GE.209.AND.IDKY.LE.220)
-
-     &              .OR.(IDKY.GE.401.AND.IDKY.LE.424)) QS=QS/3.
-
-      DM=RMASS(IDKY)
-
-      NPRODS(L)=0
-
-      DO 10 I=1,5
-
-      ID=IDKPRD(I,L)
-
-      IF (ID.LT.0.OR.ID.EQ.20.OR.ID.GT.NRES) THEN
-
-        WRITE(6,20) L,RNAME(IDKY),(RNAME(IDKPRD(J,L)),J=1,5)
-
-        IFAULT=IFAULT+1
-
-      ELSEIF (ID.NE.0) THEN
-
-        IF (VTORDK(ID)) THEN
-
-          WRITE(6,30) L,RNAME(IDKY),(RNAME(IDKPRD(J,L)),J=1,5),RNAME(ID)
-
-          IFAULT=IFAULT+1
-
-        ENDIF
-
-        NPRODS(L)=NPRODS(L)+1
-
-        IDKPRD(NPRODS(L),L)=ID
-
-        Q=FLOAT(ICHRG(ID))
-
-        IF (ID.LE.12.OR.(ID.GE.109.AND.ID.LE.120)
-
-     &              .OR.(ID.GE.209.AND.ID.LE.220)
-
-     &              .OR.(ID.GE.401.AND.ID.LE.424)) Q=Q/3.
-
-        QS=QS-Q
-
-        DM=DM-RMASS(ID)
-
-      ENDIF
-
-  10  CONTINUE
-
-C print any warnings
-
-      IF (NPRODS(L).EQ.0) THEN
-
-        WRITE(6,20) L,RNAME(IDKY),(RNAME(IDKPRD(I,L)),I=1,5)
-
-        IFAULT=IFAULT+1
-
-      ELSE
-
-        IF (ABS(QS).GT.EPS) THEN
-
-          WRITE(6,40) L,RNAME(IDKY),(RNAME(IDKPRD(I,L)),I=1,5),QS
-
-          IFAULT=IFAULT+1
-
-        ENDIF
-
-        IF (DM.LT.ZERO) THEN
-
-          WRITE(6,50) L,RNAME(IDKY),(RNAME(IDKPRD(I,L)),I=1,5),DM
-
-          IFAULT=IFAULT+1
-
-        ENDIF
-
-      ENDIF
-
-  20  FORMAT(1X,'Line ',I4,' decay: ',A8,' --> ',4(A8,1X),A8/
-
-     &       1X,'contains no or unrecognised decay product(s)')
-
-  30  FORMAT(1X,'Line ',I4,' decay: ',A8,' --> ',4(A8,1X),A8/
-
-     &       1X,'contains decay product ',A8,' which is vetoed')
-
-  40  FORMAT(1X,'Line ',I4,' decay: ',A8,' --> ',4(A8,1X),A8/
-
-     &       1X,'violates charge conservation, Qin-Qout= ',F6.3)
-
-  50  FORMAT(1X,'Line ',I4,' decay: ',A8,' --> ',4(A8,1X),A8/
-
-     &       1X,'is kinematically not allowed, Min-Mout= ',F10.3)
-
-      IF (IFAULT.NE.0) THEN
-
-        RETURN 1
-
-      ELSE
-
-        RETURN
-
-      ENDIF
-
-      END
diff --git a/HERWIG/src/hwdcle.f b/HERWIG/src/hwdcle.f
deleted file mode 100644 (file)
index f5f158d..0000000
+++ /dev/null
@@ -1,1226 +0,0 @@
-
-CDECK  ID>, HWDCLE.
-
-*CMZ :-        -28/01/92  12.34.44  by  Mike Seymour
-
-*-- Author :    Luca Stanco
-
-C-----------------------------------------------------------------------
-
-      SUBROUTINE HWDCLE(IHEP)
-
-C-----------------------------------------------------------------------
-
-C INTERFACE TO QQ-CLEO MONTE CARLO (LS 11/12/91)
-
-C-----------------------------------------------------------------------
-
-      INCLUDE 'HERWIG61.INC'
-
-      INTEGER IHEP,IIHEP,NHEPHF,QQLMAT
-
-      LOGICAL QQLERR
-
-      CHARACTER*8 NAME
-
-      EXTERNAL QQLMAT
-
-C---QQ-CLEO COMMON'S
-
-C***                 MCPARS.INC
-
-      INTEGER MCTRK, NTRKS, MCVRTX, NVTXS, MCHANS, MCDTRS, MPOLQQ
-
-      INTEGER MCNUM, MCSTBL, MCSTAB, MCTLQQ, MDECQQ
-
-      INTEGER MHLPRB, MHLLST, MHLANG, MCPLST, MFDECA
-
-      PARAMETER (MCTRK = 512)
-
-      PARAMETER (NTRKS = MCTRK)
-
-      PARAMETER (MCVRTX = 256)
-
-      PARAMETER (NVTXS = MCVRTX)
-
-      PARAMETER (MCHANS = 4000)
-
-      PARAMETER (MCDTRS = 8000)
-
-      PARAMETER (MPOLQQ = 300)
-
-      PARAMETER (MCNUM = 500)
-
-      PARAMETER (MCSTBL = 40)
-
-      PARAMETER (MCSTAB = 512)
-
-      PARAMETER (MCTLQQ = 100)
-
-      PARAMETER (MDECQQ = 300)
-
-      PARAMETER (MHLPRB = 500)
-
-      PARAMETER (MHLLST = 1000)
-
-      PARAMETER (MHLANG = 500)
-
-      PARAMETER (MCPLST = 200)
-
-      PARAMETER (MFDECA = 5)
-
-C***                 MCPROP.INC
-
-      REAL AMASS, CHARGE, CTAU, SPIN, RWIDTH, RMASMN, RMASMX
-
-      REAL RMIXPP, RCPMIX
-
-      INTEGER NPMNQQ, NPMXQQ, IDMC, INVMC, LPARTY, CPARTY
-
-      INTEGER IMIXPP, ICPMIX
-
-      COMMON/MCMAS1/
-
-     *       NPMNQQ, NPMXQQ,
-
-     *       AMASS(-20:MCNUM), CHARGE(-20:MCNUM), CTAU(-20:MCNUM),
-
-     *       IDMC(-20:MCNUM), SPIN(-20:MCNUM),
-
-     *       RWIDTH(-20:MCNUM), RMASMN(-20:MCNUM), RMASMX(-20:MCNUM),
-
-     *       LPARTY(-20:MCNUM), CPARTY(-20:MCNUM),
-
-     *       IMIXPP(-20:MCNUM), RMIXPP(-20:MCNUM),
-
-     *       ICPMIX(-20:MCNUM), RCPMIX(-20:MCNUM),
-
-     *       INVMC(0:MCSTBL)
-
-C
-
-      INTEGER NPOLQQ, IPOLQQ
-
-      COMMON/MCPOL1/
-
-     *       NPOLQQ, IPOLQQ(5,MPOLQQ)
-
-C
-
-      CHARACTER QNAME*10, PNAME*10
-
-      COMMON/MCNAMS/
-
-     *       QNAME(37), PNAME(-20:MCNUM)
-
-C
-
-C***                 MCCOMS.INC
-
-      INTEGER NCTLQQ, NDECQQ, IVRSQQ, IORGQQ, IRS1QQ
-
-      INTEGER IEVTQQ, IRUNQQ, IBMRAD
-
-      INTEGER NTRKMC, QQNTRK, NSTBMC, NSTBQQ, NCHGMC, NCHGQQ
-
-      INTEGER IRANQQ, IRANMC, IRANCC, IRS2QQ
-
-      INTEGER IPFTQQ, IPCDQQ, IPRNTV, ITYPEV, IDECSV, IDAUTV
-
-      INTEGER ISTBMC, NDAUTV
-
-      INTEGER IVPROD, IVDECA
-
-      REAL BFLDQQ
-
-      REAL ENERQQ, BEAMQQ, BMPSQQ, BMNGQQ, EWIDQQ, BWPSQQ, BWNGQQ
-
-      REAL BPOSQQ, BSIZQQ
-
-      REAL ECM, P4CMQQ, P4PHQQ, ENERNW, BEAMNW, BEAMP, BEAMN
-
-      REAL PSAV, P4QQ, HELCQQ
-
-      CHARACTER DATEQQ*20, TIMEQQ*20, FOUTQQ*80, FCTLQQ*80, FDECQQ*80
-
-      CHARACTER FGEOQQ*80
-
-      CHARACTER CCTLQQ*80, CDECQQ*80
-
-C
-
-      COMMON/MCCM1A/
-
-     *   NCTLQQ, NDECQQ, IVRSQQ, IORGQQ, IRS1QQ(3), BFLDQQ,
-
-     *   ENERQQ, BEAMQQ, BMPSQQ, BMNGQQ, EWIDQQ, BWPSQQ, BWNGQQ,
-
-     *   BPOSQQ(3), BSIZQQ(3),
-
-     *   IEVTQQ, IRUNQQ,
-
-     *   IBMRAD, ECM, P4CMQQ(4), P4PHQQ(4),
-
-     *   ENERNW, BEAMNW, BEAMP, BEAMN,
-
-     *   NTRKMC, QQNTRK, NSTBMC, NSTBQQ, NCHGMC, NCHGQQ,
-
-     *   IRANQQ(2), IRANMC(2), IRANCC(2), IRS2QQ(5),
-
-     *   IPFTQQ(MCTRK), IPCDQQ(MCTRK), IPRNTV(MCTRK), ITYPEV(MCTRK,2),
-
-     *   IDECSV(MCTRK), IDAUTV(MCTRK), ISTBMC(MCTRK), NDAUTV(MCTRK),
-
-     *   IVPROD(MCTRK), IVDECA(MCTRK),
-
-     *   PSAV(MCTRK,4), HELCQQ(MCTRK), P4QQ(4,MCTRK)
-
-C
-
-      COMMON/MCCM1B/
-
-     *   DATEQQ, TIMEQQ, FOUTQQ, FCTLQQ, FDECQQ, FGEOQQ,
-
-     *   CCTLQQ(MCTLQQ), CDECQQ(MDECQQ)
-
-      INTEGER IDSTBL
-
-      COMMON/MCCM1C/
-
-     *   IDSTBL(MCSTAB)
-
-C
-
-      INTEGER IFINAL(MCTRK), IFINSV(MCSTAB), NFINAL
-
-      EQUIVALENCE (IFINAL,ISTBMC), (IFINSV,IDSTBL), (NFINAL,NSTBMC)
-
-C
-
-      INTEGER NVRTX, ITRKIN, NTRKOU, ITRKOU, IVKODE
-
-      REAL XVTX, TVTX, RVTX
-
-      COMMON/MCCM2/
-
-     *   NVRTX, XVTX(MCVRTX,3), TVTX(MCVRTX), RVTX(MCVRTX),
-
-     *   ITRKIN(MCVRTX), NTRKOU(MCVRTX), ITRKOU(MCVRTX),
-
-     *   IVKODE(MCVRTX)
-
-C***                 MCGEN.INC
-
-      INTEGER QQIST,QQIFR,QQN,QQK,QQMESO,QQNC,QQKC,QQLASTN
-
-      REAL QQPUD,QQPS1,QQSIGM,QQMAS,QQPAR,QQCMIX,QQCND,QQBSPI,QQBSYM,QQP
-
-      REAL QQPC,QQCZF
-
-C
-
-      COMMON/DATA1/QQIST,QQIFR,QQPUD,QQPS1,QQSIGM,QQMAS(15),QQPAR(25)
-
-      COMMON/DATA2/QQCZF(15),QQMESO(36),QQCMIX(6,2)
-
-      COMMON/DATA3/QQCND(3)
-
-      COMMON/DATA5/QQBSPI(5),QQBSYM(3)
-
-      COMMON/JET/QQN,QQK(250,2),QQP(250,5),QQNC,QQKC(10),QQPC(10,4),
-
-     *  QQLASTN
-
-C---
-
-      IF(FSTEVT) THEN
-
-C---INITIALIZE QQ-CLEO
-
-        CALL QQINIT(QQLERR)
-
-        IF(QQLERR) CALL HWWARN('HWDEUR',500,*999)
-
-      E