!+ Program to evaluate the value of a SAMSON field at a given pressure.
!
! Method:
!	The field is read in and the value at the selected pressure
!	is calculated by interpolation according to the selected
!	scheme.
!
! 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.
!
!- ---------------------------------------------------------------------
      PROGRAM FVAL
!
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/dimensions_field.ucf'
      INCLUDE 'incl/samson_parm.ecf'
      INCLUDE 'incl/samson_pstar.ecf'
      INCLUDE 'incl/interp_mode.pcf'
      INCLUDE 'incl/error.pcf'
!
!     DECLARATION OF VARIABLES.
      CHARACTER
     &     FILE*80
!             NAME OF INPUT FILE
     &   , TITLE*80
!             TITLE OF INPUT FILE
!
      LOGICAL
     &     LOCK_CODE
!             LOGICAL TO FORBID INTERACTIVE LOOPING
      EXTERNAL
     &     LOCK_CODE
!
      INTEGER
     &     IERR
!             ERROR FLAG
     &   , IOS
!             I/O ERROR FLAG
     &   , N_PROFILE
!             NUMBER OF INPUT PROFILES
     &   , N_LEVEL
!             NUMBER OF INPUT LEVELS
     &   , N_FIELD_SIZE
!             NUMBER OF FIELDS
     &   , I_MODE
!             MODE OF INTERPOLATION
     &   , I
!             LOOP VARIABLE
     &   , L
!             LOOP VARIABLE
      LOGICAL
     &     L_SPLINED
!             TRUE WHEN SPLINE IS DONE
      REAL*8
     &     FIELD(NPD_PROFILE, NPD_LAYER+1)
!             INPUT FIELD
     &   , P_EVALUATE
!             PRESSURE FOR EVALUATION
     &   , FIELD_EVALUATED(NPD_PROFILE)
!             EVALUATED FIELD
     &   , A(NPD_LAYER+1)
!             GATHERED INTERPOLATION FIELD
     &   , X(NPD_LAYER+1)
!             ABSCISSA FOR INTERPOLATION
     &   , Y(NPD_LAYER+1)
!             ORDINATE FOR INTERPOLATION
     &   , Y2(NPD_LAYER+1)
!             2ND DERIVATIVE OF ORDINATE
     &   , P(NPD_LAYER+1)
!             PRESSURE FOR INTERPOLATION
     &   , WORK(NPD_LAYER+1)
!             WORKING ARRAY
     &   , PSTAR
!             SURFACE PRESSURE
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     READ_SAMSON_FIELD, INTERPOLATE_P
!
!
      DATA L_SPLINED/.FALSE./, PSTAR/PSTAR_DEFAULT/
!
!
!
!     READ IN THE BASIC FIELD.
      WRITE(IU_USER, '(/A)')
     &   'ENTER THE NAME OF THE FIELD TO BE EVALUATED.'
      READ(IU_STDIN, '(A)') FILE
      CALL READ_SAMSON_FIELD(IERR, .TRUE., .FALSE.
     &   , FILE, TITLE
     &   , N_PROFILE, N_LEVEL, P, PSTAR, FIELD)
      N_LEVEL=N_LEVEL+1
      IF (IERR.NE.I_NORMAL) STOP
      N_FIELD_SIZE=1
!     READ IN THE PRESSURE AT WHICH THE EVALUATION IS TO BE DONE.
      WRITE(IU_USER, '(/A)')
     &   'ENTER THE PRESSURE AT WHICH THE FIELD IS TO BE EVALUATED.'
1     READ(IU_STDIN, *, IOSTAT=IOS) P_EVALUATE
      IF (IOS.NE.0) THEN
         WRITE(IU_ERR, '(A)') '+++ UNRECOGNIZED RESPONSE:'
         IF (LOCK_CODE(.TRUE.)) THEN
            INCLUDE 'batch_error_main.finc'
         ELSE
            WRITE(IU_USER, '(A)') 'PLEASE RE-ENTER.'
            GOTO 1
         ENDIF
      ENDIF
!
      WRITE(IU_USER, '(/A)') 'ENTER MODE OF INTERPOLATION.'
2     READ(IU_STDIN, *, IOSTAT=IOS) I_MODE
      IF (IOS.NE.0) THEN
         WRITE(IU_ERR, '(A)') '+++ UNRECOGNIZED RESPONSE:'
         IF (LOCK_CODE(.TRUE.)) THEN
            INCLUDE 'batch_error_main.finc'
         ELSE
            WRITE(IU_USER, '(A)') 'PLEASE RE-ENTER.'
            GOTO 2
         ENDIF
      ENDIF
      IF ( (I_MODE.NE.IP_1_LIN_LIN).AND.
     &     (I_MODE.NE.IP_1_LOG_LIN).AND.
     &     (I_MODE.NE.IP_1_LIN_LOG).AND.
     &     (I_MODE.NE.IP_1_LOG_LOG).AND.
     6     (I_MODE.NE.IP_3_LIN_LIN).AND.
     &     (I_MODE.NE.IP_3_LOG_LIN).AND.
     &     (I_MODE.NE.IP_3_LIN_LOG).AND.
     &     (I_MODE.NE.IP_3_LOG_LOG) ) THEN
         WRITE(IU_ERR, '(A)') '+++ UNSUPPORTED MODE:'
         IF (LOCK_CODE(.TRUE.)) THEN
            INCLUDE 'batch_error_main.finc'
         ELSE
            WRITE(IU_USER, '(A)') 'PLEASE RE-ENTER.'
            GOTO 2
         ENDIF
      ENDIF
!
!     PERFORM THE INTERPOLATION.
      DO L=1, N_PROFILE
         DO I=1, N_LEVEL
            A(I)=FIELD(L, I)
         ENDDO
         L_SPLINED=.FALSE.
         CALL INTERPOLATE_P(IERR, N_LEVEL, P
     &      , A, X, Y, Y2, WORK
     &      , P_EVALUATE, FIELD_EVALUATED(L)
     &      , I_MODE, L_SPLINED
     &      )
         IF (IERR.EQ.I_ERR_FATAL) STOP
      ENDDO
!
!     PRINT THE FINAL FIELD.
      WRITE(IU_STDOUT, '(4(4X, 1PE14.7))') (FIELD_EVALUATED(L)
     &   , L=1, N_PROFILE)
!
!
      STOP
      END
