      SUBROUTINE MUTRAC
 
C-----------------------------------------------------------------------
C  MU(ON) TRAC(KING)
C
C  TRACKS THE MUON REGARDING MAX. STEP LENGTH FOR MULTIPLE SCATTERING
C  CHECKS PASSAGE THROUGH OBSERVATION LEVELS
C  IRET1=1 KILLS PARTICLE
C  IRET2=1 PARTICLE HAS BEEN CUTTED IN UPDATE
C  THIS SUBROUTINE IS CALLED FROM BOX3
C
C  DESIGN  : D. HECK    IK3  FZK KARLSRUHE
C-----------------------------------------------------------------------
 
      IMPLICIT NONE
*KEEP,GENER.
      COMMON /GENER/   GEN,ALEVEL
      DOUBLE PRECISION GEN,ALEVEL
*KEEP,IRET.
      COMMON /IRET/    IRET1,IRET2
      INTEGER          IRET1,IRET2
*KEEP,LONGI.
      COMMON /LONGI/   APLONG,HLONG,PLONG,SPLONG,THSTEP,THSTPI,
     *                 NSTEP,LLONGI,FLGFIT
      DOUBLE PRECISION APLONG(0:1040,9),HLONG(0:1024),PLONG(0:1040,9),
     *                 SPLONG(0:1040,9),THSTEP,THSTPI
      INTEGER          NSTEP
      LOGICAL          LLONGI,FLGFIT
*KEEP,MUPART.
      COMMON /MUPART/  AMUPAR,BCUT,CMUON,FMUBRM,FMUORG
      DOUBLE PRECISION AMUPAR(14),BCUT,CMUON(11)
      LOGICAL          FMUBRM,FMUORG
*KEEP,NPARTI.
      COMMON /NPARTI/  NPARTO,MUOND
      DOUBLE PRECISION NPARTO(10,25),NPHOTO(10),NPOSIT(10),NELECT(10),
     *                 NNU(10),NMUP(10),NMUM(10),NPI0(10),NPIP(10),
     *                 NPIM(10),NK0L(10),NKPL(10),NKMI(10),NNEUTR(10),
     *                 NPROTO(10),NPROTB(10),NK0S(10),NHYP(10),
     *                 NNEUTB(10),NDEUT(10),NTRIT(10),NALPHA(10),
     *                 NOTHER(10),MUOND
      EQUIVALENCE (NPARTO(1, 1),NPHOTO(1)), (NPARTO(1, 2),NPOSIT(1)),
     *            (NPARTO(1, 3),NELECT(1)), (NPARTO(1, 4),NNU(1))   ,
     *            (NPARTO(1, 5),NMUP(1))  , (NPARTO(1, 6),NMUM(1))  ,
     *            (NPARTO(1, 7),NPI0(1))  , (NPARTO(1, 8),NPIP(1))  ,
     *            (NPARTO(1, 9),NPIM(1))  , (NPARTO(1,10),NK0L(1))  ,
     *            (NPARTO(1,11),NKPL(1))  , (NPARTO(1,12),NKMI(1))  ,
     *            (NPARTO(1,13),NNEUTR(1)), (NPARTO(1,14),NPROTO(1)),
     *            (NPARTO(1,15),NPROTB(1)), (NPARTO(1,16),NK0S(1))  ,
     *            (NPARTO(1,18),NHYP(1))  , (NPARTO(1,19),NDEUT(1)) ,
     *            (NPARTO(1,20),NTRIT(1)) , (NPARTO(1,21),NALPHA(1)),
     *            (NPARTO(1,22),NOTHER(1)), (NPARTO(1,25),NNEUTB(1))
*KEEP,OBSPAR.
      COMMON /OBSPAR/  OBSLEV,THCKOB,XOFF,YOFF,THETAP,PHIP,
     *                 THETPR,PHIPR,NOBSLV
      DOUBLE PRECISION OBSLEV(10),THCKOB(10),XOFF(10),YOFF(10),
     *                 THETAP,THETPR(2),PHIP,PHIPR(2)
      INTEGER          NOBSLV
*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,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 CHITOT,HEIGH,HNEW,PROPAR(8),THCKHN
      INTEGER          I,IRET3,J,L,LPCT1,LPCT2
      LOGICAL          FSCAT
      EXTERNAL         HEIGH
C-----------------------------------------------------------------------
 
      IF ( DEBUG ) WRITE(MDEBUG,444) (CURPAR(I),I=1,9)
  444 FORMAT(' MUTRAC: CURPAR=',1P,9E10.3)
 
C  THE PLACE OF NEXT INTERACTION WAS DETERMINED IN BOX2
C  KEEP TOTAL STEP LENGTH UNTIL DECAY OR INTERACTION OCCURS
      CHITOT = CHI
 
 10   CONTINUE
 
C  CALCULATE MAX STEP SIZE (10 RAD. LENGTH) FOR MULTIPLE SCATTERING
      CHI = MIN( C(20), CHITOT )
      IF ( CHI .EQ. CHITOT ) THEN
        FSCAT  = .FALSE.
        IF (DEBUG) WRITE(MDEBUG,*)'MUTRAC: CHI=',SNGL(CHI)
      ELSE
        FSCAT  = .TRUE.
        IF (DEBUG) WRITE(MDEBUG,*)'MUTRAC: C(20)=',SNGL(C(20))
      ENDIF
 
 
C  CALCULATE HIGHT DIFFERENCE IN CM FROM GIVEN CHI IN G/CM**2
      THCKHN = THICKH + COSTHE * CHI
      HNEW   = HEIGH(THCKHN)
      IF (DEBUG) WRITE(MDEBUG,*)'MUTRAC: THICKH,THCKHN,HNEW=',
     *                    SNGL(THICKH),SNGL(THCKHN),SNGL(HNEW)
C  UPDATE MUON TO INTERACTION POINT (IF IT REACHES SO FAR)
C  AND STORE COORDINATES IN PROPAR
      CALL UPDATE( HNEW, THCKHN, 0 )
      IF ( DEBUG ) THEN
        WRITE(MDEBUG,455) IRET1,IRET2
  455   FORMAT(' MUTRAC: IRET1..2=',2I5)
        IF ( IRET2 .EQ. 0 ) WRITE(MDEBUG,454) (OUTPAR(I),I=1,8)
  454   FORMAT(' MUTRAC: OUTPAR=',1P,8E10.3)
      ENDIF
C  STORE MUON FOR FURTHER TREATMENT
      IF ( IRET2 .EQ. 0 ) THEN
        DO  3  I = 1,8
          PROPAR(I) = OUTPAR(I)
  3     CONTINUE
        IRET3 = 0
      ELSE
C  MUON CUTTED AT INTERACTION POINT; IT MAY HOWEVER PASS SOME OF THE
C  OBSERVATION LEVELS
        IRET3 = 1
      ENDIF
 
C  HERE THE ENDPOINT OF THE CURRENT TRACKING STEP IS WELL DEFINED.
C  THE MUON IS TRACKED FROM THICKH DOWN TO THICKHN
C  COUNT THE MUONS FOR THE LONGITUDINAL DEVELOPMENT
      IF ( LLONGI ) THEN
        LPCT1 = INT(THICKH*THSTPI + 1.D0)
        LPCT2 = INT(THCKHN*THSTPI)
        LPCT2 = MIN(NSTEP,LPCT2)
        IF     ( ITYPE .EQ. 6 ) THEN
          DO 5003 L = LPCT1,LPCT2
            PLONG(L,4) = PLONG(L,4) + 1.D0
 5003     CONTINUE
        ELSEIF ( ITYPE .EQ. 5 ) THEN
          DO 5013 L = LPCT1,LPCT2
            PLONG(L,5) = PLONG(L,5) + 1.D0
 5013     CONTINUE
        ENDIF
      ENDIF
 
C  CHECK OBSERVATION LEVEL PASSAGE AND UPDATE MUON COORDINATES
      DO  1  J = 1,NOBSLV
        IF ( HNEW .GT. OBSLEV(J) ) GOTO 2
        IF ( H    .LT. OBSLEV(J) ) GOTO 1
C  REMEMBER NUMBER OF LEVEL FOR OUTPUT
        LEVL  = J
        CALL UPDATE( OBSLEV(J), THCKOB(J), J )
        IF (DEBUG) WRITE(MDEBUG,456) J,IRET1,IRET2
  456   FORMAT(' MUTRAC: OBSLEV=',I5,' IRET1,2=',2I5)
 
C  IF MUON IS NOT CUTTED, BRING IT TO OUTPUT
        IF ( IRET2 .EQ. 0 ) THEN
          CALL OUTPUT
        ENDIF
  1   CONTINUE
 
C  KILL MUON AS IT DECAYS OR INTERACTS BELOW LOWEST OBSLEVEL
      IRET1  = 1
      FMUORG = .FALSE.
      RETURN
 
C  MUON SCATTERS, DECAYS OR INTERACTS BEFORE PASSING OBSLEVEL
  2   CONTINUE
 
      IF ( IRET3 .NE. 0 ) THEN
C  ELIMINATE MUON IF BELOW CUTS
        IRET1  = 1
        FMUORG = .FALSE.
        RETURN
      ENDIF
C  MUON IS NOW UPDATED TO POINT OF INTERACTION
      DO  5  J = 1,8
        CURPAR(J) = PROPAR(J)
  5   CONTINUE
      BETA = SQRT( GAMMA**2 - 1.D0 ) / GAMMA
      IF ( FSCAT ) THEN
C  MUON HAS MADE MULTIPLE SCATTERING AND MUST NOW BE TRACKED FURTHER ON
        CHITOT = CHITOT - C(20)
        IF ( CHITOT .GT. 0.D0 ) THEN
          THICKH = THCKHN
          IF ( DEBUG ) WRITE(MDEBUG,457) (CURPAR(I),I=1,9)
 457      FORMAT(' MUTRAC: SCATTER',1P,9E10.3)
          GOTO 10
        ENDIF
      ENDIF
C  MUONS HAVE TO DECAY IMMEDIATELY OR TO UNDERGO BREMSSTR./PAIRPR.
      IF ( FDECAY ) THEN
        ALEVEL = H
        CALL MUDECY
        MUOND  = MUOND + 1.D0
        FMUORG = .FALSE.
C  MUDECY WRITES EM-PARTICLE TO STACK
      ELSE
        IF ( FMUBRM ) THEN
          CALL MUBREM
        ELSE
          CALL MUPRPR
        ENDIF
C  MUBREM AND MUPRPR WRITE EM-PARTICLES AND MUON TO STACK
      ENDIF
      IRET1 = 1
 
      RETURN
      END
