!+ Subroutine to set the properties of a spectral band.
!
! Method:
!	The string passed to the subroutine is parsed to find
!	the limits of the band and the gases and continua active
!	within it.
!
! 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 SET_BAND(IERR
     &   , STRING, CH_UNIT
     &   , N_BAND, N_ABSORB
     &   , N_BAND_ABSORB, INDEX_ABSORB
     &   , N_BAND_CONTINUUM, INDEX_CONTINUUM
     &   , WAVE_LENGTH_SHORT, WAVE_LENGTH_LONG
     &   , TYPE_ABSORB, INDEX_TYPE
     &   , L_EXCLUDE, N_BAND_EXCLUDE, INDEX_EXCLUDE
     &   )
!
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/dimensions_io.ucf'
      INCLUDE 'incl/error.pcf'
      INCLUDE 'incl/gas_list.pcf'
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/prec_machine.ucf'
      INCLUDE 'incl/precision.pcf'
!
!
!     DUMMY ARGUMENTS.
!
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
!
      CHARACTER	!, INTENT(IN)
     &     STRING*73
!             STRING SUPPLIED
     &   , CH_UNIT*6
!             UNIT USED FOR LIMITS OF BANDS
!
!     ELEMENTS OF SPECTRUM
      INTEGER	!, INTENT(OUT)
     &     N_BAND
!             CURRENT NUMBER OF SPECTRAL BANDS
      LOGICAL	!, INTENT(OUT)
     &     L_EXCLUDE
!             FLAG TO EXCLUDE BANDS
      INTEGER	!, INTENT(OUT)
     &     N_BAND_EXCLUDE(NPD_BAND)
!             NUMBER BANDS EXCLUDED FROM THIS BAND
     &   , INDEX_EXCLUDE(NPD_EXCLUDE, NPD_BAND)
!             LIST OF EXCLUDED BANDS
      INTEGER	!, INTENT(INOUT)
     &     N_ABSORB
!             CURRENT NUMBER OF ABSORBERS
      INTEGER	!, INTENT(OUT)
     &     N_BAND_ABSORB(NPD_BAND)
!             NUMBER OF ABSORBERS IN THIS BAND
     &   , N_BAND_CONTINUUM(NPD_BAND)
!             NUMBER OF CONTINUA IN THIS BAND
     &   , TYPE_ABSORB(NPD_SPECIES)
!             TYPE NUMBERS OF ABSORBING SPECIES
     &   , INDEX_TYPE(NPD_GASES)
!             INDEXING NUMBERS OF TYPES OF GASES
     &   , INDEX_ABSORB(NPD_SPECIES, NPD_BAND)
!             LIST OF ABSORBERS ACTIVE IN SPECIFIC BANDS
     &   , INDEX_CONTINUUM(NPD_BAND, NPD_CONTINUUM)
!             LIST OF CONTINUA ACTIVE IN SPECIFIC BANDS
      REAL*8	!, INTENT(OUT)
     &     WAVE_LENGTH_SHORT(NPD_BAND)
!             SHORT END OF BAND
     &   , WAVE_LENGTH_LONG(NPD_BAND)
!             LONG END OF BAND
!
!
!     LOCAL VARIABLES.
!     POINTERS WITHIN STRING
      INTEGER
     &     LENGTH
!             LENGTH OF STRING SUPPLIED
     &   , N_COLON
!             NUMBER OF COLONS FOUND IN STRING
     &   , I_COLON(NPD_IO_LIST)
!             POSITIONS OF COLONS IN STRING
     &   , LENGTH_SECTION
!             LENGTH OF SECTION OF INPUT STRING
     &   , I_START
!             START OF SECTION OF STRING
!
!     PROPERTIES OF ANALYSED LIST
      INTEGER
     &     N_LIST
!             NUMBER OF ELEMENTS IN LIST
     &   , I_LIST(NPD_IO_LIST)
!             ELEMENTS OF LIST
!
!     CONTROLLING VARIABLES
      INTEGER
     &     I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
!     MISCELLANEOUS VARIABLES.
      REAL*8
     &     TEMPORARY
!             TEMPORARY VARIABLE FOR ORDERING LIMITS OF BANDS
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     SET_LIMIT_BAND, READ_LIST
!
!
!
!     FIND THE LAST NON-BLANK CHARACTER OF THE INPUT LINE.
      J=73
      DO WHILE ( (J.GE.1).AND.(STRING(J:J).EQ.' ') )
         J=J-1
      ENDDO
      LENGTH=J
!
!     FIND THE COLONS IN THE LINE TO SEPARATE SECTIONS
      N_COLON=0
      DO J=1, LENGTH
         IF (STRING(J:J).EQ.':') THEN
            N_COLON=N_COLON+1
            I_COLON(N_COLON)=J
         ENDIF
      ENDDO
!     A NOMINAL COLON IS INSERTED AT THE END.
      N_COLON=N_COLON+1
      I_COLON(N_COLON)=LENGTH+1
!
!     THE FIRST SECTION MUST SPECIFY THE WAVELENGTHS
      LENGTH_SECTION=I_COLON(1)-1
      CALL SET_LIMIT_BAND(IERR, STRING, LENGTH_SECTION
     &   , WAVE_LENGTH_SHORT(N_BAND), WAVE_LENGTH_LONG(N_BAND)
     &   )
      IF (IERR.EQ.I_ERR_IO) THEN
         WRITE(IU_ERR, '(/A, I5)') '*** ERROR: READING DATA FOR BAND '
     &      , N_BAND
      ENDIF
      IF (IERR.NE.I_NORMAL) RETURN
!
!     CONVERT ACCORDING TO THE UNITS GIVEN.
!     METRES NEED NO CONVERSION.
      IF (CH_UNIT(1:6).EQ.'MICRON') THEN
         WAVE_LENGTH_SHORT(N_BAND)=1.00D-06*WAVE_LENGTH_SHORT(N_BAND)
         WAVE_LENGTH_LONG(N_BAND)=1.00D-06*WAVE_LENGTH_LONG(N_BAND)
      ELSE IF (CH_UNIT(1:6).EQ.'INV_CM') THEN
         IF ( (WAVE_LENGTH_SHORT(N_BAND).LT.TOL_DIV).OR.
     &        (WAVE_LENGTH_LONG(N_BAND).LT.TOL_DIV) ) THEN
            WRITE(IU_ERR, '(/A)')
     &         '*** ERROR: A BAND MAY NOT END AT EXACTLY 0 CM-1'
            IERR=I_ERR_FATAL
            RETURN
         ENDIF
         WAVE_LENGTH_SHORT(N_BAND)=1.00D-02/WAVE_LENGTH_SHORT(N_BAND)
         WAVE_LENGTH_LONG(N_BAND)=1.00D-02/WAVE_LENGTH_LONG(N_BAND)
      ENDIF
!     NOW ORDER THE LIMITS.
      IF (WAVE_LENGTH_SHORT(N_BAND).GT.WAVE_LENGTH_LONG(N_BAND)) THEN
         TEMPORARY=WAVE_LENGTH_LONG(N_BAND)
         WAVE_LENGTH_LONG(N_BAND)=WAVE_LENGTH_SHORT(N_BAND)
         WAVE_LENGTH_SHORT(N_BAND)=TEMPORARY
      ENDIF
!
!     PROCESS THE REMAINING SECTIONS AS THEY OCCUR.
      DO J=2, N_COLON
!
!        IGNORE INITIAL LETTER.
         I_START=I_COLON(J-1)+1
         DO WHILE ( (STRING(I_START:I_START).EQ.' ').AND.
     &              (I_START.LT.I_COLON(J)) )
            I_START=I_START+1
         ENDDO
         LENGTH_SECTION=I_COLON(J)-I_START
!
!        INITIALIZE THE INPUT LIST AS EMPTY.
         N_LIST=0
!
         CALL READ_LIST(IERR
     &      , STRING(I_START+1:I_START+LENGTH_SECTION)
     &      , LENGTH_SECTION-1
     &      , N_LIST, I_LIST)
         IF (IERR.EQ.I_ERR_IO) THEN
            WRITE(IU_ERR, '(/A, I5)')
     &         '*** ERROR: ILLEGAL LIST FOR BAND ', N_BAND
         ENDIF
         IF(IERR.NE.I_NORMAL) RETURN
!
         IF (N_LIST.EQ.0) THEN
            WRITE(IU_ERR, '(/A, I5)')
     &         '*** ERROR: EMPTY LIST FOR BAND ', N_BAND
            IERR=I_ERR_FATAL
            RETURN
         ENDIF
!
!
         IF (STRING(I_START:I_START).EQ.'G') THEN
!
!           THIS SECTION IS FOR GASES.
            N_BAND_ABSORB(N_BAND)=N_LIST
            DO I=1, N_LIST
               IF (INDEX_TYPE(I_LIST(I)).EQ.0) THEN
!                 THIS IS A NEW ABSORBER, SO THE LIST OF ABSORBERS
!                 IS EXTENDED.
                  N_ABSORB=N_ABSORB+1
                  TYPE_ABSORB(N_ABSORB)=I_LIST(I)
                  INDEX_TYPE(I_LIST(I))=N_ABSORB
               ENDIF
               INDEX_ABSORB(I, N_BAND)=INDEX_TYPE(I_LIST(I))
            ENDDO
!
         ELSE IF (STRING(I_START:I_START).EQ.'C') THEN
!
!           THIS SECTION IS FOR CONTINUA.
            N_BAND_CONTINUUM(N_BAND)=N_LIST
            DO I=1, N_LIST
               INDEX_CONTINUUM(N_BAND, I)=I_LIST(I)
            ENDDO
         ELSE IF (STRING(I_START:I_START).EQ.'E') THEN
!
!           THIS SECTION IS FOR EXCLUDED BANDS
            L_EXCLUDE=.TRUE.
            N_BAND_EXCLUDE(N_BAND)=N_LIST
            DO I=1, N_LIST
               INDEX_EXCLUDE(I, N_BAND)=I_LIST(I)
            ENDDO
!
         ELSE
!
            WRITE(IU_ERR, '(A)') 'AN ILLEGAL INITIAL LETTER HAS BEEN '
     &         //'USED FOR A SECTION.'
            WRITE(IU_ERR, '(A9, A1, A10, I5)') 'LETTER = '
     &         , STRING(I_START:I_START), ' : BAND = ', N_BAND
            IERR=I_ERR_FATAL
            RETURN
         ENDIF
!
      ENDDO
!
!
!
      RETURN
      END
