!+ Subroutine to read surface properties interactively.
!
! Method:
!	The user is asked to specify the type of surface used and
!	to give its properties.
!
! 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 SURF_PROP_INTERACTIVE(IERR
     &   , N_BAND
     &   , L_SURFACE_SET, I_SPEC_SURFACE, SURFACE_ALBEDO
     &   , N_DIR_ALBEDO_FIT, DIRECT_ALBEDO_PARM
     &   , EMISSIVITY_GROUND
     &   )
!
!
!
      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
!             METHOD OF SPECIFYING PROPERTIES
     &   , N_DIR_ALBEDO_FIT
!             DEGREE OF POLYNOMIAL FITTING ALBEDO
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF SPECTRAL BANDS
      LOGICAL	!, INTENT(OUT)
     &     L_SURFACE_SET
!             LOGICAL FOR SURFACE TYPE
      REAL*8	!, INTENT(OUT)
     &     SURFACE_ALBEDO(NPD_BAND)
!             SURFACE ALBEDOS
     &   , EMISSIVITY_GROUND(NPD_BAND)
!             SURFACE EMISSIVITIES
     &   , DIRECT_ALBEDO_PARM(0: NPD_ALBEDO_PARM, NPD_BAND)
!             COEFFICIENTS FOR DIRECT ALBEDO
!
!     LOCAL VARIABLES.
!
      LOGICAL
     &     LOCK_CODE
!             LOGICAL TO FORBID INTERACTIVE LOOPING
      EXTERNAL
     &     LOCK_CODE
!
      INTEGER
     &     IOS
!             I/O ERROR FLAG
     &   , I
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
!
!
!
      WRITE(IU_USER, '(/A)')
     &   'SPECIFY THE WAY IN WHICH THE SURFACE PROPERTIES '
     &   //'ARE DETERMINED.'
      WRITE(IU_USER, '(I5, 3A, A)') IP_SURFACE_SPECIFIED, '.) '
     &   , 'FIXED ALBEDOS AND EMISSIVITIES '
     &   //'SPECIFIED BY SURFACE TYPE.'
      WRITE(IU_USER, '(I5, 3A, A)') IP_SURFACE_INTERNAL, '.) '
     &   , 'SURFACE PROPERTIES DETERMINED WITHIN THE CODE.'
      WRITE(IU_USER, '(I5, 3A, A)') IP_SURFACE_POLYNOMIAL, '.) '
     &   , 'DIRECT ALBEDO EXPRESSED AS A POLYNOMIAL IN ZENITH ANGLE.'
      WRITE(IU_USER, '(I5, 3A, A)') IP_SURFACE_PAYNE, '.) '
     &   , 'SURFACE PROPERTIES FITTED WITH PAYNE''S FUNCTIONAL FORM.'
      WRITE(IU_USER, '(/)')
10    READ(IU_STDIN, *, IOSTAT=IOS) I_SPEC_SURFACE
      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 10
         ENDIF
      ENDIF
!
      IF (I_SPEC_SURFACE.EQ.IP_SURFACE_SPECIFIED) THEN
         WRITE(IU_USER, '(/A30, I5, A9)')
     &      'SPECIFY THE ALBEDO IN EACH OF ', N_BAND, ' BAND(S).'
3        READ(IU_STDIN, *, IOSTAT=IOS) (SURFACE_ALBEDO(I)
     &      , I=1, N_BAND)
         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-ENTER THESE DATA.'
               GOTO 3
            ENDIF
         ENDIF
         WRITE(IU_USER, '(/A34, I5, A9)')
     &      'SPECIFY THE EMISSIVITY IN EACH OF '
     &      , N_BAND, ' BAND(S).'
4        READ(IU_STDIN, *, IOSTAT=IOS)
     &      (EMISSIVITY_GROUND(I), I=1, N_BAND)
         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-ENTER THESE DATA .'
               GOTO 4
            ENDIF
         ENDIF
!
      ELSE IF (I_SPEC_SURFACE.EQ.IP_SURFACE_INTERNAL) THEN
!        THE SURFACE PROPERTIES ARE DETERMINED WITHIN THE CODE.
         CONTINUE
!
      ELSE IF ( (I_SPEC_SURFACE.EQ.IP_SURFACE_POLYNOMIAL).OR.
     &          (I_SPEC_SURFACE.EQ.IP_SURFACE_PAYNE) ) THEN
         WRITE(IU_USER, '(/A30, I5, A9)')
     &      'SPECIFY THE DIFFUSE ALBEDO IN EACH OF '
     &      , N_BAND, ' BAND(S).'
5        READ(IU_STDIN, *, IOSTAT=IOS) (SURFACE_ALBEDO(I)
     &      , I=1, N_BAND)
         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-ENTER THESE DATA.'
               GOTO 5
            ENDIF
         ENDIF
         WRITE(IU_USER, '(/A34, I5, A9)')
     &      'SPECIFY THE EMISSIVITY IN EACH OF '
     &      , N_BAND, ' BAND(S).'
6        READ(IU_STDIN, *, IOSTAT=IOS)
     &      (EMISSIVITY_GROUND(I), I=1, N_BAND)
         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-ENTER THESE DATA .'
               GOTO 6
            ENDIF
         ENDIF
!
         IF (I_SPEC_SURFACE.EQ.IP_SURFACE_POLYNOMIAL) THEN
!           ACQUIRE THE COEFFICIENTS OF THE POLYNOMIAL GIVING THE
!           DIRECT ALBEDO.
            WRITE(IU_USER, '(/A)')
     &         'ENTER THE DEGREE OF THE POLYNOMIAL FITTING '
     &         //'THE DIRECT ALBEDO.'
7           READ(IU_STDIN, *, IOSTAT=IOS) N_DIR_ALBEDO_FIT
            IF (IOS.NE.0) THEN
               WRITE(IU_ERR, '(A)') '+++ ILLEGAL RESPONSE:'
               IF (LOCK_CODE(.TRUE.)) THEN
                  INCLUDE 'batch_error.finc'
               ELSE
                  WRITE(IU_USER, '(A)') 'PLEASE RE-ENTER.'
                  GOTO 7
               ENDIF
            ENDIF
            WRITE(IU_USER, '(/A, /, A)') 'SPECIFY THE COEFFICIENTS '
     &         //'OF THE POLYNOMIALS FOR THE DIRECT ALBEDO,'
     &         , 'BEGINNING WITH THE CONSTANT TERM:'
            DO I=1, N_BAND
               WRITE(IU_USER, '(A, I5)')
     &            'ENTER COEFFICIENTS OF COSINE OF ZENITH ANGLE '
     &            //'IN BAND ', I
8              READ(IU_STDIN, *, IOSTAT=IOS)
     &            (DIRECT_ALBEDO_PARM(K, I), K=0, N_DIR_ALBEDO_FIT)
               IF (IOS.NE.0) THEN
                  WRITE(IU_ERR, '(A)') '+++ ERRONEOUS LIST:'
                  IF (LOCK_CODE(.TRUE.)) THEN
                     INCLUDE 'batch_error.finc'
                  ELSE
                     WRITE(IU_USER, '(A)') 'PLEASE RE_ENTER.'
                     GOTO 8
                  ENDIF
               ENDIF
            ENDDO
         ELSE IF (I_SPEC_SURFACE.EQ.IP_SURFACE_PAYNE) THEN
!           ACQUIRE THE PARAMETERS IN THE EXPRESSION FOR THE
!           DIRECT ALBEDO.
            WRITE(IU_USER, '(/A)')
     &         'ENTER THE COEFFICIENTS OF THE FIT TO '
     &         //'THE DIRECT ALBEDO.'
            N_DIR_ALBEDO_FIT=4
            DO I=1, N_BAND
               WRITE(IU_USER, '(A, I5)')
     &            'ENTER COEFFICIENTS IN BAND ', I
9              READ(IU_STDIN, *, IOSTAT=IOS)
     &            (DIRECT_ALBEDO_PARM(K, I), K=1, N_DIR_ALBEDO_FIT)
               IF (IOS.NE.0) THEN
                  WRITE(IU_ERR, '(A)') '+++ ERRONEOUS LIST:'
                  IF (LOCK_CODE(.TRUE.)) THEN
                     INCLUDE 'batch_error.finc'
                  ELSE
                     WRITE(IU_USER, '(A)') 'PLEASE RE_ENTER.'
                     GOTO 9
                  ENDIF
               ENDIF
            ENDDO
         ENDIF
!
!
      ELSE
         WRITE(IU_ERR, '(/A)')
     &      '+++ ILLEGAL SPECIFICATION TYPE:'
         IF (LOCK_CODE(.TRUE.)) THEN
            INCLUDE 'batch_error.finc'
         ELSE
            WRITE(IU_USER, '(A)') 'PLEASE RE-ENTER.'
            GOTO 10
         ENDIF
      ENDIF
!
!
      L_SURFACE_SET=.TRUE.
!
!
      END
