      SUBROUTINE DEGIDX (LAT,LONG,STDLAT,STDLON,MESH,HEMIS,IMGDST,
     1                   ICOOR,JCOOR,ERROR)
C**********************************************************************
C
C   NAME- DEGIDX
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     USE DEGRAD AS A VARIABLE FROM /RMPARM/, RATHER THAN AS A FUNCTION.
C
C   DESCRIPTION- THIS SUBROUTINE TAKES A POINT OF LATITUDE AND LONGITUDE
C                 (L) AS INPUT AND CONVERTS THEM INTO THE INDEXING
C                 CONVENTION (I,J) (HOKE, 1981) FOR LOCATING ON A GRID
C                 CORRESPONDING TO A POLAR STEREOGRAPHIC MAP. THE
C                 FOLLOWING EQUATIONS (HOKE, 1981) MAKE USE OF THE MAPS
C                 POLAR COORDINATES (JP AND IP) STANDARD LONGITUDE (SL),
C                 AND THE RADIAL DISTANCE (RM) AS COMPUTED BY CALRD.
C                 H IS THE LATITUDES HEMISPHERE (+1 OR -1).
C
C                        I = IP + RM COS (L - SL)
C                        J = JP - H RM SIN (L - SL)
C
C                 THE MESH FACTOR, LATITUDE, LONGITUDE, STANDARD
C                 LATITUDE AND STANDARD LONGITUDE ARE CHECKED FOR VALID
C                 VALUES.  LATITUDES MUST BE IN THE RANGE OF - 90.0 TO
C                 +90.0 AND LONGITUDES MUST BE BETWEEN -180.0 TO +180.0.
C                 THE MESH FACTOR MUST BE GREATER THAN ZERO. IF
C                 ANY OF THESE ARE OUT OF RANGE, THE DEGID$ IS CALLED TO
C                 CALLED TO WRITE A MESSAGE TO THE KIDS MESSAGE
C                 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", PGS 23-34
C
C   CALLING SEQUENCE PARAMETERS-
C
C       NAME   TYPE  I/O                   DESCRIPTION
C      ------  ----  ---  --------------------------------------------
C      LAT     REAL   I   LATITUDE OF THE POINT IN DEGREES.
C
C      LONG    REAL   I   LONGITUDE OF THE POINT IN DEGREES.
C
C      STDLAT  REAL   I   LATITUDE AT WHICH PROJECTION PLANE IS DRAWN.
C                         (STANDARD LATITUDE) (DEGREES)
C
C      STDLON  REAL   I   REFERENCE LONGITUDE OF THE POSITIVE X AXIS.
C                         THE REFERENCE LONGITUDE IS LOCATED AT THE
C                         BOTTOM OF THE MAP. (DEGREES)
C
C      MESH    REAL   I   THE MESH FACTOR OF THE MAP.
C
C      HEMIS   INT    I   THE HEMISPHERE VALUE. +1 FOR NORTHERN
C                         HEMISPHERE, -1 FOR SOUTHERN HEMISPHERE.
C
C      IMGDST  REAL   I   HOLDS THE IMAGE SURFACE DISTANCE. (KM)
C
C      ICOOR   REAL   O   THE ROW AFGWC INDEX OF THE POINT.
C
C      JCOOR   REAL   O   THE COLUMN AFGWC INDEX OF THE POINT.
C
C      ERROR   INT   I/O  ERROR CODE.
C                            0 - SUCCESSFUL COMPLETION.
C                           10 - NON-FATAL ERROR.
C                           99 - FATAL ERROR.
C
C      *              I   LABEL IN THE CALLING ROUTINE THAT HANDLES
C                         ERRORS.
C
C   COMMON AREA PARAMETERS-
C
      INCLUDE 'MAPCST'
      INCLUDE 'RMPARM'
C
C   LOCAL PARAMETERS-
C
C       NAME   TYPE   I/O                  DESCRIPTION
C      ------  ----   ---  -------------------------------------------
C      POLCOR  REAL   N/A  THE AFGWC ROW AND COLUMN INDEX FOR THE POLE.
C      RADDST  REAL   N/A  THE RADIAL DISTANCE ON THE IMAGE PLANE
C                          BETWEEN THE POLE AND THE LATITUDE OF THE
C                          THE POINT IN MULTIPLES OF GRID LENGTH
C                          (DISTANCE OF WHOLE MESH GRIDS AT
C                          STANDARD LATITUDE * SCALING FACTOR * MESH
C                          FACTOR). (KM)
C      LONCOS  REAL   N/A  USED FOR CHECKING ROUNDING ERROR OF COSINE
C                          OF THE DIFFERENCE BETWEEN LONGITUDES.
C
C   SUBPROGRAMS CALLED- CALRD, DEGID$, XEQY
C
      LOGICAL XEQY
C
C   INTRINSIC FUNCTIONS- COS, SIN
C
      INTRINSIC COS, SIN
C
C   EXIT STATES-
C      10 - NONFATAL ERROR: THE INPUT LATITUDE AND/OR LONGITUDE IS/ARE
C                           OUT OF RANGE.
C      99 - FATAL ERROR: AN INVALID VALUE WAS FOUND, POSSIBLY IN THE
C                        INCLUDE MAPCST.
C
C   COMMENTS-
C      1. HEMIS WAS COMPUTED TO BE -1 OR +1 IN A HIGHER ROUTINE.
C      2. MESH IS A VALID REAL NUMBER (READ IN A HIGHER LEVEL ROUTINE).
C      3. POLE IS AT THE CENTER OF THE POLAR STEREOGRAPHIC MAP.
C
C**********************************************************************
C
      REAL     LAT, LONG, STDLAT, STDLON, MESH, IMGDST, ICOOR, JCOOR
      INTEGER  HEMIS, ERROR
C
      REAL     POLCOR, RADDST, LONCOS
C
C     INITIALIZE OUTPUT VARIABLES.
C
      ICOOR = 0.0
      JCOOR = 0.0
C
C     INITIALIZE LOCAL VARIABLES.
C
      POLCOR = 0.0
      RADDST = 0.0
      LONCOS = 0.0
C
C     MAKE SURE STANDARD LATITUDE AND LONGITUDE IS WITHIN PROPER RANGE.
C
      IF ((STDLAT .LT. -90.0) .OR. (STDLAT .GT. 90.0) .OR.
     1    (STDLON .LT. -180.0) .OR. (STDLON .GT. 180.0)) THEN
C
C          HANDLE ERROR.
C
           CALL DEGID$ (520, STDLAT, STDLON, ERROR)
           GOTO 10
C
C
C     MAKE SURE LATITUDE AND LONGITUDE ARE WITHIN PROPER RANGE.
C
      ELSE IF (((LAT .GE. -90.0) .AND. (LAT .LE. 90.0)) .AND.
     1         ((LONG .GE. -180.0) .AND. (LONG .LE. 180.0))) THEN

C
C          MAKE SURE MESH FACTOR IS A VALID VALUE.
C
           IF (MESH .LE. 0.0) THEN
C
C               HANDLE ERROR.
C
                CALL DEGID$ (530, MESH, 0.0, ERROR)
                GOTO 10
C
           ELSE
C
C               CALCULATE THE AFGWC POLAR COORDINATES. WMESHC, A
C               CONSTANT EQUAL TO THE NUMBER OF CELLS ON AN AXIS IN A
C               WHOLE MESH GRID IS DIVIDED BY THE MESH FACTOR FOR THE
C               MAP TO GET THE NUMBER OF BLOCKS ON THE CURRENT MAP.
C
C
                POLCOR = 1 + ((WMESHC/MESH)/ 2)
C
C               CALCULATE THE RADIAL DISTANCE.
C
                CALL CALRD ( LAT, STDLAT, IMGDST, HEMIS,
     1                       RADDST, ERROR)
                IF(ERROR.NE.0) GO TO 10
C
C               CALCULATE INDICES.
C
                JCOOR = POLCOR-(HEMIS*RADDST*SIN(DEGRAD*(LONG-STDLON)))
C
C               CALCULATE COSINE OF DIFFERENCE BETWEEN LONGITUDES TO
C               CHECK FOR ROUNDING ERROR.
C
                LONCOS = COS (DEGRAD*(LONG - STDLON))
                IF (XEQY (LONCOS, 0.0, 0.0001)) THEN
C
                    LONCOS = 0.0
C
                END IF
C
                ICOOR = POLCOR + (RADDST * LONCOS)
           END IF
C
      ELSE
C
C          HANDLE ERROR.
C
           CALL DEGID$ (510, LAT, LONG, ERROR)
C
      ENDIF
   10 RETURN
C
      END
C**********************************************************************
      SUBROUTINE DEGID$(MSGCOD,ARG1,ARG2,STAT)
      IMPLICIT NONE
C**********************************************************************
C   NAME- DEGID$
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- 2.0  DATE- 05/21/96   PROGRAMMER- ALEX POZDNYAK (FDC)     
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 DEGIDX.
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     ARG1                    REAL  I   DEPENDING ON THE ERROR, THIS
C                                       WILL HOLD EITHER THE LATITUDE,
C                                       STANDARD LATITUDE, OR THE MESH
C                                       FACTOR.
C
C     ARG2                    REAL  I   DEPENDING ON THE ERROR, THIS
C                                       WILL HOLD EITHER THE LONGITUDE
C                                       OR THE STANDARD LONGITUDE.
C
C     STAT                    INT   O   STATUS CODE IF AN ERROR
C                                       OCCURS DURING I/O
C
C   COMMON AREA PARAMETERS-
C
      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     C10TMP                  CH*10   HOLDING BUFFER FOR WRITING TO KIDS
C
C   SUBROUTINES CALLED- KIDS
C
C**********************************************************************
C
      INTEGER   MSGCOD,STAT
      REAL      ARG1, ARG2
      CHARACTER*4   C4TEMP
      CHARACTER*10  C10TMP
      CHARACTER*100 KMSG
C
C  SET ERINFO:SUBNAM
C
      SUBNAM = 'SPGDVR '
C
C  CHECK MESSAGE CODE AND WRITE ERROR MESSAGE
C
      IF (MSGCOD .EQ. 510) THEN
        print *,'DEGIDX invalid lat/lon = ',ARG1, ARG2
        KMSG(1:50)=' * WARNING * Lat. and/or Long. are out of range.  '
        KMSG(51:100)='Latitude =             Longitude =           '
        WRITE(C10TMP,'(F10.4)') ARG1
        KMSG(62:71) = C10TMP
        WRITE(C10TMP,'(F10.4)') ARG2
        KMSG(86:95) = C10TMP
        STAT=10
        CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
C
      ELSE IF (MSGCOD .EQ. 520) THEN
        KMSG(1:50)=' * FATAL ERROR * STD. lat. and/or lon. out of rang'
        KMSG(51:100)='e.  STDLAT =            STDLON =           '
        WRITE(C10TMP,'(F10.4)') ARG1
        KMSG(64:73) = C10TMP
        WRITE(C10TMP,'(F10.4)') ARG2
        KMSG(84:93) = C10TMP
        STAT = 99
        CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
C
      ELSE IF (MSGCOD .EQ. 530) THEN
        KMSG=' * FATAL ERROR * Mesh factor            <= 0.'
        WRITE(C10TMP,'(F10.4)') ARG1
        KMSG(31:40) = C10TMP
        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
