c
c	from ~wd20mi/jifnov93/rdg.f
c  grib routine for version1 type index files
c
c change:
c	added new routines PDS56B, PDSCAB, PDSCAC
c	identical to PDS567, PDSCAB except a name change
c	this prevents the buffer from being flushed
c
c
      SUBROUTINE RDGB(LUGB,LGRIB,LSKIP,KPDS,KGDS,NDATA,LBMS,DATA)
C
C  READ GRIB FILE
C  INPUT
C    LUGB - LOGICAL UNIT TO READ
C    LGRIB - LENGTH OF GRIB RECORD
C    LSKIP - BYTES TO SKIP FOR GRIB RECORD
C  OUTPUT
C    KPDS(100) - UNPACKED PRODUCT DEFINITION SECTION
C    KGDS(100) - UNPACKED GRID DEFINITION SECTION
C    NDATA    - NUMBER OF DATA POINTS
C    LBMS(NDATA) - LOGICAL BIT MAP
C    DATA(NDATA) - DATA UNPACKED
C
      CHARACTER GRIB(LGRIB)*1
      INTEGER KPDS(100),KGDS(100),KPTR(16)
      LOGICAL LBMS(*)
      REAL DATA(*)
      NDATA=0
      CALL BAREAD(LUGB,LSKIP,LGRIB,LREAD,GRIB)
      IF(LREAD.LT.LGRIB) RETURN
      CALL W3FI63(GRIB,KPDS,KGDS,LBMS,DATA,KPTR,IRET)
c     IF(IRET.NE.0) RETURN
      IF(IRET.NE.0) then
          write(*,*) 'error decoding file: rdgb'
          call exit(8)
      endif
      NDATA=KPTR(10)
      RETURN
      END
C-----------------------------------------------------------------------
      SUBROUTINE PDS567(LUGI,KPDS5,KPDS6,KPDS7,INUM,LSKIP,LGRIB)
C
C  SEARCH GRIB1 INDEX FILE FOR GIVEN PARAMETER AND LEVEL.
C
C  LUGI     - INPUT INTEGER UNIT OF GRIB1 INDEX FILE (GB1IX1) TO READ
C  KPDS5    - INPUT INTEGER PARAMETER NUMBER TO FIND (-1 FOR WILDCARD)
C  KPDS6    - INPUT INTEGER LEVEL TYPE TO FIND (-1 FOR WILDCARD)
C  KPDS7    - INPUT INTEGER LEVEL VALUE TO FIND (-1 FOR WILDCARD)
C  INUM     - INPUT AND OUTPUT INTEGER RECORD NUMBER
C  LSKIP    - OUTPUT INTEGER BYTES TO SKIP IN GRIB1 DATA FILE
C  LGRIB    - OUTPUT INTEGER BYTES TO READ IN GRIB1 DATA FILE
C             (0 IF RECORD NOT FOUND)
C
c      PARAMETER(MBUF=8192*128)
      PARAMETER(MBUF=2300000)
      CHARACTER CBUF(MBUF)
      SAVE LUX,NSKP,NLEN,NNUM,CBUF
      DATA LUX/0/
      CHARACTER CHEAD(2)*81
c	wne
      IF(LUGI.NE.LUX.or.INUM.LT.0) THEN
c       REWIND LUGI
c       READ(LUGI,IOSTAT=IOS) CHEAD
        call baread(lugi,0,162,ka,chead)
        ios=0
        if (ka.ne.162) ios=1

        IF(IOS.EQ.0.AND.CHEAD(1)(42:47).EQ.'GB1IX1') THEN
          LUX=0
          READ(CHEAD(2),'(8X,3I10,2X,A40)',IOSTAT=IOS) NSKP,NLEN,NNUM
          IF(IOS.EQ.0) THEN
            NBUF=NNUM*NLEN
            IF(NBUF.GT.MBUF) THEN
              PRINT *,'PDS567: INCREASE BUFFER FROM ',MBUF,' TO ',NBUF
              NNUM=MBUF/NLEN
              NBUF=NNUM*NLEN
            ENDIF
            CALL BAREAD(LUGI,NSKP,NBUF,LBUF,CBUF)
            IF(LBUF.EQ.NBUF) THEN
              LUX=LUGI
              INUM=0
            ENDIF
          ENDIF
        ENDIF
      ENDIF
      LGRIB=0
      IF(LUGI.EQ.LUX) THEN
        N=INUM+1
        DOWHILE(LGRIB.EQ.0.AND.N.LE.NNUM)
          IF((KPDS5.EQ.-1.OR.KPDS5.EQ.mova2i(CBUF((N-1)*NLEN+34))).AND.
     &       (KPDS6.EQ.-1.OR.KPDS6.EQ.mova2i(CBUF((N-1)*NLEN+35))).AND.
     &       (KPDS7.EQ.-1.OR.KPDS7.EQ.mova2i(CBUF((N-1)*NLEN+36))*256+
     &                                mova2i(CBUF((N-1)*NLEN+37)))) THEN
            INUM=N
            CALL GBYTEc(CBUF,LSKIP,8*(N-1)*NLEN,8*4)
            CALL GBYTEc(CBUF,LGRIB,8*(N-1)*NLEN+8*20,8*4)
          ENDIF
          N=N+1
        ENDDO
      ENDIF
      RETURN
      END
C-----------------------------------------------------------------------
      SUBROUTINE PDSCAN(LUGI,KPDS,INUM,LSKIP,LGRIB)
C
C  SEARCH GRIB1 INDEX FILE FOR GIVEN PDS PARAMETERS.
C
C  LUGI     - INPUT INTEGER UNIT OF GRIB1 INDEX FILE (GB1IX1) TO READ
C  KPDS     - INPUT AND OUTPUT INTEGER (100) PDS LIST TO MATCH
C             (SAME DEFINITIONS AS IN W3FI63) (-1 FOR WILDCARD)
C  INUM     - INPUT AND OUTPUT INTEGER RECORD NUMBER (-1 TO REOPEN FILE)
C  LSKIP    - OUTPUT INTEGER BYTES TO SKIP IN GRIB1 DATA FILE
C  LGRIB    - OUTPUT INTEGER BYTES TO READ IN GRIB1 DATA FILE
C             (0 IF RECORD NOT FOUND)
C
      INTEGER KPDS(100)
c      PARAMETER(MBUF=8192*128)
      PARAMETER(MBUF=2300000)
      CHARACTER CBUF(MBUF)
      SAVE LUX,NSKP,NLEN,NNUM,CBUF
      DATA LUX/0/
      CHARACTER CHEAD(2)*81
      CHARACTER CPDS(28)
      INTEGER KPTR(16),KPDSI(100)
      LOGICAL LMATCH
c	write(*,*) '>>pdscan'
      IF(INUM.LT.0.OR.LUGI.NE.LUX) THEN
c       REWIND LUGI
c       READ(LUGI,IOSTAT=IOS) CHEAD
        call baread(lugi,0,162,ka,chead)
        ios=0
        if (ka.ne.162) ios=1

        IF(IOS.EQ.0.AND.CHEAD(1)(42:47).EQ.'GB1IX1') THEN
          LUX=0
          READ(CHEAD(2),'(8X,3I10,2X,A40)',IOSTAT=IOS) NSKP,NLEN,NNUM
          IF(IOS.EQ.0) THEN
            NBUF=NNUM*NLEN
            IF(NBUF.GT.MBUF) THEN
              PRINT *,'PDS567: INCREASE BUFFER FROM ',MBUF,' TO ',NBUF
              NNUM=MBUF/NLEN
              NBUF=NNUM*NLEN
            ENDIF
            CALL BAREAD(LUGI,NSKP,NBUF,LBUF,CBUF)
            IF(LBUF.EQ.NBUF) THEN
              LUX=LUGI
              INUM=0
            ENDIF
          ENDIF
        ENDIF
      ENDIF
      LGRIB=0
      IF(INUM.GE.0.AND.LUGI.EQ.LUX) THEN
        N=INUM+1
        DOWHILE(LGRIB.EQ.0.AND.N.LE.NNUM)
c         CPDS=CBUF((N-1)*NLEN+26:(N-1)*NLEN+53)
	  do i9 = 1, 28
	     cpds(i9) = CBUF((N-1)*NLEN+25+i9)
	  enddo
          call ifill(KPTR,16,0)
          CALL GBYTEc(CBUF,KPTR(3),(N-1)*NLEN*8+25*8,3*8)
          CALL FI632(CPDS,KPTR,KPDSI,IRET)
          LMATCH=.TRUE.
          IP=1
          DOWHILE(LMATCH.AND.IP.LE.100)
            LMATCH=KPDS(IP).EQ.-1.OR.KPDS(IP).EQ.KPDSI(IP)
            IP=IP+1
          ENDDO
          IF(LMATCH) THEN
c           KPDS=KPDSI
	    call ifillv(kpds,kpdsi,100)
            INUM=N
            CALL GBYTEc(CBUF,LSKIP,(N-1)*NLEN*8,4*8)
            CALL GBYTEc(CBUF,LGRIB,(N-1)*NLEN*8+20*8,4*8)
          ENDIF
          N=N+1
        ENDDO
      ENDIF
      RETURN
      END
C-----------------------------------------------------------------------
      SUBROUTINE PDS56B(LUGI,KPDS5,KPDS6,KPDS7,INUM,LSKIP,LGRIB)
c
c identical to PDS567 except for the name
c so that you can keep 2 files open at the same time with
c out having to flush out the buffers
C
C  SEARCH GRIB1 INDEX FILE FOR GIVEN PARAMETER AND LEVEL.
C
C  LUGI     - INPUT INTEGER UNIT OF GRIB1 INDEX FILE (GB1IX1) TO READ
C  KPDS5    - INPUT INTEGER PARAMETER NUMBER TO FIND (-1 FOR WILDCARD)
C  KPDS6    - INPUT INTEGER LEVEL TYPE TO FIND (-1 FOR WILDCARD)
C  KPDS7    - INPUT INTEGER LEVEL VALUE TO FIND (-1 FOR WILDCARD)
C  INUM     - INPUT AND OUTPUT INTEGER RECORD NUMBER
C  LSKIP    - OUTPUT INTEGER BYTES TO SKIP IN GRIB1 DATA FILE
C  LGRIB    - OUTPUT INTEGER BYTES TO READ IN GRIB1 DATA FILE
C             (0 IF RECORD NOT FOUND)
C
c     PARAMETER(MBUF=8192*128)
      PARAMETER(MBUF=2300000)
      CHARACTER CBUF(MBUF)
      SAVE LUX,NSKP,NLEN,NNUM,CBUF
      DATA LUX/0/
      CHARACTER CHEAD(2)*81
c	wne
      IF(LUGI.NE.LUX.or.INUM.LT.0) THEN
c       REWIND LUGI
c       READ(LUGI,IOSTAT=IOS) CHEAD
        call baread(lugi,0,162,ka,chead)
        ios=0
        if (ka.ne.162) ios=1

        IF(IOS.EQ.0.AND.CHEAD(1)(42:47).EQ.'GB1IX1') THEN
          LUX=0
          READ(CHEAD(2),'(8X,3I10,2X,A40)',IOSTAT=IOS) NSKP,NLEN,NNUM
          IF(IOS.EQ.0) THEN
            NBUF=NNUM*NLEN
            IF(NBUF.GT.MBUF) THEN
              PRINT *,'PDS567: INCREASE BUFFER FROM ',MBUF,' TO ',NBUF
              NNUM=MBUF/NLEN
              NBUF=NNUM*NLEN
            ENDIF
            CALL BAREAD(LUGI,NSKP,NBUF,LBUF,CBUF)
            IF(LBUF.EQ.NBUF) THEN
              LUX=LUGI
              INUM=0
            ENDIF
          ENDIF
        ENDIF
      ENDIF
      LGRIB=0
      IF(LUGI.EQ.LUX) THEN
        N=INUM+1
        DOWHILE(LGRIB.EQ.0.AND.N.LE.NNUM)
          IF((KPDS5.EQ.-1.OR.KPDS5.EQ.mova2i(CBUF((N-1)*NLEN+34))).AND.
     &       (KPDS6.EQ.-1.OR.KPDS6.EQ.mova2i(CBUF((N-1)*NLEN+35))).AND.
     &       (KPDS7.EQ.-1.OR.KPDS7.EQ.mova2i(CBUF((N-1)*NLEN+36))*256+
     &                                mova2i(CBUF((N-1)*NLEN+37)))) THEN
            INUM=N
            CALL GBYTEc(CBUF,LSKIP,8*(N-1)*NLEN,8*4)
            CALL GBYTEc(CBUF,LGRIB,8*(N-1)*NLEN+8*20,8*4)
          ENDIF
          N=N+1
        ENDDO
      ENDIF
      RETURN
      END
C-----------------------------------------------------------------------
      SUBROUTINE PDSCAB(LUGI,KPDS,INUM,LSKIP,LGRIB)
C
C  SEARCH GRIB1 INDEX FILE FOR GIVEN PDS PARAMETERS.
C
C  LUGI     - INPUT INTEGER UNIT OF GRIB1 INDEX FILE (GB1IX1) TO READ
C  KPDS     - INPUT AND OUTPUT INTEGER (100) PDS LIST TO MATCH
C             (SAME DEFINITIONS AS IN W3FI63) (-1 FOR WILDCARD)
C  INUM     - INPUT AND OUTPUT INTEGER RECORD NUMBER (-1 TO REOPEN FILE)
C  LSKIP    - OUTPUT INTEGER BYTES TO SKIP IN GRIB1 DATA FILE
C  LGRIB    - OUTPUT INTEGER BYTES TO READ IN GRIB1 DATA FILE
C             (0 IF RECORD NOT FOUND)
C
      INTEGER KPDS(100)
c     PARAMETER(MBUF=8192*128)
      PARAMETER(MBUF=2300000)
      CHARACTER CBUF(MBUF)
      SAVE LUX,NSKP,NLEN,NNUM,CBUF
      DATA LUX/0/
      CHARACTER CHEAD(2)*81
      CHARACTER CPDS(28)
      INTEGER KPTR(16),KPDSI(100)
      LOGICAL LMATCH
      IF(INUM.LT.0.OR.LUGI.NE.LUX) THEN
c       REWIND LUGI
c       READ(LUGI,IOSTAT=IOS) CHEAD
        call baread(lugi,0,162,ka,chead)
        ios=0
        if (ka.ne.162) ios=1

        IF(IOS.EQ.0.AND.CHEAD(1)(42:47).EQ.'GB1IX1') THEN
          LUX=0
          READ(CHEAD(2),'(8X,3I10,2X,A40)',IOSTAT=IOS) NSKP,NLEN,NNUM
          IF(IOS.EQ.0) THEN
            NBUF=NNUM*NLEN
            IF(NBUF.GT.MBUF) THEN
              PRINT *,'PDS567: INCREASE BUFFER FROM ',MBUF,' TO ',NBUF
              NNUM=MBUF/NLEN
              NBUF=NNUM*NLEN
            ENDIF
            CALL BAREAD(LUGI,NSKP,NBUF,LBUF,CBUF)
            IF(LBUF.EQ.NBUF) THEN
              LUX=LUGI
              INUM=0
            ENDIF
          ENDIF
        ENDIF
      ENDIF
      LGRIB=0
      IF(INUM.GE.0.AND.LUGI.EQ.LUX) THEN
        N=INUM+1
        DOWHILE(LGRIB.EQ.0.AND.N.LE.NNUM)
c         CPDS=CBUF((N-1)*NLEN+26:(N-1)*NLEN+53)
	  do i9 = 1, 28
	     cpds(i9) = CBUF((N-1)*NLEN+25+i9)
	  enddo
c         KPTR=0
	  call ifill(kptr,16,0)
          CALL GBYTEc(CBUF,KPTR(3),(N-1)*NLEN*8+25*8,3*8)
          CALL FI632(CPDS,KPTR,KPDSI,IRET)
          LMATCH=.TRUE.
          IP=1
          DOWHILE(LMATCH.AND.IP.LE.22)
            LMATCH=KPDS(IP).EQ.-1.OR.KPDS(IP).EQ.KPDSI(IP)
            IP=IP+1
          ENDDO
          IF(LMATCH) THEN
c           KPDS=KPDSI
	    call ifillv(kpds,kpdsi,100)
            INUM=N
            CALL GBYTEc(CBUF,LSKIP,(N-1)*NLEN*8,4*8)
            CALL GBYTEc(CBUF,LGRIB,(N-1)*NLEN*8+20*8,4*8)
          ENDIF
          N=N+1
        ENDDO
      ENDIF
      RETURN
      END
C-----------------------------------------------------------------------
      SUBROUTINE PDSCAC(LUGI,KPDS,INUM,LSKIP,LGRIB)
C
C  SEARCH GRIB1 INDEX FILE FOR GIVEN PDS PARAMETERS.
C
C  LUGI     - INPUT INTEGER UNIT OF GRIB1 INDEX FILE (GB1IX1) TO READ
C  KPDS     - INPUT AND OUTPUT INTEGER (100) PDS LIST TO MATCH
C             (SAME DEFINITIONS AS IN W3FI63) (-1 FOR WILDCARD)
C  INUM     - INPUT AND OUTPUT INTEGER RECORD NUMBER (-1 TO REOPEN FILE)
C  LSKIP    - OUTPUT INTEGER BYTES TO SKIP IN GRIB1 DATA FILE
C  LGRIB    - OUTPUT INTEGER BYTES TO READ IN GRIB1 DATA FILE
C             (0 IF RECORD NOT FOUND)
C
      INTEGER KPDS(100)
c     PARAMETER(MBUF=8192*128)
      PARAMETER(MBUF=2300000)
      CHARACTER CBUF(MBUF)
      SAVE LUX,NSKP,NLEN,NNUM,CBUF
      DATA LUX/0/
      CHARACTER CHEAD(2)*81
      CHARACTER CPDS(28)
      INTEGER KPTR(16),KPDSI(100)
      LOGICAL LMATCH
      IF(INUM.LT.0.OR.LUGI.NE.LUX) THEN
c       REWIND LUGI
c       READ(LUGI,IOSTAT=IOS) CHEAD
        call baread(lugi,0,162,ka,chead)
        ios=0
        if (ka.ne.162) ios=1
        
        IF(IOS.EQ.0.AND.CHEAD(1)(42:47).EQ.'GB1IX1') THEN
          LUX=0
          READ(CHEAD(2),'(8X,3I10,2X,A40)',IOSTAT=IOS) NSKP,NLEN,NNUM
          IF(IOS.EQ.0) THEN
            NBUF=NNUM*NLEN
            IF(NBUF.GT.MBUF) THEN
              PRINT *,'PDS567: INCREASE BUFFER FROM ',MBUF,' TO ',NBUF
              NNUM=MBUF/NLEN
              NBUF=NNUM*NLEN
            ENDIF
            CALL BAREAD(LUGI,NSKP,NBUF,LBUF,CBUF)
            IF(LBUF.EQ.NBUF) THEN
              LUX=LUGI
              INUM=0
            ENDIF
          ENDIF
        ENDIF
      ENDIF
      LGRIB=0
      IF(INUM.GE.0.AND.LUGI.EQ.LUX) THEN
        N=INUM+1
        DOWHILE(LGRIB.EQ.0.AND.N.LE.NNUM)
c         CPDS=CBUF((N-1)*NLEN+26:(N-1)*NLEN+53)
	  do i9 = 1, 28
	     cpds(i9) = CBUF((N-1)*NLEN+25+i9)
	  enddo
c         KPTR=0
          call ifill(kptr,16,0) 
          CALL GBYTEc(CBUF,KPTR(3),(N-1)*NLEN*8+25*8,3*8)
          CALL FI632(CPDS,KPTR,KPDSI,IRET)
          LMATCH=.TRUE.
          IP=1
          DOWHILE(LMATCH.AND.IP.LE.22)
            LMATCH=KPDS(IP).EQ.-1.OR.KPDS(IP).EQ.KPDSI(IP)
            IP=IP+1
          ENDDO
          IF(LMATCH) THEN
c           KPDS=KPDSI
	    call ifillv(kpds,kpdsi,100)
            INUM=N
            CALL GBYTEc(CBUF,LSKIP,(N-1)*NLEN*8,4*8)
            CALL GBYTEc(CBUF,LGRIB,(N-1)*NLEN*8+20*8,4*8)
          ENDIF
          N=N+1
        ENDDO
      ENDIF
      RETURN
      END
C-----------------------------------------------------------------------
	subroutine ifill(ia,n,ival)
	integer ia(n),ival
	do i = 1, n
	    ia(i) = ival
	enddo
	return
	end
	subroutine ifillv(ia,ib,n)
	integer ia(n), ib(n)
	do i = 1, n
	    ia(n) = ib(n)
	enddo
	return
	end
