      SUBROUTINE CALRD(LAT,STDLAT,IMGDST,HEMIS,RADDST,ERROR)
C**********************************************************************
C
C   NAME- CALRD
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. 
C   VERSION- 3.1  DATE- 09/05/97   PROGRAMMER- LEAH WILSON (HSTX)
C     REMOVE DEGRAD AS A FUNCTION CALL, INCLUDE /RMPARM/.
C
C   DESCRIPTION- THIS ROUTINE COMPUTES THE RADIAL DISTANCE ON THE IMAGE
C                PLANE BETWEEN THE POLE AND THE LATITUDE (L) USING THE
C                FOLLOWING EQUATION (HOKE, 1981):
C
C                                RM = A S COS(L)/DI
C
C                WHERE A IS THE RADIUS OF THE EARTH SET AS A CONSTANT
C                IN THE INCLUDE MAPCST,DI IS THE IMAGE SURFACE DISTANCE,
C                AND S IS THE IMAGE SCALE AS CALCULATED BY IMGSCL. A
C                CHECK IS MADE TO ENSURE THAT DI IS NOT LESS THAN OR
C                EQUAL TO 0. IF IT IS, CALRD$ IS CALLED TO WRITE A
C                MESSAGE TO THE ERROR LOG AND SET THE ERROR RETURN CODE.
C
C                REFERENCE: HOKE, HAYES, AND RENNIGER, MARCH 1981,
C                           "MAP PROJECTIONS AND GRID SYSTEMS FOR
C                           METEOROLOGICAL APPLICATIONS", PG. 34
C
C   CALLING SEQUENCE PARAMETERS-
C
C       NAME   TYPE  I/O               DESCRIPTION
C      ------  ----  ---  -------------------------------------------
C      LAT     REAL   I   THE LATITUDE OF THE POINT. (DEGREES)
C
C      STDLAT  REAL   I   LATITUDE AT WHICH THE PROJECTION PLANE IS
C                         DRAWN. (DEGREES)
C
C      IMGDST  REAL   I   THE DISTANCE BETWEEN GRID POINTS ON THE IMAGE
C                         IMAGE SURFACE. (KM)
C
C      HEMIS   INT    I   THE HEMISPHERE VALUE. +1 FOR NORTHERN
C                         HEMISPHERE, -1 FOR SOUTHERN HEMISPHERE.
C
C      RADDST  REAL   O   THE CALCULATED RADIAL DISTANCE OF THE
C                         POINT. (KM)
C
C      ERROR   INT    O   THE RETURN CODE OF THE ROUTINE.
C                             0 - SUCCESSFUL COMPLETION.
C                            99 - FATAL ERROR OCCURRED.
C
C      *              I   THE LABEL IN THE CALLING ROUTINE THAT HANDLES
C                         ERRORS
C
C   COMMON AREA PARAMETERS- MAPCST
C
      INCLUDE 'MAPCST'
      INCLUDE 'RMPARM'
C
C   LOCAL PARAMETERS-
C
C       NAME   TYPE  I/O                   DESCRIPTION
C      ------  ----  ---  -------------------------------------------
C      IMGSCA  REAL  N/A  THE IMAGE SCALE OF THE POINT AT THE GIVEN
C                         LATITUDE.
C      LATCOS  REAL  N/A  HOLDS THE COSINE OF THE LATITUDE. THIS IS
C                         USED FOR FIXING A ROUND OFF ERROR.
C
C   SUBPROGRAMS CALLED-  IMGSCL, CALRD$, XEQY
C
      LOGICAL XEQY
C
C   INTRINSIC FUNCTIONS- COS
C
      INTRINSIC COS
C
C   EXIT STATES-
C      99 - FATAL ERROR: AN IMAGE SURFACE DISTANCE LESS THAN OR EQUAL TO
C                        0 WAS FOUND.  IF 0 A DIVISION ZERO ERROR
C                        OCCURRED.  OTHERWISE RESULTS IN VALID.
C
C   COMMENTS-
C      1. LAT IS IN THE RANGE -90.0 TO +90.0 AND HAS BEEN CHECKED IN A
C         HIGHER LEVEL ROUTINE.
C      2. STDLAT IS IN THE RANGE -90.0 TO +90.0 AND HAS BEEN CHECKED
C         IN A HIGHER LEVEL ROUTINE.
C      3. HEMIS HAS A VALUE OF -1 OR +1. (COMPUTED IN A HIGHER ROUTINE).
C
C
C**********************************************************************
C
      REAL     LAT, STDLAT, IMGDST, RADDST
      INTEGER  HEMIS, ERROR
      REAL     IMGSCA, LATCOS
C
C     INITIALIZE VARIABLES
C
      RADDST = 0.0
      IMGSCA = 0.0
      LATCOS = 0.0
C
C     MAKE SURE IMAGE SURFACE DISTANCE IS GREATER THAN 0.
C
      IF (IMGDST .LE. 0.0) THEN
          CALL CALRD$ (410, IMGDST, ERROR)
C
      ELSE
C
C         CALCULATE IMAGE SCALE
C
          CALL IMGSCL( LAT, STDLAT, HEMIS, IMGSCA, ERROR)
          IF(ERROR.NE.0) GO TO 10
C
C         CALCULATE COSINE OF LATITUDE.
C
          LATCOS = COS (LAT*DEGRAD)
          IF (XEQY (LATCOS, 0.0, 0.0001)) THEN
              LATCOS = 0.0
          END IF
C
C         CALCULATE RADIAL DISTANCE.
C
          RADDST = (EARTHR * IMGSCA * LATCOS) / IMGDST
C
      END IF
C
   10 RETURN
      END
C**********************************************************************
      SUBROUTINE CALRD$(MSGCOD,IMGDST,STAT)
C**********************************************************************
C   NAME- CALRD$
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/07/97   PROGRAMMER- LEAH WILSON (HSTX)
C
C   FUNCTION- THIS SUBROUTINE IS THE ERROR HANDLING ROUTINE FOR
C             ROUTINE CALRD.
C   VERSION- 3.0 WRITE ERROR MESSAGES TO THE KIDS FILE.  INCLUDE /SPGUNT/.
C
C   FILES-
C     DSN                    I/O   UNIT   FUNCTIONAL DESCRIPTION
C     ---                    ---  ------  -----------------------
C     ...KIDS                 O    KUNIT   KRAY INTERACTIVE DOCUMENTATION
C
C   CALLING SEQUENCE PARAMETERS-
C
C     VARIABLE               TYPE  I/O  FUNCTION
C     --------               ----  ---  --------
C     MSGCOD                  INT   I   MESSAGE CODE USED TO
C                                       IDENTITIFY THE ERROR.
C
C     IMGDST                  REAL  I   THE IMAGE SURFACE DISTANCE.
C
C     STAT                    INT   O   STATUS CODE IF AN ERROR
C                                       OCCURS DURING I/O
C
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
      CHARACTER*4   C4TEMP
      CHARACTER*7   C7TEMP
      CHARACTER*100 KMSG
      INTEGER  MSGCOD,STAT
      REAL     IMGDST
C
C  SET ERINFO:SUBNAM
C
      SUBNAM = 'SPGDVR'
C
C  CHECK MESSAGE CODE AND WRITE ERROR MESSAGE
C
      IF (MSGCOD .EQ. 410) THEN
        KMSG(1:50)=' * FATAL ERROR * Image surface distance <= 0 was f'
        KMSG(51:100)='ound. IMGDST =         '
        WRITE(C7TEMP,'(F7.3)') IMGDST
        KMSG(66:72) = C7TEMP
        STAT = 99
        CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
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

