*IF DEF,A70_1B                                                             GREYK3B.2      
*IF DEF,A01_3A,OR,DEF,A02_3A                                               GREYK3B.3      
C ******************************COPYRIGHT******************************    GREYK3B.4      
C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved.    GREYK3B.5      
C                                                                          GREYK3B.6      
C Use, duplication or disclosure of this code is subject to the            GREYK3B.7      
C restrictions as set forth in the contract.                               GREYK3B.8      
C                                                                          GREYK3B.9      
C                Meteorological Office                                     GREYK3B.10     
C                London Road                                               GREYK3B.11     
C                BRACKNELL                                                 GREYK3B.12     
C                Berkshire UK                                              GREYK3B.13     
C                RG12 2SZ                                                  GREYK3B.14     
C                                                                          GREYK3B.15     
C If no contract has been raised with this copy of the code, the use,      GREYK3B.16     
C duplication or disclosure of it is strictly prohibited.  Permission      GREYK3B.17     
C to do so must first be obtained in writing from the Head of Numerical    GREYK3B.18     
C Modelling at the above address.                                          GREYK3B.19     
C ******************************COPYRIGHT******************************    GREYK3B.20     
C                                                                          GREYK3B.21     
!+ Subroutine to calculate grey extinctions.                               GREYK3B.22     
!                                                                          GREYK3B.23     
! Method:                                                                  GREYK3B.24     
!       For each activated optical process, excluding gaseous              GREYK3B.25     
!       absorption, increments are calculated for the total and            GREYK3B.26     
!       scattering extinctions, and the products of the asymmetry          GREYK3B.27     
!       factor and the forward scattering factor in clear and              GREYK3B.28     
!       cloudy regions. These increments are summed, and the grey          GREYK3B.29     
!       total and scattering extinctions and the asymmetry and forward     GREYK3B.30     
!       scattering factors are thus calculated.                            GREYK3B.31     
!                                                                          GREYK3B.32     
! Current Owner of Code: J. M. Edwards                                     GREYK3B.33     
!                                                                          GREYK3B.34     
! History:                                                                 GREYK3B.35     
!       Version         Date                    Comment                    GREYK3B.36     
!       4.5             11-06-98                Optimised Version          GREYK3B.37     
!                                               (P. Burton)                GREYK3B.38     
!                                                                          GREYK3B.39     
! Description of Code:                                                     GREYK3B.40     
!   FORTRAN 77  with extensions listed in documentation.                   GREYK3B.41     
!                                                                          GREYK3B.42     
!- ---------------------------------------------------------------------   GREYK3B.43     

      SUBROUTINE GREY_EXTINCTION(IERR                                       1,4GREYK3B.44     
     &   , N_PROFILE, N_LAYER, L_LAYER, P, T, DENSITY                      GREYK3B.45     
     &   , L_RESCALE                                                       GREYK3B.46     
     &   , L_RAYLEIGH, RAYLEIGH_COEFF                                      GREYK3B.47     
     &   , L_CONTINUUM, N_CONTINUUM, I_CONTINUUM_POINTER, K_CONTINUUM      GREYK3B.48     
     &   , AMOUNT_CONTINUUM                                                GREYK3B.49     
     &   , L_AEROSOL, N_AEROSOL, AEROSOL_MIX_RATIO                         GREYK3B.50     
     &   , I_AEROSOL_PARAMETRIZATION                                       GREYK3B.51     
     &   , I_HUMIDITY_POINTER, HUMIDITIES, DELTA_HUMIDITY                  GREYK3B.52     
     &   , MEAN_REL_HUMIDITY                                               GREYK3B.53     
     &   , AEROSOL_ABSORPTION, AEROSOL_SCATTERING, AEROSOL_ASYMMETRY       GREYK3B.54     
     &   , L_CLOUD, N_CLOUD_PROFILE, I_CLOUD_PROFILE, N_CLOUD_TOP          GREYK3B.55     
     &   , L_CLOUD_LAYER, I_CLOUD                                          GREYK3B.56     
     &   , N_CONDENSED, L_CLOUD_CMP, I_PHASE_CMP                           GREYK3B.57     
     &   , I_CONDENSED_PARAM, CONDENSED_PARAM_LIST                         GREYK3B.58     
     &   , CONDENSED_MIX_RATIO, CONDENSED_DIM_CHAR                         GREYK3B.59     
     &   , N_CLOUD_TYPE, I_CLOUD_TYPE                                      GREYK3B.60     
     &   , K_EXT_TOT_FREE, K_EXT_SCAT_FREE, ASYMMETRY_FREE                 GREYK3B.61     
     &   , FORWARD_SCATTER_FREE                                            GREYK3B.62     
     &   , K_EXT_TOT_CLOUD, K_EXT_SCAT_CLOUD                               GREYK3B.63     
     &   , ASYMMETRY_CLOUD, FORWARD_SCATTER_CLOUD                          GREYK3B.64     
     &   , NPD_PROFILE, NPD_LAYER, NPD_CONTINUUM                           GREYK3B.65     
     &   , NPD_AEROSOL_SPECIES, NPD_HUMIDITIES                             GREYK3B.66     
     &   , NPD_CLOUD_PARAMETER                                             GREYK3B.67     
     &   )                                                                 GREYK3B.68     
!                                                                          GREYK3B.69     
!                                                                          GREYK3B.70     
!                                                                          GREYK3B.71     
      IMPLICIT NONE                                                        GREYK3B.72     
!                                                                          GREYK3B.73     
!                                                                          GREYK3B.74     
      INTEGER   !, INTENT(IN)                                              GREYK3B.75     
     &     NPD_PROFILE                                                     GREYK3B.76     
!             MAXIMUM NUMBER OF PROFILES                                   GREYK3B.77     
     &   , NPD_LAYER                                                       GREYK3B.78     
!             MAXIMUM NUMBER OF LAYERS                                     GREYK3B.79     
     &   , NPD_AEROSOL_SPECIES                                             GREYK3B.80     
!             MAXIMUM NUMBER OF AEROSOLS                                   GREYK3B.81     
     &   , NPD_HUMIDITIES                                                  GREYK3B.82     
!             MAXIMUM NUMBER OF HUMIDITIES                                 GREYK3B.83     
     &   , NPD_CONTINUUM                                                   GREYK3B.84     
!             MAXIMUM NUMBER OF CONTINUA                                   GREYK3B.85     
     &   , NPD_CLOUD_PARAMETER                                             GREYK3B.86     
!             MAXIMUM NUMBER OF CLOUD PARAMETERS                           GREYK3B.87     
!                                                                          GREYK3B.88     
!     INCLUDE COMDECKS                                                     GREYK3B.89     
*CALL STDIO3A                                                              GREYK3B.90     
*CALL DIMFIX3A                                                             GREYK3B.91     
*CALL PRMCH3A                                                              GREYK3B.92     
*CALL PRECSN3A                                                             GREYK3B.93     
*CALL AERPRM3A                                                             GREYK3B.94     
*CALL CLSCHM3A                                                             GREYK3B.95     
*CALL PHASE3A                                                              GREYK3B.96     
*CALL ERROR3A                                                              GREYK3B.97     
!                                                                          GREYK3B.98     
!                                                                          GREYK3B.99     
!                                                                          GREYK3B.100    
!     DUMMY ARGUMENTS.                                                     GREYK3B.101    
      INTEGER   !, INTENT(OUT)                                             GREYK3B.102    
     &     IERR                                                            GREYK3B.103    
!             ERROR FLAG                                                   GREYK3B.104    
!                                                                          GREYK3B.105    
!                                                                          GREYK3B.106    
!     BASIC ATMOSPHERIC PROPERTIES:                                        GREYK3B.107    
!                                                                          GREYK3B.108    
      LOGICAL   !, INTENT(IN)                                              GREYK3B.109    
     &     L_LAYER                                                         GREYK3B.110    
!             VARIABLES GIVEN IN LAYERS                                    GREYK3B.111    
!                                                                          GREYK3B.112    
      INTEGER   !, INTENT(IN)                                              GREYK3B.113    
     &     N_PROFILE                                                       GREYK3B.114    
!             NUMBER OF PROFILES                                           GREYK3B.115    
     &   , N_LAYER                                                         GREYK3B.116    
!             NUMBER OF LAYERS                                             GREYK3B.117    
!                                                                          GREYK3B.118    
      REAL      !, INTENT(IN)                                              GREYK3B.119    
     &     P(NPD_PROFILE, 0: NPD_LAYER)                                    GREYK3B.120    
!             PRESSURE                                                     GREYK3B.121    
     &   , T(NPD_PROFILE, 0: NPD_LAYER)                                    GREYK3B.122    
!             TEMPERATURE                                                  GREYK3B.123    
     &   , DENSITY(NPD_PROFILE, 0: NPD_LAYER)                              GREYK3B.124    
!             DENSITY AT LEVELS                                            GREYK3B.125    
!                                                                          GREYK3B.126    
!                                                                          GREYK3B.127    
!     OPTICAL SWITCHES:                                                    GREYK3B.128    
      LOGICAL   !, INTENT(IN)                                              GREYK3B.129    
     &     L_RESCALE                                                       GREYK3B.130    
!             DELTA-RESCALING REQUIRED                                     GREYK3B.131    
!                                                                          GREYK3B.132    
!                                                                          GREYK3B.133    
!     RAYLEIGH SCATTERING:                                                 GREYK3B.134    
!                                                                          GREYK3B.135    
      LOGICAL   !, INTENT(IN)                                              GREYK3B.136    
     &     L_RAYLEIGH                                                      GREYK3B.137    
!             RAYLEIGH SCATTERING ACTIVATED                                GREYK3B.138    
!                                                                          GREYK3B.139    
      REAL      !, INTENT(IN)                                              GREYK3B.140    
     &     RAYLEIGH_COEFF                                                  GREYK3B.141    
!             RAYLEIGH COEFFICIENT                                         GREYK3B.142    
!                                                                          GREYK3B.143    
!                                                                          GREYK3B.144    
!     CONTINUUM PROCESSES:                                                 GREYK3B.145    
      LOGICAL   !, INTENT(IN)                                              GREYK3B.146    
     &     L_CONTINUUM                                                     GREYK3B.147    
!             CONTINUUM ABSORPTION ACTIVATED                               GREYK3B.148    
!                                                                          GREYK3B.149    
      INTEGER   !, INTENT(IN)                                              GREYK3B.150    
     &     N_CONTINUUM                                                     GREYK3B.151    
!             NUMBER OF CONTINUA                                           GREYK3B.152    
     &   , I_CONTINUUM_POINTER(NPD_CONTINUUM)                              GREYK3B.153    
!             POINTERS TO ACTIVE CONTINUA                                  GREYK3B.154    
!                                                                          GREYK3B.155    
      REAL      !, INTENT(IN)                                              GREYK3B.156    
     &     K_CONTINUUM(NPD_CONTINUUM)                                      GREYK3B.157    
!             CONTINUUM EXTINCTION                                         GREYK3B.158    
     &   , AMOUNT_CONTINUUM(NPD_PROFILE, 0: NPD_LAYER, NPD_CONTINUUM)      GREYK3B.159    
!             AMOUNTS FOR CONTINUA                                         GREYK3B.160    
!                                                                          GREYK3B.161    
!                                                                          GREYK3B.162    
!     PROPERTIES OF AEROSOLS:                                              GREYK3B.163    
!                                                                          GREYK3B.164    
      LOGICAL   !, INTENT(IN)                                              GREYK3B.165    
     &     L_AEROSOL                                                       GREYK3B.166    
!             AEROSOLS ACTIVATED                                           GREYK3B.167    
!                                                                          GREYK3B.168    
      INTEGER   !, INTENT(IN)                                              GREYK3B.169    
     &     N_AEROSOL                                                       GREYK3B.170    
!             NUMBER OF AEROSOL SPECIES                                    GREYK3B.171    
     &   , I_AEROSOL_PARAMETRIZATION(NPD_AEROSOL_SPECIES)                  GREYK3B.172    
!             PARAMETRIZATIONS OF AEROSOLS                                 GREYK3B.173    
     &   , I_HUMIDITY_POINTER(NPD_PROFILE,  NPD_LAYER)                     GREYK3B.174    
!             POINTER TO AEROSOL LOOK-UP TABLE                             GREYK3B.175    
!                                                                          GREYK3B.176    
      REAL      !, INTENT(IN)                                              GREYK3B.177    
     &     AEROSOL_MIX_RATIO(NPD_PROFILE, 0: NPD_LAYER                     GREYK3B.178    
     &        , NPD_AEROSOL_SPECIES)                                       GREYK3B.179    
!             NUMBER DENSTY OF AEROSOLS                                    GREYK3B.180    
     &   , AEROSOL_ABSORPTION(NPD_HUMIDITIES, NPD_AEROSOL_SPECIES)         GREYK3B.181    
!             AEROSOL ABSORPTION IN BAND/MIX RT.                           GREYK3B.182    
     &   , AEROSOL_SCATTERING(NPD_HUMIDITIES, NPD_AEROSOL_SPECIES)         GREYK3B.183    
!             AEROSOL SCATTERING IN BAND/MIX RT.                           GREYK3B.184    
     &   , AEROSOL_ASYMMETRY(NPD_HUMIDITIES, NPD_AEROSOL_SPECIES)          GREYK3B.185    
!             AEROSOL ASYMMETRY IN BAND                                    GREYK3B.186    
     &   , HUMIDITIES(NPD_HUMIDITIES, NPD_AEROSOL_SPECIES)                 GREYK3B.187    
!             ARRAY OF HUMIDITIES                                          GREYK3B.188    
     &   , DELTA_HUMIDITY                                                  GREYK3B.189    
!             INCREMENT IN HUMIDITY                                        GREYK3B.190    
     &   , MEAN_REL_HUMIDITY(NPD_PROFILE, NPD_LAYER)                       GREYK3B.191    
!             MIXING RATIO OF WATER VAPOUR                                 GREYK3B.192    
!                                                                          GREYK3B.193    
!                                                                          GREYK3B.194    
!                                                                          GREYK3B.195    
!     PROPERTIES OF CLOUDS:                                                GREYK3B.196    
!                                                                          GREYK3B.197    
      LOGICAL   !, INTENT(IN)                                              GREYK3B.198    
     &     L_CLOUD                                                         GREYK3B.199    
!             CLOUDS ACTIVATED                                             GREYK3B.200    
!                                                                          GREYK3B.201    
!     GEOMETRY OF CLOUDS:                                                  GREYK3B.202    
!                                                                          GREYK3B.203    
      LOGICAL   !, INTENT(IN)                                              GREYK3B.204    
     &     L_CLOUD_LAYER                                                   GREYK3B.205    
!             CLOUD VARIABLES GIVEN IN LAYERS                              GREYK3B.206    
!                                                                          GREYK3B.207    
      INTEGER   !, INTENT(IN)                                              GREYK3B.208    
     &     N_CLOUD_TOP                                                     GREYK3B.209    
!             TOPMOST CLOUDY LAYER                                         GREYK3B.210    
     &   , I_CLOUD                                                         GREYK3B.211    
!             CLOUD SCHEME TO BE USED                                      GREYK3B.212    
     &   , N_CLOUD_TYPE                                                    GREYK3B.213    
!             NUMBER OF TYPES OF CLOUDS                                    GREYK3B.214    
     &   , N_CLOUD_PROFILE(NPD_LAYER)                                      GREYK3B.215    
!             NUMBER OF CLOUDY PROFILES IN EACH LAYER                      GREYK3B.216    
     &   , I_CLOUD_PROFILE(NPD_PROFILE, NPD_LAYER)                         GREYK3B.217    
!             PROFILES CONTAINING CLOUDS                                   GREYK3B.218    
     &   , I_CLOUD_TYPE(NPD_CLOUD_COMPONENT)                               GREYK3B.219    
!             TYPES OF CLOUD TO WHICH EACH COMPONENT CONTRIBUTES           GREYK3B.220    
!                                                                          GREYK3B.221    
!     MICROPHYSICAL QUANTITIES:                                            GREYK3B.222    
      INTEGER   !, INTENT(IN)                                              GREYK3B.223    
     &     N_CONDENSED                                                     GREYK3B.224    
!             NUMBER OF CONDENSED COMPONENTS                               GREYK3B.225    
     &   , I_PHASE_CMP(NPD_CLOUD_COMPONENT)                                GREYK3B.226    
!             PHASES OF CLOUDY COMPONENTS                                  GREYK3B.227    
     &   , I_CONDENSED_PARAM(NPD_CLOUD_COMPONENT)                          GREYK3B.228    
!             PARAMETRIZATION SCHEMES FOR CLOUDY COMPONENTS                GREYK3B.229    
!                                                                          GREYK3B.230    
      LOGICAL   !, INTENT(IN)                                              GREYK3B.231    
     &     L_CLOUD_CMP(NPD_CLOUD_COMPONENT)                                GREYK3B.232    
!             FLAGS TO ACTIVATE CLOUDY COMPONENTS                          GREYK3B.233    
!                                                                          GREYK3B.234    
      REAL      !, INTENT(IN)                                              GREYK3B.235    
     &     CONDENSED_PARAM_LIST(NPD_CLOUD_PARAMETER                        GREYK3B.236    
     &        , NPD_CLOUD_COMPONENT)                                       GREYK3B.237    
!             COEFFICIENTS IN PARAMETRIZATION SCHEMES                      GREYK3B.238    
     &   , CONDENSED_MIX_RATIO(NPD_PROFILE, 0: NPD_LAYER                   GREYK3B.239    
     &        , NPD_CLOUD_COMPONENT)                                       GREYK3B.240    
!             MIXING RATIOS OF CLOUDY COMPONENTS                           GREYK3B.241    
     &   , CONDENSED_DIM_CHAR(NPD_PROFILE, 0: NPD_LAYER                    GREYK3B.242    
     &      , NPD_CLOUD_COMPONENT)                                         GREYK3B.243    
!             EFFECTIVE RADII OF CLOUDY COMPONENTS                         GREYK3B.244    
!                                                                          GREYK3B.245    
!                                                                          GREYK3B.246    
!                                                                          GREYK3B.247    
!     CALCULATED OPTICAL PROPETIES:                                        GREYK3B.248    
!                                                                          GREYK3B.249    
      REAL      !, INTENT(OUT)                                             GREYK3B.250    
     &     K_EXT_SCAT_FREE(NPD_PROFILE, NPD_LAYER)                         GREYK3B.251    
!             FREE SCATTERING EXTINCTION                                   GREYK3B.252    
     &   , K_EXT_TOT_FREE(NPD_PROFILE, NPD_LAYER)                          GREYK3B.253    
!             TOTAL FREE EXTINCTION                                        GREYK3B.254    
     &   , ASYMMETRY_FREE(NPD_PROFILE, NPD_LAYER)                          GREYK3B.255    
!             FREE ASYMMETRIES                                             GREYK3B.256    
     &   , FORWARD_SCATTER_FREE(NPD_PROFILE, NPD_LAYER)                    GREYK3B.257    
!             FREE FORWARD SCATTERING                                      GREYK3B.258    
     &   , K_EXT_SCAT_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)        GREYK3B.259    
!             CLOUDY SCATTERING EXTINCTION                                 GREYK3B.260    
     &   , K_EXT_TOT_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)         GREYK3B.261    
!             TOTAL CLOUDY EXTINCTION                                      GREYK3B.262    
     &   , ASYMMETRY_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)         GREYK3B.263    
!             CLOUDY ASYMMETRIES                                           GREYK3B.264    
     &   , FORWARD_SCATTER_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)   GREYK3B.265    
!             CLOUDY FORWARD SCATTERING                                    GREYK3B.266    
!                                                                          GREYK3B.267    
!                                                                          GREYK3B.268    
!                                                                          GREYK3B.269    
!     LOCAL VARIABLES.                                                     GREYK3B.270    
      INTEGER                                                              GREYK3B.271    
     &     I_CONTINUUM                                                     GREYK3B.272    
!             TEMPORARY CONTINUUM INDEX                                    GREYK3B.273    
     &   , I_POINTER                                                       GREYK3B.274    
!             TEMPORARY POINTER                                            GREYK3B.275    
     &   , L                                                               GREYK3B.276    
!             LOOP VARIABLE                                                GREYK3B.277    
     &   , LL                                                              GREYK3B.278    
!             LOOP VARIABLE                                                GREYK3B.279    
     &   , I                                                               GREYK3B.280    
!             LOOP VARIABLE                                                GREYK3B.281    
     &   , J                                                               GREYK3B.282    
!             LOOP VARIABLE                                                GREYK3B.283    
     &   , K                                                               GREYK3B.284    
!             LOOP VARIABLE                                                GREYK3B.285    
     &   , N_INDEX                                                         GREYK3B.286    
!             NUMBER OF INDICES SATISFYING TEST                            GREYK3B.287    
     &   , INDEX(NPD_PROFILE)                                              GREYK3B.288    
!             INDICES OF TESTED POINTS                                     GREYK3B.289    
!                                                                          GREYK3B.290    
!     TEMPORARY OPTICAL PROPERTIES:                                        GREYK3B.291    
!                                                                          GREYK3B.292    
      REAL                                                                 GREYK3B.293    
     &     K_EXT_SCAT_CLOUD_COMP(NPD_PROFILE, NPD_LAYER)                   GREYK3B.294    
!             SCATTERING EXTINCTION OF CLOUDY COMPONENT                    GREYK3B.295    
     &   , K_EXT_TOT_CLOUD_COMP(NPD_PROFILE, NPD_LAYER)                    GREYK3B.296    
!             TOTAL EXTINCTION OF CLOUDY COMPONENT                         GREYK3B.297    
     &   , ASYMMETRY_CLOUD_COMP(NPD_PROFILE, NPD_LAYER)                    GREYK3B.298    
!             ASYMMETRIES OF CLOUDY COMPONENT                              GREYK3B.299    
     &   , FORWARD_SCATTER_CLOUD_COMP(NPD_PROFILE, NPD_LAYER)              GREYK3B.300    
!             FORWARD SCATTERING OF CLOUDY COMPONENT                       GREYK3B.301    
     &   , K_SCATTER(NPD_PROFILE)                                          GREYK3B.302    
!             SCATTERING VARIABLE                                          GREYK3B.303    
     &   , ASYMMETRY_PROCESS(NPD_PROFILE)                                  GREYK3B.304    
!             ASYMMETRY FACTOR FOR CURRENT PROC.                           GREYK3B.305    
!                                                                          GREYK3B.306    
!                                                                          GREYK3B.307    
      REAL                                                                 GREYK3B.308    
     &     WEIGHT_UPPER                                                    GREYK3B.309    
!             UPPER WEIGHT FOR INTERPOLATION                               GREYK3B.310    
     &   , WEIGHT_LOWER                                                    GREYK3B.311    
!             LOWER WEIGHT FOR INTERPOLATION                               GREYK3B.312    
!                                                                          GREYK3B.313    
!     Temporary variables for the divisions                                GREYK3B.314    
      REAL                                                                 GREYK3B.315    
     &  TMP_INV,TMP_INV1                                                   GREYK3B.316    
                                                                           GREYK3B.317    
!     SUBROUTINES CALLED:                                                  GREYK3B.318    
      EXTERNAL                                                             GREYK3B.319    
     &     OPT_PROP_WATER_CLOUD, OPT_PROP_ICE_CLOUD                        GREYK3B.320    
!                                                                          GREYK3B.321    
!     CRAY DIRECTIVES FOR THE WHOLE ROUTINE:                               GREYK3B.322    
!     POINTS ARE NOT REPEATED IN THE INDEXING ARRAY, SO IT IS SAFE         GREYK3B.323    
!     TO VECTORIZE OVER INDIRECTLY ADDRESSED ARRAYS.                       GREYK3B.324    
Cfpp$ NODEPCHK R                                                           GREYK3B.325    
!                                                                          GREYK3B.326    
!                                                                          GREYK3B.327    
!                                                                          GREYK3B.328    
!     INITIALIZE THE EXTINCTION COEFFICIENTS AND THE ASYMMETRY PRODUCT.    GREYK3B.329    
                                                                           GREYK3B.330    
      IF(L_RESCALE) THEN                                                   GREYK3B.331    
                                                                           GREYK3B.332    
!     Forward scattering is required only in the visible where             GREYK3B.333    
!     delta-rescaling is performed.                                        GREYK3B.334    
                                                                           GREYK3B.335    
         IF(.NOT.L_RAYLEIGH) THEN                                          GREYK3B.336    
                                                                           GREYK3B.337    
            DO I=1, N_LAYER                                                GREYK3B.338    
               DO L=1, N_PROFILE                                           GREYK3B.339    
                  K_EXT_TOT_FREE(L, I)=0.0E+00                             GREYK3B.340    
                  K_EXT_SCAT_FREE(L, I)=0.0E+00                            GREYK3B.341    
                  ASYMMETRY_FREE(L, I)=0.0E+00                             GREYK3B.342    
                  FORWARD_SCATTER_FREE(L, I)=0.0E+00                       GREYK3B.343    
               ENDDO                                                       GREYK3B.344    
            ENDDO                                                          GREYK3B.345    
                                                                           GREYK3B.346    
         ELSE IF(L_RAYLEIGH) THEN                                          GREYK3B.347    
                                                                           GREYK3B.348    
!        INCLUDE RAYLEIGH SCATTERING.                                      GREYK3B.349    
                                                                           GREYK3B.350    
            DO I=1, N_LAYER                                                GREYK3B.351    
               DO L=1, N_PROFILE                                           GREYK3B.352    
                  K_EXT_TOT_FREE(L, I)=0.0E+00                             GREYK3B.353    
                  K_EXT_SCAT_FREE(L, I)=RAYLEIGH_COEFF                     GREYK3B.354    
                  ASYMMETRY_FREE(L, I)=0.0E+00                             GREYK3B.355    
                  FORWARD_SCATTER_FREE(L, I)=0.0E+00                       GREYK3B.356    
               ENDDO                                                       GREYK3B.357    
            ENDDO                                                          GREYK3B.358    
         END IF                                                            GREYK3B.359    
                                                                           GREYK3B.360    
      ELSE IF(.NOT.L_RESCALE) THEN                                         GREYK3B.361    
                                                                           GREYK3B.362    
         IF(.NOT.L_RAYLEIGH) THEN                                          GREYK3B.363    
                                                                           GREYK3B.364    
            DO I=1, N_LAYER                                                GREYK3B.365    
               DO L=1, N_PROFILE                                           GREYK3B.366    
                  K_EXT_TOT_FREE(L, I)=0.0E+00                             GREYK3B.367    
                  K_EXT_SCAT_FREE(L, I)=0.0E+00                            GREYK3B.368    
                  ASYMMETRY_FREE(L, I)=0.0E+00                             GREYK3B.369    
               ENDDO                                                       GREYK3B.370    
            ENDDO                                                          GREYK3B.371    
                                                                           GREYK3B.372    
         ELSE IF(L_RAYLEIGH) THEN                                          GREYK3B.373    
                                                                           GREYK3B.374    
!        INCLUDE RAYLEIGH SCATTERING.                                      GREYK3B.375    
                                                                           GREYK3B.376    
            DO I=1, N_LAYER                                                GREYK3B.377    
               DO L=1, N_PROFILE                                           GREYK3B.378    
                  K_EXT_TOT_FREE(L, I)=0.0E+00                             GREYK3B.379    
                  K_EXT_SCAT_FREE(L, I)=RAYLEIGH_COEFF                     GREYK3B.380    
                  ASYMMETRY_FREE(L, I)=0.0E+00                             GREYK3B.381    
               ENDDO                                                       GREYK3B.382    
            ENDDO                                                          GREYK3B.383    
                                                                           GREYK3B.384    
         END IF                                                            GREYK3B.385    
                                                                           GREYK3B.386    
      END IF                                                               GREYK3B.387    
                                                                           GREYK3B.388    
!                                                                          GREYK3B.389    
      IF (L_AEROSOL) THEN                                                  GREYK3B.390    
!        INCLUDE THE EFFECTS OF AEROSOL.                                   GREYK3B.391    
         DO J=1, N_AEROSOL                                                 GREYK3B.392    
            IF (I_AEROSOL_PARAMETRIZATION(J)                               GREYK3B.393    
     &         .EQ.IP_AEROSOL_PARAM_DRY) THEN                              GREYK3B.394    
               DO I=1, N_LAYER                                             GREYK3B.395    
                  DO L=1, N_PROFILE                                        GREYK3B.396    
                     K_EXT_TOT_FREE(L, I)=K_EXT_TOT_FREE(L, I)             GREYK3B.397    
     &                  +AEROSOL_MIX_RATIO(L, I, J)                        GREYK3B.398    
     &                  *AEROSOL_ABSORPTION(1, J)                          GREYK3B.399    
                     K_SCATTER(L)=AEROSOL_MIX_RATIO(L, I, J)               GREYK3B.400    
     &                  *AEROSOL_SCATTERING(1, J)                          GREYK3B.401    
                     K_EXT_SCAT_FREE(L, I)=K_EXT_SCAT_FREE(L, I)           GREYK3B.402    
     &                  +K_SCATTER(L)                                      GREYK3B.403    
                     ASYMMETRY_FREE(L, I)=ASYMMETRY_FREE(L, I)             GREYK3B.404    
     &                  +K_SCATTER(L)*AEROSOL_ASYMMETRY(1, J)              GREYK3B.405    
                  ENDDO                                                    GREYK3B.406    
                  IF (L_RESCALE) THEN                                      GREYK3B.407    
!                    THIS BLOCK IS PLACED WITHIN THE LOOP OVER I TO SAVE   GREYK3B.408    
!                    STORAGE. THE COST OF RE-EXECUTING THE TEST IS QUITE   GREYK3B.409    
!                    SMALL.                                                GREYK3B.410    
                     DO L=1, N_PROFILE                                     GREYK3B.411    
                        FORWARD_SCATTER_FREE(L, I)                         GREYK3B.412    
     &                     =FORWARD_SCATTER_FREE(L, I)+K_SCATTER(L)        GREYK3B.413    
     &                     *(AEROSOL_ASYMMETRY(1, J))**2                   GREYK3B.414    
                     ENDDO                                                 GREYK3B.415    
                  ENDIF                                                    GREYK3B.416    
               ENDDO                                                       GREYK3B.417    
            ELSE IF (I_AEROSOL_PARAMETRIZATION(J)                          GREYK3B.418    
     &         .EQ.IP_AEROSOL_PARAM_MOIST) THEN                            GREYK3B.419    
               DO I=1, N_LAYER                                             GREYK3B.420    
                  DO L=1, N_PROFILE                                        GREYK3B.421    
                     I_POINTER=I_HUMIDITY_POINTER(L, I)                    GREYK3B.422    
                     WEIGHT_UPPER=(MEAN_REL_HUMIDITY(L, I)                 GREYK3B.423    
     &                 -HUMIDITIES(I_POINTER, J))                          GREYK3B.424    
     &                 /DELTA_HUMIDITY                                     GREYK3B.425    
                     WEIGHT_LOWER=1.0E+00-WEIGHT_UPPER                     GREYK3B.426    
                     K_EXT_TOT_FREE(L, I)=K_EXT_TOT_FREE(L, I)             GREYK3B.427    
     &                  +AEROSOL_MIX_RATIO(L, I, J)                        GREYK3B.428    
     &                  *(AEROSOL_ABSORPTION(I_POINTER, J)                 GREYK3B.429    
     &                  *WEIGHT_LOWER+WEIGHT_UPPER                         GREYK3B.430    
     &                  *AEROSOL_ABSORPTION(I_POINTER+1, J))               GREYK3B.431    
                     K_SCATTER(L)=                                         GREYK3B.432    
     &                  AEROSOL_MIX_RATIO(L, I, J)                         GREYK3B.433    
     &                  *(AEROSOL_SCATTERING(I_POINTER, J)                 GREYK3B.434    
     &                  *WEIGHT_LOWER+WEIGHT_UPPER                         GREYK3B.435    
     &                  *AEROSOL_SCATTERING(I_POINTER+1, J))               GREYK3B.436    
                     K_EXT_SCAT_FREE(L, I)=K_EXT_SCAT_FREE(L, I)           GREYK3B.437    
     &                  +K_SCATTER(L)                                      GREYK3B.438    
                     ASYMMETRY_PROCESS(L)=                                 GREYK3B.439    
     &                  AEROSOL_ASYMMETRY(I_POINTER, J)                    GREYK3B.440    
     &                  *WEIGHT_LOWER+WEIGHT_UPPER                         GREYK3B.441    
     &                  *AEROSOL_ASYMMETRY(I_POINTER+1, J)                 GREYK3B.442    
                     ASYMMETRY_FREE(L, I)=ASYMMETRY_FREE(L, I)             GREYK3B.443    
     &                  +K_SCATTER(L)*ASYMMETRY_PROCESS(L)                 GREYK3B.444    
                  ENDDO                                                    GREYK3B.445    
                  IF (L_RESCALE) THEN                                      GREYK3B.446    
                     DO L=1, N_PROFILE                                     GREYK3B.447    
                        FORWARD_SCATTER_FREE(L, I)                         GREYK3B.448    
     &                     =FORWARD_SCATTER_FREE(L, I)+K_SCATTER(L)        GREYK3B.449    
     &                     *(ASYMMETRY_PROCESS(L))**2                      GREYK3B.450    
                     ENDDO                                                 GREYK3B.451    
                  ENDIF                                                    GREYK3B.452    
               ENDDO                                                       GREYK3B.453    
            ELSE                                                           GREYK3B.454    
               WRITE(IU_ERR, '(/A, I3, A)')                                GREYK3B.455    
     &            '*** ERROR : I_AEROSOL_PARAMETRIZATION FOR SPECIES '     GREYK3B.456    
     &            , J, ' HAS BEEN SET TO AN ILLEGAL VALUE.'                GREYK3B.457    
               IERR=I_ERR_FATAL                                            GREYK3B.458    
               RETURN                                                      GREYK3B.459    
                                                                           GREYK3B.460    
            ENDIF                                                          GREYK3B.461    
         ENDDO                                                             GREYK3B.462    
      ENDIF                                                                GREYK3B.463    
!                                                                          GREYK3B.464    
      IF (L_CONTINUUM) THEN                                                GREYK3B.465    
!        INCLUDE CONTINUUM ABSORPTION.                                     GREYK3B.466    
         DO J=1, N_CONTINUUM                                               GREYK3B.467    
            I_CONTINUUM=I_CONTINUUM_POINTER(J)                             GREYK3B.468    
            DO I=1, N_LAYER                                                GREYK3B.469    
               DO L=1, N_PROFILE                                           GREYK3B.470    
                  K_EXT_TOT_FREE(L, I)=K_EXT_TOT_FREE(L, I)                GREYK3B.471    
     &               +K_CONTINUUM(I_CONTINUUM)                             GREYK3B.472    
     &               *AMOUNT_CONTINUUM(L, I, I_CONTINUUM)                  GREYK3B.473    
               ENDDO                                                       GREYK3B.474    
            ENDDO                                                          GREYK3B.475    
         ENDDO                                                             GREYK3B.476    
      ENDIF                                                                GREYK3B.477    
!                                                                          GREYK3B.478    
!                                                                          GREYK3B.479    
!     ADD THE SCATTERING ON TO THE TOTAL EXTINCTION. THE FINAL FREE        GREYK3B.480    
!     ASYMMETRY IS NOT CALCULATED HERE SINCE THE PRODUCT OF ASYMMETRY      GREYK3B.481    
!     AND SCATTERING IS ALSO NEEDED TO CALCULATE THE CLOUDY ASYMMETRY.     GREYK3B.482    
      DO I=1, N_LAYER                                                      GREYK3B.483    
         DO L=1, N_PROFILE                                                 GREYK3B.484    
            K_EXT_TOT_FREE(L, I)=K_EXT_TOT_FREE(L, I)                      GREYK3B.485    
     &         +K_EXT_SCAT_FREE(L, I)                                      GREYK3B.486    
         ENDDO                                                             GREYK3B.487    
      ENDDO                                                                GREYK3B.488    
!                                                                          GREYK3B.489    
!                                                                          GREYK3B.490    
!     IF THERE ARE NO CLOUDS CALCULATE THE FINAL OPTICAL PROPERTIES        GREYK3B.491    
!     AND RETURN TO THE CALLING ROUTINE.                                   GREYK3B.492    
!                                                                          GREYK3B.493    
      IF (.NOT.L_CLOUD) THEN                                               GREYK3B.494    
                                                                           GREYK3B.495    
         IF(.NOT.L_RESCALE) THEN                                           GREYK3B.496    
            DO I=1, N_LAYER                                                GREYK3B.497    
               DO L=1, N_PROFILE                                           GREYK3B.498    
                  IF (K_EXT_SCAT_FREE(L, I).GT.TOL_DIV) THEN               GREYK3B.499    
                     ASYMMETRY_FREE(L, I)=ASYMMETRY_FREE(L, I)             GREYK3B.500    
     &                    /K_EXT_SCAT_FREE(L, I)                           GREYK3B.501    
                  ENDIF                                                    GREYK3B.502    
               ENDDO                                                       GREYK3B.503    
            ENDDO                                                          GREYK3B.504    
         ELSE IF (L_RESCALE) THEN                                          GREYK3B.505    
               DO I=1, N_LAYER                                             GREYK3B.506    
                  DO L=1, N_PROFILE                                        GREYK3B.507    
                     IF (K_EXT_SCAT_FREE(L, I).GT.TOL_DIV) THEN            GREYK3B.508    
                        TMP_INV=1.0/K_EXT_SCAT_FREE(L,I)                   GREYK3B.509    
                        FORWARD_SCATTER_FREE(L, I)                         GREYK3B.510    
     &                       =FORWARD_SCATTER_FREE(L, I)                   GREYK3B.511    
     &                       *TMP_INV                                      GREYK3B.512    
                        ASYMMETRY_FREE(L, I)=ASYMMETRY_FREE(L, I)          GREYK3B.513    
     &                       *TMP_INV                                      GREYK3B.514    
                     ENDIF                                                 GREYK3B.515    
                  ENDDO                                                    GREYK3B.516    
               ENDDO                                                       GREYK3B.517    
                                                                           GREYK3B.518    
         ENDIF                                                             GREYK3B.519    
                                                                           GREYK3B.520    
         RETURN                                                            GREYK3B.521    
                                                                           GREYK3B.522    
      ENDIF                                                                GREYK3B.523    
                                                                           GREYK3B.524    
                                                                           GREYK3B.525    
!                                                                          GREYK3B.526    
!     ADDITION OF CLOUDY PROPERTIES:                                       GREYK3B.527    
!                                                                          GREYK3B.528    
!                                                                          GREYK3B.529    
!     ADD IN BACKGROUND CONTIBUTIONS:                                      GREYK3B.530    
!                                                                          GREYK3B.531    
!                                                                          GREYK3B.532    
!     ALL THE PROCESSES OCCURRING OUTSIDE CLOUDS ALSO OCCUR                GREYK3B.533    
!     WITHIN THEM.                                                         GREYK3B.534    
      DO K=1, N_CLOUD_TYPE                                                 GREYK3B.535    
         DO I=1, N_LAYER                                                   GREYK3B.536    
            DO L=1, N_PROFILE                                              GREYK3B.537    
               K_EXT_TOT_CLOUD(L, I, K)=K_EXT_TOT_FREE(L, I)               GREYK3B.538    
               K_EXT_SCAT_CLOUD(L, I, K)=K_EXT_SCAT_FREE(L, I)             GREYK3B.539    
               ASYMMETRY_CLOUD(L, I, K)=ASYMMETRY_FREE(L, I)               GREYK3B.540    
               FORWARD_SCATTER_CLOUD(L, I, K)                              GREYK3B.541    
     &            =FORWARD_SCATTER_FREE(L, I)                              GREYK3B.542    
            ENDDO                                                          GREYK3B.543    
         ENDDO                                                             GREYK3B.544    
      ENDDO                                                                GREYK3B.545    
!                                                                          GREYK3B.546    
!                                                                          GREYK3B.547    
!                                                                          GREYK3B.548    
!     ADD ON THE TERMS REPRESENTING PROCESSES WITHIN CLOUDS.               GREYK3B.549    
!                                                                          GREYK3B.550    
!     LOOP OVER THE CONDENSED COMPONENTS, CALCULATING THEIR OPTICAL        GREYK3B.551    
!     PROPERTIES AND THEN ASSIGN THEM TO THE ARRAYS FOR THE TYPES OF       GREYK3B.552    
!     CLOUD.                                                               GREYK3B.553    
!                                                                          GREYK3B.554    
      DO K=1, N_CONDENSED                                                  GREYK3B.555    
!                                                                          GREYK3B.556    
!        FLAGS FOR DEALING WITH COMPONENTS WERE SET IN THE SUBROUTINE      GREYK3B.557    
!        SET_CLOUD_POINTER. WE NOW DETERMINE WHETHER THE COMPONENT IS      GREYK3B.558    
!        TO BE INCLUDED AND CALCULATE ITS OPTICAL PROPERTIES ACCORDING     GREYK3B.559    
!        TO THE PHASE OF THE COMPONENT. THESE CONTRIBUTIONS ARE ADDED      GREYK3B.560    
!        TO THE ARRAYS FOR THE SELECTED TYPE OF CLOUD.                     GREYK3B.561    
!                                                                          GREYK3B.562    
         IF (L_CLOUD_CMP(K)) THEN                                          GREYK3B.563    
!                                                                          GREYK3B.564    
            IF (I_PHASE_CMP(K).EQ.IP_PHASE_WATER) THEN                     GREYK3B.565    
!                                                                          GREYK3B.566    
!              INCLUDE SCATTERING BY WATER DROPLETS.                       GREYK3B.567    
!                                                                          GREYK3B.568    
               CALL OPT_PROP_WATER_CLOUD(IERR                              GREYK3B.569    
     &            , N_PROFILE, N_LAYER, N_CLOUD_TOP                        GREYK3B.570    
     &            , N_CLOUD_PROFILE, I_CLOUD_PROFILE                       GREYK3B.571    
     &            , L_RESCALE, L_LAYER, L_CLOUD_LAYER                      GREYK3B.572    
     &            , I_CONDENSED_PARAM(K), CONDENSED_PARAM_LIST(1, K)       GREYK3B.573    
     &            , CONDENSED_MIX_RATIO(1, 0, K)                           GREYK3B.574    
     &            , CONDENSED_DIM_CHAR(1, 0, K)                            GREYK3B.575    
     &            , K_EXT_TOT_CLOUD_COMP, K_EXT_SCAT_CLOUD_COMP            GREYK3B.576    
     &            , ASYMMETRY_CLOUD_COMP, FORWARD_SCATTER_CLOUD_COMP       GREYK3B.577    
     &            , NPD_PROFILE, NPD_LAYER                                 GREYK3B.578    
     &            , NPD_CLOUD_PARAMETER                                    GREYK3B.579    
     &            )                                                        GREYK3B.580    
!                                                                          GREYK3B.581    
            ELSE IF (I_PHASE_CMP(K).EQ.IP_PHASE_ICE) THEN                  GREYK3B.582    
!                                                                          GREYK3B.583    
!              INCLUDE SCATTERING BY ICE CRYSTALS.                         GREYK3B.584    
!                                                                          GREYK3B.585    
               CALL OPT_PROP_ICE_CLOUD(IERR                                GREYK3B.586    
     &            , N_PROFILE, N_LAYER, N_CLOUD_TOP                        GREYK3B.587    
     &            , N_CLOUD_PROFILE, I_CLOUD_PROFILE                       GREYK3B.588    
     &            , L_RESCALE, L_LAYER, L_CLOUD_LAYER                      GREYK3B.589    
     &            , I_CONDENSED_PARAM(K), CONDENSED_PARAM_LIST(1, K)       GREYK3B.590    
     &            , CONDENSED_MIX_RATIO(1, 0, K)                           GREYK3B.591    
     &            , CONDENSED_DIM_CHAR(1, 0, K)                            GREYK3B.592    
     &            , T, DENSITY                                             GREYK3B.593    
     &            , K_EXT_TOT_CLOUD_COMP, K_EXT_SCAT_CLOUD_COMP            GREYK3B.594    
     &            , ASYMMETRY_CLOUD_COMP, FORWARD_SCATTER_CLOUD_COMP       GREYK3B.595    
     &            , NPD_PROFILE, NPD_LAYER                                 GREYK3B.596    
     &            , NPD_CLOUD_PARAMETER                                    GREYK3B.597    
     &            )                                                        GREYK3B.598    
!                                                                          GREYK3B.599    
            ENDIF                                                          GREYK3B.600    
!                                                                          GREYK3B.601    
!                                                                          GREYK3B.602    
!                                                                          GREYK3B.603    
!           INCREMENT THE ARRAYS OF OPTICAL PROPERTIES.                    GREYK3B.604    
!                                                                          GREYK3B.605    
!                                                                          GREYK3B.606    
            DO I=N_CLOUD_TOP, N_LAYER                                      GREYK3B.607    
               DO LL=1, N_CLOUD_PROFILE(I)                                 GREYK3B.608    
                  L=I_CLOUD_PROFILE(LL, I)                                 GREYK3B.609    
                  K_EXT_TOT_CLOUD(L, I, I_CLOUD_TYPE(K))                   GREYK3B.610    
     &               =K_EXT_TOT_CLOUD(L, I, I_CLOUD_TYPE(K))               GREYK3B.611    
     &               +K_EXT_TOT_CLOUD_COMP(L, I)                           GREYK3B.612    
                  K_EXT_SCAT_CLOUD(L, I, I_CLOUD_TYPE(K))                  GREYK3B.613    
     &               =K_EXT_SCAT_CLOUD(L, I, I_CLOUD_TYPE(K))              GREYK3B.614    
     &               +K_EXT_SCAT_CLOUD_COMP(L, I)                          GREYK3B.615    
                  ASYMMETRY_CLOUD(L, I, I_CLOUD_TYPE(K))                   GREYK3B.616    
     &               =ASYMMETRY_CLOUD(L, I, I_CLOUD_TYPE(K))               GREYK3B.617    
     &               +ASYMMETRY_CLOUD_COMP(L, I)                           GREYK3B.618    
               ENDDO                                                       GREYK3B.619    
            ENDDO                                                          GREYK3B.620    
            IF (L_RESCALE) THEN                                            GREYK3B.621    
               DO I=N_CLOUD_TOP, N_LAYER                                   GREYK3B.622    
                  DO LL=1, N_CLOUD_PROFILE(I)                              GREYK3B.623    
                     L=I_CLOUD_PROFILE(LL, I)                              GREYK3B.624    
                     FORWARD_SCATTER_CLOUD(L, I, I_CLOUD_TYPE(K))          GREYK3B.625    
     &                  =FORWARD_SCATTER_CLOUD(L, I, I_CLOUD_TYPE(K))      GREYK3B.626    
     &                  +FORWARD_SCATTER_CLOUD_COMP(L, I)                  GREYK3B.627    
                  ENDDO                                                    GREYK3B.628    
               ENDDO                                                       GREYK3B.629    
            ENDIF                                                          GREYK3B.630    
!                                                                          GREYK3B.631    
         ENDIF                                                             GREYK3B.632    
!                                                                          GREYK3B.633    
      ENDDO                                                                GREYK3B.634    
!                                                                          GREYK3B.635    
!                                                                          GREYK3B.636    
!                                                                          GREYK3B.637    
!                                                                          GREYK3B.638    
!     CALCULATE THE FINAL OPTICAL PROPERTIES.                              GREYK3B.639    
!     THE SCATTERING WAS INCLUDED IN THE FREE TOTAL EXTINCTION EARLIER,    GREYK3B.640    
!     BUT WE HAVE YET TO DIVIDE THE PRODUCT OF THE ASYMMETRY AND THE       GREYK3B.641    
!     SCATTERING BY THE MEAN SCATTERING.                                   GREYK3B.642    
!                                                                          GREYK3B.643    
      DO I=1, N_LAYER                                                      GREYK3B.644    
!                                                                          GREYK3B.645    
         N_INDEX=0                                                         GREYK3B.646    
         DO L   =1,N_PROFILE                                               GREYK3B.647    
           IF (K_EXT_SCAT_FREE(L,I).GT.TOL_DIV) THEN                       GREYK3B.648    
             N_INDEX       =N_INDEX+1                                      GREYK3B.649    
             INDEX(N_INDEX)=L                                              GREYK3B.650    
           END IF                                                          GREYK3B.651    
         END DO                                                            GREYK3B.652    
!                                                                          GREYK3B.653    
         IF(.NOT.L_RESCALE) THEN                                           GREYK3B.654    
            DO K=1, N_INDEX                                                GREYK3B.655    
               ASYMMETRY_FREE(INDEX(K), I)=ASYMMETRY_FREE(INDEX(K), I)     GREYK3B.656    
     &              /K_EXT_SCAT_FREE(INDEX(K), I)                          GREYK3B.657    
            ENDDO                                                          GREYK3B.658    
!                                                                          GREYK3B.659    
         ELSE IF (L_RESCALE.AND.N_INDEX.GT.0) THEN                         GREYK3B.660    
            TMP_INV=1.0                                                    GREYK3B.661    
     &           /K_EXT_SCAT_FREE(INDEX(1), I)                             GREYK3B.662    
            DO K=1, N_INDEX-1                                              GREYK3B.663    
               TMP_INV1=1.0                                                GREYK3B.664    
     &           /K_EXT_SCAT_FREE(INDEX(K+1), I)                           GREYK3B.665    
               FORWARD_SCATTER_FREE(INDEX(K), I)                           GREYK3B.666    
     &            =FORWARD_SCATTER_FREE(INDEX(K), I)                       GREYK3B.667    
     &              *TMP_INV                                               GREYK3B.668    
               ASYMMETRY_FREE(INDEX(K), I)=ASYMMETRY_FREE(INDEX(K), I)     GREYK3B.669    
     &              *TMP_INV                                               GREYK3B.670    
               TMP_INV=TMP_INV1                                            GREYK3B.671    
            ENDDO                                                          GREYK3B.672    
               FORWARD_SCATTER_FREE(INDEX(N_INDEX), I)                     GREYK3B.673    
     &            =FORWARD_SCATTER_FREE(INDEX(N_INDEX), I)                 GREYK3B.674    
     &              *TMP_INV                                               GREYK3B.675    
               ASYMMETRY_FREE(INDEX(N_INDEX), I)=                          GREYK3B.676    
     &              ASYMMETRY_FREE(INDEX(N_INDEX), I)                      GREYK3B.677    
     &              *TMP_INV                                               GREYK3B.678    
         ENDIF                                                             GREYK3B.679    
      ENDDO                                                                GREYK3B.680    
!                                                                          GREYK3B.681    
!                                                                          GREYK3B.682    
!     REPEAT FOR CLOUDS.                                                   GREYK3B.683    
      DO K=1, N_CLOUD_TYPE                                                 GREYK3B.684    
         DO I=N_CLOUD_TOP, N_LAYER                                         GREYK3B.685    
!                                                                          GREYK3B.686    
            J      =1                                                      GREYK3B.687    
            N_INDEX=0                                                      GREYK3B.688    
            DO L   =1,N_PROFILE                                            GREYK3B.689    
              IF (K_EXT_SCAT_CLOUD(L,I,K).GT.TOL_DIV) THEN                 GREYK3B.690    
                INDEX(J)=L                                                 GREYK3B.691    
                J       =J+1                                               GREYK3B.692    
                N_INDEX =N_INDEX+1                                         GREYK3B.693    
              END IF                                                       GREYK3B.694    
            END DO                                                         GREYK3B.695    
                                                                           GREYK3B.696    
            IF(.NOT.L_RESCALE) THEN                                        GREYK3B.697    
            DO J=1, N_INDEX                                                GREYK3B.698    
               ASYMMETRY_CLOUD(INDEX(J), I, K)                             GREYK3B.699    
     &            =ASYMMETRY_CLOUD(INDEX(J), I, K)                         GREYK3B.700    
     &            /K_EXT_SCAT_CLOUD(INDEX(J), I, K)                        GREYK3B.701    
            ENDDO                                                          GREYK3B.702    
            ELSE IF (L_RESCALE.AND.N_INDEX.GT.0) THEN                      GREYK3B.703    
               TMP_INV=1.0                                                 GREYK3B.704    
     &              /K_EXT_SCAT_CLOUD(INDEX(1), I, K)                      GREYK3B.705    
               DO J=1, N_INDEX-1                                           GREYK3B.706    
                  TMP_INV1=1.0                                             GREYK3B.707    
     &                 /K_EXT_SCAT_CLOUD(INDEX(J+1), I, K)                 GREYK3B.708    
                  FORWARD_SCATTER_CLOUD(INDEX(J), I, K)                    GREYK3B.709    
     &               =FORWARD_SCATTER_CLOUD(INDEX(J), I, K)                GREYK3B.710    
     &                 *TMP_INV                                            GREYK3B.711    
                  ASYMMETRY_CLOUD(INDEX(J), I, K)                          GREYK3B.712    
     &                 =ASYMMETRY_CLOUD(INDEX(J), I, K)                    GREYK3B.713    
     &                 *TMP_INV                                            GREYK3B.714    
                  TMP_INV=TMP_INV1                                         GREYK3B.715    
               ENDDO                                                       GREYK3B.716    
               FORWARD_SCATTER_CLOUD(INDEX(N_INDEX), I, K)                 GREYK3B.717    
     &              =FORWARD_SCATTER_CLOUD(INDEX(N_INDEX), I, K)           GREYK3B.718    
     &              *TMP_INV                                               GREYK3B.719    
               ASYMMETRY_CLOUD(INDEX(N_INDEX), I, K)                       GREYK3B.720    
     &              =ASYMMETRY_CLOUD(INDEX(N_INDEX), I, K)                 GREYK3B.721    
     &              *TMP_INV                                               GREYK3B.722    
            ENDIF                                                          GREYK3B.723    
                                                                           GREYK3B.724    
                                                                           GREYK3B.725    
         ENDDO                                                             GREYK3B.726    
      ENDDO                                                                GREYK3B.727    
                                                                           GREYK3B.728    
      RETURN                                                               GREYK3B.729    
      END                                                                  GREYK3B.730    
                                                                           GREYK3B.731    
*ENDIF DEF,A01_3A,OR,DEF,A02_3A                                            GREYK3B.732    
*ENDIF DEF,A70_1B                                                          GREYK3B.733