      SUBROUTINE ETADEC
 
C-----------------------------------------------------------------------
C  ETA DEC(AY)
C
C  ROUTINE TREATES DECAY OF ETA
C  DECAY WITH FULL KINEMATIC, ENERGY AND MOMENTA CONSERVED
C  THIS SUBROUTINE IS CALLED FROM BOX3
C
C  DESIGN  : D. HECK    IK3  FZK KARLSRUHE
C-----------------------------------------------------------------------
 
      IMPLICIT NONE
*KEEP,CONST.
      COMMON /CONST/   PI,PI2,OB3,TB3,ENEPER
      DOUBLE PRECISION PI,PI2,OB3,TB3,ENEPER
*KEEP,DECAY.
      COMMON /DECAY/   GAM345,COS345,PHI345
      DOUBLE PRECISION GAM345(3),COS345(3),PHI345(3)
*KEEP,EDECAY.
      COMMON /EDECAY/  CETA
      DOUBLE PRECISION CETA(5)
*KEEP,GENER.
      COMMON /GENER/   GEN,ALEVEL
      DOUBLE PRECISION GEN,ALEVEL
*KEEP,PAM.
      COMMON /PAM/     PAMA,SIGNUM
      DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
*KEEP,PARPAR.
      COMMON /PARPAR/  CURPAR,SECPAR,PRMPAR,OUTPAR,C,
     *                 E00,E00PN,PTOT0,PTOT0N,THICKH,ITYPE,LEVL
      DOUBLE PRECISION CURPAR(14),SECPAR(14),PRMPAR(14),OUTPAR(14),
     *                 C(50),E00,E00PN,PTOT0,PTOT0N,THICKH
      INTEGER          ITYPE,LEVL
*KEEP,PARPAE.
      DOUBLE PRECISION GAMMA,COSTHE,PHI,H,T,X,Y,CHI,BETA,GCM,ECM
      EQUIVALENCE      (CURPAR(2),GAMMA),  (CURPAR(3),COSTHE),
     *                 (CURPAR(4), PHI ),  (CURPAR(5), H    ),
     *                 (CURPAR(6), T   ),  (CURPAR(7), X    ),
     *                 (CURPAR(8), Y   ),  (CURPAR(9), CHI  ),
     *                 (CURPAR(10),BETA),  (CURPAR(11),GCM  ),
     *                 (CURPAR(12),ECM )
*KEEP,RANDPA.
      COMMON /RANDPA/  FAC,U1,U2,RD,NSEQ,ISEED,KNOR
      DOUBLE PRECISION FAC,U1,U2
      REAL             RD(3000)
      INTEGER          ISEED(103,10),NSEQ
      LOGICAL          KNOR
*KEEP,RUNPAR.
      COMMON /RUNPAR/  FIXHEI,THICK0,HILOECM,HILOELB,
     *                 STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
     *                 MONIOU,MDEBUG,NUCNUC,
     *                 CETAPE,
     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
     *                 N1STTR,MDBASE,
     *                 DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
     *                ,GHEISH,GHESIG
      COMMON /RUNPAC/  DSN,HOST,USER
      DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
      REAL             STEPFC
      INTEGER          NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
     *                 SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
     *                 N1STTR,MDBASE
      INTEGER          CETAPE
      CHARACTER*79     DSN
      CHARACTER*20     HOST,USER
 
      LOGICAL          DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
     *                 FIX1I,FMUADD,FNKG,FPRINT,FDBASE
     *                ,GHEISH,GHESIG
*KEND.
 
      DOUBLE PRECISION AUX1,AUX2,COSTH1,COSTH2,EETA2,FI1
      INTEGER          I
C-----------------------------------------------------------------------
 
      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
  444 FORMAT(' ETADEC: CURPAR=',1P,9E10.3)
 
C  SELECT MODE OF DECAY, IF NOT ALREADY SELECTED BY THE PARTICLE TYPE
      IF ( ITYPE .EQ. 17 ) THEN
        CALL RMMAR( RD,1,1 )
        IF     ( RD(1) .LE. CETA(1) ) THEN
          ITYPE = 71
        ELSEIF ( RD(1) .LE. CETA(2) ) THEN
          ITYPE = 72
        ELSEIF ( RD(1) .LE. CETA(3) ) THEN
          ITYPE = 73
        ELSE
          ITYPE = 74
        ENDIF
      ENDIF
 
C  COPY COORDINATES INTO SECPAR
      DO  1  I = 5,8
        SECPAR(I) = CURPAR(I)
  1   CONTINUE
      SECPAR( 9)  = GEN
      SECPAR(10)  = ALEVEL
 
C  DECAY OF ETA  WITH 4 MODES
 
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  DECAY    ETA  ---->  GAMMA + GAMMA
      IF     ( ITYPE .EQ. 71 ) THEN
        EETA2  = 0.5D0 * GAMMA * PAMA(17)
        CALL RMMAR( RD,2,1 )
        AUX1   = 1.D0 + BETA * RD(1)
        AUX2   = 1.D0 - BETA * RD(1)
        COSTH1 = (BETA + RD(1)) / AUX1
        COSTH2 = (BETA - RD(1)) / AUX2
 
        SECPAR(1) = 1.D0
C  FIRST GAMMA (WITH HIGHER ENERGY)
        FI1       = PI2 * RD(2)
        CALL ADDANG( COSTHE,PHI, COSTH1,FI1, SECPAR(3),SECPAR(4) )
        IF ( SECPAR(3) .GT. C(29) ) THEN
          SECPAR(2) = AUX1 * EETA2
          CALL TSTACK
        ENDIF
C  SECOND GAMMA (WITH LOWER ENERGY)
        CALL ADDANG( COSTHE,PHI, COSTH2,FI1+PI, SECPAR(3),SECPAR(4) )
        IF ( SECPAR(3) .GT. C(29) ) THEN
          SECPAR(2) = AUX2 * EETA2
          CALL TSTACK
        ENDIF
 
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  DECAY    ETA  ---->  PI(0) + PI(0) + PI(0)
      ELSEIF ( ITYPE .EQ. 72 ) THEN
        CALL DECAY6( PAMA(17), PAMA(7),PAMA(7),PAMA(7),
     *               0.D0,0.D0,0.D0, 1.D0, 2 )
        SECPAR(1) = 7.D0
        DO 340  I = 1,3
          CALL ADDANG( COSTHE,PHI, COS345(I),PHI345(I),
     *                                SECPAR(3),SECPAR(4) )
          IF ( SECPAR(3) .GT. C(29) ) THEN
            SECPAR(2) = GAM345(I)
            CALL TSTACK
          ENDIF
  340   CONTINUE
 
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  DECAY    ETA  ---->   PI(-) + PI(+) + PI(0)
      ELSEIF ( ITYPE .EQ. 73 ) THEN
        CALL DECAY6( PAMA(17), PAMA(9),PAMA(8),PAMA(7),
     *               CETA(4),0.D0,0.D0, CETA(5), 2 )
        DO 360  I = 1,3
          CALL ADDANG( COSTHE,PHI, COS345(I),PHI345(I),
     *                                  SECPAR(3),SECPAR(4) )
          IF ( SECPAR(3) .GT. C(29) ) THEN
            SECPAR(1) = 10 - I
            SECPAR(2) = GAM345(I)
            CALL TSTACK
          ENDIF
  360   CONTINUE
 
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C  DECAY    ETA  ---->  PI(+) + PI(-) + GAMMA
      ELSEIF ( ITYPE .EQ. 74 ) THEN
        CALL DECAY6( PAMA(17), PAMA(8),PAMA(9),0.D0,
     *               0.D0,0.D0,0.D0, 1.D0, 2 )
        DO 380  I = 1,3
          CALL ADDANG( COSTHE,PHI, COS345(I),PHI345(I),
     *                                SECPAR(3),SECPAR(4) )
          IF ( SECPAR(3) .GT. C(29) ) THEN
            IF ( I .LE. 2 ) THEN
              SECPAR(1) = 7 + I
            ELSE
              SECPAR(1) = 1.D0
            ENDIF
            SECPAR(2)   = GAM345(I)
            CALL TSTACK
          ENDIF
  380   CONTINUE
 
      ELSE
        WRITE(MONIOU,*) 'ETADEC: UNEXPECTED PARTICLE CODE ITYPE=',ITYPE
      ENDIF
      RETURN
      END
