      SUBROUTINE GRIB_WRITE(kunit,
     $                     pbuf, kbufsize, knfields,
     $                     kcode, kdate, ktime, 
     $                     kclass, ktype, kexpid,
     $                     kencodebits, kmodelid,
     $                     ktimeperiod,
     $                     kret)

      implicit none

c
c***  SUBROUTINE GRIB_WRITE(kunit,
c    $                     pbuf, kbufsize, knfields,
c    $                     kbuflen, kbuflensize,
c    $                     kclass, ktype, kexpid,
c    $                     kencodebits, kmodelid,
c    $                     ktimeperiod,
c    $                     kret)
c
c     Sami Saarinen, ECMWF, 11/3/96
c                           26/1/98 : Time period - overwrites nsec1(16)-entry
c
c***  Purpose:
c
c     To write field data from a GRIB file
c
c***  Externals:
c
c     PBWRITE   - Write 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) :: kbufsize    ! Length of the input pbuf-array
      integer, intent(in) :: knfields    ! Number of fields ( >= 0 )
c***  Output variables
      REAL,    intent(in) :: pbuf(kbufsize, knfields) ! Fields
      integer, intent(in) :: kcode(knfields)         ! Code number of the field
      integer, intent(in) :: kdate (knfields)        ! Date YYMMDD of the field
      integer, intent(in) :: ktime(knfields)         ! Date HHMM of the field
      integer, intent(in) :: kclass(knfields)        ! MARS class
      integer, intent(in) :: ktype(knfields)         ! MARS type
      integer, intent(in) :: kexpid(knfields)        ! MARS experiment id, four chars, right adj.
      integer, intent(in) :: kencodebits(knfields)   ! No. of used to encode a value
      integer, intent(in) :: kmodelid(knfields)      ! Model id; e.g. CY18R1 gives 181
      integer, intent(in) :: ktimeperiod(knfields)   ! Time period: 0=analysis, or no. of time units
      integer, intent(out):: kret  ! Return code:
                                   !   >= 0 , # of GRIB-fields written
                                   ! -1 = Error in writing data
c-----------------------------------------------------------------------
! === END OF INTERFACE BLOCK ===

      integer iret_pbio
      integer i_fields_written
      integer j, i_ngriblen, ioutlen, iword
      integer iyycent, icentref
      integer isec1_16
      character*1, parameter :: cloper = 'C'

#include "grib_internal.h"      

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

      inquire(iolength=nobytes) ngrib(1)

c      write(0,*) 'kcode=',kcode
c      write(0,*) 'kdate=',kdate
c      write(0,*) 'ktime=',ktime
c      write(0,*) 'kclass=',kclass
c      write(0,*) 'ktype=',ktype
c      write(0,*) 'cdexpid=',cdexpid

      i_fields_written = 0

      isec1_16 = nsec1(16)

      do j=1,knfields
         if (kcode(j) >= 0) nsec1(6) = kcode(j)

c--   26/1/98: Time period - overwrites nsec1(16)-entry
         if (ktimeperiod(j)>=0) nsec1(16) = ktimeperiod(j)

         if (kdate(j) >= 0) then
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 were accidentally swapped
c     in the footnote comment. Reported to John Chambers, ECMWF.
            icentref = kdate(j)/1000000
            if (icentref == 0) then
c--   Possibly an old version ==> don't touch the NSEC1(21) at all
               iyycent = kdate(j)/10000
            else
               iyycent = mod(kdate(j),1000000)/10000
               if (iyycent == 0) then
                  iyycent = 100 ! Note Year 2000 is still 20th, not 21st century
               else
                  icentref = icentref + 1
               endif
               nsec1(21) = icentref ! Century reference
            endif
            nsec1(10) = iyycent                 ! YY
            nsec1(11) = mod(kdate(j),10000)/100 ! MM
            nsec1(12) = mod(kdate(j),100)       ! DD
         endif

         if (ktime(j) >= 0) then
            nsec1(13) = ktime(j)/100            ! HH
            nsec1(14) = mod(ktime(j),100)       ! MM
         endif

         if (kclass(j) >= 0)  nsec1(38) = kclass(j)
         if (ktype(j)  >= 0)  nsec1(39) = ktype(j)
         if (kexpid(j) /= -1) nsec1(41) = kexpid(j)
         if (kmodelid(j) > 0) nsec1(3)  = kmodelid(j)
         if (kencodebits(j) >= 8) nsec4(2) = kencodebits(j)

         i_ngriblen = size(ngrib)

c         write(0,*)'i_ngriblen=',i_ngriblen

         call GRIBEX(nsec0, nsec1, 
     $        nsec2, rsec2,
     $        nsec3, rsec3,
     $        nsec4, 
     $        pbuf(1,j), kbufsize,
     $        ngrib, i_ngriblen, 
     $        iword, cloper, iret_pbio)

         if (iret_pbio > 0) then
            kret = -1
            return
         endif
         ioutlen = iword * nobytes

c         write(0,*)'iword, ioutlen=',iword, ioutlen

         call PBWRITE(kunit, ngrib, ioutlen, iret_pbio)

         if (iret_pbio < 0) then
            kret = iret_pbio
            goto 9999
         endif

         i_fields_written = i_fields_written + 1
      enddo

      kret = i_fields_written

 9999 continue
      nsec1(16) = isec1_16

      return
      END

