C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.            RAD_ALL.10171 
C                                                                                  RAD_ALL.10172 
C Use, duplication or disclosure of this code is subject to the                    RAD_ALL.10173 
C restrictions as set forth in the contract.                                       RAD_ALL.10174 
C                                                                                  RAD_ALL.10175 
C                Meteorological Office                                             RAD_ALL.10176 
C                London Road                                                       RAD_ALL.10177 
C                BRACKNELL                                                         RAD_ALL.10178 
C                Berkshire UK                                                      RAD_ALL.10179 
C                RG12 2SZ                                                          RAD_ALL.10180 
C                                                                                  RAD_ALL.10181 
C If no contract has been raised with this copy of the code, the use,              RAD_ALL.10182 
C duplication or disclosure of it is strictly prohibited.  Permission              RAD_ALL.10183 
C to do so must first be obtained in writing from the Head of Numerical            RAD_ALL.10184 
C Modelling at the above address.                                                  RAD_ALL.10185 
C ******************************COPYRIGHT******************************            RAD_ALL.10186 
C                                                                                  RAD_ALL.10187 
!+ Subroutine to solve for fluxes treating scattering approximately.               RAD_ALL.10188 
!                                                                                  RAD_ALL.10189 
! Method:                                                                          RAD_ALL.10190 
!       The routine is applicable in the infra-red. Downward                       RAD_ALL.10191 
!       differential fluxes are calculated first assuming that the                 RAD_ALL.10192 
!       upward differential fluxes are 0. Upward fluxes are then                   RAD_ALL.10193 
!       calculated using the previously calculated downward fluxes                 RAD_ALL.10194 
!       in the reflected terms.                                                    RAD_ALL.10195 
!                                                                                  RAD_ALL.10196 
! Current Owner of Code: J. M. Edwards                                             RAD_ALL.10197 
!                                                                                  RAD_ALL.10198 
! History:                                                                         RAD_ALL.10199 
!       Version         Date                    Comment                            RAD_ALL.10200 
!       4.0             27-07-95                Original Code                      RAD_ALL.10201 
!                                               (J. M. Edwards)                    RAD_ALL.10202 
!                                                                                  RAD_ALL.10203 
! Description of Code:                                                             RAD_ALL.10204 
!   FORTRAN 77  with extensions listed in documentation.                           RAD_ALL.10205 
!                                                                                  RAD_ALL.10206 
!- ---------------------------------------------------------------------           RAD_ALL.10207 
      SUBROUTINE MIX_APP_SCAT(N_PROFILE, N_LAYER, N_CLOUD_TOP                      RAD_ALL.10208 
     &   , T_FREE, R_FREE, S_DOWN_FREE, S_UP_FREE                                  RAD_ALL.10209 
     &   , T_CLOUD, R_CLOUD, S_DOWN_CLOUD, S_UP_CLOUD                              RAD_ALL.10210 
     &   , G_FF, G_FC, G_CF, G_CC                                                  RAD_ALL.10211 
     &   , B_FF, B_FC, B_CF, B_CC                                                  RAD_ALL.10212 
     &   , L_NET                                                                   RAD_ALL.10213 
     &   , FLUX_INC_DOWN                                                           RAD_ALL.10214 
     &   , SOURCE_GROUND, ALBEDO_SURFACE_DIFF                                      RAD_ALL.10215 
     &   , FLUX_DIFFUSE                                                            RAD_ALL.10216 
     &   , NPD_PROFILE, NPD_LAYER                                                  RAD_ALL.10217 
     &   )                                                                         RAD_ALL.10218 
!                                                                                  RAD_ALL.10219 
!                                                                                  RAD_ALL.10220 
      IMPLICIT NONE                                                                RAD_ALL.10221 
!                                                                                  RAD_ALL.10222 
!                                                                                  RAD_ALL.10223 
!     SIZES OF DUMMY ARRAYS.                                                       RAD_ALL.10224 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.10225 
     &     NPD_PROFILE                                                             RAD_ALL.10226 
!             MAXIMUM NUMBER OF PROFILES                                           RAD_ALL.10227 
     &   , NPD_LAYER                                                               RAD_ALL.10228 
!             MAXIMUM NUMBER OF LAYERS                                             RAD_ALL.10229 
!                                                                                  RAD_ALL.10230 
!                                                                                  RAD_ALL.10231 
!     DUMMY ARGUMENTS.                                                             RAD_ALL.10232 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.10233 
     &     N_PROFILE                                                               RAD_ALL.10234 
!             NUMBER OF PROFILES                                                   RAD_ALL.10235 
     &   , N_LAYER                                                                 RAD_ALL.10236 
!             NUMBER OF LAYERS                                                     RAD_ALL.10237 
     &   , N_CLOUD_TOP                                                             RAD_ALL.10238 
!             TOPMOST CLOUDY LAYER                                                 RAD_ALL.10239 
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.10240 
     &     L_NET                                                                   RAD_ALL.10241 
!             FLAG FOR CALCULATION OF NET FLUXES                                   RAD_ALL.10242 
      REAL      !, INTENT(IN)                                                      RAD_ALL.10243 
     &     T_FREE(NPD_PROFILE, NPD_LAYER)                                          RAD_ALL.10244 
!             FREE TRANSMISSION                                                    RAD_ALL.10245 
     &   , R_FREE(NPD_PROFILE, NPD_LAYER)                                          RAD_ALL.10246 
!             FREE REFLECTION                                                      RAD_ALL.10247 
     &   , S_DOWN_FREE(NPD_PROFILE, NPD_LAYER)                                     RAD_ALL.10248 
!             FREE DOWNWARD SOURCE FUNCTION                                        RAD_ALL.10249 
     &   , S_UP_FREE(NPD_PROFILE, NPD_LAYER)                                       RAD_ALL.10250 
!             FREE UPWARD SOURCE FUNCTION                                          RAD_ALL.10251 
     &   , T_CLOUD(NPD_PROFILE, NPD_LAYER)                                         RAD_ALL.10252 
!             CLOUDY TRANSMISSION                                                  RAD_ALL.10253 
     &   , R_CLOUD(NPD_PROFILE, NPD_LAYER)                                         RAD_ALL.10254 
!             CLOUDY REFLECTION                                                    RAD_ALL.10255 
     &   , S_DOWN_CLOUD(NPD_PROFILE, NPD_LAYER)                                    RAD_ALL.10256 
!             DOWNWARD CLOUDY SOURCE FUNCTION                                      RAD_ALL.10257 
     &   , S_UP_CLOUD(NPD_PROFILE, NPD_LAYER)                                      RAD_ALL.10258 
!             UPWARD CLOUDY SOURCE FUNCTION                                        RAD_ALL.10259 
      REAL      !, INTENT(IN)                                                      RAD_ALL.10260 
     &     G_FF(NPD_PROFILE, 0: NPD_LAYER)                                         RAD_ALL.10261 
!             ENERGY TRANSFER COEFFICIENT                                          RAD_ALL.10262 
     &   , G_FC(NPD_PROFILE, 0: NPD_LAYER)                                         RAD_ALL.10263 
!             ENERGY TRANSFER COEFFICIENT                                          RAD_ALL.10264 
     &   , G_CF(NPD_PROFILE, 0: NPD_LAYER)                                         RAD_ALL.10265 
!             ENERGY TRANSFER COEFFICIENT                                          RAD_ALL.10266 
     &   , G_CC(NPD_PROFILE, 0: NPD_LAYER)                                         RAD_ALL.10267 
!             ENERGY TRANSFER COEFFICIENT                                          RAD_ALL.10268 
     &   , B_FF(NPD_PROFILE, 0: NPD_LAYER)                                         RAD_ALL.10269 
!             ENERGY TRANSFER COEFFICIENT                                          RAD_ALL.10270 
     &   , B_FC(NPD_PROFILE, 0: NPD_LAYER)                                         RAD_ALL.10271 
!             ENERGY TRANSFER COEFFICIENT                                          RAD_ALL.10272 
     &   , B_CF(NPD_PROFILE, 0: NPD_LAYER)                                         RAD_ALL.10273 
!             ENERGY TRANSFER COEFFICIENT                                          RAD_ALL.10274 
     &   , B_CC(NPD_PROFILE, 0: NPD_LAYER)                                         RAD_ALL.10275 
!             ENERGY TRANSFER COEFFICIENT                                          RAD_ALL.10276 
      REAL      !, INTENT(IN)                                                      RAD_ALL.10277 
     &     FLUX_INC_DOWN(NPD_PROFILE)                                              RAD_ALL.10278 
!             INCIDENT DIFFUSE FLUX                                                RAD_ALL.10279 
     &   , SOURCE_GROUND(NPD_PROFILE)                                              RAD_ALL.10280 
!             SOURCE FROM GROUND                                                   RAD_ALL.10281 
     &   , ALBEDO_SURFACE_DIFF(NPD_PROFILE)                                        RAD_ALL.10282 
!             DIFFUSE ALBEDO                                                       RAD_ALL.10283 
      REAL      !, INTENT(OUT)                                                     RAD_ALL.10284 
     &     FLUX_DIFFUSE(NPD_PROFILE, 2*NPD_LAYER+2)                                RAD_ALL.10285 
!             DIFFUSE FLUX                                                         RAD_ALL.10286 
!                                                                                  RAD_ALL.10287 
!     LOCAL VARIABLES.                                                             RAD_ALL.10288 
      INTEGER                                                                      RAD_ALL.10289 
     &     I                                                                       RAD_ALL.10290 
!             LOOP VARIABLE                                                        RAD_ALL.10291 
     &   , L                                                                       RAD_ALL.10292 
!             LOOP VARIABLE                                                        RAD_ALL.10293 
!                                                                                  RAD_ALL.10294 
      REAL                                                                         RAD_ALL.10295 
     &     FLUX_DOWN(NPD_PROFILE, 0: NPD_LAYER)                                    RAD_ALL.10296 
!             DOWNWARD FLUXES OUTSIDE CLOUDS JUST BELOW I'TH LEVEL                 RAD_ALL.10297 
     &   , FLUX_DOWN_CLOUD(NPD_PROFILE, 0: NPD_LAYER)                              RAD_ALL.10298 
!             DOWNWARD FLUXES INSIDE CLOUDS JUST BELOW I'TH LEVEL                  RAD_ALL.10299 
     &   , FLUX_UP(NPD_PROFILE, 0: NPD_LAYER)                                      RAD_ALL.10300 
!             UPWARD FLUXES OUTSIDE CLOUDS JUST ABOVE I'TH LEVEL                   RAD_ALL.10301 
     &   , FLUX_UP_CLOUD(NPD_PROFILE, 0: NPD_LAYER)                                RAD_ALL.10302 
!             UPWARD FLUXES INSIDE CLOUDS JUST ABOVE I'TH LEVEL                    RAD_ALL.10303 
     &   , FLUX_PROPAGATED                                                         RAD_ALL.10304 
!             TEMPORARY PROPAGATED FLUX OUTSIDE CLOUD                              RAD_ALL.10305 
     &   , FLUX_PROPAGATED_CLOUD                                                   RAD_ALL.10306 
!             TEMPORARY PROPAGATED FLUX INSIDE CLOUD                               RAD_ALL.10307 
     &   , FLUX_CLOUD_TOP(NPD_PROFILE)                                             RAD_ALL.10308 
!             TOTAL DOWNWARD FLUX AT TOP OF CLOUD                                  RAD_ALL.10309 
!                                                                                  RAD_ALL.10310 
!                                                                                  RAD_ALL.10311 
!                                                                                  RAD_ALL.10312 
!     THE ARRAYS FLUX_DOWN AND FLUX_UP WILL EVENTUALLY CONTAIN THE TOTAL           RAD_ALL.10313 
!     FLUXES, BUT INITIALLY THEY ARE USED FOR THE CLEAR FLUXES.                    RAD_ALL.10314 
!     NOTE THAT DOWNWARD FLUXES REFER TO VALUES JUST BELOW THE INTERFACE           RAD_ALL.10315 
!     AND UPWARD FLUXES TO VALUES JUST ABOVE IT.                                   RAD_ALL.10316 
!                                                                                  RAD_ALL.10317 
!                                                                                  RAD_ALL.10318 
!     DOWNWARD FLUX:                                                               RAD_ALL.10319 
!                                                                                  RAD_ALL.10320 
!     REGION ABOVE CLOUDS:                                                         RAD_ALL.10321 
      DO L=1, N_PROFILE                                                            RAD_ALL.10322 
         FLUX_DOWN(L, 0)=FLUX_INC_DOWN(L)                                          RAD_ALL.10323 
      ENDDO                                                                        RAD_ALL.10324 
      DO I=1, N_CLOUD_TOP-1                                                        RAD_ALL.10325 
         DO L=1, N_PROFILE                                                         RAD_ALL.10326 
            FLUX_DOWN(L, I)=T_FREE(L, I)*FLUX_DOWN(L, I-1)                         RAD_ALL.10327 
     &         +S_DOWN_FREE(L, I)                                                  RAD_ALL.10328 
         ENDDO                                                                     RAD_ALL.10329 
      ENDDO                                                                        RAD_ALL.10330 
      DO L=1, N_PROFILE                                                            RAD_ALL.10331 
         FLUX_CLOUD_TOP(L)=FLUX_DOWN(L, N_CLOUD_TOP-1)                             RAD_ALL.10332 
      ENDDO                                                                        RAD_ALL.10333 
!                                                                                  RAD_ALL.10334 
!     REGION OF CLOUDS:                                                            RAD_ALL.10335 
      DO L=1, N_PROFILE                                                            RAD_ALL.10336 
         FLUX_DOWN(L, N_CLOUD_TOP-1)                                               RAD_ALL.10337 
     &      =G_FF(L, N_CLOUD_TOP-1)*FLUX_CLOUD_TOP(L)                              RAD_ALL.10338 
         FLUX_DOWN_CLOUD(L, N_CLOUD_TOP-1)                                         RAD_ALL.10339 
     &      =G_FC(L, N_CLOUD_TOP-1)*FLUX_CLOUD_TOP(L)                              RAD_ALL.10340 
      ENDDO                                                                        RAD_ALL.10341 
!                                                                                  RAD_ALL.10342 
      DO I=N_CLOUD_TOP, N_LAYER-1                                                  RAD_ALL.10343 
         DO L=1, N_PROFILE                                                         RAD_ALL.10344 
!                                                                                  RAD_ALL.10345 
!           PROPAGATE DOWNWARD FLUXES THROUGH THE LAYER.                           RAD_ALL.10346 
            FLUX_PROPAGATED=T_FREE(L, I)*FLUX_DOWN(L, I-1)                         RAD_ALL.10347 
     &         +S_DOWN_FREE(L, I)                                                  RAD_ALL.10348 
            FLUX_PROPAGATED_CLOUD=T_CLOUD(L, I)*FLUX_DOWN_CLOUD(L, I-1)            RAD_ALL.10349 
     &         +S_DOWN_CLOUD(L, I)                                                 RAD_ALL.10350 
!           TRANSFER DOWNWARD FLUXES ACROSS THE INTERFACE.                         RAD_ALL.10351 
            FLUX_DOWN(L, I)                                                        RAD_ALL.10352 
     &         =G_FF(L, I)*FLUX_PROPAGATED                                         RAD_ALL.10353 
     &         +G_CF(L, I)*FLUX_PROPAGATED_CLOUD                                   RAD_ALL.10354 
            FLUX_DOWN_CLOUD(L, I)                                                  RAD_ALL.10355 
     &         =G_CC(L, I)*FLUX_PROPAGATED_CLOUD                                   RAD_ALL.10356 
     &         +G_FC(L, I)*FLUX_PROPAGATED                                         RAD_ALL.10357 
!                                                                                  RAD_ALL.10358 
         ENDDO                                                                     RAD_ALL.10359 
      ENDDO                                                                        RAD_ALL.10360 
!                                                                                  RAD_ALL.10361 
!     PROPAGATE ACROSS THE BOTTOM LAYER, BUT WITHOUT TRANSFERRING                  RAD_ALL.10362 
!     ACROSS THE SURFACE AND FORM THE REFLECTED BEAMS.                             RAD_ALL.10363 
      DO L=1, N_PROFILE                                                            RAD_ALL.10364 
!        PROPAGATE DOWNWARD FLUXES THROUGH THE LAYER.                              RAD_ALL.10365 
         FLUX_DOWN(L, N_LAYER)                                                     RAD_ALL.10366 
     &      =T_FREE(L, N_LAYER)*FLUX_DOWN(L, N_LAYER-1)                            RAD_ALL.10367 
     &      +S_DOWN_FREE(L, N_LAYER)                                               RAD_ALL.10368 
         FLUX_DOWN_CLOUD(L, N_LAYER)                                               RAD_ALL.10369 
     &      =T_CLOUD(L, N_LAYER)*FLUX_DOWN_CLOUD(L, N_LAYER-1)                     RAD_ALL.10370 
     &      +S_DOWN_CLOUD(L, N_LAYER)                                              RAD_ALL.10371 
         FLUX_UP(L, N_LAYER)                                                       RAD_ALL.10372 
     &      =ALBEDO_SURFACE_DIFF(L)*FLUX_DOWN(L, N_LAYER)                          RAD_ALL.10373 
     &      +B_FF(L, N_LAYER)*SOURCE_GROUND(L)                                     RAD_ALL.10374 
         FLUX_UP_CLOUD(L, N_LAYER)                                                 RAD_ALL.10375 
     &      =ALBEDO_SURFACE_DIFF(L)*FLUX_DOWN_CLOUD(L, N_LAYER)                    RAD_ALL.10376 
     &      +B_CF(L, N_LAYER)*SOURCE_GROUND(L)                                     RAD_ALL.10377 
      ENDDO                                                                        RAD_ALL.10378 
!                                                                                  RAD_ALL.10379 
!                                                                                  RAD_ALL.10380 
!     CALCULATE THE UPWARD FLUXES USING THE PREVIOUS DOWNWARD FLUXES               RAD_ALL.10381 
!     TO APPROXIMATE THE SCATTERING TERM.                                          RAD_ALL.10382 
      DO I=N_LAYER, N_CLOUD_TOP, -1                                                RAD_ALL.10383 
         DO L=1, N_PROFILE                                                         RAD_ALL.10384 
!                                                                                  RAD_ALL.10385 
!           PROPAGATE UPWARD FLUXES THROUGH THE LAYER.                             RAD_ALL.10386 
            FLUX_PROPAGATED=T_FREE(L, I)*FLUX_UP(L, I)+S_UP_FREE(L, I)             RAD_ALL.10387 
     &         +R_FREE(L, I)*FLUX_DOWN(L, I-1)                                     RAD_ALL.10388 
            FLUX_PROPAGATED_CLOUD=T_CLOUD(L, I)*FLUX_UP_CLOUD(L, I)                RAD_ALL.10389 
     &         +S_UP_CLOUD(L, I)+R_CLOUD(L, I)*FLUX_DOWN_CLOUD(L, I-1)             RAD_ALL.10390 
!           TRANSFER UPWARD FLUXES ACROSS THE INTERFACE.                           RAD_ALL.10391 
            FLUX_UP(L, I-1)=B_FF(L, I-1)*FLUX_PROPAGATED                           RAD_ALL.10392 
     &         +B_FC(L, I-1)*FLUX_PROPAGATED_CLOUD                                 RAD_ALL.10393 
            FLUX_UP_CLOUD(L, I-1)=B_CC(L, I-1)*FLUX_PROPAGATED_CLOUD               RAD_ALL.10394 
     &         +B_CF(L, I-1)*FLUX_PROPAGATED                                       RAD_ALL.10395 
!                                                                                  RAD_ALL.10396 
         ENDDO                                                                     RAD_ALL.10397 
      ENDDO                                                                        RAD_ALL.10398 
!                                                                                  RAD_ALL.10399 
!     CONTINUE THROUGH THE REGION ABOVE CLOUDS.                                    RAD_ALL.10400 
      DO I=N_CLOUD_TOP-1, 1, -1                                                    RAD_ALL.10401 
         DO L=1, N_PROFILE                                                         RAD_ALL.10402 
            FLUX_UP(L, I-1)=T_FREE(L, I)*FLUX_UP(L,I)+S_UP_FREE(L, I)              RAD_ALL.10403 
     &         +R_FREE(L, I)*FLUX_DOWN(L, I-1)                                     RAD_ALL.10404 
         ENDDO                                                                     RAD_ALL.10405 
      ENDDO                                                                        RAD_ALL.10406 
!                                                                                  RAD_ALL.10407 
!                                                                                  RAD_ALL.10408 
!                                                                                  RAD_ALL.10409 
!     CALCULATE THE OVERALL FLUX.                                                  RAD_ALL.10410 
      IF (L_NET) THEN                                                              RAD_ALL.10411 
         DO I=0, N_CLOUD_TOP-2                                                     RAD_ALL.10412 
            DO L=1, N_PROFILE                                                      RAD_ALL.10413 
               FLUX_DIFFUSE(L, I+1)=FLUX_DOWN(L, I)-FLUX_UP(L, I)                  RAD_ALL.10414 
            ENDDO                                                                  RAD_ALL.10415 
         ENDDO                                                                     RAD_ALL.10416 
         DO I=N_CLOUD_TOP-1, N_LAYER                                               RAD_ALL.10417 
            DO L=1, N_PROFILE                                                      RAD_ALL.10418 
               FLUX_DIFFUSE(L, I+1)                                                RAD_ALL.10419 
     &            =FLUX_DOWN(L, I)+FLUX_DOWN_CLOUD(L, I)                           RAD_ALL.10420 
     &            -FLUX_UP(L, I)-FLUX_UP_CLOUD(L, I)                               RAD_ALL.10421 
            ENDDO                                                                  RAD_ALL.10422 
         ENDDO                                                                     RAD_ALL.10423 
      ELSE                                                                         RAD_ALL.10424 
         DO I=0, N_CLOUD_TOP-2                                                     RAD_ALL.10425 
            DO L=1, N_PROFILE                                                      RAD_ALL.10426 
               FLUX_DIFFUSE(L, 2*I+1)=FLUX_UP(L, I)                                RAD_ALL.10427 
               FLUX_DIFFUSE(L, 2*I+2)=FLUX_DOWN(L, I)                              RAD_ALL.10428 
            ENDDO                                                                  RAD_ALL.10429 
         ENDDO                                                                     RAD_ALL.10430 
         DO I=N_CLOUD_TOP-1, N_LAYER                                               RAD_ALL.10431 
            DO L=1, N_PROFILE                                                      RAD_ALL.10432 
               FLUX_DIFFUSE(L, 2*I+1)=FLUX_UP(L, I)+FLUX_UP_CLOUD(L, I)            RAD_ALL.10433 
               FLUX_DIFFUSE(L, 2*I+2)=FLUX_DOWN(L, I)                              RAD_ALL.10434 
     &            +FLUX_DOWN_CLOUD(L, I)                                           RAD_ALL.10435 
            ENDDO                                                                  RAD_ALL.10436 
         ENDDO                                                                     RAD_ALL.10437 
      ENDIF                                                                        RAD_ALL.10438 
!                                                                                  RAD_ALL.10439 
!                                                                                  RAD_ALL.10440 
      RETURN                                                                       RAD_ALL.10441 
      END           
