!+ Program to calculate continuum transmittances
!
! Method:
!	Spectral bands are determined from a spectral file. Conditions
!	at which data are required are specified and an archive of 
!	line-by-line data is read if required. Transmittances, averaged
!       across the spectral bands are then calculated at the specified
!	conditions and written to a file.
!
! 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 CONTIN_CKD93
!
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_pp_io.icf'
      INCLUDE 'incl/def_arch_io.icf'
      INCLUDE 'incl/arch_record_size.pcf'
      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/ckd1_parm.ecf'
      INCLUDE 'incl/continuum.pcf'
      INCLUDE 'incl/physical_constants_pp.ccf'
      INCLUDE 'incl/error.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
     &     N_PT_PAIR
!             NUMBER OF P,T PAIRS
     &   , N_AMOUNT
!             NUMBER OF AMOUNTS
     &   , N_PARTIAL_P
!             NUMBER OF PARTIAL PRESSURES
     &   , I_BAND_FIRST
!             FIRST BAND CONSIDERED
     &   , I_BAND_LAST
!             LAST BAND CONSIDERED
     &   , I_WEIGHT
!             WEIGHTING USED
     &   , N_PER_TRANS_RECORD
!             NUMBER OF DATA POINTS IN RECORD
     &   , I_FIRST_RECORD
!             INDEX OF FIRST RECORD OF FILE
     &   , I_SET
!             SET OF DATA BEING PRODUCED
      INTEGER
     &     N_SOLAR_POINTS
!             SIZE OF SOLAR SPECTRUM
      INTEGER
     &     I
!             LOOP VARIABLE
     &   , I_B
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
      LOGICAL
     &     L_ARCH
!             LOGICAL FOR WEIGHTING WITH LINES
     &   , L_CONVOL_FRN
!             LOGICAL FOR CONVOLVED FOREIGN CONTINUUM
      REAL*8
     &     DIFFUSIVITY
!             DIFFUSIVITY FACTOR
      REAL*8
     &     SOLAR_WAVELENGTH(NPD_SOLAR_POINTS)
!             POINTS OF SOLAR SPECTRUM
     &   , SOLAR_IRRAD(NPD_SOLAR_POINTS)
!             SOLAR IRRADIANCES
      REAL*8
     &     P(NPD_PT)
!             PRESSURES FOR TRANSMISSION
     &   , T(NPD_PT)
!             TEMPERATURES FOR TRANSMISSION
     &   , U_BASIC(NPD_AMOUNT_CONTIN)
!             BASIC AMOUNTS OF WATER VAPOUR
      REAL*8
     &     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
     &   , CONVERSION_FACTOR
!             CONVERSION FACTOR TO SI UNITS
     &   , WORK(NPD_TABLE_SELF_260+NPD_TABLE_SELF_296+NPD_TABLE_FRN)
!             WORKING VARIABLE
!
!     VARIABLES FOR ARCHIVE.
      INTEGER
     &     I_VERSION
!             VERSION OF ARCHIVE USED
     &   , N_ENTRY
!             NUMBER OF ENTRIES IN 1ST ARCHIVE
     &   , LINESHAPE(NPD_ARCH_ENTRY)
!             LINE SHAPES IN FIRST ARCHIVE
     &   , I_GAS(NPD_ARCH_ENTRY)
!             IDENTITIES OF GASES IN 1ST ARCHIVE
     &   , N_TRANS_RECORD(NPD_ARCH_ENTRY)
!             NUMBER OF RECORDS IN ENTRIES
     &   , I1_RECORD(NPD_ARCH_ENTRY)
!             POINTERS TO 1ST RECORD OF EACH ENTRY
     &   , N_TRANS_ENTRY(NPD_ARCH_ENTRY)
!             NUMBER OF TRANSMISSIONS
     &   , DATABASE(NPD_ARCH_ENTRY)
!             DATABASES IN FIRST ARCHIVE
     &   , LBL_CODE(NPD_ARCH_ENTRY)
!             LBL CODES IN FIRST ARCHIVE
     &   , N_PER_ARCH_RECORD
!             NUMBER OF TRIPLES PER RECORD
      CHARACTER
     &     DATE(NPD_ARCH_ENTRY)*9
!             DATES OF COMPOSITION OF ENTRIES
      LOGICAL
     &     LINE_COUPLE(NPD_ARCH_ENTRY)
!             LINE COUPLING IN 1ST ARCHIVE
     &   , CONTINUUM(NPD_ARCH_ENTRY)
!             CONTINUUM IN 1ST ARCHIVE
      REAL*8
     &     CUTOFF(NPD_ARCH_ENTRY)
!             LINE CUTOFFS IN FIRST ARCHIVE
     &   , 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
     &   , PARTIAL_P(NPD_ARCH_ENTRY)
!             PARTIAL PRESSURES 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 IN FREQUENCY OF ENTRIES
!
!     LIMITS OF BANDS AND EXCLUDED SECTIONS
      REAL*8
     &     EXCLUDE_SHORTER(NPD_EXCLUDE)
!             LOWER LIMITS OF EXCLUDED INTERVALS
     &   , EXCLUDE_LONGER(NPD_EXCLUDE)
!             UPPER LIMITS OF EXCLUDED INTERVALS
!
!
!     SET VARIABLES FOR SPECTRAL FILE.
      INCLUDE 'dec_spec.finc'
!
!     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
     &     IN_SPECTRUM, OPEN_ARCHIVE_IN
     &   , READ_ARCHIVE_HEADER_0, READ_ARCHIVE_HEADER_1
     &   , SET_CONDITION_CONTINUUM, SELECT_WEIGHT_TRANS
     &   , OPEN_TRANS_OUT, SPLINE_FIT
     &   , CONT_BAND_ARCH, CONT_BAND_SIMPLE
!
!
!
      DATA IERR/I_NORMAL/
!
!
!
!     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 THE SPECTRAL DATA.
      INCLUDE 'read_spec.finc'
!
      IF (IERR.NE.I_NORMAL) THEN
         IF (IERR.EQ.I_ERR_EXIST) THEN
            IERR=I_NORMAL
            GOTO 100
         ELSE
            STOP
         ENDIF
      ENDIF
!
!     SELECT THE MODE IN WHICH THE CODE WILL OPERATE.
      WRITE(IU_USER, '(/A)') 'DO YOU WANT TO AVERAGE OVER AN ARCHIVE '
     &   //'OF LbL DATA?'
1     READ(IU_STDIN, '(A)') CHAR_YN
      IF ( (CHAR_YN.EQ.'y').OR.(CHAR_YN.EQ.'Y') ) THEN
         L_ARCH=.TRUE.
         WRITE(IU_USER, '(/A)')
     &      'IS THE FOREIGN CONTINUUM TO BE CONVOLVED WITH THE '
     &      //'LINE DATA? (Y/N)'
         READ(IU_STDIN, '(A)') CHAR_YN
         IF ( (CHAR_YN.EQ.'y').OR.(CHAR_YN.EQ.'Y') ) THEN
            L_CONVOL_FRN=.TRUE.
         ELSE
            L_CONVOL_FRN=.FALSE.
         ENDIF
         CALL OPEN_ARCHIVE_IN(IERR, IU_ARCHIVE_IN, NP_BYTES_PER_RECORD
     &      , 'ENTER THE NAME OF THE ARCHIVE OF LINE DATA.'
     &      , I_VERSION, N_ENTRY)
         IF (IERR.NE.I_NORMAL) STOP
!
         IF (I_VERSION.EQ.0) THEN
            CALL READ_ARCHIVE_HEADER_0(IERR, IU_ARCHIVE_IN
     &         , N_ENTRY
     &         , DATE, DATABASE, LBL_CODE
     &         , LINESHAPE, CUTOFF, CONTINUUM, LINE_COUPLE
     &         , I_GAS, P_ARCH, T_ARCH, AMOUNT, PARTIAL_P
     &         , FREQ_ENTRY_LOW, FREQ_ENTRY_HIGH
     &         , N_TRANS_RECORD, I1_RECORD, N_TRANS_ENTRY
     &         )
            N_PER_ARCH_RECORD=NP_BYTES_PER_RECORD/24
         ELSE IF (I_VERSION.EQ.1) THEN
            CALL READ_ARCHIVE_HEADER_1(IERR, IU_ARCHIVE_IN
     &         , N_ENTRY
     &         , DATE, DATABASE, LBL_CODE
     &         , LINESHAPE, CUTOFF, CONTINUUM, LINE_COUPLE
     &         , I_GAS, P_ARCH, T_ARCH, AMOUNT, PARTIAL_P
     &         , FREQ_ENTRY_LOW, FREQ_ENTRY_HIGH
     &         , N_TRANS_RECORD, I1_RECORD, N_TRANS_ENTRY
     &         , D_FREQ_ENTRY
     &         )
            N_PER_ARCH_RECORD=NP_BYTES_PER_RECORD/4
         ENDIF
      ELSE IF ( (CHAR_YN.EQ.'n').OR.(CHAR_YN.EQ.'N') ) THEN
         L_ARCH=.FALSE.
      ELSE
         WRITE(IU_ERR, '(A)') '+++ INVALID RESPONSE.'
         IF (LOCK_CODE(.TRUE.)) THEN
            INCLUDE 'batch_error_main.finc'
         ELSE
            WRITE(IU_USER, '(A)') 'PLEASE RE-ENTER.'
            GOTO 1
         ENDIF
      ENDIF
      CALL SET_CONDITION_CONTINUUM(IERR
     &   , L_ARCH
     &   , N_BAND, INDEX_WATER
     &   , N_ENTRY, P_ARCH, T_ARCH
     &   , N_PT_PAIR, N_AMOUNT
     &   , I_BAND_FIRST, I_BAND_LAST
     &   , P, T, U_BASIC
     &   , N_PARTIAL_P
     &   )
      IF (IERR.NE.I_NORMAL) STOP
!
!     SELECT A TYPE OF WEIGHTING FOR THE CONTINUUM.
      CALL SELECT_WEIGHT_TRANS(IERR, I_WEIGHT
     &   , N_SOLAR_POINTS, SOLAR_WAVELENGTH, SOLAR_IRRAD)
!
!     CONVERT TO FLUX TRANSMITTANCES IF REQUIRED.
      WRITE(IU_USER, '(/A)')
     &   'CONVERT TO FLUX TRANSMITTANCES? (Y/N)'
2     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'
3        READ(IU_STDIN, *, IOSTAT=IOS) DIFFUSIVITY
         IF (IOS.NE.0) THEN
            IF (LOCK_CODE(.TRUE.)) THEN
               INCLUDE 'batch_error_main.finc'
            ELSE
               WRITE(IU_ERR, '(A)')
     &            '+++ UNRECOGNIZED RESPONSE: PLEASE REENTER.'
               GOTO 3
            ENDIF
         ENDIF
      ELSE IF ( (CHAR_YN.EQ.'N').OR.(CHAR_YN.EQ.'n') ) THEN
         TRANS_TYPE='PATH'
         DIFFUSIVITY=1.0D+00
      ELSE
         IF (LOCK_CODE(.TRUE.)) THEN
            INCLUDE 'batch_error_main.finc'
         ELSE
            WRITE(IU_ERR, '(A)')
     &         '+++ UNRECOGNISED RESPONSE: PLEASE RE-ENTER'
            GOTO 2
         ENDIF
      ENDIF
!
!     PREPARE THE OUTPUT FILES.
      CALL OPEN_TRANS_OUT(IERR, .TRUE., N_PER_TRANS_RECORD
     &   , IU_C_TRANSMISSION_SUMMARY, IU_C_TRANSMISSION)
!
!     THE CONTINUUM ARRAYS ARE STORED IN UNITS OF CM^3/MOLEC
!     MULTIPLIED BY 1.0D+20, SO A CONVERSION FACTOR TO M^3/MOL 
!     IS NEEDED.
      CONVERSION_FACTOR=1.0D-06*(N_AVOGADRO*1.0D-20)
!     CALCULATE THE SECOND DERIVATIVES FOR THE CONTINUUM ARRAYS:
!     TO PERFORM THE SPLINE FITS.
      DO I=1, N_TABLE_SELF_260
         WAVENUMBER_TABLE_SELF_260(I)=1.0D+02*(TABLE_START_SELF_260
     &      +(I-1)*DELTA_TABLE_SELF_260)
         C_H2O_SELF_260_SI(I)=CONVERSION_FACTOR*C_H2O_SELF_260(I)
      ENDDO
      CALL SPLINE_FIT(N_TABLE_SELF_260, WAVENUMBER_TABLE_SELF_260
     &   , C_H2O_SELF_260_SI, D2_C_H2O_SELF_260_SI, WORK
     &   )
      DO I=1, N_TABLE_SELF_296
         WAVENUMBER_TABLE_SELF_296(I)=1.0D+02*(TABLE_START_SELF_296
     &      +(I-1)*DELTA_TABLE_SELF_296)
         C_H2O_SELF_296_SI(I)=CONVERSION_FACTOR*C_H2O_SELF_296(I)
      ENDDO
      CALL SPLINE_FIT(N_TABLE_SELF_296, WAVENUMBER_TABLE_SELF_296
     &   , C_H2O_SELF_296_SI, D2_C_H2O_SELF_296_SI, WORK
     &   )
      DO I=1, N_TABLE_FRN
         WAVENUMBER_TABLE_FRN(I)=1.0D+02*(TABLE_START_FRN
     &      +(I-1)*DELTA_TABLE_FRN)
         C_H2O_FRN_SI(I)=CONVERSION_FACTOR*C_H2O_FRN(I)
      ENDDO
      CALL SPLINE_FIT(N_TABLE_FRN, WAVENUMBER_TABLE_FRN
     &   , C_H2O_FRN_SI, D2_C_H2O_FRN_SI, WORK
     &   )
!
!     INITIALIZE COUNTERS.
      I_FIRST_RECORD=1
      I_SET=0
!
      DO I_B=I_BAND_FIRST, I_BAND_LAST
!
         DO K=1, N_BAND_EXCLUDE(I_B)
            EXCLUDE_SHORTER(K)
     &         =1.0D+00/WAVE_LENGTH_LONG(INDEX_EXCLUDE(K, I_B))
            EXCLUDE_LONGER(K)
     &         =1.0D+00/WAVE_LENGTH_SHORT(INDEX_EXCLUDE(K, I_B))
         ENDDO
!
         IF (N_BAND_CONTINUUM(I_B).GT.0) THEN
            IF (L_ARCH) THEN
               CALL CONT_BAND_ARCH(IERR
     &            , L_CONVOL_FRN, TRANS_TYPE, I_WEIGHT, I_B
     &            , N_BAND_CONTINUUM(I_B), INDEX_CONTINUUM
     &            , WAVE_LENGTH_SHORT(I_B), WAVE_LENGTH_LONG(I_B)
     &            , N_BAND_EXCLUDE(I_B)
     &            , 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
     &            )
            ELSE
               CALL CONT_BAND_SIMPLE(IERR
     &            , TRANS_TYPE, I_WEIGHT, I_B
     &            , N_BAND_CONTINUUM(I_B), INDEX_CONTINUUM
     &            , WAVE_LENGTH_SHORT(I_B), WAVE_LENGTH_LONG(I_B)
     &            , N_BAND_EXCLUDE(I_B)
     &            , 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
     &            )
            ENDIF
         ENDIF
!
      ENDDO
!
!     CLOSE THE OUTPUT FILE.
      CLOSE(IU_TRANSMISSION)
!
!
      STOP
      END
