      SUBROUTINE ENERGY_ADJUST(ENERGY_FACTOR,I,J,IA,IAP,RN1,RN2,WA3,
     1POLANG,FACT_PAR,FACT_PER,PHASE_PAR,PHASE_PER,PATHL)
C     THIS ADJUSTS RAY ENERGY DUE TO COATING LOSSES
C     AND SETS UP ABSORBTION COEFFICIENT DATA FOR PATH TO THE NEXT SURFACE.
      IMPLICIT NONE
      INTEGER I,VALUE,J,WA3,K,ALLOERR,NLAY,L
      CHARACTER CNAME*8,AJ4*8,AB*8
      LOGICAL EXISTCF
      REAL*8 ENERGY_FACTOR,FACTOR,IA,IAP,RN1,RN2,EFF,POLANG,PATHL,
     1ACTIVE_WAVE,THI,LA,MGF2,MGIND,ZNSIND,R1,R2,IAM,T
      REAL*8 NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,NN9,NN10
      REAL*8 KK1,KK2,KK3,KK4,KK5,KK6,KK7,KK8,KK9,KK10
      REAL*8 FACT_PAR,FACT_PER,PHASE_PAR,PHASE_PER
      COMPLEX*16 CINDEX,SMALLTPAR,SMALLTPER,SMALLRPAR,SMALLRPER
      DIMENSION CINDEX(:,:)
      CHARACTER*13 LAYERNAME
      DIMENSION LAYERNAME(:)
      COMPLEX*16 THICKNESS,THETAI,THETAIP,PHI,INDEXI,INDEXIP,INDEXJ
     1,THETAJ,INDEXL
      COMPLEX*16 COSTHETAL,ULPAR,ULPER,THICKNESSL
     1,ROOTONE
      COMPLEX*16 MPAR,MPER,MPARL,MPERL,CPII,CTWO,CACTIVE_WAVE,DELTAL
      REAL*8 T1,T2,T3,T4,T5,T6,CTEMPR,CTEMPI
      COMPLEX*16 CTEMP
      DIMENSION MPAR(2,2),MPER(2,2),MPARL(2,2),MPERL(2,2)
      DIMENSION THICKNESS(:)
      ALLOCATABLE :: CINDEX,LAYERNAME,THICKNESS
      INCLUDE 'DATMAI.INC'
      INCLUDE 'DATLEN.INC'
      LOGICAL TIR
      COMMON/RIT/TIR
      REAL*8 BIGTPAR,BIGTPER,BIGRPAR,BIGRPER
      REAL*8 PHASETPAR,PHASETPER,PHASERPAR,PHASERPER
      REAL*8 R_BIGTPAR,R_BIGRPAR,R_BIGTPER,R_BIGRPER
      REAL*8 R_SMALLTPAR,R_SMALLRPAR,R_SMALLTPER,R_SMALLRPER
        FACT_PAR=0.0D0
        FACT_PER=0.0D0
        PHASE_PAR=0.0D0
        PHASE_PER=0.0D0
C
C       COSPOL IS AN IMPORTANT NUMBER. IT IS THE COSINE OF THE ANGLE
C       BETWEEN THE INCIDENT PLANE DIRECTION AND THE Y=PLANE OF THE RAY
C       FOR ON-AXIS IN THE Y-Z PLANE OF A CENTERED SYSTEM, THE ANGLE IS 0
C       FOR ON-AXIS RAYS IN THE X-Z PLANE OF A CENTERED SYSTEM, THE ANGLE IS
C       PII/2
C
C     NOTE THAT IT IS ASSUMED THAT THE IMAGINARY PART OF THE INCIDENT MEDIUM'S
C     REFRACTIVE INDEX IS ALWAYS ZERO.
C     NOTE THAT IT IS ASSUMED THAT THE IMAGINARY PART OF THE SUBSTRATE MEDIUM'S
C     REFRACTIVE INDEX IS ALWAYS ZERO.
C     TIR CARRIES THE TIR STATE OF THE RAY
C     ACTIVE WAVELENGTH IN MICRONS
      IF(WA3.LE.5) ACTIVE_WAVE=SYSTEM1(WA3)
      IF(WA3.GT.5) ACTIVE_WAVE=SYSTEM1(WA3*65)
      CACTIVE_WAVE=DCMPLX(ACTIVE_WAVE,0.0D0)
      FACTOR=0.0D0
C       COMPLEX REPRESENTATION OF i, THE ROOT OF -1
      ROOTONE=DCMPLX(0.0D0,1.0D0)
C       COMPLEX REPRESENTATION OF PI
      CPII=DCMPLX(3.14159265358979323846D0,0.0D0)
C       COMPLEX REPRESENTATION OF 2.0
      CTWO=DCMPLX(2.0D0,0.0D0)
C     I IS THE SURFACE NUMBER
C     J IS THE FILE NAME/NUMBER
C       SET COMPLEX INDECIES AND ANGLES
C       INDEX OF THE INCIDENT MEDIUM
                INDEXI=DCMPLX(RN1,0.0D0)
C       INDEX OF THE SUBSTRATE
                INDEXIP=DCMPLX(RN2,0.0D0)
C       ANGLE OF INCIDENCE
                THETAI=DCMPLX(IA,0.0D0)
C       ANGLE OF REFRACTION,REFLECTION OR DIFFRACTION
                THETAIP=DCMPLX(IAP,0.0D0)
C
      IF(J.LT.1.OR.J.GT.1000) THEN
C     COATING TYPE 0, NO LOSSES, NO COATING FILE WAS ASSIGNED
      ENERGY_FACTOR=1.0D0
      POLANG=0.0D0
C     NO ABSORBTION LOSSES
                RETURN
                END IF
C
C     J REPRESENTS A FILE NUMBER. SEE IF IT EXISTS
      CALL ITOA4(AJ4,J)
      CNAME='COAT'//AJ4
      EXISTCF=.FALSE.
      INQUIRE(FILE=CNAME//'.DAT',EXIST=EXISTCF)
      IF(.NOT.EXISTCF) THEN
C     NO COATING FILE FOR THAT COATING NUMBER EXISTS, NO LOSSES
      ENERGY_FACTOR=1.0D0
      POLANG=0.0D0
C     NO ABSORBTION LOSSES
                      RETURN
                      ELSE
C     COATING FILE EXISTS, CLOSE IT, THEN OPEN IT
      CALL CLOSE_FILE(34,1)
      OPEN(UNIT=34,ACCESS='SEQUENTIAL',BLANK='NULL'
     1  ,FORM='FORMATTED',FILE=CNAME//'.DAT'
     2  ,STATUS='UNKNOWN')
                      END IF
C       READ THE COATING TYPE
        READ(UNIT=34,FMT=*,ERR=999,END=999) K
        IF(K.NE.1.AND.K.NE.2.AND.K.NE.3.AND.K.NE.4) THEN
        CALL CLOSE_FILE(34,1)
C       NO COATING, NO LOSSES
        ENERGY_FACTOR=1.0D0
      POLANG=0.0D0
C     NO ABSORBTION LOSSES
                RETURN
                END IF

      IF(K.EQ.1) THEN
C     COATING TYPE 1
C     NO LOSSES
      ENERGY_FACTOR=1.0D0
      OLDABSCOEF(1:10)=ABSCOEF(1:10)
      ENERGY_FACTOR=ENERGY_FACTOR*
     1DEXP(-DABS(OLDABSCOEF(INT(WA3))*PATHL))
C     CHECK FOR ABSORB
C     SET DEFAULT
      ABSCOEF(1:10)=0.0D0
      READ(UNIT=34,FMT=*,ERR=9991,END=9991) AB
      READ(UNIT=34,FMT=*,ERR=9991,END=9991) ABSCOEF(1)
      READ(UNIT=34,FMT=*,ERR=9991,END=9991) ABSCOEF(2)
      READ(UNIT=34,FMT=*,ERR=9991,END=9991) ABSCOEF(3)
      READ(UNIT=34,FMT=*,ERR=9991,END=9991) ABSCOEF(4)
      READ(UNIT=34,FMT=*,ERR=9991,END=9991) ABSCOEF(5)
      READ(UNIT=34,FMT=*,ERR=9991,END=9991) ABSCOEF(6)
      READ(UNIT=34,FMT=*,ERR=9991,END=9991) ABSCOEF(7)
      READ(UNIT=34,FMT=*,ERR=9991,END=9991) ABSCOEF(8)
      READ(UNIT=34,FMT=*,ERR=9991,END=9991) ABSCOEF(9)
      READ(UNIT=34,FMT=*,ERR=9991,END=9991) ABSCOEF(10)
9991  CALL CLOSE_FILE(34,1)
      RETURN
      POLANG=0.0D0
      END IF

      IF(K.EQ.2) THEN
      K=5
C     NO COATING IS THE SAME AS A HALF-WAVE COATING
      END IF

      IF(K.EQ.3) THEN
C     COATING TYPE 3, FRACTIONAL EFFICIENCY COATING
      READ(UNIT=34,FMT=*,ERR=999,END=999) EFF
      ENERGY_FACTOR=EFF
      OLDABSCOEF(1:10)=ABSCOEF(1:10)
      ENERGY_FACTOR=ENERGY_FACTOR*
     1DEXP(-DABS(OLDABSCOEF(INT(WA3))*PATHL))
C     CHECK FOR ABSORB
C     SET DEFAULT
      ABSCOEF(1:10)=0.0D0
      READ(UNIT=34,FMT=*,ERR=9992,END=9992) AB
      READ(UNIT=34,FMT=*,ERR=9992,END=9992) ABSCOEF(1)
      READ(UNIT=34,FMT=*,ERR=9992,END=9992) ABSCOEF(2)
      READ(UNIT=34,FMT=*,ERR=9992,END=9992) ABSCOEF(3)
      READ(UNIT=34,FMT=*,ERR=9992,END=9992) ABSCOEF(4)
      READ(UNIT=34,FMT=*,ERR=9992,END=9992) ABSCOEF(5)
      READ(UNIT=34,FMT=*,ERR=9992,END=9992) ABSCOEF(6)
      READ(UNIT=34,FMT=*,ERR=9992,END=9992) ABSCOEF(7)
      READ(UNIT=34,FMT=*,ERR=9992,END=9992) ABSCOEF(8)
      READ(UNIT=34,FMT=*,ERR=9992,END=9992) ABSCOEF(9)
      READ(UNIT=34,FMT=*,ERR=9992,END=9992) ABSCOEF(10)
9992  CALL CLOSE_FILE(34,1)
C     FIX FOR TIR
      IF(TIR) ENERGY_FACTOR=1.0D0
      CALL CLOSE_FILE(34,1)
      POLANG=0.0D0
                       RETURN
                       END IF
C

      IF(K.EQ.4.OR.K.EQ.5) THEN
C     COATING TYPE 4
      ALLOCATE (CINDEX(1:100,1:10),LAYERNAME(1:100),THICKNESS(1:100),
     1STAT=ALLOERR)
C     A MULTILAYER COATING, ASSUMING NO-COHERENCE
C     IF RN1 AND RN2 HAVE OPPOSITE SIGNS THEN WE HAVE A REFLECTION
C     SO WE USE THE R VALUE
C     IF RN1 AND RN2 HAVE THE SAME SIGNS THEN WE HAVE A REFRACTION
C     SO WE USE THE T VALUE
                        NLAY=0
                        IF(K.EQ.4) THEN
                        DO L=1,100
      READ(UNIT=34,FMT=*,ERR=888,END=888)LAYERNAME(L),
     1NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,NN9,NN10,
     2KK1,KK2,KK3,KK4,KK5,KK6,KK7,KK8,KK9,KK10,T
                        NLAY=NLAY+1
      CINDEX(L,1)=DCMPLX(NN1,KK1)
      CINDEX(L,2)=DCMPLX(NN2,KK2)
      CINDEX(L,3)=DCMPLX(NN3,KK3)
      CINDEX(L,4)=DCMPLX(NN4,KK4)
      CINDEX(L,5)=DCMPLX(NN5,KK5)
      CINDEX(L,6)=DCMPLX(NN6,KK6)
      CINDEX(L,7)=DCMPLX(NN7,KK7)
      CINDEX(L,8)=DCMPLX(NN8,KK8)
      CINDEX(L,9)=DCMPLX(NN9,KK9)
      CINDEX(L,10)=DCMPLX(NN10,KK10)
      THICKNESS(L)=DCMPLX(T,0.0D0)
                        END DO
      OLDABSCOEF(1:10)=ABSCOEF(1:10)
      ENERGY_FACTOR=ENERGY_FACTOR*
     1DEXP(-DABS(OLDABSCOEF(INT(WA3))*PATHL))
C     CHECK FOR ABSORB
C     SET DEFAULT
      ABSCOEF(1:10)=0.0D0
      READ(UNIT=34,FMT=*,ERR=9993,END=9993) AB
      READ(UNIT=34,FMT=*,ERR=9993,END=9993) ABSCOEF(1)
      READ(UNIT=34,FMT=*,ERR=9993,END=9993) ABSCOEF(2)
      READ(UNIT=34,FMT=*,ERR=9993,END=9993) ABSCOEF(3)
      READ(UNIT=34,FMT=*,ERR=9993,END=9993) ABSCOEF(4)
      READ(UNIT=34,FMT=*,ERR=9993,END=9993) ABSCOEF(5)
      READ(UNIT=34,FMT=*,ERR=9993,END=9993) ABSCOEF(6)
      READ(UNIT=34,FMT=*,ERR=9993,END=9993) ABSCOEF(7)
      READ(UNIT=34,FMT=*,ERR=9993,END=9993) ABSCOEF(8)
      READ(UNIT=34,FMT=*,ERR=9993,END=9993) ABSCOEF(9)
      READ(UNIT=34,FMT=*,ERR=9993,END=9993) ABSCOEF(10)
9993  CALL CLOSE_FILE(34,1)
                        END IF
                        IF(K.EQ.5) THEN
                        NLAY=1
                        END IF
 888                    CONTINUE
C     NLAY AT LEAST 1, CONTINUE
C
                       DO L=1,NLAY
C     CONSTRUCT THE 2X2 L-LAYER MATRIX
C     INDEXL IS THE COMPLEX INDEX AT THE TRACED WAVELENGTH FOR THE L-TH LAYER
      IF(K.EQ.4) INDEXL=CINDEX(L,WA3)
      IF(K.EQ.5) INDEXL=INDEXIP
C       T1 IS THE REAL PART OF THE LAYER INDEX
      T1=DBLE(INDEXL)
C       T2 IS THE IMAGINARY PART OF THE LAYER INDEX
      T2=DIMAG(INDEXL)
C       T3 IS THE REAL PART OF THE LAYER THICKNESS
      IF(K.EQ.4) T3=DBLE(THICKNESSL)
      IF(K.EQ.5) T3=DBLE(0.50D0*CACTIVE_WAVE)
C       T4 IS THE REAL PART OF THE INCIDENT MEDIA INDEX
      T4=DBLE(INDEXI)
C       T5 IS THE REAL PART OF THE SINE OF THE INCIDENT ANGLE
      T5=DSIN(IA)
C
      CTEMPR=(T1**2)-(T2**2)-((T4**2)*(DSIN(IA)**2))
      CTEMPI=2.0D0*T1*T2
      CTEMP=DCMPLX(CTEMPR,CTEMPI)
      CTEMP=CDSQRT(CTEMP)
      COSTHETAL=CTEMP/INDEXL
C     THICKNESS OF L IN MICRONS IS:
      IF(K.EQ.4) THICKNESSL=THICKNESS(L)
      IF(K.EQ.5) THICKNESSL=DCMPLX(T3)
C     COS(PHIL)*THE COMPLEX INDEX OF THE LAYER IS JUST:
C     U SUB L PARALLEL IS:
      ULPAR=INDEXL/COSTHETAL
C     U SUB L PERPENDICULAR IS:
      ULPER=INDEXL*COSTHETAL
C     DELTAL IS:
      DELTAL=(CTWO*CPII/CACTIVE_WAVE)*(INDEXL*THICKNESSL*COSTHETAL)
C     THE LAYER MATRIX FOR PARALLEL POLARIZATION IS:
      MPARL(1,1)=CDCOS(DELTAL)
      MPARL(1,2)=-(ROOTONE/ULPAR)*CDSIN(DELTAL)
      MPARL(2,1)=-ROOTONE*ULPAR*CDSIN(DELTAL)
      MPARL(2,2)=MPARL(1,1)
C     THE LAYER MATRIX FOR PERPENDICULAR POLARIZATION IS:
      MPERL(1,1)=CDCOS(DELTAL)
      MPERL(1,2)=-(ROOTONE/ULPER)*CDSIN(DELTAL)
      MPERL(2,1)=-ROOTONE*ULPER*CDSIN(DELTAL)
      MPERL(2,2)=MPERL(1,1)
C     MULTIPLY THE CURRENT L-LAYER M-MATRIX INTO THE FINAL M-MATRIX
                       IF(L.EQ.1) THEN
        MPAR(1,1)=MPARL(1,1)
        MPAR(1,2)=MPARL(1,2)
        MPAR(2,1)=MPARL(2,1)
        MPAR(2,2)=MPARL(2,2)
        MPER(1,1)=MPERL(1,1)
        MPER(1,2)=MPERL(1,2)
        MPER(2,1)=MPERL(2,1)
        MPER(2,2)=MPERL(2,2)
                       ELSE
C     L GREATER THAN 1
        MPAR=MATMUL(MPARL,MPAR)
        MPER=MATMUL(MPERL,MPER)
                       END IF
                       END DO
C
C       NOW COMPUTE THE AMPLITUDE TRANSMITTANCE AND REFLECTANCE
C       COEFFICIENTS SMALLTPAR, SMALLTPER, SMALLRPAR AND SMALLRPER
        SMALLRPAR=((MPAR(1,1)*INDEXI)
     1  +(MPAR(1,2)*INDEXI*INDEXIP)
     2  -(MPAR(2,1))
     3  -(MPAR(2,2)*INDEXIP))/
     4   ((MPAR(1,1)*INDEXI)
     5  +(MPAR(1,2)*INDEXI*INDEXIP)
     6  +(MPAR(2,1))
     7  +(MPAR(2,2)*INDEXIP))
        SMALLRPER=((MPER(1,1)*INDEXI)
     1  +(MPER(1,2)*INDEXI*INDEXIP)
     2  -(MPER(2,1))
     3  -(MPER(2,2)*INDEXIP))/
     4   ((MPER(1,1)*INDEXI)
     5  +(MPER(1,2)*INDEXI*INDEXIP)
     6  +(MPER(2,1))
     7  +(MPER(2,2)*INDEXIP))
        SMALLTPAR=(CTWO*INDEXI)/
     1   ((MPAR(1,1)*INDEXI)
     2  +(MPAR(1,2)*INDEXI*INDEXIP)
     3  +(MPAR(2,1))
     4  +(MPAR(2,2)*INDEXIP))
        SMALLTPER=(CTWO*INDEXI)/
     1   ((MPER(1,1)*INDEXI)
     2  +(MPER(1,2)*INDEXI*INDEXIP)
     3  +(MPER(2,1))
     4  +(MPER(2,2)*INDEXIP))
C
C       THE INTENSITY TRANSMISSION AND REFLECTION COEFFICIENTS ARE:
        BIGTPAR=CDABS(INDEXIP/INDEXI)*((CDABS(SMALLTPAR))**2)
        BIGTPER=CDABS(INDEXIP/INDEXI)*((CDABS(SMALLTPER))**2)
        BIGRPAR=CDABS(SMALLRPAR)**2
        BIGRPER=CDABS(SMALLRPER)**2
        PHASETPAR=DATAN2(DBLE(SMALLTPAR),DIMAG(SMALLTPAR))
        PHASETPER=DATAN2(DBLE(SMALLTPER),DIMAG(SMALLTPER))
        PHASERPAR=DATAN2(DBLE(SMALLRPAR),DIMAG(SMALLRPAR))
        PHASERPER=DATAN2(DBLE(SMALLRPER),DIMAG(SMALLRPER))
C       NOW POLANG IS ANGLE BETWEEN THE PLANE OF INCIDENCE AND THE
C       PLANE FORMED BY THE "Y" RAY AND THE "Z" RAY VECTORS
C       THE T AND R COMPONENTS IN THE "Y" DIRECTION ARE:
      IF(RN1.GT.0.0D0.AND.RN2.GT.0.0D0.OR.RN1.LT.0.0D0.AND.RN2.LT.
     10.0D0) THEN
C     REFRACTION
      OLDABSCOEF(1:10)=ABSCOEF(1:10)
      ENERGY_FACTOR=(BIGTPAR+BIGTPER)/2.0D0
      ENERGY_FACTOR=ENERGY_FACTOR*
     1DEXP(-DABS(OLDABSCOEF(INT(WA3))*PATHL))
        FACT_PAR=BIGTPAR
        FACT_PER=BIGTPER
        PHASE_PAR=PHASETPAR
        PHASE_PER=PHASETPER
C     CHECK FOR ABSORB
C     SET DEFAULT
      ABSCOEF(1:10)=0.0D0
      READ(UNIT=34,FMT=*,ERR=9994,END=9994) AB
      READ(UNIT=34,FMT=*,ERR=9994,END=9994) ABSCOEF(1)
      READ(UNIT=34,FMT=*,ERR=9994,END=9994) ABSCOEF(2)
      READ(UNIT=34,FMT=*,ERR=9994,END=9994) ABSCOEF(3)
      READ(UNIT=34,FMT=*,ERR=9994,END=9994) ABSCOEF(4)
      READ(UNIT=34,FMT=*,ERR=9994,END=9994) ABSCOEF(5)
      READ(UNIT=34,FMT=*,ERR=9994,END=9994) ABSCOEF(6)
      READ(UNIT=34,FMT=*,ERR=9994,END=9994) ABSCOEF(7)
      READ(UNIT=34,FMT=*,ERR=9994,END=9994) ABSCOEF(8)
      READ(UNIT=34,FMT=*,ERR=9994,END=9994) ABSCOEF(9)
      READ(UNIT=34,FMT=*,ERR=9994,END=9994) ABSCOEF(10)
9994  CALL CLOSE_FILE(34,1)
                       ELSE

C     REFLECTION
      ENERGY_FACTOR=(BIGRPAR+BIGRPER)/2.0D0
      OLDABSCOEF(1:10)=ABSCOEF(1:10)
      ENERGY_FACTOR=ENERGY_FACTOR*
     1DEXP(-DABS(OLDABSCOEF(INT(WA3))*PATHL))
        FACT_PAR=BIGRPAR
        FACT_PER=BIGRPER
        PHASE_PAR=PHASERPAR
        PHASE_PER=PHASERPER
C     CHECK FOR ABSORB
C     SET DEFAULT
      ABSCOEF(1:10)=0.0D0
      READ(UNIT=34,FMT=*,ERR=9995,END=9995) AB
      READ(UNIT=34,FMT=*,ERR=9995,END=9995) ABSCOEF(1)
      READ(UNIT=34,FMT=*,ERR=9995,END=9995) ABSCOEF(2)
      READ(UNIT=34,FMT=*,ERR=9995,END=9995) ABSCOEF(3)
      READ(UNIT=34,FMT=*,ERR=9995,END=9995) ABSCOEF(4)
      READ(UNIT=34,FMT=*,ERR=9995,END=9995) ABSCOEF(5)
      READ(UNIT=34,FMT=*,ERR=9995,END=9995) ABSCOEF(6)
      READ(UNIT=34,FMT=*,ERR=9995,END=9995) ABSCOEF(7)
      READ(UNIT=34,FMT=*,ERR=9995,END=9995) ABSCOEF(8)
      READ(UNIT=34,FMT=*,ERR=9995,END=9995) ABSCOEF(9)
      READ(UNIT=34,FMT=*,ERR=9995,END=9995) ABSCOEF(10)
9995  CALL CLOSE_FILE(34,1)
      IF(TIR) ENERGY_FACTOR=1.0D0
        IF(TIR) THEN
      PHASE_PAR=-PII/2.0D0
      PHASE_PER=-PII/2.0D0
      FACT_PAR=1.0D0
      FACT_PER=1.0D0
      POLANG=0.0D0
                        END IF
                       END IF
      DEALLOCATE (CINDEX,LAYERNAME,THICKNESS,STAT=ALLOERR)
                       POLEXT=.TRUE.
                       RETURN
                       END IF
C**********************************************************************
 999                   ENERGY_FACTOR=1.0D0
      POLANG=0.0D0
                       CALL CLOSE_FILE(34,1)
      DEALLOCATE (CINDEX,LAYERNAME,THICKNESS,STAT=ALLOERR)
C       FILE READ ERROR
C**********************************************************************
                       RETURN
                       END
