!+ Program to average transmission data from LOWTRAN7.
!
! Method:
!	Using information generated with the program gen_lowtran_data,
!	gaseous transmissions are calculated from LOWTRAN7 and
!	averaged across spectral bands. The data are sorted into
!	groups for the same gas, band, pressure and temperature and
!	written out to the final file. Depending on the configuration
!	realized, LOWTRAN may be run as a subroutine of this program,
!	in which case a scratch file is used, or as a separate program.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!	Version		Date		Comment
!	1.0		12-04-95	First Version under RCS
!					(J. M. Edwards)
!
! Description of Code:
!   FORTRAN 77 with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
      PROGRAM BAND_AVERAGE
!
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_pp_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/dimensions_pp.ucf'
      INCLUDE 'incl/gas_list.pcf'
      INCLUDE 'incl/lowtran_parameters.ecf'
      INCLUDE 'incl/lowtran_dec.ecf'
      INCLUDE 'incl/record_size_trans.pcf'
      INCLUDE 'incl/continuum.pcf'
      INCLUDE 'incl/cloud_parametrization.pcf'
      INCLUDE 'incl/error.pcf'
      INCLUDE 'incl/prec_machine.ucf'
      INCLUDE 'incl/precision.pcf'
!
!     DECLARATION OF VARIABLES:
!
      LOGICAL
     &     LOCK_CODE
!             LOGICAL TO FORBID INTERACTIVE LOOPING
      EXTERNAL
     &     LOCK_CODE
!
      CHARACTER
     &     FILE_SPECTRAL*80
!             NAME OF SPECTRAL FILE
     &   , TRANS_TYPE*4
!             TYPE OF TRANSMITTANCE
     &   , CHAR_YN*1
!             CHARACTER RESPONSE VARIABLE
      INTEGER
     &     IERR
!             ERROR FLAG
     &   , IOS
!             I/O ERROR FLAG
      INTEGER
     &     IU_LOWTRAN_IRD
!             UNIT FOR LOWTRAN'S READING
     &   , IU_LOWTRAN_IPR
!             UNIT FOR LOWTRAN PRINT FILE
     &   , IU_LOWTRAN_IPU
!             UNIT FOR TAPE7 FILE
     &   , IU_LOWTRAN_IPR1
!             UNIT FOR TAPE8 FILE
     &   , I_REPEAT
!             REPETITION FLAG FOR LOWTRAN
      INTEGER
     &     N_BAND_ABSORB_LOWTRAN(NPD_BAND)
!             NUMBER OF LOWTRAN ABSORBERS
     &   , INDEX_ABSORB_LOWTRAN(NPD_SPECIES, NPD_BAND)
!             INDICIES OF LOWTRAN ABSORBERS
     &   , N_ABSORB_LOWTRAN
!             NUMBER OF LOWTRAN ABSORBERS
      INTEGER
     &     N_CASE
!             NUMBER OF LOWTRAN CASES
     &   , N_GROUP
!             NUMBER OF GROUPED CASES
     &   , N_SET
!             NUMBER OF SETS
     &   , N_SET_CONTINUUM
!             NUMBER OF SETS
     &   , I_WEIGHT
!             FLAG FOR METHOD OF WEIGHTING
     &   , BAND_CASE(NPD_CASE)
!             BANDS OF THE CASES
     &   , LENGTH_GROUP
!             NUMBER OF CASES IN GROUPS
     &   , LIST_GROUP(NPD_AMOUNT)
!             LIST OF CASES IN GROUP
     &   , BAND_GROUP(NPD_GROUP)
!             BAND FOR EACH GROUP
     &   , LENGTH_SET(NPD_SET_GROUP)
!             LENGTHS OF EACH SET
     &   , INDEX_SET(NPD_SET_GROUP)
!             INDEX NUMBER OF GAS IN SET
     &   , LENGTH_SET_CONTINUUM(NPD_SET_GROUP)
!             LENGTHS OF EACH CONTINUUM SET
     &   , INDEX_SET_CONTINUUM(NPD_SET_GROUP)
!             INDEX NUMBER OF CONTINUA IN SETS
     &   , GROUP_CASE(NPD_CASE)
!             GROUPS TO WHICH CASES BELONG
      INTEGER
     &     I_CASE
!             INDEX OF CASE
     &   , I_GROUP
!             INDEX OF GROUP
     &   , I_SET
!             NUMBER OF SET
     &   , I_BAND
!             NUMBER OF BAND
     &   , I_GAS
!             NUMBER OF GAS
     &   , I_LOWTRAN_COLUMN(NPD_SPECIES)
!             COLUMN FOR GAS IN LOWTRAN OUPUT
     &   , I_CONTINUUM
!             NUMBER FOR CONTINUUM
      INTEGER
     &     N_WAVENUMBER_TRANS
!             NUMBER OF LOWTRAN'S WAVENUMBERS
     &   , N_SOLAR_POINTS
!             SIZE OF SOLAR SPECTRUM
      INTEGER
     &     I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
     &   , I_NUMBER
!             NUMBER OF LOWTRAN GAS
     &   , I_BEGIN
!             INITIAL POINT FOR WEIGHTING JUST OUTSIDE BAND
     &   , N_INT_WEIGHT
!             NUMBER OF WEIGHTING POINTS
     &   , N_PER_TRANS_RECORD
!             NUMBER OF DATA PER TRANSMISSION RECORD
     &   , I_FIRST_RECORD_LINE
!             FIRST RECORD OF LINE SET
     &   , I_FIRST_RECORD_CONTINUUM
!             FIRST RECORD OF CONTINUUM SET
      LOGICAL
     &     L_FORM
!             FORMATTING FLAG FOR LOWTRAN
     &   , L_CONTINUUM
!             FLAG FOR CONTINUUM DATA
     &   , L_WAVE_NUMBER
!             FLAG FOR WAVENUMBER WEIGHTING
      REAL*8
     &     P_CASE(NPD_CASE)
!             PRESSURES IN CASES
     &   , T_CASE(NPD_CASE)
!             TEMPERATURES IN CASES
     &   , RANGE_CASE(NPD_CASE)
!             RANGE OF EACH CASE
     &   , U_CASE(NPD_CASE, NPD_SPECIES)
!             AMOUNTS FOR EACH CASE
     &   , P_GROUP(NPD_GROUP)
!             PRESSURES IN GROUPS
     &   , T_GROUP(NPD_GROUP)
!             TEMPERATURES IN GROUPS
     &   , U_SET(NPD_AMOUNT, NPD_SET_GROUP)
!             AMOUNTS IN SETS
     &   , U_SET_CONTINUUM(NPD_AMOUNT, NPD_SET_GROUP)
!             AMOUNTS IN CONTINUUM SETS
     &   , AMOUNT_N2(NPD_CASE)
!             AMOUNTS OF NITROGEN
     &   , DENSITY_BROAD(NPD_AMOUNT, NPD_SET_GROUP)
!             DENSITY OF BROADENING SPECIES
      REAL*8
     &     WAVE_NUMBER_LOW
!             LOW WAVENUMBER LIMIT OF BAND
     &   , WAVE_NUMBER_HIGH
!             HIGH WAVENUMBER LIMIT OF BAND
      REAL*8
     &     WAVENUMBER_TRANS(NPD_WAVENUMBER_TRANS)
!             WAVENUMBERS FOR TRANSMITTANCES
     &   , TRANSMITTANCE(NPD_WAVENUMBER_TRANS, NPD_SPECIES)
!             LOWTRAN TRANSMITTANCE DATA
     &   , BAND_TRANS(NPD_CASE, NPD_SPECIES)
!             AVERAGED BAND TRANSMITTANCE
     &   , TRANS_SET(NPD_AMOUNT, NPD_SET_GROUP)
!             TRANSMITTANCES IN SETS
     &   , TRANS_SET_CONTINUUM(NPD_AMOUNT, NPD_SET_GROUP)
!             TRANSMISSITANCES IN CONTINUUM SETS
     &   , TRANS_CONTINUUM(NPD_WAVENUMBER_TRANS, NPD_CONTINUUM)
!             CONTINUUM VALUES FROM LOWTRAN TRANSMITTANCE
     &   , TRANS_LINE
!             MEAN LINE TRANSMITTANCE
     &   , MEAN_CONTINUUM(NPD_CASE, NPD_CONTINUUM)
!             AVERAGED CONTINUUM TRANSMISSIONS
     &   , WEIGHT_COEFF(0: NPD_WAVENUMBER_TRANS)
!             WEIGHTING COEFFICIENTS
     &   , WORK(0: NPD_WAVENUMBER_TRANS)
!             WORK ARRAY
     &   , DIFFUSIVITY_FACTOR
!             DIFFUSIVITY FACTOR FOR FLUXES
      REAL*8
     &     SOLAR_WAVELENGTH(NPD_SOLAR_POINTS)
!             POINTS OF SOLAR SPECTRUM
     &   , SOLAR_IRRAD(NPD_SOLAR_POINTS)
!             SOLAR IRRADIANCES
!
      REAL*8
     &     EXCLUDE_SHORTER(NPD_EXCLUDE)
!             LOWER LIMITS OF EXCLUDED INTERVALS
     &   , EXCLUDE_LONGER(NPD_EXCLUDE)
!             UPPER LIMITS OF EXCLUDED INTERVALS
!
!     DECLARE SPECTRAL VARIABLES.
      INCLUDE 'dec_spec.finc'
!
!     SET THE LOWTRAN GAS NUMBERS.
      INCLUDE 'incl/gas_lowtran_type.ecf'
      INCLUDE 'incl/lowtran_map.ecf'
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     IN_SPECTRUM, OPEN_LOWTRAN_EXTERNAL, OPEN_LOWTRAN_INTERNAL
     &   , READ_RECORD, SELECT_WEIGHT_TRANS, OPEN_TRANS_OUT
     &   , SORT_GROUP, LWTRN7, READ_TAPE8_FORM, READ_TAPE7_FORM
     &   , READ_TAPE8_UNFORM, READ_TAPE7_UNFORM
     &   , WEIGHTINGS, SPLIT_GROUP, ORDER_SET, CONVERT_AMOUNT
     &   , WRITE_TRANS, WRITE_CONTINUUM
!
!
      DATA IERR/I_NORMAL/, L_WAVE_NUMBER/.TRUE./
!
!
!
!     REQUEST THE NAME OF THE FILE CONTAINING SPECTRAL DATA.
100   WRITE(IU_USER, '(/A/)')
     &   'GIVE THE NAME OF THE FILE CONTAINING THE SPECTRAL DATA.'
      READ(IU_STDIN, '(A)') FILE_SPECTRAL
!
!     READ IN SPECTRAL FILE.
      INCLUDE 'read_spec.finc'
!
      IF (IERR.NE.I_NORMAL) THEN
         IF (IERR.EQ.I_ERR_EXIST) THEN
!           RECOVER FROM THE ERROR.
            IERR=I_NORMAL
            GOTO 100
         ELSE
            STOP
         ENDIF
      ENDIF
!
!     DETERMINE WHETHER CONTINUUM DATA ARE TO BE GENERATED.
      WRITE(IU_USER, '(/A/)')
     &   'ARE CONTINUUM DATA TO BE GENERATED? (Y/N)'
      READ(IU_STDIN, '(A)') CHAR_YN
      L_CONTINUUM=.FALSE.
      IF ( (CHAR_YN.EQ.'Y').OR.(CHAR_YN.EQ.'y') ) THEN
!        CHECK THAT WATER VAPOUR IS INCLUDED IN THE SPECTRUM SO THAT
!        DATA WILL BE AVAILABLE.
         DO I=1, N_ABSORB
            IF (TYPE_ABSORB(I).EQ.IP_H2O) THEN
               L_CONTINUUM=.TRUE.
            ENDIF
         ENDDO
         IF (.NOT.L_CONTINUUM) THEN
            WRITE(IU_ERR, '(/A)') '+++ WARNING: WATER VAPOUR WAS '
     &         //'NOT INCLUDED IN THE SPECTRAL FILE.'
            WRITE(IU_ERR, '(/A)') 'CONTINUUM DATA WILL NOT BE '
     &         //'PRODUCED.'
         ENDIF
      ENDIF
!
!     ASSEMBLE THE LIST OF COLUMNS IN THE OUTPUT FROM LOWTRAN IN WHICH
!     DATA FOR THE GASES ARE TO BE FOUND. NOTE THE MAPPING FROM THE
!     INDEX OF THE GAS IN THE SPECTRAL FILE TO THE TYPE NUMBER IN THE
!     RADIATION CODE TO THE TYPE NUMBER IN LOWTRAN TO THE COLUMN OF
!     LOWTRAN OUTPUT.
      N_ABSORB_LOWTRAN=0
      DO I=1, N_ABSORB
         I_NUMBER=IP_LOWTRAN_NUMBER(TYPE_ABSORB(I))
         IF (I_NUMBER.GT.0) THEN
            N_ABSORB_LOWTRAN=N_ABSORB_LOWTRAN+1
            I_LOWTRAN_COLUMN(I)
     &         =IP_LOWTRAN_MAP(I_NUMBER)
         ENDIF
      ENDDO
!
!     ASSEMBLE THE LIST OF GASES WHICH ARE PRESENT IN LOWTRAN FOR WHICH
!     DATA CAN BE PRODUCED.
      DO I=1, N_BAND
         N_BAND_ABSORB_LOWTRAN(I)=0
         DO J=1, N_BAND_ABSORB(I)
            IF (IP_LOWTRAN_NUMBER(TYPE_ABSORB(INDEX_ABSORB(J, I)))
     &         .GT.0) THEN
               N_BAND_ABSORB_LOWTRAN(I)=N_BAND_ABSORB_LOWTRAN(I)+1
               INDEX_ABSORB_LOWTRAN(N_BAND_ABSORB_LOWTRAN(I), I)
     &            =INDEX_ABSORB(J, I)
            ENDIF
         ENDDO
      ENDDO
!
!     OPEN SCRATCH FILES FOR LOWTRAN
      CALL OPEN_LOWTRAN_INTERNAL(IERR, L_FORM, IU_LOWTRAN_IRD
     &   , IU_LOWTRAN_IPR, IU_LOWTRAN_IPU, IU_LOWTRAN_IPR1)
      IF (IERR.NE.I_NORMAL) STOP
!
!     READ IN THE RECORD FILE.
      CALL READ_RECORD(IERR, N_ABSORB, TYPE_ABSORB
     &   , N_CASE, BAND_CASE, U_CASE, P_CASE, T_CASE, RANGE_CASE
     &   , AMOUNT_N2)
      IF (IERR.NE.I_NORMAL) STOP
!
!     SELECT THE WEIGHTING FUNCTION
      CALL SELECT_WEIGHT_TRANS(IERR, I_WEIGHT
     &   , N_SOLAR_POINTS, SOLAR_WAVELENGTH, SOLAR_IRRAD)
      IF (IERR.NE.I_NORMAL) STOP
!
!     CONVERT TO FLUX TRANSMITTANCES IF REQUIRED.
      WRITE(IU_USER, '(/A)')
     &   'DO YOU WISH TO CONVERT TO FLUX TRANSMITTANCES? (Y/N)'
1     READ(IU_STDIN, '(A)') CHAR_YN
      IF ( (CHAR_YN.EQ.'Y').OR.(CHAR_YN.EQ.'y') ) THEN
         TRANS_TYPE='FLUX'
         WRITE(IU_USER, '(/A)') 'ENTER DIFFUSIVITY FACTOR.'
2        READ(IU_STDIN, *, IOSTAT=IOS) DIFFUSIVITY_FACTOR
         IF (IOS.NE.0) THEN
            WRITE(IU_ERR, '(A)') '+++ INCORRECT VALUE.'
            IF (LOCK_CODE(.TRUE.)) THEN
               INCLUDE 'batch_error_main.finc'
            ELSE
               WRITE(IU_USER, '(A)') 'PLEASE RE-ENTER.'
               GOTO 2
            ENDIF
         ENDIF
         IF (DIFFUSIVITY_FACTOR.LE.0.0D+00) THEN
            WRITE(IU_ERR, '(A)') '+++ INADMISSIBLE VALUE.'
            IF (LOCK_CODE(.TRUE.)) THEN
               INCLUDE 'batch_error_main.finc'
            ELSE
               WRITE(IU_USER, '(A)') 'PLEASE RE-ENTER.'
               GOTO 2
            ENDIF
         ENDIF
      ELSE IF ( (CHAR_YN.EQ.'N').OR.(CHAR_YN.EQ.'n') ) THEN
         TRANS_TYPE='PATH'
      ELSE
         WRITE(IU_ERR, '(A)') '+++ UNRECOGNISED RESPONSE.'
         IF (LOCK_CODE(.TRUE.)) THEN
            INCLUDE 'batch_error_main.finc'
         ELSE
            WRITE(IU_USER, '(A)') 'PLEASE RE-ENTER.'
            GOTO 1
         ENDIF
      ENDIF
!
!     OPEN THE FILES FOR OUTPUT.
      CALL OPEN_TRANS_OUT(IERR, .FALSE., N_PER_TRANS_RECORD
     &   , IU_TRANSMISSION_SUMMARY, IU_TRANSMISSION)
      IF (IERR.NE.I_NORMAL) STOP
      IF (L_CONTINUUM) THEN
         CALL OPEN_TRANS_OUT(IERR, .TRUE., N_PER_TRANS_RECORD
     &      , IU_C_TRANSMISSION_SUMMARY, IU_C_TRANSMISSION)
         IF (IERR.NE.I_NORMAL) STOP
      ENDIF
!
!     SORT THE DATA INTO GROUPS IN WHICH THE GAS, PRESSURE 
!     AND TEMPERATURE ARE THE SAME AN WHICH REFER TO THE SAME BAND.
      CALL SORT_GROUP(IERR
     &   , N_CASE, BAND_CASE, P_CASE, T_CASE
     &   , N_GROUP
     &   , BAND_GROUP, P_GROUP, T_GROUP
     &   , GROUP_CASE
     &   )
      IF (IERR.NE.I_NORMAL) STOP
!
!     FOR EACH CASE READ IN THE LOWTRAN DATA FOR THE CASE
!     AND EXTRACT THE TRANSMITTANCES, AVERAGING OVER THE BAND.
      WRITE(IU_STDOUT, '(//A23, I5, A)') 'BEGINNING PROCESSING OF '
     &   , N_CASE, ' CASES OF DATA ...'
      DO I_CASE=1, N_CASE
!
!        PRINT OUT MESSAGES OF PROGRESS FOR CASES WHEN RUNS ARE LONG.
         IF (MOD(10*I_CASE, MAX(1, 10*(N_CASE/10))).EQ.0) THEN
            WRITE(IU_STDOUT, '(A, I5)') 'PROCESSING CASE ', I_CASE
         ENDIF
!
!
         REWIND(IU_LOWTRAN_IPR)
         REWIND(IU_LOWTRAN_IPU)
         REWIND(IU_LOWTRAN_IPR1)
         CALL LWTRN7(IU_LOWTRAN_IRD, IU_LOWTRAN_IPR
     &      , IU_LOWTRAN_IPU, IU_LOWTRAN_IPR1, I_REPEAT)
         REWIND(IU_LOWTRAN_IPR)
         REWIND(IU_LOWTRAN_IPU)
         REWIND(IU_LOWTRAN_IPR1)
         IF (L_FORM) THEN
            CALL READ_TAPE8_FORM(IERR
     &         , N_WAVENUMBER_TRANS, WAVENUMBER_TRANS
     &         , TRANSMITTANCE
     &         , N_ABSORB_LOWTRAN, I_LOWTRAN_COLUMN)
            IF (IERR.NE.I_NORMAL) STOP
            IF (L_CONTINUUM) THEN
               CALL READ_TAPE7_FORM(N_WAVENUMBER_TRANS
     &            , TRANS_CONTINUUM)
            ENDIF
         ELSE
            CALL READ_TAPE8_UNFORM(IERR
     &         , N_WAVENUMBER_TRANS, WAVENUMBER_TRANS
     &         , TRANSMITTANCE
     &         , N_ABSORB_LOWTRAN, I_LOWTRAN_COLUMN)
            IF (IERR.NE.I_NORMAL) STOP
            IF (L_CONTINUUM) THEN
               CALL READ_TAPE7_FORM(N_WAVENUMBER_TRANS
     &            , TRANS_CONTINUUM)
            ENDIF
         ENDIF
!
!        CALCULATE THE WEIGHTINGS: NOTE THAT WEIGHTING IS DONE
!        BY WAVENUMBER.
         I_BAND=BAND_CASE(I_CASE)
         WAVE_NUMBER_LOW
     &      =1.0D+00/WAVE_LENGTH_LONG(I_BAND)
         WAVE_NUMBER_HIGH
     &      =1.0D+00/WAVE_LENGTH_SHORT(I_BAND)
         DO K=1, N_BAND_EXCLUDE(I_BAND)
            EXCLUDE_SHORTER(K)
     &         =1.0D+00/WAVE_LENGTH_LONG(INDEX_EXCLUDE(K, I_BAND))
            EXCLUDE_LONGER(K)
     &         =1.0D+00/WAVE_LENGTH_SHORT(INDEX_EXCLUDE(K, I_BAND))
         ENDDO
         CALL WEIGHTINGS(IERR
     &      , I_WEIGHT, L_WAVE_NUMBER
     &      , N_SOLAR_POINTS, SOLAR_WAVELENGTH, SOLAR_IRRAD
     &      , T_CASE(I_CASE)
     &      , WAVE_NUMBER_LOW, WAVE_NUMBER_HIGH
     &      , N_BAND_EXCLUDE(I_BAND), EXCLUDE_SHORTER, EXCLUDE_LONGER
     &      , N_WAVENUMBER_TRANS, WAVENUMBER_TRANS
     &      , I_BEGIN, N_INT_WEIGHT, WEIGHT_COEFF
     &      , WORK
     &      )
         IF (IERR.NE.I_NORMAL) GOTO 3
!
         DO J=1, N_BAND_ABSORB_LOWTRAN(BAND_CASE(I_CASE))
            I_GAS=INDEX_ABSORB_LOWTRAN(J, BAND_CASE(I_CASE))
            BAND_TRANS(I_CASE, I_GAS)=0.0D+00
            DO K=0, N_INT_WEIGHT
               BAND_TRANS(I_CASE, I_GAS)=BAND_TRANS(I_CASE, I_GAS)
     &            +WEIGHT_COEFF(K)*TRANSMITTANCE(I_BEGIN+K, I_GAS)
            ENDDO
         ENDDO
         IF (L_CONTINUUM) THEN
            DO J=1, N_BAND_CONTINUUM(BAND_CASE(I_CASE))
               I_CONTINUUM
     &            =INDEX_CONTINUUM(BAND_CASE(I_CASE), J)
               IF ( (I_CONTINUUM.EQ.IP_SELF_CONTINUUM).OR.
     &              (I_CONTINUUM.EQ.IP_FRN_CONTINUUM) ) THEN
!                 THESE CONTINUA ARE WEIGHTED WITH THE PRODUCT OF THE
!                 LINE TRANSMISSION AND THE WEIGHTING.
                  MEAN_CONTINUUM(I_CASE, I_CONTINUUM)=0.0D+00
                  DO K=0, N_INT_WEIGHT
                     MEAN_CONTINUUM(I_CASE, I_CONTINUUM)
     &                  =MEAN_CONTINUUM(I_CASE, I_CONTINUUM)
     &                  +WEIGHT_COEFF(K)
     &                  *TRANS_CONTINUUM(I_BEGIN+K, I_CONTINUUM)
     &                  *TRANSMITTANCE(I_BEGIN+K, INDEX_WATER)
                  ENDDO
                  TRANS_LINE=0.0D+00
                  DO K=0, N_INT_WEIGHT
                     TRANS_LINE=TRANS_LINE
     &                  +WEIGHT_COEFF(K)
     &                  *TRANSMITTANCE(I_BEGIN+K, INDEX_WATER)
                  ENDDO
                  MEAN_CONTINUUM(I_CASE, I_CONTINUUM)
     &               =MEAN_CONTINUUM(I_CASE, I_CONTINUUM)
     &               /TRANS_LINE
               ELSE IF (I_CONTINUUM.EQ.IP_N2_CONTINUUM) THEN
                  MEAN_CONTINUUM(I_CASE, I_CONTINUUM)=0.0D+00
                  DO K=0, N_INT_WEIGHT
                     MEAN_CONTINUUM(I_CASE, I_CONTINUUM)
     &                  =MEAN_CONTINUUM(I_CASE, I_CONTINUUM)
     &                  +WEIGHT_COEFF(K)
     &                  *TRANS_CONTINUUM(I_BEGIN+K, I_CONTINUUM)
                  ENDDO
               ENDIF
            ENDDO
         ENDIF
!
!
!        CONTINUE WITH THE NEXT CASE IF AVERAGING HAS FAILED.
3        CONTINUE
!        RESET THE ERROR FLAG.
         IERR=I_NORMAL
!
      ENDDO
      WRITE(IU_STDOUT, '(A/)') 'PROCESSING COMPLETE'
!
      I_FIRST_RECORD_LINE=1
      I_FIRST_RECORD_CONTINUUM=1
      DO I_GROUP=1, N_GROUP
!
         LENGTH_GROUP=0
!
!        DEAL WITH ALL CASES FOR THIS GROUP. THE FOLLOWING SEARCH IS
!        NOT THE MOST EFFICIENT PROCESS, BUT MINIMIZES STORAGE.
         DO I_CASE=1, N_CASE
            IF (GROUP_CASE(I_CASE).EQ.I_GROUP) THEN
!
!              BUILD A LIST OF CASES IN THE GROUP.
               IF (LENGTH_GROUP.LT.NPD_AMOUNT) THEN
                  LENGTH_GROUP=LENGTH_GROUP+1
                  LIST_GROUP(LENGTH_GROUP)=I_CASE
               ELSE
                  WRITE(IU_ERR, '(/A)')
     &               '*** ERROR IN MAIN PROGRAM.'
                  WRITE(IU_ERR, '(A/)')
     &               'MAXIMUM LENGTH OF DATA GROUP EXCEEDED.'
                  IERR=I_ERR_FATAL
                  STOP
               ENDIF
            ENDIF
         ENDDO
!
!        SPLIT THIS GROUP UP INTO SETS FOR THE SAME GAS.
         CALL SPLIT_GROUP(IERR
     &      , LENGTH_GROUP, LIST_GROUP
     &      , BAND_GROUP(I_GROUP), P_GROUP(I_GROUP), T_GROUP(I_GROUP)
     &      , U_CASE, RANGE_CASE, BAND_TRANS
     &      , N_BAND_ABSORB_LOWTRAN, INDEX_ABSORB_LOWTRAN
     &      , TYPE_ABSORB, INDEX_WATER, AMOUNT_N2
     &      , N_SET, LENGTH_SET
     &      , INDEX_SET, U_SET, TRANS_SET
     &      , L_CONTINUUM, N_BAND_CONTINUUM, INDEX_CONTINUUM
     &      , MEAN_CONTINUUM, N_SET_CONTINUUM, LENGTH_SET_CONTINUUM
     &      , INDEX_SET_CONTINUUM
     &      , U_SET_CONTINUUM, DENSITY_BROAD, TRANS_SET_CONTINUUM)
         IF (IERR.NE.I_NORMAL) STOP
!
         I_SET=0
         DO I=1, N_SET
!           ORDER THE ELEMENTS WITHIN THE SETS BY ABSORBER AMOUNT.
            CALL ORDER_SET(.FALSE., LENGTH_SET(I)
     &         , DENSITY_BROAD(1, I), U_SET(1, I), TRANS_SET(1, I))
            IF (TRANS_TYPE.EQ.'FLUX') THEN
               CALL CONVERT_AMOUNT(IERR, LENGTH_SET(I)
     &            , DIFFUSIVITY_FACTOR, U_SET(1, I))
            ENDIF
!           OMIT SETS IN WHICH THE MAXIMUM AMOUNT OF ABSORBER IS 0:
!           THESE WILL NOT BE REQUIRED, BUT WILL HAVE ARISEN BECAUSE
!           OF THE WAY LOWTRAN WORKS.
            IF (U_SET(LENGTH_SET(I), I).GT.TOL_TEST) THEN
               I_SET=I_SET+1
               CALL WRITE_TRANS(TYPE_ABSORB(INDEX_SET(I))
     &            , TRANS_TYPE, I_SET
     &            , LENGTH_SET(I), BAND_GROUP(I_GROUP), INDEX_SET(I)
     &            , P_GROUP(I_GROUP), T_GROUP(I_GROUP)
     &            , U_SET(1, I), TRANS_SET(1, I)
     &            , WAVE_LENGTH_SHORT(BAND_GROUP(I_GROUP))
     &            , WAVE_LENGTH_LONG(BAND_GROUP(I_GROUP))
     &            , N_PER_TRANS_RECORD, I_FIRST_RECORD_LINE
     &            )
               IF (IERR.NE.I_NORMAL) STOP
            ENDIF
         ENDDO
!
!        REPEAT FOR THE CONTINUUM.
!
         IF (L_CONTINUUM) THEN
!
            DO I=1, N_SET_CONTINUUM
               CALL ORDER_SET(.TRUE.
     &            , LENGTH_SET_CONTINUUM(I), DENSITY_BROAD(1, I)
     &            , U_SET_CONTINUUM(1, I), TRANS_SET_CONTINUUM(1, I))
               IF (TRANS_TYPE.EQ.'FLUX') THEN
                   CALL CONVERT_AMOUNT(IERR, LENGTH_SET_CONTINUUM(I)
     &            , DIFFUSIVITY_FACTOR, U_SET_CONTINUUM(1, I))
               ENDIF
               CALL WRITE_CONTINUUM(TRANS_TYPE
     &            , I, LENGTH_SET_CONTINUUM(I)
     &            , BAND_GROUP(I_GROUP), INDEX_SET_CONTINUUM(I)
     &            , P_GROUP(I_GROUP), T_GROUP(I_GROUP)
     &            , U_SET_CONTINUUM(1, I), DENSITY_BROAD(1, I)
     &            , TRANS_SET_CONTINUUM(1, I)
     &            , WAVE_LENGTH_SHORT(BAND_GROUP(I_GROUP))
     &            , WAVE_LENGTH_LONG(BAND_GROUP(I_GROUP))
     &            , N_PER_TRANS_RECORD, I_FIRST_RECORD_CONTINUUM
     &            )
               IF (IERR.NE.I_NORMAL) STOP
            ENDDO
         ENDIF
      ENDDO
!
!
      STOP
      END
