!+ Subroutins to construct an edited archive.
!
! Method:
!	The criteria for retaing an entry are selected and 
!	the retained entries are 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.
!
!- ---------------------------------------------------------------------
      SUBROUTINE CONSTRUCT_EDITED_ARCHIVE(IERR, N_PER_ARCH_RECORD_IN
     &   , IUNIT_IN, I_VERSION, N_ENTRY_IN
     &   , DATE_IN, DATABASE_IN, LBL_CODE_IN
     &   , LINESHAPE_IN, CUTOFF_IN, CONTINUUM_IN, LINE_COUPLE_IN
     &   , I_GAS_IN, P_IN, T_IN, AMOUNT_IN, PARTIAL_P_IN
     &   , FREQ_ENTRY_LOW_IN, FREQ_ENTRY_HIGH_IN
     &   , N_TRANS_RECORD_IN, I1_RECORD_IN, N_TRANS_IN
     &   , IUNIT_OUT
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/dimensions_arch.ucf'
      INCLUDE 'incl/error.pcf'
      INCLUDE 'incl/line_shape.pcf'
      INCLUDE 'incl/prec_machine.ucf'
      INCLUDE 'incl/precision.pcf'
!
!
!     DUMMY ARGUMENTS.
!
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
!
!     VARIABLES IN ARCHIVE TO BE EDITED:
!
      INTEGER	!, INTENT(IN)
     &     IUNIT_IN
!             UNIT NUMBER FOR INPUT
     &   , N_PER_ARCH_RECORD_IN
!             NUMBER OF GROUPS OF DATA IN ONE RECORD OF INPUT
     &   , I_VERSION
!             VERSION OF ARCHIVES
     &   , N_ENTRY_IN
!             NUMBER OF ENTRIES IN INPUT
     &   , LINESHAPE_IN(NPD_ARCH_ENTRY)
!             LINE SHAPES IN INPUT
     &   , I_GAS_IN(NPD_ARCH_ENTRY)
!             IDENTITIES OF GASES IN INPUT
     &   , N_TRANS_RECORD_IN(NPD_ARCH_ENTRY)
!             NUMBER OF RECORDS
     &   , I1_RECORD_IN(NPD_ARCH_ENTRY)
!             POINTERS TO 1ST RECORD OF ENTRY
     &   , N_TRANS_IN(NPD_ARCH_ENTRY)
!             NUMBER OF TRANSMISSIONS IN ENTRY
     &   , DATABASE_IN(NPD_ARCH_ENTRY)
!             DATABASES IN INPUT
     &   , LBL_CODE_IN(NPD_ARCH_ENTRY)
!             LBL CODES IN INPUT
!
      CHARACTER	!, INTENT(IN)
     &     DATE_IN(NPD_ARCH_ENTRY)*9
!             DATES IN INPUT
!
      LOGICAL	!, INTENT(IN)
     &     LINE_COUPLE_IN(NPD_ARCH_ENTRY)
!             LINE COUPLING IN INPUT
     &   , CONTINUUM_IN(NPD_ARCH_ENTRY)
!             CONTINUUM IN INPUT
!
      REAL*8	!, INTENT(IN)
     &     CUTOFF_IN(NPD_ARCH_ENTRY)
!             LINE CUTOFFS IN INPUT
     &   , P_IN(NPD_ARCH_ENTRY)
!             PRESSURES IN INPUT
     &   , T_IN(NPD_ARCH_ENTRY)
!             TEMPERATURES IN INPUT
     &   , AMOUNT_IN(NPD_ARCH_ENTRY)
!             AMOUNTS IN INPUT
     &   , PARTIAL_P_IN(NPD_ARCH_ENTRY)
!             PARTIAL PRESSURES IN INPUT
     &   , FREQ_ENTRY_LOW_IN(NPD_ARCH_ENTRY)
!             LOW FREQUENCY LIMITS OF ENTRIES IN INPUT
     &   , FREQ_ENTRY_HIGH_IN(NPD_ARCH_ENTRY)
!             HIGH FREQUENCY LIMITS OF ENTRIES IN INPUT
!
      INTEGER	!, INTENT(IN)
     &     IUNIT_OUT
!             UNIT NUMBER FOR OUPUT
!
!
!     LOCAL VARIABLES
!
      INTEGER
     &     N_PER_ARCH_RECORD_E
!             NUMBER OF GROUPS OF DATA IN ONE RECORD OF EDITED ARCHIVE
     &   , N_ENTRY_E
!             NUMBER OF ENTRIES IN EDITED ARCHIVE
     &   , LINESHAPE_E(NPD_ARCH_ENTRY)
!             LINE SHAPES IN EDITED ARCHIVE
     &   , DATABASE_E(NPD_ARCH_ENTRY)
!             DATABASES USEEDITED ARCHIVE
     &   , LBL_CODE_E(NPD_ARCH_ENTRY)
!             LBL CODES USEEDITED ARCHIVE
     &   , I_GAS_E(NPD_ARCH_ENTRY)
!             IDENTITIES OF GASES EDITED ARCHIVE
     &   , N_TRANS_RECORD_E(NPD_ARCH_ENTRY)
!             NUMBER OF RECORDS IN EDITED ARCHIVE
     &   , I1_RECORD_E(NPD_ARCH_ENTRY)
!             POINTERS TO FIRST RECORD OF ENTRY
     &   , N_TRANS_E(NPD_ARCH_ENTRY)
!             TRANSMISSIONS IN EDITED ARCHIVE
      CHARACTER
     &     DATE_E(NPD_ARCH_ENTRY)*9
!             DATES OF COMPOSITION OF ARCHIVES
      LOGICAL
     &     LINE_COUPLE_E(NPD_ARCH_ENTRY)
!             LINE COUPLING IN EDITED ARCHIVE
     &   , CONTINUUM_E(NPD_ARCH_ENTRY)
!             CONTINUUM IN EDITED ARCHIVE
      REAL*8
     &     CUTOFF_E(NPD_ARCH_ENTRY)
!             LINE CUTOFFS IN EDITED ARCHIVE
     &   , P_E(NPD_ARCH_ENTRY)
!             PRESSURES IN EDITED ARCHIVE
     &   , T_E(NPD_ARCH_ENTRY)
!             TEMPERATURES IN EDITED ARCHIVE
     &   , AMOUNT_E(NPD_ARCH_ENTRY)
!             AMOUNTS IN EDITED ARCHIVE
     &   , PARTIAL_P_E(NPD_ARCH_ENTRY)
!             PARTIAL PRESSURES IN EDITED ARCHIVE
     &   , FREQ_ENTRY_LOW_E(NPD_ARCH_ENTRY)
!             LOW FREQUENCY LIMITS OF ENTRIES
     &   , FREQ_ENTRY_HIGH_E(NPD_ARCH_ENTRY)
!             HIGH FREQUENCY LIMITS OF ENTRIES
     &   , FREQ_LOW_IN(NPD_FREQ_ENTRY)
!             LOW FREQUENCY LIMIT OF ENTRY IN INPUT ARCHIVE
     &   , FREQ_HIGH_IN(NPD_FREQ_ENTRY)
!             HIGH FREQUENCY LIMIT OF ENTRY IN INPUT ARCHIVE
     &   , TRANS_IN(NPD_FREQ_ENTRY)
!             TRANSMISSIONS IN INPUT ARCHIVE
     &   , FREQ_LOW_E(NPD_FREQ_ENTRY)
!             LOW FREQUENCY LIMIT OF EDITED ARCHIVE
     &   , FREQ_HIGH_E(NPD_FREQ_ENTRY)
!             HIGH FREQUENCY OF EDITED ARCHIVE
     &   , TRANS_E(NPD_FREQ_ENTRY)
!             TRANSMISSIONS IN EDITED ARCHIVE
     &   , FREQ_WINDOW_LOW
!             LOWER LIMIT OF WINDOW
     &   , FREQ_WINDOW_HIGH
!             UPPER LIMIT OF WINDOW
      INTEGER
     &     LAST_RECORD
!             LAST RECORD OF ARCHIVE YET WRITTEN
     &   , N_COMBINE
!             NUMBER OF INTERVALS TO COMBINE
     &   , N_LEFT
!             NUMBER OF INTERVALS LEFT
     &   , I_FIRST_RETAINED(NPD_ARCH_ENTRY)
!             FIRST INTERVAL INCLUDED
     &   , N_INTERVAL_RETAINED(NPD_ARCH_ENTRY)
!             NUMBER OF ORIGINAL INTERVALS KEPT
     &   , I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
     &   , J1
!             LOOP VARIABLE
     &   , I_E
!             LOOP VARIABLE
      LOGICAL
     &     L_INCLUDE(NPD_ARCH_ENTRY)
!             FLAG TO INCLUDE ENTRY
      REAL*8
     &     TRANS_TEMP
!             TEMPORARY TRANSMISSION
     &   , FREQ_TOP
!             TOP FREQUENCY REACHED
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     READ_ARCHIVE_ENTRY_0, WRITE_ARCHIVE_ENTRY_0
     &   , ARRANGE_ARCHIVE, WRITE_ARCHIVE_HEADER_0
!
!
!
!     DETERMINE WHICH PROPERTIES OF THE NEW ARCHIVE.
!     THE VERSION OF THE EDITED ARCHIVE IS THE SAME AS THE OLD ONE,
!     SO THE NUMBER OF ENTRIES PER RECORD IS THE SAME.
      N_PER_ARCH_RECORD_E=N_PER_ARCH_RECORD_IN
      WRITE(IU_USER, '(/A)')
     &   'ENTER RANGE OF FREQUENCIES TO RETAIN.'
      READ(IU_STDIN, *) FREQ_WINDOW_LOW, FREQ_WINDOW_HIGH
      WRITE(IU_USER, '(/A)')
     &   'ENTER NUMBER OF INTERVALS TO COMBINE.'
      READ(IU_STDIN, *) N_COMBINE
!
!     CHECK EACH ENTRY TO SEE WHETHER IT WILL BE REQUIRED 
!     IN THE NEW ARCHIVE.
      N_ENTRY_E=0
      DO I=1, N_ENTRY_IN
!        CHECK THE RANGE OF EACH ENTRY.
         IF ( (FREQ_ENTRY_HIGH_IN(I).GT.FREQ_WINDOW_LOW).AND.
     &        (FREQ_ENTRY_LOW_IN(I).LT.FREQ_WINDOW_HIGH) ) THEN
            L_INCLUDE(I)=.TRUE.
            N_ENTRY_E=N_ENTRY_E+1
         ELSE
            L_INCLUDE(I)=.FALSE.
         ENDIF
      ENDDO
      LAST_RECORD=4*N_ENTRY_E+1
!
      I_E=0
      DO I=1, N_ENTRY_IN
         IF (L_INCLUDE(I)) THEN
            I_E=I_E+1
            DATE_E(I_E)(1:9)=DATE_IN(I)(1:9)
            DATABASE_E(I_E)=DATABASE_IN(I)
            LBL_CODE_E(I_E)=LBL_CODE_IN(I)
            LINESHAPE_E(I_E)=LINESHAPE_IN(I)
            CUTOFF_E(I_E)=CUTOFF_IN(I)
            CONTINUUM_E(I_E)=CONTINUUM_IN(I)
            LINE_COUPLE_E(I_E)=LINE_COUPLE_IN(I)
            I_GAS_E(I_E)=I_GAS_IN(I)
            P_E(I_E)=P_IN(I)
            T_E(I_E)=T_IN(I)
            AMOUNT_E(I_E)=AMOUNT_IN(I)
            PARTIAL_P_E(I_E)=PARTIAL_P_IN(I)
!
!           DETERMINE THE NUMBER OF INTERVALS TO BE RETAINED.
            CALL READ_ARCHIVE_ENTRY_0(IUNIT_IN, N_TRANS_RECORD_IN(I)
     &         , I1_RECORD_IN(I), N_PER_ARCH_RECORD_IN, N_TRANS_IN(I)
     &         , FREQ_LOW_IN, FREQ_HIGH_IN, TRANS_IN
     &         )
            N_TRANS_E(I_E)=0
            DO J=1, N_TRANS_IN(I)
               IF ( (FREQ_LOW_IN(J).GE.FREQ_WINDOW_LOW
     &              *(1.0D+00-TOL_TEST)).AND.
     &              (FREQ_HIGH_IN(J).LE.FREQ_WINDOW_HIGH
     &              *(1.0D+00+TOL_TEST)) ) THEN
                  N_TRANS_E(I_E)=N_TRANS_E(I_E)+1
                  IF (N_TRANS_E(I_E).EQ.1) I_FIRST_RETAINED(I)=J
               ENDIF
            ENDDO
!           CALCULATE THE NUMBER OF COMBINED THE INTERVALS
            N_INTERVAL_RETAINED(I)=N_TRANS_E(I_E)
            N_TRANS_E(I_E)=N_TRANS_E(I_E)/N_COMBINE
            IF (N_TRANS_E(I_E)*N_COMBINE
     &            .LT.N_INTERVAL_RETAINED(I)) THEN
               N_TRANS_E(I_E)=N_TRANS_E(I_E)+1
            ENDIF
!           CHECK WHETHER NO INTERVALS HAVE CHOSEN: THIS IS AN ERROR.
            IF (N_TRANS_E(I_E).EQ.0) THEN
               WRITE(IU_ERR, '(/A, /A)')
     &            '*** ERROR: AN ENTRY IN THE ORIGINAL ARCHIVE HAS '
     &            //'BEEN KEPT BUT NO INTERVALS LIE'
     &            , 'ENTIRELY WITHIN THE RANGE OF FREQUENCIES CHOSEN.'
               IERR=I_ERR_FATAL
               RETURN
            ENDIF
!
            CALL ARRANGE_ARCHIVE(I1_RECORD_E(I_E), N_PER_ARCH_RECORD_E
     &         , LAST_RECORD, N_TRANS_E(I_E), N_TRANS_RECORD_E(I_E)
     &         )
         ENDIF
      ENDDO
!
!     PROCESS EACH ENTRY.
      I_E=0
      DO I=1, N_ENTRY_IN
         IF (L_INCLUDE(I)) THEN
            I_E=I_E+1
            CALL READ_ARCHIVE_ENTRY_0(IUNIT_IN, N_TRANS_RECORD_IN(I)
     &         , I1_RECORD_IN(I), N_PER_ARCH_RECORD_IN, N_TRANS_IN(I)
     &         , FREQ_LOW_IN, FREQ_HIGH_IN, TRANS_IN
     &         )
!
            J=0
            J1=0
            TRANS_TEMP=0.0D+00
            FREQ_TOP=0.0D+00
            DO K=I_FIRST_RETAINED(I)
     &         , I_FIRST_RETAINED(I)+N_INTERVAL_RETAINED(I)-1
               J1=J1+1
               TRANS_TEMP=TRANS_TEMP+TRANS_IN(K)
               FREQ_TOP=FREQ_HIGH_IN(K)
               IF (MOD(J1-1, N_COMBINE).EQ.0) THEN
                  J=J+1
                  FREQ_LOW_E(J)=FREQ_LOW_IN(K)
               ENDIF
               IF (MOD(J1, N_COMBINE).EQ.0) THEN
                  FREQ_HIGH_E(J)=FREQ_HIGH_IN(K)
                  TRANS_E(J)=TRANS_TEMP/DBLE(N_COMBINE)
                  TRANS_TEMP=0.0D+00
               ENDIF
            ENDDO
!           DEAL WITH ANYTHING LEFT OVER.
            N_LEFT=MOD(J1, N_COMBINE)
            IF (N_LEFT.NE.0) THEN
               TRANS_E(J)=TRANS_TEMP/DBLE(N_LEFT)
               FREQ_HIGH_E(J)=FREQ_TOP
            ENDIF
!
            FREQ_ENTRY_LOW_E(I_E)=FREQ_LOW_E(1)
            FREQ_ENTRY_HIGH_E(I_E)=FREQ_TOP
            CALL WRITE_ARCHIVE_ENTRY_0(IUNIT_OUT, N_TRANS_RECORD_E(I_E)
     &         , I1_RECORD_E(I_E), N_PER_ARCH_RECORD_E, N_TRANS_E(I_E)
     &         , FREQ_LOW_E, FREQ_HIGH_E, TRANS_E
     &         )
!
         ENDIF
      ENDDO
!
!     THE HEADER IS WRITTEN LAST SO THAT 
!     THE FREQUENCY LIMITS CAN BE SET.
      CALL WRITE_ARCHIVE_HEADER_0(IERR, IUNIT_OUT
     &   , N_ENTRY_E
     &   , DATE_E, DATABASE_E, LBL_CODE_E
     &   , LINESHAPE_E, CUTOFF_E, CONTINUUM_E, LINE_COUPLE_E
     &   , I_GAS_E, P_E, T_E, AMOUNT_E, PARTIAL_P_E
     &   , FREQ_ENTRY_LOW_E, FREQ_ENTRY_HIGH_E
     &   , N_TRANS_RECORD_E, I1_RECORD_E, N_TRANS_E
     &   )
!     FINALLY WRITE THE SUMMARY RECORD
      WRITE(IUNIT_OUT, REC=1) I_VERSION, N_ENTRY_E
!
!
!
      RETURN
      END
