!+ Subroutine to remove weakly absorbing comntinua from bands.
!
! Method:
!       A tolerance for negelecting continuum absorption is obtained.
!       A typical amount of each continuum in a column is given: for
!	the self-broadened continuum this must be multiplied by a
!	broadening density. For each band a test is made to see 
!	whether this amount of continuum absorber gives a transmission 
!	close to 1 as defined by the tolerance. If so, the continuum is
!	removed from this spectral band.
!
! 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 REMOVE_WEAK_CONT(IERR, N_BAND
     &   , N_BAND_CONTINUUM, INDEX_CONTINUUM, K_CONTINUUM
     &   )
!
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/continuum.pcf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
      INTEGER	!, INTENT(INOUT)
     &     N_BAND_CONTINUUM(NPD_BAND)
!             NUMBER OF CONTINUA IN BANDS
     &   , INDEX_CONTINUUM(NPD_BAND, NPD_SPECIES)
!             LIST OF ACTIVE CONTINUA
      REAL*8	!, INTENT(IN)
     &     K_CONTINUUM(NPD_BAND, NPD_CONTINUUM)
!             CONTINUUM EXTINCTION COEFFICIENTS
!
!     LOCAL ARGUMENTS.
!
      LOGICAL
     &     LOCK_CODE
!             LOGICAL TO FORBID INTERACTIVE LOOPING
      EXTERNAL
     &     LOCK_CODE
!
      INTEGER
     &     I_CONTINUUM
!             INDEX NUMBER OF CONTINUUM
     &   , I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
     &   , N_BAND_CONTINUUM_TEMP
!             TEMPORARY NUMBER OF CONTINUA
     &   , IOS
!             I/O ERROR FLAG
      LOGICAL
     &     L_SET_CONTINUUM
!             FLAG FOR SETTING AMOUNTS
      REAL*8
     &     COLUMN(NPD_CONTINUUM)
!             COLUMN AMOUNTS FOR CONTINUA
     &   , TRANS_NEGLECT
!             TRANSMISSION FOR NEGLECTING
     &   , TRANS_COLUMN
!             TRANSMISSION OF COLUMN
!
!
!     OBTAIN COLUMN AMOUNTS OF CONTINUA.
!     SELF-BROADENED CONTINUUM OF WATER VAPOUR.
      L_SET_CONTINUUM=.FALSE.
      DO J=1, N_BAND
         DO K=1, N_BAND_CONTINUUM(J)
            IF ( (INDEX_CONTINUUM(J, K).EQ.IP_SELF_CONTINUUM).AND.
     &           (.NOT.L_SET_CONTINUUM) ) THEN
               WRITE(IU_USER, '(/A, /A, A)') 'ENTER AMOUNT OF WATER '
     &            //'VAPOUR TIMES MOLAR DENSITY OF WATER VAPOUR'
     &            , 'TO TEST FOR NEGLECTING THE SELF-BROADENED '
     &            , 'CONTINUUM IN A BAND.'
1              READ(IU_STDIN, *, IOSTAT=IOS) COLUMN(IP_SELF_CONTINUUM)
               IF (IOS.NE.0) THEN
                  WRITE(IU_ERR, '(A)') '+++ ERRONEOUS RESPONSE:'
                  IF (LOCK_CODE(.TRUE.)) THEN
                     INCLUDE 'batch_error_main.finc'
                  ELSE
                     WRITE(IU_USER, '(A)') 'PLEASE RE-TYPE.'
                     GOTO 1
                  ENDIF
               ENDIF
               L_SET_CONTINUUM=.TRUE.
            ENDIF
        ENDDO
      ENDDO
!
!     FOREIGN BROADENED CONTINUUM OF WATER VAPOUR.
      L_SET_CONTINUUM=.FALSE.
      DO J=1, N_BAND
         DO K=1, N_BAND_CONTINUUM(J)
            IF ( (INDEX_CONTINUUM(J, K).EQ.IP_FRN_CONTINUUM).AND.
     &           (.NOT.L_SET_CONTINUUM) ) THEN
               WRITE(IU_USER, '(/A, A, /A)') 'ENTER AMOUNT OF WATER '
     &            , 'VAPOUR TO TEST FOR NEGLECTING THE '
     &            , 'FOREIGN-BROADENED CONTINUUM IN A BAND.'
2              READ(IU_STDIN, *, IOSTAT=IOS) COLUMN(IP_FRN_CONTINUUM)
               IF (IOS.NE.0) THEN
                  WRITE(IU_ERR, '(A)') '+++ ERRONEOUS RESPONSE:'
                  IF (LOCK_CODE(.TRUE.)) THEN
                     INCLUDE 'batch_error_main.finc'
                  ELSE
                     WRITE(IU_USER, '(A)') 'PLEASE RE-TYPE.'
                     GOTO 2
                  ENDIF
               ENDIF
               L_SET_CONTINUUM=.TRUE.
            ENDIF
        ENDDO
      ENDDO
!
!     NITROGEN CONTINUUM.
      L_SET_CONTINUUM=.FALSE.
      DO J=1, N_BAND
         DO K=1, N_BAND_CONTINUUM(J)
            IF ( (INDEX_CONTINUUM(J, K).EQ.IP_N2_CONTINUUM).AND.
     &           (.NOT.L_SET_CONTINUUM) ) THEN
               WRITE(IU_USER, '(/A, A, /A)') 'ENTER AMOUNT OF '
     &            , 'NITROGEN TO TEST FOR NEGLECTING THE NITROGEN '
     &            , 'CONTINUUM IN A BAND.'
3              READ(IU_STDIN, *, IOSTAT=IOS) COLUMN(IP_N2_CONTINUUM)
               IF (IOS.NE.0) THEN
                  WRITE(IU_ERR, '(A)') '+++ ERRONEOUS RESPONSE:'
                  IF (LOCK_CODE(.TRUE.)) THEN
                     INCLUDE 'batch_error_main.finc'
                  ELSE
                     WRITE(IU_USER, '(A)') 'PLEASE RE-TYPE.'
                     GOTO 3
                  ENDIF
               ENDIF
               L_SET_CONTINUUM=.TRUE.
            ENDIF
        ENDDO
      ENDDO
!
      WRITE(IU_USER, '(/A)')
     &   'ENTER THE TRANSMISSION FOR NEGLECTING CONTINUA.'
4     READ(IU_STDIN, *, IOSTAT=IOS) TRANS_NEGLECT
      IF (IOS.NE.0) THEN
         WRITE(IU_ERR, '(A)') '+++ ERRONEOUS RESPONSE:'
         IF (LOCK_CODE(.TRUE.)) THEN
            INCLUDE 'batch_error_main.finc'
         ELSE
            WRITE(IU_USER, '(A)') 'PLEASE RE-TYPE.'
            GOTO 4
         ENDIF
      ENDIF
!
!     GO THROUGH THE BANDS REMOVING CONTINUA WHICH ARE TOO WEAK.
      DO I=1, N_BAND
         N_BAND_CONTINUUM_TEMP=N_BAND_CONTINUUM(I)
         N_BAND_CONTINUUM(I)=0
         DO J=1, N_BAND_CONTINUUM_TEMP
            I_CONTINUUM=INDEX_CONTINUUM(I, J)
            TRANS_COLUMN=EXP(-K_CONTINUUM(I, I_CONTINUUM)
     &         *COLUMN(I_CONTINUUM))
            IF (TRANS_COLUMN.LT.TRANS_NEGLECT) THEN
!              THE CONTINUUM IS INCLUDED.
               N_BAND_CONTINUUM(I)=N_BAND_CONTINUUM(I)+1
               INDEX_CONTINUUM(I, N_BAND_CONTINUUM(I))=I_CONTINUUM
            ENDIF
         ENDDO
      ENDDO
!
!
      RETURN
      END
