      SUBROUTINE RETVAL(VALARR,XCELL,YCELL,EQUATR,VALUE,ERROR)
      IMPLICIT NONE
C**********************************************************************
C
C   LANGUAGE- FORTRAN 77     TYPE- SUBROUTINE     COMPUTER- CRAY     
C
C   VERSION- 1.0    DATE- 08/22/91   PROGRAMMER- JEFFREY R. JONES, SMSRC
C   VERSION- 3.0    DATE- 05/21/96   PROGRAMMER- ALEX POZDNYAK, FDC 
C     FOR REHOSTING TO THE CRAY, CHANGED ALL I*4 DECLARATIONS TO
C     INTEGER, ALL R*4 TO REAL, AND ALL LOG*4 DECLARATIONS TO
C     LOGICAL. 
C   VERSION- 3.1    DATE- 07/27/01   PROGRAMMER- FRANK TILLEY, RAYTHEON
C     CHANGED THE ASSIGNMENT OF THE X AND Y COORDINATES TO USE THE
C     NEAREST WHOLE NUMBER OF XCELL AND YCELL INSTEAD OF TRUNCATING
C     TO AN INTEGER VALUE (WR #99). ADDED CALLING ARGUMENT 'EQUATR'
C     TO FLAG LOCATIONS WITHIN 0.5 DEGREES OF THE EQUATOR. WHEN
C     THIS FLAG IS 'TRUE', THE XCELL AND YCELL VALUES ARE TRUNCATED
C     RATHER THAN BEING ROUNDED TO THE NEAREST WHOLE NUMBER. THIS
C     APPROACH PREVENTS THE RETRIEVAL OF VALUES FROM POINTS THAT ARE
C     OFF THE MAP.
C  VERSION- 3.5     DATE-04/02/02  PROGRAMMER- RICKEY ROLLINS, CSC
C         REPLACED FLUSH WITH FLUSH_
C
C   DESCRIPTION- THIS ROUTINE TAKES THE ARRAY RETURNED BY GMVALS AND THE
C                X-CELL COORDINATE AND Y-CELL COORDINATE RETURNED BY
C                CALPOS, AND EXTRACTS THE SPECIFIED CELL'S VALUE FROM
C                THE VALUE ARRAY. IF THE CELL COORDINATES ARE OUT OF
C                RANGE, RETVA$ IS CALLED TO WRITE A MESSAGE TO THE
C                KIDS MESSAGE LOG AND SET THE ERROR RETURN CODE.
C
C                      NOTE: RETVAL IS CALLED BY MAPRET ONLY.
C
C   CALLING SEQUENCE PARAMETERS-
C
C      ARGUMENTS TYPE  I/O             DESCRIPTION
C      --------- ----  --- ------------------------------------------
C      VALARR    REAL   I   HOLDS THE VALUES FOR THE BLOCK.
C
C      XCELL     REAL   I   HOLDS THE CELL'S X-COORDINATES.
C
C      YCELL     REAL   I   HOLDS THE CELL'S Y-COORDINATES.
C
C      EQUATR    LOG    I   FLAG SET TO 'TRUE' IF THE LATITUDE OF
C                           THE SPOT FOR WHICH VALUES ARE REQUESTED
C                           FALLS WITHIN 0.25 DEGREES OF THE EQUATOR.
C
C      VALUE     REAL   O   THE VALUE THAT WAS REQUESTED FOR THE GIVEN
C                           LOCATION.
C
C      ERROR     INT   I/O  THE ERROR RETURN CODE.
C                                0 - SUCCESSFUL COMPLETION.
C                               99 - FATAL ERROR.
C
C   COMMON AREA PARAMETERS-
C
      INCLUDE 'MAPCST'
C
C   LOCAL PARAMETERS-
C
C      ARGUMENTS TYPE  I/O             DESCRIPTION
C      --------- ----  ---  -----------------------------------------
C      ICOOR     INT   N/A  I COORDINATE OF THE CELL IN INTEGER FORM.
C
C      JCOOR     INT   N/A  J COORDINATE OF THE CELL IN INTEGER FORM.
C
C   SUBPROGRAMS CALLED- RETVA$
C
C   EXIT STATES-
C      99 - FATAL ERROR: THE CELL COORDINATES ARE OUT OF RANGE.
C
C**********************************************************************
C
      REAL      VALARR(WMESHC,WMESHC), VALUE, XCELL, YCELL 
      INTEGER   ERROR
      LOGICAL   EQUATR
C
      INTEGER   ICOOR, JCOOR
C
C     INITIALIZE VARIABLES
C
      VALUE = 0.0
      ICOOR = 0
      JCOOR = 0
C
C     ROUND THE XCELL AND YCELL VALUES TO THE NEAREST WHOLE NUMBER
C     UNLESS THE LOCATION IS WITHIN 0.25 DEGREES OF THE EQUATOR.
C     (WR #99)
C
      IF (.NOT.(EQUATR)) THEN
         XCELL = ANINT(XCELL)
         YCELL = ANINT(YCELL)
      END IF
C
C     CONVERT COORDINATES TO INTEGERS.
C
C
      ICOOR = XCELL
      JCOOR = YCELL
C
C     MAKE SURE CELL COORDINATES ARE IN BLOCK.
C
      IF (( ICOOR .LT. 1) .OR. ( ICOOR .GT. WMESHC) .OR.
     1    ( JCOOR .LT. 1) .OR. ( JCOOR .GT. WMESHC)) THEN
C
C
C     IF ROUNDING TO THE NEAREST WHOLE NUMBER PUTS THE
C     CELL OFF THE MAP, SET THE CELL COORDINATE TO THE
C     MAXIMUM VALUE (WMESHC). (WR #99)
C   
          IF (ICOOR.GT.(WMESHC+1).OR.JCOOR.GT.(WMESHC+1)) THEN
C
C            WRITE ERROR MESSAGE.
C
             CALL RETVA$(810,ICOOR,JCOOR,ERROR)
C
          ELSE
C            IF (ICOOR.EQ.(WMESHC+1)) ICOOR=WMESHC
             IF (JCOOR.EQ.(WMESHC+1)) JCOOR=WMESHC
             VALUE = VALARR(ICOOR,JCOOR)
          END IF
C
      ELSE
C
C         ASSIGN VALUE TO OUTPUT VARIABLE
C
          VALUE = VALARR( ICOOR, JCOOR)
C
      END IF
C
C     RETURN TO CALLING ROUTINE
C
      RETURN
C
      END
C**********************************************************************
      SUBROUTINE RETVA$(MSGCOD,ICOOR,JCOOR,STAT)
      IMPLICIT NONE
C**********************************************************************
C   NAME- RETVA$
C
C   LANGUAGE- FORTRAN 77      TYPE- SUBROUTINE      COMPUTER- CRAY     
C
C   VERSION- 1.0    DATE- 05/07/91   PROGRAMMER- JEFFREY R. JONES,SMSRC
C   VERSION- 3.0    DATE- 10/09/97   PROGRAMMER- LEAH WILSON, HSTX      
C   VERSION- 3.1    DATE- 07/31/01   PROGRAMMER- FRANK TILLEY, RAYTHEON
C
C   FUNCTION- THIS SUBROUTINE IS THE ERROR HANDLING ROUTINE FOR
C             ROUTINE RETVAL.
C   VERSION- 3.0  CONVERT FROM MMLF TO KIDS.
C
C   VERSION- 3.1  ADDED CODE TO WRITE THE ERROR MESSAGE OUT TO STANDARD
C                 OUTPUT BEFORE WRITING TO THE KIDS. (WR #99)
C
C   FILES-
C     DSN                    I/O   UNIT   FUNCTIONAL DESCRIPTION
C     ---                    ---  ------  ----------------------
C     ...KIDS                 O    KUNIT  KRAY I/A DOCUMENTATION FILE
C
C   CALLING SEQUENCE PARAMETERS-
C
C     VARIABLE               TYPE  I/O  FUNCTION
C     --------               ----  ---  --------
C     MSGCOD                  I*4   I   MESSAGE CODE USED TO
C                                       IDENTITIFY THE ERROR.
C
C     ICOOR,JCOOR             REAL  I   THE CELL COORDINATES.
C
C     STAT                    INT   O   STATUS CODE IF AN ERROR
C                                       OCCURS DURING I/O.
C
C   COMMON AREA PARAMETERS-
      INCLUDE 'SPGUNT'
      INCLUDE 'ERPARM'
      INCLUDE 'ERINFO'
C
C   LOCAL PARAMETERS-
C     VARIABLE                TYPE    FUNCTION
C     --------                ----    --------
C     KMSG                   CH*100   KIDS MESSAGE BUFFER
C     C4TEMP                  CH*4    HOLDING BUFFER FOR WRITING TO KIDS
C     C7TEMP                  CH*7    HOLDING BUFFER FOR WRITING TO KIDS
C
C   SUBROUTINES CALLED- KIDS
C
C*********************************************************************
C
      INTEGER   MSGCOD,STAT,ICOOR,JCOOR
      CHARACTER*4   C4TEMP
      CHARACTER*7   C7TEMP
      CHARACTER*100 KMSG
C
C  SET ERINFO:SUBNAM
C
      SUBNAM = 'SPGDVR '
C
C  CHECK MESSAGE CODE AND WRITE ERROR MESSAGE
C
      IF (MSGCOD .EQ. 810) THEN
        KMSG(1:50)=' * FATAL ERROR * Cell coordinates are out of range'
        KMSG(51:100)='.  I-coord. =        , J-coord. =         '
        WRITE(C7TEMP,'(F7.3)') ICOOR
        KMSG(65:71) = C7TEMP
        WRITE(C7TEMP,'(F7.3)') JCOOR
        KMSG(85:91) = C7TEMP
        PRINT *, KMSG
        STAT = 99
C
      ELSE
C
C NOT A VALID MSGCOD
C
        STAT=0
        KMSG = ' Invalid error message code = '
        WRITE(C4TEMP,'(I4)') MSGCOD
        KMSG(31:34) = C4TEMP
        CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
      ENDIF
      RETURN
      END
