!+ Program to run the radiation code using SAMSON-files.
!
! Method:
!       Options are requested, files are read in and
!       FLUX_CALC is called. This driver works with fields
!	given on levels.
!
! 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.
!
!- ---------------------------------------------------------------------
      PROGRAM DRIVER_SAMSON
!
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/dimensions_field.ucf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/dimensions_fixed.pcf'
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/spectral_region.pcf'
      INCLUDE 'incl/cloud_scheme.pcf'
      INCLUDE 'incl/cloud_component.pcf'
      INCLUDE 'incl/cloud_representation.pcf'
      INCLUDE 'incl/cloud_type.pcf'
      INCLUDE 'incl/phase.pcf'
      INCLUDE 'incl/angular_integration.pcf'
      INCLUDE 'incl/solver.pcf'
      INCLUDE 'incl/scatter_method.pcf'
      INCLUDE 'incl/cloud_parametrization.pcf'
      INCLUDE 'incl/ice_cloud_parametrization.pcf'
      INCLUDE 'incl/aerosol_component.pcf'
      INCLUDE 'incl/aerosol_parametrization.pcf'
      INCLUDE 'incl/gas_list.pcf'
      INCLUDE 'incl/gas_overlap.pcf'
      INCLUDE 'incl/input_head.pcf'
      INCLUDE 'incl/input_head.ncf'
      INCLUDE 'incl/physical_constants_0.ccf'
      INCLUDE 'incl/physical_constants_1.ccf'
      INCLUDE 'incl/math_cnst.ccf'
      INCLUDE 'incl/prec_machine.ucf'
      INCLUDE 'incl/precision.pcf'
      INCLUDE 'incl/error.pcf'
!
!
!
!     DECLARATION OF VARIABLES.
!
      INCLUDE 'dec_spec.finc'
!
!
!     TREATMENT OF ERRORS:
      INTEGER
     &     IERR
!             ERROR FLAG
     &   , IOS
!             I/O ERROR FLAG
      LOGICAL
     &     LOCK_CODE
!             LOGICAL TO FORBID INTERACTIVE LOOPING
     &   , L_CHECK
!             LOGICAL FOR CHECKING
      EXTERNAL
     &     LOCK_CODE
!
!
!     SPECTRAL INFORMATION:
      CHARACTER
     &     FILE_SPECTRAL*80
!             NAME OF SPECTRAL FILE
      INTEGER
     &     N1
!             FIRST BAND READ IN
     &   , N2
!             SECOND BAND READ IN
     &   , NMIN
!             SORTED FIRST BAND
     &   , NMAX
!             SORTED LAST BAND
      REAL*8
     &     WEIGHT_BAND(NPD_BAND)
!             WEIGHTS FOR EACH BAND
!
!     VARIABLES FOR SAMSON FILES:
      CHARACTER
     &     BASE_NAME*80
!             BASE NAME OF SAMSON FILES
     &   , FILE_NAME*80
!             NAME OF SAMSON FILE
     &   , TITLE_DUMMY*80
!             TITLE FOR READING IN
     &   , CHAR_YN*1
!             CHARACTER RESPONSE VARIABLE
     &   , TEXT*80
!             TEXT FOR I/O
     &   , SUFFIX_MR*6
!             SUFFIX FOR MIXING RATIOS
     &   , SUFFIX_RE*6
!             SUFFIX FOR EFFECTIVE RADIUS
     &   , SUFFIX_CL(NPD_CLOUD_COMPONENT)*6
!             SUFFIX FOR CLOUDS
      INTEGER
     &     I_GAS
!             SPECIES OF GAS TO BE READ
     &   , LENGTH_NAME
!             LENGTH OF NAME OF FILE
     &   , N_LAYER_DUMMY
!             DUMMY NUMBER OF LAYERS
     &   , NDUM
!             DUMMY VARIABLE
      LOGICAL
     &     L_LEVEL_SET
!             FLAG FOR SETTING OF LEVELS IN FILES
     &   , L_Q_UNREAD
!             FLAG FOR PROFILE OF Q
      REAL*8
     &     PSTAR(NPD_PROFILE)
!             SURFACE PRESSURE
     &   , P_DUMMY(NPD_PROFILE, 0: NPD_LAYER)
!             DUMMY PRESSURE
!
!     PHYSICAL PROCESSES INCLUDED
      CHARACTER
     &     PROCESS_FLAG*10
!             FLAG GIVING PROCESSES
      LOGICAL
     &     L_RAYLEIGH
!             RAYLEIGH SCATTERING INCLUDED
     &   , L_AEROSOL
!             AEROSOLS INCLUDED
     &   , L_GAS
!             GASEOUS ABSORPTION INCLUDED
     &   , L_CONTINUUM
!             CONTINUUM ABSORPTION INCLUDED
     &   , L_DROP
!             DROPLETS INCLUDED INCLUDED
     &   , L_ICE
!             ICE CRYSTALS INCLUDED
     &   , L_CLOUD
!             CLOUDS INCLUDED INCLUDED
     &   , L_DOPPLER(NPD_SPECIES)
!             DOPPLER FLAGS
!
!     ANGULAR INTEGRATION
      INTEGER
     &     I_ANGULAR_INTEGRATION
!             ANGULAR INTEGRATION
     &   , I_2STREAM
!             TWO-STREAM SCAHEME
     &   , N_ORDER_GAUSS
!             ORDER OF GAUSSIAN INTEGRATION
      LOGICAL
     &     L_RESCALE
!             FLAG FOR RESCALING
     &   , L_2_STREAM_CORRECT
!             CORRECTION TO TWO_STREAM EQUATIONS
!
!     TREATMENT OF SCATTERING
      INTEGER
     &     I_SCATTER_METHOD
!             METHOD OF TREATING SCATTERING
      LOGICAL
     &     L_SWITCH_SCATTER(NPD_BAND)
!             SWITCHES FOR SCATTERING
!
!     OPTIONS FOR SOLVERS
      LOGICAL
     &     L_CLEAR
!             SOLVE FOR CLEAR FLUXES
     &   , L_NON_NET
!             FLAG FOR SOLUTION FOR NON-NET FLUXES
      INTEGER
     &     I_SOLVER
!             MAIN SOLVER
     &   , I_EXTRAPOLATE_MIX_NET
!             EXTRAPOLATION SCHEME FOR THE MIXED SOLVER
     &   , I_SOLVER_CLEAR
!            SOLVER FOR CLEAR-SKY FLUXES
!
!     GENERAL ATMOSPHERIC PROPERTIES
      INTEGER
     &     N_LAYER
!            NUMBER OF LAYERS
!
!     SPECTRAL REGION
      INTEGER
     &     ISOLIR
!
!     SOLAR FIELDS
      REAL*8
     &     SEC_0(NPD_PROFILE)
!             SECANT OF SOLAR ZENITH ANGLE
     &   , SOLAR_TOA(NPD_PROFILE)
!             SOLAR FLUX AT TOP OF ATMOSPHERE
!
!     GENERAL ATMOSPHERIC PROPERTIES
      REAL*8
     &     P(NPD_PROFILE, 0: NPD_LAYER)
!             PRESSURES ON LEVELS
     &   , T(NPD_PROFILE, 0: NPD_LAYER)
!             TEMPERATURES ON LEVELS
     &   , T_LEVEL(NPD_PROFILE, 0: NPD_LAYER)
!             TEMPERATURES AT BOUNDARIES OF LAYERS
     &   , D_MASS(NPD_PROFILE, NPD_LAYER)
!             MASSES IN LAYERS
     &   , MEAN_PRESSURE(NPD_PROFILE, NPD_LAYER)
!             MEAN PRESSURES IN LAYERS
!
!     GASEOUS ABSORPTION
      INTEGER
     &     I_GAS_OVERLAP_IN
!             GASEOUS OVERLAP READ IN
     &   , I_GAS_OVERLAP(NPD_BAND)
!             OVERLAPS IN EACH BAND
     &   , I_GAS_SPECIES
!             GASEOUS SPECIES SELECTED
      REAL*8
     &     GAS_MIX_RATIO(NPD_PROFILE, 0: NPD_LAYER, NPD_SPECIES)
!
!     SURFACE PROPERTIES
      INTEGER
     &     I_SURFACE(NPD_PROFILE)
!             TYPES OF SURFACES
      REAL*8
     &     ALBEDO_FIELD_DIFF(NPD_PROFILE, NPD_BAND)
!             DIFFUSE ALBEDO
     &   , ALBEDO_FIELD_DIR(NPD_PROFILE, NPD_BAND)
!             DIRECT ALBEDO
     &   , EMISSIVITY_FIELD(NPD_PROFILE)
!             EMISSIVITY
     &   , T_GROUND(NPD_PROFILE)
!             TEMPERATURE OF GROUND
!
!     CLOUDY FIELDS
      INTEGER
     &     I_CLOUD
!             CLOUD SCHEME
     &   , N_CONDENSED
!             NUMBER OF CONDENSED PHASES IN CLOUDS
     &   , TYPE_CONDENSED(NPD_CLOUD_COMPONENT)
!             TYPES OF CONDENSED PHASES IN CLOUDS
     &   , I_CONDENSED_PARAM(NPD_CLOUD_COMPONENT)
!             PARAMETRIZATION SCHEMES FOR COMPONENTS
     &   , I_CLOUD_REPRESENTATION
!             REPRESENTATION OF MIXING RULE CHOSEN
     &   , I_PARAMETRIZATION_TYPE
!             TYPE OF CONDENSED COMPOENT
     &   , I_PHASE
!             PHASE OF COMPONENT OF CLOUD
     &   , N_CLOUD_TYPE
!             NUMBER OF TYPES OF CLOUDS
      REAL*8
     &     W_CLOUD(NPD_PROFILE, NPD_LAYER)
!             AMOUNTS OF CLOUD
     &   , FRAC_CLOUD(NPD_PROFILE, NPD_LAYER, NPD_CLOUD_TYPE)
!             FRACTIONS OF TYPES OF CLOUDS
     &   , 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
!
      INTEGER I_DROP, I_ICE
      PARAMETER(I_DROP=1, I_ICE=1)
!
!     AEROSOL FIELDS
      REAL*8
     &     AEROSOL_MIX_RATIO(NPD_PROFILE, 0: NPD_LAYER
     &      , NPD_AEROSOL_SPECIES)
!             MIXING RATIOS OF AEROSOLS
!
!     FLUXES CALCULATED
      REAL*8
     &     FLUX_DIRECT(NPD_PROFILE, 0: NPD_LAYER)
!             DIRECT FLUX
     &   , FLUX_DOWN(NPD_PROFILE, 0: NPD_LAYER)
!             TOTAL DOWNWARD FLUX
     &   , FLUX_DIFFUSE_DOWN(NPD_PROFILE, 0: NPD_LAYER)
!             TOTAL DOWNWARD FLUX
     &   , FLUX_UP(NPD_PROFILE, 0: NPD_LAYER)
!             UPWARD FLUX
     &   , FLUX_NET(NPD_PROFILE, 0: NPD_LAYER)
!             NET FLUX
     &   , HEATING_RATE(NPD_PROFILE, NPD_LAYER)
!             HEATING RATES
     &   , FLUX_DIRECT_CLEAR(NPD_PROFILE, 0: NPD_LAYER)
!             CLEAR-SKY DIRECT FLUX
     &   , FLUX_DOWN_CLEAR(NPD_PROFILE, 0: NPD_LAYER)
!             CLEAR-SKY DOWNWARD FLUX
     &   , FLUX_UP_CLEAR(NPD_PROFILE, 0: NPD_LAYER)
!             CLEAR-SKY UPWARD FLUX
!
!     CONTROLLING VARIABLES:
      INTEGER
     &     I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
!
!
!     FUNCTIONS CALLED
      INTEGER
     &     SET_N_CLOUD_PARAMETER
!             FUNCTION TO FIND NUMBER OF CLOUD PARAMETERS
      EXTERNAL
     &     SET_N_CLOUD_PARAMETER
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     IN_SPECTRUM, CONVOLVE_FUNCTION, READ_SAMSON_FIELD
     &   , SET_PT_LEVEL, CHECK_DATA, FLUX_CALC
     &   , WRITE_SAMSON_FIELD
!
!
      INCLUDE 'incl/input_head.dcf'
      INCLUDE 'incl/samson_pstar.ecf'
!
      DATA PSTAR/NPD_PROFILE*PSTAR_DEFAULT/
      DATA L_RAYLEIGH/.FALSE./, L_GAS/.FALSE./, L_CONTINUUM/.FALSE./
     &   , L_AEROSOL/.FALSE./, L_DROP/.FALSE./, L_ICE/.FALSE./
     &   , L_CLEAR/.FALSE./, L_Q_UNREAD/.TRUE./
     &   , I_CLOUD_REPRESENTATION/IP_CLOUD_TYPE_HOMOGEN/
      DATA L_DOPPLER/NPD_SPECIES*.FALSE./
      DATA WEIGHT_BAND/NPD_BAND*1.0D+00/
!
!     DEFAULT DROP TYPE MUST BE SET.
!
!
!

!     RETREIVE NAME OF SPECTRAL FILE AND READ ITS CONTENTS.
      WRITE(IU_USER, '(/A)') 'ENTER NAME OF SPECTRAL FILE.'
      READ(IU_STDIN, '(A)') FILE_SPECTRAL
      INCLUDE 'read_spec.finc'
      IF (IERR.NE.I_NORMAL) STOP
!
!     ALL INPUT FIELDS ARE IN SAMSON FORMAT, THE FILES CONSISTING OF A
!     FIXED BASE NAME FOLLOWED BY A SUFFIX.
      WRITE(IU_USER, '(A)') 'ENTER BASE NAME OF SAMSON INPUT FILES.'
      READ(IU_STDIN, '(A)') BASE_NAME
      J=LEN(BASE_NAME)
1     IF (BASE_NAME(J:J).EQ.' ') THEN
         J=J-1
         IF (J.EQ.0) THEN
            WRITE(IU_ERR, '(A)') 'NO NAME SUPPLIED.'
            IERR=I_ERR_FATAL
            STOP
         ELSE
            GOTO 1
         ENDIF
      ENDIF
      LENGTH_NAME=J
!
!     CODING SIMPLE HERE. MOST CHECKS ARE DONE IN UNIX INTERFACE.
      WRITE(IU_USER, '(/A)') 'ENTER SPECTRAL REGION.'
2     READ(IU_STDIN, *) ISOLIR
      IF (ISOLIR.EQ.IP_SOLAR) THEN
         WRITE(IU_USER, '(A)') 'ENTER SOLAR ZENITH ANGLE IN DEGREES.'
         READ(IU_STDIN, *) SEC_0(1)
         SEC_0(1)=1.0D+00/COS(SEC_0(1)*PI/180.0D+00)
         WRITE(IU_USER, '(A)') 'ENTER SOLAR IRRADIANCE AT TOA.'
         READ(IU_STDIN, *) SOLAR_TOA(1)
      ELSE IF (ISOLIR.NE.IP_INFRA_RED) THEN
            WRITE(IU_ERR, '(A)') '+++ UNKNOWN SPECTRAL REGION:'
         IF (LOCK_CODE(.TRUE.)) THEN
            INCLUDE 'batch_error_main.finc'
         ELSE
            WRITE(IU_ERR, '(A)') 'PLEASE REENTER.'
            GOTO 2
         ENDIF
      ENDIF
!
!     ZERO THE SOURCES FUNCTIONS OUTSIDE SPECIFIED BANDS.
      WRITE(IU_USER, '(/A)') 'ENTER RANGE OF ACTIVE BANDS.'
3     READ(IU_STDIN, *, IOSTAT=IOS) N1, N2
      IF (IOS.NE.0) THEN
         WRITE(IU_ERR, '(A)') 'UNRECOGNIZED RESPONSE: '
         IF (LOCK_CODE(.TRUE.)) THEN
            INCLUDE 'batch_error_main.finc'
         ELSE
            WRITE(IU_ERR, '(A)') 'PLEASE RE-ENTER.'
            GOTO 3
         ENDIF
      ENDIF
      NMAX=MAX(N1, N2)
      NMIN=MIN(N1, N2)
      IF ( (NMAX.GT.N_BAND).OR.(NMIN.LT.1) ) THEN
         WRITE(IU_ERR, '(A)') 'BANDS OUT OF RANGE: '
         IF (LOCK_CODE(.TRUE.)) THEN
            INCLUDE 'batch_error_main.finc'
         ELSE
            WRITE(IU_ERR, '(A)') 'PLEASE REENTER.'
            GOTO 3
         ENDIF
      ENDIF
!
!     CALCULATE THE WEIGHTING FOR THE BANDS.
      WRITE(IU_USER, '(A)')
     &   'WEIGHT FLUXES WITH A FILTER FUNCTION? (Y/N)'
      READ(IU_STDIN, '(A)') CHAR_YN
      IF ( (CHAR_YN.EQ.'Y').OR.(CHAR_YN.EQ.'y') ) THEN
         CALL CONVOLVE_FUNCTION(IERR, N_BAND
     &      , WAVE_LENGTH_SHORT, WAVE_LENGTH_LONG
     &      , WEIGHT_BAND)
      ENDIF
!
!
!     OBTAIN THE VARIOUS OPTION FLAGS.
      WRITE(IU_USER, '(/A)') 'ENTER PROCESS FLAG.'
      READ(IU_STDIN, '(A)') PROCESS_FLAG
      DO J=1, LEN(PROCESS_FLAG)
         IF (PROCESS_FLAG(J: J).EQ.'r') THEN
            L_RAYLEIGH=.TRUE.
         ELSE IF (PROCESS_FLAG(J: J).EQ.'a') THEN
            L_AEROSOL=.TRUE.
         ELSE IF (PROCESS_FLAG(J: J).EQ.'g') THEN
            L_GAS=.TRUE.
         ELSE IF (PROCESS_FLAG(J: J).EQ.'c') THEN
            L_CONTINUUM=.TRUE.
         ELSE IF (PROCESS_FLAG(J: J).EQ.'d') THEN
            L_DROP=.TRUE.
         ELSE IF (PROCESS_FLAG(J: J).EQ.'i') THEN
            L_ICE=.TRUE.
         ELSE IF (PROCESS_FLAG(J: J).EQ.'b') THEN
            DO I=1, N_ABSORB
               L_DOPPLER(I)=L_DOPPLER_PRESENT(I)
            ENDDO
         ENDIF
      ENDDO
!
!
!     ALL SAMSON FIELDS DEPEND ON THE VALUE OF THE SURFACE PRESSURE
!     WHICH MUST THEREFORE BE SET BEFORE ANY ARE READ.
      FILE_NAME(1: LENGTH_NAME+7)=BASE_NAME(1: LENGTH_NAME)
     &   //'.'//PHYS_SUFFIX(IP_PRESSURE_GROUND)
      CALL READ_SAMSON_FIELD(IERR, .TRUE., .FALSE.
     &   , FILE_NAME, TITLE_DUMMY
     &   , NDUM, N_LAYER_DUMMY, P_DUMMY, P_DUMMY, PSTAR)
      IF (IERR.EQ.I_MISSING_DATA) THEN
         WRITE(IU_ERR, '(/A)')
     &      '*** ERROR IN PROGRAM SAMSON_DRIVER.'
         WRITE(IU_ERR, '(A, /A80,/A)') 'FILE ', FILE_NAME
     &      , ' DOES NOT EXIST'
         IERR=I_ERR_FATAL
         STOP
      ENDIF
!
!
!     SET SURFACE PROPERTIES
      WRITE(IU_USER, '(A)') 'ENTER SURFACE TYPE.'
      READ(IU_STDIN, *) I_SURFACE(1)
!
!
      IF (L_GAS) THEN
         WRITE(IU_USER, '(A)') 'ENTER TREATMENT OF GASEOUS OVERLAPS.'
         READ(IU_STDIN, *) I_GAS_OVERLAP_IN
         DO J=NMIN, NMAX
            I_GAS_OVERLAP(J)=I_GAS_OVERLAP_IN
         ENDDO
         IF ( (I_GAS_OVERLAP_IN.EQ.IP_OVERLAP_SINGLE).OR.
     &        (I_GAS_OVERLAP_IN.EQ.IP_OVERLAP_SINGLE_INT) ) THEN
            WRITE(IU_USER, '(A)') 'ENTER TYPE NUMBER OF GAS.'
4           READ(IU_STDIN, *) I_GAS_SPECIES
!           CONVERT FROM THE TYPE TO THE SPECIES.
            I=0
5           I=I+1
            IF (TYPE_ABSORB(I).EQ.I_GAS_SPECIES) THEN
               I_GAS_SPECIES=I
            ELSE IF (I.LT.N_ABSORB) THEN
               GOTO 5
            ELSE
               WRITE(IU_ERR, '(/A)')
     &            '+++ THIS GAS IS NOT IN THE SPECTRUM.'
               WRITE(IU_ERR, '(A)') 'PLEASE RE-ENTER.'
               GOTO 4
            ENDIF
         ENDIF
      ENDIF
!
!
!     GASEOUS ABSORPTION:
!
      IF (L_GAS) THEN
         DO I_GAS=1, N_ABSORB
            FILE_NAME(1: LENGTH_NAME+7)=BASE_NAME(1: LENGTH_NAME)
     &         //'.'//GAS_SUFFIX(TYPE_ABSORB(I_GAS))(1:6)
            CALL READ_SAMSON_FIELD(IERR, .TRUE., .FALSE.
     &         , FILE_NAME, TITLE_DUMMY
     &         , NDUM, N_LAYER, P, PSTAR
     &         , GAS_MIX_RATIO(1, 0, I_GAS)
     &         )
            IF (IERR.EQ.I_MISSING_DATA) THEN
               WRITE(IU_ERR, '(/A)')
     &            '*** ERROR IN PROGRAM SAMSON_DRIVER.'
               WRITE(IU_ERR, '(A, /A80,/A)') 'FILE ', FILE_NAME
     &            , ' DOES NOT EXIST'
               IERR=I_ERR_FATAL
               STOP
            ELSE
               L_LEVEL_SET=.TRUE.
            ENDIF
         ENDDO
      ENDIF
!
!
!     AEROSOL PROCESSES:
!
      IF (L_AEROSOL) THEN
         DO I=1, N_AEROSOL
!           AN OBSERVATIONAL PROFILE IS TAKEN FROM THE SPECTRAL FILE,
!           BUT WITH A PARAMETRIZATION THE MIXING RATIOS MUST
!           BE READ IN.
            IF (I_AEROSOL_PARAMETRIZATION(I).NE.
     &          IP_AEROSOL_UNPARAMETRIZED) THEN
               FILE_NAME(1: LENGTH_NAME+7)=BASE_NAME(1: LENGTH_NAME)
     &            //'.'//AEROSOL_SUFFIX(TYPE_AEROSOL(I))
               CALL READ_SAMSON_FIELD(IERR, .TRUE., .FALSE.
     &            , FILE_NAME, TITLE_DUMMY
     &            , NDUM, N_LAYER, P, PSTAR
     &            , AEROSOL_MIX_RATIO(1, 0, I)
     &            )
               IF (IERR.EQ.I_MISSING_DATA) THEN
                  WRITE(IU_ERR, '(/A)')
     &               '*** ERROR IN PROGRAM SAMSON_DRIVER.'
                  WRITE(IU_ERR, '(A, /A80,/A)') 'FILE ', FILE_NAME
     &               , ' DOES NOT EXIST.'
                  IERR=I_ERR_FATAL
                  STOP
               ELSE
                  L_LEVEL_SET=.TRUE.
               ENDIF
            ENDIF
!
!           TO COMPUTE THE RADIATION FIELD FOR A MOIST AEROSOL
!           THE PROFILE OF WATER VAPOUR IS NEEDED.
            IF ( (I_AEROSOL_PARAMETRIZATION(I)
     &           .EQ.IP_AEROSOL_PARAM_MOIST)
     &           .AND.(.NOT.L_GAS).AND.L_Q_UNREAD) THEN
               IF (INDEX_WATER.LE.0) THEN
                  WRITE(IU_ERR, '(/A)')
     &               '*** ERROR: WATER MUST BE INCLUDED IN THE'
     &               //'SPECTRAL FILE TO TREAT MOIST AEROSOLS.'
                  IERR=I_ERR_FATAL
                  STOP
               ENDIF
               FILE_NAME(1: LENGTH_NAME+7)=BASE_NAME(1: LENGTH_NAME)
     &            //'.'//GAS_SUFFIX(IP_H2O)(1:6)
               CALL READ_SAMSON_FIELD(IERR, .TRUE., .FALSE.
     &            , FILE_NAME, TITLE_DUMMY
     &            , NDUM, N_LAYER, P, PSTAR
     &            , GAS_MIX_RATIO(1, 0, INDEX_WATER)
     &            )
               IF (IERR.EQ.I_MISSING_DATA) THEN
                  WRITE(IU_ERR, '(/A)')
     &               '*** ERROR IN PROGRAM SAMSON_DRIVER.'
                  WRITE(IU_ERR, '(A, /A80,/A)') 'FILE ', FILE_NAME
     &               , ' DOES NOT EXIST'
                  IERR=I_ERR_FATAL
                  STOP
               ELSE
                  L_LEVEL_SET=.TRUE.
               ENDIF
               L_Q_UNREAD=.FALSE.
            ENDIF
         ENDDO
      ENDIF
!
!
!
!     CLOUDS:
!
      WRITE(IU_USER, '(/A)') 'ENTER CLOUD SCHEME.'
      READ(IU_STDIN, *) I_CLOUD
!
!     SET THE CLOUD FLAG FROM CONSIDERATION OF THE VALUE OF I_CLOUD.
!     AND DETERMINE ALL THE COMPONENTS PRESENT.
!
      IF ( (I_CLOUD.EQ.IP_CLOUD_SCHMETZ).OR.
     &     (I_CLOUD.EQ.IP_CLOUD_MIX_MAX).OR.
     &     (I_CLOUD.EQ.IP_CLOUD_MIX_RANDOM).OR.
     &     (I_CLOUD.EQ.IP_CLOUD_COLUMN_MAX) ) THEN
!
!        CLOUDS ARE INCLUDED.
         L_CLOUD=.TRUE.
!
         WRITE(IU_USER, '(A)') 'ENTER REPRESENTATION OF CLOUDS.'
         READ(IU_STDIN, *) I_CLOUD_REPRESENTATION
!
         IF ( L_ICE.AND.L_DROP) THEN
!
!           BOTH PHASES ARE PRESENT
            IF ( (I_CLOUD_REPRESENTATION.EQ.IP_CLOUD_HOMOGEN).OR.
     &           (I_CLOUD_REPRESENTATION.EQ.IP_CLOUD_ICE_WATER) ) THEN
               N_CONDENSED=2
               TYPE_CONDENSED(1)=IP_CLCMP_ST_WATER
               TYPE_CONDENSED(2)=IP_CLCMP_ST_ICE
            ELSE IF ( (I_CLOUD_REPRESENTATION
     &              .EQ.IP_CLOUD_CONV_STRAT).OR.
     &              (I_CLOUD_REPRESENTATION.EQ.IP_CLOUD_CSIW) ) THEN
               N_CONDENSED=4
               TYPE_CONDENSED(1)=IP_CLCMP_ST_WATER
               TYPE_CONDENSED(2)=IP_CLCMP_ST_ICE
               TYPE_CONDENSED(3)=IP_CLCMP_CNV_WATER
               TYPE_CONDENSED(4)=IP_CLCMP_CNV_ICE
            ENDIF
!
         ELSE IF ( L_ICE.AND.(.NOT.L_DROP) ) THEN
!           ONLY ICE IS PRESENT.
!
            IF ( (I_CLOUD_REPRESENTATION.EQ.IP_CLOUD_HOMOGEN).OR.
     &           (I_CLOUD_REPRESENTATION.EQ.IP_CLOUD_ICE_WATER) ) THEN
               N_CONDENSED=1
               TYPE_CONDENSED(1)=IP_CLCMP_ST_ICE
            ELSE IF ( (I_CLOUD_REPRESENTATION
     &              .EQ.IP_CLOUD_CONV_STRAT).OR.
     &              (I_CLOUD_REPRESENTATION.EQ.IP_CLOUD_CSIW) ) THEN
               N_CONDENSED=2
               TYPE_CONDENSED(1)=IP_CLCMP_ST_ICE
               TYPE_CONDENSED(2)=IP_CLCMP_CNV_ICE
            ENDIF
!
         ELSE IF ( (.NOT.L_ICE).AND.L_DROP ) THEN
!
!           ONLY DROPLETS ARE PRESENT.
            IF ( (I_CLOUD_REPRESENTATION.EQ.IP_CLOUD_HOMOGEN).OR.
     &           (I_CLOUD_REPRESENTATION.EQ.IP_CLOUD_ICE_WATER) ) THEN
               N_CONDENSED=1
               TYPE_CONDENSED(1)=IP_CLCMP_ST_WATER
            ELSE IF ( (I_CLOUD_REPRESENTATION
     &              .EQ.IP_CLOUD_CONV_STRAT).OR.
     &              (I_CLOUD_REPRESENTATION.EQ.IP_CLOUD_CSIW) ) THEN
               N_CONDENSED=2
               TYPE_CONDENSED(1)=IP_CLCMP_ST_WATER
               TYPE_CONDENSED(2)=IP_CLCMP_CNV_WATER
            ENDIF
!
         ELSE
!
            WRITE(IU_ERR, '(/A)') 
     &         '*** ERROR: CLOUDS ARE SPECIFIED, BUT NO CLOUDY '
     &         //'PROCESSES ARE INCLUDED.'
            STOP
!
         ENDIF
!
!        READ IN THE DATA FOR ALL COMPONENTS.
         DO I=1, N_CONDENSED
!
            IF (TYPE_CONDENSED(I).EQ.IP_CLCMP_ST_WATER) THEN
               TEXT='ENTER TYPE OF (STRATIFORM) DROPLETS'
               I_PHASE=IP_PHASE_WATER
               SUFFIX_MR(1:6)=PHYS_SUFFIX(IP_LWM)(1:6)
               SUFFIX_RE(1:6)=PHYS_SUFFIX(IP_RE)(1:6)
            ELSE IF (TYPE_CONDENSED(I).EQ.IP_CLCMP_ST_ICE) THEN
               TEXT='ENTER TYPE OF (STRATIFORM) ICE CRSYATLS'
               I_PHASE=IP_PHASE_ICE
               SUFFIX_MR(1:6)=PHYS_SUFFIX(IP_IWM)(1:6)
               SUFFIX_RE(1:6)=PHYS_SUFFIX(IP_IRE)(1:6)
            ELSE IF (TYPE_CONDENSED(I).EQ.IP_CLCMP_CNV_WATER) THEN
               TEXT='ENTER TYPE OF CONVECTIVE DROPLETS'
               I_PHASE=IP_PHASE_WATER
               SUFFIX_MR(1:6)=PHYS_SUFFIX(IP_LWMCV)(1:6)
               SUFFIX_RE(1:6)=PHYS_SUFFIX(IP_RECV)(1:6)
            ELSE IF (TYPE_CONDENSED(I).EQ.IP_CLCMP_CNV_ICE) THEN
               TEXT='ENTER TYPE OF CONVECTIVE ICE CRSYATLS'
               I_PHASE=IP_PHASE_ICE
               SUFFIX_MR(1:6)=PHYS_SUFFIX(IP_IWMCV)(1:6)
               SUFFIX_RE(1:6)=PHYS_SUFFIX(IP_IRECV)(1:6)
            ENDIF
!
            WRITE(IU_USER, '(A)') TEXT
            READ(IU_STDIN, *) I_PARAMETRIZATION_TYPE
!
!
            IF ( .NOT.( ( (I_PHASE.EQ.IP_PHASE_WATER).AND.
     &                  (I_DROP_PARAMETRIZATION(I_PARAMETRIZATION_TYPE)
     &                  .EQ.IP_DROP_UNPARAMETRIZED) ).OR.
     &                  ( (I_PHASE.EQ.IP_PHASE_ICE).AND.
     &                  (I_ICE_PARAMETRIZATION(I_PARAMETRIZATION_TYPE)
     &                  .EQ.IP_ICE_UNPARAMETRIZED) ) ) )  THEN
!              UNPARAMETRIZED DATA FROM THE SPECTRAL FILE ARE NOT USED:
!              THE PARAMETRIZATION MUST BE SET AND THE MIXING RATIO 
!              AND EFFECTIVE RADIUS MUST BE READ FROM FILES.
!
               IF (I_PHASE.EQ.IP_PHASE_WATER) THEN
                  I_CONDENSED_PARAM(I)
     &               =I_DROP_PARAMETRIZATION(I_PARAMETRIZATION_TYPE)
                  DO J=1, N_BAND
                     DO K=1, SET_N_CLOUD_PARAMETER(I_CONDENSED_PARAM(I)
     &                  , TYPE_CONDENSED(I))
                        CONDENSED_PARAM_LIST(K, I, J)
     &                     =DROP_PARAMETER_LIST(K, J
     &                     , I_PARAMETRIZATION_TYPE)
                     ENDDO
                  ENDDO
               ELSE IF (I_PHASE.EQ.IP_PHASE_ICE) THEN
                  I_CONDENSED_PARAM(I)
     &               =I_ICE_PARAMETRIZATION(I_PARAMETRIZATION_TYPE)
                  DO J=1, N_BAND
                     DO K=1, SET_N_CLOUD_PARAMETER(I_CONDENSED_PARAM(I)
     &                  , TYPE_CONDENSED(I))
                        CONDENSED_PARAM_LIST(K, I, J)
     &                     =ICE_PARAMETER_LIST
     &                     (K, J, I_PARAMETRIZATION_TYPE)
                     ENDDO
                  ENDDO
               ENDIF
!
               FILE_NAME(1: LENGTH_NAME+7)=BASE_NAME(1: LENGTH_NAME)
     &            //'.'//SUFFIX_MR
               CALL READ_SAMSON_FIELD(IERR, .TRUE., .FALSE.
     &            , FILE_NAME, TITLE_DUMMY
     &            , NDUM, N_LAYER, P, PSTAR
     &            , CONDENSED_MIX_RATIO(1, 0, I))
               IF (IERR.EQ.I_MISSING_DATA) THEN
                  WRITE(IU_ERR, '(/A)')
     &               '*** ERROR IN PROGRAM SAMSON_DRIVER.'
                  WRITE(IU_ERR, '(A, /A80,/A)') 'FILE ', FILE_NAME
     &               , ' DOES NOT EXIST'
                  IERR=I_ERR_FATAL
                  STOP
               ELSE
                  L_LEVEL_SET=.TRUE.
               ENDIF
!
               FILE_NAME(1: LENGTH_NAME+7)=BASE_NAME(1: LENGTH_NAME)
     &            //'.'//SUFFIX_RE
               CALL READ_SAMSON_FIELD(IERR, .TRUE., .FALSE.
     &            , FILE_NAME, TITLE_DUMMY
     &            , NDUM, N_LAYER, P, PSTAR
     &            , CONDENSED_RE(1, 0, I))
               IF (IERR.EQ.I_MISSING_DATA) THEN
                  WRITE(IU_ERR, '(/A)')
     &               '*** ERROR IN PROGRAM SAMSON_DRIVER.'
                  WRITE(IU_ERR, '(A, /A80,/A)') 'FILE ', FILE_NAME
     &               , ' DOES NOT EXIST'
                  IERR=I_ERR_FATAL
                  STOP
               ELSE
                  L_LEVEL_SET=.TRUE.
               ENDIF
!
            ENDIF
!
         ENDDO
!
!
!
!        SETTING OF AMOUNTS OF CLOUD:
!
!        SET THE NUMER OF TYPES OF CLOUD AND THEIR PROPERTIES FROM THE 
!        REPRESENTATION:
!
         IF (I_CLOUD_REPRESENTATION.EQ.IP_CLOUD_HOMOGEN) THEN
            N_CLOUD_TYPE=1
            SUFFIX_CL(1)(1:6)=PHYS_SUFFIX(IP_CLOUD_FRACTION)(1:6)
         ELSE IF (I_CLOUD_REPRESENTATION.EQ.IP_CLOUD_ICE_WATER) THEN
            N_CLOUD_TYPE=2
            SUFFIX_CL(1)(1:6)=PHYS_SUFFIX(IP_CLOUD_FRACTION_W)(1:6)
            SUFFIX_CL(2)(1:6)=PHYS_SUFFIX(IP_CLOUD_FRACTION_I)(1:6)
         ELSE IF (I_CLOUD_REPRESENTATION.EQ.IP_CLOUD_CONV_STRAT) THEN
            N_CLOUD_TYPE=2
            SUFFIX_CL(1)(1:6)=PHYS_SUFFIX(IP_CLOUD_FRACTION)(1:6)
            SUFFIX_CL(2)(1:6)=PHYS_SUFFIX(IP_CLOUD_FRACTION_CV)(1:6)
         ELSE IF (I_CLOUD_REPRESENTATION.EQ.IP_CLOUD_CSIW) THEN
            N_CLOUD_TYPE=4
            SUFFIX_CL(1)(1:6)=PHYS_SUFFIX(IP_CLOUD_FRACTION_W)(1:6)
            SUFFIX_CL(2)(1:6)=PHYS_SUFFIX(IP_CLOUD_FRACTION_I)(1:6)
            SUFFIX_CL(3)(1:6)=PHYS_SUFFIX(IP_CLOUD_FRACTION_W_CV)(1:6)
            SUFFIX_CL(4)(1:6)=PHYS_SUFFIX(IP_CLOUD_FRACTION_I_CV)(1:6)
         ENDIF
!
         DO I=1, N_CLOUD_TYPE
            FILE_NAME(1: LENGTH_NAME+7)=BASE_NAME(1: LENGTH_NAME)
     &         //'.'//SUFFIX_CL(I)
            CALL READ_SAMSON_FIELD(IERR, .TRUE., .FALSE.
     &         , FILE_NAME, TITLE_DUMMY
     &         , NDUM, N_LAYER, P, PSTAR, FRAC_CLOUD(1, 1, I))
            IF (IERR.EQ.I_MISSING_DATA) THEN
               WRITE(IU_ERR, '(/A)')
     &            '*** ERROR IN PROGRAM SAMSON_DRIVER.'
               WRITE(IU_ERR, '(A, /A80,/A)') 'FILE ', FILE_NAME
     &            , ' DOES NOT EXIST'
               IERR=I_ERR_FATAL
               STOP
            ENDIF
         ENDDO
!
!        NORMALIZE CLOUD FRACTIONS
         DO I=1, N_LAYER
            W_CLOUD(1, I)=0.0D+00
            DO J=1, N_CLOUD_TYPE
               W_CLOUD(1, I)=W_CLOUD(1, I)+FRAC_CLOUD(1, I, J)
            ENDDO
            IF (W_CLOUD(1, I).GT.0.0D+00) THEN
               DO J=1, N_CLOUD_TYPE
                  FRAC_CLOUD(1, I, J)=FRAC_CLOUD(1, I, J)/W_CLOUD(1, I)
               ENDDO
            ENDIF
         ENDDO
!
      ELSE
!
!        CLOUDS ARE NOT INCLUDED.
         L_CLOUD=.FALSE.
!
      ENDIF
!
!
      WRITE(IU_USER, '(A)') 'ENTER TYPE OF ANGULAR INTEGRATION.'
      READ(IU_STDIN, *) I_ANGULAR_INTEGRATION
      IF (I_ANGULAR_INTEGRATION.EQ.IP_TWO_STREAM) THEN
         WRITE(IU_USER, '(A)') 'ENTER TWO-STREAM SCHEME.'
         READ(IU_STDIN, *) I_2STREAM
         WRITE(IU_USER, '(A)') 'ENTER RESCALING FLAG.'
         READ(IU_STDIN, *) L_RESCALE
         IF (ISOLIR.EQ.IP_INFRA_RED) THEN
            WRITE(IU_USER, '(A)')
     &         'APPLY EDGE CORRECTION TO TWO-STREAM EQUATIONS? (Y/N)'
            READ(IU_STDIN, '(A)') CHAR_YN
            IF ( (CHAR_YN.EQ.'Y').OR.(CHAR_YN.EQ.'y') ) THEN
               L_2_STREAM_CORRECT=.TRUE.
            ELSE
               L_2_STREAM_CORRECT=.FALSE.
            ENDIF
         ELSE
            L_2_STREAM_CORRECT=.FALSE.
         ENDIF
         WRITE(IU_USER, '(A)') 'ENTER SOLVER.'
         READ(IU_STDIN, *) I_SOLVER
         IF (I_SOLVER.EQ.IP_SOLVER_MIX_NET) THEN
            WRITE(IU_USER, '(A)') 'EXTRAPOLATION SCHEME FOR SOLVER.'
            READ(IU_STDIN, *) I_EXTRAPOLATE_MIX_NET
         ENDIF
!        DETERMINE WHETHER UPWARD AND DOWNWARD FLUXES WILL BE AVAILABLE.
         IF ( (I_SOLVER.EQ.IP_SOLVER_TRIDIAG_NET).OR.
     &        (I_SOLVER.EQ.IP_SOLVER_MIX_NET) ) THEN
            L_NON_NET=.FALSE.
         ELSE
            L_NON_NET=.TRUE.
         ENDIF
      ELSE IF (I_ANGULAR_INTEGRATION.EQ.IP_IR_GAUSS) THEN
         WRITE(IU_USER, '(A)') 'ENTER ORDER OF GAUSSIAN QUADRATURE.'
         READ(IU_STDIN, *) N_ORDER_GAUSS
         L_NON_NET=.TRUE.
      ENDIF
!
!
      WRITE(IU_USER, '(/A)') 'ENTER TREATMENT OF SCATTERING.'
      READ(IU_STDIN, *) I_SCATTER_METHOD
      IF ( (I_SCATTER_METHOD.EQ.IP_NO_SCATTER_ABS).OR.
     &     (I_SCATTER_METHOD.EQ.IP_NO_SCATTER_EXT) ) THEN
         WRITE(IU_USER, '(A)')
     &      'ENTER SCATTERING FLAGS FOR ACTIVE BANDS.'
         READ(IU_STDIN, *) (L_SWITCH_SCATTER(J), J=NMIN, NMAX)
      ENDIF
!
!
!     READ THE TEMPERATURE
      FILE_NAME(1: LENGTH_NAME+7)=BASE_NAME(1: LENGTH_NAME)
     &   //'.'//PHYS_SUFFIX(IP_TEMPERATURE)
      CALL READ_SAMSON_FIELD(IERR, .TRUE., .FALSE.
     &   , FILE_NAME, TITLE_DUMMY
     &   , NDUM, N_LAYER, P, PSTAR, T)
      IF (IERR.EQ.I_MISSING_DATA) THEN
         WRITE(IU_ERR, '(/A)')
     &      '*** ERROR IN PROGRAM SAMSON_DRIVER.'
         WRITE(IU_ERR, '(A, /A80,/A)') 'FILE ', FILE_NAME
     &      , ' DOES NOT EXIST'
         IERR=I_ERR_FATAL
         STOP
      ELSE
         L_LEVEL_SET=.TRUE.
      ENDIF
!
      IF (ISOLIR.EQ.IP_INFRA_RED) THEN
!        SURFACE TEMPERATURE DATA ARE REQUIRED.
         FILE_NAME(1: LENGTH_NAME+7)=BASE_NAME(1: LENGTH_NAME)
     &      //'.'//PHYS_SUFFIX(IP_TEMPERATURE_GROUND)
         CALL READ_SAMSON_FIELD(IERR, .TRUE., .FALSE.
     &      , FILE_NAME, TITLE_DUMMY
     &      , NDUM, N_LAYER_DUMMY, P_DUMMY, PSTAR, T_GROUND)
         IF (IERR.EQ.I_MISSING_DATA) THEN
            WRITE(IU_ERR, '(/A)')
     &         '*** ERROR IN PROGRAM SAMSON_DRIVER.'
            WRITE(IU_ERR, '(A, /A80,/A)') 'FILE ', FILE_NAME
     &         , ' DOES NOT EXIST'
            IERR=I_ERR_FATAL
            STOP
         ENDIF
!        LEVEL TEMPERATURES MUST BE ASSIGNED.
         DO I=0, N_LAYER
            T_LEVEL(1, I)=T(1, I)
         ENDDO
      ENDIF
!
      IF (.NOT.L_LEVEL_SET) THEN
!        A FILE OF PRESSURE LEVELS IS REQUIRED IF IT HAS NOT BEEN
!        READ INDIRECTLY FROM ANOTHER FILE.
         FILE_NAME(1: LENGTH_NAME+7)=BASE_NAME(1: LENGTH_NAME)
     &      //PHYS_SUFFIX(IP_PRESSURE)
         CALL READ_SAMSON_FIELD(IERR, .TRUE., .FALSE.
     &      , FILE_NAME, TITLE_DUMMY
     &      , NDUM, N_LAYER, P, PSTAR, P_DUMMY)
         L_LEVEL_SET=.TRUE.
         IF (IERR.EQ.I_MISSING_DATA) THEN
            WRITE(IU_ERR, '(A)')
     &         '*** ERROR: PRESSURE DATA MISSING.'
            WRITE(IU_ERR, '(A)') 'NO SIMULATION IS POSSIBLE.'
            IERR=I_ERR_FATAL
            STOP
         ENDIF
      ENDIF
!
!     DETERMINE THE MASS IN EACH LAYER.
      DO I=N_LAYER, 1, -1
         D_MASS(1, I)=(P(1, I)-P(1, I-1))/GRAV_ACC
      ENDDO
!
!
!     INPUT OF DATA COMPLETED. INFER FURTHER FLAGS, CARRY OUT CHECKS,
!     AND PROCEED TO SOLVE EQUATIONS.
!
      WRITE(IU_USER, '(A)') 'ENTER CHECK FLAG.'
      READ(IU_STDIN, *) L_CHECK
      IF (L_CHECK) THEN
!        CHECK THAT THE SPECTRAL DATA IS SUFFICIENT FOR THE PROBLEM
!        TO BE SOLVED.
         CALL CHECK_DATA(IERR
     &      , 1
     &      , ISOLIR
     &      , L_PRESENT
     &      , L_RAYLEIGH, L_AEROSOL, L_GAS, L_CONTINUUM
     &      , L_CLOUD, I_CLOUD, L_DROP, L_ICE
     &      , L_DROP_TYPE, L_ICE_TYPE, I_DROP, I_ICE
     &      , L_SURFACE, I_SURFACE
     &      , L_DOPPLER, L_DOPPLER_PRESENT, N_ABSORB
     &      )
         IF (IERR.EQ.I_ERR_FATAL) STOP
      ENDIF
!
!     CALCULATE THE DIRECT, DOWNWARD AND UPWARD FLUXES.
      CALL 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, NMIN, NMAX, WEIGHT_BAND
!			General Atmospheric Properties
     &   , 1, N_LAYER
     &   , .FALSE., .FALSE.
     &   , 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
     &   , .FALSE.
!			Gaseous Absorption
     &   , N_ABSORB, I_GAS_OVERLAP, I_GAS_SPECIES
     &   , 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_DROP_DATA_LAYER(I_DROP)
     &   , DROP_PRESSURE(0, I_DROP)
     &   , DROP_ABSORPTION(0, 1, I_DROP)
     &   , DROP_SCATTERING(0, 1, I_DROP)
     &   , DROP_ASYMMETRY(0, 1, I_DROP)
     &   , N_ICE_DATA_LAYER(I_ICE), ICE_PRESSURE(0, I_ICE)
     &   , ICE_ABSORPTION(0, 1, I_ICE)
     &   , ICE_SCATTERING(0, 1, I_ICE)
     &   , ICE_ASYMMETRY(0, 1, I_ICE)
!			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
     &   )
      IF (IERR.EQ.I_ERR_FATAL) STOP
!
!
!     CALCULATE THE HEATING RATES AND NET FLUX AND PRODUCE THE OUTPUT.
      DO I=0, N_LAYER
         FLUX_NET(1, I)=FLUX_DOWN(1, I)-FLUX_UP(1, I)
      ENDDO
      DO I=1, N_LAYER
         HEATING_RATE(1, I)=(FLUX_NET(1, I-1)-FLUX_NET(1, I))
     &         /(D_MASS(1, I)*CP_AIR_DRY)
!        CONVERT TO KELVIN PER DAY.
         HEATING_RATE(1, I)=SECONDS_PER_DAY*HEATING_RATE(1, I)
         MEAN_PRESSURE(1, I)=0.5D+00*(P(1, I-1)+P(1, I))
      ENDDO
      IF (ISOLIR.EQ.IP_SOLAR) THEN
         DO I=0, N_LAYER
            FLUX_DIFFUSE_DOWN(1, I)=FLUX_DOWN(1, I)-FLUX_DIRECT(1, I)
         ENDDO
      ENDIF
!
!     WRITE OUT THE SAMSON FILES.
      IF (L_NON_NET) THEN
         FILE_NAME(1: LENGTH_NAME+7)=BASE_NAME(1: LENGTH_NAME)
     &      //'.'//PHYS_SUFFIX(IP_FLUX_DOWN)
         IF (ISOLIR.EQ.IP_SOLAR) THEN
            CALL WRITE_SAMSON_FIELD(IERR, .FALSE., FILE_NAME
     &         , PHYS_TITLE(IP_FLUX_DOWN), 1, N_LAYER
     &         , P, PSTAR, FLUX_DIFFUSE_DOWN)
         ELSE IF (ISOLIR.EQ.IP_INFRA_RED) THEN
            CALL WRITE_SAMSON_FIELD(IERR, .FALSE., FILE_NAME
     &         , PHYS_TITLE(IP_FLUX_DOWN), 1, N_LAYER
     &         , P, PSTAR, FLUX_DOWN)
         ENDIF
         FILE_NAME(1: LENGTH_NAME+7)=BASE_NAME(1: LENGTH_NAME)
     &      //'.'//PHYS_SUFFIX(IP_FLUX_UP)
         CALL WRITE_SAMSON_FIELD(IERR, .FALSE., FILE_NAME
     &      , PHYS_TITLE(IP_FLUX_UP)
     &      , 1, N_LAYER, P, PSTAR, FLUX_UP)
      ENDIF
      FILE_NAME(1: LENGTH_NAME+7)=BASE_NAME(1: LENGTH_NAME)
     &   //'.'//PHYS_SUFFIX(IP_FLUX_NET)
      CALL WRITE_SAMSON_FIELD(IERR, .FALSE., FILE_NAME
     &   , PHYS_TITLE(IP_FLUX_NET)
     &   , 1, N_LAYER, P, PSTAR, FLUX_NET)
      IF (ISOLIR.EQ.IP_SOLAR) THEN
         FILE_NAME(1: LENGTH_NAME+7)=BASE_NAME(1: LENGTH_NAME)
     &      //'.'//PHYS_SUFFIX(IP_FLUX_DIRECT)
         CALL WRITE_SAMSON_FIELD(IERR, .FALSE., FILE_NAME
     &      , PHYS_TITLE(IP_FLUX_DIRECT)
     &      , 1, N_LAYER, P, PSTAR, FLUX_DIRECT)
         IF (L_NON_NET) THEN
            FILE_NAME(1: LENGTH_NAME+7)=BASE_NAME(1: LENGTH_NAME)
     &         //'.'//PHYS_SUFFIX(IP_FLUX_TOTAL_DOWN)
            CALL WRITE_SAMSON_FIELD(IERR, .FALSE., FILE_NAME
     &         , PHYS_TITLE(IP_FLUX_TOTAL_DOWN)
     &         , 1, N_LAYER, P, PSTAR, FLUX_DOWN)
         ENDIF
      ENDIF
      FILE_NAME(1: LENGTH_NAME+7)=BASE_NAME(1: LENGTH_NAME)
     &   //'.'//PHYS_SUFFIX(IP_HEATING_RATE)
      CALL WRITE_SAMSON_FIELD(IERR, .FALSE., FILE_NAME
     &   , PHYS_TITLE(IP_HEATING_RATE), 1, N_LAYER-1, MEAN_PRESSURE
     &   , PSTAR, HEATING_RATE)
!
!
      STOP
      END
