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 'HERWIG59.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)
      ENDIF
C---CONSTRUCT THE HADRON FOR QQ-CLEO
C NOTE: THE IDPDG CODE IS PROVIDED THROUGH THE QQLMAT ROUTINE
C       FROM THE CLEO PACKAGE (QQ-CLEO <--> IDPDG CODE TRANSFORMATION)
      QQN=1
      IDHEP(IHEP)=IDPDG(IDHW(IHEP))
      QQK(1,1)=0
      QQK(1,2)=QQLMAT(IDHEP(IHEP),1)
      QQP(1,1)=PHEP(1,IHEP)
      QQP(1,2)=PHEP(2,IHEP)
      QQP(1,3)=PHEP(3,IHEP)
      QQP(1,5)=AMASS(QQK(1,2))
      QQP(1,4)=SQRT(QQP(1,5)**2+QQP(1,1)**2+QQP(1,2)**2+QQP(1,3)**2)
C---LET QQ-CLEO DO THE JOB
      QQNTRK=0
      NVRTX=0
      CALL DECADD(.FALSE.)
C---UPDATE THE HERWIG TABLE : LOOP OVER QQN-CLEO FINAL PARTICLES
      DO 40 IIHEP=1,QQN
      NHEP=NHEP+1
      ISTHEP(NHEP)=198
      IF(ITYPEV(IIHEP,2).GE.0) ISTHEP(NHEP)=1
      IDHEP(NHEP)=QQLMAT(ITYPEV(IIHEP,1),2)
      CALL HWUIDT(1,IDHEP(NHEP),IDHW(NHEP),NAME)
      IF(IIHEP.EQ.1) THEN
        ISTHEP(IHEP)=199
        JDAHEP(1,IHEP)=NHEP
        JDAHEP(2,IHEP)=NHEP
        ISTHEP(NHEP)=199
        NHEPHF=NHEP
        JMOHEP(1,NHEP)=IHEP
        JMOHEP(2,NHEP)=IHEP
      ELSE
        JMOHEP(1,NHEP)=IPRNTV(IIHEP)+NHEPHF-1
        JMOHEP(2,NHEP)=NHEPHF
      ENDIF
      JDAHEP(1,NHEP)=0
      JDAHEP(2,NHEP)=0
      IF(NDAUTV(IIHEP).GT.0) THEN
        JDAHEP(1,NHEP)=IDAUTV(IIHEP)+NHEPHF-1
        JDAHEP(2,NHEP)=JDAHEP(1,NHEP)+NDAUTV(IIHEP)-1
      ENDIF
      PHEP(1,NHEP)=QQP(IIHEP,1)
      PHEP(2,NHEP)=QQP(IIHEP,2)
      PHEP(3,NHEP)=QQP(IIHEP,3)
      PHEP(4,NHEP)=QQP(IIHEP,4)
      PHEP(5,NHEP)=QQP(IIHEP,5)
      VHEP(1,NHEP)=XVTX(IVPROD(IIHEP),1)
      VHEP(2,NHEP)=XVTX(IVPROD(IIHEP),2)
      VHEP(3,NHEP)=XVTX(IVPROD(IIHEP),3)
      VHEP(4,NHEP)=0.
   40 CONTINUE
  999 END
