C *****************************COPYRIGHT******************************             RAD_ALL.26146 
C (c) CROWN COPYRIGHT 1996, METEOROLOGICAL OFFICE, All Rights Reserved.            RAD_ALL.26147 
C                                                                                  RAD_ALL.26148 
C Use, duplication or disclosure of this code is subject to the                    RAD_ALL.26149 
C restrictions as set forth in the contract.                                       RAD_ALL.26150 
C                                                                                  RAD_ALL.26151 
C                Meteorological Office                                             RAD_ALL.26152 
C                London Road                                                       RAD_ALL.26153 
C                BRACKNELL                                                         RAD_ALL.26154 
C                Berkshire UK                                                      RAD_ALL.26155 
C                RG12 2SZ                                                          RAD_ALL.26156 
C                                                                                  RAD_ALL.26157 
C If no contract has been raised with this copy of the code, the use,              RAD_ALL.26158 
C duplication or disclosure of it is strictly prohibited.  Permission              RAD_ALL.26159 
C to do so must first be obtained in writing from the Head of Numerical            RAD_ALL.26160 
C Modelling at the above address.                                                  RAD_ALL.26161 
C ******************************COPYRIGHT******************************            RAD_ALL.26162 
C                                                                                  RAD_ALL.26163 
!+ Subroutine to set the solar solar terms in a triple column.                     RAD_ALL.26164 
!                                                                                  RAD_ALL.26165 
! Method:                                                                          RAD_ALL.26166 
!       The Direct beam is calculated by propagating down through                  RAD_ALL.26167 
!       the column. These direct fluxes are used to  the                           RAD_ALL.26168 
!       source terms in each layer.                                                RAD_ALL.26169 
!                                                                                  RAD_ALL.26170 
! Current Owner of Code: J. M. Edwards                                             RAD_ALL.26171 
!                                                                                  RAD_ALL.26172 
! History:                                                                         RAD_ALL.26173 
!       Version         Date                    Comment                            RAD_ALL.26174 
!       4.2             24-05-96                Original Code                      RAD_ALL.26175 
!                                               (J. M. Edwards)                    RAD_ALL.26176 
!                                                                                  RAD_ALL.26177 
! Description of Code:                                                             RAD_ALL.26178 
!   FORTRAN 77  with extensions listed in documentation.                           RAD_ALL.26179 
!                                                                                  RAD_ALL.26180 
!- ---------------------------------------------------------------------           RAD_ALL.26181 
      SUBROUTINE TRIPLE_SOLAR_SOURCE(N_PROFILE, N_LAYER, N_CLOUD_TOP               RAD_ALL.26182 
     &   , FLUX_INC_DIRECT                                                         RAD_ALL.26183 
     &   , L_SCALE_SOLAR, ADJUST_SOLAR_KE                                          RAD_ALL.26184 
     &   , TRANS_0, SOURCE_COEFF                                                   RAD_ALL.26185 
     &   , V11, V12, V13, V21, V22, V23, V31, V32, V33                             RAD_ALL.26186 
     &   , FLUX_DIRECT                                                             RAD_ALL.26187 
     &   , FLUX_DIRECT_GROUND                                                      RAD_ALL.26188 
     &   , S_UP, S_DOWN                                                            RAD_ALL.26189 
     &   , NPD_PROFILE, NPD_LAYER                                                  RAD_ALL.26190 
     &   )                                                                         RAD_ALL.26191 
!                                                                                  RAD_ALL.26192 
!                                                                                  RAD_ALL.26193 
!                                                                                  RAD_ALL.26194 
      IMPLICIT NONE                                                                RAD_ALL.26195 
!                                                                                  RAD_ALL.26196 
!                                                                                  RAD_ALL.26197 
!     SIZES OF DUMMY ARRAYS                                                        RAD_ALL.26198 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.26199 
     &     NPD_PROFILE                                                             RAD_ALL.26200 
!             MAXIMUM NUMBER OF PROFILES                                           RAD_ALL.26201 
     &   , NPD_LAYER                                                               RAD_ALL.26202 
!             MAXIMUM NUMBER OF LAYERS                                             RAD_ALL.26203 
!                                                                                  RAD_ALL.26204 
!     COMDECKS INCLUDED                                                            RAD_ALL.26205 
!     ------------------------------------------------------------------           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    
!     ------------------------------------------------------------------           SCFPT3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       SCFPT3A.3     
!                                                                                  SCFPT3A.4     
!     MODULE TO SET POINTERS TO SOURCE COEFFICIENTS.                               SCFPT3A.5     
!                                                                                  SCFPT3A.6     
      INTEGER                                                                      SCFPT3A.7     
     &     IP_SCF_SOLAR_UP                                                         SCFPT3A.8     
!             POINTER TO SOURCE COEFICIENT FOR UPWARD SOLAR BEAM                   SCFPT3A.9     
     &   , IP_SCF_SOLAR_DOWN                                                       SCFPT3A.10    
!             POINTER TO SOURCE COEFICIENT FOR DOWNWARD SOLAR BEAM                 SCFPT3A.11    
     &   , IP_SCF_IR_1D                                                            SCFPT3A.12    
!             POINTER TO SOURCE COEFICIENT                                         SCFPT3A.13    
!             FOR 1ST DIFFERENCE OF PLANCKIAN                                      SCFPT3A.14    
     &   , IP_SCF_IR_2D                                                            SCFPT3A.15    
!             POINTER TO SOURCE COEFICIENT                                         SCFPT3A.16    
!             FOR 2ND DIFFERENCE OF PLANCKIAN                                      SCFPT3A.17    
!                                                                                  SCFPT3A.18    
      PARAMETER(                                                                   SCFPT3A.19    
     &     IP_SCF_SOLAR_UP=1                                                       SCFPT3A.20    
     &   , IP_SCF_SOLAR_DOWN=2                                                     SCFPT3A.21    
     &   , IP_SCF_IR_1D=1                                                          SCFPT3A.22    
     &   , IP_SCF_IR_2D=2                                                          SCFPT3A.23    
     &   )                                                                         SCFPT3A.24    
!                                                                                  SCFPT3A.25    
!     ------------------------------------------------------------------           SCFPT3A.26    
!     ------------------------------------------------------------------           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.26209 
!                                                                                  RAD_ALL.26210 
!                                                                                  RAD_ALL.26211 
!     DUMMY ARGUMENTS.                                                             RAD_ALL.26212 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.26213 
     &     N_PROFILE                                                               RAD_ALL.26214 
!             NUMBER OF PROFILES                                                   RAD_ALL.26215 
     &   , N_LAYER                                                                 RAD_ALL.26216 
!             NUMBER OF LAYERS                                                     RAD_ALL.26217 
     &   , N_CLOUD_TOP                                                             RAD_ALL.26218 
!             TOP CLOUDY LAYER                                                     RAD_ALL.26219 
!                                                                                  RAD_ALL.26220 
!     SPECIAL ARRAYS FOR EQUIVALENT EXTINCTION:                                    RAD_ALL.26221 
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.26222 
     &     L_SCALE_SOLAR                                                           RAD_ALL.26223 
!             SCALING APPLIED TO SOLAR FLUX                                        RAD_ALL.26224 
      REAL      !, INTENT(IN)                                                      RAD_ALL.26225 
     &     ADJUST_SOLAR_KE(NPD_PROFILE, NPD_LAYER)                                 RAD_ALL.26226 
!             ADJUSTMENT TO SOLAR FLUXES WITH EQUIVALENT EXTINCTION                RAD_ALL.26227 
!                                                                                  RAD_ALL.26228 
      REAL      !, INTENT(IN)                                                      RAD_ALL.26229 
     &     FLUX_INC_DIRECT(NPD_PROFILE)                                            RAD_ALL.26230 
!             INCIDENT DIRECT SOLAR FLUX                                           RAD_ALL.26231 
!                                                                                  RAD_ALL.26232 
!     OPTICAL PROPERTIES:                                                          RAD_ALL.26233 
      REAL      !, INTENT(IN)                                                      RAD_ALL.26234 
     &     TRANS_0(NPD_PROFILE, NPD_LAYER, NPD_REGION)                             RAD_ALL.26235 
!             DIRECT TRANSMISSION                                                  RAD_ALL.26236 
     &   , SOURCE_COEFF(NPD_PROFILE, NPD_LAYER                                     RAD_ALL.26237 
     &      , NPD_SOURCE_COEFF, NPD_REGION)                                        RAD_ALL.26238 
!             SOURCE COEFFICIENTS                                                  RAD_ALL.26239 
!                                                                                  RAD_ALL.26240 
!     ENERGY TRANSFER COEFFICIENTS:                                                RAD_ALL.26241 
      REAL      !, INTENT(IN)                                                      RAD_ALL.26242 
     &     V11(NPD_PROFILE, 0: NPD_LAYER)                                          RAD_ALL.26243 
!             ENERGY TRANSFER COEFFICIENT                                          RAD_ALL.26244 
     &   , V12(NPD_PROFILE, 0: NPD_LAYER)                                          RAD_ALL.26245 
!             ENERGY TRANSFER COEFFICIENT                                          RAD_ALL.26246 
     &   , V13(NPD_PROFILE, 0: NPD_LAYER)                                          RAD_ALL.26247 
!             ENERGY TRANSFER COEFFICIENT                                          RAD_ALL.26248 
     &   , V21(NPD_PROFILE, 0: NPD_LAYER)                                          RAD_ALL.26249 
!             ENERGY TRANSFER COEFFICIENT                                          RAD_ALL.26250 
     &   , V22(NPD_PROFILE, 0: NPD_LAYER)                                          RAD_ALL.26251 
!             ENERGY TRANSFER COEFFICIENT                                          RAD_ALL.26252 
     &   , V23(NPD_PROFILE, 0: NPD_LAYER)                                          RAD_ALL.26253 
!             ENERGY TRANSFER COEFFICIENT                                          RAD_ALL.26254 
     &   , V31(NPD_PROFILE, 0: NPD_LAYER)                                          RAD_ALL.26255 
!             ENERGY TRANSFER COEFFICIENT                                          RAD_ALL.26256 
     &   , V32(NPD_PROFILE, 0: NPD_LAYER)                                          RAD_ALL.26257 
!             ENERGY TRANSFER COEFFICIENT                                          RAD_ALL.26258 
     &   , V33(NPD_PROFILE, 0: NPD_LAYER)                                          RAD_ALL.26259 
!             ENERGY TRANSFER COEFFICIENT                                          RAD_ALL.26260 
!                                                                                  RAD_ALL.26261 
!     CALCULATED DIRECT FLUX AND SOURCE TERMS:                                     RAD_ALL.26262 
      REAL      !, INTENT(OUT)                                                     RAD_ALL.26263 
     &     FLUX_DIRECT(NPD_PROFILE, 0: NPD_LAYER)                                  RAD_ALL.26264 
!             OVERALL DIRECT FLUX                                                  RAD_ALL.26265 
     &   , FLUX_DIRECT_GROUND(NPD_PROFILE, NPD_REGION)                             RAD_ALL.26266 
!             DIRECT FLUXES AT GROUND BENEATH EACH REGION                          RAD_ALL.26267 
     &   , S_UP(NPD_PROFILE, NPD_LAYER, NPD_REGION)                                RAD_ALL.26268 
!             UPWARD SOURCE FUNCTIONS                                              RAD_ALL.26269 
     &   , S_DOWN(NPD_PROFILE, NPD_LAYER, NPD_REGION)                              RAD_ALL.26270 
!             DOWNWARD SOURCE FUNCTIONS                                            RAD_ALL.26271 
!                                                                                  RAD_ALL.26272 
!                                                                                  RAD_ALL.26273 
!     LOCAL VARIABLES.                                                             RAD_ALL.26274 
      INTEGER                                                                      RAD_ALL.26275 
     &     N_REGION                                                                RAD_ALL.26276 
!             NUMBER OF REGIONS                                                    RAD_ALL.26277 
      INTEGER                                                                      RAD_ALL.26278 
     &     I                                                                       RAD_ALL.26279 
!             LOOP VARIABLE                                                        RAD_ALL.26280 
     &   , L                                                                       RAD_ALL.26281 
!             LOOP VARIABLE                                                        RAD_ALL.26282 
     &   , K                                                                       RAD_ALL.26283 
!             LOOP VARIABLE                                                        RAD_ALL.26284 
!                                                                                  RAD_ALL.26285 
      REAL                                                                         RAD_ALL.26286 
     &     SOLAR_TOP(NPD_PROFILE, NPD_REGION)                                      RAD_ALL.26287 
!             SOLAR FLUXES AT TOP OF LAYER                                         RAD_ALL.26288 
     &   , SOLAR_BASE(NPD_PROFILE, NPD_REGION)                                     RAD_ALL.26289 
!             SOLAR FLUXES AT BASE OF LAYER                                        RAD_ALL.26290 
!                                                                                  RAD_ALL.26291 
!                                                                                  RAD_ALL.26292 
!     SET THE NUMBER OF REGIONS.                                                   RAD_ALL.26293 
      N_REGION=3                                                                   RAD_ALL.26294 
!                                                                                  RAD_ALL.26295 
!     THE CLEAR AND CLOUDY DIRECT FLUXES ARE CALCULATED SEPARATELY                 RAD_ALL.26296 
!     AND ADDED TOGETHER TO FORM THE TOTAL DIRECT FLUX.                            RAD_ALL.26297 
!                                                                                  RAD_ALL.26298 
!     SET INCIDENT FLUXES.                                                         RAD_ALL.26299 
      DO L=1, N_PROFILE                                                            RAD_ALL.26300 
         FLUX_DIRECT(L, 0)=FLUX_INC_DIRECT(L)                                      RAD_ALL.26301 
      ENDDO                                                                        RAD_ALL.26302 
!                                                                                  RAD_ALL.26303 
!     WITH EQUIVALENT EXTINCTION THE DIRECT SOLAR FLUX MUST BE                     RAD_ALL.26304 
!     CORRECTED.                                                                   RAD_ALL.26305 
!                                                                                  RAD_ALL.26306 
      IF (L_SCALE_SOLAR) THEN                                                      RAD_ALL.26307 
!                                                                                  RAD_ALL.26308 
         DO I=1, N_CLOUD_TOP-1                                                     RAD_ALL.26309 
            DO L=1, N_PROFILE                                                      RAD_ALL.26310 
               FLUX_DIRECT(L, I)                                                   RAD_ALL.26311 
     &            =FLUX_DIRECT(L, I-1)*TRANS_0(L, I, IP_REGION_CLEAR)              RAD_ALL.26312 
     &            *ADJUST_SOLAR_KE(L, I)                                           RAD_ALL.26313 
               S_UP(L, I, IP_REGION_CLEAR)                                         RAD_ALL.26314 
     &            =SOURCE_COEFF(L, I, IP_SCF_SOLAR_UP, IP_REGION_CLEAR)            RAD_ALL.26315 
     &            *FLUX_DIRECT(L, I-1)                                             RAD_ALL.26316 
               S_DOWN(L, I, IP_REGION_CLEAR)                                       RAD_ALL.26317 
     &            =(SOURCE_COEFF(L, I                                              RAD_ALL.26318 
     &            , IP_SCF_SOLAR_DOWN, IP_REGION_CLEAR)                            RAD_ALL.26319 
     &            -TRANS_0(L, I, IP_REGION_CLEAR))*FLUX_DIRECT(L, I-1)             RAD_ALL.26320 
     &            +FLUX_DIRECT(L, I)                                               RAD_ALL.26321 
            ENDDO                                                                  RAD_ALL.26322 
         ENDDO                                                                     RAD_ALL.26323 
!                                                                                  RAD_ALL.26324 
      ELSE                                                                         RAD_ALL.26325 
!                                                                                  RAD_ALL.26326 
         DO I=1, N_CLOUD_TOP-1                                                     RAD_ALL.26327 
            DO L=1, N_PROFILE                                                      RAD_ALL.26328 
               FLUX_DIRECT(L, I)                                                   RAD_ALL.26329 
     &            =FLUX_DIRECT(L, I-1)*TRANS_0(L, I, IP_REGION_CLEAR)              RAD_ALL.26330 
               S_UP(L, I, IP_REGION_CLEAR)                                         RAD_ALL.26331 
     &            =SOURCE_COEFF(L, I, IP_SCF_SOLAR_UP, IP_REGION_CLEAR)            RAD_ALL.26332 
     &            *FLUX_DIRECT(L, I-1)                                             RAD_ALL.26333 
               S_DOWN(L, I, IP_REGION_CLEAR)                                       RAD_ALL.26334 
     &            =SOURCE_COEFF(L, I                                               RAD_ALL.26335 
     &            , IP_SCF_SOLAR_DOWN, IP_REGION_CLEAR)                            RAD_ALL.26336 
     &            *FLUX_DIRECT(L, I-1)                                             RAD_ALL.26337 
            ENDDO                                                                  RAD_ALL.26338 
         ENDDO                                                                     RAD_ALL.26339 
!                                                                                  RAD_ALL.26340 
      ENDIF                                                                        RAD_ALL.26341 
!                                                                                  RAD_ALL.26342 
!                                                                                  RAD_ALL.26343 
!                                                                                  RAD_ALL.26344 
!     CLEAR AND CLOUDY REGION.                                                     RAD_ALL.26345 
!     INITIALIZE PARTIAL FLUXES:                                                   RAD_ALL.26346 
      DO L=1, N_PROFILE                                                            RAD_ALL.26347 
         SOLAR_BASE(L, IP_REGION_CLEAR)=FLUX_DIRECT(L, N_CLOUD_TOP-1)              RAD_ALL.26348 
         SOLAR_BASE(L, IP_REGION_STRAT)=0.0E+00                                    RAD_ALL.26349 
         SOLAR_BASE(L, IP_REGION_CONV)=0.0E+00                                     RAD_ALL.26350 
      ENDDO                                                                        RAD_ALL.26351 
!                                                                                  RAD_ALL.26352 
!                                                                                  RAD_ALL.26353 
      DO I=N_CLOUD_TOP, N_LAYER                                                    RAD_ALL.26354 
!                                                                                  RAD_ALL.26355 
!        TRANSFER FLUXES ACROSS THE INTERFACE.                                     RAD_ALL.26356 
!                                                                                  RAD_ALL.26357 
         DO L=1, N_PROFILE                                                         RAD_ALL.26358 
            SOLAR_TOP(L, IP_REGION_CLEAR)                                          RAD_ALL.26359 
     &         =V11(L, I-1)*SOLAR_BASE(L, IP_REGION_CLEAR)                         RAD_ALL.26360 
     &         +V12(L, I-1)*SOLAR_BASE(L, IP_REGION_STRAT)                         RAD_ALL.26361 
     &         +V13(L, I-1)*SOLAR_BASE(L, IP_REGION_CONV)                          RAD_ALL.26362 
            SOLAR_TOP(L, IP_REGION_STRAT)                                          RAD_ALL.26363 
     &         =V21(L, I-1)*SOLAR_BASE(L, IP_REGION_CLEAR)                         RAD_ALL.26364 
     &         +V22(L, I-1)*SOLAR_BASE(L, IP_REGION_STRAT)                         RAD_ALL.26365 
     &         +V23(L, I-1)*SOLAR_BASE(L, IP_REGION_CONV)                          RAD_ALL.26366 
            SOLAR_TOP(L, IP_REGION_CONV)                                           RAD_ALL.26367 
     &         =V31(L, I-1)*SOLAR_BASE(L, IP_REGION_CLEAR)                         RAD_ALL.26368 
     &         +V32(L, I-1)*SOLAR_BASE(L, IP_REGION_STRAT)                         RAD_ALL.26369 
     &         +V33(L, I-1)*SOLAR_BASE(L, IP_REGION_CONV)                          RAD_ALL.26370 
         ENDDO                                                                     RAD_ALL.26371 
!                                                                                  RAD_ALL.26372 
!                                                                                  RAD_ALL.26373 
!        PROPAGATE THE FLUXES THROUGH THE LAYER:                                   RAD_ALL.26374 
!                                                                                  RAD_ALL.26375 
         IF (L_SCALE_SOLAR) THEN                                                   RAD_ALL.26376 
!                                                                                  RAD_ALL.26377 
            DO K=1, N_REGION                                                       RAD_ALL.26378 
               DO L=1, N_PROFILE                                                   RAD_ALL.26379 
                  SOLAR_BASE(L, K)                                                 RAD_ALL.26380 
     &               =SOLAR_TOP(L, K)                                              RAD_ALL.26381 
     &               *TRANS_0(L, I, K)*ADJUST_SOLAR_KE(L, I)                       RAD_ALL.26382 
                  S_UP(L, I, K)                                                    RAD_ALL.26383 
     &               =SOURCE_COEFF(L, I, IP_SCF_SOLAR_UP, K)                       RAD_ALL.26384 
     &               *SOLAR_TOP(L, K)                                              RAD_ALL.26385 
                  S_DOWN(L, I, K)                                                  RAD_ALL.26386 
     &               =(SOURCE_COEFF(L, I, IP_SCF_SOLAR_DOWN, K)                    RAD_ALL.26387 
     &               -TRANS_0(L, I, K))*SOLAR_TOP(L, K)                            RAD_ALL.26388 
     &               +SOLAR_BASE(L, K)                                             RAD_ALL.26389 
               ENDDO                                                               RAD_ALL.26390 
            ENDDO                                                                  RAD_ALL.26391 
!                                                                                  RAD_ALL.26392 
         ELSE                                                                      RAD_ALL.26393 
!                                                                                  RAD_ALL.26394 
            DO K=1, N_REGION                                                       RAD_ALL.26395 
               DO L=1, N_PROFILE                                                   RAD_ALL.26396 
                  SOLAR_BASE(L, K)=SOLAR_TOP(L, K)                                 RAD_ALL.26397 
     &               *TRANS_0(L, I, K)                                             RAD_ALL.26398 
                  S_UP(L, I, K)                                                    RAD_ALL.26399 
     &               =SOURCE_COEFF(L, I, IP_SCF_SOLAR_UP, K)                       RAD_ALL.26400 
     &               *SOLAR_TOP(L, K)                                              RAD_ALL.26401 
                  S_DOWN(L, I, K)                                                  RAD_ALL.26402 
     &               =SOURCE_COEFF(L, I, IP_SCF_SOLAR_DOWN, K)                     RAD_ALL.26403 
     &               *SOLAR_TOP(L, K)                                              RAD_ALL.26404 
               ENDDO                                                               RAD_ALL.26405 
            ENDDO                                                                  RAD_ALL.26406 
!                                                                                  RAD_ALL.26407 
         ENDIF                                                                     RAD_ALL.26408 
!                                                                                  RAD_ALL.26409 
!                                                                                  RAD_ALL.26410 
!        CALCULATE THE TOTAL DIRECT FLUX.                                          RAD_ALL.26411 
!                                                                                  RAD_ALL.26412 
         DO L=1, N_PROFILE                                                         RAD_ALL.26413 
            FLUX_DIRECT(L, I)=SOLAR_BASE(L, IP_REGION_CLEAR)                       RAD_ALL.26414 
     &         +SOLAR_BASE(L, IP_REGION_STRAT)                                     RAD_ALL.26415 
     &         +SOLAR_BASE(L, IP_REGION_CONV)                                      RAD_ALL.26416 
         ENDDO                                                                     RAD_ALL.26417 
!                                                                                  RAD_ALL.26418 
      ENDDO                                                                        RAD_ALL.26419 
!                                                                                  RAD_ALL.26420 
!     PASS THE LAST VALUE AT THE BASE OF THE CLOUD OUT.                            RAD_ALL.26421 
      DO K=1, N_REGION                                                             RAD_ALL.26422 
         DO L=1, N_PROFILE                                                         RAD_ALL.26423 
            FLUX_DIRECT_GROUND(L, K)=SOLAR_BASE(L, K)                              RAD_ALL.26424 
         ENDDO                                                                     RAD_ALL.26425 
      ENDDO                                                                        RAD_ALL.26426 
!                                                                                  RAD_ALL.26427 
!                                                                                  RAD_ALL.26428 
!                                                                                  RAD_ALL.26429 
      RETURN                                                                       RAD_ALL.26430 
      END    
