*
* $Id: hwures.F,v 1.1.1.1 1996/03/08 17:02:18 mclareni Exp $
*
* $Log: hwures.F,v $
* Revision 1.1.1.1  1996/03/08 17:02:18  mclareni
* Herwig58
*
*
*CMZ :          29/08/94  11.51.49  by  Unknown
*-- Author :
CDECK  ID>, HWURES.
*CMZ :-        -26/04/91  11.11.56  by  Bryan Webber
*-- Author :    Bryan Webber
C------------------------------------------------------------------------
      SUBROUTINE HWURES
C     HWURES AND BLOCK DATA HWUDAT LOAD COMMON BLOCKS WITH
C     DATA ON NRES PARTICLES AND THEIR DECAY MODES
C
C     RNAME(I) = NAME OF PARTICLE I
C     RMASS(I) = MASS OF PARTICLE I
C     ICHRG(I) = CHARGE OF PARTICLE I
C     IDPDG(I) = PDG CODE FOR PARTICLE I
C     MADDR(I) = POINTER FOR DECAY MODES OF I
C     MODES(I) = NUMBER OF DECAY MODES OF I
C     BFRAC(J) = BRANCHING FRACTION FOR MODE J
C     CMMOM(J) = C.M.MOMENTUM FOR 2-BODY MODE J (0 FOR 3-BODY)
C     RESWT(J,I) = COMBINATIONS OF WEIGHT AND MASS FOR PARTICLE I
C                  (USED FOR CLUSTER DECAY)
C     IDPRO(K,J) = LOCATION OF K-TH DECAY PRODUCT FOR MODE J
C------------------------------------------------------------------------
#include "herwig58/herwig58.inc"
      INTEGER M,I,J,K,NM,JM,ID,ID1,ID2,ID3,J0
      DOUBLE PRECISION HWUPCM,SW,WT,EM0,EM1,EM2,ETAWGT
      CHARACTER*4 IPR(3,24)
      M=0
      DO 50 I=1,NRES
      MADDR(I)=M
C---COMPUTE WEIGHTS FOR CLUSTER DECAY
      SW=SWT(I)
      WT=1.
      IF (SW.EQ.3.) WT=VECWT
      IF (SW.EQ.4.) WT=DECWT
      IF (SW.EQ.5.) WT=TENWT
      SWTEF(I)=WT**2
C---COMPUTE C.M. MOMENTA FOR TWO-BODY MODES
      NM=MODES(I)
      MODEF(I)=NM
      IF (NM.EQ.0) GO TO 50
      DO 49 J=1,NM
      JM=J+M
      ID1=IDPRO(1,JM)
      ID2=IDPRO(2,JM)
      ID3=IDPRO(3,JM)
      IF (ID2.NE.0.AND.ID3.EQ.0) GO TO 45
      CMMOM(JM)=0.
      GO TO 49
   45 EM0=RMASS(I)
      EM1=RMASS(ID1)
      EM2=RMASS(ID2)
      CMMOM(JM)=HWUPCM(EM0,EM1,EM2)
   49 CONTINUE
   50 M=M+NM
C---PREPARE TABLES FOR CLUSTER DECAY
      DO 54 J=1,3
      DO 54 I=4,9
      LOCN(I,J)=LOCN(J,I)+18
   54 RESN(I,J)=RESN(J,I)
      DO 55 I=1,9
      LOCN(10,I)=LOCN(I,10)-35
   55 RESN(10,I)=RESN(I,10)
      DO 56 I=1,10
      LOCN(I,11)=244+I
   56 LOCN(I,12)=254+I
      DO 57 I=1,12
      LOCN(11,I)=220+I
      LOCN(12,I)=232+I
      RESN(11,I)=RESN(I,11)
   57 RESN(12,I)=RESN(I,12)
      DO 58 J=1,12
      DO 58 I=1,12
      ID=LOCN(I,J)
      IF (ID.EQ.0) THEN
        ID=19
        LOCN(I,J)=ID
      ENDIF
   58 RMIN(I,J)=RMASS(ID)
C---INCLUDE ETA-ETAPRIME MIXING IN THEIR CLUSTER DECAY WEIGHTS
      IF (RESWT(22).EQ.RESWT(21)) THEN
        ETAWGT=COS(ETAMIX*PIFAC/180+ACOS(ONE/SQRT(THREE)))**2
        RESWT(22)=RESWT(22)*ETAWGT
        RESWT(25)=RESWT(25)*(1-ETAWGT)
        RESWT(54)=RESWT(54)*(1-ETAWGT)
        RESWT(55)=RESWT(55)*ETAWGT
      ENDIF
      IF (IPRINT.LT.2) RETURN
C---PRINT OUT TABLE OF PARTICLE PROPERTIES
      WRITE (6,80) NRES
      DO 70 I=1,NRES
      WT=RESWT(I)
      NM=MODES(I)
      IF (NM.NE.0) GO TO 59
      WRITE (6,85) I,RNAME(I),IDPDG(I),RMASS(I),ICHRG(I),WT,NM
      GO TO 70
C---FIND DECAY PRODUCTS
   59 J0=MADDR(I)
      DO 60 J=1,NM
      DO 60 K=1,3
      ID=IDPRO(K,J0+J)
      IF (ID.EQ.0) ID=62
   60 IPR(K,J)=RNAME(ID)
      WRITE (6,90) I,RNAME(I),IDPDG(I),RMASS(I),ICHRG(I),
     &WT,NM,(BFRAC(J0+J),(IPR(K,J),K=1,3),J=1,NM)
   70 CONTINUE
   80 FORMAT(1H1//30X,'TABLE OF PROPERTIES OF',I4,' PARTICLES USED'//
     &/9X,'IDENT IDPDG   MASS CHG WT MODES  BRANCHING FRACTIONS',
     &' AND DECAY PRODUCTS')
   85 FORMAT(/I8,1X,A4,I7,F7.3,I3,F5.2,I3)
   90 FORMAT(/I8,1X,A4,I7,F7.3,I3,F5.2,I3,2X,4(F5.2,1X,3A4),
     &5(/40X,4(F5.2,1X,3A4)))
      END
