!+ Subroutine to make spectral blocks of type 4.
!
! Method:
!       Straightforward.
!
! 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 MAKE_BLOCK_4(IERR
     &   , N_BAND, N_ABSORB, TYPE_INDEX
     &   , N_BAND_ABSORB, INDEX_ABSORB
     &   )
!
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_pp_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/dimensions_pp.ucf'
      INCLUDE 'incl/gas_list.pcf'
      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_INDEX(NPD_GASES)
!             INDICES OF EACH GAS TYPE
      INTEGER	!, INTENT(OUT)
     &     N_BAND_ABSORB(NPD_BAND)
!             NUMBER OF ABSORBERS IN EACH BAND
     &   , INDEX_ABSORB(NPD_SPECIES, NPD_BAND)
!             ARRAY OF INDICES FOR ABSORBERS
!
!
!     LOCAL VARIABLES
!
      LOGICAL
     &     LOCK_CODE
!             LOGICAL TO FORBID INTERACTIVE LOOPING
      EXTERNAL
     &     LOCK_CODE
!
      CHARACTER
     &     PROMPT*35
!             PROMPT FOR INPUT
      INTEGER
     &     I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
     &   , I_LIST(NPD_SPECIES)
!             INDICES FOR ONE BAND
!
!
      DATA PROMPT/'TYPE NUMBERS OF ABSORBERS IN BAND '/
!
!
!
!     OBTAIN THE INPUT DATA.
      WRITE(IU_USER, '(//A)')
     &   'FOR EACH BAND SPECIFY THE TYPE NUMBERS OF THE ABSORBERS'
      WRITE(IU_USER, '(A)')
     &   'ACTIVE IN THAT BAND.'
      WRITE(IU_USER, '(A)')
     &   'TO CONTINUE INPUT ON THE NEXT LINE TERMINATE THE LINE'
      WRITE(IU_USER, '(A)')
     &   'WITH AN &.'
      WRITE(IU_USER, '(/A/)')
     &   'ENTER ''0'' IF THERE IS NO GASEOUS ABSORPTION IN THE BAND.'
      DO I=1, N_BAND
1        CALL READ_LINE(IERR, I, PROMPT, NPD_SPECIES
     &      , N_ABSORB, N_BAND_ABSORB(I), I_LIST)
         IF (IERR.NE.I_NORMAL) RETURN
         DO J=1, N_BAND_ABSORB(I)
            INDEX_ABSORB(J, I)=TYPE_INDEX(I_LIST(J))
            IF ( INDEX_ABSORB(J, I).EQ.-1) THEN
               WRITE(IU_ERR, '(/A)')
     &            '+++ ERRONEOUS INPUT:  AN ABSORBER HAS BEEN SPECIFIED'
               WRITE(IU_ERR, '(A)')
     &            'WHICH HAS NOT PREVOIUSLY BEEN DECLARED.'
               IF (LOCK_CODE(.TRUE.)) THEN
                  INCLUDE 'batch_error.finc'
               ELSE
                  WRITE(IU_ERR, '(A/)') 'PLEASE RE-SPECIFY.'
                  GOTO 1
               ENDIF
            ENDIF
         ENDDO
      ENDDO
!
!
!
      RETURN
      END
