!+ Subroutines to write out the data in a spectral file.
!
! Method:
!	The output file is opened and a subroutine is called to
!	write out each block of data.
!
! 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 OUT_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/continuum.pcf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY VARIABLES.
      CHARACTER	!, INTENT(IN)
     &     FILE_SPECTRAL*(*)
!             NAME OF SPECTRAL FILE
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
      INCLUDE 'dec_spec.finc'
!
!     LOCAL VARIABLES.
      INTEGER
     &     IOS
!             IO ERROR FLAG
     &   , I
!             LOOP VARIABLE
      LOGICAL
     &     L_OPEN
!             OPEN FLAG FOR FILE
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     WRITE_BLOCK_0, WRITE_BLOCK_1, WRITE_BLOCK_2
     &   , WRITE_BLOCK_3, WRITE_BLOCK_4, WRITE_BLOCK_5
     &   , WRITE_BLOCK_6, WRITE_BLOCK_7, WRITE_BLOCK_8
     &   , WRITE_BLOCK_9, WRITE_BLOCK_10, WRITE_BLOCK_11
     &   , WRITE_BLOCK_12, WRITE_BLOCK_13, WRITE_BLOCK_14
!
!
!
!     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 WRITING.
      OPEN(UNIT=IU_SPC, FILE=FILE_SPECTRAL, IOSTAT=IOS
     &   , STATUS='UNKNOWN'
     &   )
      IF (IOS.NE.0) THEN
         WRITE(IU_ERR, '(/A)') '*** ERROR: FILE COULD NOT BE OPENED.'
         IERR=I_ERR_FATAL
         RETURN
      ENDIF
!
!     FOR EACH TYPE OF DATA WHICH IS PRESENT
!     WRITE OUT THE APPROPRIATE BLOCK.
!     WE DEFAULT TO THE LOWEST TYPE AND VERSION.
      IF (L_PRESENT(0)) THEN
         CALL WRITE_BLOCK_0(N_BAND, N_ABSORB, TYPE_ABSORB
     &      , N_AEROSOL, TYPE_AEROSOL)
      ENDIF
      IF (L_PRESENT(1)) THEN
         CALL WRITE_BLOCK_1(N_BAND
     &      , WAVE_LENGTH_SHORT, WAVE_LENGTH_LONG)
      ENDIF
      IF (L_PRESENT(2)) THEN
         CALL WRITE_BLOCK_2(N_BAND, SOLAR_FLUX_BAND)
      ENDIF
      IF (L_PRESENT(3)) THEN
         CALL WRITE_BLOCK_3(N_BAND, RAYLEIGH_COEFFICIENT)
      ENDIF
      IF (L_PRESENT(4)) THEN
         CALL WRITE_BLOCK_4(N_BAND, N_BAND_ABSORB, INDEX_ABSORB)
      ENDIF
      IF (L_PRESENT(5)) THEN
         CALL WRITE_BLOCK_5(N_BAND, N_BAND_ABSORB
     &      , INDEX_ABSORB, I_BAND_ESFT
     &      , K_ESFT, W_ESFT, I_SCALE_ESFT
     &      , I_SCALE_FNC, SCALE_VECTOR, P_REFERENCE, T_REFERENCE
     &      )
      ENDIF
      IF (L_PRESENT(6)) THEN
         CALL WRITE_BLOCK_6(N_BAND, N_DEG_FIT
     &      , T_REF_PLANCK, THERMAL_COEFFICIENT)
      ENDIF
      IF (L_PRESENT(7)) THEN
!        HERE DIFFERENT BLOCKS ARE PRODUCED FOR DIFFERENT SURFACES.
         DO I=1, NPD_SURFACE
            IF (L_SURFACE(I)) THEN
               CALL WRITE_BLOCK_7(N_BAND, I, I_SPEC_SURFACE(I)
     &            , SURFACE_ALBEDO(1, I), N_DIR_ALBEDO_FIT(I)
     &            , DIRECT_ALBEDO_PARM(0, 1, I)
     &            , EMISSIVITY_GROUND(1, I))
            ENDIF
         ENDDO
      ENDIF
      IF (L_PRESENT(8)) THEN
         CALL WRITE_BLOCK_8(N_BAND, N_BAND_CONTINUUM
     &      , INDEX_CONTINUUM, INDEX_WATER)
      ENDIF
      IF (L_PRESENT(9)) THEN
         CALL WRITE_BLOCK_9(N_BAND, N_BAND_CONTINUUM
     &      , INDEX_CONTINUUM
     &      , K_CONTINUUM
     &      , I_SCALE_FNC_CONT, SCALE_CONTINUUM
     &      , P_REF_CONTINUUM, T_REF_CONTINUUM
     &      )
      ENDIF
      IF (L_PRESENT(10)) THEN
!        A SEPARATE  BLOCK IS WRITTEN FOR EACH TYPE OF DROP.
         DO I=1, NPD_DROP_TYPE
            IF (L_DROP_TYPE(I)) THEN
               CALL WRITE_BLOCK_10(N_BAND
     &            , I, I_DROP_PARAMETRIZATION(I)
     &            , DROP_PARAMETER_LIST(1, 1, I)
     &            , N_DROP_DATA_LAYER(I)
     &            , DROP_PRESSURE(0, I), DROP_ABSORPTION(0, 1, I)
     &            , DROP_SCATTERING(0, 1, I), DROP_ASYMMETRY(0, 1, I)
     &            )
            ENDIF
         ENDDO
      ENDIF
      IF (L_PRESENT(11)) THEN
!        A DIFFERENT BLOCK IS PRODUCED FOR EACH SPECIES.
         DO I=1, N_AEROSOL
            IF (L_AEROSOL_SPECIES(I)) THEN
               CALL WRITE_BLOCK_11(N_BAND
     &            , I, I_AEROSOL_PARAMETRIZATION(I), TYPE_AEROSOL(I)
     &            , AEROSOL_ABSORPTION
     &            , AEROSOL_SCATTERING, AEROSOL_ASYMMETRY
     &            , NHUMIDITY(I), HUMIDITIES
     &            , N_AEROSOL_DATA_LAYER(I)
     &            , OBS_AEROSOL_PRESSURE
     &            , OBS_AEROSOL_ABSORPTION
     &            , OBS_AEROSOL_SCATTERING
     &            , OBS_AEROSOL_ASYMMETRY
     &            )
            ENDIF
         ENDDO
      ENDIF
      IF (L_PRESENT(12)) THEN
!        A SEPARATE  BLOCK IS WRITTEN FOR EACH TYPE OF CRYSTAL.
         DO I=1, NPD_ICE_TYPE
            IF (L_ICE_TYPE(I)) THEN
               CALL WRITE_BLOCK_12(N_BAND
     &            , I, I_ICE_PARAMETRIZATION(I)
     &            , ICE_PARAMETER_LIST(1, 1, I)
     &            , N_ICE_DATA_LAYER(I)
     &            , ICE_PRESSURE(0, I)
     &            , ICE_ABSORPTION(0, 1, I)
     &            , ICE_SCATTERING(0, 1, I)
     &            , ICE_ASYMMETRY(0, 1, I)
     &            )
            ENDIF
         ENDDO
      ENDIF
      IF (L_PRESENT(13)) THEN
         CALL WRITE_BLOCK_13(N_ABSORB
     &      , L_DOPPLER_PRESENT, DOPPLER_CORRECTION
     &      )
      ENDIF
      IF (L_PRESENT(14)) THEN
         CALL WRITE_BLOCK_14(N_BAND, N_BAND_EXCLUDE, INDEX_EXCLUDE)
      ENDIF
!
!     CLOSE THE FILE.
      CLOSE(IU_SPC)
!
!
      RETURN
      END
!     ******************************************************************
!     *                                                                *
!     *      SUBROUTINE TO WRITE BLOCK TYPE 0.                         *
!     *                                                                *
!     ******************************************************************
      SUBROUTINE WRITE_BLOCK_0(N_BAND, N_ABSORB, TYPE_ABSORB
     &   , N_AEROSOL, TYPE_AEROSOL)
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/gas_list.pcf'
      INCLUDE 'incl/gas_list.ncf'
      INCLUDE 'incl/aerosol_component.pcf'
      INCLUDE 'incl/aerosol_name.ncf'
      INCLUDE 'incl/dimensions_spec.ucf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF SPECTRAL BANDS
     &   , N_ABSORB
!             NUMBER OF ABSORBERS
     &   , N_AEROSOL
!             NUMBER OF AEROSOLS
     &   , TYPE_ABSORB(NPD_SPECIES)
!             TYPE NUMBERS OF ABSORBERS
     &   , TYPE_AEROSOL(NPD_AEROSOL_SPECIES)
!             TYPE NUMBERS OF AEROSOLS
!
!     LOCAL VARIABLES.
      INTEGER
     &     I
!             LOOP VARIABLE
     &   , I_TYPE
!             TYPE VARIABLE
!
!     INCLUDE NAMES OF GASES AND AEROSOLS.
      INCLUDE 'incl/gas_names.dcf'
      INCLUDE 'incl/aerosol_name.dcf'
!
!
      WRITE(IU_SPC, '(A19, A16, A16)') '*BLOCK: TYPE =    0'
     &   , ': SUBTYPE =    0'
     &   , ': VERSION =    1'
      WRITE(IU_SPC, '(A)') 'SUMMARY OF SPECTRAL DATA.'
!
      WRITE (IU_SPC, '(A26, 1X, I5)')
     &   'NUMBER OF SPECTRAL BANDS =', N_BAND
      WRITE(IU_SPC, '(A35, 1X, I5)')
     &   'TOTAL NUMBER OF GASEOUS ABSORBERS =', N_ABSORB
      WRITE(IU_SPC, '(A26, 1X, I5)')
     &   'TOTAL NUMBER OF AEROSOLS =', N_AEROSOL
!
      WRITE(IU_SPC, '(A)') 'LIST OF INDEXING NUMBERS AND ABSORBERS.'
      WRITE(IU_SPC, '(A)')
     &   'INDEX       ABSORBER(TYPE NUMBER AND NAME)'
      DO I=1, N_ABSORB
         I_TYPE=TYPE_ABSORB(I)
         WRITE(IU_SPC, '(I5, 7X, I5, 7X, A)')
     &        I, I_TYPE, NAME_ABSORB(I_TYPE)
      ENDDO
!
      WRITE(IU_SPC, '(A)') 'LIST OF INDEXING NUMBERS OF AEROSOLS.'
      WRITE(IU_SPC, '(A)')
     &   'INDEX       AEROSOL(TYPE NUMBER AND NAME)'
      DO I=1, N_AEROSOL
         I_TYPE=TYPE_AEROSOL(I)
         WRITE(IU_SPC, '(I5, 7X, I5, 7X, A)')
     &        I, I_TYPE, NAME_AEROSOL_COMPONENT(I_TYPE)
      ENDDO
!
      WRITE(IU_SPC, '(A4)') '*END'
!
!
      RETURN
      END
!     ******************************************************************
!     *                                                                *
!     *      SUBROUTINE TO WRITE BLOCKS OF TYPE 1.                     *
!     *                                                                *
!     ******************************************************************
      SUBROUTINE WRITE_BLOCK_1(N_BAND
     &   , WAVE_LENGTH_SHORT, WAVE_LENGTH_LONG)
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(IN)
     &   N_BAND
!             NUMBER OF BANDS
      REAL*8	!, INTENT(IN)
     &     WAVE_LENGTH_SHORT(NPD_BAND)
!             SHORTER LIMITS OF BANDS
     &   , WAVE_LENGTH_LONG(NPD_BAND)
!             LONGER LIMITS OF BANDS
!
!     LOCAL VARIABLES.
      INTEGER
     &     I
!             LOOP VARIABLE
!
!
      WRITE(IU_SPC, '(A19, A16, A16)') '*BLOCK: TYPE =    1'
     &   , ': SUBTYPE =    0'
     &   , ': VERSION =    0'
      WRITE(IU_SPC, '(A)') 'SPECIFICATION OF SPECTRAL INTERVALS'
      WRITE(IU_SPC, '(A)')
     &   'LIMITS OF SPECTRAL INTERVALS (WAVELENGTHS IN M.)'
      WRITE(IU_SPC, '(A4, 8X, A11, 9X, A11)')
     &   'BAND', 'LOWER LIMIT', 'UPPER LIMIT'
!
      DO I=1, N_BAND
         WRITE(IU_SPC, '(I5, 3X, 2(4X, 1PE16.9))' )
     &      I, WAVE_LENGTH_SHORT(I), WAVE_LENGTH_LONG(I)
      ENDDO
!
      WRITE(IU_SPC, '(A4)') '*END'
!
!
      RETURN
      END
!     ******************************************************************
!     *                                                                *
!     *      SUBROUTINE TO WRITE A BLOCK OF TYPE 2.                    *
!     *                                                                *
!     ******************************************************************
      SUBROUTINE WRITE_BLOCK_2(N_BAND, SOLAR_FLUX_BAND)
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/def_spc_io.icf'
!
!     DUMMY ARGUMENTS
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF SPECTRAL BANDS
      REAL*8	!, INTENT(IN)
     &     SOLAR_FLUX_BAND(NPD_BAND)
!             SOLAR FLUX IN EACH BAND
!
!     LOCAL VARIABLES
      INTEGER
     &     I
!             LOOP VARIABLE
!
!
      WRITE(IU_SPC, '(A19, A16, A16)') '*BLOCK: TYPE =    2'
     &   , ': SUBTYPE =    0'
     &   , ': VERSION =    0'
      WRITE(IU_SPC, '(A  )')
     &   'NORMALIZED SOLAR FLUX IN EACH SPECTRAL INTERVAL.'
      WRITE(IU_SPC, '(A4, 8X, A15)') 'BAND', 'NORMALIZED FLUX'
!
      DO I=1, N_BAND
         WRITE(IU_SPC, '(I5, 7X, 1PE16.9)') I, SOLAR_FLUX_BAND(I)
      ENDDO
!
      WRITE(IU_SPC, '(A4)') '*END'
!
!
      RETURN
      END
!     ******************************************************************
!     *                                                                *
!     *      SUBROUTINE TO WRITE BLOCKS OF TYPE 3.                     *
!     *                                                                *
!     ******************************************************************
      SUBROUTINE WRITE_BLOCK_3(N_BAND
     &   , RAYLEIGH_COEFFICIENT
     &   )
!
!     INCLUDE HEADERS.
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF SPECTRAL BANDS
      REAL*8	!, INTENT(IN)
     &     RAYLEIGH_COEFFICIENT(NPD_BAND)
!             RAYLEIGH COEFFICIENTS
!
!     LOCAL VARIABLES.
      INTEGER
     &     I
!             LOOP VARIABLE
!
!
      WRITE(IU_SPC, '(A19, A16, A16)') '*BLOCK: TYPE =    3'
     &   , ': SUBTYPE =    0'
     &   , ': VERSION =    0'
      WRITE(IU_SPC, '(A)')
     &   'MASS RAYLEIGH SCATERING COEFFICIENTS AT STP: UNIT m**2/kg'
      WRITE(IU_SPC, '(A4, 8X, A20)') 'BAND', 'RAYLEIGH COEFFICIENT'
      WRITE(IU_SPC, '(17X, A5)') 'm2/kg'
!
      DO I=1, N_BAND
         WRITE(IU_SPC, '(I5, 7X, 1PE16.9)') I, RAYLEIGH_COEFFICIENT(I)
      ENDDO
!
      WRITE(IU_SPC, '(A4)') '*END'
!
!
      RETURN
      END
!     ******************************************************************
!     *                                                                *
!     *      SUBROUTINE TO WRITE BLOCKS OF TYPE 4.                     *
!     *                                                                *
!     ******************************************************************
      SUBROUTINE WRITE_BLOCK_4(N_BAND, N_BAND_ABSORB, INDEX_ABSORB)
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
!
!     DUMMY ARGUMENTS
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
     &   , N_BAND_ABSORB(NPD_BAND)
!             NUMBER OF ABSORBERS IN BANDS
     &   , INDEX_ABSORB(NPD_SPECIES, NPD_BAND)
!             INDICES OF ABSORBERS IN BANDS
!
!     LOCAL VARIABLES
      INTEGER
     &     I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
!
!
      WRITE(IU_SPC, '(A19, A16, A16)') '*BLOCK: TYPE =    4'
     &   , ': SUBTYPE =    0'
     &   , ': VERSION =    0'
      WRITE(IU_SPC, '(A)') 'GASEOUS ABSORBERS IN EACH INTERVAL'
      WRITE(IU_SPC, '(A)')
     &   '(THE NUMBER IS THE INDEXING NUMBER OF THE SPECIES AS SET OUT'
      WRITE(IU_SPC, '(A)')
     &   ' IN THE SUMMARY BLOCK 0.)'
      WRITE(IU_SPC, '(A)')
     &   'A ZERO INDICATES THAT THERE IN NO GASEOUS ABSORPTION '
     &   //'IN THE INTERVAL.'
      WRITE(IU_SPC, '(A4, 8X, A55)')
     &   'BAND'
     &   , 'NUMBER OF ACTIVE ABSORBERS FOLLOWED BY INDEXING NUMBERS'
!
      DO I=1, N_BAND
         WRITE(IU_SPC, '(I5, 7X, I5)') I, N_BAND_ABSORB(I)
         IF (N_BAND_ABSORB(I).GT.0) THEN
            WRITE(IU_SPC, '(5X, 4(2X, I3))')
     &         (INDEX_ABSORB(J, I), J=1, N_BAND_ABSORB(I))
         ENDIF
      ENDDO
!
      WRITE(IU_SPC, '(A4)') '*END'
!
!
      RETURN
      END
!     ******************************************************************
!     *                                                                *
!     *      SUBROUTINE TO WRITE BLOCKS OF TYPE 5.                     *
!     *                                                                *
!     ******************************************************************
      SUBROUTINE WRITE_BLOCK_5(N_BAND, N_BAND_ABSORB
     &   , INDEX_ABSORB, I_BAND_ESFT
     &   , K_ESFT, W_ESFT, I_SCALE_ESFT
     &   , I_SCALE_FNC, SCALE_VECTOR, P_REFERENCE, T_REFERENCE
     &   )
!
!     INCLUDE HEADERS.
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/scale_fnc.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF SPECTRAL BANDS
     &   , N_BAND_ABSORB(NPD_BAND)
!             NUMBER OF ABSORBERS IN BANDS
     &   , INDEX_ABSORB(NPD_SPECIES, NPD_BAND)
!             LIST OF ABSORBERS
     &   , I_BAND_ESFT(NPD_BAND, NPD_SPECIES)
!             NUMBER OF ESFT TERMS
     &   , I_SCALE_ESFT(NPD_BAND, NPD_SPECIES)
!             SCALING TYPES
     &   , I_SCALE_FNC(NPD_BAND, NPD_SPECIES)
!             TYPES OF SCALING FUNCTION
      REAL*8	!, INTENT(IN)
     &     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 PRESSURES
     &   , T_REFERENCE(NPD_SPECIES, NPD_BAND)
!             REFERENCE TEMPERATURES
!
!     LOCAL VARIABLES.
      INTEGER
     &     I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
     &   , L
!             LOOP VARIABLE
     &   , I_INDEX
!             INDEX OF GAS
!
      INCLUDE 'incl/scale_fnc.dcf'
!
!
      WRITE(IU_SPC, '(A19, A16, A16)') '*BLOCK: TYPE =    5'
     &   , ': SUBTYPE =    0'
     &   , ': VERSION =    0'
      WRITE(IU_SPC, '(A)')
     &   'EXPONENTIAL SUM FITING COEFFICIENTS: (EXPONENTS: m2/kg)'
      WRITE(IU_SPC, '(A4, 8X, A61, /, 12X, A48)') 'BAND'
     &   , 'GAS, NUMBER OF ESFT TERMS, '
     &   //'SCALING TYPE AND SCALING FUNCTION,'
     &   , ' FOLLOWED BY REFERENCE PRESSURE AND TEMPERATURE,'
      WRITE(IU_SPC, '(12X, A47)') ' ESFT EXPONENTS, '
     &   //'WEIGHTS AND SCALING PARAMETERS.'
!
      DO I=1, N_BAND
         DO J=1, N_BAND_ABSORB(I)
            I_INDEX=INDEX_ABSORB(J, I)
            WRITE(IU_SPC, '(I5, 4(7X, I5))')
     &         I, I_INDEX, I_BAND_ESFT(I, I_INDEX)
     &         , I_SCALE_ESFT(I, I_INDEX), I_SCALE_FNC(I, I_INDEX)
            WRITE(IU_SPC, '(2(6X, 1PE16.9))')
     &         P_REFERENCE(I_INDEX, I), T_REFERENCE(I_INDEX, I)
            DO K=1, I_BAND_ESFT(I, I_INDEX)
               WRITE(IU_SPC, '(2(3X, 1PE16.9), (T39, 2(3X, 1PE16.9)))')
     &            K_ESFT(K, I, I_INDEX), W_ESFT(K, I, I_INDEX)
     &            , (SCALE_VECTOR(L, K, I, I_INDEX)
     &            , L=1, N_SCALE_VARIABLE(I_SCALE_FNC(I, I_INDEX)))
            ENDDO
         ENDDO
      ENDDO
!
      WRITE(IU_SPC, '(A4)') '*END'
!
!
      RETURN
      END
!     ******************************************************************
!     *                                                                *
!     *           SUBROUTINE TO WRITE OUT BLOCKS OF TYPE 6.            *
!     *         COEFFICIENTS FOR SOURCE FUNCTION IN EACH BAND.         *
!     *                                                                *
!     ******************************************************************
      SUBROUTINE WRITE_BLOCK_6(N_BAND, N_DEG_FIT
     &   , T_REF_PLANCK, THERMAL_COEFFICIENT
     &   )
!
!     INCLUDE DEFINITIONS OF UNIT NUMBERS FOR I/O.
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF SPECTRAL BANDS
     &   , N_DEG_FIT
!             DEGREE OF POLYNOMIAL
      REAL*8	!, INTENT(IN)
     &     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
!
!
!
      WRITE(IU_SPC, '(A19, A16, A16)') '*BLOCK: TYPE =    6'
     &   , ': SUBTYPE =    0'
     &   , ': VERSION =    0'
      WRITE(IU_SPC, '(A)') 'POLYNOMIAL FIT TO THERMAL SOURCE FUNCTION.'
      WRITE(IU_SPC, '(A22, 1X, I5, A1, 1X, A23, 1X, 1PE16.9)')
     &   'DEGREE OF POLYNOMIAL =', N_DEG_FIT, ':'
     &   , 'REFERENCE TEMPERATURE =', T_REF_PLANCK
      WRITE(IU_SPC, '(A)') 'COEFFICIENTS IN EACH BAND.'
      WRITE(IU_SPC, '(A4, 8X, 2X, A)') 'BAND', 'W/m2'
      DO I=1, N_BAND
         WRITE(IU_SPC, '(I5, 7X, (T13, 3(1PE16.9, 4X)))') I
     &      , (THERMAL_COEFFICIENT(K, I)
     &      , K=0, N_DEG_FIT)
      ENDDO
!
      WRITE(IU_SPC, '(A4)') '*END'
!
!
      RETURN
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO WRITE BLOCKS OF TYPE 7.                     *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE WRITE_BLOCK_7(N_BAND
     &   , I_SURFACE, I_SPECIFICATION, SURFACE_ALBEDO
     &   , N_DIR_ALBEDO_FIT, DIRECT_ALBEDO_PARM, EMISSIVITY_GROUND
     &   )
!
!     INCLUDE HEADERS.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/surface_spec.pcf'
      INCLUDE 'incl/dimensions_spec.ucf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
     &   , I_SURFACE
!             NUMBER OF SURFACE TYPE
     &   , I_SPECIFICATION
!             SPECIFICATION OF SURFACE PROPERTIES
     &   , N_DIR_ALBEDO_FIT
!             NUMBER OF PARAMETERS IN FIT TO DIRECT ALBEDO
      REAL*8	!, INTENT(IN)
     &     SURFACE_ALBEDO(NPD_BAND)
!             (DIFFUSE) SURFACE ALBEDOS
     &   , EMISSIVITY_GROUND(NPD_BAND)
!             SURFACE EMISSIVITIES
     &   , DIRECT_ALBEDO_PARM(0: NPD_ALBEDO_PARM, NPD_BAND)
!             COEFFICIENTS FOR DIRECT ALBEDO
!
!     LOCAL VARIABLES.
      INTEGER
     &     I
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
     &   , IOS
!             IOSTAT VARIABLE
     &   , I_SUBTYPE
!             SUBTYPE OF BLOCK
!
!
!     ESTABLISH THE CORRECT SUBTYPE OF BLOCK FROM THE SPECIFICATION.
      IF (I_SPECIFICATION.EQ.IP_SURFACE_SPECIFIED) THEN
         I_SUBTYPE=1
      ELSE IF (I_SPECIFICATION.EQ.IP_SURFACE_INTERNAL) THEN
         I_SUBTYPE=2
      ELSE IF (I_SPECIFICATION.EQ.IP_SURFACE_POLYNOMIAL) THEN
         I_SUBTYPE=3
      ELSE IF (I_SPECIFICATION.EQ.IP_SURFACE_PAYNE) THEN
         I_SUBTYPE=4
      ENDIF
!
      IF (I_SUBTYPE.EQ.0) THEN
!        THIS SECTION IS HISTORICAL NOW.
         WRITE(IU_SPC, '(A19, A16, A16)') '*BLOCK: TYPE =    7'
     &      , ': SUBTYPE =    0'
     &      , ': VERSION =    0'
         WRITE(IU_SPC, '(A)') 'SURFACE PROPERTIES IN EACH BAND.'
!
         WRITE(IU_SPC, '(A14, I5)') 'SURFACE TYPE =', I_SURFACE
         WRITE(IU_SPC, '(A4, 8X, A6, 17X, A10)') 'BAND', 'ALBEDO'
     &      , 'EMISSIVITY'
!
!        WRITE OUT THE SURFACE ALBEDO IN EACH BAND.
         DO I=1, N_BAND
            WRITE(IU_SPC, FMT='(I5, 2(7X, 1PE16.9))', IOSTAT=IOS)
     &         I, SURFACE_ALBEDO(I), EMISSIVITY_GROUND(I)
         ENDDO
!
      ELSE IF (I_SUBTYPE.EQ.1) THEN
         WRITE(IU_SPC, '(A19, A16, A16)') '*BLOCK: TYPE =    7'
     &      , ': SUBTYPE =    1'
     &      , ': VERSION =    0'
         WRITE(IU_SPC, '(A)')
     &      'FIXED SURFACE PROPERTIES SPECIFIED IN EACH BAND.'
!
         WRITE(IU_SPC, '(A14, I5, A23, I5)')
     &      'SURFACE TYPE =', I_SURFACE, ': SPECIFICATION TYPE = '
     &      , I_SPECIFICATION
         WRITE(IU_SPC, '(A4, 8X, A6, 17X, A10)') 'BAND', 'ALBEDO'
     &      , 'EMISSIVITY'
!
!        WRITE OUT THE SURFACE ALBEDO IN EACH BAND.
         DO I=1, N_BAND
            WRITE(IU_SPC, FMT='(I5, 2(7X, 1PE16.9))', IOSTAT=IOS)
     &         I, SURFACE_ALBEDO(I), EMISSIVITY_GROUND(I)
         ENDDO
!
      ELSE IF (I_SUBTYPE.EQ.2) THEN
         WRITE(IU_SPC, '(A19, A16, A16)') '*BLOCK: TYPE =    7'
     &      , ': SUBTYPE =    2'
     &      , ': VERSION =    0'
         WRITE(IU_SPC, '(A)')
     &      'SURFACE PROPERTIES IN EACH BAND DERIVED '
     &      //'WITHIN THE MAIN CODE.'
!
         WRITE(IU_SPC, '(A14, I5, A23, I5)')
     &      'SURFACE TYPE =', I_SURFACE, ': SPECIFICATION TYPE = '
     &      , I_SPECIFICATION
!
      ELSE IF (I_SUBTYPE.EQ.3) THEN
         WRITE(IU_SPC, '(A19, A16, A16)') '*BLOCK: TYPE =    7'
     &      , ': SUBTYPE =    3'
     &      , ': VERSION =    0'
         WRITE(IU_SPC, '(A)')
     &      'SURFACE PROPERTIES IN EACH BAND WITH DIRECT ALBEDO '
     &      //'DEPENDING ON ZENITH ANGLE.'
!
         WRITE(IU_SPC, '(A14, I5, A23, I5)')
     &      'SURFACE TYPE =', I_SURFACE, ': SPECIFICATION TYPE = '
     &      , I_SPECIFICATION
         WRITE(IU_SPC, '(A4, 8X, A14, 9X, A10)') 'BAND'
     &      , 'DIFFUSE ALBEDO', 'EMISSIVITY'
!
!        WRITE OUT THE DIFFUSE SURFACE ALBEDO IN EACH BAND.
         DO I=1, N_BAND
            WRITE(IU_SPC, FMT='(I5, 2(7X, 1PE16.9))', IOSTAT=IOS)
     &         I, SURFACE_ALBEDO(I), EMISSIVITY_GROUND(I)
         ENDDO
!
!        WRITE OUT THE PARAMETRIZED DIRECT ALBEDO.
         WRITE(IU_SPC, '(A45, I5)')
     &      'DEGREE OF POLYNOMIAL FITTING DIRECT ALBEDO = '
     &      , N_DIR_ALBEDO_FIT
         WRITE(IU_SPC, '(A4, 8X, A48)') 'BAND'
     &      , 'COEFFICIENTS OF POLYNOMIAL IN SOLAR ZENITH ANGLE.'
         DO I=1, N_BAND
            WRITE(IU_SPC, '(I5, 7X, (T13, 3(1PE16.9, 4X)))') I
     &         , (DIRECT_ALBEDO_PARM(K, I)
     &         , K=0, N_DIR_ALBEDO_FIT)
         ENDDO
!
      ELSE IF (I_SUBTYPE.EQ.4) THEN
         WRITE(IU_SPC, '(A19, A16, A16)') '*BLOCK: TYPE =    7'
     &      , ': SUBTYPE =    4'
     &      , ': VERSION =    1'
         WRITE(IU_SPC, '(A)')
     &      'SURFACE PROPERTIES FITTED USING PAYNE''S FUNCTIONAL FORM.'
!
         WRITE(IU_SPC, '(A14, I5, A23, I5)')
     &      'SURFACE TYPE =', I_SURFACE, ': SPECIFICATION TYPE = '
     &      , I_SPECIFICATION
         WRITE(IU_SPC, '(A4, 8X, A14, 9X, A10)') 'BAND'
     &      , 'DIFFUSE ALBEDO', 'EMISSIVITY'
!
!        WRITE OUT THE DIFFUSE SURFACE ALBEDO IN EACH BAND.
         DO I=1, N_BAND
            WRITE(IU_SPC, FMT='(I5, 2(7X, 1PE16.9))', IOSTAT=IOS)
     &         I, SURFACE_ALBEDO(I), EMISSIVITY_GROUND(I)
         ENDDO
!
!        WRITE OUT THE PARAMETRIZED DIRECT ALBEDO.
         WRITE(IU_SPC, '(A42, I5)')
     &      'NUMBER OF TERMS IN FIT TO DIRECT ALBEDO = '
     &      , N_DIR_ALBEDO_FIT
         WRITE(IU_SPC, '(A4, 8X, A25)') 'BAND'
     &      , 'COEFFICIENTS OF FUNCTION.'
         DO I=1, N_BAND
            WRITE(IU_SPC, '(I5, 7X, (T13, 3(1PE16.9, 4X)))') I
     &         , (DIRECT_ALBEDO_PARM(K, I)
     &         , K=1, N_DIR_ALBEDO_FIT)
         ENDDO
!
      ENDIF
!
      WRITE(IU_SPC, '(A4)') '*END'
!
!
      END
!     ******************************************************************
!     *                                                                *
!     *      SUBROUTINE TO WRITE BLOCKS OF TYPE 8.                     *
!     *                                                                *
!     ******************************************************************
      SUBROUTINE WRITE_BLOCK_8(N_BAND
     &   , N_BAND_CONTINUUM, INDEX_CONTINUUM, INDEX_WATER)
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/continuum.pcf'
!
!     DUMMY ARGUMENTS
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
     &   , N_BAND_CONTINUUM(NPD_BAND)
!             NUMBER OF CONTINUA IN BANDS
     &   , INDEX_CONTINUUM(NPD_BAND, NPD_CONTINUUM)
!             INDICES OF CONTINUA IN BANDS
     &   , INDEX_WATER
!             INDEX OF WATER
!
!     LOCAL VARIABLES
      INTEGER
     &     I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
!
!
      WRITE(IU_SPC, '(A19, A16, A16)') '*BLOCK: TYPE =    8'
     &   , ': SUBTYPE =    0'
     &   , ': VERSION =    0'
      WRITE(IU_SPC, '(A)') 'CONTINUUM ABSORBERS IN EACH INTERVAL'
      WRITE(IU_SPC, '(A)')
     &   '(THE NUMBER IS THE INDEXING NUMBER OF EACH TYPE IS AS SET OUT'
      WRITE(IU_SPC, '(A)')
     &   ' IN THE FILE continuum.pcf.)'
      WRITE(IU_SPC, '(A)')
     &   'A ZERO INDICATES THAT THERE IN NO CONTINUUM ABSORPTION '
     &   //'IN THE INTERVAL.'
      WRITE(IU_SPC, '(A4, 8X, A55)')
     &   'BAND'
     &   , 'NUMBER OF ACTIVE CONTINUA FOLLOWED BY INDEXING NUMBERS'
!
      DO I=1, N_BAND
         WRITE(IU_SPC, '(I5, 7X, I5)') I, N_BAND_CONTINUUM(I)
         IF (N_BAND_CONTINUUM(I).GT.0) THEN
            WRITE(IU_SPC, '(5X, 4(2X, I3))')
     &         (INDEX_CONTINUUM(I, J), J=1, N_BAND_CONTINUUM(I))
         ENDIF
      ENDDO
!
      WRITE(IU_SPC, '(A)') 'INDEXING NUMBERS OF GASES FOR CONTINUA:'
      WRITE(IU_SPC, '(5X, A16, 1X, I5)')
     &   'INDEX OF WATER =', INDEX_WATER
!
      WRITE(IU_SPC, '(A4)') '*END'
!
!
      RETURN
      END
!     ******************************************************************
!     *                                                                *
!     *      SUBROUTINE TO WRITE BLOCKS OF TYPE 9.                     *
!     *                                                                *
!     ******************************************************************
      SUBROUTINE WRITE_BLOCK_9(N_BAND, N_BAND_CONTINUUM
     &   , INDEX_CONTINUUM
     &   , K_CONTINUUM
     &   , I_SCALE_FNC_CONT, SCALE_CONTINUUM
     &   , P_REF_CONTINUUM, T_REF_CONTINUUM
     &   )
!
!     INCLUDE HEADERS.
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/continuum.pcf'
      INCLUDE 'incl/scale_fnc.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF SPECTRAL BANDS
     &   , N_BAND_CONTINUUM(NPD_BAND)
!             NUMBER OF CONTINUA IN BANDS
     &   , INDEX_CONTINUUM(NPD_BAND, NPD_CONTINUUM)
!             LIST OF CONTINUA
     &   , I_SCALE_FNC_CONT(NPD_BAND, NPD_CONTINUUM)
!             SCALING FUNCTIONS FOR CONTINUA
      REAL*8	!, INTENT(IN)
     &     K_CONTINUUM(NPD_BAND, NPD_CONTINUUM)
!             CONTINUUM EXTINCTIONS
     &   , SCALE_CONTINUUM(NPD_SCALE_VARIABLE, NPD_BAND, NPD_CONTINUUM)
!             CONTINUUM SCALING PARAMETERS
     &   , P_REF_CONTINUUM(NPD_CONTINUUM, NPD_BAND)
!             CONTINUUM REFERENCE PRESSURES
     &   , T_REF_CONTINUUM(NPD_CONTINUUM, NPD_BAND)
!             CONTINUUM REFERENCE TEMPERATURES
!
!     LOCAL VARIABLES.
      INTEGER
     &     I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
     &   , L
!             LOOP VARIABLE
     &   , I_INDEX
!             INDEX OF GAS
!
      INCLUDE 'incl/scale_fnc.dcf'
!
!
      WRITE(IU_SPC, '(A19, A16, A16)') '*BLOCK: TYPE =    9'
     &   , ': SUBTYPE =    0'
     &   , ': VERSION =    0'
      WRITE(IU_SPC, '(A)')
     &   'CONTINUUM ABSORPTION COEFFICIENTS: (UNITS: m5/(kg.mol))'
      WRITE(IU_SPC, '(A4, 8X, A9, 3X, A51)') 'BAND'
     &   , 'CONTINUUM', 'SCALING FUNCTION '
     &   //'FOLLOWED BY REFERENCE PRESSURE AND'
      WRITE(IU_SPC, '(12X, A48)') ' TEMPERTURE, EXTINCTION, '
     &   //'AND SCALING PARAMETERS.'
!
      DO I=1, N_BAND
         DO J=1, N_BAND_CONTINUUM(I)
            I_INDEX=INDEX_CONTINUUM(I, J)
            WRITE(IU_SPC, '(I5, 2(7X, I5))')
     &         I, I_INDEX, I_SCALE_FNC_CONT(I, I_INDEX)
            WRITE(IU_SPC, '(2(6X, 1PE16.9))')
     &         P_REF_CONTINUUM(I_INDEX, I), T_REF_CONTINUUM(I_INDEX, I)
               WRITE(IU_SPC, '(6X, 1PE16.9, (T23, 2(6X, 1PE16.9)))')
     &            K_CONTINUUM(I, I_INDEX)
     &            , (SCALE_CONTINUUM(L, I, I_INDEX)
     &            , L=1, N_SCALE_VARIABLE(I_SCALE_FNC_CONT(I, I_INDEX)))
         ENDDO
      ENDDO
!
      WRITE(IU_SPC, '(A4)') '*END'
!
!
      RETURN
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO WRITE OUT THE CONTENTS OF BLOCK TYPE 10.    *
!     *                PARAMETRIZED MIE SCATTERING DATA.              *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE WRITE_BLOCK_10(N_BAND
     &   , I_DROP, I_DROP_PARAMETRIZATION, DROP_PARAMETER_LIST
     &   , N_DROP_DATA_LAYER, DROP_PRESSURE, DROP_ABSORPTION
     &   , DROP_SCATTERING, DROP_ASYMMETRY
     &   )
!
!     INCLUDE HEADERS.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/opt_variable.pcf'
      INCLUDE 'incl/cloud_parametrization.pcf'
      INCLUDE 'incl/cloud_parametrization.ncf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
     &   , I_DROP
!             TYPE OF DROPLET
     &   , I_DROP_PARAMETRIZATION
!             PARAMETRIZATION SCHEME
     &   , N_DROP_DATA_LAYER
!             NUMBER OF CLOUD DATA LAYERS
      REAL*8	!, INTENT(IN)
     &     DROP_PARAMETER_LIST(NPD_CLOUD_PARAMETER, NPD_BAND)
!             LIST OF DROPLET PARAMETERS
     &   , DROP_PRESSURE(0: NPD_CLOUD_DATA_LAYER)
!             DROP_PRESSURE
     &   , DROP_ABSORPTION(0: NPD_CLOUD_DATA_LAYER, NPD_BAND)
!             DROP_ABSORPTION
     &   , DROP_SCATTERING(0: NPD_CLOUD_DATA_LAYER, NPD_BAND)
!             DROP_SCATTERING
     &   , DROP_ASYMMETRY(0: NPD_CLOUD_DATA_LAYER, NPD_BAND)
!             DROP_ASYMMETRY
!
!     LOCAL VARIABLES.
      INTEGER
     &     N_PARAMETER
!             NUMBER OF PARAMETERS
     &   , I
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
!
!     SET DATA VALUES.
      INCLUDE 'incl/initial.pcf'
      INCLUDE 'incl/cloud_parm_data.dcf'
!
!
      IF ( (I_DROP_PARAMETRIZATION.EQ.IP_SLINGO_SCHRECKER)
     &   .OR.(I_DROP_PARAMETRIZATION.EQ.IP_ACKERMAN_STEPHENS) ) THEN
!
         WRITE(IU_SPC, '(A19, A16, A16)') '*BLOCK: TYPE =   10'
     &      , ': SUBTYPE =    0'
     &      , ': VERSION =    0'
!
!        CALCULATE THE NUMBER OF PARAMETERS FOR THE SCHEME.
         N_PARAMETER=
     &      N_CLOUD_FIT_PARAMETER(I_DROP_PARAMETRIZATION, IP_EXTINCTION)
     &      +N_CLOUD_FIT_PARAMETER(I_DROP_PARAMETRIZATION, IP_SS_ALBEDO)
     &      +N_CLOUD_FIT_PARAMETER(I_DROP_PARAMETRIZATION, IP_ASYMMETRY)
!
         WRITE(IU_SPC, '(A39)')
     &      'PARAMETRIZED SCATTERING DATA FOR DROPS.'
         WRITE(IU_SPC, '(A27, I5)')
     &      'TYPE NUMBER OF DROPLETS = ', I_DROP
         WRITE(IU_SPC, '(A34, I5, A27, I5)')
     &      'INDEX OF PARAMETRIZATION SCHEME = '
     &      , I_DROP_PARAMETRIZATION
     &      , ':   NUMBER OF PARAMETERS = ', N_PARAMETER
!
!        WRITE OUT THE SCATTERING PARAMETERS IN EACH BAND.
         DO I=1, N_BAND
            WRITE(IU_SPC, '(A7, I5, 5X, A19, /, (4(4X, 1PE12.5)))')
     &         'BAND = ', I, 'FITTING PARAMETERS:'
     &         , (DROP_PARAMETER_LIST(K, I), K=1, N_PARAMETER)
         ENDDO
!
      ELSE IF (I_DROP_PARAMETRIZATION.EQ.IP_DROP_UNPARAMETRIZED) THEN
!
         WRITE(IU_SPC, '(A19, A16, A16)') '*BLOCK: TYPE =   10'
     &      , ': SUBTYPE =    2'
     &      , ': VERSION =    0'
!
         WRITE(IU_SPC, '(A47)')
     &      'UNPARAMETRIZED SINGLE SCATTERING DATA FOR DROPS.'
         WRITE(IU_SPC, '(A27, I5)')
     &      'TYPE NUMBER OF DROPLETS = ', I_DROP
         WRITE(IU_SPC, '(A34, I5)')
     &      'NUMBER OF LAYERS OF CLOUDY DATA = ', N_DROP_DATA_LAYER
         DO I=1, N_BAND
            WRITE(IU_SPC, '(A7, I5)') 'BAND = ', I
            WRITE(IU_SPC, '(5X, A8, 8X, A10, 6X, A10, 6X, A9)')
     &         'PRESSURE', 'ABSORPTION', 'SCATTERING', 'ASYMMETRY'
            WRITE(IU_SPC, '(7X, A4, 9X, A9, 7X, A9)')
     &         '(Pa)', '(m-1)', '(m-1)'
            DO K=0, N_DROP_DATA_LAYER
               WRITE(IU_SPC, '(4(4X, 1PE12.5))')
     &              DROP_PRESSURE(K), DROP_ABSORPTION(K, I)
     &            , DROP_SCATTERING(K, I), DROP_ASYMMETRY(K, I)
            ENDDO
         ENDDO
      ENDIF
!
      WRITE(IU_SPC, '(A4)') '*END'
!
!
      RETURN
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO WRITE OUT THE CONTENTS OF BLOCK TYPE 11.    *
!     *                AEROSOL SCATTERING DATA.                       *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE WRITE_BLOCK_11(N_BAND
     &   , I_SPECIES, I_AEROSOL_PARAMETRIZATION, TYPE_AEROSOL
     &   , AEROSOL_ABSORPTION, AEROSOL_SCATTERING, AEROSOL_ASYMMETRY
     &   , NHUMIDITY, HUMIDITIES
     &   , N_AEROSOL_DATA_LAYER
     &   , OBS_AEROSOL_PRESSURE, OBS_AEROSOL_ABSORPTION
     &   , OBS_AEROSOL_SCATTERING, OBS_AEROSOL_ASYMMETRY
     &   )
!
!     INCLUDE HEADERS.
      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_name.ncf'
      INCLUDE 'incl/aerosol_parametrization.pcf'
!
!     DUMMY ARGUMENTS.
!
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
     &   , I_SPECIES
!             INDEX OF AEROSOL COMPONENT
     &   , NHUMIDITY
!             NUMBER OF VALUES OF HUMIDITY
     &   , I_AEROSOL_PARAMETRIZATION
!             AEROSOL PARAMETRIZATION
     &   , TYPE_AEROSOL
!             TYPE OF AEROSOL
     &   , N_AEROSOL_DATA_LAYER
!             NUMBER OF LAYERS OF AEROSOL DATA
      REAL*8	!, INTENT(IN)
     &     AEROSOL_ABSORPTION(NPD_HUMIDITIES, NPD_AEROSOL_SPECIES
     &        , NPD_BAND)
!             ABSORPTION BY AEROSOLS
     &   , AEROSOL_SCATTERING(NPD_HUMIDITIES, NPD_AEROSOL_SPECIES
     &        , NPD_BAND)
!             SCATTERING BY AEROSOLS
     &   , AEROSOL_ASYMMETRY(NPD_HUMIDITIES, NPD_AEROSOL_SPECIES
     &        , NPD_BAND)
!             ASYMMETRY BY AEROSOLS
     &   , HUMIDITIES(NPD_HUMIDITIES, NPD_AEROSOL_SPECIES)
!             HUMIDITY VALUES
      REAL*8	!, INTENT(IN)
     &     OBS_AEROSOL_PRESSURE(0: NPD_AEROSOL_DATA_LAYER
     &        , NPD_AEROSOL_SPECIES)
!             PRESSURE LEVELS FOR DATA
     &   , OBS_AEROSOL_ABSORPTION(0: NPD_AEROSOL_DATA_LAYER
     &        , NPD_AEROSOL_SPECIES, NPD_BAND)
!             ABSORPTION BY AEROSOLS
     &   , OBS_AEROSOL_SCATTERING(0: NPD_AEROSOL_DATA_LAYER
     &        , NPD_AEROSOL_SPECIES, NPD_BAND)
!             SCATTERING BY AEROSOLS
     &   , OBS_AEROSOL_ASYMMETRY(0: NPD_AEROSOL_DATA_LAYER
     &        , NPD_AEROSOL_SPECIES, NPD_BAND)
!             ASYMMETRY BY AEROSOLS
!
!
!     LOCAL VARIABLES.
      INTEGER
     &     I
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
!
!     SET NAMES OF AEROSOL COMPONENTS.
      INCLUDE 'incl/aerosol_name.dcf'
!
!
      IF (I_AEROSOL_PARAMETRIZATION.EQ.IP_AEROSOL_PARAM_DRY) THEN
         WRITE(IU_SPC, '(A19, A16, A16)') '*BLOCK: TYPE =   11'
     &      , ': SUBTYPE =    0'
     &      , ': VERSION =    1'
         WRITE(IU_SPC, '(A38)')
     &      'SCATTERING PARAMETERS FOR DRY AEROSOLS.'
         WRITE(IU_SPC, '(A19, I5, 2X, A20)') 'INDEX OF SPECIES = '
     &      , I_SPECIES, NAME_AEROSOL_COMPONENT(TYPE_AEROSOL)
         WRITE(IU_SPC, '(A4, 8X, 2(A10, 10X), A9)') 'BAND'
     &      , 'ABSORPTION', 'SCATTERING', 'ASYMMETRY'
         WRITE(IU_SPC, '(12X, A9, 11X, A9)') '(m2.kg-1)', '(m2.kg-1)'
!
!        WRITE OUT THE SCATTERING PARAMETERS FOR EACH BAND
         DO I=1, N_BAND
            WRITE(IU_SPC, FMT='(I5, 3(4X, 1PE16.9))') I
     &         , AEROSOL_ABSORPTION(1, I_SPECIES, I)
     &         , AEROSOL_SCATTERING(1, I_SPECIES, I)
     &         , AEROSOL_ASYMMETRY(1, I_SPECIES, I)
         ENDDO
      ELSE IF (I_AEROSOL_PARAMETRIZATION.EQ.
     &     IP_AEROSOL_PARAM_MOIST) THEN
         WRITE(IU_SPC, '(A19, A16, A16)') '*BLOCK: TYPE =   11'
     &      , ': SUBTYPE =    1'
     &      , ': VERSION =    0'
         WRITE(IU_SPC, '(A40)')
     &      'SCATTERING PARAMETERS FOR MOIST AEROSOLS.'
         WRITE(IU_SPC, '(A19, I5, 2X, A20)') 'INDEX OF SPECIES = '
     &      , I_SPECIES, NAME_AEROSOL_COMPONENT(TYPE_AEROSOL)
         WRITE(IU_SPC, '(A28, I3)') 'NUMBER OF HUMIDITY VALUES = '
     &      , NHUMIDITY
!        WRITE OUT THE SCATTERING PARAMETERS FOR EACH BAND
         DO I=1, N_BAND
            WRITE(IU_SPC, '(A7, I4)') 'BAND = ', I
            WRITE(IU_SPC, '(6X, A8, 8X, A10, 5X, A10, 6X, A9)')
     &         'HUMIDITY', 'ABSORPTION', 'SCATTERING', 'ASYMMETRY'
            WRITE(IU_SPC, '(22X, A9, 6X, A9)') '(m2.kg-1)', '(m2.kg-1)'
!
            DO K=1, NHUMIDITY
               WRITE(IU_SPC, FMT='(4(4X, 1PE12.5))')
     &           HUMIDITIES(K, I_SPECIES)
     &         , AEROSOL_ABSORPTION(K, I_SPECIES, I)
     &         , AEROSOL_SCATTERING(K, I_SPECIES, I)
     &         , AEROSOL_ASYMMETRY(K, I_SPECIES, I)
            ENDDO
         ENDDO
      ELSE IF (I_AEROSOL_PARAMETRIZATION
     &   .EQ.IP_AEROSOL_UNPARAMETRIZED) THEN
!
         WRITE(IU_SPC, '(A19, A16, A16)') '*BLOCK: TYPE =   11'
     &      , ': SUBTYPE =    2'
     &      , ': VERSION =    0'
!
         WRITE(IU_SPC, '(A51)')
     &      'UNPARAMETRIZED SINGLE SCATTERING DATA FOR AEROSOLS.'
         WRITE(IU_SPC, '(A21, I5)')
     &      'SPECIES OF AEROSOL = ', I_SPECIES
         WRITE(IU_SPC, '(A35, I5)')
     &      'NUMBER OF LAYERS OF AEROSOL DATA = ', N_AEROSOL_DATA_LAYER
         DO I=1, N_BAND
            WRITE(IU_SPC, '(A7, I5)') 'BAND = ', I
            WRITE(IU_SPC, '(5X, A8, 8X, A10, 6X, A10, 6X, A9)')
     &         'PRESSURE', 'ABSORPTION', 'SCATTERING', 'ASYMMETRY'
            WRITE(IU_SPC, '(7X, A4, 9X, A9, 7X, A9)')
     &         '(Pa)', '(m-1)', '(m-1)'
            DO K=0, N_AEROSOL_DATA_LAYER
               WRITE(IU_SPC, '(4(4X, 1PE12.5))')
     &              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)
            ENDDO
         ENDDO
      ENDIF
!
      WRITE(IU_SPC, '(A4)') '*END'
!
!
      RETURN
      END
!     *****************************************************************
!     *                                                               *
!     *     SUBROUTINE TO WRITE OUT THE CONTENTS OF BLOCK TYPE 12.    *
!     *          PARAMETRIZED ICE CRYSTAL SCATTERING DATA.            *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE WRITE_BLOCK_12(N_BAND
     &   , I_ICE, I_ICE_PARAMETRIZATION, ICE_PARAMETER_LIST
     &   , N_ICE_DATA_LAYER, ICE_PRESSURE
     &   , ICE_ABSORPTION, ICE_SCATTERING
     &   , ICE_ASYMMETRY
     &   )
!
!     INCLUDE HEADERS.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/opt_variable.pcf'
      INCLUDE 'incl/ice_cloud_parametrization.pcf'
      INCLUDE 'incl/ice_cloud_parametrization.ncf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
     &   , I_ICE
!             TYPE OF ICE CRYSTAL
     &   , I_ICE_PARAMETRIZATION
!             PARAMETRIZATION SCHEME
     &   , N_ICE_DATA_LAYER
!             NUMBER OF CLOUD DATA LAYERS
      REAL*8	!, INTENT(IN)
     &     ICE_PARAMETER_LIST(NPD_CLOUD_PARAMETER, NPD_BAND)
!             LIST OF ICE CRYSTAL PARAMETERS
     &   , ICE_PRESSURE(0: NPD_CLOUD_DATA_LAYER)
!             CLOUD_PRESSURE
     &   , ICE_ABSORPTION(0: NPD_CLOUD_DATA_LAYER, NPD_BAND)
!             CLOUD_ABSORPTION
     &   , ICE_SCATTERING(0: NPD_CLOUD_DATA_LAYER, NPD_BAND)
!             CLOUD_SCATTERING
     &   , ICE_ASYMMETRY(0: NPD_CLOUD_DATA_LAYER, NPD_BAND)
!             CLOUD_ASYMMETRY
!
!     LOCAL VARIABLES.
      INTEGER
     &     N_PARAMETER
!             NUMBER OF PARAMETERS
     &   , I
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
!
!     SET DATA VALUES.
      INCLUDE 'incl/initial.pcf'
      INCLUDE 'incl/ice_cloud_parm_data.dcf'
!
!
      IF ( (I_ICE_PARAMETRIZATION.EQ.IP_SLINGO_SCHRECKER_ICE)
     &   .OR.(I_ICE_PARAMETRIZATION.EQ.IP_CIRRUS_ADT) ) THEN
!
         WRITE(IU_SPC, '(A19, A16, A16)') '*BLOCK: TYPE =   12'
     &      , ': SUBTYPE =    0'
     &      , ': VERSION =    0'
!
!        CALCULATE THE NUMBER OF PARAMETERS FOR THE SCHEME.
         N_PARAMETER=
     &      N_ICE_CLOUD_FIT_PARAMETER(I_ICE_PARAMETRIZATION
     &      , IP_EXTINCTION)
     &      +N_ICE_CLOUD_FIT_PARAMETER(I_ICE_PARAMETRIZATION
     &      , IP_SS_ALBEDO)
     &      +N_ICE_CLOUD_FIT_PARAMETER(I_ICE_PARAMETRIZATION
     &      , IP_ASYMMETRY)
!
         WRITE(IU_SPC, '(A46)')
     &      'PARAMETRIZED SCATTERING DATA FOR ICE CRYSTALS.'
         WRITE(IU_SPC, '(A31, I5)')
     &      'TYPE NUMBER OF ICE CRYSTALS = ', I_ICE
         WRITE(IU_SPC, '(A34, I5, A27, I5)')
     &      'INDEX OF PARAMETRIZATION SCHEME = '
     &      , I_ICE_PARAMETRIZATION
     &      , ':   NUMBER OF PARAMETERS = ', N_PARAMETER
!
!        WRITE OUT THE SCATTERING PARAMETERS IN EACH BAND.
         DO I=1, N_BAND
            WRITE(IU_SPC, '(A7, I5, 5X, A19, /, (4(4X, 1PE12.5)))')
     &         'BAND = ', I, 'FITTING PARAMETERS:'
     &         , (ICE_PARAMETER_LIST(K, I), K=1, N_PARAMETER)
         ENDDO
!
      ELSE IF (I_ICE_PARAMETRIZATION.EQ.IP_ICE_UNPARAMETRIZED) THEN
!
         WRITE(IU_SPC, '(A19, A16, A16)') '*BLOCK: TYPE =   12'
     &      , ': SUBTYPE =    2'
     &      , ': VERSION =    0'
!
         WRITE(IU_SPC, '(A50)')
     &      'UNPARAMETRIZED SINGLE SCATTERING DATA FOR ICE CRYSTALS.'
         WRITE(IU_SPC, '(A31, I5)')
     &      'TYPE NUMBER OF ICE CRYSTALS = ', I_ICE
         WRITE(IU_SPC, '(A34, I5)')
     &      'NUMBER OF LAYERS OF CLOUDY DATA = ', N_ICE_DATA_LAYER
         DO I=1, N_BAND
            WRITE(IU_SPC, '(A7, I5)') 'BAND = ', I
            WRITE(IU_SPC, '(5X, A8, 8X, A10, 6X, A10, 6X, A9)')
     &         'PRESSURE', 'ABSORPTION', 'SCATTERING', 'ASYMMETRY'
            WRITE(IU_SPC, '(7X, A4, 9X, A9, 7X, A9)')
     &         '(Pa)', '(m-1)', '(m-1)'
            DO K=0, N_ICE_DATA_LAYER
               WRITE(IU_SPC, '(4(4X, 1PE12.5))')
     &              ICE_PRESSURE(K), ICE_ABSORPTION(K, I)
     &            , ICE_SCATTERING(K, I)
     &            , ICE_ASYMMETRY(K, I)
            ENDDO
         ENDDO
      ENDIF
!
      WRITE(IU_SPC, '(A4)') '*END'
!
!
      RETURN
      END
!     *****************************************************************
!     *                                                               *
!     *           SUBROUTINE TO WRITE BLOCKS OF TYPE 13.              *
!     *                DOPPLER BROADENING TERMS.                      *
!     *                                                               *
!     *****************************************************************
      SUBROUTINE WRITE_BLOCK_13(N_ABSORB
     &   , L_DOPPLER_PRESENT, DOPPLER_CORRECTION
     &   )
!
!     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_ABSORB
!             NUMBER OF ABSORBERS
      LOGICAL	!, INTENT(IN)
     &     L_DOPPLER_PRESENT(NPD_SPECIES)
!             DOPPLER FLAGS
      REAL*8	!, INTENT(IN)
     &     DOPPLER_CORRECTION(NPD_SPECIES)
!             DOPPLER CORRECTIONS
!
!
!     LOCAL VARIABLES.
      INTEGER
     &     I
!             LOOP VARIABLE
!
!
      WRITE(IU_SPC, '(A19, A16, A16)') '*BLOCK: TYPE =   13'
     &   , ': SUBTYPE =    0'
     &   , ': VERSION =    0'
      WRITE(IU_SPC, '(A)')
     &   'DOPPLER BROADENING COEFFICIENTS FOR THE GASES'
      WRITE(IU_SPC, '(A)')
     &   'SPECIES    DOPPLER FLAG   DOPPLER COEFFICIENT'
!     WRITE OUT THE DOPPLER TERMS FOR EACH SPECIES.
      DO I=1, N_ABSORB
         WRITE(IU_SPC, FMT='(I5, 7X, L6, 9X, 1PE12.5)')
     &      I, L_DOPPLER_PRESENT(I), DOPPLER_CORRECTION(I)
      ENDDO
      WRITE(IU_SPC, '(A4)') '*END'
!
!
      RETURN
      END
!     ******************************************************************
!     *                                                                *
!     *      SUBROUTINE TO WRITE BLOCKS OF TYPE 14.                    *
!     *                                                                *
!     ******************************************************************
      SUBROUTINE WRITE_BLOCK_14(N_BAND, N_BAND_EXCLUDE, INDEX_EXCLUDE)
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
!
!     DUMMY ARGUMENTS
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
     &   , N_BAND_EXCLUDE(NPD_BAND)
!             NUMBER OF BANDS EXCLUDED FROM SPECIFIC BANDS
     &   , INDEX_EXCLUDE(NPD_EXCLUDE, NPD_BAND)
!             INDICES OF EXCLUDED BANDS
!
!     LOCAL VARIABLES
      INTEGER
     &     I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
!
!
      WRITE(IU_SPC, '(A19, A16, A16)') '*BLOCK: TYPE =   14'
     &   , ': SUBTYPE =    0'
     &   , ': VERSION =    0'
      WRITE(IU_SPC, '(A)') 'REGIONS EXCLUDED FROM SPECIFIC BANDS'
      WRITE(IU_SPC, '(A)')
     &   'A ZERO INDICATES THAT NO BANDS HAVE BEEN EXCLUDED FROM THE '
     &   //'PARTICULAR BAND.'
      WRITE(IU_SPC, '(A4, 8X, A55)')
     &   'BAND'
     &   , 'NUMBER OF EXCLUDED BANDS FOLLOWED BY INDICES.'
!
      DO I=1, N_BAND
         WRITE(IU_SPC, '(I5, 7X, I5)') I, N_BAND_EXCLUDE(I)
         IF (N_BAND_EXCLUDE(I).GT.0) THEN
            WRITE(IU_SPC, '(14X, 8(3X, I5))')
     &         (INDEX_EXCLUDE(J, I), J=1, N_BAND_EXCLUDE(I))
         ENDIF
      ENDDO
!
      WRITE(IU_SPC, '(A4)') '*END'
!
!
!
      RETURN
      END
