C   09/11/84            MEMBER NAME  JTRNTR   (S)           FORTRAN
C
C-----------------------------------------------------------------------
      SUBROUTINE JTRNTR( PV, R, * )
C-----------------------------------------------------------------------
C
C  VERSION OF 29/11/83                          W.BARTEL
C  TRACK NEUTRONS AND K0L
C  UP TO THE LEAD GLASS SURFACES OF BARREL COUNTERS AND END CAPS
C  CHANGED 16/02/84                        K.-H. HELLENBRAND
C  TO IMPLEMENT DECAYS OF K0L
C
C      PV = USUAL PARTICLE VECTOR OF DIMENSION 10
C           FIRST FOUR ARE FOURVECTOR COMPONENTS SEE TRCDET
C      R  = THREE DIMENSIONAL RADIUS VECTOR
C      PV AND R ARE OVER WRITTEN UPON RETURN
C  RETURN 1   PARTICLE MISSES LEAD GLASS
C             OR DECAYS BEFORE LEAD GLASS
C-----------------------------------------------------------------------
C
      IMPLICIT INTEGER*2 (H)
      COMMON/CGEO1/BKGAUS, RPIP,DRPIP,XRLPIP, RBPC,DRBPC,XRLBPC,
     *             RITNK,DRITNK,XRLTKI, R0ROH,DR0ROH,XR0ROH,
     *             R1ROH,DR1ROH,XR1ROH, R2ROH,DR2ROH,XR2ROH,
     *             R3ROH,DR3ROH,XR3ROH, ROTNK,DROTNK,XRLTKO,
     *             RTOF,DRTOF,XRTOF, RCOIL, DRCOIL, XRCOIL,
     *             ZJM,DZJM,XRZJM, ZJP,DZJP,XRZJP,
     *             ZTKM,DZTKM,XRZTKM, ZTKP,DZTKP,XRZTKP,
     *             ZBPPL,ZBPMI,ZTOFPL,ZTOFMI,
     *             XRJETC,
     *             RLG,ZLGPL,ZLGMI,OUTR2,CTLIMP,CTLIMM,DELFI,
     *             BLXY,BLZ,BLDEP,ZENDPL,ZENDMI,DEPEND,
     *             XHOL1,XHOL2,YHOL1,YHOL2
      DIMENSION PV(10),R(3),R0(3)
      DATA PMIN / 0.005 /, DKL/ 15540.0 /
C
C
C      TEST ON SOME KINEMATIC QUANTITIES
C *** TEST PARTICLE ENERGY
      IF( PV(6) .LT. PMIN ) RETURN 1
      PVX=PV(1)/PV(6)
      PVY=PV(2)/PV(6)
      PVZ=PV(3)/PV(6)
C *** TEST ON GAMMA ANGLE
      IF(ABS(PVZ).GT.0.968) RETURN 1
      PVXY=PVX**2+PVY**2
      IF(PVXY.LT.1.E-5) RETURN 1
C
      RDL=1.E4
      R0(1)=R(1)
      R0(2)=R(2)
      R0(3)=R(3)
      IF(ABS(PV(8)-6.).LT.1.E-5) GOTO 100
C..........................DETERMINE DECAY LENGTH FOR K0L
      BETA=PV(6)/PV(4)
      GA=PV(4)/PV(5)
      EFUN=ALOG(RN(DUM))
      RDL=-DKL*BETA*GA*EFUN
C
C      FOLLOW PARTICLE FROM THE IA POINT TO THE LEAD GLASS SURFACE
C
  100 STH=SQRT(1.-PVZ**2)
      R1=R(1)**2+R(2)**2
      DR2=(RLG**2-R1)/PVXY
      IF( DR2 .LE. 0. ) RETURN 1
      PVR=R(1)*PVX+R(2)*PVY
      PVR=PVR/PVXY
      XL=-PVR+SQRT(PVR**2+DR2)
C
      R(1)=R(1)+XL*PVX
      R(2)=R(2)+XL*PVY
      R(3)=R(3)+XL*PVZ
C
      IF(R(3).GT.ZLGPL) GO TO 1000
      IF(R(3).LT.ZLGMI) GO TO 1000
C
C............CHECK WHETHER K0L DECAYS BEFORE LEAD GLAS BARREL
      RVD=DLENG(R(1),R(2),R(3),R0(1),R0(2),R0(3))
      IF(RVD.LT.RDL) RETURN
      GOTO 4000
C
C      FOLLOW PARTICLE TO THE FACE OF THE END CAP COUNTERS
C
 1000 CONTINUE
      RABS=R(1)**2 + R(2)**2 + R(3)**2
      RABS=SQRT(RABS)
      R(1) = R(1)/RABS
      R(2) = R(2)/RABS
      R(3) = R(3)/RABS
      ZLAM=ZENDPL/R(3)
      IF( R(3) .LT. 0. ) ZLAM=ZENDMI/R(3)
C
      R(1) = ZLAM*R(1)
      R(2) = ZLAM*R(2)
      R(3) = ZLAM*R(3)
C
C.....................CHECK WHETHER K0L DECAYS BEFORE END CAP
      RVD=DLENG(R(1),R(2),R(3),R0(1),R0(2),R0(3))
      IF(RVD.LT.RDL) GOTO 3000
      GOTO 4000
C
 3000 CALL ENDCLG(R,NCL,*3500)
      RETURN
 3500 RETURN 1
C
C................CALCULATE DECAY VERTEX AND CALL DECAY ROUTINE
 4000 R(1)=R0(1)+PVX*RDL
      R(2)=R0(2)+PVY*RDL
      R(3)=R0(3)+PVZ*RDL
      CALL TRKADC(PV,R,R0,RDL,*5000)
      RETURN 1
 5000 RETURN 1
      END
CCCCCCCCCCCCCCCCCCCCCCC
      FUNCTION DLENG(R1,R2,R3,RX,RY,RZ)
      DR=(R1-RX)**2 + (R2-RY)**2 + (R3-RZ)**2
      DLENG=SQRT(DR)
      RETURN
      END
