!+ Subroutines to read a Spectral File.
!
! Method:
!	The file is opened with checks. Logical arrays are set.
!	The file is now read until a line beginning a block is found.
!	A routine is called to read the block which in turn calls
!	an appropriate subroutine depending on the type, sub-type
!	and version of the block.
!
! 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 IN_SPECTRUM(IERR
     &   , FILE_SPECTRAL
     &   , L_PRESENT
     &   , N_BAND
     &   , N_ABSORB, N_BAND_ABSORB, INDEX_ABSORB, TYPE_ABSORB
     &   , N_AEROSOL, TYPE_AEROSOL
     &   , N_BAND_CONTINUUM, INDEX_CONTINUUM, INDEX_WATER
     &   , I_BAND_ESFT, K_ESFT, W_ESFT, I_SCALE_ESFT
     &   , I_SCALE_FNC, SCALE_VECTOR, P_REFERENCE, T_REFERENCE
     &   , WAVE_LENGTH_SHORT , WAVE_LENGTH_LONG
     &   , N_BAND_EXCLUDE, INDEX_EXCLUDE
     &   , SOLAR_FLUX_BAND, N_DEG_FIT, THERMAL_COEFFICIENT, T_REF_PLANCK
     &   , RAYLEIGH_COEFFICIENT
     &   , I_SPEC_SURFACE, SURFACE_ALBEDO, N_DIR_ALBEDO_FIT
     &   , DIRECT_ALBEDO_PARM, EMISSIVITY_GROUND, L_SURFACE
     &   , K_CONTINUUM, I_SCALE_FNC_CONT, SCALE_CONTINUUM
     &   , P_REF_CONTINUUM, T_REF_CONTINUUM
     &   , L_DROP_TYPE, I_DROP_PARAMETRIZATION, DROP_PARAMETER_LIST
     &   , N_DROP_DATA_LAYER, DROP_PRESSURE, DROP_ABSORPTION
     &   , DROP_SCATTERING, DROP_ASYMMETRY
     &   , L_ICE_TYPE, I_ICE_PARAMETRIZATION, ICE_PARAMETER_LIST
     &   , N_ICE_DATA_LAYER, ICE_PRESSURE
     &   , ICE_ABSORPTION
     &   , ICE_SCATTERING, ICE_ASYMMETRY
     &   , L_AEROSOL_SPECIES, AEROSOL_ABSORPTION
     &   , AEROSOL_SCATTERING, AEROSOL_ASYMMETRY
     &   , NHUMIDITY, HUMIDITIES, I_AEROSOL_PARAMETRIZATION
     &   , N_AEROSOL_DATA_LAYER, OBS_AEROSOL_PRESSURE
     &   , OBS_AEROSOL_ABSORPTION
     &   , OBS_AEROSOL_SCATTERING, OBS_AEROSOL_ASYMMETRY
     &   , L_DOPPLER_PRESENT, DOPPLER_CORRECTION
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/gas_list.pcf'
      INCLUDE 'incl/continuum.pcf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY VARIABLES.
      CHARACTER	!, INTENT(IN)
     &     FILE_SPECTRAL*80
!             SPECTRAL FILE
      INTEGER	!, INTENT(OUT)
     &     IERR
!             OUT  ERROR FLAG
!
!     INCLUDE DECLARATIONS OF SPECTRAL QUANTITIES.
      INCLUDE 'dec_spec.finc'
!
!     LOCAL VARIABLES.
      CHARACTER
     &     LINE*80
!             LINE READ FROM FILE
     &   , CHAR_DUM*80
!             DUMMY CHARCATER VARIABLE
      INTEGER
     &     IOS
!             IO VARIABLE
     &   , I_TYPE
!             TYPE OF BLOCK READ IN
     &   , I_SUBTYPE
!             SUBTYPE OF BLOCK
     &   , I_VERSION
!             VERSION FOR TYPE AND SUBTYPE
     &   , I
!             LOOP VARIABLE
      LOGICAL
     &     L_EXIST
!             EXISTENCE FLAG FOR FILE
     &   , L_OPEN
!             OPEN FLAG FOR FILE
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     READ_BLOCK
!
!
!
!     IT IS IMPORTANT TO KNOW WHICH GAS IS WATER VAPOUR FOR SOME
!     APPLICATIONS: HERE WE INITIALIZE INDEX_WATER TO 0 TO
!     PRODUCE AN ERROR IN THE CODE IF IT IS NOT RESET TO A LEGAL VALUE.
!     THIS SHOULD GUARD AGAINST OMITTING WATER VAPOUR WHEN IT IS NEEDED.
      INDEX_WATER=0
!
!     CHECK THAT THE SPECTRAL FILE EXISTS.
      INQUIRE(FILE=FILE_SPECTRAL, EXIST=L_EXIST)
      IF (.NOT.L_EXIST) THEN
         WRITE(IU_ERR, '(/A)') '*** ERROR: FILE DOES NOT EXIST.'
         IERR=I_ERR_EXIST
         RETURN
      ENDIF
!     CHECK THAT THE UNIT IS NOT ALREADY OPEN.
      INQUIRE(IU_SPC, OPENED=L_OPEN)
      IF (L_OPEN) THEN
         WRITE(IU_ERR, '(/A)') '*** ERROR: UNIT IS ALREADY CONNECTED.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
!
!     OPEN THE FILE FOR READING
      OPEN(UNIT=IU_SPC, FILE=FILE_SPECTRAL, IOSTAT=IOS
     &   , STATUS='OLD')
      IF (IOS.NE.0) THEN
         WRITE(IU_ERR, '(/A)') '*** ERROR: FILE COULD NOT BE OPENED.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
!
!     INITIALIZE THE ELEMENTS OF THE ARRAYS L_PRESENT
!     L_SURFACE AND L_AERSOL_SPECIES TO FALSE.
      DO I=0, NPD_TYPE
         L_PRESENT(I)=.FALSE.
      ENDDO
      DO I=1, NPD_SURFACE
         L_SURFACE(I)=.FALSE.
      ENDDO
      DO I=1, NPD_AEROSOL_SPECIES
         L_AEROSOL_SPECIES(I)=.FALSE.
      ENDDO
      DO I=1, NPD_DROP_TYPE
         L_DROP_TYPE(I)=.FALSE.
      ENDDO
!
!
!     READ THROUGH THE FILE PROCESSING THE BLOCKS OF DATA AS THEY
!     ARE ENCOUNTERED.
!     EACH LINE IS READ INTO AN INTERNAL FILE AND THEN PROCESSED.
100   READ(IU_SPC, '(A80)', END=101) LINE
!     LOCATE A BLOCK HEADER.
      IF (LINE(1:6).EQ.'*BLOCK') THEN
         READ(LINE, FMT='(A15, I4, 12X, I4, 12X, I4)', IOSTAT=IOS)
     &      CHAR_DUM, I_TYPE, I_SUBTYPE, I_VERSION
         IF (IOS.NE.0) THEN
            WRITE(IU_ERR, '(/A/)')
     &         '*** ERROR IN SUBROUTINE IN_SPECTRUM.'
            WRITE(IU_ERR, *) 'BLOCK HEADER IS INCORRECT.'
            IERR=I_ERR_FATAL
            RETURN
         ENDIF
!
!        READ IN THE REST OF THE BLOCK.
         CALL READ_BLOCK(IERR
     &      , I_TYPE, I_SUBTYPE, I_VERSION
     &      , N_BAND
     &      , N_ABSORB, N_BAND_ABSORB, INDEX_ABSORB, TYPE_ABSORB
     &      , N_AEROSOL, TYPE_AEROSOL
     &      , N_BAND_CONTINUUM, INDEX_CONTINUUM, INDEX_WATER
     &      , I_BAND_ESFT, K_ESFT, W_ESFT, I_SCALE_ESFT
     &      , I_SCALE_FNC, SCALE_VECTOR, P_REFERENCE, T_REFERENCE
     &      , WAVE_LENGTH_SHORT, WAVE_LENGTH_LONG
     &      , N_BAND_EXCLUDE, INDEX_EXCLUDE
     &      , SOLAR_FLUX_BAND
     &      , N_DEG_FIT, THERMAL_COEFFICIENT, T_REF_PLANCK
     &      , RAYLEIGH_COEFFICIENT
     &      , I_SPEC_SURFACE, SURFACE_ALBEDO, N_DIR_ALBEDO_FIT
     &      , DIRECT_ALBEDO_PARM, EMISSIVITY_GROUND, L_SURFACE
     &      , K_CONTINUUM, I_SCALE_FNC_CONT, SCALE_CONTINUUM
     &      , P_REF_CONTINUUM, T_REF_CONTINUUM
     &      , L_DROP_TYPE, I_DROP_PARAMETRIZATION, DROP_PARAMETER_LIST
     &      , N_DROP_DATA_LAYER, DROP_PRESSURE, DROP_ABSORPTION
     &      , DROP_SCATTERING, DROP_ASYMMETRY
     &      , L_ICE_TYPE, I_ICE_PARAMETRIZATION
     &      , ICE_PARAMETER_LIST
     &      , N_ICE_DATA_LAYER, ICE_PRESSURE
     &      , ICE_ABSORPTION, ICE_SCATTERING
     &      , ICE_ASYMMETRY
     &      , L_AEROSOL_SPECIES, AEROSOL_ABSORPTION
     &      , AEROSOL_SCATTERING, AEROSOL_ASYMMETRY
     &      , NHUMIDITY, HUMIDITIES, I_AEROSOL_PARAMETRIZATION
     &      , N_AEROSOL_DATA_LAYER, OBS_AEROSOL_PRESSURE
     &      , OBS_AEROSOL_ABSORPTION
     &      , OBS_AEROSOL_SCATTERING, OBS_AEROSOL_ASYMMETRY
     &      , L_DOPPLER_PRESENT, DOPPLER_CORRECTION
     &      )
         IF (IERR.NE.I_NORMAL) THEN
            RETURN
         ENDIF
!
!        READ IN THE TERMINATION STATEMENT
         READ(IU_SPC, '(A4)') CHAR_DUM
         IF (CHAR_DUM(1:4).NE.'*END') THEN
            WRITE(IU_ERR, '(/A/)') '*** ERROR IN SUBROUTINE IN_SPECTRUM'
            WRITE(IU_ERR, *) 'BLOCK INCORRECTLY TERMINATED.'
            WRITE(IU_ERR, '(2X, A7, I5, A13, I5, A12, I5)')
     &         'TYPE = ', I_TYPE
     &         , ': SUB-TYPE = ', I_SUBTYPE
     &         , ': VERSION = ', I_VERSION
            IERR=I_ERR_FATAL
            RETURN
         ENDIF
!
!        THE BLOCK HAS BEEN PROPERLY READ: RECORD THE DATA AS PRESENT.
         L_PRESENT(I_TYPE)=.TRUE.
!
      ENDIF
!
!     READ NEXT LINE.
      GOTO 100
!
!
!     CLOSE THE FILE.
101   CLOSE(IU_SPC)
!
!     SET THE INDEX OF WATER.
      DO I=1, N_ABSORB
         IF (TYPE_ABSORB(I).EQ.IP_H2O) INDEX_WATER=I
      ENDDO
!
!
      RETURN
      END
!     *****************************************************************
!     *                                                               *
!     *      SUBROUTINE TO CONTROL THE READING IN OF BLOCKS OF DATA.  *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE READ_BLOCK(IERR
     &   , I_TYPE, I_SUBTYPE, I_VERSION
     &   , N_BAND
     &   , N_ABSORB, N_BAND_ABSORB, INDEX_ABSORB, TYPE_ABSORB
     &   , N_AEROSOL, TYPE_AEROSOL
     &   , N_BAND_CONTINUUM, INDEX_CONTINUUM, INDEX_WATER
     &   , I_BAND_ESFT, K_ESFT, W_ESFT, I_SCALE_ESFT
     &   , I_SCALE_FNC, SCALE_VECTOR, P_REFERENCE, T_REFERENCE
     &   , WAVE_LENGTH_SHORT , WAVE_LENGTH_LONG
     &   , N_BAND_EXCLUDE, INDEX_EXCLUDE
     &   , SOLAR_FLUX_BAND, N_DEG_FIT, THERMAL_COEFFICIENT, T_REF_PLANCK
     &   , RAYLEIGH_COEFFICIENT
     &   , I_SPEC_SURFACE, SURFACE_ALBEDO, N_DIR_ALBEDO_FIT
     &   , DIRECT_ALBEDO_PARM, EMISSIVITY_GROUND, L_SURFACE
     &   , K_CONTINUUM, I_SCALE_FNC_CONT, SCALE_CONTINUUM
     &   , P_REF_CONTINUUM, T_REF_CONTINUUM
     &   , L_DROP_TYPE, I_DROP_PARAMETRIZATION, DROP_PARAMETER_LIST
     &   , N_DROP_DATA_LAYER, DROP_PRESSURE, DROP_ABSORPTION
     &   , DROP_SCATTERING, DROP_ASYMMETRY
     &   , L_ICE_TYPE, I_ICE_PARAMETRIZATION
     &   , ICE_PARAMETER_LIST
     &   , N_ICE_DATA_LAYER, ICE_PRESSURE
     &   , ICE_ABSORPTION, ICE_SCATTERING
     &   , ICE_ASYMMETRY
     &   , L_AEROSOL_SPECIES, AEROSOL_ABSORPTION
     &   , AEROSOL_SCATTERING, AEROSOL_ASYMMETRY
     &   , NHUMIDITY, HUMIDITIES, I_AEROSOL_PARAMETRIZATION
     &   , N_AEROSOL_DATA_LAYER, OBS_AEROSOL_PRESSURE
     &   , OBS_AEROSOL_ABSORPTION
     &   , OBS_AEROSOL_SCATTERING, OBS_AEROSOL_ASYMMETRY
     &   , L_DOPPLER_PRESENT, DOPPLER_CORRECTION
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/error.pcf'
      INCLUDE 'incl/continuum.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
      INTEGER	!, INTENT(IN)
     &     I_TYPE
!             TYPE OF BLOCK
     &   , I_SUBTYPE
!             SUBTYPE OF BLOCK
     &   , I_VERSION
!             VERSION OF BLOCK
     &   , I
!             LOOP VARIABLE
      INCLUDE 'dec_spec.finc'
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     READ_BLOCK_0_0_0, READ_BLOCK_0_0_1, READ_BLOCK_1_0_0
     &   , READ_BLOCK_2_0_0, READ_BLOCK_3_0_0, READ_BLOCK_4_0_0
     &   , READ_BLOCK_5_0_0, READ_BLOCK_6_0_0, READ_BLOCK_7_0_0
     &   , READ_BLOCK_7_1_0, READ_BLOCK_7_2_0, READ_BLOCK_7_3_0
     &   , READ_BLOCK_7_4_0, READ_BLOCK_7_4_1, READ_BLOCK_8_0_0
     &   , READ_BLOCK_9_0_0, READ_BLOCK_10_0_0
     &   , READ_BLOCK_10_2_0, READ_BLOCK_11_0_0
     &   , READ_BLOCK_11_0_1, READ_BLOCK_11_1_0
     &   , READ_BLOCK_11_1_1, READ_BLOCK_11_2_0
     &   , READ_BLOCK_12_0_0, READ_BLOCK_12_2_0
     &   , READ_BLOCK_13_0_0, READ_BLOCK_14_0_0
!
!
!
!     DEPENDING ON THE VALUE OF I_TYPE, THE APPROPRIATE SUBROUTINE
!     IS CALLED.
      IF (I_TYPE.EQ.0) THEN
         IF (I_SUBTYPE.EQ.0) THEN
            IF (I_VERSION.EQ.0) THEN
               CALL READ_BLOCK_0_0_0(IERR
     &            , N_BAND, N_ABSORB, TYPE_ABSORB
     &            )
CMOD-08-06-93: NEW INDEXING SCHEME FOR AEROSOLS INTRODUCED.
!              SET THE NEW AEROSOL ARRAYS TO GIVE COMPATIBILITY WITH
!              THE OLD SPECTRAL FILE.
               N_AEROSOL=7
               IF (NPD_AEROSOL_SPECIES.LT.N_AEROSOL) THEN
                  WRITE(IU_ERR, '(/A)')
     &               '*** ERROR IN SUBROUTINE READ_BLOCK'
                  WRITE(IU_ERR, '(A)')
     &               'YOU HAVE TRIED TO READ AN OLD SPECTRAL FILE WITH'
     &               //' TOO LOW A VALUE OF NPD_AEROSOL_SPECIES.'
                  WRITE(IU_ERR, '(A)')
     &               'RECOMPILE; WITH THIS PARAMETER SET TO 7 OR '
     &               //'GREATER.'
                  IERR=I_ERR_FATAL
                  RETURN
               ENDIF
               DO I=1, N_AEROSOL
                  TYPE_AEROSOL(I)=I
               ENDDO
            ELSE IF (I_VERSION.EQ.1) THEN
               CALL READ_BLOCK_0_0_1(IERR
     &            , N_BAND, N_ABSORB, TYPE_ABSORB
     &            , N_AEROSOL, TYPE_AEROSOL
     &            )
            ENDIF
         ENDIF
      ELSE IF (I_TYPE.EQ.1) THEN
         IF (I_SUBTYPE.EQ.0) THEN
            IF (I_VERSION.EQ.0) THEN
               CALL READ_BLOCK_1_0_0(IERR
     &            , N_BAND
     &            , WAVE_LENGTH_SHORT, WAVE_LENGTH_LONG
     &            )
            ENDIF
         ENDIF
      ELSE IF (I_TYPE.EQ.2) THEN
         IF (I_SUBTYPE.EQ.0) THEN
            IF (I_VERSION.EQ.0) THEN
               CALL READ_BLOCK_2_0_0(IERR
     &            , N_BAND
     &            , SOLAR_FLUX_BAND
     &            )
            ENDIF
         ENDIF
      ELSE IF (I_TYPE.EQ.3) THEN
         IF (I_SUBTYPE.EQ.0) THEN
            IF (I_VERSION.EQ.0) THEN
               CALL READ_BLOCK_3_0_0(IERR
     &            , N_BAND
     &            , RAYLEIGH_COEFFICIENT
     &            )
            ENDIF
         ENDIF
      ELSE IF (I_TYPE.EQ.4) THEN
         IF (I_SUBTYPE.EQ.0) THEN
            IF (I_VERSION.EQ.0) THEN
               CALL READ_BLOCK_4_0_0(IERR
     &            , N_BAND
     &            , N_BAND_ABSORB, INDEX_ABSORB
     &            )
            ENDIF
         ENDIF
      ELSE IF (I_TYPE.EQ.5) THEN
         IF (I_SUBTYPE.EQ.0) THEN
            IF (I_VERSION.EQ.0) THEN
               CALL READ_BLOCK_5_0_0(IERR
     &            , N_BAND, N_BAND_ABSORB
     &            , I_BAND_ESFT, K_ESFT, W_ESFT, I_SCALE_ESFT
     &            , I_SCALE_FNC, SCALE_VECTOR, P_REFERENCE, T_REFERENCE
     &            )
            ENDIF
         ENDIF
      ELSE IF (I_TYPE.EQ.6) THEN
         IF (I_SUBTYPE.EQ.0) THEN
            IF (I_VERSION.EQ.0) THEN
               CALL READ_BLOCK_6_0_0(IERR
     &            , N_BAND, N_DEG_FIT
     &            , T_REF_PLANCK, THERMAL_COEFFICIENT
     &            )
            ENDIF
         ENDIF
      ELSE IF (I_TYPE.EQ.7) THEN
         IF (I_SUBTYPE.EQ.0) THEN
            IF (I_VERSION.EQ.0) THEN
               CALL READ_BLOCK_7_0_0(IERR
     &            , N_BAND
     &            , SURFACE_ALBEDO, EMISSIVITY_GROUND, L_SURFACE
     &            , I_SPEC_SURFACE
     &            )
            ENDIF
         ENDIF
         IF (I_SUBTYPE.EQ.1) THEN
            IF (I_VERSION.EQ.0) THEN
               CALL READ_BLOCK_7_1_0(IERR
     &            , N_BAND
     &            , SURFACE_ALBEDO, EMISSIVITY_GROUND, L_SURFACE
     &            , I_SPEC_SURFACE
     &            )
            ENDIF
         ENDIF
         IF (I_SUBTYPE.EQ.2) THEN
            IF (I_VERSION.EQ.0) THEN
               CALL READ_BLOCK_7_2_0(IERR
     &            , L_SURFACE, I_SPEC_SURFACE
     &            )
            ENDIF
         ENDIF
         IF (I_SUBTYPE.EQ.3) THEN
            IF (I_VERSION.EQ.0) THEN
               CALL READ_BLOCK_7_3_0(IERR
     &            , N_BAND
     &            , SURFACE_ALBEDO, N_DIR_ALBEDO_FIT, DIRECT_ALBEDO_PARM
     &            , EMISSIVITY_GROUND, L_SURFACE, I_SPEC_SURFACE
     &            )
            ENDIF
         ENDIF
         IF (I_SUBTYPE.EQ.4) THEN
            IF (I_VERSION.EQ.0) THEN
               CALL READ_BLOCK_7_4_0(IERR
     &            , N_BAND
     &            , SURFACE_ALBEDO, N_DIR_ALBEDO_FIT, DIRECT_ALBEDO_PARM
     &            , EMISSIVITY_GROUND, L_SURFACE, I_SPEC_SURFACE
     &            )
            ELSE IF (I_VERSION.EQ.1) THEN
               CALL READ_BLOCK_7_4_1(IERR
     &            , N_BAND
     &            , SURFACE_ALBEDO, N_DIR_ALBEDO_FIT, DIRECT_ALBEDO_PARM
     &            , EMISSIVITY_GROUND, L_SURFACE, I_SPEC_SURFACE
     &            )
            ENDIF
         ENDIF
      ELSE IF (I_TYPE.EQ.8) THEN
         IF (I_SUBTYPE.EQ.0) THEN
            IF (I_VERSION.EQ.0) THEN
               CALL READ_BLOCK_8_0_0(IERR
     &            , N_BAND
     &            , N_BAND_CONTINUUM, INDEX_CONTINUUM, INDEX_WATER
     &            )
            ENDIF
         ENDIF
      ELSE IF (I_TYPE.EQ.9) THEN
         IF (I_SUBTYPE.EQ.0) THEN
            IF (I_VERSION.EQ.0) THEN
               CALL READ_BLOCK_9_0_0(IERR
     &            , N_BAND, N_BAND_CONTINUUM
     &            , K_CONTINUUM
     &            , I_SCALE_FNC_CONT, SCALE_CONTINUUM
     &            , P_REF_CONTINUUM, T_REF_CONTINUUM
     &            )
            ENDIF
         ENDIF
      ELSE IF (I_TYPE.EQ.10) THEN
         IF (I_SUBTYPE.EQ.0) THEN
            IF (I_VERSION.EQ.0) THEN
               CALL READ_BLOCK_10_0_0(IERR
     &            , N_BAND
     &            , L_DROP_TYPE, I_DROP_PARAMETRIZATION
     &            , DROP_PARAMETER_LIST
     &            )
            ENDIF
         ELSE IF (I_SUBTYPE.EQ.2) THEN
            IF (I_VERSION.EQ.0) THEN
               CALL READ_BLOCK_10_2_0(IERR
     &            , N_BAND
     &            , L_DROP_TYPE, I_DROP_PARAMETRIZATION
     &            , N_DROP_DATA_LAYER, DROP_PRESSURE
     &            , DROP_ABSORPTION, DROP_SCATTERING, DROP_ASYMMETRY
     &            )
            ENDIF
         ENDIF
      ELSE IF (I_TYPE.EQ.11) THEN
         IF (I_SUBTYPE.EQ.0) THEN
            IF (I_VERSION.EQ.0) THEN
               CALL READ_BLOCK_11_0_0(IERR
     &            , N_BAND, L_AEROSOL_SPECIES
     &            , AEROSOL_ABSORPTION, AEROSOL_SCATTERING
     &            , AEROSOL_ASYMMETRY
     &            , NHUMIDITY, I_AEROSOL_PARAMETRIZATION
     &            )
            ELSE IF (I_VERSION.EQ.1) THEN
               CALL READ_BLOCK_11_0_1(IERR
     &            , N_BAND, L_AEROSOL_SPECIES
     &            , AEROSOL_ABSORPTION, AEROSOL_SCATTERING
     &            , AEROSOL_ASYMMETRY
     &            , NHUMIDITY, I_AEROSOL_PARAMETRIZATION
     &            )
            ENDIF
         ELSE IF (I_SUBTYPE.EQ.1) THEN
            IF (I_VERSION.EQ.0) THEN
               CALL READ_BLOCK_11_1_0(IERR
     &            , N_BAND, L_AEROSOL_SPECIES
     &            , AEROSOL_ABSORPTION, AEROSOL_SCATTERING
     &            , AEROSOL_ASYMMETRY
     &            , NHUMIDITY, HUMIDITIES, I_AEROSOL_PARAMETRIZATION
     &            )
            ELSE IF (I_VERSION.EQ.1) THEN
               CALL READ_BLOCK_11_1_1(IERR
     &            , N_BAND, L_AEROSOL_SPECIES
     &            , AEROSOL_ABSORPTION, AEROSOL_SCATTERING
     &            , AEROSOL_ASYMMETRY
     &            , NHUMIDITY, HUMIDITIES, I_AEROSOL_PARAMETRIZATION
     &            )
            ENDIF
         ELSE IF (I_SUBTYPE.EQ.2) THEN
            IF (I_VERSION.EQ.0) THEN
               CALL READ_BLOCK_11_2_0(IERR
     &            , N_BAND
     &            , L_AEROSOL_SPECIES, I_AEROSOL_PARAMETRIZATION
     &            , N_AEROSOL_DATA_LAYER
     &            , OBS_AEROSOL_PRESSURE, OBS_AEROSOL_ABSORPTION
     &            , OBS_AEROSOL_SCATTERING, OBS_AEROSOL_ASYMMETRY
     &            )
            ENDIF
         ENDIF
      ELSE IF (I_TYPE.EQ.12) THEN
         IF (I_SUBTYPE.EQ.0) THEN
            IF (I_VERSION.EQ.0) THEN
               CALL READ_BLOCK_12_0_0(IERR
     &            , N_BAND
     &            , L_ICE_TYPE, I_ICE_PARAMETRIZATION
     &            , ICE_PARAMETER_LIST
     &            )
            ENDIF
         ELSE IF (I_SUBTYPE.EQ.2) THEN
            IF (I_VERSION.EQ.0) THEN
               CALL READ_BLOCK_12_2_0(IERR
     &            , N_BAND
     &            , L_ICE_TYPE, I_ICE_PARAMETRIZATION
     &            , N_ICE_DATA_LAYER, ICE_PRESSURE
     &            , ICE_ABSORPTION, ICE_SCATTERING
     &            , ICE_ASYMMETRY
     &            )
            ENDIF
         ENDIF
      ELSE IF (I_TYPE.EQ.13) THEN
         IF (I_SUBTYPE.EQ.0) THEN
            IF (I_VERSION.EQ.0) THEN
               CALL READ_BLOCK_13_0_0(IERR
     &            , N_ABSORB, L_DOPPLER_PRESENT, DOPPLER_CORRECTION
     &            )
            ENDIF
         ENDIF
      ELSE IF (I_TYPE.EQ.14) THEN
         IF (I_SUBTYPE.EQ.0) THEN
            IF (I_VERSION.EQ.0) THEN
               CALL READ_BLOCK_14_0_0(IERR
     &            , N_BAND, N_BAND_EXCLUDE, INDEX_EXCLUDE
     &            )
            ENDIF
         ENDIF
      ELSE
!        THE VALUE OF I_TYPE DOES NOT CORRESPOND TO A SUPPORTED TYPE
!        OF BLOCK.
         WRITE(IU_ERR, '(/A/)') '*** ERROR IN SUBROUTINE READ_BLOCK.'
         WRITE(IU_ERR, '(A17, I4)') 'VALUE OF I_TYPE = ',I_TYPE
         WRITE(IU_ERR, *) 'THIS VALUE IS NOT IMPLEMENTED.'
         IERR=I_ERR_FATAL
      ENDIF
!
!     CEASE READING IF AN ERROR IS ENCOUNTERED.
      IF (IERR.NE.I_NORMAL) THEN
         RETURN
      ENDIF
!
!
      RETURN
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO READ IN THE CONTENTS OF BLOCK TYPE 0.       *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE READ_BLOCK_0_0_0(IERR
     &   , N_BAND, N_ABSORB, TYPE_ABSORB
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!              ERROR FLAG
     &   , N_BAND
!              NUMBER OF BANDS
     &   , N_ABSORB
!              NUMBER OF ABSORBERS
     &   , TYPE_ABSORB(NPD_SPECIES)
!              LIST OF ABSORBER TYPES
!
!     LOCAL VARIABLES.
      CHARACTER
     &     CHDUM
!             DUMMY CHARACTER
      INTEGER
     &     IOS
!             IO FLAG
     &   , I
!             LOOP VARIABLE
     &   , IDUM
!             DUMMY INTEGER
!
!
!     SKIP OVER THE HEADER.
      READ(IU_SPC, *)
!
!     READ IN THE NUMBER OF SPECTRAL INTERVALS AND THE NUMBER OF
!     GASEOUS ABSORBERS.
      READ(IU_SPC, '(27X, I5)', IOSTAT=IOS) N_BAND
      IF (IOS.NE.0) THEN
         WRITE(IU_ERR, '(/A/)')
     &      '*** ERROR IN SUBROUTINE READ_BLOCK_0_0_0'
         WRITE(IU_ERR, *) 'NUMBER OF BANDS COULD NOT BE READ.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
      IF (N_BAND.GT.NPD_BAND) THEN
         WRITE(IU_ERR, '(/A/)')
     &      '*** ERROR IN SUBROUTINE READ_BLOCK_0_0_0'
         WRITE(IU_ERR, *)
     &      'NUMBER OF BANDS EXCEEDS MAXIMUM PERMITTED NUMBER.'
         WRITE(IU_ERR, *)
     &      'INCREASE NPD_BAND AND RECOMPILE.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
      READ(IU_SPC, '(36X, I5)', IOSTAT=IOS) N_ABSORB
      IF (IOS.NE.0) THEN
         WRITE(IU_ERR, '(/A/)')
     &      '*** ERROR IN SUBROUTINE READ_BLOCK_0_0_0'
         WRITE(IU_ERR, *) 'NUMBER OF ABSORBERS COULD NOT BE READ.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
      IF (N_ABSORB.GT.NPD_SPECIES) THEN
         WRITE(IU_ERR, '(/A/)')
     &      '*** ERROR IN SUBROUTINE READ_BLOCK_0_0_0'
         WRITE(IU_ERR, *)
     &      'NUMBER OF GASEOUS ABSORBERS EXCEEDS MAXIMUM '
     &         //'PERMITTED NUMBER.'
         WRITE(IU_ERR, *)
     &      'INCREASE NPD_SPECIES AND RECOMPILE.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
!
!     READ OVER THE HEADERS AND THE LIST OF ABSORBERS.
      READ(IU_SPC, '(/)')
      DO I=1, N_ABSORB
         READ(IU_SPC, '(I5, 7X, I5, 7X, A)')
     &      IDUM, TYPE_ABSORB(I), CHDUM
      ENDDO
!
!
      RETURN
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO READ IN THE CONTENTS OF BLOCK TYPE 0.       *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE READ_BLOCK_0_0_1(IERR
     &   , N_BAND, N_ABSORB, TYPE_ABSORB
     &   , N_AEROSOL, TYPE_AEROSOL
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!              ERROR FLAG
     &   , N_BAND
!              NUMBER OF BANDS
     &   , N_ABSORB
!              NUMBER OF ABSORBERS
     &   , N_AEROSOL
!              NUMBER OF AEROSOLS
     &   , TYPE_ABSORB(NPD_SPECIES)
!              LIST OF ABSORBER TYPES
     &   , TYPE_AEROSOL(NPD_AEROSOL_SPECIES)
!              LIST OF AEROSOL TYPES
!
!     LOCAL VARIABLES.
      CHARACTER
     &     CHDUM
!             DUMMY CHARACTER
      INTEGER
     &     IOS
!             IO FLAG
     &   , I
!             LOOP VARIABLE
     &   , IDUM
!             DUMMY INTEGER
!
!
!     SKIP OVER THE HEADER.
      READ(IU_SPC, *)
!
!     READ IN THE NUMBER OF SPECTRAL INTERVALS, THE NUMBER OF
!     GASEOUS ABSORBERS AND THE NUMBER OF AEROSOLS.
      READ(IU_SPC, '(27X, I5)', IOSTAT=IOS) N_BAND
      IF (IOS.NE.0) THEN
         WRITE(IU_ERR, '(/A/)')
     &      '*** ERROR IN SUBROUTINE READ_BLOCK_0_0_1'
         WRITE(IU_ERR, *) 'NUMBER OF BANDS COULD NOT BE READ.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
      IF (N_BAND.GT.NPD_BAND) THEN
         WRITE(IU_ERR, '(/A/)')
     &      '*** ERROR IN SUBROUTINE READ_BLOCK_0_0_1'
         WRITE(IU_ERR, *)
     &      'NUMBER OF BANDS EXCEEDS MAXIMUM PERMITTED NUMBER.'
         WRITE(IU_ERR, *)
     &      'INCREASE NPD_BAND AND RECOMPILE.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
      READ(IU_SPC, '(36X, I5)', IOSTAT=IOS) N_ABSORB
      IF (IOS.NE.0) THEN
         WRITE(IU_ERR, '(/A/)')
     &      '*** ERROR IN SUBROUTINE READ_BLOCK_0_0_1'
         WRITE(IU_ERR, *) 'NUMBER OF ABSORBERS COULD NOT BE READ.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
      IF (N_ABSORB.GT.NPD_SPECIES) THEN
         WRITE(IU_ERR, '(/A/)')
     &      '*** ERROR IN SUBROUTINE READ_BLOCK_0_0_1'
         WRITE(IU_ERR, *)
     &      'NUMBER OF GASEOUS ABSORBERS EXCEEDS MAXIMUM '
     &         //'PERMITTED NUMBER.'
         WRITE(IU_ERR, *)
     &      'INCREASE NPD_SPECIES AND RECOMPILE.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
      READ(IU_SPC, '(27X, I5)', IOSTAT=IOS) N_AEROSOL
      IF (IOS.NE.0) THEN
         WRITE(IU_ERR, '(/A/)')
     &      '*** ERROR IN SUBROUTINE READ_BLOCK_0_0_1'
         WRITE(IU_ERR, *) 'NUMBER OF AEROSOLS COULD NOT BE READ.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
      IF (N_AEROSOL.GT.NPD_AEROSOL_SPECIES) THEN
         WRITE(IU_ERR, '(/A/)')
     &      '*** ERROR IN SUBROUTINE READ_BLOCK_0_0_1'
         WRITE(IU_ERR, *)
     &      'NUMBER OF AEROSOLS EXCEEDS MAXIMUM '
     &         //'PERMITTED NUMBER.'
         WRITE(IU_ERR, *)
     &      'INCREASE NPD_AEROSOL_SPECIES AND RECOMPILE.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
!
!     READ OVER THE HEADERS AND THE LIST OF ABSORBERS.
      READ(IU_SPC, '(/)')
      DO I=1, N_ABSORB
         READ(IU_SPC, '(I5, 7X, I5, 7X, A)')
     &      IDUM, TYPE_ABSORB(I), CHDUM
      ENDDO
!
!     READ OVER THE HEADERS AND THE LIST OF AEROSOLS.
      READ(IU_SPC, '(/)')
      DO I=1, N_AEROSOL
         READ(IU_SPC, '(I5, 7X, I5, 7X, A)')
     &      IDUM, TYPE_AEROSOL(I), CHDUM
      ENDDO
!
!
      RETURN
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO READ IN THE CONTENTS OF BLOCK TYPE 1.       *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE READ_BLOCK_1_0_0(IERR
     &   , N_BAND
     &   , WAVE_LENGTH_SHORT, WAVE_LENGTH_LONG
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
      REAL*8	!, INTENT(OUT)
     &     WAVE_LENGTH_SHORT(NPD_BAND)
!             SHORTER WAVELENGTH
     &   , WAVE_LENGTH_LONG(NPD_BAND)
!             LONGER WAVELENGTH
!
!     LOCAL VARIABLES.
      INTEGER
     &     IDUM
!             DUMMY INTEGER
     &   , IOS
!             IOSTAT VARIABLE
     &   , I
!             LOOP VARIABLE
!
!
!     SKIP OVER THE HEADERS.
      READ(IU_SPC, '(//)')
!
!     READ IN THE LIMITS ON THE INTERVALS IN THE SPECTRUM
      DO I=1, N_BAND
         READ(IU_SPC, FMT='(I5, 7X, 1PE16.9, 4X, 1PE16.9)'
     &      , IOSTAT=IOS)
     &      IDUM, WAVE_LENGTH_SHORT(I), WAVE_LENGTH_LONG(I)
         IF (IOS.NE.0) THEN
            WRITE(IU_ERR, '(/A/)')
     &         '*** ERROR IN SUBROUTINE READ_BLOCK_1_0_0.'
            WRITE(IU_ERR, *) 'LIMITS ON WAVELENGTH COULD NOT BE READ.'
            IERR=I_ERR_FATAL
            RETURN
         ENDIF
      ENDDO
!
!
      RETURN
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO READ IN THE CONTENTS OF BLOCK TYPE 2.       *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE READ_BLOCK_2_0_0(IERR
     &   , N_BAND
     &   , SOLAR_FLUX_BAND
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
      REAL*8	!, INTENT(OUT)
     &     SOLAR_FLUX_BAND(NPD_BAND)
!             NORMALIZED SOLAR FLUX
!
!     LOCAL VARIABLES.
      INTEGER
     &     IDUM
!             DUMMY INTEGER
     &   , I
!             LOOP VARIABLE
     &   , IOS
!             IOSTAT FLAG
!
!
!     SKIP OVER THE HEADERS.
      READ(IU_SPC, '(/)')
!
!     READ IN THE LIMITS ON THE INTERVALS IN THE SPECTRUM
      DO I=1, N_BAND
         READ(IU_SPC, FMT='(I5, 7X, 1PE16.9)', IOSTAT=IOS)
     &      IDUM, SOLAR_FLUX_BAND(I)
         IF (IOS.NE.0) THEN
            WRITE(IU_ERR, '(/A)') 
     &         '*** ERROR: SOLAR SPECTRAL DATA ARE NOT CORRECT.'
            IERR=I_ERR_FATAL
            RETURN
         ENDIF
      ENDDO
!
!
      RETURN
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO READ IN THE CONTENTS OF BLOCK TYPE 3.       *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE READ_BLOCK_3_0_0(IERR
     &   , N_BAND
     &   , RAYLEIGH_COEFFICIENT
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
      REAL*8	!, INTENT(OUT)
     &     RAYLEIGH_COEFFICIENT(NPD_BAND)
!             RAYLEIGH COEFFICIENT
!
!     LOCAL VARIABLES.
      INTEGER
     &     IDUM
!             DUMMY INTEGER
     &   , I
!             LOOP VARIABLE
     &   , IOS
!             READING ERROR FLAG
!
!
!     SKIP OVER THE HEADERS.
      READ(IU_SPC, '(//)')
!
!     READ IN THE LIMITS ON THE INTERVALS IN THE SPECTRUM
      DO I=1, N_BAND
         READ(IU_SPC, FMT='(I5, 7X, 1PE16.9)', IOSTAT=IOS)
     &      IDUM, RAYLEIGH_COEFFICIENT(I)
         IF (IOS.NE.0) THEN
            WRITE(IU_ERR, '(/A)')
     &         '*** ERROR: RAYLEIGH SCATTERING DATA ARE NOT CORRECT.'
            IERR=I_ERR_FATAL
            RETURN
         ENDIF
      ENDDO
!
!
      RETURN
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO READ IN THE CONTENTS OF BLOCK TYPE 4.       *
!     *          INDEX NUMBERS OF ABSORBERS IN EACH BAND.             *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE READ_BLOCK_4_0_0(IERR
     &   , N_BAND
     &   , N_BAND_ABSORB, INDEX_ABSORB
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
     &   , N_BAND_ABSORB(NPD_BAND)
!             NUMBER OF GASES IN EACH BAND
     &   , INDEX_ABSORB(NPD_SPECIES, NPD_BAND)
!             ABSORBERS IN EACH BAND
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
!
!     LOCAL VARIABLES.
      INTEGER
     &     IDUM
!             DUMMY INTEGER
     &   , I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
     &   , IOS
!             IOSTAT VARIABLE
!
!
!     SKIP OVER THE HEADERS.
      READ(IU_SPC, '(////)')
!
!     READ IN THE LIST OF ABSORBERS IN EACH BAND.
      DO I=1, N_BAND
         READ(IU_SPC, FMT='(I5, 7X, I5)', IOSTAT=IOS)
     &      IDUM, N_BAND_ABSORB(I)
         IF (IOS.NE.0) THEN
            WRITE(IU_ERR, '(/A/)')
     &         '*** ERROR IN SUBROUTINE READ_BLOCK_4_0_0'
            WRITE(IU_ERR, *) 'THE LIST OF ABSORBERS IS NOT CORRECT.'
            IERR=I_ERR_FATAL
            RETURN
         ENDIF
         IF (N_BAND_ABSORB(I).GT.0) THEN
            READ(IU_SPC, '(5X, 4(2X, I3))')
     &         ( INDEX_ABSORB(J, I), J=1, N_BAND_ABSORB(I) )
         ENDIF
         IF (IOS.NE.0) THEN
            WRITE(IU_ERR, '(/A/)')
     &         '*** ERROR IN SUBROUTINE READ_BLOCK_4_0_0'
            WRITE(IU_ERR, *) 'THE LIST OF ABSORBERS IS NOT CORRECT.'
            IERR=I_ERR_FATAL
            RETURN
         ENDIF
      ENDDO
!
!
      RETURN
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO READ IN THE CONTENTS OF BLOCK TYPE 5.       *
!     *            EXPONENTIAL SUM FITTING TERMS.                     *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE READ_BLOCK_5_0_0(IERR
     &   , N_BAND
     &   , N_BAND_ABSORB, I_BAND_ESFT, K_ESFT, W_ESFT, I_SCALE_ESFT
     &   , I_SCALE_FNC, SCALE_VECTOR, P_REFERENCE, T_REFERENCE
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/scale_fnc.pcf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
     &   , I_BAND_ESFT(NPD_BAND, NPD_SPECIES)
!             NUMBER OF ESFT TERMS
     &   , I_SCALE_ESFT(NPD_BAND, NPD_SPECIES)
!             TYPE OF ESFT SCALING
     &   , I_SCALE_FNC(NPD_BAND, NPD_SPECIES)
!             INDEX OF SCALING FUNCTION
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
     &   , N_BAND_ABSORB(NPD_BAND)
!             NUMBER OF ABSORBERS IN BANDS
      REAL*8	!, INTENT(OUT)
     &     K_ESFT(NPD_ESFT_TERM, NPD_BAND, NPD_SPECIES)
!             ESFT EXPONENTIALS
     &   , W_ESFT(NPD_ESFT_TERM, NPD_BAND, NPD_SPECIES)
!             ESFT WEIGHTS
     &   , SCALE_VECTOR(NPD_SCALE_VARIABLE, NPD_ESFT_TERM, NPD_BAND
     &      , NPD_SPECIES)
!             SCALING PARAMETERS
     &   , P_REFERENCE(NPD_SPECIES, NPD_BAND)
!             REFERENCE SCALING PRESSURE
     &   , T_REFERENCE(NPD_SPECIES, NPD_BAND)
!             REFERENCE SCALING TEMPERATURE
!
!     LOCAL VARIABLES.
      INTEGER
     &     IDUM_BAND
!             DUMMY INTEGER
     &   , IDUM_SPECIES
!             DUMMY INTEGER
     &   , IDUM_SCALE
!             DUMMY INTEGER
     &   , IDUM_FNC
!             DUMMY INTEGER
     &   , NUMBER_TERM
!             NUMBER OF TERMS
     &   , I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
     &   , L
!             LOOP VARIABLE
     &   , IOS
!             IOSTAT VARIABLE
!
      INCLUDE 'incl/scale_fnc.dcf'
!
!
!     SKIP OVER THE HEADERS.
      READ(IU_SPC, '(///)')
!
!     READ IN THE NUMBER OF ESFT TERMS IN EACH BAND.
      DO I=1, N_BAND
         DO J=1, N_BAND_ABSORB(I)
            READ(IU_SPC, FMT='(I5, 5(7X, I5))', IOSTAT=IOS)
     &         IDUM_BAND, IDUM_SPECIES, NUMBER_TERM, IDUM_SCALE
     &         , IDUM_FNC
            IF (IOS.NE.0) THEN
               WRITE(IU_ERR, '(/A/)')
     &            '*** ERROR IN SUBROUTINE READ_BLOCK_5_0_0'
               WRITE(IU_ERR, *)
     &            'ESFT DATA ARE NOT CONSISTENT WITH SUMMARY.'
               IERR=I_ERR_FATAL
               RETURN
            ENDIF
            IF ( (IDUM_FNC.EQ.IP_SCALE_POWER_LAW) .OR.
     &           (IDUM_FNC.EQ.IP_SCALE_POWER_QUAD).OR.
     &           (IDUM_FNC.EQ.IP_SCALE_DOPPLER_QUAD).OR.
     &           (IDUM_FNC.EQ.IP_SCALE_FNC_NULL) ) THEN
               CONTINUE
            ELSE
               WRITE(IU_ERR, '(/A)')
     &            '*** ERROR IN SUBROUTINE READ_BLOCK_5_0_0'
               WRITE(IU_ERR, '(A)') 'AN ILLEGAL SCALING FUNCTION '
     &            //'HAS BEEN SPECIFIED.'
               IERR=I_ERR_FATAL
               RETURN
            ENDIF
            IF (NUMBER_TERM.GT.NPD_ESFT_TERM) THEN
               WRITE(IU_ERR, '(/A)')
     &            '*** ERROR IN SUBROUTINE READ_BLOCK_5_0_0'
               WRITE(IU_ERR, '(A)') 'TOO MANY ESFT TERMS HAVE BEEN '
     &            //'GIVEN.'
               WRITE(IU_ERR, '(A)')
     &            'INCREASE NPD_ESFT_TERM AND RECOMPILE.'
               IERR=I_ERR_FATAL
               RETURN
            ENDIF
            I_BAND_ESFT(IDUM_BAND, IDUM_SPECIES)=NUMBER_TERM
            I_SCALE_ESFT(IDUM_BAND, IDUM_SPECIES)=IDUM_SCALE
            I_SCALE_FNC(IDUM_BAND, IDUM_SPECIES)=IDUM_FNC
!           READ THE REFERENCE TEMPERATURE AND PRESSURE.
            READ(IU_SPC, '(2(6X, 1PE16.9))')
     &           P_REFERENCE(IDUM_SPECIES, IDUM_BAND)
     &         , T_REFERENCE(IDUM_SPECIES, IDUM_BAND)
!           FOR EACH BAND READ THE VALUES OF THE COEFFICIENTS.
            DO K=1, NUMBER_TERM
               READ(IU_SPC, '(2(3X, 1PE16.9), (T39,2(3X, 1PE16.9)))'
     &            , IOSTAT=IOS)
     &              K_ESFT(K, IDUM_BAND, IDUM_SPECIES)
     &            , W_ESFT(K, IDUM_BAND, IDUM_SPECIES)
     &            , (SCALE_VECTOR(L, K, IDUM_BAND, IDUM_SPECIES)
     &            , L=1, N_SCALE_VARIABLE(IDUM_FNC))
               IF (IOS.NE.0) THEN
                  WRITE(IU_ERR, '(/A/)')
     &            '*** ERROR IN SUBROUTINE READ_BLOCK_5_0_0'
                  WRITE(IU_ERR, *)
     &               'ESFT DATA ARE NOT CONSISTENT WITH SUMMARY.'
                  IERR=I_ERR_FATAL
                  RETURN
               ENDIF
            ENDDO
         ENDDO
      ENDDO
!
!
      RETURN
      END
!     ******************************************************************
!     *                                                                *
!     *      SUBROUTINE TO READ THE CONTENTS OF BLOCK 6.               *
!     *         COEFFICIENTS FOR SOURCE FUNCTION IN EACH BAND.         *
!     *                                                                *
!     ******************************************************************
      SUBROUTINE READ_BLOCK_6_0_0(IERR
     &   , N_BAND, N_DEG_FIT
     &   , T_REF_PLANCK, THERMAL_COEFFICIENT
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
     &   , N_DEG_FIT
!             DEGREE OF POLYNOMIAL
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF SPECTRAL BANDS
      REAL*8	!, INTENT(OUT)
     &     T_REF_PLANCK
!             PLANCKIAN REFERENCE TEMP
     &   , THERMAL_COEFFICIENT(0: NPD_THERMAL_COEFF-1, NPD_BAND)
!             THERMAL COEFFICIENTS
!
!     LOCAL VARIABLES.
      INTEGER
     &     I
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
     &   , IOS
!             READING ERROR FLAG
     &   , I_BAND
!             NUMBER OF BAND
!
!
      READ(IU_SPC, '(/, 23X, I5, 26X, 1PE16.9)')
     &   N_DEG_FIT, T_REF_PLANCK
      IF (N_DEG_FIT.GT.NPD_THERMAL_COEFF-1) THEN
         WRITE(IU_ERR, '(/A/)')
     &      '*** ERROR IN SUBROUTINE READ_BLOCK_6_0_0'
         WRITE(IU_ERR, '(A)')
     &      'THE DEGREE OF THE POLYNOMIAL FIT IS TOO HIGH.'
         WRITE(IU_ERR, '(A)')
     &      'INCREASE NPD_THERMAL_COEFF AND RECOMPILE.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
!
      READ(IU_SPC, '(/)')
      DO I=1, N_BAND
         READ(IU_SPC, '(I5, 7X, (T13, 3(1PE16.9, 4X)))', IOSTAT=IOS)
     &      I_BAND, (THERMAL_COEFFICIENT(K, I), K=0, N_DEG_FIT)
         IF (IOS.NE.0) THEN
            WRITE(IU_ERR, '(/A/)')
     &         '*** ERROR IN SUBROUTINE READ_BLOCK_6_0_0'
            WRITE(IU_ERR, '(A)')
     &         'THE THERMAL SOURCE FUNCTION DATA COULD NOT BE READ.'
            IERR=I_ERR_FATAL
            RETURN
         ENDIF
      ENDDO
!
!
      RETURN
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO READ IN THE CONTENTS OF BLOCK TYPE 7.       *
!     *            SURFACE ALBEDO IN EACH SPECTRAL BAND.              *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE READ_BLOCK_7_0_0(IERR
     &   , N_BAND
     &   , SURFACE_ALBEDO, EMISSIVITY_GROUND, L_SURFACE
     &   , I_SPEC_SURFACE
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/surface_spec.pcf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
     &   , I_SPEC_SURFACE(NPD_SURFACE)
!             METHOD BY SURFACE PROPERTIES ARE
!             GIVEN
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
      LOGICAL	!, INTENT(OUT)
     &     L_SURFACE(NPD_SURFACE)
!             SURFACE TYPE FLAGS
      REAL*8	!, INTENT(OUT)
     &     SURFACE_ALBEDO(NPD_BAND, NPD_SURFACE)
!             SURFACE ALBEDOS
     &   , EMISSIVITY_GROUND(NPD_BAND, NPD_SURFACE)
!             SURFACE EMISSIVITIES
!
!     LOCAL VARIABLES.
      INTEGER
     &     IDUM
!             DUMMY INTEGER
     &   , I
!             LOOP VARIABLE
     &   , ISURF
!             NUMBER OF SURFACE TYPE
     &   , IOS
!             IOSTAT VARIABLE
!
!
!     SKIP OVER THE HEADER.
      READ(IU_SPC, *)
!     READ IN THE SURFACE TYPE.
      READ(IU_SPC, '(15X, I4)') ISURF
      IF ( (ISURF.LE.0).OR.(ISURF.GT.NPD_SURFACE) ) THEN
         WRITE(IU_ERR, '(/A/)')
     &      '*** ERROR IN SUBROUTINE READ_BLOCK_7_0_0'
         WRITE(IU_ERR, *) 'THE INDEX OF THE SURFACE IS OUTSIDE THE '
     &      , 'PERMITTED RANGE.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
      L_SURFACE(ISURF)=.TRUE.
!     SET THE SPECIFICATION TYPE TO FIXED PARAMETERS.
      I_SPEC_SURFACE(ISURF)=IP_SURFACE_SPECIFIED
!     READ THE NEXT HEADER.
      READ(IU_SPC, *)
!
!     READ IN THE SURFACE ALBEDO IN EACH BAND.
      DO I=1, N_BAND
         READ(IU_SPC, FMT='(I5, 2(7X, 1PE16.9))', IOSTAT=IOS)
     &      IDUM, SURFACE_ALBEDO(I, ISURF), EMISSIVITY_GROUND(I, ISURF)
         IF (IOS.NE.0) THEN
            WRITE(IU_ERR, '(/A/)')
     &         '*** ERROR IN SUBROUTINE READ_BLOCK_7_0_0.'
            WRITE(IU_ERR, *)
     &         'THE SURFACE PROPERTIES COULD NOT BE READ SUCCESSFULLY.'
            IERR=I_ERR_FATAL
            RETURN
         ENDIF
      ENDDO
!
!
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO READ IN THE CONTENTS OF BLOCK TYPE 7.       *
!     *          SURFACE PROPERTIES IN EACH SPECTRAL BAND.            *
!     *                         (SUBTYPE=1)                           *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE READ_BLOCK_7_1_0(IERR
     &   , N_BAND
     &   , SURFACE_ALBEDO, EMISSIVITY_GROUND, L_SURFACE
     &   , I_SPEC_SURFACE
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
     &   , I_SPEC_SURFACE(NPD_SURFACE)
!             METHOD BY SURFACE PROPERTIES ARE
!             GIVEN
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
      LOGICAL	!, INTENT(OUT)
     &     L_SURFACE(NPD_SURFACE)
!             SURFACE TYPE FLAGS
      REAL*8	!, INTENT(OUT)
     &     SURFACE_ALBEDO(NPD_BAND, NPD_SURFACE)
!             SURFACE ALBEDOS
     &   , EMISSIVITY_GROUND(NPD_BAND, NPD_SURFACE)
!             SURFACE EMISSIVITIES
!
!     LOCAL VARIABLES.
      INTEGER
     &     IDUM
!             DUMMY INTEGER
     &   , I
!             LOOP VARIABLE
     &   , ISURF
!             NUMBER OF SURFACE TYPE
     &   , IOS
!             IOSTAT VARIABLE
!
!
!     SKIP OVER THE HEADER.
      READ(IU_SPC, *)
!     READ IN THE SURFACE TYPE AND METHOD OF SPECIFICATION.
      READ(IU_SPC, '(15X, I4, 23X, I5)') ISURF, IDUM
      IF ( (ISURF.LE.0).OR.(ISURF.GT.NPD_SURFACE) ) THEN
         WRITE(IU_ERR, '(/A/)')
     &      '*** ERROR IN SUBROUTINE READ_BLOCK_7_1_0'
         WRITE(IU_ERR, *) 'THE INDEX OF THE SURFACE IS OUTSIDE THE '
     &      , 'PERMITTED RANGE.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
      L_SURFACE(ISURF)=.TRUE.
      I_SPEC_SURFACE(ISURF)=IDUM
!     READ THE NEXT HEADER.
      READ(IU_SPC, *)
!
!     READ IN THE SURFACE ALBEDO IN EACH BAND.
      DO I=1, N_BAND
         READ(IU_SPC, FMT='(I5, 2(7X, 1PE16.9))', IOSTAT=IOS)
     &      IDUM, SURFACE_ALBEDO(I, ISURF), EMISSIVITY_GROUND(I, ISURF)
         IF (IOS.NE.0) THEN
            WRITE(IU_ERR, '(/A/)')
     &         '*** ERROR IN SUBROUTINE READ_BLOCK_7_0_0.'
            WRITE(IU_ERR, *)
     &         'THE SURFACE PROPERTIES COULD NOT BE READ SUCCESSFULLY.'
            IERR=I_ERR_FATAL
            RETURN
         ENDIF
      ENDDO
!
!
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO READ IN THE CONTENTS OF BLOCK TYPE 7.       *
!     *          SURFACE PROPERTIES IN EACH SPECTRAL BAND.            *
!     *                     (SUBTYPE=2)                               *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE READ_BLOCK_7_2_0(IERR
     &   , L_SURFACE, I_SPEC_SURFACE
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
     &   , I_SPEC_SURFACE(NPD_SURFACE)
!             METHOD OF GIVING SURFACE PROPERTY
      LOGICAL	!, INTENT(OUT)
     &     L_SURFACE(NPD_SURFACE)
!             SURFACE TYPE FLAGS
!
!     LOCAL VARIABLES.
      INTEGER
     &     IDUM
!             DUMMY INTEGER
     &   , ISURF
!             NUMBER OF SURFACE TYPE
!
!
!     SKIP OVER THE HEADER.
      READ(IU_SPC, *)
!     READ IN THE SURFACE TYPE.
      READ(IU_SPC, '(15X, I4, 23X, I5)') ISURF, IDUM
      IF ( (ISURF.LE.0).OR.(ISURF.GT.NPD_SURFACE) ) THEN
         WRITE(IU_ERR, '(/A/)')
     &      '*** ERROR IN SUBROUTINE READ_BLOCK_7_2_0'
         WRITE(IU_ERR, *) 'THE INDEX OF THE SURFACE IS OUTSIDE THE '
     &      , 'PERMITTED RANGE.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
      L_SURFACE(ISURF)=.TRUE.
      I_SPEC_SURFACE(ISURF)=IDUM
!
!
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO READ IN THE CONTENTS OF BLOCK TYPE 7.       *
!     *         SURFACE PROPERTIES IN EACH SPECTRAL BAND.             *
!     *                    (SUBTYPE=3)                                *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE READ_BLOCK_7_3_0(IERR
     &   , N_BAND
     &   , SURFACE_ALBEDO, N_DIR_ALBEDO_FIT, DIRECT_ALBEDO_PARM
     &   , EMISSIVITY_GROUND, L_SURFACE, I_SPEC_SURFACE
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
     &   , I_SPEC_SURFACE(NPD_SURFACE)
!             METHOD OF GIVING SURFACE PROPERTY
     &   , N_DIR_ALBEDO_FIT(NPD_SURFACE)
!             DEGREE OF POLYNOMIAL FOR DIRECT ALBEDO
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
      LOGICAL	!, INTENT(OUT)
     &     L_SURFACE(NPD_SURFACE)
!             SURFACE TYPE FLAGS
      REAL*8	!, INTENT(OUT)
     &     SURFACE_ALBEDO(NPD_BAND, NPD_SURFACE)
!             DIFFUSE SURFACE ALBEDOS
     &   , DIRECT_ALBEDO_PARM(0: NPD_ALBEDO_PARM, NPD_BAND, NPD_SURFACE)
!             PARAMETERS FOR DIRECT ALBEDO
     &   , EMISSIVITY_GROUND(NPD_BAND, NPD_SURFACE)
!             SURFACE EMISSIVITIES
!
!     LOCAL VARIABLES.
      INTEGER
     &     IDUM
!             DUMMY INTEGER
     &   , I
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
     &   , ISURF
!             NUMBER OF SURFACE TYPE
     &   , IOS
!             IOSTAT VARIABLE
!
!
!     SKIP OVER THE HEADER.
      READ(IU_SPC, *)
!     READ IN THE SURFACE TYPE.
      READ(IU_SPC, '(15X, I4, 23X, I5)') ISURF, IDUM
      IF ( (ISURF.LE.0).OR.(ISURF.GT.NPD_SURFACE) ) THEN
         WRITE(IU_ERR, '(/A/)')
     &      '*** ERROR IN SUBROUTINE READ_BLOCK_7_3_0'
         WRITE(IU_ERR, *) 'THE INDEX OF THE SURFACE IS OUTSIDE THE '
     &      , 'PERMITTED RANGE.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
      L_SURFACE(ISURF)=.TRUE.
      I_SPEC_SURFACE(ISURF)=IDUM
!     READ THE NEXT HEADER.
      READ(IU_SPC, *)
!
!     READ IN THE DIFFUSE ALBEDO AND EMISSIVITY IN EACH BAND.
      DO I=1, N_BAND
         READ(IU_SPC, FMT='(I5, 2(7X, 1PE16.9))', IOSTAT=IOS)
     &      IDUM, SURFACE_ALBEDO(I, ISURF), EMISSIVITY_GROUND(I, ISURF)
         IF (IOS.NE.0) THEN
            WRITE(IU_ERR, '(/A/)')
     &         '*** ERROR IN SUBROUTINE READ_BLOCK_7_3_0.'
            WRITE(IU_ERR, *)
     &         'THE SURFACE PROPERTIES COULD NOT BE READ SUCCESSFULLY.'
            IERR=I_ERR_FATAL
            RETURN
         ENDIF
      ENDDO
!
!     READ THE COEFFICIENTS OF THE POLYNOMIAL SETTING THE DIRECT ALBEDO.
      READ(IU_SPC, '(45X, I5, /)') N_DIR_ALBEDO_FIT(ISURF)
      DO I=1, N_BAND
         READ(IU_SPC, '(I5, 7X, (T13, 3(1PE16.9, 4X)))', IOSTAT=IOS)
     &      IDUM, (DIRECT_ALBEDO_PARM(K, I, ISURF)
     &      , K=0, N_DIR_ALBEDO_FIT(ISURF))
         IF (IOS.NE.0) THEN
            WRITE(IU_ERR, '(/A/)')
     &         '*** ERROR IN SUBROUTINE READ_BLOCK_7_3_0'
            WRITE(IU_ERR, '(A)')
     &         'THE DIRECT ALBEDO COULD NOT BE READ.'
            IERR=I_ERR_FATAL
            RETURN
         ENDIF
      ENDDO
!
!
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO READ IN THE CONTENTS OF BLOCK TYPE 7.       *
!     *          SURFACE PROPERTIES FOR SEA WATER FITTED              *
!     *          USING THE FORMULAE FROM VN 2.8 OF THE UM             *
!     *                     (SUBTYPE=4)                               *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE READ_BLOCK_7_4_0(IERR
     &   , N_BAND
     &   , SURFACE_ALBEDO, N_DIR_ALBEDO_FIT, DIRECT_ALBEDO_PARM
     &   , EMISSIVITY_GROUND, L_SURFACE, I_SPEC_SURFACE
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
     &   , I_SPEC_SURFACE(NPD_SURFACE)
!             METHOD OF GIVING SURFACE PROPERTY
     &   , N_DIR_ALBEDO_FIT(NPD_SURFACE)
!             NUMBER OF COEFFICIENTS IN FIT TO DIRECT ALBEDO
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
      LOGICAL	!, INTENT(OUT)
     &     L_SURFACE(NPD_SURFACE)
!             SURFACE TYPE FLAGS
      REAL*8	!, INTENT(OUT)
     &     SURFACE_ALBEDO(NPD_BAND, NPD_SURFACE)
!             DIFFUSE SURFACE ALBEDOS
     &   , DIRECT_ALBEDO_PARM(0: NPD_ALBEDO_PARM, NPD_BAND, NPD_SURFACE)
!             PARAMETERS FOR DIRECT ALBEDO
     &   , EMISSIVITY_GROUND(NPD_BAND, NPD_SURFACE)
!             SURFACE EMISSIVITIES
!
!     LOCAL VARIABLES.
      INTEGER
     &     IDUM
!             DUMMY INTEGER
     &   , ISURF
!             NUMBER OF SURFACE TYPE
     &   , IB
!             LOOP VARIABLE
!
!
!     SKIP OVER THE HEADER.
      READ(IU_SPC, *)
!     READ IN THE SURFACE TYPE.
      READ(IU_SPC, '(15X, I4, 23X, I5)') ISURF, IDUM
      IF ( (ISURF.LE.0).OR.(ISURF.GT.NPD_SURFACE) ) THEN
         WRITE(IU_ERR, '(/A/)')
     &      '*** ERROR IN SUBROUTINE READ_BLOCK_7_4_0'
         WRITE(IU_ERR, *) 'THE INDEX OF THE SURFACE IS OUTSIDE THE '
     &      , 'PERMITTED RANGE.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
      L_SURFACE(ISURF)=.TRUE.
      I_SPEC_SURFACE(ISURF)=IDUM
!
!
!     THIS BLOCK REPRESENTS PAYNE'S FIT TO THE ALBEDO OF SEA WATER, AND
!     IS NOW OBSOLETE. WE PUT EQUIVALENT DATA INTO THE ARRAYS USED NOW.
      DO IB=1, N_BAND
         SURFACE_ALBEDO(IB, ISURF)=0.06D+00
         EMISSIVITY_GROUND(IB, ISURF)=0.94D+00
         N_DIR_ALBEDO_FIT(ISURF)=4
         DIRECT_ALBEDO_PARM(1, IB, ISURF)=0.05D+00
         DIRECT_ALBEDO_PARM(2, IB, ISURF)=0.15D+00
         DIRECT_ALBEDO_PARM(3, IB, ISURF)=1.10D+00
         DIRECT_ALBEDO_PARM(4, IB, ISURF)=1.40D+00
      ENDDO
!
!
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO READ IN THE CONTENTS OF BLOCK TYPE 7.       *
!     *          SURFACE PROPERTIES IN EACH SPECTRAL BAND.            *
!     *                    (SUBTYPE=4)                                *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE READ_BLOCK_7_4_1(IERR
     &   , N_BAND
     &   , SURFACE_ALBEDO, N_DIR_ALBEDO_FIT, DIRECT_ALBEDO_PARM
     &   , EMISSIVITY_GROUND, L_SURFACE, I_SPEC_SURFACE
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
     &   , I_SPEC_SURFACE(NPD_SURFACE)
!             METHOD OF GIVING SURFACE PROPERTY
     &   , N_DIR_ALBEDO_FIT(NPD_SURFACE)
!             NUMBER OF COEFFICIENTS IN FIT TO DIRECT ALBEDO
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
      LOGICAL	!, INTENT(OUT)
     &     L_SURFACE(NPD_SURFACE)
!             SURFACE TYPE FLAGS
      REAL*8	!, INTENT(OUT)
     &     SURFACE_ALBEDO(NPD_BAND, NPD_SURFACE)
!             DIFFUSE SURFACE ALBEDOS
     &   , DIRECT_ALBEDO_PARM(0: NPD_ALBEDO_PARM, NPD_BAND, NPD_SURFACE)
!             PARAMETERS FOR DIRECT ALBEDO
     &   , EMISSIVITY_GROUND(NPD_BAND, NPD_SURFACE)
!             SURFACE EMISSIVITIES
!
!     LOCAL VARIABLES.
      INTEGER
     &     IDUM
!             DUMMY INTEGER
     &   , I
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
     &   , ISURF
!             NUMBER OF SURFACE TYPE
     &   , IOS
!             IOSTAT VARIABLE
!
!
!     SKIP OVER THE HEADER.
      READ(IU_SPC, *)
!     READ IN THE SURFACE TYPE.
      READ(IU_SPC, '(15X, I4, 23X, I5)') ISURF, IDUM
      IF ( (ISURF.LE.0).OR.(ISURF.GT.NPD_SURFACE) ) THEN
         WRITE(IU_ERR, '(/A/)')
     &      '*** ERROR IN SUBROUTINE READ_BLOCK_7_4_1'
         WRITE(IU_ERR, *) 'THE INDEX OF THE SURFACE IS OUTSIDE THE '
     &      , 'PERMITTED RANGE.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
      L_SURFACE(ISURF)=.TRUE.
      I_SPEC_SURFACE(ISURF)=IDUM
!     READ THE NEXT HEADER.
      READ(IU_SPC, *)
!
!     READ IN THE DIFFUSE ALBEDO AND EMISSIVITY IN EACH BAND.
      DO I=1, N_BAND
         READ(IU_SPC, FMT='(I5, 2(7X, 1PE16.9))', IOSTAT=IOS)
     &      IDUM, SURFACE_ALBEDO(I, ISURF), EMISSIVITY_GROUND(I, ISURF)
         IF (IOS.NE.0) THEN
            WRITE(IU_ERR, '(/A/)')
     &         '*** ERROR IN SUBROUTINE READ_BLOCK_7_4_1.'
            WRITE(IU_ERR, *)
     &         'THE SURFACE PROPERTIES COULD NOT BE READ SUCCESSFULLY.'
            IERR=I_ERR_FATAL
            RETURN
         ENDIF
      ENDDO
!
!     READ THE COEFFICIENTS OF THE FUNCTION SETTING THE DIRECT ALBEDO.
      READ(IU_SPC, '(42X, I5, /)') N_DIR_ALBEDO_FIT(ISURF)
      DO I=1, N_BAND
         READ(IU_SPC, '(I5, 7X, (T13, 3(1PE16.9, 4X)))', IOSTAT=IOS)
     &      IDUM, (DIRECT_ALBEDO_PARM(K, I, ISURF)
     &      , K=1, N_DIR_ALBEDO_FIT(ISURF))
         IF (IOS.NE.0) THEN
            WRITE(IU_ERR, '(/A/)')
     &         '*** ERROR IN SUBROUTINE READ_BLOCK_7_4_1'
            WRITE(IU_ERR, '(A)')
     &         'THE DIRECT ALBEDO COULD NOT BE READ.'
            IERR=I_ERR_FATAL
            RETURN
         ENDIF
      ENDDO
!
!
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO READ IN THE CONTENTS OF BLOCK TYPE 8.       *
!     *           INDEX NUMBERS OF CONTINUA IN EACH BAND.             *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE READ_BLOCK_8_0_0(IERR
     &   , N_BAND
     &   , N_BAND_CONTINUUM, INDEX_CONTINUUM, INDEX_WATER
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/continuum.pcf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
     &   , N_BAND_CONTINUUM(NPD_BAND)
!             NUMBER OF CONTINUA
!                  IN EACH BAND
     &   , INDEX_CONTINUUM(NPD_BAND, NPD_CONTINUUM)
!             CONTINUUM
!                  IN EACH BAND
     &   , INDEX_WATER
!             INDEX OF WATER VAPOUR
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
!
!     LOCAL VARIABLES.
      INTEGER
     &     IDUM
!             DUMMY INTEGER
     &   , I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
     &   , IOS
!             IOSTAT VARIABLE
!
!
!     SKIP OVER THE HEADERS.
      READ(IU_SPC, '(////)')
!
!     READ IN THE LIMITS ON THE INTERVALS IN THE SPECTRUM
      DO I=1, N_BAND
         READ(IU_SPC, FMT='(I5, 7X, I5)', IOSTAT=IOS)
     &      IDUM, N_BAND_CONTINUUM(I)
         IF (IOS.NE.0) THEN
            WRITE(IU_ERR, '(/A/)')
     &         '*** ERROR IN SUBROUTINE READ_BLOCK_8_0_0'
            WRITE(IU_ERR, *) 'THE LIST OF CONTINUA IS NOT CORRECT.'
            IERR=I_ERR_FATAL
            RETURN
         ENDIF
         IF (N_BAND_CONTINUUM(I).GT.NPD_CONTINUUM) THEN
            WRITE(IU_ERR, '(/A/)')
     &         '*** ERROR IN SUBROUTINE READ_BLOCK_8_0_0'
            WRITE(IU_ERR, *) 'THERE ARE TOO MANY CONTINUA:'
            WRITE(IU_ERR, *) 'INCREASE NPD_CONTINUUM AND RECOMPILE.'
            IERR=I_ERR_FATAL
            RETURN
         ENDIF
         IF (N_BAND_CONTINUUM(I).GT.0) THEN
            READ(IU_SPC, '(5X, 4(2X, I3))')
     &         ( INDEX_CONTINUUM(I, J), J=1, N_BAND_CONTINUUM(I) )
         ENDIF
         IF (IOS.NE.0) THEN
            WRITE(IU_ERR, '(/A/)')
     &         '*** ERROR IN SUBROUTINE READ_BLOCK_8_0_0'
            WRITE(IU_ERR, *) 'THE LIST OF CONTINUA IS NOT CORRECT.'
            IERR=I_ERR_FATAL
            RETURN
         ENDIF
      ENDDO
!
!     READ IN THE INDICES OF GASES FORMING THE CONTINUUM SPECIES.
      READ(IU_SPC, '(/, 22X, I5)') INDEX_WATER
!
!
      RETURN
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO READ IN THE CONTENTS OF BLOCK TYPE 9.       *
!     *            EXPONENTIAL SUM FITTING TERMS.                     *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE READ_BLOCK_9_0_0(IERR
     &   , N_BAND
     &   , N_BAND_CONTINUUM, K_CONTINUUM
     &   , I_SCALE_FNC_CONT, SCALE_CONTINUUM
     &   , P_REF_CONTINUUM, T_REF_CONTINUUM
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/continuum.pcf'
      INCLUDE 'incl/scale_fnc.pcf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
     &   , N_BAND_CONTINUUM(NPD_BAND)
!             NUMBER OF CONTINUUM IN BANDS
     &   , I_SCALE_FNC_CONT(NPD_BAND, NPD_CONTINUUM)
!             TYEPS OF SCALING FUNCTION
      REAL*8	!, INTENT(OUT)
     &     K_CONTINUUM(NPD_BAND, NPD_CONTINUUM)
!             CONTINUUM EXTINCTIONS
     &   , SCALE_CONTINUUM(NPD_SCALE_VARIABLE, NPD_BAND
     &      , NPD_CONTINUUM)
!             CONTINUUM SCALINGS
     &   , P_REF_CONTINUUM(NPD_CONTINUUM, NPD_BAND)
!             CONTINUUM REFERENCE PRESSURE
     &   , T_REF_CONTINUUM(NPD_CONTINUUM, NPD_BAND)
!             CONTINUUM REFERENCE TEMPERATURE
!
!     LOCAL VARIABLES.
      INTEGER
     &     IDUM_BAND
!             DUMMY INTEGER
     &   , IDUM_CONTINUUM
!             DUMMY INTEGER
     &   , IDUM_FNC
!             DUMMY INTEGER
     &   , I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
     &   , L
!             LOOP VARIABLE
     &   , IOS
!             IOSTAT VARIABLE
!
      INCLUDE 'incl/scale_fnc.dcf'
!
!
!     SKIP OVER THE HEADERS.
      READ(IU_SPC, '(//)')
!
      DO I=1, N_BAND
         DO J=1, N_BAND_CONTINUUM(I)
            READ(IU_SPC, FMT='(I5, 2(7X, I5))', IOSTAT=IOS)
     &         IDUM_BAND, IDUM_CONTINUUM, IDUM_FNC
            IF (IOS.NE.0) THEN
               WRITE(IU_ERR, '(/A/)')
     &            '*** ERROR IN SUBROUTINE READ_BLOCK_9_0_0'
               WRITE(IU_ERR, *)
     &            'CONTINUUM TYPE OR BAND COULD NOT BE READ.'
               IERR=I_ERR_FATAL
               RETURN
            ENDIF
            I_SCALE_FNC_CONT(IDUM_BAND, IDUM_CONTINUUM)=IDUM_FNC
!           READ THE REFERENCE TEMPERATURE AND PRESSURE.
            READ(IU_SPC, '(2(6X, 1PE16.9))')
     &           P_REF_CONTINUUM(IDUM_CONTINUUM, IDUM_BAND)
     &         , T_REF_CONTINUUM(IDUM_CONTINUUM, IDUM_BAND)
!           FOR EACH BAND READ THE VALUES OF THE COEFFICIENTS.
            READ(IU_SPC, '(6X, 1PE16.9, (T23, 2(6X, 1PE16.9)))'
     &         , IOSTAT=IOS)
     &           K_CONTINUUM(IDUM_BAND, IDUM_CONTINUUM)
     &         , (SCALE_CONTINUUM(L, IDUM_BAND, IDUM_CONTINUUM)
     &         , L=1, N_SCALE_VARIABLE(IDUM_FNC))
            IF (IOS.NE.0) THEN
               WRITE(IU_ERR, '(/A)')
     &            '*** ERROR IN SUBROUTINE READ_BLOCK_9_0_0'
               WRITE(IU_ERR, '(A)')
     &            'CONTINUUM DATA COULD NOT BE READ.'
               IERR=I_ERR_FATAL
               RETURN
            ENDIF
         ENDDO
      ENDDO
!
!
      RETURN
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO READ IN THE CONTENTS OF BLOCK TYPE 10.      *
!     *                PARAMETRIZED MIE SCATTERING DATA.              *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE READ_BLOCK_10_0_0(IERR
     &   , N_BAND
     &   , L_DROP_TYPE, I_DROP_PARAMETRIZATION, DROP_PARAMETER_LIST
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/cloud_parametrization.pcf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
     &   , I_DROP_PARAMETRIZATION(NPD_DROP_TYPE)
!             NUMBER OF PARAMETRIZATION
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
      LOGICAL	!, INTENT(OUT)
     &     L_DROP_TYPE(NPD_DROP_TYPE)
!             TYPES OF DROPS PRESENT
      REAL*8	!, INTENT(OUT)
     &     DROP_PARAMETER_LIST(NPD_CLOUD_PARAMETER
     &   , NPD_BAND, NPD_DROP_TYPE)
!             FITTING PARAMETERS FOR DROPS
!
!     LOCAL VARIABLES.
      INTEGER
     &     I_DROP
!             TYPE OF DROPLET
     &   , I_PARAMETRIZATION_DROP
!             DUMMY INDEX OF PARAMETER SCHEME
     &   , N_PARAMETER
!             NUMBER OF PARAMETERS
     &   , I
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
     &   , IOS
!             I/O ERROR FLAG
     &   , I_DUMMY
!             DUMMY READING VARIABLE
!
!
!     READ THE HEADERS.
      READ(IU_SPC, '(/, 27X, I5, /, 34X, I5, 27X, I5)')
     &   I_DROP, I_PARAMETRIZATION_DROP, I_DUMMY
      IF (I_DROP.GT.NPD_DROP_TYPE) THEN
         WRITE(IU_ERR, '(/A/)')
     &      '*** ERROR IN SUBROUTINE READ_BLOCK_10_0_0'
         WRITE(IU_ERR, *)
     &      'DROP TYPE EXEEDS MAXIMUM PERMITTED VALUE:'
         WRITE(IU_ERR, *)
     &      'INCREASE NPD_DROP_TYPE AND RE-COMPILE.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
!
      IF ( (I_PARAMETRIZATION_DROP.EQ.IP_SLINGO_SCHRECKER)
     &   .OR.(I_PARAMETRIZATION_DROP.EQ.IP_ACKERMAN_STEPHENS) ) THEN
!        DATA ARE PARAMETRIZED.
         N_PARAMETER=I_DUMMY
!
         DO I=1, N_BAND
            READ(IU_SPC, FMT='(/, (4(4X, 1PE12.5)))', IOSTAT=IOS)
     &         (DROP_PARAMETER_LIST(K, I, I_DROP), K=1, N_PARAMETER)
!           FOR EACH BAND READ THE VALUES OF THE PARAMETERS.
            IF (IOS.NE.0) THEN
               WRITE(IU_ERR, '(/A/)')
     &            '*** ERROR IN SUBROUTINE READ_BLOCK_10_0_0'
               WRITE(IU_ERR, *)
     &            'DATA FOR DROPLETS ARE NOT IN THE CORRECT FORMAT.'
               IERR=I_ERR_FATAL
               RETURN
            ENDIF
         ENDDO
      ELSE
!        ILLEGAL PARAMETRIZATION SCHEME ENCOUNTERED.
         WRITE(IU_ERR, '(/A)')
     &      '*** ERROR IN SUBROUTINE READ_BLOCK_10_0_0'
         WRITE(IU_ERR, '(/A)')
     &      'AN UNKNOWN PARAMETRIZATION SCHEME HAS BEEN SPECIFIED.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
!
!     RECORD THE PRESENCE OF THE DROP TYPE AND THE INDEX
!     OF THE PARAMETRIZATION
      L_DROP_TYPE(I_DROP)=.TRUE.
      I_DROP_PARAMETRIZATION(I_DROP)=I_PARAMETRIZATION_DROP
!
!
      RETURN
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO READ IN THE CONTENTS OF BLOCK TYPE 10.      *
!     *                PARAMETRIZED MIE SCATTERING DATA.              *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE READ_BLOCK_10_2_0(IERR
     &   , N_BAND
     &   , L_DROP_TYPE, I_DROP_PARAMETRIZATION
     &   , N_DROP_DATA_LAYER, DROP_PRESSURE, DROP_ABSORPTION
     &   , DROP_SCATTERING, DROP_ASYMMETRY
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/cloud_parametrization.pcf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
     &   , I_DROP_PARAMETRIZATION(NPD_DROP_TYPE)
!             NUMBER OF PARAMETRIZATION
     &   , N_DROP_DATA_LAYER(NPD_DROP_TYPE)
!             NUMBER OF CLOUD DATA LAYERS
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
      LOGICAL	!, INTENT(OUT)
     &     L_DROP_TYPE(NPD_DROP_TYPE)
!             TYPES OF DROPS PRESENT
      REAL*8	!, INTENT(OUT)
     &     DROP_PRESSURE(0: NPD_CLOUD_DATA_LAYER, NPD_DROP_TYPE)
!             PRESSURE AT CLOUD DATA LEVELS
     &   , DROP_ABSORPTION(0: NPD_CLOUD_DATA_LAYER, NPD_BAND
     &        , NPD_DROP_TYPE)
!             CLOUD ABSORPTION
     &   , DROP_SCATTERING(0: NPD_CLOUD_DATA_LAYER, NPD_BAND
     &        , NPD_DROP_TYPE)
!             CLOUD SCATTERING
     &   , DROP_ASYMMETRY(0: NPD_CLOUD_DATA_LAYER, NPD_BAND
     &        , NPD_DROP_TYPE)
!             CLOUD ASYMMETRY
!
!     LOCAL VARIABLES.
      INTEGER
     &     I_DROP
!             TYPE OF DROPLET
     &   , N_TEMP
!             TEMPORARY INTEGER
     &   , I
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
     &   , IOS
!             I/O ERROR FLAG
!
!
!     READ THE HEADERS.
      READ(IU_SPC, '(/, 27X, I5, /, 34X, I5)')
     &   I_DROP, N_TEMP
!
!     CHECK THE SIZES OF ARRAYS.
      IF ( (I_DROP.LT.0).OR.(I_DROP.GT.NPD_DROP_TYPE) ) THEN
         WRITE(IU_ERR, '(/A)')
     &      '*** ERROR IN SUBROUTINE READ_BLOCK_10_2_0'
         WRITE(IU_ERR, '(A)')
     &      'THE TYPE OF DROPLET IS OUTSIDE THE ALLOWED RANGE'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
      IF ( (N_TEMP.LT.0).OR.(N_TEMP.GT.NPD_CLOUD_DATA_LAYER) ) THEN
         WRITE(IU_ERR, '(/A)')
     &      '*** ERROR IN SUBROUTINE READ_BLOCK_10_2_0'
         WRITE(IU_ERR, '(A)')
     &      'THERE ARE TOO MANY LEVELS OF CLOUD DATA '
     &      //'IN THE SPECTRAL FILE.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
      N_DROP_DATA_LAYER(I_DROP)=N_TEMP
!
      DO I=1, N_BAND
         READ(IU_SPC, '(//)')
         DO K=0, N_DROP_DATA_LAYER(I_DROP)
            READ(IU_SPC, '(4(4X, 1PE12.5))', IOSTAT=IOS)
     &           DROP_PRESSURE(K, I_DROP)
     &         , DROP_ABSORPTION(K, I, I_DROP)
     &         , DROP_SCATTERING(K, I, I_DROP)
     &         , DROP_ASYMMETRY(K, I, I_DROP)
            IF (IOS.NE.0) THEN
               WRITE(IU_ERR, '(/A)')
     &            '*** ERROR IN SUBROUTINE READ_BLOCK_10_2_0'
               WRITE(IU_ERR, '(/A)')
     &            'UNPARAMETRIZED CLOUD DATA ARE NOT IN A '
     &            //'RECOGNIZED FORMAT.'
               IERR=I_ERR_FATAL
               RETURN
            ENDIF
         ENDDO
      ENDDO
!
!     RECORD THE PRESENCE OF THE DROP TYPE AND THE INDEX
!     OF THE PARAMETRIZATION
      L_DROP_TYPE(I_DROP)=.TRUE.
      I_DROP_PARAMETRIZATION(I_DROP)=IP_DROP_UNPARAMETRIZED
!
!
      RETURN
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO READ IN THE CONTENTS OF BLOCK TYPE 11.      *
!     *                AEROSOL SCATTERING DATA.                       *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE READ_BLOCK_11_0_0(IERR, N_BAND
     &   , L_AEROSOL_COMPONENT, AEROSOL_ABSORPTION
     &   , AEROSOL_SCATTERING, AEROSOL_ASYMMETRY
     &   , NHUMIDITY, I_AEROSOL_PARAMETRIZATION
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/aerosol_component.pcf'
      INCLUDE 'incl/aerosol_component.ncf'
      INCLUDE 'incl/aerosol_parametrization.pcf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
     &   , NHUMIDITY(NPD_AEROSOL_SPECIES)
!             (DUMMY) NUMBER OF HUMIDITIES
     &   , I_AEROSOL_PARAMETRIZATION(NPD_AEROSOL_SPECIES)
!             PARAMETRIZATION OF SPECIES
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
      LOGICAL	!, INTENT(OUT)
     &     L_AEROSOL_COMPONENT(NPD_AEROSOL_SPECIES)
!             SPECIES PRESENT
      REAL*8	!, INTENT(OUT)
     &     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
!
!
!     LOCAL VARIABLES.
      INTEGER
     &     I
!             LOOP VARIABLE
     &   , I_COMPONENT
!             INDEX OF COMPONENT
     &   , IDUM
!             DUMMY READING VARIABLE
     &   , IOS
!             I/O ERROR FLAG
!
!
      INCLUDE 'incl/aerosol_component.dcf'
!
!
!
      READ(IU_SPC, '(/, 18X, I5, //)') I_COMPONENT
!
!     READ IN THE SCATTERING PARAMETERS FOR EACH BAND
      DO I=1, N_BAND
         READ(IU_SPC, FMT='(I5, 3(4X, 1PE16.9))', IOSTAT=IOS) IDUM
     &      , AEROSOL_ABSORPTION(1, I_COMPONENT, I)
     &      , AEROSOL_SCATTERING(1, I_COMPONENT, I)
     &      , AEROSOL_ASYMMETRY(1, I_COMPONENT, I)
         IF (IOS.NE.0) THEN
            WRITE(IU_ERR, '(/A/)')
     &         '*** ERROR IN SUBROUTINE READ_BLOCK_11_0_0'
            WRITE(IU_ERR, '(A)')
     &         'DRY AEROSOL SCATTERING DATA ARE '
     &         //'NOT IN THE CORRECT FORMAT.'
            IERR=I_ERR_FATAL
            RETURN
         ENDIF
!        CONVERT TO QUANTITIES PER UNIT MASS.
         AEROSOL_ABSORPTION(1, I_COMPONENT, I)
     &      =AEROSOL_ABSORPTION(1, I_COMPONENT, I)
     &      /DENSITY_COMPONENT(I_COMPONENT)
         AEROSOL_SCATTERING(1, I_COMPONENT, I)
     &      =AEROSOL_SCATTERING(1, I_COMPONENT, I)
     &      /DENSITY_COMPONENT(I_COMPONENT)
      ENDDO
      NHUMIDITY(I_COMPONENT)=0
      I_AEROSOL_PARAMETRIZATION(I_COMPONENT)=IP_AEROSOL_PARAM_DRY
!
!     AFTER SUCEESFUL READING THE PRESENCE 
!     OF THIS COMPONENT IS SPECIFIED.
      L_AEROSOL_COMPONENT(I_COMPONENT)=.TRUE.
!
!
      RETURN
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO READ IN THE CONTENTS OF BLOCK TYPE 11.      *
!     *                AEROSOL SCATTERING DATA.                       *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE READ_BLOCK_11_0_1(IERR, N_BAND
     &   , L_AEROSOL_SPECIES, AEROSOL_ABSORPTION
     &   , AEROSOL_SCATTERING, AEROSOL_ASYMMETRY
     &   , NHUMIDITY, I_AEROSOL_PARAMETRIZATION
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/aerosol_parametrization.pcf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
     &   , NHUMIDITY(NPD_AEROSOL_SPECIES)
!             (DUMMY) NUMBER OF HUMIDITIES
     &   , I_AEROSOL_PARAMETRIZATION(NPD_AEROSOL_SPECIES)
!             PARAMETRIZATION OF SPECIES
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
      LOGICAL	!, INTENT(OUT)
     &     L_AEROSOL_SPECIES(NPD_AEROSOL_SPECIES)
!             SPECIES PRESENT
      REAL*8	!, INTENT(OUT)
     &     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
!
!
!     LOCAL VARIABLES.
      INTEGER
     &     I
!             LOOP VARIABLE
     &   , I_SPECIES
!             INDEX OF SPECIES
     &   , IDUM
!             DUMMY READING VARIABLE
     &   , IOS
!             I/O ERROR FLAG
!
!
      READ(IU_SPC, '(/, 19X, I5, //)') I_SPECIES
!
!     READ IN THE SCATTERING PARAMETERS FOR EACH BAND
      DO I=1, N_BAND
         READ(IU_SPC, FMT='(I5, 3(4X, 1PE16.9))', IOSTAT=IOS) IDUM
     &      , AEROSOL_ABSORPTION(1, I_SPECIES, I)
     &      , AEROSOL_SCATTERING(1, I_SPECIES, I)
     &      , AEROSOL_ASYMMETRY(1, I_SPECIES, I)
         IF (IOS.NE.0) THEN
            WRITE(IU_ERR, '(/A/)')
     &         '*** ERROR IN SUBROUTINE READ_BLOCK_11_0_1'
            WRITE(IU_ERR, '(A)')
     &         'DRY AEROSOL SCATTERING DATA ARE '
     &         //'NOT IN THE CORRECT FORMAT.'
            IERR=I_ERR_FATAL
            RETURN
         ENDIF
      ENDDO
      NHUMIDITY(I_SPECIES)=0
      I_AEROSOL_PARAMETRIZATION(I_SPECIES)=IP_AEROSOL_PARAM_DRY
!
!     AFTER SUCESSFUL READING THE PRESENCE OF THIS SPECIES IS SPECIFIED.
      L_AEROSOL_SPECIES(I_SPECIES)=.TRUE.
!
!
      RETURN
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO READ IN THE CONTENTS OF BLOCK TYPE 11.      *
!     *              MOIST AEROSOL SCATTERING DATA.                   *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE READ_BLOCK_11_1_0(IERR, N_BAND
     &   , L_AEROSOL_COMPONENT, AEROSOL_ABSORPTION
     &   , AEROSOL_SCATTERING, AEROSOL_ASYMMETRY
     &   , NHUMIDITY, HUMIDITIES, I_AEROSOL_PARAMETRIZATION
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/aerosol_parametrization.pcf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
     &   , NHUMIDITY(NPD_AEROSOL_SPECIES)
!             NUMBER OF HUMIDITIES
     &   , I_AEROSOL_PARAMETRIZATION(NPD_AEROSOL_SPECIES)
!             PARAMETRIZATION OF SPECIES
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
      LOGICAL	!, INTENT(OUT)
     &     L_AEROSOL_COMPONENT(NPD_AEROSOL_SPECIES)
!             SPECIES PRESENT
      REAL*8	!, INTENT(OUT)
     &     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)
!             VALUES OF HUMIDITY FOR AEROSOLS
!
!
!     LOCAL VARIABLES.
      INTEGER
     &     I
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
     &   , I_COMPONENT
!             INDEX OF COMPONENT
     &   , IOS
!             I/O ERROR FLAG
!
!
      READ(IU_SPC, '(/, 19X, I5 )') I_COMPONENT
      READ(IU_SPC, '(28X, I3)') NHUMIDITY(I_COMPONENT)
!
!     READ IN THE SCATTERING PARAMETERS FOR EACH BAND
      DO I=1, N_BAND
         READ(IU_SPC, '(//)')
         DO K=1, NHUMIDITY(I_COMPONENT)
            READ(IU_SPC, '(4(4X, 1PE12.5))', IOSTAT=IOS)
     &           HUMIDITIES(K, I_COMPONENT)
     &         , AEROSOL_ABSORPTION(K, I_COMPONENT, I)
     &         , AEROSOL_SCATTERING(K, I_COMPONENT, I)
     &         , AEROSOL_ASYMMETRY(K, I_COMPONENT, I)
            IF (IOS.NE.0) THEN
               WRITE(IU_ERR, '(/A/)')
     &            '*** ERROR IN SUBROUTINE READ_BLOCK_11_1_0'
               WRITE(IU_ERR, '(A)')
     &            'MOIST AEROSOL SCATTERING DATA ARE '
     &            //'NOT IN THE CORRECT FORMAT.'
               IERR=I_ERR_FATAL
               RETURN
            ENDIF
         ENDDO
      ENDDO
!
      I_AEROSOL_PARAMETRIZATION(I_COMPONENT)=IP_AEROSOL_PARAM_MOIST
!
!     AFTER SUCEESFUL READING THE PRESENCE 
!     OF THIS COMPONENT IS SPECIFIED.
      L_AEROSOL_COMPONENT(I_COMPONENT)=.TRUE.
!
!
      RETURN
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO READ IN THE CONTENTS OF BLOCK TYPE 11.      *
!     *              MOIST AEROSOL SCATTERING DATA.                   *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE READ_BLOCK_11_1_1(IERR, N_BAND
     &   , L_AEROSOL_SPECIES, AEROSOL_ABSORPTION
     &   , AEROSOL_SCATTERING, AEROSOL_ASYMMETRY
     &   , NHUMIDITY, HUMIDITIES, I_AEROSOL_PARAMETRIZATION
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/aerosol_parametrization.pcf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
     &   , NHUMIDITY(NPD_AEROSOL_SPECIES)
!             NUMBER OF HUMIDITIES
     &   , I_AEROSOL_PARAMETRIZATION(NPD_AEROSOL_SPECIES)
!             PARAMETRIZATION OF SPECIES
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
      LOGICAL	!, INTENT(OUT)
     &     L_AEROSOL_SPECIES(NPD_AEROSOL_SPECIES)
!             SPECIES PRESENT
      REAL*8	!, INTENT(OUT)
     &     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)
!             VALUES OF HUMIDITY FOR AEROSOLS
!
!
!     LOCAL VARIABLES.
      INTEGER
     &     I
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
     &   , I_SPECIES
!             INDEX OF COMPONENT
     &   , IOS
!             I/O ERROR FLAG
!
!
      READ(IU_SPC, '(/, 19X, I5 )') I_SPECIES
      READ(IU_SPC, '(28X, I3)') NHUMIDITY(I_SPECIES)
!
!     READ IN THE SCATTERING PARAMETERS FOR EACH BAND
      DO I=1, N_BAND
         READ(IU_SPC, '(//)')
         DO K=1, NHUMIDITY(I_SPECIES)
            READ(IU_SPC, '(4(4X, 1PE12.5))', IOSTAT=IOS)
     &           HUMIDITIES(K, I_SPECIES)
     &         , AEROSOL_ABSORPTION(K, I_SPECIES, I)
     &         , AEROSOL_SCATTERING(K, I_SPECIES, I)
     &         , AEROSOL_ASYMMETRY(K, I_SPECIES, I)
            IF (IOS.NE.0) THEN
               WRITE(IU_ERR, '(/A/)')
     &            '*** ERROR IN SUBROUTINE READ_BLOCK_11_1_1'
               WRITE(IU_ERR, '(A)')
     &            'MOIST AEROSOL SCATTERING DATA ARE '
     &            //'NOT IN THE CORRECT FORMAT.'
               IERR=I_ERR_FATAL
               RETURN
            ENDIF
         ENDDO
      ENDDO
!
      I_AEROSOL_PARAMETRIZATION(I_SPECIES)=IP_AEROSOL_PARAM_MOIST
!
!     AFTER SUCESSFUL READING THE PRESENCE OF THIS SPECIES IS SPECIFIED.
      L_AEROSOL_SPECIES(I_SPECIES)=.TRUE.
!
!
      RETURN
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO READ IN THE CONTENTS OF BLOCK TYPE 11.      *
!     *           UNPARAMETRIZED AEROSOL SCATTERING DATA.             *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE READ_BLOCK_11_2_0(IERR
     &   , N_BAND
     &   , L_AEROSOL_SPECIES, I_AEROSOL_PARAMETRIZATION
     &   , N_AEROSOL_DATA_LAYER
     &   , OBS_AEROSOL_PRESSURE, OBS_AEROSOL_ABSORPTION
     &   , OBS_AEROSOL_SCATTERING, OBS_AEROSOL_ASYMMETRY
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/aerosol_parametrization.pcf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
     &   , I_AEROSOL_PARAMETRIZATION(NPD_AEROSOL_SPECIES)
!             NUMBER OF PARAMETRIZATION
     &   , N_AEROSOL_DATA_LAYER(NPD_AEROSOL_SPECIES)
!             NUMBER OF AEROSOL DATA LAYERS
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
      LOGICAL	!, INTENT(OUT)
     &     L_AEROSOL_SPECIES(NPD_AEROSOL_SPECIES)
!             TYPES OF AEROSOL PRESENT
      REAL*8	!, INTENT(OUT)
     &     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
!
!     LOCAL VARIABLES.
      INTEGER
     &     I_SPECIES
!             SPECIES OF AEROSOL
     &   , N_TEMP
!             TEMPORARY VARIABLE
     &   , I
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
     &   , IOS
!             I/O ERROR FLAG
!
!
!     READ THE HEADERS.
      READ(IU_SPC, '(/, 21X, I5, /, 35X, I5)')
     &   I_SPECIES, N_TEMP
!
!     CHECK THE SIZES OF ARRAYS.
      IF ( (I_SPECIES.LT.0).OR.(I_SPECIES.GT.NPD_AEROSOL_SPECIES) ) THEN
         WRITE(IU_ERR, '(/A)')
     &      '*** ERROR IN SUBROUTINE READ_BLOCK_11_2_0'
         WRITE(IU_ERR, '(A)')
     &      'THE TYPE OF AEROSOL IS OUTSIDE THE ALLOWED RANGE'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
      IF ( (N_TEMP.LT.0).OR.(N_TEMP.GT.NPD_AEROSOL_DATA_LAYER) ) THEN
         WRITE(IU_ERR, '(/A)')
     &      '*** ERROR IN SUBROUTINE READ_BLOCK_11_2_0'
         WRITE(IU_ERR, '(A)')
     &      'THERE ARE TOO MANY LEVELS OF AEROSOL DATA '
     &      //'IN THE SPECTRAL FILE.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
      N_AEROSOL_DATA_LAYER(I_SPECIES)=N_TEMP
!
      DO I=1, N_BAND
         READ(IU_SPC, '(//)')
         DO K=0, N_AEROSOL_DATA_LAYER(I_SPECIES)
            READ(IU_SPC, '(4(4X, 1PE12.5))', IOSTAT=IOS)
     &           OBS_AEROSOL_PRESSURE(K, I_SPECIES)
     &         , OBS_AEROSOL_ABSORPTION(K, I_SPECIES, I)
     &         , OBS_AEROSOL_SCATTERING(K, I_SPECIES, I)
     &         , OBS_AEROSOL_ASYMMETRY(K, I_SPECIES, I)
            IF (IOS.NE.0) THEN
               WRITE(IU_ERR, '(/A)')
     &            '*** ERROR IN SUBROUTINE READ_BLOCK_11_2_0'
               WRITE(IU_ERR, '(/A)')
     &            'UNPARAMETRIZED AEROSOL DATA ARE NOT IN A '
     &            //'RECOGNIZED FORMAT.'
               IERR=I_ERR_FATAL
               RETURN
            ENDIF
         ENDDO
      ENDDO
!
!     RECORD THE PRESENCE OF THE DROP TYPE AND THE INDEX
!     OF THE PARAMETRIZATION
      L_AEROSOL_SPECIES(I_SPECIES)=.TRUE.
      I_AEROSOL_PARAMETRIZATION(I_SPECIES)=IP_AEROSOL_UNPARAMETRIZED
!
!
      RETURN
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO READ IN THE CONTENTS OF BLOCK TYPE 12.      *
!     *            PARAMETRIZED ICE CRYSTAL SCATTERING DATA.          *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE READ_BLOCK_12_0_0(IERR
     &   , N_BAND
     &   , L_ICE_TYPE, I_ICE_PARAMETRIZATION, ICE_PARAMETER_LIST
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/ice_cloud_parametrization.pcf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
     &   , I_ICE_PARAMETRIZATION(NPD_ICE_TYPE)
!             NUMBER OF PARAMETRIZATION
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
      LOGICAL	!, INTENT(OUT)
     &     L_ICE_TYPE(NPD_ICE_TYPE)
!             TYPES OF ICE CRYSTALS PRESENT
      REAL*8	!, INTENT(OUT)
     &     ICE_PARAMETER_LIST(NPD_CLOUD_PARAMETER
     &   , NPD_BAND, NPD_ICE_TYPE)
!             FITTING PARAMETERS FOR ICE
!
!     LOCAL VARIABLES.
      INTEGER
     &     I_ICE
!             TYPE OF ICE CRYSTAL
     &   , I_PARAMETRIZATION_ICE
!             DUMMY INDEX OF PARAMETER SCHEME
     &   , N_PARAMETER
!             NUMBER OF PARAMETERS
     &   , I
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
     &   , IOS
!             I/O ERROR FLAG
     &   , I_DUMMY
!             DUMMY READING VARIABLE
!
!
!     READ THE HEADERS.
      READ(IU_SPC, '(/, 31X, I5, /, 34X, I5, 27X, I5)')
     &   I_ICE, I_PARAMETRIZATION_ICE, I_DUMMY
!
      IF ( (I_PARAMETRIZATION_ICE.EQ.IP_SLINGO_SCHRECKER_ICE)
     &   .OR.(I_PARAMETRIZATION_ICE.EQ.IP_CIRRUS_ADT)
     &   .OR.(I_PARAMETRIZATION_ICE.EQ.IP_SUN_SHINE_VN2_VIS)
     &   .OR.(I_PARAMETRIZATION_ICE.EQ.IP_SUN_SHINE_VN2_IR) ) THEN
!        DATA ARE PARAMETRIZED.
         N_PARAMETER=I_DUMMY
!
         DO I=1, N_BAND
            READ(IU_SPC, FMT='(/, (4(4X, 1PE12.5)))', IOSTAT=IOS)
     &         (ICE_PARAMETER_LIST(K, I, I_ICE), K=1, N_PARAMETER)
!           FOR EACH BAND READ THE VALUES OF THE PARAMETERS.
            IF (IOS.NE.0) THEN
               WRITE(IU_ERR, '(/A/)')
     &            '*** ERROR IN SUBROUTINE READ_BLOCK_12_0_0'
               WRITE(IU_ERR, *)
     &            'DATA FOR ICE CRYSTALS ARE NOT '
     &            //'IN THE CORRECT FORMAT.'
               IERR=I_ERR_FATAL
               RETURN
            ENDIF
         ENDDO
      ELSE
!        ILLEGAL PARAMETRIZATION SCHEME ENCOUNTERED.
         WRITE(IU_ERR, '(/A)')
     &      '*** ERROR IN SUBROUTINE READ_BLOCK_12_0_0'
         WRITE(IU_ERR, '(/A)')
     &      'AN UNKNOWN PARAMETRIZATION SCHEME HAS BEEN SPECIFIED.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
!
!     RECORD THE PRESENCE OF THE ICE CRYSTAL TYPE AND THE INDEX
!     OF THE PARAMETRIZATION
      L_ICE_TYPE(I_ICE)=.TRUE.
      I_ICE_PARAMETRIZATION(I_ICE)=I_PARAMETRIZATION_ICE
!
!
      RETURN
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO READ IN THE CONTENTS OF BLOCK TYPE 10.      *
!     *                PARAMETRIZED MIE SCATTERING DATA.              *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE READ_BLOCK_12_2_0(IERR
     &   , N_BAND
     &   , L_ICE_TYPE, I_ICE_PARAMETRIZATION
     &   , N_ICE_DATA_LAYER, ICE_PRESSURE
     &   , ICE_ABSORPTION
     &   , ICE_SCATTERING, ICE_ASYMMETRY
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/ice_cloud_parametrization.pcf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
     &   , I_ICE_PARAMETRIZATION(NPD_ICE_TYPE)
!             NUMBER OF PARAMETRIZATION
     &   , N_ICE_DATA_LAYER(NPD_ICE_TYPE)
!             NUMBER OF ICE CLOUD DATA LAYERS
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
      LOGICAL	!, INTENT(OUT)
     &     L_ICE_TYPE(NPD_ICE_TYPE)
!             TYPES OF ICE CRYSTALS PRESENT
      REAL*8	!, INTENT(OUT)
     &     ICE_PRESSURE(0: NPD_CLOUD_DATA_LAYER, NPD_ICE_TYPE)
!             PRESSURE AT CLOUD DATA LEVELS
     &   , ICE_ABSORPTION(0: NPD_CLOUD_DATA_LAYER, NPD_BAND
     &        , NPD_ICE_TYPE)
!             CLOUD ABSORPTION
     &   , ICE_SCATTERING(0: NPD_CLOUD_DATA_LAYER, NPD_BAND
     &        , NPD_ICE_TYPE)
!             CLOUD SCATTERING
     &   , ICE_ASYMMETRY(0: NPD_CLOUD_DATA_LAYER, NPD_BAND
     &        , NPD_ICE_TYPE)
!             CLOUD ASYMMETRY
!
!     LOCAL VARIABLES.
      INTEGER
     &     I_ICE
!             TYPE OF ICE CRYSTAL
     &   , N_TEMP
!             TEMPORARY VARIABLE
     &   , I
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
     &   , IOS
!             I/O ERROR FLAG
!
!
!     READ THE HEADERS.
      READ(IU_SPC, '(/, 27X, I5, /, 34X, I5)')
     &   I_ICE, N_TEMP
!
!     CHECK THE SIZES OF ARRAYS.
      IF ( (I_ICE.LT.0).OR.(I_ICE.GT.NPD_ICE_TYPE) ) THEN
         WRITE(IU_ERR, '(/A)')
     &      '*** ERROR IN SUBROUTINE READ_BLOCK_12_2_0'
         WRITE(IU_ERR, '(A)')
     &      'THE TYPE OF ICE CRYSTAL IS OUTSIDE THE ALLOWED RANGE'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
      IF ( (N_TEMP.LT.0).OR.(N_TEMP.GT.NPD_CLOUD_DATA_LAYER) ) THEN
         WRITE(IU_ERR, '(/A)')
     &      '*** ERROR IN SUBROUTINE READ_BLOCK_12_2_0'
         WRITE(IU_ERR, '(A)')
     &      'THERE ARE TOO MANY LEVELS OF ICE DATA '
     &      //'IN THE SPECTRAL FILE.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
      N_ICE_DATA_LAYER(I_ICE)=N_TEMP
!
      DO I=1, N_BAND
         READ(IU_SPC, '(//)')
         DO K=0, N_ICE_DATA_LAYER(I_ICE)
            READ(IU_SPC, '(4(4X, 1PE12.5))', IOSTAT=IOS)
     &           ICE_PRESSURE(K, I_ICE)
     &         , ICE_ABSORPTION(K, I, I_ICE)
     &         , ICE_SCATTERING(K, I, I_ICE)
     &         , ICE_ASYMMETRY(K, I, I_ICE)
            IF (IOS.NE.0) THEN
               WRITE(IU_ERR, '(/A)')
     &            '*** ERROR IN SUBROUTINE READ_BLOCK_12_2_0'
               WRITE(IU_ERR, '(/A)')
     &            'UNPARAMETRIZED ICE CLOUD DATA ARE NOT IN A '
     &            //'RECOGNIZED FORMAT.'
               IERR=I_ERR_FATAL
               RETURN
            ENDIF
         ENDDO
      ENDDO
!
!     RECORD THE PRESENCE OF THE ICE TYPE AND THE INDEX
!     OF THE PARAMETRIZATION
      L_ICE_TYPE(I_ICE)=.TRUE.
      I_ICE_PARAMETRIZATION(I_ICE)=IP_ICE_UNPARAMETRIZED
!
!
      RETURN
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO READ IN THE CONTENTS OF BLOCK TYPE 13.      *
!     *                DOPPLER BROADENING TERMS.                      *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE READ_BLOCK_13_0_0(IERR, N_ABSORB
     &   , L_DOPPLER_PRESENT, DOPPLER_CORRECTION
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
      INTEGER	!, INTENT(IN)
     &     N_ABSORB
!             NUMBER OF ABSORBERS
      LOGICAL	!, INTENT(OUT)
     &     L_DOPPLER_PRESENT(NPD_SPECIES)
!             DOPPLER FLAGS
      REAL*8	!, INTENT(OUT)
     &     DOPPLER_CORRECTION(NPD_SPECIES)
!             DOPPLER CORRECTIONS
!
!
!     LOCAL VARIABLES.
      INTEGER
     &     I
!             LOOP VARIABLE
     &   , IDUM
!             DUMMY READING VARIABLE
     &   , IOS
!             I/O ERROR FLAG
      LOGICAL
     &     L_DUM
!             DUMMY LOGICAL
      REAL*8
     &     R_DUM
!             DUMMY REAL
!
!
      READ(IU_SPC, '(/)')
!
!     READ IN THE DOPPLER INFORMATION FOR EACH GAS.
      DO I=1, N_ABSORB
         READ(IU_SPC, FMT='(I5, 7X, L6, 9X, 1PE12.5)', IOSTAT=IOS)
     &      IDUM, L_DUM, R_DUM
         IF (IOS.NE.0) THEN
            WRITE(IU_ERR, '(/A)')
     &         '***ERROR: DOPPLER BROADENING DATA ARE NOT IN '
     &         //'THE CORRECT FORMAT.'
            IERR=I_ERR_FATAL
            RETURN
         ENDIF
         L_DOPPLER_PRESENT(IDUM)=L_DUM
         DOPPLER_CORRECTION(IDUM)=R_DUM
      ENDDO
!
!
      RETURN
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO READ IN THE CONTENTS OF BLOCK TYPE 14.      *
!     *        BANDS EXCLUDED FROM REGIONS OF THE SPECTRUM.           *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE READ_BLOCK_14_0_0(IERR
     &   , N_BAND
     &   , N_BAND_EXCLUDE, INDEX_EXCLUDE
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
     &   , N_BAND_EXCLUDE(NPD_BAND)
!             NUMBER OF BANDS EXCLUDED FROM PARTICULAR BANDS
     &   , INDEX_EXCLUDE(NPD_EXCLUDE, NPD_BAND)
!             LIST OF EXCLUDED BANDS
!
!     LOCAL VARIABLES.
      INTEGER
     &     IDUM
!             DUMMY INTEGER
     &   , I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
     &   , IOS
!             IOS ERROR VARIABLE
!
!
!     SKIP OVER THE HEADERS.
      READ(IU_SPC, '(//)')
!
!     READ IN THE LIST OF EXCLUDED BANDS FOR EACH BAND IN TURN.
      DO I=1, N_BAND
         READ(IU_SPC, FMT='(I5, 7X, I5)', IOSTAT=IOS)
     &      IDUM, N_BAND_EXCLUDE(I)
         IF (IOS.NE.0) THEN
            WRITE(IU_ERR, '(/A/)')
     &         '*** ERROR IN SUBROUTINE READ_BLOCK_14_0_0'
            WRITE(IU_ERR, *)
     &         'THE LIST OF EXCLUDED BANDS IS NOT CORRECT.'
            IERR=I_ERR_FATAL
            RETURN
         ENDIF
         IF (N_BAND_EXCLUDE(I).GT.0) THEN
            READ(IU_SPC, '(14X, 8(3X, I5))')
     &         (INDEX_EXCLUDE(J, I), J=1, N_BAND_EXCLUDE(I) )
         ENDIF
         IF (IOS.NE.0) THEN
            WRITE(IU_ERR, '(/A/)')
     &         '*** ERROR IN SUBROUTINE READ_BLOCK_14_0_0'
            WRITE(IU_ERR, *)
     &         'THE LIST OF EXCLUDED BANDS IS NOT CORRECT.'
            IERR=I_ERR_FATAL
            RETURN
         ENDIF
      ENDDO
!
!
      RETURN
      END
