!+ Subroutine to calculate grey extinctions.
!
! Method:
!	For each activated optical process, excluding gaseous 
!	absorption, increments are calculated for the total and
!	scattering extinctions, and the products of the asymmetry
!	factor and the forward scattering factor in clear and
!	cloudy regions. These increments are summed, and the grey
!	total and scattering extinctions and the asymmetry and forward
!	scattering factors are thus calculated.
!
! 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 GREY_EXTINCTION(IERR
     &   , N_PROFILE, N_LAYER, L_LAYER, P, T, DENSITY
     &   , L_RESCALE
     &   , L_RAYLEIGH, RAYLEIGH_COEFF
     &   , L_CONTINUUM, N_CONTINUUM, I_CONTINUUM_POINTER, K_CONTINUUM
     &   , AMOUNT_CONTINUUM
     &   , L_AEROSOL, N_AEROSOL, AEROSOL_MIX_RATIO
     &   , I_AEROSOL_PARAMETRIZATION
     &   , I_HUMIDITY_POINTER, HUMIDITIES, DELTA_HUMIDITY
     &   , MEAN_REL_HUMIDITY
     &   , AEROSOL_ABSORPTION, AEROSOL_SCATTERING, AEROSOL_ASYMMETRY
     &   , N_AEROSOL_DATA_LAYER, OBS_AEROSOL_PRESSURE
     &   , OBS_AEROSOL_ABSORPTION, OBS_AEROSOL_SCATTERING
     &   , OBS_AEROSOL_ASYMMETRY
     &   , L_CLOUD, N_CLOUD_PROFILE, I_CLOUD_PROFILE, N_CLOUD_TOP
     &   , L_CLOUD_LAYER, I_CLOUD
     &   , N_CONDENSED, L_CLOUD_CMP, I_PHASE_CMP
     &   , I_CONDENSED_PARAM, CONDENSED_PARAM_LIST
     &   , CONDENSED_MIX_RATIO, CONDENSED_RE
     &   , N_CLOUD_TYPE, I_CLOUD_TYPE
     &   , N_LAYER_DROP_DATA, DROP_PRESSURE, DROP_ABSORPTION
     &   , DROP_SCATTERING, DROP_ASYMMETRY
     &   , N_LAYER_ICE_DATA, ICE_PRESSURE
     &   , ICE_ABSORPTION, ICE_SCATTERING
     &   , ICE_ASYMMETRY
     &   , K_EXT_TOT_FREE, K_EXT_SCAT_FREE, ASYMMETRY_FREE
     &   , FORWARD_SCATTER_FREE
     &   , K_EXT_TOT_CLOUD, K_EXT_SCAT_CLOUD
     &   , ASYMMETRY_CLOUD, FORWARD_SCATTER_CLOUD
     &   )
!
!
!
      IMPLICIT NONE
!
!
!     INCLUSION OF HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/dimensions_field.ucf'
      INCLUDE 'incl/dimensions_fixed.pcf'
      INCLUDE 'incl/prec_machine.ucf'
      INCLUDE 'incl/precision.pcf'
      INCLUDE 'incl/aerosol_parametrization.pcf'
      INCLUDE 'incl/cloud_scheme.pcf'
      INCLUDE 'incl/phase.pcf'
      INCLUDE 'incl/layer_distrib.ucf'
      INCLUDE 'incl/error.pcf'
!
!
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
!
!
!     BASIC ATMOSPHERIC PROPERTIES:
!
      LOGICAL	!, INTENT(IN)
     &     L_LAYER
!             VARIABLES GIVEN IN LAYERS
!
      INTEGER	!, INTENT(IN)
     &     N_PROFILE
!             NUMBER OF PROFILES
     &   , N_LAYER
!             NUMBER OF LAYERS
!
      REAL*8	!, INTENT(IN)
     &     P(NPD_PROFILE, 0: NPD_LAYER)
!             PRESSURE
     &   , T(NPD_PROFILE, 0: NPD_LAYER)
!             TEMPERATURE
     &   , DENSITY(NPD_PROFILE, 0: NPD_LAYER)
!             DENSITY AT LEVELS
!
!
!     OPTICAL SWITCHES:
      LOGICAL	!, INTENT(IN)
     &     L_RESCALE
!             DELTA-RESCALING REQUIRED
!
!
!     RAYLEIGH SCATTERING:
!
      LOGICAL	!, INTENT(IN)
     &     L_RAYLEIGH
!             RAYLEIGH SCATTERING ACTIVATED
!
      REAL*8	!, INTENT(IN)
     &     RAYLEIGH_COEFF
!             RAYLEIGH COEFFICIENT
!
!
!     CONTINUUM PROCESSES:
      LOGICAL	!, INTENT(IN)
     &     L_CONTINUUM
!             CONTINUUM ABSORPTION ACTIVATED
!
      INTEGER	!, INTENT(IN)
     &     N_CONTINUUM
!             NUMBER OF CONTINUA
     &   , I_CONTINUUM_POINTER(NPD_CONTINUUM)
!             POINTERS TO ACTIVE CONTINUA
!
      REAL*8	!, INTENT(IN)
     &     K_CONTINUUM(NPD_CONTINUUM)
!             CONTINUUM EXTINCTION
     &   , AMOUNT_CONTINUUM(NPD_PROFILE, 0: NPD_LAYER
     &        , 0: NPD_CONTINUUM)
!             AMOUNTS FOR CONTINUA
!
!
!     PROPERTIES OF AEROSOLS:
!
      LOGICAL	!, INTENT(IN)
     &     L_AEROSOL
!             AEROSOLS ACTIVATED
!
      INTEGER	!, INTENT(IN)
     &     N_AEROSOL
!             NUMBER OF AEROSOL SPECIES
     &   , I_AEROSOL_PARAMETRIZATION(NPD_AEROSOL_SPECIES)
!             PARAMETRIZATIONS OF AEROSOLS
     &   , I_HUMIDITY_POINTER(NPD_PROFILE,  NPD_LAYER)
!             POINTER TO AEROSOL LOOK-UP TABLE
!
      REAL*8	!, INTENT(IN)
     &     AEROSOL_MIX_RATIO(NPD_PROFILE, 0: NPD_LAYER
     &        , NPD_AEROSOL_SPECIES)
!             NUMBER DENSTY OF AEROSOLS
     &   , AEROSOL_ABSORPTION(NPD_HUMIDITIES, NPD_AEROSOL_SPECIES)
!             AEROSOL ABSORPTION IN BAND/MIX RT.
     &   , AEROSOL_SCATTERING(NPD_HUMIDITIES, NPD_AEROSOL_SPECIES)
!             AEROSOL SCATTERING IN BAND/MIX RT.
     &   , AEROSOL_ASYMMETRY(NPD_HUMIDITIES, NPD_AEROSOL_SPECIES)
!             AEROSOL ASYMMETRY IN BAND
     &   , HUMIDITIES(NPD_HUMIDITIES, NPD_AEROSOL_SPECIES)
!             ARRAY OF HUMIDITIES
     &   , DELTA_HUMIDITY
!             INCREMENT IN HUMIDITY
     &   , MEAN_REL_HUMIDITY(NPD_PROFILE, NPD_LAYER)
!             MIXING RATIO OF WATER VAPOUR
!
!     OBSERVATIONAL PROPERTIES OF AEROSOLS:
      INTEGER	!, INTENT(IN)
     &     N_AEROSOL_DATA_LAYER(NPD_AEROSOL_SPECIES)
!             NUMBER OF AEROSOL DATA LAYERS
!
      REAL*8	!, INTENT(IN)
     &     OBS_AEROSOL_PRESSURE(0: NPD_AEROSOL_DATA_LAYER
     &        , NPD_AEROSOL_SPECIES)
!             PRESSURE AT AEROSOL DATA LEVELS
     &   , OBS_AEROSOL_ABSORPTION(0: NPD_AEROSOL_DATA_LAYER
     &        , NPD_AEROSOL_SPECIES)
!             AEROSOL ABSORPTION
     &   , OBS_AEROSOL_SCATTERING(0: NPD_AEROSOL_DATA_LAYER
     &        , NPD_AEROSOL_SPECIES)
!             AEROSOL SCATTERING
     &   , OBS_AEROSOL_ASYMMETRY(0: NPD_AEROSOL_DATA_LAYER
     &        , NPD_AEROSOL_SPECIES)
!             AEROSOL ASYMMETRY
!
!
!     PROPERTIES OF CLOUDS:
!
      LOGICAL	!, INTENT(IN)
     &     L_CLOUD
!             CLOUDS ACTIVATED
!
!     GEOMETRY OF CLOUDS:
!
      LOGICAL	!, INTENT(IN)
     &     L_CLOUD_LAYER
!             CLOUD VARIABLES GIVEN IN LAYERS
!
      INTEGER	!, INTENT(IN)
     &     N_CLOUD_TOP
!             TOPMOST CLOUDY LAYER
     &   , I_CLOUD
!             CLOUD SCHEME TO BE USED
     &   , N_CLOUD_TYPE
!             NUMBER OF TYPES OF CLOUDS
     &   , N_CLOUD_PROFILE(NPD_LAYER)
!             NUMBER OF CLOUDY PROFILES IN EACH LAYER
     &   , I_CLOUD_PROFILE(NPD_PROFILE, NPD_LAYER)
!             PROFILES CONTAINING CLOUDS
     &   , I_CLOUD_TYPE(NPD_CLOUD_COMPONENT)
!             TYPES OF CLOUD TO WHICH EACH COMPONENT CONTRIBUTES
!
!     MICROPHYSICAL QUANTITIES:
      INTEGER	!, INTENT(IN)
     &     N_CONDENSED
!             NUMBER OF CONDENSED COMPONENTS
     &   , I_PHASE_CMP(NPD_CLOUD_COMPONENT)
!             PHASES OF CLOUDY COMPONENTS
     &   , I_CONDENSED_PARAM(NPD_CLOUD_COMPONENT)
!             PARAMETRIZATION SCHEMES FOR CLOUDY COMPONENTS
!
      LOGICAL	!, INTENT(IN)
     &     L_CLOUD_CMP(NPD_CLOUD_COMPONENT)
!             FLAGS TO ACTIVATE CLOUDY COMPONENTS
!
      REAL*8	!, INTENT(IN)
     &     CONDENSED_PARAM_LIST(NPD_CLOUD_PARAMETER
     &        , NPD_CLOUD_COMPONENT)
!             COEFFICIENTS IN PARAMETRIZATION SCHEMES
     &   , CONDENSED_MIX_RATIO(NPD_PROFILE, 0: NPD_LAYER
     &        , NPD_CLOUD_COMPONENT)
!             MIXING RATIOS OF CLOUDY COMPONENTS
     &   , CONDENSED_RE(NPD_PROFILE, 0: NPD_LAYER, NPD_CLOUD_COMPONENT)
!             EFFECTIVE RADII OF CLOUDY COMPONENTS
!
!     OBSERVATIONAL CLOUD PROPERTIES:
      INTEGER	!, INTENT(IN)
     &     N_LAYER_DROP_DATA
!             NUMBER OF WATER CLOUD DATA LAYERS
     &   , N_LAYER_ICE_DATA
!             NUMBER OF ICE CLOUD DATA LAYERS
!
      REAL*8	!, INTENT(IN)
     &     DROP_PRESSURE(0: NPD_CLOUD_DATA_LAYER)
!             PRESSURE AT CLOUD DATA LEVELS
     &   , DROP_ABSORPTION(0: NPD_CLOUD_DATA_LAYER)
!             CLOUD ABSORPTION
     &   , DROP_SCATTERING(0: NPD_CLOUD_DATA_LAYER)
!             CLOUD SCATTERING
     &   , DROP_ASYMMETRY(0: NPD_CLOUD_DATA_LAYER)
!             CLOUD ASYMMETRY
     &   , ICE_PRESSURE(0: NPD_CLOUD_DATA_LAYER)
!             PRESSURE AT ICE CLOUD DATA LEVELS
     &   , ICE_ABSORPTION(0: NPD_CLOUD_DATA_LAYER)
!             ICE CLOUD ABSORPTION
     &   , ICE_SCATTERING(0: NPD_CLOUD_DATA_LAYER)
!             ICE CLOUD SCATTERING
     &   , ICE_ASYMMETRY(0: NPD_CLOUD_DATA_LAYER)
!             ICE CLOUD ASYMMETRY
!
!
!     CALCULATED OPTICAL PROPETIES:
!
      REAL*8	!, INTENT(OUT)
     &     K_EXT_SCAT_FREE(NPD_PROFILE, NPD_LAYER)
!             FREE SCATTERING EXTINCTION
     &   , K_EXT_TOT_FREE(NPD_PROFILE, NPD_LAYER)
!             TOTAL FREE EXTINCTION
     &   , ASYMMETRY_FREE(NPD_PROFILE, NPD_LAYER)
!             FREE ASYMMETRIES
     &   , FORWARD_SCATTER_FREE(NPD_PROFILE, NPD_LAYER)
!             FREE FORWARD SCATTERING
     &   , K_EXT_SCAT_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)
!             CLOUDY SCATTERING EXTINCTION
     &   , K_EXT_TOT_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)
!             TOTAL CLOUDY EXTINCTION
     &   , ASYMMETRY_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)
!             CLOUDY ASYMMETRIES
     &   , FORWARD_SCATTER_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)
!             CLOUDY FORWARD SCATTERING
!
!
!
!     LOCAL VARIABLES.
      INTEGER
     &     I_CONTINUUM
!             TEMPORARY CONTINUUM INDEX
     &   , I_POINTER
!             TEMPORARY POINTER
     &   , L
!             LOOP VARIABLE
     &   , LL
!             LOOP VARIABLE
     &   , I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
     &   , N_INDEX
!             NUMBER OF INDICES SATISFYING TEST
     &   , INDEX(NPD_PROFILE)
!             INDICES OF TESTED POINTS
!
!     TEMPORARY OPTICAL PROPERTIES:
!
      REAL*8
     &     K_EXT_SCAT_CLOUD_COMP(NPD_PROFILE, NPD_LAYER)
!             SCATTERING EXTINCTION OF CLOUDY COMPONENT
     &   , K_EXT_TOT_CLOUD_COMP(NPD_PROFILE, NPD_LAYER)
!             TOTAL EXTINCTION OF CLOUDY COMPONENT
     &   , ASYMMETRY_CLOUD_COMP(NPD_PROFILE, NPD_LAYER)
!             ASYMMETRIES OF CLOUDY COMPONENT
     &   , FORWARD_SCATTER_CLOUD_COMP(NPD_PROFILE, NPD_LAYER)
!             FORWARD SCATTERING OF CLOUDY COMPONENT
     &   , K_SCATTER(NPD_PROFILE)
!             SCATTERING VARIABLE
     &   , ASYMMETRY_PROCESS(NPD_PROFILE)
!             ASYMMETRY FACTOR FOR CURRENT PROC.
!
      REAL*8
     &     AEROSOL_MIX_RATIO_AVE
!             AVERAGE MIXING RATIO OF AEROSOLS
!
      REAL*8
     &     WEIGHT_UPPER
!             UPPER WEIGHT FOR INTERPOLATION
     &   , WEIGHT_LOWER
!             LOWER WEIGHT FOR INTERPOLATION
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     OPT_PROP_WATER_CLOUD, OPT_PROP_ICE_CLOUD
     &   , WHENFGT 
     &   , OBS_AEROSOL_PROP
!
!     CRAY DIRECTIVES FOR THE WHOLE ROUTINE:
!     POINTS ARE NOT REPEATED IN THE INDEXING ARRAY, SO IT IS SAFE
!     TO VECTORIZE OVER INDIRECTLY ADDRESSED ARRAYS.
Cfpp$ NODEPCHK R
!
!
!
!     INITIALIZE THE EXTINCTION COEFFICIENTS AND THE ASYMMETRY PRODUCT.
      DO I=1, N_LAYER
         DO L=1, N_PROFILE
            K_EXT_TOT_FREE(L, I)=0.0D+00
            K_EXT_SCAT_FREE(L, I)=0.0D+00
            ASYMMETRY_FREE(L, I)=0.0D+00
         ENDDO
      ENDDO
!     FORWARD SCATTERING IS REQUIRED ONLY IN THE VISIBLE WHERE
!     DELTA-RESCALING IS PERFORMED.
      IF (L_RESCALE) THEN
         DO I=1, N_LAYER
            DO L=1, N_PROFILE
               FORWARD_SCATTER_FREE(L, I)=0.0D+00
            ENDDO
         ENDDO
      ENDIF
!
      IF (L_RAYLEIGH) THEN
!        INCLUDE RAYLEIGH SCATTERING.
         DO I=1, N_LAYER
            DO L=1, N_PROFILE
               K_EXT_SCAT_FREE(L, I)
     &             =K_EXT_SCAT_FREE(L, I)+RAYLEIGH_COEFF
            ENDDO
         ENDDO
      ENDIF
!
      IF (L_AEROSOL) THEN
!        INCLUDE THE EFFECTS OF AEROSOL.
         DO J=1, N_AEROSOL
            IF (I_AEROSOL_PARAMETRIZATION(J)
     &         .EQ.IP_AEROSOL_PARAM_DRY) THEN
               DO I=1, N_LAYER
                  DO L=1, N_PROFILE
                     IF (L_LAYER) THEN
                        AEROSOL_MIX_RATIO_AVE=AEROSOL_MIX_RATIO(L, I, J)
                     ELSE
                        AEROSOL_MIX_RATIO_AVE=AEROSOL_MIX_RATIO(L, I, J)
     &                     +WEIGHT_UPPER_AEROSOL
     &                     *(AEROSOL_MIX_RATIO(L, I-1, J)
     &                     -AEROSOL_MIX_RATIO(L, I, J))
                     ENDIF
                     K_EXT_TOT_FREE(L, I)=K_EXT_TOT_FREE(L, I)
     &                  +AEROSOL_MIX_RATIO_AVE
     &                  *AEROSOL_ABSORPTION(1, J)
                     K_SCATTER(L)=AEROSOL_MIX_RATIO_AVE
     &                  *AEROSOL_SCATTERING(1, J)
                     K_EXT_SCAT_FREE(L, I)=K_EXT_SCAT_FREE(L, I)
     &                  +K_SCATTER(L)
                     ASYMMETRY_FREE(L, I)=ASYMMETRY_FREE(L, I)
     &                  +K_SCATTER(L)*AEROSOL_ASYMMETRY(1, J)
                  ENDDO
                  IF (L_RESCALE) THEN
!                    THIS BLOCK IS PLACED WITHIN THE LOOP OVER I TO SAVE
!                    STORAGE. THE COST OF RE-EXECUTING THE TEST IS QUITE
!                    SMALL.
                     DO L=1, N_PROFILE
                        FORWARD_SCATTER_FREE(L, I)
     &                     =FORWARD_SCATTER_FREE(L, I)+K_SCATTER(L)
     &                     *(AEROSOL_ASYMMETRY(1, J))**2
                     ENDDO
                  ENDIF
               ENDDO
            ELSE IF (I_AEROSOL_PARAMETRIZATION(J)
     &         .EQ.IP_AEROSOL_PARAM_MOIST) THEN
               DO I=1, N_LAYER
                  DO L=1, N_PROFILE
                     I_POINTER=I_HUMIDITY_POINTER(L, I)
                     WEIGHT_UPPER=(MEAN_REL_HUMIDITY(L, I)
     &                 -HUMIDITIES(I_POINTER, J))
     &                 /DELTA_HUMIDITY
                     WEIGHT_LOWER=1.0D+00-WEIGHT_UPPER
                     IF (L_LAYER) THEN
                        AEROSOL_MIX_RATIO_AVE=AEROSOL_MIX_RATIO(L, I, J)
                     ELSE
                        AEROSOL_MIX_RATIO_AVE=AEROSOL_MIX_RATIO(L, I, J)
     &                     +WEIGHT_UPPER_AEROSOL
     &                     *(AEROSOL_MIX_RATIO(L, I-1, J)
     &                     -AEROSOL_MIX_RATIO(L, I, J))
                     ENDIF
                     K_EXT_TOT_FREE(L, I)=K_EXT_TOT_FREE(L, I)
     &                  +AEROSOL_MIX_RATIO_AVE
     &                  *(AEROSOL_ABSORPTION(I_POINTER, J)
     &                  *WEIGHT_LOWER+WEIGHT_UPPER
     &                  *AEROSOL_ABSORPTION(I_POINTER+1, J))
                     K_SCATTER(L)=
     &                  AEROSOL_MIX_RATIO_AVE
     &                  *(AEROSOL_SCATTERING(I_POINTER, J)
     &                  *WEIGHT_LOWER+WEIGHT_UPPER
     &                  *AEROSOL_SCATTERING(I_POINTER+1, J))
                     K_EXT_SCAT_FREE(L, I)=K_EXT_SCAT_FREE(L, I)
     &                  +K_SCATTER(L)
                     ASYMMETRY_PROCESS(L)=
     &                  AEROSOL_ASYMMETRY(I_POINTER, J)
     &                  *WEIGHT_LOWER+WEIGHT_UPPER
     &                  *AEROSOL_ASYMMETRY(I_POINTER+1, J)
                     ASYMMETRY_FREE(L, I)=ASYMMETRY_FREE(L, I)
     &                  +K_SCATTER(L)*ASYMMETRY_PROCESS(L)
                  ENDDO
                  IF (L_RESCALE) THEN
                     DO L=1, N_PROFILE
                        FORWARD_SCATTER_FREE(L, I)
     &                     =FORWARD_SCATTER_FREE(L, I)+K_SCATTER(L)
     &                     *(ASYMMETRY_PROCESS(L))**2
                     ENDDO
                  ENDIF
               ENDDO
            ELSE IF (I_AEROSOL_PARAMETRIZATION(J)
     &         .EQ.IP_AEROSOL_UNPARAMETRIZED) THEN
!
               CALL OBS_AEROSOL_PROP(IERR
     &            , N_PROFILE, N_LAYER
     &            , N_AEROSOL_DATA_LAYER(J)
     &            , L_RESCALE
     &            , P, DENSITY, L_LAYER
     &            , OBS_AEROSOL_PRESSURE(0, J)
     &            , OBS_AEROSOL_ABSORPTION(0, J)
     &            , OBS_AEROSOL_SCATTERING(0, J)
     &            , OBS_AEROSOL_ASYMMETRY(0, J)
     &            , K_EXT_TOT_FREE, K_EXT_SCAT_FREE, ASYMMETRY_FREE
     &            , FORWARD_SCATTER_FREE
     &            )
!
            ELSE
               WRITE(IU_ERR, '(/A, I3, A)') 
     &            '*** ERROR : I_AEROSOL_PARAMETRIZATION FOR SPECIES '
     &            , J, ' HAS BEEN SET TO AN ILLEGAL VALUE.'
               IERR=I_ERR_FATAL
               RETURN

            ENDIF
         ENDDO
      ENDIF
!
      IF (L_CONTINUUM) THEN
!        INCLUDE CONTINUUM ABSORPTION.
         DO J=1, N_CONTINUUM
            I_CONTINUUM=I_CONTINUUM_POINTER(J)
            DO I=1, N_LAYER
               DO L=1, N_PROFILE
                  K_EXT_TOT_FREE(L, I)=K_EXT_TOT_FREE(L, I)
     &               +K_CONTINUUM(I_CONTINUUM)
     &               *AMOUNT_CONTINUUM(L, I, I_CONTINUUM)
               ENDDO
            ENDDO
         ENDDO
      ENDIF
!
!
!     ADD THE SCATTERING ON TO THE TOTAL EXTINCTION. THE FINAL FREE
!     ASYMMETRY IS NOT CALCULATED HERE SINCE THE PRODUCT OF ASYMMETRY
!     AND SCATTERING IS ALSO NEEDED TO CALCULATE THE CLOUDY ASYMMETRY.
      DO I=1, N_LAYER
         DO L=1, N_PROFILE
            K_EXT_TOT_FREE(L, I)=K_EXT_TOT_FREE(L, I)
     &         +K_EXT_SCAT_FREE(L, I)
         ENDDO
      ENDDO
!
!
!     IF THERE ARE NO CLOUDS CALCULATE THE FINAL OPTICAL PROPERTIES
!     AND RETURN TO THE CALLING ROUTINE.
!
      IF (.NOT.L_CLOUD) THEN
!
         DO I=1, N_LAYER
            DO L=1, N_PROFILE
               IF (K_EXT_SCAT_FREE(L, I).GT.TOL_DIV) THEN
                  ASYMMETRY_FREE(L, I)=ASYMMETRY_FREE(L, I)
     &               /K_EXT_SCAT_FREE(L, I)
               ENDIF
            ENDDO
         ENDDO
         IF (L_RESCALE) THEN
            DO I=1, N_LAYER
               DO L=1, N_PROFILE
                  IF (K_EXT_SCAT_FREE(L, I).GT.TOL_DIV) THEN
                     FORWARD_SCATTER_FREE(L, I)
     &                  =FORWARD_SCATTER_FREE(L, I)
     &                  /K_EXT_SCAT_FREE(L, I)
                  ENDIF
               ENDDO
            ENDDO
!
         ENDIF
!
         RETURN
!
      ENDIF
!
!
!
!
!     ADDITION OF CLOUDY PROPERTIES:
!
!
!     ADD IN BACKGROUND CONTIBUTIONS:
!
      IF (I_CLOUD.NE.IP_CLOUD_SCHMETZ) THEN
!
!        ALL THE PROCESSES OCCURRING OUTSIDE CLOUDS ALSO OCCUR 
!        WITHIN THEM.
         DO K=1, N_CLOUD_TYPE
            DO I=1, N_LAYER
               DO L=1, N_PROFILE
                  K_EXT_TOT_CLOUD(L, I, K)=K_EXT_TOT_FREE(L, I)
                  K_EXT_SCAT_CLOUD(L, I, K)=K_EXT_SCAT_FREE(L, I)
                  ASYMMETRY_CLOUD(L, I, K)=ASYMMETRY_FREE(L, I)
                  FORWARD_SCATTER_CLOUD(L, I, K)
     &               =FORWARD_SCATTER_FREE(L, I)
               ENDDO
            ENDDO
         ENDDO
!
      ELSE IF (I_CLOUD.EQ.IP_CLOUD_SCHMETZ) THEN
!
!        IN SCHEMTZ'S ALGORITHM THE CLOUDY FLUXES SUBSEQUENTLY PASS 
!        THROUGH THE FREE PART OF THE LAYER, SO THE CLOUDY OPTICAL 
!        PROPERTIES MUST BE DERIVED ONLY FROM THE PURELY CLOUDY 
!        CONTRIBUTIONS.
         DO K=1, N_CLOUD_TYPE
            DO I=1, N_LAYER
               DO L=1, N_PROFILE
                  K_EXT_TOT_CLOUD(L, I, K)=0.0D+00
                  K_EXT_SCAT_CLOUD(L, I, K)=0.0D+00
                  ASYMMETRY_CLOUD(L, I, K)=0.0D+00
                  FORWARD_SCATTER_CLOUD(L, I, K)=0.0D+00
               ENDDO
            ENDDO
         ENDDO
!
      ENDIF
!
!
!     ADD ON THE TERMS REPRESENTING PROCESSES WITHIN CLOUDS.
!
!     LOOP OVER THE CONDENSED COMPONENTS, CALCULATING THEIR OPTICAL
!     PROPERTIES AND THEN ASSIGN THEM TO THE ARRAYS FOR THE TYPES OF 
!     CLOUD.
!
      DO K=1, N_CONDENSED
!
!        FLAGS FOR DEALING WITH COMPONENTS WERE SET IN THE SUBROUTINE
!        SET_CLOUD_POINTER. WE NOW DETERMINE WHETHER THE COMPONENT IS
!        TO BE INCLUDED AND CALCULATE ITS OPTICAL PROPERTIES ACCORDING
!        TO THE PHASE OF THE COMPONENT. THESE CONTRIBUTIONS ARE ADDED
!        TO THE ARRAYS FOR THE SELECTED TYPE OF CLOUD.
!
         IF (L_CLOUD_CMP(K)) THEN
!
            IF (I_PHASE_CMP(K).EQ.IP_PHASE_WATER) THEN
!
!              INCLUDE SCATTERING BY WATER DROPLETS.
!
               CALL OPT_PROP_WATER_CLOUD(IERR
     &            , N_PROFILE, N_LAYER, N_CLOUD_TOP
     &            , N_CLOUD_PROFILE, I_CLOUD_PROFILE
     &            , L_RESCALE, L_LAYER, L_CLOUD_LAYER
     &            , I_CONDENSED_PARAM(K), CONDENSED_PARAM_LIST(1, K)
     &            , CONDENSED_MIX_RATIO(1, 0, K), CONDENSED_RE(1, 0, K)
     &            , P, DENSITY
     &            , N_LAYER_DROP_DATA, DROP_PRESSURE
     &            , DROP_ABSORPTION, DROP_SCATTERING
     &            , DROP_ASYMMETRY
     &            , K_EXT_TOT_CLOUD_COMP, K_EXT_SCAT_CLOUD_COMP
     &            , ASYMMETRY_CLOUD_COMP, FORWARD_SCATTER_CLOUD_COMP
     &            )
!
            ELSE IF (I_PHASE_CMP(K).EQ.IP_PHASE_ICE) THEN
!
!              INCLUDE SCATTERING BY ICE CRYSTALS.
!
               CALL OPT_PROP_ICE_CLOUD(IERR
     &            , N_PROFILE, N_LAYER, N_CLOUD_TOP
     &            , N_CLOUD_PROFILE, I_CLOUD_PROFILE
     &            , L_RESCALE, L_LAYER, L_CLOUD_LAYER
     &            , I_CONDENSED_PARAM(K), CONDENSED_PARAM_LIST(1, K)
     &            , CONDENSED_MIX_RATIO(1, 0, K), CONDENSED_RE(1, 0, K)
     &            , P, T, DENSITY
     &            , N_LAYER_ICE_DATA, ICE_PRESSURE
     &            , ICE_ABSORPTION, ICE_SCATTERING
     &            , ICE_ASYMMETRY
     &            , K_EXT_TOT_CLOUD_COMP, K_EXT_SCAT_CLOUD_COMP
     &            , ASYMMETRY_CLOUD_COMP, FORWARD_SCATTER_CLOUD_COMP
     &            )
!
            ENDIF
!
!
!
!           INCREMENT THE ARRAYS OF OPTICAL PROPERTIES.
!
!
            DO I=N_CLOUD_TOP, N_LAYER
               DO LL=1, N_CLOUD_PROFILE(I)
                  L=I_CLOUD_PROFILE(LL, I)
                  K_EXT_TOT_CLOUD(L, I, I_CLOUD_TYPE(K))
     &               =K_EXT_TOT_CLOUD(L, I, I_CLOUD_TYPE(K))
     &               +K_EXT_TOT_CLOUD_COMP(L, I)
                  K_EXT_SCAT_CLOUD(L, I, I_CLOUD_TYPE(K))
     &               =K_EXT_SCAT_CLOUD(L, I, I_CLOUD_TYPE(K))
     &               +K_EXT_SCAT_CLOUD_COMP(L, I)
                  ASYMMETRY_CLOUD(L, I, I_CLOUD_TYPE(K))
     &               =ASYMMETRY_CLOUD(L, I, I_CLOUD_TYPE(K))
     &               +ASYMMETRY_CLOUD_COMP(L, I)
               ENDDO
            ENDDO
            IF (L_RESCALE) THEN
               DO I=N_CLOUD_TOP, N_LAYER
                  DO LL=1, N_CLOUD_PROFILE(I)
                     L=I_CLOUD_PROFILE(LL, I)
                     FORWARD_SCATTER_CLOUD(L, I, I_CLOUD_TYPE(K))
     &                  =FORWARD_SCATTER_CLOUD(L, I, I_CLOUD_TYPE(K))
     &                  +FORWARD_SCATTER_CLOUD_COMP(L, I)
                  ENDDO
               ENDDO
            ENDIF
!
         ENDIF
!
      ENDDO
!
!
!
!
!     CALCULATE THE FINAL OPTICAL PROPERTIES.
!     THE SCATTERING WAS INCLUDED IN THE FREE TOTAL EXTINCTION EARLIER,
!     BUT WE HAVE YET TO DIVIDE THE PRODUCT OF THE ASYMMETRY AND THE
!     SCATTERING BY THE MEAN SCATTERING.
!
      DO I=1, N_LAYER
!
         CALL WHENFGT(N_PROFILE, K_EXT_SCAT_FREE(1, I), 1, TOL_DIV
     &      , INDEX, N_INDEX)
         DO K=1, N_INDEX
               ASYMMETRY_FREE(INDEX(K), I)=ASYMMETRY_FREE(INDEX(K), I)
     &            /K_EXT_SCAT_FREE(INDEX(K), I)
         ENDDO
!
         IF (L_RESCALE) THEN
            DO K=1, N_INDEX
               FORWARD_SCATTER_FREE(INDEX(K), I)
     &            =FORWARD_SCATTER_FREE(INDEX(K), I)
     &            /K_EXT_SCAT_FREE(INDEX(K), I)
            ENDDO
         ENDIF
      ENDDO
!
!
!     REPEAT FOR CLOUDS.
      DO K=1, N_CLOUD_TYPE
         DO I=N_CLOUD_TOP, N_LAYER
            CALL WHENFGT(N_PROFILE, K_EXT_SCAT_CLOUD(1, I, K), 1
     &         , TOL_DIV, INDEX, N_INDEX)
            DO J=1, N_INDEX
               ASYMMETRY_CLOUD(INDEX(J), I, K)
     &            =ASYMMETRY_CLOUD(INDEX(J), I, K)
     &            /K_EXT_SCAT_CLOUD(INDEX(J), I, K)
            ENDDO
            IF (L_RESCALE) THEN
               DO J=1, N_INDEX
                  FORWARD_SCATTER_CLOUD(INDEX(J), I, K)
     &               =FORWARD_SCATTER_CLOUD(INDEX(J), I, K)
     &               /K_EXT_SCAT_CLOUD(INDEX(J), I, K)
               ENDDO
            ENDIF
         ENDDO
      ENDDO
!
!
!
      RETURN
      END
