      SUBROUTINE HOWFAR
C
C*********************************************************************
C  DESIGN  : D. HECK   IK3  FZK KARLSRUHE
C  DATE    : SEP  05, 1988
C*********************************************************************
C  THE FOLLOWING IS A GENERAL SPECIFICATION OF HOWFAR:
C  GIVEN A PARTICLE AT (X,Y,Z) IN REGION IR AND GOING IN DIRECTION
C  (U,V,W), THIS ROUTINE ANSWERS THE QUESTION, CAN THE PARTICLE GO
C  A DISTANCE USTEP WITHOUT CROSSING A BOUNDARY OR OBSERVATION LEVEL?
C          IF YES, IT CALCULATES DNEAR AND RETURNS.
C          IF NO, IT SETS USTEP=DISTANCE TO BOUNDARY OR DETECTOR IN
C             IN THE CURRENT DIRECTION.
C             IT SETS IRNEW TO THE REGION NUMBER ON THE FAR SIDE
C             OF THE BOUNDARY (THIS CAN BE MESSY IN GENERAL!);
C             IT SETS NEWOBS TO THE DETECTOR NUMBER NEXT AFTER THE
C             DETECTOR JUST PASSING.
C  THE USER CAN TERMINATE A HISTORY BY SETTING IDISC>0. THE USER
C  CAN TRANSPORT THE LAST PARTICLE  BY SETTING IDISC<0. HERE WE
C  TERMINATE ALL HISTORIES WHICH ENTER REGION 6 OR ARE GOING
C  BACKWARDS IN REGION 1 OR HAVE PASSED THE LAST OBSERVATION LEVEL.
C*********************************************************************
C   ELECTRON OR PHOTON        POSITIVE Z-DIRECTION (W>0) IS DOWNWARDS
C            |
C            |                  REGION 1   (VACUUM)
C            V
C---------------------------    STARTING PLANE AT -BOUND(1) = -ZALTIT
C
C                               REGION 2   (AIR WITH EXPONENTIALLY
C                                           INCREASING DENSITY)
C
C---------------------------    BOUNDARY AT -BOUND(2)
C
C                               REGION 3   (AIR WITH EXPONENTIALLY
C                                           INCREASING DENSITY)
C
C---------------------------    BOUNDARY AT  -BOUND(3)
C
C                               REGION 4   (AIR WITH EXPONENTIALLY
C                                           INCREASING DENSITY)
C
C---------------------------    BOUNDARY AT  -BOUND(4)
C
C                               REGION 5   (AIR WITH EXPONENTIALLY
C                                           INCREASING DENSITY)
C
C-------------------------Z=0   BOUNDARY AT -BOUND(5)   (SEA LEVEL)
C////////////|/////////
C////////////|/////////         REGION 6   (VACUUM)
C////////////V/////////                    (MAY CONTAIN DETECTOR)
C   ELECTRON OR PHOTON
C------------------------       BOUNDARY AT -BOUND(6)
C
C*********************************************************************
*KEEP,EPCONT.
      COMMON/EPCONT/   EDEP,RATIO,TSTEP,TUSTEP,USTEP,TVSTEP,VSTEP,IDISC,
     *                 IROLD,IRNEW,RHOFAC, EOLD,ENEW,EKE,ELKE,BETA2,GLE,
     *                 TSCAT,IAUSFL
      DOUBLE PRECISION EDEP,RATIO
      REAL             TSTEP,TUSTEP,USTEP,TVSTEP,VSTEP,RHOFAC,EOLD,ENEW,
     *                 EKE,ELKE,BETA2,GLE,TSCAT
      INTEGER          IDISC,IROLD,IRNEW,IAUSFL(29)
*KEND.
      COMMON/GEOM/ZALTIT,BOUND(6),NEWOBS,OBSLVL(10)
*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,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
*KEEP,STACKE.
      COMMON/STACKE/   E,TIME,X,Y,Z,U,V,W,DNEAR,IQ,IGEN,IR,IOBS,LPCTE,NP
      DOUBLE PRECISION E(60),TIME(60)
      REAL             X(60),Y(60),Z(60),U(60),V(60),W(60),DNEAR(60)
      INTEGER          IQ(60),IGEN(60),IR(60),IOBS(60),LPCTE(60),NP
*KEND.
      COMMON/ACLOCK/NCLOCK,JCLOCK
C_____IF (NCLOCK.GT.JCLOCK) THEN
C______WRITE(MDEBUG,* )' HOWFAR:NP=',NP,' IR=',IR(NP),' IOBS=',IOBS(NP)
C______CALL AUSGB2
C_____END IF
      IF (IR(NP).GT.1 .AND. IR(NP).LT.6) THEN
C ***  WE ARE IN THE ATMOSPHERE - CHECK THE GEOMETRY
       IRL=IR(NP)
C ***  GOING FORWARD - CONSIDER FIRST SINCE MOST FREQUENT
       NOBS=IOBS(NP)
       IF (W(NP).GT.0.0) THEN
C  ***  TVAL IS DISTANCE TO NEXT BOUNDARY OR
C  ***  OBSERVATION LEVEL IN THIS DIRECTION
        TVAL=(-Z(NP)-MAX(BOUND(IRL),OBSLVL(NOBS)))/W(NP)
        IF (TVAL.GT.USTEP) THEN
C   ***  CAN TAKE CURRENTLY REQUESTED STEP
         DNEAR(NP)=TVAL*W(NP)
        ELSE
C   ***  GO TO DETECTOR OR BOUNDARY, WHICH IS CLOSER
         USTEP=MAX(TVAL,0.0001)
         IF (BOUND(IRL).GE.OBSLVL(NOBS)) THEN
C    ***  PARTICLE CROSSES BOUNDARY
          IRNEW=IRL+1
C    ***  PARTICLE LEAVES AIR
          IF((IRNEW.GE.6))IDISC=-1
         END IF
         IF (BOUND(IRL).LE.OBSLVL(NOBS)) THEN
C    ***  PARTICLE CROSSES DETECTOR
          NEWOBS=NOBS+1
C    ***  MAKE A VERY SMALL STEP TO AVOID HANGUP OF PROGRAM
          IF((USTEP.LE.0.0))USTEP = 0.0001
C    ***  TRANSPORT PARTICLE  TO FINAL DETECTOR LEVEL AND DISCARD IT
          IF((NEWOBS.GT.NOBSLV))IDISC=-1
         END IF
        END IF
C  ***  END OF W(NP)>0 CASE
C  ***  GOING UPWARD IN ATMOSPHERE
       ELSE IF(W(NP).LT.0.0) THEN
C  ***  NO DETECTOR ABOVE PARTICLE
        IF (NOBS.LE.1) THEN
C   ***  DISTANCE TO BOUNDARY ABOVE
         TVAL=(-Z(NP)-BOUND(IRL-1))/W(NP)
         IF (TVAL.GT.USTEP) THEN
C    ***  CAN TAKE CURRENTLY REQUESTED STEP
          DNEAR(NP)=MIN(Z(NP)+BOUND(IRL-1),-(Z(NP)+BOUND(IRL)))
         ELSE
C    ***  CROSS BOUNDARY ABOVE
          USTEP=MAX(TVAL,0.0001)
          IRNEW=IRL-1
         END IF
        ELSE
C   ***  BOUNDARY AND DETECTOR ABOVE PARTICLE
         TVAL=(-Z(NP)-MIN(BOUND(IRL-1),OBSLVL(NOBS-1)))/W(NP)
         IF (TVAL.GT.USTEP) THEN
C    ***  CAN TAKE CURRENTLY REQUESTED STEP
C    ***  DNEAR IS CLOSEST DISTANCE TO DETECTOR OR
C    ***  BOUNDARY ABOVE OR BELOW PARTICLE
          DNEAR(NP)=MIN(Z(NP)+MIN(BOUND(IRL-1),OBSLVL(NOBS-1)), -Z(NP) +
     *     MAX(BOUND(IRL),OBSLVL(NOBS)))
         ELSE
C    ***  TAKE ONLY STEP UP TO BOUNDARY OR DETECTOR
          USTEP=MAX(TVAL,0.0001)
          IF (BOUND(IRL-1).LE.OBSLVL(NOBS-1)) THEN
C     ***  PARTICLE CROSSES  BOUNDARY ABOVE
           IRNEW=IRL-1
C     ***  PARTICLE LEAVES ATMOSPHERE
           IF((IRNEW.LE.1))IDISC=1
          END IF
          IF ((BOUND(IRL-1).GE.OBSLVL(NOBS-1))) THEN
C     ***  PARTICLE CROSSES DETECTOR ABOVE; IT IS NOT
C     ***  PRINTED, BECAUSE IT MUST HIT DETECTOR DOWNWARDS
           NEWOBS=NOBS-1
           IOBS(NP)=NEWOBS
          END IF
         END IF
        END IF
C  ***  END W(NP)<0 CASE
C  ***  PARTICLE IS MOVING HORIZONTALLY, CANNOT HIT BOUNDARY
       ELSE IF(W(NP).EQ.0.0) THEN
        RETURN
       END IF
C ***  END OF ATMOSPHERE REGION CASE
      ELSE IF(IR(NP).EQ.6) THEN
C ***  TERMINATE THIS HISTORY, IT IS PAST THE ATMOSPHERE
       IDISC=1
C ***  WE ARE IN THE REGION WITH SOURCE ABOVE AIR
      ELSE IF(IR(NP).EQ.1) THEN
       IF (W(NP).GT.0.0) THEN
C  ***  IT MUST BE A SOURCE PARTICLE ON BOUNDARY 1
        USTEP=0.0001
        IRNEW=2
       ELSE
C  ***  IT IS A REFLECTED PARTICLE, DISCARD IT
        IDISC=1
       END IF
C ***  END REGION 1 CASE
      END IF
      RETURN
      END
