!+ Subroutine to make spectral blocks of type 13.
!
! 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_13(IERR
     &   , N_ABSORB, TYPE_ABSORB
     &   , L_DOPPLER_PRESENT, DOPPLER_CORRECTION
     &   , L_PRESENT_13)
!
!
!
      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_ABSORB
!             NUMBER OF GASEOUS ABSORBERS
     &   , TYPE_ABSORB(NPD_SPECIES)
!             TYPE NUMBERS FOR ABSORBERS
      LOGICAL	!, INTENT(OUT)
     &     L_DOPPLER_PRESENT(NPD_SPECIES)
!             DOPPLER DATA FLAGS FOR EACH GAS
     &   , L_PRESENT_13
!             PRESENCE FLAG FOR BLOCK OF DATA
      REAL*8	!, INTENT(OUT)
     &     DOPPLER_CORRECTION(NPD_SPECIES)
!             DOPPLER BROADENING TERMS FOR GASES
!
!     LOCAL VARIABLES
!
      LOGICAL
     &     LOCK_CODE
!             LOGICAL TO FORBID INTERACTIVE LOOPING
      EXTERNAL
     &     LOCK_CODE
!
      INTEGER
     &     I
!             LOOP VARIABLE
     &   , IOS
!             I/O ERROR VARIABLE
     &   , TYPE_GAS
!             TYPE OF GAS
     &   , I_SPECIES
!             SPECIES OF GAS
      LOGICAL
     &     L_FOUND
!             TRUE IF GAS IS FOUND
!
      INCLUDE 'incl/gas_names.dcf'
!
!
!
!     INITIALIZE FOR NO DOPPLER INFORMATION IF THE BLOCK IS NOT PRESENT.
      IF (.NOT.L_PRESENT_13) THEN
         DO I=1, N_ABSORB
            L_DOPPLER_PRESENT(I)=.FALSE.
            DOPPLER_CORRECTION(I)=0.0D+00
         ENDDO
      ENDIF
!
!     THESE COEFFICIENTS ARE EMPIRICALLY DERIVED 
!     AND SO ARE ENTERED BY HAND.
10    WRITE(IU_USER, '(/A)')
     &   'ENTER TYPE OF GAS: ENTER -1 TO RETURN.'
1     READ(IU_STDIN, *, IOSTAT=IOS) TYPE_GAS
      IF (IOS.NE.0) THEN
         WRITE(IU_ERR, '(A)') '+++ UNRECOGNIZED RESPONSE:'
         IF (LOCK_CODE(.TRUE.)) THEN
            INCLUDE 'batch_error.finc'
         ELSE
            WRITE(IU_USER, '(A)') 'PLEASE RE-ENTER'
            GOTO 1
         ENDIF
      ENDIF
      IF (TYPE_GAS.LT.0) GOTO 20
!
!     CHECK FOR VALID GAS.
      I=1
      L_FOUND=.FALSE.
      DO WHILE ( (.NOT.L_FOUND).AND.(I.LE.N_ABSORB) )
         IF (TYPE_ABSORB(I).EQ.TYPE_GAS) THEN
            L_FOUND=.TRUE.
            I_SPECIES=I
         ENDIF
         I=I+1
      ENDDO
      IF (.NOT.L_FOUND) THEN
         WRITE(IU_ERR, '(A)') 
     &      '*** ERROR: THIS GAS IS NOT IN THE SPECTRAL FILE.'
         IF (LOCK_CODE(.TRUE.)) THEN
            INCLUDE 'batch_error.finc'
         ELSE
            WRITE(IU_USER, '(A)') 'PLEASE RE-ENTER'
            GOTO 10
         ENDIF
      ENDIF
!
      WRITE(IU_USER, '(A, A)') 'ENTER DOPPLER CORRECTION FOR '
     &   , NAME_ABSORB(TYPE_GAS)
2     READ(IU_STDIN, *, IOSTAT=IOS) 
     &   DOPPLER_CORRECTION(I_SPECIES)
      IF (IOS.NE.0) THEN
         WRITE(IU_ERR, '(A)') '+++ UNRECOGNIZED RESPONSE:'
         IF (LOCK_CODE(.TRUE.)) THEN
            INCLUDE 'batch_error.finc'
         ELSE
            WRITE(IU_USER, '(A)') 'PLEASE RE-ENTER'
            GOTO 2
         ENDIF
      ENDIF
      L_DOPPLER_PRESENT(I_SPECIES)=.TRUE.
!
      GOTO 10
!
!     DATA HAVE NOW BEEN CORRECTLY ASSEMBLED.
20    L_PRESENT_13=.TRUE.
!
!
      RETURN
      END
