!+ Program to print an entry in an archive.
!
! Method:
!	In transmissions in a selected entry in a given archive
!	are printed along with the corresponding frequencies 
!	in two columns for plotting.
!
! 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 COLUMN_ARCHIVE
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_arch_io.icf'
      INCLUDE 'incl/dimensions_arch.ucf'
      INCLUDE 'incl/arch_record_size.pcf'
      INCLUDE 'incl/error.pcf'
!
!     DECLARATION OF VARIABLES.
      INTEGER
     &     I_VERSION
!             VERSION OF ARCHIVE IN USE
     &   , 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 REC. OF EACH ENTRY
     &   , N_TRANS(NPD_ARCH_ENTRY)
!             NUMBER OF TRANSMISSIONS
     &   , DATABASE(NPD_ARCH_ENTRY)
!             DATABASES IN FIRST ARCHIVE
     &   , LBL_CODE(NPD_ARCH_ENTRY)
!             LBL CODES IN FIRST ARCHIVE
      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(NPD_ARCH_ENTRY)
!             PRESSURES IN FIRST ARCHIVE
     &   , T(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(NPD_ARCH_ENTRY)
!             INCREMENT IN FREQUENCY
      REAL*8
     &     FREQ_LOW(NPD_FREQ_ENTRY)
!             LOW FREQUENCY OF ENTRY
     &   , FREQ_HIGH(NPD_FREQ_ENTRY)
!             HIGH FREQUENCY OF ENTRY
     &   , TRANS(NPD_FREQ_ENTRY)
!             TRANSMISSIONS
     &   , FREQ_TEMP
!             TEMPORARY FREQUENCY VARIABLE
      INTEGER
     &     IERR
!             ERROR FLAG
     &   , N_PER_ARCH_RECORD
!             NUMBER IN ONE RECORD
      INTEGER
     &     I
!             LOOP VARIABLE
     &   , I_ENTRY
!             NUMBER OF ENTRY
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     OPEN_FILE_OUT, OPEN_ARCHIVE_IN
     &   , READ_ARCHIVE_HEADER_0, READ_ARCHIVE_HEADER_1
     &   , READ_ARCHIVE_ENTRY_0, READ_ARCHIVE_ENTRY_1
!
!
      DATA IERR/I_NORMAL/
!
!
!
!     OPEN THE FILE TO CONTAIN THE CONTENTS OF AN ENTRY.
      CALL OPEN_FILE_OUT(IERR, IU_ARCHIVE_OUT
     &   , 'ENTER THE NAME OF THE COLUMN OUTPUT FILE')
      IF (IERR.NE.I_NORMAL) STOP
!
!     OPEN AND READ IN THE HEADERS FOR THE ARCHIVE.
      CALL OPEN_ARCHIVE_IN(IERR, IU_ARCHIVE_IN, NP_BYTES_PER_RECORD
     &   , 'ENTER THE NAME OF THE ARCHIVE.'
     &    , 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, T, AMOUNT, PARTIAL_P
     &      , FREQ_ENTRY_LOW, FREQ_ENTRY_HIGH
     &      , N_TRANS_RECORD, I1_RECORD, N_TRANS
     &      )
         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, T, AMOUNT, PARTIAL_P
     &      , FREQ_ENTRY_LOW, FREQ_ENTRY_HIGH
     &      , N_TRANS_RECORD, I1_RECORD, N_TRANS, D_FREQ
     &      )
         N_PER_ARCH_RECORD=NP_BYTES_PER_RECORD/4
      ENDIF
!
      WRITE(IU_USER, '(/A)') 'ENTER THE NUMBER OF THE ENTRY TO PRINT.'
1     READ(IU_STDIN, *) I_ENTRY
      IF (I_ENTRY.GT.N_ENTRY) THEN
         WRITE(IU_ERR, '(A)')
     &      '+++ THERE ARE NOT THAT MANY ENTRIES IN THE ARCHIVE.'
         WRITE(IU_ERR, '(A)') 'PLEASE RE-ENTER'
         GOTO 1
      ELSE IF (I_ENTRY.LE.0) THEN
         WRITE(IU_ERR, '(A)')
     &      '+++ NON-POSITIVE NUMBERS DO NOT INDEX ENTRIES IN '
     &      //'THE ARCHIVE.'
         WRITE(IU_ERR, '(A)') 'PLEASE RE-ENTER'
         GOTO 1
      ENDIF
!
      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(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(I_ENTRY)
     &      , FREQ_ENTRY_LOW(I_ENTRY), D_FREQ(I_ENTRY)
     &      , FREQ_LOW, FREQ_HIGH, TRANS
     &      )
      ENDIF
      DO I=1, N_TRANS(I_ENTRY)
         FREQ_TEMP=0.5D+00*(FREQ_LOW(I)+FREQ_HIGH(I))
         WRITE(IU_ARCHIVE_OUT, '(2(3X, 1PE12.5))')
     &      FREQ_TEMP, TRANS(I)
      ENDDO
!
!
!
      STOP
      END
