!+ Subroutine to remove weakly absorbing gases from bands.
!
! Method:
!	A tolerance for negelecting gaseous absorption is obtained.
!	A typical amount of each gas in a column is given. For each
!	band a test is made to see whether this amount of absorber
!	gives a transmission close to 1 as defined by the tolerance.
!	If so, the gas 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(IERR, N_BAND, N_ABSORB, TYPE_ABSORB
     &   , N_BAND_ABSORB, INDEX_ABSORB
     &   , I_BAND_ESFT, W_ESFT, K_ESFT
     &   )
!
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/gas_list.pcf'
      INCLUDE 'incl/gas_list.ncf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
     &   , N_ABSORB
!             NUMBER OF ABSORBERS
     &   , TYPE_ABSORB(NPD_SPECIES)
!             TYPES OF GASES
      INTEGER	!, INTENT(OUT)
     &     I_BAND_ESFT(NPD_BAND, NPD_SPECIES)
!             NUMBER OF ESFT TERMS
     &   , N_BAND_ABSORB(NPD_BAND)
!             NUMBER OF ABSORBERS IN BANDS
     &   , INDEX_ABSORB(NPD_SPECIES, NPD_BAND)
!             LIST OF ACTIVE ABSORBERS
      REAL*8	!, INTENT(OUT)
     &     K_ESFT(NPD_ESFT_TERM, NPD_BAND, NPD_SPECIES)
!             ESFT EXPONENTIALS
     &   , W_ESFT(NPD_ESFT_TERM, NPD_BAND, NPD_SPECIES)
!             ESFT WEIGHTS
!
!     LOCAL ARGUMENTS.
!
      LOGICAL
     &     LOCK_CODE
!             LOGICAL TO FORBID INTERACTIVE LOOPING
      EXTERNAL
     &     LOCK_CODE
!
      INTEGER
     &     I_GAS
!             INDEX NUMBER OF ABSORBER
     &   , I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
     &   , N_BAND_ABSORB_TEMP
!             TEMPORARY NUMBER OF ABSORBERS
     &   , IOS
!             I/O ERROR FLAG
      REAL*8
     &     COLUMN(NPD_SPECIES)
!             COLUMN AMOUNTS FOR GASES
     &   , TRANS_NEGLECT
!             TRANSMISSION FOR NEGLECTING
     &   , TRANS_COLUMN
!             TRANSMISSION OF COLUMN
!
      INCLUDE 'incl/gas_names.dcf'
!
!
!     OBTAIN COLUMN AMOUNTS OF ABSORBER.
      WRITE(IU_USER, '(/A, /A)')
     &   'FOR EACH ABSORBER ENTER THE AMOUNTS OF THE GAS TO TEST FOR'
     &   , 'NEGLECTING THE GAS IN A BAND.'
      DO I=1, N_ABSORB
         WRITE(IU_USER, '(4X, 2A)') 'COLUMN AMOUNT FOR '
     &      , NAME_ABSORB(TYPE_ABSORB(I))
1        READ(IU_STDIN, *, IOSTAT=IOS) COLUMN(I)
         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
      ENDDO
!
      WRITE(IU_USER, '(/A)')
     &   'ENTER THE TRANSMISSION FOR NEGLECTING GASES.'
2     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 2
         ENDIF
      ENDIF
!
!     GO THROUGH THE BANDS REMOVING GASES WHICH ARE TOO WEAK.
      DO I=1, N_BAND
         N_BAND_ABSORB_TEMP=N_BAND_ABSORB(I)
         N_BAND_ABSORB(I)=0
         DO J=1, N_BAND_ABSORB_TEMP
            I_GAS=INDEX_ABSORB(J, I)
            TRANS_COLUMN=0.0D+00
            DO K=1, I_BAND_ESFT(I, I_GAS)
               TRANS_COLUMN=TRANS_COLUMN+W_ESFT(K, I, I_GAS)
     &            *EXP(-K_ESFT(K, I, I_GAS)*COLUMN(I_GAS))
            ENDDO
            IF (TRANS_COLUMN.LT.TRANS_NEGLECT) THEN
!              THE GAS IS INCLUDED.
               N_BAND_ABSORB(I)=N_BAND_ABSORB(I)+1
               INDEX_ABSORB(N_BAND_ABSORB(I), I)=I_GAS
            ENDIF
         ENDDO
      ENDDO
!
!
      RETURN
      END
