!+ Subroutine to find the optical depth and single scattering albedo.
!
! Method:
!	Depending on the treatment of scattering, the optical and
!	and single scattering albedo are determined from the 
!	extinctions supplied.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!	Version		Date			Comment
!	1.0		12-04-95		First Version under RCS
!						(J. M. Edwards)
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
      SUBROUTINE SINGLE_SCATTERING(I_SCATTER_METHOD_BAND
     &   , N_PROFILE, N_LAYER, I_TOP
     &   , D_MASS
     &   , K_GREY_TOT, K_EXT_SCAT, K_GAS_ABS
     &   , TAU, OMEGA
     &   )
!
!
!
      IMPLICIT NONE
!
!
!     INCLUSION OF HEADER FILES.
      INCLUDE 'incl/dimensions_field.ucf'
      INCLUDE 'incl/prec_machine.ucf'
      INCLUDE 'incl/scatter_method.pcf'
!
!     DUMMY VARIABLES.
      INTEGER	!, INTENT(IN)
     &     I_SCATTER_METHOD_BAND
!             TREATMENT OF SCATTERING IN THIS BAND
!
!			Atmospheric Properties
      INTEGER	!, INTENT(IN)
     &     N_PROFILE
!             NUMBER OF PROFILES
     &   , N_LAYER
!             NUMBER OF LAYERS
     &   , I_TOP
!             TOP LAYER TO CONSIDER
      REAL*8	!, INTENT(IN)
     &     D_MASS(NPD_PROFILE, NPD_LAYER)
!             MASS THICKNESS OF EACH LAYER
!
!			Optical Propeties
      REAL*8	!, INTENT(IN)
     &     K_GREY_TOT(NPD_PROFILE, NPD_LAYER)
!             ABSORPTIVE EXTINCTION
     &   , K_EXT_SCAT(NPD_PROFILE, NPD_LAYER)
!             SCATTERING EXTINCTION
     &   , K_GAS_ABS(NPD_PROFILE, NPD_LAYER)
!             GASEOUS EXTINCTION
!
!			Single Scattering Propeties
      REAL*8	!, INTENT(OUT)
     &     TAU(NPD_PROFILE, NPD_LAYER)
!             OPTICAL DEPTH
     &   , OMEGA(NPD_PROFILE, NPD_LAYER)
!             SINGLE SCATTERING ALBEDO
!
!
!
!     LOCAL VARIABLES.
      INTEGER
     &     L
!             LOOP VARIABLE
     &   , I
!             LOOP VARIABLE
!
!
!
!     THE MACHINE TOLERANCE IS ADDED TO THE DENOMINATOR IN THE 
!     EXPRESSION FOR OMEGA TO PREVENT DIVISION BY ZERO: THIS IS 
!     SIGNIFICANT ONLY IF THE TOTAL EXTINCTION IS SMALL, AND THUS 
!     WILL NOT SENSIBLY AFFECT ANY PHYSICAL RESULTS.
!
      IF (I_SCATTER_METHOD_BAND.EQ.IP_SCATTER_FULL) THEN
!
         DO I=I_TOP, N_LAYER
            DO L=1, N_PROFILE
               TAU(L, I)=(K_GREY_TOT(L, I)+K_GAS_ABS(L, I))
     &            *D_MASS(L, I)
               OMEGA(L, I)=K_EXT_SCAT(L, I)
     &            /(K_GREY_TOT(L, I)+K_GAS_ABS(L, I)+TOL_MACHINE)
            ENDDO
         ENDDO
!
      ELSE IF (I_SCATTER_METHOD_BAND.EQ.IP_NO_SCATTER_ABS) THEN
!
!        THE SCATTERING EXTINCTION IS IGNORED COMPLETELY, SO
!        ONLY THE ABSORPTIVE CONTRIBUTIONS TO THE SINGLE
!        SCATTERING PROPETIES ARE INCLUDED.
!
         DO I=I_TOP, N_LAYER
            DO L=1, N_PROFILE
               TAU(L, I)=(K_GREY_TOT(L, I)+K_GAS_ABS(L, I)
     &            -K_EXT_SCAT(L, I))*D_MASS(L, I)
               OMEGA(L, I)=0.0
            ENDDO
         ENDDO
!
      ELSE IF (I_SCATTER_METHOD_BAND.EQ.IP_NO_SCATTER_EXT) THEN
!
!        THE SCATTERING EXTINCTION IS ADDED ON TO THE ABSORPTION.
!
         DO I=I_TOP, N_LAYER
            DO L=1, N_PROFILE
               TAU(L, I)=(K_GREY_TOT(L, I)+K_GAS_ABS(L, I))
     &            *D_MASS(L, I)
               OMEGA(L, I)=0.0D+00
            ENDDO
         ENDDO
!
      ENDIF
!
!
!
      RETURN
      END
