C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved.            RAD_ALL.16576 
C                                                                                  RAD_ALL.16577 
C Use, duplication or disclosure of this code is subject to the                    RAD_ALL.16578 
C restrictions as set forth in the contract.                                       RAD_ALL.16579 
C                                                                                  RAD_ALL.16580 
C                Meteorological Office                                             RAD_ALL.16581 
C                London Road                                                       RAD_ALL.16582 
C                BRACKNELL                                                         RAD_ALL.16583 
C                Berkshire UK                                                      RAD_ALL.16584 
C                RG12 2SZ                                                          RAD_ALL.16585 
C                                                                                  RAD_ALL.16586 
C If no contract has been raised with this copy of the code, the use,              RAD_ALL.16587 
C duplication or disclosure of it is strictly prohibited.  Permission              RAD_ALL.16588 
C to do so must first be obtained in writing from the Head of Numerical            RAD_ALL.16589 
C Modelling at the above address.                                                  RAD_ALL.16590 
C ******************************COPYRIGHT******************************            RAD_ALL.16591 
C                                                                                  RAD_ALL.16592 
!+ Subroutine to calculate fluxes using equivalent extinction.                     RAD_ALL.16593 
!                                                                                  RAD_ALL.16594 
! Method:                                                                          RAD_ALL.16595 
!       For each minor gas an equivalent extinction is calculated                  RAD_ALL.16596 
!       from a clear-sky calculation. These equivalent extinctions                 RAD_ALL.16597 
!       are then used in a full calculation involving the major gas.               RAD_ALL.16598 
!                                                                                  RAD_ALL.16599 
! Current Owner of Code: J. M. Edwards                                             RAD_ALL.16600 
!                                                                                  RAD_ALL.16601 
! History:                                                                         RAD_ALL.16602 
!       Version         Date                    Comment                            RAD_ALL.16603 
!       4.0             27-07-95                Original Code                      RAD_ALL.16604 
!                                               (J. M. Edwards)                    RAD_ALL.16605 
!       4.1             04-03-96                Calculation of equival-            RAD_ALL.16606 
!                                               ent extinction removed             RAD_ALL.16607 
!                                               from within the loop               RAD_ALL.16608 
!                                               over the major gas since           RAD_ALL.16609 
!                                               no dependence on                   RAD_ALL.16610 
!                                               the ESFT                           RAD_ALL.16611 
!                                               coefficient of the major           RAD_ALL.16612 
!                                               gas is currently used.             RAD_ALL.16613 
!                                               Half-precision exponent-           RAD_ALL.16614 
!                                               ial introduced.                    RAD_ALL.16615 
!                                               (J. M. Edwards)                    RAD_ALL.16616 
!       4.2             08-08-96                Code for vertically                RAD_ALL.16617 
!                                               coherent convective                RAD_ALL.16618 
!                                               cloud added.                       RAD_ALL.16619 
!                                               (J. M. Edwards)                    RAD_ALL.16620 
!       4.2             Oct. 96     T3E migration: EXPHF function                  RAD_ALL.16621 
!                                   replaced.   (S.J.Swarbrick)                    RAD_ALL.16622 
!                                                                                  RAD_ALL.16623 
! Description of Code:                                                             RAD_ALL.16624 
!   FORTRAN 77  with extensions listed in documentation.                           RAD_ALL.16625 
!                                                                                  RAD_ALL.16626 
!- ---------------------------------------------------------------------           RAD_ALL.16627 
      SUBROUTINE SOLVE_BAND_K_EQV(IERR                                             RAD_ALL.16628 
!                       Atmospheric Properties                                     RAD_ALL.16629 
     &   , N_PROFILE, N_LAYER, L_LAYER, I_TOP, P, T, D_MASS                        RAD_ALL.16630 
!                       Angular Integration                                        RAD_ALL.16631 
     &   , I_ANGULAR_INTEGRATION, I_2STREAM, L_2_STREAM_CORRECT                    RAD_ALL.16632 
     &   , L_RESCALE, N_ORDER_GAUSS                                                RAD_ALL.16633 
!                       Treatment of Scattering                                    RAD_ALL.16634 
     &   , I_SCATTER_METHOD_BAND                                                   RAD_ALL.16635 
!                       Options for Solver                                         RAD_ALL.16636 
     &   , I_SOLVER, L_NET, I_EXTRAPOLATE_MIX_NET, N_AUGMENT                       RAD_ALL.16637 
!                       Gaseous Properties                                         RAD_ALL.16638 
     &   , I_BAND, N_GAS                                                           RAD_ALL.16639 
     &   , INDEX_ABSORB, I_BAND_ESFT, I_SCALE_ESFT, I_SCALE_FNC                    RAD_ALL.16640 
     &   , K_ESFT, W_ESFT, SCALE_VECTOR                                            RAD_ALL.16641 
     &   , P_REFERENCE, T_REFERENCE                                                RAD_ALL.16642 
     &   , GAS_MIX_RATIO, GAS_FRAC_RESCALED                                        RAD_ALL.16643 
     &   , L_DOPPLER, DOPPLER_CORRECTION                                           RAD_ALL.16644 
!                       Spectral Region                                            RAD_ALL.16645 
     &   , ISOLIR                                                                  RAD_ALL.16646 
!                       Solar Properties                                           RAD_ALL.16647 
     &   , SEC_0, SOLAR_FLUX                                                       RAD_ALL.16648 
!                       Infra-red Properties                                       RAD_ALL.16649 
     &   , PLANCK_SOURCE_BAND                                                      RAD_ALL.16650 
     &   , DIFF_PLANCK_BAND                                                        RAD_ALL.16651 
     &   , L_IR_SOURCE_QUAD, DIFF_PLANCK_BAND_2                                    RAD_ALL.16652 
!                       Surface Properties                                         RAD_ALL.16653 
     &   , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR, THERMAL_GROUND_BAND            RAD_ALL.16654 
!                       Clear-sky Optical Properties                               RAD_ALL.16655 
     &   , K_GREY_TOT_FREE, K_EXT_SCAT_FREE, ASYMMETRY_FREE                        RAD_ALL.16656 
     &   , FORWARD_SCATTER_FREE                                                    RAD_ALL.16657 
!                       Cloudy Properties                                          RAD_ALL.16658 
     &   , L_CLOUD, I_CLOUD                                                        RAD_ALL.16659 
!                       Cloud Geometry                                             RAD_ALL.16660 
     &   , N_CLOUD_TOP                                                             RAD_ALL.16661 
     &   , N_CLOUD_TYPE, FRAC_CLOUD                                                RAD_ALL.16662 
     &   , I_REGION_CLOUD, FRAC_REGION                                             RAD_ALL.16663 
     &   , W_FREE, N_FREE_PROFILE, I_FREE_PROFILE                                  RAD_ALL.16664 
     &   , W_CLOUD, N_CLOUD_PROFILE, I_CLOUD_PROFILE                               RAD_ALL.16665 
     &   , CLOUD_OVERLAP                                                           RAD_ALL.16666 
     &   , N_COLUMN, L_COLUMN, AREA_COLUMN                                         RAD_ALL.16667 
!                       Cloudy Optical Properties                                  RAD_ALL.16668 
     &   , K_GREY_TOT_CLOUD, K_EXT_SCAT_CLOUD                                      RAD_ALL.16669 
     &   , ASYMMETRY_CLOUD, FORWARD_SCATTER_CLOUD                                  RAD_ALL.16670 
!                       Fluxes Calculated                                          RAD_ALL.16671 
     &   , FLUX_DIRECT_BAND, FLUX_TOTAL_BAND                                       RAD_ALL.16672 
!                       Flags for Clear-sky Fluxes                                 RAD_ALL.16673 
     &   , L_CLEAR, I_SOLVER_CLEAR                                                 RAD_ALL.16674 
!                       Clear-sky Fluxes Calculated                                RAD_ALL.16675 
     &   , FLUX_DIRECT_CLEAR_BAND, FLUX_TOTAL_CLEAR_BAND                           RAD_ALL.16676 
!                       Dimensions of Arrays                                       RAD_ALL.16677 
     &   , NPD_PROFILE, NPD_LAYER, NPD_COLUMN                                      RAD_ALL.16678 
     &   , NPD_BAND, NPD_SPECIES                                                   RAD_ALL.16679 
     &   , NPD_ESFT_TERM, NPD_SCALE_VARIABLE, NPD_SCALE_FNC                        RAD_ALL.16680 
     &   )                                                                         RAD_ALL.16681 
!                                                                                  RAD_ALL.16682 
!                                                                                  RAD_ALL.16683 
!                                                                                  RAD_ALL.16684 
      IMPLICIT NONE                                                                RAD_ALL.16685 
!                                                                                  RAD_ALL.16686 
!                                                                                  RAD_ALL.16687 
!     SIZES OF DUMMY ARRAYS.                                                       RAD_ALL.16688 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.16689 
     &     NPD_PROFILE                                                             RAD_ALL.16690 
!             MAXIMUM NUMBER OF PROFILES                                           RAD_ALL.16691 
     &   , NPD_LAYER                                                               RAD_ALL.16692 
!             MAXIMUM NUMBER OF LAYERS                                             RAD_ALL.16693 
     &   , NPD_BAND                                                                RAD_ALL.16694 
!             MAXIMUM NUMBER OF SPECTRAL BANDS                                     RAD_ALL.16695 
     &   , NPD_SPECIES                                                             RAD_ALL.16696 
!             MAXIMUM NUMBER OF SPECIES                                            RAD_ALL.16697 
     &   , NPD_ESFT_TERM                                                           RAD_ALL.16698 
!             MAXIMUM NUMBER OF ESFT TERMS                                         RAD_ALL.16699 
     &   , NPD_SCALE_VARIABLE                                                      RAD_ALL.16700 
!             MAXIMUM NUMBER OF SCALE VARIABLES                                    RAD_ALL.16701 
     &   , NPD_SCALE_FNC                                                           RAD_ALL.16702 
!             MAXIMUM NUMBER OF SCALING FUNCTIONS                                  RAD_ALL.16703 
     &   , NPD_COLUMN                                                              RAD_ALL.16704 
!             NUMBER OF COLUMNS PER POINT                                          RAD_ALL.16705 
!                                                                                  RAD_ALL.16706 
!     INCLUDE COMDECKS.                                                            RAD_ALL.16707 
!     ------------------------------------------------------------------           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    
!     ------------------------------------------------------------------           PRMCH3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       PRMCH3A.3     
!                                                                                  PRMCH3A.4     
!     MODULE FOR SETTING MACHINE PRECISION.                                        PRMCH3A.5     
!                                                                                  PRMCH3A.6     
      REAL                                                                         PRMCH3A.7     
     &     TOL_MACHINE                                                             PRMCH3A.8     
!             MACHINE TOLERANCE                                                    PRMCH3A.9     
     &   , SQRT_TOL_MACHINE                                                        PRMCH3A.10    
!             SQRT OF MACHINE TOLERANCE                                            PRMCH3A.11    
!                                                                                  PRMCH3A.12    
!                                                                                  PRMCH3A.13    
!     THE PRECISION SHOULD BE ABOUT 2/2^(SIZE OF SIGNIFICAND)                      PRMCH3A.14    
!                                                                                  PRMCH3A.15    
!     THE IEEE-FORMAT USES 53 BITS FOR THE SIGNIFICAND                             PRMCH3A.16    
!     IN DOUBLE PRECISION                                                          PRMCH3A.17    
!                                                                                  PRMCH3A.18    
!     THE CRAY FORMAT USES 47 BITS IN SINGLE PRECISION.                            PRMCH3A.19    
!                                                                                  PRMCH3A.20    
      PARAMETER(                                                                   PRMCH3A.21    
     &     TOL_MACHINE=1.42E-14                                                    PRMCH3A.22    
     &   , SQRT_TOL_MACHINE=1.19E-7                                                PRMCH3A.23    
     &   )                                                                         PRMCH3A.24    
!                                                                                  PRMCH3A.25    
!     ------------------------------------------------------------------           PRMCH3A.26    
!     ------------------------------------------------------------------           PRECSN3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       PRECSN3A.3     
!                                                                                  PRECSN3A.4     
!     MODULE FOR SETTING MACHINE-DEPENDENT TOLERANCES.                             PRECSN3A.5     
!     (THE COMDECK PRMCH3A MUST ALWAYS BE INCLUDED BEFORE THIS COMDECK.)           PRECSN3A.6     
!                                                                                  PRECSN3A.7     
      REAL                                                                         PRECSN3A.8     
     &     TOL_DIV                                                                 PRECSN3A.9     
!             TOLERANCE FOR DIVISION                                               PRECSN3A.10    
     &   , TOL_TEST                                                                PRECSN3A.11    
!             TOLERANCE FOR TESTING EQUALITY                                       PRECSN3A.12    
!                                                                                  PRECSN3A.13    
      PARAMETER(                                                                   PRECSN3A.14    
     &     TOL_DIV=3.2E+01*TOL_MACHINE                                             PRECSN3A.15    
     &   , TOL_TEST=1.6E+01*TOL_MACHINE                                            PRECSN3A.16    
     &   )                                                                         PRECSN3A.17    
!                                                                                  PRECSN3A.18    
!     ------------------------------------------------------------------           PRECSN3A.19    
!     ------------------------------------------------------------------           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    
!     ------------------------------------------------------------------           DIFFKE3A.2     
!     COMDECK FOR TWO-STREAM RADIATION CODE.                                       DIFFKE3A.3     
!                                                                                  DIFFKE3A.4     
!     MODULE TO SET THE DIFFUSIVITY FACTOR FOR USE WITH                            DIFFKE3A.5     
!     EQUIVALENT EXTINCTION                                                        DIFFKE3A.6     
!                                                                                  DIFFKE3A.7     
      REAL                                                                         DIFFKE3A.8     
     &     DIFFUSIVITY_FACTOR_MINOR                                                DIFFKE3A.9     
!             MINOR DIFFUSIVITY FACTOR                                             DIFFKE3A.10    
!                                                                                  DIFFKE3A.11    
      PARAMETER(                                                                   DIFFKE3A.12    
     &     DIFFUSIVITY_FACTOR_MINOR=1.66E+00                                       DIFFKE3A.13    
     &   )                                                                         DIFFKE3A.14    
!                                                                                  DIFFKE3A.15    
!     ------------------------------------------------------------------           DIFFKE3A.16    
!     ------------------------------------------------------------------           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.16715 
!                                                                                  RAD_ALL.16716 
!                                                                                  RAD_ALL.16717 
!     DUMMY ARGUMENTS.                                                             RAD_ALL.16718 
      INTEGER   !, INTENT(OUT)                                                     RAD_ALL.16719 
     &     IERR                                                                    RAD_ALL.16720 
!             ERROR FLAG                                                           RAD_ALL.16721 
!                                                                                  RAD_ALL.16722 
!                       Atmospheric Properties                                     RAD_ALL.16723 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.16724 
     &     N_PROFILE                                                               RAD_ALL.16725 
!             NUMBER OF PROFILES                                                   RAD_ALL.16726 
     &   , N_LAYER                                                                 RAD_ALL.16727 
!             NUMBER OF LAYERS                                                     RAD_ALL.16728 
     &   , I_TOP                                                                   RAD_ALL.16729 
!             TOP OF VERTICAL GRID                                                 RAD_ALL.16730 
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.16731 
     &     L_LAYER                                                                 RAD_ALL.16732 
!             PROPERTIES GIVEN IN LAYERS                                           RAD_ALL.16733 
      REAL  !, INTENT(IN)                                                          RAD_ALL.16734 
     &     D_MASS(NPD_PROFILE, NPD_LAYER)                                          RAD_ALL.16735 
!             MASS THICKNESS OF EACH LAYER                                         RAD_ALL.16736 
     &   , P(NPD_PROFILE, 0: NPD_LAYER)                                            RAD_ALL.16737 
!             PRESSURE                                                             RAD_ALL.16738 
     &   , T(NPD_PROFILE, 0: NPD_LAYER)                                            RAD_ALL.16739 
!             TEMPERATURE                                                          RAD_ALL.16740 
!                                                                                  RAD_ALL.16741 
!                       Angular Integration                                        RAD_ALL.16742 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.16743 
     &     I_ANGULAR_INTEGRATION                                                   RAD_ALL.16744 
!             ANGULAR INTEGRATION SCHEME                                           RAD_ALL.16745 
     &   , I_2STREAM                                                               RAD_ALL.16746 
!             TWO-STREAM SCHEME                                                    RAD_ALL.16747 
     &   , N_ORDER_GAUSS                                                           RAD_ALL.16748 
!             ORDER OF GAUSSIAN INTEGRATION                                        RAD_ALL.16749 
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.16750 
     &     L_2_STREAM_CORRECT                                                      RAD_ALL.16751 
!             USE AN EDGE CORRECTION                                               RAD_ALL.16752 
     &   , L_RESCALE                                                               RAD_ALL.16753 
!             RESCALE OPTICAL PROPERTIES                                           RAD_ALL.16754 
!                                                                                  RAD_ALL.16755 
!                       Treatment of Scattering                                    RAD_ALL.16756 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.16757 
     &     I_SCATTER_METHOD_BAND                                                   RAD_ALL.16758 
!             METHOD OF TREATING SCATTERING                                        RAD_ALL.16759 
!                                                                                  RAD_ALL.16760 
!                       Options for Solver                                         RAD_ALL.16761 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.16762 
     &     I_SOLVER                                                                RAD_ALL.16763 
!             SOLVER USED                                                          RAD_ALL.16764 
     &   , I_EXTRAPOLATE_MIX_NET                                                   RAD_ALL.16765 
!             METHOD FOR EXTRAPOLATING WITH A MIXED SOLVER                         RAD_ALL.16766 
     &   , N_AUGMENT                                                               RAD_ALL.16767 
!             LENGTH OF LONG FLUX VECTOR                                           RAD_ALL.16768 
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.16769 
     &     L_NET                                                                   RAD_ALL.16770 
!             CALCULATE NET FLUXES                                                 RAD_ALL.16771 
!                                                                                  RAD_ALL.16772 
!                       Gaseous Properties                                         RAD_ALL.16773 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.16774 
     &     I_BAND                                                                  RAD_ALL.16775 
!             BAND BEING CONSIDERED                                                RAD_ALL.16776 
     &   , N_GAS                                                                   RAD_ALL.16777 
!             NUMBER OF GASES IN BAND                                              RAD_ALL.16778 
     &   , INDEX_ABSORB(NPD_SPECIES, NPD_BAND)                                     RAD_ALL.16779 
!             LIST OF ABSORBERS IN BANDS                                           RAD_ALL.16780 
     &   , I_BAND_ESFT(NPD_BAND, NPD_SPECIES)                                      RAD_ALL.16781 
!             NUMBER OF TERMS IN BAND                                              RAD_ALL.16782 
     &   , I_SCALE_ESFT(NPD_BAND, NPD_SPECIES)                                     RAD_ALL.16783 
!             TYPE OF ESFT SCALING                                                 RAD_ALL.16784 
     &   , I_SCALE_FNC(NPD_BAND, NPD_SPECIES)                                      RAD_ALL.16785 
!             TYPE OF SCALING FUNCTION                                             RAD_ALL.16786 
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.16787 
     &     L_DOPPLER(NPD_SPECIES)                                                  RAD_ALL.16788 
!             DOPPLER BROADENING INCLUDED                                          RAD_ALL.16789 
      REAL  !, INTENT(IN)                                                          RAD_ALL.16790 
     &     K_ESFT(NPD_ESFT_TERM, NPD_BAND, NPD_SPECIES)                            RAD_ALL.16791 
!             EXPONENTIAL ESFT TERMS                                               RAD_ALL.16792 
     &   , W_ESFT(NPD_ESFT_TERM, NPD_BAND, NPD_SPECIES)                            RAD_ALL.16793 
!             WEIGHTS FOR ESFT                                                     RAD_ALL.16794 
     &   , SCALE_VECTOR(NPD_SCALE_VARIABLE, NPD_ESFT_TERM, NPD_BAND                RAD_ALL.16795 
     &        , NPD_SPECIES)                                                       RAD_ALL.16796 
!             ABSORBER SCALING PARAMETERS                                          RAD_ALL.16797 
     &   , P_REFERENCE(NPD_SPECIES, NPD_BAND)                                      RAD_ALL.16798 
!             REFERENCE SCALING PRESSURE                                           RAD_ALL.16799 
     &   , T_REFERENCE(NPD_SPECIES, NPD_BAND)                                      RAD_ALL.16800 
!             REFERENCE SCALING TEMPERATURE                                        RAD_ALL.16801 
     &   , GAS_MIX_RATIO(NPD_PROFILE, 0: NPD_LAYER, NPD_SPECIES)                   RAD_ALL.16802 
!             GAS MASS MIXING RATIOS                                               RAD_ALL.16803 
     &   , GAS_FRAC_RESCALED(NPD_PROFILE, 0: NPD_LAYER, NPD_SPECIES)               RAD_ALL.16804 
!             RESCALED GAS MASS FRACTIONS                                          RAD_ALL.16805 
     &   , DOPPLER_CORRECTION(NPD_SPECIES)                                         RAD_ALL.16806 
!             DOPPLER BROADENING TERMS                                             RAD_ALL.16807 
!                                                                                  RAD_ALL.16808 
!                       Spectral Region                                            RAD_ALL.16809 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.16810 
     &     ISOLIR                                                                  RAD_ALL.16811 
!             VISIBLE OR IR                                                        RAD_ALL.16812 
!                                                                                  RAD_ALL.16813 
!                       Solar Properties                                           RAD_ALL.16814 
      REAL  !, INTENT(IN)                                                          RAD_ALL.16815 
     &     SEC_0(NPD_PROFILE)                                                      RAD_ALL.16816 
!             SECANT OF SOLAR ZENITH ANGLE                                         RAD_ALL.16817 
     &   , SOLAR_FLUX(NPD_PROFILE)                                                 RAD_ALL.16818 
!             INCIDENT SOLAR FLUX IN BAND                                          RAD_ALL.16819 
!                                                                                  RAD_ALL.16820 
!                       Infra-red Properties                                       RAD_ALL.16821 
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.16822 
     &     L_IR_SOURCE_QUAD                                                        RAD_ALL.16823 
!             USE A QUADRATIC SOURCE FUNCTION                                      RAD_ALL.16824 
      REAL  !, INTENT(IN)                                                          RAD_ALL.16825 
     &     PLANCK_SOURCE_BAND(NPD_PROFILE, 0: NPD_LAYER)                           RAD_ALL.16826 
!             PLANCKIAN SOURCE IN BAND                                             RAD_ALL.16827 
     &   , DIFF_PLANCK_BAND(NPD_PROFILE, NPD_LAYER)                                RAD_ALL.16828 
!             THERMAL SOURCE FUNCTION                                              RAD_ALL.16829 
     &   , DIFF_PLANCK_BAND_2(NPD_PROFILE, NPD_LAYER)                              RAD_ALL.16830 
!             2x2ND DIFFERENCE OF PLANCKIAN IN BAND                                RAD_ALL.16831 
!                                                                                  RAD_ALL.16832 
!                       Surface Properties                                         RAD_ALL.16833 
      REAL  !, INTENT(IN)                                                          RAD_ALL.16834 
     &     ALBEDO_SURFACE_DIFF(NPD_PROFILE)                                        RAD_ALL.16835 
!             DIFFUSE SURFACE ALBEDO                                               RAD_ALL.16836 
     &   , ALBEDO_SURFACE_DIR(NPD_PROFILE)                                         RAD_ALL.16837 
!             DIRECT SURFACE ALBEDO                                                RAD_ALL.16838 
     &   , THERMAL_GROUND_BAND(NPD_PROFILE)                                        RAD_ALL.16839 
!             THERMAL SOURCE FUNCTION AT GROUND                                    RAD_ALL.16840 
!                                                                                  RAD_ALL.16841 
!                       Clear-sky Optical Properties                               RAD_ALL.16842 
      REAL  !, INTENT(IN)                                                          RAD_ALL.16843 
     &     K_GREY_TOT_FREE(NPD_PROFILE, NPD_LAYER)                                 RAD_ALL.16844 
!             FREE ABSORPTIVE EXTINCTION                                           RAD_ALL.16845 
     &   , K_EXT_SCAT_FREE(NPD_PROFILE, NPD_LAYER)                                 RAD_ALL.16846 
!             FREE SCATTERING EXTINCTION                                           RAD_ALL.16847 
     &   , ASYMMETRY_FREE(NPD_PROFILE, NPD_LAYER)                                  RAD_ALL.16848 
!             CLEAR-SKY ASYMMETRY                                                  RAD_ALL.16849 
     &   , FORWARD_SCATTER_FREE(NPD_PROFILE, NPD_LAYER)                            RAD_ALL.16850 
!             FREE FORWARD SCATTERING                                              RAD_ALL.16851 
!                                                                                  RAD_ALL.16852 
!                       Cloudy Properties                                          RAD_ALL.16853 
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.16854 
     &     L_CLOUD                                                                 RAD_ALL.16855 
!             CLOUDS REQUIRED                                                      RAD_ALL.16856 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.16857 
     &     I_CLOUD                                                                 RAD_ALL.16858 
!             CLOUD SCHEME USED                                                    RAD_ALL.16859 
!                                                                                  RAD_ALL.16860 
!                       Cloud Geometry                                             RAD_ALL.16861 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.16862 
     &     N_CLOUD_TOP                                                             RAD_ALL.16863 
!             TOPMOST CLOUDY LAYER                                                 RAD_ALL.16864 
     &   , N_CLOUD_TYPE                                                            RAD_ALL.16865 
!             NUMBER OF TYPES OF CLOUDS                                            RAD_ALL.16866 
     &   , N_FREE_PROFILE(NPD_LAYER)                                               RAD_ALL.16867 
!             NUMBER OF FREE PROFILES                                              RAD_ALL.16868 
     &   , I_FREE_PROFILE(NPD_PROFILE, NPD_LAYER)                                  RAD_ALL.16869 
!             INDICES OF FREE PROFILES                                             RAD_ALL.16870 
     &   , N_CLOUD_PROFILE(NPD_LAYER)                                              RAD_ALL.16871 
!             NUMBER OF CLOUDY PROFILES                                            RAD_ALL.16872 
     &   , I_CLOUD_PROFILE(NPD_PROFILE, NPD_LAYER)                                 RAD_ALL.16873 
!             INDICES OF CLOUDY PROFILES                                           RAD_ALL.16874 
     &   , N_COLUMN(NPD_PROFILE)                                                   RAD_ALL.16875 
!             NUMBER OF COLUMNS REQUIRED                                           RAD_ALL.16876 
     &   , I_REGION_CLOUD(NPD_CLOUD_TYPE)                                          RAD_ALL.16877 
!             REGIONS IN WHICH TYPES OF CLOUDS FALL                                RAD_ALL.16878 
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.16879 
     &     L_COLUMN(NPD_PROFILE, NPD_LAYER, NPD_COLUMN)                            RAD_ALL.16880 
!             COLUMN FLAGS FOR COLUMNS                                             RAD_ALL.16881 
      REAL  !, INTENT(IN)                                                          RAD_ALL.16882 
     &     W_CLOUD(NPD_PROFILE, NPD_LAYER)                                         RAD_ALL.16883 
!             CLOUDY FRACTION                                                      RAD_ALL.16884 
     &   , FRAC_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)                      RAD_ALL.16885 
!             FRACTIONS OF DIFFERENT TYPES OF CLOUD                                RAD_ALL.16886 
     &   , W_FREE(NPD_PROFILE, NPD_LAYER)                                          RAD_ALL.16887 
!             CLEAR-SKY FRACTION                                                   RAD_ALL.16888 
     &   , CLOUD_OVERLAP(NPD_PROFILE, 0: NPD_LAYER, NPD_OVERLAP_COEFF)             RAD_ALL.16889 
!             COEFFICIENTS FOR TRANSFER FOR ENERGY AT INTERFACES                   RAD_ALL.16890 
     &   , AREA_COLUMN(NPD_PROFILE, NPD_COLUMN)                                    RAD_ALL.16891 
!             AREAS OF COLUMNS                                                     RAD_ALL.16892 
     &   , FRAC_REGION(NPD_PROFILE, NPD_LAYER, NPD_REGION)                         RAD_ALL.16893 
!             FRACTIONS OF TOTAL CLOUD OCCUPIED BY EACH REGION                     RAD_ALL.16894 
!                                                                                  RAD_ALL.16895 
!                       Cloudy Optical Properties                                  RAD_ALL.16896 
      REAL  !, INTENT(IN)                                                          RAD_ALL.16897 
     &     K_GREY_TOT_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)                RAD_ALL.16898 
!             CLOUDY ABSORPTIVE EXTINCTION                                         RAD_ALL.16899 
     &   , K_EXT_SCAT_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)                RAD_ALL.16900 
!             CLOUDY SCATTERING EXTINCTION                                         RAD_ALL.16901 
     &   , ASYMMETRY_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)                 RAD_ALL.16902 
!             CLOUDY ASYMMETRY                                                     RAD_ALL.16903 
     &   , FORWARD_SCATTER_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)           RAD_ALL.16904 
!             CLOUDY FORWARD SCATTERING                                            RAD_ALL.16905 
!                                                                                  RAD_ALL.16906 
!                       Fluxes Calculated                                          RAD_ALL.16907 
      REAL  !, INTENT(OUT)                                                         RAD_ALL.16908 
     &     FLUX_DIRECT_BAND(NPD_PROFILE, 0: NPD_LAYER)                             RAD_ALL.16909 
!             DIRECT FLUX IN BAND                                                  RAD_ALL.16910 
     &   , FLUX_TOTAL_BAND(NPD_PROFILE, 2*NPD_LAYER+2)                             RAD_ALL.16911 
!             TOTAL FLUX IN BAND                                                   RAD_ALL.16912 
!                                                                                  RAD_ALL.16913 
!                       Flags for Clear-sky Fluxes                                 RAD_ALL.16914 
      LOGICAL   !, INTENT(IN)                                                      RAD_ALL.16915 
     &     L_CLEAR                                                                 RAD_ALL.16916 
!             CALCULATE CLEAR-SKY PROPERTIES                                       RAD_ALL.16917 
      INTEGER   !, INTENT(IN)                                                      RAD_ALL.16918 
     &     I_SOLVER_CLEAR                                                          RAD_ALL.16919 
!             CLEAR SOLVER USED                                                    RAD_ALL.16920 
!                                                                                  RAD_ALL.16921 
!                       Clear-sky Fluxes Calculated                                RAD_ALL.16922 
      REAL  !, INTENT(OUT)                                                         RAD_ALL.16923 
     &     FLUX_DIRECT_CLEAR_BAND(NPD_PROFILE, 0: NPD_LAYER)                       RAD_ALL.16924 
!             CLEAR-SKY DIRECT FLUX IN BAND                                        RAD_ALL.16925 
     &   , FLUX_TOTAL_CLEAR_BAND(NPD_PROFILE, 2*NPD_LAYER+2)                       RAD_ALL.16926 
!             CLEAR-SKY TOTAL FLUX IN BAND                                         RAD_ALL.16927 
!                                                                                  RAD_ALL.16928 
!                                                                                  RAD_ALL.16929 
!                                                                                  RAD_ALL.16930 
!     LOCAL VARIABLES.                                                             RAD_ALL.16931 
      INTEGER                                                                      RAD_ALL.16932 
     &     I                                                                       RAD_ALL.16933 
!             LOOP VARIABLE                                                        RAD_ALL.16934 
     &   , J                                                                       RAD_ALL.16935 
!             LOOP VARIABLE                                                        RAD_ALL.16936 
     &   , K                                                                       RAD_ALL.16937 
!             LOOP VARIABLE                                                        RAD_ALL.16938 
     &   , L                                                                       RAD_ALL.16939 
!             LOOP VARIABLE                                                        RAD_ALL.16940 
      INTEGER                                                                      RAD_ALL.16941 
     &     I_GAS                                                                   RAD_ALL.16942 
!             INDEX OF MAIN GAS                                                    RAD_ALL.16943 
     &   , I_GAS_BAND                                                              RAD_ALL.16944 
!             INDEX OF ACTIVE GAS                                                  RAD_ALL.16945 
     &   , I_GAS_POINTER(NPD_SPECIES)                                              RAD_ALL.16946 
!             POINTER ARRAY FOR MONOCHROMATIC ESFTs                                RAD_ALL.16947 
     &   , IEX                                                                     RAD_ALL.16948 
!             INDEX OF ESFT TERM                                                   RAD_ALL.16949 
      REAL                                                                         RAD_ALL.16950 
     &     SOURCE_GROUND(NPD_PROFILE)                                              RAD_ALL.16951 
!             GROUND SOURCE FUNCTION                                               RAD_ALL.16952 
     &   , FLUX_INC_DIRECT(NPD_PROFILE)                                            RAD_ALL.16953 
!             INCIDENT DIRECT FLUX                                                 RAD_ALL.16954 
     &   , FLUX_INC_DOWN(NPD_PROFILE)                                              RAD_ALL.16955 
!             INCIDENT DOWNWARD FLUX                                               RAD_ALL.16956 
     &   , ESFT_WEIGHT                                                             RAD_ALL.16957 
!             ESFT WEIGHT FOR CURRENT CALCULATION                                  RAD_ALL.16958 
     &   , ADJUST_SOLAR_KE(NPD_PROFILE, NPD_LAYER)                                 RAD_ALL.16959 
!             ADJUSTMENT OF SOLAR TRANSMISSION TO INCLUDE EFFECTS                  RAD_ALL.16960 
!             OF MINOR GASES AND TAKE OUT EQUIVALENT EXTINCTION                    RAD_ALL.16961 
     &   , K_EQV(NPD_PROFILE, NPD_LAYER)                                           RAD_ALL.16962 
!             EQUIVALENT EXTINCTION                                                RAD_ALL.16963 
     &   , TAU_GAS(NPD_PROFILE, NPD_LAYER)                                         RAD_ALL.16964 
!             OPTICAL DEPTH OF GAS                                                 RAD_ALL.16965 
     &   , K_ESFT_MONO(NPD_SPECIES)                                                RAD_ALL.16966 
!             MONOCHROMATIC EXPONENTS                                              RAD_ALL.16967 
     &   , K_GAS_ABS(NPD_PROFILE, NPD_LAYER)                                       RAD_ALL.16968 
!             GASEOUS EXTINCTION                                                   RAD_ALL.16969 
      REAL                                                                         RAD_ALL.16970 
     &     FLUX_DIRECT_PART(NPD_PROFILE, 0: NPD_LAYER)                             RAD_ALL.16971 
!             PARTIAL DIRECT FLUX                                                  RAD_ALL.16972 
     &   , FLUX_TOTAL_PART(NPD_PROFILE, 2*NPD_LAYER+2)                             RAD_ALL.16973 
!             PARTIAL TOTAL FLUX                                                   RAD_ALL.16974 
     &   , FLUX_DIRECT_CLEAR_PART(NPD_PROFILE, 0: NPD_LAYER)                       RAD_ALL.16975 
!             CLEAR PARTIAL DIRECT FLUX                                            RAD_ALL.16976 
     &   , FLUX_TOTAL_CLEAR_PART(NPD_PROFILE, 2*NPD_LAYER+2)                       RAD_ALL.16977 
!             CLEAR PARTIAL TOTAL FLUX                                             RAD_ALL.16978 
     &   , SUM_FLUX(NPD_PROFILE, 2*NPD_LAYER+2, NPD_SPECIES)                       RAD_ALL.16979 
!             SUM OF FLUXES FOR WEIGHTING                                          RAD_ALL.16980 
     &   , SUM_K_FLUX(NPD_PROFILE, 2*NPD_LAYER+2, NPD_SPECIES)                     RAD_ALL.16981 
!             SUM OF K*FLUXES FOR WEIGHTING                                        RAD_ALL.16982 
     &   , FLUX_TERM(NPD_PROFILE, 0: NPD_LAYER)                                    RAD_ALL.16983 
!             FLUX WITH ONE TERM                                                   RAD_ALL.16984 
     &   , FLUX_GAS(NPD_PROFILE, 0: NPD_LAYER)                                     RAD_ALL.16985 
!             FLUX WITH ONE GAS                                                    RAD_ALL.16986 
      REAL                                                                         RAD_ALL.16987 
     &     MEAN_NET_FLUX                                                           RAD_ALL.16988 
!             MEAN NET FLUX                                                        RAD_ALL.16989 
     &   , MEAN_K_NET_FLUX                                                         RAD_ALL.16990 
!             MEAN K-WEIGHTED NET FLUX                                             RAD_ALL.16991 
     &   , K_WEAK                                                                  RAD_ALL.16992 
!             WEAK ABSORPTION FOR MINOR GAS                                        RAD_ALL.16993 
      REAL                                                                         RAD_ALL.16994 
     &     KE_GREY_TOT_FREE(NPD_PROFILE, NPD_LAYER)                                RAD_ALL.16995 
!             EQUIVALENT FREE ABSORPTIVE EXTINCTION                                RAD_ALL.16996 
     &   , KE_GREY_TOT_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)               RAD_ALL.16997 
!             EQUIVALENT FREE ABSORPTIVE EXTINCTION                                RAD_ALL.16998 
!                                                                                  RAD_ALL.16999 
!     SUBROUTINES CALLED:                                                          RAD_ALL.17000 
      EXTERNAL                                                                     RAD_ALL.17001 
     &     SCALE_ABSORB, GAS_OPTICAL_PROPERTIES                                    RAD_ALL.17002 
     &   , MONOCHROMATIC_GAS_FLUX, MONOCHROMATIC_FLUX                              RAD_ALL.17003 
     &   , AUGMENT_FLUX                                                            RAD_ALL.17004 
!                                                                                  RAD_ALL.17005 
!                                                                                  RAD_ALL.17006 
!                                                                                  RAD_ALL.17007 
      I_GAS=INDEX_ABSORB(1, I_BAND)                                                RAD_ALL.17008 
!                                                                                  RAD_ALL.17009 
      IF (ISOLIR.EQ.IP_SOLAR) THEN                                                 RAD_ALL.17010 
!                                                                                  RAD_ALL.17011 
!        AN APPROPRIATE SCALING FACTOR IS CALCULATED FOR THE DIRECT                RAD_ALL.17012 
!        BEAM, WHILST THE EQUIVALENT EXTINCTION FOR THE DIFFUSE BEAM               RAD_ALL.17013 
!        IS WEIGHTED WITH THE SOLAR SCALING FACTOR AS EVALUATED                    RAD_ALL.17014 
!        AT THE SURFACE.                                                           RAD_ALL.17015 
!                                                                                  RAD_ALL.17016 
!        INITIALIZE THE SCALING FACTORS:                                           RAD_ALL.17017 
         DO I=1, N_LAYER                                                           RAD_ALL.17018 
            DO L=1, N_PROFILE                                                      RAD_ALL.17019 
               ADJUST_SOLAR_KE(L, I)=1.0E+00                                       RAD_ALL.17020 
               K_EQV(L, I)=0.0E+00                                                 RAD_ALL.17021 
            ENDDO                                                                  RAD_ALL.17022 
         ENDDO                                                                     RAD_ALL.17023 
!                                                                                  RAD_ALL.17024 
         DO J=2, N_GAS                                                             RAD_ALL.17025 
!                                                                                  RAD_ALL.17026 
!           INITIALIZE THE NORMALIZED FLUX FOR THE GAS.                            RAD_ALL.17027 
            DO L=1, N_PROFILE                                                      RAD_ALL.17028 
               FLUX_GAS(L, 0)=1.0E+00                                              RAD_ALL.17029 
            ENDDO                                                                  RAD_ALL.17030 
            DO I=1, N_LAYER                                                        RAD_ALL.17031 
               DO L=1, N_PROFILE                                                   RAD_ALL.17032 
                  FLUX_GAS(L, I)=0.0E+00                                           RAD_ALL.17033 
                  SUM_K_FLUX(L, N_LAYER, J)=0.0E+00                                RAD_ALL.17034 
                  SUM_FLUX(L, N_LAYER, J)=0.0E+00                                  RAD_ALL.17035 
               ENDDO                                                               RAD_ALL.17036 
            ENDDO                                                                  RAD_ALL.17037 
!                                                                                  RAD_ALL.17038 
            I_GAS_BAND=INDEX_ABSORB(J, I_BAND)                                     RAD_ALL.17039 
            DO IEX=1, I_BAND_ESFT(I_BAND, I_GAS_BAND)                              RAD_ALL.17040 
!                                                                                  RAD_ALL.17041 
!              STORE THE ESFT WEIGHT FOR FUTURE USE.                               RAD_ALL.17042 
               ESFT_WEIGHT=W_ESFT(IEX, I_BAND,  I_GAS_BAND)                        RAD_ALL.17043 
!                                                                                  RAD_ALL.17044 
!              RESCALE THE AMOUNT OF GAS FOR THIS ABSORBER IF REQUIRED.            RAD_ALL.17045 
               IF (I_SCALE_ESFT(I_BAND, I_GAS_BAND).EQ.IP_SCALE_TERM)              RAD_ALL.17046 
     &            THEN                                                             RAD_ALL.17047 
                  CALL SCALE_ABSORB(IERR, N_PROFILE, N_LAYER                       RAD_ALL.17048 
     &               , GAS_MIX_RATIO(1, 0, I_GAS_BAND), P, T                       RAD_ALL.17049 
     &               , L_LAYER, I_TOP                                              RAD_ALL.17050 
     &               , GAS_FRAC_RESCALED(1, 0, I_GAS_BAND)                         RAD_ALL.17051 
     &               , I_SCALE_FNC(I_BAND, I_GAS_BAND)                             RAD_ALL.17052 
     &               , P_REFERENCE(I_GAS_BAND, I_BAND)                             RAD_ALL.17053 
     &               , T_REFERENCE(I_GAS_BAND, I_BAND)                             RAD_ALL.17054 
     &               , SCALE_VECTOR(1, IEX, I_BAND, I_GAS_BAND)                    RAD_ALL.17055 
     &               , L_DOPPLER(I_GAS_BAND)                                       RAD_ALL.17056 
     &               , DOPPLER_CORRECTION(I_GAS_BAND)                              RAD_ALL.17057 
     &               , NPD_PROFILE, NPD_LAYER, NPD_SCALE_FNC                       RAD_ALL.17058 
     &               , NPD_SCALE_VARIABLE                                          RAD_ALL.17059 
     &               )                                                             RAD_ALL.17060 
                  IF (IERR.NE.I_NORMAL) RETURN                                     RAD_ALL.17061 
               ENDIF                                                               RAD_ALL.17062 
!                                                                                  RAD_ALL.17063 
               DO L=1, N_PROFILE                                                   RAD_ALL.17064 
                  FLUX_TERM(L, 0)=ESFT_WEIGHT                                      RAD_ALL.17065 
               ENDDO                                                               RAD_ALL.17066 
               DO I=1, N_LAYER                                                     RAD_ALL.17067 
                  DO L=1, N_PROFILE                                                RAD_ALL.17068 
                     FLUX_TERM(L, I)=FLUX_TERM(L, I-1)                             RAD_ALL.17069 
     &                  *EXP(-K_ESFT(IEX, I_BAND, I_GAS_BAND)                      RAD_ALL.17070 
     &                  *GAS_FRAC_RESCALED(L, I, I_GAS_BAND)                       RAD_ALL.17071 
     &                  *D_MASS(L, I)*SEC_0(L))                                    RAD_ALL.17072 
                     FLUX_GAS(L, I)=FLUX_GAS(L, I)+FLUX_TERM(L, I)                 RAD_ALL.17073 
                  ENDDO                                                            RAD_ALL.17074 
               ENDDO                                                               RAD_ALL.17075 
!                                                                                  RAD_ALL.17076 
!              CALCULATE THE INCREMENT IN THE ABSORPTIVE EXTINCTION                RAD_ALL.17077 
               DO L=1, N_PROFILE                                                   RAD_ALL.17078 
                  SUM_K_FLUX(L, N_LAYER, J)                                        RAD_ALL.17079 
     &               =SUM_K_FLUX(L, N_LAYER, J)                                    RAD_ALL.17080 
     &               +K_ESFT(IEX, I_BAND, I_GAS_BAND)                              RAD_ALL.17081 
     &               *FLUX_TERM(L, N_LAYER)                                        RAD_ALL.17082 
                  SUM_FLUX(L, N_LAYER, J)                                          RAD_ALL.17083 
     &               =SUM_FLUX(L, N_LAYER, J)+FLUX_TERM(L, N_LAYER)                RAD_ALL.17084 
               ENDDO                                                               RAD_ALL.17085 
!                                                                                  RAD_ALL.17086 
            ENDDO                                                                  RAD_ALL.17087 
!                                                                                  RAD_ALL.17088 
!           SET THE EQUIVALENT EXTINCTION FOR THE DIFFUSE BEAM,                    RAD_ALL.17089 
!           WEIGHTING WITH THE DIRECT SURFACE FLUX.                                RAD_ALL.17090 
            DO I=1, N_LAYER                                                        RAD_ALL.17091 
               DO L=1, N_PROFILE                                                   RAD_ALL.17092 
                  IF (SUM_FLUX(L, N_LAYER, J).GT.0.0E+00) THEN                     RAD_ALL.17093 
                     K_EQV(L, I)=K_EQV(L, I)                                       RAD_ALL.17094 
     &                  +GAS_FRAC_RESCALED(L, I, I_GAS_BAND)                       RAD_ALL.17095 
     &                  *SUM_K_FLUX(L, N_LAYER, J)                                 RAD_ALL.17096 
     &                  /SUM_FLUX(L, N_LAYER, J)                                   RAD_ALL.17097 
                  ELSE                                                             RAD_ALL.17098 
!                    THIS CASE CAN ARISE ONLY WHEN THE SUN IS CLOSE                RAD_ALL.17099 
!                    TO THE HORIZON WHEN THE EXPONENTIAL MAY UNDERFLOW             RAD_ALL.17100 
!                    TO 0. WE USE THE WEAKEST ESFT-TERM.                           RAD_ALL.17101 
                     K_EQV(L, I)=K_EQV(L, I)                                       RAD_ALL.17102 
     &                  *K_ESFT(1, I_BAND, I_GAS_BAND)                             RAD_ALL.17103 
     &                  *GAS_FRAC_RESCALED(L, I, I_GAS_BAND)                       RAD_ALL.17104 
                  ENDIF                                                            RAD_ALL.17105 
                  IF (FLUX_GAS(L, I-1).GT.0.0E+00) THEN                            RAD_ALL.17106 
!                    IF THE FLUX HAS BEEN REDUCED TO 0 AT THE UPPER                RAD_ALL.17107 
!                    LEVEL THE ADJUSTING FACTOR IS NOT OF IMPORTANCE               RAD_ALL.17108 
!                    AND NEED NOT BE ADJUSTED. THIS WILL PREVENT                   RAD_ALL.17109 
!                    POSSIBLE FAILURES.                                            RAD_ALL.17110 
                     ADJUST_SOLAR_KE(L, I)                                         RAD_ALL.17111 
     &                  =ADJUST_SOLAR_KE(L, I)*FLUX_GAS(L, I)                      RAD_ALL.17112 
     &                  /FLUX_GAS(L, I-1)                                          RAD_ALL.17113 
                  ENDIF                                                            RAD_ALL.17114 
                                                                                   RAD_ALL.17115 
               ENDDO                                                               RAD_ALL.17116 
            ENDDO                                                                  RAD_ALL.17117 
!                                                                                  RAD_ALL.17118 
         ENDDO                                                                     RAD_ALL.17119 
!                                                                                  RAD_ALL.17120 
!        SINCE THE GREY EXTINCTION WILL LATER BE MODIFIED WE MUST                  RAD_ALL.17121 
!        INCREASE THE TRANSMISSION OF THE SOLAR BEAM TO COMPENSATE.                RAD_ALL.17122 
         DO I=1, N_LAYER                                                           RAD_ALL.17123 
            DO L=1, N_PROFILE                                                      RAD_ALL.17124 
               ADJUST_SOLAR_KE(L, I)=ADJUST_SOLAR_KE(L, I)                         RAD_ALL.17125 
     &            *EXP(K_EQV(L, I)*D_MASS(L, I)*SEC_0(L))                          RAD_ALL.17126 
            ENDDO                                                                  RAD_ALL.17127 
         ENDDO                                                                     RAD_ALL.17128 
!                                                                                  RAD_ALL.17129 
      ELSE IF (ISOLIR.EQ.IP_INFRA_RED) THEN                                        RAD_ALL.17130 
!                                                                                  RAD_ALL.17131 
!        EQUIVALENT ABSORPTION IS USED FOR THE MINOR GASES.                        RAD_ALL.17132 
!                                                                                  RAD_ALL.17133 
         DO J=2, N_GAS                                                             RAD_ALL.17134 
!                                                                                  RAD_ALL.17135 
!                                                                                  RAD_ALL.17136 
!           INITIALIZE THE SUMS TO FORM THE RATIO TO 0.                            RAD_ALL.17137 
            DO I=1, 2*N_LAYER+2                                                    RAD_ALL.17138 
               DO L=1, N_PROFILE                                                   RAD_ALL.17139 
                  SUM_FLUX(L, I, J)=0.0E+00                                        RAD_ALL.17140 
                  SUM_K_FLUX(L, I, J)=0.0E+00                                      RAD_ALL.17141 
               ENDDO                                                               RAD_ALL.17142 
            ENDDO                                                                  RAD_ALL.17143 
!                                                                                  RAD_ALL.17144 
            I_GAS_BAND=INDEX_ABSORB(J, I_BAND)                                     RAD_ALL.17145 
            DO IEX=1, I_BAND_ESFT(I_BAND, I_GAS_BAND)                              RAD_ALL.17146 
!                                                                                  RAD_ALL.17147 
!              STORE THE ESFT WEIGHT FOR FUTURE USE.                               RAD_ALL.17148 
               ESFT_WEIGHT=W_ESFT(IEX, I_BAND,  I_GAS_BAND)                        RAD_ALL.17149 
!                                                                                  RAD_ALL.17150 
!                                                                                  RAD_ALL.17151 
!              RESCALE THE AMOUNT OF GAS FOR THIS ABSORBER IF REQUIRED.            RAD_ALL.17152 
               IF (I_SCALE_ESFT(I_BAND, I_GAS_BAND).EQ.IP_SCALE_TERM)              RAD_ALL.17153 
     &            THEN                                                             RAD_ALL.17154 
                  CALL SCALE_ABSORB(IERR, N_PROFILE, N_LAYER                       RAD_ALL.17155 
     &               , GAS_MIX_RATIO(1, 0, I_GAS_BAND), P, T                       RAD_ALL.17156 
     &               , L_LAYER, I_TOP                                              RAD_ALL.17157 
     &               , GAS_FRAC_RESCALED(1, 0, I_GAS_BAND)                         RAD_ALL.17158 
     &               , I_SCALE_FNC(I_BAND, I_GAS_BAND)                             RAD_ALL.17159 
     &               , P_REFERENCE(I_GAS_BAND, I_BAND)                             RAD_ALL.17160 
     &               , T_REFERENCE(I_GAS_BAND, I_BAND)                             RAD_ALL.17161 
     &               , SCALE_VECTOR(1, IEX, I_BAND, I_GAS_BAND)                    RAD_ALL.17162 
     &               , L_DOPPLER(I_GAS_BAND)                                       RAD_ALL.17163 
     &               , DOPPLER_CORRECTION(I_GAS_BAND)                              RAD_ALL.17164 
     &               , NPD_PROFILE, NPD_LAYER, NPD_SCALE_FNC                       RAD_ALL.17165 
     &               , NPD_SCALE_VARIABLE                                          RAD_ALL.17166 
     &               )                                                             RAD_ALL.17167 
                  IF (IERR.NE.I_NORMAL) RETURN                                     RAD_ALL.17168 
               ENDIF                                                               RAD_ALL.17169 
!                                                                                  RAD_ALL.17170 
!              SET THE APPROPRIATE BOUNDARY TERMS FOR THE                          RAD_ALL.17171 
!              TOTAL UPWARD AND DOWNWARD FLUXES AT THE BOUNDARIES.                 RAD_ALL.17172 
!                                                                                  RAD_ALL.17173 
               DO L=1, N_PROFILE                                                   RAD_ALL.17174 
                  FLUX_INC_DIRECT(L)=0.0E+00                                       RAD_ALL.17175 
                  FLUX_DIRECT_PART(L, N_LAYER)=0.0E+00                             RAD_ALL.17176 
                  FLUX_INC_DOWN(L)=-PLANCK_SOURCE_BAND(L, 0)                       RAD_ALL.17177 
                  SOURCE_GROUND(L)=THERMAL_GROUND_BAND(L)                          RAD_ALL.17178 
     &               -(1.0E+00-ALBEDO_SURFACE_DIFF(L))                             RAD_ALL.17179 
     &               *PLANCK_SOURCE_BAND(L, N_LAYER)                               RAD_ALL.17180 
               ENDDO                                                               RAD_ALL.17181 
!                                                                                  RAD_ALL.17182 
!              SET THE OPTICAL DEPTHS OF EACH LAYER.                               RAD_ALL.17183 
               DO I=1, N_LAYER                                                     RAD_ALL.17184 
                  DO L=1, N_PROFILE                                                RAD_ALL.17185 
                     TAU_GAS(L, I)=K_ESFT(IEX, I_BAND, I_GAS_BAND)                 RAD_ALL.17186 
     &                  *GAS_FRAC_RESCALED(L, I, I_GAS_BAND)                       RAD_ALL.17187 
     &                  *D_MASS(L, I)                                              RAD_ALL.17188 
                  ENDDO                                                            RAD_ALL.17189 
               ENDDO                                                               RAD_ALL.17190 
!                                                                                  RAD_ALL.17191 
!              CALCULATE THE FLUXES WITH JUST THIS GAS.                            RAD_ALL.17192 
               CALL MONOCHROMATIC_GAS_FLUX(N_PROFILE, N_LAYER                      RAD_ALL.17193 
     &            , .FALSE.                                                        RAD_ALL.17194 
     &            , TAU_GAS                                                        RAD_ALL.17195 
     &            , ISOLIR, SEC_0, FLUX_INC_DIRECT, FLUX_INC_DOWN                  RAD_ALL.17196 
     &            , DIFF_PLANCK_BAND, SOURCE_GROUND                                RAD_ALL.17197 
     &            , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR                        RAD_ALL.17198 
     &            , DIFFUSIVITY_FACTOR_MINOR                                       RAD_ALL.17199 
     &            , FLUX_DIRECT_PART, FLUX_TOTAL_PART                              RAD_ALL.17200 
     &            , NPD_PROFILE, NPD_LAYER                                         RAD_ALL.17201 
     &            )                                                                RAD_ALL.17202 
!                                                                                  RAD_ALL.17203 
               DO I=1, 2*N_LAYER+2                                                 RAD_ALL.17204 
                  DO L=1, N_PROFILE                                                RAD_ALL.17205 
                     SUM_K_FLUX(L, I, J)=SUM_K_FLUX(L, I, J)                       RAD_ALL.17206 
     &                  +K_ESFT(IEX, I_BAND, I_GAS_BAND)                           RAD_ALL.17207 
     &                  *ESFT_WEIGHT*FLUX_TOTAL_PART(L, I)                         RAD_ALL.17208 
                     SUM_FLUX(L, I, J)=SUM_FLUX(L, I, J)                           RAD_ALL.17209 
     &                  +ESFT_WEIGHT*FLUX_TOTAL_PART(L, I)                         RAD_ALL.17210 
                  ENDDO                                                            RAD_ALL.17211 
               ENDDO                                                               RAD_ALL.17212 
!                                                                                  RAD_ALL.17213 
            ENDDO                                                                  RAD_ALL.17214 
!                                                                                  RAD_ALL.17215 
         ENDDO                                                                     RAD_ALL.17216 
!                                                                                  RAD_ALL.17217 
!                                                                                  RAD_ALL.17218 
         DO I=1, N_LAYER                                                           RAD_ALL.17219 
            DO L=1, N_PROFILE                                                      RAD_ALL.17220 
               K_EQV(L, I)=0.0E+00                                                 RAD_ALL.17221 
            ENDDO                                                                  RAD_ALL.17222 
         ENDDO                                                                     RAD_ALL.17223 
!                                                                                  RAD_ALL.17224 
         DO J=2, N_GAS                                                             RAD_ALL.17225 
            DO I=1, N_LAYER                                                        RAD_ALL.17226 
               DO L=1, N_PROFILE                                                   RAD_ALL.17227 
                  MEAN_K_NET_FLUX=0.5E+00*(SUM_K_FLUX(L, 2*I, J)                   RAD_ALL.17228 
     &               +SUM_K_FLUX(L, 2*I+2, J)                                      RAD_ALL.17229 
     &               -SUM_K_FLUX(L, 2*I-1, J)                                      RAD_ALL.17230 
     &               -SUM_K_FLUX(L, 2*I+1, J))                                     RAD_ALL.17231 
                  MEAN_NET_FLUX=0.5E+00*(SUM_FLUX(L, 2*I, J)                       RAD_ALL.17232 
     &               +SUM_FLUX(L, 2*I+2, J)                                        RAD_ALL.17233 
     &               -SUM_FLUX(L, 2*I-1, J)                                        RAD_ALL.17234 
     &               -SUM_FLUX(L, 2*I+1, J))                                       RAD_ALL.17235 
!                 NEGATIVE EFFECTIVE EXTINCTIONS MUST BE REMOVED.                  RAD_ALL.17236 
                  K_WEAK=MAX(0.0E+00, MEAN_K_NET_FLUX/MEAN_NET_FLUX)               RAD_ALL.17237 
                  K_EQV(L, I)=K_EQV(L, I)                                          RAD_ALL.17238 
     &               +K_WEAK*GAS_FRAC_RESCALED(L, I                                RAD_ALL.17239 
     &               , INDEX_ABSORB(J, I_BAND))                                    RAD_ALL.17240 
               ENDDO                                                               RAD_ALL.17241 
            ENDDO                                                                  RAD_ALL.17242 
         ENDDO                                                                     RAD_ALL.17243 
                                                                                   RAD_ALL.17244 
      ENDIF                                                                        RAD_ALL.17245 
!                                                                                  RAD_ALL.17246 
!                                                                                  RAD_ALL.17247 
!     THE ESFT TERMS FOR THE MAJOR GAS IN THE BAND ARE USED WITH                   RAD_ALL.17248 
!     APPROPRIATE WEIGHTED TERMS FOR THE MINOR GASES.                              RAD_ALL.17249 
      I_GAS_POINTER(1)=I_GAS                                                       RAD_ALL.17250 
      DO IEX=1, I_BAND_ESFT(I_BAND, I_GAS)                                         RAD_ALL.17251 
!                                                                                  RAD_ALL.17252 
!        STORE THE ESFT WEIGHT FOR FUTURE USE.                                     RAD_ALL.17253 
         ESFT_WEIGHT=W_ESFT(IEX, I_BAND,  I_GAS)                                   RAD_ALL.17254 
!                                                                                  RAD_ALL.17255 
!        RESCALE FOR EACH ESFT TERM IF THAT IS REQUIRED.                           RAD_ALL.17256 
         IF (I_SCALE_ESFT(I_BAND, I_GAS).EQ.IP_SCALE_TERM) THEN                    RAD_ALL.17257 
            CALL SCALE_ABSORB(IERR, N_PROFILE, N_LAYER                             RAD_ALL.17258 
     &         , GAS_MIX_RATIO(1, 0, I_GAS), P, T                                  RAD_ALL.17259 
     &         , L_LAYER, I_TOP                                                    RAD_ALL.17260 
     &         , GAS_FRAC_RESCALED(1, 0, I_GAS)                                    RAD_ALL.17261 
     &         , I_SCALE_FNC(I_BAND, I_GAS)                                        RAD_ALL.17262 
     &         , P_REFERENCE(I_GAS, I_BAND)                                        RAD_ALL.17263 
     &         , T_REFERENCE(I_GAS, I_BAND)                                        RAD_ALL.17264 
     &         , SCALE_VECTOR(1, IEX, I_BAND, I_GAS)                               RAD_ALL.17265 
     &         , L_DOPPLER(I_GAS), DOPPLER_CORRECTION(I_GAS)                       RAD_ALL.17266 
     &         , NPD_PROFILE, NPD_LAYER, NPD_SCALE_FNC                             RAD_ALL.17267 
     &         , NPD_SCALE_VARIABLE                                                RAD_ALL.17268 
     &         )                                                                   RAD_ALL.17269 
            IF (IERR.NE.I_NORMAL) RETURN                                           RAD_ALL.17270 
         ENDIF                                                                     RAD_ALL.17271 
!                                                                                  RAD_ALL.17272 
!        SET THE APPROPRIATE BOUNDARY TERMS FOR THE TOTAL                          RAD_ALL.17273 
!        UPWARD AND DOWNWARD FLUXES.                                               RAD_ALL.17274 
!                                                                                  RAD_ALL.17275 
         IF (ISOLIR.EQ.IP_SOLAR) THEN                                              RAD_ALL.17276 
!           VISIBLE REGION.                                                        RAD_ALL.17277 
            DO L=1, N_PROFILE                                                      RAD_ALL.17278 
               SOURCE_GROUND(L)=0.0E+00                                            RAD_ALL.17279 
               FLUX_INC_DOWN(L)=SOLAR_FLUX(L)                                      RAD_ALL.17280 
               FLUX_INC_DIRECT(L)=SOLAR_FLUX(L)                                    RAD_ALL.17281 
            ENDDO                                                                  RAD_ALL.17282 
         ELSEIF (ISOLIR.EQ.IP_INFRA_RED) THEN                                      RAD_ALL.17283 
!           INFRA-RED REGION.                                                      RAD_ALL.17284 
            DO L=1, N_PROFILE                                                      RAD_ALL.17285 
               FLUX_INC_DIRECT(L)=0.0E+00                                          RAD_ALL.17286 
               FLUX_DIRECT_PART(L, N_LAYER)=0.0E+00                                RAD_ALL.17287 
               FLUX_INC_DOWN(L)=-PLANCK_SOURCE_BAND(L, 0)                          RAD_ALL.17288 
               SOURCE_GROUND(L)=THERMAL_GROUND_BAND(L)                             RAD_ALL.17289 
     &            -(1.0E+00-ALBEDO_SURFACE_DIFF(L))                                RAD_ALL.17290 
     &            *PLANCK_SOURCE_BAND(L, N_LAYER)                                  RAD_ALL.17291 
            ENDDO                                                                  RAD_ALL.17292 
            IF (L_CLEAR) THEN                                                      RAD_ALL.17293 
               DO L=1, N_PROFILE                                                   RAD_ALL.17294 
                  FLUX_DIRECT_CLEAR_PART(L, N_LAYER)=0.0E+00                       RAD_ALL.17295 
               ENDDO                                                               RAD_ALL.17296 
            ENDIF                                                                  RAD_ALL.17297 
         ENDIF                                                                     RAD_ALL.17298 
!                                                                                  RAD_ALL.17299 
!                                                                                  RAD_ALL.17300 
!        AUGMENT THE GREY EXTINCTION WITH AN EFFECTIVE VALUE                       RAD_ALL.17301 
!        FOR EACH GAS.                                                             RAD_ALL.17302 
!                                                                                  RAD_ALL.17303 
         DO I=1, N_LAYER                                                           RAD_ALL.17304 
            DO L=1, N_PROFILE                                                      RAD_ALL.17305 
               KE_GREY_TOT_FREE(L, I)=K_GREY_TOT_FREE(L, I)                        RAD_ALL.17306 
            ENDDO                                                                  RAD_ALL.17307 
         ENDDO                                                                     RAD_ALL.17308 
         IF (L_CLOUD) THEN                                                         RAD_ALL.17309 
            DO K=1, N_CLOUD_TYPE                                                   RAD_ALL.17310 
               DO I=N_CLOUD_TOP, N_LAYER                                           RAD_ALL.17311 
                  DO L=1, N_PROFILE                                                RAD_ALL.17312 
                     KE_GREY_TOT_CLOUD(L, I, K)                                    RAD_ALL.17313 
     &                  =K_GREY_TOT_CLOUD(L, I, K)                                 RAD_ALL.17314 
                  ENDDO                                                            RAD_ALL.17315 
               ENDDO                                                               RAD_ALL.17316 
            ENDDO                                                                  RAD_ALL.17317 
         ENDIF                                                                     RAD_ALL.17318 
!                                                                                  RAD_ALL.17319 
!                                                                                  RAD_ALL.17320 
         DO I=1, N_LAYER                                                           RAD_ALL.17321 
            DO L=1, N_PROFILE                                                      RAD_ALL.17322 
               KE_GREY_TOT_FREE(L, I)=KE_GREY_TOT_FREE(L, I)                       RAD_ALL.17323 
     &            +K_EQV(L, I)                                                     RAD_ALL.17324 
            ENDDO                                                                  RAD_ALL.17325 
         ENDDO                                                                     RAD_ALL.17326 
         IF (L_CLOUD) THEN                                                         RAD_ALL.17327 
            DO K=1, N_CLOUD_TYPE                                                   RAD_ALL.17328 
               DO I=N_CLOUD_TOP, N_LAYER                                           RAD_ALL.17329 
                  DO L=1, N_PROFILE                                                RAD_ALL.17330 
                     KE_GREY_TOT_CLOUD(L, I, K)                                    RAD_ALL.17331 
     &                  =KE_GREY_TOT_CLOUD(L, I, K)+K_EQV(L, I)                    RAD_ALL.17332 
                  ENDDO                                                            RAD_ALL.17333 
               ENDDO                                                               RAD_ALL.17334 
            ENDDO                                                                  RAD_ALL.17335 
         ENDIF                                                                     RAD_ALL.17336 
!                                                                                  RAD_ALL.17337 
!        ASSIGN THE MONOCHROMATIC ABSORPTION COEFFICIENT.                          RAD_ALL.17338 
         K_ESFT_MONO(I_GAS)=K_ESFT(IEX, I_BAND, I_GAS)                             RAD_ALL.17339 
!                                                                                  RAD_ALL.17340 
         CALL GAS_OPTICAL_PROPERTIES(N_PROFILE, N_LAYER                            RAD_ALL.17341 
     &      , 1, I_GAS_POINTER, K_ESFT_MONO                                        RAD_ALL.17342 
     &      , GAS_FRAC_RESCALED                                                    RAD_ALL.17343 
     &      , K_GAS_ABS                                                            RAD_ALL.17344 
     &      , NPD_PROFILE, NPD_LAYER, NPD_SPECIES                                  RAD_ALL.17345 
     &      )                                                                      RAD_ALL.17346 
!                                                                                  RAD_ALL.17347 
!                                                                                  RAD_ALL.17348 
         CALL MONOCHROMATIC_FLUX(IERR                                              RAD_ALL.17349 
!                       Atmospheric Properties                                     RAD_ALL.17350 
     &      , N_PROFILE, N_LAYER, D_MASS                                           RAD_ALL.17351 
!                       Angular Integration                                        RAD_ALL.17352 
     &      , I_ANGULAR_INTEGRATION, I_2STREAM, L_2_STREAM_CORRECT                 RAD_ALL.17353 
     &      , L_RESCALE, N_ORDER_GAUSS                                             RAD_ALL.17354 
!                       Treatment of Scattering                                    RAD_ALL.17355 
     &      , I_SCATTER_METHOD_BAND                                                RAD_ALL.17356 
!                       Options for Solver                                         RAD_ALL.17357 
     &      , I_SOLVER, L_NET, I_EXTRAPOLATE_MIX_NET, N_AUGMENT                    RAD_ALL.17358 
!                       Gaseous Propreties                                         RAD_ALL.17359 
     &      , K_GAS_ABS                                                            RAD_ALL.17360 
!                       Options for Equivalent Extinction                          RAD_ALL.17361 
     &      , .TRUE., ADJUST_SOLAR_KE                                              RAD_ALL.17362 
!                       Spectral Region                                            RAD_ALL.17363 
     &      , ISOLIR                                                               RAD_ALL.17364 
!                       Infra-red Properties                                       RAD_ALL.17365 
     &      , DIFF_PLANCK_BAND                                                     RAD_ALL.17366 
     &      , L_IR_SOURCE_QUAD, DIFF_PLANCK_BAND_2                                 RAD_ALL.17367 
!                       Conditions at TOA                                          RAD_ALL.17368 
     &      , SEC_0, FLUX_INC_DIRECT, FLUX_INC_DOWN                                RAD_ALL.17369 
!                       Surface Properties                                         RAD_ALL.17370 
     &      , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR, SOURCE_GROUND               RAD_ALL.17371 
     &      , THERMAL_GROUND_BAND                                                  RAD_ALL.17372 
!                       Clear-sky Optical Properties                               RAD_ALL.17373 
     &      , KE_GREY_TOT_FREE, K_EXT_SCAT_FREE                                    RAD_ALL.17374 
     &      , ASYMMETRY_FREE, FORWARD_SCATTER_FREE                                 RAD_ALL.17375 
!                       Cloudy Properties                                          RAD_ALL.17376 
     &      , L_CLOUD, I_CLOUD                                                     RAD_ALL.17377 
!                       Cloud Geometry                                             RAD_ALL.17378 
     &      , N_CLOUD_TOP                                                          RAD_ALL.17379 
     &      , N_CLOUD_TYPE, FRAC_CLOUD                                             RAD_ALL.17380 
     &      , I_REGION_CLOUD, FRAC_REGION                                          RAD_ALL.17381 
     &      , W_FREE, N_FREE_PROFILE, I_FREE_PROFILE                               RAD_ALL.17382 
     &      , W_CLOUD, N_CLOUD_PROFILE, I_CLOUD_PROFILE                            RAD_ALL.17383 
     &      , CLOUD_OVERLAP                                                        RAD_ALL.17384 
     &      , N_COLUMN, L_COLUMN, AREA_COLUMN                                      RAD_ALL.17385 
!                       Cloudy Optical Properties                                  RAD_ALL.17386 
     &      , KE_GREY_TOT_CLOUD, K_EXT_SCAT_CLOUD                                  RAD_ALL.17387 
     &      , ASYMMETRY_CLOUD, FORWARD_SCATTER_CLOUD                               RAD_ALL.17388 
!                       Flxues Calculated                                          RAD_ALL.17389 
     &      , FLUX_DIRECT_PART, FLUX_TOTAL_PART                                    RAD_ALL.17390 
!                       Flags for Clear-sky Calculations                           RAD_ALL.17391 
     &      , L_CLEAR, I_SOLVER_CLEAR                                              RAD_ALL.17392 
!                       Clear-sky Fluxes Calculated                                RAD_ALL.17393 
     &      , FLUX_DIRECT_CLEAR_PART, FLUX_TOTAL_CLEAR_PART                        RAD_ALL.17394 
!                       Planckian Function                                         RAD_ALL.17395 
     &      , PLANCK_SOURCE_BAND                                                   RAD_ALL.17396 
!                       Dimensions of Arrays                                       RAD_ALL.17397 
     &      , NPD_PROFILE, NPD_LAYER, NPD_COLUMN                                   RAD_ALL.17398 
     &      )                                                                      RAD_ALL.17399 
         IF (IERR.NE.I_NORMAL) RETURN                                              RAD_ALL.17400 
!                                                                                  RAD_ALL.17401 
!        INCREMENT THE FLUXES WITHIN THE BAND.                                     RAD_ALL.17402 
         CALL AUGMENT_FLUX(N_PROFILE, N_LAYER, N_AUGMENT                           RAD_ALL.17403 
     &      , ISOLIR, L_CLEAR                                                      RAD_ALL.17404 
     &      , ESFT_WEIGHT                                                          RAD_ALL.17405 
     &      , FLUX_DIRECT_BAND, FLUX_TOTAL_BAND                                    RAD_ALL.17406 
     &      , FLUX_DIRECT_PART, FLUX_TOTAL_PART                                    RAD_ALL.17407 
     &      , FLUX_DIRECT_CLEAR_BAND, FLUX_TOTAL_CLEAR_BAND                        RAD_ALL.17408 
     &      , FLUX_DIRECT_CLEAR_PART, FLUX_TOTAL_CLEAR_PART                        RAD_ALL.17409 
     &      , NPD_PROFILE, NPD_LAYER                                               RAD_ALL.17410 
     &      )                                                                      RAD_ALL.17411 
      ENDDO                                                                        RAD_ALL.17412 
!                                                                                  RAD_ALL.17413 
!                                                                                  RAD_ALL.17414 
      RETURN                                                                       RAD_ALL.17415 
      END       
