C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.            RAD_ALL.17421 
C                                                                                  RAD_ALL.17422 
C Use, duplication or disclosure of this code is subject to the                    RAD_ALL.17423 
C restrictions as set forth in the contract.                                       RAD_ALL.17424 
C                                                                                  RAD_ALL.17425 
C                Meteorological Office                                             RAD_ALL.17426 
C                London Road                                                       RAD_ALL.17427 
C                BRACKNELL                                                         RAD_ALL.17428 
C                Berkshire UK                                                      RAD_ALL.17429 
C                RG12 2SZ                                                          RAD_ALL.17430 
C                                                                                  RAD_ALL.17431 
C If no contract has been raised with this copy of the code, the use,              RAD_ALL.17432 
C duplication or disclosure of it is strictly prohibited.  Permission              RAD_ALL.17433 
C to do so must first be obtained in writing from the Head of Numerical            RAD_ALL.17434 
C Modelling at the above address.                                                  RAD_ALL.17435 
C ******************************COPYRIGHT******************************            RAD_ALL.17436 
C                                                                                  RAD_ALL.17437 
!+ Subroutine to calculate the fluxes assuming random overlap.                     RAD_ALL.17438 
!                                                                                  RAD_ALL.17439 
! Method:                                                                          RAD_ALL.17440 
!       Monochromatic calculations are performed for each                          RAD_ALL.17441 
!       combination of ESFT terms and the results are summed.                      RAD_ALL.17442 
!                                                                                  RAD_ALL.17443 
! Current Owner of Code: J. M. Edwards                                             RAD_ALL.17444 
!                                                                                  RAD_ALL.17445 
! History:                                                                         RAD_ALL.17446 
!       Version         Date                    Comment                            RAD_ALL.17447 
!       4.0             27-07-95                Original Code                      RAD_ALL.17448 
!                                               (J. M. Edwards)                    RAD_ALL.17449 
!       4.1             08-05-96                Rescaling of absorbers             RAD_ALL.17450 
!                                               extended to treat                  RAD_ALL.17451 
!                                               separate scaling for               RAD_ALL.17452 
!                                               each ESFT term.                    RAD_ALL.17453 
!       4.2             08-08-96                Code for vertically                RAD_ALL.17454 
!                                               coherent convective                RAD_ALL.17455 
!                                               cloud added.                       RAD_ALL.17456 
!                                               (J. M. Edwards)                    RAD_ALL.17457 
!                                                                                  RAD_ALL.17458 
! Description of Code:                                                             RAD_ALL.17459 
!   FORTRAN 77  with extensions listed in documentation.                           RAD_ALL.17460 
!                                                                                  RAD_ALL.17461 
!- ---------------------------------------------------------------------           RAD_ALL.17462 
      SUBROUTINE SOLVE_BAND_RANDOM_OVERLAP(IERR                                    RAD_ALL.17463 
!                       Atmospheric Column                                         RAD_ALL.17464 
     &   , N_PROFILE, N_LAYER, L_LAYER, I_TOP, P, T, D_MASS                        RAD_ALL.17465 
!                       Angular Integration                                        RAD_ALL.17466 
     &   , I_ANGULAR_INTEGRATION, I_2STREAM, L_2_STREAM_CORRECT                    RAD_ALL.17467 
     &   , L_RESCALE, N_ORDER_GAUSS                                                RAD_ALL.17468 
!                       Treatment of Scattering                                    RAD_ALL.17469 
     &   , I_SCATTER_METHOD_BAND                                                   RAD_ALL.17470 
!                       Options for solver                                         RAD_ALL.17471 
     &   , I_SOLVER, L_NET, I_EXTRAPOLATE_MIX_NET, N_AUGMENT                       RAD_ALL.17472 
!                       Gaseous Properties                                         RAD_ALL.17473 
     &   , I_BAND, N_GAS                                                           RAD_ALL.17474 
     &   , INDEX_ABSORB, I_BAND_ESFT, I_SCALE_ESFT, I_SCALE_FNC                    RAD_ALL.17475 
     &   , K_ESFT, W_ESFT, SCALE_VECTOR                                            RAD_ALL.17476 
     &   , P_REFERENCE, T_REFERENCE                                                RAD_ALL.17477 
     &   , GAS_MIX_RATIO, GAS_FRAC_RESCALED                                        RAD_ALL.17478 
     &   , L_DOPPLER, DOPPLER_CORRECTION                                           RAD_ALL.17479 
!                       Spectral Region                                            RAD_ALL.17480 
     &   , ISOLIR                                                                  RAD_ALL.17481 
!                       Solar Properties                                           RAD_ALL.17482 
     &   , SEC_0, SOLAR_FLUX                                                       RAD_ALL.17483 
!                       Infra-red Properties                                       RAD_ALL.17484 
     &   , PLANCK_SOURCE_TOP, PLANCK_SOURCE_BOTTOM                                 RAD_ALL.17485 
     &   , DIFF_PLANCK_BAND                                                        RAD_ALL.17486 
     &   , L_IR_SOURCE_QUAD, DIFF_PLANCK_BAND_2                                    RAD_ALL.17487 
!                       Surface Properties                                         RAD_ALL.17488 
     &   , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR, THERMAL_GROUND_BAND            RAD_ALL.17489 
!                       Clear-sky Optical Properties                               RAD_ALL.17490 
     &   , K_GREY_TOT_FREE, K_EXT_SCAT_FREE, ASYMMETRY_FREE                        RAD_ALL.17491 
     &   , FORWARD_SCATTER_FREE                                                    RAD_ALL.17492 
!                       Cloudy Properties                                          RAD_ALL.17493 
     &   , L_CLOUD, I_CLOUD                                                        RAD_ALL.17494 
!                       Cloud Geometry                                             RAD_ALL.17495 
     &   , N_CLOUD_TOP                                                             RAD_ALL.17496 
     &   , N_CLOUD_TYPE, FRAC_CLOUD                                                RAD_ALL.17497 
     &   , I_REGION_CLOUD, FRAC_REGION                                             RAD_ALL.17498 
     &   , W_FREE, N_FREE_PROFILE, I_FREE_PROFILE                                  RAD_ALL.17499 
     &   , W_CLOUD, N_CLOUD_PROFILE, I_CLOUD_PROFILE                               RAD_ALL.17500 
     &   , CLOUD_OVERLAP                                                           RAD_ALL.17501 
     &   , N_COLUMN, L_COLUMN, AREA_COLUMN                                         RAD_ALL.17502 
!                       Cloudy Optical Properties                                  RAD_ALL.17503 
     &   , K_GREY_TOT_CLOUD, K_EXT_SCAT_CLOUD                                      RAD_ALL.17504 
     &   , ASYMMETRY_CLOUD, FORWARD_SCATTER_CLOUD                                  RAD_ALL.17505 
!                       Fluxes Calculated                                          RAD_ALL.17506 
     &   , FLUX_DIRECT_BAND, FLUX_TOTAL_BAND                                       RAD_ALL.17507 
!                       Flags for Clear-sky Fluxes                                 RAD_ALL.17508 
     &   , L_CLEAR, I_SOLVER_CLEAR                                                 RAD_ALL.17509 
!                       Clear-sky Fluxes                                           RAD_ALL.17510 
     &   , FLUX_DIRECT_CLEAR_BAND, FLUX_TOTAL_CLEAR_BAND                           RAD_ALL.17511 
!                       Planckian Function                                         RAD_ALL.17512 
     &   , PLANCK_SOURCE_BAND                                                      RAD_ALL.17513 
     &   , NPD_PROFILE, NPD_LAYER, NPD_COLUMN                                      RAD_ALL.17514 
     &   , NPD_BAND, NPD_SPECIES                                                   RAD_ALL.17515 
     &   , NPD_ESFT_TERM, NPD_SCALE_VARIABLE, NPD_SCALE_FNC                        RAD_ALL.17516 
     &   )                                                                         RAD_ALL.17517 
!                                                                                  RAD_ALL.17518 
!                                                                                  RAD_ALL.17519 
!                                                                                  RAD_ALL.17520 
      IMPLICIT NONE                                                                RAD_ALL.17521 
!                                                                                  RAD_ALL.17522 
!                                                                                  RAD_ALL.17523 
!     SIZES OF DUMMY ARRAYS.                                                       RAD_ALL.17524 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.17525 
     &     NPD_PROFILE                                                             RAD_ALL.17526 
!             MAXIMUM NUMBER OF PROFILES                                           RAD_ALL.17527 
     &   , NPD_LAYER                                                               RAD_ALL.17528 
!             MAXIMUM NUMBER OF LAYERS                                             RAD_ALL.17529 
     &   , NPD_BAND                                                                RAD_ALL.17530 
!             MAXIMUM NUMBER OF SPECTRAL BANDS                                     RAD_ALL.17531 
     &   , NPD_SPECIES                                                             RAD_ALL.17532 
!             MAXIMUM NUMBER OF SPECIES                                            RAD_ALL.17533 
     &   , NPD_ESFT_TERM                                                           RAD_ALL.17534 
!             MAXIMUM NUMBER OF ESFT TERMS                                         RAD_ALL.17535 
     &   , NPD_SCALE_VARIABLE                                                      RAD_ALL.17536 
!             MAXIMUM NUMBER OF SCALE VARIABLES                                    RAD_ALL.17537 
     &   , NPD_SCALE_FNC                                                           RAD_ALL.17538 
!             MAXIMUM NUMBER OF SCALING FUNCTIONS                                  RAD_ALL.17539 
     &   , NPD_COLUMN                                                              RAD_ALL.17540 
!             NUMBER OF COLUMNS PER POINT                                          RAD_ALL.17541 
!                                                                                  RAD_ALL.17542 
!     INCLUDE COMDECKS.                                                            RAD_ALL.17543 
!     ------------------------------------------------------------------           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    
!     ------------------------------------------------------------------           ESFTSC3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       ESFTSC3A.3     
!                                                                                  ESFTSC3A.4     
!     MODULE SETTING TYPES OF ESFT SCALING                                         ESFTSC3A.5     
!                                                                                  ESFTSC3A.6     
      INTEGER                                                                      ESFTSC3A.7     
     &     IP_SCALE_NULL                                                           ESFTSC3A.8     
!             NO SCALING AT ALL                                                    ESFTSC3A.9     
     &   , IP_SCALE_BAND                                                           ESFTSC3A.10    
!             SAME SCALING THROUGHOUT BAND                                         ESFTSC3A.11    
     &   , IP_SCALE_TERM                                                           ESFTSC3A.12    
!             DIFFERENT SCALING FOR EACH ESFT                                      ESFTSC3A.13    
!                                                                                  ESFTSC3A.14    
      PARAMETER(                                                                   ESFTSC3A.15    
     &     IP_SCALE_NULL=0                                                         ESFTSC3A.16    
     &   , IP_SCALE_BAND=1                                                         ESFTSC3A.17    
     &   , IP_SCALE_TERM=2                                                         ESFTSC3A.18    
     &   )                                                                         ESFTSC3A.19    
!                                                                                  ESFTSC3A.20    
!     ------------------------------------------------------------------           ESFTSC3A.21    
!     ------------------------------------------------------------------           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    
!                                                                                  RAD_ALL.17548 
!                                                                                  RAD_ALL.17549 
!                                                                                  RAD_ALL.17550 
!     DUMMY ARGUMENTS.                                                             RAD_ALL.17551 
      INTEGER   !, INTENT(OUT)                                                     RAD_ALL.17552 
     &     IERR                                                                    RAD_ALL.17553 
!             ERROR FLAG                                                           RAD_ALL.17554 
!                                                                                  RAD_ALL.17555 
!                       Atmospheric Column                                         RAD_ALL.17556 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.17557 
     &     N_PROFILE                                                               RAD_ALL.17558 
!             NUMBER OF PROFILES                                                   RAD_ALL.17559 
     &   , N_LAYER                                                                 RAD_ALL.17560 
!             NUMBER OF LAYERS                                                     RAD_ALL.17561 
     &   , I_TOP                                                                   RAD_ALL.17562 
!             TOP OF VERTICAL GRID                                                 RAD_ALL.17563 
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.17564 
     &     L_LAYER                                                                 RAD_ALL.17565 
!             PROPERTIES GIVEN IN LAYERS                                           RAD_ALL.17566 
      REAL  !, INTENT(IN)                                                          RAD_ALL.17567 
     &     D_MASS(NPD_PROFILE, NPD_LAYER)                                          RAD_ALL.17568 
!             MASS THICKNESS OF EACH LAYER                                         RAD_ALL.17569 
     &   , P(NPD_PROFILE, 0: NPD_LAYER)                                            RAD_ALL.17570 
!             PRESSURE                                                             RAD_ALL.17571 
     &   , T(NPD_PROFILE, 0: NPD_LAYER)                                            RAD_ALL.17572 
!             TEMPERATURE                                                          RAD_ALL.17573 
!                                                                                  RAD_ALL.17574 
!                       Angular Integration                                        RAD_ALL.17575 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.17576 
     &     I_ANGULAR_INTEGRATION                                                   RAD_ALL.17577 
!             ANGULAR INTEGRATION SCHEME                                           RAD_ALL.17578 
     &   , I_2STREAM                                                               RAD_ALL.17579 
!             TWO-STREAM SCHEME                                                    RAD_ALL.17580 
     &   , N_ORDER_GAUSS                                                           RAD_ALL.17581 
!             ORDER OF GAUSSIAN INTEGRATION                                        RAD_ALL.17582 
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.17583 
     &     L_2_STREAM_CORRECT                                                      RAD_ALL.17584 
!             USE AN EDGE CORRECTION                                               RAD_ALL.17585 
     &   , L_RESCALE                                                               RAD_ALL.17586 
!             RESCALE OPTICAL PROPERTIES                                           RAD_ALL.17587 
!                                                                                  RAD_ALL.17588 
!                       Treatment of Scattering                                    RAD_ALL.17589 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.17590 
     &     I_SCATTER_METHOD_BAND                                                   RAD_ALL.17591 
!             METHOD OF TREATING SCATTERING                                        RAD_ALL.17592 
!                                                                                  RAD_ALL.17593 
!                       Options for Solver                                         RAD_ALL.17594 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.17595 
     &     I_SOLVER                                                                RAD_ALL.17596 
!             SOLVER USED                                                          RAD_ALL.17597 
     &   , I_EXTRAPOLATE_MIX_NET                                                   RAD_ALL.17598 
!             METHOD FOR EXTRAPOLATING WITH A MIXED SOLVER                         RAD_ALL.17599 
     &   , N_AUGMENT                                                               RAD_ALL.17600 
!             LENGTH OF LONG FLUX VECTOR                                           RAD_ALL.17601 
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.17602 
     &     L_NET                                                                   RAD_ALL.17603 
!             SOLVE FOR NET FLUXES                                                 RAD_ALL.17604 
!                                                                                  RAD_ALL.17605 
!                       Gaseous Properties                                         RAD_ALL.17606 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.17607 
     &     I_BAND                                                                  RAD_ALL.17608 
!             BAND BEING CONSIDERED                                                RAD_ALL.17609 
     &   , N_GAS                                                                   RAD_ALL.17610 
!             NUMBER OF GASES IN BAND                                              RAD_ALL.17611 
     &   , INDEX_ABSORB(NPD_SPECIES, NPD_BAND)                                     RAD_ALL.17612 
!             LIST OF ABSORBERS IN BANDS                                           RAD_ALL.17613 
     &   , I_BAND_ESFT(NPD_BAND, NPD_SPECIES)                                      RAD_ALL.17614 
!             NUMBER OF TERMS IN BAND                                              RAD_ALL.17615 
     &   , I_SCALE_ESFT(NPD_BAND, NPD_SPECIES)                                     RAD_ALL.17616 
!             TYPE OF ESFT SCALING                                                 RAD_ALL.17617 
     &   , I_SCALE_FNC(NPD_BAND, NPD_SPECIES)                                      RAD_ALL.17618 
!             TYPE OF SCALING FUNCTION                                             RAD_ALL.17619 
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.17620 
     &     L_DOPPLER(NPD_SPECIES)                                                  RAD_ALL.17621 
!             DOPPLER BROADENING INCLUDED                                          RAD_ALL.17622 
      REAL      !, INTENT(IN)                                                      RAD_ALL.17623 
     &     K_ESFT(NPD_ESFT_TERM, NPD_BAND, NPD_SPECIES)                            RAD_ALL.17624 
!             EXPONENTIAL ESFT TERMS                                               RAD_ALL.17625 
     &   , W_ESFT(NPD_ESFT_TERM, NPD_BAND, NPD_SPECIES)                            RAD_ALL.17626 
!             WEIGHTS FOR ESFT                                                     RAD_ALL.17627 
     &   , SCALE_VECTOR(NPD_SCALE_VARIABLE, NPD_ESFT_TERM, NPD_BAND                RAD_ALL.17628 
     &        , NPD_SPECIES)                                                       RAD_ALL.17629 
!             ABSORBER SCALING PARAMETERS                                          RAD_ALL.17630 
     &   , P_REFERENCE(NPD_SPECIES, NPD_BAND)                                      RAD_ALL.17631 
!             REFERENCE SCALING PRESSURE                                           RAD_ALL.17632 
     &   , T_REFERENCE(NPD_SPECIES, NPD_BAND)                                      RAD_ALL.17633 
!             REFERENCE SCALING TEMPERATURE                                        RAD_ALL.17634 
     &   , GAS_MIX_RATIO(NPD_PROFILE, 0: NPD_LAYER, NPD_SPECIES)                   RAD_ALL.17635 
!             GAS MASS MIXING RATIOS                                               RAD_ALL.17636 
     &   , GAS_FRAC_RESCALED(NPD_PROFILE, 0: NPD_LAYER, NPD_SPECIES)               RAD_ALL.17637 
!             RESCALED GAS MASS FRACTIONS                                          RAD_ALL.17638 
     &   , DOPPLER_CORRECTION(NPD_SPECIES)                                         RAD_ALL.17639 
!             DOPPLER BROADENING TERMS                                             RAD_ALL.17640 
!                                                                                  RAD_ALL.17641 
!                       Spectral Region                                            RAD_ALL.17642 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.17643 
     &     ISOLIR                                                                  RAD_ALL.17644 
!             VISIBLE OR IR                                                        RAD_ALL.17645 
!                                                                                  RAD_ALL.17646 
!                       Solar Properties                                           RAD_ALL.17647 
      REAL  !, INTENT(IN)                                                          RAD_ALL.17648 
     &     SEC_0(NPD_PROFILE)                                                      RAD_ALL.17649 
!             SECANT OF SOLAR ZENITH ANGLE                                         RAD_ALL.17650 
     &   , SOLAR_FLUX(NPD_PROFILE)                                                 RAD_ALL.17651 
!             INCIDENT SOLAR FLUX IN BAND                                          RAD_ALL.17652 
!                                                                                  RAD_ALL.17653 
!                       Infra-red Properties                                       RAD_ALL.17654 
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.17655 
     &     L_IR_SOURCE_QUAD                                                        RAD_ALL.17656 
!             USE A QUADRATIC SOURCE FUNCTION                                      RAD_ALL.17657 
      REAL  !, INTENT(IN)                                                          RAD_ALL.17658 
     &     PLANCK_SOURCE_TOP(NPD_PROFILE)                                          RAD_ALL.17659 
!             PLANCKIAN SOURCE AT TOP                                              RAD_ALL.17660 
     &   , PLANCK_SOURCE_BOTTOM(NPD_PROFILE)                                       RAD_ALL.17661 
!             PLANCKIAN SOURCE AT BOTTOM                                           RAD_ALL.17662 
     &   , DIFF_PLANCK_BAND(NPD_PROFILE, NPD_LAYER)                                RAD_ALL.17663 
!             THERMAL SOURCE FUNCTION                                              RAD_ALL.17664 
     &   , DIFF_PLANCK_BAND_2(NPD_PROFILE, NPD_LAYER)                              RAD_ALL.17665 
!             2x2ND DIFFERENCE OF PLANCKIAN IN BAND                                RAD_ALL.17666 
!                                                                                  RAD_ALL.17667 
!                       Surface Properties                                         RAD_ALL.17668 
      REAL  !, INTENT(IN)                                                          RAD_ALL.17669 
     &     ALBEDO_SURFACE_DIFF(NPD_PROFILE)                                        RAD_ALL.17670 
!             DIFFUSE SURFACE ALBEDO                                               RAD_ALL.17671 
     &   , ALBEDO_SURFACE_DIR(NPD_PROFILE)                                         RAD_ALL.17672 
!             DIRECT SURFACE ALBEDO                                                RAD_ALL.17673 
     &   , THERMAL_GROUND_BAND(NPD_PROFILE)                                        RAD_ALL.17674 
!             THERMAL SOURCE FUNCTION AT GROUND                                    RAD_ALL.17675 
!                                                                                  RAD_ALL.17676 
!                       Clear-sky Optical Properties                               RAD_ALL.17677 
      REAL  !, INTENT(IN)                                                          RAD_ALL.17678 
     &     K_GREY_TOT_FREE(NPD_PROFILE, NPD_LAYER)                                 RAD_ALL.17679 
!             FREE ABSORPTIVE EXTINCTION                                           RAD_ALL.17680 
     &   , K_EXT_SCAT_FREE(NPD_PROFILE, NPD_LAYER)                                 RAD_ALL.17681 
!             FREE SCATTERING EXTINCTION                                           RAD_ALL.17682 
     &   , ASYMMETRY_FREE(NPD_PROFILE, NPD_LAYER)                                  RAD_ALL.17683 
!             CLEAR-SKY ASYMMETRY                                                  RAD_ALL.17684 
     &   , FORWARD_SCATTER_FREE(NPD_PROFILE, NPD_LAYER)                            RAD_ALL.17685 
!             FREE FORWARD SCATTERING                                              RAD_ALL.17686 
!                                                                                  RAD_ALL.17687 
!                       Cloudy properties                                          RAD_ALL.17688 
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.17689 
     &     L_CLOUD                                                                 RAD_ALL.17690 
!             CLOUD ENABLED                                                        RAD_ALL.17691 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.17692 
     &     I_CLOUD                                                                 RAD_ALL.17693 
!             CLOUD SCHEME USED                                                    RAD_ALL.17694 
!                                                                                  RAD_ALL.17695 
!                       Cloud Geometry                                             RAD_ALL.17696 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.17697 
     &     N_CLOUD_TOP                                                             RAD_ALL.17698 
!             TOPMOST CLOUDY LAYER                                                 RAD_ALL.17699 
     &   , N_CLOUD_TYPE                                                            RAD_ALL.17700 
!             NUMBER OF TYPES OF CLOUD                                             RAD_ALL.17701 
     &   , N_FREE_PROFILE(NPD_LAYER)                                               RAD_ALL.17702 
!             NUMBER OF FREE PROFILES                                              RAD_ALL.17703 
     &   , I_FREE_PROFILE(NPD_PROFILE, NPD_LAYER)                                  RAD_ALL.17704 
!             INDICES OF FREE PROFILES                                             RAD_ALL.17705 
     &   , N_CLOUD_PROFILE(NPD_LAYER)                                              RAD_ALL.17706 
!             NUMBER OF CLOUDY PROFILES                                            RAD_ALL.17707 
     &   , I_CLOUD_PROFILE(NPD_PROFILE, NPD_LAYER)                                 RAD_ALL.17708 
!             INDICES OF CLOUDY PROFILES                                           RAD_ALL.17709 
     &   , N_COLUMN(NPD_PROFILE)                                                   RAD_ALL.17710 
!             NUMBER OF COLUMNS REQUIRED                                           RAD_ALL.17711 
     &   , I_REGION_CLOUD(NPD_CLOUD_TYPE)                                          RAD_ALL.17712 
!             REGIONS IN WHICH TYPES OF CLOUDS FALL                                RAD_ALL.17713 
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.17714 
     &     L_COLUMN(NPD_PROFILE, NPD_LAYER, NPD_COLUMN)                            RAD_ALL.17715 
!             FLAGS FOR CONTENT OF COLUMNS                                         RAD_ALL.17716 
      REAL  !, INTENT(IN)                                                          RAD_ALL.17717 
     &     W_CLOUD(NPD_PROFILE, NPD_LAYER)                                         RAD_ALL.17718 
!             CLOUDY FRACTION                                                      RAD_ALL.17719 
     &   , FRAC_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)                      RAD_ALL.17720 
!             FRACTIONS OF TYPES OF CLOUDS                                         RAD_ALL.17721 
     &   , W_FREE(NPD_PROFILE, NPD_LAYER)                                          RAD_ALL.17722 
!             CLEAR-SKY FRACTION                                                   RAD_ALL.17723 
     &   , CLOUD_OVERLAP(NPD_PROFILE, 0: NPD_LAYER, NPD_OVERLAP_COEFF)             RAD_ALL.17724 
!             COEFFICIENTS FOR TRANSFER FOR ENERGY AT INTERFACES                   RAD_ALL.17725 
     &   , AREA_COLUMN(NPD_PROFILE, NPD_COLUMN)                                    RAD_ALL.17726 
!             AREAS OF COLUMNS                                                     RAD_ALL.17727 
     &   , FRAC_REGION(NPD_PROFILE, NPD_LAYER, NPD_REGION)                         RAD_ALL.17728 
!             FRACTIONS OF TOTAL CLOUD OCCUPIED BY EACH REGION                     RAD_ALL.17729 
!                                                                                  RAD_ALL.17730 
!                       Cloudy Optical Properties                                  RAD_ALL.17731 
      REAL  !, INTENT(IN)                                                          RAD_ALL.17732 
     &     K_GREY_TOT_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)                RAD_ALL.17733 
!             CLOUDY ABSORPTIVE EXTINCTION                                         RAD_ALL.17734 
     &   , K_EXT_SCAT_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)                RAD_ALL.17735 
!             CLOUDY SCATTERING EXTINCTION                                         RAD_ALL.17736 
     &   , ASYMMETRY_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)                 RAD_ALL.17737 
!             CLOUDY ASYMMETRY                                                     RAD_ALL.17738 
     &   , FORWARD_SCATTER_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)           RAD_ALL.17739 
!             CLOUDY FORWARD SCATTERING                                            RAD_ALL.17740 
!                                                                                  RAD_ALL.17741 
!                       Flags for Clear-sky Calculations                           RAD_ALL.17742 
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.17743 
     &     L_CLEAR                                                                 RAD_ALL.17744 
!             CALCULATE CLEAR-SKY PROPERTIES                                       RAD_ALL.17745 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.17746 
     &     I_SOLVER_CLEAR                                                          RAD_ALL.17747 
!             CLEAR SOLVER USED                                                    RAD_ALL.17748 
!                                                                                  RAD_ALL.17749 
!                       Planckian Source Function                                  RAD_ALL.17750 
      REAL  !, INTENT(IN)                                                          RAD_ALL.17751 
     &     PLANCK_SOURCE_BAND(NPD_PROFILE, 0: NPD_LAYER)                           RAD_ALL.17752 
!             PLANCKIAN SOURCE IN BAND                                             RAD_ALL.17753 
!                                                                                  RAD_ALL.17754 
!                       Fluxes Calculated                                          RAD_ALL.17755 
      REAL  !, INTENT(OUT)                                                         RAD_ALL.17756 
     &     FLUX_DIRECT_BAND(NPD_PROFILE, 0: NPD_LAYER)                             RAD_ALL.17757 
!             DIRECT FLUX IN BAND                                                  RAD_ALL.17758 
     &   , FLUX_TOTAL_BAND(NPD_PROFILE, 2*NPD_LAYER+2)                             RAD_ALL.17759 
!             TOTAL FLUX IN BAND                                                   RAD_ALL.17760 
!                                                                                  RAD_ALL.17761 
!                       Clear-sky Fluxes Calculated                                RAD_ALL.17762 
      REAL  !, INTENT(OUT)                                                         RAD_ALL.17763 
     &     FLUX_DIRECT_CLEAR_BAND(NPD_PROFILE, 0: NPD_LAYER)                       RAD_ALL.17764 
!             CLEAR-SKY DIRECT FLUX IN BAND                                        RAD_ALL.17765 
     &   , FLUX_TOTAL_CLEAR_BAND(NPD_PROFILE, 2*NPD_LAYER+2)                       RAD_ALL.17766 
!             CLEAR-SKY TOTAL FLUX IN BAND                                         RAD_ALL.17767 
!                                                                                  RAD_ALL.17768 
!                                                                                  RAD_ALL.17769 
!                                                                                  RAD_ALL.17770 
!     LOCAL VARIABLES.                                                             RAD_ALL.17771 
      INTEGER                                                                      RAD_ALL.17772 
     &     J                                                                       RAD_ALL.17773 
!             LOOP VARIABLE                                                        RAD_ALL.17774 
     &   , K                                                                       RAD_ALL.17775 
!             LOOP VARIABLE                                                        RAD_ALL.17776 
     &   , L                                                                       RAD_ALL.17777 
!             LOOP VARIABLE                                                        RAD_ALL.17778 
      INTEGER                                                                      RAD_ALL.17779 
     &     I_GAS_BAND                                                              RAD_ALL.17780 
!             INDEX OF ACTIVE GAS                                                  RAD_ALL.17781 
     &   , I_GAS_POINTER(NPD_SPECIES)                                              RAD_ALL.17782 
!             POINTER ARRAY FOR MONOCHROMATIC ESFTs                                RAD_ALL.17783 
     &   , I_ESFT_POINTER(NPD_SPECIES)                                             RAD_ALL.17784 
!             POINTER TO ESFT FOR GAS                                              RAD_ALL.17785 
     &   , I_CHANGE                                                                RAD_ALL.17786 
!             POSITION OF ESFT TERM TO BE ALTERED                                  RAD_ALL.17787 
     &   , INDEX_CHANGE                                                            RAD_ALL.17788 
!             INDEX OF TERM TO BE ALTERED                                          RAD_ALL.17789 
     &   , INDEX_LAST                                                              RAD_ALL.17790 
!             INDEX OF LAST GAS IN BAND                                            RAD_ALL.17791 
     &   , IEX                                                                     RAD_ALL.17792 
!             INDEX OF ESFT TERM                                                   RAD_ALL.17793 
      REAL                                                                         RAD_ALL.17794 
     &     K_ESFT_MONO(NPD_SPECIES)                                                RAD_ALL.17795 
!             ESFT MONOCHROMATIC EXPONENTS                                         RAD_ALL.17796 
     &   , K_GAS_ABS(NPD_PROFILE, NPD_LAYER)                                       RAD_ALL.17797 
!             GASEOUS ABSORPTION                                                   RAD_ALL.17798 
     &   , SOURCE_GROUND(NPD_PROFILE)                                              RAD_ALL.17799 
!             GROUND SOURCE FUNCTION                                               RAD_ALL.17800 
     &   , FLUX_INC_DIRECT(NPD_PROFILE)                                            RAD_ALL.17801 
!             INCIDENT DIRECT FLUX                                                 RAD_ALL.17802 
     &   , FLUX_INC_DOWN(NPD_PROFILE)                                              RAD_ALL.17803 
!             INCIDENT DOWNWARD FLUX                                               RAD_ALL.17804 
     &   , PRODUCT_WEIGHT                                                          RAD_ALL.17805 
!             PRODUCT OF ESFT WEIGHTS                                              RAD_ALL.17806 
     &   , DUMMY_KE(NPD_PROFILE, NPD_LAYER)                                        RAD_ALL.17807 
!             DUMMY ARRAY (NOT USED)                                               RAD_ALL.17808 
      REAL                                                                         RAD_ALL.17809 
     &     FLUX_DIRECT_PART(NPD_PROFILE, 0: NPD_LAYER)                             RAD_ALL.17810 
!             PARTIAL DIRECT FLUX                                                  RAD_ALL.17811 
     &   , FLUX_TOTAL_PART(NPD_PROFILE, 2*NPD_LAYER+2)                             RAD_ALL.17812 
!             PARTIAL TOTAL FLUX                                                   RAD_ALL.17813 
     &   , FLUX_DIRECT_CLEAR_PART(NPD_PROFILE, 0: NPD_LAYER)                       RAD_ALL.17814 
!             PARTIAL CLEAR-SKY DIRECT FLUX                                        RAD_ALL.17815 
     &   , FLUX_TOTAL_CLEAR_PART(NPD_PROFILE, 2*NPD_LAYER+2)                       RAD_ALL.17816 
!             PARTIAL CLEAR-SKY TOTAL FLUX                                         RAD_ALL.17817 
!                                                                                  RAD_ALL.17818 
!     SUBROUTINES CALLED:                                                          RAD_ALL.17819 
      EXTERNAL                                                                     RAD_ALL.17820 
     &     SCALE_ABSORB, GAS_OPTICAL_PROPERTIES                                    RAD_ALL.17821 
     &   , MONOCHROMATIC_FLUX, AUGMENT_FLUX                                        RAD_ALL.17822 
!                                                                                  RAD_ALL.17823 
!                                                                                  RAD_ALL.17824 
!                                                                                  RAD_ALL.17825 
!     SET THE NUMBER OF ACTIVE GASES AND INITIALIZE THE POINTERS.                  RAD_ALL.17826 
      DO K=1, N_GAS                                                                RAD_ALL.17827 
         I_GAS_POINTER(K)=INDEX_ABSORB(K, I_BAND)                                  RAD_ALL.17828 
         I_ESFT_POINTER(INDEX_ABSORB(K, I_BAND))=1                                 RAD_ALL.17829 
      ENDDO                                                                        RAD_ALL.17830 
      INDEX_LAST=INDEX_ABSORB(N_GAS, I_BAND)                                       RAD_ALL.17831 
!                                                                                  RAD_ALL.17832 
!     PERFORM THE INITIAL RESCALING OF THE GASES OTHER THAN THE LAST.              RAD_ALL.17833 
!     NOTE: WE RESCALE AMOUNTS AS REQUIRED. IT WOULD BE MORE                       RAD_ALL.17834 
!     EFFICIENT TO SAVE THE RESCALED AMOUNTS, BUT THE STORAGE                      RAD_ALL.17835 
!     NEEDED WOULD BECOME EXCESSIVE FOR A MULTICOLUMN CODE. IN A                   RAD_ALL.17836 
!     SINGLE CODE THE OVERHEAD IS LESS SIGNIFICANT.                                RAD_ALL.17837 
      DO K=1, N_GAS-1                                                              RAD_ALL.17838 
         I_GAS_BAND=I_GAS_POINTER(K)                                               RAD_ALL.17839 
!        INITIALIZE THE MONOCHROMATIC ABSORPTION COEFFICIENTS.                     RAD_ALL.17840 
         K_ESFT_MONO(I_GAS_BAND)                                                   RAD_ALL.17841 
     &      =K_ESFT(1, I_BAND, I_GAS_BAND)                                         RAD_ALL.17842 
         IF (I_SCALE_ESFT(I_BAND, I_GAS_BAND).EQ.IP_SCALE_TERM) THEN               RAD_ALL.17843 
            CALL SCALE_ABSORB(IERR, N_PROFILE, N_LAYER                             RAD_ALL.17844 
     &         , GAS_MIX_RATIO(1, 0, I_GAS_BAND), P, T                             RAD_ALL.17845 
     &         , L_LAYER, I_TOP                                                    RAD_ALL.17846 
     &         , GAS_FRAC_RESCALED(1, 0, I_GAS_BAND)                               RAD_ALL.17847 
     &         , I_SCALE_FNC(I_BAND, I_GAS_BAND)                                   RAD_ALL.17848 
     &         , P_REFERENCE(I_GAS_BAND, I_BAND)                                   RAD_ALL.17849 
     &         , T_REFERENCE(I_GAS_BAND, I_BAND)                                   RAD_ALL.17850 
     &         , SCALE_VECTOR(1, 1, I_BAND, I_GAS_BAND)                            RAD_ALL.17851 
     &         , L_DOPPLER(I_GAS_BAND), DOPPLER_CORRECTION(I_GAS_BAND)             RAD_ALL.17852 
     &         , NPD_PROFILE, NPD_LAYER, NPD_SCALE_FNC                             RAD_ALL.17853 
     &         , NPD_SCALE_VARIABLE                                                RAD_ALL.17854 
     &         )                                                                   RAD_ALL.17855 
            IF (IERR.NE.I_NORMAL) RETURN                                           RAD_ALL.17856 
         ENDIF                                                                     RAD_ALL.17857 
      ENDDO                                                                        RAD_ALL.17858 
!                                                                                  RAD_ALL.17859 
!     LOOP THROUGH THE TERMS FOR THE FIRST ABSORBER.                               RAD_ALL.17860 
2000  I_ESFT_POINTER(INDEX_LAST)=0                                                 RAD_ALL.17861 
      DO K=1, I_BAND_ESFT(I_BAND, INDEX_LAST)                                      RAD_ALL.17862 
         I_ESFT_POINTER(INDEX_LAST)                                                RAD_ALL.17863 
     &      =I_ESFT_POINTER(INDEX_LAST)+1                                          RAD_ALL.17864 
!                                                                                  RAD_ALL.17865 
!        SET THE ESFT COEFFICIENT AND PERFORM RESCALING FOR THE                    RAD_ALL.17866 
!        LAST GAS.                                                                 RAD_ALL.17867 
         IEX=I_ESFT_POINTER(INDEX_LAST)                                            RAD_ALL.17868 
         K_ESFT_MONO(INDEX_LAST)                                                   RAD_ALL.17869 
     &      =K_ESFT(IEX, I_BAND, INDEX_LAST)                                       RAD_ALL.17870 
         IF (I_SCALE_ESFT(I_BAND, INDEX_LAST).EQ.IP_SCALE_TERM) THEN               RAD_ALL.17871 
            CALL SCALE_ABSORB(IERR, N_PROFILE, N_LAYER                             RAD_ALL.17872 
     &         , GAS_MIX_RATIO(1, 0, INDEX_LAST), P, T                             RAD_ALL.17873 
     &         , L_LAYER, I_TOP                                                    RAD_ALL.17874 
     &         , GAS_FRAC_RESCALED(1, 0, INDEX_LAST)                               RAD_ALL.17875 
     &         , I_SCALE_FNC(I_BAND, INDEX_LAST)                                   RAD_ALL.17876 
     &         , P_REFERENCE(INDEX_LAST, I_BAND)                                   RAD_ALL.17877 
     &         , T_REFERENCE(INDEX_LAST, I_BAND)                                   RAD_ALL.17878 
     &         , SCALE_VECTOR(1, IEX, I_BAND, INDEX_LAST)                          RAD_ALL.17879 
     &         , L_DOPPLER(INDEX_LAST)                                             RAD_ALL.17880 
     &         , DOPPLER_CORRECTION(INDEX_LAST)                                    RAD_ALL.17881 
     &         , NPD_PROFILE, NPD_LAYER, NPD_SCALE_FNC                             RAD_ALL.17882 
     &         , NPD_SCALE_VARIABLE                                                RAD_ALL.17883 
     &         )                                                                   RAD_ALL.17884 
            IF (IERR.NE.I_NORMAL) RETURN                                           RAD_ALL.17885 
         ENDIF                                                                     RAD_ALL.17886 
!                                                                                  RAD_ALL.17887 
!        SET THE APPROPRIATE SOURCE TERMS FOR THE TWO-STREAM                       RAD_ALL.17888 
!        EQUATIONS.                                                                RAD_ALL.17889 
!        THE PRODUCT OF THE ESFT WEIGHGTS CAN BE PRECALCULATED                     RAD_ALL.17890 
!        FOR SPEED.                                                                RAD_ALL.17891 
         PRODUCT_WEIGHT=1.0E+00                                                    RAD_ALL.17892 
         DO J=1, N_GAS                                                             RAD_ALL.17893 
            I_GAS_BAND=I_GAS_POINTER(J)                                            RAD_ALL.17894 
            IEX=I_ESFT_POINTER(I_GAS_BAND)                                         RAD_ALL.17895 
            PRODUCT_WEIGHT=PRODUCT_WEIGHT                                          RAD_ALL.17896 
     &         *W_ESFT(IEX, I_BAND, I_GAS_BAND)                                    RAD_ALL.17897 
         ENDDO                                                                     RAD_ALL.17898 
!                                                                                  RAD_ALL.17899 
         IF (ISOLIR.EQ.IP_SOLAR) THEN                                              RAD_ALL.17900 
!           VISIBLE REGION.                                                        RAD_ALL.17901 
            DO L=1, N_PROFILE                                                      RAD_ALL.17902 
               SOURCE_GROUND(L)=0.0E+00                                            RAD_ALL.17903 
               FLUX_INC_DOWN(L)=SOLAR_FLUX(L)                                      RAD_ALL.17904 
               FLUX_INC_DIRECT(L)=SOLAR_FLUX(L)                                    RAD_ALL.17905 
            ENDDO                                                                  RAD_ALL.17906 
         ELSEIF (ISOLIR.EQ.IP_INFRA_RED) THEN                                      RAD_ALL.17907 
!           INFRA-RED REGION.                                                      RAD_ALL.17908 
            DO L=1, N_PROFILE                                                      RAD_ALL.17909 
               FLUX_INC_DIRECT(L)=0.0E+00                                          RAD_ALL.17910 
               FLUX_DIRECT_PART(L, N_LAYER)=0.0E+00                                RAD_ALL.17911 
               FLUX_INC_DOWN(L)=-PLANCK_SOURCE_TOP(L)                              RAD_ALL.17912 
               SOURCE_GROUND(L)=THERMAL_GROUND_BAND(L)                             RAD_ALL.17913 
     &            -(1.-ALBEDO_SURFACE_DIFF(L))                                     RAD_ALL.17914 
     &            *PLANCK_SOURCE_BOTTOM(L)                                         RAD_ALL.17915 
            ENDDO                                                                  RAD_ALL.17916 
            IF (L_CLEAR) THEN                                                      RAD_ALL.17917 
               DO L=1, N_PROFILE                                                   RAD_ALL.17918 
                  FLUX_DIRECT_CLEAR_PART(L, N_LAYER)=0.0E+00                       RAD_ALL.17919 
               ENDDO                                                               RAD_ALL.17920 
            ENDIF                                                                  RAD_ALL.17921 
         ENDIF                                                                     RAD_ALL.17922 
!                                                                                  RAD_ALL.17923 
         CALL GAS_OPTICAL_PROPERTIES(N_PROFILE, N_LAYER                            RAD_ALL.17924 
     &      , N_GAS, I_GAS_POINTER, K_ESFT_MONO                                    RAD_ALL.17925 
     &      , GAS_FRAC_RESCALED                                                    RAD_ALL.17926 
     &      , K_GAS_ABS                                                            RAD_ALL.17927 
     &      , NPD_PROFILE, NPD_LAYER, NPD_SPECIES                                  RAD_ALL.17928 
     &      )                                                                      RAD_ALL.17929 
!                                                                                  RAD_ALL.17930 
!                                                                                  RAD_ALL.17931 
         CALL MONOCHROMATIC_FLUX(IERR                                              RAD_ALL.17932 
!                       Atmospheric Properties                                     RAD_ALL.17933 
     &      , N_PROFILE, N_LAYER, D_MASS                                           RAD_ALL.17934 
!                       Angular Integration                                        RAD_ALL.17935 
     &      , I_ANGULAR_INTEGRATION, I_2STREAM, L_2_STREAM_CORRECT                 RAD_ALL.17936 
     &      , L_RESCALE, N_ORDER_GAUSS                                             RAD_ALL.17937 
!                       Treatment of Scattering                                    RAD_ALL.17938 
     &      , I_SCATTER_METHOD_BAND                                                RAD_ALL.17939 
!                       Options for Solver                                         RAD_ALL.17940 
     &      , I_SOLVER, L_NET, I_EXTRAPOLATE_MIX_NET, N_AUGMENT                    RAD_ALL.17941 
!                       Gaseous Propreties                                         RAD_ALL.17942 
     &      , K_GAS_ABS                                                            RAD_ALL.17943 
!                       Options for Equivalent Extinction                          RAD_ALL.17944 
     &      , .FALSE., DUMMY_KE                                                    RAD_ALL.17945 
!                       Spectral Region                                            RAD_ALL.17946 
     &      , ISOLIR                                                               RAD_ALL.17947 
!                       Infra-red Properties                                       RAD_ALL.17948 
     &      , DIFF_PLANCK_BAND                                                     RAD_ALL.17949 
     &      , L_IR_SOURCE_QUAD, DIFF_PLANCK_BAND_2                                 RAD_ALL.17950 
!                       Conditions at TOA                                          RAD_ALL.17951 
     &      , SEC_0, FLUX_INC_DIRECT, FLUX_INC_DOWN                                RAD_ALL.17952 
!                       Surface Properties                                         RAD_ALL.17953 
     &      , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR, SOURCE_GROUND               RAD_ALL.17954 
     &      , THERMAL_GROUND_BAND                                                  RAD_ALL.17955 
!                       Clear-sky Optical Properties                               RAD_ALL.17956 
     &      , K_GREY_TOT_FREE, K_EXT_SCAT_FREE                                     RAD_ALL.17957 
     &      , ASYMMETRY_FREE, FORWARD_SCATTER_FREE                                 RAD_ALL.17958 
!                       Cloudy Properties                                          RAD_ALL.17959 
     &      , L_CLOUD, I_CLOUD                                                     RAD_ALL.17960 
!                       Cloud Geometry                                             RAD_ALL.17961 
     &      , N_CLOUD_TOP                                                          RAD_ALL.17962 
     &      , N_CLOUD_TYPE, FRAC_CLOUD                                             RAD_ALL.17963 
     &      , I_REGION_CLOUD, FRAC_REGION                                          RAD_ALL.17964 
     &      , W_FREE, N_FREE_PROFILE, I_FREE_PROFILE                               RAD_ALL.17965 
     &      , W_CLOUD, N_CLOUD_PROFILE, I_CLOUD_PROFILE                            RAD_ALL.17966 
     &      , CLOUD_OVERLAP                                                        RAD_ALL.17967 
     &      , N_COLUMN, L_COLUMN, AREA_COLUMN                                      RAD_ALL.17968 
!                       Cloudy Optical Properties                                  RAD_ALL.17969 
     &      , K_GREY_TOT_CLOUD, K_EXT_SCAT_CLOUD                                   RAD_ALL.17970 
     &      , ASYMMETRY_CLOUD, FORWARD_SCATTER_CLOUD                               RAD_ALL.17971 
!                       Fluxes Calculated                                          RAD_ALL.17972 
     &      , FLUX_DIRECT_PART, FLUX_TOTAL_PART                                    RAD_ALL.17973 
!                       Flags for Clear-sky Calculations                           RAD_ALL.17974 
     &      , L_CLEAR, I_SOLVER_CLEAR                                              RAD_ALL.17975 
!                       Clear-sky Fluxes Calculated                                RAD_ALL.17976 
     &      , FLUX_DIRECT_CLEAR_PART, FLUX_TOTAL_CLEAR_PART                        RAD_ALL.17977 
!                       Planckian Function                                         RAD_ALL.17978 
     &      , PLANCK_SOURCE_BAND                                                   RAD_ALL.17979 
!                       Dimensions of Arrays                                       RAD_ALL.17980 
     &      , NPD_PROFILE, NPD_LAYER, NPD_COLUMN                                   RAD_ALL.17981 
     &      )                                                                      RAD_ALL.17982 
         IF (IERR.NE.I_NORMAL) RETURN                                              RAD_ALL.17983 
!                                                                                  RAD_ALL.17984 
!        INCREMENT THE FLUXES WITHIN THE BAND.                                     RAD_ALL.17985 
         CALL AUGMENT_FLUX(N_PROFILE, N_LAYER, N_AUGMENT                           RAD_ALL.17986 
     &      , ISOLIR, L_CLEAR                                                      RAD_ALL.17987 
     &      , PRODUCT_WEIGHT                                                       RAD_ALL.17988 
     &      , FLUX_DIRECT_BAND, FLUX_TOTAL_BAND                                    RAD_ALL.17989 
     &      , FLUX_DIRECT_PART, FLUX_TOTAL_PART                                    RAD_ALL.17990 
     &      , FLUX_DIRECT_CLEAR_BAND, FLUX_TOTAL_CLEAR_BAND                        RAD_ALL.17991 
     &      , FLUX_DIRECT_CLEAR_PART, FLUX_TOTAL_CLEAR_PART                        RAD_ALL.17992 
     &      , NPD_PROFILE, NPD_LAYER                                               RAD_ALL.17993 
     &      )                                                                      RAD_ALL.17994 
      ENDDO                                                                        RAD_ALL.17995 
!                                                                                  RAD_ALL.17996 
      IF (N_GAS.GT.1) THEN                                                         RAD_ALL.17997 
!        INCREMENT THE ESFT POINTERS FOR THE NEXT PASS THROUGH                     RAD_ALL.17998 
!        THE LOOP ABOVE. I_CHANGE IS THE ORDINAL OF THE GAS,                       RAD_ALL.17999 
!        THE POINTER OF WHICH IS TO BE CHANGED.                                    RAD_ALL.18000 
         I_CHANGE=N_GAS-1                                                          RAD_ALL.18001 
2001     INDEX_CHANGE=INDEX_ABSORB(I_CHANGE, I_BAND)                               RAD_ALL.18002 
         IF (I_BAND_ESFT(I_BAND, INDEX_CHANGE)                                     RAD_ALL.18003 
     &      .GT.I_ESFT_POINTER(INDEX_CHANGE)) THEN                                 RAD_ALL.18004 
            I_ESFT_POINTER(INDEX_CHANGE)                                           RAD_ALL.18005 
     &         =I_ESFT_POINTER(INDEX_CHANGE)+1                                     RAD_ALL.18006 
!           RESCALE THE AMOUNT OF THIS GAS AND ADVANCE THE                         RAD_ALL.18007 
!           ESFT TERM.                                                             RAD_ALL.18008 
            K_ESFT_MONO(INDEX_CHANGE)                                              RAD_ALL.18009 
     &         =K_ESFT(I_ESFT_POINTER(INDEX_CHANGE)                                RAD_ALL.18010 
     &         , I_BAND, INDEX_CHANGE)                                             RAD_ALL.18011 
            IF (I_SCALE_ESFT(I_BAND, INDEX_CHANGE).EQ.IP_SCALE_TERM)               RAD_ALL.18012 
     &         THEN                                                                RAD_ALL.18013 
               CALL SCALE_ABSORB(IERR, N_PROFILE, N_LAYER                          RAD_ALL.18014 
     &            , GAS_MIX_RATIO(1, 0, INDEX_CHANGE), P, T                        RAD_ALL.18015 
     &            , L_LAYER, I_TOP                                                 RAD_ALL.18016 
     &            , GAS_FRAC_RESCALED(1, 0, INDEX_CHANGE)                          RAD_ALL.18017 
     &            , I_SCALE_FNC(I_BAND, INDEX_CHANGE)                              RAD_ALL.18018 
     &            , P_REFERENCE(INDEX_CHANGE, I_BAND)                              RAD_ALL.18019 
     &            , T_REFERENCE(INDEX_CHANGE, I_BAND)                              RAD_ALL.18020 
     &            , SCALE_VECTOR(1, I_ESFT_POINTER(INDEX_CHANGE)                   RAD_ALL.18021 
     &            , I_BAND, INDEX_CHANGE)                                          RAD_ALL.18022 
     &            , L_DOPPLER(INDEX_CHANGE)                                        RAD_ALL.18023 
     &            , DOPPLER_CORRECTION(INDEX_CHANGE)                               RAD_ALL.18024 
     &            , NPD_PROFILE, NPD_LAYER, NPD_SCALE_FNC                          RAD_ALL.18025 
     &            , NPD_SCALE_VARIABLE                                             RAD_ALL.18026 
     &            )                                                                RAD_ALL.18027 
               IF (IERR.NE.I_NORMAL) RETURN                                        RAD_ALL.18028 
            ENDIF                                                                  RAD_ALL.18029 
                                                                                   RAD_ALL.18030 
            GOTO 2000                                                              RAD_ALL.18031 
         ELSE IF (I_CHANGE.GT.1) THEN                                              RAD_ALL.18032 
!           ALL TERMS FOR THIS ABSORBER HAVE BEEN DONE:                            RAD_ALL.18033 
!           RESET ITS POINTER TO 1 AND MOVE TO THE NEXT ABSORBER.                  RAD_ALL.18034 
            I_ESFT_POINTER(INDEX_CHANGE)=1                                         RAD_ALL.18035 
            K_ESFT_MONO(INDEX_CHANGE)=K_ESFT(1, I_BAND, INDEX_CHANGE)              RAD_ALL.18036 
            I_CHANGE=I_CHANGE-1                                                    RAD_ALL.18037 
            GOTO 2001                                                              RAD_ALL.18038 
         ENDIF                                                                     RAD_ALL.18039 
      ENDIF                                                                        RAD_ALL.18040 
!                                                                                  RAD_ALL.18041 
!                                                                                  RAD_ALL.18042 
!                                                                                  RAD_ALL.18043 
      RETURN                                                                       RAD_ALL.18044 
      END  
