ww3_grib.F90 File Reference

Contains program W3GRIB for post-processing grid output. More...

Go to the source code of this file.

Functions/Subroutines
program	w3grib
	Post-processing of grid output. More...
subroutine	w3exgb (NX, NY, NSEA)
	Perform actual GRIB output. More...

Detailed Description

Contains program W3GRIB for post-processing grid output.

Author

H. L. Tolman

A. Chawla

J.-H. Alves

Date

22-Mar-2021

Definition in file ww3_grib.F90.

Function/Subroutine Documentation

w3exgb()

subroutine w3grib::w3exgb	(	integer, intent(in)	NX,
		integer, intent(in)	NY,
		integer, intent(in)	NSEA
	)

Perform actual GRIB output.

Parameters

[in]	NX	X array dimension
[in]	NY	Y array dimension
[in]	NSEA	Seapoint array dimension

Author

H. L. Tolman

A. Chawla

Date

22-Mar-2021

Definition at line 915 of file ww3_grib.F90.

    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |             A. Chawla             |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         22-Mar-2021 |
    !/                  +-----------------------------------+
    !/
    !/    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)
    !/    22-Mar-2021 : New coupling fields output          ( version 7.13 )
    !/
    !  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.
    !     !/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
#ifdef W3_RTD
    USE w3servmd, ONLY : w3thrtn, w3xyrtn
#endif
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER, INTENT(IN)     :: NX, NY, NSEA
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    INTEGER                 :: J, IXY, NDATA
    INTEGER                 :: IO
#ifdef W3_S
    INTEGER, SAVE           :: IENT = 0
#endif
    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
    !/
    !/ ------------------------------------------------------------------- /
    !/
#ifdef W3_S
    CALL strace (ient, 'W3EXGB')
#endif
    !
#ifdef W3_T
    WRITE (ndst,9000) ((flreq(ifi,ifj),ifj=1,ngrpp), ifi=1,nogrp)
    WRITE (ndst,9001) ndsdat, kpds, kgds
#endif
    !
    !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    ! 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.
          !
#ifdef W3_T
          WRITE (ndst,9020) idout(ifi,ifj)
#endif
          !
          ! 2.a Set output arrays and parameters
          !
          !     Water depth
          !
          IF ( ifi .EQ. 1 .AND. ifj .EQ.  1 ) THEN
            flone = .true.
#ifdef W3_NCEP2
            kpds(2) = 14
            kpds(1) = 4
#endif
            CALL w3s2xy ( nsea, nsea, nx, ny, dw(1:nsea)          &
                 , mapsf, x1 )
            !
            !     Current
            !
          ELSE IF ( ifi .EQ. 1 .AND. ifj .EQ.  2 ) THEN
            fltwo = .true.
#ifdef W3_NCEP2
            kpds(2) = 1
            kpds(1) = 1
#endif
#ifdef W3_RTD
            ! Rotate x,y vector back to standard pole
            IF ( flagunr ) CALL w3xyrtn(nsea, cx, cy, angld)
#endif
            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.
#ifdef W3_NCEP2
            kpds(2) = 1
            kpds(1) = 2
            listsec0(1) = 0
#endif
#ifdef W3_RTD
            ! Rotate x,y vector back to standard pole
            IF ( flagunr ) CALL w3xyrtn(nsea, ua, ud, angld)
#endif
            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.
#ifdef W3_NCEP2
            kpds(2) = 255
            kpds(1) = 3
#endif
            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.
#ifdef W3_NCEP2
            kpds(2) = 1
            kpds(1) = 3
#endif
            CALL w3s2xy ( nsea, nsea, nx, ny, wlv   , mapsf, x1 )
            !
            !     Ice concentration
            !
          ELSE IF ( ifi .EQ. 1 .AND. ifj .EQ. 6 ) THEN
            flone = .true.
#ifdef W3_NCEP2
            kpds(2) = 0
            kpds(1) = 2
#endif
            CALL w3s2xy ( nsea, nsea, nx, ny, ice   , mapsf, x1 )
            !
            !     Atmospheric momentum
            !
          ELSE IF ( ifi .EQ. 1 .AND. ifj .EQ.  8 ) THEN
            fltwo = .true.
#ifdef W3_NCEP2
            kpds(2) = 1
            kpds(1) = 2
            listsec0(1) = 0
#endif
#ifdef W3_RTD
            ! Rotate x,y vector back to standard pole
            IF ( flagunr ) CALL w3xyrtn(nsea, taua, tauadir, angld)
#endif
            CALL w3s2xy ( nsea, nsea, nx, ny, taua(1:nsea)        &
                 , mapsf, xx )
            CALL w3s2xy ( nsea, nsea, nx, ny, tauadir(1:nsea)     &
                 , mapsf, xy )
            DO isea=1, nsea
              IF (taua(isea) .NE. undef) THEN
                uabs   = sqrt(taua(isea)**2+tauadir(isea)**2)
                IF ( uabs .GT. 0.001 ) THEN
                  tauadir(isea) = mod( 630. -                 &
                       rade*atan2(tauadir(isea),taua(isea)) , 360. )
                ELSE
                  tauadir(isea) = 0.
                END IF
              ELSE
                uabs = undef
                tauadir(isea) = undef
              END IF
              taua(isea) = uabs
            END DO
            CALL w3s2xy ( nsea, nsea, nx, ny, taua(1:nsea)        &
                 , mapsf, x1 )
            CALL w3s2xy ( nsea, nsea, nx, ny, tauadir(1:nsea)     &
                 , mapsf, x2 )
            !
            !     Air density
            !
          ELSE IF ( ifi .EQ. 1 .AND. ifj .EQ. 9 ) THEN
            flone = .true.
#ifdef W3_NCEP2
            kpds(2) = 0
            kpds(1) = 2
#endif
            CALL w3s2xy ( nsea, nsea, nx, ny, rhoair, mapsf, x1 )
            !
            !     Significant wave height
            !
          ELSE IF ( ifi .EQ. 2 .AND. ifj .EQ.  1 ) THEN
            flone = .true.
#ifdef W3_NCEP2
            kpds(2) = 3
#endif
            CALL w3s2xy ( nsea, nsea, nx, ny, hs    , mapsf, x1 )
            !
            !     Mean wave length
            !
          ELSE IF ( ifi .EQ. 2 .AND. ifj .EQ.  2 ) THEN
            flone = .true.
#ifdef W3_NCEP2
            kpds(2) = 193
#endif
            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.
#ifdef W3_NCEP2
            if ((gen_pro.eq.1) .or. (gen_pro.eq.0)) then
              kpds(2) = 28
            else
              kpds(2) = 25
            endif
#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.
#ifdef W3_NCEP2
            kpds(2) = 15
#endif
            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.
#ifdef W3_NCEP2
            if ((gen_pro.eq.1) .or. (gen_pro.eq.0)) then
              kpds(2) = 34
            else
              kpds(2) = 15
            endif
#endif
            CALL w3s2xy ( nsea, nsea, nx, ny, t01   , mapsf, x1 )
            !
            !     Peak frequency
            !
          ELSE IF ( ifi .EQ. 2 .AND. ifj .EQ. 6 ) THEN
            flone = .true.
#ifdef W3_NCEP2
            kpds(2) = 11
#endif
            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.
#ifdef W3_NCEP2
            kpds(2) = 14
#endif
#ifdef W3_RTD
            ! Rotate direction back to standard pole
            IF ( flagunr ) CALL w3thrtn(nsea, thm, angld, .false.)
#endif
            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.
#ifdef W3_NCEP2
            kpds(2) = 31
#endif
            CALL w3s2xy ( nsea, nsea, nx, ny, ths   , mapsf, x1 )
            !
            !     Peak direction
            !
          ELSE IF ( ifi .EQ. 2 .AND. ifj .EQ. 9 ) THEN
            flone = .true.
#ifdef W3_NCEP2
            if ((gen_pro.eq.1) .or. (gen_pro.eq.0)) then
              kpds(2) = 46
            else
              kpds(2) = 10
            endif
#endif
#ifdef W3_RTD
            ! Rotate direction back to standard pole
            IF ( flagunr ) CALL w3thrtn(nsea, thp0, angld, .false.)
#endif
            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 )
            !
            !     Mean wave number
            !
          ELSE IF ( ifi .EQ. 2 .AND. ifj .EQ. 19 ) THEN
            flone = .true.
#ifdef W3_NCEP2
            kpds(2) = 255
#endif
            CALL w3s2xy ( nsea, nsea, nx, ny, wnmean, mapsf, x1 )
            !
            !     Partitioned wave height
            !
          ELSE IF ( ifi .EQ. 4 .AND. ifj .EQ. 1 ) THEN
            flprt = .true.
#ifdef W3_NCEP2
            kpds5a  = 5
            kpds5b  = 8
            if ((gen_pro.eq.1) .or. (gen_pro.eq.0)) then
              kpds5a1(1)  =47
              kpds5a1(2)  =48
              kpds5a1(3)  =49
            else
              kpds5b  = 8
            endif
#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.
#ifdef W3_NCEP2
            kpds5a  = 6
            kpds5b = 9
            if ((gen_pro.eq.1) .or. (gen_pro.eq.0)) then
              kpds5a1(1)  = 50
              kpds5a1(2)  = 51
              kpds5a1(3)  = 52
            else
              kpds5b = 9
            endif
#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.
#ifdef W3_NCEP2
            kpds5a  =  193
            kpds5b  =  193
#endif
            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.
#ifdef W3_NCEP2
            kpds5a  = 4
            kpds5b = 7
            if ((gen_pro.eq.1) .or. (gen_pro.eq.0)) then
              kpds5a1(1)  = 53
              kpds5a1(2)  = 54
              kpds5a1(3)  = 55
            else
              kpds5b = 7
            endif
#endif
#ifdef W3_RTD
            DO i = 0,noswll
              ! Rotate direction back to standard pole
              IF ( flagunr ) CALL w3thrtn(nsea, pdir(:,i), angld, .false.)
            END DO
#endif
            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.
#ifdef W3_NCEP2
            kpds5a  =  32
            kpds5b  =  33
#endif
            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.
#ifdef W3_NCEP2
            kpds5a  =  255
            kpds5b  =  255
#endif
            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.
#ifdef W3_NCEP2
            kpds(2) = 255
#endif
            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.
#ifdef W3_NCEP2
            kpds(2) = 255
#endif
            CALL w3s2xy ( nsea, nsea, nx, ny, pnr   , mapsf, x1 )
            !
            !     Friction velocity
            !
          ELSE IF ( ifi .EQ. 5 .AND. ifj .EQ.  1 ) THEN
            fltwo = .true.
#ifdef W3_NCEP2
            kpds(2) = 17
            kpds(1) = 1
#endif
#ifdef W3_RTD
            ! Rotate x,y vector back to standard pole
            IF ( flagunr ) CALL w3xyrtn(nsea, ust, ustdir, angld)
#endif
            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.
#ifdef W3_NCEP2
            kpds(2) = 255
#endif
            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.
#ifdef W3_NCEP2
            kpds(2) = 255
#endif
            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.
#ifdef W3_NCEP2
            kpds(2) = 255
#endif
            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.
#ifdef W3_NCEP2
            kpds(2) = 255
#endif
            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
            !
#ifdef W3_NCEP2
            kpds(2) = kpds5a
#endif
            DO ixy=1, nx*ny
              bitmap(ixy) = yy(ixy,0) .NE. undef
            END DO
#ifdef W3_NCEP2
            CALL gribcreate (cgrib,lcgrib,listsec0,listsec1,io)
            IF (io .NE. 0) GOTO 810
            CALL addgrid (cgrib,lcgrib,igds,kgds,200,ideflist,   &
                 idefnum, io)
            IF (io .NE. 0) GOTO 820
            CALL addfield (cgrib,lcgrib,kpdsnum,kpds,200,        &
                 coordlist, numcoord, idrsnum, idrs,   &
                 200,yy(:,0), ndata, ibmp, bitmap, io)
            IF (io .NE. 0) GOTO 820
            CALL gribend (cgrib, lcgrib, lengrib, io)
            IF (io .NE. 0) GOTO 830
            CALL wryte (ndsdat, lengrib, cgrib)
#endif
            !
#ifdef W3_NCEP2
            if ((gen_pro.eq.0) .or. (gen_pro.eq.1)) then
              kpds(10) = 241
#endif
              DO i=1, noswll
#ifdef W3_NCEP2
                kpds(2) = kpds5a1(i)
                kpds(12) = i
#endif
                DO ixy=1, nx*ny
                  bitmap(ixy) = yy(ixy,i) .NE. undef
                END DO
#ifdef W3_NCEP2
                CALL gribcreate (cgrib,lcgrib,listsec0,listsec1,io)
                IF (io .NE. 0) GOTO 810
                CALL addgrid (cgrib,lcgrib,igds,kgds,200,ideflist,   &
                     idefnum, io)
                IF (io .NE. 0) GOTO 820
                CALL addfield (cgrib,lcgrib,kpdsnum,kpds,200,        &
                     coordlist, numcoord, idrsnum, idrs,   &
                     200,yy(:,i), ndata, ibmp, bitmap, io)
                IF (io .NE. 0) GOTO 820
                CALL gribend (cgrib, lcgrib, lengrib, io)
                IF (io .NE. 0) GOTO 830
                CALL wryte (ndsdat, lengrib, cgrib)
#endif
              END DO
#ifdef W3_NCEP2
            ELSE
              kpds(2) = kpds5b
              kpds(10) = 241
#endif
              DO i=1, noswll
#ifdef W3_NCEP2
                kpds(12) = i
#endif
                DO ixy=1, nx*ny
                  bitmap(ixy) = yy(ixy,i) .NE. undef
                END DO
#ifdef W3_NCEP2
                CALL gribcreate (cgrib,lcgrib,listsec0,listsec1,io)
                IF (io .NE. 0) GOTO 810
                CALL addgrid (cgrib,lcgrib,igds,kgds,200,ideflist,   &
                     idefnum, io)
                IF (io .NE. 0) GOTO 820
                CALL addfield (cgrib,lcgrib,kpdsnum,kpds,200,        &
                     coordlist, numcoord, idrsnum, idrs,   &
                     200,yy(:,i), ndata, ibmp, bitmap, io)
                IF (io .NE. 0) GOTO 820
                CALL gribend (cgrib, lcgrib, lengrib, io)
                IF (io .NE. 0) GOTO 830
                CALL wryte (ndsdat, lengrib, cgrib)
#endif
              END DO
#ifdef W3_NCEP2
            ENDIF
            kpds(10) = 1
            kpds(12) = 1
#endif
            !
            ! 3.b Other data
            !
          ELSE IF (flone) THEN
            !
            DO ixy=1, nx*ny
              bitmap(ixy) = x1(ixy) .NE. undef
            END DO
            !
#ifdef W3_NCEP2
            CALL gribcreate (cgrib,lcgrib,listsec0,listsec1,io)
            IF (io .NE. 0) GOTO 810
            CALL addgrid (cgrib,lcgrib,igds,kgds,200,ideflist,   &
                 idefnum, io)
            IF (io .NE. 0) GOTO 820
            CALL addfield (cgrib,lcgrib,kpdsnum,kpds,200,        &
                 coordlist, numcoord, idrsnum, idrs,   &
                 200,x1, ndata, ibmp, bitmap, io)
            IF (io .NE. 0) GOTO 820
            CALL gribend (cgrib, lcgrib, lengrib, io)
            IF (io .NE. 0) GOTO 830
            CALL wryte (ndsdat, lengrib, cgrib)
#endif
            !
          ELSE IF ( fltwo ) THEN
            !
            DO ixy=1, nx*ny
              bitmap(ixy) = x1(ixy) .NE. undef
            END DO
#ifdef W3_NCEP2
            CALL gribcreate (cgrib,lcgrib,listsec0,listsec1,io)
            IF (io .NE. 0) GOTO 810
            CALL addgrid (cgrib,lcgrib,igds,kgds,200,ideflist, &
                 idefnum, io)
            IF (io .NE. 0) GOTO 820
            CALL addfield (cgrib,lcgrib,kpdsnum,kpds,200, &
                 coordlist, numcoord, idrsnum, idrs, &
                 200,x1, ndata, ibmp, bitmap, io)
            IF (io .NE. 0) GOTO 820
            CALL gribend (cgrib, lcgrib, lengrib, io)
            IF (io .NE. 0) GOTO 830
            CALL wryte (ndsdat, lengrib, cgrib)
#endif
 
#ifdef W3_NCEP2
            kpds(2) = 0
            CALL gribcreate (cgrib,lcgrib,listsec0,listsec1,io)
            IF (io .NE. 0) GOTO 810
            CALL addgrid (cgrib,lcgrib,igds,kgds,200,ideflist, &
                 idefnum, io)
            IF (io .NE. 0) GOTO 820
            CALL addfield (cgrib,lcgrib,kpdsnum,kpds,200,      &
                 coordlist, numcoord, idrsnum, idrs, &
                 200,x2, ndata, ibmp, bitmap, io)
            IF (io .NE. 0) GOTO 820
            CALL gribend (cgrib, lcgrib, lengrib, io)
            IF (io .NE. 0) GOTO 830
            CALL wryte (ndsdat, lengrib, cgrib)
            kpds(2) = 2
            CALL gribcreate (cgrib,lcgrib,listsec0,listsec1,io)
            IF (io .NE. 0) GOTO 810
            CALL addgrid (cgrib,lcgrib,igds,kgds,200,ideflist, &
                 idefnum, io)
            IF (io .NE. 0) GOTO 820
            CALL addfield (cgrib,lcgrib,kpdsnum,kpds,200,      &
                 coordlist, numcoord, idrsnum, idrs, &
                 200,xx, ndata, ibmp, bitmap, io)
            IF (io .NE. 0) GOTO 820
            CALL gribend (cgrib, lcgrib, lengrib, io)
            IF (io .NE. 0) GOTO 830
            CALL wryte (ndsdat, lengrib, cgrib)
            kpds(2) = 3
            CALL gribcreate (cgrib,lcgrib,listsec0,listsec1,io)
            IF (io .NE. 0) GOTO 810
            CALL addgrid (cgrib,lcgrib,igds,kgds,200,ideflist, &
                 idefnum, io)
            IF (io .NE. 0) GOTO 820
            CALL addfield (cgrib,lcgrib,kpdsnum,kpds,200,      &
                 coordlist, numcoord, idrsnum, idrs, &
                 200,xy, ndata, ibmp, bitmap, io)
            IF (io .NE. 0) GOTO 820
            CALL gribend (cgrib, lcgrib, lengrib, io)
            IF (io .NE. 0) GOTO 830
            CALL wryte (ndsdat, lengrib, cgrib)
#endif
            !
          END IF
#ifdef W3_NCEP2
          listsec0(1) = 10
          kpds(1)     = 0
#endif
          !
          ! ... End of fields loop
          !
        END IF
      END DO
    END DO
    !
    RETURN
    !
    ! Error escape locations
    !
#ifdef W3_NCEP2
810 CONTINUE
    WRITE (ndse,1010) io
    CALL extcde ( 20 )
820 CONTINUE
    WRITE (ndse,1020) io
    CALL extcde ( 30 )
830 CONTINUE
    WRITE (ndse,1030) io
    CALL extcde ( 40 )
#endif
    !
    ! Formats
    !
999 FORMAT (/' *** WAVEWATCH III ERROR IN W3EXGB :'/                &
         '     PLEASE UPDATE FIELDS !!! '/)
    !
#ifdef W3_NCEP2
1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3EXGB : '/               &
         '     ERROR IN OPENING OUTPUT FILE'/                   &
         '     IOSTAT =',i5/)
#endif
    !
#ifdef W3_NCEP2
1010 FORMAT (/' *** WAVEWATCH III ERROR IN W3EXGB : '/               &
         '     ERROR CREATING NEW GRIB2 FIELD'/                 &
         '     IOSTAT =',i5/)
#endif
    !
#ifdef W3_NCEP2
1020 FORMAT (/' *** WAVEWATCH III ERROR IN W3EXGB : '/               &
         '     ERROR ADDING GRIB2 FIELD'/                       &
         '     IOSTAT =',i5/)
#endif
    !
#ifdef W3_NCEP2
1030 FORMAT (/' *** WAVEWATCH III ERROR IN W3EXGB : '/               &
         '     ERROR ENDING GRIB2 MESSAGE'/                     &
         '     IOSTAT =',i5/)
#endif
    !
#ifdef W3_T
9000 FORMAT (' TEST W3EXGB : FLAGS  :',40l2)
9001 FORMAT (' TEST W3EXGB : NDSDAT :',i4/                        &
         '               KPDS   :',13i4/                      &
         '                       ',12i4/                      &
         '               KGDS   :',8i6/                       &
         '                       ',8i6/                       &
         '                       ',6i6)
#endif
    !
#ifdef W3_T
9012 FORMAT (' TEST W3EXGB : BLOK PARS    : ',3i4)
9014 FORMAT ('           BASE NAME : ',a)
#endif
    !
#ifdef W3_T
9020 FORMAT (' TEST W3EXGB : OUTPUT FIELD : ',a)
#endif
    !/
    !/ End of W3EXGB ----------------------------------------------------- /
    !/

References constants::rade, constants::undef, w3servmd::w3s2xy(), w3servmd::w3thrtn(), and w3servmd::w3xyrtn().

Referenced by w3grib().

w3grib()

program w3grib

Post-processing of grid output.

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

Author

H. L. Tolman

A. Chawla

J.-H. Alves

Date

22-Mar-2021

Definition at line 27 of file ww3_grib.F90.

References w3timemd::dsec21(), w3servmd::extcde(), file(), w3odatmd::flogd, w3odatmd::flogrd, w3odatmd::fnmpre, w3wdatmd::ice, w3odatmd::idout, w3servmd::itrace(), w3odatmd::ndse, w3odatmd::ndso, w3odatmd::ndst, w3servmd::nextln(), w3odatmd::ngrpp, w3odatmd::noge, w3odatmd::nogrp, w3odatmd::noswll, w3wdatmd::rhoair, w3timemd::stme21(), w3servmd::strace(), w3timemd::tick21(), w3wdatmd::time, constants::undef, w3wdatmd::ust, w3wdatmd::ustdir, w3exgb(), w3iogomd::w3iogo(), w3iogrmd::w3iogr(), w3adatmd::w3naux(), w3wdatmd::w3ndat(), w3gdatmd::w3nmod(), w3odatmd::w3nout(), w3iogomd::w3readflgrd(), w3adatmd::w3seta(), w3gdatmd::w3setg(), w3odatmd::w3seto(), w3wdatmd::w3setw(), and w3wdatmd::wlv.