gx_outf.F90

Go to the documentation of this file.

 
#include "w3macros.h"
 
!/ ------------------------------------------------------------------- /
PROGRAM gxoutf
  !/
  !/                  +-----------------------------------+
  !/                  | WAVEWATCH III           NOAA/NCEP |
  !/                  |           H. L. Tolman            |
  !/                  |           A. Chawla               |
  !/                  |           J.H.G.M. Alves          |
  !/                  |                        FORTRAN 90 |
  !/                  | Last update :         22-Mar-2021 |
  !/                  +-----------------------------------+
  !/
  !/    30-Jun-1999 : Final FORTRAN 77                    ( version 1.18 )
  !/    24-Jan-2000 : Upgrade to FORTRAN 90               ( version 2.00 )
  !/    25-Jan-2001 : Cartesian grid version              ( version 2.06 )
  !/    29-Jan-2001 : Add output fields 17-18             ( version 2.20 )
  !/    13-Nov-2002 : Add stress vector.                  ( version 3.00 )
  !/    24-Dec-2004 : Multiple grid version.              ( version 3.06 )
  !/    27-Jun-2005 : Adding MAPST2.                      ( version 3.07 )
  !/    21-Jul-2005 : Add output fields 19-21.            ( version 3.07 )
  !/    15-Dec-2005 : Updating MAPST2 for 2-way nest.     ( version 3.08 )
  !/    13-Mar-2006 : MSOUT and MBOUT added.              ( version 3.09 )
  !/    29-Jun-2006 : Adding file name preamble.          ( version 3.09 )
  !/    05-Jul-2006 : Consolidate stress arrays.          ( version 3.09 )
  !/    18-Jan-2007 : Update MSOUT/MBOUT treatment.       ( version 3.10 )
  !/    28-Mar-2007 : Adding partitioned output.          ( version 3.11 )
  !/                  Adding user slots for outputs.
  !/    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)
  !/    06-Dec-2010 : Change from GLOBAL (logical) to ICLOSE (integer) to
  !/                  specify index closure for a grid.   ( version 3.14 )
  !/                  (T. J. Campbell, NRL)
  !/    05-Oct-2011 : Updating to the 53 output parameter ( version 4.05 )
  !/                  (J-H Alves)
  !/    25-Feb-2013 : Adding double-index output fields   ( version 4.11 )
  !/    27-Aug-2015 : ICEH and ICEF added as output       ( version 5.10 )
  !/    25-Aug-2018 : Add WBT parameter                   ( version 6.06 )
  !/    22-Mar-2021 : RHOA and TAUA added as output       ( version 7.13 )
  !/
  !/
  !/    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 :
  !
  !     Generate GrADS input files from raw WAVEWATCH data file.
  !
  !  2. Method :
  !
  !     Data is read from the grid output file out_grd.ww3 (raw data)
  !     and from the file gx_outf.inp ( NDSI, output requests ).
  !     Model definition and raw data files are read using WAVEWATCH III
  !     subroutines.
  !
  !     Output files are ww3.ctl and ww3.grads. the output files
  !     contains a land-sea map, followed by requested fields. See the
  !     control file for the names of the fields.
  !
  !  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.
  !      W3EXGO    Subr. Internal Execute grid output.
  !     ----------------------------------------------------------------
  !
  !  5. Called by :
  !
  !     None, stand-alone program.
  !
  !  6. Error messages :
  !
  !     Checks on input, checks in W3IOxx.
  !     Check on grid type.
  !
  !  7. Remarks :
  !
  !     - For the Cartesian grid version the X and Y increment are
  !       artificially converted to long-lat by assuming the 1 degree
  !       equals 100 km.
  !     - Curvilinear grids currently not supported.
  !
  !  8. Structure :
  !
  !     See source code.
  !
  !  9. Switches :
  !
  !        !/S     Enable subroutine tracing.
  !
  ! 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
#ifdef W3_S
  USE w3servmd, ONLY : strace
#endif
  USE w3timemd, ONLY: stme21, tick21, dsec21
  !/
  USE w3gdatmd
  USE w3wdatmd, ONLY: time, wlv, ice, iceh, icef, berg,            &
       ust, ustdir, rhoair
  USE w3adatmd, ONLY: cflxymax, cflthmax, as, cx, cy, ua, ud, wn,  &
       dw, hs, wlm, t01, t0m1, t02, thm, ths, fp0,  &
       thp0, aba, abd, uba, ubd, fcut,              &
       sxx, syy, sxy, phs, ptp, plp, pdir, psi, pws,&
       ptm1, pt1, pt2, pep, taua, tauadir,          &
       pthp0, pqp, psw, ppe, pgw, qp,               &
       pwst, pnr, usero, tauox, tauoy, tauwix,      &
       tauwiy, phiaw, phioc, tusx, tusy, prms, tpms,&
       ussx, ussy, mssx, mssy, mscx, mscy, charn,   &
       tauwnx,  tauwny, bhd, p2sms, dtdyn,          &
       cge, t02, bedforms, whitecap, taubbl, phibbl,&
       cflxymax, cflthmax, cflkmax, us3d, stmaxe,   &
       stmaxd, hmaxe, hcmaxe, hmaxd, hcmaxd, wbt
  USE w3odatmd, ONLY: ndse, ndst, ndso, nogrp, ngrpp, idout, undef,&
       flogrd, fnmpre, noswll, noge
  !
  IMPLICIT NONE
  !/
  !/ ------------------------------------------------------------------- /
  !/ Local parameters
  !/
  INTEGER                 :: ndsi, ndsm, ndsog, ndsdat, ndsctl,   &
       ndstrc, ntrace, ierr, i,j,k, ifi,ifj,&
       tout(2), nout, tdum(2), nvar, iout,  &
       ix0, ixn, iy0, iyn, time0(2), ih0,   &
       im0, id0, iid, ij0, iotest, iinc, iu,&
       timen(2), jlen
#ifdef W3_S
  INTEGER, SAVE           :: ient = 0
#endif
  REAL                    :: dtreq, dtest
  REAL                    :: fac, xymax
  CHARACTER               :: comstr*1, idtime*23, iddday*11,      &
       cinc*2
  CHARACTER*3             :: mnth(12)
  CHARACTER*5             :: parid
  LOGICAL                 :: flone, fltwo, fldir, fltri, flprt
  LOGICAL                 :: flreq(nogrp,ngrpp), flog(nogrp),     &
       msout, mbout, ltemp(ngrpp)
  !/
  !/ ------------------------------------------------------------------- /
  !/
  DATA time0  / -1, 0 /
  DATA mnth   / 'JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN',         &
       'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC' /
  !
  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  ! 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
  ndsctl = 51
  !
  ndstrc =  6
  ntrace = 10
  !
  WRITE (ndso,900)
  !
  CALL itrace ( ndstrc, ntrace )
#ifdef W3_S
  CALL strace (ient, 'GXOUTF')
#endif
  !
  jlen   = len_trim(fnmpre)
  OPEN (ndsi,file=fnmpre(:jlen)//'gx_outf.inp',status='OLD',       &
       err=800,iostat=ierr)
  READ (ndsi,'(A)',END=801,ERR=802) comstr
  IF (comstr.EQ.' ') comstr = '$'
  WRITE (ndso,901) comstr
  !
  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  ! 2.  Read model definition file.
  !
  CALL w3iogr ( 'READ', ndsm )
  WRITE (ndso,920) gname
  IF ( gtype .EQ. clgtype ) THEN
    WRITE(ndse,*)'PROGRAM GXOUTF: '// &
         'GRADS OUTPUT NOT IMPLEMENTED FOR CURVILINEAR GRIDS. '// &
         'NOW STOPPING.'
    CALL extcde ( 1 )
  END IF
  IF ( iclose .EQ. iclose_trpl ) THEN
    WRITE(ndse,*)'PROGRAM GXOUTF: '// &
         'GRADS OUTPUT NOT IMPLEMENTED FOR TRIPOLE GRIDS. '// &
         'NOW STOPPING.'
    CALL extcde ( 1 )
  END IF
  !
  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  ! 3.  Read general data and first fields from file
  !
  CALL w3iogo ( 'READ', ndsog, iotest )
  !
  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
  !
  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  ! 4.  Read requests from input file.
  !     Output times
  !
  CALL nextln ( comstr , ndsi , ndse )
  READ (ndsi,*,END=801,ERR=802) TOUT, DTREQ, nout
  dtreq  = max( 0. , dtreq )
  IF ( dtreq.EQ.0 ) nout = 1
  nout   = max( 1 , nout )
  !
  CALL stme21 ( tout , idtime )
  WRITE (ndso,940) idtime
  !
  tdum = 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
  !
  IF ( mod(nint(dtreq),60) .NE. 0 ) GOTO 810
  !
  ! ... Output fields
  !
  flreq(:,:)=.false. ! Initialize FLGRD
  CALL w3readflgrd ( ndsi, ndso, 9, ndse, comstr, flog,      &
       flreq, 1, 1, ierr )
  !
  !
  ! Reset flags for variables not yet implemented in grads output interface
  !
  !    This needs to be reviewed whenever new parameters are added to the
  !     grads ctl and data files
  !
  ifi = 3
  DO ifj = 1,noge(ifi)
    IF ( flreq(ifi,ifj) ) THEN
      WRITE (ndso,946) idout(ifi,ifj),                           &
           '*** NOT YET CODED INTO GXOUTF ***'
      flreq(ifi,ifj) = .false.
    END IF
  END DO
  ifi = 5
  DO ifj = 7,10
    IF ( flreq(ifi,ifj) ) THEN
      WRITE (ndso,946) idout(ifi,ifj),                           &
           '*** NOT YET CODED INTO GXOUTF ***'
      flreq(ifi,ifj) = .false.
    END IF
  END DO
  DO ifi = 6,8
    DO ifj = 1,noge(ifi)
      IF ( flreq(ifi,ifj) ) THEN
        WRITE (ndso,946) idout(ifi,ifj),                           &
             '*** NOT YET CODED INTO GXOUTF ***'
        flreq(ifi,ifj) = .false.
      END IF
    END DO
  END DO
  ifi = 10
  DO ifj = 1,noge(ifi)
    IF ( flreq(ifi,ifj) ) THEN
      WRITE (ndso,946) idout(ifi,ifj),                           &
           '*** NOT YET CODED INTO GXOUTF ***'
      flreq(ifi,ifj) = .false.
    END IF
  END DO
  IF ( flreq(9,5) ) THEN
    WRITE (ndso,946) idout(9,5),'*** NOT YET CODED INTO GXOUTF ***'
    flreq(9,5) = .false.
  END IF
 
  WRITE (ndso,945)
  !
  nvar  = 1
  DO ifi=1, nogrp
    DO ifj=1, ngrpp
      IF ( flreq(ifi,ifj) ) THEN
        IF ( .NOT. flogrd(ifi,ifj) ) THEN
          WRITE (ndso,946) idout(ifi,ifj),'*** DATA NOT AVAILABLE ***'
        ELSE
          WRITE (ndso,946) idout(ifi,ifj), ' '
        END IF
      END IF
      flreq(ifi,ifj) = flreq(ifi,ifj) .AND. flogrd(ifi,ifj)
      !
      ! Note: Whenever number of output parameters change, this needs updating
      !
      ! The grads output type code does NOT cover all the output parameter space!!
      !
      IF ( ifi.EQ.6 .AND. ifj.EQ.1 ) THEN ! Radiation stresses needs 3D variable setting
        IF ( flreq(ifi,ifj) ) nvar = nvar + 3
      ELSE IF ( ifi.EQ.4 .AND. ifj.LE.noge(4) ) THEN
        IF ( flreq(ifi,ifj) ) nvar = nvar + noswll + 1 ! Partitioned parameters
      ELSE IF ( ifi.EQ.1 .AND. ifj .EQ. 2 ) THEN
        IF ( flreq(ifi,ifj) ) nvar = nvar + 2 ! Current vector
      ELSE IF ( ifi.EQ.1 .AND. ifj.EQ.3 ) THEN
        IF ( flreq(ifi,ifj) ) nvar = nvar + 2 ! Wind vector
      ELSE IF ( ifi.EQ.5 .AND. ifj.EQ.1 ) THEN
        IF ( flreq(ifi,ifj) ) nvar = nvar + 2 ! USTAR vector
      ELSE IF ( ifi.EQ.5 .AND. ifj.EQ.5 ) THEN
        IF ( flreq(ifi,ifj) ) nvar = nvar + 2 ! TAUWI vector
      ELSE IF ( ifi.EQ.5 .AND. ifj.EQ.6 ) THEN
        IF ( flreq(ifi,ifj) ) nvar = nvar + 2 ! TAUWN vector
        !          ELSE IF ( IFI.EQ.9 .AND. IFJ.EQ.5 ) THEN
        !            IF ( FLREQ(IFI,IFJ) ) NVAR = NVAR + 2 ! Max angular CFL vector
      ELSE
        IF ( flreq(ifi,ifj) ) nvar = nvar + 1 ! scalars
      END IF
    END DO
  END DO
  !
  ! ... Grid range
  !
  CALL nextln ( comstr , ndsi , ndse )
  READ (ndsi,*,END=801,ERR=802) IX0, IXN, IY0, IYN, MSOUT, mbout
  !
  WRITE (ndso,947)
  !
  ix0    = max( 1, ix0 )
  iy0    = max( 1, iy0 )
  ixn    = min( nx, ixn )
  iyn    = min( ny, iyn )
  !
  WRITE (ndso,948) ix0, ixn, iy0, iyn
  !
  IF ( msout ) THEN
    WRITE (ndso,950) 'YES/--'
  ELSE
    WRITE (ndso,950) '---/NO'
  END IF
  !
  IF ( .NOT. msout ) mbout = .false.
  IF ( mbout ) THEN
    WRITE (ndso,951) 'YES/--'
  ELSE
    WRITE (ndso,951) '---/NO'
  END IF
  !
  msout  = .NOT. msout
  mbout  = .NOT. mbout
  !
  OPEN (ndsdat,file=fnmpre(:jlen)//'ww3.grads',form='UNFORMATTED', convert=file_endian, &
       err=811,iostat=ierr)
  !
  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  ! 5.  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 600
      END IF
      cycle
    END IF
    IF ( dtest .LT. 0. ) THEN
      CALL tick21 ( tout , dtreq )
      cycle
    END IF
    !
    iout   = iout + 1
    CALL stme21 ( tout , idtime )
    WRITE (ndso,971) idtime
    !
    CALL gxexgo ( nx, ny, nsea )
    timen  = tout
    !
    IF ( time0(1) .EQ. -1 ) time0 = time
    !
    CALL tick21 ( tout , dtreq )
    IF ( iout .GE. nout ) EXIT
  END DO
  !
  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  ! 6.  Close data file and write control file
  !
600 CONTINUE
  WRITE (ndso,980)
  !
  WRITE (ndso,981)
  CLOSE (ndsdat)
  WRITE (ndso,982)
  OPEN (ndsctl,file=fnmpre(:jlen)//'ww3.ctl',err=812,iostat=ierr)
  !
  ih0    = time0(2)/10000
  im0    = mod(time0(2)/100,100)
  id0    = mod(time0(1),100)
  iid    = mod(time0(1)/100,100)
  ij0    = time0(1)/10000
  !
  IF ( iout .GT. 1 ) dtreq  = dsec21( time0, timen ) / real(iout-1)
  IF ( iout .EQ. 1 ) dtreq  = 3600.
  IF ( dtreq .GT. 3599. ) THEN
    cinc   = 'HR'
    iinc   = nint(dtreq/3600.)
    IF ( mod(nint(dtreq),3600) .NE. 0 ) GOTO 820
  ELSE
    cinc   = 'MN'
    iinc   = nint(dtreq/60.)
  END IF
  !
  WRITE (ndso,983) iout, ih0, im0, id0, mnth(iid), ij0, iinc, cinc
  !
  IF ( flagll ) THEN
    fac = 1.
  ELSE
    xymax  = max( abs(x0+real(ix0-1)*sx), &
         abs(x0+real(ixn-1)*sx), &
         abs(y0+real(iy0-1)*sy), &
         abs(y0+real(iyn-1)*sy) )
    IF ( xymax .LT. 1.e3 ) THEN
      fac    = 1.e-1
    ELSE IF ( xymax .LT. 1.e4 ) THEN
      fac    = 1.e-2
    ELSE IF ( xymax .LT. 1.e5 ) THEN
      fac    = 1.e-3
    ELSE IF ( xymax .LT. 1.e6 ) THEN
      fac    = 1.e-4
    ELSE
      fac    = 1.e-5
    END IF
  END IF !FLAGLL
  !
  WRITE (ndsctl,990) undef,                                       &
       (1+ixn-ix0), fac*(x0+real(ix0-1)*sx), fac*sx,&
       (1+iyn-iy0), fac*(y0+real(iy0-1)*sy), fac*sy,&
       1, 1000., 1.,                                &
       iout, ih0, im0, id0, mnth(iid), ij0,         &
       iinc, cinc, nvar
  !
  iu     = 99
  WRITE (ndsctl,991) 'MAP  ', 0, iu, 'grid use map   '
  !
  IF ( flreq(01,01) )                                              &
       WRITE (ndsctl,991) 'dpt  ', 0, iu, 'Water depth    '
  IF ( flreq(01,02) )                                              &
       WRITE (ndsctl,991) 'ucur ', 0, iu, 'Current U (m/s)'
  IF ( flreq(01,02) )                                              &
       WRITE (ndsctl,991) 'vcur ', 0, iu, 'Current V (m/s)'
  IF ( flreq(01,03) )                                              &
       WRITE (ndsctl,991) 'uwnd ', 0, iu, 'Wind U (m/s)   '
  IF ( flreq(01,03) )                                              &
       WRITE (ndsctl,991) 'vwnd ', 0, iu, 'Wind V (m/s)   '
  IF ( flreq(01,04) )                                              &
       WRITE (ndsctl,991) 'ast  ', 0, iu, 'AT-SST (degr)  '
  IF ( flreq(01,05) )                                              &
       WRITE (ndsctl,991) 'wlv  ', 0, iu, 'Water Level (m)'
  IF ( flreq(01,06) )                                              &
       WRITE (ndsctl,991) 'ice  ', 0, iu, 'Ice Conc. (-)  '
#ifdef W3_IS2
  IF (flreq(01,09) )                                              &
       WRITE (ndsctl,991) 'ic1 ', 0, iu, 'Ice thick. (m) '
  IF (flreq(01,10) )                                              &
       WRITE (ndsctl,991) 'ic5 ', 0, iu, 'Floe diam. (m)  '
#endif
  IF ( flreq(02,01) )                                              &
       WRITE (ndsctl,991) 'hs   ', 0, iu, 'Wave height (m)'
  IF ( flreq(02,02) )                                              &
       WRITE (ndsctl,991) 'lm   ', 0, iu, 'Mean L (m)     '
  IF ( flreq(02,03) )                                              &
       WRITE (ndsctl,991) 't02  ', 0, iu, 'Mean Per Tz (s)'
  IF ( flreq(02,04) )                                              &
       WRITE (ndsctl,991) 't01  ', 0, iu, 'Mean Per Tm (s)  '
  IF ( flreq(02,05) )                                              &
       WRITE (ndsctl,991) 't0m1', 0, iu, 'Mean Per Te (s)  '
  IF ( flreq(02,06) )                                              &
       WRITE (ndsctl,991) 'fp   ', 0, iu, 'Peak Freq. (Hz)'
  IF ( flreq(02,07) )                                              &
       WRITE (ndsctl,991) 'dir  ', 0, iu, 'Mean Dir. (rad)'
  IF ( flreq(02,08) )                                              &
       WRITE (ndsctl,991) 'spr  ', 0, iu, 'Dir. spread    '
  IF ( flreq(02,09) )                                              &
       WRITE (ndsctl,991) 'dp   ', 0, iu, 'Peak Dir. (rad)'
  IF ( flreq(04,01) ) THEN
    parid  = 'phs  '
    DO i=0, noswll
      WRITE (parid(4:5),'(I2.2)') i
      WRITE (ndsctl,991) parid , 0, iu, 'Part. Hs (m)   '
    END DO
  END IF
  IF ( flreq(04,02) ) THEN
    parid  = 'ptp  '
    DO i=0, noswll
      WRITE (parid(4:5),'(I2.2)') i
      WRITE (ndsctl,991) parid , 0, iu, 'Part. Tp (s)   '
    END DO
  END IF
  IF ( flreq(04,03) ) THEN
    parid  = 'plp  '
    DO i=0, noswll
      WRITE (parid(4:5),'(I2.2)') i
      WRITE (ndsctl,991) parid , 0, iu, 'Part. L  (m)   '
    END DO
  END IF
  IF ( flreq(04,04) ) THEN
    parid  = 'pdir  '
    DO i=0, noswll
      WRITE (parid(4:5),'(I2.2)') i
      WRITE (ndsctl,991) parid , 0, iu, 'Part. Th (deg.)'
    END DO
  END IF
  IF ( flreq(04,05) ) THEN
    parid  = 'pspr '
    DO i=0, noswll
      WRITE (parid(4:5),'(I2.2)') i
      WRITE (ndsctl,991) parid , 0, iu, 'Part. si (deg.)'
    END DO
  END IF
  IF ( flreq(04,06) ) THEN
    parid  = 'pws  '
    DO i=0, noswll
      WRITE (parid(4:5),'(I2.2)') i
      WRITE (ndsctl,991) parid , 0, iu, 'Part. ws frac. '
    END DO
  END IF
  IF ( flreq(04,07) )                                              &
       WRITE (ndsctl,991) 'tws  ', 0, iu, 'Total ws frac. '
  IF ( flreq(04,08) )                                              &
       WRITE (ndsctl,991) 'pnr  ', 0, iu, 'Number of part.'
  IF ( flreq(05,01) )                                              &
       WRITE (ndsctl,991) 'uust ', 0, iu, 'Fr.Vel. U(m/s) '
  IF ( flreq(05,01) )                                              &
       WRITE (ndsctl,991) 'vust ', 0, iu, 'Fr.Vel. V(m/s) '
  IF ( flreq(05,02) )                                              &
       WRITE (ndsctl,991) 'cha  ', 0, iu, 'Charnock parameter'
  IF ( flreq(05,03) )                                              &
       WRITE (ndsctl,991) 'cge  ', 0, iu, 'Energy Flux (W/m)'
  IF ( flreq(05,04) )                                              &
       WRITE (ndsctl,991) 'faw  ', 0, iu, 'Air-sea energy flux'
  IF ( flreq(05,05) )                                              &
       WRITE (ndsctl,991) 'utaw  ', 0, iu, 'Net wave supp str'
  IF ( flreq(05,05) )                                              &
       WRITE (ndsctl,991) 'vtaw  ', 0, iu, 'Net wave supp str'
  IF ( flreq(05,06) )                                              &
       WRITE (ndsctl,991) 'utwa  ', 0, iu, 'Neg wave supp str'
  IF ( flreq(05,06) )                                              &
       WRITE (ndsctl,991) 'vtwa  ', 0, iu, 'Neg wave supp str'
  IF ( flreq(09,01) )                                              &
       WRITE (ndsctl,991) 'dtd  ', 0, iu, 'DTAVG ST (min) '
  IF ( flreq(09,02) )                                              &
       WRITE (ndsctl,991) 'fc   ', 0, iu, 'fcut (Hz)      '
  IF ( flreq(09,03) )                                              &
       WRITE (ndsctl,991) 'cfx  ', 0, iu, 'Max CFL XY Prop'
  IF ( flreq(09,04) )                                              &
       WRITE (ndsctl,991) 'cfd  ', 0, iu, 'Max CFL TH Prop'
  !
  WRITE (ndsctl,992)
  !
  GOTO 888
  !
  ! Escape locations read errors :
  !
800 CONTINUE
  WRITE (ndse,1000) ierr
  CALL extcde ( 1 )
  !
801 CONTINUE
  WRITE (ndse,1001)
  CALL extcde ( 2 )
  !
802 CONTINUE
  WRITE (ndse,1002) ierr
  CALL extcde ( 3 )
  !
810 CONTINUE
  WRITE (ndse,1010)
  CALL extcde ( 10 )
  !
811 CONTINUE
  WRITE (ndse,1011)
  CALL extcde ( 11 )
  !
812 CONTINUE
  WRITE (ndse,1012)
  CALL extcde ( 12 )
  !
820 CONTINUE
  WRITE (ndse,1020) dtreq
  CALL extcde ( 20 )
  !
821 CONTINUE
  WRITE (ndse,1021)
  CALL extcde ( 21 )
  !
888 CONTINUE
  WRITE (ndso,999)
  !
  ! Formats
  !
900 FORMAT (/12x,'   *** WAVEWATCH III GrADS field output postp. ***   '/ &
       12x,'====================================================='/)
901 FORMAT ( '  Comment character is ''',a,''''/)
  !
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 '/)
  !
945 FORMAT (/'  Requested output fields : '/                        &
       ' -----------------------------------------------------')
946 FORMAT ( '      ',a,1x,a)
  !
947 FORMAT (/'  Requested discrete grid ranges : '/                 &
       ' -----------------------------------------------------')
948 FORMAT ( '      Longitudes         : ',2i6/                     &
       '      lattidutes         : ',2i6/                     &
       '      Opening file ww3.grads')
949 FORMAT ( '      Alternative definition is used ')
950 FORMAT ( '      Sea points in mask :      ',a)
951 FORMAT ( '      Bound. pts. in mask:      ',a)
  !
970 FORMAT (//'  Generating file '/                                 &
       ' -----------------------------------------------------')
971 FORMAT ( '      Data for ',a)
  !
980 FORMAT (//'  Final file management '/                           &
       ' -----------------------------------------------------')
981 FORMAT ( '      Closing file ww3.grads')
982 FORMAT ( '      Opening file ww3.ctl')
983 FORMAT ( '         Number of times : ',i6/                      &
       '         Initial time ID : ',i2.2,':',i2.2,'Z',i2.2,a3,i4/ &
       '         Time step ID    : ',i2,a2)
  !
990 FORMAT ('DSET      ww3.grads'/                                  &
       'TITLE     WAVEWATCH III gridded data'/                 &
       'OPTIONS   sequential'/                                 &
       'OPTIONS   big_endian'/                                 &
       'UNDEF    ',f8.1/                                       &
       'XDEF     ',i4,'  LINEAR ',2f12.5/                      &
       'YDEF     ',i4,'  LINEAR ',2f12.5/                      &
       'ZDEF     ',i4,'  LINEAR ',2f12.5/                      &
       'TDEF     ',i4,'  LINEAR ',i6.2,':',i2.2,'Z',i2.2,a3,i4, &
       2x,i2,a2/                                              &
       'VARS     ',i4)
991 FORMAT (a6,2i4,2x,a15)
992 FORMAT ('ENDVARS')
  !
999 FORMAT (/'  End of program '/                                   &
       ' ========================================='/          &
       '         WAVEWATCH III GrADS field output '/)
  !
#ifdef W3_T
9050 FORMAT ( ' TEST GXOUTF : KPDS : ',13i4/                      &
       '                      ',12i4)
9051 FORMAT ( ' TEST GXOUTF : KGDS : ',8i6/                       &
       '                      ',8i6/                       &
       '                      ',6i6)
#endif
  !
1000 FORMAT (/' *** WAVEWATCH III ERROR IN GXOUTF : '/               &
       '     ERROR IN OPENING INPUT FILE'/                    &
       '     IOSTAT =',i5/)
  !
1001 FORMAT (/' *** WAVEWATCH III ERROR IN GXOUTF : '/               &
       '     PREMATURE END OF INPUT FILE'/)
  !
1002 FORMAT (/' *** WAVEWATCH III ERROR IN GXOUTF : '/               &
       '     ERROR IN READING FROM INPUT FILE'/               &
       '     IOSTAT =',i5/)
  !
1010 FORMAT (/' *** WAVEWATCH III ERROR IN GXOUTF : '/               &
       '     SMALLEST OUTPUT INCREMENT IS 60 SEC.'/)
  !
1011 FORMAT (/' *** WAVEWATCH III ERROR IN GXOUTF : '/               &
       '     ERROR IN OPENING OUTPUT FILE ww3.grads'/         &
       '     IOSTAT =',i5/)
  !
1012 FORMAT (/' *** WAVEWATCH III ERROR IN GXOUTF : '/               &
       '     ERROR IN OPENING OUTPUT FILE ww3.ctl'/           &
       '     IOSTAT =',i5/)
  !
1020 FORMAT (/' *** WAVEWATCH III ERROR IN GXOUTF : '/               &
       '     FIELD INCREMENT > 1HR BUT NOT MULTIPLE',f10.0/)
  !
1021 FORMAT (/' *** WAVEWATCH III ERROR IN GXOUTF : '/               &
       '     UPDATE PARS IN LOOP 610 !!!'/)
  !/
  !/ Internal subroutine GXEXGO ---------------------------------------- /
  !/
CONTAINS
  !/ ------------------------------------------------------------------- /
  SUBROUTINE gxexgo ( NX, NY, NSEA )
    !/
    !/                  +-----------------------------------+
    !/                  | WAVEWATCH III           NOAA/NCEP |
    !/                  |           H. L. Tolman            |
    !/                  |                        FORTRAN 90 |
    !/                  | Last update :         22-Mar-2021 |
    !/                  +-----------------------------------+
    !/
    !/    30-Jun-1999 : Final FORTRAN 77                    ( version 1.18 )
    !/    24-Jan-2000 : Upgrade to FORTRAN 90               ( version 2.00 )
    !/                  Massive changes to logistics.
    !/    29-Jan-2001 : Add output fields 17-18             ( version 2.20 )
    !/    24-Dec-2004 : Multiple grid version.              ( version 3.06 )
    !/    27-Jun-2005 : Adding MAPST2.                      ( version 3.07 )
    !/    21-Jul-2005 : Add output fields 19-21.            ( version 3.07 )
    !/    05-Jul-2006 : Consolidate stress arrays.          ( version 3.09 )
    !/    18-Jan-2007 : Update MSOUT/MBOUT treatment.       ( version 3.10 )
    !/    28-Mar-2007 : Adding partitioned output.          ( version 3.11 )
    !/                  Adding user slots for outputs.
    !/    22-Mar-2021 : Add output fields RHOA and TAUA     ( version 7.13 )
    !/
    !  1. Purpose :
    !
    !     Perform actual output for GrADS postprocessing.
    !
    !  3. Parameters :
    !
    !     Parameter list
    !     ----------------------------------------------------------------
    !       NX/Y    Int.  I  Grid dimensions.
    !       NSEA    Int.  I  Number of sea points.
    !     ----------------------------------------------------------------
    !
    !     Internal parameters
    !     ----------------------------------------------------------------
    !       X1, X2, XX
    !               R.A.  Output fields
    !     ----------------------------------------------------------------
    !
    !  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.
    !     ---------------------------------------------------------------
    !
    !  5. Called by :
    !
    !     Main 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.
    !     - VALLND added to assure that map with only land plots in
    !       GrADS.
    !
    !  8. Structure :
    !
    !     See source code.
    !
    !  9. Switches :
    !
    !     !/S  Enable subroutine tracing.
    !     !/T  Enable test output.
    !
    ! 10. Source code :
    !
    !/ ------------------------------------------------------------------- /
    USE w3servmd, ONLY: w3s2xy
    !/
    !/ ------------------------------------------------------------------- /
    !/ Parameter list
    !/
    INTEGER, INTENT(IN)     :: NX, NY, NSEA
    !/
    !/ ------------------------------------------------------------------- /
    !/ Local parameters
    !/
    INTEGER                 :: IX, IY, J, ISEA, IXL, IXR
    INTEGER                 :: MAPXCL(NY,NX), MAPDRY(NY,NX),        &
         MAPICE(NY,NX), MAPLND(NY,NX),        &
         MAPMSK(NY,NX)
#ifdef W3_S
    INTEGER, SAVE           :: IENT   = 0
#endif
    REAL                    :: X1(NX,NY), XX(NX,NY), XY(NX,NY),     &
         XA(NX,NY,0:NOSWLL)
    REAL                    :: VALLND = 0.001
    !/
    !/ ------------------------------------------------------------------- /
    !/
#ifdef W3_S
    CALL strace (ient, 'GXEXGO')
#endif
    !
#ifdef W3_T
    WRITE (ndst,9000) ((flreq(j,k),j=1,nogrp), k=1,ngrpp)
#endif
    !
    !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    ! 1.  Preparations
    ! 1.a Write map to file
    !
    mapxcl = mod(mapst2,2)
    mapice = mod(mapst2,2)
    mapdry = mod(mapst2/2,2)
    maplnd = mod(mapst2/4,2)
    mapmsk = mod(mapst2/8,2)
    !
    DO iy=1, ny
      DO ix=1, nx
        IF ( mapsta(iy,ix).EQ.0 ) THEN
          IF ( mapxcl(iy,ix).EQ.1 ) THEN
            x1(ix,iy) = undef
          ELSE
            x1(ix,iy) = vallnd
          END IF
        ELSE IF ( mapsta(iy,ix).LT.0 ) THEN
          IF ( mapmsk(iy,ix).EQ.1 ) THEN
            x1(ix,iy) = -4.
          ELSE IF ( maplnd(iy,ix).EQ.1 ) THEN
            x1(ix,iy) = vallnd
          ELSE IF ( mapice(iy,ix).EQ.1 .AND.                    &
               mapdry(iy,ix).EQ.1 ) THEN
            x1(ix,iy) = -3.
          ELSE IF ( mapdry(iy,ix).EQ.1 ) THEN
            x1(ix,iy) = -2.
          ELSE IF ( mapice(iy,ix).EQ.1 ) THEN
            x1(ix,iy) = -1.
          ELSE
            x1(ix,iy) = -5.
          END IF
        ELSE
          x1(ix,iy) = real(mapsta(iy,ix))
          IF ( msout ) THEN
            IF ( mapsta(iy,ix) .GT. 0 ) x1(ix,iy) = undef
          ELSE IF ( mbout ) THEN
            IF ( mapsta(iy,ix).EQ.2  .OR.                      &
                 iy.EQ.1 .OR. iy.EQ.ny .OR.                    &
                 ( iclose.NE.iclo_none .AND.                   &
                 (ix.EQ.1 .OR. ix.EQ.nx) ) ) THEN
              x1(ix,iy) = undef
            ELSE
              ixl    = 1 + mod(ix+nx-2,nx)
              ixr    = 1 + mod(ix,nx)
              IF ( mapsta(iy+1,ixl).EQ.0 .AND.               &
                   mapxcl(iy+1,ixl).EQ.1 ) x1(ix,iy) = undef
              IF ( mapsta(iy+1,ix ).EQ.0 .AND.               &
                   mapxcl(iy+1,ix ).EQ.1 ) x1(ix,iy) = undef
              IF ( mapsta(iy+1,ixr).EQ.0 .AND.               &
                   mapxcl(iy+1,ixr).EQ.1 ) x1(ix,iy) = undef
              IF ( mapsta( iy ,ixr).EQ.0 .AND.               &
                   mapxcl( iy ,ixr).EQ.1 ) x1(ix,iy) = undef
              IF ( mapsta(iy-1,ixr).EQ.0 .AND.               &
                   mapxcl(iy-1,ixr).EQ.1 ) x1(ix,iy) = undef
              IF ( mapsta(iy-1,ix ).EQ.0 .AND.               &
                   mapxcl(iy-1,ix ).EQ.1 ) x1(ix,iy) = undef
              IF ( mapsta(iy-1,ixl).EQ.0 .AND.               &
                   mapxcl(iy-1,ixl).EQ.1 ) x1(ix,iy) = undef
              IF ( mapsta( iy ,ixl).EQ.0 .AND.               &
                   mapxcl( iy ,ixl).EQ.1 ) x1(ix,iy) = undef
            END IF
          END IF
          IF ( msout .AND. mapsta(iy,ix).EQ.1 ) x1(ix,iy) = undef
          IF ( mbout .AND. mapsta(iy,ix).EQ.2 ) x1(ix,iy) = undef
        END IF
        vallnd = - vallnd
      END DO
    END DO
    !
    WRITE (ndsdat) ((x1(ix,iy),ix=ix0,ixn),iy=iy0,iyn)
    !
    ! 1.b Initialize arrays
    !
    x1 = undef
    xx = undef
    xy = undef
    xa = undef
    !
    !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    ! 2.  Loop over output fields.
    !
    DO j=1, nogrp
      DO k=1, ngrpp
        !        WRITE(*,*)J,K,FLREQ(J,K)
        IF ( flreq(j,k) ) THEN
          !
          ! Set array dimension flags
          flone = .false.
          fltwo = .false.
          fldir = .false.
          fltri = .false.
          flprt = .false.
          !
#ifdef W3_T
          WRITE (ndst,9020) idout(j,k)
#endif
          !
          ! 2.a Set output arrays and parameters
          !
          !     Water depth
          !
          IF ( j.EQ.1 .AND. k.EQ.1 ) THEN
            flone = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, dw(1:nsea)          &
                 , mapsf, x1 )
            !
            !     Current
            !
          ELSE IF ( j.EQ.1 .AND. k.EQ.2 ) THEN
            fltwo = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, cx(1:nsea)          &
                 , mapsf, xx )
            CALL w3s2xy ( nsea, nsea, nx, ny, cy(1:nsea)          &
                 , mapsf, xy )
            !
            !     Wind speed
            !
          ELSE IF ( j.EQ.1 .AND. k.EQ.3 ) THEN
            fltwo = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, ua(1:nsea)          &
                 , mapsf, xx )
            CALL w3s2xy ( nsea, nsea, nx, ny, ud(1:nsea)          &
                 , mapsf, xy )
            !
            !     Air-sea temp. dif.
            !
          ELSE IF ( j.EQ.1 .AND. k.EQ.4 ) THEN
            flone = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, as(1:nsea)          &
                 , mapsf, x1 )
            !
            !     Water level
            !
          ELSE IF ( j.EQ.1 .AND. k.EQ.5 ) THEN
            flone = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, wlv   , mapsf, x1 )
            !
            !     Ice concentration
            !
          ELSE IF ( j.EQ.1 .AND. k.EQ.6 ) THEN
            flone = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, ice   , mapsf, x1 )
            !
            !     Atmospheric momentum
            !
          ELSE IF ( j.EQ.1 .AND. k.EQ.8 ) THEN
            fltwo = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, taua(1:nsea)        &
                 , mapsf, xx )
            CALL w3s2xy ( nsea, nsea, nx, ny, tauadir(1:nsea)     &
                 , mapsf, xy )
            !
            !     Air density
            !
          ELSE IF ( j.EQ.1 .AND. k.EQ.9 ) THEN
            flone = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, rhoair, mapsf, x1 )
            !
            !     Ice thickness
            !
#ifdef W3_IS2
          ELSE IF ( j.EQ.1 .AND. k.EQ.11 ) THEN
            flone = .true.
            CALL w3s2xy (nsea, nsea, nx, ny, iceh  , mapsf, x1 )
#endif
            !
            !     Average sea ice floe diameter
            !
#ifdef W3_IS2
          ELSE IF ( j.EQ.1 .AND. k.EQ.12) THEN
            flone = .true.
            CALL w3s2xy (nsea, nsea, nx, ny, icef  , mapsf, x1 )
#endif
            !
            !
            !     Significant wave height
            !
          ELSE IF ( j.EQ.2 .AND. k.EQ.1 ) THEN
            flone = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, hs    , mapsf, x1 )
            !
            !     Mean wave length
            !
          ELSE IF ( j.EQ.2 .AND. k.EQ.2 ) THEN
            flone = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, wlm   , mapsf, x1 )
            !
            !     Mean zero-crossing wave period T02
            !
          ELSE IF ( j.EQ.2 .AND. k.EQ.3 ) THEN
            flone = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, t02   , mapsf, x1 )
            !
            !     Mean wave period Tm
            !
          ELSE IF ( j.EQ.2 .AND. k.EQ.4 ) THEN
            flone = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, t0m1   , mapsf, x1 )
            !
            !     Mean energy wave period Te
            !
          ELSE IF ( j.EQ.2 .AND. k.EQ.5 ) THEN
            flone = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, t01   , mapsf, x1 )
            !
            !     Peak period
            !
          ELSE IF ( j.EQ.2 .AND. k.EQ.6 ) THEN
            flone = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, fp0   , mapsf, x1 )
            !
            !     Mean wave direction
            !
          ELSE IF ( j.EQ.2 .AND. k.EQ.7 ) THEN
            flone = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, thm   , mapsf, x1 )
            !
            !     Directional spread
            !
          ELSE IF ( j.EQ.2 .AND. k.EQ.8 ) THEN
            flone = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, ths   , mapsf, x1 )
            !
            !     Peak direction
            !
          ELSE IF ( j.EQ.2 .AND. k.EQ.9 ) THEN
            flone = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, thp0  , mapsf, x1 )
            !
            !     Dominant wave breaking probability
            !
          ELSE IF ( j.EQ.2 .AND. k.EQ.17 ) THEN
            flone = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, wbt  , mapsf, x1 )
            !
            !     Partitioned wave heights
            !
          ELSE IF ( j.EQ.4 .AND. k.EQ.1 ) THEN
            flprt = .true.
            DO i=0, noswll
              CALL w3s2xy ( nsea, nsea, nx, ny, phs(:,i),         &
                   mapsf, xa(:,:,i) )
            END DO
            !
            !     Partitioned peak period
            !
          ELSE IF ( j.EQ.4 .AND. k.EQ.2 ) THEN
            flprt = .true.
            DO i=0, noswll
              CALL w3s2xy ( nsea, nsea, nx, ny, ptp(:,i),         &
                   mapsf, xa(:,:,i) )
            END DO
            !
            !     Partitioned wave leangths (peak)
            !
          ELSE IF ( j.EQ.4 .AND. k.EQ.3 ) THEN
            flprt = .true.
            DO i=0, noswll
              CALL w3s2xy ( nsea, nsea, nx, ny, plp(:,i),         &
                   mapsf, xa(:,:,i) )
            END DO
            !
            !     Partitioned directions
            !
          ELSE IF ( j.EQ.4 .AND. k.EQ.4 ) THEN
            flprt = .true.
            DO i=0, noswll
              CALL w3s2xy ( nsea, nsea, nx, ny, pdir(:,i),         &
                   mapsf, xa(:,:,i) )
            END DO
            !
            !     Partitioned direstional spread
            !
          ELSE IF ( j.EQ.4 .AND. k.EQ.5 ) THEN
            flprt = .true.
            DO i=0, noswll
              CALL w3s2xy ( nsea, nsea, nx, ny, psi(:,i),         &
                   mapsf, xa(:,:,i) )
            END DO
            !
            !     Partitioned wind sea fraction
            !
          ELSE IF ( j.EQ.4 .AND. k.EQ.6 ) THEN
            flprt = .true.
            DO i=0, noswll
              CALL w3s2xy ( nsea, nsea, nx, ny, pws(:,i),         &
                   mapsf, xa(:,:,i) )
            END DO
            !
            !     Partitioned peak direction
            !
          ELSE IF ( j.EQ.4 .AND. k.EQ.7 ) THEN
            flprt = .true.
            DO i=0, noswll
              CALL w3s2xy ( nsea, nsea, nx, ny, pthp0(:,i),       &
                   mapsf, xa(:,:,i) )
            END DO
            !
            !     Partitioned peakedness
            !
          ELSE IF ( j.EQ.4 .AND. k.EQ.8 ) THEN
            flprt = .true.
            DO i=0, noswll
              CALL w3s2xy ( nsea, nsea, nx, ny, pqp(:,i),         &
                   mapsf, xa(:,:,i) )
            END DO
            !
            !
            !     Partitioned peak enhancement factor
            !
          ELSE IF ( j.EQ.4 .AND. k.EQ.9 ) THEN
            flprt = .true.
            DO i=0, noswll
              CALL w3s2xy ( nsea, nsea, nx, ny, ppe(:,i),         &
                   mapsf, xa(:,:,i) )
            END DO
            !
            !
            !     Partitioned gaussian frequency spread
            !
          ELSE IF ( j.EQ.4 .AND. k.EQ.10 ) THEN
            flprt = .true.
            DO i=0, noswll
              CALL w3s2xy ( nsea, nsea, nx, ny, pgw(:,i),         &
                   mapsf, xa(:,:,i) )
            END DO
            !
            !
            !     Partitioned spectral width
            !
          ELSE IF ( j.EQ.4 .AND. k.EQ.11 ) THEN
            flprt = .true.
            DO i=0, noswll
              CALL w3s2xy ( nsea, nsea, nx, ny, psw(:,i),         &
                   mapsf, xa(:,:,i) )
            END DO
            !
            !
            !     Partitioned mean energy period (-1)
            !
          ELSE IF ( j.EQ.4 .AND. k.EQ.12 ) THEN
            flprt = .true.
            DO i=0, noswll
              CALL w3s2xy ( nsea, nsea, nx, ny, ptm1(:,i),        &
                   mapsf, xa(:,:,i) )
            END DO
            !
            !
            !     Partitioned mean wave period (+1)
            !
          ELSE IF ( j.EQ.4 .AND. k.EQ.13 ) THEN
            flprt = .true.
            DO i=0, noswll
              CALL w3s2xy ( nsea, nsea, nx, ny, pt1(:,i),         &
                   mapsf, xa(:,:,i) )
            END DO
            !
            !
            !     Partitioned mean wave period (+2)
            !
          ELSE IF ( j.EQ.4 .AND. k.EQ.14 ) THEN
            flprt = .true.
            DO i=0, noswll
              CALL w3s2xy ( nsea, nsea, nx, ny, pt2(:,i),         &
                   mapsf, xa(:,:,i) )
            END DO
            !
            !
            !     Partitioned peak density
            !
          ELSE IF ( j.EQ.4 .AND. k.EQ.15 ) THEN
            flprt = .true.
            DO i=0, noswll
              CALL w3s2xy ( nsea, nsea, nx, ny, pep(:,i),         &
                   mapsf, xa(:,:,i) )
            END DO
            !
            !     Total wind sea fraction
            !
          ELSE IF ( j.EQ.4 .AND. k.EQ.16 ) THEN
            flone = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, pwst ,mapsf, x1 )
            !
            !     Number of partitions
            !
          ELSE IF ( j.EQ.4 .AND. k.EQ.17 ) THEN
            flone = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, pnr , mapsf, x1 )
            !
            !     Friction velocity
            !
          ELSE IF ( j.EQ.5 .AND. k.EQ.1 ) THEN
            fltwo = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, ust(1:nsea)      &
                 , mapsf, xx )
            CALL w3s2xy ( nsea, nsea, nx, ny, ustdir(1:nsea)      &
                 , mapsf, xy )
            !
            !     Charnock parameter
            !
          ELSE IF ( j.EQ.5 .AND. k.EQ.2 ) THEN
            flone = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, charn , mapsf, x1 )
            !
            !     Mean energy flux
            !
          ELSE IF ( j.EQ.5 .AND. k.EQ.3 ) THEN
            flone = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, cge   , mapsf, x1 )
            !
            !     Air-sea energy flux
            !
          ELSE IF ( j.EQ.5 .AND. k.EQ.4 ) THEN
            flone = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, phiaw , mapsf, x1 )
            !
            !     Net supported wave stress
            !
          ELSE IF ( j.EQ.5 .AND. k.EQ.5 ) THEN
            fltwo = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, tauwix, mapsf, xx )
            CALL w3s2xy ( nsea, nsea, nx, ny, tauwiy, mapsf, xy )
            !
            !     Net supported wave stress
            !
          ELSE IF ( j.EQ.5 .AND. k.EQ.6 ) THEN
            fltwo = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, tauwnx, mapsf, xx )
            CALL w3s2xy ( nsea, nsea, nx, ny, tauwny, mapsf, xy )
            !
            !     Peakedness
            !
          ELSE IF ( j.EQ.8 .AND. k.EQ.5 ) THEN
            flone = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, qp    , mapsf, x1 )
            !
            !     Average source term time step
            !
          ELSE IF ( j.EQ.9 .AND. k.EQ.1 ) THEN
            flone = .true.
            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 ( j.EQ.9 .AND. k.EQ.2 ) THEN
            flone = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, fcut  , mapsf, x1 )
            !
            !     Max CFL step for XY propagation
            !
          ELSE IF ( j.EQ.9 .AND. k.EQ.3 ) THEN
            flone = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, cflxymax  , mapsf, x1 )
            !
            !     Max CFL step for directional propagation
            !
          ELSE IF ( j.EQ.9 .AND. k.EQ.4 ) THEN
            flone = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, cflthmax , mapsf, x1 )
            !!
            !! Not yet coded onto control file list (section 6 above)
            !
            !    Near-bottom amplitude
            !
          ELSE IF ( j.EQ.7 .AND. k.EQ.1 ) THEN
            fltwo = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, aba   , mapsf, xx )
            CALL w3s2xy ( nsea, nsea, nx, ny, abd   , mapsf, xy )
            !
            !     Near-bottom velocity
            !
          ELSE IF ( j.EQ.7 .AND. k.EQ.2 ) THEN
            fltwo = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, uba   , mapsf, xx )
            CALL w3s2xy ( nsea, nsea, nx, ny, ubd   , mapsf, xy )
            !
            !     Radiation stresses
            !
          ELSE IF ( j.EQ.6 .AND. k.EQ.1 ) THEN
            fltwo = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, sxx   , mapsf, x1 )
            CALL w3s2xy ( nsea, nsea, nx, ny, syy   , mapsf, xx )
            CALL w3s2xy ( nsea, nsea, nx, ny, sxy   , mapsf, xy )
            !
            !     User defined #1
            !
          ELSE IF ( j.EQ.10 .AND. k.EQ.1 ) THEN
            flone = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, usero(:,1)          &
                 , mapsf, x1 )
            !
            !     User defined #2
            !
          ELSE IF ( j.EQ.10 .AND. k.EQ.2 ) THEN
            flone = .true.
            CALL w3s2xy ( nsea, nsea, nx, ny, usero(:,2)          &
                 , mapsf, x1 )
            !
          ELSE
            WRITE (ndse,990) j, k
            WRITE (ndse,999)
            CALL extcde ( 1 )
            !
          END IF
          !
          ! 3   Perform output
          !
          !     3D array fields
          !
          IF ( fltri ) THEN
            WRITE (ndsdat)                                        &
                 ((x1(ix,iy),ix=ix0,ixn),iy=iy0,iyn)
            WRITE (ndsdat)                                        &
                 ((xx(ix,iy),ix=ix0,ixn),iy=iy0,iyn)
            WRITE (ndsdat)                                        &
                 ((xy(ix,iy),ix=ix0,ixn),iy=iy0,iyn)
            !
            !     Partitions parameters
            !
          ELSE IF ( flprt ) THEN
            DO i=0, noswll
              WRITE (ndsdat)                                      &
                   ((xa(ix,iy,i),ix=ix0,ixn),iy=iy0,iyn)
            END DO
            !
            !     2D array fields
            !
          ELSE IF ( fltwo ) THEN
            WRITE (ndsdat)                                        &
                 ((xx(ix,iy),ix=ix0,ixn),iy=iy0,iyn)
            WRITE (ndsdat)                                        &
                 ((xy(ix,iy),ix=ix0,ixn),iy=iy0,iyn)
            !
            !     Scalars
            !
          ELSE IF ( flone ) THEN
            WRITE (ndsdat)                                        &
                 ((x1(ix,iy),ix=ix0,ixn),iy=iy0,iyn)
          END IF
          !
          ! ... End of fields loop
          !
        END IF
      END DO
    END DO
    !
    RETURN
    !
    ! Error escape locations
    !
    ! Formats
    !
940 FORMAT (1x,i8,3i3.2,2x,4e12.4)
950 FORMAT (1x,a13,i9.8,i7.6,2(2f8.2,i4),                           &
         1x,a4,f8.4,1x,a10,2i2,1x,a11,i4)
951 FORMAT (1x,2f10.5,2i8)
    !
990 FORMAT (/' *** WAVEWATCH III ERROR IN W3EXGO :'/           &
         '     GROUP',i2,' PARAMETER',i3,' NOT LISTED '    )
999 FORMAT (/' *** WAVEWATCH III ERROR IN GXEXGO :'/                &
         '     PLEASE UPDATE FIELDS !!! '/)
    !
#ifdef W3_T
9000 FORMAT (' TEST GXEXGO : FLAGS  :',40l2)
9020 FORMAT (' TEST GXEXGO : OUTPUT FIELD : ',a)
#endif
    !/
    !/ End of GXEXGO ----------------------------------------------------- /
    !/
  END SUBROUTINE gxexgo
  !/
  !/ End of GXOUTF ----------------------------------------------------- /
  !/
END PROGRAM gxoutf