!+ Subroutine to calculate radiative fluxes.
!
! Method:
!	Properties independent of the spectral bands are set.
!	A loop over bands is then entered. Grey optical properties
!	are set and an appropriate subroutine is called to treat
!	the gaseous overlaps. The final fluxes are assigned.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!	Version		Date			Comment
!	1.0		12-04-95		First Version under RCS
!						(J. M. Edwards)
!
! Description of Code:
!   FORTRAN 77  with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
      SUBROUTINE FLUX_CALC(IERR
!			Logical Flags for Processes
     &   , L_RAYLEIGH, L_AEROSOL, L_GAS, L_CONTINUUM
     &   , L_CLOUD, L_DROP, L_ICE
!			Angular Integration
     &   , I_ANGULAR_INTEGRATION, I_2STREAM, L_2_STREAM_CORRECT
     &   , L_RESCALE, N_ORDER_GAUSS
!			Treatment of Scattering
     &   , I_SCATTER_METHOD, L_SWITCH_SCATTER
!			Options for Solver
     &   , I_SOLVER, I_EXTRAPOLATE_MIX_NET
!			General Spectral Properties
     &   , N_BAND, I_FIRST_BAND, I_LAST_BAND, WEIGHT_BAND
!			General Atmospheric Properties
     &   , N_PROFILE, N_LAYER
     &   , L_LAYER, L_CLOUD_LAYER
     &   , P, T, T_GROUND, T_LEVEL, D_MASS
!			Spectral Region
     &   , ISOLIR
!			Solar Fields
     &   , SEC_0, SOLAR_TOA, SOLAR_FLUX_BAND, RAYLEIGH_COEFFICIENT
!			Infra-red Fields
     &   , N_DEG_FIT, THERMAL_COEFFICIENT, T_REF_PLANCK
     &   , L_IR_SOURCE_QUAD
!			Gaseous Absorption
     &   , N_ABSORB, I_GAS_OVERLAP, I_GAS
     &   , GAS_MIX_RATIO, N_BAND_ABSORB, INDEX_ABSORB
     &   , I_BAND_ESFT, W_ESFT, K_ESFT, I_SCALE_ESFT
     &   , I_SCALE_FNC, SCALE_VECTOR
     &   , P_REFERENCE, T_REFERENCE
!			Doppler Broadening
     &   , L_DOPPLER, DOPPLER_CORRECTION
!			Surface Fields
     &   , L_SURFACE, I_SURFACE, I_SPEC_SURFACE, SURFACE_ALBEDO
     &   , ALBEDO_FIELD_DIFF, ALBEDO_FIELD_DIR
     &   , N_DIR_ALBEDO_FIT, DIRECT_ALBEDO_PARM
     &   , EMISSIVITY_GROUND, EMISSIVITY_FIELD
!			Continuum Absorption
     &   , N_BAND_CONTINUUM, INDEX_CONTINUUM, INDEX_WATER
     &   , K_CONTINUUM, I_SCALE_FNC_CONT, SCALE_CONTINUUM
     &   , P_REF_CONTINUUM, T_REF_CONTINUUM
!			Properties of Aerosols
     &   , N_AEROSOL, AEROSOL_MIX_RATIO
     &   , AEROSOL_ABSORPTION, AEROSOL_SCATTERING, AEROSOL_ASYMMETRY
     &   , I_AEROSOL_PARAMETRIZATION, NHUMIDITY, HUMIDITIES
     &   , N_AEROSOL_DATA_LAYER
     &   , OBS_AEROSOL_PRESSURE, OBS_AEROSOL_ABSORPTION
     &   , OBS_AEROSOL_SCATTERING, OBS_AEROSOL_ASYMMETRY
!			Properties of Clouds
     &   , N_CONDENSED, TYPE_CONDENSED
     &   , I_CLOUD, I_CLOUD_REPRESENTATION, W_CLOUD, FRAC_CLOUD
     &   , CONDENSED_MIX_RATIO, CONDENSED_RE
     &   , I_CONDENSED_PARAM, CONDENSED_PARAM_LIST
     &   , N_LAYER_DROP_DATA, DROP_PRESSURE
     &   , DROP_ABSORPTION, DROP_SCATTERING, DROP_ASYMMETRY
     &   , N_LAYER_ICE_DATA, ICE_PRESSURE
     &   , ICE_ABSORPTION, ICE_SCATTERING
     &   , ICE_ASYMMETRY
!			Fluxes Calculated
     &   , FLUX_DIRECT, FLUX_DOWN, FLUX_UP
!			Options for Clear-sky Fluxes
     &   , L_CLEAR, I_SOLVER_CLEAR
!			Clear-sky Fluxes Calculated
     &   , FLUX_DIRECT_CLEAR, FLUX_DOWN_CLEAR, FLUX_UP_CLEAR
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/dimensions_field.ucf'
      INCLUDE 'incl/dimensions_fixed.pcf'
      INCLUDE 'incl/gas_overlap.pcf'
      INCLUDE 'incl/cloud_scheme.pcf'
      INCLUDE 'incl/cloud_representation.pcf'
      INCLUDE 'incl/cloud_component.pcf'
      INCLUDE 'incl/cloud_type.pcf'
      INCLUDE 'incl/angular_integration.pcf'
      INCLUDE 'incl/solver.pcf'
      INCLUDE 'incl/two_stream_scheme.pcf'
      INCLUDE 'incl/spectral_region.pcf'
      INCLUDE 'incl/aerosol_parametrization.pcf'
      INCLUDE 'incl/esft_scale.pcf'
      INCLUDE 'incl/error.pcf'
!
!
!
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
!
!STR  GENERAL LOGICAL SWITCHES:
      LOGICAL	!, INTENT(IN)
     &     L_LAYER
!             VALUES GIVEN IN LAYERS
     &   , L_CLOUD_LAYER
!             CLOUD VALUES GIVEN IN LAYERS
     &   , L_CLEAR
!             CALCULATE CLEAR-SKY FLUXES
     &   , L_IR_SOURCE_QUAD
!             USE A QUADRATIC SOURCE FUNCTION
     &   , L_RESCALE
!             FLAG FOR DELTA-RESCALING
     &   , L_2_STREAM_CORRECT
!             CORRECTION TO 2-STREAM SCHEME
!
!STR  PARAMETERS CONTROLLING ALGORITHMS:
!     REPRESENTATION OF CLOUDS:
      INTEGER	!, INTENT(IN)
     &     I_CLOUD
!             CLOUD SCHEME USED
!     NUMERICAL ALGORITHMS:
      INTEGER	!, INTENT(IN)
     &     ISOLIR
!             VISIBLE OR IR
     &   , I_SOLVER
!             SOLVER USED
     &   , I_EXTRAPOLATE_MIX_NET
!             METHOD FOR EXTRAPOLATING WITH A MIXED SOLVER
     &   , I_SOLVER_CLEAR
!             CLEAR SOLVER USED
     &   , I_2STREAM
!             TWO-STREAM SCHEME
     &   , I_ANGULAR_INTEGRATION
!             ANGULAR INTEGRATION SCHEME
     &   , N_ORDER_GAUSS
!             ORDER OF GAUSSIAN INTEGRATION
!     RANGE OF SPECTRAL BANDS:
      INTEGER	!, INTENT(IN)
     &     I_FIRST_BAND
!             FIRST BAND
     &   , I_LAST_BAND
!             LAST BAND
!
!     GENERAL PROPERTIES OF SPECTRUM:
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF SPECTRAL BANDS
     &   , N_ABSORB
!             NUMBER OF ABSORBERS
     &   , N_AEROSOL
!             NUMBER OF AEROSOL SPECIES
!
!STR  SOLAR FIELDS:
      REAL*8	!, INTENT(IN)
     &     SOLAR_TOA(NPD_PROFILE)
!             INCIDENT SOLAR RADIATION
     &   , SOLAR_FLUX_BAND(NPD_BAND)
!             NORMALIZED FLUX IN BAND
     &   , SEC_0(NPD_PROFILE)
!             SECANT OF ZENITH ANGLE
!
!STR  ATMOSPHERIC PROFILES:
      INTEGER	!, INTENT(IN)
     &     N_PROFILE
!             NUMBER OF PROFILES
     &   , N_LAYER
!             NUMBER OF LAYERS
      REAL*8	!, INTENT(IN)
     &     P(NPD_PROFILE, 0: NPD_LAYER)
!             PRESSURE
     &   , T(NPD_PROFILE, 0: NPD_LAYER)
!             TEMPERATURE
     &   , T_GROUND(NPD_PROFILE)
!             TEMPERATURE OF GROUND
     &   , T_LEVEL(NPD_PROFILE, 0: NPD_LAYER)
!             TEMPERATURE ON LEVELS
     &   , D_MASS(NPD_PROFILE, NPD_LAYER)
!             MASS THICKNESS OF EACH LAYER
     &   , GAS_MIX_RATIO(NPD_PROFILE, 0: NPD_LAYER, NPD_SPECIES)
!             GASEOUS MASS MIXING RATIOS
!
!STR  SURFACE PROPERTIES:
      LOGICAL	!, INTENT(IN)
     &     L_SURFACE(NPD_SURFACE)
!             TYPES OF SURFACES FOR WHICH DATA ARE PRESENT
      INTEGER	!, INTENT(IN)
     &     I_SURFACE(NPD_PROFILE)
!             TYPE OF SURFACE AT THE FOOT OF EACH PROFILE
     &   , I_SPEC_SURFACE(NPD_SURFACE)
!             METHOD OF SPECIFYING ALBEDO
     &   , N_DIR_ALBEDO_FIT(NPD_SURFACE)
!             NUMBER OF PARAMETERS IN FIT TO DIRECT ALBEDO
      REAL*8	!, INTENT(IN)
     &     SURFACE_ALBEDO(NPD_BAND, NPD_SURFACE)
!             SURFACE ALBEDO
     &   , ALBEDO_FIELD_DIFF(NPD_PROFILE, NPD_BAND)
!             SPECIFIED DIFFUSE ALBEDOS
     &   , ALBEDO_FIELD_DIR(NPD_PROFILE, NPD_BAND)
!             SPECIFIED DIRECT ALBEDOS
     &   , DIRECT_ALBEDO_PARM(0: NPD_ALBEDO_PARM, NPD_BAND, NPD_SURFACE)
!             COEFFICIENTS FOR DIRECT ALBEDOS
     &   , EMISSIVITY_GROUND(NPD_BAND, NPD_SURFACE)
!             SURFACE EMISSIVITIES
     &   , EMISSIVITY_FIELD(NPD_PROFILE, NPD_BAND)
!             SPECIFIED EMISSIVITIES
!
!STR  RAYLEIGH SCATTERING:
      LOGICAL	!, INTENT(IN)
     &     L_RAYLEIGH
!             INCLUDE RAYLEIGH SCATTERING IN THE CALCULATION.
      REAL*8	!, INTENT(IN)
     &     RAYLEIGH_COEFFICIENT(NPD_BAND)
!             RAYLEIGH COEFFICIENTS
!
!STR  FIELDS FOR GASEOUS ABSORPTION:
      LOGICAL	!, INTENT(IN)
     &     L_GAS
!             INCLUDE GAS ABSORPTION IN THE CALCULATION
!     GASEOUS OVERLAPS:
      INTEGER	!, INTENT(IN)
     &     I_GAS_OVERLAP(NPD_BAND)
!             GAS OVERLAP ASSUMPTION
     &   , I_GAS
!             GAS TO BE CONSIDERED (ONE GAS ONLY)
!     ESFTS:
      INTEGER	!, INTENT(IN)
     &     N_BAND_ABSORB(NPD_BAND)
!             NUMBER OF ABSORBERS IN BAND
     &   , INDEX_ABSORB(NPD_SPECIES, NPD_BAND)
!             LIST OF ABSORBERS IN BANDS
     &   , I_BAND_ESFT(NPD_BAND, NPD_SPECIES)
!             NUMBER OF TERMS IN BAND
     &   , I_SCALE_ESFT(NPD_BAND, NPD_SPECIES)
!             TYPE OF ESFT SCALING
     &   , I_SCALE_FNC(NPD_BAND, NPD_SPECIES)
!             TYPE OF SCALING FUNCTION
      REAL*8	!, INTENT(IN)
     &     W_ESFT(NPD_ESFT_TERM, NPD_BAND, NPD_SPECIES)
!             WEIGHTS FOR ESFT
     &   , K_ESFT(NPD_ESFT_TERM, NPD_BAND, NPD_SPECIES)
!             EXPONENTIAL ESFT TERMS
     &   , SCALE_VECTOR(NPD_SCALE_VARIABLE, NPD_ESFT_TERM, NPD_BAND
     &        , NPD_SPECIES)
!             ABSORBER SCALING PARAMETERS
     &   , P_REFERENCE(NPD_SPECIES, NPD_BAND)
!             REFERENCE SCALING PRESSURE
     &   , T_REFERENCE(NPD_SPECIES, NPD_BAND)
!             REFERENCE SCALING TEMPERATURE
!
!STR  SPECTRAL DATA FOR THE CONTINUUM:
      LOGICAL	!, INTENT(IN)
     &     L_CONTINUUM
!             INCLUDE CONTINUUM ABSORPTION IN THE CALCULATION
      INTEGER	!, INTENT(IN)
     &     N_BAND_CONTINUUM(NPD_BAND)
!             NUMBER OF CONTINUA IN BANDS
     &   , INDEX_CONTINUUM(NPD_BAND, NPD_CONTINUUM)
!             INDICES OF CONTINUA
     &   , INDEX_WATER
!             INDEX OF WATER
     &   , I_SCALE_FNC_CONT(NPD_BAND, NPD_CONTINUUM)
!             TYPE OF SCALING FUNCTION FOR CONTINUUM
      REAL*8	!, INTENT(IN)
     &     K_CONTINUUM(NPD_BAND, NPD_CONTINUUM)
!             CONTINUUM EXTINCTION COEFFICIENTS
     &   , SCALE_CONTINUUM(NPD_SCALE_VARIABLE, NPD_BAND, NPD_CONTINUUM)
!             CONTINUUM SCALING PARAMETERS
     &   , P_REF_CONTINUUM(NPD_CONTINUUM, NPD_BAND)
!             CONTINUUM REFERENCE PRESSURE
     &   , T_REF_CONTINUUM(NPD_CONTINUUM, NPD_BAND)
!             CONTINUUM REFERENCE TEMPERATURE
!
!
!STR  GENERAL CLOUD FIELDS:
      LOGICAL	!, INTENT(IN)
     &     L_CLOUD
!             CLOUDS ARE REQUIRED IN THE CALCULATION
      REAL*8	!, INTENT(IN)
     &     W_CLOUD(NPD_PROFILE, NPD_LAYER)
!             AMOUNT OF CLOUD
     &   , FRAC_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)
!             FRACTIONS OF DIFFERENT TYPES OF CLOUD
!
!STR  FIELDS FOR MICROPHYSICAL QUANTITIES:
!
      LOGICAL	!, INTENT(IN)
     &     L_DROP
!             INCLUDE DROPLETS IN THE CALCULATION
     &   , L_ICE
!             INCLUDE ICE IN THE CALCULATION
      INTEGER	!, INTENT(IN)
     &     N_CONDENSED
!             NUMBER OF CONDENSED COMPONENTS IN CLOUDS
     &   , TYPE_CONDENSED(NPD_CLOUD_COMPONENT)
!             TYPES OF CONDENSED COMPONENTS
     &   , I_CONDENSED_PARAM(NPD_CLOUD_COMPONENT)
!             PARAMETRIZATION SCHEMES FOR COMPONENTS
     &   , I_CLOUD_REPRESENTATION
!             REPRESENTATION OF MIXING RULE CHOSEN
!    
      REAL*8	!, INTENT(IN)
     &     CONDENSED_MIX_RATIO(NPD_PROFILE, 0: NPD_LAYER
     &        , NPD_CLOUD_COMPONENT)
!             MIXING RATIOS OF CONDENSED COMPONENTS
     &   , CONDENSED_RE(NPD_PROFILE, 0: NPD_LAYER
     &        , NPD_CLOUD_COMPONENT)
!             EFFECTIVE RADII OF CONDENSED COMPONENTS
     &   , CONDENSED_PARAM_LIST(NPD_CLOUD_PARAMETER
     &        , NPD_CLOUD_COMPONENT, NPD_BAND)
!             COEFFICIENTS IN PARAMETRIZATIONS OF CONDENSED PHASES
!
!
!     FIELDS FOR OBSERVATIONAL DISTRIBUTIONS OF WATER CLOUDS:
      INTEGER	!, INTENT(IN)
     &     N_LAYER_DROP_DATA
!             NUMBER OF WATER CLOUD DATA LAYERS
      REAL*8	!, INTENT(IN)
     &     DROP_PRESSURE(0: NPD_CLOUD_DATA_LAYER)
!             PRESSURE AT CLOUD DATA LEVELS
     &   , DROP_ABSORPTION(0: NPD_CLOUD_DATA_LAYER, NPD_BAND)
!             CLOUD ABSORPTION
     &   , DROP_SCATTERING(0: NPD_CLOUD_DATA_LAYER, NPD_BAND)
!             CLOUD SCATTERING
     &   , DROP_ASYMMETRY(0: NPD_CLOUD_DATA_LAYER, NPD_BAND)
!             CLOUD ASYMMETRY
!
!     FIELDS FOR OBSERVATIONAL DISTRIBUTIONS OF ICE CLOUDS:
      INTEGER	!, INTENT(IN)
     &     N_LAYER_ICE_DATA
!             NUMBER OF ICE CLOUD DATA LAYERS
      REAL*8	!, INTENT(IN)
     &     ICE_PRESSURE(0: NPD_CLOUD_DATA_LAYER)
!             PRESSURE AT ICE CLOUD DATA LEVELS
     &   , ICE_ABSORPTION(0: NPD_CLOUD_DATA_LAYER, NPD_BAND)
!             ICE CLOUD ABSORPTION
     &   , ICE_SCATTERING(0: NPD_CLOUD_DATA_LAYER, NPD_BAND)
!             ICE CLOUD SCATTERING
     &   , ICE_ASYMMETRY(0: NPD_CLOUD_DATA_LAYER, NPD_BAND)
!             ICE CLOUD ASYMMETRY
!
!
!STR  FIELDS FOR AEROSOLS:
      LOGICAL	!, INTENT(IN)
     &     L_AEROSOL
!             INCLUDE AEROSOLS IN THE CALCULATION
      INTEGER	!, INTENT(IN)
     &     I_AEROSOL_PARAMETRIZATION(NPD_AEROSOL_SPECIES)
!             PARAMETRIZATION FLAGS FOR AEROSOL
      INTEGER	!, INTENT(IN)
     &     NHUMIDITY(NPD_AEROSOL_SPECIES)
!             NUMBER OF HUMIDITIES
      REAL*8	!, INTENT(IN)
     &     AEROSOL_MIX_RATIO(NPD_PROFILE, 0: NPD_LAYER
     &        , NPD_AEROSOL_SPECIES)
!             NUMBER DENSITY OF AEROSOLS
      REAL*8	!, INTENT(IN)
     &     AEROSOL_ABSORPTION(NPD_HUMIDITIES, NPD_AEROSOL_SPECIES
     &        , NPD_BAND)
!             ABSORPTION BY AEROSOLS
     &   , AEROSOL_SCATTERING(NPD_HUMIDITIES, NPD_AEROSOL_SPECIES
     &        , NPD_BAND)
!             SCATTERING BY AEROSOLS
     &   , AEROSOL_ASYMMETRY(NPD_HUMIDITIES, NPD_AEROSOL_SPECIES
     &        , NPD_BAND)
!             ASYMMETRY BY AEROSOLS
     &   , HUMIDITIES(NPD_HUMIDITIES, NPD_AEROSOL_SPECIES)
!             HUMIDITIES FOR SPECIES
!
      INTEGER	!, INTENT(IN)
     &     N_AEROSOL_DATA_LAYER(NPD_AEROSOL_SPECIES)
!             NUMBER OF LAYERS OF AEROSOL DATA
      REAL*8	!, INTENT(IN)
     &     OBS_AEROSOL_PRESSURE(0: NPD_AEROSOL_DATA_LAYER
     &        , NPD_AEROSOL_SPECIES)
!             PRESSURE AT AEROSOL DATA LEVELS
     &   , OBS_AEROSOL_ABSORPTION(0: NPD_AEROSOL_DATA_LAYER
     &        , NPD_AEROSOL_SPECIES, NPD_BAND)
!             AEROSOL ABSORPTION
     &   , OBS_AEROSOL_SCATTERING(0: NPD_AEROSOL_DATA_LAYER
     &        , NPD_AEROSOL_SPECIES, NPD_BAND)
!             AEROSOL SCATTERING
     &   , OBS_AEROSOL_ASYMMETRY(0: NPD_AEROSOL_DATA_LAYER
     &        , NPD_AEROSOL_SPECIES, NPD_BAND)
!             AEROSOL ASYMMETRY
!
!STR  FITTING OF THE PLANCKIAN FUNCTION:
      INTEGER	!, INTENT(IN)
     &     N_DEG_FIT
!             DEGREE OF THERMAL FITTING FNC.
      REAL*8	!, INTENT(IN)
     &     THERMAL_COEFFICIENT(0: NPD_THERMAL_COEFF-1, NPD_BAND)
!             COEFFICIENTS OF SOURCE TERMS
     &   , T_REF_PLANCK
!             PLANCKIAN REFERENCE TEMPERATURE
!
!STR  DOPPLER BROADENING
      LOGICAL	!, INTENT(IN)
     &     L_DOPPLER(NPD_SPECIES)
!             FLAGS TO ACTIVATE DOPPLER CORRECTIONS
      REAL*8	!, INTENT(IN)
     &     DOPPLER_CORRECTION(NPD_SPECIES)
!             DOPPLER BROADENING TERM
      REAL*8	!, INTENT(OUT)
     &     WEIGHT_BAND(NPD_BAND)
!             WEIGHTING FUNCTION FOR BANDS
!
!STR  CONTROL OF SCATTERING:
      INTEGER	!, INTENT(IN)
     &     I_SCATTER_METHOD
!             METHOD OF TREATING SCATTERING
      LOGICAL	!, INTENT(IN)
     &     L_SWITCH_SCATTER(NPD_BAND)
!             SWITCHES FOR SCATTERING IN BANDS
!
!
!STR  FLUXES CALCULATED:
      REAL*8	!, INTENT(OUT)
     &     FLUX_DIRECT(NPD_PROFILE, 0: NPD_LAYER)
!             DIRECT FLUX
     &   , FLUX_DOWN(NPD_PROFILE, 0: NPD_LAYER)
!             DOWNWARD FLUX
     &   , FLUX_UP(NPD_PROFILE, 0: NPD_LAYER)
!             UPWARD FLUX
     &   , FLUX_DIRECT_CLEAR(NPD_PROFILE, 0: NPD_LAYER)
!             CLEAR DIRECT FLUX
     &   , FLUX_DOWN_CLEAR(NPD_PROFILE, 0: NPD_LAYER)
!             CLEAR DOWNWARD FLUX
     &   , FLUX_UP_CLEAR(NPD_PROFILE, 0: NPD_LAYER)
!             CLEAR UPWARD FLUX
!
!
!
!     LOCAL ARGUMENTS.
!     GENERAL POINTERS:
      INTEGER
     &     I_TOP
!             TOP LEVEL OF PROFILES
     &   , I_BAND
!             SPECTRAL BAND
     &   , N_AUGMENT
!             LENGTH OF LONG FLUX VECTOR
     &   , N_GAS
!             NUMBER OF ACTIVE GASES
     &   , I_GAS_BAND
!             SINGLE VARIABLE FOR GAS IN BAND
     &   , N_CONTINUUM
!             NUMBER OF CONTINUA IN BAND
     &   , I_CONTINUUM
!             CONTINUUM NUMBER
     &   , I_CONTINUUM_POINTER(NPD_CONTINUUM)
!             POINTERS TO CONTINUA
     &   , I_POINTER_WATER
!             POINTER TO WATER VAPOUR
!
!     SCATTERING IN INDIVIDUAL BANDS
      INTEGER
     &     I_SCATTER_METHOD_BAND
!             METHOD OF TREATING SCATTERING IN GIVEN BAND
!
!     VARIABLES FOR SURFACE PROPERTIES:
      INTEGER
     &     N_POINT_TYPE(NPD_SURFACE)
!             NUMBER OF POINTS OF EACH TYPE
     &   , INDEX_SURFACE(NPD_PROFILE, NPD_SURFACE)
!             INDICES OF EACH SURFACE TYPE
!
!     POINTERS TO THE CONTENTS OF LAYERS:
      INTEGER
     &     N_FREE_PROFILE(NPD_LAYER)
!             NUMBER OF FREE PROFILES
     &   , I_FREE_PROFILE(NPD_PROFILE, NPD_LAYER)
!             COLUMNS CONTAINING FREE PROFILES
     &   , N_CLOUD_TOP
!             TOPMOST CLOUDY LAYER
     &   , N_CLOUD_PROFILE(NPD_LAYER)
!             NUMBER OF CLOUDY PROFILES
     &   , I_CLOUD_PROFILE(NPD_PROFILE, NPD_LAYER)
!             PROFILES CONTAINING CLOUDS
!
!     POINTERS TO TYPES OF CLOUDS:
      LOGICAL
     &     L_CLOUD_CMP(NPD_CLOUD_COMPONENT)
!             LOGICAL SWITCHES TO INCLUDE COMPONENTS
      INTEGER
     &     I_PHASE_CMP(NPD_CLOUD_COMPONENT)
!             PHASES OF COMPONENTS
     &   , I_CLOUD_TYPE(NPD_CLOUD_COMPONENT)
!             TYPES OF CLOUD TO WHICH EACH COMPONENT CONTRIBUTES
     &   , I_REGION_CLOUD(NPD_CLOUD_TYPE)
!             REGIONS IN WHICH PARTICULAR TYPE OF CLOUD FALL
!
!     FRACTIONAL COVERAGE OF DIFFERENT REGIONS:
      REAL*8
     &     FRAC_REGION(NPD_PROFILE, NPD_LAYER, NPD_REGION)
!             FRACTION OF TOTAL CLOUD OCCUPIED BY SPECIFIC REGIONS
!
!     POINTER TO TABLE OF HUMIDITY:
      INTEGER
     &     I_HUMIDITY_POINTER(NPD_PROFILE, NPD_LAYER)
!             POINTER TO LOOK-UP TABLE FOR AEROSOLS
!
!     CONTROLLING VARIABLES:
      INTEGER
     &     I
!             LOOP INDEX
     &   , J
!             LOOP INDEX
     &   , K
!             LOOP INDEX
     &   , L
!             LOOP INDEX
!
!     LOGICAL SWITCHES:
      LOGICAL
     &     L_GAS_BAND
!             FLAG TO INCLUDE GASEOUS ABSORPTION IN A PARTICULAR BAND
     &   , L_MOIST_AEROSOL
!             FLAG FOR MOIST AEROSOL
     &   , L_AEROSOL_DENSITY
!             FLAG FOR CALCULATION OF ATMOSPHERIC DENSITY FOR AEROSOLS
     &   , L_NET
!             FLAG FOR NET FLUXES
!
!     SURFACE PROPERTIES:
      REAL*8
     &     ALBEDO_SURFACE_DIFF(NPD_PROFILE)
!             DIFFUSE SURFACE ALBEDO
     &   , ALBEDO_SURFACE_DIR(NPD_PROFILE)
!             DIRECT SURFACE ALBEDO
!
      REAL*8
     &     INC_SOLAR_FLUX_BAND(NPD_PROFILE)
!             INCIDENT SOLAR FLUX IN BAND
      REAL*8
     &     GAS_FRAC_RESCALED(NPD_PROFILE, 0: NPD_LAYER, NPD_SPECIES)
!             RESCALED GAS MIXING RATIOS
     &   , AMOUNT_CONTINUUM(NPD_PROFILE, 0: NPD_LAYER
     &        , 0: NPD_CONTINUUM)
!             AMOUNTS OF CONTINUA
     &   , K_CONTINUUM_MONO(NPD_CONTINUUM)
!             MONOCHROMATIC CONTINUUM COMPONENTS
!
!     THERMAL ARRAYS:
      REAL*8
     &     PLANCK_SOURCE_BAND(NPD_PROFILE, 0: NPD_LAYER)
!             PLANCK FUNCTION IN BAND AT LEVELS
     &   , DIFF_PLANCK_BAND(NPD_PROFILE, NPD_LAYER)
!             DIFFERENTIAL THERMAL SOURCE IN BAND
     &   , DIFF_PLANCK_BAND_2(NPD_PROFILE, NPD_LAYER)
!             2 x 2ND DIFF. THERMAL SOURCE IN BAND
     &   , THERMAL_GROUND_BAND(NPD_PROFILE)
!             GROUND SOURCE FUNCTION IN BAND
!
!     ATMOSPHERIC DENSITIES:
      REAL*8
     &     DENSITY(NPD_PROFILE, 0: NPD_LAYER)
!             OVERALL DENSITY
     &   , MOLAR_DENSITY_WATER(NPD_PROFILE, 0: NPD_LAYER)
!             MOLAR DENSITY OF WATER
     &   , MOLAR_DENSITY_FRN(NPD_PROFILE, 0: NPD_LAYER)
!             MOLAR DENSITY OF FOREIGN SPECIES
!
!     FIELDS FOR MOIST AEROSOLS:
      REAL*8
     &     DELTA_HUMIDITY
!             INCREMENT IN LOOK-UP TABLE FOR HUM.
     &   , MEAN_REL_HUMIDITY(NPD_PROFILE, NPD_LAYER)
!             MEAN RELATIVE HUMIDITY OF LAYERS
!
!     FUNDAMENTAL OPTICAL PROPERTIES OF LAYERS:
      REAL*8
     &     K_GREY_TOT_FREE(NPD_PROFILE, NPD_LAYER)
!             FREE TOTAL GREY EXTINCTION
     &   , K_EXT_SCAT_FREE(NPD_PROFILE, NPD_LAYER)
!             FREE SCATTERING EXTINCTION
     &   , ASYMMETRY_FREE(NPD_PROFILE, NPD_LAYER)
!             FREE ASYMMETRIES
     &   , FORWARD_SCATTER_FREE(NPD_PROFILE, NPD_LAYER)
!             FREE FORWARD SCATTERING
     &   , K_GREY_TOT_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)
!             TOTAL CLOUDY GREY EXTINCTION
     &   , K_EXT_SCAT_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)
!             CLOUDY SCATTERING EXTINCTION
     &   , ASYMMETRY_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)
!             CLOUDY ASYMMETRIES
     &   , FORWARD_SCATTER_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)
!             CLOUDY FORWARD SCATTERING
!
!     LOCAL RADIATIVE FLUXES:
      REAL*8
     &     FLUX_TOTAL(NPD_PROFILE, 2*NPD_LAYER+2)
!             TOTAL FLUX
     &   , FLUX_TOTAL_CLEAR(NPD_PROFILE, 2*NPD_LAYER+2)
!             CLEAR TOTAL FLUX
     &   , FLUX_DIRECT_BAND(NPD_PROFILE, 0: NPD_LAYER)
!             DIRECT FLUX IN BAND
     &   , FLUX_TOTAL_BAND(NPD_PROFILE, 2*NPD_LAYER+2)
!             TOTAL FLUX IN BAND
     &   , FLUX_DIRECT_CLEAR_BAND(NPD_PROFILE, 0: NPD_LAYER)
!             DIRECT FLUX IN BAND
     &   , FLUX_TOTAL_CLEAR_BAND(NPD_PROFILE, 2*NPD_LAYER+2)
!             TOTAL FLUX IN BAND
     &   , PLANCK_FLUX(NPD_PROFILE, 0: NPD_LAYER)
!             PLANCKIAN FLUX IN BAND
!
!     COEFFICIENTS FOR THE TRANSFER OF ENERGY BETWEEN
!     PARTIALLY CLOUDY LAYERS:
      REAL*8
     &     CLOUD_OVERLAP(NPD_PROFILE, 0: NPD_LAYER, NPD_OVERLAP_COEFF)
!             COEFFICIENTS DEFINING OVERLAPPING OPTIONS FOR CLOUDS:
!             THESE ALSO DEPEND ON THE SOLVER SELECTED.
     &   , W_FREE(NPD_PROFILE, NPD_LAYER)
!             CLEAR-SKY FRACTION
      INTEGER
     &     N_COLUMN(NPD_PROFILE)
!             NUMBER OF COLUMNS REQUIRED
      LOGICAL
     &     L_COLUMN(NPD_PROFILE, NPD_LAYER, NPD_COLUMN)
!             COLUMN FLAGS FOR COLUMNS
      REAL*8
     &     AREA_COLUMN(NPD_PROFILE, NPD_COLUMN)
!             AREAS OF COLUMNS

! EJH fields for band by band fluxes
      real*8
     &     el_DIRECT(NPD_PROFILE, 0: NPD_LAYER)
!             DIRECT FLUX IN BAND
     &   , el_TOTAL(NPD_PROFILE, 2*NPD_LAYER+2)
!             TOTAL FLUX IN BAND
     &   , el_DIRECT_CLEAR(NPD_PROFILE, 0: NPD_LAYER)
!             DIRECT FLUX IN BAND
     &   , el_TOTAL_CLEAR(NPD_PROFILE, 2*NPD_LAYER+2)
!             TOTAL FLUX IN BAND
     &   , eflux_up(NPD_PROFILE, 2*NPD_LAYER+2)
!             TOTAL FLUX IN BAND
     &   , eflux_down(NPD_PROFILE, 0: NPD_LAYER)
!             DIRECT FLUX IN BAND
     &   , eflux_up_clear(NPD_PROFILE, 2*NPD_LAYER+2)
!             TOTAL FLUX IN BAND
     &   , eflux_down_clear(NPD_PROFILE, 0: NPD_LAYER)
!             DIRECT FLUX IN BAND

!
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     SET_CLOUD_POINTER, SET_CLOUD_GEOMETRY, SET_SCATTERING
     &   , OVERLAP_MIX_MAXIMUM, OVERLAP_MIX_RANDOM
     &   , SPLIT_MAXIMUM, COLLECT_SURFACE, INITIALIZE_FLUX
     &   , CALCULATE_DENSITY, SET_MOIST_AEROSOL_PROPERTIES
     &   , SCALE_ABSORB, RESCALE_CONTINUUM, GREY_EXTINCTION
     &   , RESCALE_ASYMMETRY
     &   , DIFF_PLANCK_SOURCE, SET_SURFACE_PROPERTIES
     &   , SOLVE_BAND_WITHOUT_GAS, SOLVE_BAND_ONE_GAS
     &   , SOLVE_BAND_RANDOM_OVERLAP, SOLVE_BAND_FESFT
     &   , SOLVE_BAND_CLR_FESFT, SOLVE_BAND_K_EQV
     &   , AUGMENT_TOTAL_FLUX, ASSIGN_FLUX
     &   , OVERLAP_TRIPLE


!     FUNCTIONS CALLED:
      LOGICAL
     &     L_CLOUD_DENSITY
!             FLAG FOR CALCULATION OF ATMOSPHERIC DENSITIES FOR CLOUDS
      EXTERNAL
     &     L_CLOUD_DENSITY
!
!
!     SETTING OF PROPERTIES OF ARRAYS:
      INCLUDE 'incl/cloud_representation.dcf'
!
!
!
!
!
!     INITIAL DETERMINATION OF FLAGS AND SWITCHES:
!
      IF (I_ANGULAR_INTEGRATION.EQ.IP_TWO_STREAM) THEN
!
!        SET THE FLAG FOR NET FLUXES.
         IF ( (I_SOLVER.EQ.IP_SOLVER_TRIDIAG_NET).OR.
     &        (I_SOLVER.EQ.IP_SOLVER_MIX_NET_APP_SCAT).OR.
     &        (I_SOLVER.EQ.IP_SOLVER_MIX_DIRECT_NET).OR.
     &        (I_SOLVER.EQ.IP_SOLVER_MIX_NET) ) THEN
            L_NET=.TRUE.
         ELSE
            L_NET=.FALSE.
         ENDIF
!
      ELSE IF (I_ANGULAR_INTEGRATION.EQ.IP_IR_GAUSS) THEN
!
         L_NET=.FALSE.
!
      ENDIF
!
!     THE LENGTH OF THE LONG FLUX VECTOR DEPENDS ON WHETHER WE SOLVE
!     FOR THE FULL OR THE NET FLUX.
      IF (L_NET) THEN
         N_AUGMENT=N_LAYER+1
      ELSE
         N_AUGMENT=2*(N_LAYER+1)
      ENDIF
!
!     SET THE TOP LEVEL OF THE PROFILES.
      IF (L_LAYER) THEN
         I_TOP=1
      ELSE
         I_TOP=0
      ENDIF
!
!
!
!     INITIAL CALCULATIONS FOR SURFACE PROPERTIES:
!
!     COLLECT POINTS WITH THE SAME SURFACE SPECIFICATION.
      CALL COLLECT_SURFACE(N_PROFILE
     &   , I_SURFACE
     &   , N_POINT_TYPE, INDEX_SURFACE
     &   )
!
!
!
!     INITIAL CALCULATIONS FOR AEROSOLS:
!
!     SET THE SPECTRALLY INDEPENDENT PROPERTIES OF MOIST AEROSOLS.
      L_MOIST_AEROSOL=.FALSE.
      DO J=1, N_AEROSOL
         L_MOIST_AEROSOL=L_MOIST_AEROSOL.OR.
     &      (I_AEROSOL_PARAMETRIZATION(J)
     &      .EQ.IP_AEROSOL_PARAM_MOIST)
      ENDDO
!
      IF (L_MOIST_AEROSOL) THEN
         CALL SET_MOIST_AEROSOL_PROPERTIES(N_PROFILE, N_LAYER, L_LAYER
     &      , N_AEROSOL, I_AEROSOL_PARAMETRIZATION, NHUMIDITY
     &      , GAS_MIX_RATIO(1, 0, INDEX_WATER), T, P, DELTA_HUMIDITY
     &      , MEAN_REL_HUMIDITY, I_HUMIDITY_POINTER
     &      )
      ENDIF
!
!
!     CHECK WHETHER THE DENSITIES WILL BE NEEDED FOR 
!     UNPARAMETRIZED AEROSOLS.
      IF (L_AEROSOL) THEN
         L_AEROSOL_DENSITY=.FALSE.
         DO J=1, N_AEROSOL
            L_AEROSOL_DENSITY=L_AEROSOL_DENSITY.OR.
     &         (I_AEROSOL_PARAMETRIZATION(J).EQ.
     &            IP_AEROSOL_PARAM_MOIST)
         ENDDO
      ENDIF
!
!
!
!     INITIAL CALCULATIONS FOR CLOUDS:
!
!     SET POINTERS TO THE TYPES OF CLOUD.
      CALL SET_CLOUD_POINTER(IERR
     &   , N_CONDENSED, TYPE_CONDENSED, I_CLOUD_REPRESENTATION
     &   , L_DROP, L_ICE
     &   , I_PHASE_CMP, I_CLOUD_TYPE, L_CLOUD_CMP
     &   )
      IF (IERR.NE.I_NORMAL) RETURN
!
!
!     SET THE GEOMETRY OF THE CLOUDS.
      CALL SET_CLOUD_GEOMETRY(N_PROFILE, N_LAYER
     &   , W_CLOUD
     &   , N_CLOUD_PROFILE, I_CLOUD_PROFILE
     &   , N_CLOUD_TOP
     &   , N_FREE_PROFILE, I_FREE_PROFILE
     &   )
!
      IF (I_CLOUD.EQ.IP_CLOUD_TRIPLE) THEN
!        AGGREGATE CLOUDS INTO REGIONS FOR SOLVING.
         CALL AGGREGATE_CLOUD(IERR
     &      , N_PROFILE, N_LAYER, N_CLOUD_TOP
     &      , I_CLOUD, I_CLOUD_REPRESENTATION
     &      , NP_CLOUD_TYPE(I_CLOUD_REPRESENTATION)
     &      , FRAC_CLOUD
     &      , I_REGION_CLOUD, FRAC_REGION
     &      )
      ENDIF
!
!     CALCULATE ENERGY TRANSFER COEFFICIENTS IN A MIXED COLUMN,
!     OR SPLIT THE ATMOSPHERE INTO COLUMNS WITH A COLUMN MODEL:
!
      IF (I_CLOUD.EQ.IP_CLOUD_MIX_MAX) THEN
!
         CALL OVERLAP_MIX_MAXIMUM(N_PROFILE, N_LAYER, N_CLOUD_TOP
     &      , ISOLIR, I_SOLVER
     &      , W_CLOUD, W_FREE
     &      , CLOUD_OVERLAP
     &      )
      ELSE IF (I_CLOUD.EQ.IP_CLOUD_MIX_RANDOM) THEN
         CALL OVERLAP_MIX_RANDOM(N_PROFILE, N_LAYER, N_CLOUD_TOP
     &      , ISOLIR, I_SOLVER
     &      , W_CLOUD, W_FREE
     &      , CLOUD_OVERLAP
     &      )
!
      ELSE IF (I_CLOUD.EQ.IP_CLOUD_TRIPLE) THEN
!
!        CALCULATE OVERLAPS FOR THE TRIPLE DECOMPOSITION 
!        OF THE COLUMN INTO STRATIFORM AND CONVECTIVE PARTS.
         CALL OVERLAP_TRIPLE(N_PROFILE, N_LAYER, N_CLOUD_TOP
     &      , W_CLOUD, W_FREE, FRAC_REGION
     &      , CLOUD_OVERLAP
     &      )
         IF (IERR.NE.I_NORMAL) RETURN
!
      ELSE IF (I_CLOUD.EQ.IP_CLOUD_COLUMN_MAX) THEN
!
         CALL SPLIT_MAXIMUM(N_PROFILE, N_LAYER
     &      , W_CLOUD
     &      , N_COLUMN, AREA_COLUMN, L_COLUMN
     &      )
      ENDIF
!
!
!     CALCULATE THE ATMOSPHERIC DENSITIES:
!
      IF ( L_CONTINUUM
     &      .OR.L_AEROSOL_DENSITY
     &      .OR.(L_CLOUD
     &      .AND.L_CLOUD_DENSITY(N_CONDENSED, I_PHASE_CMP, L_CLOUD_CMP
     &                        , I_CONDENSED_PARAM
     &                        ) ) ) THEN
!        SET THE POINTER FOR WATER VAPOUR TO A LEGAL VALUE: THIS MUST
!        BE DONE FOR CASES WHERE WATER VAPOUR IS NOT INCLUDED IN THE
!        SPECTRAL FILE, BUT DENSITIES ARE NEEDED FOR AEROSOLS.
         I_POINTER_WATER=MAX(INDEX_WATER, 1)
         CALL CALCULATE_DENSITY(N_PROFILE, N_LAYER, L_CONTINUUM
     &      , GAS_MIX_RATIO(1, 0, I_POINTER_WATER)
     &      , P, T, I_TOP
     &      , DENSITY, MOLAR_DENSITY_WATER, MOLAR_DENSITY_FRN
     &      )
      ENDIF
!
!
!
!     INITIALIZE THE TOTAL FLUXES.
!
      CALL INITIALIZE_FLUX(N_PROFILE, N_LAYER, N_AUGMENT
     &   , ISOLIR
     &   , FLUX_DIRECT, FLUX_TOTAL
     &   , L_CLEAR
     &   , FLUX_DIRECT_CLEAR, FLUX_TOTAL_CLEAR
     &   , 0.0D+00
     &   )
!
!     INITIALIZE THE PLANCKIAN FLUXES IF REQUIRED.
      IF ( (ISOLIR.EQ.IP_INFRA_RED).AND.(.NOT.L_NET) ) THEN
         DO I=0, N_LAYER
            DO L=1, N_PROFILE
               PLANCK_FLUX(L, I)=0.0D+00
            ENDDO
         ENDDO
      ENDIF
!
!
!
!
!
!
!     SOLVE THE EQUATION OF TRANSFER IN EACH BAND AND
!     INCREMENT THE FLUXES.
!
      DO I_BAND=I_FIRST_BAND, I_LAST_BAND
!
!
!        SET THE FLAG FOR THE TREATMENT OF SCATTERING IN THIS BAND
         CALL SET_SCATTERING(I_SCATTER_METHOD
     &      , L_SWITCH_SCATTER(I_BAND)
     &      , I_SCATTER_METHOD_BAND
     &      )
!
!        DETERMINE WHETHER GASEOUS ABSORPTION IS INCLUDED IN THIS BAND.
         IF ( (L_GAS).AND.(N_BAND_ABSORB(I_BAND).GT.0) ) THEN
!
!           NOTE: I_GAS_BAND IS USED EXTENSIVELY BELOW SINCE NESTED 
!           ARRAY ELEMENTS IN A SUBROUTINE CALL (SEE LATER) CAN 
!           CONFUSE SOME COMPILERS.
!
!           NORMALLY THE NUMBER OF GASES IN THE CALCULATION WILL BE 
!           AS IN THE SPECTRAL FILE, BUT PARTICULAR OPTIONS MAY RESULT 
!           IN THE OMISSION OF SOME GASES.
!
            N_GAS=N_BAND_ABSORB(I_BAND)
!
            IF (I_GAS_OVERLAP(I_BAND).EQ.IP_OVERLAP_SINGLE) THEN
!
!              THERE WILL BE NO GASEOUS ABSORPTION IN THIS BAND
!              UNLESS THE SELECTED GAS APPEARS.
               N_GAS=0
!
               DO I=1, N_BAND_ABSORB(I_BAND)
                  IF (INDEX_ABSORB(I, I_BAND).EQ.I_GAS) N_GAS=1
               ENDDO
!
            ENDIF
!
!
            IF (N_GAS.GT.0) THEN
!
!              SET THE FLAG FOR GASEOUS ABSORPTION IN THE BAND.
               L_GAS_BAND=.TRUE.
!
               DO J=1, N_GAS
!
                  I_GAS_BAND=INDEX_ABSORB(J, I_BAND)
!
!                 RESET THE POINTER IF THERE IS JUST ONE GAS.
!
                  IF (I_GAS_OVERLAP(I_BAND).EQ.IP_OVERLAP_SINGLE)
     &               THEN
!                    ONLY THE SELECTED GAS IS ACTIVE IN THE BAND.
                     I_GAS_BAND=I_GAS
!
                  ENDIF
!
                  IF (I_SCALE_ESFT(I_BAND, I_GAS_BAND)
     &               .EQ.IP_SCALE_BAND) THEN
!                    RESCALE THE AMOUNT OF GAS FOR THIS BAND NOW.
                     CALL SCALE_ABSORB(IERR, N_PROFILE, N_LAYER
     &                  , GAS_MIX_RATIO(1, 0, I_GAS_BAND), P, T
     &                  , L_LAYER, I_TOP
     &                  , GAS_FRAC_RESCALED(1, 0, I_GAS_BAND)
     &                  , I_SCALE_FNC(I_BAND, I_GAS_BAND)
     &                  , P_REFERENCE(I_GAS_BAND, I_BAND)
     &                  , T_REFERENCE(I_GAS_BAND, I_BAND)
     &                  , SCALE_VECTOR(1, 1, I_BAND, I_GAS_BAND)
     &                  , L_DOPPLER(I_GAS_BAND)
     &                  , DOPPLER_CORRECTION(I_GAS_BAND)
     &                  )
                     IF (IERR.NE.I_NORMAL) RETURN
!
                  ELSE IF (I_SCALE_ESFT(I_BAND, I_GAS_BAND)
     &               .EQ.IP_SCALE_NULL) THEN
!                    COPY ACROSS THE UNSCALED ARRAY.
                     IF (L_LAYER) THEN
                        DO I=1, N_LAYER
                           DO L=1, N_PROFILE
                              GAS_FRAC_RESCALED(L, I, I_GAS_BAND)
     &                           =GAS_MIX_RATIO(L, I, I_GAS_BAND)
                           ENDDO
                        ENDDO
                     ELSE
                        DO I=0, N_LAYER
                           DO L=1, N_PROFILE
                              GAS_FRAC_RESCALED(L, I, I_GAS_BAND)
     &                           =GAS_MIX_RATIO(L, I, I_GAS_BAND)
                           ENDDO
                        ENDDO
                     ENDIF
                  ENDIF
               ENDDO
            ELSE
               L_GAS_BAND=.FALSE.
            ENDIF
!
         ELSE
            L_GAS_BAND=.FALSE.
         ENDIF
!
!
!
!        RESCALE AMOUNTS OF CONTINUA.
!
         IF (L_CONTINUUM) THEN
            N_CONTINUUM=N_BAND_CONTINUUM(I_BAND)
            DO I=1, N_CONTINUUM
               I_CONTINUUM_POINTER(I)=INDEX_CONTINUUM(I_BAND, I)
               I_CONTINUUM=I_CONTINUUM_POINTER(I)
               K_CONTINUUM_MONO(I_CONTINUUM)
     &            =K_CONTINUUM(I_BAND, I_CONTINUUM)
               CALL RESCALE_CONTINUUM(N_PROFILE, N_LAYER, I_CONTINUUM
     &            , P, T, L_LAYER, I_TOP
     &            , DENSITY, MOLAR_DENSITY_WATER, MOLAR_DENSITY_FRN
     &            , GAS_MIX_RATIO(1, 0, INDEX_WATER)
     &            , AMOUNT_CONTINUUM(1, 0, I_CONTINUUM)
     &            , I_SCALE_FNC_CONT(I_BAND, I_CONTINUUM)
     &            , P_REF_CONTINUUM(I_CONTINUUM, I_BAND)
     &            , T_REF_CONTINUUM(I_CONTINUUM, I_BAND)
     &            , SCALE_CONTINUUM(1, I_BAND, I_CONTINUUM)
     &            )
            ENDDO
         ENDIF
!
!
!
!        CALCULATE THE GREY EXTINCTION WITHIN THE BAND.
!
         CALL GREY_EXTINCTION(IERR
     &      , N_PROFILE, N_LAYER, L_LAYER, P, T, DENSITY
     &      , L_RESCALE
     &      , L_RAYLEIGH, RAYLEIGH_COEFFICIENT(I_BAND)
     &      , L_CONTINUUM, N_CONTINUUM, I_CONTINUUM_POINTER
     &      , K_CONTINUUM_MONO, AMOUNT_CONTINUUM
     &      , L_AEROSOL, N_AEROSOL, AEROSOL_MIX_RATIO
     &      , I_AEROSOL_PARAMETRIZATION
     &      , I_HUMIDITY_POINTER, HUMIDITIES, DELTA_HUMIDITY
     &      , MEAN_REL_HUMIDITY
     &      , AEROSOL_ABSORPTION(1, 1, I_BAND)
     &      , AEROSOL_SCATTERING(1, 1, I_BAND)
     &      , AEROSOL_ASYMMETRY(1, 1, I_BAND)
     &      , N_AEROSOL_DATA_LAYER, OBS_AEROSOL_PRESSURE
     &      , OBS_AEROSOL_ABSORPTION(0, 1, I_BAND)
     &      , OBS_AEROSOL_SCATTERING(0, 1, I_BAND)
     &      , OBS_AEROSOL_ASYMMETRY(0, 1, I_BAND)
     &      , L_CLOUD, N_CLOUD_PROFILE, I_CLOUD_PROFILE, N_CLOUD_TOP
     &      , L_CLOUD_LAYER, I_CLOUD
     &      , N_CONDENSED, L_CLOUD_CMP, I_PHASE_CMP
     &      , I_CONDENSED_PARAM, CONDENSED_PARAM_LIST(1, 1, I_BAND)
     &      , CONDENSED_MIX_RATIO, CONDENSED_RE
     &      , NP_CLOUD_TYPE(I_CLOUD_REPRESENTATION)
     &      , I_CLOUD_TYPE
     &      , N_LAYER_DROP_DATA, DROP_PRESSURE
     &      , DROP_ABSORPTION(0, I_BAND), DROP_SCATTERING(0, I_BAND)
     &      , DROP_ASYMMETRY(0, I_BAND)
     &      , N_LAYER_ICE_DATA, ICE_PRESSURE
     &      , ICE_ABSORPTION(0, I_BAND), ICE_SCATTERING(0, I_BAND)
     &      , ICE_ASYMMETRY(0, I_BAND)
     &      , K_GREY_TOT_FREE, K_EXT_SCAT_FREE, ASYMMETRY_FREE
     &      , FORWARD_SCATTER_FREE
     &      , K_GREY_TOT_CLOUD, K_EXT_SCAT_CLOUD
     &      , ASYMMETRY_CLOUD, FORWARD_SCATTER_CLOUD
     &      )
         IF (IERR.NE.I_NORMAL) RETURN
!
!
!
         IF (I_ANGULAR_INTEGRATION.EQ.IP_TWO_STREAM) THEN
!
!           RESCALE THE ASYMMETRY AND CALCULATE THE SCATTERING
!           FRACTIONS. (THESE ARE GREY AND MAY BE CALCULATED OUTSIDE
!           A LOOP OVER GASES).
!
            IF (L_RESCALE) THEN
!
!              RESCALE FREE ASYMMETRY:
!
               CALL RESCALE_ASYMMETRY(N_PROFILE, 1, N_LAYER
     &            , ASYMMETRY_FREE, FORWARD_SCATTER_FREE
     &            )
!
!
               IF (L_CLOUD) THEN
!
!                 RESCALE CLOUDY ASYMMETRY:
!
                  DO K=1, NP_CLOUD_TYPE(I_CLOUD_REPRESENTATION)
                     CALL RESCALE_ASYMMETRY(N_PROFILE, N_CLOUD_TOP
     &                  , N_LAYER
     &                  , ASYMMETRY_CLOUD(1, 1, K)
     &                  , FORWARD_SCATTER_CLOUD(1, 1, K)
     &                  )
                  ENDDO
!
               ENDIF
!
            ENDIF
!
         ENDIF
!
!
!
!
!        PRELIMINARY CALCULATIONS FOR SOURCE TERMS:
!
         IF (ISOLIR.EQ.IP_SOLAR) THEN
!           CONVERT NORMALIZED BAND FLUXES TO ACTUAL ENERGY FLUXES.
            DO L=1, N_PROFILE
               INC_SOLAR_FLUX_BAND(L)=SOLAR_TOA(L)
     &            *SOLAR_FLUX_BAND(I_BAND)/SEC_0(L)
            ENDDO
!
         ELSE IF (ISOLIR.EQ.IP_INFRA_RED) THEN
!
!           CALCULATE THE CHANGE IN THE THERMAL SOURCE FUNCTION
!           ACROSS EACH LAYER FOR THE INFRA-RED PART OF THE SPECTRUM.
!
            CALL DIFF_PLANCK_SOURCE(N_PROFILE, N_LAYER
     &         , N_DEG_FIT, THERMAL_COEFFICIENT(0, I_BAND)
     &         , T_REF_PLANCK, T_LEVEL, T_GROUND
     &         , PLANCK_SOURCE_BAND, DIFF_PLANCK_BAND
     &         , THERMAL_GROUND_BAND
     &         , L_IR_SOURCE_QUAD, T, DIFF_PLANCK_BAND_2
     &         )
         ENDIF
!
!
!
!
!        SET THE SURFACE PROPERTIES:
!        
         CALL SET_SURFACE_PROPERTIES(N_POINT_TYPE, INDEX_SURFACE
     &      , I_SPEC_SURFACE
     &      , ISOLIR, I_BAND
     &      , SURFACE_ALBEDO
     &      , ALBEDO_FIELD_DIFF(1, I_BAND), ALBEDO_FIELD_DIR(1, I_BAND)
     &      , N_DIR_ALBEDO_FIT, DIRECT_ALBEDO_PARM, SEC_0
     &      , EMISSIVITY_GROUND, EMISSIVITY_FIELD(1, I_BAND)
     &      , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR
     &      , THERMAL_GROUND_BAND
     &      )
!
!
!
!
!
!        CALL A SOLVER APPROPRIATE TO THE PRESENCE OF GASES AND
!        THE OVERLAP ASSUMED:
!
         IF (.NOT.L_GAS_BAND) THEN
!
!           THERE IS NO GASEOUS ABSORPTION. SOLVE FOR THE 
!           FLUXES DIRECTLY.
!
            CALL SOLVE_BAND_WITHOUT_GAS(IERR
!			Atmospheric Properties
     &         , N_PROFILE, N_LAYER, D_MASS
!			Angular integration
     &         , I_ANGULAR_INTEGRATION, I_2STREAM, L_2_STREAM_CORRECT
     &         , L_RESCALE, N_ORDER_GAUSS
!			Treatment of scattering
     &         , I_SCATTER_METHOD_BAND
!			Options for solver
     &         , I_SOLVER, L_NET, I_EXTRAPOLATE_MIX_NET, N_AUGMENT
!			Spectral region
     &         , ISOLIR
!			Solar Properties
     &         , SEC_0, INC_SOLAR_FLUX_BAND
!			Infra-red Properties
     &         , PLANCK_SOURCE_BAND(1, 0)
     &         , PLANCK_SOURCE_BAND(1, N_LAYER)
     &         , DIFF_PLANCK_BAND, L_IR_SOURCE_QUAD, DIFF_PLANCK_BAND_2
!			Surface Properties
     &         , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR
     &         , THERMAL_GROUND_BAND
!			Clear-sky optical properties
     &         , K_GREY_TOT_FREE, K_EXT_SCAT_FREE, ASYMMETRY_FREE
     &         , FORWARD_SCATTER_FREE
!			Cloudy properties
     &         , L_CLOUD, I_CLOUD
!			Cloudy Geometry
     &         , N_CLOUD_TOP
     &         , NP_CLOUD_TYPE(I_CLOUD_REPRESENTATION), FRAC_CLOUD
     &         , I_REGION_CLOUD, FRAC_REGION
     &         , W_FREE, N_FREE_PROFILE, I_FREE_PROFILE
     &         , W_CLOUD, N_CLOUD_PROFILE, I_CLOUD_PROFILE
     &         , CLOUD_OVERLAP
     &         , N_COLUMN, L_COLUMN, AREA_COLUMN
!			Cloudy optical properties
     &         , K_GREY_TOT_CLOUD, K_EXT_SCAT_CLOUD
     &         , ASYMMETRY_CLOUD, FORWARD_SCATTER_CLOUD
!			Calculated Fluxes
     &         , FLUX_DIRECT_BAND, FLUX_TOTAL_BAND
!			Flags for Clear-sky Fluxes
     &         , L_CLEAR, I_SOLVER_CLEAR
!			Calculated Clear-sky Fluxes
     &         , FLUX_DIRECT_CLEAR_BAND, FLUX_TOTAL_CLEAR_BAND
!			Planckian Function
     &         , PLANCK_SOURCE_BAND
     &         )
            IF (IERR.NE.I_NORMAL) RETURN
!
!
         ELSE
!
!           GASES ARE INCLUDED.
!
!           INITIALIZE THE FLUX IN THE BAND TO ZERO.
            CALL INITIALIZE_FLUX(N_PROFILE, N_LAYER, N_AUGMENT
     &         , ISOLIR
     &         , FLUX_DIRECT_BAND, FLUX_TOTAL_BAND
     &         , L_CLEAR
     &         , FLUX_DIRECT_CLEAR_BAND, FLUX_TOTAL_CLEAR_BAND
     &         , 0.0D+00
     &         )
!
!           TREAT THE GASEOUS OVERLAPS AS DIRECTED BY 
!           THE OVERLAP SWITCH.
!
            IF (I_GAS_OVERLAP(I_BAND).EQ.IP_OVERLAP_SINGLE) THEN
!
               CALL SOLVE_BAND_ONE_GAS(IERR
!			Atmospheric Properties
     &            , N_PROFILE, N_LAYER, L_LAYER, I_TOP, P, T, D_MASS
!			Angular Integration
     &            , I_ANGULAR_INTEGRATION, I_2STREAM, L_2_STREAM_CORRECT
     &            , L_RESCALE, N_ORDER_GAUSS
!			Treatment of Scattering
     &            , I_SCATTER_METHOD_BAND
!			Options for solver
     &            , I_SOLVER, L_NET, I_EXTRAPOLATE_MIX_NET, N_AUGMENT
!			Gaseous Properties
     &            , I_BAND, I_GAS
     &            , I_BAND_ESFT, I_SCALE_ESFT, I_SCALE_FNC
     &            , K_ESFT, W_ESFT, SCALE_VECTOR
     &            , P_REFERENCE, T_REFERENCE
     &            , GAS_MIX_RATIO, GAS_FRAC_RESCALED
     &            , L_DOPPLER, DOPPLER_CORRECTION
!			Spectral Region
     &            , ISOLIR
!			Solar Properties
     &            , SEC_0, INC_SOLAR_FLUX_BAND
!			Infra-red Properties
     &            , PLANCK_SOURCE_BAND(1, 0)
     &            , PLANCK_SOURCE_BAND(1, N_LAYER)
     &            , DIFF_PLANCK_BAND
     &            , L_IR_SOURCE_QUAD, DIFF_PLANCK_BAND_2
!			Surface Properties
     &            , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR
     &            , THERMAL_GROUND_BAND
!			Clear-sky optical Properties
     &            , K_GREY_TOT_FREE, K_EXT_SCAT_FREE, ASYMMETRY_FREE
     &            , FORWARD_SCATTER_FREE
!			Cloudy properties
     &            , L_CLOUD, I_CLOUD
!			Cloud Geometry
     &            , N_CLOUD_TOP
     &            , NP_CLOUD_TYPE(I_CLOUD_REPRESENTATION), FRAC_CLOUD
     &            , I_REGION_CLOUD, FRAC_REGION
     &            , W_FREE, N_FREE_PROFILE, I_FREE_PROFILE
     &            , W_CLOUD, N_CLOUD_PROFILE, I_CLOUD_PROFILE
     &            , CLOUD_OVERLAP
     &            , N_COLUMN, L_COLUMN, AREA_COLUMN
!			Cloudy Optical Properties
     &            , K_GREY_TOT_CLOUD, K_EXT_SCAT_CLOUD
     &            , ASYMMETRY_CLOUD 
     &            , FORWARD_SCATTER_CLOUD
!			Fluxes Calculated
     &            , FLUX_DIRECT_BAND, FLUX_TOTAL_BAND
!			Flags for clear-sky calculations
     &            , L_CLEAR, I_SOLVER_CLEAR
!			Clear-sky Fluxes
     &            , FLUX_DIRECT_CLEAR_BAND, FLUX_TOTAL_CLEAR_BAND
!			Planckian Function
     &            , PLANCK_SOURCE_BAND
     &            )
!
            ELSE IF (I_GAS_OVERLAP(I_BAND).EQ.IP_OVERLAP_RANDOM) THEN
!
               CALL SOLVE_BAND_RANDOM_OVERLAP(IERR
!			Atmospheric Properties
     &            , N_PROFILE, N_LAYER, L_LAYER, I_TOP, P, T, D_MASS
!			Angular Integration
     &            , I_ANGULAR_INTEGRATION, I_2STREAM, L_2_STREAM_CORRECT
     &            , L_RESCALE, N_ORDER_GAUSS
!			Treatment of Scattering
     &            , I_SCATTER_METHOD_BAND
!			Options for solver
     &            , I_SOLVER, L_NET, I_EXTRAPOLATE_MIX_NET, N_AUGMENT
!			Gaseous Properties
     &            , I_BAND, N_GAS
     &            , INDEX_ABSORB, I_BAND_ESFT, I_SCALE_ESFT, I_SCALE_FNC
     &            , K_ESFT, W_ESFT, SCALE_VECTOR
     &            , P_REFERENCE, T_REFERENCE
     &            , GAS_MIX_RATIO, GAS_FRAC_RESCALED
     &            , L_DOPPLER, DOPPLER_CORRECTION
!			Spectral Region
     &            , ISOLIR
!			Solar Properties
     &            , SEC_0, INC_SOLAR_FLUX_BAND
!			Infra-red Properties
     &            , PLANCK_SOURCE_BAND(1, 0)
     &            , PLANCK_SOURCE_BAND(1, N_LAYER)
     &            , DIFF_PLANCK_BAND
     &            , L_IR_SOURCE_QUAD, DIFF_PLANCK_BAND_2
!			Surface Properties
     &            , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR
     &            , THERMAL_GROUND_BAND
!			Clear-sky optical Properties
     &            , K_GREY_TOT_FREE, K_EXT_SCAT_FREE, ASYMMETRY_FREE
     &            , FORWARD_SCATTER_FREE
!			Cloudy Properties
     &            , L_CLOUD, I_CLOUD
!			Cloud Geometry
     &            , N_CLOUD_TOP
     &            , NP_CLOUD_TYPE(I_CLOUD_REPRESENTATION), FRAC_CLOUD
     &            , I_REGION_CLOUD, FRAC_REGION
     &            , W_FREE, N_FREE_PROFILE, I_FREE_PROFILE
     &            , W_CLOUD, N_CLOUD_PROFILE, I_CLOUD_PROFILE
     &            , CLOUD_OVERLAP
     &            , N_COLUMN, L_COLUMN, AREA_COLUMN
!			Cloudy optical Properties
     &            , K_GREY_TOT_CLOUD, K_EXT_SCAT_CLOUD
     &            , ASYMMETRY_CLOUD
     &            , FORWARD_SCATTER_CLOUD
!			Fluxes Calculated
     &            , FLUX_DIRECT_BAND, FLUX_TOTAL_BAND
!			Flags for Clear-sky Calculations
     &            , L_CLEAR, I_SOLVER_CLEAR
!			Clear-sky Fluxes
     &            , FLUX_DIRECT_CLEAR_BAND, FLUX_TOTAL_CLEAR_BAND
!			Planckian Function
     &            , PLANCK_SOURCE_BAND
     &            )
!
            ELSE IF (I_GAS_OVERLAP(I_BAND).EQ.IP_OVERLAP_FESFT) THEN
!
               CALL SOLVE_BAND_FESFT(IERR
!			Atmospheric Properties
     &            , N_PROFILE, N_LAYER, L_LAYER, I_TOP, P, T, D_MASS
!			Angular Integration
     &            , I_ANGULAR_INTEGRATION, I_2STREAM, L_2_STREAM_CORRECT
     &            , L_RESCALE, N_ORDER_GAUSS
!			Treatment of Scattering
     &            , I_SCATTER_METHOD_BAND
!			Options for solver
     &            , I_SOLVER, L_NET, I_EXTRAPOLATE_MIX_NET, N_AUGMENT
!			Gaseous Properties
     &            , I_BAND, N_GAS
     &            , INDEX_ABSORB, I_BAND_ESFT, I_SCALE_ESFT, I_SCALE_FNC
     &            , K_ESFT, W_ESFT, SCALE_VECTOR
     &            , P_REFERENCE, T_REFERENCE
     &            , GAS_MIX_RATIO, GAS_FRAC_RESCALED
     &            , L_DOPPLER, DOPPLER_CORRECTION
!			Spectral Region
     &            , ISOLIR
!			Solar Properties
     &            , SEC_0, INC_SOLAR_FLUX_BAND
!			Infra-red Properties
     &            , PLANCK_SOURCE_BAND(1, 0)
     &            , PLANCK_SOURCE_BAND(1, N_LAYER)
     &            , DIFF_PLANCK_BAND
     &            , L_IR_SOURCE_QUAD, DIFF_PLANCK_BAND_2
!			Surface Properties
     &            , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR
     &            , THERMAL_GROUND_BAND
!			Clear-sky Optical Properties
     &            , K_GREY_TOT_FREE, K_EXT_SCAT_FREE, ASYMMETRY_FREE
     &            , FORWARD_SCATTER_FREE
!			Cloudy Properties
     &            , L_CLOUD, I_CLOUD
!			Cloud Geometry
     &            , N_CLOUD_TOP
     &            , NP_CLOUD_TYPE(I_CLOUD_REPRESENTATION), FRAC_CLOUD
     &            , I_REGION_CLOUD, FRAC_REGION
     &            , W_FREE, N_FREE_PROFILE, I_FREE_PROFILE
     &            , W_CLOUD, N_CLOUD_PROFILE, I_CLOUD_PROFILE
     &            , CLOUD_OVERLAP
     &            , N_COLUMN, L_COLUMN, AREA_COLUMN
!			Cloudy Optical Properties
     &            , K_GREY_TOT_CLOUD, K_EXT_SCAT_CLOUD
     &            , ASYMMETRY_CLOUD, FORWARD_SCATTER_CLOUD
!			Fluxes Calculated
     &            , FLUX_DIRECT_BAND, FLUX_TOTAL_BAND
!			Flags for Clear Fluxes
     &            , L_CLEAR, I_SOLVER_CLEAR
!			Clear-sky Fluxes Calculated
     &            , FLUX_DIRECT_CLEAR_BAND, FLUX_TOTAL_CLEAR_BAND
!			Planckian Source Function
     &            , PLANCK_SOURCE_BAND
     &            )
!
            ELSE IF (I_GAS_OVERLAP(I_BAND).EQ.IP_OVERLAP_CLR_FESFT) THEN
!
               CALL SOLVE_BAND_CLR_FESFT(IERR
!			Atmospheric Properties
     &            , N_PROFILE, N_LAYER, L_LAYER, I_TOP, P, T, D_MASS
!			Angular Integration
     &            , I_ANGULAR_INTEGRATION, I_2STREAM, L_2_STREAM_CORRECT
     &            , L_RESCALE, N_ORDER_GAUSS
!			Treatment of Scattering
     &            , I_SCATTER_METHOD_BAND
!			Options for Solver
     &            , I_SOLVER, L_NET, I_EXTRAPOLATE_MIX_NET, N_AUGMENT
!			Gaseous Properties
     &            , I_BAND, N_GAS
     &            , INDEX_ABSORB, I_BAND_ESFT, I_SCALE_ESFT, I_SCALE_FNC
     &            , K_ESFT, W_ESFT, SCALE_VECTOR
     &            , P_REFERENCE, T_REFERENCE
     &            , GAS_MIX_RATIO, GAS_FRAC_RESCALED
     &            , L_DOPPLER, DOPPLER_CORRECTION
!			Spectral Region
     &            , ISOLIR
!			Solar Properties
     &            , SEC_0, INC_SOLAR_FLUX_BAND
!			Infra-red Properties
     &            , PLANCK_SOURCE_BAND
     &            , DIFF_PLANCK_BAND
     &            , L_IR_SOURCE_QUAD, DIFF_PLANCK_BAND_2
!			Surface Properties
     &            , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR
     &            , THERMAL_GROUND_BAND
!			Clear-sky Optical Properties
     &            , K_GREY_TOT_FREE, K_EXT_SCAT_FREE, ASYMMETRY_FREE
     &            , FORWARD_SCATTER_FREE
!			Cloudy Properties
     &            , L_CLOUD, I_CLOUD
!			Cloud Geometry
     &            , N_CLOUD_TOP
     &            , NP_CLOUD_TYPE(I_CLOUD_REPRESENTATION), FRAC_CLOUD
     &            , I_REGION_CLOUD, FRAC_REGION
     &            , W_FREE, N_FREE_PROFILE, I_FREE_PROFILE
     &            , W_CLOUD, N_CLOUD_PROFILE, I_CLOUD_PROFILE
     &            , CLOUD_OVERLAP
     &            , N_COLUMN, L_COLUMN, AREA_COLUMN
!			Cloudy Optical Properties
     &            , K_GREY_TOT_CLOUD, K_EXT_SCAT_CLOUD
     &            , ASYMMETRY_CLOUD
     &            , FORWARD_SCATTER_CLOUD
!			Fluxes Calculated
     &            , FLUX_DIRECT_BAND, FLUX_TOTAL_BAND
!			Flags for Clear-sky Fluxes
     &            , L_CLEAR, I_SOLVER_CLEAR
!			Clear-sky Fluxes Calculated
     &            , FLUX_DIRECT_CLEAR_BAND, FLUX_TOTAL_CLEAR_BAND
     &            )
!
            ELSE IF (I_GAS_OVERLAP(I_BAND).EQ.IP_OVERLAP_K_EQV) THEN
!
               CALL SOLVE_BAND_K_EQV(IERR
!			Atmospheric Properties
     &            , N_PROFILE, N_LAYER, L_LAYER, I_TOP, P, T, D_MASS
!			Angular Integration
     &            , I_ANGULAR_INTEGRATION, I_2STREAM, L_2_STREAM_CORRECT
     &            , L_RESCALE, N_ORDER_GAUSS
!			Treatment of Scattering
     &            , I_SCATTER_METHOD_BAND
!			Options for Solver
     &            , I_SOLVER, L_NET, I_EXTRAPOLATE_MIX_NET, N_AUGMENT
!			Gaseous Properties
     &            , I_BAND, N_GAS
     &            , INDEX_ABSORB, I_BAND_ESFT, I_SCALE_ESFT, I_SCALE_FNC
     &            , K_ESFT, W_ESFT, SCALE_VECTOR
     &            , P_REFERENCE, T_REFERENCE
     &            , GAS_MIX_RATIO, GAS_FRAC_RESCALED
     &            , L_DOPPLER, DOPPLER_CORRECTION
!			Spectral Region
     &            , ISOLIR
!			Solar Properties
     &            , SEC_0, INC_SOLAR_FLUX_BAND
!			Infra-red Properties
     &            , PLANCK_SOURCE_BAND
     &            , DIFF_PLANCK_BAND
     &            , L_IR_SOURCE_QUAD, DIFF_PLANCK_BAND_2
!			Surface Properties
     &            , ALBEDO_SURFACE_DIFF, ALBEDO_SURFACE_DIR
     &            , THERMAL_GROUND_BAND
!			Clear-sky optical properties
     &            , K_GREY_TOT_FREE, K_EXT_SCAT_FREE, ASYMMETRY_FREE
     &            , FORWARD_SCATTER_FREE
!			Cloudy Properties
     &            , L_CLOUD, I_CLOUD
!			Cloud Geometry
     &            , N_CLOUD_TOP
     &            , NP_CLOUD_TYPE(I_CLOUD_REPRESENTATION), FRAC_CLOUD
     &            , I_REGION_CLOUD, FRAC_REGION
     &            , W_FREE, N_FREE_PROFILE, I_FREE_PROFILE
     &            , W_CLOUD, N_CLOUD_PROFILE, I_CLOUD_PROFILE
     &            , CLOUD_OVERLAP
     &            , N_COLUMN, L_COLUMN, AREA_COLUMN
!			Cloudy Optical Properties
     &            , K_GREY_TOT_CLOUD, K_EXT_SCAT_CLOUD
     &            , ASYMMETRY_CLOUD
     &            , FORWARD_SCATTER_CLOUD
!			Fluxes Calculated
     &            , FLUX_DIRECT_BAND, FLUX_TOTAL_BAND
!			Flags for Clear-sky Calculations
     &            , L_CLEAR, I_SOLVER_CLEAR
!			Clear-sky Fluxes Calculated
     &            , FLUX_DIRECT_CLEAR_BAND, FLUX_TOTAL_CLEAR_BAND
     &            )
!
            ENDIF
         ENDIF
!
!
! EJH 21/2/01 Band by band output of fluxes for spectral sigal
c         print*,n_profile,n_layer
        
         

!
!        INCREMENT THE TOTAL FLUXES.
!
c         do i=1,n_layer
c            do l=1,n_profile
c               print*,i,l,planck_flux(i,l),flux_total_band(i,l)
c            end do
c         end do
         

         CALL AUGMENT_TOTAL_FLUX(N_PROFILE, N_LAYER, N_AUGMENT
     &      , ISOLIR, L_CLEAR, L_NET
     &      , WEIGHT_BAND(I_BAND), PLANCK_SOURCE_BAND
     &      , FLUX_DIRECT, FLUX_TOTAL
     &      , FLUX_DIRECT_BAND, FLUX_TOTAL_BAND
     &      , FLUX_DIRECT_CLEAR, FLUX_TOTAL_CLEAR
     &      , FLUX_DIRECT_CLEAR_BAND, FLUX_TOTAL_CLEAR_BAND
     &      , PLANCK_FLUX
     &      )
c          CALL AUGMENT_TOTAL_FLUX(N_PROFILE, N_LAYER, N_AUGMENT
c     &      , ISOLIR, L_CLEAR
c     &      , WEIGHT_BAND(I_BAND)
c     &      , FLUX_DIRECT, FLUX_TOTAL
c     &      , FLUX_DIRECT_BAND, FLUX_TOTAL_BAND
c     &      , FLUX_DIRECT_CLEAR, FLUX_TOTAL_CLEAR
c     &      , FLUX_DIRECT_CLEAR_BAND, FLUX_TOTAL_CLEAR_BAND
c     &      )
!
!
c         do i=1,n_layer
c            do l=1,n_profile
c               print*,i,l,planck_flux(i,l),flux_total_band(i,l)
c            end do
c         end do

          if (isolir.eq.ip_solar) then
            do i=0,n_layer
               do l=1,n_profile
                  el_direct(l,i)=flux_direct_band(l,i)
               end do
            end do
         endif
         do i=1,n_augment
            do l=1,n_profile
               el_total(l,i)=flux_total_band(l,i)
            end do
         end do
         if (l_clear) then
            if (isolir.eq.ip_solar) then
               do i=0,n_layer
                  do l=1,n_profile
                     el_direct_clear(l,i)=flux_direct_clear_band(l,i)
                  end do
               end do
            endif
            do i=1,n_augment
               do l=1,n_profile
                  el_total_clear(l,i)=flux_total_clear_band(l,i)
               end do
            end do
         end if

! assign band by band fluxes to band by band fup and fdown etc
! doesn#t work if l_net is true.. does upward and downwards fluxes
         if (isolir.eq.ip_solar) then
            
            do i=1,n_layer
               do l=1,n_profile
                  eflux_up(l,i)=el_total(l,2*i+1)
                  eflux_down(l,i)=el_total(l,2*i+2)
               end do
            end do
         else 
            if (isolir.eq.ip_infra_red) then
               do i=1,n_layer
                  do l=1,n_profile
c                     print*,planck_flux(i,l)
                     eflux_up(l,i)=el_total(l,2*i+1)+planck_flux(i,l)
                     eflux_down(l,i)=el_total(l,2*i+2)+
     $                    planck_flux(i,l)
c                     eflux_up(l,i)=el_total(l,2*i+1)
c                     eflux_down(l,i)=el_total(l,2*i+2)
                  end do
               end do
               
            end if
         end if
         
         
         if (L_clear) then
            if (isolir.eq.ip_solar) then
               
               do i=1,n_layer
                  do l=1,n_profile
                     eflux_up_clear(l,i)=el_total_clear(l,2*i+1)
                     eflux_down_clear(l,i)=el_total_clear(l,2*i+2)
                  end do
               end do
            else 
               if (isolir.eq.ip_infra_red) then
                  do i=1,n_layer
                     do l=1,n_profile
                    
                        eflux_up_clear(l,i)=el_total_clear(l,2*i+1)
     $                       +planck_flux(i,l)
                        eflux_down_clear(l,i)=el_total_clear(l,2*i+2)
     $                       +planck_flux(i,l)
c                        eflux_up_clear(l,i)=el_total_clear(l,2*i+1)
c                        eflux_down_clear(l,i)=el_total_clear(l,2*i+2)
  
                     end do
                  end do
                  
               end if
            end if
        
         end if

         do i=1,n_layer
            do l=1,n_profile
               write(100,*)i,eflux_up(l,i),eflux_down(l,i)
            end do
         end do
        
         if (l_clear) then
            print*,'clear fluxes'
            do i=1,n_layer
               do l=1,n_profile
                  write(101,*)i,eflux_up_clear(l,i),
     $                 eflux_down_clear(l,i)
               end do
            end do
         end if

      ENDDO
!
!
!
!
!     PASS THE CALCULATED FLUXES INTO THE OUTPUT ARRAYS.
!
      CALL ASSIGN_FLUX(N_PROFILE, N_LAYER
     &   , FLUX_TOTAL, FLUX_TOTAL_CLEAR
     &   , ISOLIR
     &   , PLANCK_FLUX
     &   , L_CLEAR, L_NET
     &   , FLUX_DOWN, FLUX_UP, FLUX_DOWN_CLEAR, FLUX_UP_CLEAR
     &   )
!
!
!
      RETURN
      END
