C   09/11/81 705131621  MEMBER NAME  LSCCTL0  (S)           FORTRAN
      SUBROUTINE LSCCTL(XU,JBC)
C
C     S.YAMADA   09-03-78  17:50
C     LAST MODIFICATION  09-11-81  21:35
C
C MODIFIED TO WORK WITH SF5-SF6 MVERSION OF SHOWER MC   23.1.86  J.0.
C
C
C---- MAIN SUBROUTINE TO CONTROL LEAD-GLASS CERENKOV LIGHT GENRTN.
C
C
C  SHOWER MC COMMON
C
      COMMON /CLGD56/ RADIUS(6),ZEND(2),ZWID,ZGAP,PHWID,
     2                ECXLST(24), ECYLST(24),ZECAP(4),ZPV(4),TPV,
     3                TH(4),THECP
C     COMMON /CLGDMS/ X0,RADIUS(6),RADSX0(6),THX0(4),
C    1                ZEND(2),ZENDX0(2),ZWID(2),ZGAP(2),PHWID(2),
C    2                ZECAP(4),ZECAPX(4),THECPX(2),
C    3                ECXLST(24), ECYLST(24),
C    4                ZPV(4),ZPVX0(4),TPV(2),TH(4)
C
      COMMON /CMATTR/ IMATTR,IMTLIS(10),XCM(10)
C
      COMMON / COLSON/ IPRO
      DIMENSION XO(3),PA0(9),XABS(3)
C
C
C---- XU(1--6) = POSITION AND DIRECTION OF THE PARTICLE INJECTED
C                INTO THE LEAD GLASS
C          THE UNIT OF XU(1--3) IS MM FOR INPUT
C            UNIT IS NOT CHANGED HERE, CONTRARY TO THE OLD VERSION
C
      DIMENSION XU(6)
C
C---- MEMORIZE THE INCIDENT DIRECTION AND ROTATE AROUND Z-AXIS
C    SO THAT IT HITS THE LEAD GLASS IN THE X-Z PLANE.
C
C  COSP AND SINP ARE PROJECTED ANGLES IN X-Y PLANE. ROTATION INTO THE
C   X-Z PLANE ACCORDING TO:
C
C       | COSP   SINP     0  |   |  XU(4)  |
C       |-SINP   COSP     0  | * |  XU(5)  |
C       |   0      0      1  |   |  XU(6)  |
C
C
      JBCI = JBC
      SJBC = JBC
      IF(JBC) 2,1,2
C
C        BARREL PART
C
    1 COSP = XU(1)/RADIUS(1)
      SINP = XU(2)/RADIUS(1)
C
C     XU(1) = RADSX0(1)
      XU(1) = RADIUS(1)
      XU(2) = 0.
C     XU(3) = XU(3)/X0
      W = XU(4)*COSP+XU(5)*SINP
      XU(5) = XU(5)*COSP-XU(4)*SINP
      XU(4) = W
      RETURN
C
C---- END CAP PART
C
C   2 W = XU(1)/X0
    2 W = XU(1)
C     XU(1) = XU(3)*SJBC/X0
      XU(1) = XU(3)*SJBC
C     XU(3) = XU(2)/X0
      XU(3) = XU(2)
      XU(2) = W
      W = XU(4)
      XU(4) = XU(6)*SJBC
      XU(6) = XU(5)
      XU(5) = W
      RETURN
C
C***********************************
C
      ENTRY LSCCTC(XO,PA0,T)
C
C   UPON ENTRY, UNIT IS RADIATION LENGTH. MULTIPLY BACK TO MM UNIT, BY
C        RAD.LENGTH FOR THE MATERIAL IN QUESTION (IMATTR AND XCM)
C     NOTE:  XCM IS GIVEN IN UNIT OF CM
C
C   PA0 IS THE 9-VECTOR OF THE PARTICLE, AT CURRENT POSITION
C   XO IS THE POSITION AT START
C
C
C---- CALCULATE BETA**2
C---- ENERGY UNIT OF PA0 IS ELECTRON MASS.
      BETA2 = 1.0-1.0/PA0(2)**2
C
      IF(IPRO.GT.0) WRITE(6,2001) (XO(IK),IK=1,3),BETA2,T
2001  FORMAT(' LSCCTC: XO ',3E12.4,' BETA2 ',E12.4,' T ',E12.4)
C
      IF(IPRO.GT.0) WRITE(6,2002) (PA0(IJ),IJ=1,9)
2002  FORMAT(' LSCCTC: PA0 ',9E12.4)
C
C---- SET THE AVERAGE POSITION
        DO 10 I=1,3
   10   XABS(I) = 0.5*(XO(I)+PA0(I+3))
      DEPTH = XABS(1)
      XJJ = XCM(IMATTR)*10.
      DEPTHM = DEPTH*XJJ
C
      IF(IPRO.GT.0) WRITE(6,2003) JBC,DEPTH,DEPTHM
2003  FORMAT(' LSCCTC: JBC ',I3,' DEPTH DEPTHM ',2E12.4)
C
      IF(JBC) 12,11,12
C
C#################
C-               --- BARREL
C#################
C
C---- CORRECT ENERGY LOSS IN THE AL-COIL.  CHANGED TO INCLUDE H2O,CH2..
C                                           ON 01-11-81 07:55
CC 11 IF(DEPTH.GE.RADSX0(1).AND.DEPTH.LE.RADSX0(2)) PA0(2)=PA0(2)-40.*T
C  11 IF(DEPTH.GE.RADSX0(1).AND.DEPTH.LE.RADSX0(2)) PA0(2)=PA0(2)-51.7*T
   11 IF(DEPTHM.GE.RADIUS(1).AND.DEPTHM.LE.RADIUS(2))
     $ PA0(2)=PA0(2)-51.7*T
C
      IF(IPRO.GT.0) WRITE(6,2004) PA0(2)
2004  FORMAT(' LSCCTC:  PA0(2) ',E12.4)
C
      IF(DEPTHM.LT.RADIUS(3).OR.DEPTHM.GT.RADIUS(4)) RETURN
      DEPTH = DEPTH-RADIUS(3)/XJJ
C
C---- ROTATE BACK W.R.T.Z-AXIS BY PHI.
      XABS1 = XABS(1)*COSP-XABS(2)*SINP
      XABS(2) = XABS(1)*SINP+XABS(2)*COSP
      XABS(1) = XABS1
C
      IF(IPRO.GT.0) WRITE(6,2005) DEPTH,(XABS(IK),IK=1,3)
2005  FORMAT(' LSCCTC: DEPTH XABS1-3 ',4E12.4)
C
      GO TO 30
C
C###########################
C                        ---- END CAP
C###########################
C
   12 W = XABS(1)
      XABS(1) = XABS(2)
      XABS(2) = XABS(3)
      XABS(3) = W*SJBC
C
      IF(IPRO.GT.0) WRITE(6,2006) (XABS(IK),IK=1,3)
2006  FORMAT(' LSCCTC: ECAP  XABS1-3 ',3E12.4)
C
      IF(DEPTHM.GE.ZPV(3).AND.DEPTHM.LE.ZPV(4)) PA0(2)=PA0(2)-51.7*T
      DEPTH = DEPTH -ZECAP(3)/XJJ
C
      IF(IPRO.GT.0) WRITE(6,2007) PA0(2),DEPTH,ZECAP(3),XJJ,THECP
2007  FORMAT(' LSCCTC: PA02 DEPTH,ZECAP3 XJJ THECP ',5E12.4)
C
      IF(DEPTH.LT.0. .OR. DEPTH.GT.THECP/XJJ) RETURN
C
   30 CONTINUE
C
      IF(IPRO.GT.0) WRITE(6,2008) T,DEPTH,PA0(7),JBCI
2008  FORMAT(' LSCCTC: CALL LGCR56 T DEPTH PA07 JBCI ',3E12.4,I5)
C
      CALL LGCR56( T,DEPTH,PA0(7),BETA2,XABS,JBCI )
      RETURN
      END
