C *****************************COPYRIGHT******************************             RAD_ALL.27044 
C (c) CROWN COPYRIGHT 1996, METEOROLOGICAL OFFICE, All Rights Reserved.            RAD_ALL.27045 
C                                                                                  RAD_ALL.27046 
C Use, duplication or disclosure of this code is subject to the                    RAD_ALL.27047 
C restrictions as set forth in the contract.                                       RAD_ALL.27048 
C                                                                                  RAD_ALL.27049 
C                Meteorological Office                                             RAD_ALL.27050 
C                London Road                                                       RAD_ALL.27051 
C                BRACKNELL                                                         RAD_ALL.27052 
C                Berkshire UK                                                      RAD_ALL.27053 
C                RG12 2SZ                                                          RAD_ALL.27054 
C                                                                                  RAD_ALL.27055 
C If no contract has been raised with this copy of the code, the use,              RAD_ALL.27056 
C duplication or disclosure of it is strictly prohibited.  Permission              RAD_ALL.27057 
C to do so must first be obtained in writing from the Head of Numerical            RAD_ALL.27058 
C Modelling at the above address.                                                  RAD_ALL.27059 
C ******************************COPYRIGHT******************************            RAD_ALL.27060 
C                                                                                  RAD_ALL.27061 
!+ Subroutine to calculate two-stream coefficients in the regions.                 RAD_ALL.27062 
!                                                                                  RAD_ALL.27063 
! Method:                                                                          RAD_ALL.27064 
!	The coefficients for each region are determined and                              RAD_ALL.27065 
!       averaged.                                                                  RAD_ALL.27066 
!                                                                                  RAD_ALL.27067 
! Current Owner of Code: J. M. Edwards                                             RAD_ALL.27068 
!                                                                                  RAD_ALL.27069 
! History:                                                                         RAD_ALL.27070 
!       Version         Date                    Comment                            RAD_ALL.27071 
!       4.2             15-05-96                Original Code                      RAD_ALL.27072 
!                                               (J. M. Edwards)                    RAD_ALL.27073 
!	4.3		20-02-97		Calls to vector                                                   RAD_ALL.27074 
!                                               searching routine                  RAD_ALL.27075 
!                                               WHENFGT removed.                   RAD_ALL.27076 
!						(J. M. Edwards)                                                             RAD_ALL.27077 
!                                                                                  RAD_ALL.27078 
! Description of Code:                                                             RAD_ALL.27079 
!   FORTRAN 77  with extensions listed in documentation.                           RAD_ALL.27080 
!                                                                                  RAD_ALL.27081 
!- ---------------------------------------------------------------------           RAD_ALL.27082 
      SUBROUTINE TWO_COEFF_REGION(IERR                                             RAD_ALL.27083 
     &   , N_PROFILE, N_LAYER, N_CLOUD_TOP                                         RAD_ALL.27084 
     &   , I_2STREAM, L_IR_SOURCE_QUAD, N_SOURCE_COEFF                             RAD_ALL.27085 
     &   , N_CLOUD_TYPE, FRAC_CLOUD                                                RAD_ALL.27086 
     &   , I_REGION_CLOUD, FRAC_REGION                                             RAD_ALL.27087 
     &   , ASYMMETRY_FREE, OMEGA_FREE, TAU_FREE                                    RAD_ALL.27088 
     &   , ASYMMETRY_CLOUD, OMEGA_CLOUD, TAU_CLOUD                                 RAD_ALL.27089 
     &   , ISOLIR, SEC_0                                                           RAD_ALL.27090 
     &   , TRANS, REFLECT, TRANS_0                                                 RAD_ALL.27091 
     &   , SOURCE_COEFF                                                            RAD_ALL.27092 
     &   , NPD_PROFILE, NPD_LAYER                                                  RAD_ALL.27093 
     &   )                                                                         RAD_ALL.27094 
!                                                                                  RAD_ALL.27095 
!                                                                                  RAD_ALL.27096 
!                                                                                  RAD_ALL.27097 
      IMPLICIT NONE                                                                RAD_ALL.27098 
!                                                                                  RAD_ALL.27099 
!                                                                                  RAD_ALL.27100 
!     SIZES OF DUMMY ARRAYS.                                                       RAD_ALL.27101 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.27102 
     &     NPD_PROFILE                                                             RAD_ALL.27103 
!             MAXIMUM NUMBER OF PROFILES                                           RAD_ALL.27104 
     &   , NPD_LAYER                                                               RAD_ALL.27105 
!             MAXIMUM NUMBER OF LAYERS                                             RAD_ALL.27106 
!                                                                                  RAD_ALL.27107 
!     INCLUDE COMDECKS.                                                            RAD_ALL.27108 
!     ------------------------------------------------------------------           DIMFIX3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       DIMFIX3A.3     
!                                                                                  DIMFIX3A.4     
!     MODULE TO SET INTERNAL DIMENSIONS TIED TO ALGORITHMS,                        DIMFIX3A.5     
!     MOSTLY FOR CLOUDS.                                                           DIMFIX3A.6     
!                                                                                  DIMFIX3A.7     
      INTEGER                                                                      DIMFIX3A.8     
     &     NPD_CLOUD_COMPONENT                                                     DIMFIX3A.9     
!             NUMBER OF COMPONENTS OF CLOUDS                                       DIMFIX3A.10    
     &   , NPD_CLOUD_TYPE                                                          DIMFIX3A.11    
!             NUMBER OF PERMITTED TYPES OF CLOUDS.                                 DIMFIX3A.12    
     &   , NPD_CLOUD_REPRESENTATION                                                DIMFIX3A.13    
!             NUMBER OF PERMITTED REPRESENTATIONS OF CLOUDS.                       DIMFIX3A.14    
     &   , NPD_OVERLAP_COEFF                                                       DIMFIX3A.15    
!             NUMBER OF OVERLAP COEFFICIENTS FOR CLOUDS                            DIMFIX3A.16    
     &   , NPD_SOURCE_COEFF                                                        DIMFIX3A.17    
!             NUMBER OF COEFFICIENTS FOR TWO-STREAM SOURCES                        DIMFIX3A.18    
     &   , NPD_REGION                                                              DIMFIX3A.19    
!             NUMBER OF REGIONS IN A LAYER                                         DIMFIX3A.20    
!                                                                                  DIMFIX3A.21    
      PARAMETER(                                                                   DIMFIX3A.22    
     &     NPD_CLOUD_COMPONENT=4                                                   DIMFIX3A.23    
     &   , NPD_CLOUD_TYPE=4                                                        DIMFIX3A.24    
     &   , NPD_CLOUD_REPRESENTATION=4                                              DIMFIX3A.25    
     &   , NPD_OVERLAP_COEFF=18                                                    DIMFIX3A.26    
     &   , NPD_SOURCE_COEFF=2                                                      DIMFIX3A.27    
     &   , NPD_REGION=3                                                            DIMFIX3A.28    
     &   )                                                                         DIMFIX3A.29    
!                                                                                  DIMFIX3A.30    
!     ------------------------------------------------------------------           DIMFIX3A.31    
!     ------------------------------------------------------------------           SPCRG3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       SPCRG3A.3     
!                                                                                  SPCRG3A.4     
!     MODULE TO SET FLAGS FOR DIFFERENT PORTIONS                                   SPCRG3A.5     
!     OF THE SPECTRUM.                                                             SPCRG3A.6     
!                                                                                  SPCRG3A.7     
      INTEGER                                                                      SPCRG3A.8     
     &     IP_SOLAR                                                                SPCRG3A.9     
!             SOLAR REGION                                                         SPCRG3A.10    
     &   , IP_INFRA_RED                                                            SPCRG3A.11    
!             INFRA-RED REGION                                                     SPCRG3A.12    
!                                                                                  SPCRG3A.13    
      PARAMETER(                                                                   SPCRG3A.14    
     &     IP_SOLAR=1                                                              SPCRG3A.15    
     &   , IP_INFRA_RED=2                                                          SPCRG3A.16    
     &   )                                                                         SPCRG3A.17    
!                                                                                  SPCRG3A.18    
!     ------------------------------------------------------------------           SPCRG3A.19    
!     ------------------------------------------------------------------           ERROR3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       ERROR3A.3     
!                                                                                  ERROR3A.4     
!     MODULE TO SET ERROR FLAGS IN THE RADIATION CODE.                             ERROR3A.5     
!                                                                                  ERROR3A.6     
      INTEGER                                                                      ERROR3A.7     
     &     I_NORMAL                                                                ERROR3A.8     
!             ERROR FREE CONDITION                                                 ERROR3A.9     
     &   , I_ERR_FATAL                                                             ERROR3A.10    
!             FATAL ERROR: IMMEDIATE RETURN                                        ERROR3A.11    
     &   , I_ABORT_CALCULATION                                                     ERROR3A.12    
!             CALCULATION ABORTED                                                  ERROR3A.13    
     &   , I_MISSING_DATA                                                          ERROR3A.14    
!             MISSING DATA ERROR: CONDITIONAL                                      ERROR3A.15    
     &   , I_ERR_IO                                                                ERROR3A.16    
!             I/O ERROR                                                            ERROR3A.17    
     &   , I_ERR_RANGE                                                             ERROR3A.18    
!             INTERPOLATION RANGE ERROR                                            ERROR3A.19    
     &   , I_ERR_EXIST                                                             ERROR3A.20    
!             EXISTENCE ERROR                                                      ERROR3A.21    
!                                                                                  ERROR3A.22    
      PARAMETER(                                                                   ERROR3A.23    
     &     I_NORMAL=0                                                              ERROR3A.24    
     &   , I_ERR_FATAL=1                                                           ERROR3A.25    
     &   , I_ABORT_CALCULATION=2                                                   ERROR3A.26    
     &   , I_MISSING_DATA=3                                                        ERROR3A.27    
     &   , I_ERR_IO=4                                                              ERROR3A.28    
     &   , I_ERR_RANGE=5                                                           ERROR3A.29    
     &   , I_ERR_EXIST=6                                                           ERROR3A.30    
     &   )                                                                         ERROR3A.31    
!                                                                                  ERROR3A.32    
!     ------------------------------------------------------------------           ERROR3A.33    
!     ------------------------------------------------------------------           CLDREG3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       CLDREG3A.3     
!                                                                                  CLDREG3A.4     
!     MODULE TO DEFINE REFERENCE NUMBERS FOR REGIONS OF CLOUDS.                    CLDREG3A.5     
!                                                                                  CLDREG3A.6     
      INTEGER                                                                      CLDREG3A.7     
     &     IP_REGION_CLEAR                                                         CLDREG3A.8     
!             REFERENCE NUMBER FOR CLEAR-SKY REGION                                CLDREG3A.9     
     &   , IP_REGION_STRAT                                                         CLDREG3A.10    
!             REFERENCE NUMBER FOR STRATIFORM CLOUDY REGION                        CLDREG3A.11    
     &   , IP_REGION_CONV                                                          CLDREG3A.12    
!             REFERENCE NUMBER FOR CONVECTIVE CLOUDY REGION                        CLDREG3A.13    
!                                                                                  CLDREG3A.14    
      PARAMETER(                                                                   CLDREG3A.15    
     &     IP_REGION_CLEAR=1                                                       CLDREG3A.16    
     &   , IP_REGION_STRAT=2                                                       CLDREG3A.17    
     &   , IP_REGION_CONV=3                                                        CLDREG3A.18    
     &   )                                                                         CLDREG3A.19    
!                                                                                  CLDREG3A.20    
!     ------------------------------------------------------------------           CLDREG3A.21    
!                                                                                  RAD_ALL.27113 
!                                                                                  RAD_ALL.27114 
!                                                                                  RAD_ALL.27115 
!     DUMMY ARGUMENTS.                                                             RAD_ALL.27116 
      INTEGER   !, INTENT(OUT)                                                     RAD_ALL.27117 
     &     IERR                                                                    RAD_ALL.27118 
!             ERROR FLAG                                                           RAD_ALL.27119 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.27120 
     &     N_PROFILE                                                               RAD_ALL.27121 
!             NUMBER OF PROFILES                                                   RAD_ALL.27122 
     &   , N_LAYER                                                                 RAD_ALL.27123 
!             NUMBER OF LAYERS                                                     RAD_ALL.27124 
     &   , N_CLOUD_TOP                                                             RAD_ALL.27125 
!             TOPMOST CLOUDY LAYER                                                 RAD_ALL.27126 
     &   , ISOLIR                                                                  RAD_ALL.27127 
!             SPECTRAL REGION                                                      RAD_ALL.27128 
     &   , N_CLOUD_TYPE                                                            RAD_ALL.27129 
!             NUMBER OF TYPES OF CLOUDS                                            RAD_ALL.27130 
     &   , I_2STREAM                                                               RAD_ALL.27131 
!             TWO STREAM SCHEME                                                    RAD_ALL.27132 
     &   , N_SOURCE_COEFF                                                          RAD_ALL.27133 
!             NUMBER OF SOURCE COEFFICIENTS                                        RAD_ALL.27134 
!                                                                                  RAD_ALL.27135 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.27136 
     &     I_REGION_CLOUD(NPD_CLOUD_TYPE)                                          RAD_ALL.27137 
!             REGIONS IN WHICH TYPES OF CLOUDS FALL                                RAD_ALL.27138 
!                                                                                  RAD_ALL.27139 
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.27140 
     &     L_IR_SOURCE_QUAD                                                        RAD_ALL.27141 
!             USE A QUADRATIC SOURCE IN THE INFRA-RED                              RAD_ALL.27142 
!                                                                                  RAD_ALL.27143 
!     OPTICAL PROPERTIES OF LAYER:                                                 RAD_ALL.27144 
      REAL      !, INTENT(IN)                                                      RAD_ALL.27145 
     &     FRAC_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)                      RAD_ALL.27146 
!             FRACTIONS OF DIFFERENT TYPES OF CLOUDS                               RAD_ALL.27147 
     &   , FRAC_REGION(NPD_PROFILE, NPD_LAYER, NPD_REGION)                         RAD_ALL.27148 
!             FRACTIONS OF TOTAL CLOUD OCCUPIED BY EACH REGION                     RAD_ALL.27149 
     &   , ASYMMETRY_FREE(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)                  RAD_ALL.27150 
!             CLEAR-SKY ASYMMETRY FACTOR                                           RAD_ALL.27151 
     &   , OMEGA_FREE(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)                      RAD_ALL.27152 
!             CLEAR-SKY ALBEDO OF SINGLE SCATTERING                                RAD_ALL.27153 
     &   , TAU_FREE(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)                        RAD_ALL.27154 
!             CLEAR-SKY OPTICAL DEPTH                                              RAD_ALL.27155 
     &   , ASYMMETRY_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)                 RAD_ALL.27156 
!             ASYMMETRY FACTOR                                                     RAD_ALL.27157 
     &   , OMEGA_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)                     RAD_ALL.27158 
!             ALBEDO OF SINGLE SCATTERING                                          RAD_ALL.27159 
     &   , TAU_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)                       RAD_ALL.27160 
!             OPTICAL DEPTH                                                        RAD_ALL.27161 
!                                                                                  RAD_ALL.27162 
!     SOLAR BEAM                                                                   RAD_ALL.27163 
      REAL      !, INTENT(IN)                                                      RAD_ALL.27164 
     &     SEC_0(NPD_PROFILE)                                                      RAD_ALL.27165 
!             SECANT OF ZENITH ANGLE                                               RAD_ALL.27166 
!                                                                                  RAD_ALL.27167 
!                                                                                  RAD_ALL.27168 
!     COEFFICIENTS IN THE TWO-STREAM EQUATIONS:                                    RAD_ALL.27169 
      REAL      !, INTENT(OUT)                                                     RAD_ALL.27170 
     &     TRANS(NPD_PROFILE, NPD_LAYER, NPD_REGION)                               RAD_ALL.27171 
!             DIFFUSE TRANSMISSION COEFFICIENT                                     RAD_ALL.27172 
     &   , REFLECT(NPD_PROFILE, NPD_LAYER, NPD_REGION)                             RAD_ALL.27173 
!             DIFFUSE REFLECTION COEFFICIENT                                       RAD_ALL.27174 
     &   , TRANS_0(NPD_PROFILE, NPD_LAYER, NPD_REGION)                             RAD_ALL.27175 
!             DIRECT TRANSMISSION COEFFICIENT                                      RAD_ALL.27176 
     &   , SOURCE_COEFF(NPD_PROFILE, NPD_LAYER                                     RAD_ALL.27177 
     &      , NPD_SOURCE_COEFF, NPD_REGION)                                        RAD_ALL.27178 
!             SOURCE COEFFICIENTS IN TWO-STREAM EQUATIONS                          RAD_ALL.27179 
!                                                                                  RAD_ALL.27180 
!     LOCAL VARIABLES.                                                             RAD_ALL.27181 
      INTEGER                                                                      RAD_ALL.27182 
     &     N_REGION                                                                RAD_ALL.27183 
!             NUMBER OF REGIONS                                                    RAD_ALL.27184 
      INTEGER                                                                      RAD_ALL.27185 
     &     I                                                                       RAD_ALL.27186 
!             LOOP VARIABLE                                                        RAD_ALL.27187 
     &   , J                                                                       RAD_ALL.27188 
!             LOOP VARIABLE                                                        RAD_ALL.27189 
     &   , K                                                                       RAD_ALL.27190 
!             LOOP VARIABLE                                                        RAD_ALL.27191 
     &   , L                                                                       RAD_ALL.27192 
!             LOOP VARIABLE                                                        RAD_ALL.27193 
     &   , I_REGION                                                                RAD_ALL.27194 
!             LOOP VARIABLE OVER REGIONS                                           RAD_ALL.27195 
!                                                                                  RAD_ALL.27196 
!     COEFFICIENTS IN THE TWO-STREAM EQUATIONS:                                    RAD_ALL.27197 
      REAL      !, INTENT(OUT)                                                     RAD_ALL.27198 
     &     TRANS_TEMP(NPD_PROFILE, NPD_LAYER)                                      RAD_ALL.27199 
!             TEMPORARY DIFFUSE TRANSMISSION COEFFICIENT                           RAD_ALL.27200 
     &   , REFLECT_TEMP(NPD_PROFILE, NPD_LAYER)                                    RAD_ALL.27201 
!             TEMPORARY DIFFUSE REFLECTION COEFFICIENT                             RAD_ALL.27202 
     &   , TRANS_0_TEMP(NPD_PROFILE, NPD_LAYER)                                    RAD_ALL.27203 
!             TEMPORARY DIRECT TRANSMISSION COEFFICIENT                            RAD_ALL.27204 
     &   , SOURCE_COEFF_TEMP(NPD_PROFILE, NPD_LAYER, NPD_SOURCE_COEFF)             RAD_ALL.27205 
!             TEMPORARY SOURCE COEFFICIENTS IN TWO-STREAM EQUATIONS                RAD_ALL.27206 
!                                                                                  RAD_ALL.27207 
!     VARIABLES FOR GATHERING:                                                     RAD_ALL.27208 
      INTEGER                                                                      RAD_ALL.27209 
     &     N_LIST                                                                  RAD_ALL.27210 
!             NUMBER OF POINTS IN LIST                                             RAD_ALL.27211 
     &   , L_LIST(NPD_PROFILE)                                                     RAD_ALL.27212 
!             LIST OF COLLECTED POINTS                                             RAD_ALL.27213 
     &   , LL                                                                      RAD_ALL.27214 
      REAL                                                                         RAD_ALL.27215 
     &     TAU_GATHERED(NPD_PROFILE, NPD_LAYER)                                    RAD_ALL.27216 
!             GATHERED OPTICAL DEPTH                                               RAD_ALL.27217 
     &   , OMEGA_GATHERED(NPD_PROFILE, NPD_LAYER)                                  RAD_ALL.27218 
!             GATHERED ALEBDO OF SINGLE SCATTERING                                 RAD_ALL.27219 
     &   , ASYMMETRY_GATHERED(NPD_PROFILE, NPD_LAYER)                              RAD_ALL.27220 
!             GATHERED ASYMMETRY                                                   RAD_ALL.27221 
     &   , SEC_0_GATHERED(NPD_PROFILE)                                             RAD_ALL.27222 
!             GATHERED ASYMMETRY                                                   RAD_ALL.27223 
!                                                                                  RAD_ALL.27224 
!     SUBROUTINES CALLED:                                                          RAD_ALL.27225 
      EXTERNAL                                                                     RAD_ALL.27226 
     &     TWO_COEFF                                                               RAD_ALL.27227 
!                                                                                  RAD_ALL.27228 
!     CRAY DIRECTIVES FOR THE WHOLE ROUTINE:                                       RAD_ALL.27229 
!     POINTS ARE NOT REPEATED IN THE INDEXING ARRAY, SO IT IS SAFE                 RAD_ALL.27230 
!     TO VECTORIZE OVER INDIRECTLY ADDRESSED ARRAYS.                               RAD_ALL.27231 
Cfpp$ NODEPCHK R                                                                   RAD_ALL.27232 
!                                                                                  RAD_ALL.27233 
!                                                                                  RAD_ALL.27234 
!                                                                                  RAD_ALL.27235 
!     FOR THE TRIPLE OVERLAP THE NUMBER OF REGIONS IS 3.                           RAD_ALL.27236 
      N_REGION=3                                                                   RAD_ALL.27237 
!                                                                                  RAD_ALL.27238 
!     DETERMINE THE OPTICAL PROPERTIES OF THE CLEAR-SKY REGIONS OF                 RAD_ALL.27239 
!     THE LAYERS.                                                                  RAD_ALL.27240 
!                                                                                  RAD_ALL.27241 
      CALL TWO_COEFF(IERR                                                          RAD_ALL.27242 
     &   , N_PROFILE, 1, N_LAYER                                                   RAD_ALL.27243 
     &   , I_2STREAM, L_IR_SOURCE_QUAD                                             RAD_ALL.27244 
     &   , ASYMMETRY_FREE, OMEGA_FREE, TAU_FREE                                    RAD_ALL.27245 
     &   , ISOLIR, SEC_0                                                           RAD_ALL.27246 
     &   , TRANS(1, 1, IP_REGION_CLEAR)                                            RAD_ALL.27247 
     &   , REFLECT(1, 1, IP_REGION_CLEAR)                                          RAD_ALL.27248 
     &   , TRANS_0(1, 1, IP_REGION_CLEAR)                                          RAD_ALL.27249 
     &   , SOURCE_COEFF(1, 1, 1, IP_REGION_CLEAR)                                  RAD_ALL.27250 
     &   , NPD_PROFILE, NPD_LAYER                                                  RAD_ALL.27251 
     &   )                                                                         RAD_ALL.27252 
      IF (IERR.NE.I_NORMAL) RETURN                                                 RAD_ALL.27253 
!                                                                                  RAD_ALL.27254 
!                                                                                  RAD_ALL.27255 
!     NOW DEAL WITH CLOUDS.                                                        RAD_ALL.27256 
!                                                                                  RAD_ALL.27257 
!     INITIALIZE THE FULL ARRAYS FOR CLOUDY REGIONS.                               RAD_ALL.27258 
!                                                                                  RAD_ALL.27259 
      DO I_REGION=1, N_REGION                                                      RAD_ALL.27260 
         IF (I_REGION.NE.IP_REGION_CLEAR) THEN                                     RAD_ALL.27261 
            DO I=N_CLOUD_TOP, N_LAYER                                              RAD_ALL.27262 
               DO L=1, N_PROFILE                                                   RAD_ALL.27263 
                  TRANS(L, I, I_REGION)=0.0E+00                                    RAD_ALL.27264 
                  REFLECT(L, I, I_REGION)=0.0E+00                                  RAD_ALL.27265 
               ENDDO                                                               RAD_ALL.27266 
            ENDDO                                                                  RAD_ALL.27267 
            DO J=1, N_SOURCE_COEFF                                                 RAD_ALL.27268 
               DO I=N_CLOUD_TOP, N_LAYER                                           RAD_ALL.27269 
                  DO L=1, N_PROFILE                                                RAD_ALL.27270 
                     SOURCE_COEFF(L, I, J, I_REGION)=0.0E+00                       RAD_ALL.27271 
                  ENDDO                                                            RAD_ALL.27272 
               ENDDO                                                               RAD_ALL.27273 
            ENDDO                                                                  RAD_ALL.27274 
!                                                                                  RAD_ALL.27275 
            IF (ISOLIR.EQ.IP_SOLAR) THEN                                           RAD_ALL.27276 
               DO I=N_CLOUD_TOP, N_LAYER                                           RAD_ALL.27277 
                  DO L=1, N_PROFILE                                                RAD_ALL.27278 
                     TRANS_0(L, I, I_REGION)=0.0E+00                               RAD_ALL.27279 
                  ENDDO                                                            RAD_ALL.27280 
               ENDDO                                                               RAD_ALL.27281 
            ENDIF                                                                  RAD_ALL.27282 
!                                                                                  RAD_ALL.27283 
         ENDIF                                                                     RAD_ALL.27284 
!                                                                                  RAD_ALL.27285 
      ENDDO                                                                        RAD_ALL.27286 
!                                                                                  RAD_ALL.27287 
!                                                                                  RAD_ALL.27288 
!                                                                                  RAD_ALL.27289 
!     CONSIDER EACH TYPE OF CLOUD IN TURN, CHECKING WHICH REGION IT                RAD_ALL.27290 
!     CONTRUBUTES TO AND FORM WEIGHTED SUMS OF CLOUD PROPERTIES.                   RAD_ALL.27291 
!                                                                                  RAD_ALL.27292 
      DO K=1, N_CLOUD_TYPE                                                         RAD_ALL.27293 
!                                                                                  RAD_ALL.27294 
!                                                                                  RAD_ALL.27295 
!        SET THE REGION IN WHICH CLOUDS OF THIS TYPE ARE INCLUDED.                 RAD_ALL.27296 
         I_REGION=I_REGION_CLOUD(K)                                                RAD_ALL.27297 
!                                                                                  RAD_ALL.27298 
         DO I=N_CLOUD_TOP, N_LAYER                                                 RAD_ALL.27299 
!                                                                                  RAD_ALL.27300 
!           FORM A LIST OF POINTS WHERE CLOUD OF THIS TYPE EXISTS                  RAD_ALL.27301 
!           ON THIS ROW FOR GATHERING.                                             RAD_ALL.27302 
            N_LIST=0                                                               RAD_ALL.27303 
            DO L=1, N_PROFILE                                                      RAD_ALL.27304 
               IF (FRAC_CLOUD(L, I, K).GT.0.0E+00) THEN                            RAD_ALL.27305 
                  N_LIST=N_LIST+1                                                  RAD_ALL.27306 
                  L_LIST(N_LIST)=L                                                 RAD_ALL.27307 
               ENDIF                                                               RAD_ALL.27308 
            ENDDO                                                                  RAD_ALL.27309 
!                                                                                  RAD_ALL.27310 
!                                                                                  RAD_ALL.27311 
            IF (N_LIST.GT.0) THEN                                                  RAD_ALL.27312 
!                                                                                  RAD_ALL.27313 
!              GATHER THE OPTICAL PROPERTIES. THOUGH WE CONSIDER ONLY              RAD_ALL.27314 
!              ONE LAYER AT A TIME THE LOWER ROUTINES WILL OPERATE ON              RAD_ALL.27315 
!              ARRAYS WITH VERTICAL STRUCTURE, SO THE GATHERED ARRAYS              RAD_ALL.27316 
!              ARE TWO-DIMENSIONAL.                                                RAD_ALL.27317 
!                                                                                  RAD_ALL.27318 
               DO L=1, N_LIST                                                      RAD_ALL.27319 
                  TAU_GATHERED(L, I)                                               RAD_ALL.27320 
     &              =TAU_CLOUD(L_LIST(L), I, K)                                    RAD_ALL.27321 
                  OMEGA_GATHERED(L, I)                                             RAD_ALL.27322 
     &              =OMEGA_CLOUD(L_LIST(L), I, K)                                  RAD_ALL.27323 
                  ASYMMETRY_GATHERED(L, I)                                         RAD_ALL.27324 
     &              =ASYMMETRY_CLOUD(L_LIST(L), I, K)                              RAD_ALL.27325 
               ENDDO                                                               RAD_ALL.27326 
               IF (ISOLIR.EQ.IP_SOLAR) THEN                                        RAD_ALL.27327 
                  DO L=1, N_LIST                                                   RAD_ALL.27328 
                     SEC_0_GATHERED(L)=SEC_0(L_LIST(L))                            RAD_ALL.27329 
                  ENDDO                                                            RAD_ALL.27330 
               ENDIF                                                               RAD_ALL.27331 
!                                                                                  RAD_ALL.27332 
!                                                                                  RAD_ALL.27333 
               CALL TWO_COEFF(IERR                                                 RAD_ALL.27334 
     &            , N_LIST, I, I                                                   RAD_ALL.27335 
     &            , I_2STREAM, L_IR_SOURCE_QUAD                                    RAD_ALL.27336 
     &            , ASYMMETRY_GATHERED, OMEGA_GATHERED                             RAD_ALL.27337 
     &            , TAU_GATHERED                                                   RAD_ALL.27338 
     &            , ISOLIR, SEC_0_GATHERED                                         RAD_ALL.27339 
     &            , TRANS_TEMP, REFLECT_TEMP, TRANS_0_TEMP                         RAD_ALL.27340 
     &            , SOURCE_COEFF_TEMP                                              RAD_ALL.27341 
     &            , NPD_PROFILE, NPD_LAYER                                         RAD_ALL.27342 
     &            )                                                                RAD_ALL.27343 
               IF (IERR.NE.I_NORMAL) RETURN                                        RAD_ALL.27344 
!                                                                                  RAD_ALL.27345 
!                                                                                  RAD_ALL.27346 
               DO L=1, N_LIST                                                      RAD_ALL.27347 
                  LL=L_LIST(L)                                                     RAD_ALL.27348 
                  TRANS(LL, I, I_REGION)=TRANS(LL, I, I_REGION)                    RAD_ALL.27349 
     &               +FRAC_CLOUD(LL, I, K)*TRANS_TEMP(L, I)                        RAD_ALL.27350 
                  REFLECT(LL, I, I_REGION)=REFLECT(LL, I, I_REGION)                RAD_ALL.27351 
     &               +FRAC_CLOUD(LL, I, K)*REFLECT_TEMP(L, I)                      RAD_ALL.27352 
               ENDDO                                                               RAD_ALL.27353 
               DO J=1, N_SOURCE_COEFF                                              RAD_ALL.27354 
                  DO L=1, N_LIST                                                   RAD_ALL.27355 
                     LL=L_LIST(L)                                                  RAD_ALL.27356 
                     SOURCE_COEFF(LL, I, J, I_REGION)                              RAD_ALL.27357 
     &                  =SOURCE_COEFF(LL, I, J, I_REGION)                          RAD_ALL.27358 
     &                  +FRAC_CLOUD(LL, I, K)                                      RAD_ALL.27359 
     &                  *SOURCE_COEFF_TEMP(L, I, J)                                RAD_ALL.27360 
                  ENDDO                                                            RAD_ALL.27361 
               ENDDO                                                               RAD_ALL.27362 
               IF (ISOLIR.EQ.IP_SOLAR) THEN                                        RAD_ALL.27363 
                  DO L=1, N_LIST                                                   RAD_ALL.27364 
                     LL=L_LIST(L)                                                  RAD_ALL.27365 
                     TRANS_0(LL, I, I_REGION)=TRANS_0(LL, I, I_REGION)             RAD_ALL.27366 
     &                  +FRAC_CLOUD(LL, I, K)*TRANS_0_TEMP(L, I)                   RAD_ALL.27367 
                  ENDDO                                                            RAD_ALL.27368 
               ENDIF                                                               RAD_ALL.27369 
!                                                                                  RAD_ALL.27370 
            ENDIF                                                                  RAD_ALL.27371 
!                                                                                  RAD_ALL.27372 
         ENDDO                                                                     RAD_ALL.27373 
      ENDDO                                                                        RAD_ALL.27374 
!                                                                                  RAD_ALL.27375 
!                                                                                  RAD_ALL.27376 
!     FINALLY, SCALE THE WEIGHTED SUMS BY THE CLOUD FRACTIONS.                     RAD_ALL.27377 
      DO I_REGION=1, N_REGION                                                      RAD_ALL.27378 
         IF (I_REGION.NE.IP_REGION_CLEAR) THEN                                     RAD_ALL.27379 
            DO I=N_CLOUD_TOP, N_LAYER                                              RAD_ALL.27380 
!                                                                                  RAD_ALL.27381 
!              GATHER POINTS WITHIN THIS REGION.                                   RAD_ALL.27382 
               N_LIST=0                                                            RAD_ALL.27383 
               DO L=1,N_PROFILE                                                    RAD_ALL.27384 
                  IF (FRAC_REGION(L, I, I_REGION).GT.0.0E+00) THEN                 RAD_ALL.27385 
                     N_LIST=N_LIST+1                                               RAD_ALL.27386 
                     L_LIST(N_LIST)=L                                              RAD_ALL.27387 
                  ENDIF                                                            RAD_ALL.27388 
               ENDDO                                                               RAD_ALL.27389 
               DO L=1, N_LIST                                                      RAD_ALL.27390 
                  LL=L_LIST(L)                                                     RAD_ALL.27391 
                  TRANS(LL, I, I_REGION)=TRANS(LL, I, I_REGION)                    RAD_ALL.27392 
     &               /FRAC_REGION(LL, I, I_REGION)                                 RAD_ALL.27393 
                  REFLECT(LL, I, I_REGION)=REFLECT(LL, I, I_REGION)                RAD_ALL.27394 
     &               /FRAC_REGION(LL, I, I_REGION)                                 RAD_ALL.27395 
               ENDDO                                                               RAD_ALL.27396 
               DO J=1, N_SOURCE_COEFF                                              RAD_ALL.27397 
                  DO L=1, N_LIST                                                   RAD_ALL.27398 
                     LL=L_LIST(L)                                                  RAD_ALL.27399 
                     SOURCE_COEFF(LL, I, J, I_REGION)                              RAD_ALL.27400 
     &                  =SOURCE_COEFF(LL, I, J, I_REGION)                          RAD_ALL.27401 
     &                  /FRAC_REGION(LL, I, I_REGION)                              RAD_ALL.27402 
                  ENDDO                                                            RAD_ALL.27403 
               ENDDO                                                               RAD_ALL.27404 
               IF (ISOLIR.EQ.IP_SOLAR) THEN                                        RAD_ALL.27405 
                  DO L=1, N_LIST                                                   RAD_ALL.27406 
                     LL=L_LIST(L)                                                  RAD_ALL.27407 
                     TRANS_0(LL, I, I_REGION)=TRANS_0(LL, I, I_REGION)             RAD_ALL.27408 
     &                  /FRAC_REGION(LL, I, I_REGION)                              RAD_ALL.27409 
                  ENDDO                                                            RAD_ALL.27410 
               ENDIF                                                               RAD_ALL.27411 
            ENDDO                                                                  RAD_ALL.27412 
         ENDIF                                                                     RAD_ALL.27413 
      ENDDO                                                                        RAD_ALL.27414 
!                                                                                  RAD_ALL.27415 
!                                                                                  RAD_ALL.27416 
!                                                                                  RAD_ALL.27417 
      RETURN                                                                       RAD_ALL.27418 
      END   
