C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.            RAD_ALL.7605  
C                                                                                  RAD_ALL.7606  
C Use, duplication or disclosure of this code is subject to the                    RAD_ALL.7607  
C restrictions as set forth in the contract.                                       RAD_ALL.7608  
C                                                                                  RAD_ALL.7609  
C                Meteorological Office                                             RAD_ALL.7610  
C                London Road                                                       RAD_ALL.7611  
C                BRACKNELL                                                         RAD_ALL.7612  
C                Berkshire UK                                                      RAD_ALL.7613  
C                RG12 2SZ                                                          RAD_ALL.7614  
C                                                                                  RAD_ALL.7615  
C If no contract has been raised with this copy of the code, the use,              RAD_ALL.7616  
C duplication or disclosure of it is strictly prohibited.  Permission              RAD_ALL.7617  
C to do so must first be obtained in writing from the Head of Numerical            RAD_ALL.7618  
C Modelling at the above address.                                                  RAD_ALL.7619  
C ******************************COPYRIGHT******************************            RAD_ALL.7620  
C                                                                                  RAD_ALL.7621  
!+ Subroutine to calculate the absorptive extinctions of gases.                    RAD_ALL.7622  
!                                                                                  RAD_ALL.7623  
! Method:                                                                          RAD_ALL.7624  
!       Straightforward.                                                           RAD_ALL.7625  
!                                                                                  RAD_ALL.7626  
! Current Owner of Code: J. M. Edwards                                             RAD_ALL.7627  
!                                                                                  RAD_ALL.7628  
! History:                                                                         RAD_ALL.7629  
!       Version         Date                    Comment                            RAD_ALL.7630  
!       4.0             27-07-95                Original Code                      RAD_ALL.7631  
!                                               (J. M. Edwards)                    RAD_ALL.7632  
!                                                                                  RAD_ALL.7633  
! Description of Code:                                                             RAD_ALL.7634  
!   FORTRAN 77  with extensions listed in documentation.                           RAD_ALL.7635  
!                                                                                  RAD_ALL.7636  
!- ---------------------------------------------------------------------           RAD_ALL.7637  
      SUBROUTINE GAS_OPTICAL_PROPERTIES(N_PROFILE, N_LAYER                         RAD_ALL.7638  
     &   , N_GAS, I_GAS_POINTER, K_ESFT_MONO, GAS_MIX_RATIO                        RAD_ALL.7639  
     &   , K_GAS_ABS                                                               RAD_ALL.7640  
     &   , NPD_PROFILE, NPD_LAYER, NPD_SPECIES                                     RAD_ALL.7641  
     &   )                                                                         RAD_ALL.7642  
!                                                                                  RAD_ALL.7643  
!                                                                                  RAD_ALL.7644  
      IMPLICIT NONE                                                                RAD_ALL.7645  
!                                                                                  RAD_ALL.7646  
!                                                                                  RAD_ALL.7647  
!     SIZES OF DUMMY ARRAYS.                                                       RAD_ALL.7648  
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.7649  
     &     NPD_PROFILE                                                             RAD_ALL.7650  
!             MAXIMUM NUMBER OF PROFILES                                           RAD_ALL.7651  
     &   , NPD_LAYER                                                               RAD_ALL.7652  
!             MAXIMUM NUMBER OF LAYERS                                             RAD_ALL.7653  
     &   , NPD_SPECIES                                                             RAD_ALL.7654  
!             MAXIMUM NUMBER OF GASEOUS SPECIES                                    RAD_ALL.7655  
!                                                                                  RAD_ALL.7656  
!     DUMMY VARIABLES.                                                             RAD_ALL.7657  
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.7658  
     &     N_PROFILE                                                               RAD_ALL.7659  
!             NUMBER OF PROFILES                                                   RAD_ALL.7660  
     &   , N_LAYER                                                                 RAD_ALL.7661  
!             NUMBER OF LAYERS                                                     RAD_ALL.7662  
     &   , N_GAS                                                                   RAD_ALL.7663  
!             NUMBER OF GASES                                                      RAD_ALL.7664  
     &   , I_GAS_POINTER(NPD_SPECIES)                                              RAD_ALL.7665  
!             POINTERS TO ACTIVE GASES                                             RAD_ALL.7666  
      REAL      !, INTENT(IN)                                                      RAD_ALL.7667  
     &     K_ESFT_MONO(NPD_SPECIES)                                                RAD_ALL.7668  
!             ESFT EXPONENTS FOR EACH GAS                                          RAD_ALL.7669  
     &   , GAS_MIX_RATIO(NPD_PROFILE, 0: NPD_LAYER, NPD_SPECIES)                   RAD_ALL.7670  
!             GAS MIXING RATIOS                                                    RAD_ALL.7671  
      REAL      !, INTENT(OUT)                                                     RAD_ALL.7672  
     &     K_GAS_ABS(NPD_PROFILE, NPD_LAYER)                                       RAD_ALL.7673  
!             CLEAR ABSORPTIVE EXTINCTION                                          RAD_ALL.7674  
!                                                                                  RAD_ALL.7675  
!     LOCAL VARIABLES.                                                             RAD_ALL.7676  
      INTEGER                                                                      RAD_ALL.7677  
     &     I_GAS                                                                   RAD_ALL.7678  
!             TEMPORARY GAS INDEX                                                  RAD_ALL.7679  
     &   , L                                                                       RAD_ALL.7680  
!             LOOP VARIABLE                                                        RAD_ALL.7681  
     &   , I                                                                       RAD_ALL.7682  
!             LOOP VARIABLE                                                        RAD_ALL.7683  
     &   , J                                                                       RAD_ALL.7684  
!             LOOP VARIABLE                                                        RAD_ALL.7685  
!                                                                                  RAD_ALL.7686  
!                                                                                  RAD_ALL.7687  
!     CALCULATE THE ABSORPTION FOR THE FIRST GAS AND ADD ON THE REST.              RAD_ALL.7688  
      I_GAS=I_GAS_POINTER(1)                                                       RAD_ALL.7689  
      DO J=1, N_LAYER                                                              RAD_ALL.7690  
         DO L=1, N_PROFILE                                                         RAD_ALL.7691  
            K_GAS_ABS(L, J)                                                        RAD_ALL.7692  
     &         =K_ESFT_MONO(I_GAS)*GAS_MIX_RATIO(L, J, I_GAS)                      RAD_ALL.7693  
         ENDDO                                                                     RAD_ALL.7694  
      ENDDO                                                                        RAD_ALL.7695  
      DO I=2, N_GAS                                                                RAD_ALL.7696  
      I_GAS=I_GAS_POINTER(I)                                                       RAD_ALL.7697  
         DO J=1, N_LAYER                                                           RAD_ALL.7698  
            DO L=1, N_PROFILE                                                      RAD_ALL.7699  
               K_GAS_ABS(L, J)=K_GAS_ABS(L, J)                                     RAD_ALL.7700  
     &            +K_ESFT_MONO(I_GAS)*GAS_MIX_RATIO(L, J, I_GAS)                   RAD_ALL.7701  
            ENDDO                                                                  RAD_ALL.7702  
         ENDDO                                                                     RAD_ALL.7703  
      ENDDO                                                                        RAD_ALL.7704  
!                                                                                  RAD_ALL.7705  
!                                                                                  RAD_ALL.7706  
      RETURN                                                                       RAD_ALL.7707  
      END       
