!+ Program to merge two archives of line-by-line data.
!
! Method:
!	The archives are opened, the headers are read and the method
!	of merging is selected. An appropriate subroutine is called
!	to perform the merging.
!
! 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 MERGE_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.
!
      LOGICAL
     &     LOCK_CODE
!             LOGICAL TO FORBID INTERACTIVE LOOPING
      EXTERNAL
     &     LOCK_CODE
!
!
!     ELEMENTS OF FIRST ARCHIVE.
      INTEGER
     &     I_VERSION_1
!             VERSION OF FIRST ARCHIVE
     &   , N_ENTRY_1
!             NUMBER OF ENTRIES IN FIRST ARCHIVE
     &   , LINESHAPE_1(NPD_ARCH_ENTRY)
!             LINE SHAPES IN FIRST ARCHIVE
     &   , I_GAS_1(NPD_ARCH_ENTRY)
!             IDENTITIES OF GASES IN FIRST ARCHIVE
     &   , N_TRANS_RECORD_1(NPD_ARCH_ENTRY)
!             NUMBER OF RECORDS IN ENTRIES
     &   , I1_RECORD_1(NPD_ARCH_ENTRY)
!             POINTERS TO FIRST RECORD OF EACH ENTRY
     &   , N_TRANS_1(NPD_ARCH_ENTRY)
!             NUMBER OF TRANSMISSIONS
     &   , DATABASE_1(NPD_ARCH_ENTRY)
!             DATABASES IN FIRST ARCHIVE
     &   , LBL_CODE_1(NPD_ARCH_ENTRY)
!             LBL CODES IN FIRST ARCHIVE
      CHARACTER
     &     DATE_1(NPD_ARCH_ENTRY)*9
!             DATES OF COMPOSITION OF ENTRIES
      LOGICAL
     &     LINE_COUPLE_1(NPD_ARCH_ENTRY)
!             LINE COUPLING IN 1ST ARCHIVE
     &   , CONTINUUM_1(NPD_ARCH_ENTRY)
!             CONTINUUM IN 1ST ARCHIVE
      REAL*8
     &     CUTOFF_1(NPD_ARCH_ENTRY)
!             LINE CUTOFFS IN FIRST ARCHIVE
     &   , P_1(NPD_ARCH_ENTRY)
!             PRESSURES IN FIRST ARCHIVE
     &   , T_1(NPD_ARCH_ENTRY)
!             TEMPERATURES IN FIRST ARCHIVE
     &   , AMOUNT_1(NPD_ARCH_ENTRY)
!             AMOUNTS IN FIRST ARCHIVE
     &   , PARTIAL_P_1(NPD_ARCH_ENTRY)
!             PARTIAL PRESSURES IN FIRST ARCHIVE
     &   , FREQ_ENTRY_LOW_1(NPD_ARCH_ENTRY)
!             LOW FREQUENCY LIMITS OF ENTRIES
     &   , FREQ_ENTRY_HIGH_1(NPD_ARCH_ENTRY)
!             HIGH FREQUENCY LIMITS OF ENTRIES
!
!     ELEMENTS OF SECOND ARCHIVE
      REAL*8
     &     I_VERSION_2
!             VERSION OF SECOND ARCHIVE
     &   , N_ENTRY_2
!             NUMBER OF ENTRIES IN SECOND ARCHIVE
     &   , LINESHAPE_2(NPD_ARCH_ENTRY)
!             LINE SHAPES IN SECOND ARCHIVE
     &   , I_GAS_2(NPD_ARCH_ENTRY)
!             IDENTITIES OF GASES IN SECOND ARCHIVE
     &   , N_TRANS_RECORD_2(NPD_ARCH_ENTRY)
!             NUMBER OF RECORDS IN ENTRIES
     &   , I1_RECORD_2(NPD_ARCH_ENTRY)
!             POINTERS TO FIRST RECORD OF EACH ENTRY
     &   , N_TRANS_2(NPD_ARCH_ENTRY)
!             NUMBER OF TRANSMISSIONS
     &   , DATABASE_2(NPD_ARCH_ENTRY)
!             DATABASES IN SECOND ARCHIVE
     &   , LBL_CODE_2(NPD_ARCH_ENTRY)
!             LBL CODES IN SECOND ARCHIVE
      CHARACTER
     &     DATE_2(NPD_ARCH_ENTRY)*9
!             DATES OF COMPOSITION OF ENTRIES
      LOGICAL
     &     LINE_COUPLE_2(NPD_ARCH_ENTRY)
!             LINE COUPLING IN 2ND ARCHIVE
     &   , CONTINUUM_2(NPD_ARCH_ENTRY)
!             CONTINUUM IN 2ND ARCHIVE
      REAL*8
     &     CUTOFF_2(NPD_ARCH_ENTRY)
!             LINE CUTOFFS IN 2ND ARCHIVE
     &   , P_2(NPD_ARCH_ENTRY)
!             PRESSURES IN 2ND ARCHIVE
     &   , T_2(NPD_ARCH_ENTRY)
!             TEMPERATURES IN 2ND ARCHIVE
     &   , AMOUNT_2(NPD_ARCH_ENTRY)
!             AMOUNTS IN 2ND ARCHIVE
     &   , PARTIAL_P_2(NPD_ARCH_ENTRY)
!             PARTIAL PRESSURES IN 2ND ARCHIVE
     &   , FREQ_ENTRY_LOW_2(NPD_ARCH_ENTRY)
!             LOW FREQUENCY LIMITS OF ENTRIES
     &   , FREQ_ENTRY_HIGH_2(NPD_ARCH_ENTRY)
!             HIGH FREQUENCY LIMITS OF ENTRIES
!
!
      INTEGER
     &     IERR
!             ERROR FLAG
     &   , IUNIT_1
!             UNIT FOR 1ST ARCHIVE
     &   , IUNIT_2
!             UNIT FOR 2ND ARCHIVE
      LOGICAL
     &     L_OPEN
!             LOGICAL FOR OPEN UNIT
      CHARACTER
     &     CHAR_IF*1
!             CHARACTER RESPONSE VARIABLE
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     OPEN_ARCHIVE_OUT, OPEN_ARCHIVE_IN, READ_ARCHIVE_HEADER_0
     &   , CONCAT_ARCH, JOIN_ARCH
!
!
      DATA IERR/I_NORMAL/
!
!
!
!     OPEN THE OUTPUT ARCHIVE TO BE FORMED.
      CALL OPEN_ARCHIVE_OUT(IERR, IU_ARCHIVE_OUT, NP_BYTES_PER_RECORD
     &   , 'ENTER THE NAME OF THE MERGED ARCHIVE TO FORM'
     &   )
      IF (IERR.NE.I_NORMAL) STOP
!
!     OPEN AND READ IN THE HEADERS FOR THE FIRST ARCHIVE.
      CALL OPEN_ARCHIVE_IN(IERR, IU_ARCHIVE_IN, NP_BYTES_PER_RECORD
     &   , 'ENTER THE NAME OF THE FIRST ARCHIVE.'
     &   , I_VERSION_1, N_ENTRY_1)
      IF (IERR.NE.I_NORMAL) STOP
      IF (I_VERSION_1.NE.0) THEN
         WRITE(IU_ERR, '(/A)')
     &      '*** ERROR: ONLY ARCHIVES OF VERSION 0 CAN BE MERGED.'
         IERR=I_ERR_FATAL
         STOP
      ENDIF
!
      IUNIT_1=IU_ARCHIVE_IN
      CALL READ_ARCHIVE_HEADER_0(IERR, IUNIT_1
     &   , N_ENTRY_1
     &   , DATE_1, DATABASE_1, LBL_CODE_1
     &   , LINESHAPE_1, CUTOFF_1, CONTINUUM_1, LINE_COUPLE_1
     &   , I_GAS_1, P_1, T_1, AMOUNT_1, PARTIAL_P_1
     &   , FREQ_ENTRY_LOW_1, FREQ_ENTRY_HIGH_1
     &   , N_TRANS_RECORD_1, I1_RECORD_1, N_TRANS_1
     &   )
!
!     FIND THE NEXT FREE UNIT TO READ THE HEADERS 
!     FOR THE SECOND ARCHIVE.
      IUNIT_2=IUNIT_1
1     IUNIT_2=IUNIT_2+1
      INQUIRE(UNIT=IUNIT_2, OPENED=L_OPEN)
      IF (L_OPEN) THEN
         IF (IUNIT_2.LT.99) THEN
            GOTO 1
         ELSE
            WRITE(IU_ERR, '(/A)')
     &         '*** ERROR: NO FREE UNIT NUMBER IS AVAILABLE '
     &         //'TO READ THE SECOND ARCHIVE.'
            IERR=I_ERR_FATAL
            STOP
         ENDIF
      ENDIF
!
      CALL OPEN_ARCHIVE_IN(IERR, IUNIT_2, NP_BYTES_PER_RECORD
     &   , 'ENTER THE NAME OF THE SECOND ARCHIVE.'
     &   , I_VERSION_2, N_ENTRY_2)
      IF (IERR.NE.I_NORMAL) STOP
      IF (I_VERSION_2.NE.0) THEN
         WRITE(IU_ERR, '(/A)')
     &      '*** ERROR: ONLY ARCHIVES OF VERSION 0 CAN BE MERGED.'
         IERR=I_ERR_FATAL
         STOP
      ENDIF
!
      CALL READ_ARCHIVE_HEADER_0(IERR, IUNIT_2
     &   , N_ENTRY_2
     &   , DATE_2, DATABASE_2, LBL_CODE_2
     &   , LINESHAPE_2, CUTOFF_2, CONTINUUM_2, LINE_COUPLE_2
     &   , I_GAS_2, P_2, T_2, AMOUNT_2, PARTIAL_P_2
     &   , FREQ_ENTRY_LOW_2, FREQ_ENTRY_HIGH_2
     &   , N_TRANS_RECORD_2, I1_RECORD_2, N_TRANS_2
     &   )
!
!     ESTABLISH THE CONDITIONS FOR MERGING.
      WRITE(IU_USER, '(/A)')
     &   'DO YOU WISH TO MERGE INDIVIDUAL ARCHIVES, '
     &   //'OR MERELY COMBINE THE FILES? (I/F)'
2     READ(IU_STDIN, '(A)') CHAR_IF
      IF ( (CHAR_IF.EQ.'F').OR.(CHAR_IF.EQ.'f') ) THEN
         CALL CONCAT_ARCH(IERR, IU_ARCHIVE_OUT
     &      , IUNIT_1, N_ENTRY_1
     &      , DATE_1, DATABASE_1, LBL_CODE_1
     &      , LINESHAPE_1, CUTOFF_1, CONTINUUM_1, LINE_COUPLE_1
     &      , I_GAS_1, P_1, T_1, AMOUNT_1, PARTIAL_P_1
     &      , FREQ_ENTRY_LOW_1, FREQ_ENTRY_HIGH_1
     &      , N_TRANS_RECORD_1, I1_RECORD_1, N_TRANS_1
     &      , IUNIT_2, N_ENTRY_2
     &      , DATE_2, DATABASE_2, LBL_CODE_2
     &      , LINESHAPE_2, CUTOFF_2, CONTINUUM_2, LINE_COUPLE_2
     &      , I_GAS_2, P_2, T_2, AMOUNT_2, PARTIAL_P_2
     &      , FREQ_ENTRY_LOW_2, FREQ_ENTRY_HIGH_2
     &      , N_TRANS_RECORD_2, I1_RECORD_2, N_TRANS_2
     &      )
      ELSE IF ( (CHAR_IF.EQ.'I').OR.(CHAR_IF.EQ.'i') ) THEN
         CALL JOIN_ARCH(IERR, IU_ARCHIVE_OUT
     &      , IUNIT_1, N_ENTRY_1
     &      , DATE_1, DATABASE_1, LBL_CODE_1
     &      , LINESHAPE_1, CUTOFF_1, CONTINUUM_1, LINE_COUPLE_1
     &      , I_GAS_1, P_1, T_1, AMOUNT_1, PARTIAL_P_1
     &      , FREQ_ENTRY_LOW_1, FREQ_ENTRY_HIGH_1
     &      , N_TRANS_RECORD_1, I1_RECORD_1, N_TRANS_1
     &      , IUNIT_2, N_ENTRY_2
     &      , DATE_2, DATABASE_2, LBL_CODE_2
     &      , LINESHAPE_2, CUTOFF_2, CONTINUUM_2, LINE_COUPLE_2
     &      , I_GAS_2, P_2, T_2, AMOUNT_2, PARTIAL_P_2
     &      , FREQ_ENTRY_LOW_2, FREQ_ENTRY_HIGH_2
     &      , N_TRANS_RECORD_2, I1_RECORD_2, N_TRANS_2
     &      )
      ELSE
         IF (LOCK_CODE(.TRUE.)) THEN
            INCLUDE 'batch_error_main.finc'
         ELSE
            WRITE(IU_ERR, '(/A)')
     &         '+++ UNRECOGNIZED RESPONSE: PLEASE RETYPE.'
            GOTO 2
         ENDIF
      ENDIF
!
!
      STOP
      END
