!+ Subroutine to read surface properties from a file.
!
! Method:
!	A file is opened and searched for directives indicating
!	the properties of the surface. Subsequent data are processed
!	accordingly.
!
! 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_FILE(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
!
      LOGICAL
     &     L_TYPE_SET
!             LOGICAL FOR SETTING OF SURFACE TYPE
     &   , L_DIFF_ALB_SET
!             LOGICAL FOR SETTING OF DIFFUSE ALBEDOS
     &   , L_EMISSIVITY_SET
!             LOGICAL FOR SETTING OF EMISSIVITIES
     &   , L_DIR_ALB_SET
!             LOGICAL FOR SETTING OF DIRECT ALBEDOS
      CHARACTER
     &     LINE*80
!             LINE OF INPUT
      INTEGER
     &     IOS
!             I/O ERROR FLAG
     &   , I
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     OPEN_FILE_IN
!
!
!
!     INITIALIZE THE LOGICALS TO ENABLE CHECKING OF SETTINGS LATER.
      L_DIFF_ALB_SET=.FALSE.
      L_EMISSIVITY_SET=.FALSE.
      L_DIR_ALB_SET=.FALSE.
!
!     OPEN THE FILE CONTAINING THE DATA.
      CALL OPEN_FILE_IN(IERR, IU_FILE_IN 
     &   , 'GIVE THE NAME OF THE FILE CONTAINING THE SURFACE DATA.')
!     READ EACH LINE LOOKING FOR A DIRECTIVE.
      IOS=0
      L_TYPE_SET=.FALSE.
      DO WHILE (IOS.EQ.0)
         READ(IU_FILE_IN, '(A)', IOSTAT=IOS) LINE
         IF (IOS.NE.0) GOTO 1
!
!        CHECK FOR DIRECTIVES.
!
         IF (LINE(1:11).EQ.'*SURF_FIXED') THEN
            I_SPEC_SURFACE=IP_SURFACE_SPECIFIED
            L_TYPE_SET=.TRUE.
         ELSE IF (LINE(1:11).EQ.'*SURF_INT') THEN
            I_SPEC_SURFACE=IP_SURFACE_INTERNAL
            L_TYPE_SET=.TRUE.
         ELSE IF (LINE(1:11).EQ.'*SURF_POLY') THEN
            I_SPEC_SURFACE=IP_SURFACE_POLYNOMIAL
            L_TYPE_SET=.TRUE.
         ELSE IF (LINE(1:11).EQ.'*SURF_PAYNE') THEN
            I_SPEC_SURFACE=IP_SURFACE_PAYNE
            L_TYPE_SET=.TRUE.
         ELSE IF (L_TYPE_SET) THEN
            IF (LINE(1:9).EQ.'*DIFF_ALB') THEN
               READ(IU_FILE_IN,*, IOSTAT=IOS)
     &            (SURFACE_ALBEDO(I), I=1, N_BAND)
               IF (IOS.NE.0) THEN
                  WRITE(IU_ERR,'(/A)')
     &               '***ERROR: DIFFUSE ALBEDOS NOT READ.'
                  IERR=I_ERR_FATAL
                  GOTO 1
               ENDIF
               L_DIFF_ALB_SET=.TRUE.
            ELSE IF (LINE(1:11).EQ.'*EMISSIVITY') THEN
               READ(IU_FILE_IN,*, IOSTAT=IOS)
     &            (EMISSIVITY_GROUND(I), I=1, N_BAND)
               IF (IOS.NE.0) THEN
                  WRITE(IU_ERR,'(/A)')
     &               '***ERROR: EMISSIVITIES NOT READ.'
                  IERR=I_ERR_FATAL
                  GOTO 1
               ENDIF
               L_EMISSIVITY_SET=.TRUE.
            ELSE IF (LINE(1:11).EQ.'*POLY_FIT') THEN
!              CHECK THAT THE SURFACE SPECIFIED IS COMPATIBLE
!              WITH THE DIRECTIVE.
               IF (I_SPEC_SURFACE.NE.IP_SURFACE_POLYNOMIAL) THEN
                  WRITE(IU_ERR, '(/A, I5)')
     &               '*** ERROR: DIRECTIVE "*POLY_FIT" IS '
     &               //'INCOMPATIBLE WITH SPECIFICATION '
     &               , I_SPEC_SURFACE
                  IERR=I_ERR_FATAL
                  GOTO 1
               ENDIF
               READ(IU_FILE_IN, *, IOSTAT=IOS)
     &            N_DIR_ALBEDO_FIT
               IF (IOS.NE.0) THEN
                  WRITE(IU_ERR,'(/A)')
     &               '***ERROR: DEGREE OF FIT TO DIRECT ALBEDOS '
     &               //'NOT READ.'
                  IERR=I_ERR_FATAL
                  GOTO 1
               ENDIF
               READ(IU_FILE_IN,*, IOSTAT=IOS)
     &            ( (DIRECT_ALBEDO_PARM(K, I)
     &            , K=0, N_DIR_ALBEDO_FIT ), I=1, N_BAND)
               IF (IOS.NE.0) THEN
                  WRITE(IU_ERR,'(/A)')
     &               '***ERROR: DIRECT ALBEDOS NOT READ.'
                  IERR=I_ERR_FATAL
                  GOTO 1
               ENDIF
               L_DIR_ALB_SET=.TRUE.
            ELSE IF (LINE(1:11).EQ.'*PAYNE_FIT') THEN
!              CHECK THAT THE SURFACE SPECIFIED IS COMPATIBLE
!              WITH THE DIRECTIVE.
               IF (I_SPEC_SURFACE.NE.IP_SURFACE_PAYNE) THEN
                  WRITE(IU_ERR, '(/A, I5)')
     &               '*** ERROR: DIRECTIVE "*PAYNE_FIT" IS '
     &               //'INCOMPATIBLE WITH SPECIFICATION '
     &               , I_SPEC_SURFACE
                  IERR=I_ERR_FATAL
                  GOTO 1
               ENDIF
               N_DIR_ALBEDO_FIT=4
               READ(IU_FILE_IN,*, IOSTAT=IOS)
     &            ( (DIRECT_ALBEDO_PARM(K, I)
     &            , K=1, N_DIR_ALBEDO_FIT ), I=1, N_BAND)
               IF (IOS.NE.0) THEN
                  WRITE(IU_ERR,'(/A)')
     &               '***ERROR: FIT TO DIRECT ALBEDO NOT READ.'
                  IERR=I_ERR_FATAL
                  GOTO 1
               ENDIF
               L_DIR_ALB_SET=.TRUE.
            ENDIF
         ENDIF
      ENDDO

      CLOSE(IU_FILE_IN)
!
!     CHECK THAT THE DATA ARE PROPERLY SET.
      IF (.NOT.L_DIFF_ALB_SET) THEN
         WRITE(IU_ERR, '(/A)')
     &      '*** ERROR: DIFFUSE ALBEDOS HAVE NOT BEEN SET.'
         IERR=I_ERR_FATAL
         GOTO 1
      ENDIF
      IF (.NOT.L_EMISSIVITY_SET) THEN
         WRITE(IU_ERR, '(/A)')
     &      '*** ERROR: EMSSIVITIES HAVE NOT BEEN SET.'
         IERR=I_ERR_FATAL
         GOTO 1
      ENDIF
      IF ( (I_SPEC_SURFACE.EQ.IP_SURFACE_POLYNOMIAL).OR.
     &     (I_SPEC_SURFACE.EQ.IP_SURFACE_PAYNE) ) THEN
         IF (.NOT.L_DIR_ALB_SET) THEN
            WRITE(IU_ERR, '(/A)')
     &         '*** ERROR: DIRECT ALBEDOS HAVE NOT BEEN SET.'
            IERR=I_ERR_FATAL
            GOTO 1
         ENDIF
      ENDIF
!
      L_SURFACE_SET=.TRUE.
!
!
1     CLOSE(IU_FILE_IN)
      RETURN
      END
