!+ Subroutine to calculate continuum transmissions with an archive.
!
! Method:
!	Self and foreign-broadened continuum transmissions are 
!	generated at points in the band where line transmissions
!	are available from an archive and these transmissions are
!	weighted and averaged across the band.
!
! 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 CONT_BAND_ARCH(IERR
     &   , L_CONVOL_FRN, TRANS_TYPE, I_WEIGHT, I_BAND
     &   , N_BAND_CONTINUUM, INDEX_CONTINUUM
     &   , WAVELENGTH_SHORT, WAVELENGTH_LONG
     &   , N_EXCLUDE, EXCLUDE_SHORTER, EXCLUDE_LONGER
     &   , N_PT_PAIR, P, T
     &   , N_PARTIAL_P
     &   , N_SOLAR_POINTS, SOLAR_WAVELENGTH, SOLAR_IRRAD
     &   , WAVENUMBER_TABLE_SELF_260
     &   , C_H2O_SELF_260_SI, D2_C_H2O_SELF_260_SI
     &   , WAVENUMBER_TABLE_SELF_296
     &   , C_H2O_SELF_296_SI, D2_C_H2O_SELF_296_SI
     &   , WAVENUMBER_TABLE_FRN, C_H2O_FRN_SI, D2_C_H2O_FRN_SI
     &   , DIFFUSIVITY
     &   , N_PER_TRANS_RECORD, I_FIRST_RECORD, I_SET
     &   , I_VERSION, N_ENTRY, N_PER_ARCH_RECORD, I_GAS
     &   , N_TRANS_RECORD, I1_RECORD
     &   , N_TRANS_ENTRY
     &   , P_ARCH, T_ARCH, AMOUNT
     &   , FREQ_ENTRY_LOW, FREQ_ENTRY_HIGH, D_FREQ_ENTRY
     &   )
!
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.

!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_pp_io.icf'
      INCLUDE 'incl/def_arch_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/dimensions_pp.ucf'
      INCLUDE 'incl/dimensions_arch.ucf'
      INCLUDE 'incl/ckd1_table_size.ecf'
      INCLUDE 'incl/ckd1_table_parm.ecf'
      INCLUDE 'incl/continuum.pcf'
      INCLUDE 'incl/gas_list.pcf'
      INCLUDE 'incl/physical_constants_pp.ccf'
      INCLUDE 'incl/error.pcf'
!
!     VARIABLES.
      CHARACTER	!, INTENT(IN)
     &     TRANS_TYPE*4
!             TYPE OF TRANSMITTANCE
      LOGICAL	!, INTENT(IN)
     &     L_CONVOL_FRN
!             FLAG TO CONVOLVE FOREIGN CTN.
      INTEGER	!, INTENT(IN)
     &     IERR
!             ERROR FLAG
      INTEGER	!, INTENT(IN)
     &     N_BAND_CONTINUUM
!             NUMBER OF CONTINUA IN BANDS
     &   , INDEX_CONTINUUM(NPD_BAND, NPD_CONTINUUM)
!             INDICES OF CONTINUA IN BANDS
      INTEGER	!, INTENT(IN)
     &     N_PT_PAIR
!             NUMBER OF P,T PAIRS
     &   , N_PARTIAL_P
!             NUMBER OF PARTIAL PRESSURES
     &   , I_BAND
!             BAND CONSIDERED
     &   , I_WEIGHT
!             WEIGHTING USED
     &   , N_PER_TRANS_RECORD
!             NUMBER OF POINTS IN TRANS RECORD
     &   , I_FIRST_RECORD
!             INDEX OF FIRST RECORD OF FILE
!
      INTEGER	!, INTENT(IN)
     &     N_SOLAR_POINTS
!             SIZE OF SOLAR SPECTRUM
      REAL*8	!, INTENT(IN)
     &     SOLAR_WAVELENGTH(NPD_SOLAR_POINTS)
!             POINTS OF SOLAR SPECTRUM
     &   , SOLAR_IRRAD(NPD_SOLAR_POINTS)
!             SOLAR IRRADIANCES
!
      INTEGER	!, INTENT(IN)
     &     N_EXCLUDE
!             NUMBER OF EXCLUDED REGIONS IN BAND
      REAL*8
     &     EXCLUDE_SHORTER(NPD_EXCLUDE)
!             LOWER LIMITS OF EXCLUDED INTERVALS
     &   , EXCLUDE_LONGER(NPD_EXCLUDE)
!             UPPER LIMITS OF EXCLUDED INTERVALS
      REAL*8	!, INTENT(IN)
     &     WAVELENGTH_SHORT
!             SHORTWAVE LIMIT OF BAND
     &   , WAVELENGTH_LONG
!             LONGWAVE LIMIT OF BAND
      REAL*8	!, INTENT(IN)
     &     DIFFUSIVITY
!             DIFFUSIVITY FACTOR
      REAL*8	!, INTENT(IN)
     &     P(NPD_PT)
!             PRESSURES FOR TRANSMISSION
     &   , T(NPD_PT)
!             TEMPERATURES FOR TRANSMISSION
      REAL*8	!, INTENT(IN)
     &     WAVENUMBER_TABLE_SELF_260(NPD_TABLE_SELF_260)
!             WAVENUMBERS OF ENTRIES IN TABLE
     &   , C_H2O_SELF_260_SI(NPD_TABLE_SELF_260)
!             SI VALUES OF COEFFICIENTS IN TABLE
     &   , D2_C_H2O_SELF_260_SI(NPD_TABLE_SELF_260)
!             2ND DERIVATIVES OF COEFFICIENTS
     &   , WAVENUMBER_TABLE_SELF_296(NPD_TABLE_SELF_296)
!             WAVENUMBERS OF ENTRIES IN TABLE
     &   , C_H2O_SELF_296_SI(NPD_TABLE_SELF_296)
!             SI VALUES OF COEFFICIENTS IN TABLE
     &   , D2_C_H2O_SELF_296_SI(NPD_TABLE_SELF_296)
!             2ND DERIVATIVES OF COEFFICIENTS
     &   , WAVENUMBER_TABLE_FRN(NPD_TABLE_FRN)
!             WAVENUMBERS OF ENTRIES IN TABLE
     &   , C_H2O_FRN_SI(NPD_TABLE_FRN)
!             SI VALUES OF COEFFICIENTS IN TABLE
     &   , D2_C_H2O_FRN_SI(NPD_TABLE_FRN)
!             2ND DERIVATIVES OF COEFFICIENTS
      REAL*8	!, INTENT(IN)
     &     MEAN_CONTINUUM(NPD_AMOUNT)
!             MEAN CONTINUUM TRANSMISSION
     &   , CONTINUUM_TRANS(NPD_WAVENUMBER_TRANS)
!             CONTINUUM TRANSMISSIONS
!
!     VARIABLES FOR ARCHIVE.
      INTEGER	!, INTENT(IN)
     &     I_VERSION
!             VERSION OF ARCHIVE IN USE
     &   , N_ENTRY
!             NUMBER OF ENTRIES IN ARCHIVE
     &   , N_PER_ARCH_RECORD
!             NUMBER OF TRIPLES IN RECORD
     &   , I_GAS(NPD_ARCH_ENTRY)
!             IDENTITIES OF GASES IN ARCHIVE
     &   , N_TRANS_RECORD(NPD_ARCH_ENTRY)
!             NUMBER OF RECORDS IN ENTRIES
     &   , I1_RECORD(NPD_ARCH_ENTRY)
!             POINTERS TO 1ST REC. OF EACH ENTRY
     &   , N_TRANS_ENTRY(NPD_ARCH_ENTRY)
!             NUMBER OF TRANSMISSIONS
      REAL*8	!, INTENT(IN)
     &     P_ARCH(NPD_ARCH_ENTRY)
!             PRESSURES IN FIRST ARCHIVE
     &   , T_ARCH(NPD_ARCH_ENTRY)
!             TEMPERATURES IN FIRST ARCHIVE
     &   , AMOUNT(NPD_ARCH_ENTRY)
!             AMOUNTS IN FIRST ARCHIVE
     &   , FREQ_ENTRY_LOW(NPD_ARCH_ENTRY)
!             LOW FREQUENCY LIMITS OF ENTRIES
     &   , FREQ_ENTRY_HIGH(NPD_ARCH_ENTRY)
!             HIGH FREQUENCY LIMITS OF ENTRIES
     &   , D_FREQ_ENTRY(NPD_ARCH_ENTRY)
!             INCREMENTS OF FREQUENCY IN ENTRIES
!
!     LOCAL VARIABLES
!
      LOGICAL
     &     LOCK_CODE
!             LOGICAL TO FORBID INTERACTIVE LOOPING
      EXTERNAL
     &     LOCK_CODE
!
      INTEGER
     &     N_INT_WEIGHT
!             NUMBER OF WEIGHTING INTERVALS
     &   , N_REDUCED_TRANS
!             LENGTH OF REDUCED TRANSMISSIONS
     &   , OFFSET
!             OFFSET IN ARRAY OF TRANSMISSIONS
     &   , I_BEGIN
!             FIRST WEIGHTING POINT
      INTEGER	!, INTENT(IN)
     &     J
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
     &   , I_C
!             LOOP VARIABLE
     &   , I_PP
!             LOOP VARIABLE
     &   , I_PT
!             LOOP VARIABLE
     &   , I_ENTRY
!             INDEX OF ENTRIES
     &   , I_CONTINUUM
!             CONTINUUM CONSIDERED
     &   , I_SET
!             NUMBER OF SET OF DATA
     &   , LENGTH_SET
!             LENGTH OF FULL SET
      REAL*8
     &     WEIGHT_COEFF(0: NPD_WAVENUMBER_TRANS)
!             WEIGHTING COEFFICIENTS
     &   , WORK(0: NPD_WAVENUMBER_TRANS)
!             WORK ARRAY
     &   , U(NPD_AMOUNT)
!             AMOUNTS OF WATER VAPOUR
     &   , DENSITY_BROAD(NPD_AMOUNT)
!             MOLAR BROADENING DENSITY
     &   , DENSITY_DUMMY
!             DUMMY DENSITY
     &   , PARTIAL_P
!             PARTIAL PRESSURE OF WATER VAPOUR
     &   , MAX_PARTIAL_P
!             MAXIMUM PARTIAL PRESSURE
     &   , WAVENUMBER_TRANS(NPD_WAVENUMBER_TRANS)
!             WAVENUMBERS OF DATA POINTS
     &   , WAVENUMBER_LOW_BAND
!             LOW WAVENUMBER OF BAND
     &   , WAVENUMBER_HIGH_BAND
!             HIGH WAVENUMBER OF BAND
      REAL*8
     &     FREQ_LOW(NPD_FREQ_ENTRY)
!             LOW FREQUENCIES IN ENTRIES
     &   , FREQ_HIGH(NPD_FREQ_ENTRY)
!             HIGH FREQUENCIES IN ENTRIES
     &   , TRANS(NPD_FREQ_ENTRY)
!             TRANSMISSIONS IN ENTRIES
     &   , TRANS_REDUCED(NPD_FREQ_ENTRY)
!             REDUCED TRANSMISSIONS
     &   , MEAN_LINE_TRANS
!             MEAN LINE TRANSMISSION
!
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     READ_ARCHIVE_ENTRY_0, READ_ARCHIVE_ENTRY_1
     &   , CONTINUUM_SELF_TRANS, CONTINUUM_FRN_TRANS
     &   , WEIGHTINGS, WRITE_CONTINUUM
!
!     FUNCTIONS CALLED:
      REAL*8
     &     SATURATION_VP
!             FUNCTION FOR SVP
      EXTERNAL
     &     SATURATION_VP
!
!
!     COMMON BLOCKS INTERFACING TO CLOUGH'S DATA.
      COMMON/S260/TABLE_START_SELF_260, TABLE_END_SELF_260
     &   , DELTA_TABLE_SELF_260, N_TABLE_SELF_260
     &   , C_H2O_SELF_260
      COMMON/SH2O/TABLE_START_SELF_296, TABLE_END_SELF_296
     &   , DELTA_TABLE_SELF_296, N_TABLE_SELF_296
     &   , C_H2O_SELF_296
      COMMON/FH2O/TABLE_START_FRN, TABLE_END_FRN
     &   , DELTA_TABLE_FRN, N_TABLE_FRN
     &   , C_H2O_FRN
!
!
!
      WAVENUMBER_LOW_BAND=1.0D+00/WAVELENGTH_LONG
      WAVENUMBER_HIGH_BAND=1.0D+00/WAVELENGTH_SHORT
!
      DO I_PT=1, N_PT_PAIR
         MAX_PARTIAL_P=SATURATION_VP(P(I_PT), T(I_PT))
         DO I_C=1, N_BAND_CONTINUUM
            I_CONTINUUM=INDEX_CONTINUUM(I_BAND, I_C)
!
!           THIS WEIGHTING IS TO BE CARRIED OUT ONLY FOR THE CONTINUA
!           OF WATER VAPOUR: RETURN FROM OTHER CONTINUA.
            IF ( (I_CONTINUUM.NE.IP_SELF_CONTINUUM).AND.
     &           (I_CONTINUUM.NE.IP_FRN_CONTINUUM) ) RETURN
!
            LENGTH_SET=0
            DO I_ENTRY=1, N_ENTRY
!
               IF ( (P_ARCH(I_ENTRY).EQ.P(I_PT) ).AND.
     &              (T_ARCH(I_ENTRY).EQ.T(I_PT) ).AND.
     &              (I_GAS(I_ENTRY).EQ.IP_H2O).AND.
     &              (FREQ_ENTRY_LOW(I_ENTRY)
     &              .LT.WAVENUMBER_LOW_BAND).AND.
     &              (FREQ_ENTRY_HIGH(I_ENTRY)
     &              .GT.WAVENUMBER_HIGH_BAND) ) THEN
                  IF (I_VERSION.EQ.0) THEN
                     CALL READ_ARCHIVE_ENTRY_0(IU_ARCHIVE_IN
     &                  , N_TRANS_RECORD(I_ENTRY), I1_RECORD(I_ENTRY)
     &                  , N_PER_ARCH_RECORD, N_TRANS_ENTRY(I_ENTRY)
     &                  , FREQ_LOW, FREQ_HIGH, TRANS
     &                  )
                  ELSE IF (I_VERSION.EQ.1) THEN
                     CALL READ_ARCHIVE_ENTRY_1(IU_ARCHIVE_IN
     &                  , N_TRANS_RECORD(I_ENTRY), I1_RECORD(I_ENTRY)
     &                  , N_PER_ARCH_RECORD, N_TRANS_ENTRY(I_ENTRY)
     &                  , FREQ_ENTRY_LOW(I_ENTRY), D_FREQ_ENTRY(I_ENTRY)
     &                  , FREQ_LOW, FREQ_HIGH, TRANS
     &                  )
                  ENDIF
!
!                 CONSTRUCT THE REDUCED ARRAY OF TRANSMISSIONS REQUIRED.
                  N_REDUCED_TRANS=0
                  J=0
100               J=J+1
                  IF ( ( (J.GT.1).AND.(J.LT.N_TRANS_ENTRY(I_ENTRY))
     &               .AND.((FREQ_LOW(J+1)+FREQ_HIGH(J+1)).GE.(2.0D+00
     &               *WAVENUMBER_LOW_BAND)).AND.((FREQ_LOW(J-1)
     &               +FREQ_HIGH(J-1)).LE.(2.0D+00*WAVENUMBER_HIGH_BAND))
     &               ).OR.( (J.EQ.1).AND.((FREQ_LOW(2)+FREQ_HIGH(2)).GE.
     &               2.0D+00*WAVENUMBER_LOW_BAND) )
     &               .OR.( (J.EQ.N_TRANS_ENTRY(I_ENTRY)).AND.
     &               ((FREQ_LOW(N_TRANS_ENTRY(I_ENTRY)-1)
     &               +FREQ_HIGH(N_TRANS_ENTRY(I_ENTRY)-1)).LE.
     &               2.0D+00*WAVENUMBER_HIGH_BAND) ) ) THEN
!                    SET THE OFFSET ON THE FIRST PASS.
                     IF (N_REDUCED_TRANS.EQ.0) OFFSET=J-1
                     N_REDUCED_TRANS=N_REDUCED_TRANS+1
                     TRANS_REDUCED(N_REDUCED_TRANS)=TRANS(J)
                     WAVENUMBER_TRANS(N_REDUCED_TRANS)
     &                  =0.5D+00*(FREQ_LOW(J)+FREQ_HIGH(J))
                  ENDIF
                  IF (J.LE.N_TRANS_ENTRY(I_ENTRY)) GOTO 100
!
!                 CONVOLVE THE FOREIGN CONTINUUM WITH THE LINE DATA:
!                 THIS IS SENSIBLE ONLY FOR THE 
!                 SELF-BROADENED CONTINUUM.
                  IF ( L_CONVOL_FRN.AND.
     &               (I_CONTINUUM.EQ.IP_SELF_CONTINUUM) ) THEN
                     CALL CONTINUUM_FRN_TRANS(IERR
     &                  , N_REDUCED_TRANS, WAVENUMBER_TRANS
     &                  , P(I_PT), 0.0D+00, T(I_PT)
     &                  , AMOUNT(I_ENTRY)
     &                  , N_TABLE_FRN, WAVENUMBER_TABLE_FRN
     &                  , C_H2O_FRN_SI, D2_C_H2O_FRN_SI
     &                  , CONTINUUM_TRANS
     &                  , DENSITY_DUMMY
     &                  )
                     DO J=1, N_REDUCED_TRANS
                        TRANS_REDUCED(J)=TRANS_REDUCED(J)
     &                     *CONTINUUM_TRANS(J)
                     ENDDO
                  ENDIF
!
                  CALL WEIGHTINGS(IERR
     &               , I_WEIGHT, .TRUE.
     &               , N_SOLAR_POINTS, SOLAR_WAVELENGTH, SOLAR_IRRAD
     &               , T(I_PT)
     &               , WAVENUMBER_LOW_BAND, WAVENUMBER_HIGH_BAND
     &               , N_EXCLUDE, EXCLUDE_SHORTER, EXCLUDE_LONGER
     &               , N_REDUCED_TRANS, WAVENUMBER_TRANS
     &               , I_BEGIN, N_INT_WEIGHT, WEIGHT_COEFF
     &               , WORK
     &               )
                  DO I_PP=1, N_PARTIAL_P
                     PARTIAL_P=MAX_PARTIAL_P
     &                  *DBLE(I_PP)/DBLE(N_PARTIAL_P)
                     IF (LENGTH_SET.LT.NPD_AMOUNT) THEN
                        LENGTH_SET=LENGTH_SET+1
                     ELSE
                        WRITE(IU_ERR, '(/A)')
     &                     '*** ERROR: TOO MANY AMOUNTS ARE REQUIRED.'
                        WRITE(IU_ERR, '(A)')
     &                     'RECOMPILE WITH A LARGER VALUE OF '
     &                     //'NPD_AMOUNT.'
                        IERR=I_ERR_FATAL
                        RETURN
                     ENDIF
                     U(LENGTH_SET)=AMOUNT(I_ENTRY)/DIFFUSIVITY
!
                     IF (I_CONTINUUM.EQ.IP_SELF_CONTINUUM) THEN
                        CALL CONTINUUM_SELF_TRANS(IERR
     &                     , N_REDUCED_TRANS, WAVENUMBER_TRANS
     &                     , P(I_PT), PARTIAL_P, T(I_PT)
     &                     , AMOUNT(I_ENTRY)
     &                     , N_TABLE_SELF_260, WAVENUMBER_TABLE_SELF_260
     &                     , C_H2O_SELF_260_SI, D2_C_H2O_SELF_260_SI
     &                     , N_TABLE_SELF_296, WAVENUMBER_TABLE_SELF_296
     &                     , C_H2O_SELF_296_SI, D2_C_H2O_SELF_296_SI
     &                     , CONTINUUM_TRANS, DENSITY_BROAD(LENGTH_SET)
     &                     )
                     ELSE IF (I_CONTINUUM.EQ.IP_FRN_CONTINUUM) THEN
                        CALL CONTINUUM_FRN_TRANS(IERR
     &                     , N_REDUCED_TRANS, WAVENUMBER_TRANS
     &                     , P(I_PT), PARTIAL_P, T(I_PT)
     &                     , AMOUNT(I_ENTRY)
     &                     , N_TABLE_FRN, WAVENUMBER_TABLE_FRN
     &                     , C_H2O_FRN_SI, D2_C_H2O_FRN_SI
     &                     , CONTINUUM_TRANS
     &                     , DENSITY_BROAD(LENGTH_SET)
     &                     )
                     ELSE
                        WRITE(IU_ERR, '(/A)') '*** WARNING FROM '
     &                     //'SUBROUTINE CONT_BAND_ARCH'
                        WRITE(IU_ERR, '(A, I5, /, A)')
     &                     'CONTINUUM TYPE ', I_CONTINUUM
     &                     , 'IS NOT SUPPORTED IN THIS '
     &                     //'PROGRAM: IT WILL BE IGNORED.'
                     ENDIF
!
!                    WEIGHT WITH THE PRODUCT OF THE LINE TRANSMISSION
!                    AND THE WEIGHTING FUNCTION.
                     MEAN_CONTINUUM(LENGTH_SET)=0.0D+00
                     MEAN_LINE_TRANS=0.0D+00
                     DO K=0, N_INT_WEIGHT
                        MEAN_CONTINUUM(LENGTH_SET)
     &                     =MEAN_CONTINUUM(LENGTH_SET)+WEIGHT_COEFF(K)
     &                     *CONTINUUM_TRANS(I_BEGIN+K)
     &                     *TRANS_REDUCED(I_BEGIN+K)
                        MEAN_LINE_TRANS
     &                     =MEAN_LINE_TRANS+WEIGHT_COEFF(K)
     &                     *TRANS_REDUCED(I_BEGIN+K)
                     ENDDO
!
!                    IF THE LINES ARE COMPLETELY OPAQUE THE CONTINUUM
!                    WILL ALSO BE COMPLETELY OPAQUE.
                     IF (MEAN_LINE_TRANS.GT.0.0D+00) THEN
                        MEAN_CONTINUUM(LENGTH_SET)
     &                     =MEAN_CONTINUUM(LENGTH_SET)/MEAN_LINE_TRANS
                     ELSE
                        MEAN_CONTINUUM(LENGTH_SET)=0.0D+00
                     ENDIF
!
!
!                    SITUATIONS IN WHICH THE LINES ARE TOTALLY OPAQUE
!                    ARE FLAGGED BY NEGATIVE TRANSMITTANCES AND ARE
!                    TO BE DISCARDED.
                     IF (MEAN_CONTINUUM(LENGTH_SET).LT.0) THEN
                        LENGTH_SET=LENGTH_SET-1
                     ENDIF
!
                  ENDDO
!
               ENDIF
            ENDDO
!
!           ADVANCE THE COUNT OF SETS FOR THE PRESENT CASE.
            I_SET=I_SET+1
!
            CALL WRITE_CONTINUUM(TRANS_TYPE
     &         , I_SET, LENGTH_SET, I_BAND, I_CONTINUUM
     &         , P(I_PT), T(I_PT)
     &         , U, DENSITY_BROAD, MEAN_CONTINUUM
     &         , WAVELENGTH_SHORT, WAVELENGTH_LONG
     &         , N_PER_TRANS_RECORD, I_FIRST_RECORD)
!
         ENDDO
      ENDDO
!
!
      RETURN
      END
