!+ Subroutine to print a summary of an archive.
!
!
! Method:
!	The headers of an archive are read and the information
!	which they contain are written to a readable output 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 PRINT_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
     &   , N_ENTRY
!             NUMBER OF ENTRIES IN ARCHIVE
     &   , LINESHAPE(NPD_ARCH_ENTRY)
!             LINE SHAPES IN ARCHIVE
     &   , 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(NPD_ARCH_ENTRY)
!             NUMBER OF TRANSMISSIONS
     &   , DATABASE(NPD_ARCH_ENTRY)
!             DATABASES IN ARCHIVE
     &   , LBL_CODE(NPD_ARCH_ENTRY)
!             LBL CODES IN ARCHIVE
      CHARACTER
     &     DATE(NPD_ARCH_ENTRY)*9
!             DATES OF COMPOSITION OF ENTRIES
      LOGICAL
     &     LINE_COUPLE(NPD_ARCH_ENTRY)
!             LINE COUPLING IN ARCHIVE
     &   , CONTINUUM(NPD_ARCH_ENTRY)
!             CONTINUUM IN ARCHIVE
      REAL*8
     &     CUTOFF(NPD_ARCH_ENTRY)
!             LINE CUTOFFS IN ARCHIVE
     &   , P(NPD_ARCH_ENTRY)
!             PRESSURES IN ARCHIVE
     &   , T(NPD_ARCH_ENTRY)
!             TEMPERATURES IN ARCHIVE
     &   , AMOUNT(NPD_ARCH_ENTRY)
!             AMOUNTS IN ARCHIVE
     &   , PARTIAL_P(NPD_ARCH_ENTRY)
!             PARTIAL PRESSURES IN 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)
!             FREQUENCY INCREMENTS OF ENTRIES
      INTEGER
     &     IERR
!             ERROR FLAG
      INTEGER
     &     I
!             LOOP VARIABLE
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     OPEN_FILE_OUT, OPEN_ARCHIVE_IN 
     &   , READ_ARCHIVE_HEADER_0, READ_ARCHIVE_HEADER_1
!
!
      DATA IERR/I_NORMAL/
!
!
!
!     OPEN THE FILE CONTAINING THE HEADING INFORMATION FROM THE ARCHIVE.
      CALL OPEN_FILE_OUT(IERR, IU_ARCHIVE_OUT
     &   , 'ENTER THE NAME OF THE SUMMARY 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
     &      )
      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
     &      )
      ENDIF
!
!
      WRITE(IU_ARCHIVE_OUT, '(/T20, A)')
     &   'SUMMARY OF CONTENTS OF ARCHIVE'
      WRITE(IU_ARCHIVE_OUT, '(//A, I5)')
     &   'VERSION OF ARCHIVE =', I_VERSION
      DO I=1, N_ENTRY
         WRITE(IU_ARCHIVE_OUT, '(//A, T55, I5, /)')
     &      'NUMBER OF ENTRY', I
         WRITE(IU_ARCHIVE_OUT, '(I5, T10, A, T55, A9)')
     &      I, 'DATE OF ENTRY', DATE(I)
         WRITE(IU_ARCHIVE_OUT, '(I5, T10, A, T55, I5)')
     &      I, 'INDEX OF DATABASE USED', DATABASE(I)
         WRITE(IU_ARCHIVE_OUT, '(I5, T10, A, T55, I5)')
     &      I, 'INDEX OF LBL CODE USED', LBL_CODE(I)
         WRITE(IU_ARCHIVE_OUT, '(I5, T10, A, T55, I5)')
     &      I, 'LINESHAPE', LINESHAPE(I)
         WRITE(IU_ARCHIVE_OUT, '(I5, T10, A, T55, 1PE12.5)')
     &      I, 'CUTOFF ', CUTOFF(I)
         WRITE(IU_ARCHIVE_OUT, '(I5, T10, A, T55, L7)')
     &      I, 'CONTINUUM INCLUDED', CONTINUUM(I)
         WRITE(IU_ARCHIVE_OUT, '(I5, T10, A, T55, L7)')
     &      I, 'LINE COUPLING INCLUDED ', LINE_COUPLE(I)
         WRITE(IU_ARCHIVE_OUT, '(I5, T10, A, T55, I5)')
     &      I, 'TYPE OF GAS CONSIDERED', I_GAS(I)
         WRITE(IU_ARCHIVE_OUT, '(I5, T10, A, T55, 1PE12.5)')
     &      I, 'PRESSURE OF CALCULATION', P(I)
         WRITE(IU_ARCHIVE_OUT, '(I5, T10, A, T55, 1PE12.5)')
     &      I, 'TEMPERATURE OF CALCULATION', T(I)
         WRITE(IU_ARCHIVE_OUT, '(I5, T10, A, T55, 1PE12.5)')
     &      I, 'AMOUNT OF ABSORBER', AMOUNT(I)
         WRITE(IU_ARCHIVE_OUT, '(I5, T10, A, T55, 1PE12.5)')
     &      I, 'PARTIAL PRESSURE OF CALCULATION', PARTIAL_P(I)
         WRITE(IU_ARCHIVE_OUT, '(I5, T10, A, T55, 1PE12.5)')
     &      I, 'LOW FREQUENCY OF ENTRY', FREQ_ENTRY_LOW(I)
         WRITE(IU_ARCHIVE_OUT, '(I5, T10, A, T55, 1PE12.5)')
     &      I, 'HIGH FREQUENCY OF ENTRY', FREQ_ENTRY_HIGH(I)
         WRITE(IU_ARCHIVE_OUT, '(I5, T10, A, T55, I5)')
     &      I, 'NUMBER OF TRANSMISSIONS', N_TRANS(I)
         IF (I_VERSION.EQ.1) THEN
            WRITE(IU_ARCHIVE_OUT, '(I5, T10, A, T55, 1PE12.5)')
     &         I, 'INCREMENT IN FREQUENCY', D_FREQ(I)
         ENDIF
      ENDDO
!
!
      STOP
      END
