#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