      PROGRAM UNPKGRB1
C$$$  MAIN PROGRAM DOCUMENTATION BLOCK
C
C MAIN PROGRAM: UNPKGRB1     UNPACK GRIB DATA IN AWIPS FILE 
C   AUTHOR: JONES, R.E       ORG: W342        DATE: 93-10-05
C
C ABSTRACT: UNPACK THE RECORDS IN A GRIB FILE MADE BY GRIBAWP1
C   FOR FAMILY OF SERVICES OR CED1 FILES MADE BY GRIBCED1.
C   CONTROL CARDS CAN BE USED TO READ AND UNPACK ALL RECORDS,
C   SELECTED RECORDS BY READING A CONTROL CARD WITH A PDS.
C   THERE IS ALSO AN OPTION TO INVENTORY THE FILE, CONTROL CARD 
C   OPTION FOR FILE NAME OF OUTPUT FILE. THIS CODE WILL UNPACK
C   THE BULLETIN FILE IN 1280 BYTE BLOCKS, OR THE VSAM FILE OF
C   THE GRIB RECORDS COPIED TO A SEQUENTIAL FILE BY IBM UTILITY
C   IDCAMS WITH REPRO AND THEN FTP TO A WORK STATION. CAN ALSO
C   UNPACK GRIB FILES MADE BY THE CRAY.
C
C PROGRAM HISTORY LOG:
C   90-12-17  R.E.JONES 
C   91-03-09  R.E JONES   CHANGES FOR SiliconGraphics FORTRAN
C   92-08-27  R.E.JONES   ADD OPTION 9 FOR INVENTORY ONLY
C   93-03-04  R.E.JONES   DOCUMENT THE PROGRAM BETTER 
C   93-03-24  R.E.JONES   ADD CHANGES FOR VAX, PC, INTERGRAPH 
C                         SET VAX TO .TRUE. FOR LITTLE ENDIAN
C                         COMPUTERS.
C   93-07-30  R.E.JONES   MAKE ARRAY KGDS BIGGER FOR GRIB TYPES
C                         37-44.
C   93-08-08  R.E.JONES   MAKE ARRAYS BIGGER
C   93-10-04  R.E.JONES   ADD CODE TO CALL SYSTEM IF NO STAT
C                         FUNCTION ON YOUR COMPUTER
C   94-02-10  R.E.JONES   NEW IW3PDS OPTION TO TEST 11 OF 1ST
C                         12 BYTES OF PDS. MUST USE NEW VERSION
C                         OF IW3PDS
C   94-04-01  R.E.JONES   CORRECTION SO RECORDS ARE IN THE SAME
C                         ORDER AS THE PDS CARDS INSTEAD OF THE
C                         SAME ORDER AS IN THE FILE.
C   94-12-07  R.E.JONES   INCREASE IBUF TO 15000000, INCREASE
C                         MXSIZE TO 260000.
C   94-12-15  R.E.JONES   INCREASE IBUF TO 30000000 FOR ETA FILES
C   95-01-21  R.E.JONES   TAKE ONE CHARACTER OUT OF LINE SO IT FITS
C                         ON ALL 132 CHARACTER WIDE PRINTERS.
C   95-02-14  R.E.JONES   PUT IN ERROR MESSAGE IF FILE IS TO BIG.
C   95-03-15  R.E.JONES   CLEAN UP CODE
C   95-03-23  R.E.JONES   INCREASE IBUF TO 34000000 FOR BIGGER
C                         ETA 29KM MODEL.
C
C USAGE:
C   INPUT FILES:
C      5         - INPUT CONTROL CARDS (3 TYPES)
C                  FORMAT (I1,I1,I3,A44)
C                  FORMAT (A44)
C                  FORMAT (6(2X,4Z2),2X,I1)    
C     11         - INTERNAL UNIT NUMBER OF AWIP GRIB INPUT FILE
C
C   OUTPUT FILES:
C     6        -   PRINT OUTPUT (STANDARD FORTRAN OUTPUT FILE)
C                  PRINTS ON SCREEN OF PC.
C     51       -   3 OR 4 WRITES FOR EACH GRIB RECORD
C                  1ST (3 INTEGER WORDS) NUMBER OF BYTES IN PDS,
C                  NUMBER OF INTEGER WORDS IN KGDS, NUMBER OF
C                  OF FLOATING POINT NUMBER UNPACKED.
C                  2ND WRITE IS THE PDS
C                  3RD WRITE IS UNPACKED GDS INFORMATION FROM W3FI63
C                  IN ARRAY KGDS. NOT WRITTEN IF NO GDS.
C                  4TH IS UNPACKED FLOATING POINT GRIB DATA   
C
C   SUBPROGRAMS CALLED:
C     UNIQUE:     NONE
C
C     LIBRARY:
C       W3LIB    - W3FP11, W3FI63, IW3PDS, XMOVEX, GBYTE, GBYTES,
C                  W3FI01, SWAP32, W3TAGB, DATIMX, IW3JDN, W3FI83
C
C   EXIT STATES:
C     COND = 0    SUCCESSFUL RUN
C          = 8    ERROR ON OPEN OF FILE MADE BY UNIX COMMAND ls -l
C          = 9    ERROR ON READ OF FILE MADE BY UNIX COMMAND ls -l
C          = 10   ERROR ON OPEN OF CONTROL CARD FILE
C          = 20   ERROR ON OPEN OF INPUT UNPACKED GRIB FILE
C          = 30   ERROR ON OPEN OF OUTPUT UNPACKED GRIB FILE
C          = 40   ERROR, INPUT GRIB FILE IS TO BIG, CHANGE PROGRAM
C          = 60   ERROR READING GRIB FILE
C          = 99   I/O ERROR USING STAT FUNCTION 
C          = 100  PROGRAMMER FORGOT CONTROL CARDS
C          = 110  NO CARD WITH FFFFFFFF AFTER PDS CARDS TO SHOW 
C                 END OF PDS CARDS
C
C  WARNING:  On a SGI 25, 35, INDIGO, Indy you must add to the f77
C            option -old_rl, this make RECL a byte count and not a
C            word count.
C
C   EXAMPLE:  CONTROL CARDS IN unpkgrb1.dat FILE
C
C  Example 1. To Inventory only rf12.dat and rf48.dat file
C
C  col. 1
C       90000rf12.dat
C       90000rf48.dat
C
C
C  Example 2. To inventory and unpack all the grib records in file
C             rf48.dat and write unpacked data in file gribout.dat
C
C  col. 1
C       11000rf48.dat
C       gribout.dat
C
C
C  Example 3. To inventory and unpack all the grib records in file
C             rf48.dat by grib type 6, 101, 105 into three output
C             files,  map6.dat, map101.dat, and map105.dat
C
C  col. 1
C       12006rf48.dat
C       map6.dat
C       02101rf48.dat
C       map101.dat
C       02105rf48.dat
C       map105.dat
C
C
C  Example 4. To inventory and unpack selected records from file rf24
C             and rf48 using cards read in with the PDS of the record.
C             After the last card with a PDS, the next card must have
C             FFFFFFFF starting in column 3. Get the 500 mb ht and
C             500 mb tmp and write the unpacked data into map6.dat .
C             You may have to run one time to get inventory for HEX 
C             values in the PDS control cards. Col. 63 is set 0 so
C             the date in not used to find the record. In an archive
C             file where the data is the same type, but the dates are
C             different this would be set to 1. In this case a date
C             would have to be in the 4th HEX word.
C
C  col. 1
C       10000rf24.dat
C       map101.dat
C         00001C01  07276500  0B6401F4  00000000  00011800  00000000  0 
C         00001C01  07276500  076401F4  00000000  00011800  00000000  0 
C         FFFFFFFF  00000000  00000000  00000000  00000000  00000000  0
C       10000rf48.dat
C       map6.dat
C         00001C01  07270600  0B6401F4  00000000  00013000  00000000  0 
C         00001C01  07270600  076401F4  00000000  00013000  00000000  0 
C         FFFFFFFF  00000000  00000000  00000000  00000000  00000000  0
C
C  Example 5. To inventory and unpack selected records from file rf24
C             and rf48 using cards read in with the PDS of the record.
C             After the last card with a PDS, the next card must have
C             FFFFFFFF starting in column 3. Get the 500 mb ht and
C             500 mb tmp and write the unpacked data into map6.dat .
C             You may have to run one time to get inventory for HEX 
C             values in the PDS control cards. Col. 63 is set 2 so
C             only 11 of 1st 12 bytes are used to find records. Byte
C             4 is not checked so when the table version is changed
C             from 1 to 2 the cards will not have to be changed.
C             The same cards can be used for all forecast hours.
C             If Col. 63 is set to 3, bytes 4, 5, 6 are not tested.
C             WAFS data from USA, FNOC, U.K MET, ECMR will work without
C             changing cards.
C
C  col. 1
C       10000rf24.dat
C       map24.dat
C         00001C01  07270600  0B6401F4  00000000  00000000  00000000  2 
C         00001C01  07270600  076401F4  00000000  00000000  00000000  2 
C         FFFFFFFF  00000000  00000000  00000000  00000000  00000000  0
C       10000rf48.dat
C       map48.dat
C         00001C02  07270600  0B6401F4  00000000  00000000  00000000  2 
C         00001C02  07270600  076401F4  00000000  00000000  00000000  2 
C         FFFFFFFF  00000000  00000000  00000000  00000000  00000000  0
C
C ATTRIBUTES:
C   LANGUAGE: SUN 1.4, 2.01 FORTRAN 77
C   MACHINE:  SUN SPARCstation 1+, 2, 10, SPARCserver 630, 690
C
C$$$
C      MXSIZE IS SET FOR LARGEST GRIB RECORD, GRID TYPE 4,
C      A .5 DEGREE (720 * 361) GRID. THIS MAY BE CHANGED TO THE
C      LARGEST RECORD SIZE YOU USE. 
C
       PARAMETER          (MXSIZE=260000)
       PARAMETER          (MSIZE=MXSIZE*3)
       PARAMETER          (IBUFSIZE=50000000)
C
C      IBUF is set bigger than the largest GRIB file you may read.
C
       CHARACTER * 1      IBUF(IBUFSIZE)
       CHARACTER * 28     V1(900)
       CHARACTER * 3      JMON(12)
       CHARACTER * 4      LABEL
       CHARACTER * 86     KTITLE
       CHARACTER * 8      GRIB
       CHARACTER * 28     JGRIB
       CHARACTER * 44     IFILE5
       CHARACTER * 44     NFILE
       CHARACTER * 1      MSGA(MSIZE)
       CHARACTER * 44     OFILE
       CHARACTER * 1      PDS(100)
       CHARACTER * 1      IPDS(24)
       CHARACTER * 10     JFILE
       CHARACTER * 80     COMND
C      CHARACTER * 80     LS
C
       INTEGER            JPDS(7)
       INTEGER            KPTR(20)
       INTEGER            KPDS(100)
       INTEGER            KGDS(200)
       INTEGER            RCBYTE(900)
       INTEGER            ISTART(900)
       INTEGER            IUNPK(900)
       INTEGER            OUTPUT
       INTEGER            IDONE
       INTEGER            JSTAT(13)
       INTEGER            STAT
       INTEGER            IV1(7,900)
       INTEGER            TYPEGRID
       INTEGER            IMESG
       INTEGER            TOTAL
C
       LOGICAL            IW3PDS
       LOGICAL            VAX
C
       LOGICAL*1          KBMS(MXSIZE)
C 
       REAL               FLD(MXSIZE)
       REAL               TIMEDIFF
       REAL               TIMEARRAY
C
       SAVE
C
       EQUIVALENCE        (V1(1)(1:1),IV1(1,1))
       EQUIVALENCE        (IPDS(1),ITEST)
       EQUIVALENCE        (JPDS(1),JGRIB(1:1))
       EQUIVALENCE        (MSGA(1),IMESG)
C
       DATA  COMND /'ls -l                                      '/
       DATA  IFILE5/'unpkgrb1.dat'/
       DATA  JFILE /'unpkls.dat'/
       DATA  IDONE /Z'FFFFFFFF'/
       DATA  JJJ   /0/
       DATA  JMON  / 'JAN','FEB','MAR','APR','MAY','JUN',
     &               'JUL','AUG','SEP','OCT','NOV','DEC'/
       DATA  KGDS  / 200 * 0 /
       DATA  KPDS  / 100 * 0 /
       DATA  KPTR  / 20 * 0 /
       DATA  OUTPUT/6/
C
C      Set VAX to .TRUE. if on VAX, PC, or INTERGRAPH
C
       DATA  VAX   /.FALSE./
C
2100   FORMAT ( /,' INVENTORY FOR FILE = ',A44,//)
2300   FORMAT(' PRODUCT DEFINITION SECTION (PDS) OF EACH RECORD.',
     &     '  SEE NMC OFFICE NOTE 388 ON GRIB (WMO CODE FM 92-IX EXT.)',
     &     '   PDS EDITION 1  BYTES')
2400   FORMAT ( //,' ... END OF ',A30,' FILE.  A TOTAL',
     &             ' OF',I5,' GRIB RECORDS (BINARY). FILE NUMBER ',
     &       I3,',',I10,' BYTES IN FILE.',/)
2600   FORMAT ( ' ERROR EXIT W3FP11 = ',I2,1X,',  RECORD  = ',A4,
     & ',  ',7(1X,4Z2.2),' , BYTES  = ',I6)
2800   FORMAT ( 1X,A4,1X,7(Z8.8,1X),A25,A17,A2,A11,I6)
C
C***********************************************************************
C
         CALL W3TAGB('UNPKGRB1',0095,0075,0050,'NMC421')
         TIMEDIFF = DTIME( TIMEARRAY )
C
         GRIB(1:4) = 'GRIB'
         GRIB(5:5) = CHAR(0)
         GRIB(6:6) = CHAR(0)
         GRIB(7:7) = CHAR(0)
         GRIB(8:8) = CHAR(1)
C
         KKK  = 0
         KRET = 0
C
C        open control card file
C
         OPEN (UNIT=5,FILE=IFILE5,STATUS='OLD',
     &   FORM='FORMATTED',IOSTAT=MERR)
         IF (MERR.NE.0) THEN
           PRINT *,' ERROR OPENING CONTROL CARD FILE = ',IFILE5
           STOP 10
         ENDIF
C
C      PARAMETERS ON CONTROL CARD TYPE 1
C
C      INVEN = 0    DO NOT INVENTORY, BUT UNPACK FILE 
C      INVEN = 1    INVENTORY PLUS UNPACK FILE
C      INVEN = 9    INVENTORY FILE ONLY
C
C      IALL  = 0    UNPACK ONLY SELECTED RECORDS USING CARDS WITH PDS
C      IALL  = 1    UNPACK ALL RECORDS IN FILE
C      IALL  = 2    UNPACK ONLY ONE GRID TYPE   
C
 10    CONTINUE
         READ (5,'(I1,I1,I3,A44)',END=100) INVEN, IALL, TYPEGRID, NFILE
         PRINT *,'INVENTORY, IALL, TYPEGRID = ',INVEN, IALL, TYPEGRID
         PRINT *,'INPUT COM.CED1, AWIPS, OR CRAY FILE = ',NFILE
         KKK = KKK + 1
C
C        DO NOT READ OUTPUT FILE CARD WITH FILE NAME IF INVEN = 9
C
         JJJ = JJJ + 1
         IF (INVEN.NE.9) THEN
           READ (5,'(A44)',END=100) OFILE
           PRINT *,'OUTPUT FILE WITH UNPACKED GRIB DATA = ',OFILE(1:20)
         END IF
         IF (IALL.EQ.2.AND.TYPEGRID.EQ.0) THEN
           PRINT *,'ERROR, IALL = 2, AND TYPEGRID = 0'
           GO TO 10
         END IF  
C
C        CALL FUNCTION STAT TO FIND NUMBER OF BYTES IN FILE
C        WORD 8 OF ARRAY JSTAT HAS THE NUMBER OF BYTES IN FILE
C        IF YOUR COMPUTER DOES NOT HAVE THE C FUNCTION STAT
C        COMMENT OUT THE NEXT 7 LINES
C
         IF (STAT(NFILE,JSTAT).NE.0) THEN
           PRINT *,'ERROR IN FUNCTION STAT GETTING FILE STATS'
           CALL W3TAGE('UNPKGRB1')
           STOP 99
         ELSE
           KBYTES = JSTAT(8)
           PRINT *,'NUMBER OF BYTES IN GRIB FILE   = ',KBYTES
         END IF
C
C        TEST TO SEE IF INPUT GRIB FILE IS TO BIG
C
         IF (IBUFSIZE.LT.KBYTES) THEN
           PRINT *,'GRIB INPUT FILE IS TO BIG FOR UNPKGRB1 PROGRAM'
           PRINT *,'CHANGE PROGRAM SO PARAMETER IBUFSIZE IS LARGER'
           PRINT *,'THAN THE NUMBER OF BYTES IN THE FILE'
           CALL W3TAGE('UNPKGRB1')
           STOP 40
         END IF
C
C        IF YOUR COMPUTER DOES NOT HAVE STAT, YOU MAY BE ABLE TO
C        USE CALL SYSTEM FROM FORTRAN, THIS WILL EXECUTE UNIX
C        COMMANDS FROM YOUR FORTRAN PROGRAM. Using ls -l WITH
C        THE INPUT FILE NAME WE CAN WRITE A FILE unpkls.dat 
C        WITH THE NUMBER OF BYTES IN THE FILE.
C        THIS FILE IS OPENED, READ, AND THE BYTE COUNT DECODED
C        THIS WILL WORK ON AN IBM RS/6000, HP 700's, AND
C        INTERGRAPH. UNCOMMENT THE NEXT 25 LINES
C
C        COMND(7:50)  = NFILE(1:44)
C        COMND(51:51) = '>'
C        COMND(52:61) = JFILE(1:10)
C
C        CALL SYSTEM(COMND)
C
C        open file made by ls -l nfile>unpkls.dat
C
C        OPEN (UNIT=9,FILE=JFILE,STATUS='OLD',
C    &   ACCESS='SEQUENTIAL',FORM='FORMATTED',IOSTAT=IERR)
C        IF (IERR.NE.0) THEN
C          PRINT 8, JFILE, IERR
C  8       FORMAT ( ' ERROR OPENING UNIT=9, FILE NAME = ',A10,
C    &     ', IOSTAT = ',I3) 
C          STOP 8
C        ENDIF
C
C        read the record made by ls -l
C
C        READ (9,'(A)',IOSTAT=JERR) ls
C        IF (JERR.NE.0) THEN
C          PRINT 9 , JFILE, JERR
C  9       FORMAT ( ' ERROR READING UNIT=9, FILE NAME = ',A10,
C    &     ', IOSTAT = ',I3)
C          CLOSE (UNIT=9)
C          STOP 9
C        ENDIF
C        CLOSE (UNIT=9)
C       
C     PRINT *,'12345678901234567890123456789012345678901234567890' 
C     print *,ls
C
C     USE INTERNAL READ to get byte count
C
C     READ (UNIT=LS(31:40),FMT='(I10)') kbytes
C     print *,'kbytes = ',kbytes
C
C        OPEN FILE WITH GRIB COM SEQUENTIAL FILE OR AWIPS FILE
C        On some computers RECL can be set to KBYTES, the number
C        of bytes in the file. This is both compiler and computer
C        dependent. On the 1st read, the entire file is read into
C        array IBUF.  SET RECL=KBYTES FOR IBM RS/6000, HP 700.
C
C        OPEN (UNIT=11,FILE=NFILE,STATUS='OLD',ACCESS='DIRECT',
C    &   FORM='UNFORMATTED',IOSTAT=MERR,RECL=KBYTES)
C
         OPEN (UNIT=11,FILE=NFILE,STATUS='OLD',ACCESS='DIRECT',
     &   FORM='UNFORMATTED',IOSTAT=MERR,RECL=1)
         IF (MERR.NE.0) THEN
           PRINT *,'OPEN INPUT FILE ERROR ON FILE = ', NFILE
           PRINT *,'ERROR = ',MERR
           CALL W3TAGE('UNPKGRB1')
           STOP 20
         END IF
C
C        OPEN OUTPUT FILE FOR UNPACKED GRIB DATA IN FLOATING POINT
C        DO NOT OPEN IF INVEN = 9 
C 
         IF (INVEN.NE.9) THEN 
           OPEN (UNIT=51,FILE=OFILE,STATUS='unknown',
     &     FORM='UNFORMATTED',ACCESS='SEQUENTIAL',IOSTAT=MERR)
           IF (MERR.NE.0) THEN
             PRINT *,'OPEN OUTPUT FILE ERROR ON FILE = ', OFILE
             PRINT *,'ERROR = ',MERR
             CALL W3TAGE('UNPKGRB1')
             STOP 30
           END IF
         END IF
C
C        Read the entire GRIB file into array IBUF
C        On SUN and SGI the stat function works, when RECL=1
C        REC is a pointer at what byte in the file to start
C        reading at. The SUN and SGI compilers compile this as
C        one big read, other compilers, such as the INTERGRAPH, 
C        give a compile error, or run time error. 
C        If so, comment out this line, uncomment the code that 
C        that applies to your computer. This works, but is very
C        slow because you are doing one read for each byte in 
C        file.  Replace this if your computer has a better way of
C        doing it. This should also work if RECL=KBYTES.       
C
         READ (11,REC=1,ERR=60) (IBUF(I),I=1,KBYTES)
C
C      Use this if you have no stat function or system function
C      This is very slow.     
C
C      I = 1
C 1    CONTINUE
C        READ (11,REC=I,IOSTAT=IERR) IBUF(I)
C        IF (IERR.EQ.0) THEN
C          I = I + 1
C          GO TO 1
C        ELSE 
C          KBYTES = I - 1
C          PRINT *,'NUMBER OF BYTES IN GRIB FILE   = ',KBYTES
C        END IF 
C      
C      Use this if you have stat or system function and RECL=1 but 
C      the read does not work. This is very slow.     
C
C      DO I = 1,KBYTES
C        READ (11,REC=I,ERR=60) IBUF(I)
C      END DO
C
C  -------------------  FIND  all 'GRIB' in file, save address
C  -------------------  PDS, length of grib message.
C
      JSTART = 1
      NN = 0
      DO 101 I = JSTART, KBYTES
        IF (ICHAR(IBUF(I  )).NE.71) GO TO 101
        IF (ICHAR(IBUF(I+1)).NE.82) GO TO 101
        IF (ICHAR(IBUF(I+2)).NE.73) GO TO 101
        IF (ICHAR(IBUF(I+3)).NE.66) GO TO 101
        IF (ICHAR(IBUF(I+7)).NE.1)  GO TO 101
        NN = NN + 1
        DO J = I,I+27
          V1(NN)(J-I+1:J-I+1) = IBUF(J+8)
        END DO 
        RCBYTE(NN) = ICHAR(IBUF(I+4)) * 65536 + ICHAR(IBUF(I+5)) *
     &  256 + ICHAR(IBUF(I+6)) 
        JSTART     = I + RCBYTE(NN)
        ISTART(nn) = I
c       print *,'nn,i,jstart,rcbyte(nn) = ',nn,i,jstart,rcbyte(nn)
  101 CONTINUE
C
        PRINT *,'NUMBER OF GRIB RECORDS IN FILE = ',NN
C
C        DECODE MONTH TO INTEGER
C
         IF (INVEN.EQ.1.OR.INVEN.EQ.9) THEN
           WRITE (OUTPUT,2100) NFILE
           WRITE (OUTPUT,2300)
         END IF
C
C        INVENTORY FILE IF INVEN EQUAL 1 OR 9
C
         NUMREC = NN
         TOTAL  = 0
         DO K = 1,NUMREC
             NNN    = K + 1000
             WRITE (LABEL(1:4),'(I4)') NNN
             LABEL(1:1) = CHAR(78)
             JGRIB(1:28) = V1(K)(1:28)
             NBYTES = RCBYTE(K)
             TOTAL  = TOTAL + NBYTES
             IF (INVEN.EQ.1.OR.INVEN.EQ.9) THEN 
               CALL W3FP11(GRIB,JGRIB,KTITLE,JERR)
C
C              REVERSE ORDER OF BYTES IF VAX, PC, OR INTERGRAPH
C
               IF (VAX) THEN
                 CALL SWAP32(JPDS,7)
               END IF
               IF (JERR.NE.0) THEN
                 WRITE (OUTPUT,2600) JERR, LABEL(1:4), JPDS, 
     &           NBYTES
               END IF
               LABEL(1:1) = CHAR(78)
               WRITE (OUTPUT,2800) LABEL(1:4), JPDS, KTITLE(2:26),
     &         KTITLE(28:44), KTITLE(46:47), KTITLE(51:61), NBYTES
             ENDIF 
         END DO
C
C        INVENTORY FILE IF INVEN EQUAL 1 OR 9
C
           IF (INVEN.EQ.1.OR.INVEN.EQ.9) THEN
             WRITE (OUTPUT,2400) NFILE(1:30), NUMREC, JJJ, TOTAL
           END IF
           IF (INVEN.EQ.9) GO TO 50
C
C     READ AND UNPACK ALL GRIB RECORDS IN THE FILE
C
       IF (IALL.EQ.1.OR.IALL.EQ.2) THEN
         NREC = 0
         IF (IALL.EQ.1) PRINT *,'UNPACK ALL GRIB RECORDS IN THE FILE'
         IF (IALL.EQ.2) THEN
           PRINT *,'IALL = 2, OUTPUT ONLY RECORDS OF GRID TYPE ',
     &     TYPEGRID
         END IF
C
         DO 30 K =1,NUMREC
           MBYTES = RCBYTE(K)
           KSTART = ISTART(K)
           IF (IALL.EQ.2) THEN
             IGRID = ICHAR(IBUF(KSTART+14))
             PRINT *,'IGRID = ',IGRID
             IF (TYPEGRID.NE.IGRID) GO TO 30
           END IF
C
C          MOVE GRIB RECORD SO IT IS ON WORD BOUNDARY
C
           CALL XMOVEX(MSGA,IBUF(KSTART),MBYTES)
           IF (ICHAR(MSGA(15)).EQ.0) MSGA(15) = CHAR(2)
C
C          REVERSE ORDER OF BYTES IF VAX, PC, OR INTERGRAPH
C
           IF (VAX) THEN 
             IWORDS = (MBYTES+3) / 4
             CALL SWAP32(MSGA,IWORDS)
           END IF
           CALL W3FI63(MSGA,KPDS,KGDS,KBMS,FLD,KPTR,KRET)
           print *,' '
           PRINT *,'KPTR = ',KPTR,'  REC. NO. = ',K
           PRINT *,'KPDS = ',(KPDS(J),J=1,KPTR(3))
           write(99,*) (kpds(j),j=1,kptr(3))
           LENKGDS = 0
           IF (KPTR(4).NE.0) THEN
             IF (KPTR(4).LE.52) THEN
               PRINT *,'KGDS = ',(KGDS(J),J=1,20)
               LENKGDS = 20
             ELSE
               LENKGDS = (KPTR(4) - (KGDS(20) - 1)) / 2 + 21 
               PRINT *,'LENKGDS = ', LENKGDS
               PRINT *,'KGDS = ',(KGDS(J),J=1,LENKGDS)
             END IF
           END IF 
           IF (KRET.EQ.9) THEN
C
C            DO NOTHING
C
           ELSE IF (KRET.NE.0) THEN
             PRINT *,'W3FI63 GRIB UNPACKER ERROR = ',KRET
             GO TO 30
           ENDIF
C 
C         KPTR(10) HAS THE NUMBER OF F.P. NUMBERS IN UNPACKED GRID
C         KPTR(9) HAS START LOCATION IN ARRAY MSGA OF NAME 'GRIB'
           
           NWORDS  = KPTR(10)
           NSTART  = KPTR(9) / 8
           IGRIBL  = KPTR(2)
           LENPDS  = KPTR(3)
           DO J = 1,LENPDS
             PDS(J) = MSGA(NSTART+IGRIBL+J)
           END DO
c          print *,'nstart, nwords  = ',nstart, nwords
C
C         WRITE TO UNIT 51 3 OR 4 RECORDS FOR EACH GRIB RECORD
C         WRITE IN 1ST RECORD 3 INTEGER WORDS, LENGTH OF PDS
C         IN BYTES, NUMBER OF WORDS IN KGDS, NUMBER OF
C         UNPACKED FLOATING POINT NUMBERS IN THE GRIB RECORD
C         2ND RECORD IS THE PDS
C         3RD RECORD IS THE KGDS ARRAY WITH UNPACED GDS
C         INFORMATION
C         4TH IS THE UNPACKED GRIB FLOATING POINT NUMBERS
C 
           WRITE (51) LENPDS, LENKGDS, NWORDS
           WRITE (51) (PDS(J),J=1,LENPDS)
           IF (LENKGDS.NE.0) WRITE (51) (KGDS(J),J=1,LENKGDS)
           WRITE (51) (FLD(J),J=1,NWORDS)
           NREC = NREC + 1 
C
 30      CONTINUE
       ENDIF
C
C      READ ONLY SELECTED RECORDS BY CONTROL CARD, CONTROL CARD
C      HAS PDS, INDEX RECORD IS SEARCHED FOR MATCH OF PDS, WITH
C      OR WITHOUT USING THE DATE IN THE PDS.  KEY = 0 IF YOU DO
C      NOT USE DATE IN PRODUCT DEFINITION SECTION (PDS).    
C    
       IF (IALL.EQ.0) THEN
         DO I = 1,NUMREC
           IUNPK(I) = 0
         END DO
         N      = 0
         ICARDS = 0
C
 32    CONTINUE
         READ (5,'(6(2X,4Z2),2X,I1)',END=110) IPDS, KEY
C
C     TEST FOR  FFFFFFFF, END OF (PDS) CARDS.  
C
         IF (ITEST.EQ.IDONE) GO TO 36
         N = N + 1
         PRINT 33, IPDS, KEY
 33      FORMAT (' PDS = ',6(2X,4Z2.2),2X,I1)
         DO 35 K = 1,NUMREC
           IF (IW3PDS(IV1(1,K),IPDS,KEY)) THEN
             ICARDS        = ICARDS + 1
             IUNPK(ICARDS) = K
             GO TO 32
           ENDIF
 35      CONTINUE
         PRINT 37, IPDS, KEY
 37      FORMAT (' CAN NOT FIND PDS = ',6(2X,4Z2.2),2X,I1)
         IF (N.LE.NUMREC) GO TO 32
         IF (N.GT.NUMREC) THEN
           PRINT *,' POSSIBLE ERROR, YOU HAVE MORE PDS CARDS'
           PRINT *,' THEN RECORDS IN FILE. YOU MAY WANT A '
           PRINT *,' DUPLICATE RECORD, I WILL CONTINUE.'
           GO TO 32
         END IF
 36    CONTINUE
        PRINT *,' '
      ENDIF  
C
C     READ AND UNPACK ONLY THE SELECTED GRIB RECORDS IN THE FILE
C
       KCARDS = 0
       IF (IALL.EQ.0) THEN
       IF (ICARDS.EQ.0) GO TO 50
         NREC = 0
         DO 40 K = 1,ICARDS
           MBYTES = RCBYTE(IUNPK(K))
           KSTART = ISTART(IUNPK(K))
C
C          MOVE GRIB RECORD SO IT IS ON WORD BOUNDARY
C
           CALL XMOVEX(MSGA,IBUF(KSTART),MBYTES)
C          IF (ICHAR(MSGA(15)).EQ.0) MSGA(15) = CHAR(2)
C
C          REVERSE ORDER OF BYTES IF VAX, PC, OR INTERGRAPH
C
           IF (VAX) THEN 
             IWORDS = (MBYTES+3) / 4
             CALL SWAP32(MSGA,IWORDS)
           END IF
           CALL W3FI63(MSGA,KPDS,KGDS,KBMS,FLD,KPTR,KRET)
           KCARDS = KCARDS + 1
           PRINT *,'KPTR = ',KPTR,'  REC. NO. = ',K
           PRINT *,'KPDS = ',(KPDS(J),J=1,KPTR(3))
           LENKGDS = 0
           IF (KPTR(4).NE.0) THEN
             IF (KPTR(4).LE.52) THEN
               PRINT *,'KGDS = ',(KGDS(J),J=1,20)
               LENKGDS = 20
             ELSE
               LENKGDS = (KPTR(4) - (KGDS(20) - 1)) / 2 + 21 
               PRINT *,'LENKGDS = ', LENKGDS
               PRINT *,'KGDS = ',(KGDS(J),J=1,LENKGDS)
             END IF
           END IF 
           IF (KRET.EQ.9) THEN
C
C            DO NOTHING
C
           ELSE IF (KRET.NE.0) THEN
             PRINT *,'W3FI63 GRIB UNPACKER ERROR = ',KRET
             GO TO 40
           ENDIF
C
           NWORDS  = KPTR(10)
           NSTART  = KPTR(9) / 8 
           IGRIBL  = KPTR(2)
           LENPDS  = KPTR(3)
           DO J = 1,LENPDS
             PDS(J) = MSGA(NSTART+IGRIBL+J)
           END DO
           WRITE (51) LENPDS, LENKGDS, NWORDS
           WRITE (51) (PDS(J),J=1,LENPDS)
           IF (LENKGDS.GT.0) WRITE (51) (KGDS(J),J=1,LENKGDS)
           WRITE (51) (FLD(J),J=1,NWORDS)
           NREC = NREC + 1
C
 40      CONTINUE
         ENDIF
C
 50      CONTINUE
           PRINT *,' '
           IF (NREC.NE.0.OR.INVEN.NE.9) THEN
           PRINT *,'WROTE ',NREC,' GRIB RECORDS IN FILE ',OFILE(1:20) 
           ENDIF
           PRINT *,' '         
           CLOSE (UNIT=11)
           IF (INVEN.NE.9) THEN
             END FILE 51
             CLOSE (UNIT=51)
           END IF
           GO TO 10
C
 60    CONTINUE
         PRINT *,'READ ERROR READING GRIB FILE, ERROR = ',JERR
         CALL W3TAGE('UNPKGRB1')
         STOP 60
C
 100    CONTINUE
          IF (KKK.EQ.0) THEN
            PRINT *,'EOF READING 1ST CONTROL CARD, FILE = ',IFILE5
            CALL W3TAGE('UNPKGRB1')
            STOP 100
          ENDIF
C
          PRINT *,' '
          TIMEDIFF = DTIME( TIMEARRAY )
          PRINT *,'CPU TIME IN SECONDS = ',TIMEDIFF
C
          CALL W3TAGE('UNPKGRB1')
          STOP
C
 110    CONTINUE
          PRINT *,' EOF READING CONTROL CARDS WITH PDS '
          CALL W3TAGE('UNPKGRB1')
          STOP 110
        END
