WAVEWATCH III  beta 0.0.1
ww3_outp.F90
Go to the documentation of this file.
1 
12 
13 #include "w3macros.h"
14 !/ ------------------------------------------------------------------- /
15 
36 PROGRAM w3outp
37  !/
38  !/ +-----------------------------------+
39  !/ | WAVEWATCH III NOAA/NCEP |
40  !/ | H. L. Tolman |
41  !/ | J.H. Alves |
42  !/ | A. Chawla |
43  !/ | F. Ardhuin |
44  !/ | E. Rogers |
45  !/ | T. Campbell |
46  !/ | FORTRAN 90 |
47  !/ | Last update : 27-Aug-2015 |
48  !/ +-----------------------------------+
49  !/
50  !/ 14-Jan-1999 : Final FORTRAN 77 ( version 1.18 )
51  !/ 21-Jan-2000 : Upgrade to FORTRAN 90 ( version 2.00 )
52  !/ 14-Feb-2000 : Exact nonlinear interactions ( version 2.01 )
53  !/ 09-Jan-2001 : U* bug fix in tabular output ( version 2.05 )
54  !/ 25-Jan-2001 : Flat grid version ( version 2.06 )
55  !/ 02-Feb-2001 : Xnl version 3.0 ( version 2.07 )
56  !/ 11-Jun-2001 : Clean up ( version 2.11 )
57  !/ 11-Oct-2001 : Clean up, X*, Y* in tables ( version 2.14 )
58  !/ 13-Nov-2002 : Add stress vector ( version 3.00 )
59  !/ 27-Nov-2002 : First version of VDIA and MDIA ( version 3.01 )
60  !/ 24-Dec-2004 : Multiple grid version. ( version 3.06 )
61  !/ 17-Apr-2006 : Filter for directional spread. ( version 3.09 )
62  !/ 23-Jun-2006 : Linear input added. ( version 3.09 )
63  !/ 28-Jun-2006 : Adding file name preamble. ( version 3.09 )
64  !/ 03-Jul-2006 : Separate flux modules. ( version 3.09 )
65  !/ 28-Oct-2006 : Add partitioning option. ( version 3.10 )
66  !/ 24-Mar-2007 : Add pars for entire spectrum. ( version 3.11 )
67  !/ 25-Apr-2007 : Battjes-Janssen Sdb added. ( version 3.11 )
68  !/ (J. H. Alves)
69  !/ 08-Aug-2007 : Creation of buoy log file added ( version 3.12 )
70  !/ (switch O14 -- A. Chawla)
71  !/ 09-Oct-2007 : WAM 4+ Sin and Sds added. ( version 3.13 )
72  !/ (F. Ardhuin)
73  !/ 09-Oct-2007 : Experimental Sbs (BS1) added. ( version 3.13 )
74  !/ (F. Ardhuin)
75  !/ 09-Apr-2008 : Adding an additional output for ( version 3.12 )
76  !/ WMO standard (A. Chawla)
77  !/ 29-Apr-2008 : Adjust format partition output. ( version 3.14 )
78  !/ 29-May-2009 : Preparing distribution version. ( version 3.14 )
79  !/ 30-Oct-2009 : Implement run-time grid selection. ( version 3.14 )
80  !/ (W. E. Rogers & T. J. Campbell, NRL)
81  !/ 04-Mar-2010 : Added partitions bulletin output. ( version 3.14 )
82  !/ (J. H. Alves)
83  !/ 20-Apr-2010 : Fix initialization of USTAR. ( version 3.14.1 )
84  !/ 16-Jul-2012 : Move GMD (SNL3) and nonlinear filter (SNLS)
85  !/ from 3.15 (HLT). ( version 4.08 )
86  !/ 23-Aug-2012 : Adding movable bed friction BT4 ( version 4.08 )
87  !/ 26-Dec-2012 : Modified obsolete declarations. ( version 4.11 )
88  !/ 10-Sep-2013 : Implement second order correction ( version 4.12 )
89  !/ (F. Ardhuin)
90  !/ 06-Feb-2014 : Fix header format in part. files. ( version 4.18 )
91  !/ 27-Aug-2015 : Sice add as additional output ( version 5.10 )
92  !/ (in source terms)
93  !/ 27-Jun-2017 : Expanding WMO table to 2 digits JHA ( version 6.02 )
94  !/ 18-Aug-2018 : S_{ice} IC5 (Q. Liu) ( version 6.06 )
95  !/ 19-Jul-2021 : Momentum and air density support ( version 7.14 )
96  !/ 21-Jul-2022 : Correct FP0 calc for peak energy in ( version 7.14 )
97  !/ min/max freq band (B. Pouliot, CMC)
98  !/
99  !/ Copyright 2009-2014 National Weather Service (NWS),
100  !/ National Oceanic and Atmospheric Administration. All rights
101  !/ reserved. WAVEWATCH III is a trademark of the NWS.
102  !/ No unauthorized use without permission.
103  !/
104  ! 1. Purpose :
105  !
106  ! Post-processing of point output.
107  !
108  ! 2. Method :
109  !
110  ! Data is read from the grid output file out_pnt.ww3 (raw data)
111  ! and from the file ww3_outp.inp ( NDSI, output requests ).
112  ! Model definition and raw data files are read using WAVEWATCH III
113  ! subroutines.
114  !
115  ! Output types ITYPE : Sub-type OTYPE :
116  ! -------------------- -----------------
117  ! 0 : Check file.
118  ! 1 : Spectra.
119  ! 1 : Print plots.
120  ! 2 : Table of 1-D spectra
121  ! 3 : Transfer file
122  ! 2 : Table of mean wave parameters
123  ! 1 : Depth, current, wind
124  ! 2 : Mean wave pars.
125  ! 3 : Nondimensional pars. (U*)
126  ! 4 : Nondimensional pars. (U10)
127  ! 5 : Validation table
128  ! 6 : WMO standard output
129  ! 3 : Source terms
130  ! 1 : Print plots.
131  ! 2 : Table of 1-D S(f).
132  ! 3 : Table of 1-D time scales.
133  ! 4 : Transfer file.
134  !
135  ! 4 : Partitioning and bulletins
136  ! 1 : Spectral partitions table
137  ! 2 : Bulletins ASCII format
138  ! 3 : Bulletins CSV format
139  ! 4 : Bulletins CSV & ASCII format
140  ! 3. Parameters :
141  !
142  ! 4. Subroutines used :
143  !
144  ! Name Type Module Description
145  ! ----------------------------------------------------------------
146  ! W3NMOD Subr. W3GDATMD Set number of model.
147  ! W3SETG Subr. Id. Point to selected model.
148  ! W3NDAT Subr. W3WDATMD Set number of model for wave data.
149  ! W3SETW Subr. Id. Point to selected model for wave data.
150  ! W3NAUX Subr. W3ADATMD Set number of model for aux data.
151  ! W3SETA Subr. Id. Point to selected model for aux data.
152  ! W3NOUT Subr. W3ODATMD Set number of model for output.
153  ! W3SETO Subr. Id. Point to selected model for output.
154  ! ITRACE Subr. W3SERVMD Subroutine tracing initialization.
155  ! STRACE Subr. Id. Subroutine tracing.
156  ! NEXTLN Subr. Id. Get next line from input filw
157  ! EXTCDE Subr. Id. Abort program as graceful as possible.
158  ! STME21 Subr. W3TIMEMD Convert time to string.
159  ! TICK21 Subr. Id. Advance time.
160  ! DSEC21 Func. Id. Difference between times.
161  ! W3IOGR Subr. W3IOGRMD Reading/writing model definition file.
162  ! W3IOPO Subr. W3IOPOMD Reading/writing raw point output file.
163  ! W3EXPO Subr. Internal Execute point output.
164  ! W3BULL Subr. W3BULLMD Generate buletins from spectral part.
165  ! ----------------------------------------------------------------
166  !
167  ! 5. Called by :
168  !
169  ! None, stand-alone program.
170  !
171  ! 6. Error messages :
172  !
173  ! Checks on input, checks in W3IOxx.
174  !
175  ! 7. Remarks :
176  !
177  ! - Tables written to file 'tabNN.ww3', where NN is the
178  ! unit umber (NDSTAB).
179  ! - Transfder file written to ww3.yymmddhh.spc with multiple
180  ! spectra and times in file. yymmddhh relates to first
181  ! output (NDSTAB).
182  ! - !/IC1 !/IC2 !/IC3 !/IC4 !/IC5 are not included in dissipation term
183  ! FIXME: ICE is a dummy variable at the moment
184  ! Include ice parameters in point output file out_pnt.ww3
185  ! Ice coupling to SIN, SDS and SIC similar to w3srcemd.ftn
186  !
187  ! 8. Structure :
188  !
189  ! See source code.
190  !
191  ! 9. Switches :
192  !
193  ! !/S Enable subroutine tracing.
194  !
195  ! !/NCO NCEP NCO modifications for operational implementation.
196  !
197  ! !/O14 Buoy log file generation.
198  !
199  ! 10. Source code :
200  !
201  !/ ------------------------------------------------------------------- /
202  USE constants
203  !/
204  ! USE W3GDATMD, ONLY: W3NMOD, W3SETG
205  USE w3wdatmd, ONLY: w3setw, w3ndat
206 #ifdef W3_NL1
207  USE w3adatmd, ONLY: w3seta, w3naux
208 #endif
209  USE w3odatmd, ONLY: w3seto, w3nout
210  USE w3iogrmd, ONLY: w3iogr
211 #ifdef W3_BIN2NC
212  USE w3iopomd, ONLY: w3iopon, w3iopon_read, w3iopon_write
213 #else
214  USE w3iopomd, ONLY: w3iopo
215 #endif
216  USE w3servmd, ONLY : itrace, nextln, extcde
217 #ifdef W3_S
218  USE w3servmd, ONLY : strace
219 #endif
220  USE w3timemd, ONLY: stme21, tick21, dsec21
221  USE w3gdatmd
222  USE w3wdatmd, ONLY: time
223  USE w3odatmd, ONLY: ndse, ndst, ndso, nopts, ptloc, ptnme, &
224  dpo, wao, wdo, aso, cao, cdo, spco, fnmpre,&
225  iceo, iceho, icefo, dimp
226 #ifdef W3_FLX5
227  USE w3odatmd, ONLY: tauao, taudo, dairo
228 #endif
229  USE w3bullmd, ONLY: nptab, nfld, npmax, bhsmin, bhsdrop, iyy, &
230  hst, tpt, dmt, ascbline, csvbline
231 #ifdef W3_NCO
232  USE w3bullmd, ONLY: cascbline
233 #endif
234 #ifdef W3_O14
235  USE w3odatmd, ONLY: grdid
236 #endif
237 #ifdef W3_IG1
238  USE w3gig1md, ONLY: w3addig
239  USE w3canomd, ONLY: w3add2ndorder
240 #endif
241  !
242  IMPLICIT NONE
243  !/
244  !/ ------------------------------------------------------------------- /
245  !/ Local parameters
246  !/
247  INTEGER :: ndsi, ndsm, ndsop, ndstrc, ntrace, &
248  ierr, i, tout(2), nout, tdum(2), &
249  nreq, ipoint, itype, otype, ndstab, &
250  iotest, ik, ith, iout, j, dimxp, &
251  ndsbul, ndscsv, icsv, ij
252 #ifdef W3_NCO
253  INTEGER :: ndscbul
254 #endif
255  INTEGER :: iscale = 0
256  INTEGER :: timev(2)
257 #ifdef W3_O14
258  INTEGER :: ndbo
259 #endif
260 #ifdef W3_S
261  INTEGER, SAVE :: ient = 0
262 #endif
263  REAL :: dtreq, scale1, scale2, dtest
264  REAL :: m2km
265  REAL, ALLOCATABLE :: xpart(:,:)
266  LOGICAL :: flform, flsrce(7)
267  LOGICAL, ALLOCATABLE :: flreq(:)
268  CHARACTER :: comstr*1, idtime*23, iddday*11, &
269  tabnme*9, tfname*16
270  CHARACTER(LEN=25) :: idsrce(7)
271  CHARACTER :: hstr*6, htype*3
272  !/
273  !/ ------------------------------------------------------------------- /
274  !/
275  DATA idsrce / 'Spectrum ' , &
276  'Wind-wave interactions ' , &
277  'Nonlinear interactions ' , &
278  'Dissipation ' , &
279  'Wave-bottom interactions ' , &
280  'Wave-ice interactions ' , &
281  'Sum of selected sources ' /
282  flsrce = .false.
283  !
284 #ifdef W3_NCO
285  ! CALL W3TAGB('WAVESPEC',1998,0007,0050,'NP21 ')
286 #endif
287  !
288  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
289  ! 1. IO set-up.
290  !
291  CALL w3nmod ( 1, 6, 6 )
292  CALL w3setg ( 1, 6, 6 )
293  CALL w3ndat ( 6, 6 )
294  CALL w3setw ( 1, 6, 6 )
295 #ifdef W3_NL1
296  CALL w3naux ( 6, 6 )
297  CALL w3seta ( 1, 6, 6 )
298 #endif
299  CALL w3nout ( 6, 6 )
300  CALL w3seto ( 1, 6, 6 )
301  !
302  ndsi = 10
303  ndsm = 20
304  ndsop = 20
305  ndsbul = 0
306 #ifdef W3_NCO
307  ndscbul = 0
308 #endif
309  !
310  ndstrc = 6
311  ntrace = 10
312  CALL itrace ( ndstrc, ntrace )
313 
314  !
315 #ifdef W3_S
316  CALL strace (ient, 'W3OUTP')
317 #endif
318  !
319 #ifdef W3_NCO
320  !
321  ! Redo according to NCO
322  !
323  ndsi = 11
324  ndso = 6
325  ndse = ndso
326  ndst = ndso
327  ndsm = 12
328  ndsop = 13
329 #endif
330 #ifdef W3_O14
331  ndbo = 14
332 #endif
333 #ifdef W3_NCO
334  ndstrc = ndso
335 #endif
336  !
337  WRITE (ndso,900)
338  !
339  j = len_trim(fnmpre)
340  OPEN (ndsi,file=fnmpre(:j)//'ww3_outp.inp',status='OLD', &
341  err=800,iostat=ierr)
342  READ (ndsi,'(A)',END=801,ERR=802) comstr
343  IF (comstr.EQ.' ') comstr = '$'
344  WRITE (ndso,901) comstr
345  !
346  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
347  ! 2. Read model definition file.
348  !
349  CALL w3iogr ( 'READ', ndsm )
350  WRITE (ndso,920) gname
351  !
352  IF ( flagll ) THEN
353  m2km = 1.
354  ELSE
355  m2km = 1.e-3
356  END IF
357  !
358  dimxp = ((nk+1)/2) * ((nth-1)/2)
359  ALLOCATE ( xpart(dimp,0:dimxp) )
360  xpart = undef
361  !
362  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
363  ! 3. Read general data and first fields from file
364  !
365 #if W3_BIN2NC
366  CALL w3iopon ( 'READ', ndsop, iotest )
367 #else
368  CALL w3iopo ( 'READ', ndsop, iotest )
369 #endif
370  !
371  WRITE (ndso,930)
372  DO i=1, nopts
373  IF ( flagll ) THEN
374  WRITE (ndso,931) ptnme(i), m2km*ptloc(1,i), m2km*ptloc(2,i)
375  ELSE
376  WRITE (ndso,932) ptnme(i), m2km*ptloc(1,i), m2km*ptloc(2,i)
377  END IF
378  END DO
379  !
380  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
381  ! 4. Read requests from input file.
382  ! Output times
383  !
384  CALL nextln ( comstr , ndsi , ndse )
385  READ (ndsi,*,END=801,ERR=802) TOUT, DTREQ, nout
386  dtreq = max( 0. , dtreq )
387  IF ( dtreq.EQ.0 ) nout = 1
388  nout = max( 1 , nout )
389  !
390  CALL stme21 ( tout , idtime )
391  WRITE (ndso,940) idtime
392  !
393  tdum = 0
394  CALL tick21 ( tdum , dtreq )
395  CALL stme21 ( tdum , idtime )
396  IF ( dtreq .GE. 86400. ) THEN
397  WRITE (iddday,'(I10,1X)') int(dtreq/86400.)
398  ELSE
399  iddday = ' '
400  END IF
401  idtime(1:11) = iddday
402  idtime(21:23) = ' '
403  WRITE (ndso,941) idtime, nout
404  !
405  ! ... Output points
406  !
407  ALLOCATE ( flreq(nopts) )
408  flreq = .false.
409  nreq = 0
410  !
411  DO i=1, nopts
412  ! reads point index
413  CALL nextln ( comstr , ndsi , ndse )
414  READ (ndsi,*,END=801,ERR=802) ipoint
415  ! last index
416  IF (ipoint .LT. 0) THEN
417  IF (i.EQ.1) THEN
418  flreq = .true.
419  nreq = nopts
420  END IF
421  EXIT
422  END IF
423  ! existing index in out_pnt.ww3
424  IF ( (ipoint .GT. 0) .AND. (ipoint .LE. nopts) ) THEN
425  IF ( .NOT. flreq(ipoint) ) THEN
426  nreq = nreq + 1
427  END IF
428  flreq(ipoint) = .true.
429  END IF
430  ! read the 'end of list' if nopts reached before it
431  IF ( (ipoint .GT. 0) .AND. (nreq .EQ. nopts) ) THEN
432  CALL nextln ( comstr , ndsi , ndse )
433  READ (ndsi,*,END=801,ERR=802) ipoint
434  END IF
435  END DO
436  ! check if last point index is -1
437  IF (ipoint .NE. -1) THEN
438  WRITE (ndse,1007)
439  CALL extcde ( 47 )
440  END IF
441 
442  !
443  ! ... Output type
444  !
445  CALL nextln ( comstr , ndsi , ndse )
446  READ (ndsi,*,END=801,ERR=802) itype
447  !
448  ! ... ITYPE = 0
449  !
450  IF ( itype .EQ. 0 ) THEN
451  !
452 #ifdef W3_O14
453  WRITE (ndso,942) itype, 'Generating buoy log file'
454  OPEN (ndbo,file=fnmpre(:j)//'buoy_log.ww3', &
455  status='NEW',err=805,iostat=ierr)
456  DO i = 1,nopts
457  WRITE(ndbo,945) i, ptnme(i), ptloc(1,i), &
458  ptloc(2,i), grdid(i)
459  END DO
460  CLOSE(ndbo)
461 #endif
462  !
463  WRITE (ndso,942) itype, 'Checking contents of file'
464  DO
465  CALL stme21 ( time , idtime )
466  WRITE (ndso,948) idtime
467 #ifdef W3_BIN2NC
468  CALL w3iopon ( 'READ', ndsop, iotest )
469 #else
470  CALL w3iopo ( 'READ', ndsop, iotest )
471 #endif
472  IF ( iotest .EQ. -1 ) THEN
473  WRITE (ndso,949)
474  GOTO 888
475  END IF
476  END DO
477  !
478  ! ... ITYPE = 1
479  !
480  ELSE IF (itype .EQ. 1) THEN
481  WRITE (ndso,942) itype, '1-D and/or 2-D spectra'
482  CALL nextln ( comstr , ndsi , ndse )
483  READ (ndsi,*,END=801,ERR=802) OTYPE, SCALE1, SCALE2, &
484  ndstab, flform
485 #ifdef W3_NCO
486  ndstab = 51
487 #endif
488  IF (otype .EQ. 1) THEN
489  WRITE (ndso,943) 'print plots'
490  IF ( scale1 .LT. 0. ) THEN
491  WRITE (ndso,1940) '1-D'
492  ELSE IF ( scale1 .EQ. 0. ) THEN
493  WRITE (ndso,1941) '1-D'
494  ELSE
495  WRITE (ndso,1942) '1-D', scale1
496  END IF
497  IF ( scale2 .LT. 0. ) THEN
498  WRITE (ndso,1940) '2-D'
499  ELSE IF ( scale2 .EQ. 0. ) THEN
500  WRITE (ndso,1941) '2-D'
501  ELSE
502  WRITE (ndso,1942) '2-D', scale2
503  END IF
504  ELSE IF ( otype .EQ. 2 ) THEN
505  WRITE (ndso,943) 'Table of 1-D spectral data'
506  tabnme = 'tab--.ww3'
507  IF ( ndstab.LE.0 .OR. ndstab.GT.99 ) ndstab = 51
508  WRITE ( tabnme(4:5) , '(I2.2)' ) ndstab
509  j = len_trim(fnmpre)
510  OPEN (ndstab,file=fnmpre(:j)//tabnme,err=803,iostat=ierr)
511  WRITE (ndso,1947) tabnme
512  ELSE IF ( otype .EQ. 3 ) THEN
513  tfname = 'ww3.--------.spc'
514  WRITE (tfname(5:12),'(I6.6,I2.2)') &
515  mod(tout(1),1000000), tout(2)/10000
516  WRITE (ndso,943) 'Transfer file'
517  IF ( flform ) THEN
518  WRITE (ndso,1943) tfname, 'UNFORMATTED'
519  j = len_trim(fnmpre)
520  OPEN (ndstab,file=fnmpre(:j)//tfname,err=804, &
521  iostat=ierr,form='UNFORMATTED', convert=file_endian)
522  WRITE (ndstab) 'WAVEWATCH III SPECTRA', &
523  nk, nth, nreq, gname
524  WRITE (ndstab) (sig(ik)*tpiinv,ik=1,nk)
525  !
526  ! conversion of directions from trignonmetric to nautical (still uses directions TO )
527  !
528  WRITE (ndstab) (mod(2.5*pi-th(ith),tpi),ith=1,nth)
529 
530  ELSE
531  WRITE (ndso,1943) tfname, 'FORMATTED'
532  j = len_trim(fnmpre)
533  OPEN (ndstab,file=fnmpre(:j)//tfname,err=804, &
534  iostat=ierr,form='FORMATTED')
535  WRITE (ndstab,1944) 'WAVEWATCH III SPECTRA', &
536  nk, nth, nreq, gname
537  WRITE (ndstab,1945) (sig(ik)*tpiinv,ik=1,nk)
538  WRITE (ndstab,1946) &
539  (mod(2.5*pi-th(ith),tpi),ith=1,nth)
540  END IF
541  ELSE
542  WRITE (ndse,1011) otype
543  CALL extcde ( 10 )
544  END IF
545  !
546  ! ... ITYPE = 2
547  !
548  ELSE IF (itype .EQ. 2) THEN
549  WRITE (ndso,942) itype, 'Table of mean wave parameters'
550  CALL nextln ( comstr , ndsi , ndse )
551  READ (ndsi,*,END=801,ERR=802) OTYPE, ndstab
552 #ifdef W3_NCO
553  ndstab = 51
554 #endif
555  tabnme = 'tab--.ww3'
556  IF ( ndstab.LE.0 .OR. ndstab.GT.99 ) ndstab = 51
557  WRITE ( tabnme(4:5) , '(I2.2)' ) ndstab
558  j = len_trim(fnmpre)
559  OPEN (ndstab,file=fnmpre(:j)//tabnme,err=803,iostat=ierr)
560  IF ( otype .EQ. 1 ) THEN
561  WRITE (ndso,2940) 'Depth, current and wind', tabnme
562  ELSE IF ( otype .EQ. 2 ) THEN
563  WRITE (ndso,2940) 'Mean wave parameters', tabnme
564  ELSE IF ( otype .EQ. 3 ) THEN
565  WRITE (ndso,2940) 'Nondimensional parameters (U*)', &
566  tabnme
567  ELSE IF ( otype .EQ. 4 ) THEN
568  WRITE (ndso,2940) 'Nondimensional parameters (U10)', &
569  tabnme
570  ELSE IF ( otype .EQ. 5 ) THEN
571  WRITE (ndso,2940) 'Validation parameters', tabnme
572  ELSE IF ( otype .EQ. 6 ) THEN
573  WRITE (ndso,2940) 'WMO standard mean parameters', tabnme
574  ELSE
575  WRITE (ndse,1011) otype
576  CALL extcde ( 20 )
577  END IF
578  !
579  ! ... ITYPE = 3
580  !
581  ELSE IF (itype .EQ. 3) THEN
582  WRITE (ndso,942) itype, 'Source terms'
583  CALL nextln ( comstr , ndsi , ndse )
584  READ (ndsi,*,END=801,ERR=802) OTYPE, SCALE1, SCALE2, &
585  ndstab, flsrce, iscale, flform
586 #ifdef W3_NCO
587  ndstab = 51
588 #endif
589  iscale = max( 0 , min( 5 , iscale ) )
590  IF ( otype .EQ. 1 ) THEN
591  WRITE (ndso,943) 'Print plots'
592  ELSE IF ( otype .EQ. 2 ) THEN
593  IF ( iscale .LE. 2) THEN
594  WRITE (ndso,943) 'Tables as a function of freq.'
595  ELSE
596  WRITE (ndso,943) 'Tables as a function of f/fp.'
597  END IF
598  IF ( mod(iscale,3) .EQ. 1 ) THEN
599  WRITE (ndso,944) '(nondimensional based on U10)'
600  ELSE IF ( mod(iscale,3) .EQ. 2) THEN
601  WRITE (ndso,944) '(nondimensional based on U*)'
602  END IF
603  ELSE IF ( otype .EQ. 3 ) THEN
604  IF ( iscale .LE. 2) THEN
605  WRITE (ndso,943) 'Time scales as a function of freq.'
606  ELSE
607  WRITE (ndso,943) 'Time scales as a function of f/fp.'
608  END IF
609  IF ( iscale .EQ. 1 ) THEN
610  WRITE (ndso,944) '(nondimensional based on U10)'
611  ELSE IF ( iscale .EQ. 2) THEN
612  WRITE (ndso,944) '(nondimensional based on U*)'
613  END IF
614  ELSE IF ( otype .EQ. 4 ) THEN
615  tfname = 'ww3.--------.src'
616  WRITE (tfname(5:12),'(I6.6,I2.2)') &
617  mod(tout(1),1000000), tout(2)/10000
618  WRITE (ndso,943) 'Transfer file'
619  IF ( flform ) THEN
620  WRITE (ndso,3943) tfname, 'UNFORMATTED'
621  j = len_trim(fnmpre)
622  OPEN (ndstab,file=fnmpre(:j)//tfname,err=804, &
623  iostat=ierr,form='UNFORMATTED', convert=file_endian)
624  WRITE (ndstab) 'WAVEWATCH III SOURCES', &
625  nk, nth, nreq, flsrce
626  WRITE (ndstab) (sig(ik)*tpiinv,ik=1,nk)
627  WRITE (ndstab) (mod(2.5*pi-th(ith),tpi),ith=1,nth)
628 
629  ELSE
630  WRITE (ndso,3943) tfname, 'FORMATTED'
631  j = len_trim(fnmpre)
632  OPEN (ndstab,file=fnmpre(:j)//tfname,err=804, &
633  iostat=ierr,form='FORMATTED')
634  WRITE (ndstab,3944) 'WAVEWATCH III SOURCES', &
635  nk, nth, nreq, flsrce
636  WRITE (ndstab,3945) (sig(ik)*tpiinv,ik=1,nk)
637  WRITE (ndstab,3946) &
638  (mod(2.5*pi-th(ith),tpi),ith=1,nth)
639  END IF
640  ELSE
641  WRITE (ndse,1011) otype
642  CALL extcde ( 30 )
643  END IF
644  !
645  DO i=1, 7
646  IF ( flsrce(i) ) WRITE (ndso,3940) idsrce(i)
647  END DO
648  WRITE (ndso,*) ' '
649  !
650  IF ( otype .EQ. 1 ) THEN
651  IF ( scale1 .LT. 0. ) THEN
652  WRITE (ndso,1940) '1-D'
653  ELSE IF ( scale1 .EQ. 0. ) THEN
654  WRITE (ndso,1941) '1-D'
655  ELSE
656  WRITE (ndso,1942) '1-D', scale1
657  END IF
658  IF ( scale2 .LT. 0. ) THEN
659  WRITE (ndso,1940) '2-D'
660  ELSE IF ( scale2 .EQ. 0. ) THEN
661  WRITE (ndso,1941) '2-D'
662  ELSE
663  WRITE (ndso,1942) '2-D', scale2
664  END IF
665  END IF
666  !
667  IF ( otype.EQ.2 .OR. otype.EQ.3 ) THEN
668  tabnme = 'tab--.ww3'
669  IF ( ndstab.LE.0 .OR. ndstab.GT.99 ) ndstab = 51
670  WRITE ( tabnme(4:5) , '(I2.2)' ) ndstab
671  j = len_trim(fnmpre)
672  OPEN (ndstab,file=fnmpre(:j)//tabnme,err=803,iostat=ierr)
673  WRITE (ndso,3941) tabnme
674  END IF
675  !
676  ! ... ITYPE = 4
677  !
678  ELSE IF (itype .EQ. 4) THEN
679  WRITE (ndso,942) itype, 'Spectral partitions or bulletins'
680  CALL nextln ( comstr , ndsi , ndse )
681  READ (ndsi,*,END=801,ERR=802) OTYPE, NDSTAB, TIMEV, htype
682 #ifdef W3_NCO
683  ndstab = 51
684 #endif
685  IF ( otype .EQ. 1 ) THEN
686  WRITE (ndso,943) 'Partitioning of spectra'
687  tabnme = 'tab--.ww3'
688  IF ( ndstab.LE.0 .OR. ndstab.GT.99 ) ndstab = 51
689  WRITE ( tabnme(4:5) , '(I2.2)' ) ndstab
690  j = len_trim(fnmpre)
691  OPEN (ndstab,file=fnmpre(:j)//tabnme,err=803,iostat=ierr)
692  WRITE (ndso,1947) tabnme
693 
694  ELSEIF ( otype .GE. 2 ) THEN
695  IF (otype .EQ. 2 .OR. otype .EQ. 4 ) THEN
696  WRITE (ndso,943) 'Bulletins, ASCII format'
697  j = len_trim(fnmpre)
698  DO ij = 1,nopts
699  IF ( count(flreq) .GT. 1 ) THEN
700  ! ... This version only allows single point output for bulletins
701  WRITE (ndse,1012) otype
702  CALL extcde ( 45 )
703  ENDIF
704  IF (flreq(ij)) THEN
705  ndsbul = ndstab + (ij - 1)
706  OPEN(ndsbul,file=trim(ptnme(ij))//'.bull',err=803,iostat=ierr)
707  WRITE (ndso,1947) trim(ptnme(ij))//'.bull'
708 #ifdef W3_NCO
709  ndscbul = ndstab + (ij - 1) + nopts
710  OPEN(ndscbul,file=trim(ptnme(ij))//'.cbull',err=803,iostat=ierr)
711  WRITE (ndso,1947) trim(ptnme(ij))//'.cbull'
712 #endif
713  ENDIF
714  ENDDO
715  ENDIF
716  IF ( otype .EQ. 3 .OR. otype .EQ. 4 ) THEN
717  WRITE (ndso,943) 'Bulletins, CSV format'
718  j = len_trim(fnmpre)
719  DO ij = 1,nopts
720  IF (flreq(ij)) THEN
721  icsv = 0
722  IF ( ndsbul .GT. 0 ) icsv = ndsbul
723 #ifdef W3_NCO
724  IF ( ndscbul .GT. 0 ) icsv = ndscbul
725 #endif
726  ndscsv = ndstab + (ij - 1) + icsv
727  OPEN(ndscsv,file=trim(ptnme(ij))//'.csv',err=803,iostat=ierr)
728  WRITE (ndso,1947) trim(ptnme(ij))//'.csv'
729  ENDIF
730  ENDDO
731  ENDIF
732  ELSE
733  WRITE (ndse,1011) otype
734  CALL extcde ( 50 )
735  END IF
736  !
737  ! ... ITYPE = ILLEGAL
738  !
739  ELSE
740  WRITE (ndse,1010) itype
741  CALL extcde ( 1 )
742  !
743  END IF
744  !
745  ! ... Output of output points
746  !
747  WRITE (ndso,950) nreq
748  DO i=1, nopts
749  IF (flreq(i)) THEN
750  IF ( flagll ) THEN
751  WRITE (ndso,951) ptnme(i), m2km*ptloc(1,i), &
752  m2km*ptloc(2,i)
753  ELSE
754  WRITE (ndso,953) ptnme(i), m2km*ptloc(1,i), &
755  m2km*ptloc(2,i)
756  END IF
757  END IF
758  END DO
759  !
760  IF ( itype.EQ.3 .AND. otype.EQ.4 ) WRITE (ndso,952)
761  !
762  !--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
763  ! 5. Time management.
764  !
765  iout = 0
766  !
767  ! remark: it would be better to write these warnings only if source term
768  ! output is requested
769 #ifdef W3_IC1
770  WRITE(ndso,3960)
771 #endif
772 #ifdef W3_IC2
773  WRITE(ndso,3960)
774 #endif
775 #ifdef W3_IC3
776  WRITE(ndso,3960)
777 #endif
778 #ifdef W3_IC4
779  WRITE(ndso,3960)
780 #endif
781 #ifdef W3_IC5
782  WRITE(ndso,3960)
783 #endif
784 #ifdef W3_NL5
785  WRITE(ndso,3961)
786 #endif
787 
788  DO
789  dtest = dsec21( time , tout )
790  IF ( dtest .GT. 0. ) THEN
791 #ifdef W3_BIN2NC
792  CALL w3iopon ( 'READ', ndsop, iotest )
793 #else
794  CALL w3iopo ( 'READ', ndsop, iotest )
795 #endif
796  IF ( iotest .EQ. -1 ) THEN
797  WRITE (ndso,949)
798  EXIT
799  END IF
800  cycle
801  END IF
802  IF ( dtest .LT. 0. ) THEN
803  CALL tick21 ( tout , dtreq )
804  cycle
805  END IF
806  !
807  iout = iout + 1
808  CALL stme21 ( tout , idtime )
809  IF ( ( itype.EQ.1 .AND. otype.EQ.1 ) .OR. &
810  ( itype.EQ.3 .AND. otype.EQ.1 ) &
811  ) WRITE (ndso,960) idtime
812  CALL w3expo
813  CALL tick21 ( tout , dtreq )
814  IF ( iout .GE. nout ) EXIT
815  END DO
816  !
817  ! ... ITYPE=4 & OTYPES=[2,4] requires adding lines at bottom of
818  ! bulletin output for compatibility with version 2.22
819  !
820  IF (itype .EQ. 4 .AND. ( otype .EQ. 2 .OR. otype .EQ. 4 ) ) THEN
821  DO ij = 1,nopts
822  IF (flreq(ij)) THEN
823  ndsbul = ndstab + (ij - 1)
824  WRITE(ndsbul,971)
825  WRITE(ndsbul,974) bhsdrop, bhsmin
826 #ifdef W3_NCO
827  ndscbul = ndstab + (ij - 1) + nopts
828  WRITE(ndscbul,961)
829  WRITE(ndscbul,962)
830 #endif
831  ENDIF
832  ENDDO
833  ENDIF
834  !
835  GOTO 888
836  !
837  ! Escape locations read errors :
838  !
839 800 CONTINUE
840  WRITE (ndse,1000) ierr
841  CALL extcde ( 40 )
842  !
843 801 CONTINUE
844  WRITE (ndse,1001)
845  CALL extcde ( 41 )
846  !
847 802 CONTINUE
848  WRITE (ndse,1002) ierr
849  CALL extcde ( 42 )
850  !
851 803 CONTINUE
852  WRITE (ndse,1003) ierr
853  CALL extcde ( 43 )
854  !
855 804 CONTINUE
856  WRITE (ndse,1004) ierr
857  CALL extcde ( 44 )
858  !
859 #ifdef W3_O14
860 805 CONTINUE
861  WRITE (ndse,1005) ierr
862  CALL extcde ( 45 )
863 #endif
864  !
865 888 CONTINUE
866  !
867  WRITE (ndso,999)
868  !
869 #ifdef W3_NCO
870  ! CALL W3TAGE('WAVESPEC')
871 #endif
872  !
873  ! Formats
874  !
875 900 FORMAT (/15x,' *** WAVEWATCH III Point output post.*** '/ &
876  15x,'==============================================='/)
877 901 FORMAT ( ' Comment character is ''',a,''''/)
878  !
879 920 FORMAT ( ' Grid name : ',a/)
880  !
881 930 FORMAT ( ' Points in file : '/ &
882  ' ------------------------------------')
883 931 FORMAT ( ' ',a,2f10.2)
884 932 FORMAT ( ' ',a,2(f8.1,'E3'))
885  !
886 940 FORMAT (/' Output time data : '/ &
887  ' --------------------------------------------------'/ &
888  ' First time : ',a)
889 941 FORMAT ( ' Interval : ',a/ &
890  ' Number of requests : ',i6)
891 942 FORMAT (/' Output type ',i2,' :'/ &
892  ' --------------------------------------------------'/ &
893  ' ',a/)
894 943 FORMAT ( ' Subtype : ',a)
895 944 FORMAT ( ' ',a)
896 #ifdef W3_O14
897 945 FORMAT ( ' ',i5,3x,a,2f10.2,3x,a)
898 #endif
899 948 FORMAT ( ' Data for ',a)
900 949 FORMAT (/' End of file reached '/)
901  !
902 950 FORMAT (/' Requested output for',i3,' points : '/ &
903  ' --------------------------------------------------')
904 951 FORMAT ( ' ',a,2f10.2)
905 953 FORMAT ( ' ',a,2(f8.1,'E3'))
906 952 FORMAT (/' Output times :'/ &
907  ' --------------------------------------------------')
908 #ifdef W3_NCO
909 961 FORMAT ('----------------------------------------', &
910  '---------------------------')
911 962 FORMAT ( 'DD = Day of Month'/ &
912  'HH = Hour of Day'/ &
913  'HS = Total Significant Wave Height (feet)'/ &
914  'SS = Significant Wave Height of separate system (feet)'/ &
915  'PP = Peak Period of separate system (whole seconds)'/ &
916  'DDD = Mean Direction of separate system (degrees,"from")')
917 #endif
918 971 FORMAT (' +-------+-----------+-----------------+', &
919  '-----------------+-----------------+----', &
920  '-------------+-----------------+--------', &
921  '---------+')!
922 974 FORMAT ( &
923  75x,'Hst : Total sigificant wave height.'/ &
924  75x,'n : Number of fields with Hs > ',f4.2, &
925  ' in 2-D spectrum.'/ &
926  75x,'x : Number of fields with Hs > ',f4.2, &
927  ' not in table.'/ &
928  75x,'Hs : Significant wave height of separate wave field.'/ &
929  75x,'Tp : Peak period of separate wave field.'/ &
930  75x,'dir : Mean direction of separate wave field.'/ &
931  75x,'* : Wave generation due to local wind probable.')
932 
933 1940 FORMAT ( ' ',a,' print plots not requested.')
934 1941 FORMAT ( ' ',a,' print plots normalized.')
935 1942 FORMAT ( ' Scale factor ',a,' spectrum : ',e10.3)
936 1943 FORMAT ( ' File name : ',a,' (',a,')')
937 1944 FORMAT ('''',a,'''',1x,3i6,1x,'''',a,'''')
938 1945 FORMAT (8e10.3)
939 1946 FORMAT (7e11.3)
940 1947 FORMAT ( ' File name : ',a)
941  !
942 2940 FORMAT ( ' Table output : ',a/ &
943  ' File name : ',a)
944  !
945 3940 FORMAT ( ' ',a)
946 3941 FORMAT ( ' File name : ',a)
947 3943 FORMAT ( ' File name : ',a,' (',a,')')
948 3944 FORMAT ('''',a,'''',1x,3i6,6l2)
949 3945 FORMAT (8e10.3)
950 3946 FORMAT (7e11.3)
951  !
952 960 FORMAT (//' Output for ',a/ &
953  ' --------------------------------------------------')
954  !
955 999 FORMAT (/' End of program '/ &
956  ' ========================================='/ &
957  ' WAVEWATCH III Point output '/)
958  !
959 1000 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUTP : '/ &
960  ' ERROR IN OPENING INPUT FILE'/ &
961  ' IOSTAT =',i5/)
962  !
963 1001 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUTP : '/ &
964  ' PREMATURE END OF INPUT FILE'/)
965  !
966 1002 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUTP : '/ &
967  ' ERROR IN READING FROM INPUT FILE'/ &
968  ' IOSTAT =',i5/)
969  !
970 1003 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUTP : '/ &
971  ' ERROR IN OPENING TABLE FILE'/ &
972  ' IOSTAT =',i5/)
973  !
974 1004 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUTP : '/ &
975  ' ERROR IN OPENING IDL FILE'/ &
976  ' IOSTAT =',i5/)
977  !
978 #ifdef W3_O14
979 1005 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUTP : '/ &
980  ' ERROR IN OPENING BUOY LOG FILE'/ &
981  ' IOSTAT =',i5/)
982 #endif
983  !
984 1007 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUTP : '/ &
985  ' ERROR IN READING FROM INPUT FILE'/ &
986  ' LAST POINT INDEX IS NOT -1'/ &
987  ' OR TOO MANY POINT INDEXES DEFINED'/)
988  !
989 1010 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUTP : '/ &
990  ' ILLEGAL TYPE, ITYPE =',i4/)
991  !
992 1011 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUTP : '/ &
993  ' ILLEGAL TYPE, OTYPE =',i4/)
994  !
995 1012 FORMAT (/' *** WAVEWATCH III ERROR IN W3OUTP : '/ &
996  ' MULTIPLE OUTPUT POINTS DEFINED, ITYPE =',i4,/ &
997  ' ONLY SINGLE POINT ALLOWED IN THIS VERSION'/)
998 #ifdef W3_IC1
999 3960 FORMAT (/' *** WAVEWATCH-III WARNING IN W3OUTP :'/ &
1000  ' Ice source terms !/IC1 skipped'/ &
1001  ' in dissipation term.'/)
1002 #endif
1003 #ifdef W3_IC2
1004 3960 FORMAT (/' *** WAVEWATCH-III WARNING IN W3OUTP :'/ &
1005  ' Ice source terms !/IC2 skipped'/ &
1006  ' in dissipation term.'/)
1007 #endif
1008 #ifdef W3_IC3
1009 3960 FORMAT (/' *** WAVEWATCH-III WARNING IN W3OUTP :'/ &
1010  ' Ice source terms !/IC3 skipped'/ &
1011  ' in dissipation term.'/)
1012 #endif
1013 #ifdef W3_IC4
1014 3960 FORMAT (/' *** WAVEWATCH-III WARNING IN W3OUTP :'/ &
1015  ' Ice source terms !/IC4 skipped'/ &
1016  ' in dissipation term.'/)
1017 #endif
1018 #ifdef W3_IC5
1019 3960 FORMAT (/' *** WAVEWATCH-III WARNING IN W3OUTP :'/ &
1020  ' Ice source terms !/IC5 skipped'/ &
1021  ' in dissipation term.'/)
1022 #endif
1023 #ifdef W3_NL5
1024 3961 FORMAT (/' *** WAVEWATCH-III WARNING IN W3OUTP :'/ &
1025  ' Snl source terms !/NL5 skipped'/ &
1026  ' in interaction term.'/)
1027 #endif
1028  !
1029  !/
1030  !/ Internal subroutine W3EXPO ---------------------------------------- /
1031  !/
1032 CONTAINS
1033  !/ ------------------------------------------------------------------- /
1034 
1044  SUBROUTINE w3expo
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  !/
2863  END SUBROUTINE w3expo
2864  !/
2865  !/ End of W3OUTP ----------------------------------------------------- /
2866  !/
2867 END PROGRAM w3outp
w3dispmd::dfac
real, parameter dfac
Definition: w3dispmd.F90:75
constants::pi
real, parameter pi
PI Value of Pi.
Definition: constants.F90:71
w3timemd::dsec21
real function dsec21(TIME1, TIME2)
Definition: w3timemd.F90:333
w3servmd::nextln
subroutine nextln(CHCKC, NDSI, NDSE)
Definition: w3servmd.F90:222
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
w3iopomd::w3iopon_write
subroutine w3iopon_write(timestep_only, filename, ncerr)
Write point output in netCDF format.
Definition: w3iopomd.F90:1427
w3bullmd::cascbline
character(len=67) cascbline
Definition: w3bullmd.F90:53
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
w3adatmd
Define data structures to set up wave model auxiliary data for several models simultaneously.
Definition: w3adatmd.F90:26
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
w3wdatmd
Define data structures to set up wave model dynamic data for several models simultaneously.
Definition: w3wdatmd.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
w3bullmd::tpt
real, dimension(nptab, 2) tpt
Definition: w3bullmd.F90:48
w3odatmd::nopts
integer, pointer nopts
Definition: w3odatmd.F90:484
w3bullmd::ascbline
character(len=129) ascbline
Definition: w3bullmd.F90:50
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
w3odatmd::grdid
character(len=13), dimension(:), pointer grdid
Definition: w3odatmd.F90:502
w3bullmd::iyy
logical, dimension(npmax) iyy
Definition: w3bullmd.F90:55
w3wdatmd::time
integer, dimension(:), pointer time
Definition: w3wdatmd.F90:172
w3bullmd::hst
real, dimension(nptab, 2) hst
Definition: w3bullmd.F90:48
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
w3bullmd::bhsmin
real, parameter bhsmin
Definition: w3bullmd.F90:47
w3odatmd::fnmpre
character(len=80) fnmpre
Definition: w3odatmd.F90:330
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
w3odatmd::dpo
real, dimension(:), pointer dpo
Definition: w3odatmd.F90:492
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
w3odatmd::wdo
real, dimension(:), pointer wdo
Definition: w3odatmd.F90:492
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
w3gdatmd::w3setg
subroutine w3setg(IMOD, NDSE, NDST)
Definition: w3gdatmd.F90:2152
w3odatmd::ndse
integer, pointer ndse
Definition: w3odatmd.F90:456
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::w3seta
subroutine w3seta(IMOD, NDSE, NDST)
Select one of the WAVEWATCH III grids / models.
Definition: w3adatmd.F90:2645
w3odatmd::ptloc
real, dimension(:,:), pointer ptloc
Definition: w3odatmd.F90:492
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
w3wdatmd::w3ndat
subroutine w3ndat(NDSE, NDST)
Set up the number of grids to be used.
Definition: w3wdatmd.F90:210
w3canomd
Calculation of the second order correction to the surface gravity wave spectrum.
Definition: w3canomd.F90:23
w3servmd
Definition: w3servmd.F90:3
w3bullmd::nptab
integer, parameter nptab
Definition: w3bullmd.F90:45
w3bullmd::dmt
real, dimension(nptab, 2) dmt
Definition: w3bullmd.F90:48
w3timemd::tick21
subroutine tick21(TIME, DTIME)
Definition: w3timemd.F90:84
w3wdatmd::w3setw
subroutine w3setw(IMOD, NDSE, NDST)
Select one of the WAVEWATCH III grids / models.
Definition: w3wdatmd.F90:660
w3odatmd::wao
real, dimension(:), pointer wao
Definition: w3odatmd.F90:492
w3bullmd::csvbline
character(len=664) csvbline
Definition: w3bullmd.F90:51
constants::tpiinv
real, parameter tpiinv
TPIINV Inverse of 2*Pi.
Definition: constants.F90:74
w3odatmd::w3seto
subroutine w3seto(IMOD, NDSERR, NDSTST)
Definition: w3odatmd.F90:1523
w3timemd::stme21
subroutine stme21(TIME, DTME21)
Definition: w3timemd.F90:682
w3gig1md
Definition: w3gig1md.F90:3
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
w3odatmd
Definition: w3odatmd.F90:3
w3dispmd::ecg1
real, dimension(0:nar1d) ecg1
Definition: w3dispmd.F90:78
w3adatmd::w3naux
subroutine w3naux(NDSE, NDST)
Set up the number of grids to be used.
Definition: w3adatmd.F90:704
w3gdatmd::iicedisp
logical, pointer iicedisp
Definition: w3gdatmd.F90:1217
constants::dwat
real, parameter dwat
DWAT Density of water (kg/m3).
Definition: constants.F90:62
w3iopomd::w3iopon_read
subroutine w3iopon_read(IOTST, IMOD_IN, filename, ncerr)
Read point output in netCDF format.
Definition: w3iopomd.F90:1152
w3sbs1md::w3sbs1
subroutine w3sbs1(A, CG, WN, DEPTH, CX1, CY1, TAUSCX, TAUSCY, S, D)
Bottom scattering source term.
Definition: w3sbs1md.F90:114
w3iogrmd::w3iogr
subroutine w3iogr(INXOUT, NDSM, IMOD, FEXT ifdef W3_ASCII
Reading and writing of the model definition file.
Definition: w3iogrmd.F90:117
w3gig1md::w3addig
subroutine w3addig(E, DEPTH, WN, CG, IACTION)
Definition: w3gig1md.F90:147
file
file(STRINGS ${CMAKE_BINARY_DIR}/switch switch_strings) separate_arguments(switches UNIX_COMMAND $
Definition: CMakeLists.txt:3
w3iogrmd
Reading/writing of model definition file.
Definition: w3iogrmd.F90:20
constants::radius
real, parameter radius
RADIUS Radius of the earth (m).
Definition: constants.F90:79
w3iopomd::w3iopon
subroutine w3iopon(INXOUT, NDSOP, IOTST, IMOD)
Read or write the netCDF point output file, depending on the value of the first parameter.
Definition: w3iopomd.F90:1747
w3odatmd::ptnme
character(len=40), dimension(:), pointer ptnme
Definition: w3odatmd.F90:501
w3arrymd::prt1ds
subroutine prt1ds(NDS, NFR, E, FR, UFR, NLINES, FTOPI, PRVAR, PRUNIT, PNTNME)
Definition: w3arrymd.F90:1366
w3outp
program w3outp
Post-processing of point output.
Definition: ww3_outp.F90:36
w3expo
subroutine w3expo
Perform actual point output.
Definition: ww3_outp.F90:1045
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
w3bullmd::nfld
integer, parameter nfld
Definition: w3bullmd.F90:45
w3servmd::strace
subroutine strace(IENT, SNAME)
Definition: w3servmd.F90:148
w3src6md::w3spr6
subroutine, public w3spr6(A, CG, WN, EMEAN, FMEAN, WNMEAN, AMAX, FP)
Calculate mean wave parameters.
Definition: w3src6md.F90:122
w3bullmd::bhsdrop
real, parameter bhsdrop
Definition: w3bullmd.F90:47
w3snl2md::w3snl2
subroutine w3snl2(A, CG, DEPTH, S, D)
Interface to exact interactions.
Definition: w3snl2md.F90:96
w3odatmd::ndso
integer, pointer ndso
Definition: w3odatmd.F90:456
w3gdatmd::w3nmod
subroutine w3nmod(NUMBER, NDSE, NDST, NAUX)
Definition: w3gdatmd.F90:1433
w3arrymd
Definition: w3arrymd.F90:3
w3sis2md
Floe-size dependant scattering of waves in the marginal ice zone.
Definition: w3sis2md.F90:33
w3odatmd::dimp
integer, parameter dimp
Definition: w3odatmd.F90:325
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
w3odatmd::ndst
integer, pointer ndst
Definition: w3odatmd.F90:456
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
constants
Define some much-used constants for global use (all defined as PARAMETER).
Definition: constants.F90:20
w3gdatmd
Definition: w3gdatmd.F90:16
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
constants::file_endian
character(*), parameter file_endian
FILE_ENDIAN Filled by preprocessor with 'big_endian', 'little_endian', or 'native'.
Definition: constants.F90:86
w3servmd::extcde
subroutine extcde(IEXIT, UNIT, MSG, FILE, LINE, COMM)
Definition: w3servmd.F90:736
w3odatmd::w3nout
subroutine w3nout(NDSERR, NDSTST)
Definition: w3odatmd.F90:561
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
w3snl3md
Generalized and optimized multiple DIA implementation.
Definition: w3snl3md.F90:24
w3snl4md
Generic shallow-water Boltzmann integral (FBI or TSA).
Definition: w3snl4md.F90:25
w3bullmd::npmax
integer, parameter npmax
Definition: w3bullmd.F90:45
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
w3servmd::itrace
subroutine itrace(NDS, NMAX)
Definition: w3servmd.F90:91
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
w3timemd
Definition: w3timemd.F90:3
constants::undef
real undef
UNDEF Value for undefined variable in output.
Definition: constants.F90:84
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
w3odatmd::aso
real, dimension(:), pointer aso
Definition: w3odatmd.F90:492
w3iopomd::w3iopo
subroutine w3iopo(INXOUT, NDSOP, IOTST, IMOD ifdef W3_ASCII
Read or write point output.
Definition: w3iopomd.F90:1907
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
w3iopomd
Process point output.
Definition: w3iopomd.F90:19
w3src1md::w3spr1
subroutine w3spr1(A, CG, WN, EMEAN, FMEAN, WNMEAN, AMAX)
Definition: w3src1md.F90:88
w3dispmd::dsie
real dsie
Definition: w3dispmd.F90:78