      SUBROUTINE RDNMC(HOUR, ERSTAT)
      IMPLICIT NONE
C********************************************************************
C
C   NAME- RDNMC
C
C   LANGUAGE- FORTRAN 77     TYPE- SUBROUTINE      COMPUTER- CRAY
C
C   VERSION- 1.0    DATE- 02/15/95   PROGRAMMER- LEAH CASEY (HUGHES STX)
C   VERSION- 2.0    DATE- 06/29/95   PROGRAMMER- ALEX POZDNYAK (SMSRC)
C   VERSION- 3.0    DATE- 05/14/96   PROGRAMMER- ALEX POZDNYAK, FDC
C      FOR REHOSTING TO THE CRAY, CHANGED ALL I*4 DECLARATIONS TO
C      INTEGER AND R*4 TO REAL.
C
C   VERSION- 4.0    DATE- 05/04/98   PROGRAMMER- BRIAN BARIL (RSTX)
C                   CHANGED THE GENERAL FORMAT FOR THE READING OF THE
C                   NMC RECORDS.  REMOVED THE LOGICAL HOLD CONDITION.
C                   THIS ROUTINE NEEDS ONLY TO BE CALLED ONCE PER ORBIT.
C                   CHANGED GRDBUFF FROM A 4 TO A 2 DIMENSION ARRRAY
C   VERSION- 4.1    DATE- 02/22/99   PROGRAMMER- BRIAN BARIL (ITSS)
C                   FIXED A PROBLEM WHICH CAUSED GOOD FORECAST FILES TO
C                   BE SKIPPED IF A BAD DATE WAS FOUND IN A PREVIOUS FILE.
C
C   FUNCTION- THIS ROUTINE COPIES GLOBAL GRIDDED NMC GEOPOTENTIAL HEIGHTS
C             AS OBTAINED FROM THE NMC FORECAST FILES OUT TO THE BUFFER.
C
C
C   FILES-
C   DSN OR DESCRIPTIVE TITLE    I/O  UNIT  FUNCTIONAL DESCRIPTION
C   ------------------------    ---  ----  ----------------------
C   .../NMCB06                   I    35   6-HR FORECAST FILE FROM 0Z MODEL.
C   .../NMCB12                   I    36   12-HR FORECAST FILE FROM 0Z MODEL.
C   .../NMCA06                   I    37   6-HR FORECAST FILE FROM 12Z MODEL.
C   .../NMCA12                   I    38   12-HR FORECAST FILE FROM 12Z MODEL.
C   .../NMCAV18                  I    39   18-HR FORECAST FILE FROM MOST
C                                          RECENT MODEL (VALID 18Z,30Z).
C
C
C   CALLING SEQUENCE PARAMETERS-
C     VARIABLE      TYPE    I/O      DEFINITION
C     ---------     ----    ---      ----------
C     GLOBEG        REAL     O       ARRAY (DIM 5 X 4 X 2 X 145 X 37) OF
C                                    GLOBAL GRIDDED NMC GEOPOTENTIAL
C                                    HEIGHTS WHERE THERE ARE 5 NMC FORE-
C                                    CAST FILES, 4 PRESSURE LEVELS, 2
C                                    HEMISPHERES, (1=NORTH, 2=SOUTH),
C                                    145 LONGITUDES IN 2-1/2 DEGREE
C                                    INCREMENTS, AND 37 LATITUDES IN 2-1/2
C                                    DEGREE INCREMENT.
C     HOUR          INT      O       ARRAY (DIM 5) STORING THE JULIAN
C                                    HOUR OF EACH NMC FORECAST FILE.
C     ERSTAT        INT      O       ERROR STATUS CODE.
C
C
C   COMMON AREA PARAMETERS- SPVAL
C
C
C   LOCAL PARAMETERS-
C     VARIABLE      TYPE      DESCRIPTION
C     --------      ----      -----------
C     DAY           INT       DAY OF DATA FROM NMC FORECAST FILE.
C     GRDBUF        REAL      ARRAY (DIM 145 X 37) OF FORECAST INFO.
C                             THERE ARE 145 LONGITUDES AND 37 LATITUDES.
C     HKBUFR        REAL      ARRAY (DIM 5365) STORING FORECAST HOUSE-
C                             KEEPING INFORMATION.
C     HOUR          INT       HOUR OF DATA FROM NMC FORECAST FILE.
C     ICHECK        INT       VALUE USED TO CHECK FOR MISSING NMC DATA.
C     IFIL          INT       ARRAY (DIM 5) OF UNIT NUMBER OF NMC FILES.
C     IREC          INT       LOGICAL RECORD NUMBER.
C     INIREC        INT       VARIABLE STORING RECORD OFFSET FOR NORTHERN
C                             OR SOUTHERN HEMISPHERE.
C     INREC         INT       ARRAY (DIM 4) STORING RECORD OFFSET (FROM
C                             HOUSEKEEPING RECORD) TO READ FOR EACH
C                             INPUT PRESSURE LEVEL.
C     IMAP          INT       VARIABLE CONTAINING HEMISPHERE NUMBER
C                             (1=NORTHERN, 2=SOUTHERN).
C     MON           INT       MONTH OF DATA FROM NMC FORECAST FILE.
C     PNMC          INT       ARRAY (DIM 10) OF PRESSURE LEVELS THAT
C                             HELP SET CORRESPONDENCE TO NMC RECORDS TO
C                             READ.
C     RECLEN        INT       RECORD LENGTH (AND BLOCKSIZE) OF AN NMC
C                             FORECAST FILE.
C     FCSTI         INT       ARRAY (DIM 3) OF YR/MON, DAY/HR, MIN/SEC.
C                             OF FCST TIME PACKED FOR USE BY JULHR.
C     YEAR          INT       YEAR OF DATA FROM NMC FORECAST FILE.
C     ILAT          INT       VARIABLE STORING LATITUDE.
C     ILONG         INT       VARIABLE STORING LONGITUDE.
C     IPR           INT       VARIABLE STORING PRESSURE LEVEL.
C     INMC          INT       VARIABLE CONTAINING FILE NUMBER.
C     I,J,K         INT       DO LOOP VARIABLES.
C     L, M          INT       DO LOOP VARIABLES.
C     II, JJ        INT       DO LOOP VARIABLES.
C     STATUS        INT       ERROR STATUS CODE FOR CALLED ROUTINES.
C
C
C   SUBROUTINES CALLED- NONE
C
C   FUNCTIONS USED- JULHR
C
C   EXIT STATES- ERROR = 99 - FATAL ERROR : I/O ERROR OCCURS OPENING/READING
C                NMC FORECAST FILE OR NO DATA WAS AVAILABLE.
C
C********************************************************************
C
      INCLUDE 'STBCOM'
      INCLUDE 'NMCCOM'
      INCLUDE 'SPVAL'
C
      INTEGER   HOUR(5), ERSTAT
C
      INTEGER   ILAT, ILONG, IPR, BDDATE
      INTEGER   ICHECK, STATUS, II, JJ
      INTEGER   INREC(4), INMC, I, J, K, L, M
      INTEGER   FCSTI(3), IREC, INIREC, IMAP, JULHR
      INTEGER   I1, I2, I3, I4, I5
C
C  INITIALIZE VARIABLES.
C
      STATUS = 0
      ERSTAT = 0
      BDDATE = 0

C INITIALIZE GLOBEG ARRAY TO MISSING VALUES

       DO I1=1,2
        DO I2=1,4
         DO I3=1,5
          DO I4=1,37
           DO I5=1,145
            GLOBEG(I3,I2,I1,I5,I4) = R4SPV
           ENDDO
          ENDDO
         ENDDO
        ENDDO
       ENDDO

C
C  LOOP OVER THE 5 NMC FILES.
C
      DO 700 INMC = 1, 5
C
         FCSTI(1) = YEARS(INMC)*100 + MONS(INMC)
         FCSTI(2) = DAYS(INMC)*100 + HOURS(INMC)
         FCSTI(3) = 0
C
C  CHECK FOR MISSING DATA; THE MAX ICHECK CAN BE = 172
C  = 99 + 12 + 31 + 30 (DECEMBER 31, 1999, THE HOUR SOMETIMES
C  COMES IN AS 30 HOURS DUE TO AN NCEP PROBLEM.)
C
         ICHECK = YEARS(INMC) + MONS(INMC) + DAYS(INMC) + 
     +            HOURS(INMC)
         IF (ICHECK .LE. 0 .OR. ICHECK .GT. 172) THEN
           BDDATE = 99
           GOTO 900
         ENDIF
C
C  CONVERT FORECAST TIME TO JULIAN HOURS.
C
         HOUR(INMC) = JULHR(FCSTI)
C
C  SET THE RECORD NUMBERS TO READ THAT CORRESPOND TO THE PRESSURE
C  LEVELS BEING USED.
C
            DO 200 JJ = 1, 10
               IF(PNMC(JJ) .EQ. PINPUT( 1)) INREC( 1) = JJ
               IF(PNMC(JJ) .EQ. PINPUT( 2)) INREC( 2) = JJ
               IF(PNMC(JJ) .EQ. PINPUT( 3)) INREC( 3) = JJ
               IF(PNMC(JJ) .EQ. PINPUT( 4)) INREC( 4) = JJ
 200        CONTINUE
C
         INIREC = 1
C
         DO 600 IMAP = 1,2
C
C  READ THE HEIGHT FIELDS FOR EACH PRESSURE LEVEL INPUTTED.
C
            DO 500 IPR = 1,4
              IREC = INIREC + INREC(IPR)

C  NMC FILES WERE OPENED IN SPGDVR
   
C  
C  READ THE GRID INFORMATION TO BUFNMC.  USE IBM2CRAY TO
C  UNPACK 
C
          READ(IFIL(INMC),REC=IREC,ERR=800) GRDBUF  



                 DO ILAT = 1, 37
                    DO ILONG = 1, 145

                       GLOBEG(INMC,IPR,IMAP,ILONG,ILAT) = 
     +                               GRDBUF(ILONG,ILAT)

                    ENDDO 
                  ENDDO   

C
  500       CONTINUE
            INIREC = 11
C
  600    CONTINUE
C
C
  900 IF (BDDATE.EQ.99) 
     +CALL RDNMC$ (102, IFIL(INMC), STATUS)

  700 CONTINUE
      GOTO 1000
C
  800 CONTINUE
      CALL RDNMC$ (101, IFIL(INMC), STATUS)
      ERSTAT = 99
      GOTO 1000
C

C
  950 CONTINUE
      CALL RDNMC$ (103, IFIL(INMC), STATUS)
      ERSTAT = 99
C
C     RETURN TO CALLING ROUTINE.
C
 1000 RETURN    
      END                                                         
C**********************************************************************        
      SUBROUTINE RDNMC$ ( MSGCOD, FLUNT, STAT )
C********************************************************************** 
C   NAME- RDNMC$                                                               
C                                                                              
C   LANGUAGE- VS FORTRAN    TYPE- SUBROUTINE       COMPUTER- CRAY J916
C                                                                              
C   VERSION- 1.0    DATE- 06/24/95   PROGRAMMER- ALEX POZDNYAK (SMSRC)         
C   VERSION- 3.0    DATE- 10/10/97   PROGRAMMER- LEAH WILSON (HSTX)
C   VERSION- 3.1    DATE- 08/31/98   PROGRAMMER- LEAH WILSON (HSTX)
C                   
C   FUNCTION- THIS SUBROUTINE IS THE ERROR HANDLING ROUTINE FOR                
C             ROUTINE RDNMC.                                    
C   VERSION- 3.0 WRITE ERROR MESSAGES TO THE KIDS FILE.  INCLUDE /SPGUNT/.
C   VERSION- 3.1 ADD TO MSG 102 VIA /NMCCOM/.
C                                                                              
C   FILES-                                                                     
C                                                                              
C     DSN                    I/O   UNIT   FUNCTIONAL DESCRIPTION               
C     ---------------------  ---  ------  -----------------------              
C     ...KIDS                 O    KUNIT   KRAY INTERACTIVE DOCUMENTATION
C                                                                              
C   CALLING SEQUENCE PARAMETERS-                                              
C                                                                              
C     ARGUMENT               TYPE  I/O  FUNCTION                               
C     --------               ----  ---  --------                               
C     MSGCOD                  INT   I   MESSAGE CODE USED TO                   
C                                       IDENTIFY THE ERROR.                    
C
C     FLUNT                   INT   I   FILE UNIT.      
C 
C     STAT                    INT   O   STATUS CODE IF AN ERROR                
C                                       OCCURS DURING I/O.                     
C                                                                              
C                                                                              
C   COMMON AREA PARAMETERS-                                                    
C                                                                              
      INCLUDE 'SPGUNT'
      INCLUDE 'NMCCOM'
      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     I                        INT    IMPLIED DO INDEX.                       
C
C   SUBROUTINES CALLED- KIDS
C                                                                              
C**********************************************************************        
C                                                                              
      INTEGER MSGCOD, FLUNT, STAT
      CHARACTER*1 C1TEMP
      CHARACTER*2 C2TEMP
      CHARACTER*4 C4TEMP
      CHARACTER*100 KMSG
C                                                                              
      INTEGER I                                                             
C
C  SET ERINFO:SUBNAM
C
      SUBNAM = 'SPGDVR'
      STAT = 0                                                                 
C                                                                              
C     CHECK THE MSGCOD TO DETERMINE WHICH MESSAGE TO PUT INTO DBMBUF.          
C
      IF(MSGCOD .EQ. 101) THEN
        KMSG=' * FATAL ERROR * During open/read of NMC file unit     '
        WRITE(C4TEMP,'(I4)') FLUNT
        KMSG(52:55) = C4TEMP
        STAT = 99
        CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
C 
      ELSEIF(MSGCOD .EQ. 102) THEN                                             
        KMSG='* FATAL ERROR * NCEP Fcst Date problem-sum of dates>172'
        STAT = 99
        CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
        DO III=1,5
           KMSG = 'NMC file   - Year      Mon    Day    Hour   '
           WRITE(C1TEMP,'(I1)') III
           KMSG(10:10) = C1TEMP
           WRITE(C4TEMP,'(I4)') YEARS(III)
           KMSG(19:22) = C4TEMP
           WRITE(C2TEMP,'(I2)') MONS(III)
           KMSG(28:29) = C2TEMP
           WRITE(C2TEMP,'(I2)') DAYS(III)
           KMSG(35:36) = C2TEMP
           WRITE(C2TEMP,'(I2)') HOURS(III)
           KMSG(43:44) = C2TEMP
           CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
         END DO
         KMSG='--- Problem with file on unit number     '                      
         WRITE(C4TEMP,'(I4)') FLUNT
         KMSG(38:41)=C4TEMP
         IF(FLUNT.EQ.35) KMSG(45:52) = 'NMCB06'
         IF(FLUNT.EQ.36) KMSG(45:52) = 'NMCB12'
         IF(FLUNT.EQ.37) KMSG(45:52) = 'NMCA06'
         IF(FLUNT.EQ.38) KMSG(45:52) = 'NMCA12'
         IF(FLUNT.EQ.39) KMSG(45:52) = 'NMCAV18'
         CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
C
      ELSEIF(MSGCOD .EQ. 103) THEN                                             
        KMSG=' * FATAL ERROR * No data available in NCEP file u:     '
        WRITE(C4TEMP,'(I4)') FLUNT
        KMSG(52:55) = C4TEMP
        STAT = 99
        CALL KIDS(KUNIT,SUBNAM,0,KMSG,0)
C 
      ELSEIF(MSGCOD .EQ. 104) THEN
        KMSG=' * FATAL ERROR * Error in real conversion'
        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
