!+ Subroutine to make spectral blocks of type 5.
!
! Method:
!	Initaiily, a transparent grey fit is set for each gas.
!	A file is opened and an ESFT fit is read from the file.
!
! 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_5(IERR
     &   , N_BAND, N_ABSORB, N_BAND_ABSORB, INDEX_ABSORB
     &   , I_BAND_ESFT, W_ESFT, K_ESFT, I_SCALE_ESFT
     &   , I_SCALE_FNC, SCALE_VECTOR, P_REFERENCE, T_REFERENCE
     &   , L_PRESENT_5
     &   )
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_pp_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/scale_fnc.pcf'
      INCLUDE 'incl/esft_scale.pcf'
      INCLUDE 'incl/file_type.pcf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY ARGUMENTS.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
     &   , I_BAND_ESFT(NPD_BAND, NPD_SPECIES)
!             NUMBER OF ESFT TERMS
     &   , I_SCALE_ESFT(NPD_BAND, NPD_SPECIES)
!             ESFT SCALING TYPES
     &   , I_SCALE_FNC(NPD_BAND, NPD_SPECIES)
!             INDEX OF SCALING FUNCTION
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF BANDS
     &   , N_ABSORB
!             NUMBER OF ABSORBERS
     &   , N_BAND_ABSORB(NPD_BAND)
!             NUMBER OF ABSORBERS IN BANDS
     &   , INDEX_ABSORB(NPD_SPECIES, NPD_BAND)
!             LIST OF ACTIVE ABSORBERS
      LOGICAL	!, INTENT(OUT)
     &     L_PRESENT_5
!             PRESENCE FLAG
      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
     &   , SCALE_VECTOR(NPD_SCALE_VARIABLE, NPD_ESFT_TERM, NPD_BAND
     &      , NPD_SPECIES)
!             ABSORBER SCALING PARAMETERS
     &   , P_REFERENCE(NPD_SPECIES, NPD_BAND)
!             REFERENCE PRESSURE FOR FIT
     &   , T_REFERENCE(NPD_SPECIES, NPD_BAND)
!             REFERENCE TEMPERATURE FOR FIT
!
!     LOCAL ARGUMENTS.
      CHARACTER
     &     LINE*80
!             INPUT LINE
      INTEGER
     &     I_INPUT_TYPE
!             TYPE OF INPUT FILE
     &   , I_INDEX
!             INDEX NUMBER OF ABSORBER
     &   , I_BAND
!             NUMBER OF BAND
     &   , I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
     &   , L
!             LOOP VARIABLE
      LOGICAL
     &     L_INDEX_BAND(NPD_BAND, NPD_SPECIES)
!             ABSORBERS PRESENT
     &   , NON_BLANK
!             FUNCTION TO DETECT BLANK LINES
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     OPEN_FILE_IN
!
      INCLUDE 'incl/scale_fnc.dcf'
!
!
!
!     IF THE BLOCK DOES NOT EXIST IT IS FILLED WITH GREY NULL FITS.
      IF (.NOT.L_PRESENT_5) THEN
         DO I=1, N_BAND
            DO J=1, N_BAND_ABSORB(I)
               I_BAND_ESFT(I, J)=1
               I_SCALE_ESFT(I, J)=IP_SCALE_NULL
               I_SCALE_FNC(I, J)=IP_SCALE_FNC_NULL
               K_ESFT(1, I, J)=0.0D+00
               W_ESFT(1, I, J)=1.0D+00
            ENDDO
         ENDDO
      ENDIF
!     OBTAIN THE BAND DATA FORM THE PREPARED FILE OF ESFT TERMS.
      CALL OPEN_FILE_IN(IERR, IU_ESFT
     &   , 'ENTER THE NAME OF THE FILE OF ESFT DATA.')
      IF (IERR.NE.I_NORMAL) RETURN
!
!
!     ASSEMBLE THE LIST OF INDEXING NUMBERS.
      DO I=1, N_BAND
         DO J=1, NPD_SPECIES
            L_INDEX_BAND(I, J)=.FALSE.
         ENDDO
         DO J=1, N_BAND_ABSORB(I)
            L_INDEX_BAND(I, INDEX_ABSORB(J, I))=.TRUE.
         ENDDO
      ENDDO
!
100      READ(IU_ESFT, '(15X, I5, //)', END=999) I_INPUT_TYPE
         IF (I_INPUT_TYPE.NE.IT_FILE_LINE_FIT) THEN
            WRITE(IU_ERR, '(/A)')
     &         '***ERROR: THE ESFT DATA HAVE AN INVALID FILE TYPE.'
            IERR=I_ERR_FATAL
            RETURN
         ENDIF
         READ(IU_ESFT, '(14X, I5, 21X, I5)') I_BAND, I_INDEX
!
!        FIND THE POSITION OF THIS DATUM IN THE ARRAY OF GASES.
         IF (.NOT.L_INDEX_BAND(I_BAND, I_INDEX)) THEN
            WRITE(IU_ERR, '(/A)')
     &         '***ERROR: THE ESFT DATA AND THE SPECTRAL '
     &         //'FILE ARE INCONSISTENT.'
            IERR=I_ERR_FATAL
            RETURN
         ENDIF
!
         READ(IU_ESFT, '(18X, 1PE10.3, 21X, 1PE10.3)')
     &      P_REFERENCE(I_INDEX, I_BAND), T_REFERENCE(I_INDEX, I_BAND)
         READ(IU_ESFT, '(//)')
!        READ OVER THE TRANSMISSION DATA.
2        READ(IU_ESFT, '(A)') LINE
         IF (NON_BLANK(LINE)) GOTO 2
         READ(IU_ESFT, '(/, 23X, I5, 20X, I5, 21X, I5, //)')
     &      I_BAND_ESFT(I_BAND, I_INDEX), I_SCALE_ESFT(I_BAND, I_INDEX)
     &      , I_SCALE_FNC(I_BAND, I_INDEX)
         DO K=1, I_BAND_ESFT(I_BAND, I_INDEX)
            READ(IU_ESFT, '(2(3X, 1PE16.9), (T39, 2(3X, 1PE16.9)))')
     &         K_ESFT(K, I_BAND, I_INDEX), W_ESFT(K, I_BAND, I_INDEX)
     &         , (SCALE_VECTOR(L, K, I_BAND, I_INDEX)
     &         , L=1, N_SCALE_VARIABLE(I_SCALE_FNC(I_BAND, I_INDEX)))
         ENDDO
         READ(IU_ESFT, '(/)')
         GOTO 100
!
999   L_PRESENT_5=.TRUE.
      CLOSE(IU_ESFT)
!
!
      RETURN
      END
