      SUBROUTINE GRIB_READ(kunit,
     $                     pbuf, kbufsize, 
     $                     kbuflen, kbuflensize,
     $                     kcode, kdate, ktime,
     $                     cdoper, kwhat, kret)

      implicit none

c
c***  SUBROUTINE GRIB_READ(kunit,
c    $                     pbuf, kbufsize, 
c    $                     kbuflen, kbuflensize,
c    $                     kcode, kdate, ktime,
c    $                     cdoper, kwhat, kret)
c
c     Sami Saarinen, ECMWF, 28/11/95
c
c***  Purpose:
c
c     To read field data from a GRIB file
c
c***  Externals:
c
c     PBGRIB    - Read one GRIB-product (field) from a GRIB-file
c     GRIBEX    - Unpack product to a fp-field array
c
c***  Notes:
c
c     Coded in Fortran-90
c
c***  Input variables
      integer, intent(in) :: kunit ! PBIO file pointer
      integer, intent(in) :: kwhat ! Type of read:
                                   ! 1 = Read the next field
                                   ! n = Read the 'n' next fields
                                   !-1 = Read all the remaining fields
      integer, intent(in) :: kbufsize    ! Length of the input pbuf-array
      integer, intent(in) :: kbuflensize ! Length of the GRIB-length array
      character*1, intent(in) :: cdoper  ! GRIBEX operation (e.g. 'D' or 'R')
c***  Output variables
      REAL,    intent(out):: pbuf(kbufsize)       ! Real array for GRIB-data
      integer, intent(out):: kbuflen(kbuflensize) ! GRIB-length array
      integer, intent(out):: kcode(kbuflensize)   ! Code number per field
      integer, intent(out):: kdate(kbuflensize)   ! Field date
      integer, intent(out):: ktime(kbuflensize)   ! Field time
      integer, intent(out):: kret  ! Return code:
                                   !   >= 0 , # of GRIB-fields read
                                   ! -1 = Error in reading data
                                   ! -2 = kbufsize was not large
                                   !      enough to hold all the data
                                   ! -3 = kbuflensize was not large
                                   !      enough to hold the GRIB-lengths

c-----------------------------------------------------------------------
! === END OF INTERFACE BLOCK ===

      integer iret_pbio
      integer i_fields, i_fields_read, i_field_len
      integer j, i_ptr, i_ngriblen, ioutlen, iword, icode
      integer idate, itime
      integer iyycent, icentref

#include "grib_internal.h"

c-----------------------------------------------------------------------
c
c     1. Read and unpack GRIB-products (fields) from a GRIB-file
c        -------------------------------------------------------
c

      if ( kwhat < 0 ) then
         i_fields = jp_bignum
      else
         i_fields = kwhat
      endif

      i_fields_read = 0
      i_ptr = 0

      inquire(iolength=nobytes) ngrib(1)

      do j=1,i_fields
         i_ngriblen = size(ngrib) * nobytes

         call PBGRIB(kunit, ngrib, i_ngriblen, ioutlen, iret_pbio)

         if (iret_pbio == -1) then
            if (kwhat < 0) exit ! do j=1,i_fields
         endif

         if (iret_pbio < 0) then
            kret = -1
            if (iret_pbio == -3) kret = -2
            return
         endif

         i_fields_read = i_fields_read + 1
         if (i_fields_read > kbuflensize) then
            kret = -3
            return
         endif
         
         call GRIBEX(nsec0, nsec1, 
     $        nsec2, rsec2,
     $        nsec3, rsec3,
     $        nsec4, 
     $        pbuf(i_ptr + 1), kbufsize - i_ptr,
     $        ngrib, ioutlen, 
     $        iword, cdoper, iret_pbio)

         icode = nsec1(6)

c--   Y2K fix for date done
c     13/5/98: note there was an error in GRIB doc, where
c     ksec1(10) and ksec1(21) indices where accidentally swapped
c     in the footnote comment. Reported to John Chambers, ECMWF.
         
c     nsec1(21) = 20; nsec1(10)=100 ! Year 2000 --> OK
c     nsec1(21) = 21; nsec1(10)=1   ! Year 2001 --> OK
         
         iyycent = nsec1(10)
         icentref = nsec1(21)

         if (icentref == 100) then
c--   Years 1900, 2000, 2100, ...
            icentref = 0
         else
c--   Any other year
            icentref = icentref - 1
         endif
         
         idate = 
     $   icentref*1000000 + iyycent*10000 + nsec1(11)*100 + nsec1(12)

         itime = nsec1(13)*100 + nsec1(14)

         i_field_len = max(0,abs(nsec4(1)))
         kbuflen(j) = i_field_len
         kcode(j) = icode
         kdate(j) = idate
         ktime(j) = itime
         
         i_ptr = i_ptr + i_field_len

         if (i_ptr > kbufsize) then
            kret = -2
            return
         endif
      enddo

      kret = i_fields_read

      return
      END

