!+ Subroutine to calculate the absorptive extinctions of gases.
!
! Method:
!	Straightforward.
!
! 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 GAS_OPTICAL_PROPERTIES(N_PROFILE, N_LAYER
     &   , N_GAS, I_GAS_POINTER, K_ESFT_MONO, GAS_MIX_RATIO
     &   , K_GAS_ABS
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUSION OF HEADER FILES.
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/dimensions_field.ucf'
!
!     DUMMY VARIABLES.
      INTEGER	!, INTENT(IN)
     &     N_PROFILE
!             NUMBER OF PROFILES
     &   , N_LAYER
!             NUMBER OF LAYERS
     &   , N_GAS
!             NUMBER OF GASES
     &   , I_GAS_POINTER(NPD_SPECIES)
!             POINTERS TO ACTIVE GASES
      REAL*8	!, INTENT(IN)
     &     K_ESFT_MONO(NPD_SPECIES)
!             ESFT EXPONENTS FOR EACH GAS
     &   , GAS_MIX_RATIO(NPD_PROFILE, 0: NPD_LAYER, NPD_SPECIES)
!             GAS MIXING RATIOS
      REAL*8	!, INTENT(OUT)
     &     K_GAS_ABS(NPD_PROFILE, NPD_LAYER)
!             CLEAR ABSORPTIVE EXTINCTION
!
!     LOCAL VARIABLES.
      INTEGER
     &     I_GAS
!             TEMPORARY GAS INDEX
     &   , L
!             LOOP VARIABLE
     &   , I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
!
!
!     CALCULATE THE ABSORPTION FOR THE FIRST GAS AND ADD ON THE REST.
      I_GAS=I_GAS_POINTER(1)
      DO J=1, N_LAYER
         DO L=1, N_PROFILE
            K_GAS_ABS(L, J)
     &         =K_ESFT_MONO(I_GAS)*GAS_MIX_RATIO(L, J, I_GAS)
c              print*,L,J,K_GAS_ABS(L,J)
         ENDDO
      ENDDO
      DO I=2, N_GAS
      I_GAS=I_GAS_POINTER(I)
         DO J=1, N_LAYER
            DO L=1, N_PROFILE
               K_GAS_ABS(L, J)=K_GAS_ABS(L, J)
     &            +K_ESFT_MONO(I_GAS)*GAS_MIX_RATIO(L, J, I_GAS)
c               print*,L,J,K_GAS_ABS(L,J)
            ENDDO
         ENDDO
      ENDDO
!
!
      RETURN
      END
