WAVEWATCH III  beta 0.0.1
Functions/Subroutines
ww3_outp.F90 File Reference

Post-processing of point output. More...

Go to the source code of this file.

Functions/Subroutines

program w3outp
 Post-processing of point output. More...
 
subroutine w3expo
 Perform actual point output. More...
 

Detailed Description

Post-processing of point output.

Author
H. L. Tolman
J.H. Alves
A. Chawla
F. Ardhuin
E. Rogers
T. Campbell
Date
27-Aug-2015

Definition in file ww3_outp.F90.

Function/Subroutine Documentation

◆ w3expo()

subroutine w3outp::w3expo

Perform actual point output.

Author
H. L. Tolman
J. H. Alves
F. Ardhuin
A. Chawla
Date
06-Feb-2014

Definition at line 1045 of file ww3_outp.F90.

1045  !/
1046  !/ +-----------------------------------+
1047  !/ | WAVEWATCH III NOAA/NCEP |
1048  !/ | H. L. Tolman |
1049  !/ | J.H. Alves |
1050  !/ | F. Ardhuin |
1051  !/ | A. Chawla |
1052  !/ | FORTRAN 90 |
1053  !/ | Last update : 06-Feb-2014 |
1054  !/ +-----------------------------------+
1055  !/
1056  !/ 08-Jun-1999 : Final FORTRAN 77 ( version 1.18 )
1057  !/ 21-Jan-2000 : Upgrade to FORTRAN 90 ( version 2.00 )
1058  !/ Massive changes to logistics
1059  !/ 09-Jan-2001 : U* bug fix in tabular output ( version 2.05 )
1060  !/ 25-Jan-2001 : Flat grid version ( version 2.06 )
1061  !/ 02-Feb-2001 : Xnl version 3.0 ( version 2.07 )
1062  !/ 11-Jun-2001 : Clean up ( version 2.11 )
1063  !/ 11-Oct-2001 : Clean up, X*, Y* in tables ( version 2.14 )
1064  !/ 24-Dec-2004 : Multiple grid version. ( version 3.06 )
1065  !/ 17-Apr-2006 : Filter for directional spread. ( version 3.09 )
1066  !/ 23-Jun-2006 : Linear input added. ( version 3.09 )
1067  !/ 03-Jul-2006 : Separate flux modules. ( version 3.09 )
1068  !/ 28-Oct-2006 : Add partitioning option. ( version 3.10 )
1069  !/ 24-Mar-2007 : Add pars for entire spectrum. ( version 3.11 )
1070  !/ 25-Apr-2007 : Battjes-Janssen Sdb added. ( version 3.11 )
1071  !/ (J. H. Alves)
1072  !/ 09-Oct-2007 : WAM 4+ Sin and Sds added. ( version 3.13 )
1073  !/ (F. Ardhuin)
1074  !/ 09-Oct-2007 : Experimental Sbs (BS1) added. ( version 3.13 )
1075  !/ (F. Ardhuin)
1076  !/ 09-Apr-2008 : Adding an additional output for ( version 3.12 )
1077  !/ WMO standard (A. Chawla)
1078  !/ 29-Apr-2008 : Adjust format partition output. ( version 3.14 )
1079  !/ 01-Jul-2011 : Adding BT4 ( version 4.01 )
1080  !/ 16-Jul-2012 : Move GMD (SNL3) and nonlinear filter (SNLS)
1081  !/ from 3.15 (HLT). ( version 4.08 )
1082  !/ 26-Dec-2012 : Modified obsolete declarations. ( version 4.11 )
1083  !/ 06-Feb-2014 : Fix header format in part. files. ( version 4.18 )
1084  !/ 19-Jul-2021 : Momentum and air density support ( version 7.14 )
1085  !/
1086  ! 1. Purpose :
1087  !
1088  ! Perform actual point output.
1089  !
1090  ! 3. Parameters :
1091  !
1092  ! 4. Subroutines used :
1093  !
1094  ! Name Type Module Description
1095  ! ----------------------------------------------------------------
1096  ! W3SPRn Subr. W3SRCnMD Mean wave parameters for use in
1097  ! source terms.
1098  ! W3FLXn Subr. W3FLXnMD Flux/stress computation.
1099  ! W3SLNn Subr. W3SLNnMD Linear input.
1100  ! W3SINn Subr. W3SRCnMD Input source term.
1101  ! W3SDSn Subr. W3SRCnMD Whitecapping source term
1102  ! W3SNLn Subr. W3SNLnMD Nonlinear interactions.
1103  ! W3SBTn Subr. W3SBTnMD Bottom friction source term.
1104  ! W3SDBn Subr. W3SBTnMD Depth induced breaking source term.
1105  ! W3STRn Subr. W3STRnMD Triad interaction source term.
1106  ! W3SBSn Subr. W3SBSnMD Bottom scattering source term.
1107  ! W3PART Sunr. W3PARTMD Spectral partitioning routine.
1108  ! STRACE Subr. W3SERVMD Subroutine tracing.
1109  ! STME21 Subr. W3TIMEMD Convert time to string.
1110  ! PRT1DS Subr. W3ARRYMD Print plot of 1-D spectrum.
1111  ! PRT1DM Subr. Id. Print plot of several 1-D spectra.
1112  ! PRT2DS Subr. Id. Print plot of 2-D spectrum.
1113  ! WAVNU1 Subr. W3DISPMD Solve dispersion relation.
1114  ! ----------------------------------------------------------------
1115  !
1116  ! 5. Called by :
1117  !
1118  ! Main program in which it is contained,
1119  !
1120  ! 6. Error messages :
1121  !
1122  ! None.
1123  !
1124  ! 7. Remarks :
1125  !
1126  ! - Spectra are relative frequency energy spectra.
1127  ! - Note that arrays CX and CY of the main program now contain
1128  ! the absolute current speed and direction respectively.
1129  !
1130  ! - BT8&9 issues :
1131  !
1132  ! Q: What is the problem?
1133  ! A: Point output of Sbot with BT8 or BT9 is not presently
1134  ! supported.
1135  !
1136  ! Q: What can a user do now?
1137  ! A: When using BT8 or BT9 with ITYPE=3 , the
1138  ! user should set the 5th T/F value in ww3_outp.inp for
1139  ! ITYPE=3 to "F" like so :
1140  ! 2 1. 1. 51 T T T T F T 0 F
1141  ! $ ^ ^ ^ ^ ^ ^ Sum of selected sources
1142  ! $ | | | | ^ Wave-bottom interactions
1143  ! $ | | | ^ Dissipation
1144  ! $ | | ^ Nonlinear interactions
1145  ! $ | ^ Wind-wave interactions
1146  ! $ ^ Spectrum
1147  ! If the user really need this source function, he/she
1148  ! needs to add test output to the mud subroutine
1149  ! directly
1150  !
1151  ! Q: Why doesn't this functionality exist?
1152  ! A: The Sbot source function in ww3_outp was originally written
1153  ! with the case of BT1 in mind. BT1 uses a uniform friction
1154  ! factor, so it does not need any special variable for the
1155  ! local friction factor. BT8 and BT9 allow non-uniform mud
1156  ! variables (thickness, density, viscosity) and the mud
1157  ! subroutines are written with ww3_shel in mind, where the
1158  ! source function is calculated on the computational grid
1159  ! point IX IY.
1160 
1161  ! Q: How can we add this functionality?
1162  ! A: To fix it, we would need to :
1163  ! 1) interpolate the mud variables from the computational
1164  ! grid point IX IY to the output points (this is already
1165  ! done now for wind, for example) (the same should probably
1166  ! be done for the ice properties also) This would be done
1167  ! in w3iopomd.ftn, analogous to what is done now for the
1168  ! wind variable WAO.
1169  ! 2) manage the arrays for the new variables (mud and ice
1170  ! properties on the output points) This would be done in
1171  ! w3odatmd.ftn, again analogous to what is done now for the
1172  ! wind variable WAO.
1173  ! 3) change the mud routines so that they take the local mud
1174  ! parameters through the subroutine arguments rather than
1175  ! taking IX IY as subroutine arguments. This would allow
1176  ! flexibility to call the mud routine from ww3_shel or
1177  ! ww3_outp (instead of just ww3_shel as is the case now).
1178  !
1179  !/---------------------------------------------------------------------/
1180  !
1181  ! 8. Structure :
1182  !
1183  ! See source code.
1184  !
1185  ! 9. Switches :
1186  !
1187  ! !/S Enable subroutine tracing.
1188  ! !/T Enable test output.
1189  !
1190  ! !/FLXx Flux/stress computation.
1191  ! !/LNx Linear input package
1192  ! !/STx Source term package
1193  ! !/NLx Nonlinear interaction package
1194  ! !/BTx Bottom friction package
1195  ! !/ICx S_ice source term package
1196  ! !/DBx Depth-induced breaking package
1197  ! !/TRx Triad interaction package
1198  ! !/BSx Bottom scattering package
1199  !
1200  ! !/STAB2 Stability correction for !/ST2
1201  !
1202  ! 10. Source code :
1203  !
1204  !/ ------------------------------------------------------------------- /
1205 #ifdef W3_FLX1
1206  USE w3flx1md
1207 #endif
1208 #ifdef W3_FLX2
1209  USE w3flx2md
1210 #endif
1211 #ifdef W3_FLX3
1212  USE w3flx3md
1213 #endif
1214 #ifdef W3_FLX4
1215  USE w3flx4md
1216 #endif
1217 #ifdef W3_FLX5
1218  USE w3flx5md
1219 #endif
1220 #ifdef W3_LN1
1221  USE w3sln1md
1222 #endif
1223 #ifdef W3_ST1
1224  USE w3src1md
1225 #endif
1226 #ifdef W3_ST2
1227  USE w3src2md
1228 #endif
1229 #ifdef W3_ST3
1230  USE w3src3md
1231 #endif
1232 #ifdef W3_ST4
1233  USE w3src4md, ONLY : w3spr4, w3sin4, w3sds4
1234 #endif
1235 #ifdef W3_ST6
1236  USE w3src6md
1237  USE w3swldmd, ONLY : w3swl6
1238  USE w3gdatmd, ONLY : swl6s6
1239 #endif
1240 #ifdef W3_NL1
1241  USE w3snl1md
1242 #endif
1243 #ifdef W3_NL2
1244  USE w3snl2md
1245 #endif
1246 #ifdef W3_NL3
1247  USE w3snl3md
1248 #endif
1249 #ifdef W3_NL4
1250  USE w3snl4md
1251 #endif
1252 #ifdef W3_NLS
1253  USE w3snlsmd
1254 #endif
1255 #ifdef W3_BT1
1256  USE w3sbt1md
1257 #endif
1258 #ifdef W3_BT4
1259  USE w3sbt4md
1260 #endif
1261 #ifdef W3_BT8
1262  USE w3sbt8md
1263 #endif
1264 #ifdef W3_BT9
1265  USE w3sbt9md
1266 #endif
1267 #ifdef W3_DB1
1268  USE w3sdb1md
1269 #endif
1270 #ifdef W3_BS1
1271  USE w3sbs1md
1272 #endif
1273 #ifdef W3_IS2
1274  USE w3sis2md
1275  USE w3gdatmd, ONLY: iicedisp
1276 #endif
1277  USE w3partmd, ONLY: w3part
1278  USE w3dispmd, ONLY: wavnu1, liu_forward_dispersion
1279  !/
1280  USE w3arrymd, ONLY: prt1ds, prt2ds, prt1dm
1281  USE w3dispmd, ONLY: nar1d, dfac, n1max, ecg1, ewn1, dsie
1282  USE w3bullmd, ONLY: w3bull
1283  !/
1284  !/ ------------------------------------------------------------------- /
1285  !/ Local parameters
1286  !/
1287  INTEGER :: J, I1, I2, ISP, IKM, ITH, &
1288  IK, IH, IM, IS, IYR, IMTH, IDY, ITT, &
1289  I, NPART, IP, IX, IY, ISEA
1290  INTEGER, SAVE :: IPASS = 0
1291 #ifdef W3_S
1292  INTEGER, SAVE :: IENT = 0
1293 #endif
1294  REAL :: DEPTH, SQRTH, CDIR, SIX, R1, R2, &
1295  UDIR, UDIRR, UABS, XL, XH, XL2, XH2, &
1296  ET, EWN, ETR, ETX, ETY, EBND, EBX, &
1297  EBY, HSIG, WLEN, TMEAN, THMEAN, &
1298  THSPRD, EMAX, EL, EH, DENOM, FP, THP,&
1299  SPP, CD, USTAR, FACTOR, UNORM, ESTAR,&
1300  FPSTAR, FACF, FACE, FACS, HMAT, WNA, &
1301  XYZ, AGE1, AFR, AGE2, FACT, XSTAR, &
1302  YSTAR, FHIGH, ZWND, Z0, USTD, EMEAN, &
1303  FMEAN, WNMEAN, UDIRCA, X, Y, CHARN, &
1304  M2KM, ICEF, ICEDMAX, ICETHICK, &
1305  ICECON
1306 #ifdef W3_FLX5
1307  REAL ::TAUA, TAUADIR, RHOAIR
1308 #endif
1309 #ifdef W3_IS2
1310  REAL :: WN_R(NK),CG_ICE(NK), ALPHA_LIU(NK)
1311 #endif
1312 #ifdef W3_ST1
1313  REAL :: AMAX, FH1, FH2
1314 #endif
1315 #ifdef W3_ST2
1316  REAL :: AMAX, ALPHA(NK), FPI
1317 #endif
1318 #ifdef W3_ST3
1319  REAL :: AMAX, FMEANS, FMEANWS, TAUWX, TAUWY, &
1320  TAUWNX, TAUWNY
1321 #endif
1322 #ifdef W3_ST4
1323  REAL :: AMAX, FMEANS, FMEANWS, TAUWX, TAUWY, &
1324  TAUWNX, TAUWNY, FMEAN1, WHITECAP(1:4), DLWMEAN
1325 #endif
1326 #ifdef W3_ST6
1327  REAL :: AMAX, TAUWX, TAUWY, TAUWNX, TAUWNY
1328 #endif
1329 #ifdef W3_BS1
1330  REAL :: TAUSCX, TAUSCY
1331 #endif
1332 #ifdef W3_BT4
1333  REAL :: D50, PSIC, BEDFORM(3), TAUBBL(2)
1334 #endif
1335  REAL :: ICE
1336 #ifdef W3_STAB2
1337  REAL :: STAB0, STAB, COR1, COR2, ASFAC, &
1338  THARG1, THARG2
1339 #endif
1340  REAL, SAVE :: HSMIN = 0.05
1341  REAL :: WN(NK), CG(NK), R(NK)
1342  REAL :: E(NK,NTH), E1(NK), APM(NK), &
1343  THBND(NK), SPBND(NK), A(NTH,NK), &
1344  WN2(NTH,NK)
1345  REAL :: DIA(NTH,NK), SWN(NK,NTH), SNL(NK,NTH),&
1346  SDS(NK,NTH), SBT(NK,NTH), SIS(NK,NTH),&
1347  STT(NK,NTH), DIA2(NTH,NK)
1348  REAL :: XLN(NTH,NK), XIN(NTH,NK), XNL(NTH,NK),&
1349  XTR(NTH,NK), XDS(NTH,NK), XDB(NTH,NK),&
1350  XBT(NTH,NK), XBS(NTH,NK), XXX(NTH,NK),&
1351  XIS(NTH,NK), XWL(NTH,NK)
1352  REAL :: SIN1(NK), SNL1(NK), SDS1(NK), &
1353  SBT1(NK), STT1(NK), SIS1(NK), &
1354  E1ALL(NK,6)
1355  LOGICAL :: LBREAK
1356 #ifdef W3_ST3
1357  LOGICAL :: LLWS(NSPEC)
1358 #endif
1359 #ifdef W3_ST4
1360  LOGICAL :: LLWS(NSPEC)
1361  REAL :: LAMBDA(NSPEC)
1362 #endif
1363  CHARACTER :: DTME21*23
1364  CHARACTER(LEN=4) VAR1(6)
1365  CHARACTER(LEN=1) IDLAT, IDLON
1366  CHARACTER(LEN=100) BT8MSG
1367  !
1368  DATA var1 / 'Sin ' , 'Snl ', 'Sds ' , 'Sbt ' , 'Sice', 'Stot' /
1369  !/
1370  !/ ------------------------------------------------------------------- /
1371  !/
1372  ! 1. Initialisations
1373  !
1374 #ifdef W3_S
1375  CALL strace (ient, 'W3EXPO')
1376 #endif
1377  !
1378  IF ( flagll ) THEN
1379  m2km = 1.
1380  ELSE
1381  m2km = 1.e-3
1382  END IF
1383  !
1384  xl = 1./xfr - 1.
1385  xh = xfr - 1.
1386  xl2 = xl**2
1387  xh2 = xh**2
1388  ipass = ipass + 1
1389  !
1390  IF ( itype .EQ. 3 ) THEN
1391  xln = 0.
1392  xin = 0.
1393  xnl = 0.
1394  xtr = 0.
1395  xds = 0.
1396  xdb = 0.
1397  xbt = 0.
1398  xbs = 0.
1399  xwl = 0.
1400  xxx = 0.
1401  xis = 0.
1402  END IF
1403  !
1404 #ifdef W3_T
1405  WRITE (ndst,9000) (flreq(j),j=1,nopts)
1406  WRITE (ndst,9001) itype, otype, nreq, scale1, scale2, flsrce
1407 #endif
1408  !
1409  ! Output of time
1410  !
1411  IF ( ( itype.EQ.1 .AND. otype.EQ.3 ) .OR. &
1412  ( itype.EQ.3 .AND. otype.EQ.4 ) ) THEN
1413  IF ( flform ) THEN
1414  WRITE (ndstab) time
1415  ELSE
1416  WRITE (ndstab,900) time
1417  END IF
1418  END IF
1419  !
1420  IF (itype.EQ.2) THEN
1421  IF ( nreq.EQ.1 .AND. ipass.EQ.1 ) THEN
1422  IF ( otype.EQ.1 ) THEN
1423  WRITE (ndstab,1901)
1424  ELSE IF ( otype.EQ.2 ) THEN
1425  WRITE (ndstab,1902)
1426  ELSE IF ( otype.EQ.3 ) THEN
1427  WRITE (ndstab,1903)
1428  ELSE IF ( otype.EQ.4 ) THEN
1429  WRITE (ndstab,1904)
1430  ELSE IF ( otype.EQ.5 ) THEN
1431  WRITE (ndstab,1905)
1432  ELSE IF ( otype.EQ.6 ) THEN
1433  WRITE (ndstab,1906)
1434  END IF
1435  END IF
1436  IF ( nreq.NE.1 ) THEN
1437  CALL stme21 ( time , dtme21 )
1438  IF ( ipass .NE. 1 ) WRITE (ndstab,1910)
1439  IF ( otype.EQ.1 ) THEN
1440  IF ( flagll ) THEN
1441  WRITE (ndstab,1911) dtme21
1442  ELSE
1443  WRITE (ndstab,1711) dtme21
1444  END IF
1445  ELSE IF ( otype.EQ.2 ) THEN
1446  IF ( flagll ) THEN
1447  WRITE (ndstab,1912) dtme21
1448  ELSE
1449  WRITE (ndstab,1712) dtme21
1450  END IF
1451  ELSE IF ( otype.EQ.3 ) THEN
1452  WRITE (ndstab,1913) dtme21
1453  ELSE IF ( otype.EQ.4 ) THEN
1454  WRITE (ndstab,1914) dtme21
1455  ELSE IF ( otype.EQ.5 ) THEN
1456  IF ( flagll ) THEN
1457  WRITE (ndstab,1915) dtme21
1458  ELSE
1459  WRITE (ndstab,1715) dtme21
1460  END IF
1461  ELSE IF ( otype.EQ.6 ) THEN
1462  IF ( flagll ) THEN
1463  WRITE (ndstab,1916) dtme21
1464  ELSE
1465  WRITE (ndstab,1716) dtme21
1466  END IF
1467  END IF
1468  END IF
1469  END IF
1470  !
1471  IF (itype.EQ.3) THEN
1472  IF ( otype .EQ. 4 ) THEN
1473  CALL stme21 ( time , dtme21 )
1474  WRITE (ndso,905) dtme21
1475  END IF
1476  END IF
1477  !
1478  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1479  ! Loop over output points.
1480  !
1481  DO j=1, nopts
1482  IF ( flreq(j) ) THEN
1483  !
1484 #ifdef W3_T
1485  WRITE (ndst,9002) ptnme(j)
1486 #endif
1487  !
1488  ! 2. Calculate grid parameters using and inlined version of WAVNU1.
1489  !
1490  depth = max( dmin, dpo(j) )
1491  sqrth = sqrt( depth )
1492  udir = mod( 270. - wdo(j)*rade , 360. )
1493  udirca = wdo(j)*rade
1494  udirr = wdo(j)
1495  uabs = max( 0.001 , wao(j) )
1496 #ifdef W3_FLX5
1497  taua = max( 0.001 , tauao(j))
1498  tauadir = mod( 270. - taudo(j)*rade , 360. )
1499  rhoair = max( 0. , dairo(j))
1500 #endif
1501  cdir = mod( 270. - cdo(j)*rade , 360. )
1502 #ifdef W3_IS2
1503  icedmax = max( 0., icefo(j))
1504  icef = icedmax
1505  icethick = max(0., iceho(j))
1506  icecon = max(0., iceo(j))
1507 #endif
1508  !
1509 #ifdef W3_STAB2
1510  stab0 = zwind * grav / 273.
1511  stab = stab0 * aso(j) / max(5.,wao(j))**2
1512  stab = max( -1. , min( 1. , stab ) )
1513  tharg1 = max( 0. , ffng*(stab-ofstab))
1514  tharg2 = max( 0. , ffps*(stab-ofstab))
1515  cor1 = ccng * tanh(tharg1)
1516  cor2 = ccps * tanh(tharg2)
1517  asfac = sqrt( (1.+cor1+cor2)/shstab )
1518 #endif
1519  !
1520 #ifdef W3_T
1521  WRITE (ndst,9010) depth
1522 #endif
1523  DO ik=1, nk
1524  six = sig(ik) * sqrth
1525  i1 = int(six/dsie)
1526  IF (i1.LE.n1max) THEN
1527  i2 = i1 + 1
1528  r1 = six/dsie - real(i1)
1529  r2 = 1. - r1
1530  wn(ik) = ( r2*ewn1(i1) + r1*ewn1(i2) ) / depth
1531  cg(ik) = ( r2*ecg1(i1) + r1*ecg1(i2) ) * sqrth
1532  ELSE
1533  wn(ik) = sig(ik)*sig(ik)/grav
1534  cg(ik) = 0.5 * grav / sig(ik)
1535  END IF
1536 #ifdef W3_T
1537  WRITE (ndst,9011) ik, tpi/sig(ik), wn(ik), cg(ik)
1538 #endif
1539  !
1540  END DO
1541 
1542  !
1543  ! Computes 2nd order spectrum
1544  !
1545 #ifdef W3_IG1
1546  IF (igpars(2).EQ.1) THEN
1547  IF(igpars(1).EQ.1) THEN
1548  CALL w3addig(spco(:,j),dpo(j),wn,cg,0)
1549  ELSE
1550  CALL w3add2ndorder(spco(:,j),dpo(j),wn,cg,0)
1551  END IF
1552  END IF
1553 #endif
1554  !
1555  ! 3. Prepare spectra etc.
1556  ! 3.a Mean wave parameters.
1557  !
1558  et = 0.
1559  ewn = 0.
1560  etr = 0.
1561  etx = 0.
1562  ety = 0.
1563  DO ik=1, nk
1564  ebnd = 0.
1565  ebx = 0.
1566  eby = 0.
1567  DO ith=1, nth
1568  isp = ith + (ik-1)*nth
1569  e(ik,ith) = spco(isp,j)
1570  ebnd = ebnd + spco(isp,j)
1571  ebx = ebx + spco(isp,j)*ecos(ith)
1572  eby = eby + spco(isp,j)*esin(ith)
1573  END DO
1574  e1(ik) = ebnd * dth
1575  apm(ik)= e1(ik) / ( tpi * grav**2 / sig(ik)**5 )
1576  IF ( e1(ik) .GT. 1.e-5) THEN
1577  thbnd(ik) = mod(630.- rade*atan2(eby,ebx),360.)
1578  spbnd(ik) = rade * sqrt( max( 0. , 2.*( 1. - &
1579  sqrt( max(0.,(ebx**2+eby**2)/ebnd**2) ) ) ) )
1580  ELSE
1581  thbnd(ik) = -999.9
1582  spbnd(ik) = -999.9
1583  END IF
1584  ebnd = e1(ik) * dsii(ik) * tpiinv
1585  et = et + ebnd
1586  ewn = ewn + ebnd / wn(ik)
1587  etr = etr + ebnd / sig(ik)
1588  etx = etx + ebx * dsii(ik)
1589  ety = ety + eby * dsii(ik)
1590  END DO
1591  !
1592  ! tail factors for radian action etc ...!
1593  !
1594  ebnd = e1(nk) * tpiinv / ( sig(nk) * dth )
1595  et = et + fte *ebnd
1596  ewn = ewn + ftwl*ebnd
1597  etr = etr + fttr*ebnd
1598  etx = dth*etx*tpiinv + fte*ebx*tpiinv/sig(nk)
1599  ety = dth*ety*tpiinv + fte*eby*tpiinv/sig(nk)
1600  !
1601  hsig = 4. * sqrt( max(0.,et) )
1602  IF ( hsig .GT. hsmin ) THEN
1603  wlen = ewn / et * tpi
1604  tmean = etr / et * tpi
1605  thmean = mod( 630. - rade*atan2(ety,etx) , 360. )
1606  thsprd = rade * sqrt( max( 0. , 2.*( 1. - sqrt( &
1607  max(0.,(etx**2+ety**2)/et**2) ) ) ) )
1608  IF ( thsprd .LT. 0.01*rade*dth ) thsprd = 0.
1609  ELSE
1610  wlen = 0.
1611  tmean = 0.
1612  thmean = 0.
1613  thsprd = 0.
1614  DO ik=1, nk
1615  e1(ik) = 0.
1616  DO ith=1, nth
1617  e(ik,ith) = 0.
1618  END DO
1619  END DO
1620  END IF
1621  !
1622  ! peak frequency
1623  !
1624  emax = e1(nk)
1625  ikm = nk
1626  !
1627  DO ik=nk-1, 1, -1
1628  IF ( e1(ik) .GT. emax ) THEN
1629  emax = e1(ik)
1630  ikm = ik
1631  END IF
1632  END DO
1633 
1634  IF ( hsig .GE. hsmin .AND. ikm .NE. nk ) THEN
1635  IF ( ikm .EQ. 1 ) THEN
1636  el = - e1(ikm)
1637  ELSE
1638  el = e1(ikm-1) - e1(ikm)
1639  END IF
1640 
1641  eh = e1(ikm+1) - e1(ikm)
1642 
1643  denom = xl*eh - xh*el
1644  !
1645  fp = sig(ikm) * ( 1. + 0.5 * ( xl2*eh - xh2*el ) &
1646  / sign( max(abs(denom),1.e-15) , denom ) )
1647  thp = thbnd(ikm)
1648  spp = spbnd(ikm)
1649  IF ( spp .LT. 0.01*rade*dth ) spp = 0.
1650  ELSE
1651  fp = 0.
1652  thp = 0.
1653  spp = 0.
1654  END IF
1655  !
1656  ! spectral partitioning
1657  !
1658  IF ( itype.EQ.4 ) CALL w3part &
1659  ( e, uabs, udirca, depth, wn, npart, xpart, dimxp )
1660  !
1661  ! nondimensional parameters
1662  !
1663  IF ( ( itype.EQ.2 .AND. (otype.EQ.3.OR.otype.EQ.4) ) .OR. &
1664  ( itype.EQ.1 .AND. (otype.EQ.2) ) ) THEN
1665  !
1666  DO ik=1, nk
1667  factor = tpiinv * cg(ik) / sig(ik)
1668  DO ith=1, nth
1669  isp = ith + (ik-1)*nth
1670  a(ith,ik) = factor * spco(isp,j)
1671  wn2(ith,ik) = wn(ik)
1672  END DO
1673  END DO
1674  !
1675 #ifdef W3_STAB2
1676  uabs = uabs / asfac
1677 #endif
1678  !
1679 #ifdef W3_ST0
1680  zwnd = 10.
1681 #endif
1682 #ifdef W3_ST1
1683  zwnd = 10.
1684 #endif
1685 #ifdef W3_ST2
1686  zwnd = zwind
1687 #endif
1688 #ifdef W3_ST3
1689  zwnd = zzwnd
1690  tauwx = 0.
1691  tauwy = 0.
1692  llws(:) = .true.
1693 #endif
1694 #ifdef W3_ST4
1695  llws(:) = .true.
1696  zwnd = zzwnd
1697  tauwx = 0.
1698  tauwy = 0.
1699 #endif
1700 #ifdef W3_ST6
1701  zwnd = 10.
1702 #endif
1703  ustar = 1.
1704  !
1705 #ifdef W3_ST1
1706  CALL w3spr1 (a, cg, wn, emean, fmean, wnmean, amax)
1707  fp = 0.85 * fmean
1708 #endif
1709 #ifdef W3_ST2
1710  CALL w3spr2 (a, cg, wn, depth, fp , uabs, ustar, &
1711  emean, fmean, wnmean, amax, alpha, fp )
1712 #endif
1713 #ifdef W3_ST3
1714  CALL w3spr3 (a, cg, wn, emean, fmean, fmeans, &
1715  wnmean, amax, uabs, udirr, ustar, ustd,&
1716  tauwx, tauwy, cd, z0, charn, llws, fmeanws )
1717 #endif
1718 #ifdef W3_ST4
1719  CALL w3spr4 (a, cg, wn, emean, fmean, fmean1, &
1720  wnmean, amax, uabs, udirr, &
1721 #ifdef W3_FLX5
1722  taua, tauadir, rhoair, &
1723 #endif
1724  ustar, ustd, tauwx, tauwy, cd, z0, &
1725  charn, llws, fmeanws, dlwmean )
1726 #endif
1727 #ifdef W3_ST6
1728  CALL w3spr6 (a, cg, wn, emean, fmean, wnmean, amax, fp)
1729 #endif
1730  !
1731 #ifdef W3_FLX1
1732  CALL w3flx1 ( zwnd, uabs, udirr, &
1733  ustar, ustd, z0, cd )
1734 #endif
1735 #ifdef W3_FLX2
1736  CALL w3flx2 ( zwnd, depth, fp, uabs, udirr, &
1737  ustar, ustd, z0, cd )
1738 #endif
1739 #ifdef W3_FLX3
1740  CALL w3flx3 ( zwnd, depth, fp, uabs, udirr, &
1741  ustar, ustd, z0, cd )
1742 #endif
1743 #ifdef W3_FLX4
1744  CALL w3flx4 ( zwnd, uabs, udirr, ustar, ustd, z0, cd )
1745 #endif
1746 #ifdef W3_FLX5
1747  CALL w3flx5 ( zwnd, uabs, udirr, taua, tauadir, &
1748  rhoair, ustar, ustd, z0, cd, charn )
1749 #endif
1750  !
1751  DO itt=1, 3
1752 #ifdef W3_ST2
1753  CALL w3sin2 (a, cg, wn2, uabs, udirr, cd, z0, &
1754  fpi, xin, dia )
1755  CALL w3spr2 (a, cg, wn, depth, fpi, uabs, ustar, &
1756  emean, fmean, wnmean, amax, alpha, fp )
1757 #endif
1758 #ifdef W3_ST3
1759  ix=1
1760  iy=1
1761  CALL w3sin3 ( a, cg, wn2, uabs, ustar, dair/dwat,&
1762  aso(j), udirr, z0, cd, tauwx, tauwy,&
1763  tauwnx, tauwny, ice, xin, dia, llws, ix, iy )
1764  CALL w3spr3 (a, cg, wn, emean, fmean, fmeans, &
1765  wnmean, amax, uabs, udirr, ustar, ustd,&
1766  tauwx, tauwy, cd, z0, charn, llws, fmeanws )
1767 #endif
1768 #ifdef W3_ST4
1769  ix=1
1770  iy=1
1771  CALL w3sin4 ( a, cg, wn2, uabs, ustar, dair/dwat,&
1772  aso(j), udirr, z0, cd, tauwx, tauwy,&
1773  tauwnx, tauwny, xin, dia, llws, ix, iy, lambda )
1774  CALL w3spr4 (a, cg, wn, emean, fmean, fmean1, &
1775  wnmean, amax, uabs, udirr, &
1776 #ifdef W3_FLX5
1777  taua, tauadir, rhoair, &
1778 #endif
1779  ustar, ustd, tauwx, tauwy, cd, z0, &
1780  charn, llws, fmeanws, dlwmean )
1781 #endif
1782 #ifdef W3_FLX2
1783  CALL w3flx2 ( zwnd, depth, fp, uabs, udirr, &
1784  ustar, ustd, z0, cd )
1785 #endif
1786 #ifdef W3_FLX3
1787  CALL w3flx3 ( zwnd, depth, fp, uabs, udirr, &
1788  ustar, ustd, z0, cd )
1789 #endif
1790  END DO
1791  !
1792  ! Add alternative flux calculations here as part of !/ST2 option ....
1793  ! Also add before actual source term calculation !!!
1794  !
1795 #ifdef W3_STAB2
1796  uabs = uabs * asfac
1797 #endif
1798  !
1799  IF ( wao(j) .LT. 0.01 ) THEN
1800  unorm = 0.
1801  estar = 0.
1802  fpstar = 0.
1803  ELSE
1804  IF ( otype.EQ.3 ) THEN
1805  unorm = ustar
1806  ELSE
1807  unorm = wao(j)
1808  END IF
1809  estar = et * grav**2 / unorm**4
1810  fpstar = fp * tpiinv * unorm / grav
1811  xstar = ptloc(1,j) * grav / unorm**2
1812  ystar = ptloc(2,j) * grav / unorm**2
1813  IF ( flagll ) THEN
1814  xstar = xstar * dera * radius &
1815  * cos(ptloc(2,j)*dera)
1816  ystar = ystar * dera * radius
1817  END IF
1818  END IF
1819  !
1820  END IF
1821  !
1822  ! 3.4 source terms
1823  !
1824  IF ( itype.EQ.3 ) THEN
1825  !
1826  DO ik=1, nk
1827  factor = tpiinv * cg(ik) / sig(ik)
1828  DO ith=1, nth
1829  a(ith,ik) = factor * spco(ith+(ik-1)*nth,j)
1830  wn2(ith,ik) = wn(ik)
1831  END DO
1832  END DO
1833  !
1834 #ifdef W3_STAB2
1835  uabs = uabs / asfac
1836 #endif
1837  !
1838 #ifdef W3_ST0
1839  zwnd = 10.
1840 #endif
1841 #ifdef W3_ST1
1842  zwnd = 10.
1843 #endif
1844 #ifdef W3_ST2
1845  zwnd = zwind
1846 #endif
1847 #ifdef W3_ST3
1848  zwnd = zzwnd
1849 #endif
1850 #ifdef W3_ST0
1851  ustar = 1.
1852 #endif
1853 #ifdef W3_ST1
1854  ustar = 1.
1855 #endif
1856 #ifdef W3_ST2
1857  ustar = 1.
1858 #endif
1859 #ifdef W3_ST3
1860  ustar = 0.
1861  ustd = 0.
1862  tauwx = 0.
1863  tauwy = 0.
1864 #endif
1865 #ifdef W3_ST4
1866  zwnd = zzwnd
1867  ustar = 0.
1868  ustd = 0.
1869  tauwx = 0.
1870  tauwy = 0.
1871 #endif
1872 #ifdef W3_ST6
1873  zwnd = 10.
1874 #endif
1875  !
1876 #ifdef W3_ST0
1877  fhigh = sig(nk)
1878 #endif
1879 #ifdef W3_ST1
1880  CALL w3spr1 (a, cg, wn, emean, fmean, wnmean, amax)
1881  fp = 0.85 * fmean
1882  fh1 = fxfm * fmean
1883  fh2 = fxpm / ustar
1884  fhigh = max( fh1 , fh2 )
1885 #endif
1886 #ifdef W3_ST2
1887  CALL w3spr2 (a, cg, wn, depth, fp , uabs, ustar, &
1888  emean, fmean, wnmean, amax, alpha, fp )
1889 #endif
1890 #ifdef W3_ST3
1891  CALL w3spr3 (a, cg, wn, emean, fmean, fmeans, &
1892  wnmean, amax, uabs, udirr, ustar, ustd,&
1893  tauwx, tauwy, cd, z0, charn, llws, fmeanws )
1894 #endif
1895 #ifdef W3_ST4
1896  CALL w3spr4 (a, cg, wn, emean, fmean, fmean1, &
1897  wnmean, amax, uabs, udirr, &
1898 #ifdef W3_FLX5
1899  taua, tauadir, rhoair, &
1900 #endif
1901  ustar, ustd, tauwx, tauwy, cd, z0, &
1902  charn, llws, fmeanws, dlwmean )
1903 #endif
1904 #ifdef W3_ST6
1905  CALL w3spr6 (a, cg, wn, emean, fmean, wnmean, amax, fp)
1906  fhigh = sig(nk)
1907 #endif
1908  !
1909 #ifdef W3_FLX1
1910  CALL w3flx1 ( zwnd, uabs, udirr, &
1911  ustar, ustd, z0, cd )
1912 #endif
1913 #ifdef W3_FLX2
1914  CALL w3flx2 ( zwnd, depth, fp, uabs, udirr, &
1915  ustar, ustd, z0, cd )
1916 #endif
1917 #ifdef W3_FLX3
1918  CALL w3flx3 ( zwnd, depth, fp, uabs, udirr, &
1919  ustar, ustd, z0, cd )
1920 #endif
1921 #ifdef W3_FLX4
1922  CALL w3flx4 ( zwnd, uabs, udirr, ustar, ustd, z0, cd )
1923 #endif
1924 #ifdef W3_FLX5
1925  CALL w3flx5 ( zwnd, uabs, udirr, taua, tauadir, &
1926  rhoair, ustar, ustd, z0, cd, charn )
1927 #endif
1928  !
1929  DO itt=1, 3
1930 #ifdef W3_ST2
1931  CALL w3sin2 (a, cg, wn2, uabs, udirr, cd, z0, &
1932  fpi, xin, dia )
1933  CALL w3spr2 (a, cg, wn, depth, fpi, uabs, ustar, &
1934  emean, fmean, wnmean, amax, alpha, fp )
1935 #endif
1936 #ifdef W3_ST3
1937  CALL w3spr3 (a, cg, wn, emean, fmean, fmeans, &
1938  wnmean, amax, uabs, udirr, ustar, ustd,&
1939  tauwx, tauwy, cd, z0, charn, llws, fmeanws )
1940  CALL w3sin3 ( a, cg, wn2, uabs, ustar, dair/dwat,&
1941  aso(j), udirr, z0, cd,tauwx, tauwy, &
1942  tauwnx, tauwny, ice, xin, dia, llws, ix, iy )
1943 #endif
1944 #ifdef W3_ST4
1945  CALL w3spr4 (a, cg, wn, emean, fmean, fmean1, &
1946  wnmean, amax, uabs, udirr, &
1947 #ifdef W3_FLX5
1948  taua, tauadir, rhoair, &
1949 #endif
1950  ustar, ustd, tauwx, tauwy, cd, z0, &
1951  charn, llws, fmeanws, dlwmean )
1952  CALL w3sin4 ( a, cg, wn2, uabs, ustar, dair/dwat,&
1953  aso(j), udirr, z0, cd,tauwx, tauwy, &
1954  tauwnx, tauwny, xin, dia, llws, ix, iy, lambda )
1955 #endif
1956 #ifdef W3_FLX2
1957  CALL w3flx2 ( zwnd, depth, fp, uabs, udirr, &
1958  ustar, ustd, z0, cd )
1959 #endif
1960 #ifdef W3_FLX3
1961  CALL w3flx3 ( zwnd, depth, fp, uabs, udirr, &
1962  ustar, ustd, z0, cd )
1963 #endif
1964  END DO
1965  !
1966 #ifdef W3_ST2
1967  fhigh = xfc * fpi
1968 #endif
1969  !
1970  IF ( flsrce(2) ) THEN
1971 #ifdef W3_LN1
1972  CALL w3sln1 (wn, fhigh, ustar, udirr, xln )
1973 #endif
1974  !
1975 #ifdef W3_ST1
1976  CALL w3sin1 (a, wn2, ustar, udirr, xin, dia )
1977 #endif
1978 #ifdef W3_ST2
1979  CALL w3sin2 (a, cg, wn2, uabs, udirr, cd, z0,&
1980  fpi, xin, dia )
1981 #endif
1982 #ifdef W3_ST3
1983  CALL w3sin3 ( a, cg, wn2, uabs, ustar, &
1984  dair/dwat, aso(j), udirr, &
1985  z0, cd, tauwx, tauwy,tauwnx, tauwny, &
1986  ice, xin, dia, llws, ix, iy )
1987 #endif
1988 #ifdef W3_ST4
1989  CALL w3sin4 ( a, cg, wn2, uabs, ustar, &
1990  dair/dwat, aso(j), udirr, &
1991  z0, cd, tauwx, tauwy,tauwnx, tauwny, &
1992  xin, dia, llws, ix, iy, lambda )
1993 #endif
1994 #ifdef W3_ST6
1995  CALL w3sin6 (a, cg, wn2, uabs, ustar, udirr, cd, dair, &
1996  tauwx, tauwy, tauwnx, tauwny, xin, dia )
1997 #endif
1998  END IF
1999  IF ( flsrce(3) ) THEN
2000 #ifdef W3_NL1
2001  IF (iqtpe.GT.0) THEN
2002  CALL w3snl1 ( a, cg, wnmean*depth, xnl, dia )
2003  ELSE
2004  CALL w3snlgqm ( a, cg, wn, depth, xnl, dia )
2005  END IF
2006 #endif
2007 #ifdef W3_NL2
2008  CALL w3snl2 ( a, cg, depth, xnl, dia )
2009 #endif
2010 #ifdef W3_NL3
2011  CALL w3snl3 ( a, cg, wn, depth, xnl, dia )
2012 #endif
2013 #ifdef W3_NL4
2014  CALL w3snl4 ( a, cg, wn, depth, xnl, dia )
2015 #endif
2016  END IF
2017  IF ( flsrce(4) ) THEN
2018 #ifdef W3_ST1
2019  CALL w3sds1 ( a, wn2, emean, fmean, wnmean, &
2020  xds, dia )
2021 #endif
2022 #ifdef W3_ST2
2023  CALL w3sds2 ( a, cg, wn, fpi, ustar, &
2024  alpha, xds, dia )
2025 #endif
2026 #ifdef W3_ST3
2027  CALL w3sds3 ( a, wn, cg, emean, fmeans, wnmean, &
2028  ustar, ustd, depth, xds, dia, ix, iy )
2029 #endif
2030 #ifdef W3_ST4
2031  CALL w3sds4 ( a, wn, cg, ustar, ustd, depth, dair, xds, &
2032  dia, ix, iy, lambda, whitecap, dlwmean )
2033 #endif
2034 #ifdef W3_ST6
2035  CALL w3sds6 ( a, cg, wn, xds, dia )
2036  IF (swl6s6) CALL w3swl6 ( a, cg, wn, xwl, dia )
2037 #endif
2038  !
2039 #ifdef W3_DB1
2040  CALL w3sdb1 ( i, a, depth, emean, fmean, &
2041  wnmean, cg, lbreak, xdb, dia )
2042 #endif
2043  END IF
2044  IF ( flsrce(5) ) THEN
2045 #ifdef W3_BT1
2046  CALL w3sbt1 ( a, cg, wn, depth, xbt, dia )
2047 #endif
2048 #ifdef W3_BT4
2049  ix=1 ! to be fixed later
2050  iy=1 ! to be fixed later
2051  isea=1 ! to be fixed later
2052  d50 = sed_d50(isea)
2053  psic= sed_psic(isea)
2054 #endif
2055 
2056 #ifdef W3_BT4
2057  CALL w3sbt4 ( a, cg, wn, depth, d50, psic, taubbl, &
2058  bedform, xbt, dia, ix, iy )
2059 #endif
2060 
2061  bt8msg='ww3_outp: ITYPE=3 with BT8 or BT9: Sbot out'//&
2062  'put is not yet supported. Use "F" for the 5'//&
2063  'th T/F flag.'
2064 #ifdef W3_BT8
2065  CALL extcde( 516,msg=bt8msg)
2066 #endif
2067 #ifdef W3_BT9
2068  CALL extcde( 516,msg=bt8msg)
2069 #endif
2070 
2071  ! For info on this issue, see : "BT8&9 issues" in "Remarks" section above.
2072 
2073  !...broken....!/BT8 CALL W3SBT8 ( A, DEPTH, XBT, DIA, IX, IY )
2074  !...broken....!/BT9 CALL W3SBT9 ( A, DEPTH, XBT, DIA, IX, IY )
2075 
2076 
2077  !
2078 #ifdef W3_BS1
2079  CALL w3sbs1 ( a, cg, wn, depth, &
2080  cao(j)*cos(cdo(j)), cao(j)*sin(cdo(j)), &
2081  tauscx, tauscy, xbs, dia )
2082 #endif
2083  END IF
2084  !
2085  IF ( flsrce(6) ) THEN
2086 #ifdef W3_IS2
2087  IF (iicedisp) THEN
2088  CALL liu_forward_dispersion (icethick,0.,depth, &
2089  sig,wn_r,cg_ice,alpha_liu)
2090  ELSE
2091  wn_r=wn
2092  cg_ice=cg
2093  END IF
2094 #endif
2095  !
2096 #ifdef W3_IS2
2097  CALL w3sis2(a, depth, icecon, icethick, icef, icedmax, &
2098  ix, iy, xis, dia, dia2, wn, cg, wn_r, cg_ice, r)
2099 #endif
2100  END IF
2101  !
2102 #ifdef W3_STAB2
2103  uabs = uabs * asfac
2104 #endif
2105  !
2106  IF ( iscale.EQ.0 .OR. iscale.EQ.3 ) THEN
2107  facf = tpiinv
2108  face = 1.
2109  facs = 1.
2110  ELSE IF ( iscale.EQ.1 .OR. iscale.EQ.4 ) THEN
2111  facf = tpiinv * uabs / grav
2112  face = grav**3 / uabs**5
2113  facs = grav**2 / uabs**4
2114  ELSE IF ( iscale.EQ.2 .OR. iscale.EQ.5 ) THEN
2115  facf = tpiinv * ustar / grav
2116  face = grav**3 / ustar**5
2117  facs = grav**2 / ustar**4
2118  END IF
2119  !
2120  DO ik=1, nk
2121  factor = tpi / cg(ik) * sig(ik)
2122  e1(ik) = 0.
2123  sin1(ik) = 0.
2124  snl1(ik) = 0.
2125  sds1(ik) = 0.
2126  sbt1(ik) = 0.
2127  stt1(ik) = 0.
2128  sis1(ik) = 0.
2129  DO ith=1, nth
2130  isp = ith + (ik-1)*nth
2131  e(ik,ith) = spco(isp,j)
2132  swn(ik,ith) = ( xln(ith,ik) + xin(ith,ik) ) * factor
2133  snl(ik,ith) = ( xnl(ith,ik) + xtr(ith,ik) ) * factor
2134  sds(ik,ith) = ( xds(ith,ik) + xdb(ith,ik) ) * factor
2135 #ifdef W3_ST6
2136  sds(ik,ith) = sds(ik,ith) +(xwl(ith,ik) * factor)
2137 #endif
2138  sbt(ik,ith) = ( xbt(ith,ik) * xbs(ith,ik) ) * factor
2139  sis(ik,ith) = xis(ith,ik) * factor
2140  stt(ik,ith) = swn(ik,ith) + snl(ik,ith)+sds(ik,ith)&
2141  + sbt(ik,ith) + sis(ik,ith) &
2142  + xxx(ith,ik) * factor
2143  e1(ik) = e1(ik) + e(ik,ith)
2144  sin1(ik) = sin1(ik) + swn(ik,ith)
2145  snl1(ik) = snl1(ik) + snl(ik,ith)
2146  sds1(ik) = sds1(ik) + sds(ik,ith)
2147  sbt1(ik) = sbt1(ik) + sbt(ik,ith)
2148  sis1(ik) = sis1(ik) + sis(ik,ith)
2149  END DO
2150  e1(ik) = e1(ik) * dth * face
2151  sin1(ik) = sin1(ik) * dth * facs
2152  snl1(ik) = snl1(ik) * dth * facs
2153  sds1(ik) = sds1(ik) * dth * facs
2154  sbt1(ik) = sbt1(ik) * dth * facs
2155  sis1(ik) = sis1(ik) * dth * facs
2156  END DO
2157  !
2158  stt1 = sin1 + snl1 + sds1 + sbt1 + sis1
2159  e1all(:,1) = sin1
2160  e1all(:,2) = snl1
2161  e1all(:,3) = sds1
2162  e1all(:,4) = sbt1
2163  e1all(:,5) = sis1
2164  e1all(:,6) = stt1
2165  !
2166  END IF
2167  !
2168  ! 4.a Perform output type 1 ( print plots / tables / file )
2169  !
2170  IF ( itype .EQ. 1 ) THEN
2171  !
2172  IF ( otype .EQ. 1 ) THEN
2173  !
2174  IF ( scale1 .GE. 0. ) &
2175  CALL prt1ds (ndso, nk, e1, sig(1:nk), 'RAD/S',&
2176  17, scale1, 'E(f)', 'm^2s', ptnme(j) )
2177  IF ( scale2 .GE. 0. ) &
2178  CALL prt2ds (ndso, nk, nk, nth, e, sig(1:nk), &
2179  'RAD/S', 1., scale2, 0.0001, 'E(f,th)', &
2180  'm^2s', ptnme(j) )
2181  WRITE (ndso,910) dpo(j), uabs
2182  IF ( wao(j) .GT. 0. ) WRITE (ndso,911) udir
2183  WRITE (ndso,912) aso(j), cao(j)
2184  IF ( cao(j) .GT. 0. ) WRITE (ndso,913) cdir
2185  WRITE (ndso,914) hsig, wlen, tmean, thmean, thsprd
2186  !
2187  ELSE IF ( otype .EQ. 2 ) THEN
2188  !
2189  CALL stme21 ( time , dtme21 )
2190  IF ( flagll ) THEN
2191  WRITE (ndstab,920) dtme21, ptnme(j), &
2192  m2km*ptloc(1,j), m2km*ptloc(2,j), &
2193  dpo(j), ustar, wao(j), udir
2194  ELSE
2195  WRITE (ndstab,720) dtme21, ptnme(j), &
2196  m2km*ptloc(1,j), m2km*ptloc(2,j), &
2197  dpo(j), ustar, wao(j), udir
2198  END IF
2199  IF ( fp .EQ. 0. ) fp = sig(nk)
2200  DO ik=1, nk
2201  WRITE (ndstab,921) tpiinv*sig(ik), sig(ik)/fp, &
2202  e1(ik), thbnd(ik), spbnd(ik), apm(ik)
2203  END DO
2204  IF ( fp .EQ. sig(nk) ) fp = 0.
2205  WRITE (ndstab,922)
2206  !
2207  ELSE IF ( otype .EQ. 3 ) THEN
2208  !
2209  IF ( flform ) THEN
2210  WRITE (ndstab) ptnme(j), ptloc(2,j), &
2211  ptloc(1,j), dpo(j), wao(j), &
2212  udir, cao(j), cdir
2213  WRITE (ndstab) ((e(ik,ith),ik=1,nk),ith=1,nth)
2214  ELSE
2215  WRITE (ndstab,901) ptnme(j), m2km*ptloc(2,j), &
2216  m2km*ptloc(1,j), dpo(j), &
2217  wao(j), udir, cao(j), cdir
2218  WRITE (ndstab,902) &
2219  ((e(ik,ith),ik=1,nk),ith=1,nth)
2220  END IF
2221  !
2222  END IF
2223  !
2224  ! 4.b Perform output type 2 ( tables )
2225  !
2226  ELSE IF ( itype .EQ. 2 ) THEN
2227  !
2228  IF ( nreq .EQ. 1 ) THEN
2229  !
2230  iyr = time(1) / 10000
2231  imth = mod( time(1) , 10000 ) / 100
2232  idy = mod( time(1) , 100 )
2233  ih = time(2) / 10000
2234  im = mod( time(2) , 10000 ) / 100
2235  is = mod( time(2) , 100 )
2236  IF ( otype .EQ. 1 ) THEN
2237  WRITE (ndstab,1921) time(1), ih, im, is, &
2238  dpo(j), cao(j), cdir, wao(j), udir
2239  ELSE IF ( otype .EQ. 2 ) THEN
2240  WRITE (ndstab,1922) time(1), ih, im, is, &
2241  hsig, wlen, tmean, thmean, thsprd, &
2242  fp*tpiinv, thp, spp
2243  ELSE IF ( otype.EQ.3 ) THEN
2244  WRITE (ndstab,1923) time(1), ih, im, is, &
2245  unorm, estar, fpstar, cd*1000., apm(nk)*100.
2246  ELSE IF ( otype.EQ.4 ) THEN
2247  WRITE (ndstab,1924) time(1), ih, im, is, &
2248  unorm, estar, fpstar, cd*1000., apm(nk)*100.
2249  ELSE IF ( otype.EQ.5 ) THEN
2250  hmat = min( 100. , 3.33*grav*hsig/uabs**2 )
2251  IF ( hsig .GE. hsmin ) THEN
2252  CALL wavnu1 ( fp, dpo(j), wna, xyz )
2253  age1 = min( 100. , fp / wna / uabs )
2254  afr = tpi / tmean
2255  CALL wavnu1 ( afr, dpo(j), wna, xyz )
2256  age2 = min( 100. , afr / wna / uabs )
2257  ELSE
2258  age1 = -9.99
2259  age2 = -9.99
2260  END IF
2261  WRITE (ndstab,1925) time(1), ih, im, is, &
2262  wao(j), udir, hsig, hmat, age1, age2, &
2263  aso(j)
2264  ELSE IF ( otype.EQ.6 ) THEN
2265  IF ( hsig .GE. hsmin ) THEN
2266  WRITE (ndstab,1926) iyr, imth, idy, ih, &
2267  wao(j), nint(udir), hsig, tpi / fp
2268  ELSE
2269  WRITE (ndstab,1926) iyr, imth, idy, ih, &
2270  wao(j), nint(udir), hsig, 0.0
2271  END IF
2272  END IF
2273  !
2274  ELSE
2275  !
2276  IF ( otype .EQ. 1 ) THEN
2277  IF ( flagll ) THEN
2278  WRITE (ndstab,1931) m2km*ptloc(1,j), &
2279  m2km*ptloc(2,j), dpo(j), cao(j), &
2280  cdir, wao(j), udir
2281  ELSE
2282  WRITE (ndstab,1731) m2km*ptloc(1,j), &
2283  m2km*ptloc(2,j), dpo(j), cao(j), &
2284  cdir, wao(j), udir
2285  END IF
2286  ELSE IF ( otype .EQ. 2 ) THEN
2287  IF ( flagll ) THEN
2288  WRITE (ndstab,1932) m2km*ptloc(1,j), &
2289  m2km*ptloc(2,j), hsig, wlen, &
2290  tmean, thmean, thsprd, fp*tpiinv, &
2291  thp, spp
2292  ELSE
2293  WRITE (ndstab,1732) m2km*ptloc(1,j), &
2294  m2km*ptloc(2,j), hsig, wlen, &
2295  tmean, thmean, thsprd, fp*tpiinv, &
2296  thp, spp
2297  END IF
2298  ELSE IF ( otype .EQ. 3 ) THEN
2299  WRITE (ndstab,1933) 1.e-4*xstar, &
2300  1.e-4*ystar, unorm, estar, fpstar, &
2301  cd*1000., apm(nk)*100.
2302  ELSE IF ( otype .EQ. 4 ) THEN
2303  WRITE (ndstab,1934) xstar, ystar, unorm, &
2304  estar, fpstar, cd*1000., apm(nk)*100.
2305  ELSE IF ( otype .EQ. 5 ) THEN
2306  hmat = min( 100. , 3.33*grav*hsig/uabs**2 )
2307  CALL wavnu1 ( fp, dpo(j), wna, xyz )
2308  age1 = min( 100. , fp / wna / uabs )
2309  afr = tpi / tmean
2310  CALL wavnu1 ( afr, dpo(j), wna, xyz )
2311  age2 = min( 100. , afr / wna / uabs )
2312  IF ( flagll ) THEN
2313  WRITE (ndstab,1935) m2km*ptloc(1,j), &
2314  m2km*ptloc(2,j), wao(j), udir, &
2315  hsig, hmat, age1, age2, aso(j)
2316  ELSE
2317  WRITE (ndstab,1735) m2km*ptloc(1,j), &
2318  m2km*ptloc(2,j), wao(j), udir, &
2319  hsig, hmat, age1, age2, aso(j)
2320  END IF
2321  ELSE IF ( otype .EQ. 6 ) THEN
2322  IF ( hsig .GE. hsmin ) THEN
2323  IF ( flagll ) THEN
2324  WRITE (ndstab,1936) m2km*ptloc(1,j), &
2325  m2km*ptloc(2,j), wao(j), nint(udir),&
2326  hsig, tpi / fp
2327  ELSE
2328  WRITE (ndstab,1736) m2km*ptloc(1,j), &
2329  m2km*ptloc(2,j), wao(j), nint(udir),&
2330  hsig, tpi / fp
2331  END IF
2332  ELSE
2333  IF ( flagll ) THEN
2334  WRITE (ndstab,1936) m2km*ptloc(1,j), &
2335  m2km*ptloc(2,j), wao(j), nint(udir),&
2336  hsig, 0.0
2337  ELSE
2338  WRITE (ndstab,1736) m2km*ptloc(1,j), &
2339  m2km*ptloc(2,j), wao(j), nint(udir),&
2340  hsig, 0.0
2341  END IF
2342  END IF
2343  END IF
2344  !
2345  END IF
2346  !
2347  ! 4.c Perform output type 3 ( source terms )
2348  !
2349  ELSE IF ( itype .EQ. 3 ) THEN
2350  !
2351  IF ( otype .EQ. 1 ) THEN
2352  !
2353  IF ( scale1 .GE. 0. ) THEN
2354  IF ( flsrce(1) ) &
2355  CALL prt1ds (ndso, nk, e1, sig(1:nk), &
2356  'RAD/S', 17, 0., 'E(f)', 'm^2s', &
2357  ptnme(j) )
2358  IF (flsrce(2) .OR. flsrce(3) .OR. &
2359  flsrce(4) .OR. flsrce(5) .OR. &
2360  flsrce(6) .OR. flsrce(7) ) &
2361  CALL prt1dm (ndso, nk, 6, e1all, sig(1:nk),&
2362  'RAD/S', 17, scale1, var1, 'M2', &
2363  ptnme(j) )
2364  END IF
2365  IF ( scale2 .GE. 0. ) THEN
2366  IF ( flsrce(1) ) &
2367  CALL prt2ds (ndso, nk, nk, nth, e, &
2368  sig(1:nk), 'RAD/S', 1., 0., 0.0001, &
2369  'E(f,th)', 'm^2s', ptnme(j) )
2370  IF ( flsrce(2) ) &
2371  CALL prt2ds (ndso, nk, nk, nth, swn, &
2372  sig(1:nk), 'RAD/S', 1., scale2, 0.0001,&
2373  'Sin(f,th)', 'm^2', ptnme(j) )
2374  IF ( flsrce(3) ) &
2375  CALL prt2ds (ndso, nk, nk, nth, snl, &
2376  sig(1:nk), 'RAD/S', 1., scale2, 0.0001,&
2377  'Snl(f,th)', 'm^2', ptnme(j) )
2378  IF ( flsrce(4) ) &
2379  CALL prt2ds (ndso, nk, nk, nth, sds, &
2380  sig(1:nk), 'RAD/S', 1., scale2, 0.0001,&
2381  'Sds(f,th)', 'm^2', ptnme(j) )
2382  IF ( flsrce(5) ) &
2383  CALL prt2ds (ndso, nk, nk, nth, sbt, &
2384  sig(1:nk), 'RAD/S', 1., scale2, 0.0001,&
2385  'Sbt(f,th)', 'm^2', ptnme(j) )
2386  IF ( flsrce(6) ) &
2387  CALL prt2ds (ndso, nk, nk, nth, sis, &
2388  sig(1:nk), 'RAD/S', 1., scale2, 0.0001,&
2389  'Sice(f,th)', 'm^2', ptnme(j) )
2390  IF ( flsrce(7) ) &
2391  CALL prt2ds (ndso, nk, nk, nth, stt, &
2392  sig(1:nk), 'RAD/S', 1., scale2, 0.0001,&
2393  'Stot(f,th)', 'm^2', ptnme(j) )
2394  END IF
2395  !
2396  ELSE IF ( otype .EQ. 2 ) THEN
2397  !
2398  CALL stme21 ( time , dtme21 )
2399  IF ( flagll ) THEN
2400  WRITE (ndstab,2920) dtme21, ptnme(j), &
2401  m2km*ptloc(1,j), m2km*ptloc(2,j), &
2402  dpo(j), ustar, wao(j)
2403  ELSE
2404  WRITE (ndstab,2720) dtme21, ptnme(j), &
2405  m2km*ptloc(1,j), m2km*ptloc(2,j), &
2406  dpo(j), ustar, wao(j)
2407  END IF
2408  IF ( iscale.EQ.0 ) THEN
2409  WRITE (ndstab,2921)
2410  ELSE IF ( iscale.EQ.1 .OR. iscale.EQ.2 ) THEN
2411  WRITE (ndstab,2922)
2412  ELSE IF ( iscale.EQ.3 ) THEN
2413  WRITE (ndstab,2923)
2414  ELSE IF ( iscale.EQ.4 .OR. iscale.EQ.5 ) THEN
2415  WRITE (ndstab,2924)
2416  END IF
2417  IF ( iscale.GE.3 ) facf = 1. / fp
2418  DO ik=1, nk
2419  WRITE (ndstab,2930) facf*sig(ik), e1(ik), &
2420  sin1(ik), snl1(ik), sds1(ik), sbt1(ik), &
2421  sis1(ik), stt1(ik)
2422 
2423  END DO
2424  WRITE (ndstab,2940)
2425  !
2426  ELSE IF ( otype .EQ. 3 ) THEN
2427  !
2428  CALL stme21 ( time , dtme21 )
2429  IF ( flagll ) THEN
2430  WRITE (ndstab,2920) dtme21, ptnme(j), &
2431  m2km*ptloc(1,j), m2km*ptloc(2,j), &
2432  dpo(j), ustar, wao(j)
2433  ELSE
2434  WRITE (ndstab,2720) dtme21, ptnme(j), &
2435  m2km*ptloc(1,j), m2km*ptloc(2,j), &
2436  dpo(j), ustar, wao(j)
2437  END IF
2438  IF ( iscale.EQ.0 ) THEN
2439  WRITE (ndstab,2925)
2440  ELSE IF ( iscale.EQ.1 .OR. iscale.EQ.2 ) THEN
2441  WRITE (ndstab,2926)
2442  ELSE IF ( iscale.EQ.3 ) THEN
2443  WRITE (ndstab,2927)
2444  ELSE IF ( iscale.EQ.4 .OR. iscale.EQ.5 ) THEN
2445  WRITE (ndstab,2928)
2446  END IF
2447  !
2448  IF ( iscale.GE.3 ) facf = 1. / fp
2449  DO ik=1, nk
2450  fact = 1. / max( 1.e-10 , e1(ik) )
2451  IF ( e1(ik) .GT. 1.e-10 ) THEN
2452  WRITE (ndstab,2931) facf*sig(ik), e1(ik), &
2453  fact*sin1(ik), fact*snl1(ik), &
2454  fact*sds1(ik), fact*sbt1(ik), &
2455  fact*sis1(ik),fact*stt1(ik)
2456  ELSE
2457  WRITE (ndstab,2931) facf*sig(ik), e1(ik)
2458  END IF
2459  END DO
2460  WRITE (ndstab,2940)
2461  !
2462  ELSE IF ( otype .EQ. 4 ) THEN
2463  !
2464  IF ( flform ) THEN
2465  WRITE (ndstab) ptnme(j), ptloc(2,j), &
2466  ptloc(1,j), dpo(j), wao(j), &
2467  udir, cao(j), cdir
2468  IF ( flsrce(1) ) WRITE (ndstab) &
2469  ((e(ik,ith),ik=1,nk),ith=1,nth)
2470  IF ( flsrce(2) ) WRITE (ndstab) &
2471  ((swn(ik,ith),ik=1,nk),ith=1,nth)
2472  IF ( flsrce(3) ) WRITE (ndstab) &
2473  ((snl(ik,ith),ik=1,nk),ith=1,nth)
2474  IF ( flsrce(4) ) WRITE (ndstab) &
2475  ((sds(ik,ith),ik=1,nk),ith=1,nth)
2476  IF ( flsrce(5) ) WRITE (ndstab) &
2477  ((sbt(ik,ith),ik=1,nk),ith=1,nth)
2478  IF ( flsrce(6) ) WRITE (ndstab) &
2479  ((sis(ik,ith),ik=1,nk),ith=1,nth)
2480  IF ( flsrce(7) ) WRITE (ndstab) &
2481  ((stt(ik,ith),ik=1,nk),ith=1,nth)
2482  ELSE
2483  IF ( flagll ) THEN
2484  WRITE (ndstab,901) ptnme(j), &
2485  m2km*ptloc(2,j), m2km*ptloc(1,j), &
2486  dpo(j), wao(j), udir, cao(j), cdir
2487  ELSE
2488  WRITE (ndstab,701) ptnme(j), &
2489  m2km*ptloc(2,j), m2km*ptloc(1,j), &
2490  dpo(j), wao(j), udir, cao(j), cdir
2491  END IF
2492  IF ( flsrce(1) ) WRITE (ndstab,902) &
2493  ((e(ik,ith),ik=1,nk),ith=1,nth)
2494  IF ( flsrce(2) ) WRITE (ndstab,902) &
2495  ((swn(ik,ith),ik=1,nk),ith=1,nth)
2496  IF ( flsrce(3) ) WRITE (ndstab,902) &
2497  ((snl(ik,ith),ik=1,nk),ith=1,nth)
2498  IF ( flsrce(4) ) WRITE (ndstab,902) &
2499  ((sds(ik,ith),ik=1,nk),ith=1,nth)
2500  IF ( flsrce(5) ) WRITE (ndstab,902) &
2501  ((sbt(ik,ith),ik=1,nk),ith=1,nth)
2502  IF ( flsrce(6) ) WRITE (ndstab,902) &
2503  ((sis(ik,ith),ik=1,nk),ith=1, nth)
2504  IF ( flsrce(7) ) WRITE (ndstab,902) &
2505  ((stt(ik,ith),ik=1,nk),ith=1,nth)
2506  END IF
2507  !
2508  END IF
2509  !
2510  ! 4.d Perform output type 4 ( Spectral partitions and bulletins )
2511  !
2512  ELSE IF ( itype .EQ. 4 ) THEN
2513  !
2514  IF ( otype .EQ. 1 ) THEN
2515  !
2516  IF ( flagll ) THEN
2517  IF ( ptloc(1,j) .LT. 0. ) &
2518  ptloc(1,j) = ptloc(1,j) + 360.
2519  WRITE (ndstab,940) time, m2km*ptloc(2,j), &
2520  m2km*ptloc(1,j), ptnme(j), npart, depth, &
2521  wao(j), udir, cao(j), cdir
2522  ELSE
2523  WRITE (ndstab,943) time, m2km*ptloc(1,j), &
2524  m2km*ptloc(2,j), ptnme(j), npart, depth, &
2525  wao(j), udir, cao(j), cdir
2526  END IF
2527  ! WRITE (NDSTAB,941)
2528  DO i=0, npart
2529  WRITE (ndstab,942) i, xpart(:,i)
2530  END DO
2531  !
2532  ELSEIF ( otype .GE. 2 ) THEN
2533  CALL w3bull (npart, xpart, dimxp, uabs, &
2534  udir, j, iout, timev )
2535  !
2536  IF ( flagll ) THEN
2537  x = m2km * ptloc(1,j)
2538  y = m2km * ptloc(2,j)
2539 
2540  x = mod( x+720. , 360. )
2541  IF ( x .LE. 180. ) THEN
2542  idlon = 'E'
2543  ELSE
2544  x = 360. - x
2545  idlon = 'W'
2546  ENDIF
2547  !IF ( ABS(Y) .LE. 0.0049 ) THEN
2548  !IDLAT = '-'
2549  IF ( y .GE. 0. ) THEN
2550  idlat = 'N'
2551  ELSE
2552  idlat = 'S'
2553  y = -y
2554  ENDIF
2555  ELSE
2556  idlat = ' '
2557  idlon = ' '
2558  ENDIF
2559  IF ( otype .EQ. 2 .OR. otype .EQ. 4 ) THEN
2560  ndsbul=ndstab + (j - 1)
2561 #ifdef W3_NCO
2562  ndscbul=ndstab + (j - 1) + nopts
2563 #endif
2564  IF (iout .EQ. 1) THEN
2565  WRITE(hstr,'(I2,1X,A)') timev(2)/10000, &
2566  htype
2567  WRITE (ndsbul,970) ptnme(j), y, idlat, x, &
2568  idlon, gname, timev(1), &
2569  hstr
2570  WRITE (ndsbul,971)
2571  WRITE (ndsbul,972)
2572  WRITE (ndsbul,971)
2573 #ifdef W3_NCO
2574  WRITE (ndscbul,960) ptnme(j), y, idlat, &
2575  x, idlon, gname, timev(1), hstr
2576  WRITE (ndscbul,961)
2577 #endif
2578  ENDIF
2579 
2580  WRITE (ndsbul,973) ascbline
2581 #ifdef W3_NCO
2582  WRITE (ndscbul,963) cascbline
2583 #endif
2584  ENDIF
2585  IF ( otype .EQ. 3 .OR. otype .EQ. 4 ) THEN
2586  icsv = 0
2587  IF ( ndsbul .GT. 0 ) icsv = ndsbul
2588 #ifdef W3_NCO
2589  IF ( ndscbul .GT. 0 ) icsv = ndscbul
2590 #endif
2591  ndscsv = ndstab + (j - 1) + icsv
2592  WRITE (ndscsv,'(A664)') csvbline
2593  ENDIF
2594  END IF
2595  !
2596  END IF
2597  ! ... End of fields loop
2598  !
2599  END IF
2600  END DO
2601  !
2602  RETURN
2603  !
2604  ! Formats
2605  !
2606 900 FORMAT (i8.8,i7.6)
2607 901 FORMAT ('''',a10,'''',2f7.2,f10.1,2(f7.2,f6.1))
2608 701 FORMAT ('''',a10,'''',2(f8.1,'E3'),f10.1,2(f7.2,f6.1))
2609 902 FORMAT (7e11.3)
2610 905 FORMAT (9x,a)
2611 910 FORMAT (/15x,' Water depth :',f7.1,' (m)'/ &
2612  15x,' Wind speed :',f8.2,' (m/s)')
2613 911 FORMAT ( 15x,' Wind direction :',f7.1,' (degr)')
2614 912 FORMAT ( 15x,' Air-sea temp. dif.:',f7.1,' (degr)'/ &
2615  15x,' Current speed :',f8.2,' (m/s)')
2616 913 FORMAT ( 15x,' Current direction :',f7.1,' (degr)')
2617 914 FORMAT ( 15x,' Wave height :',f8.2,' (m)'/ &
2618  15x,' Mean wave length :',f6.0,' (m)'/ &
2619  15x,' Mean wave period :',f7.1,' (s)'/ &
2620  15x,' Mean wave direct. :',f7.1,' (degr)'/ &
2621  15x,' Direct. spread :',f7.1,' (degr)'/)
2622 920 FORMAT (' Time : ',a/ &
2623  ' Location : ',a,' (',2f8.2,' )'/ &
2624  ' depth : ',f7.1,' m'/ &
2625  ' U* : ',f9.3,' m/s'/ &
2626  ' U10 : ',f7.1,' m/s'/ &
2627  ' Dir U10 : ',f7.1,' degr'// &
2628  ' f f/fp F(f) theta spr alpha '/ &
2629  ' (Hz) (-) (m2s) (deg) (deg) (-) '/ &
2630  ' --------------------------------------------------')
2631 720 FORMAT (' Time : ',a/ &
2632  ' Location : ',a,' (',2(f8.1,'E3'),' )'/ &
2633  ' depth : ',f7.1,' m'/ &
2634  ' U* : ',f9.3,' m/s'/ &
2635  ' U10 : ',f7.1,' m/s'/ &
2636  ' Dir U10 : ',f7.1,' degr'// &
2637  ' f f/fp F(f) theta spr alpha '/ &
2638  ' (Hz) (-) (m2s) (deg) (deg) (-) '/ &
2639  ' --------------------------------------------------')
2640 921 FORMAT (1x,f8.5,f7.3,e11.3,2f8.1,f8.4)
2641 922 FORMAT (' '/' ')
2642  !
2643 940 FORMAT (1x,i8.8,1x,i6.6,2f8.3,2x,'''',a10,'''', &
2644  1x,i3,f7.1,f5.1,f6.1,f5.2,f6.1)
2645 943 FORMAT (1x,i8.8,1x,i6.6,2(f8.1,'E3'),2x,'''',a10,'''', &
2646  1x,i3,f7.1,f5.1,f6.1,f5.2,f6.1)
2647 941 FORMAT (' hs tp lp theta sp wf')
2648 942 FORMAT (i3,3f8.2,2f9.2,10f7.2)
2649  !
2650  !
2651 #ifdef W3_NCO
2652 960 FORMAT ( 'Location : ',a,' (',f5.2,a,1x,f6.2,a,')'/ &
2653  'Model : ',a/ &
2654  'Cycle : ',i8,1x,a// &
2655  'DDHH HS SS PP DDD SS PP DDD SS PP DDD', &
2656  ' SS PP DDD SS PP DDD SS PP DDD')
2657 961 FORMAT ('----------------------------------------', &
2658  '---------------------------')
2659 963 FORMAT (a)
2660 #endif
2661  !
2662 970 FORMAT ( ' Location : ',a,' (',f5.2,a,1x,f6.2,a,')'/ &
2663  ' Model : ',a/ &
2664  ' Cycle : ',i8,1x,a)
2665 971 FORMAT (' +-------+-----------+-----------------+', &
2666  '-----------------+-----------------+----', &
2667  '-------------+-----------------+--------', &
2668  '---------+')
2669 972 FORMAT (' | day & | Hst n x | Hs Tp dir |', &
2670  ' Hs Tp dir |', &
2671  ' Hs Tp dir |', &
2672  ' Hs Tp dir |', &
2673  ' Hs Tp dir |', &
2674  ' Hs Tp dir |'/ &
2675  ' | hour | (m) - - | (m) (s) (d) |', &
2676  ' (m) (s) (d) |', &
2677  ' (m) (s) (d) |', &
2678  ' (m) (s) (d) |', &
2679  ' (m) (s) (d) |', &
2680  ' (m) (s) (d) |')
2681 973 FORMAT (1x,a)
2682  !
2683 1901 FORMAT ( &
2684  ' Date Time d Uc Dir. U10 Dir. '/ &
2685  ' h m s (m) (m/s) (d.N) (m/s) (d.N) '/ &
2686  ' ---------------------------------------------------------')
2687 1902 FORMAT ( &
2688  ' Date Time Hs L Tr Dir. Spr. ', &
2689  ' fp p_dir p_spr'/ &
2690  ' h m s (m) (m) (s) (d.N) (deg)', &
2691  ' (Hz) (d.N) (deg)'/ &
2692  ' -------------------------------------------------------', &
2693  '-----------------------')
2694 1903 FORMAT ( &
2695  ' Date Time U* E* fp* Cd alpha'/&
2696  ' h m s (m/s) (-) (-) *1000 *100'/ &
2697  ' --------------------------------------------------------------')
2698 1904 FORMAT ( &
2699  ' Date Time U10 E* fp* Cd alpha'/&
2700  ' h m s (m/s) (-) (-) *1000 *100'/ &
2701  ' --------------------------------------------------------------')
2702 1905 FORMAT ( &
2703  ' Date Time U10 Dir. Hs H* cp/U ', &
2704  ' cm/U Dt'/ &
2705  ' (m/s) (d.N) (m) (-) (-) ', &
2706  ' (-) (deg)'/ &
2707  ' --------------------------------------------------', &
2708  '---------------------')
2709 1906 FORMAT ( &
2710  ' Time U10 Dir. Hs Tp '/ &
2711  ' yr mth dy h (m/s) (d.N) (m) (s) '/ &
2712  ' ----------------------------------')
2713 1910 FORMAT ( ' '/' ' )
2714 1911 FORMAT (' Time : ',a// &
2715  ' Long. Lat. d Uc Dir. U10 Dir. '/ &
2716  ' (m) (m/s) (d.N) (m/s) (d.N) '/ &
2717  ' --------------------------------------------------------')
2718 1912 FORMAT (' Time : ',a// &
2719  ' Long. Lat. Hs L Tr Dir. Spr. ', &
2720  ' fp p_dir p_spr'/ &
2721  ' (m) (m) (s) (d.N) (deg)', &
2722  ' (Hz) (d.N) (deg)'/ &
2723  ' ------------------------------------------------------', &
2724  '-----------------------')
2725 1711 FORMAT (' Time : ',a// &
2726  ' X Y d Uc Dir. U10 Dir. '/ &
2727  ' (m) (m) (m) (m/s) (d.N) (m/s) (d.N) '/ &
2728  ' ----------------------------------------------------------')
2729 1712 FORMAT (' Time : ',a// &
2730  ' X Y Hs L Tr Dir. Spr. ', &
2731  ' fp p_dir p_spr'/ &
2732  ' (m) (m)) (m) (m) (s) (d.N) (deg)', &
2733  ' (Hz) (d.N) (deg)'/ &
2734  ' ------------------------------------------------------', &
2735  '-------------------------')
2736 1913 FORMAT (' Time : ',a// &
2737  ' X* Y* U* E* fp* Cd alpha'/&
2738  ' (-) (-) (m/s) (-) (-) *1000 *100'/ &
2739  ' --------------------------------------------------------------')
2740 1914 FORMAT (' Time : ',a// &
2741  ' X* Y* U10 E* fp* Cd alpha'/ &
2742  ' (-) (-) (m/s) (-) (-) *1000 *100 '/ &
2743  ' --------------------------------------------------------------')
2744 1915 FORMAT (' Time : ',a// &
2745  ' Long. Lat. U10 Dir. Hs H* cp/U ', &
2746  ' cm/U Dt'/ &
2747  ' (m/s) (d.N) (m) (-) (-) ', &
2748  ' (-) (deg)'/ &
2749  ' -------------------------------------------------', &
2750  '---------------------')
2751 1715 FORMAT (' Time : ',a// &
2752  ' X Y U10 Dir. Hs H* cp/U ', &
2753  ' cm/U Dt'/ &
2754  ' (m) (m) (m/s) (d.N) (m) (-) (-) ', &
2755  ' (-) (deg)'/ &
2756  ' ---------------------------------------------------', &
2757  '---------------------')
2758 1916 FORMAT (' Time : ',a// &
2759  ' Long. Lat. U10 Dir. Hs Tp '/ &
2760  ' (m/s) (d.N) (m) (s) '/ &
2761  '-----------------------------------------------')
2762 1716 FORMAT (' Time : ',a// &
2763  ' X Y U10 Dir. Hs Tp '/ &
2764  ' (m) (m) (m/s) (d.N) (m) (s) '/ &
2765  '---------------------------------------------------')
2766 1921 FORMAT ( 2x,i8.8,i3,2(1x,i2.2),f10.1,f6.2,f7.1,f6.2,f7.1)
2767 1922 FORMAT ( 2x,i8.8,i3,2(1x,i2.2),f9.3,f7.1,f7.2,f7.1,f7.2, &
2768  f8.4,f7.1,f7.2)
2769 1923 FORMAT ( 2x,i8.8,i3,2(1x,i2.2),f8.4,2e11.3,2f7.3)
2770 1924 FORMAT ( 2x,i8.8,i3,2(1x,i2.2),f7.1,2e11.3,2f7.3)
2771 1925 FORMAT ( 2x,i8.8,i3,2(1x,i2.2),f7.2,f7.1,2f7.2,2f8.2,f7.1)
2772 1926 FORMAT ( 2x,i4,3(1x,i2),f6.2,1x,i3,2f6.2)
2773 1931 FORMAT ( 2x,2f8.3,f10.1,f6.2,f7.1,f6.2,f7.1)
2774 1932 FORMAT ( 2x,2f8.3,f9.3,f7.1,f7.2,f7.1,f7.2, &
2775  f8.4,f7.1,f7.2)
2776 1731 FORMAT ( 2x,2(f7.1,'E3'),f10.1,f6.2,f7.1,f6.2,f7.1)
2777 1732 FORMAT ( 2x,2(f7.1,'E3'),f9.3,f7.1,f7.2,f7.1,f7.2, &
2778  f8.4,f7.1,f7.2)
2779 1933 FORMAT ( 2x,2(f7.1,'E4'),f8.4,2e11.3,2f7.3)
2780 1934 FORMAT ( 2x,2f9.1,f7.1,2e11.3,2f7.3)
2781 1935 FORMAT ( 2x,2f8.3,f7.2,f7.1,2f7.2,2f8.2,f7.1)
2782 1735 FORMAT ( 2x,2(f7.1,'E3'),f7.2,f7.1,2f7.2,2f8.2,f7.1)
2783 1936 FORMAT ( 2x,2f8.3,f6.2,1x,i3,2f6.2)
2784 1736 FORMAT ( 2x,2(f8.2,'E3'),f6.2,1x,i3,2f6.2)
2785  !
2786 2920 FORMAT (' Time : ',a/ &
2787  ' Location : ',a,' (',2f8.2,' )'/ &
2788  ' depth : ',f7.1,' m'/ &
2789  ' U* : ',f9.3,' m/s'/ &
2790  ' U10 : ',f7.1,' m/s'/)
2791 2720 FORMAT (' Time : ',a/ &
2792  ' Location : ',a,' (',2(f8.1,'E3'),' )'/ &
2793  ' depth : ',f7.1,' m'/ &
2794  ' U* : ',f9.3,' m/s'/ &
2795  ' U10 : ',f7.1,' m/s'/)
2796 2921 FORMAT (' f E ', &
2797  ' Sin Snl Sds Sbt Sice Stot'/ &
2798  ' (Hz) (m2s) ', &
2799  ' (m2) (m2) (m2) (m2) (m2) (m2)'/ &
2800  ' ------------------------------------------', &
2801  '-------------------------------------------')
2802 2922 FORMAT (' f* E* ', &
2803  ' Sin* Snl* Sds* Sbt* Sice* Stot*'/ &
2804  ' (-) (-) ', &
2805  ' (-) (-) (-) (-) (-) (-)'/ &
2806  ' ------------------------------------------', &
2807  '-------------------------------------------')
2808 2923 FORMAT (' f/fp E ', &
2809  ' Sin Snl Sds Sbt Sice Stot'/ &
2810  ' (-) (m2s) ', &
2811  ' (m2) (m2) (m2) (m2) (m2) (m2)'/ &
2812  ' ------------------------------------------', &
2813  '-------------------------------------------')
2814 2924 FORMAT (' f/fp E* ', &
2815  ' Sin* Snl* Sds* Sbt* Sice* Stot*'/ &
2816  ' (-) (-) ', &
2817  ' (-) (-) (-) (-) (-) (-)'/ &
2818  ' ------------------------------------------', &
2819  '-------------------------------------------')
2820 2925 FORMAT (' f E ', &
2821  ' Tini Tnli Tdsi Tbti Ticei Ttoti'/ &
2822  ' (Hz) (m2s) ', &
2823  ' (1/s) (1/s) (1/s) (1/s) (1/s) (1/s)'/ &
2824  ' ----------------------------------------', &
2825  '-------------------------------------------')
2826 2926 FORMAT (' f* E* ', &
2827  ' Tini* Tnli* Tdsi* Tbti* Ticei* Ttoti*'/ &
2828  ' (-) (-) ', &
2829  ' (-) (-) (-) (-) (-) (-)'/ &
2830  ' ----------------------------------------', &
2831  '-------------------------------------------')
2832 2927 FORMAT (' f/fp E ', &
2833  ' Tini Tnli Tdsi Tbti Ticei Ttoti'/ &
2834  ' (-) (m2s) ', &
2835  ' (1/s) (1/s) (1/s) (1/s) (1/s) (1/s)'/ &
2836  ' ----------------------------------------', &
2837  '-------------------------------------------')
2838 2928 FORMAT (' f/fp E* ', &
2839  ' Tini* Tnli* Tdsi* Tbti* Ticei* Ttoti*'/ &
2840  ' (-) (-) ', &
2841  ' (-) (-) (-) (-) (-) (-)'/ &
2842  ' ----------------------------------------', &
2843  '-------------------------------------------')
2844 2930 FORMAT (1x,f6.4,2x,7e11.3)
2845 2931 FORMAT (1x,f6.4,7e11.3)
2846 2940 FORMAT ( ' '/' ' )
2847  !
2848 #ifdef W3_T
2849 9000 FORMAT (' TEST W3EXPO : FLAGS :',40l2)
2850 9001 FORMAT (' TEST W3EXPO : ITPYE :',i4/ &
2851  ' OTPYE :',i4/ &
2852  ' NREQ :',i4/ &
2853  ' SCALE1 :',e10.3/ &
2854  ' SCALE2 :',e10.3/ &
2855  ' FLSRCE :',7l2)
2856 9002 FORMAT (' TEST W3EXPO : OUTPUT POINT : ',a)
2857 9010 FORMAT (' TEST W3EXPO : DEPTH =',f7.1,' IK, T, K, CG :')
2858 9011 FORMAT (' ',i3,f8.2,f8.4,f8.2)
2859 #endif
2860  !/
2861  !/ End of W3EXPO ----------------------------------------------------- /
2862  !/

References constants::dair, constants::dera, w3dispmd::dfac, w3dispmd::dsie, constants::dwat, w3dispmd::ecg1, w3dispmd::ewn1, constants::grav, w3gdatmd::iicedisp, w3dispmd::liu_forward_dispersion(), w3dispmd::n1max, w3dispmd::nar1d, w3arrymd::prt1dm(), w3arrymd::prt1ds(), w3arrymd::prt2ds(), constants::rade, constants::radius, w3gdatmd::swl6s6, constants::tpi, constants::tpiinv, w3bullmd::w3bull(), w3flx1md::w3flx1(), w3flx2md::w3flx2(), w3flx3md::w3flx3(), w3flx4md::w3flx4(), w3flx5md::w3flx5(), w3partmd::w3part(), w3sbs1md::w3sbs1(), w3sbt1md::w3sbt1(), w3sbt4md::w3sbt4(), w3sdb1md::w3sdb1(), w3src1md::w3sds1(), w3src2md::w3sds2(), w3src3md::w3sds3(), w3src4md::w3sds4(), w3src6md::w3sds6(), w3src1md::w3sin1(), w3src2md::w3sin2(), w3src3md::w3sin3(), w3src4md::w3sin4(), w3src6md::w3sin6(), w3sis2md::w3sis2(), w3sln1md::w3sln1(), w3snl1md::w3snl1(), w3snl2md::w3snl2(), w3snl3md::w3snl3(), w3snl4md::w3snl4(), w3snl1md::w3snlgqm(), w3src1md::w3spr1(), w3src2md::w3spr2(), w3src3md::w3spr3(), w3src4md::w3spr4(), w3src6md::w3spr6(), w3swldmd::w3swl6(), and w3dispmd::wavnu1().

Referenced by w3outp().

◆ w3outp()

program w3outp

Post-processing of point output.

Data is read from the grid output file out_pnt.ww3 (raw data) and from the file ww3_outp.inp ( NDSI, output requests ). Model definition and raw data files are read using WAVEWATCH III subroutines.

Author
H. L. Tolman
J.H. Alves
A. Chawla
F. Ardhuin
E. Rogers
T. Campbell
Date
27-Aug-2015
Copyright
Copyright 2009-2022 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.

Definition at line 36 of file ww3_outp.F90.

References w3bullmd::ascbline, w3odatmd::aso, w3bullmd::bhsdrop, w3bullmd::bhsmin, w3bullmd::cascbline, w3bullmd::csvbline, w3odatmd::dimp, w3bullmd::dmt, w3odatmd::dpo, w3timemd::dsec21(), w3servmd::extcde(), file(), constants::file_endian, w3odatmd::fnmpre, w3odatmd::grdid, w3bullmd::hst, w3servmd::itrace(), w3bullmd::iyy, w3odatmd::ndse, w3odatmd::ndso, w3odatmd::ndst, w3servmd::nextln(), w3bullmd::nfld, w3odatmd::nopts, w3bullmd::npmax, w3bullmd::nptab, constants::pi, w3odatmd::ptloc, w3odatmd::ptnme, w3timemd::stme21(), w3servmd::strace(), w3timemd::tick21(), w3wdatmd::time, constants::tpi, constants::tpiinv, w3bullmd::tpt, constants::undef, w3canomd::w3add2ndorder(), w3gig1md::w3addig(), w3expo(), w3iogrmd::w3iogr(), w3iopomd::w3iopo(), w3iopomd::w3iopon(), w3iopomd::w3iopon_read(), w3iopomd::w3iopon_write(), w3adatmd::w3naux(), w3wdatmd::w3ndat(), w3gdatmd::w3nmod(), w3odatmd::w3nout(), w3adatmd::w3seta(), w3gdatmd::w3setg(), w3odatmd::w3seto(), w3wdatmd::w3setw(), w3odatmd::wao, and w3odatmd::wdo.

w3dispmd::dfac
real, parameter dfac
Definition: w3dispmd.F90:75
w3sln1md
Definition: w3sln1md.F90:3
w3sln1md::w3sln1
subroutine w3sln1(K, FHIGH, USTAR, USDIR, S)
Definition: w3sln1md.F90:57
w3src3md::w3sin3
subroutine w3sin3(A, CG, K, U, USTAR, DRAT, AS, USDIR, Z0, CD, TAUWX, TAUWY, TAUWNX, TAUWNY, ICE, S, D, LLWS, IX, IY)
Calculate diagonal and input source term for WAM4+ approach.
Definition: w3src3md.F90:386
w3adatmd::charn
real, dimension(:), pointer charn
Definition: w3adatmd.F90:603
w3arrymd::prt1dm
subroutine prt1dm(NDS, NFR, NE, E, FR, UFR, NLINES, FTOPI, PRVAR, PRUNIT, PNTNME)
Definition: w3arrymd.F90:1627
w3gdatmd::swl6s6
logical, pointer swl6s6
Definition: w3gdatmd.F90:1338
w3swldmd
Source term module for swell dissipation.
Definition: w3swldmd.F90:18
w3flx5md::w3flx5
subroutine w3flx5(ZWND, U10, U10D, TAUA, TAUADIR, RHOAIR, UST, USTD, Z0, CD, CHARN)
Unified process to obtain friction velocity and drag when stresses are an input (from atmospheric mod...
Definition: w3flx5md.F90:119
constants::dair
real, parameter dair
DAIR Density of air (kg/m3).
Definition: constants.F90:63
constants::dera
real, parameter dera
DERA Conversion factor from degrees to radians.
Definition: constants.F90:77
w3snl1md::w3snl1
subroutine w3snl1(A, CG, KDMEAN, S, D)
Calculate nonlinear interactions and the diagonal term of its derivative.
Definition: w3snl1md.F90:115
w3partmd
Spectral partitioning according to the watershed method.
Definition: w3partmd.F90:18
w3flx4md::w3flx4
subroutine w3flx4(ZWND, U10, U10D, UST, USTD, Z0, CD)
Flux/stress computations according to Hwang (JTECH, 2011).
Definition: w3flx4md.F90:106
w3adatmd::cg
real, dimension(:,:), pointer cg
Definition: w3adatmd.F90:575
w3wdatmd::icef
real, dimension(:), pointer icef
Definition: w3wdatmd.F90:183
w3sbt1md::w3sbt1
subroutine w3sbt1(A, CG, WN, DEPTH, S, D)
Bottom friction source term according to the empirical JONSWAP formulation.
Definition: w3sbt1md.F90:89
w3src2md::w3sds2
subroutine w3sds2(A, CG, K, FPI, USTAR, ALFA, S, D)
Calculate whitecapping source term and diagonal term of derivative.
Definition: w3src2md.F90:583
w3sdb1md
Dummy slot for bottom friction source term.
Definition: w3sdb1md.F90:24
w3adatmd::ipass
integer, pointer ipass
Definition: w3adatmd.F90:686
w3wdatmd::time
integer, dimension(:), pointer time
Definition: w3wdatmd.F90:172
w3flx2md::w3flx2
subroutine w3flx2(ZWIND, DEPTH, FP, U, UDIR, UST, USTD, Z0, CD)
FLux/stress computations according Tolman and Chalikov (1996).
Definition: w3flx2md.F90:91
w3bullmd::w3bull
subroutine w3bull(NPART, XPART, DIMXP, UABS, UD, IPNT, IOUT, TIMEV)
Read a WAVEWATCH-III version 1.17 point output data file and produces a table of mean parameters for ...
Definition: w3bullmd.F90:91
constants::rade
real, parameter rade
RADE Conversion factor from radians to degrees.
Definition: constants.F90:76
w3sbt4md::w3sbt4
subroutine w3sbt4(A, CG, WN, DEPTH, D50, PSIC, TAUBBL, BEDFORM, S, D, IX, IY)
Computes the SHOWEX bottom friction with movable bed effects.
Definition: w3sbt4md.F90:341
w3src4md::w3sds4
subroutine w3sds4(A, K, CG, USTAR, USDIR, DEPTH, DAIR, SRHS, DDIAG, IX, IY, BRLAMBDA, WHITECAP, DLWMEAN)
Calculate whitecapping source term and diagonal term of derivative.
Definition: w3src4md.F90:2034
w3src6md::w3sin6
subroutine, public w3sin6(A, CG, WN2, UABS, USTAR, USDIR, CD, DAIR, TAUWX, TAUWY, TAUNWX, TAUNWY, S, D)
Observation-based source term for wind input.
Definition: w3src6md.F90:292
w3snl4md::w3snl4
subroutine w3snl4(A, CG, WN, DEPTH, S, D)
Interface module for TSA type nonlinear interactions.
Definition: w3snl4md.F90:611
w3src2md::w3sin2
subroutine w3sin2(A, CG, K, U, UDIR, CD, Z0, FPI, S, D)
Calculate input source term.
Definition: w3src2md.F90:309
w3adatmd::taubbl
real, dimension(:,:), pointer taubbl
Definition: w3adatmd.F90:614
w3flx3md
FLux/stress computations according Tolman and Chalikov (1996).
Definition: w3flx3md.F90:23
w3flx4md
Flux/stress computations according to Hwang ( 2011).
Definition: w3flx4md.F90:27
w3flx5md
Unified process to obtain friction velocity and drag when stresses are an input (from atmospheric mod...
Definition: w3flx5md.F90:28
w3dispmd::ewn1
real, dimension(0:nar1d) ewn1
Definition: w3dispmd.F90:78
w3flx1md
Flux/stress computations according to Wu (1980).
Definition: w3flx1md.F90:21
w3adatmd::tauwny
real, dimension(:), pointer tauwny
Definition: w3adatmd.F90:603
w3flx2md
FLux/stress computations according Tolman and Chalikov (1996).
Definition: w3flx2md.F90:21
w3src4md::w3sin4
subroutine w3sin4(A, CG, K, U, USTAR, DRAT, AS, USDIR, Z0, CD, TAUWX, TAUWY, TAUWNX, TAUWNY, S, D, LLWS, IX, IY, BRLAMBDA)
Calculate diagonal and input source term for WAM4+ approach.
Definition: w3src4md.F90:426
w3sdb1md::w3sdb1
subroutine w3sdb1(IX, A, DEPTH, EMEAN, FMEAN, WNMEAN, CG, LBREAK, S, D)
Compute depth-induced breaking using Battjes and Janssen bore model approach.
Definition: w3sdb1md.F90:97
constants::tpiinv
real, parameter tpiinv
TPIINV Inverse of 2*Pi.
Definition: constants.F90:74
w3timemd::stme21
subroutine stme21(TIME, DTME21)
Definition: w3timemd.F90:682
w3adatmd::tauwnx
real, dimension(:), pointer tauwnx
Definition: w3adatmd.F90:603
w3adatmd::alpha
real, dimension(:,:), pointer alpha
Definition: w3adatmd.F90:687
w3snlsmd
Nonlinear interaction based ‘smoother’ for high frequencies.
Definition: w3snlsmd.F90:21
w3dispmd::liu_forward_dispersion
subroutine liu_forward_dispersion(H_ICE, VISC, H_WDEPTH, SIGMA, K_SOLUTION, CG, ALPHA)
Definition: w3dispmd.F90:688
w3dispmd::ecg1
real, dimension(0:nar1d) ecg1
Definition: w3dispmd.F90:78
w3gdatmd::iicedisp
logical, pointer iicedisp
Definition: w3gdatmd.F90:1217
w3adatmd::taua
real, dimension(:), pointer taua
Definition: w3adatmd.F90:584
constants::dwat
real, parameter dwat
DWAT Density of water (kg/m3).
Definition: constants.F90:62
w3sbs1md::w3sbs1
subroutine w3sbs1(A, CG, WN, DEPTH, CX1, CY1, TAUSCX, TAUSCY, S, D)
Bottom scattering source term.
Definition: w3sbs1md.F90:114
w3adatmd::wnmean
real, dimension(:), pointer wnmean
Definition: w3adatmd.F90:587
w3gig1md::w3addig
subroutine w3addig(E, DEPTH, WN, CG, IACTION)
Definition: w3gig1md.F90:147
constants::radius
real, parameter radius
RADIUS Radius of the earth (m).
Definition: constants.F90:79
w3adatmd::wn
real, dimension(:,:), pointer wn
Definition: w3adatmd.F90:575
w3arrymd::prt1ds
subroutine prt1ds(NDS, NFR, E, FR, UFR, NLINES, FTOPI, PRVAR, PRUNIT, PNTNME)
Definition: w3arrymd.F90:1366
constants::tpi
real, parameter tpi
TPI 2*Pi.
Definition: constants.F90:72
w3src1md::w3sin1
subroutine w3sin1(A, K, USTAR, USDIR, S, D)
Calculate diagonal of input source (actual source term put together in W3SRCE).
Definition: w3src1md.F90:256
w3wdatmd::icedmax
real, dimension(:), pointer icedmax
Definition: w3wdatmd.F90:183
w3src6md::w3spr6
subroutine, public w3spr6(A, CG, WN, EMEAN, FMEAN, WNMEAN, AMAX, FP)
Calculate mean wave parameters.
Definition: w3src6md.F90:122
w3snl2md::w3snl2
subroutine w3snl2(A, CG, DEPTH, S, D)
Interface to exact interactions.
Definition: w3snl2md.F90:96
w3wdatmd::ice
real, dimension(:), pointer ice
Definition: w3wdatmd.F90:183
w3arrymd
Definition: w3arrymd.F90:3
w3sis2md
Floe-size dependant scattering of waves in the marginal ice zone.
Definition: w3sis2md.F90:33
w3adatmd::whitecap
real, dimension(:,:), pointer whitecap
Definition: w3adatmd.F90:603
w3sbt8md
Contains routines for computing dissipation by viscous fluid mud using Dalrymple and Liu (1978) "Thin...
Definition: w3sbt8md.F90:25
w3src3md::w3spr3
subroutine w3spr3(A, CG, WN, EMEAN, FMEAN, FMEANS, WNMEAN, AMAX, U, UDIR, USTAR, USDIR, TAUWX, TAUWY, CD, Z0, CHARN, LLWS, FMEANWS)
Calculate mean wave parameters for the use in the source term routines.
Definition: w3src3md.F90:137
w3sbt9md
Contains routines for computing dissipation by viscous fluid mud using Ng (2000).
Definition: w3sbt9md.F90:25
w3src2md::w3spr2
subroutine w3spr2(A, CG, WN, DEPTH, FPI, U, USTAR, EMEAN, FMEAN, WNMEAN, AMAX, ALFA, FP)
Calculate mean wave parameters for the use in the source term routines (Tolman and Chalikov).
Definition: w3src2md.F90:127
w3sbt4md
SHOWEX bottom friction source term (Ardhuin et al.
Definition: w3sbt4md.F90:25
w3sbt1md
JONSWAP bottom friction routine.
Definition: w3sbt1md.F90:21
w3src3md::w3sds3
subroutine w3sds3(A, K, CG, EMEAN, FMEAN, WNMEAN, USTAR, USDIR, DEPTH, S, D, IX, IY)
Calculate whitecapping source term and diagonal term of derivative.
Definition: w3src3md.F90:1255
w3gdatmd
Definition: w3gdatmd.F90:16
w3adatmd::hsig
real, dimension(:), pointer hsig
Definition: w3adatmd.F90:587
w3swldmd::w3swl6
subroutine, public w3swl6(A, CG, WN, S, D)
Turbulent dissipation of narrow-banded swell.
Definition: w3swldmd.F90:252
w3dispmd::nar1d
integer, parameter nar1d
Definition: w3dispmd.F90:74
w3sbs1md
This module computes a scattering term based on the theory by Ardhuin and Magne (JFM 2007).
Definition: w3sbs1md.F90:22
w3dispmd::wavnu1
subroutine wavnu1(SI, H, K, CG)
Definition: w3dispmd.F90:85
w3sis2md::w3sis2
subroutine, public w3sis2(A, DEPTH, CICE, ICEH, ICEF, ICEDMAX, IX, IY, S, D, DISSIP, WN, CG, WN_R, CG_ICE, R)
Wave scattering in the MIZ, adapted from Dumont et al.
Definition: w3sis2md.F90:654
w3adatmd::tauadir
real, dimension(:), pointer tauadir
Definition: w3adatmd.F90:584
w3canomd::w3add2ndorder
subroutine w3add2ndorder(E, DEPTH, WN, CG, IACTION)
Adds second order spectrum on top of first order spectrum.
Definition: w3canomd.F90:153
w3src6md::w3sds6
subroutine, public w3sds6(A, CG, WN, S, D)
Observation-based source term for dissipation.
Definition: w3src6md.F90:547
w3arrymd::prt2ds
subroutine prt2ds(NDS, NFR0, NFR, NTH, E, FR, UFR, FACSP, FSC, RRCUT, PRVAR, PRUNIT, PNTNME)
Definition: w3arrymd.F90:1943
w3wdatmd::rhoair
real, dimension(:), pointer rhoair
Definition: w3wdatmd.F90:183
w3snl3md
Generalized and optimized multiple DIA implementation.
Definition: w3snl3md.F90:24
w3snl4md
Generic shallow-water Boltzmann integral (FBI or TSA).
Definition: w3snl4md.F90:25
w3src3md
The 'WAM4+' source terms based on P.A.E.M.
Definition: w3src3md.F90:30
w3src4md
The 'SHOM/Ifremer' source terms based on P.A.E.M.
Definition: w3src4md.F90:28
w3snl1md
Bundles routines to calculate nonlinear wave-wave interactions according to the Discrete Interaction ...
Definition: w3snl1md.F90:25
w3src6md
Observation-based wind input and dissipation after Donelan et al (2006), and Babanin et al.
Definition: w3src6md.F90:27
w3snl2md
Interface module to exact nonlinear interactions.
Definition: w3snl2md.F90:23
w3partmd::w3part
subroutine w3part(SPEC, UABS, UDIR, DEPTH, WN, NP, XP, DIMXP)
Interface to watershed partitioning routines.
Definition: w3partmd.F90:139
w3src1md
Bundle WAM cycle 3 input and dissipation source terms with their defining parameters.
Definition: w3src1md.F90:15
w3src2md
Tolman and Chalikov (1996) input and dissipation source terms.
Definition: w3src2md.F90:16
w3snl3md::w3snl3
subroutine w3snl3(A, CG, WN, DEPTH, S, D)
Multiple Discrete Interaction Parameterization for arbitrary depths with generalized quadruplet layou...
Definition: w3snl3md.F90:181
w3snl1md::w3snlgqm
subroutine w3snlgqm(A, CG, WN, DEPTH, TSTOTn, TSDERn)
Definition: w3snl1md.F90:789
w3flx3md::w3flx3
subroutine w3flx3(ZWIND, DEPTH, FP, U, UDIR, UST, USTD, Z0, CD)
FLux/stress computations according Tolman and Chalikov (1996).
Definition: w3flx3md.F90:96
w3bullmd
Module W3BULLMD.
Definition: w3bullmd.F90:23
w3src4md::w3spr4
subroutine w3spr4(A, CG, WN, EMEAN, FMEAN, FMEAN1, WNMEAN, AMAX, U, UDIR, ifdef W3_FLX5
Calculate mean wave parameters for the use in the source term routines.
Definition: w3src4md.F90:145
w3flx1md::w3flx1
subroutine w3flx1(ZWND, U10, U10D, UST, USTD, Z0, CD)
FLux/stress computations according to Wu (1980).
Definition: w3flx1md.F90:89
w3dispmd
Definition: w3dispmd.F90:3
w3dispmd::n1max
integer n1max
Definition: w3dispmd.F90:77
w3src1md::w3sds1
subroutine w3sds1(A, K, EMEAN, FMEAN, WNMEAN, S, D)
Calculate whitecapping source term and diagonal term of derivative.
Definition: w3src1md.F90:433
constants::grav
real, parameter grav
GRAV Acc.
Definition: constants.F90:61
w3src1md::w3spr1
subroutine w3spr1(A, CG, WN, EMEAN, FMEAN, WNMEAN, AMAX)
Definition: w3src1md.F90:88
w3dispmd::dsie
real dsie
Definition: w3dispmd.F90:78