*
* $Id: hwdeur.F,v 1.1.1.1 1996/03/08 17:02:11 mclareni Exp $
*
* $Log: hwdeur.F,v $
* Revision 1.1.1.1  1996/03/08 17:02:11  mclareni
* Herwig58
*
*
*CMZ :          29/08/94  11.51.46  by  Unknown
*-- Author :
CDECK  ID>, HWDEUR.
*CMZ :-        -28/01/92  12.34.44  by  Mike Seymour
*-- Author :    Luca Stanco
C-----------------------------------------------------------------------
      SUBROUTINE HWDEUR(IHEP)
C
C INTERFACE TO EURODEC PACKAGE (LS 10/29/91)
C
C-----------------------------------------------------------------------
#include "herwig58/herwig58.inc"
      INTEGER IHEP,IIHEP,NHEPHF,IEUPDG,IPDGEU
      CHARACTER*4 NAME
C---EURODEC COMMON'S : INITIAL INPUT
      INTEGER EULUN0,EULUN1,EULUN2,EURUN,EUEVNT
      CHARACTER*4 EUDATD,EUTIT
      REAL AMINIE(12),EUWEI
      COMMON/INPOUT/EULUN0,EULUN1,EULUN2
      COMMON/FILNAM/EUDATD,EUTIT
      COMMON/HVYINI/AMINIE
      COMMON/RUNINF/EURUN,EUEVNT,EUWEI
C---EURODEC WORKING COMMON'S
      INTEGER NPMAX,NTMAX
      PARAMETER (NPMAX=18,NTMAX=2000)
      INTEGER EUNP,EUIP(NPMAX),EUPHEL(NPMAX),EUTEIL,EUINDX(NTMAX),
     &    EUORIG(NTMAX),EUDCAY(NTMAX),EUTHEL(NTMAX)
      REAL EUAPM(NPMAX),EUPCM(5,NPMAX),EUPVTX(3,NPMAX),EUPTEI(5,NTMAX),
     &    EUSECV(3,NTMAX)
      COMMON/MOMGEN/EUNP,EUIP,EUAPM,EUPCM,EUPHEL,EUPVTX
      COMMON/RESULT/EUTEIL,EUPTEI,EUINDX,EUORIG,EUDCAY,EUTHEL,EUSECV
C---EURODEC COMMON'S FOR DECAY PROPERTIES
      INTEGER NGMAX,NCMAX
      PARAMETER (NGMAX=400,NCMAX=9000)
      INTEGER EUNPA,EUIPC(NGMAX),EUIPDG(NGMAX),EUIDP(NGMAX),
     &     EUCONV(NCMAX)
      REAL EUPM(NGMAX),EUPLT(NGMAX)
      COMMON/PCTABL/EUNPA,EUIPC,EUIPDG,EUPM,EUPLT,EUIDP
      COMMON/CONVRT/EUCONV
C---
      IF(FSTEVT) THEN
C---CHANGE HERE THE DEFAULT VALUES OF EURODEC COMMON'S
C
C---INITIALIZE EURODEC COMMON'S
CC        CALL EUDCIN
C---INITIALIZE EURODEC
        CALL EUDINI
      ENDIF
C---CONSTRUCT THE HADRON FOR EURODEC FROM ID1,ID2
      EUNP=1
      IDHEP(IHEP)=IDPDG(IDHW(IHEP))
      EUIP(1)=IPDGEU(IDHEP(IHEP))
      EUAPM(1)=EUPM(EUCONV(IABS(EUIP(1))))
      EUPCM(1,1)=PHEP(1,IHEP)
      EUPCM(2,1)=PHEP(2,IHEP)
      EUPCM(3,1)=PHEP(3,IHEP)
      EUPCM(5,1)=SQRT(PHEP(1,IHEP)**2+PHEP(2,IHEP)**2+PHEP(3,IHEP)**2)
      EUPCM(4,1)=SQRT(EUPCM(5,1)**2+EUAPM(1)**2)
C NOT POLARIZED HADRONS
      EUPHEL(1)=0
C HADRONS START FROM PRIMARY VERTEX
      EUPVTX(1,1)=0.
      EUPVTX(2,1)=0.
      EUPVTX(3,1)=0.
C---LET EURODEC DO THE JOB
      EUTEIL=0
      CALL FRAGMT(1,1,0)
C---UPDATE THE HERWIG TABLE : LOOP OVER N-EURODEC FINAL PARTICLES
      DO 40 IIHEP=1,EUTEIL
      NHEP=NHEP+1
      ISTHEP(NHEP)=198
      IF(EUDCAY(IIHEP).EQ.0) ISTHEP(NHEP)=1
      IDHEP(NHEP)=IEUPDG(EUINDX(IIHEP))
      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
        JDAHEP(1,NHEP)=EUDCAY(IIHEP)/10000+NHEPHF-1
        JDAHEP(2,NHEP)=MOD(EUDCAY(IIHEP),10000)+NHEPHF-1
      ELSE
        JMOHEP(1,NHEP)=MOD(EUORIG(IIHEP),10000)+NHEPHF-1
        JMOHEP(2,NHEP)=NHEPHF
        JDAHEP(1,NHEP)=EUDCAY(IIHEP)/10000+NHEPHF-1
        JDAHEP(2,NHEP)=MOD(EUDCAY(IIHEP),10000)+NHEPHF-1
      ENDIF
      PHEP(1,NHEP)=EUPTEI(1,IIHEP)
      PHEP(2,NHEP)=EUPTEI(2,IIHEP)
      PHEP(3,NHEP)=EUPTEI(3,IIHEP)
      PHEP(4,NHEP)=EUPTEI(4,IIHEP)
      PHEP(5,NHEP)=EUPTEI(5,IIHEP)
      VHEP(1,NHEP)=EUSECV(1,IIHEP)
      VHEP(2,NHEP)=EUSECV(2,IIHEP)
      VHEP(3,NHEP)=EUSECV(3,IIHEP)
      VHEP(4,NHEP)=0.
      IF (IIHEP.GT.NTMAX) CALL HWWARN('HWDEUR',99,*999)
   40 CONTINUE
  999 END