!+ Subroutine to make spectral blocks of type 7.
!
! 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_7(IERR
     &   , N_BAND
     &   , L_SURFACE, I_SPEC_SURFACE, SURFACE_ALBEDO, N_DIR_ALBEDO_FIT
     &   , DIRECT_ALBEDO_PARM, EMISSIVITY_GROUND
     &   , L_PRESENT_7
     &   )
!
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/surface_spec.pcf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY VARIABLES.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
     &   , I_SPEC_SURFACE(NPD_SURFACE)
!             METHOD OF SPECIFYING PROPERTIES
     &   , N_DIR_ALBEDO_FIT(NPD_SURFACE)
!             DEGREE OF POLYNOMIAL FITTING ALBEDO
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF SPECTRAL BANDS
      LOGICAL	!, INTENT(OUT)
     &     L_PRESENT_7
!             FLAG FOR OCCURENCE OF BLOCK
     &   , L_SURFACE(NPD_SURFACE)
!             LOGICALS FOR SURFACE TYPES
      REAL*8	!, INTENT(OUT)
     &     SURFACE_ALBEDO(NPD_BAND, NPD_SURFACE)
!             SURFACE ALBEDOS
     &   , EMISSIVITY_GROUND(NPD_BAND, NPD_SURFACE)
!             SURFACE EMISSIVITIES
     &   , DIRECT_ALBEDO_PARM(0: NPD_ALBEDO_PARM, NPD_BAND, NPD_SURFACE)
!             COEFFICIENTS FOR DIRECT ALBEDO
!
!     LOCAL VARIABLES.
!
      LOGICAL
     &     LOCK_CODE
!             LOGICAL TO FORBID INTERACTIVE LOOPING
      EXTERNAL
     &     LOCK_CODE
!
      LOGICAL
     &     L_SET_PROPERTIES
!             LOGICAL TO PROCEED WITH THE SETTING OF PROPERTIES
      CHARACTER
     &     CHAR_YN
!             CHARACTER RESPONSE
     &   , CHAR_IF
!             CHARACTER TO SET SOURCE OF DATA
      INTEGER
     &     I_SURFACE
!             NUMBER OF SURFACE
     &   , IOS
!             I/O ERROR FLAG
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     SURF_PROP_INTERACTIVE, SURF_PROP_FILE
!
!
!     OBTAIN AND CHECK THE TYPE OF SURFACE.
1     WRITE(IU_USER, '(/A)') 'SPECIFY THE NUMBER OF THE SURFACE.'
2     READ(IU_STDIN, *, IOSTAT=IOS) I_SURFACE
      IF (IOS.NE.0) THEN
         WRITE(IU_ERR, '(/A)') '+++ ERRONEOUS INPUT'
         IF (LOCK_CODE(.TRUE.)) THEN
            INCLUDE 'batch_error.finc'
         ELSE
            WRITE(IU_USER, '(A)') 'PLEASE RE-TYPE.'
            GOTO 2
         ENDIF
      ENDIF
      IF ( (I_SURFACE.LT.1).OR.(I_SURFACE.GT.NPD_SURFACE) ) THEN
         WRITE(IU_ERR, '(/A)') '+++ NUMBER IS OUTSIDE ALLOWED RANGE:'
         IF (LOCK_CODE(.TRUE.)) THEN
            INCLUDE 'batch_error.finc'
         ELSE
            WRITE(IU_USER, '(A)') 'PLEASE RE-ENTER.'
            GOTO 2
         ENDIF
      ENDIF
!
      L_SET_PROPERTIES=.TRUE.
      IF (L_SURFACE(I_SURFACE)) THEN
         WRITE(IU_ERR, '(/A)')
     &      '+++ WARNING: DATA FOR THIS TYPE OF SURFACE ALREADY EXIST.'
         IF (.NOT.LOCK_CODE(.TRUE.)) THEN
            WRITE(IU_USER, '(/A)') ' DO YOU WANT TO OVERWRITE? (Y/N)'
            READ(IU_STDIN, '(A)') CHAR_YN
            IF ( (CHAR_YN.NE.'Y').AND.(CHAR_YN.NE.'y') )
     &         L_SET_PROPERTIES=.FALSE.
         ENDIF
      ENDIF
!
      IF (L_SET_PROPERTIES) THEN
!        THE CHARACTERISTICS OF THE SURFACE MAY BE SET INTERACTIVELY OR
!        READ FORM A FILE.
         WRITE(IU_USER, '(/A, /A)')
     &      'ENTER "F" TO READ THE CHARACTERISTICS OF THE SURFACE FROM'
     &      , 'A FILE OR "I" TO SET THEM INTERACTIVELY.'
         READ(IU_STDIN, '(A)') CHAR_IF
         DO WHILE ( (CHAR_IF.NE.'I').AND.(CHAR_IF.NE.'i').AND.
     &              (CHAR_IF.NE.'F').AND.(CHAR_IF.NE.'f') )
            WRITE(IU_ERR, '(A)') '+++ UNRECOGNISED INPUT:'
            IF (LOCK_CODE(.TRUE.)) THEN
               INCLUDE 'batch_error_main.finc'
            ELSE
               WRITE(IU_USER, '(A)') 'PLEASE RE-ENTER.'
               READ(IU_STDIN, '(A)') CHAR_IF
            ENDIF
         ENDDO
!
         IF ( (CHAR_IF.EQ.'I').OR.(CHAR_IF.EQ.'i') ) THEN
            CALL SURF_PROP_INTERACTIVE(IERR
     &         , N_BAND
     &         , L_SURFACE(I_SURFACE), I_SPEC_SURFACE(I_SURFACE)
     &         , SURFACE_ALBEDO(1, I_SURFACE)
     &         , N_DIR_ALBEDO_FIT(I_SURFACE)
     &         , DIRECT_ALBEDO_PARM(0, 1, I_SURFACE)
     &         , EMISSIVITY_GROUND(1, I_SURFACE)
     &         )
         ELSE IF ( (CHAR_IF.EQ.'F').OR.(CHAR_IF.EQ.'f') ) THEN
            CALL SURF_PROP_FILE(IERR
     &         , N_BAND
     &         , L_SURFACE(I_SURFACE), I_SPEC_SURFACE(I_SURFACE)
     &         , SURFACE_ALBEDO(1, I_SURFACE)
     &         , N_DIR_ALBEDO_FIT(I_SURFACE)
     &         , DIRECT_ALBEDO_PARM(0, 1, I_SURFACE)
     &         , EMISSIVITY_GROUND(1, I_SURFACE)
     &         )
         ENDIF
         IF (IERR.NE.I_NORMAL) RETURN
      ENDIF
!
      WRITE(IU_USER, '(/A)') 'SPECIFY ANOTHER SURFACE TYPE? (Y/N)'
      READ(IU_STDIN, '(A)') CHAR_YN
      IF ( (CHAR_YN.NE.'Y').AND.(CHAR_YN.NE.'y') ) THEN
         L_PRESENT_7=.TRUE.
         RETURN
      ELSE
         GOTO 1
      ENDIF
!
!
!
      RETURN
      END
