      SUBROUTINE MAPRET(UNITNM,LAT,LONG,NUMLOC,PARM,VALUE,ERROR)
      IMPLICIT NONE
C**********************************************************************
C
C   NAME- MAPRET
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- 10/08/97   PROGRAMMER- LEAH WILSON, HSTX  
C   VERSION- 3.2    DATE- 11/03/98   PROGRAMMER- BRIAN BARIL, RAYTHEON
C   VERSION- 3.3    DATE- 02/05/99   PROGRAMMER- LEAH WILSON, RAYTHEON
C   VERSION- 3.4    DATE- 07/30/01   PROGRAMMER- FRANK TILLEY, RAYTHEON
C   VERSION- 3.5    DATE- 04/02/02   PROGRAMMER- RICKEY ROLLINS, CSC
C   VERSION- 4.0    DATE- 02/27/03   PROGRAMMER- Rickey Rollins (CSC)
C
C   DESCRIPTION- THIS ROUTINE TAKES AS INPUT ONE OR MORE LOCATIONS IN
C                THE FORM OF LATITUDE/LONGITUDE PAIRS, AND A REQUESTED
C                PARAMETER AND RETURNS THE VALUE OF THE PARAMETER BASED
C                ON THE VALUE STORED FOR THAT LOCATION IN THE MAP
C                DATABASE.
C
C                THE ARGUMENTS LATITUDE, LONGITUDE, AND VALUE ARE
C                ARRAYS THAT CORRESPOND TO THE NUMBER OF LOCATIONS THAT
C                REQUIRE VALUES. EACH ARRAY IS TREATED AS A FIELD
C                WITH THE ARRAYS GROUPED TOGETHER TO FORM
C                NUMBER OF LOCATIONS RECORDS.
C
C   VERSION- 3.1 IN-LINE CALISD, CHANGE CDB CALLS, AND REPLACE MMLF
C                WITH KIDS.
C   VERSION- 3.2 REMOVED ALL CALLS AND REFERENCES TO THE OLD FAU'S.
C                REPLACED WITH INTCOEF AND REALCOEF SINCE AN 8 BYTE 
C                MAPPARM CDB NOW EXISTS.  ADDED FOUR STORAGE BUFFERS:
C                VALAR1 - 4, TO SAVE BLOCK DATA THAT WOULD OTHERWISE
C                BE READ IN REPETITIOUSLY.  
C   VERSION- 3.3 REMOVED CALHEM AND REPLACED WITH INLINING.
C   VERSION- 3.4 REMOVED SPACES IN CALLS TO MAPRE$ FOR ERROR CODE 210
C                TO KEEP THE LINE FROM EXTENDING BEYOND COLUMN 72.
C                DECLARED BLK, COL, ROW USED AS DUMMY ARGUMENTS IN
C                THE CALL TO MAPRE$ FOR ERROR CODE 210. REFORMATTED
C                THE CODE TO SHOW PROPER NESTING. ADDED LOGICAL FLAG
C                EQUATR TO THE CALL TO RETVAL. WHEN .TRUE. THE 
C                LATITUDE OF THE REQUESTED LOCATION IS WITHIN 0.25
C                DEGREES OF THE EQUATOR. (WR #99)
C  VERSION- 3.5 REPLACED FLUSH WITH FLUSH_      
C   VERSION- 4.0    DATE- 02/27/03   PROGRAMMER- Rickey Rollins (CSC)
C        Replace R4SPV equivalence test with ISR4SPV function 
C
C   CALLING SEQUENCE PARAMETERS-
C
C     ARGUMENTS TYPE  I/O             DESCRIPTION
C     --------- ----  --- ------------------------------------------
C     UNITNM    INT    I   THE MAPPARM CDB UNIT NUMBER.           
C
C     LAT       REAL   I   LATITUDE OF THE LOCATION FOR WHICH THE
C                          PARAMETER IS BEING REQUESTED. (DEGREES)
C
C     LONG      REAL   I   LONGITUDE OF THE LOCATION FOR WHICH THE
C                          PARAMETER IS BEING REQUESTED. (DEGREES)
C
C     NUMLOC    INT    I   THE NUMBER OF LOCATIONS OF WHICH VALUES ARE
C                          BEING REQUESTED.
C
C     PARM     CH*8    I   THE PARAMETER FOR WHICH FOR A VALUE IS
C                          BEING REQUESTED.
C
C     VALUE     REAL   O   THE VALUE THAT WAS REQUESTED FOR THE GIVEN
C                          LOCATION.
C
C     ERROR     INT    O   THE ERROR RETURN CODE.
C                               0 - SUCCESSFUL COMPLETION.
C                              10 - NON-FATAL ERROR.
C                              99 - FATAL ERROR.
C
C   COMMON AREA PARAMETERS-
C
      INCLUDE 'MAPCST'
C
C   LOCAL PARAMETERS-
C
C     ARGUMENTS TYPE              DESCRIPTION
C     --------- ----   -----------------------------------------
C     BLK       INT    DUMMY BLOCK NUMBER FOR CALL TO MAPRE$.
C
C     COL       INT    DUMMY COLUMN NUMBER FOR CALL TO MAPRE$.
C
C     ROW       INT    DUMMY ROW NUMBER FOR CALL TO MAPRE$.
C
C     CURUNT    INT    THE UNIT NUMBER OF THE CURRENT CDB.
C
C     EQUATR    LOG    FLAG SET TO .TRUE. WHEN THE REQUESTED
C                      LATITUDE IS WITHIN 0.25 DEGREES OF THE
C                      EQUATOR. USED IN THE CALL TO RETVAL.
C
C     PRVUNT    INT    THE UNIT NUMBER OF THE PREVIOUS CALL TO
C                      MAPRET.
C
C     CHEMIS   CH*8    ARRAY THAT HOLDS THE CHARACTER VERSION OF
C                      THE HEMISPHERE (NORTHERN OR SOUTHERN).
C
C     IHEMIS    INT    HOLDS THE INTEGER VERSION OF THE HEMISPHERE
C                      (+1 FOR NORTHERN OR -1 FOR SOUTHERN).
C
C     PRVHEM   CH*8    HOLDS THE LAST LOCATIONS HEMISPHERE.
C
C     STDLAT(2) REAL   HOLDS THE LATITUDE AT WHICH THE PROJECTION
C                      PLANE IS DRAWN FOR THE MAP. (DEGREES)
C                      THE FIRST ARGUMENT IS FOR THE NORTHERN
C                      HEMISPHERE AND THE SECOND IS FOR THE
C                      SOUTHERN HEMISPHERE.
C
C     PRVSLA(2) REAL   HOLDS THE LATITUDE AT WHICH THE PROJECTION
C                      PLANE IS DRAWN FOR THE MAP IN THE PREVIOUS
C                      CALL OF MAPRET. (DEGREES)
C                      THE FIRST ARGUMENT IS FOR THE NORTHERN
C                      HEMISPHERE AND THE SECOND IS FOR THE
C                      SOUTHERN HEMISPHERE.
C
C     STDLON(2) REAL   HOLDS THE REFERENCE LONGITUDE FOR THE Y
C                      AXIS. (DEGREES)
C                      THE FIRST ARGUMENT IS FOR THE NORTHERN
C                      HEMISPHERE AND THE SECOND IS FOR THE
C                      SOUTHERN HEMISPHERE.
C
C     PRVSLO(2) REAL   HOLDS THE REFERENCE LONGITUDE FROM THE
C                      PREVIOUS CALL OF MAPRET. (DEGREES)
C                      THE FIRST ARGUMENT IS FOR THE NORTHERN
C                      HEMISPHERE AND THE SECOND IS FOR THE
C                      SOUTHERN HEMISPHERE.
C
C     MESH(2)   REAL   HOLDS THE MESH FACTOR OF THE MAP.
C                      THE FIRST ARGUMENT IS FOR THE NORTHERN
C                      HEMISPHERE AND THE SECOND IS FOR THE
C                      SOUTHERN HEMISPHERE.
C
C     PRVMES(2) REAL   HOLDS THE MESH FACTOR OF THE MAP IN THE
C                      PREVIOUS CALL OF MAPRET.
C                      THE FIRST ARGUMENT IS FOR THE NORTHERN
C                      HEMISPHERE AND THE SECOND IS FOR THE
C                      SOUTHERN HEMISPHERE.
C
C     PRVPAR   CH*8    HOLDS THE PARAMETER USED IN THE PREVIOUS
C                      CALL OF MAPRET.
C
C     SCAFAC    REAL   HOLDS THE SCALE FACTOR OF THE MAP.
C
C
C     PRVSCF    REAL   HOLDS THE SCALE FACTOR FROM THE LAST CALL
C                      TO MAPRET.
C
C     IMGDST(2) REAL   HOLDS THE DISTANCE BETWEEN POINTS ON THE
C                      IMAGE SURFACE IN KM. (IMAGE SURFACE DISTANCE)
C                      THE FIRST ARGUMENT IS FOR THE NORTHERN
C                      HEMISPHERE AND THE SECOND IS FOR THE
C                      SOUTHERN HEMISPHERE.
C
C     PRVISD(2) REAL   HOLDS THE IMAGE SURFACE DISTANCE FROM THE
C                      LAST CALL TO MAPRET. (KM)
C                      THE FIRST ARGUMENT IS FOR THE NORTHERN
C                      HEMISPHERE AND THE SECOND IS FOR THE
C                      SOUTHERN HEMISPHERE.
C
C     BLCK      INT    HOLDS THE NUMBER OF THE BLOCK IN WHICH THE
C                      LOCATION RESIDES.
C
C     PRVBLK    INT    HOLDS THE LAST LOCATION'S BLOCK NUMBER.
C
C     CHGFLG    LOG    LOGICAL SET TRUE TO INDICATE MORE RETRIEVALS
C                      ARE NECESSARY.
C
C     RETFLG    LOG    VECTOR OF LENGHT MAPCST:MAXLOC SET TRUE WHEN
C                      ALL RETRIEVALS HAVE BEEN MADE.
C
C     CELL      REAL   HOLDS THE CELL COORDINATES OF THE LOCATIONS.
C                      THIS IS A NUMLOC BY 2 ARRAY.
C
C     ICOOR     REAL   HOLDS THE LOCATIONS AFGWC I COORDINATE.
C
C     JCOOR     REAL   HOLDS THE LOCATIONS AFGWC J COORDINATE.
C
C     VALARR    REAL   HOLDS THE VALUES ARRAY RETURNED BY GMVALS.
C
C     I         INT    DO LOOP INDEX.
C
C
C     STATUS    INT    THE RETURN CODE FROM THE CDB ROUTINE GETPRM.
C
C   SUBPROGRAMS CALLED-  GMINFO, CALSF, DEGIDX, REALCOEF,
C                        CALPOS, GMVALS, RETVAL, MAPRE$
C
C   EXIT STATES-
C       10 - NON-FATAL ERROR: THE INPUT LATITUDE AND/OR LONGITUDE WERE
C                             OUT OF RANGE.
C
C       99 - FATAL ERROR:
C               1. AN ERROR WAS FOUND DUE TO IMPROPER VALUES IN EITHER
C                  THE MAP MANAGER'S CDB OR THE CONSTANT INCLUDE FILE
C                  MAPCST.
C               2. THE CDB MANAGER ENCOUNTERED PROBLEMS.
C
C***********************************************************************
C
      CHARACTER*8 PARM
      INTEGER     NUMLOC, ERROR, UNITNM
      INTEGER     BLKID1,BLKID2,BLKID3,BLKID4
      REAL        LAT(NUMLOC), LONG(NUMLOC), VALUE(NUMLOC)
C
      CHARACTER*8 CHEMIS(MAXLOC), PRVPAR, PRVHEM
      REAL        STDLAT(2), STDLON(2), MESH(2)
      REAL        VALAR1(WMESHC,WMESHC), VALAR2(WMESHC,WMESHC)
      REAL        VALAR3(WMESHC,WMESHC), VALAR4(WMESHC,WMESHC)
      REAL        SCLFAC, IMGDST(2), ICOOR, JCOOR, CELL(MAXLOC,2)
      REAL        PRVSCF,PRVISD(2),PRVSLA(2),PRVMES(2),PRVSLO(2)
      INTEGER     BLCK(MAXLOC), PRVBLK, IHEMIS, I, PBLCK
      INTEGER     CURUNT, PRVUNT, STATUS, USEBLK, BLK, COL, ROW
      LOGICAL     CHGFLG, RETFLG(MAXLOC), LOC1, LOC2, LOC3, LOC4
      LOGICAL     EQUATR
      LOGICAL   ISR4SPV
C
C
      INTEGER VLDNUM, DOUBLE
      PARAMETER (VLDNUM = 11)
      PARAMETER (DOUBLE = 8)
C
      SAVE PRVPAR, PRVSLA, PRVMES, PRVSCF, PRVISD, PRVSLO, PRVUNT,
     1     PRVBLK, PRVHEM, VALAR1,VALAR2, VALAR3, VALAR4, PBLCK, 
     1     BLKID1, BLKID2, BLKID3, BLKID4, USEBLK, LOC1, LOC2, 
     1     LOC3, LOC4
C
      INCLUDE 'SPVAL'
C
C   INITIALIZE SAVED VARIABLES.
C
      DATA PRVPAR /'        '/, PRVSLA /99.9,99.9/, PRVMES /0.0,0.0/,
     1  PRVSCF /0.0/,PRVISD /0.0,0.0/,PRVSLO /999.9,999.9/,PRVUNT /99/,
     2  PRVHEM/'        '/, PRVBLK /-1/
C
C   INITIALIZE VARIABLES.
C
C   NOTE:  THE ARRAYS VALARR, VALUE, CHEMIS, BLK, AND CELL ARE NOT
C          INITIALIZED HERE TO SAVE PROCESSING TIME.  THEY ARE SET
C          THROUGH CALLS TO OTHER SUBROUTINES.
C
      DO 10, I = 1,NUMLOC
         RETFLG(I) = .FALSE.
   10 CONTINUE
C
      IHEMIS    = 1
      STDLAT(1) = PRVSLA(1)
      STDLAT(2) = PRVSLA(2)
      STDLON(1) = PRVSLO(1)
      STDLON(2) = PRVSLO(2)
      MESH(1)   = PRVMES(1)
      MESH(2)   = PRVMES(2)
      SCLFAC    = PRVSCF
      IMGDST(1) = PRVISD(1)
      IMGDST(2) = PRVISD(2)
      ERROR     = 0
      ICOOR     = 0
      JCOOR     = 0
      CHGFLG    = .TRUE.

C
C   GET CURRENT CDB'S UNIT NUMBER.
C
      STATUS = 0

C 
C     SET ARGUMENT PARAMETER VALUE 1.
C 
      CURUNT = UNITNM          
C
C   DETERMINE IF THE PARAMETER IS THE SAME AS LAST CALL.
C
C
      IF ((PARM .NE. PRVPAR) .OR. (CURUNT .NE. PRVUNT) .OR.
     1    (MESH(1) .LE. 0.0) .OR. (ABS(STDLAT(1)) .GT. 90.0) .OR.
     2    (MESH(2) .LE. 0.0) .OR. (ABS(STDLAT(2)) .GT. 90.0) .OR.
     3    (ABS(STDLON(1)).GT.180.0).OR.(ABS(STDLON(2)).GT.180.0)) THEN
C
C         PARAMETER IS NOT THE SAME AS THE PREVIOUS CALL.
C         GET MAP INFORMATION (STANDARD LATITUDE, STANDARD LONGITUDE,
C         AND MESH FACTOR) FROM CDB.
C
         PRVBLK = -1
         CALL GMINFO (UNITNM, PARM, 'NORTHERN', STDLAT(1), STDLON(1),
     1                MESH(1), ERROR)
         IF(ERROR.NE.0) GO TO 70

         CALL GMINFO (UNITNM, PARM, 'SOUTHERN', STDLAT(2), STDLON(2),
     1                MESH(2), ERROR)
         IF(ERROR.NE.0) GO TO 70
C
C         MAKE SURE THE STANDARD LATITUDE IS NOT THE SAME AS LAST CALL.
C         THIS SECTION IS FOR THE NORTHERN HEMISPHERE.
C
         IF (STDLAT(1) .NE. PRVSLA(1)) THEN
C
C            CALCULATE SCALING FACTOR AND IMAGE SURFACE DISTANCE
C            OF EACH HEMISPHERE.
C
            CALL CALSF ( STDLAT(1), 1, SCLFAC, ERROR)
            IF(ERROR.NE.0) GO TO 70
            IMGDST(1) = MESDST * SCLFAC * MESH(1)
C
C         CHECK FOR ERRONEOUS RESULT
C
            IF (IMGDST(1) .LE. 0.0) THEN
               CALL MAPRE$(210,PARM,BLK,ROW,COL,SCLFAC,MESH(1),MESDST, 
     1                     ERROR) 
               GOTO 70
            ENDIF
C
         ELSE IF (MESH(1) .NE. PRVMES(1)) THEN
C
C             CALCULATE IMAGE SURFACE DISTANCE OF THE MAP.
C
            IMGDST(1) = MESDST * SCLFAC * MESH(1)
C
C         CHECK FOR ERRONEOUS RESULT
C
            IF (IMGDST(1) .LE. 0.0) THEN
               CALL MAPRE$(210,PARM,BLK,ROW,COL,SCLFAC,MESH(1),MESDST, 
     1                     ERROR) 
               GOTO 70
            ENDIF
C
         END IF
C
C         MAKE SURE THE STANDARD LATITUDE IS NOT THE SAME AS LAST CALL.
C         THIS SECTION IS FOR THE SOUTHERN HEMISPHERE.
C
         IF (STDLAT(2) .NE. PRVSLA(2)) THEN
C
C             CALCULATE SCALING FACTOR AND IMAGE SURFACE DISTANCE
C             OF EACH HEMISPHERE.
C
            CALL CALSF ( STDLAT(2), -1, SCLFAC, ERROR)
            IF(ERROR.NE.0) GO TO 70
            IMGDST(2) = MESDST * SCLFAC * MESH(2)
C
C         CHECK FOR ERRONEOUS RESULT

            IF (IMGDST(2) .LE. 0.0) THEN
               CALL MAPRE$(210,PARM,BLK,ROW,COL,SCLFAC,MESH(2),MESDST, 
     1                     ERROR) 
               GOTO 70
            ENDIF
C
         ELSE IF (MESH(2) .NE. PRVMES(2)) THEN
C
C             CALCULATE IMAGE SURFACE DISTANCE OF THE MAP.
C
            IMGDST(2) = MESDST * SCLFAC * MESH(2)
C
C         CHECK FOR ERRONEOUS RESULT
C
            IF (IMGDST(2) .LE. 0.0) THEN
               CALL MAPRE$(210,PARM,BLK,ROW,COL,SCLFAC,MESH(2),MESDST, 
     1                     ERROR) 
               GOTO 70
            ENDIF
C
         END IF
C
      END IF
C
C   LOOP THRU EACH LOCATION, GETTING MAP LOCATION AND RETURNING ITS
C   VALUE.
C
      DO 30,I = 1, NUMLOC
C
C         CALCULATE HEMISPHERE OF POINT.
C
         IF (LAT(I) .GE. 0.0) THEN
C
C         POINT IN NORTHERN HEMISPHERE.
C
            CHEMIS(I) = 'NORTHERN'
            IHEMIS = 1
C
         ELSE
C
C         POINT IN SOUTHERN HEMISPHERE
C
            CHEMIS(I) = 'SOUTHERN'
            IHEMIS = -1

         END IF
C
C         CALCULATE POINTS POSITION ON MAP.
C
         IF (IHEMIS .EQ. 1) THEN
            CALL DEGIDX (LAT(I), LONG(I), STDLAT(1), STDLON(1), MESH(1),
     1              IHEMIS,IMGDST(1), ICOOR, JCOOR, ERROR)
            if (error.ne.0) then
               print *,'DEGIDX error ',error,' for location index ',I
               print *,'Lat/Lon = ',LAT(I),LONG(I)
            end if
            IF(ERROR.EQ.99) GO TO 70
            IF(ERROR.EQ.10) GO TO 20
C
            CALL CALPOS (ICOOR, JCOOR, MESH(1), BLCK(I), CELL(I,1),
     1                 CELL(I,2), ERROR)
            IF(ERROR.NE.0) GO TO 70
         ELSE
            CALL DEGIDX (LAT(I), LONG(I), STDLAT(2), STDLON(2), MESH(2),
     1              IHEMIS,IMGDST(2), ICOOR, JCOOR, ERROR)
            if (error.ne.0) then
               print *,'DEGIDX error ',error,' for location index ',I
               print *,'Lat/Lon = ',LAT(I),LONG(I)
            end if
            IF(ERROR.EQ.99) GO TO 70
            IF(ERROR.EQ.10) GO TO 20
C
            CALL CALPOS (ICOOR, JCOOR, MESH(2), BLCK(I), CELL(I,1),
     1                 CELL(I,2), ERROR)
            IF(ERROR.NE.0) GO TO 70
         END IF
C
C
         RETFLG(I) = .FALSE.

         GOTO 30
C
C         A NON-FATAL ERROR OCCURED SET RETURN VARIABLES TO SPECIAL
C         VALUES AND CONTINUE WITH LOOP.
C
   20    CONTINUE
         VALUE(I) = R4SPV
         RETFLG(I) = .TRUE.
C
   30 CONTINUE
C
C     THE FOLLOWING CODE IS TO PROCESS ALL VALUES IN A GIVEN BLOCK
C     (VALAR1 - 4) OBTAINED FROM THE MAPPARM CDB TO SAVE ON CPU TIME.
C
C     THE LOGICAL ARRAY (RETFLG) WILL PROCESS EACH CELL OF VALAR
C     WITHIN THE CURRENT BLOCK AND KEEP LOOPING, GETTING A NEW BLOCK
C     EACH PASS UNTIL ALL ELEMENTS OF RETFLG ARE SET TRUE.
C
   40 CHGFLG = .FALSE.
C
C
      DO 50,I = 1,NUMLOC
C
C        IF THE LATITUDE OF THE REQUESTED LOCATION IS WITHIN
C        0.25 DEGREES OF THE EQUATOR, SET THE 'EQUATR' FLAG
C        TO .TRUE. FOR THE CALL TO RETVAL TO PREVENT 'OFF-
C        THE-EARTH' ERRORS FOR I/J ROUNDING. (WR #99)
C
         IF (ABS(LAT(I)).GT.0.25) THEN
            EQUATR = .FALSE.
         ELSE
            EQUATR = .TRUE.
         END IF
            
         IF (CHEMIS(I) .NE. PRVHEM) THEN
C
            PRVBLK = -1
C
         END IF
C
         IF (.NOT.(RETFLG(I))) THEN
C
            IF (PRVBLK .EQ. -1) THEN

               IF ((PARM.NE.PRVPAR).OR.(CHEMIS(I).NE.PRVHEM)) THEN
                  BLKID1 = -1 
                  BLKID2 = -1
                  BLKID3 = -1
                  BLKID4 = -1
                  LOC1  = .TRUE.
                  LOC2  = .FALSE.
                  LOC3  = .FALSE.
                  LOC4  = .FALSE.
               ENDIF
C
               IF ((PARM.NE.PRVPAR).OR.(CHEMIS(I).NE.PRVHEM).OR.
     1            (BLCK(I).NE.PBLCK)) THEN


                  IF (BLCK(I).EQ.BLKID1) THEN
                     USEBLK = 1
                  ELSE IF(BLCK(I).EQ.BLKID2) THEN
                     USEBLK = 2
                  ELSE IF(BLCK(I).EQ.BLKID3) THEN
                     USEBLK = 3
                  ELSE IF(BLCK(I).EQ.BLKID4) THEN
                     USEBLK = 4
               ELSE

                  IF (LOC1) THEN
                     CALL GMVALS (UNITNM,PARM,CHEMIS(I),BLCK(I),VALAR1,
     1                            ERROR)
                     IF(ERROR.NE.0) GO TO 70
                     BLKID1 = BLCK(I)
                     USEBLK = 1
                     LOC1  = .FALSE.
                     LOC2  = .TRUE.
                     LOC3  = .FALSE.
                     LOC4  = .FALSE.

                  ELSE IF (LOC2) THEN
                     CALL GMVALS (UNITNM,PARM,CHEMIS(I),BLCK(I),VALAR2,
     1                            ERROR)
                     IF(ERROR.NE.0) GO TO 70
                     BLKID2 = BLCK(I)
                     USEBLK = 2 
                     LOC1  = .FALSE.
                     LOC2  = .FALSE.
                     LOC3  = .TRUE.
                     LOC4  = .FALSE.
                  ELSE IF(LOC3) THEN

                     CALL GMVALS (UNITNM,PARM,CHEMIS(I),BLCK(I),VALAR3,
     1                            ERROR)
                     IF(ERROR.NE.0) GO TO 70
                     BLKID3 = BLCK(I)
                     USEBLK = 3
                     LOC1  = .FALSE.
                     LOC2  = .FALSE.
                     LOC3  = .FALSE.
                     LOC4  = .TRUE.
     
                  ELSE IF(LOC4) THEN
                     CALL GMVALS (UNITNM,PARM,CHEMIS(I),BLCK(I),VALAR4,
     1                            ERROR)
                     IF(ERROR.NE.0) GO TO 70
                     BLKID4 = BLCK(I)
                     USEBLK = 4 
                     LOC1  = .TRUE.
                     LOC2  = .FALSE.
                     LOC3  = .FALSE.
                     LOC4  = .FALSE.
                  ENDIF

               ENDIF

               PRVPAR = PARM
               PRVHEM = CHEMIS(I)
               PBLCK  = BLCK(I)

            ENDIF
C
            IF (USEBLK.EQ.1) THEN
               CALL RETVAL (VALAR1,CELL(I,1),CELL(I,2),EQUATR,VALUE(I),
     1                      ERROR)
               IF(ERROR.NE.0) GO TO 70
            ELSE IF (USEBLK.EQ.2) THEN
               CALL RETVAL (VALAR2,CELL(I,1),CELL(I,2),EQUATR,VALUE(I),
     1                      ERROR)
               IF(ERROR.NE.0) GO TO 70
            ELSE IF (USEBLK.EQ.3) THEN
               CALL RETVAL (VALAR3,CELL(I,1),CELL(I,2),EQUATR,VALUE(I),
     1                      ERROR)
               IF(ERROR.NE.0) GO TO 70
            ELSE 
               CALL RETVAL (VALAR4,CELL(I,1),CELL(I,2),EQUATR,VALUE(I),
     1                      ERROR)
               IF(ERROR.NE.0) GO TO 70

            ENDIF
C
C                 THE TERRAIN MAPS SHOULD NOT CONTAIN A MISSING VALUE.
C                 CHECK FOR MISSING VALUES, IN THESE MAPS AND IF ONE
C                 IS FOUND SHUT DOWN PROCESSING UNTIL THE MAP IS FIXED.
C
            IF ((PARM .EQ. 'SURFTYPE' .AND. ISR4SPV(VALUE(I)))
     1           .OR. (PARM .EQ. 'SURFELEV' .AND. ISR4SPV(VALUE(I))))
     2         THEN
               ROW = CELL(I,1)
               COL = CELL(I,2)
C              CALL MAPRE$ (-9,PARM,BLCK(I),CELL(I,1),CELL(I,2),
               CALL MAPRE$ (-9,PARM,BLCK(I),ROW,COL,
     1                      SCLFAC,MESH(1),MESDST,ERROR)
               GO TO 70 
            ENDIF
C
            PRVBLK = BLCK(I)
            PRVHEM = CHEMIS(I)
            CHGFLG = .TRUE.
            RETFLG(I) = .TRUE.
C
         ELSE IF (BLCK(I) .EQ. PRVBLK) THEN
C
            IF (USEBLK.EQ.1) THEN
               CALL RETVAL (VALAR1,CELL(I,1),CELL(I,2),EQUATR,VALUE(I),
     1                      ERROR)
               IF(ERROR.NE.0) GO TO 70
            ELSE IF (USEBLK.EQ.2) THEN 
               CALL RETVAL (VALAR2,CELL(I,1),CELL(I,2),EQUATR,VALUE(I),
     1                      ERROR)
               IF(ERROR.NE.0) GO TO 70
            ELSE IF (USEBLK.EQ.3) THEN
               CALL RETVAL (VALAR3,CELL(I,1),CELL(I,2),EQUATR,VALUE(I),
     1                      ERROR)
               IF(ERROR.NE.0) GO TO 70
            ELSE 
               CALL RETVAL (VALAR4,CELL(I,1),CELL(I,2),EQUATR,VALUE(I),
     1                      ERROR)
               IF(ERROR.NE.0) GO TO 70
            ENDIF
C
C                 THE TERRAIN MAPS SHOULD NOT CONTAIN A MISSING VALUE.
C                 CHECK FOR MISSING VALUES, IN THESE MAPS AND IF ONE
C                 IS FOUND SHUT DOWN PROCESSING UNTIL THE MAP IS FIXED.
C
            IF ((PARM .EQ. 'SURFTYPE' .AND. ISR4SPV(VALUE(I)))
     1          .OR. (PARM .EQ. 'SURFELEV' .AND. ISR4SPV(VALUE(I))))
     2         THEN
               ROW = CELL(I,1)
               COL = CELL(I,2)
c              CALL MAPRE$ (-9,PARM,BLCK(I),CELL(I,1),CELL(I,2),
               CALL MAPRE$ (-9,PARM,BLCK(I),ROW,COL,
     1                      SCLFAC,MESH(1),MESDST,ERROR)
               GO TO 70  
            ENDIF
C
            RETFLG(I) = .TRUE.
C
         END IF
C
      END IF
C
C         IF MORE SPOTS IN THIS PASS PROCESS NEXT SPOT.
C
   50 CONTINUE
C
C         IF THERE ARE MORE RETRIEVALS NECESSARY MAKE NEXT PASS.
C
      IF (CHGFLG) THEN
          PRVBLK = -1
          GOTO 40
      END IF
C
C SAVE THIS CALLS VALUES.
C
      PRVPAR = PARM
      PRVSLA(1) = STDLAT(1)
      PRVSLA(2) = STDLAT(2)
      PRVSLO(1) = STDLON(1)
      PRVSLO(2) = STDLON(2)
      PRVMES(1) = MESH(1)
      PRVMES(2) = MESH(2)
      PRVSCF = SCLFAC
      PRVISD(1) = IMGDST(1)
      PRVISD(2) = IMGDST(2)
      PRVUNT = CURUNT
       
C
C     RETURN TO CALLING ROUTINE.
C
   70 CONTINUE
      RETURN
      END
C
      SUBROUTINE MAPRE$ (MSGCOD,PARM,BLK,ROW,COL,SCLFAC,MESH,MESDST,
     1                   STAT)
      IMPLICIT NONE
C**********************************************************************
C   NAME- MAPRE$
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- 08/04/97   PROGRAMMER- LEAH WILSON (HSTX)
C   VERSION- 3.1    DATE- 07/30/01   PROGRAMMER- FRANK TILLEY (RAYTHEON)
C
C   FUNCTION- THIS SUBROUTINE IS THE ERROR HANDLING ROUTINE FOR
C             ROUTINE MAPRET.
C   VERSION- 3.0 CONVERSION FROM MMLF TO KIDS CONVENTION.
C   VERSION- 3.1 CORRECTED BLOCK NUMBER PLACEMENT FROM BYTES 52:55 TO
C                62:65 IN THE KIDS ERROR MESSAGE FOR MSGCOD -9. ADDED
C                CODE TO WRITE OUT ERROR MESSAGES TO STANDARD OUTPUT
C                IN ADDITION TO SENDING THEM TO THE KIDS FILE. (WR #99)
C
C   FILES-
C
C     DSN                    I/O   UNIT   FUNCTIONAL DESCRIPTION
C     ---                    ---  ------  -----------------------
C     .../KIDS                O    KUNIT  KRAY I/A DOCUMENTATION SYSTEM
C
C   COMMON AREA PARAMETERS-
C
      INCLUDE 'ERPARM'
      INCLUDE 'ERINFO'
      INCLUDE 'SPGUNT'
C
C   CALLING SEQUENCE PARAMETERS-
C
C     VARIABLE               TYPE  I/O  FUNCTION
C     --------               ----  ---  --------
C     MSGCOD                  INT   I   MESSAGE CODE USED TO
C                                       IDENTIFY THE ERROR.
C     PARM                   CH*8   I   TERRAIN MAP TYPE.
C     BLK                     INT   I   BLOCK NUMBER.
C     ROW                     INT   I   ROW INDEX.
C     COL                     INT   I   COLUMN INDEX.
C     STAT                    INT   O   STATUS CODE IF AN ERROR
C                                       OCCURS DURING I/O.
C
C   LOCAL PARAMETERS-
C
C     ARGUMENT    TYPE    DESCRIPTION
C     --------    ----    -----------
C     IROW         INT    INTEGER ROW INDEX.
C     ICOL         INT    INTEGER COLUMN INDEX.
C     I            INT    IMPLIED DO INDEX.
C     C4TEMP      CH*4    TEMPORARY FOR WRITING INTO KMSG. 
C     C7TEMP      CH*7    TEMPORARY FOR WRITING INTO KMSG. 
C     KMSG       CH*100   KIDS MESSAGE BUFFER.
C
C   SUBPROGRAMS CALLED- KIDS
C
C**********************************************************************
      INTEGER     MSGCOD, STAT, BLK
C     REAL        COL, ROW
      REAL     SCLFAC, MESH, MESDST
      CHARACTER*4 C4TEMP
      CHARACTER*7 C7TEMP
      CHARACTER*8 PARM
      CHARACTER*100 KMSG
C
      INTEGER     ROW, COL, I, IROW, ICOL
C
C  SET SUBNAM TO MAIN MODULE, SINCE KIDS FILLS IN SUBROUTINE NAME.
C
      SUBNAM = 'SPGDVR'
      STAT = 0
C
C     CHECK THE MSGCOD TO DETERMINE WHICH MESSAGE TO PUT INTO KIDS.
C
      IF (MSGCOD .EQ. -9) THEN
C
C        THIS IS A FATAL ERROR
C
         IROW = ROW
         ICOL = COL
         KMSG(1:50)='* FATAL ERROR * Missing value found in terrain map'
         KMSG(51:100)=': MAP          BLOCK      ROW      COL     '
         KMSG(57:64) = PARM
         WRITE(C4TEMP,'(I4)') BLK 
         KMSG(72:75) = C4TEMP
         WRITE(C4TEMP,'(I4)') IROW 
         KMSG(81:84) = C4TEMP
         WRITE(C4TEMP,'(I4)') ICOL
         KMSG(90:93) = C4TEMP
         PRINT *, KMSG
         CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
         STAT = 99
C
C
C  CHECK MESSAGE CODE AND WRITE ERROR MESSAGE
C
      ELSEIF (MSGCOD .EQ. 210) THEN
         KMSG(1:50)='* FATAL ERROR * Img. sfc dist <=0 was calculated. '
         KMSG(51:100)='SCLFAC =         MESH =         MESDST =        '
         WRITE(C7TEMP,'(F7.3)') SCLFAC
         KMSG(60:66) = C7TEMP
         WRITE(C7TEMP,'(F7.3)') MESH
         KMSG(75:81) = C7TEMP
         WRITE(C7TEMP,'(F7.3)') MESDST
         KMSG(92:98) = C7TEMP
         KMSG(90:93) = C4TEMP
         PRINT *, KMSG
         CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
         STAT = 99
      ELSE
C
C NOT A VALID MSGCOD
C
        STAT=0
        KMSG = 'Invalid message code      '
        WRITE(C4TEMP,'(I4)') MSGCOD
        KMSG(22:25) = C4TEMP
        CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
      ENDIF
      RETURN
      END
