C   14/12/81 705141358  MEMBER NAME  LGECORY  (S)           FORTRAN
      SUBROUTINE LGECOR(BDATA,DEP,IFLAG)
C
      IMPLICIT INTEGER*2 (H)
C
C  THIS PROGRAM CALCULATE THE INCIDENT ENERGY
C  FROM THE MEASURED ENERGY.
C
C      05/3/1979     HIROSHI TAKEDA
C      LAST MODIFICATION   22/09/79
C      LAST MODIFICATION   04/10/79 Y.WATANABE
C      LAST MODIFICATION   09/02/80 H.TAKEDA(TYPED BY Y.WATANABE)
C         IMPLEMENTED ON 21/2/80 18:00
C      LAST MODIFICATION   08/09/80 Y.W. LGPOSC FOR BARREL.
C      LAST MODIFICATION   14/12/81 H.T. ENGLOS FOR END-CAP.
C      LAST MODIFICATION   14/12/81 H.T. THICKNESS FOR BARREL MATERIALS
C      LAST MODIFICATION   06/04/82 S.ODAKA
C                          BRLGN FOR BARREL INSTEAD OF LGPOSC
C  BDATA : DATA BUFFER OF THE FOLLOWING PARAMETERS.
C
C    IDATA(1)   0   BARREL
C                    -1   BOTTOM END CAP
C                    +1   TOP    END CAP
C    BDATA(2)   CLUSTER ENERGY IN GEV
C    BDATA(3)   SIGMA(ENERGY)
C    BDATA(4)   WEIGHTED AVERAGE PHI        BARREL
C                                       X        END CAP
C    BDATA(5)   WEIGHTED AVERAGE  Z         BARREL
C                                       Y        END CAP
C    BDATA(6)   SIGMA PHI (WEIGHTED)        BARREL
C                            X                   END CAP
C    BDATA(7)   SIGMA  Z (WEIGHTED)         BARREL
C                            Y                   END CAP
C    IDATA(8)   NUMBER OF CORRESPONDING INNER TRACKS
C    BDATA(9--11) DIRECTION COSIGNS CORRECTED FOR SHOWER DEPTH
C
C  DEP  :  SHOWER DEPTH IN MM
C  IFLAG   0    NORMAL RETURN
C          1    ITERATION OVERFLOW
C          2    HIT OUTSIDE END-CAP
C          3    TOO MUCH ENERGY LOSS
C          4    OTHER ILLEGAL RETURNS
C
      DIMENSION BDATA(2)
      COMMON /CLLLLL/  IPRO
      COMMON /CLGDMS/  X0,RADIUS(6),RADSX0(6),
     1  THX0(4),ZEND(2),ZENDX0(2),
     2  ZWID(2),ZGAP(2),PHWID(2),
     3  ZECAP(4),ZECAPX(4),THECPX(2),
     4  ECXLST(24),ECYLST(24)
C
C  THECPX(1)   THICKNESS OF END CAP COUNTER IN MM
C        (2)                                   X0
C  RADIUS(1,2) DISTANCE TO THE COIL SURFACE (INNER AND OUTER)
C        (3,4) DISTANCE TO THE LEAD GLASS SURFACE (TYPE A)
C  ZEND(1)     END POINT OF BARREL PART COUNTERS  (-)
C      (2)                                        (+)
C  ZGAP(1)     COUNTER GAP OF BARREL PART IN MM
C  THX0(1)     MAGNET COIL THICKNESS IN X0
C              X0 = 8.9 CM FOR ALUMINUM
C
#include "cdata.for"
      COMMON /TODAY/ HDATE(6)
C
      EQUIVALENCE (PHI,XCO),(ZCO,YCO),(IBE,BE)
      DATA ETHRE/0.01/,PAI2/6.283185/
C
C  INITIAL SET UP
C
      BE   =BDATA(1)
      ENERGY=BDATA(2)
C CHANGE 30.4.87 TO AVOID SYSTEMATIC EFFECTS AT LOW ENERGIES
      ETHRE = .05*ENERGY
      IF(ETHRE.GT..01) ETHRE = .01
      COSX  =BDATA(9)
      COSY  =BDATA(10)
      COSZ  =BDATA(11)
      PHI   =BDATA(4)
      ZCO   =BDATA(5)
C     WRITE(6,900) BE,ENERGY,COSX,COSY,COSZ,PHI,ZCO,DEP
C900  FORMAT(10F10.3)
      IFLAG=0
C
      IF(IBE.EQ.0) GO TO 1
CCCCCCCCCCCCCCCCCCCCC
C
C  END CAP COUNTERS
C
CCCCCCCCCCCCCCCCCCCCC
C
C  EXTRAPOLATION TO THE FACE OF THE LIGHT GUIDE
C
      R=(THECPX(1)-DEP)/COSZ
      R=ABS(R)
      XX=XCO+R*COSX
      YY=YCO+R*COSY
C
      THETA=ARCOS(COSZ)
      THETA=ABS(THETA)*57.2958
      IF(IBE.EQ.-1) THETA=180.0-THETA
C     WRITE(6,900) R,XX,YY,THETA
C
C   ITERATION FOR INCIDENT ENERGY
C
      ETEMP1=ENERGY
      ITERA=1
      JTERA=1
C
C
C  DISTANCE FROM THE CENTER OF LIGHT GUIDE
C
      X=XX/X0
      Y=YY/X0
      CALL LGNMEC(X,Y,ID)
C
C   CHECK IF HIT IS INSIDE THE COUNTER
C
C
      IF(ID.GT.0) GO TO 60
      X=XCO/X0
      Y=YCO/X0
      CALL LGNMEC(X,Y,ID)
C
      IF(ID.GT.0) GO TO 60
      IFLAG=2
      RETURN
C
   60 MB=(ID-1)/24 +1
      ID=MOD(ID-1,24)+1
      U=ECXLST(ID)
      V=ECYLST(ID)
      GO TO (4,5,6,7),MB
    4 X=U
      Y=V
      GO TO 8
    5 X=-V
      Y=U
      GO TO 8
    6 X=-U
      Y=-V
      GO TO 8
    7 X=V
      Y=-U
    8 R=0.1*SQRT((X-XX)*(X-XX)+(Y-YY)*(Y-YY))
      DDR=SQRT(XX*XX+YY*YY)-SQRT(X*X+Y*Y)
      IF(ABS(R).GT.1.E-10) DDR=0.1*DDR/R
C
C     ENERGY LOSS
C
      THICK=1.17*8.9/ABS(COSZ)
   10 CALL ENGLOS(ETEMP1,THICK,DELTAE,&80)
      ETEMP3=ETEMP1-DELTAE
      IF(ETEMP3.GT.0.) GO TO 32
      ETEMP1=ETEMP1+ETHRE
      GO TO 10
C
C     POS DEP
C
   32 CALL POSEND(ETEMP3,R,DDR,FAC,&80)
C
      ETEMP2=ENERGY/FAC+DELTAE
      EDIF=ABS(ETEMP2-ETEMP1)
      IF(EDIF.LE.ETHRE) GO TO 9
      ITERA=ITERA+1
      IF(ITERA.GE.10) GO TO 40
      ETEMP1=ETEMP2
      GO TO 10
C
   40 ITERA=1
      ETEMP1=0.5*(ETEMP1+ETEMP2)
      JTERA=JTERA+1
      IF(JTERA.LT.5) GO TO 10
      IFLAG=1
      RETURN
C
    9 BDATA(2)=ETEMP2
       IF(IPRO.GT.0) WRITE(6,940) ITERA,JTERA,ETEMP1,FAC,X,Y,R,DDR
 940   FORMAT(' ITER JTER ETEMP1 FAC X Y R DDR ',2I4,6E12.4)
      RETURN
CCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C  BARREL PART COUNTERS
C
CCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C  EXTRAPOLATION TO THE FACE OF LIGHT GUIDE
C
    1 R=RADIUS(3)+DEP
      COSPHI=COS(PHI)
      SINPHI=SIN(PHI)
C       X Y POSITION AT THE SHOWER MEDIAN.
      X=R*COSPHI
      Y=R*SINPHI
C
C     DISTANCE FROM THE SHOWER MAX POINT TO THE EXTRAPOLATED POINT
C           AT THE END FACE OF LEAD GLASS
      A=COSX*COSX+COSY*COSY
      B=X*COSX+Y*COSY
      C=X*X+Y*Y-RADIUS(4)*RADIUS(4)
      RDIF=(SQRT(B*B-A*C)-B)/A
C      X Y Z POSITION AT THE END FACE OF LG
      X=X+RDIF*COSX
      Y=Y+RDIF*COSY
CCC   Z=ZCO+RDIF*COSZ
C     WRITE(6,900) COSPHI,SINPHI,X,Y,Z,A,B,C,RDIF
C
C  DISTANCE FROM THE CENTER OF LIGHT GUIDE
C
CCC   Z=Z-ZEND(1)+0.5*ZGAP(1)
CCC   PERIOD=ZWID(1)+ZGAP(1)
CCC   IZ=Z/PERIOD+1
CCC   IF(IZ.LE.1) IZ=2
CCC   IF(IZ.GE.32) IZ=31
CCC   Z=Z-PERIOD*(IZ-0.5)
C
      THETA=ATAN2(Y,X)
      IF(THETA.LT.0.) THETA=THETA+PAI2
      STEP=PAI2/84.
      ITH=THETA/STEP
CCC   THETA=(THETA-(ITH+0.5)*STEP)*RADIUS(4)
C
CCC   R=0.1*SQRT(Z*Z+THETA*THETA)
CCCCCCC    CCC ARE NEEDED ONLY FOR POSITION CORRECTION.....
C
C       INCIDENT ANGLE
      ANGNOR=(ITH+0.5)*STEP
      COSNOR=COS(ANGNOR)
      SINNOR=SIN(ANGNOR)
      THETA=COSNOR*COSX+SINNOR*COSY
C     ABSORBER THICKNESS TRAVERSED BY THE PARTICLE.
C     D=7.88/ABS(THETA)    <--- OLD VERSION
      D=0.97*8.9/ABS(THETA)
C
C  FOR MC EVENTS, GET CORRECT THICKNESS FOR 1984-86
C
      IPHEAD = IDATA(IBLN('HEAD'))
      IPHEA2 = 2*IPHEAD
      HRUN = HDATA(IPHEA2+10)
C
      IF(HRUN.LT.100.AND.HDATE(6).GT.1983) D=1.04*8.9/ABS(THETA)
      THETA=ARCOS(THETA)*57.2958
      IF(IPRO.NE.0) WRITE(6,910) ITH,ANGNOR,COSNOR,SINNOR,THETA,D
 910  FORMAT(' ITH ',I4,' ANGN COSN SINN TH D ',5E12.4)
      IF(D.LT.50.) GO TO 70
      IFLAG=3
      RETURN
C
C     ITERATION
70    ITERA=1
      EINC=ENERGY
C
C        ENERGY LOSS IN THE COIL
C
21    CONTINUE
C
      IF(IPRO.NE.0) WRITE(6,2361) EINC,D,ETHRE
2361  FORMAT(' FOR ENGLOS  EINC D ETHRE ',3E12.4)
C
      CALL ENGLOS(EINC,D,DELTAE,&80)
      EEXP=EINC-DELTAE
C
      IF(IPRO.NE.0) WRITE(6,2362) EEXP,DELTAE
2362  FORMAT(' AFT ENGLOS  EEXP DELTAE ',3E12.4)
C
      IF(EEXP.GT.0.) GO TO 22
      EINC=EINC+ETHRE
      GO TO 21
C
C       ANGLE DEPENDENCE
C
22    CONTINUE
C
      IF(IPRO.NE.0) WRITE(6,2363) EEXP,THETA
2363  FORMAT(' FOR ANGBAR  EEXP THETA ',3E12.4)
C
      CALL ANGBAR(EEXP,THETA,AFAC,&80)
      EEXP= EEXP*AFAC
C
      IF(IPRO.NE.0) WRITE(6,2364) EEXP,AFAC
2364  FORMAT(' AFT ANGBAR  EEXP AFAC ',3E12.4)
C
C
C       FINE POSITION DEPENDENCE
C
      PFAC= BRLGN( EINC, BDATA(11), BDATA(4) )
      EEXP= EEXP*PFAC
C
      IF(IPRO.NE.0) WRITE(6,2365) EEXP,PFAC,BDATA(11),BDATA(4)
2365  FORMAT(' AFT BRLGN  EEXP PFAC BDATA 11 4 ',4E12.4)
C
C
      EDIF= ENERGY -EEXP
C
      IF(IPRO.NE.0) WRITE(6,2366) ITERA,ENERGY,EEXP,EDIF,ETHRE
2366  FORMAT(' ITER ENERGY EEXP EDIF ETHRE ',I3,4E12.4)
C
      IF(ABS(EDIF).LE.ETHRE) GO TO 20
      ITERA=ITERA+1
      IF(ITERA.GT.10) GO TO 50
      EINC=EINC+EDIF
C
      IF(IPRO.NE.0) WRITE(6,2367) ITERA,EINC
2367  FORMAT(' ITER EINC ',I3,4E12.4)
C
      GO TO 21
C
   50 CONTINUE
      IFLAG=1
      RETURN
C
   20 BDATA(2)=EINC
CC      WRITE(6,10100) ENERGY,BDATA(4),BDATA(11),D,
CC     &  EINC,DELTAE,AFAC,PFAC,ITERA
CC10100 FORMAT(' <LGECOR> E',F8.3,', PHI',F6.3,', COSZ',F6.3,', D',F8.3,
CC     &  ', EINC',F8.3,', ELOSS',F6.3,', AFAC',F6.3,', PFAC',F6.3,
CC     &  ', ITERA',I3)
      RETURN
C
C     ILLEGAL RETURN
C
   80 BDATA(2)=ENERGY
      RETURN
C************************************
      ENTRY LGECR0(NVR)
C
C  VERSION NUMBER (DATE)   82  6 13
C
      DATA IVR/820613/
      NVR=IVR
      RETURN
      END
