!+ Subroutine to calculate unconvolved continuum transmissions.
!
! Method:
!	Monochromatic continuum transmissions are generated at
!	points within a spectral band and averaged across that 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_SIMPLE(IERR
     &   , 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_AMOUNT, U_BASIC
     &   , 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
     &   )
!
!
!
      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/ckd1_table_size.ecf'
      INCLUDE 'incl/ckd1_table_parm.ecf'
      INCLUDE 'incl/ckd1_parm.ecf'
      INCLUDE 'incl/continuum.pcf'
      INCLUDE 'incl/physical_constants_pp.ccf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      CHARACTER	!, INTENT(IN)
     &     TRANS_TYPE*4
!             TYPE OF TRANSMISSION
      INTEGER	!, INTENT(IN)
     &     IERR
!             ERROR FLAG
      INTEGER	!, INTENT(IN)
     &     N_PT_PAIR
!             NUMBER OF P,T PAIRS
     &   , N_AMOUNT
!             NUMBER OF AMOUNTS
     &   , N_PARTIAL_P
!             NUMBER OF PARTIAL PRESSURES
     &   , I_BAND
!             BAND CONSIDERED
     &   , I_WEIGHT
!             WEIGHTING USED
     &   , I_SET
!             NUMBER OF SET OF DATA
      INTEGER	!, INTENT(IN)
     &     N_BAND_CONTINUUM
!             NUMBER OF CONTINUA IN BANDS
     &   , INDEX_CONTINUUM(NPD_BAND, NPD_CONTINUUM)
!             LIST OF CONTINUA
!
      INTEGER	!, INTENT(IN)
     &     N_SOLAR_POINTS
!             SIZE OF SOLAR SPECTRUM
     &   , N_PER_TRANS_RECORD
!             VALUES PER TRANSMISSION RECORD
     &   , I_FIRST_RECORD
!             FIRST RECORD OF OUTPUT FILE
!
      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
!             UPPER END OF BAND
     &   , WAVELENGTH_LONG
!             LOWER END OF BAND
     &   , DIFFUSIVITY
!             DIFFUSIVITY FACTOR
!
      REAL*8	!, INTENT(IN)
     &     SOLAR_WAVELENGTH(NPD_SOLAR_POINTS)
!             POINTS OF SOLAR SPECTRUM
     &   , SOLAR_IRRAD(NPD_SOLAR_POINTS)
!             SOLAR IRRADIANCES
!
!
      REAL*8	!, INTENT(IN)
     &     P(NPD_PT)
!             PRESSURES FOR TRANSMISSION
     &   , T(NPD_PT)
!             TEMPERATURES FOR TRANSMISSION
     &   , U_BASIC(NPD_AMOUNT_CONTIN)
!             BASIC AMOUNTS OF WATER VAPOUR
!
      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
!
!
!     LOCAL VARIABLES.
!
      LOGICAL
     &     LOCK_CODE
!             LOGICAL TO FORBID INTERACTIVE LOOPING
      EXTERNAL
     &     LOCK_CODE
!
      INTEGER
     &     N_INT_WEIGHT
!             NUMBER OF WEIGHTING INTERVALS
     &   , N_POINTS
!             NUMBER OF CONTINUUM DATA POINTS
     &   , I_BEGIN
!             FIRST WEIGHTING POINT
      INTEGER
     &     I
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
     &   , I_A
!             LOOP VARIABLE
     &   , I_C
!             LOOP VARIABLE
     &   , I_PP
!             LOOP VARIABLE
     &   , I_PT
!             LOOP VARIABLE
     &   , I_CONTINUUM
!             CONTINUUM CONSIDERED
     &   , I_POINTER
!             POINTER TO ELEMENT OF SET
     &   , LENGTH_SET
!             LENGTH OF FULL SET
      REAL*8
     &     MEAN_CONTINUUM(NPD_AMOUNT)
!             MEAN CONTINUUM TRANSMISSION
     &   , CONTINUUM_TRANS(NPD_WAVENUMBER_TRANS)
!             CONTINUUM TRANSMISSIONS
     &   , U(NPD_AMOUNT)
!             AMOUNTS OF WATER VAPOUR
     &   , DENSITY_BROAD(NPD_AMOUNT)
!             MOLAR BROADENING DENSITY
      REAL*8
     &     WEIGHT_COEFF(0: NPD_WAVENUMBER_TRANS)
!             WEIGHTING COEFFICIENTS
     &   , WORK(0: NPD_WAVENUMBER_TRANS)
!             WORK ARRAY
      REAL*8
     &     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
     &   , WAVENUMBER_START
!             STARTING WAVENUMBER
!
!     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
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     WEIGHTINGS, WRITE_CONTINUUM
     &   , CONTINUUM_SELF_TRANS, CONTINUUM_FRN_TRANS
!
!
!
!     DIVIDE THE BAND INTO INTERVALS
      WAVENUMBER_LOW_BAND=1.0D+00/WAVELENGTH_LONG
      WAVENUMBER_HIGH_BAND=1.0D+00/WAVELENGTH_SHORT
      N_POINTS=(WAVENUMBER_HIGH_BAND-WAVENUMBER_LOW_BAND)
     &   /WAVENUMBER_RESOLUTION+3
      IF (N_POINTS.GT.NPD_WAVENUMBER_TRANS) THEN
         WRITE(IU_ERR, '(/A)')
     &      '*** ERROR: TOO MANY POINTS ARE REQUIRED IN THE BAND.'
         STOP
      ENDIF
      WAVENUMBER_START=WAVENUMBER_LOW_BAND
     &   -WAVENUMBER_RESOLUTION
      DO I=1, N_POINTS
         WAVENUMBER_TRANS(I)=WAVENUMBER_START
     &      +WAVENUMBER_RESOLUTION*DBLE(I-1)
      ENDDO

!     LOOP THROUGH THE COMBINATIONS OF PRESSURE AND TEMPERATURE
      DO I_PT=1, N_PT_PAIR
         MAX_PARTIAL_P=SATURATION_VP(P(I_PT), T(I_PT))
!
         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_POINTS, WAVENUMBER_TRANS
     &      , I_BEGIN, N_INT_WEIGHT, WEIGHT_COEFF
     &      , WORK
     &      )
         DO I_C=1, N_BAND_CONTINUUM
            I_CONTINUUM=INDEX_CONTINUUM(I_BAND, I_C)
            LENGTH_SET=0
            DO I_PP=1, N_PARTIAL_P
               PARTIAL_P=MAX_PARTIAL_P
     &            *DBLE(I_PP)/DBLE(N_PARTIAL_P)
               DO I_A=1, N_AMOUNT
                  I_POINTER=N_AMOUNT*(I_PP-1)+I_A
                  LENGTH_SET=LENGTH_SET+1
!                 U IS THE ARRAY OF AMOUNTS TO BE WRITTEN OUT
!                 WE CONVERT TO AMOUNTS FOR FLUX TRANSMITTANCES NOW.
                  U(I_POINTER)=U_BASIC(I_A)/DIFFUSIVITY
                  IF (I_CONTINUUM.EQ.IP_SELF_CONTINUUM) THEN
                     CALL CONTINUUM_SELF_TRANS(IERR
     &                  , N_POINTS, WAVENUMBER_TRANS
     &                  , P(I_PT), PARTIAL_P, T(I_PT)
     &                  , U_BASIC(I_A)
     &                  , 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(I_POINTER)
     &                  )
                  ELSE IF (I_CONTINUUM.EQ.IP_FRN_CONTINUUM) THEN
                     CALL CONTINUUM_FRN_TRANS(IERR
     &                  , N_POINTS, WAVENUMBER_TRANS
     &                  , P(I_PT), PARTIAL_P, T(I_PT)
     &                  , U_BASIC(I_A)
     &                  , N_TABLE_FRN, WAVENUMBER_TABLE_FRN
     &                  , C_H2O_FRN_SI, D2_C_H2O_FRN_SI
     &                  , CONTINUUM_TRANS
     &                  , DENSITY_BROAD(I_POINTER)
     &                  )
                  ELSE
                      WRITE(IU_ERR, '(/A)') '*** WARNING FROM '
     &                   //'SUBROUTINE CONT_BAND_SIMPLE'
                      WRITE(IU_ERR, '(A, I5, /, A)') 'CONTINUUM TYPE '
     &                   , I_CONTINUUM, 'IS NOT SUPPORTED IN THIS '
     &                   //'PROGRAM: IT WILL BE IGNORED.'
                  ENDIF
!
                  MEAN_CONTINUUM(I_POINTER)=0.0D+00
                  DO K=0, N_INT_WEIGHT
                     MEAN_CONTINUUM(I_POINTER)
     &                  =MEAN_CONTINUUM(I_POINTER)+WEIGHT_COEFF(K)
     &                  *CONTINUUM_TRANS(I_BEGIN+K)
                  ENDDO
!
               ENDDO
            ENDDO
!
            IF (LENGTH_SET.GT.0) THEN
!              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)
            ENDIF
!
         ENDDO
      ENDDO
!
!
      RETURN
      END
