#include "w3macros.h"
!/ ------------------------------------------------------------------- /
      PROGRAM W3GRIB
!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |           H. L. Tolman            |
!/                  |            A. Chawla              |
!/                  |           J.-H. Alves             |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         26-Jul-2018 |
!/                  +-----------------------------------+
!/
!/    01-Nov-1999 : Final FORTRAN 77        ( version 1.18 + error fix )
!/    24-Jan-2000 : Upgrade to FORTRAN 90               ( version 2.00 )
!/    25-Jan-2001 : Flat grid error exit added          ( version 2.06 )
!/    29-Apr-2002 : Adding output fields 17-18.         ( version 2.20 )
!/    08-May-2002 : Replace XLF switch with NCEP1.      ( version 2.21 )
!/    13-Nov-2002 : Add stress vector.                  ( version 3.00 )
!/    24-Dec-2004 : Multiple grid version.              ( version 3.06 )
!/    20-Jul-2005 : Additional output parameters.       ( version 3.07 )
!/    11-Apr-2007 : Additional output parameters.       ( version 3.11 )
!/    18-May-2007 : Update GRIB1 for partitioning.      ( version 3.11 )
!/    16-Jul-2007 : Adding GRIB2 capability.            ( version 3.11 )
!/                  (A. Chawla)
!/    01-Aug-2007 : Update FLGRIB for GRIB2.            ( version 3.11 )
!/    29-May-2009 : Preparing distribution version.     ( version 3.14 )
!/    30-Oct-2009 : Implement run-time grid selection.  ( version 3.14 )
!/                  (W. E. Rogers & T. J. Campbell, NRL)
!/    05-Oct-2011 : Updating to the 53 output parameter ( version 4.05 )
!/                  (Arun Chawla)
!/    01-Mar-2013 : Adding double-index output fields   ( version 4.11 )
!/                  (J-Henrique Alves)
!/    01-Dec-2016 : Adding lambert conformal grid       ( version 6.01 ) 
!/                  (J.H. Alves)
!/    26-Jul-2018 : Adding polar stereographic grid     ( version 6.05 ) 
!/                  (J.H. Alves)
!/
!/    Copyright 2009 National Weather Service (NWS),
!/       National Oceanic and Atmospheric Administration.  All rights
!/       reserved.  WAVEWATCH III is a trademark of the NWS. 
!/       No unauthorized use without permission.
!/
!  1. Purpose :
!
!     Post-processing of grid output.
!
!  2. Method :
!
!     Data is read from the grid output file out_grd.ww3 (raw data)
!     and from the file ww3_grib.inp ( NDSI, output requests ).
!     Model definition and raw data files are read using WAVEWATCH III
!     subroutines.
!     GRIB packing is performed using NCEP's W3 library (not supplied).
!
!     When adding new parameters to GRIB packing, keep in mind that
!     packing is done differently for scalar and vector quantities
!
!  3. Parameters :
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      W3NMOD    Subr. W3GDATMD Set number of model.
!      W3SETG    Subr.   Id.    Point to selected model.
!      W3NDAT    Subr. W3WDATMD Set number of model for wave data.
!      W3SETW    Subr.   Id.    Point to selected model for wave data.
!      W3NAUX    Subr. W3ADATMD Set number of model for aux data.
!      W3SETA    Subr.   Id.    Point to selected model for aux data.
!      ITRACE    Subr. W3SERVMD Subroutine tracing initialization.
!      STRACE    Subr.   Id.    Subroutine tracing.
!      NEXTLN    Subr.   Id.    Get next line from input filw
!      EXTCDE    Subr.   Id.    Abort program as graceful as possible.
!      STME21    Subr. W3TIMEMD Convert time to string.
!      TICK21    Subr.   Id.    Advance time.
!      DSEC21    Func.   Id.    Difference between times.
!      W3IOGR    Subr. W3IOGRMD Reading/writing model definition file.
!      W3IOGO    Subr. W3IOGOMD Reading/writing raw gridded data file.
!      W3READFLGRD Subr. W3IOGOMD Reading output fields flags. 
!      W3EXGB    Subr. Internal Execute grib output.
!      BAOPEN    Subr.          NCEP library routine.
!      BAOPENW    Subr.          NCEP library routine.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!     None, stand-alone program.
!
!  6. Error messages :
!
!     Checks on input, checks in W3IOxx.
!
!  7. Remarks :
!
!  8. Structure :
!
!     See source code.
!
!  9. Switches :
!
!       !/S     Enable subroutine tracing.
!
!       !/NCO   NCEP NCO modifications for operational implementation.
!
!       !/NOGRB No GRIB package included.
!       !/NCEP1 NCEP IBM links to GRIB1 packing routines.
!       !/NCEP2 NCEP IBM links to GRIB2 packing routines.
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
      USE CONSTANTS
!
!     USE W3GDATMD, ONLY: W3NMOD, W3SETG
      USE W3WDATMD, ONLY: W3NDAT, W3SETW
!      USE W3ADATMD, ONLY: W3NAUX, W3SETA
      USE W3ODATMD, ONLY: W3NOUT, W3SETO
      USE W3IOGRMD, ONLY: W3IOGR
      USE W3IOGOMD, ONLY: W3READFLGRD, W3IOGO
      USE W3SERVMD, ONLY : ITRACE, NEXTLN, EXTCDE
!/S      USE W3SERVMD, ONLY : STRACE
      USE W3TIMEMD, ONLY: STME21, TICK21, DSEC21
!
      USE W3GDATMD
      USE W3WDATMD, ONLY: TIME, WLV, ICE, UST, USTDIR
      USE W3ADATMD
      USE W3ODATMD, ONLY: NDSE, NDST, NDSO, NOGRP, NGRPP, IDOUT, UNDEF,&
                          FLOGRD, FNMPRE, NOSWLL, NOGE, FLOGD
!
      IMPLICIT NONE
!/
!/ ------------------------------------------------------------------- /
!/ Local variables
!/
      INTEGER                 :: NDSI, NDSM, NDSOG, NDSDAT, NDSTRC,   &
                                 NTRACE, IERR, IOTEST, I,J,K, IFI,IFJ,&
                                 ISEA, IX, IY, TOUT(2), NOUT, TDUM(2),&
                                 FTIME(2), CID, PID, GID, GDS, IOUT,  &
                                 GDTN
      INTEGER, ALLOCATABLE    :: IFIA(:),IFJA(:) 
! GRIB1 specific variables
!/NOGRB      INTEGER                 :: KPDS(1), KGDS(1)
!/NCEP1      INTEGER                 :: KPDS(25), KGDS(22)
! GRIB2 specific variables
!/NCEP2      INTEGER                 :: KPDS(200), KGDS(200), IDRS(200)
!/NCEP2      INTEGER                 :: LISTSEC0(3), LISTSEC1(13),IGDS(5)
!/NCEP2      INTEGER                 :: IDEFLIST, IDEFNUM, KPDSNUM, NUMCOORD
!/NCEP2      INTEGER                 :: IBMP, LCGRIB, LENGRIB, IDRSNUM
!/NCEP2      REAL                    :: COORDLIST, XN
!/NCEP2      CHARACTER(LEN=1), ALLOCATABLE  :: CGRIB(:)
!/NCEP2      INTEGER                 :: LATAN1, LONV, SCNMOD, LATIN1, & 
!/NCEP2                                 LATIN2, LATSP, LONSP  
!/NCEP2      REAL                    :: DSX, DSY 
!/NCEP2      REAL                    :: YN, X0N, Y0N 
!/S      INTEGER, SAVE           :: IENT = 0
      REAL                    :: DTREQ, DTEST, RFTIME
      LOGICAL                 :: FLREQ(NOGRP,NGRPP), FLGRIB(NOGRP,NGRPP)
      CHARACTER               :: COMSTR*1, IDTIME*23, IDDDAY*11
      CHARACTER(LEN=80)       :: LINEIN
      CHARACTER(LEN=8)        :: WORDS(5)
      INTEGER                 :: GEN_PRO

!/
!/ ------------------------------------------------------------------- /
!/
!/NCO/!     CALL W3TAGB('WAVEGRIB',1998,0007,0050,'NP21   ')
!
!--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! 1.  IO set-up.
!
      CALL W3NMOD ( 1, 6, 6 )
      CALL W3SETG ( 1, 6, 6 )
      CALL W3NDAT (    6, 6 )
      CALL W3SETW ( 1, 6, 6 )
      CALL W3NAUX (    6, 6 )
      CALL W3SETA ( 1, 6, 6 )
      CALL W3NOUT (    6, 6 )
      CALL W3SETO ( 1, 6, 6 )
!
      NDSI   = 10
      NDSM   = 20
      NDSOG  = 20
      NDSDAT = 50
!
      NDSTRC =  6
      NTRACE = 10
!
!/NCO/!
!/NCO/! Redo according to NCO
!/NCO/!
!/NCO      NDSI   = 11
!/NCO      NDSO   =  6
!/NCO      NDSE   = NDSO
!/NCO      NDST   = NDSO
!/NCO      NDSM   = 12
!/NCO      NDSOG  = 13
!/NCO      NDSDAT = 51
!/NCO      NDSTRC = NDSO
!
      WRITE (NDSO,900)
!
      CALL ITRACE ( NDSTRC, NTRACE )
!/S      CALL STRACE (IENT, 'W3GRIB')
!
      OPEN (NDSI,FILE='ww3_grib.inp',STATUS='OLD',ERR=800,IOSTAT=IERR)
      READ (NDSI,'(A)',END=801,ERR=802) COMSTR
      IF (COMSTR.EQ.' ') COMSTR = '$'
      WRITE (NDSO,901) COMSTR
!
!/NOGRB      WRITE (NDSE,902)
!/NCEP1      CALL BAOPEN (NDSDAT,'gribfile',IERR)
!/NCEP2      CALL BAOPENW (NDSDAT,'gribfile',IERR)
!
!--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! 2.  Read model definition file.
!
      CALL W3IOGR ( 'READ', NDSM )
      WRITE (NDSO,920) GNAME
!
      IF ( .NOT. FLAGLL ) GOTO 810
!
!--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! 3.  Read requests from input file.
!     Output times
!
      CALL NEXTLN ( COMSTR , NDSI , NDSE )
      READ (NDSI,'(A)') LINEIN
      WRITE(NDSO,*)' LINEIN:  ',LINEIN
      READ(LINEIN,*,iostat=ierr) WORDS
      WRITE (NDSO,*) WORDS
          READ(WORDS( 1 ), * ) TOUT(1)
          READ(WORDS( 2 ), * ) TOUT(2)
          READ(WORDS( 3 ), * ) DTREQ
          READ(WORDS( 4 ), * ) NOUT
       IF (WORDS(5) .NE. '0' .AND. WORDS(5) .NE. '1') THEN
            GEN_PRO=-99999
          ELSE
            READ(WORDS( 5 ), * ) GEN_PRO
      ENDIF
      WRITE(NDSO,*) 'GEN_PRO  ',GEN_PRO 
      DTREQ  = MAX ( 0. , DTREQ )
      IF ( DTREQ.EQ.0 ) NOUT = 1
      NOUT   = MAX ( 1 , NOUT )
!
      CALL STME21 ( TOUT , IDTIME )
      WRITE (NDSO,940) IDTIME
!
      TDUM(1) = 0
      TDUM(2) = 0
      CALL TICK21 ( TDUM , DTREQ )
      CALL STME21 ( TDUM , IDTIME )
      IF ( DTREQ .GE. 86400. ) THEN
          WRITE (IDDDAY,'(I10,1X)') INT(DTREQ/86400.)
        ELSE
          IDDDAY = '           '
        END IF
      IDTIME(1:11) = IDDDAY
      IDTIME(21:23) = '   '
      WRITE (NDSO,941) IDTIME, NOUT
!
! ... Initialize FLGRD array 
!
      FLREQ(:,:)=.FALSE. 
!
! ... Call to interface for reading flags or namelists
!
      CALL W3READFLGRD ( NDSI, NDSO, 9, NDSE, COMSTR, FLOGD, FLREQ,   &
                         1, 1, IERR )
!
! Inform user of parameters that were requested but failed to make the
! grade, as they are not available for grib encoding, or are not
! included presently
!
      WRITE (NDSO,944)
! Reset flags for variables not yet implemented in grib output
! interface 
!
!
      IFI = 3 ! Entire group Frequency-dependent parameters 
      DO IFJ = 1,NOGE(IFI)
        IF ( FLREQ(IFI,IFJ) ) THEN
          WRITE (NDSO,946) IDOUT(IFI,IFJ),                           &
                           '*** NOT YET CODED INTO WW3_GRIB ***'
          FLREQ(IFI,IFJ) = .FALSE.
        END IF
      END DO
! 
      IFI = 5 ! Atm-waves layer, all except for friction velocity
      DO IFJ = 2,10
        IF ( FLREQ(IFI,IFJ) ) THEN
          WRITE (NDSO,946) IDOUT(IFI,IFJ),                           &
                           '*** NOT YET CODED INTO WW3_GRIB ***'
          FLREQ(IFI,IFJ) = .FALSE.
        END IF
      END DO
      DO IFI = 6,8 ! Entire groups wave-ocean interaction, wave-bottom
                   ! layer and spectrum parameters
        DO IFJ = 1,NOGE(IFI)
          IF ( FLREQ(IFI,IFJ) ) THEN
            WRITE (NDSO,946) IDOUT(IFI,IFJ),                           &
                             '*** NOT YET CODED INTO WW3_GRIB ***'
            FLREQ(IFI,IFJ) = .FALSE.
          END IF
        END DO
      END DO
      IF ( FLREQ(9,5) ) THEN ! CFL number for K advection
       WRITE (NDSO,946) IDOUT(9,5),'*** NOT YET CODED INTO WW3_GRIB ***'
        FLREQ(9,5) = .FALSE.
      END IF
      IFI = 10 ! User defined parameters
      DO IFJ = 1,NOGE(IFI)
        IF ( FLREQ(IFI,IFJ) ) THEN
          WRITE (NDSO,946) IDOUT(IFI,IFJ),                           &
                           '*** NOT YET CODED INTO WW3_GRIB ***'
          FLREQ(IFI,IFJ) = .FALSE.
        END IF
      END DO
!
! Compatibility with NCEP operational codes, same effect as old FLGRIB
!  lists variables that have no code for variable names (not 100%
!  correct in old codes... )
!
! Chage this as parameters become available in grib2 tables
!
      ALLOCATE ( IFIA (13), IFJA(13) ) 

      IFIA = (/ 1, 2, 2, 4, 4, 4, 4, 4, 5, 9, 9, 9, 9 /)
      IFJA = (/ 4, 2, 8, 3, 5, 6, 7, 8, 1, 1, 2, 3, 4 /)
      DO I = 1, 13 
        IF ( FLREQ(IFIA(I),IFJA(I)) ) THEN
          FLREQ(IFIA(I),IFJA(I)) = .FALSE. 
          WRITE(NDSO,946) IDOUT(IFIA(I),IFJA(I)),                      &
                        '*** EXCLUDED FROM GRIB OUTPUT ***'
        END IF
      END DO
!
! Write to stdout parameters that have successfully been requested
!
      WRITE (NDSO,945)
       DO I=1, NOGRP
       DO J=1, NGRPP
        IF ( FLREQ(I,J) ) WRITE (NDSO,931) IDOUT(I,J)
        END DO
        END DO
!
!
!
! ... GRIB specific parameters
!
      CALL NEXTLN ( COMSTR , NDSI , NDSE )
      READ (NDSI,*,END=801,ERR=802) FTIME, CID, PID, GID, GDS, GDTN
! 
! Check if grid type is curvilinear, and only go on if Lambert conformal 
! or PolarStereo
! 
      IF ( GTYPE .EQ. CLGTYPE ) THEN 
!/NCEP2! Allowing code to work with Lambert conformal grids 
!/NCEP2      IF ( GDTN .NE. 30 .AND. GDTN .NE. 20 ) THEN 
        WRITE(NDSE,*)'PROGRAM W3GRIB: CURVILINEAR GRID SUPPORT '// & 
        'FOR GRIB OUTPUT IS NOT YET IMPLEMENTED. NOW STOPPING' 
        CALL EXTCDE ( 1 ) 
!/NCEP2      ENDIF 
      END IF 
! 
! 
! Coded up to now only for Lamber conformal grids (GDTN=30) or 
! PolarStereo (GDTN=20). For regular grids use GDTN=0 
! 
!/NCEP2      IF ( GDTN .EQ. 30 ) THEN 
!/NCEP2! This is a Lambert conformal grid, read projection parameters 
!/NCEP2        CALL NEXTLN ( COMSTR , NDSI , NDSE ) 
!/NCEP2        READ (NDSI,*,END=801,ERR=802) LATAN1, LONV, DSX, DSY,          & 
!/NCEP2                                SCNMOD, LATIN1, LATIN2, LATSP, LONSP 
!/NCEP2             ELSEIF ( GDTN .EQ. 20 ) THEN
!/NCEP2               CALL NEXTLN ( COMSTR , NDSI , NDSE )
!/NCEP2               READ (NDSI,*,END=801,ERR=802) LATAN1, LONV, DSX, DSY,   &
!/NCEP2                                             SCNMOD

!/NCEP2      ENDIF 
!
      CALL STME21 ( FTIME , IDTIME )
      WRITE (NDSO,948) IDTIME, CID, PID, GID, GDS
! 
! 
!--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
! 4.  Read general data and first fields from file 
! 4.a Read file. 
! 
      CALL W3IOGO ( 'READ', NDSOG, IOTEST ) 
! 
! 4.b Output fields in file 
! 
! 
      WRITE (NDSO,930) 
      DO I=1, NOGRP 
       DO J=1, NGRPP 
        IF ( FLOGRD(I,J) ) WRITE (NDSO,931) IDOUT(I,J) 
        END DO 
        END DO 
! 
!/NCEP2! 
!/NCEP2      IF ( GDTN .EQ. 0 ) THEN 
!/NCEP2! 
! 4.c Flip MAPSF for REGULAR/RECTILINEAR grids 
! 
      DO ISEA=1, NSEA 
        IX            = MAPSF(ISEA,1) 
        IY            = MAPSF(ISEA,2) 
        MAPSF(ISEA,2) = NY + 1 - IY 
        MAPSF(ISEA,3) = IY +( IX-1)*NY 
        END DO 
!/NCEP2! 
!/NCEP2      ENDIF 
!
!--- - - - - - - - - - - - - - - - - - - - - - - - - -  
! 5. Set grib encoding parameter Sections 
! 
! ... Initialize KPDS and KGDS (for both NCEP1 and NCEP2)
!
      KPDS     =   0
      KGDS     =   0
!
! ... Set PDS GRIB1 elements
!
!     ( 1)  ID OF CENTER
!     ( 2)  GENERATING PROCESS ID NUMBER
!     ( 3)  GRID DEFINITION
!     ( 4)  GDS/BMS FLAG (RIGHT ADJ COPY OF OCTET 8)
!  ** ( 5)  INDICATOR OF PARAMETER
!     ( 6)  TYPE OF LEVEL
!     ( 7)  HEIGHT/PRESSURE , ETC OF LEVEL
!   * ( 8)  YEAR of century
!   * ( 9)  MONTH OF YEAR
!   * (10)  DAY OF MONTH
!   * (11)  HOUR OF DAY
!     (12)  MINUTE OF HOUR
!     (13)  INDICATOR OF FORECAST TIME UNIT
!   * (14)  TIME RANGE 1
!     (15)  TIME RANGE 2
!     (16)  TIME RANGE FLAG
!     (17)  NUMBER INCLUDED IN AVERAGE
!     (18)  VERSION NR OF GRIB SPECIFICATION
!     (19)  VERSION NR OF PARAMETER TABLE
!     (20)  NR MISSING FROM AVERAGE/ACCUMULATION
!   * (21)  CENTURY OF REFERENCE TIME OF DATA
!     (22)  UNITS DECIMAL SCALE FACTOR
!     (23)  SUBCENTER NUMBER
!     (24)  PDS BYTE 29, FOR NMC ENSEMBLE PRODUCTS
!     (25)  PDS BYTE 30, NOT USED
!
!  * : Changing on the fly in main program
! ** : Changing on the fly in W3EXGB
!
!/NCEP1      KPDS( 1) = CID
!/NCEP1      KPDS( 2) = PID
!/NCEP1      KPDS( 3) = GID
!/NCEP1      KPDS( 4) = GDS
!/NCEP1      KPDS( 6) =   1
!/NCEP1      KPDS( 7) =   1
!/NCEP1      KPDS(13) =   1
!/NCEP1      KPDS(18) =   1
!/NCEP1      KPDS(22) =   2
!
! ... Set GDS GRIB1 elements
!
!     ( 1)  DATA REPRESENTATION TYPE
!     ( 2)  N(I) NR POINTS ON LATITUDE CIRCLE
!     ( 3)  N(J) NR POINTS ON LONGITUDE MERIDIAN
!     ( 4)  LA(1) LATITUDE OF ORIGIN
!     ( 5)  LO(1) LONGITUDE OF ORIGIN
!     ( 6)  RESOLUTION FLAG (RIGHT ADJ COPY OF OCTET 17)
!     ( 7)  LA(2) LATITUDE OF EXTREME POINT
!     ( 8)  LO(2) LONGITUDE OF EXTREME POINT
!     ( 9)  DI LONGITUDINAL DIRECTION OF INCREMENT
!     (10)  DJ LATITUDINAL DIRECTION INCREMENT
!     (11)  SCANNING MODE FLAG (RIGHT ADJ COPY OF OCTET 28)
!     (19)  NUMBER OF VERTICAL COORDINATE PARAMETERS
!     (20)  OCTET NUMBER OF THE LIST OF VERTICAL COORDINATE
!           PARAMETERS OR OCTET NUMBER OF THE LIST OF NUMBERS
!           OF POINTS IN EACH ROW OR 255 IF NEITHER ARE PRESENT
!     (21)  FOR GRIDS WITH PL, NUMBER OF POINTS IN GRID
!     (22)  NUMBER OF WORDS IN EACH ROW
!
!/NCEP1      KGDS( 2) = NX
!/NCEP1      KGDS( 3) = NY
!/NCEP1      KGDS( 4) = NINT(1000.*(Y0+(REAL(NY-1)*SY)))
!/NCEP1      KGDS( 5) = NINT(1000.*X0)
!/NCEP1      KGDS( 6) = 128
!/NCEP1      KGDS( 7) = NINT(1000.*Y0)
!/NCEP1      KGDS( 8) = NINT(1000.*(X0+REAL(NX-1)*SX))
!/NCEP1      KGDS( 9) = NINT(1000.*SX)
!/NCEP1      KGDS(10) = NINT(1000.*SY)
!/NCEP1      KGDS(20) = 255
!
! ... Set GRIB2 packing arrays
!
!/NCEP2      LCGRIB = 4*NX*NY
!/NCEP2      ALLOCATE(CGRIB(LCGRIB))
!
! ... Set GRIB2 Indicator Section
!      ( 1)  Discipline-GRIB Master Table Number (see Code Table 0.0)
!            0 = Metereological; 10 = Oceanographic
!      ( 2)  GRIB Edition Number
!      ( 3)
!/NCEP2       LISTSEC0      =   0
!/NCEP2       LISTSEC0(1)   =   10      
!/NCEP2       LISTSEC0(2)   =   2       
!
! ... Set GRIB2 Identification Section
!       ( 1) ID OF CENTER
!       ( 2) ID OF SUB-CENTER
!       ( 3) GRIB Master Tables Version Number (Code Table 1.0)
!       ( 4) GRIB Local Tables Version Number (Code Table 1.0)
!       ( 5) Significance of Reference Time (Code Table 1.2)
!     * ( 6) YEAR (4 digits)
!     * ( 7) MONTH OF YEAR
!     * ( 8) DAY OF MONTH
!     * ( 9) HOUR OF DAY
!       (10) MINUTE OF HOUR
!       (11) SECOND OF MINUTE
!       (12) Production status of data (Code Table 1.3)
!       (13) Type of processed data (Code Table 1.4)
!
!/NCEP2       LISTSEC1     =  0
!/NCEP2       LISTSEC1(1)  = CID
!/NCEP2       LISTSEC1(3)  = 2
!/NCEP2       LISTSEC1(4)  = 1
!/NCEP2       LISTSEC1(5)  = 1
!/NCEP2       LISTSEC1(13) = 1
!
! ... Set GRIB2 IGDS elements
!       ( 1) Source of grid definition (Code Table 3.0)
!       ( 2) Number of grid points
!       ( 3) Number of octets needed for each additional grid points definition
!       ( 4) Interpretation of list for optional points definition (Code Table 3.11)
!       ( 5) Grid definition template number (Code Table 3.1)
!
!/NCEP2         IGDS     = 0 ! Defined in code
!/NCEP2         IGDS(2)  = NX*NY
!/NCEP2         IDEFNUM  = 0
!/NCEP2         IDEFLIST = 0
!/NCEP2         IGDS(5)=GDTN
!/NCEP2       IF ( GDTN .EQ. 30 .AND. GTYPE .EQ. CLGTYPE ) THEN
!/NCEP2         IDEFNUM  = 1
!/NCEP2         WRITE (NDSO,1011) 'LAMBERTCONF'
!/NCEP2       ELSEIF ( GDTN .EQ. 20 .AND. GTYPE .EQ. CLGTYPE ) THEN
!/NCEP2         WRITE (NDSO,1011) 'POLARSTEREO'
!/NCEP2       ELSEIF ( GDTN .EQ. 0 ) THEN
!/NCEP2         WRITE (NDSO,1011) 'LLRECTILINEAR'
!/NCEP2       ELSE
!/NCEP2         WRITE(NDSE,*)'PROGRAM WAVEGRIB2: SUPPORT FOR CHOSEN '// &
!/NCEP2         'GRIB2 GRID DEFINITION TEMPLATE NOT YET IMPLEMENTED'
!/NCEP2         CALL EXTCDE ( 2 )
!/NCEP2       ENDIF
!
! ... Set GRIB2 KGDS elements
!
! General parameters for all grids
!       ( 1) Coordinate system (6 = spherical coordinate system with radius of 6,371,229 m)
!       ( 2) 
!       ( 3)
!       ( 4) 
!       ( 5)
!       ( 6)
!       ( 7)
!       ( 8) Number of points along parallel
!       ( 9) Number of points along meridian
!/NCEP2      KGDS( 1) = 6
!/NCEP2      KGDS( 8) = NX
!/NCEP2      KGDS( 9) = NY
!
!/NCEP2      IF ( GDTN .EQ. 30 ) THEN
!
! Lambert Conformal grid
!       (10) Latitude of first grid point
!       (11) Longitude of first grid point
!       (12) Resolution and component flags 
!       (13) Latitude where DX and DY are specified
!       (14) Longitude of orientation
!       (15) Increment of longitude
!       (16) Increment of latitude
!       (17) Projection center flag
!       (18) Scanning mode
!       (19) First latitude of secant cone 
!       (20) Second latitude of secant cone
!       (21) Latitude of southern pole
!       (22) Longitude of southern pole
!
!/NCEP2        X0 = MOD(XGRD(1,1) + 360.,360.)
!/NCEP2        XN = MOD(XGRD(NY,NX) + 360., 360.)
!/NCEP2        X0N = MOD(XGRD(NY,1) + 360., 360.)
!/NCEP2        KGDS(11)=KNINT(1000000.*X0)
!/NCEP2        Y0 = YGRD(1,1)
!/NCEP2        YN = YGRD(NY,NX)
!/NCEP2        Y0N = YGRD(NY,1)
!/NCEP2        KGDS(10)=KNINT(1000000.*Y0)
!/NCEP2        KGDS(12)=0
!/NCEP2        KGDS(13)=DBLE(1000000.*LATAN1)
!/NCEP2        KGDS(14)=DBLE(1000000.*LONV)
!/NCEP2        KGDS(15)=KNINT(1000000*DSX)
!/NCEP2        KGDS(16)=KNINT(1000000*DSY)
!/NCEP2        KGDS(17)=0
!/NCEP2        KGDS(18)=SCNMOD
!/NCEP2        KGDS(19)=DBLE(1000000.*LATIN1)
!/NCEP2        KGDS(20)=DBLE(1000000.*LATIN2)
!/NCEP2        KGDS(21)=DBLE(1000000.*LATSP)
!/NCEP2        KGDS(22)=DBLE(1000000.*LONSP)
!
!/NCEP2      ELSEIF (GDTN .EQ. 20 ) THEN
!
! PolarStereo grid
!       (10) Latitude of first grid point
!       (11) Longitude of first grid point
!       (12) Res and component flags
!       (13) Latitude where DX and DY are specified
!       (14) Longitude of orientation
!       (15) Increment of longitude
!       (16) Increment of latitude
!       (17) Projection center flag
!       (18) Scanning mode
!
!/NCEP2        X0 = MOD(XGRD(1,1) + 360.,360.)
!/NCEP2        XN = MOD(XGRD(NY,NX) + 360., 360.)
!/NCEP2        X0N = MOD(XGRD(NY,1) + 360., 360.)
!/NCEP2        KGDS(11)=KNINT(1000000.*X0)
!/NCEP2        Y0 = YGRD(1,1)
!/NCEP2        YN = YGRD(NY,NX)
!/NCEP2        Y0N = YGRD(NY,1)
!/NCEP2        KGDS(10)=KNINT(1000000.*Y0)
!/NCEP2        KGDS(12)=0
!/NCEP2        KGDS(13)=DBLE(1000000.*LATAN1)
!/NCEP2        KGDS(14)=DBLE(1000000.*LONV)
!/NCEP2        KGDS(15)=KNINT(1000000*DSX)
!/NCEP2        KGDS(16)=KNINT(1000000*DSY)
!/NCEP2        KGDS(17)=0
!/NCEP2        KGDS(18)=SCNMOD
!
!/NCEP2      ELSEIF (GDTN .EQ. 0 ) THEN
!
! Lat Lon rectilinear grid
!       (10)
!       (11)
!       (12) Latitude of first grid point
!       (13) Longitude of first grid point
!       (14) Res and component flags
!       (15) Latitude of last grid point
!       (16) Longitude of last grid point
!       (17) Increment of longitude
!       (18) Increment of latitude
!       (19) Scanning mode
!
!/NCEP2        KGDS(12) = KNINT(1000000.*(Y0+(REAL(NY-1)*SY)))
!/NCEP2        X0 = MOD(X0 + 360.,360.)
!/NCEP2        KGDS(13) = KNINT(1000000.*X0)
!/NCEP2        KGDS(14) = 48
!/NCEP2        KGDS(15) = KNINT(1000000.*Y0)
!/NCEP2        XN = MOD(X0+REAL(NX-1)*SX + 360., 360.)
!/NCEP2        KGDS(16) = KNINT(1000000.*XN)
!/NCEP2        KGDS(17) = KNINT(1000000.*SX)
!/NCEP2        KGDS(18) = KNINT(1000000.*SY)
!/NCEP2      ENDIF
!
! ... Set GRIB2 PDS elements
!     KPDSNUM   (0 indicates forecast at a horizontal level)
!     ( 1) Parameter category (Code Table 4.1)
!            For oceanographic products -- 0 = waves; 1 = currents; 2 = ice
!            For atmospheric products   -- 2 = momentum
!     ( 2) Parameter number (Code Table 4.2)
!     ( 3) Generating process (Code Table 4.3)
!     ( 4) Background generating process identifier (center specific)
!     ( 5) Process or model number
!     ( 6) Hours of observational data cutoff after reference time
!     ( 7) Minutes of observational data cutoff after reference time
!     ( 8) Indicator of forecast time unit (Code Table 4.4)
!     ( 9) Time range
!     (10) Type of level (Code Table 4.5) 1st level
!     (11) Scaled factor of (10)
!     (12) Scaled value of (10) 
!     (13) Type of level (Code Table 4.5) 2nd level
!     (14) Scaled factor of (13)
!     (15) Scaled value of (13)
!
!
!      KPDS(3)=4 ensemble forecast:ww3_grib.inp has gen_pro set to 1
!             =2 deterministic forecast: ww3_grib.inp gen_pro set to 0
!             =2 legacy :with no gen_pro set in ww3_grib.inp
!              (in the case of legacy the params revert back to old names)
!/NCEP2       KPDSNUM = 0
!/NCEP2      if ( gen_pro.eq.1 ) then
!/NCEP2       KPDS( 3) = 4
!/NCEP2      else
!/NCEP2       KPDS(3)=2
!/NCEP2      endif
!/NCEP2       KPDS( 4) = 0
!/NCEP2       KPDS( 5) = PID
!/NCEP2       KPDS( 8) = 1
!/NCEP2       KPDS(10) = 1
!/NCEP2       KPDS(12) = 1
!/NCEP2       KPDS(13) = 255
!
! ... Set GRIB2 vertical layer information 
!
!/NCEP2       NUMCOORD  = 0
!/NCEP2       COORDLIST = 0.0
!
! ... Set GRIB2 bitmap information
!      0 Bitmap is provided
!
!/NCEP2       IBMP = GDS
!
! ... Set GRIB2 Data Representation Template Number (Code Table 5.0)
!
!/NCEP2       IDRSNUM = 40 !jpeg2000 *** SEGFAULTS in some linux
!                            clusters with Intel compiler ***
!/NCEP2       !IDRSNUM = 0 !simple packing
!/NCEP2       !IDRSNUM = 41 !png packing
!/NCEP2       !IDRSNUM = 2 !Complex Packing (Grid Point Data)
!
! ... Set GRIB2 IDRS elements
!     ( 1) Reference value (R) (IEEE 32-bit floating-point value)
!     ( 2) Binary Scale Factor (E)
!     ( 3) Decimal Scale Factor (D)
!     ( 4) Number of bits used for each packed value
!     ( 5) Type of original field values (Code Table 5.1)
!
!/NCEP2      IDRS    = 0
!/NCEP2      IDRS(3) = 2
!
!/T      WRITE (NDST,9050) KPDS
!/T      WRITE (NDST,9051) KGDS
!
!--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! 6.  Time management.
!
      IOUT   = 0
      WRITE (NDSO,970)
!
      DO
        DTEST  = DSEC21 ( TIME , TOUT )
        IF ( DTEST .GT. 0. ) THEN
            CALL W3IOGO ( 'READ', NDSOG, IOTEST )
            IF ( IOTEST .EQ. -1 ) THEN
                WRITE (NDSO,942)
                GOTO 888
              END IF
            CYCLE
          END IF
        IF ( DTEST .LT. 0. ) THEN
            CALL TICK21 ( TOUT , DTREQ )
            CYCLE
          END IF
!
        IOUT   = IOUT + 1
        CALL STME21 ( TOUT , IDTIME )
!
        RFTIME = DSEC21 ( FTIME , TIME ) / 3600.
        IF ( RFTIME .LT. 0. ) THEN
!/NCEP1            KPDS( 8) = 1 + MOD(TIME(1)/10000-1,100)
!/NCEP1            KPDS( 9) = MOD(TIME(1),10000) / 100
!/NCEP1            KPDS(10) = MOD(TIME(1),100)
!/NCEP1            KPDS(11) = TIME(2) / 10000
!/NCEP1            KPDS(14) = 0
!/NCEP1            KPDS(21) = 1 + (TIME(1)/10000-1)/100
!/NCEP2            LISTSEC1( 6) = TIME(1)/10000
!/NCEP2            LISTSEC1( 7) = MOD(TIME(1),10000) / 100
!/NCEP2            LISTSEC1( 8) = MOD(TIME(1),100)
!/NCEP2            LISTSEC1( 9) = TIME(2) / 10000
!/NCEP2            KPDS( 9)     = 0
            WRITE (NDSO,972) IDTIME
          ELSE
!/NCEP1            KPDS( 8) = 1 + MOD(FTIME(1)/10000-1,100)
!/NCEP1            KPDS( 9) = MOD(FTIME(1),10000) / 100
!/NCEP1            KPDS(10) = MOD(FTIME(1),100)
!/NCEP1            KPDS(11) = FTIME(2) / 10000
!/NCEP1            KPDS(14) = NINT(RFTIME)
!/NCEP1            KPDS(21) = 1 + (FTIME(1)/10000-1)/100
!/NCEP2            LISTSEC1( 6) = FTIME(1)/10000
!/NCEP2            LISTSEC1( 7) = MOD(FTIME(1),10000) / 100
!/NCEP2            LISTSEC1( 8) = MOD(FTIME(1),100)
!/NCEP2            LISTSEC1( 9) = FTIME(2) / 10000
!/NCEP2            KPDS( 9)     = NINT(RFTIME)
            WRITE (NDSO,971) IDTIME, NINT(RFTIME)
          END IF
!
        CALL W3EXGB ( NX, NY, NSEA )
        CALL TICK21 ( TOUT , DTREQ )
        IF ( IOUT .GE. NOUT ) EXIT
        END DO
!
      GOTO 888
!
! Escape locations read errors :
!
  800 CONTINUE
      WRITE (NDSE,1000) IERR
      CALL EXTCDE ( 3 )
!
  801 CONTINUE
      WRITE (NDSE,1001)
      CALL EXTCDE ( 4 )
!
  802 CONTINUE
      WRITE (NDSE,1002) IERR
      CALL EXTCDE ( 5 )
!
  810 CONTINUE
      IF ( .NOT. FLAGLL ) THEN
          WRITE (NDSE,1010)
          CALL EXTCDE ( 10 )
        END IF
!
  888 CONTINUE
      WRITE (NDSO,999)
!
!/NCO/!     CALL W3TAGE('WAVEGRIB')
!
! Formats
!
  900 FORMAT (/15X,'   *** WAVEWATCH III GRIB output postp. ***   '/ &
               15X,'=============================================='/)
  901 FORMAT ( '  Comment character is ''',A,''''/)
  902 FORMAT (/'  *** WARNING : NO GRIB PACKAGE LINKED ***'/)
!
  920 FORMAT ( '  Grid name : ',A/)
!
  930 FORMAT ( '  Fields in file : '/                                 &
               ' --------------------------')
  931 FORMAT ( '      ',A)
!
  940 FORMAT (/'  Output time data : '/                               &
               ' -----------------------------------------------------'/ &
               '      First time         : ',A)
  941 FORMAT ( '      Interval           : ',A/                       &
               '      Number of requests : ',I4)
  942 FORMAT (/'      End of file reached '/)
!
  944 FORMAT (/'  Requested output fields not yet available: '/        &
               ' -----------------------------------------------------')
!
  945 FORMAT (/'  Successfully requested output fields : '/            &
               ' -----------------------------------------------------')
  946 FORMAT ( '      ',A,1X,A)
!
  948 FORMAT (/'  Additional GRIB parameters : '/                     &
               ' -----------------------------------------------------'/ &
               '      Run time           : ',A/                       &
               '      GRIB center ID     : ',I4/                      &
               '      GRIB gen. proc. ID : ',I4/                      &
               '      GRIB grid ID       : ',I4/                      &
               '      GRIB GDS parameter : ',I4)
!
  970 FORMAT (//'  Generating file '/                                 &
               ' -----------------------------------------------------')
  971 FORMAT ( '      Data for ',A,'  ',I3,'H forecast.')
  972 FORMAT ( '      Data for ',A,'       hindcast.')
!
  999 FORMAT (/'  End of program '/                                   &
               ' ========================================='/          &
               '         WAVEWATCH III GRIB output '/)
!
!/T 9050 FORMAT ( ' TEST W3GRIB : KPDS : ',13I4/                      &
!/T               '                      ',12I4)
!/T 9051 FORMAT ( ' TEST W3GRIB : KGDS : ',8I6/                       &
!/T               '                      ',8I6/                       &
!/T               '                      ',6I6)
!
 1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRIB : '/               &
               '     ERROR IN OPENING INPUT FILE'/                    &
               '     IOSTAT =',I5/)
!
 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRIB : '/               &
               '     PREMATURE END OF INPUT FILE'/)
!
 1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3GRIB : '/               &
               '     ERROR IN READING FROM INPUT FILE'/               &
               '     IOSTAT =',I5/)
!
 1010 FORMAT (/' *** WAVEWATCH-III ERROR IN W3GRIB : '/          &
               '     GRIB REQUIRES SPHERICAL GRID'/)
!/NCEP2 1011 FORMAT (/' CHOSEN GRID TYPE: : ',A/)
!/
!/ Internal subroutine W3EXGB ---------------------------------------- /
!/
      CONTAINS
!/ ------------------------------------------------------------------- /
      SUBROUTINE W3EXGB ( NX, NY, NSEA )
!/
!/                  +-----------------------------------+
!/                  | WAVEWATCH III           NOAA/NCEP |
!/                  |           H. L. Tolman            |
!/                  |             A. Chawla             |
!/                  |                        FORTRAN 90 |
!/                  | Last update :         16-Jul-2007 |
!/                  +-----------------------------------+
!/
!/    10-Jun-1999 : Final FORTRAN 77                    ( version 1.18 )
!/    24-Jan-2000 : Upgrade to FORTRAN 90               ( version 2.00 )
!/                  Massive changes to logistics.
!/    29-Apr-2002 : Adding output fields 17-18.         ( version 2.20 )
!/    24-Dec-2004 : Multiple grid version.              ( version 3.06 )
!/    18-May-2007 : Update GRIB1 for partitioning.      ( version 3.11 )
!/    16-Jul-2007 : Adding GRIB2 capability             ( version 3.11 )
!/                  (A. Chawla)
!/
!  1. Purpose :
!
!     Perform actual GRIB output.
!
!  3. Parameters :
!
!     Parameter list
!     ----------------------------------------------------------------
!       NX, NY, NSEA
!               Int.  I  Array dimensions.
!     ----------------------------------------------------------------
!
!     Internal parameters
!     ----------------------------------------------------------------
!       X1, X2, XX, XY
!               R.A.  Output fields
!       BITMAP  L.A.  Data / no data bitmap
!     ----------------------------------------------------------------
!
!  4. Subroutines used :
!
!      Name      Type  Module   Description
!     ----------------------------------------------------------------
!      STRACE     Subr. W3SERVMD Subroutine tracing.
!      EXTCDE     Subr.   Id.    Abort program as graceful as possible.
!      W3S2XY     Subr.   Id.    Convert from storage to spatial grid. 
!      PUTGB      Subr.          NCEP GRIB1 library routine.
!      GRIBCREATE Subr.          NCEP GRIB2 library routine.
!      ADDGRID    Subr.          NCEP GRIB2 library routine.
!      ADDFIELD   Subr.          NCEP GRIB2 library routine.
!      GRIBEND    Subr.          NCEP GRIB2 library routine.
!      WRYTE      Subr.          NCEP GRIB2 library routine.
!     ----------------------------------------------------------------
!
!  5. Called by :
!
!     Program in which it is contained.
!
!  6. Error messages :
!
!     None.
!
!  7. Remarks :
!
!     - Note that arrays CX and CY of the main program now contain
!       the absolute current speed and direction respectively.
!
!  8. Structure :
!
!     See source code.
!
!  9. Switches :
!
!     !/S      Enable subroutine tracing.
!     !/T      Enable test output.
!     !/NCEP1  NCEP IBM calls to GRIB1 packer.
!     !/NCEP2  NCEP IBM calls to GRIB2 packer (follows updated grib2
!     tables under verification as of 02/10/2012).
!
! 10. Source code :
!
!/ ------------------------------------------------------------------- /
      USE W3SERVMD, ONLY : W3S2XY
!/RTD      USE W3SERVMD, ONLY : W3THRTN, W3XYRTN
!/
!/ ------------------------------------------------------------------- /
!/ Parameter list
!/
      INTEGER, INTENT(IN)     :: NX, NY, NSEA
!/
!/ ------------------------------------------------------------------- /
!/ Local parameters
!/
      INTEGER                 :: J, IXY, NDATA
      INTEGER                 :: IO
!/S      INTEGER, SAVE           :: IENT = 0
      REAL                    ::  X1(NX*NY), X2(NX*NY), XX(NX*NY),    &
                                  XY(NX*NY), CABS, UABS,              &
                                  YY(NX*NY,0:NOSWLL), KPDS5A, KPDS5B, &
                                  KPDS5A1(3)
      LOGICAL*1               ::  BITMAP(NX*NY)
      LOGICAL                 :: FLONE, FLTWO, FLDIR, FLTRI, FLPRT
!/
!/ ------------------------------------------------------------------- /
!/
!/S      CALL STRACE (IENT, 'W3EXGB')
!
!/T      WRITE (NDST,9000) ((FLREQ(IFI,IFJ),IFJ=1,NGRPP), IFI=1,NOGRP)
!/T      WRITE (NDST,9001) NDSDAT, KPDS, KGDS
!
!--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! 1.  Preparations
!
      X1     = UNDEF
      X2     = UNDEF
      XX     = UNDEF
      XY     = UNDEF
      YY     = UNDEF
!
!
!--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! 2.  Loop over output fields.
!
      DO IFI=1, NOGRP
       DO IFJ=1, NGRPP
        IF ( FLREQ(IFI,IFJ) ) THEN


!
! Initialize array dimension flags
!
        FLONE = .FALSE.
        FLTWO = .FALSE.
        FLDIR = .FALSE.
        FLTRI = .FALSE.
        FLPRT = .FALSE.
!
!/T            WRITE (NDST,9020) IDOUT(IFI,IFJ)
!
! 2.a Set output arrays and parameters
!
!     Water depth
!
            IF ( IFI .EQ. 1 .AND. IFJ .EQ.  1 ) THEN
                FLONE = .TRUE.
!/NCEP1                KPDS(5) = -1
!/NCEP2                KPDS(2) = 14 
!/NCEP2                KPDS(1) = 4  
                CALL W3S2XY ( NSEA, NSEA, NX, NY, DW(1:NSEA)          &
                                                        , MAPSF, X1 )
!
!     Current
!
              ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ.  2 ) THEN
                FLTWO = .TRUE.
!/NCEP1                KPDS(5) = -1
!/NCEP2                KPDS(2) = 1 
!/NCEP2                KPDS(1) = 1 
!/RTD                ! Rotate x,y vector back to standard pole
!/RTD                IF ( FLAGUNR ) CALL W3XYRTN(NSEA, CX, CY, AnglD)
                CALL W3S2XY ( NSEA, NSEA, NX, NY, CX(1:NSEA)          &
                                                        , MAPSF, XX )
                CALL W3S2XY ( NSEA, NSEA, NX, NY, CY(1:NSEA)          &
                                                        , MAPSF, XY )
                DO ISEA=1, NSEA
                  IF (CX(ISEA) .NE. UNDEF) THEN
                     CABS   = SQRT(CX(ISEA)**2+CY(ISEA)**2)
                     IF ( CABS .GT. 0.001 ) THEN
                         CY(ISEA) = MOD ( 630. -                         &
                               RADE*ATAN2(CY(ISEA),CX(ISEA)) , 360. )
                       ELSE
                         CY(ISEA) = 0.
                       END IF
                    ELSE
                       CABS = UNDEF
                       CY(ISEA) = UNDEF
                     END IF
                  CX(ISEA) = CABS
                  END DO
                CALL W3S2XY ( NSEA, NSEA, NX, NY, CX(1:NSEA)          &
                                                        , MAPSF, X1 )
                CALL W3S2XY ( NSEA, NSEA, NX, NY, CY(1:NSEA)          &
                                                        , MAPSF, X2 )
!
!     Wind speed
!
              ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ.  3 ) THEN
                FLTWO = .TRUE.
!/NCEP1                KPDS(5) = 032
!/NCEP2                KPDS(2) = 1
!/NCEP2                KPDS(1) = 2
!/NCEP2                LISTSEC0(1) = 0
!/RTD                ! Rotate x,y vector back to standard pole
!/RTD                IF ( FLAGUNR ) CALL W3XYRTN(NSEA, UA, UD, AnglD)
                CALL W3S2XY ( NSEA, NSEA, NX, NY, UA(1:NSEA)          &
                                                        , MAPSF, XX )
                CALL W3S2XY ( NSEA, NSEA, NX, NY, UD(1:NSEA)          &
                                                        , MAPSF, XY )
                DO ISEA=1, NSEA
                  IF (UA(ISEA) .NE. UNDEF) THEN
                     UABS   = SQRT(UA(ISEA)**2+UD(ISEA)**2)
                     IF ( UABS .GT. 0.001 ) THEN
                         UD(ISEA) = MOD ( 630. -                         &
                               RADE*ATAN2(UD(ISEA),UA(ISEA)) , 360. )
                       ELSE
                         UD(ISEA) = 0.
                       END IF
                    ELSE
                       UABS = UNDEF
                       UD(ISEA) = UNDEF
                     END IF
                  UA(ISEA) = UABS
                  END DO
                CALL W3S2XY ( NSEA, NSEA, NX, NY, UA(1:NSEA)          &
                                                        , MAPSF, X1 )
                CALL W3S2XY ( NSEA, NSEA, NX, NY, UD(1:NSEA)          &
                                                        , MAPSF, X2 )
!
!     Air-sea temp. dif.
!
              ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ.  4 ) THEN
                FLONE = .TRUE.
!/NCEP1                KPDS(5) = -1
!/NCEP2                KPDS(2) = 255 
!/NCEP2                KPDS(1) = 3   
                CALL W3S2XY ( NSEA, NSEA, NX, NY, AS(1:NSEA)          &
                                                        , MAPSF, X1 )
!
!     Water level
!
              ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 5 ) THEN
                FLONE = .TRUE.
!/NCEP1                KPDS(5) = -1 
!/NCEP2                KPDS(2) = 1 
!/NCEP2                KPDS(1) = 3 
                CALL W3S2XY ( NSEA, NSEA, NX, NY, WLV   , MAPSF, X1 )
!
!     Ice concentration
!
              ELSE IF ( IFI .EQ. 1 .AND. IFJ .EQ. 6 ) THEN
                FLONE = .TRUE.
!/NCEP1                KPDS(5) = 091
!/NCEP2                KPDS(2) = 0
!/NCEP2                KPDS(1) = 2
                CALL W3S2XY ( NSEA, NSEA, NX, NY, ICE   , MAPSF, X1 )
!
!     Significant wave height
!
              ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ.  1 ) THEN
                FLONE = .TRUE.
!/NCEP1                KPDS(5) = 100
!/NCEP2                KPDS(2) = 3
                CALL W3S2XY ( NSEA, NSEA, NX, NY, HS    , MAPSF, X1 )
!
!     Mean wave length
!
              ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ.  2 ) THEN
                FLONE = .TRUE.
!/NCEP1                KPDS(5) = -1
!/NCEP2                KPDS(2) = 193
                CALL W3S2XY ( NSEA, NSEA, NX, NY, WLM   , MAPSF, X1 )
!
!     Mean wave period (based on second moment)
!
              ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ.  3 ) THEN
                FLONE = .TRUE.
!/NCEP1                KPDS(5) = -1 
!/NCEP2         if ((gen_pro.eq.1) .or. (gen_pro.eq.0)) then
!/NCEP2                KPDS(2) = 28
!/NCEP2         else
!/NCEP2                KPDS(2) = 25
!/NCEP2         endif

                CALL W3S2XY ( NSEA, NSEA, NX, NY, T02   , MAPSF, X1 )
!
!     Mean wave period (based on first moment)
!
              ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ.  4 ) THEN
                FLONE = .TRUE.
!/NCEP1                KPDS(5) = 103
!/NCEP2                KPDS(2) = 15
                CALL W3S2XY ( NSEA, NSEA, NX, NY, T0M1   , MAPSF, X1 )
!
!     Mean wave period (based on first inverse moment)
!
              ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ.  5 ) THEN
                FLONE = .TRUE.
!/NCEP1                KPDS(5) = -1 
!/NCEP2         if ((gen_pro.eq.1) .or. (gen_pro.eq.0)) then
!/NCEP2                KPDS(2) = 34
!/NCEP2         else
!/NCEP2                KPDS(2) = 15
!/NCEP2         endif 
                CALL W3S2XY ( NSEA, NSEA, NX, NY, T01   , MAPSF, X1 )
!
!     Peak frequency
!
              ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 6 ) THEN
                FLONE = .TRUE.
!/NCEP1                KPDS(5) = 108
!/NCEP2                KPDS(2) = 11
                DO ISEA=1, NSEA
                  IF ( FP0(ISEA) .NE. UNDEF .AND. FP0(ISEA) .NE. 0 ) THEN
                      FP0(ISEA) = 1. / MAX(FR1,FP0(ISEA)) ! Limit FP to lowest discrete frequency
                    END IF
                  END DO
                CALL W3S2XY ( NSEA, NSEA, NX, NY, FP0   , MAPSF, X1 )
!
!
!     Mean wave direction
!
              ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ.  7 ) THEN
                FLONE = .TRUE.
!/NCEP1                KPDS(5) = 101
!/NCEP2                KPDS(2) = 14
!/RTD                ! Rotate direction back to standard pole
!/RTD                IF ( FLAGUNR ) CALL W3THRTN(NSEA, THM, AnglD, .FALSE.)
                DO ISEA=1, NSEA
                  IF ( THM(ISEA) .NE. UNDEF )                         &
                       THM(ISEA) = MOD ( 630. - RADE*THM(ISEA) , 360. )
                  END DO
                CALL W3S2XY ( NSEA, NSEA, NX, NY, THM   , MAPSF, X1 )
!
!     Directional spread
!
              ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 8 ) THEN
                FLONE = .TRUE.
!/NCEP1                KPDS(5) = -1
!/NCEP2                KPDS(2) = 31
                CALL W3S2XY ( NSEA, NSEA, NX, NY, THS   , MAPSF, X1 )
!
!     Peak direction
!
              ELSE IF ( IFI .EQ. 2 .AND. IFJ .EQ. 9 ) THEN
                FLONE = .TRUE.
!/NCEP1                KPDS(5) = 107
!/NCEP2         if ((gen_pro.eq.1) .or. (gen_pro.eq.0)) then
!/NCEP2                KPDS(2) = 46
!/NCEP2         else
!/NCEP2                KPDS(2) = 10
!/NCEP2                endif    
!/RTD                ! Rotate direction back to standard pole
!/RTD                IF ( FLAGUNR ) CALL W3THRTN(NSEA, THP0, AnglD, .FALSE.)
                DO ISEA=1, NSEA
                  IF ( THP0(ISEA) .NE. UNDEF ) THEN
                      THP0(ISEA) = MOD ( 630-RADE*THP0(ISEA) , 360. )
                    END IF
                  END DO
                CALL W3S2XY ( NSEA, NSEA, NX, NY, THP0  , MAPSF, X1 )
!
!     Partitioned wave height
!
              ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 1 ) THEN
                FLPRT = .TRUE.
!/NCEP1                KPDS5A  = 102
!/NCEP1                KPDS5B  = 105
!/NCEP2                KPDS5A  = 5
!/NCEP2                KPDS5B  = 8
!/NCEP2         if ((gen_pro.eq.1) .or. (gen_pro.eq.0)) then
!/NCEP2                KPDS5A1(1)  =47
!/NCEP2                KPDS5A1(2)  =48
!/NCEP2                KPDS5A1(3)  =49
!/NCEP2         else
!/NCEP2                KPDS5B  = 8
!/NCEP2         endif
                CALL W3S2XY                                           &
                        ( NSEA, NSEA, NX, NY, PHS(:,0), MAPSF, YY(:,0) )
                DO I=1, NOSWLL
                  CALL W3S2XY                                         &
                        ( NSEA, NSEA, NX, NY, PHS(:,I), MAPSF, YY(:,I) )
                  END DO
!
!     Partitioned peak period
!
              ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 2 ) THEN
                FLPRT = .TRUE.
!/NCEP1                KPDS5A  = 110
!/NCEP1                KPDS5B  = 106
!/NCEP2                KPDS5A  = 6
!/NCEP2                KPDS5B = 9
!/NCEP2         if ((gen_pro.eq.1) .or. (gen_pro.eq.0)) then
!/NCEP2                KPDS5A1(1)  = 50
!/NCEP2                KPDS5A1(2)  = 51
!/NCEP2                KPDS5A1(3)  = 52
!/NCEP2         else
!/NCEP2                KPDS5B = 9
!/NCEP2         endif
                CALL W3S2XY                                           &
                        ( NSEA, NSEA, NX, NY, PTP(:,0), MAPSF, YY(:,0) )
                DO I=1, NOSWLL
                  CALL W3S2XY                                         &
                        ( NSEA, NSEA, NX, NY, PTP(:,I), MAPSF, YY(:,I) )
                  END DO
!
!     Partitioned peak wave length
!
              ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 3 ) THEN
                FLPRT = .TRUE.
!/NCEP1                KPDS5A  =  -1
!/NCEP1                KPDS5B  =  -1
!/NCEP2                KPDS5A  =  193
!/NCEP2                KPDS5B  =  193
                CALL W3S2XY                                           &
                        ( NSEA, NSEA, NX, NY, PLP(:,0), MAPSF, YY(:,0) )
                DO I=1, NOSWLL
                  CALL W3S2XY                                         &
                        ( NSEA, NSEA, NX, NY, PLP(:,I), MAPSF, YY(:,I) )
                  END DO
!
!     Partitioned mean direction
!
              ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 4 ) THEN
                FLPRT = .TRUE.
!/NCEP1                KPDS5A  = 109
!/NCEP1                KPDS5B  = 104
!/NCEP2                KPDS5A  = 4
!/NCEP2                KPDS5B = 7
!/NCEP2         if ((gen_pro.eq.1) .or. (gen_pro.eq.0)) then
!/NCEP2                KPDS5A1(1)  = 53
!/NCEP2                KPDS5A1(2)  = 54
!/NCEP2                KPDS5A1(3)  = 55
!/NCEP2         else
!/NCEP2                KPDS5B = 7
!/NCEP2         endif
!/RTD                DO I = 0,NOSWLL
!/RTD                  ! Rotate direction back to standard pole
!/RTD                  IF ( FLAGUNR ) CALL W3THRTN(NSEA, PDIR(:,I), AnglD, .FALSE.)
!/RTD                END DO
                DO ISEA = 1,NSEA
                  DO I = 0,NOSWLL
                     IF ( PDIR(ISEA,I) .NE. UNDEF ) THEN
                        PDIR(ISEA,I) = MOD ( 630 - RADE*PDIR(ISEA,I) , 360. )
                        END IF
                     END DO
                  END DO
                CALL W3S2XY                                           &
                        ( NSEA, NSEA, NX, NY, PDIR(:,0), MAPSF, YY(:,0) )
                DO I=1, NOSWLL
                  CALL W3S2XY                                         &
                        ( NSEA, NSEA, NX, NY, PDIR(:,I), MAPSF, YY(:,I) )
                  END DO
!
!     Partitioned Directional spread
!
              ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 5 ) THEN
                FLPRT = .TRUE.
!/NCEP1                KPDS5A  =  -1
!/NCEP1                KPDS5B  =  -1
!/NCEP2                KPDS5A  =  32 
!/NCEP2                KPDS5B  =  33 
                CALL W3S2XY                                           &
                        ( NSEA, NSEA, NX, NY, PSI(:,0), MAPSF, YY(:,0) )
                DO I=1, NOSWLL
                  CALL W3S2XY                                         &
                        ( NSEA, NSEA, NX, NY, PSI(:,I), MAPSF, YY(:,I) )
                  END DO
!
!     Partitioned wind sea fraction
!
              ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 6 ) THEN
                FLPRT = .TRUE.
!/NCEP1                KPDS5A  =  -1
!/NCEP1                KPDS5B  =  -1
!/NCEP2                KPDS5A  =  255
!/NCEP2                KPDS5B  =  255
                CALL W3S2XY                                           &
                        ( NSEA, NSEA, NX, NY, PWS(:,0), MAPSF, YY(:,0) )
                DO I=1, NOSWLL
                  CALL W3S2XY                                         &
                        ( NSEA, NSEA, NX, NY, PWS(:,I), MAPSF, YY(:,I) )
                  END DO
!
!     Total wind sea fraction
!
              ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 16 ) THEN
                FLONE = .TRUE.
!/NCEP1                KPDS(5) = -1
!/NCEP2                KPDS(2) = 255
                CALL W3S2XY ( NSEA, NSEA, NX, NY, PWST  , MAPSF, X1 )
!
!     Number of fields in partition
!
              ELSE IF ( IFI .EQ. 4 .AND. IFJ .EQ. 17 ) THEN
                FLONE = .TRUE.
!/NCEP1                KPDS(5) = -1
!/NCEP2                KPDS(2) = 255
                CALL W3S2XY ( NSEA, NSEA, NX, NY, PNR   , MAPSF, X1 )
!
!     Friction velocity
!
              ELSE IF ( IFI .EQ. 5 .AND. IFJ .EQ.  1 ) THEN
                FLTWO = .TRUE.
!/NCEP1                KPDS(5) = -1
!/NCEP2                KPDS(2) = 17 
!/NCEP2                KPDS(1) = 1
!/RTD                ! Rotate x,y vector back to standard pole
!/RTD                IF ( FLAGUNR ) CALL W3XYRTN(NSEA, UST, USTDIR, AnglD)
                CALL W3S2XY ( NSEA, NSEA, NX, NY, UST(1:NSEA)         &
                                                        , MAPSF, X1 )
                CALL W3S2XY ( NSEA, NSEA, NX, NY, USTDIR(1:NSEA)      &
                                                        , MAPSF, X2 )
!
!     Average source term time step
!
              ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 1 ) THEN
                FLONE = .TRUE.
!/NCEP1                KPDS(5) = -1
!/NCEP2                KPDS(2) = 255
                DO ISEA=1, NSEA
                  IF ( DTDYN(ISEA) .NE. UNDEF )                       &
                       DTDYN(ISEA) = DTDYN(ISEA) / 60.
                  END DO
                CALL W3S2XY ( NSEA, NSEA, NX, NY, DTDYN , MAPSF, X1 )
!
!     Cut-off frequency
!
              ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 2 ) THEN
                FLONE = .TRUE.
!/NCEP1                KPDS(5) = -1
!/NCEP2                KPDS(2) = 255
                CALL W3S2XY ( NSEA, NSEA, NX, NY, FCUT  , MAPSF, X1 )
!
!     CFL Maximum (in spatial space)
!
              ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 3 ) THEN
                FLONE = .TRUE.
!/NCEP1                KPDS(5) = -1
!/NCEP2                KPDS(2) = 255
                CALL W3S2XY ( NSEA, NSEA, NX, NY, CFLXYMAX  , MAPSF, X1 )
!
!     CFL Maximum (in spectral space)
!
              ELSE IF ( IFI .EQ. 9 .AND. IFJ .EQ. 4 ) THEN
                FLONE = .TRUE.
!/NCEP1                KPDS(5) = -1
!/NCEP2                KPDS(2) = 255
                CALL W3S2XY ( NSEA, NSEA, NX, NY, CFLTHMAX  , MAPSF, X1 )
!
              ELSE
                WRITE (NDSE,999)
                CALL EXTCDE ( 1 )
!
              END IF
!
! 3   Perform output
!
            NDATA  = NX*NY
!
! 3.a Partitioned data
!
            IF ( FLPRT ) THEN
!
!/NCEP1                KPDS(5) = KPDS5A
!/NCEP2                KPDS(2) = KPDS5A
                DO IXY=1, NX*NY
                  BITMAP(IXY) = YY(IXY,0) .NE. UNDEF
                  END DO
!/NCEP1                CALL PUTGB (NDSDAT,NDATA,KPDS,KGDS,BITMAP,YY(:,0),IO)
!/NCEP2                CALL GRIBCREATE (CGRIB,LCGRIB,LISTSEC0,LISTSEC1,IO)
!/NCEP2                IF (IO .NE. 0) GOTO 810
!/NCEP2                CALL ADDGRID (CGRIB,LCGRIB,IGDS,KGDS,200,IDEFLIST,   &
!/NCEP2                             IDEFNUM, IO)
!/NCEP2                IF (IO .NE. 0) GOTO 820
!/NCEP2                CALL ADDFIELD (CGRIB,LCGRIB,KPDSNUM,KPDS,200,        &
!/NCEP2                               COORDLIST, NUMCOORD, IDRSNUM, IDRS,   &
!/NCEP2                               200,YY(:,0), NDATA, IBMP, BITMAP, IO)
!/NCEP2                IF (IO .NE. 0) GOTO 820
!/NCEP2                CALL GRIBEND (CGRIB, LCGRIB, LENGRIB, IO)
!/NCEP2                IF (IO .NE. 0) GOTO 830
!/NCEP2                CALL WRYTE (NDSDAT, LENGRIB, CGRIB)
!
!/NCEP2               if ((gen_pro.eq.0) .or. (gen_pro.eq.1)) then
!/NCEP1                KPDS(5) = KPDS5B
!/NCEP1                KPDS(6) = 241
!/NCEP2                KPDS(10) = 241
                DO I=1, NOSWLL
!/NCEP1                  KPDS(7) = I
!/NCEP2                KPDS(2) = KPDS5A1(I)
!/NCEP2                  KPDS(12) = I
                  DO IXY=1, NX*NY
                    BITMAP(IXY) = YY(IXY,I) .NE. UNDEF
                    END DO
!/NCEP1                  CALL PUTGB (NDSDAT,NDATA,KPDS,KGDS,BITMAP,YY(:,I),IO)
!/NCEP2                  CALL GRIBCREATE (CGRIB,LCGRIB,LISTSEC0,LISTSEC1,IO)
!/NCEP2                  IF (IO .NE. 0) GOTO 810
!/NCEP2                  CALL ADDGRID (CGRIB,LCGRIB,IGDS,KGDS,200,IDEFLIST,   &
!/NCEP2                               IDEFNUM, IO)
!/NCEP2                  IF (IO .NE. 0) GOTO 820
!/NCEP2                  CALL ADDFIELD (CGRIB,LCGRIB,KPDSNUM,KPDS,200,        &
!/NCEP2                                 COORDLIST, NUMCOORD, IDRSNUM, IDRS,   &
!/NCEP2                                 200,YY(:,I), NDATA, IBMP, BITMAP, IO)
!/NCEP2                  IF (IO .NE. 0) GOTO 820
!/NCEP2                  CALL GRIBEND (CGRIB, LCGRIB, LENGRIB, IO)
!/NCEP2                  IF (IO .NE. 0) GOTO 830
!/NCEP2                  CALL WRYTE (NDSDAT, LENGRIB, CGRIB)
                  END DO
!/NCEP2           ELSE
!/NCEP1                KPDS(5) = KPDS5B
!/NCEP1                KPDS(6) = 241
!/NCEP2                KPDS(2) = KPDS5B
!/NCEP2                KPDS(10) = 241
                DO I=1, NOSWLL
!/NCEP1                  KPDS(7) = I
!/NCEP2                  KPDS(12) = I
                  DO IXY=1, NX*NY
                    BITMAP(IXY) = YY(IXY,I) .NE. UNDEF
                    END DO
!/NCEP1                  CALL PUTGB (NDSDAT,NDATA,KPDS,KGDS,BITMAP,YY(:,I),IO)
!/NCEP2                  CALL GRIBCREATE (CGRIB,LCGRIB,LISTSEC0,LISTSEC1,IO)
!/NCEP2                  IF (IO .NE. 0) GOTO 810
!/NCEP2                  CALL ADDGRID (CGRIB,LCGRIB,IGDS,KGDS,200,IDEFLIST,   &
!/NCEP2                               IDEFNUM, IO)
!/NCEP2                  IF (IO .NE. 0) GOTO 820
!/NCEP2                  CALL ADDFIELD (CGRIB,LCGRIB,KPDSNUM,KPDS,200,        &
!/NCEP2                                 COORDLIST, NUMCOORD, IDRSNUM, IDRS,   &
!/NCEP2                                 200,YY(:,I), NDATA, IBMP, BITMAP, IO)
!/NCEP2                  IF (IO .NE. 0) GOTO 820
!/NCEP2                  CALL GRIBEND (CGRIB, LCGRIB, LENGRIB, IO)
!/NCEP2                  IF (IO .NE. 0) GOTO 830
!/NCEP2                  CALL WRYTE (NDSDAT, LENGRIB, CGRIB)
                  END DO
!/NCEP2           ENDIF
!/NCEP1                KPDS(6) = 1
!/NCEP1                KPDS(7) = 1
!/NCEP2                KPDS(10) = 1
!/NCEP2                KPDS(12) = 1
!
! 3.b Other data
!
              ELSE IF (FLONE) THEN
!
                DO IXY=1, NX*NY
                  BITMAP(IXY) = X1(IXY) .NE. UNDEF
                  END DO
!
!/NCEP1            CALL PUTGB (NDSDAT,NDATA,KPDS,KGDS,BITMAP,X1,IO)
!/NCEP2            CALL GRIBCREATE (CGRIB,LCGRIB,LISTSEC0,LISTSEC1,IO)
!/NCEP2            IF (IO .NE. 0) GOTO 810
!/NCEP2            CALL ADDGRID (CGRIB,LCGRIB,IGDS,KGDS,200,IDEFLIST,   &
!/NCEP2                         IDEFNUM, IO)
!/NCEP2            IF (IO .NE. 0) GOTO 820
!/NCEP2            CALL ADDFIELD (CGRIB,LCGRIB,KPDSNUM,KPDS,200,        &
!/NCEP2                           COORDLIST, NUMCOORD, IDRSNUM, IDRS,   &
!/NCEP2                           200,X1, NDATA, IBMP, BITMAP, IO)
!/NCEP2            IF (IO .NE. 0) GOTO 820
!/NCEP2            CALL GRIBEND (CGRIB, LCGRIB, LENGRIB, IO)
!/NCEP2            IF (IO .NE. 0) GOTO 830
!/NCEP2            CALL WRYTE (NDSDAT, LENGRIB, CGRIB)
!
              ELSE IF ( FLTWO ) THEN
!
                DO IXY=1, NX*NY
                  BITMAP(IXY) = X1(IXY) .NE. UNDEF
                  END DO
!/NCEP1            CALL PUTGB (NDSDAT,NDATA,KPDS,KGDS,BITMAP,X1,IO)
!/NCEP2            CALL GRIBCREATE (CGRIB,LCGRIB,LISTSEC0,LISTSEC1,IO)
!/NCEP2            IF (IO .NE. 0) GOTO 810
!/NCEP2            CALL ADDGRID (CGRIB,LCGRIB,IGDS,KGDS,200,IDEFLIST, &
!/NCEP2                         IDEFNUM, IO)
!/NCEP2            IF (IO .NE. 0) GOTO 820
!/NCEP2            CALL ADDFIELD (CGRIB,LCGRIB,KPDSNUM,KPDS,200, &
!/NCEP2                           COORDLIST, NUMCOORD, IDRSNUM, IDRS, &
!/NCEP2                           200,X1, NDATA, IBMP, BITMAP, IO)
!/NCEP2            IF (IO .NE. 0) GOTO 820
!/NCEP2            CALL GRIBEND (CGRIB, LCGRIB, LENGRIB, IO)
!/NCEP2            IF (IO .NE. 0) GOTO 830
!/NCEP2            CALL WRYTE (NDSDAT, LENGRIB, CGRIB)

!/NCEP1                    KPDS(5) = 031
!/NCEP1                    CALL PUTGB (NDSDAT,NDATA,KPDS,KGDS,BITMAP,X2,IO)
!/NCEP2                    KPDS(2) = 0
!/NCEP2                    CALL GRIBCREATE (CGRIB,LCGRIB,LISTSEC0,LISTSEC1,IO)
!/NCEP2                    IF (IO .NE. 0) GOTO 810
!/NCEP2                    CALL ADDGRID (CGRIB,LCGRIB,IGDS,KGDS,200,IDEFLIST, &
!/NCEP2                                 IDEFNUM, IO)
!/NCEP2                    IF (IO .NE. 0) GOTO 820
!/NCEP2                    CALL ADDFIELD (CGRIB,LCGRIB,KPDSNUM,KPDS,200,      &
!/NCEP2                                   COORDLIST, NUMCOORD, IDRSNUM, IDRS, &
!/NCEP2                                   200,X2, NDATA, IBMP, BITMAP, IO)
!/NCEP2                    IF (IO .NE. 0) GOTO 820
!/NCEP2                    CALL GRIBEND (CGRIB, LCGRIB, LENGRIB, IO)
!/NCEP2                    IF (IO .NE. 0) GOTO 830
!/NCEP2                    CALL WRYTE (NDSDAT, LENGRIB, CGRIB)
!/NCEP1                    KPDS(5) = 033
!/NCEP1                    CALL PUTGB (NDSDAT,NDATA,KPDS,KGDS,BITMAP,XX,IO)
!/NCEP2                    KPDS(2) = 2
!/NCEP2                    CALL GRIBCREATE (CGRIB,LCGRIB,LISTSEC0,LISTSEC1,IO)
!/NCEP2                    IF (IO .NE. 0) GOTO 810
!/NCEP2                    CALL ADDGRID (CGRIB,LCGRIB,IGDS,KGDS,200,IDEFLIST, &
!/NCEP2                                 IDEFNUM, IO)
!/NCEP2                    IF (IO .NE. 0) GOTO 820
!/NCEP2                    CALL ADDFIELD (CGRIB,LCGRIB,KPDSNUM,KPDS,200,      &
!/NCEP2                                   COORDLIST, NUMCOORD, IDRSNUM, IDRS, &
!/NCEP2                                   200,XX, NDATA, IBMP, BITMAP, IO)
!/NCEP2                    IF (IO .NE. 0) GOTO 820
!/NCEP2                    CALL GRIBEND (CGRIB, LCGRIB, LENGRIB, IO)
!/NCEP2                    IF (IO .NE. 0) GOTO 830
!/NCEP2                    CALL WRYTE (NDSDAT, LENGRIB, CGRIB)
!/NCEP1                    KPDS(5) = 034
!/NCEP1                    CALL PUTGB (NDSDAT,NDATA,KPDS,KGDS,BITMAP,XY,IO)
!/NCEP2                    KPDS(2) = 3
!/NCEP2                    CALL GRIBCREATE (CGRIB,LCGRIB,LISTSEC0,LISTSEC1,IO)
!/NCEP2                    IF (IO .NE. 0) GOTO 810
!/NCEP2                    CALL ADDGRID (CGRIB,LCGRIB,IGDS,KGDS,200,IDEFLIST, &
!/NCEP2                                 IDEFNUM, IO)
!/NCEP2                    IF (IO .NE. 0) GOTO 820
!/NCEP2                    CALL ADDFIELD (CGRIB,LCGRIB,KPDSNUM,KPDS,200,      &
!/NCEP2                                   COORDLIST, NUMCOORD, IDRSNUM, IDRS, &
!/NCEP2                                   200,XY, NDATA, IBMP, BITMAP, IO)
!/NCEP2                    IF (IO .NE. 0) GOTO 820
!/NCEP2                    CALL GRIBEND (CGRIB, LCGRIB, LENGRIB, IO)
!/NCEP2                    IF (IO .NE. 0) GOTO 830
!/NCEP2                    CALL WRYTE (NDSDAT, LENGRIB, CGRIB)
!
              END IF
!/NCEP2              LISTSEC0(1) = 10
!/NCEP2              KPDS(1)     = 0
!
! ... End of fields loop
!
          END IF
        END DO
       END DO
!
      RETURN
!
! Error escape locations
!
!/NCEP2  810 CONTINUE
!/NCEP2      WRITE (NDSE,1010) IO
!/NCEP2      CALL EXTCDE ( 20 )
!/NCEP2  820 CONTINUE
!/NCEP2      WRITE (NDSE,1020) IO
!/NCEP2      CALL EXTCDE ( 30 )
!/NCEP2  830 CONTINUE
!/NCEP2      WRITE (NDSE,1030) IO
!/NCEP2      CALL EXTCDE ( 40 )
!
! Formats
!
  999 FORMAT (/' *** WAVEWATCH III ERROR IN W3EXGB :'/                &
               '     PLEASE UPDATE FIELDS !!! '/)
!
!/NCEP2 1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3EXGB : '/               &
!/NCEP2               '     ERROR IN OPENING OUTPUT FILE'/                   &
!/NCEP2               '     IOSTAT =',I5/)
!
!/NCEP2 1010 FORMAT (/' *** WAVEWATCH III ERROR IN W3EXGB : '/               &
!/NCEP2               '     ERROR CREATING NEW GRIB2 FIELD'/                 &
!/NCEP2               '     IOSTAT =',I5/)
!
!/NCEP2 1020 FORMAT (/' *** WAVEWATCH III ERROR IN W3EXGB : '/               &
!/NCEP2               '     ERROR ADDING GRIB2 FIELD'/                       &
!/NCEP2               '     IOSTAT =',I5/)
!
!/NCEP2 1030 FORMAT (/' *** WAVEWATCH III ERROR IN W3EXGB : '/               &
!/NCEP2               '     ERROR ENDING GRIB2 MESSAGE'/                     &
!/NCEP2               '     IOSTAT =',I5/)
!
!/T 9000 FORMAT (' TEST W3EXGB : FLAGS  :',40L2)
!/T 9001 FORMAT (' TEST W3EXGB : NDSDAT :',I4/                        &
!/T              '               KPDS   :',13I4/                      &
!/T              '                       ',12I4/                      &
!/T              '               KGDS   :',8I6/                       &
!/T              '                       ',8I6/                       &
!/T              '                       ',6I6)
!
!/T 9012 FORMAT (' TEST W3EXGB : BLOK PARS    : ',3I4)
!/T 9014 FORMAT ('           BASE NAME : ',A)
!
!/T 9020 FORMAT (' TEST W3EXGB : OUTPUT FIELD : ',A)
!/
!/ End of W3EXGB ----------------------------------------------------- /
!/
      END SUBROUTINE W3EXGB
!/
!/ End of W3GRIB ----------------------------------------------------- /
!/
      END PROGRAM W3GRIB
