!+ Program to covert archives of type 0 to type 1.
!
! Method:
!	An archive of type 0 is read and its entries are checked.
!	If it is possible, an archive of type 1 is generated.
!
! 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 CONVERT_ARCHIVE_01
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_arch_io.icf'
      INCLUDE 'incl/dimensions_arch.ucf'
      INCLUDE 'incl/prec_machine.ucf'
      INCLUDE 'incl/precision.pcf'
      INCLUDE 'incl/arch_record_size.pcf'
      INCLUDE 'incl/error.pcf'
!
!
!     DECLARATION OF VARIABLES.
!
      INTEGER
     &     IERR
!             ERROR FLAG
!
      INTEGER
     &     I_VERSION_1
!             VERSION OF FINAL ARCHIVE
!
      INTEGER
     &     I_VERSION
!             VERSION OF INITIAL ARCHIVE
     &   , N_ENTRY
!             NUMBER OF ENTRIES IN INITIAL ARCHIVE
     &   , LINESHAPE(NPD_ARCH_ENTRY)
!             LINE SHAPES IN INITIAL ARCHIVE
     &   , I_GAS(NPD_ARCH_ENTRY)
!             IDENTITIES OF GASES IN INITIAL ARCHIVE
     &   , N_TRANS_RECORD_0(NPD_ARCH_ENTRY)
!             NUMBER OF RECORDS IN ENTRIES IN INITIAL ARCHIVE
     &   , I1_RECORD_0(NPD_ARCH_ENTRY)
!             POINTERS TO FIRST RECORD OF EACH ENTRY IN INITIAL ARCHIVE
     &   , N_TRANS_RECORD_1(NPD_ARCH_ENTRY)
!             NUMBER OF RECORDS IN ENTRIES IN FINAL ARCHIVE
     &   , I1_RECORD_1(NPD_ARCH_ENTRY)
!             POINTERS TO FIRST RECORD OF EACH ENTRY IN FINAL ARCHIVE
     &   , N_TRANS(NPD_ARCH_ENTRY)
!             NUMBER OF TRANSMISSIONS IN EACH ENTRY
     &   , DATABASE(NPD_ARCH_ENTRY)
!             DATABASES IN INITIAL ARCHIVE
     &   , LBL_CODE(NPD_ARCH_ENTRY)
!             LBL CODES IN INITIAL ARCHIVE
!
      CHARACTER
     &     DATE(NPD_ARCH_ENTRY)*9
!             DATES OF COMPOSITION OF ENTRIES
!
      LOGICAL
     &     LINE_COUPLE(NPD_ARCH_ENTRY)
!             LINE COUPLING IN INITIAL ARCHIVE
     &   , CONTINUUM(NPD_ARCH_ENTRY)
!             CONTINUUM IN INITIAL ARCHIVE
!
      REAL*8
     &     CUTOFF(NPD_ARCH_ENTRY)
!             LINE CUTOFFS IN INITIAL ARCHIVE
     &   , P(NPD_ARCH_ENTRY)
!             PRESSURES IN INITIAL ARCHIVE
     &   , T(NPD_ARCH_ENTRY)
!             TEMPERATURES IN INITIAL ARCHIVE
     &   , AMOUNT(NPD_ARCH_ENTRY)
!             AMOUNTS IN INITIAL ARCHIVE
     &   , PARTIAL_P(NPD_ARCH_ENTRY)
!             PARTIAL PRESSURES IN INITIAL 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)
!             INTERVAL OF FREQUENCIES COVERED BY TRANSMISSIONS
      REAL*8
     &     FREQ_LOW(NPD_FREQ_ENTRY)
!             LOWER LIMITS OF INTERVALS
     &   , FREQ_HIGH(NPD_FREQ_ENTRY)
!             UPPPER LIMITS OF INTERVALS
     &   , TRANS(NPD_FREQ_ENTRY)
!             UPPPER LIMITS OF INTERVALS
!
      INTEGER
     &     N_PER_ARCH_RECORD_0
!             NUMBER OF GROUPS OF DATA IN ONE RECORD OF INITIAL ARCHIVE
     &   , N_PER_ARCH_RECORD_1
!             NUMBER OF GROUPS OF DATA IN ONE RECORD OF FINAL ARCHIVE
     &   , LAST_RECORD
!             LAST RECORD OF ARCHIVE
     &   , I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     OPEN_ARCHIVE_IN, OPEN_ARCHIVE_OUT, ARRANGE_ARCHIVE
     &   , READ_ARCHIVE_HEADER_0, READ_ARCHIVE_ENTRY_0
     &   , WRITE_ARCHIVE_HEADER_1, WRITE_ARCHIVE_ENTRY_1
!
!
      DATA
     &     IERR/I_NORMAL/
     &   , I_VERSION_1/1/
!
!
!
!
!     OPEN AND READ IN THE HEADERS FOR THE ORIGINAL ARCHIVE.
      CALL OPEN_ARCHIVE_IN(IERR, IU_ARCHIVE_IN, NP_BYTES_PER_RECORD
     &   , 'ENTER THE NAME OF THE ARCHIVE TO CONVERT.'
     &   , 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_0, I1_RECORD_0, N_TRANS
     &      )
         N_PER_ARCH_RECORD_0=NP_BYTES_PER_RECORD/24
      ELSE IF (I_VERSION.EQ.1) THEN
         WRITE(IU_ERR, '(/A)')
     &      '*** ERROR: THIS ARCHIVE IS ALREADY OF VERSION 1.'
         IERR=I_ERR_FATAL
         STOP
      ENDIF
      IF (IERR.NE.I_NORMAL) STOP
!
!     OPEN THE OUTPUT ARCHIVE TO BE FORMED.
      CALL OPEN_ARCHIVE_OUT(IERR, IU_ARCHIVE_OUT, NP_BYTES_PER_RECORD
     &   , 'ENTER THE NAME OF THE CONVERTED ARCHIVE TO FORM')
      IF (IERR.NE.I_NORMAL) STOP
      N_PER_ARCH_RECORD_1=NP_BYTES_PER_RECORD/4
!
!     WRITE THE CONVERTED ENTRIES FIRST. SINCE THE HEADER IS WRITTEN
!     LAST, IF CONVERSION FAILS FOR ONE ENTRY NO HEADER WILL BE
!     WRITTEN AND THE RESULTING ERRONEOUS ARCHIVE WILL BE
!     SAFELY UNREADABLE.
!
!     SET THE BEGINNING OF THE REGION OF DATA.
      LAST_RECORD=N_ENTRY+1
      DO I=1, N_ENTRY
         CALL READ_ARCHIVE_ENTRY_0(IU_ARCHIVE_IN, N_TRANS_RECORD_0(I)
     &      , I1_RECORD_0(I), N_PER_ARCH_RECORD_0, N_TRANS(I)
     &      , FREQ_LOW, FREQ_HIGH, TRANS
     &      )
!        TEST THE WIDTHS OF THE INTERVALS.
         D_FREQ(I)=FREQ_HIGH(1)-FREQ_LOW(1)
         DO J=2, N_TRANS(I)
            IF ( ( (FREQ_HIGH(J)-FREQ_LOW(J)).LT.
     &             (1.0D+00-TOL_TEST)*D_FREQ(I) ).OR.
     &           ( (FREQ_HIGH(J)-FREQ_LOW(J)).GT.
     &             (1.0D+00+TOL_TEST)*D_FREQ(I) ) ) THEN
               WRITE(IU_ERR, '(/A, /A, /A, I5)')
     &            '*** ERROR: INTERVALS ARE NOT OF CONSTANT WIDTH.'
     &            , 'CONVERSION IS NOT POSSIBLE.'
     &            , 'ENTRY = ', I
               IERR=I_ERR_FATAL
               STOP
            ENDIF
         ENDDO
!
!        CALCULATE THE POINTER IN THE FILE.
         CALL ARRANGE_ARCHIVE(I1_RECORD_1(I), N_PER_ARCH_RECORD_1
     &      , LAST_RECORD, N_TRANS(I), N_TRANS_RECORD_1(I)
     &      )
!
         CALL WRITE_ARCHIVE_ENTRY_1(IU_ARCHIVE_OUT
     &      , N_TRANS_RECORD_1(I), I1_RECORD_1(I), N_PER_ARCH_RECORD_1
     &      , N_TRANS(I), TRANS
     &      )
!
      ENDDO
!
!     NOW WRITE THE HEADERS.
      CALL WRITE_ARCHIVE_HEADER_1(IERR, IU_ARCHIVE_OUT
     &   , 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_1, I1_RECORD_1, N_TRANS, D_FREQ
     &   )
!
!     THE FILE IS COMPLETED BY WRITING THE INITIAL RECORD.
      WRITE(IU_ARCHIVE_OUT, REC=1) I_VERSION_1, N_ENTRY
      CLOSE(IU_ARCHIVE_OUT)
      CLOSE(IU_ARCHIVE_IN)
!
!
!
      STOP
      END
