ROMS
Loading...
Searching...
No Matches
bbl_output.F
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE bbl_output_mod
3
4#if (defined BBL_MODEL || defined WAVES_OUTPUT) && defined SOLVE3D
5!
6!git $Id$
7!================================================== Hernan G. Arango ===
8! Copyright (c) 2002-2025 The ROMS Group !
9! Licensed under a MIT/X style license !
10! See License_ROMS.md !
11!=======================================================================
12! !
13! This module defines/writes Waves Effect on Currents variables into !
14! output NetCDF files. !
15! !
16!=======================================================================
17!
18 USE mod_param
19 USE mod_parallel
20# ifdef AVERAGES
21 USE mod_average
22# endif
23# ifdef BBL_MODEL
24 USE mod_bbl
25# endif
26 USE mod_forces
27 USE mod_grid
28 USE mod_iounits
29 USE mod_mixing
30 USE mod_ncparam
31 USE mod_ocean
32 USE mod_scalars
33# ifdef BBL_MODEL
34 USE mod_sedbed
35# endif
36# ifdef SEDIMENT
37 USE mod_sediment
38# endif
39 USE mod_stepping
40!
41 USE def_var_mod, ONLY : def_var
42# ifdef STATIONS
43 USE extract_sta_mod, ONLY : extract_sta2d
44# ifdef SOLVE3D
45 USE extract_sta_mod, ONLY : extract_sta3d
46# endif
47# endif
48 USE nf_fwrite2d_mod, ONLY : nf_fwrite2d
49# ifdef SOLVE3D
50 USE nf_fwrite3d_mod, ONLY : nf_fwrite3d
51 USE omega_mod, ONLY : scale_omega
52# endif
53 USE strings_mod, ONLY : founderror
54!
55 implicit none
56!
57 PUBLIC :: bbl_def_nf90
58# if defined PIO_LIB && defined DISTRIBUTE
59 PUBLIC :: bbl_def_pio
60# endif
61# ifdef STATIONS
62 PUBLIC :: bbl_def_station_nf90
63# if defined PIO_LIB && defined DISTRIBUTE
64 PUBLIC :: bbl_def_station_pio
65# endif
66# endif
67 PUBLIC :: bbl_wrt_nf90
68# if defined PIO_LIB && defined DISTRIBUTE
69 PUBLIC :: bbl_wrt_pio
70# endif
71# ifdef STATIONS
72 PUBLIC :: bbl_wrt_station_nf90
73# if defined PIO_LIB && defined DISTRIBUTE
74 PUBLIC :: bbl_wrt_station_pio
75# endif
76# endif
77!
78 CONTAINS
79!
80!***********************************************************************
81 SUBROUTINE bbl_def_nf90 (ng, model, ldef, VarOut, S, &
82 & t2dgrd, u2dgrd, v2dgrd)
83!***********************************************************************
84!
85 USE mod_netcdf
86!
87! Imported variable declarations.
88!
89 logical, intent(in) :: ldef, varout(nv,ngrids)
90!
91 integer, intent(in) :: ng, model
92 integer, intent(in), optional :: t2dgrd(:), u2dgrd(:), v2dgrd(:)
93!
94 TYPE(t_io), intent(inout) :: s(ngrids)
95!
96! Local variable declarations.
97!
98 logical :: got_var(nv)
99!
100 integer, parameter :: natt = 25
101
102 integer :: i, j, nvd3, nvd4, status
103!
104 real(r8) :: aval(6)
105!
106# ifdef ADJOINT
107 character (len=21) :: prefix
108# else
109 character (len=13) :: prefix
110# endif
111 character (len=120) :: vinfo(natt)
112 character (len=256) :: ncname
113!
114 character (len=*), parameter :: myfile = &
115 & __FILE__//", bbl_def_nf90"
116!
117 sourcefile=myfile
118!
119!-----------------------------------------------------------------------
120! Define Bottom Boundary Layer (BBFL) and Waves output variables.
121!-----------------------------------------------------------------------
122!
123 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
124 ncname=s(ng)%name
125!
126 define : IF (ldef) THEN
127!
128! Set number of dimensions for output variables.
129!
130# if defined WRITE_WATER && defined MASKING
131 nvd3=2
132 nvd4=2
133# else
134 nvd3=3
135 nvd4=4
136# endif
137!
138! Set long name prefix string.
139!
140# ifdef ADJOINT
141!! Prefix='time-averaged adjoint'
142 prefix='adjoint'
143# else
144!! Prefix='time-averaged'
145 prefix=char(32) ! blank space
146# endif
147!
148! Initialize local information variable arrays.
149!
150 DO i=1,natt
151 DO j=1,len(vinfo(1))
152 vinfo(i)(j:j)=' '
153 END DO
154 END DO
155 DO i=1,6
156 aval(i)=0.0_r8
157 END DO
158
159# if defined BBL_MODEL || defined SED_BEDLOAD_VANDERA || \
160 defined wav_coupling
161!
162! Define wind-induced bottom orbital velocity.
163!
164 IF (varout(idworb,ng)) THEN
165 vinfo( 1)=vname(1,idworb)
166 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
167 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idworb))
168 ELSE
169 vinfo( 2)=vname(2,idworb)
170 END IF
171 vinfo( 3)=vname(3,idworb)
172 vinfo(14)=vname(4,idworb)
173 vinfo(16)=vname(1,idtime)
174# if defined WRITE_WATER && defined MASKING
175 vinfo(20)='mask_rho'
176# endif
177 vinfo(21)=vname(6,idworb)
178 vinfo(22)='coordinates'
179 aval(5)=real(iinfo(1,idworb,ng),r8)
180 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idworb), &
181 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
182 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
183 END IF
184# endif
185
186# ifdef BBL_MODEL
187!
188! Define bottom U-current stress.
189!
190 IF (varout(idubrs,ng)) THEN
191 vinfo( 1)=vname(1,idubrs)
192 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
193 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idubrs))
194 ELSE
195 vinfo( 2)=vname(2,idubrs)
196 END IF
197 vinfo( 3)=vname(3,idubrs)
198 vinfo(14)=vname(4,idubrs)
199 vinfo(16)=vname(1,idtime)
200# if defined WRITE_WATER && defined MASKING
201 vinfo(20)='mask_rho'
202# endif
203 vinfo(21)=vname(6,idubrs)
204 vinfo(22)='coordinates'
205 aval(5)=real(iinfo(1,idubrs,ng),r8)
206 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idubrs), &
207 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
208 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
209 END IF
210!
211! Define bottom V-current stress.
212!
213 IF (varout(idvbrs,ng)) THEN
214 vinfo( 1)=vname(1,idvbrs)
215 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
216 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idvbrs))
217 ELSE
218 vinfo( 2)=vname(2,idvbrs)
219 END IF
220 vinfo( 3)=vname(3,idvbrs)
221 vinfo(14)=vname(4,idvbrs)
222 vinfo(16)=vname(1,idtime)
223# if defined WRITE_WATER && defined MASKING
224 vinfo(20)='mask_rho'
225# endif
226 vinfo(21)=vname(6,idvbrs)
227 vinfo(22)='coordinates'
228 aval(5)=real(iinfo(1,idvbrs,ng),r8)
229 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idvbrs), &
230 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
231 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
232 END IF
233!
234! Define wind-induced, bottom U-wave stress.
235!
236 IF (varout(idubws,ng)) THEN
237 vinfo( 1)=vname(1,idubws)
238 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
239 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idubws))
240 ELSE
241 vinfo( 2)=vname(2,idubws)
242 END IF
243 vinfo( 3)=vname(3,idubws)
244 vinfo(14)=vname(4,idubws)
245 vinfo(16)=vname(1,idtime)
246# if defined WRITE_WATER && defined MASKING
247 vinfo(20)='mask_rho'
248# endif
249 vinfo(21)=vname(6,idubws)
250 vinfo(22)='coordinates'
251 aval(5)=real(iinfo(1,idubws,ng),r8)
252 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idubws), &
253 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
254 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
255 END IF
256!
257! Define bottom wind-induced, bottom V-wave stress.
258!
259 IF (varout(idvbws,ng)) THEN
260 vinfo( 1)=vname(1,idvbws)
261 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
262 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idvbws))
263 ELSE
264 vinfo( 2)=vname(2,idvbws)
265 END IF
266 vinfo( 3)=vname(3,idvbws)
267 vinfo(14)=vname(4,idvbws)
268 vinfo(16)=vname(1,idtime)
269# if defined WRITE_WATER && defined MASKING
270 vinfo(20)='mask_rho'
271# endif
272 vinfo(21)=vname(6,idvbws)
273 vinfo(22)='coordinates'
274 aval(5)=real(iinfo(1,idvbws,ng),r8)
275 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idvbws), &
276 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
277 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
278 END IF
279!
280! Define maximum wind and current, bottom U-wave stress.
281!
282 IF (varout(idubcs,ng)) THEN
283 vinfo( 1)=vname(1,idubcs)
284 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
285 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idubcs))
286 ELSE
287 vinfo( 2)=vname(2,idubcs)
288 END IF
289 vinfo( 3)=vname(3,idubcs)
290 vinfo(14)=vname(4,idubcs)
291 vinfo(16)=vname(1,idtime)
292# if defined WRITE_WATER && defined MASKING
293 vinfo(20)='mask_rho'
294# endif
295 vinfo(21)=vname(6,idubcs)
296 vinfo(22)='coordinates'
297 aval(5)=real(iinfo(1,idubcs,ng),r8)
298 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idubcs), &
299 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
300 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
301 END IF
302!
303! Define maximum wind and current, bottom V-wave stress.
304!
305 IF (varout(idvbcs,ng)) THEN
306 vinfo( 1)=vname(1,idvbcs)
307 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
308 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idvbcs))
309 ELSE
310 vinfo( 2)=vname(2,idvbcs)
311 END IF
312 vinfo( 3)=vname(3,idvbcs)
313 vinfo(14)=vname(4,idvbcs)
314 vinfo(16)=vname(1,idtime)
315# if defined WRITE_WATER && defined MASKING
316 vinfo(20)='mask_rho'
317# endif
318 vinfo(21)=vname(6,idvbcs)
319 vinfo(22)='coordinates'
320 aval(5)=real(iinfo(1,idvbcs,ng),r8)
321 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idvbcs), &
322 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
323 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
324 END IF
325!
326! Define maximum wave and current bottom stress magnitude.
327!
328 IF (varout(iduvwc,ng)) THEN
329 vinfo( 1)=vname(1,iduvwc)
330 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
331 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,iduvwc))
332 ELSE
333 vinfo( 2)=vname(2,iduvwc)
334 END IF
335 vinfo( 3)=vname(3,iduvwc)
336 vinfo(14)=vname(4,iduvwc)
337 vinfo(16)=vname(1,idtime)
338# if defined WRITE_WATER && defined MASKING
339 vinfo(20)='mask_rho'
340# endif
341 vinfo(21)=vname(6,iduvwc)
342 vinfo(22)='coordinates'
343 aval(5)=real(iinfo(1,iduvwc,ng),r8)
344 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(iduvwc), &
345 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
346 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
347 END IF
348!
349! Define wind-induced, bed wave orbital U-velocity.
350!
351 IF (varout(idubot,ng)) THEN
352 vinfo( 1)=vname(1,idubot)
353 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
354 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idubot))
355 ELSE
356 vinfo( 2)=vname(2,idubot)
357 END IF
358 vinfo( 3)=vname(3,idubot)
359 vinfo(14)=vname(4,idubot)
360 vinfo(16)=vname(1,idtime)
361# if defined WRITE_WATER && defined MASKING
362 vinfo(20)='mask_rho'
363# endif
364 vinfo(21)=vname(6,idubot)
365 vinfo(22)='coordinates'
366 aval(5)=real(iinfo(1,idubot,ng),r8)
367 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idubot), &
368 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
369 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
370 END IF
371!
372! Define wind-induced, bed wave orbital V-velocity.
373!
374 IF (varout(idvbot,ng)) THEN
375 vinfo( 1)=vname(1,idvbot)
376 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
377 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idvbot))
378 ELSE
379 vinfo( 2)=vname(2,idvbot)
380 END IF
381 vinfo( 3)=vname(3,idvbot)
382 vinfo(14)=vname(4,idvbot)
383 vinfo(16)=vname(1,idtime)
384# if defined WRITE_WATER && defined MASKING
385 vinfo(20)='mask_rho'
386# endif
387 vinfo(21)=vname(6,idvbot)
388 vinfo(22)='coordinates'
389 aval(5)=real(iinfo(1,idvbot,ng),r8)
390 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idvbot), &
391 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
392 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
393 END IF
394!
395! Define bottom U-momentum above bed.
396!
397 IF (varout(idubur,ng)) THEN
398 vinfo( 1)=vname(1,idubur)
399 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
400 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idubur))
401 ELSE
402 vinfo( 2)=vname(2,idubur)
403 END IF
404 vinfo( 3)=vname(3,idubur)
405 vinfo(14)=vname(4,idubur)
406 vinfo(16)=vname(1,idtime)
407# if defined WRITE_WATER && defined MASKING
408 vinfo(20)='mask_rho'
409# endif
410 vinfo(21)=vname(6,idubur)
411 vinfo(22)='coordinates'
412 aval(5)=real(iinfo(1,idubur,ng),r8)
413 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idubur), &
414 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
415 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
416 END IF
417!
418! Define bottom V-momentum above bed.
419!
420 IF (varout(idvbvr,ng)) THEN
421 vinfo( 1)=vname(1,idvbvr)
422 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
423 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idvbvr))
424 ELSE
425 vinfo( 2)=vname(2,idvbvr)
426 END IF
427 vinfo( 3)=vname(3,idvbvr)
428 vinfo(14)=vname(4,idvbvr)
429 vinfo(16)=vname(1,idtime)
430# if defined WRITE_WATER && defined MASKING
431 vinfo(20)='mask_rho'
432# endif
433 vinfo(21)=vname(6,idvbvr)
434 vinfo(22)='coordinates'
435 aval(5)=real(iinfo(1,idvbvr,ng),r8)
436 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idvbvr), &
437 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
438 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
439 END IF
440# endif
441
442# if defined UV_KIRBY && defined AVERAGES
443!
444! Define U-velocity from Kirby and Chen.
445!
446 IF (varout(iduwav,ng)) THEN
447 vinfo( 1)=vname(1,iduwav)
448 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,iduwav))
449 vinfo( 3)=vname(3,iduwav)
450 vinfo(14)=vname(4,iduwav)
451 vinfo(16)=vname(1,idtime)
452# if defined WRITE_WATER && defined MASKING
453 vinfo(20)='mask_rho'
454# endif
455 vinfo(21)=vname(6,iduwav)
456 vinfo(22)='coordinates'
457 aval(5)=real(iinfo(1,iduwav,ng),r8)
458 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(iduwav), &
459 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
460 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
461 END IF
462!
463! Define V-velocity from Kirby and Chen.
464!
465 IF (varout(idvwav,ng)) THEN
466 vinfo( 1)=vname(1,idvwav)
467 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idvwav))
468 vinfo( 3)=vname(3,idvwav)
469 vinfo(14)=vname(4,idvwav)
470 vinfo(16)=vname(1,idtime)
471# if defined WRITE_WATER && defined MASKING
472 vinfo(20)='mask_rho'
473# endif
474 vinfo(21)=vname(6,idvwav)
475 vinfo(22)='coordinates'
476 aval(5)=real(iinfo(1,idvwav,ng),r8)
477 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idvwav), &
478 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
479 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
480 END IF
481# endif
482
483# ifdef WAVES_HEIGHT
484!
485! Define wind-induced significant wave height.
486!
487 IF (varout(idwamp,ng)) THEN
488 vinfo( 1)=vname(1,idwamp)
489 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
490 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idwamp))
491 ELSE
492 vinfo( 2)=vname(2,idwamp)
493 END IF
494 vinfo( 3)=vname(3,idwamp)
495 vinfo(14)=vname(4,idwamp)
496 vinfo(16)=vname(1,idtime)
497# if defined WRITE_WATER && defined MASKING
498 vinfo(20)='mask_rho'
499# endif
500 vinfo(21)=vname(6,idwamp)
501 vinfo(22)='coordinates'
502 aval(5)=real(iinfo(1,idwamp,ng),r8)
503 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idwamp), &
504 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
505 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
506 END IF
507
508# ifdef AVERAGES
509!
510! Write out wind-induced significant wave height squared.
511!
512 IF (varout(idwam2,ng)) THEN
513 vinfo( 1)=vname(1,idwam2)
514 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
515 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idwam2))
516 ELSE
517 vinfo( 2)=vname(2,idwam2)
518 END IF
519 vinfo( 3)=vname(3,idwam2)
520 vinfo(14)=vname(4,idwam2)
521 vinfo(16)=vname(1,idtime)
522# if defined WRITE_WATER && defined MASKING
523 vinfo(20)='mask_rho'
524# endif
525 vinfo(21)=vname(6,idwam2)
526 vinfo(22)='coordinates'
527 aval(5)=real(iinfo(1,idwam2,ng),r8)
528 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idwam2), &
529 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
530 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
531 END IF
532# endif
533# endif
534
535# ifdef WAVES_LENGTH
536!
537! Define wind-induced mean wavelength.
538!
539 IF (varout(idwlen,ng)) THEN
540 vinfo( 1)=vname(1,idwlen)
541 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
542 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idwlen))
543 ELSE
544 vinfo( 2)=vname(2,idwlen)
545 END IF
546 vinfo( 3)=vname(3,idwlen)
547 vinfo(14)=vname(4,idwlen)
548 vinfo(16)=vname(1,idtime)
549# if defined WRITE_WATER && defined MASKING
550 vinfo(20)='mask_rho'
551# endif
552 vinfo(21)=vname(6,idwlen)
553 vinfo(22)='coordinates'
554 aval(5)=real(iinfo(1,idwlen,ng),r8)
555 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idwlen), &
556 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
557 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
558 END IF
559# endif
560
561# ifdef WAVES_LENGTHP
562!
563! Define wind-induced peak wave wavelength.
564!
565 IF (varout(idwlep,ng)) THEN
566 vinfo( 1)=vname(1,idwlep)
567 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
568 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idwlep))
569 ELSE
570 vinfo( 2)=vname(2,idwlep)
571 END IF
572 vinfo( 3)=vname(3,idwlep)
573 vinfo(14)=vname(4,idwlep)
574 vinfo(16)=vname(1,idtime)
575# if defined WRITE_WATER && defined MASKING
576 vinfo(20)='mask_rho'
577# endif
578 vinfo(21)=vname(6,idwlep)
579 vinfo(22)='coordinates'
580 aval(5)=real(iinfo(1,idwlep,ng),r8)
581 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idwlep), &
582 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
583 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
584 END IF
585# endif
586
587# ifdef WAVES_DIR
588!
589! Define wind-induced mean wave direction.
590!
591 IF (varout(idwdir,ng)) THEN
592 vinfo( 1)=vname(1,idwdir)
593 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
594 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idwdir))
595 ELSE
596 vinfo( 2)=vname(2,idwdir)
597 END IF
598 vinfo( 3)=vname(3,idwdir)
599 vinfo(14)=vname(4,idwdir)
600 vinfo(16)=vname(1,idtime)
601# if defined WRITE_WATER && defined MASKING
602 vinfo(20)='mask_rho'
603# endif
604 vinfo(21)=vname(6,idwdir)
605 vinfo(22)='coordinates'
606 aval(5)=real(iinfo(1,idwdir,ng),r8)
607 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idwdir), &
608 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
609 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
610 END IF
611# endif
612
613# ifdef WAVES_DIRP
614!
615! Define wind-induced peak wave direction.
616!
617 IF (varout(idwdip,ng)) THEN
618 vinfo( 1)=vname(1,idwdip)
619 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
620 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idwdip))
621 ELSE
622 vinfo( 2)=vname(2,idwdip)
623 END IF
624 vinfo( 3)=vname(3,idwdip)
625 vinfo(14)=vname(4,idwdip)
626 vinfo(16)=vname(1,idtime)
627# if defined WRITE_WATER && defined MASKING
628 vinfo(20)='mask_rho'
629# endif
630 vinfo(21)=vname(6,idwdip)
631 vinfo(22)='coordinates'
632 aval(5)=real(iinfo(1,idwdip,ng),r8)
633 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idwdip), &
634 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
635 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
636 END IF
637# endif
638
639# ifdef WAVES_TOP_PERIOD
640!
641! Define wind-induced surface wave period.
642!
643 IF (varout(idwptp,ng)) THEN
644 vinfo( 1)=vname(1,idwptp)
645 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
646 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idwptp))
647 ELSE
648 vinfo( 2)=vname(2,idwptp)
649 END IF
650 vinfo( 3)=vname(3,idwptp)
651 vinfo(14)=vname(4,idwptp)
652 vinfo(16)=vname(1,idtime)
653# if defined WRITE_WATER && defined MASKING
654 vinfo(20)='mask_rho'
655# endif
656 vinfo(21)=vname(6,idwptp)
657 vinfo(22)='coordinates'
658 aval(5)=real(iinfo(1,idwptp,ng),r8)
659 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idwptp), &
660 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
661 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
662 END IF
663# endif
664
665# ifdef WAVES_BOT_PERIOD
666!
667! Define wind-induced bottom wave period.
668!
669 IF (varout(idwpbt,ng)) THEN
670 vinfo( 1)=vname(1,idwpbt)
671 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
672 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idwpbt))
673 ELSE
674 vinfo( 2)=vname(2,idwpbt)
675 END IF
676 vinfo( 3)=vname(3,idwpbt)
677 vinfo(14)=vname(4,idwpbt)
678 vinfo(16)=vname(1,idtime)
679# if defined WRITE_WATER && defined MASKING
680 vinfo(20)='mask_rho'
681# endif
682 vinfo(21)=vname(6,idwpbt)
683 vinfo(22)='coordinates'
684 aval(5)=real(iinfo(1,idwpbt,ng),r8)
685 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idwpbt), &
686 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
687 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
688 END IF
689
690# endif
691
692# ifdef WAVES_DSPR
693!
694! Define waves directional spreading.
695!
696 IF (varout(idwvds,ng)) THEN
697 vinfo( 1)=vname(1,idwvds)
698 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
699 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idwvds))
700 ELSE
701 vinfo( 2)=vname(2,idwvds)
702 END IF
703 vinfo( 3)=vname(3,idwvds)
704 vinfo(14)=vname(4,idwvds)
705 vinfo(16)=vname(1,idtime)
706# if defined WRITE_WATER && defined MASKING
707 vinfo(20)='mask_rho'
708# endif
709 vinfo(21)=vname(6,idwvds)
710 vinfo(22)='coordinates'
711 aval(5)=real(iinfo(1,idwvds,ng),r8)
712 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idwvds), &
713 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
714 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
715 END IF
716!
717! Define waves spectrum peakeness.
718!
719 IF (varout(idwvqp,ng)) THEN
720 vinfo( 1)=vname(1,idwvqp)
721 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
722 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idwvqp))
723 ELSE
724 vinfo( 2)=vname(2,idwvqp)
725 END IF
726 vinfo( 3)=vname(3,idwvqp)
727 vinfo(14)=vname(4,idwvqp)
728 vinfo(16)=vname(1,idtime)
729# if defined WRITE_WATER && defined MASKING
730 vinfo(20)='mask_rho'
731# endif
732 vinfo(21)=vname(6,idwvqp)
733 vinfo(22)='coordinates'
734 aval(5)=real(iinfo(1,idwvqp,ng),r8)
735 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idwvqp), &
736 & nf_fout, nvd3, t2dgrd, aval, vinfo, ncname)
737 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
738 END IF
739# endif
740
741 END IF define
742!
743!-----------------------------------------------------------------------
744! Otherwise, check existing output file and prepare for appending
745! data.
746!-----------------------------------------------------------------------
747!
748 query : IF (.not.ldef) THEN
749!
750! Initialize local logical switches.
751!
752 DO i=1,nv
753 got_var(i)=.false.
754 END DO
755!
756! Scan variable list from input NetCDF and activate switches for
757! Waves Effect on Currents variables. Get variable IDs.
758!
759 DO i=1,n_var
760 IF (trim(var_name(i)).eq.trim(vname(1,idtime))) THEN
761 got_var(idtime)=.true.
762 s(ng)%Vid(idtime)=var_id(i)
763# if defined BBL_MODEL || defined SED_BEDLOAD_VANDERA || \
764 defined wav_coupling
765 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idworb))) THEN
766 got_var(idworb)=.true.
767 s(ng)%Vid(idworb)=var_id(i)
768# endif
769# ifdef BBL_MODEL
770 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubrs))) THEN
771 got_var(idubrs)=.true.
772 s(ng)%Vid(idubrs)=var_id(i)
773 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbrs))) THEN
774 got_var(idvbrs)=.true.
775 s(ng)%Vid(idvbrs)=var_id(i)
776 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubws))) THEN
777 got_var(idubws)=.true.
778 s(ng)%Vid(idubws)=var_id(i)
779 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbws))) THEN
780 got_var(idvbws)=.true.
781 s(ng)%Vid(idvbws)=var_id(i)
782 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubcs))) THEN
783 got_var(idubcs)=.true.
784 s(ng)%Vid(idubcs)=var_id(i)
785 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbcs))) THEN
786 got_var(idvbcs)=.true.
787 s(ng)%Vid(idvbcs)=var_id(i)
788 ELSE IF (trim(var_name(i)).eq.trim(vname(1,iduvwc))) THEN
789 got_var(iduvwc)=.true.
790 s(ng)%Vid(iduvwc)=var_id(i)
791 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubot))) THEN
792 got_var(idubot)=.true.
793 s(ng)%Vid(idubot)=var_id(i)
794 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbot))) THEN
795 got_var(idvbot)=.true.
796 s(ng)%Vid(idvbot)=var_id(i)
797 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubur))) THEN
798 got_var(idubur)=.true.
799 s(ng)%Vid(idubur)=var_id(i)
800 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbvr))) THEN
801 got_var(idvbvr)=.true.
802 s(ng)%Vid(idvbvr)=var_id(i)
803# endif
804# if defined UV_KIRBY && defined AVERAGES
805 ELSE IF (trim(var_name(i)).eq.trim(vname(1,iduwav))) THEN
806 got_var(iduwav)=.true.
807 s(ng)%Vid(iduwav)=var_id(i)
808 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvwav))) THEN
809 got_var(idvwav)=.true.
810 s(ng)%Vid(idvwav)=var_id(i)
811# endif
812# ifdef WAVES_HEIGHT
813 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwamp))) THEN
814 got_var(idwamp)=.true.
815 s(ng)%Vid(idwamp)=var_id(i)
816# ifdef AVERAGES
817 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwam2))) THEN
818 got_var(idwam2)=.true.
819 s(ng)%Vid(idwam2)=var_id(i)
820# endif
821# endif
822# ifdef WAVES_LENGTH
823 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwlen))) THEN
824 got_var(idwlen)=.true.
825 s(ng)%Vid(idwlen)=var_id(i)
826# endif
827# ifdef WAVES_LENGTHP
828 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwlep))) THEN
829 got_var(idwlep)=.true.
830 s(ng)%Vid(idwlep)=var_id(i)
831# endif
832# ifdef WAVES_DIR
833 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwdir))) THEN
834 got_var(idwdir)=.true.
835 s(ng)%Vid(idwdir)=var_id(i)
836# endif
837# ifdef WAVES_DIRP
838 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwdip))) THEN
839 got_var(idwdip)=.true.
840 s(ng)%Vid(idwdip)=var_id(i)
841# endif
842# ifdef WAVES_TOP_PERIOD
843 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwptp))) THEN
844 got_var(idwptp)=.true.
845 s(ng)%Vid(idwptp)=var_id(i)
846# endif
847# ifdef WAVES_BOT_PERIOD
848 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwpbt))) THEN
849 got_var(idwpbt)=.true.
850 s(ng)%Vid(idwpbt)=var_id(i)
851# endif
852# ifdef WAVES_DSPR
853 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwvds))) THEN
854 got_var(idwvds)=.true.
855 s(ng)%Vid(idwvds)=var_id(i)
856 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwvqp))) THEN
857 got_var(idwvqp)=.true.
858 s(ng)%Vid(idwvqp)=var_id(i)
859# endif
860 END IF
861 END DO
862!
863! Check if output variables are available in input NetCDF file.
864!
865 IF (.not.got_var(idtime)) THEN
866 IF (master) WRITE (stdout,10) trim(vname(1,idtime)), &
867 & trim(ncname)
868 exit_flag=3
869 RETURN
870 END IF
871# if defined BBL_MODEL || defined SED_BEDLOAD_VANDERA || \
872 defined wav_coupling
873 IF (.not.got_var(idworb).and.varout(idworb,ng)) THEN
874 IF (master) WRITE (stdout,10) trim(vname(1,idworb)), &
875 & trim(ncname)
876 exit_flag=3
877 RETURN
878 END IF
879# endif
880# ifdef BBL_MODEL
881 IF (.not.got_var(idubrs).and.varout(idubrs,ng)) THEN
882 IF (master) WRITE (stdout,10) trim(vname(1,idubrs)), &
883 & trim(ncname)
884 exit_flag=3
885 RETURN
886 END IF
887 IF (.not.got_var(idvbrs).and.varout(idvbrs,ng)) THEN
888 IF (master) WRITE (stdout,10) trim(vname(1,idvbrs)), &
889 & trim(ncname)
890 exit_flag=3
891 RETURN
892 END IF
893 IF (.not.got_var(idubws).and.varout(idubws,ng)) THEN
894 IF (master) WRITE (stdout,10) trim(vname(1,idubws)), &
895 & trim(ncname)
896 exit_flag=3
897 RETURN
898 END IF
899 IF (.not.got_var(idvbws).and.varout(idvbws,ng)) THEN
900 IF (master) WRITE (stdout,10) trim(vname(1,idvbws)), &
901 & trim(ncname)
902 exit_flag=3
903 RETURN
904 END IF
905 IF (.not.got_var(idubcs).and.varout(idubcs,ng)) THEN
906 IF (master) WRITE (stdout,10) trim(vname(1,idubcs)), &
907 & trim(ncname)
908 exit_flag=3
909 RETURN
910 END IF
911 IF (.not.got_var(idvbcs).and.varout(idvbcs,ng)) THEN
912 IF (master) WRITE (stdout,10) trim(vname(1,idvbcs)), &
913 & trim(ncname)
914 exit_flag=3
915 RETURN
916 END IF
917 IF (.not.got_var(iduvwc).and.varout(iduvwc,ng)) THEN
918 IF (master) WRITE (stdout,10) trim(vname(1,iduvwc)), &
919 & trim(ncname)
920 exit_flag=3
921 RETURN
922 END IF
923 IF (.not.got_var(idubot).and.varout(idubot,ng)) THEN
924 IF (master) WRITE (stdout,10) trim(vname(1,idubot)), &
925 & trim(ncname)
926 exit_flag=3
927 RETURN
928 END IF
929 IF (.not.got_var(idvbot).and.varout(idvbot,ng)) THEN
930 IF (master) WRITE (stdout,10) trim(vname(1,idvbot)), &
931 & trim(ncname)
932 exit_flag=3
933 RETURN
934 END IF
935 IF (.not.got_var(idubur).and.varout(idubur,ng)) THEN
936 IF (master) WRITE (stdout,10) trim(vname(1,idubur)), &
937 & trim(ncname)
938 exit_flag=3
939 RETURN
940 END IF
941 IF (.not.got_var(idvbvr).and.varout(idvbvr,ng)) THEN
942 IF (master) WRITE (stdout,10) trim(vname(1,idvbvr)), &
943 & trim(ncname)
944 exit_flag=3
945 RETURN
946 END IF
947# endif
948# if defined UV_KIRBY && defined AVERAGES
949 IF (.not.got_var(iduwav).and.varout(iduwav,ng)) THEN
950 IF (master) WRITE (stdout,10) trim(vname(1,iduwav)), &
951 & trim(ncname)
952 exit_flag=3
953 RETURN
954 END IF
955 IF (.not.got_var(idvwav).and.varout(idvwav,ng)) THEN
956 IF (master) WRITE (stdout,10) trim(vname(1,idvwav)), &
957 & trim(ncname)
958 exit_flag=3
959 RETURN
960 END IF
961# endif
962# ifdef WAVES_HEIGHT
963 IF (.not.got_var(idwamp).and.varout(idwamp,ng)) THEN
964 IF (master) WRITE (stdout,10) trim(vname(1,idwamp)), &
965 & trim(ncname)
966 exit_flag=3
967 RETURN
968 END IF
969# ifdef AVERAGES
970 IF (.not.got_var(idwam2).and.varout(idwam2,ng)) THEN
971 IF (master) WRITE (stdout,10) trim(vname(1,idwam2)), &
972 & trim(ncname)
973 exit_flag=3
974 RETURN
975 END IF
976# endif
977# endif
978# ifdef WAVES_LENGTH
979 IF (.not.got_var(idwlen).and.varout(idwlen,ng)) THEN
980 IF (master) WRITE (stdout,10) trim(vname(1,idwlen)), &
981 & trim(ncname)
982 exit_flag=3
983 RETURN
984 END IF
985# endif
986# ifdef WAVES_LENGTHP
987 IF (.not.got_var(idwlep).and.varout(idwlep,ng)) THEN
988 IF (master) WRITE (stdout,10) trim(vname(1,idwlep)), &
989 & trim(ncname)
990 exit_flag=3
991 RETURN
992 END IF
993# endif
994# ifdef WAVES_DIR
995 IF (.not.got_var(idwdir).and.varout(idwdir,ng)) THEN
996 IF (master) WRITE (stdout,10) trim(vname(1,idwdir)), &
997 & trim(ncname)
998 exit_flag=3
999 RETURN
1000 END IF
1001# endif
1002# ifdef WAVES_DIRP
1003 IF (.not.got_var(idwdip).and.varout(idwdip,ng)) THEN
1004 IF (master) WRITE (stdout,10) trim(vname(1,idwdip)), &
1005 & trim(ncname)
1006 exit_flag=3
1007 RETURN
1008 END IF
1009# endif
1010# ifdef WAVES_TOP_PERIOD
1011 IF (.not.got_var(idwptp).and.varout(idwptp,ng)) THEN
1012 IF (master) WRITE (stdout,10) trim(vname(1,idwptp)), &
1013 & trim(ncname)
1014 exit_flag=3
1015 RETURN
1016 END IF
1017# endif
1018# ifdef WAVES_BOT_PERIOD
1019 IF (.not.got_var(idwpbt).and.varout(idwpbt,ng)) THEN
1020 IF (master) WRITE (stdout,10) trim(vname(1,idwpbt)), &
1021 & trim(ncname)
1022 exit_flag=3
1023 RETURN
1024 END IF
1025# endif
1026# ifdef WAVES_DSPR
1027 IF (.not.got_var(idwvds).and.varout(idwvds,ng)) THEN
1028 IF (master) WRITE (stdout,10) trim(vname(1,idwvds)), &
1029 & trim(ncname)
1030 exit_flag=3
1031 RETURN
1032 END IF
1033 IF (.not.got_var(idwvqp).and.varout(idwvqp,ng)) THEN
1034 IF (master) WRITE (stdout,10) trim(vname(1,idwvqp)), &
1035 & trim(ncname)
1036 exit_flag=3
1037 RETURN
1038 END IF
1039# endif
1040 END IF query
1041!
1042 10 FORMAT (/,' BBL_DEF_NF90 - unable to find variable: ',a,2x, &
1043 & ' in output NetCDF file: ',a)
1044!
1045 RETURN
1046 END SUBROUTINE bbl_def_nf90
1047
1048# ifdef STATIONS
1049!
1050!***********************************************************************
1051 SUBROUTINE bbl_def_station_nf90 (ng, model, ldef, VarOut, S, &
1052 & pgrd, rgrd)
1053!***********************************************************************
1054!
1055 USE mod_netcdf
1056!
1057! Imported variable declarations.
1058!
1059 logical, intent(in) :: ldef, varout(nv,ngrids)
1060!
1061 integer, intent(in) :: ng, model
1062 integer, intent(in), optional :: pgrd(:), rgrd(:)
1063!
1064 TYPE(t_io), intent(inout) :: s(ngrids)
1065!
1066! Local variable declarations.
1067!
1068 logical :: got_var(nv)
1069!
1070 integer, parameter :: natt = 25
1071
1072 integer :: i, j, status
1073!
1074 real(r8) :: aval(6)
1075!
1076 character (len=120) :: vinfo(natt)
1077 character (len=256) :: ncname
1078!
1079 character (len=*), parameter :: myfile = &
1080 & __FILE__//", bbl_def_station_nf90"
1081!
1082 sourcefile=myfile
1083!
1084!-----------------------------------------------------------------------
1085! Define sediment output stations variables.
1086!-----------------------------------------------------------------------
1087!
1088 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1089 ncname=s(ng)%name
1090!
1091 define : IF (ldef) THEN
1092!
1093! Initialize local information variable arrays.
1094!
1095 DO i=1,natt
1096 DO j=1,len(vinfo(1))
1097 vinfo(i)(j:j)=' '
1098 END DO
1099 END DO
1100 DO i=1,6
1101 aval(i)=0.0_r8
1102 END DO
1103
1104# ifdef WAVES_UB
1105!
1106! Define wind-induced wave bottom orbital velocity.
1107!
1108 IF (varout(idworb,ng)) THEN
1109 vinfo( 1)=vname(1,idworb)
1110 vinfo( 2)=vname(2,idworb)
1111 vinfo( 3)=vname(3,idworb)
1112 vinfo(14)=vname(4,idworb)
1113 vinfo(16)=vname(1,idtime)
1114 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idworb), &
1115 & nf_fout, 2, pgrd, aval, vinfo, ncname, &
1116 & setfillval = .true., &
1117 & setparaccess = .true.)
1118 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1119 END IF
1120# endif
1121
1122# ifdef BBL_MODEL
1123!
1124! Define current-induced, bottom U-current stress.
1125!
1126 IF (varout(idubrs,ng)) THEN
1127 vinfo( 1)=vname(1,idubrs)
1128 vinfo( 2)=vname(2,idubrs)
1129 vinfo( 3)=vname(3,idubrs)
1130 vinfo(14)=vname(4,idubrs)
1131 vinfo(16)=vname(1,idtime)
1132 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idubrs), &
1133 & nf_fout, 2, pgrd, aval, vinfo, ncname, &
1134 & setfillval = .true., &
1135 & setparaccess = .true.)
1136 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1137 END IF
1138!
1139! Define current-induced, bottom V-current stress.
1140!
1141 IF (varout(idvbrs,ng)) THEN
1142 vinfo( 1)=vname(1,idvbrs)
1143 vinfo( 2)=vname(2,idvbrs)
1144 vinfo( 3)=vname(3,idvbrs)
1145 vinfo(14)=vname(4,idvbrs)
1146 vinfo(16)=vname(1,idtime)
1147 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idvbrs), &
1148 & nf_fout, 2, pgrd, aval, vinfo, ncname, &
1149 & setfillval = .true., &
1150 & setparaccess = .true.)
1151 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1152 END IF
1153!
1154! Define wind-induced, bottom U-wave stress.
1155!
1156 IF (varout(idubws,ng)) THEN
1157 vinfo( 1)=vname(1,idubws)
1158 vinfo( 2)=vname(2,idubws)
1159 vinfo( 3)=vname(3,idubws)
1160 vinfo(14)=vname(4,idubws)
1161 vinfo(16)=vname(1,idtime)
1162 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idubws), &
1163 & nf_fout, 2, pgrd, aval, vinfo, ncname, &
1164 & setfillval = .true., &
1165 & setparaccess = .true.)
1166 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1167 END IF
1168!
1169! Define bottom wind-induced, bottom V-wave stress.
1170!
1171 IF (varout(idvbws,ng)) THEN
1172 vinfo( 1)=vname(1,idvbws)
1173 vinfo( 2)=vname(2,idvbws)
1174 vinfo( 3)=vname(3,idvbws)
1175 vinfo(14)=vname(4,idvbws)
1176 vinfo(16)=vname(1,idtime)
1177 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idvbws), &
1178 & nf_fout, 2, pgrd, aval, vinfo, ncname, &
1179 & setfillval = .true., &
1180 & setparaccess = .true.)
1181 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1182 END IF
1183!
1184! Define maximum wind and current, bottom U-wave stress.
1185!
1186 IF (varout(idubcs,ng)) THEN
1187 vinfo( 1)=vname(1,idubcs)
1188 vinfo( 2)=vname(2,idubcs)
1189 vinfo( 3)=vname(3,idubcs)
1190 vinfo(14)=vname(4,idubcs)
1191 vinfo(16)=vname(1,idtime)
1192 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idubcs), &
1193 & nf_fout, 2, pgrd, aval, vinfo, ncname, &
1194 & setfillval = .true., &
1195 & setparaccess = .true.)
1196 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1197 END IF
1198!
1199! Define maximum wind and current, bottom V-wave stress.
1200!
1201 IF (varout(idvbcs,ng)) THEN
1202 vinfo( 1)=vname(1,idvbcs)
1203 vinfo( 2)=vname(2,idvbcs)
1204 vinfo( 3)=vname(3,idvbcs)
1205 vinfo(14)=vname(4,idvbcs)
1206 vinfo(16)=vname(1,idtime)
1207 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idvbcs), &
1208 & nf_fout, 2, pgrd, aval, vinfo, ncname, &
1209 & setfillval = .true., &
1210 & setparaccess = .true.)
1211 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1212 END IF
1213!
1214! Define wind-induced, bed wave orbital U-velocity.
1215!
1216 IF (varout(idubot,ng)) THEN
1217 vinfo( 1)=vname(1,idubot)
1218 vinfo( 2)=vname(2,idubot)
1219 vinfo( 3)=vname(3,idubot)
1220 vinfo(14)=vname(4,idubot)
1221 vinfo(16)=vname(1,idtime)
1222 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idubot), &
1223 & nf_fout, 2, pgrd, aval, vinfo, ncname, &
1224 & setfillval = .true., &
1225 & setparaccess = .true.)
1226 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1227 END IF
1228!
1229! Define wind-induced, bed wave orbital V-velocity.
1230!
1231 IF (varout(idvbot,ng)) THEN
1232 vinfo( 1)=vname(1,idvbot)
1233 vinfo( 2)=vname(2,idvbot)
1234 vinfo( 3)=vname(3,idvbot)
1235 vinfo(14)=vname(4,idvbot)
1236 vinfo(16)=vname(1,idtime)
1237 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idvbot), &
1238 & nf_fout, 2, pgrd, aval, vinfo, ncname, &
1239 & setfillval = .true., &
1240 & setparaccess = .true.)
1241 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1242 END IF
1243!
1244! Define bottom U-momentum above bed.
1245!
1246 IF (varout(idubur,ng)) THEN
1247 vinfo( 1)=vname(1,idubur)
1248 vinfo( 2)=vname(2,idubur)
1249 vinfo( 3)=vname(3,idubur)
1250 vinfo(14)=vname(4,idubur)
1251 vinfo(16)=vname(1,idtime)
1252 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idubur), &
1253 & nf_fout, 2, pgrd, aval, vinfo, ncname, &
1254 & setfillval = .true., &
1255 & setparaccess = .true.)
1256 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1257 END IF
1258!
1259! Define bottom V-momentum above bed.
1260!
1261 IF (varout(idvbvr,ng)) THEN
1262 vinfo( 1)=vname(1,idvbvr)
1263 vinfo( 2)=vname(2,idvbvr)
1264 vinfo( 3)=vname(3,idvbvr)
1265 vinfo(14)=vname(4,idvbvr)
1266 vinfo(16)=vname(1,idtime)
1267 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idvbvr), &
1268 & nf_fout, 2, pgrd, aval, vinfo, ncname, &
1269 & setfillval = .true., &
1270 & setparaccess = .true.)
1271 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1272 END IF
1273# endif
1274
1275# ifdef WAVES_HEIGHT
1276!
1277! Define wind-induced significant wave height.
1278!
1279 IF (varout(idwamp,ng)) THEN
1280 vinfo( 1)=vname(1,idwamp)
1281 vinfo( 2)=vname(2,idwamp)
1282 vinfo( 3)=vname(3,idwamp)
1283 vinfo(14)=vname(4,idwamp)
1284 vinfo(16)=vname(1,idtime)
1285 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idwamp), &
1286 & nf_fout, 2, pgrd, aval, vinfo, ncname, &
1287 & setfillval = .true., &
1288 & setparaccess = .true.)
1289 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1290 END IF
1291# endif
1292
1293# ifdef WAVES_LENGTH
1294!
1295! Define wind-induced mean wavelenght.
1296!
1297 IF (varout(idwlen,ng)) THEN
1298 vinfo( 1)=vname(1,idwlen)
1299 vinfo( 2)=vname(2,idwlen)
1300 vinfo( 3)=vname(3,idwlen)
1301 vinfo(14)=vname(4,idwlen)
1302 vinfo(16)=vname(1,idtime)
1303 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idwlen), &
1304 & nf_fout, 2, pgrd, aval, vinfo, ncname, &
1305 & setfillval = .true., &
1306 & setparaccess = .true.)
1307 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1308 END IF
1309# endif
1310
1311# ifdef WAVES_LENGTHP
1312!
1313! Define wind-induced peak wave wavelength.
1314!
1315 IF (varout(idwlep,ng)) THEN
1316 vinfo( 1)=vname(1,idwlep)
1317 vinfo( 2)=vname(2,idwlep)
1318 vinfo( 3)=vname(3,idwlep)
1319 vinfo(14)=vname(4,idwlep)
1320 vinfo(16)=vname(1,idtime)
1321 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idwlep), &
1322 & nf_fout, 2, pgrd, aval, vinfo, ncname, &
1323 & setfillval = .true., &
1324 & setparaccess = .true.)
1325 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1326 END IF
1327# endif
1328
1329# ifdef WAVES_DIR
1330!
1331! Define wind-induced mean wave direction.
1332!
1333 IF (varout(idwdir,ng)) THEN
1334 vinfo( 1)=vname(1,idwdir)
1335 vinfo( 2)=vname(2,idwdir)
1336 vinfo( 3)=vname(3,idwdir)
1337 vinfo(14)=vname(4,idwdir)
1338 vinfo(16)=vname(1,idtime)
1339 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idwdir), &
1340 & nf_fout, 2, pgrd, aval, vinfo, ncname, &
1341 & setfillval = .true., &
1342 & setparaccess = .true.)
1343 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1344 END IF
1345# endif
1346
1347# ifdef WAVES_DIRP
1348!
1349! Define wind-induced peak wave direction.
1350!
1351 IF (varout(idwdip,ng)) THEN
1352 vinfo( 1)=vname(1,idwdip)
1353 vinfo( 2)=vname(2,idwdip)
1354 vinfo( 3)=vname(3,idwdip)
1355 vinfo(14)=vname(4,idwdip)
1356 vinfo(16)=vname(1,idtime)
1357 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idwdip), &
1358 & nf_fout, 2, pgrd, aval, vinfo, ncname, &
1359 & setfillval = .true., &
1360 & setparaccess = .true.)
1361 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1362 END IF
1363# endif
1364
1365# ifdef WAVES_TOP_PERIOD
1366!
1367! Define wind-induced surface wave period.
1368!
1369 IF (varout(idwptp,ng)) THEN
1370 vinfo( 1)=vname(1,idwptp)
1371 vinfo( 2)=vname(2,idwptp)
1372 vinfo( 3)=vname(3,idwptp)
1373 vinfo(14)=vname(4,idwptp)
1374 vinfo(16)=vname(1,idtime)
1375 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idwptp), &
1376 & nf_fout, 2, pgrd, aval, vinfo, ncname, &
1377 & setfillval = .true., &
1378 & setparaccess = .true.)
1379 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1380 END IF
1381
1382# endif
1383
1384# ifdef WAVES_BOT_PERIOD
1385!
1386! Define wind-induced bottom wave period.
1387!
1388 IF (varout(idwpbt,ng)) THEN
1389 vinfo( 1)=vname(1,idwpbt)
1390 vinfo( 2)=vname(2,idwpbt)
1391 vinfo( 3)=vname(3,idwpbt)
1392 vinfo(14)=vname(4,idwpbt)
1393 vinfo(16)=vname(1,idtime)
1394 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idwpbt), &
1395 & nf_fout, 2, pgrd, aval, vinfo, ncname, &
1396 & setfillval = .true., &
1397 & setparaccess = .true.)
1398 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1399 END IF
1400
1401# endif
1402
1403# ifdef WAVES_DSPR
1404!
1405! Define waves directional spreading.
1406!
1407 IF (varout(idwvds,ng)) THEN
1408 vinfo( 1)=vname(1,idwvds)
1409 vinfo( 2)=vname(2,idwvds)
1410 vinfo( 3)=vname(3,idwvds)
1411 vinfo(14)=vname(4,idwvds)
1412 vinfo(16)=vname(1,idtime)
1413 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idwvds), &
1414 & nf_fout, 2, pgrd, aval, vinfo, ncname, &
1415 & setfillval = .true., &
1416 & setparaccess = .true.)
1417 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1418 END IF
1419!
1420! Define wave spectrum peakedness.
1421!
1422 IF (varout(idwvqp,ng)) THEN
1423 vinfo( 1)=vname(1,idwvqp)
1424 vinfo( 2)=vname(2,idwvqp)
1425 vinfo( 3)=vname(3,idwvqp)
1426 vinfo(14)=vname(4,idwvqp)
1427 vinfo(16)=vname(1,idtime)
1428 status=def_var(ng, model, s(ng)%ncid, s(ng)%Vid(idwvqp), &
1429 & nf_fout, 2, pgrd, aval, vinfo, ncname, &
1430 & setfillval = .true., &
1431 & setparaccess = .true.)
1432 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1433 END IF
1434# endif
1435
1436 END IF define
1437!
1438!-----------------------------------------------------------------------
1439! Otherwise, check existing output file and prepare for appending
1440! data.
1441!-----------------------------------------------------------------------
1442!
1443 query : IF (.not.ldef) THEN
1444!
1445! Initialize locallogical switches.
1446!
1447 DO i=1,nv
1448 got_var(i)=.false.
1449 END DO
1450!
1451! Scan variable list from input NetCDF and activate switches for
1452! Waves Effect on Currents variables. Get variable IDs.
1453!
1454 DO i=1,n_var
1455 IF (trim(var_name(i)).eq.trim(vname(1,idtime))) THEN
1456 got_var(idtime)=.true.
1457 s(ng)%Vid(idtime)=var_id(i)
1458# ifdef WAVES_UB
1459 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idworb))) THEN
1460 got_var(idworb)=.true.
1461 s(ng)%Vid(idworb)=var_id(i)
1462# endif
1463# ifdef BBL_MODEL
1464 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubrs))) THEN
1465 got_var(idubrs)=.true.
1466 s(ng)%Vid(idubrs)=var_id(i)
1467 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbrs))) THEN
1468 got_var(idvbrs)=.true.
1469 s(ng)%Vid(idvbrs)=var_id(i)
1470 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubws))) THEN
1471 got_var(idubws)=.true.
1472 s(ng)%Vid(idubws)=var_id(i)
1473 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbws))) THEN
1474 got_var(idvbws)=.true.
1475 s(ng)%Vid(idvbws)=var_id(i)
1476 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubcs))) THEN
1477 got_var(idubcs)=.true.
1478 s(ng)%Vid(idubcs)=var_id(i)
1479 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbcs))) THEN
1480 got_var(idvbcs)=.true.
1481 s(ng)%Vid(idvbcs)=var_id(i)
1482 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubot))) THEN
1483 got_var(idubot)=.true.
1484 s(ng)%Vid(idubot)=var_id(i)
1485 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbot))) THEN
1486 got_var(idvbot)=.true.
1487 s(ng)%Vid(idvbot)=var_id(i)
1488 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubur))) THEN
1489 got_var(idubur)=.true.
1490 s(ng)%Vid(idubur)=var_id(i)
1491 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbvr))) THEN
1492 got_var(idvbvr)=.true.
1493 s(ng)%Vid(idvbvr)=var_id(i)
1494# endif
1495# ifdef WAVES_HEIGHT
1496 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwamp))) THEN
1497 got_var(idwamp)=.true.
1498 s(ng)%Vid(idwamp)=var_id(i)
1499# endif
1500# ifdef WAVES_LENGTH
1501 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwlen))) THEN
1502 got_var(idwlen)=.true.
1503 s(ng)%Vid(idwlen)=var_id(i)
1504# endif
1505# ifdef WAVES_LENGTHP
1506 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwlep))) THEN
1507 got_var(idwlep)=.true.
1508 s(ng)%Vid(idwlep)=var_id(i)
1509# endif
1510# ifdef WAVES_DIR
1511 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwdir))) THEN
1512 got_var(idwdir)=.true.
1513 s(ng)%Vid(idwdir)=var_id(i)
1514# endif
1515# ifdef WAVES_DIRP
1516 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwdip))) THEN
1517 got_var(idwdip)=.true.
1518 s(ng)%Vid(idwdip)=var_id(i)
1519# endif
1520# ifdef WAVES_TOP_PERIOD
1521 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwptp))) THEN
1522 got_var(idwptp)=.true.
1523 s(ng)%Vid(idwptp)=var_id(i)
1524# endif
1525# ifdef WAVES_BOT_PERIOD
1526 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwpbt))) THEN
1527 got_var(idwpbt)=.true.
1528 s(ng)%Vid(idwpbt)=var_id(i)
1529# endif
1530# ifdef WAVES_DSPR
1531 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwvds))) THEN
1532 got_var(idwvds)=.true.
1533 s(ng)%Vid(idwvds)=var_id(i)
1534 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwvqp))) THEN
1535 got_var(idwvqp)=.true.
1536 s(ng)%Vid(idwvqp)=var_id(i)
1537# endif
1538 END IF
1539 END DO
1540!
1541! Check if output variables are available in input NetCDF file.
1542!
1543 IF (.not.got_var(idtime)) THEN
1544 IF (master) WRITE (stdout,10) trim(vname(1,idtime)), &
1545 & trim(ncname)
1546 exit_flag=3
1547 RETURN
1548 END IF
1549# ifdef WAVES_UB
1550 IF (.not.got_var(idworb).and.varout(idworb,ng)) THEN
1551 IF (master) WRITE (stdout,10) trim(vname(1,idworb)), &
1552 & trim(ncname)
1553 exit_flag=3
1554 RETURN
1555 END IF
1556# endif
1557# ifdef BBL_MODEL
1558 IF (.not.got_var(idubrs).and.varout(idubrs,ng)) THEN
1559 IF (master) WRITE (stdout,10) trim(vname(1,idubrs)), &
1560 & trim(ncname)
1561 exit_flag=3
1562 RETURN
1563 END IF
1564 IF (.not.got_var(idvbrs).and.varout(idvbrs,ng)) THEN
1565 IF (master) WRITE (stdout,10) trim(vname(1,idvbrs)), &
1566 & trim(ncname)
1567 exit_flag=3
1568 RETURN
1569 END IF
1570 IF (.not.got_var(idubws).and.varout(idubws,ng)) THEN
1571 IF (master) WRITE (stdout,10) trim(vname(1,idubws)), &
1572 & trim(ncname)
1573 exit_flag=3
1574 RETURN
1575 END IF
1576 IF (.not.got_var(idvbws).and.varout(idvbws,ng)) THEN
1577 IF (master) WRITE (stdout,10) trim(vname(1,idvbws)), &
1578 & trim(ncname)
1579 exit_flag=3
1580 RETURN
1581 END IF
1582 IF (.not.got_var(idubcs).and.varout(idubcs,ng)) THEN
1583 IF (master) WRITE (stdout,10) trim(vname(1,idubcs)), &
1584 & trim(ncname)
1585 exit_flag=3
1586 RETURN
1587 END IF
1588 IF (.not.got_var(idvbcs).and.varout(idvbcs,ng)) THEN
1589 IF (master) WRITE (stdout,10) trim(vname(1,idvbcs)), &
1590 & trim(ncname)
1591 exit_flag=3
1592 RETURN
1593 END IF
1594 IF (.not.got_var(idubot).and.varout(idubot,ng)) THEN
1595 IF (master) WRITE (stdout,10) trim(vname(1,idubot)), &
1596 & trim(ncname)
1597 exit_flag=3
1598 RETURN
1599 END IF
1600 IF (.not.got_var(idvbot).and.varout(idvbot,ng)) THEN
1601 IF (master) WRITE (stdout,10) trim(vname(1,idvbot)), &
1602 & trim(ncname)
1603 exit_flag=3
1604 RETURN
1605 END IF
1606 IF (.not.got_var(idubur).and.varout(idubur,ng)) THEN
1607 IF (master) WRITE (stdout,10) trim(vname(1,idubur)), &
1608 & trim(ncname)
1609 exit_flag=3
1610 RETURN
1611 END IF
1612 IF (.not.got_var(idvbvr).and.varout(idvbvr,ng)) THEN
1613 IF (master) WRITE (stdout,10) trim(vname(1,idvbvr)), &
1614 & trim(ncname)
1615 exit_flag=3
1616 RETURN
1617 END IF
1618# endif
1619# ifdef WAVES_HEIGHT
1620 IF (.not.got_var(idwamp).and.varout(idwamp,ng)) THEN
1621 IF (master) WRITE (stdout,10) trim(vname(1,idwamp)), &
1622 & trim(ncname)
1623 exit_flag=3
1624 RETURN
1625 END IF
1626# endif
1627# ifdef WAVES_LENGTH
1628 IF (.not.got_var(idwlen).and.varout(idwlen,ng)) THEN
1629 IF (master) WRITE (stdout,10) trim(vname(1,idwlen)), &
1630 & trim(ncname)
1631 exit_flag=3
1632 RETURN
1633 END IF
1634# endif
1635# ifdef WAVES_LENGTHP
1636 IF (.not.got_var(idwlep).and.varout(idwlep,ng)) THEN
1637 IF (master) WRITE (stdout,10) trim(vname(1,idwlep)), &
1638 & trim(ncname)
1639 exit_flag=3
1640 RETURN
1641 END IF
1642# endif
1643# ifdef WAVES_DIR
1644 IF (.not.got_var(idwdir).and.varout(idwdir,ng)) THEN
1645 IF (master) WRITE (stdout,10) trim(vname(1,idwdir)), &
1646 & trim(ncname)
1647 exit_flag=3
1648 RETURN
1649 END IF
1650# endif
1651# ifdef WAVES_DIRP
1652 IF (.not.got_var(idwdip).and.varout(idwdip,ng)) THEN
1653 IF (master) WRITE (stdout,10) trim(vname(1,idwdip)), &
1654 & trim(ncname)
1655 exit_flag=3
1656 RETURN
1657 END IF
1658# endif
1659# ifdef WAVES_TOP_PERIOD
1660 IF (.not.got_var(idwptp).and.varout(idwptp,ng)) THEN
1661 IF (master) WRITE (stdout,10) trim(vname(1,idwptp)), &
1662 & trim(ncname)
1663 exit_flag=3
1664 RETURN
1665 END IF
1666# endif
1667# ifdef WAVES_BOT_PERIOD
1668 IF (.not.got_var(idwpbt).and.varout(idwpbt,ng)) THEN
1669 IF (master) WRITE (stdout,10) trim(vname(1,idwpbt)), &
1670 & trim(ncname)
1671 exit_flag=3
1672 RETURN
1673 END IF
1674# endif
1675# ifdef WAVES_DSPR
1676 IF (.not.got_var(idwvds).and.varout(idwvds,ng)) THEN
1677 IF (master) WRITE (stdout,10) trim(vname(1,idwvds)), &
1678 & trim(ncname)
1679 exit_flag=3
1680 RETURN
1681 END IF
1682 IF (.not.got_var(idwvqp).and.varout(idwvqp,ng)) THEN
1683 IF (master) WRITE (stdout,10) trim(vname(1,idwvqp)), &
1684 & trim(ncname)
1685 exit_flag=3
1686 RETURN
1687 END IF
1688# endif
1689 END IF query
1690!
1691 10 FORMAT (/,' BBL_DEF_STATION_NF90 - unable to find variable:', &
1692 & 1x,a,2x,' in output NetCDF file: ',a)
1693!
1694 RETURN
1695 END SUBROUTINE bbl_def_station_nf90
1696# endif
1697!
1698!***********************************************************************
1699 SUBROUTINE bbl_wrt_nf90 (ng, model, tile, &
1700 & LBi, UBi, LBj, UBj, &
1701 & VarOut, S)
1702!***********************************************************************
1703!
1704 USE mod_netcdf
1705!
1706! Imported variable declarations.
1707!
1708 logical, intent(in) :: varout(nv,ngrids)
1709!
1710 integer, intent(in) :: ng, model, tile
1711 integer, intent(in) :: lbi, ubi, lbj, ubj
1712!
1713 TYPE(t_io), intent(inout) :: s(ngrids)
1714!
1715! Local variable declarations.
1716!
1717 logical :: linstataneous
1718!
1719 integer :: gfactor, gtype, status
1720!
1721 real(dp) :: scale
1722!
1723 real(r8), allocatable :: wrk2d(:,:,:)
1724!
1725 character (len=*), parameter :: myfile = &
1726 & __FILE__//", bbl_wrt_nf90"
1727!
1728 sourcefile=myfile
1729!
1730!-----------------------------------------------------------------------
1731! Write out Waves Effect on Currents output variables into specified
1732! output NetCDF file.
1733!-----------------------------------------------------------------------
1734!
1735 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1736!
1737! Set grid type factor to write full (gfactor=1) fields or water
1738! points (gfactor=-1) fields only.
1739!
1740# if defined WRITE_WATER && defined MASKING
1741 gfactor=-1
1742# else
1743 gfactor=1
1744# endif
1745!
1746! Set instantaneous fields.
1747!
1748 IF ((s(ng)%ncid.eq.s(ng)%ncid).or. &
1749 & (s(ng)%ncid.eq.qck(ng)%ncid)) THEN
1750 linstataneous=.true.
1751 ELSE
1752 linstataneous=.false. ! time-averged fiels
1753 END IF
1754
1755# if defined BBL_MODEL || defined SED_BEDLOAD_VANDERA || \
1756 defined wav_coupling
1757!
1758! Write out wind-induced wave bottom orbital velocity.
1759!
1760 IF (varout(idworb,ng)) THEN
1761 scale=1.0_dp
1762 gtype=gfactor*r2dvar
1763 IF (linstataneous) THEN
1764 status=nf_fwrite2d(ng, model, s(ng)%ncid, idworb, &
1765 & s(ng)%Vid(idworb), &
1766 & s(ng)%Rindex, gtype, &
1767 & lbi, ubi, lbj, ubj, scale, &
1768# ifdef MASKING
1769 & grid(ng) % rmask, &
1770# endif
1771 & forces(ng) % Uwave_rms)
1772# ifdef AVERAGES
1773 ELSE
1774 status=nf_fwrite2d(ng, model, s(ng)%ncid, idworb, &
1775 & s(ng)%Vid(idworb), &
1776 & s(ng)%Rindex, gtype, &
1777 & lbi, ubi, lbj, ubj, scale, &
1778# ifdef MASKING
1779 & grid(ng) % rmask, &
1780# endif
1781 & average(ng) % avgWorb)
1782# endif
1783 END IF
1784 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1785 IF (master) THEN
1786 WRITE (stdout,10) trim(vname(1,idworb)), s(ng)%Rindex
1787 END IF
1788 exit_flag=3
1789 ioerror=status
1790 RETURN
1791 END IF
1792 END IF
1793# endif
1794
1795# ifdef BBL_MODEL
1796!
1797! Write out current-induced, bottom U-stress at RHO-points.
1798!
1799 IF (varout(idubrs,ng)) THEN
1800 scale=-rho0
1801 gtype=gfactor*r2dvar
1802 IF (linstataneous) THEN
1803 status=nf_fwrite2d(ng, model, s(ng)%ncid, idubrs, &
1804 & s(ng)%Vid(idubrs), &
1805 & s(ng)%Rindex, gtype, &
1806 & lbi, ubi, lbj, ubj, scale, &
1807# ifdef MASKING
1808 & grid(ng) % rmask, &
1809# endif
1810 & bbl(ng) % bustrc)
1811# ifdef AVERAGES
1812 ELSE
1813 status=nf_fwrite2d(ng, model, s(ng)%ncid, idubrs, &
1814 & s(ng)%Vid(idubrs), &
1815 & s(ng)%Rindex, gtype, &
1816 & lbi, ubi, lbj, ubj, scale, &
1817# ifdef MASKING
1818 & grid(ng) % rmask, &
1819# endif
1820 & average(ng) % avgUbrs)
1821# endif
1822 END IF
1823 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1824 IF (master) THEN
1825 WRITE (stdout,10) trim(vname(1,idubrs)), s(ng)%Rindex
1826 END IF
1827 exit_flag=3
1828 ioerror=status
1829 RETURN
1830 END IF
1831 END IF
1832!
1833! Write out current-induced, bottom V-stress at RHO-points.
1834!
1835 IF (varout(idvbrs,ng)) THEN
1836 scale=-rho0
1837 gtype=gfactor*r2dvar
1838 IF (linstataneous) THEN
1839 status=nf_fwrite2d(ng, model, s(ng)%ncid, idvbrs, &
1840 & s(ng)%Vid(idvbrs), &
1841 & s(ng)%Rindex, gtype, &
1842 & lbi, ubi, lbj, ubj, scale, &
1843# ifdef MASKING
1844 & grid(ng) % rmask, &
1845# endif
1846 & bbl(ng) % bvstrc)
1847# ifdef AVERAGES
1848 ELSE
1849 status=nf_fwrite2d(ng, model, s(ng)%ncid, idvbrs, &
1850 & s(ng)%Vid(idvbrs), &
1851 & s(ng)%Rindex, gtype, &
1852 & lbi, ubi, lbj, ubj, scale, &
1853# ifdef MASKING
1854 & grid(ng) % rmask, &
1855# endif
1856 & average(ng) % avgVbrs)
1857# endif
1858 END IF
1859 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1860 IF (master) THEN
1861 WRITE (stdout,10) trim(vname(1,idvbrs)), s(ng)%Rindex
1862 END IF
1863 exit_flag=3
1864 ioerror=status
1865 RETURN
1866 END IF
1867 END IF
1868!
1869! Write out wind-induced, bottom U-stress at RHO-points.
1870!
1871 IF (varout(idubws,ng)) THEN
1872 scale=rho0
1873 gtype=gfactor*r2dvar
1874 IF (linstataneous) THEN
1875 status=nf_fwrite2d(ng, model, s(ng)%ncid, idubws, &
1876 & s(ng)%Vid(idubws), &
1877 & s(ng)%Rindex, gtype, &
1878 & lbi, ubi, lbj, ubj, scale, &
1879# ifdef MASKING
1880 & grid(ng) % rmask, &
1881# endif
1882 & bbl(ng) % bustrw)
1883# ifdef AVERAGES
1884 ELSE
1885 status=nf_fwrite2d(ng, model, s(ng)%ncid, idubws, &
1886 & s(ng)%Vid(idubws), &
1887 & s(ng)%Rindex, gtype, &
1888 & lbi, ubi, lbj, ubj, scale, &
1889# ifdef MASKING
1890 & grid(ng) % rmask, &
1891# endif
1892 & average(ng) % avgUbws)
1893# endif
1894 END IF
1895 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1896 IF (master) THEN
1897 WRITE (stdout,10) trim(vname(1,idubws)), s(ng)%Rindex
1898 END IF
1899 exit_flag=3
1900 ioerror=status
1901 RETURN
1902 END IF
1903 END IF
1904!
1905! Write out wind-induced, bottom V-stress at RHO-points.
1906!
1907 IF (varout(idvbws,ng)) THEN
1908 scale=rho0
1909 gtype=gfactor*r2dvar
1910 IF (linstataneous) THEN
1911 status=nf_fwrite2d(ng, model, s(ng)%ncid, idvbws, &
1912 & s(ng)%Vid(idvbws), &
1913 & s(ng)%Rindex, gtype, &
1914 & lbi, ubi, lbj, ubj, scale, &
1915# ifdef MASKING
1916 & grid(ng) % rmask, &
1917# endif
1918 & bbl(ng) % bvstrw)
1919# ifdef AVERAGES
1920 ELSE
1921 status=nf_fwrite2d(ng, model, s(ng)%ncid, idvbws, &
1922 & s(ng)%Vid(idvbws), &
1923 & s(ng)%Rindex, gtype, &
1924 & lbi, ubi, lbj, ubj, scale, &
1925# ifdef MASKING
1926 & grid(ng) % rmask, &
1927# endif
1928 & average(ng) % avgVbws)
1929# endif
1930 END IF
1931 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1932 IF (master) THEN
1933 WRITE (stdout,10) trim(vname(1,idvbws)), s(ng)%Rindex
1934 END IF
1935 exit_flag=3
1936 ioerror=status
1937 RETURN
1938 END IF
1939 END IF
1940!
1941! Write out maximum wind and current, bottom U-stress at RHO-points.
1942!
1943 IF (varout(idubcs,ng)) THEN
1944 scale=rho0
1945 gtype=gfactor*r2dvar
1946 IF (linstataneous) THEN
1947 status=nf_fwrite2d(ng, model, s(ng)%ncid, idubcs, &
1948 & s(ng)%Vid(idubcs), &
1949 & s(ng)%Rindex, gtype, &
1950 & lbi, ubi, lbj, ubj, scale, &
1951# ifdef MASKING
1952 & grid(ng) % rmask, &
1953# endif
1954 & bbl(ng) % bustrcwmax)
1955# ifdef AVERAGES
1956 ELSE
1957 status=nf_fwrite2d(ng, model, s(ng)%ncid, idubcs, &
1958 & s(ng)%Vid(idubcs), &
1959 & s(ng)%Rindex, gtype, &
1960 & lbi, ubi, lbj, ubj, scale, &
1961# ifdef MASKING
1962 & grid(ng) % rmask, &
1963# endif
1964 & average(ng) % avgUbcs)
1965# endif
1966 END IF
1967 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1968 IF (master) THEN
1969 WRITE (stdout,10) trim(vname(1,idubcs)), s(ng)%Rindex
1970 END IF
1971 exit_flag=3
1972 ioerror=status
1973 RETURN
1974 END IF
1975 END IF
1976!
1977! Write out maximum wind and current, bottom V-stress at RHO-points.
1978!
1979 IF (varout(idvbcs,ng)) THEN
1980 scale=rho0
1981 gtype=gfactor*r2dvar
1982 IF (linstataneous) THEN
1983 status=nf_fwrite2d(ng, model, s(ng)%ncid, idvbcs, &
1984 & s(ng)%Vid(idvbcs), &
1985 & s(ng)%Rindex, gtype, &
1986 & lbi, ubi, lbj, ubj, scale, &
1987# ifdef MASKING
1988 & grid(ng) % rmask, &
1989# endif
1990 & bbl(ng) % bvstrcwmax)
1991# ifdef AVERAGES
1992 ELSE
1993 status=nf_fwrite2d(ng, model, s(ng)%ncid, idvbcs, &
1994 & s(ng)%Vid(idvbcs), &
1995 & s(ng)%Rindex, gtype, &
1996 & lbi, ubi, lbj, ubj, scale, &
1997# ifdef MASKING
1998 & grid(ng) % rmask, &
1999# endif
2000 & average(ng) % avgVbcs)
2001# endif
2002 END IF
2003 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2004 IF (master) THEN
2005 WRITE (stdout,10) trim(vname(1,idvbcs)), s(ng)%Rindex
2006 END IF
2007 exit_flag=3
2008 ioerror=status
2009 RETURN
2010 END IF
2011 END IF
2012!
2013! Write out maximum wave and current bottom stress magnitude.
2014!
2015 IF (varout(iduvwc,ng)) THEN
2016 scale=rho0
2017 gtype=gfactor*r2dvar
2018 IF (linstataneous) THEN
2019 IF (.not.allocated(wrk2d)) THEN
2020 allocate ( wrk2d(lbi:ubi, lbj:ubj) )
2021 wrk2d(lbi:ubi,lbj:ubj)=0.0_r8
2022 END IF
2023 wrk2d=sqrt(bbl(ng)%bustrcwmax*bbl(ng)%bustrcwmax+ &
2024 & bbl(ng)%bvstrcwmax*bbl(ng)%bvstrcwmax+1.0e-10_r8)
2025!
2026 status=nf_fwrite2d(ng, model, s(ng)%ncid, iduvwc, &
2027 & s(ng)%Vid(iduvwc), &
2028 & s(ng)%Rindex, gtype, &
2029 & lbi, ubi, lbj, ubj, scale, &
2030# ifdef MASKING
2031 & grid(ng) % rmask, &
2032# endif
2033 & wrk2d)
2034 deallocate (wrk2d)
2035# ifdef AVERAGES
2036 ELSE
2037 status=nf_fwrite2d(ng, model, s(ng)%ncid, iduvwc, &
2038 & s(ng)%Vid(iduvwc), &
2039 & s(ng)%Rindex, gtype, &
2040 & lbi, ubi, lbj, ubj, scale, &
2041# ifdef MASKING
2042 & grid(ng) % rmask, &
2043# endif
2044 & average(ng) % avgUVwc)
2045# endif
2046 END IF
2047 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2048 IF (master) THEN
2049 WRITE (stdout,10) trim(vname(1,iduvwc)), s(ng)%Rindex
2050 END IF
2051 exit_flag=3
2052 ioerror=status
2053 RETURN
2054 END IF
2055 END IF
2056!
2057! Write out wind-induced, bed wave orbital U-velocity at RHO-points.
2058!
2059 IF (varout(idubot,ng)) THEN
2060 scale=1.0_dp
2061 gtype=gfactor*r2dvar
2062 IF (linstataneous) THEN
2063 status=nf_fwrite2d(ng, model, s(ng)%ncid, idubot, &
2064 & s(ng)%Vid(idubot), &
2065 & s(ng)%Rindex, gtype, &
2066 & lbi, ubi, lbj, ubj, scale, &
2067# ifdef MASKING
2068 & grid(ng) % rmask, &
2069# endif
2070 & bbl(ng) % Ubot)
2071# ifdef AVERAGES
2072 ELSE
2073 status=nf_fwrite2d(ng, model, s(ng)%ncid, idubot, &
2074 & s(ng)%Vid(idubot), &
2075 & s(ng)%Rindex, gtype, &
2076 & lbi, ubi, lbj, ubj, scale, &
2077# ifdef MASKING
2078 & grid(ng) % rmask, &
2079# endif
2080 & average(ng) % avgUbot)
2081# endif
2082 END IF
2083 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2084 IF (master) THEN
2085 WRITE (stdout,10) trim(vname(1,idubot)), s(ng)%Rindex
2086 END IF
2087 exit_flag=3
2088 ioerror=status
2089 RETURN
2090 END IF
2091 END IF
2092!
2093! Write out wind-induced, bed wave orbital V-velocity at RHO-points
2094!
2095 IF (varout(idvbot,ng)) THEN
2096 scale=1.0_dp
2097 gtype=gfactor*r2dvar
2098 IF (linstataneous) THEN
2099 status=nf_fwrite2d(ng, model, s(ng)%ncid, idvbot, &
2100 & s(ng)%Vid(idvbot), &
2101 & s(ng)%Rindex, gtype, &
2102 & lbi, ubi, lbj, ubj, scale, &
2103# ifdef MASKING
2104 & grid(ng) % rmask, &
2105# endif
2106 & bbl(ng) % Vbot)
2107# ifdef AVERAGES
2108 ELSE
2109 status=nf_fwrite2d(ng, model, s(ng)%ncid, idvbot, &
2110 & s(ng)%Vid(idvbot), &
2111 & s(ng)%Rindex, gtype, &
2112 & lbi, ubi, lbj, ubj, scale, &
2113# ifdef MASKING
2114 & grid(ng) % rmask, &
2115# endif
2116 & average(ng) % avgVbot)
2117# endif
2118 END IF
2119 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2120 IF (master) THEN
2121 WRITE (stdout,10) trim(vname(1,idvbot)), s(ng)%Rindex
2122 END IF
2123 exit_flag=3
2124 ioerror=status
2125 RETURN
2126 END IF
2127 END IF
2128!
2129! Write out bottom U-velocity above bed at RHO-points.
2130!
2131 IF (varout(idubur,ng)) THEN
2132 scale=1.0_dp
2133 gtype=gfactor*r2dvar
2134 IF (linstataneous) THEN
2135 status=nf_fwrite2d(ng, model, s(ng)%ncid, idubur, &
2136 & s(ng)%Vid(idubur), &
2137 & s(ng)%Rindex, gtype, &
2138 & lbi, ubi, lbj, ubj, scale, &
2139# ifdef MASKING
2140 & grid(ng) % rmask, &
2141# endif
2142 & bbl(ng) % Ur)
2143# ifdef AVERAGES
2144 ELSE
2145 status=nf_fwrite2d(ng, model, s(ng)%ncid, idubur, &
2146 & s(ng)%Vid(idubur), &
2147 & s(ng)%Rindex, gtype, &
2148 & lbi, ubi, lbj, ubj, scale, &
2149# ifdef MASKING
2150 & grid(ng) % rmask, &
2151# endif
2152 & average(ng) % avgUbur)
2153# endif
2154 END IF
2155 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2156 IF (master) THEN
2157 WRITE (stdout,10) trim(vname(1,idubur)), s(ng)%Rindex
2158 END IF
2159 exit_flag=3
2160 ioerror=status
2161 RETURN
2162 END IF
2163 END IF
2164!
2165! Write out bottom V-velocity above bed at RHO-points.
2166!
2167 IF (varout(idvbvr,ng)) THEN
2168 scale=1.0_dp
2169 gtype=gfactor*r2dvar
2170 IF (linstataneous) THEN
2171 status=nf_fwrite2d(ng, model, s(ng)%ncid, idvbvr, &
2172 & s(ng)%Vid(idvbvr), &
2173 & s(ng)%Rindex, gtype, &
2174 & lbi, ubi, lbj, ubj, scale, &
2175# ifdef MASKING
2176 & grid(ng) % rmask, &
2177# endif
2178 & bbl(ng) % Vr)
2179# ifdef AVERAGES
2180 ELSE
2181 status=nf_fwrite2d(ng, model, s(ng)%ncid, idvbvr, &
2182 & s(ng)%Vid(idvbvr), &
2183 & s(ng)%Rindex, gtype, &
2184 & lbi, ubi, lbj, ubj, scale, &
2185# ifdef MASKING
2186 & grid(ng) % rmask, &
2187# endif
2188 & average(ng) % avgVbvr)
2189# endif
2190 END IF
2191 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2192 IF (master) THEN
2193 WRITE (stdout,10) trim(vname(1,idvbvr)), s(ng)%Rindex
2194 END IF
2195 exit_flag=3
2196 ioerror=status
2197 RETURN
2198 END IF
2199 END IF
2200# endif
2201
2202# if defined UV_KIRBY && defined AVERAGES
2203!
2204! Write out U-velocity from Kirby and Chen.
2205!
2206 IF (varout(iduwav,ng)) THEN
2207 scale=1.0_dp
2208 gtype=gfactor*r2dvar
2209 IF (.not.linstataneous) THEN
2210 status=nf_fwrite2d(ng, model, s(ng)%ncid, iduwav, &
2211 & s(ng)%Vid(iduwav), &
2212 & s(ng)%Rindex, gtype, &
2213 & lbi, ubi, lbj, ubj, scale, &
2214# ifdef MASKING
2215 & grid(ng) % rmask, &
2216# endif
2217 & average(ng) % avgUwav)
2218 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2219 IF (master) THEN
2220 WRITE (stdout,10) trim(vname(1,iduwav)), s(ng)%Rindex
2221 END IF
2222 exit_flag=3
2223 ioerror=status
2224 RETURN
2225 END IF
2226 END IF
2227 END IF
2228!
2229! Write out V-velocity from Kirby and Chen.
2230!
2231 IF (varout(idvwav,ng)) THEN
2232 scale=1.0_dp
2233 gtype=gfactor*r2dvar
2234 IF (.not.linstataneous) THEN
2235 status=nf_fwrite2d(ng, model, s(ng)%ncid, idvwav, &
2236 & s(ng)%Vid(idvwav), &
2237 & s(ng)%Rindex, gtype, &
2238 & lbi, ubi, lbj, ubj, scale, &
2239# ifdef MASKING
2240 & grid(ng) % rmask, &
2241# endif
2242 & average(ng) % avgVwav)
2243 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2244 IF (master) THEN
2245 WRITE (stdout,10) trim(vname(1,idvwav)), s(ng)%Rindex
2246 END IF
2247 exit_flag=3
2248 ioerror=status
2249 RETURN
2250 END IF
2251 END IF
2252 END IF
2253# endif
2254
2255# ifdef WAVES_HEIGHT
2256!
2257! Write out wind-induced signiticant wave height.
2258!
2259 IF (varout(idwamp,ng)) THEN
2260 scale=1.0_dp
2261 gtype=gfactor*r2dvar
2262 IF (linstataneous) THEN
2263 status=nf_fwrite2d(ng, model, s(ng)%ncid, idwamp, &
2264 & s(ng)%Vid(idwamp), &
2265 & s(ng)%Rindex, gtype, &
2266 & lbi, ubi, lbj, ubj, scale, &
2267# ifdef MASKING
2268 & grid(ng) % rmask, &
2269# endif
2270 & forces(ng) % Hwave)
2271# ifdef AVERAGES
2272 ELSE
2273 status=nf_fwrite2d(ng, model, s(ng)%ncid, idwamp, &
2274 & s(ng)%Vid(idwamp), &
2275 & s(ng)%Rindex, gtype, &
2276 & lbi, ubi, lbj, ubj, scale, &
2277# ifdef MASKING
2278 & grid(ng) % rmask, &
2279# endif
2280 & average(ng) % avgWamp)
2281# endif
2282 END IF
2283 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2284 IF (master) THEN
2285 WRITE (stdout,10) trim(vname(1,idwamp)), s(ng)%Rindex
2286 END IF
2287 exit_flag=3
2288 ioerror=status
2289 RETURN
2290 END IF
2291 END IF
2292
2293# ifdef AVERAGES
2294!
2295! Write out wind-induced significant wave height squared.
2296!
2297 IF (varout(idwam2,ng)) THEN
2298 scale=1.0_dp
2299 gtype=gfactor*r2dvar
2300 IF (.not.linstataneous) THEN
2301 status=nf_fwrite2d(ng, model, s(ng)%ncid, idwam2, &
2302 & s(ng)%Vid(idwam2), &
2303 & s(ng)%Rindex, gtype, &
2304 & lbi, ubi, lbj, ubj, scale, &
2305# ifdef MASKING
2306 & grid(ng) % rmask, &
2307# endif
2308 & average(ng) % avgWam2)
2309 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2310 IF (master) THEN
2311 WRITE (stdout,10) trim(vname(1,idwam2)), s(ng)%Rindex
2312 END IF
2313 exit_flag=3
2314 ioerror=status
2315 RETURN
2316 END IF
2317 END IF
2318 END IF
2319# endif
2320# endif
2321
2322# ifdef WAVES_LENGTH
2323!
2324! Write out wind-induced mean wavelength.
2325!
2326 IF (varout(idwlen,ng)) THEN
2327 scale=1.0_dp
2328 gtype=gfactor*r2dvar
2329 IF (linstataneous) THEN
2330 status=nf_fwrite2d(ng, model, s(ng)%ncid, idwlen, &
2331 & s(ng)%Vid(idwlen), &
2332 & s(ng)%Rindex, gtype, &
2333 & lbi, ubi, lbj, ubj, scale, &
2334# ifdef MASKING
2335 & grid(ng) % rmask, &
2336# endif
2337 & forces(ng) % Lwave)
2338# ifdef AVERAGES
2339 ELSE
2340 status=nf_fwrite2d(ng, model, s(ng)%ncid, idwlen, &
2341 & s(ng)%Vid(idwlen), &
2342 & s(ng)%Rindex, gtype, &
2343 & lbi, ubi, lbj, ubj, scale, &
2344# ifdef MASKING
2345 & grid(ng) % rmask, &
2346# endif
2347 & average(ng) % avgWlen)
2348# endif
2349 END IF
2350 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2351 IF (master) THEN
2352 WRITE (stdout,10) trim(vname(1,idwlen)), s(ng)%Rindex
2353 END IF
2354 exit_flag=3
2355 ioerror=status
2356 RETURN
2357 END IF
2358 END IF
2359# endif
2360
2361# ifdef WAVES_LENGTHP
2362!
2363! Write out wind-induced peak wave wavelength.
2364!
2365 IF (varout(idwlep,ng)) THEN
2366 scale=1.0_dp
2367 gtype=gfactor*r2dvar
2368 IF (linstataneous) THEN
2369 status=nf_fwrite2d(ng, model, s(ng)%ncid, idwlep, &
2370 & s(ng)%Vid(idwlep), &
2371 & s(ng)%Rindex, gtype, &
2372 & lbi, ubi, lbj, ubj, scale, &
2373# ifdef MASKING
2374 & grid(ng) % rmask, &
2375# endif
2376 & forces(ng) % Lwavep)
2377# ifdef AVERAGES
2378 ELSE
2379 status=nf_fwrite2d(ng, model, s(ng)%ncid, idwlep, &
2380 & s(ng)%Vid(idwlep), &
2381 & s(ng)%Rindex, gtype, &
2382 & lbi, ubi, lbj, ubj, scale, &
2383# ifdef MASKING
2384 & grid(ng) % rmask, &
2385# endif
2386 & average(ng) % avgWlep)
2387# endif
2388 END IF
2389 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2390 IF (master) THEN
2391 WRITE (stdout,10) trim(vname(1,idwlep)), s(ng)%Rindex
2392 END IF
2393 exit_flag=3
2394 ioerror=status
2395 RETURN
2396 END IF
2397 END IF
2398# endif
2399
2400# ifdef WAVES_DIR
2401!
2402! Write out wind-induced mean wave direction.
2403!
2404 IF (varout(idwdir,ng)) THEN
2405 scale=rad2deg
2406 gtype=gfactor*r2dvar
2407 IF (linstataneous) THEN
2408 status=nf_fwrite2d(ng, model, s(ng)%ncid, idwdir, &
2409 & s(ng)%Vid(idwdir), &
2410 & s(ng)%Rindex, gtype, &
2411 & lbi, ubi, lbj, ubj, scale, &
2412# ifdef MASKING
2413 & grid(ng) % rmask, &
2414# endif
2415 & forces(ng) % Dwave)
2416# ifdef AVERAGES
2417 ELSE
2418 status=nf_fwrite2d(ng, model, s(ng)%ncid, idwdir, &
2419 & s(ng)%Vid(idwdir), &
2420 & s(ng)%Rindex, gtype, &
2421 & lbi, ubi, lbj, ubj, scale, &
2422# ifdef MASKING
2423 & grid(ng) % rmask, &
2424# endif
2425 & average(ng) % avgWdir)
2426# endif
2427 END IF
2428 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2429 IF (master) THEN
2430 WRITE (stdout,10) trim(vname(1,idwdir)), s(ng)%Rindex
2431 END IF
2432 exit_flag=3
2433 ioerror=status
2434 RETURN
2435 END IF
2436 END IF
2437# endif
2438
2439# ifdef WAVES_DIRP
2440!
2441! Write out wind-induced peak wave direction.
2442!
2443 IF (varout(idwdip,ng)) THEN
2444 scale=rad2deg
2445 gtype=gfactor*r2dvar
2446 IF (linstataneous) THEN
2447 status=nf_fwrite2d(ng, model, s(ng)%ncid, idwdip, &
2448 & s(ng)%Vid(idwdip), &
2449 & s(ng)%Rindex, gtype, &
2450 & lbi, ubi, lbj, ubj, scale, &
2451# ifdef MASKING
2452 & grid(ng) % rmask, &
2453# endif
2454 & forces(ng) % Dwavep)
2455# ifdef AVERAGES
2456 ELSE
2457 status=nf_fwrite2d(ng, model, s(ng)%ncid, idwdip, &
2458 & s(ng)%Vid(idwdip), &
2459 & s(ng)%Rindex, gtype, &
2460 & lbi, ubi, lbj, ubj, scale, &
2461# ifdef MASKING
2462 & grid(ng) % rmask, &
2463# endif
2464 & average(ng) % avgWdip)
2465# endif
2466 END IF
2467 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2468 IF (master) THEN
2469 WRITE (stdout,10) trim(vname(1,idwdip)), s(ng)%Rindex
2470 END IF
2471 exit_flag=3
2472 ioerror=status
2473 RETURN
2474 END IF
2475 END IF
2476# endif
2477
2478# ifdef WAVES_TOP_PERIOD
2479!
2480! Write out wind-induced surface wave period.
2481!
2482 IF (varout(idwptp,ng)) THEN
2483 scale=1.0_dp
2484 gtype=gfactor*r2dvar
2485 IF (linstataneous) THEN
2486 status=nf_fwrite2d(ng, model, s(ng)%ncid, idwptp, &
2487 & s(ng)%Vid(idwptp), &
2488 & s(ng)%Rindex, gtype, &
2489 & lbi, ubi, lbj, ubj, scale, &
2490# ifdef MASKING
2491 & grid(ng) % rmask, &
2492# endif
2493 & forces(ng) % Pwave_top)
2494# ifdef AVERAGES
2495 ELSE
2496 status=nf_fwrite2d(ng, model, s(ng)%ncid, idwptp, &
2497 & s(ng)%Vid(idwptp), &
2498 & s(ng)%Rindex, gtype, &
2499 & lbi, ubi, lbj, ubj, scale, &
2500# ifdef MASKING
2501 & grid(ng) % rmask, &
2502# endif
2503 & average(ng) % avgWptp)
2504# endif
2505 END IF
2506 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2507 IF (master) THEN
2508 WRITE (stdout,10) trim(vname(1,idwptp)), s(ng)%Rindex
2509 END IF
2510 exit_flag=3
2511 ioerror=status
2512 RETURN
2513 END IF
2514 END IF
2515# endif
2516
2517# ifdef WAVES_BOT_PERIOD
2518!
2519! Write out wind-induced bottom wave period.
2520!
2521 IF (varout(idwpbt,ng)) THEN
2522 scale=1.0_dp
2523 gtype=gfactor*r2dvar
2524 IF (linstataneous) THEN
2525 status=nf_fwrite2d(ng, model, s(ng)%ncid, idwpbt, &
2526 & s(ng)%Vid(idwpbt), &
2527 & s(ng)%Rindex, gtype, &
2528 & lbi, ubi, lbj, ubj, scale, &
2529# ifdef MASKING
2530 & grid(ng) % rmask, &
2531# endif
2532 & forces(ng) % Pwave_bot)
2533# ifdef AVERAGES
2534 ELSE
2535 status=nf_fwrite2d(ng, model, s(ng)%ncid, idwpbt, &
2536 & s(ng)%Vid(idwpbt), &
2537 & s(ng)%Rindex, gtype, &
2538 & lbi, ubi, lbj, ubj, scale, &
2539# ifdef MASKING
2540 & grid(ng) % rmask, &
2541# endif
2542 & average(ng) % avgWpbt)
2543# endif
2544 END IF
2545 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2546 IF (master) THEN
2547 WRITE (stdout,10) trim(vname(1,idwpbt)), s(ng)%Rindex
2548 END IF
2549 exit_flag=3
2550 ioerror=status
2551 RETURN
2552 END IF
2553 END IF
2554# endif
2555
2556# ifdef WAVES_DSPR
2557!
2558! Write out waves directional spreading.
2559!
2560 IF (varout(idwvds,ng)) THEN
2561 IF (linstataneous) THEN
2562 scale=1.0_dp
2563 gtype=gfactor*r2dvar
2564 status=nf_fwrite2d(ng, model, s(ng)%ncid, idwvds, &
2565 & s(ng)%Vid(idwvds), &
2566 & s(ng)%Rindex, gtype, &
2567 & lbi, ubi, lbj, ubj, scale, &
2568# ifdef MASKING
2569 & grid(ng) % rmask, &
2570# endif
2571 & forces(ng) % Wave_ds)
2572 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2573 IF (master) THEN
2574 WRITE (stdout,10) trim(vname(1,idwvds)), s(ng)%Rindex
2575 END IF
2576 exit_flag=3
2577 ioerror=status
2578 RETURN
2579 END IF
2580 END IF
2581 END IF
2582!
2583! Write out waves spectrum peakeness.
2584!
2585 IF (varout(idwvqp,ng)) THEN
2586 IF (linstataneous) THEN
2587 scale=1.0_dp
2588 gtype=gfactor*r2dvar
2589 status=nf_fwrite2d(ng, model, s(ng)%ncid, idwvqp, &
2590 & s(ng)%Vid(idwvqp), &
2591 & s(ng)%Rindex, gtype, &
2592 & lbi, ubi, lbj, ubj, scale, &
2593# ifdef MASKING
2594 & grid(ng) % rmask, &
2595# endif
2596 & forces(ng) % Wave_qp)
2597 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2598 IF (master) THEN
2599 WRITE (stdout,10) trim(vname(1,idwvqp)), s(ng)%Rindex
2600 END IF
2601 exit_flag=3
2602 ioerror=status
2603 RETURN
2604 END IF
2605 END IF
2606 END IF
2607# endif
2608!
2609 10 FORMAT (/," BBL_WRT_NF90 - error while writing variable '", &
2610 & a,"', time record = ",i0,/,11x,'into file: ',a)
2611!
2612 RETURN
2613 END SUBROUTINE bbl_wrt_nf90
2614
2615# ifdef STATIONS
2616!
2617!***********************************************************************
2618 SUBROUTINE bbl_wrt_station_nf90 (ng, model, tile, &
2619 & LBi, UBi, LBj, UBj, &
2620 & VarOut, S)
2621!***********************************************************************
2622!
2623 USE mod_netcdf
2624!
2625! Imported variable declarations.
2626!
2627 logical, intent(in) :: varout(nv,ngrids)
2628!
2629 integer, intent(in) :: ng, model, tile
2630 integer, intent(in) :: lbi, ubi, lbj, ubj
2631!
2632 TYPE(t_io), intent(inout) :: s(ngrids)
2633!
2634! Local variable declarations.
2635!
2636 logical :: cgrid
2637!
2638 integer :: nposr, nposw
2639 integer :: i, k, np, status
2640!
2641 real(dp) :: scale
2642!
2643 real(r8), dimension(Nstation(ng)) :: xpos, ypos, zpos, psta
2644# ifdef SOLVE3D
2645 real(r8), dimension(Nstation(ng)*(N(ng))) :: xposr, yposr, zposr
2646 real(r8), dimension(Nstation(ng)*(N(ng)+1)) :: rsta
2647# endif
2648!
2649 character (len=*), parameter :: myfile = &
2650 & __FILE__//", bbl_wrt_station_nf90"
2651!
2652 sourcefile=myfile
2653!
2654!-----------------------------------------------------------------------
2655! Write out sediment output variables into specified stations NetCDF
2656! file.
2657!-----------------------------------------------------------------------
2658!
2659 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2660!
2661! Set switch to extract station data at native C-grid position (TRUE)
2662! or at RHO-points (FALSE).
2663!
2664# ifdef STATIONS_CGRID
2665 cgrid=.true.
2666# else
2667 cgrid=.false.
2668# endif
2669!
2670! Set positions for generic extraction routine.
2671!
2672 nposr=nstation(ng)*n(ng)
2673 nposw=nstation(ng)*(n(ng)+1)
2674 DO i=1,nstation(ng)
2675 xpos(i)=scalars(ng)%SposX(i)
2676 ypos(i)=scalars(ng)%SposY(i)
2677 zpos(i)=1.0_r8
2678# ifdef SOLVE3D
2679 DO k=1,n(ng)
2680 np=k+(i-1)*n(ng)
2681 xposr(np)=scalars(ng)%SposX(i)
2682 yposr(np)=scalars(ng)%SposY(i)
2683 zposr(np)=real(k,r8)
2684 END DO
2685# endif
2686 END DO
2687
2688# ifdef WAVES_UB
2689!
2690! Write out wind-induced wave bottom orbital velocity.
2691!
2692 IF (varout(idworb,ng)) THEN
2693 scale=1.0_dp
2694 CALL extract_sta2d (ng, model, cgrid, idworb, r2dvar, &
2695 & lbi, ubi, lbj, ubj, &
2696 & scale, forces(ng) % Uwave_rms, &
2697 & nstation(ng), xpos, ypos, psta)
2698 CALL netcdf_put_fvar (ng, model, s(ng)%name, &
2699 & trim(vname(1,idworb)), psta, &
2700 & (/1,s(ng)%Rindex/), (/nstation(ng),1/), &
2701 & ncid = s(ng)%ncid, &
2702 & varid = s(ng)%Vid(idworb))
2703 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2704 END IF
2705# endif
2706
2707# ifdef BBL_MODEL
2708!
2709! Write out current-induced, bottom U-stress.
2710!
2711 IF (varout(idubrs,ng)) THEN
2712 scale=-rho0
2713 CALL extract_sta2d (ng, model, cgrid, idubrs, r2dvar, &
2714 & lbi, ubi, lbj, ubj, &
2715 & scale, bbl(ng)%bustrc, &
2716 & nstation(ng), xpos, ypos, psta)
2717 CALL netcdf_put_fvar (ng, model, s(ng)%name, &
2718 & trim(vname(1,idubrs)), psta, &
2719 & (/1,s(ng)%Rindex/), (/nstation(ng),1/), &
2720 & ncid = s(ng)%ncid, &
2721 & varid = s(ng)%Vid(idubrs))
2722 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2723 END IF
2724!
2725! Write out current-induced, bottom V-stress.
2726!
2727 IF (varout(idvbrs,ng)) THEN
2728 scale=-rho0
2729 CALL extract_sta2d (ng, model, cgrid, idvbrs, r2dvar, &
2730 & lbi, ubi, lbj, ubj, &
2731 & scale, bbl(ng)%bvstrc, &
2732 & nstation(ng), xpos, ypos, psta)
2733 CALL netcdf_put_fvar (ng, model, s(ng)%name, &
2734 & trim(vname(1,idvbrs)), psta, &
2735 & (/1,s(ng)%Rindex/), (/nstation(ng),1/), &
2736 & ncid = s(ng)%ncid, &
2737 & varid = s(ng)%Vid(idvbrs))
2738 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2739 END IF
2740!
2741! Write out wind-induced, bottom U-stress.
2742!
2743 IF (varout(idubws,ng)) THEN
2744 scale=rho0
2745 CALL extract_sta2d (ng, model, cgrid, idubws, r2dvar, &
2746 & lbi, ubi, lbj, ubj, &
2747 & scale, bbl(ng)%bustrw, &
2748 & nstation(ng), xpos, ypos, psta)
2749 CALL netcdf_put_fvar (ng, model, s(ng)%name, &
2750 & trim(vname(1,idubws)), psta, &
2751 & (/1,s(ng)%Rindex/), (/nstation(ng),1/), &
2752 & ncid = s(ng)%ncid, &
2753 & varid = s(ng)%Vid(idubws))
2754 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2755 END IF
2756!
2757! Write out wind-induced, bottom V-wave stress.
2758!
2759 IF (varout(idvbws,ng)) THEN
2760 scale=rho0
2761 CALL extract_sta2d (ng, model, cgrid, idvbws, r2dvar, &
2762 & lbi, ubi, lbj, ubj, &
2763 & scale, bbl(ng)%bvstrw, &
2764 & nstation(ng), xpos, ypos, psta)
2765 CALL netcdf_put_fvar (ng, model, s(ng)%name, &
2766 & trim(vname(1,idvbws)), psta, &
2767 & (/1,s(ng)%Rindex/), (/nstation(ng),1/), &
2768 & ncid = s(ng)%ncid, &
2769 & varid = s(ng)%Vid(idvbws))
2770 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2771 END IF
2772!
2773! Write out maximum wind and current, bottom U-stress.
2774!
2775 IF (varout(idubcs,ng)) THEN
2776 scale=rho0
2777 CALL extract_sta2d (ng, model, cgrid, idubcs, r2dvar, &
2778 & lbi, ubi, lbj, ubj, &
2779 & scale, bbl(ng)%bustrcwmax, &
2780 & nstation(ng), xpos, ypos, psta)
2781 CALL netcdf_put_fvar (ng, model, s(ng)%name, &
2782 & trim(vname(1,idubcs)), psta, &
2783 & (/1,s(ng)%Rindex/), (/nstation(ng),1/), &
2784 & ncid = s(ng)%ncid, &
2785 & varid = s(ng)%Vid(idubcs))
2786 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2787 END IF
2788!
2789! Write out maximum wind and current, bottom V-stress.
2790!
2791 IF (varout(idvbcs,ng)) THEN
2792 scale=rho0
2793 CALL extract_sta2d (ng, model, cgrid, idvbcs, r2dvar, &
2794 & lbi, ubi, lbj, ubj, &
2795 & scale, bbl(ng)%bvstrcwmax, &
2796 & nstation(ng), xpos, ypos, psta)
2797 CALL netcdf_put_fvar (ng, model, s(ng)%name, &
2798 & trim(vname(1,idvbcs)), psta, &
2799 & (/1,s(ng)%Rindex/), (/nstation(ng),1/), &
2800 & ncid = s(ng)%ncid, &
2801 & varid = s(ng)%Vid(idvbcs))
2802 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2803 END IF
2804!
2805! Write out wind-induced, bed wave orbital U-velocity.
2806!
2807 IF (varout(idubot,ng)) THEN
2808 scale=1.0_dp
2809 CALL extract_sta2d (ng, model, cgrid, idubot, r2dvar, &
2810 & lbi, ubi, lbj, ubj, &
2811 & scale, bbl(ng)%Ubot, &
2812 & nstation(ng), xpos, ypos, psta)
2813 CALL netcdf_put_fvar (ng, model, s(ng)%name, &
2814 & trim(vname(1,idubot)), psta, &
2815 & (/1,s(ng)%Rindex/), (/nstation(ng),1/), &
2816 & ncid = s(ng)%ncid, &
2817 & varid = s(ng)%Vid(idubot))
2818 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2819 END IF
2820!
2821! Write out wind-induced, bed wave orbital V-velocity.
2822!
2823 IF (varout(idvbot,ng)) THEN
2824 scale=1.0_dp
2825 CALL extract_sta2d (ng, model, cgrid, idvbot, r2dvar, &
2826 & lbi, ubi, lbj, ubj, &
2827 & scale, bbl(ng)%Vbot, &
2828 & nstation(ng), xpos, ypos, psta)
2829 CALL netcdf_put_fvar (ng, model, s(ng)%name, &
2830 & trim(vname(1,idvbot)), psta, &
2831 & (/1,s(ng)%Rindex/), (/nstation(ng),1/), &
2832 & ncid = s(ng)%ncid, &
2833 & varid = s(ng)%Vid(idvbot))
2834 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2835 END IF
2836!
2837! Write out bottom U-velocity above bed.
2838!
2839 IF (varout(idubur,ng)) THEN
2840 scale=1.0_dp
2841 CALL extract_sta2d (ng, model, cgrid, idubur, r2dvar, &
2842 & lbi, ubi, lbj, ubj, &
2843 & scale, bbl(ng)%Ur, &
2844 & nstation(ng), xpos, ypos, psta)
2845 CALL netcdf_put_fvar (ng, model, s(ng)%name, &
2846 & trim(vname(1,idubur)), psta, &
2847 & (/1,s(ng)%Rindex/), (/nstation(ng),1/), &
2848 & ncid = s(ng)%ncid, &
2849 & varid = s(ng)%Vid(idubur))
2850 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2851 END IF
2852!
2853! Write out bottom V-velocity above bed.
2854!
2855 IF (varout(idvbvr,ng)) THEN
2856 scale=1.0_dp
2857 CALL extract_sta2d (ng, model, cgrid, idvbvr, r2dvar, &
2858 & lbi, ubi, lbj, ubj, &
2859 & scale, bbl(ng)%Vr, &
2860 & nstation(ng), xpos, ypos, psta)
2861 CALL netcdf_put_fvar (ng, model, s(ng)%name, &
2862 & trim(vname(1,idvbvr)), psta, &
2863 & (/1,s(ng)%Rindex/), (/nstation(ng),1/), &
2864 & ncid = s(ng)%ncid, &
2865 & varid = s(ng)%Vid(idvbvr))
2866 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2867 END IF
2868# endif
2869
2870# ifdef WAVES_HEIGHT
2871!
2872! Write out wind-induced significant wave height.
2873!
2874 IF (varout(idwamp,ng)) THEN
2875 scale=1.0_dp
2876 CALL extract_sta2d (ng, model, cgrid, idwamp, r2dvar, &
2877 & lbi, ubi, lbj, ubj, &
2878 & scale, forces(ng) % Hwave, &
2879 & nstation(ng), xpos, ypos, psta)
2880 CALL netcdf_put_fvar (ng, model, s(ng)%name, &
2881 & trim(vname(1,idwamp)), psta, &
2882 & (/1,s(ng)%Rindex/), (/nstation(ng),1/), &
2883 & ncid = s(ng)%ncid, &
2884 & varid = s(ng)%Vid(idwamp))
2885 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2886 END IF
2887# endif
2888
2889# ifdef WAVES_LENGTH
2890!
2891! Write out wind-induced mean wavelenght.
2892!
2893 IF (varout(idwlen,ng)) THEN
2894 scale=1.0_dp
2895 CALL extract_sta2d (ng, model, cgrid, idwlen, r2dvar, &
2896 & lbi, ubi, lbj, ubj, &
2897 & scale, forces(ng) % Lwave, &
2898 & nstation(ng), xpos, ypos, psta)
2899 CALL netcdf_put_fvar (ng, model, s(ng)%name, &
2900 & trim(vname(1,idwlen)), psta, &
2901 & (/1,s(ng)%Rindex/), (/nstation(ng),1/), &
2902 & ncid = s(ng)%ncid, &
2903 & varid = s(ng)%Vid(idwlen))
2904 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2905 END IF
2906# endif
2907
2908# ifdef WAVES_LENGTHP
2909!
2910! Write out wind-induced peak wave wavelength.
2911!
2912 IF (varout(idwlep,ng)) THEN
2913 scale=1.0_dp
2914 CALL extract_sta2d (ng, model, cgrid, idwlep, r2dvar, &
2915 & lbi, ubi, lbj, ubj, &
2916 & scale, forces(ng) % Lwavep, &
2917 & nstation(ng), xpos, ypos, psta)
2918 CALL netcdf_put_fvar (ng, model, s(ng)%name, &
2919 & trim(vname(1,idwlep)), psta, &
2920 & (/1,s(ng)%Rindex/), (/nstation(ng),1/), &
2921 & ncid = s(ng)%ncid, &
2922 & varid = s(ng)%Vid(idwlep))
2923 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2924 END IF
2925# endif
2926
2927# ifdef WAVES_DIR
2928!
2929! Write out wind-induced mean wave direction.
2930!
2931 IF (varout(idwdir,ng)) THEN
2932 scale=rad2deg
2933 CALL extract_sta2d (ng, model, cgrid, idwdir, r2dvar, &
2934 & lbi, ubi, lbj, ubj, &
2935 & scale, forces(ng) % Dwave, &
2936 & nstation(ng), xpos, ypos, psta)
2937 CALL netcdf_put_fvar (ng, model, s(ng)%name, &
2938 & trim(vname(1,idwdir)), psta, &
2939 & (/1,s(ng)%Rindex/), (/nstation(ng),1/), &
2940 & ncid = s(ng)%ncid, &
2941 & varid = s(ng)%Vid(idwdir))
2942 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2943 END IF
2944# endif
2945
2946# ifdef WAVES_DIRP
2947!
2948! Write out wind-induced peak wave direction.
2949!
2950 IF (varout(idwdip,ng)) THEN
2951 scale=rad2deg
2952 CALL extract_sta2d (ng, model, cgrid, idwdip, r2dvar, &
2953 & lbi, ubi, lbj, ubj, &
2954 & scale, forces(ng) % Dwavep, &
2955 & nstation(ng), xpos, ypos, psta)
2956 CALL netcdf_put_fvar (ng, model, s(ng)%name, &
2957 & trim(vname(1,idwdip)), psta, &
2958 & (/1,s(ng)%Rindex/), (/nstation(ng),1/), &
2959 & ncid = s(ng)%ncid, &
2960 & varid = s(ng)%Vid(idwdip))
2961 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2962 END IF
2963# endif
2964
2965# ifdef WAVES_TOP_PERIOD
2966!
2967! Write out wind-induced surface wave period.
2968!
2969 IF (varout(idwptp,ng)) THEN
2970 scale=1.0_dp
2971 CALL extract_sta2d (ng, model, cgrid, idwptp, r2dvar, &
2972 & lbi, ubi, lbj, ubj, &
2973 & scale, forces(ng) % Pwave_top, &
2974 & nstation(ng), xpos, ypos, psta)
2975 CALL netcdf_put_fvar (ng, model, s(ng)%name, &
2976 & trim(vname(1,idwptp)), psta, &
2977 & (/1,s(ng)%Rindex/), (/nstation(ng),1/), &
2978 & ncid = s(ng)%ncid, &
2979 & varid = s(ng)%Vid(idwptp))
2980 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2981 END IF
2982# endif
2983
2984# ifdef WAVES_BOT_PERIOD
2985!
2986! Write out wind-induced bottom wave period.
2987!
2988 IF (varout(idwpbt,ng)) THEN
2989 scale=1.0_dp
2990 CALL extract_sta2d (ng, model, cgrid, idwpbt, r2dvar, &
2991 & lbi, ubi, lbj, ubj, &
2992 & scale, forces(ng) % Pwave_bot, &
2993 & nstation(ng), xpos, ypos, psta)
2994 CALL netcdf_put_fvar (ng, model, s(ng)%name, &
2995 & trim(vname(1,idwpbt)), psta, &
2996 & (/1,s(ng)%Rindex/), (/nstation(ng),1/), &
2997 & ncid = s(ng)%ncid, &
2998 & varid = s(ng)%Vid(idwpbt))
2999 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3000 END IF
3001# endif
3002
3003# if defined WAVES_DSPR
3004!
3005! Write out waves directional spreading.
3006!
3007 IF (varout(idwvds,ng)) THEN
3008 scale=1.0_dp
3009 CALL extract_sta2d (ng, model, cgrid, idwvds, r2dvar, &
3010 & lbi, ubi, lbj, ubj, &
3011 & scale, forces(ng) % Wave_ds, &
3012 & nstation(ng), xpos, ypos, psta)
3013 CALL netcdf_put_fvar (ng, model, s(ng)%name, &
3014 & trim(vname(1,idwvds)), psta, &
3015 & (/1,s(ng)%Rindex/), (/nstation(ng),1/), &
3016 & ncid = s(ng)%ncid, &
3017 & varid = s(ng)%Vid(idwvds))
3018 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3019 END IF
3020!
3021! Write out wave spectrum peakedness.
3022!
3023 IF (varout(idwvqp,ng)) THEN
3024 scale=1.0_dp
3025 CALL extract_sta2d (ng, model, cgrid, idwvqp, r2dvar, &
3026 & lbi, ubi, lbj, ubj, &
3027 & scale, forces(ng) % Wave_qp, &
3028 & nstation(ng), xpos, ypos, psta)
3029 CALL netcdf_put_fvar (ng, model, s(ng)%name, &
3030 & trim(vname(1,idwvqp)), psta, &
3031 & (/1,s(ng)%Rindex/), (/nstation(ng),1/), &
3032 & ncid = s(ng)%ncid, &
3033 & varid = s(ng)%Vid(idwvqp))
3034 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3035 END IF
3036# endif
3037!
3038 RETURN
3039 END SUBROUTINE bbl_wrt_station_nf90
3040# endif
3041
3042# if defined PIO_LIB && defined DISTRIBUTE
3043!
3044!***********************************************************************
3045 SUBROUTINE bbl_def_pio (ng, model, ldef, VarOut, S, &
3046 & t2dgrd, u2dgrd, v2dgrd)
3047!***********************************************************************
3048!
3049 USE mod_pio_netcdf
3050!
3051! Imported variable declarations.
3052!
3053 logical, intent(in) :: ldef, varout(nv,ngrids)
3054!
3055 integer, intent(in) :: ng, model
3056 integer, intent(in), optional :: t2dgrd(:), u2dgrd(:), v2dgrd(:)
3057!
3058 TYPE(t_io), intent(inout) :: s(ngrids)
3059!
3060! Local variable declarations.
3061!
3062 logical :: got_var(nv)
3063!
3064 integer, parameter :: natt = 25
3065
3066 integer :: i, j, nvd3, nvd4, status
3067!
3068 real(r8) :: aval(6)
3069!
3070# ifdef ADJOINT
3071 character (len=21) :: prefix
3072# else
3073 character (len=13) :: prefix
3074# endif
3075 character (len=120) :: vinfo(natt)
3076 character (len=256) :: ncname
3077!
3078 character (len=*), parameter :: myfile = &
3079 & __FILE__//", bbl_def_pio"
3080!
3081 sourcefile=myfile
3082!
3083!-----------------------------------------------------------------------
3084! Define Waves Effect on Currents output variables.
3085!-----------------------------------------------------------------------
3086!
3087 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3088 ncname=s(ng)%name
3089!
3090 define : IF (ldef) THEN
3091!
3092! Set number of dimensions for output variables.
3093!
3094# if defined WRITE_WATER && defined MASKING
3095 nvd3=2
3096 nvd4=2
3097# else
3098 nvd3=3
3099 nvd4=4
3100# endif
3101!
3102! Set long name prefix string.
3103!
3104# ifdef ADJOINT
3105!! Prefix='time-averaged adjoint'
3106 prefix='adjoint'
3107# else
3108!! Prefix='time-averaged'
3109 prefix=char(32) ! blank space
3110# endif
3111!
3112! Initialize local information variable arrays.
3113!
3114 DO i=1,natt
3115 DO j=1,len(vinfo(1))
3116 vinfo(i)(j:j)=' '
3117 END DO
3118 END DO
3119 DO i=1,6
3120 aval(i)=0.0_r8
3121 END DO
3122
3123# if defined BBL_MODEL || defined SED_BEDLOAD_VANDERA || \
3124 defined wav_coupling
3125!
3126! Define wind-induced bottom orbital velocity.
3127!
3128 IF (varout(idworb,ng)) THEN
3129 vinfo( 1)=vname(1,idworb)
3130 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
3131 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idworb))
3132 ELSE
3133 vinfo( 2)=vname(2,idworb)
3134 END IF
3135 vinfo( 3)=vname(3,idworb)
3136 vinfo(14)=vname(4,idworb)
3137 vinfo(16)=vname(1,idtime)
3138# if defined WRITE_WATER && defined MASKING
3139 vinfo(20)='mask_rho'
3140# endif
3141 vinfo(21)=vname(6,idworb)
3142 vinfo(22)='coordinates'
3143 aval(5)=real(iinfo(1,idworb,ng),r8)
3144 s(ng)%pioVar(idworb)%dkind=pio_fout
3145 s(ng)%pioVar(idworb)%gtype=r2dvar
3146!
3147 status=def_var(ng, model, s(ng)%pioFile, &
3148 & s(ng)%pioVar(idworb)%vd, &
3149 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
3150 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3151 END IF
3152# endif
3153
3154# ifdef BBL_MODEL
3155!
3156! Define bottom U-current stress.
3157!
3158 IF (varout(idubrs,ng)) THEN
3159 vinfo( 1)=vname(1,idubrs)
3160 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
3161 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idubrs))
3162 ELSE
3163 vinfo( 2)=vname(2,idubrs)
3164 END IF
3165 vinfo( 3)=vname(3,idubrs)
3166 vinfo(14)=vname(4,idubrs)
3167 vinfo(16)=vname(1,idtime)
3168# if defined WRITE_WATER && defined MASKING
3169 vinfo(20)='mask_rho'
3170# endif
3171 vinfo(21)=vname(6,idubrs)
3172 vinfo(22)='coordinates'
3173 aval(5)=real(iinfo(1,idubrs,ng),r8)
3174 s(ng)%pioVar(idubrs)%dkind=pio_fout
3175 s(ng)%pioVar(idubrs)%gtype=r2dvar
3176!
3177 status=def_var(ng, model, s(ng)%pioFile, &
3178 & s(ng)%pioVar(idubrs)%vd, &
3179 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
3180 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3181 END IF
3182!
3183! Define bottom V-current stress.
3184!
3185 IF (varout(idvbrs,ng)) THEN
3186 vinfo( 1)=vname(1,idvbrs)
3187 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
3188 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idvbrs))
3189 ELSE
3190 vinfo( 2)=vname(2,idvbrs)
3191 END IF
3192 vinfo( 3)=vname(3,idvbrs)
3193 vinfo(14)=vname(4,idvbrs)
3194 vinfo(16)=vname(1,idtime)
3195# if defined WRITE_WATER && defined MASKING
3196 vinfo(20)='mask_rho'
3197# endif
3198 vinfo(21)=vname(6,idvbrs)
3199 vinfo(22)='coordinates'
3200 aval(5)=real(iinfo(1,idvbrs,ng),r8)
3201 s(ng)%pioVar(idvbrs)%dkind=pio_fout
3202 s(ng)%pioVar(idvbrs)%gtype=r2dvar
3203!
3204 status=def_var(ng, model, s(ng)%pioFile, &
3205 & s(ng)%pioVar(idvbrs)%vd, &
3206 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
3207 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3208 END IF
3209!
3210! Define wind-induced, bottom U-wave stress.
3211!
3212 IF (varout(idubws,ng)) THEN
3213 vinfo( 1)=vname(1,idubws)
3214 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
3215 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idubws))
3216 ELSE
3217 vinfo( 2)=vname(2,idubws)
3218 END IF
3219 vinfo( 3)=vname(3,idubws)
3220 vinfo(14)=vname(4,idubws)
3221 vinfo(16)=vname(1,idtime)
3222# if defined WRITE_WATER && defined MASKING
3223 vinfo(20)='mask_rho'
3224# endif
3225 vinfo(21)=vname(6,idubws)
3226 vinfo(22)='coordinates'
3227 aval(5)=real(iinfo(1,idubws,ng),r8)
3228 s(ng)%pioVar(idubws)%dkind=pio_fout
3229 s(ng)%pioVar(idubws)%gtype=r2dvar
3230!
3231 status=def_var(ng, model, s(ng)%pioFile, &
3232 & s(ng)%pioVar(idubws)%vd, &
3233 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
3234 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3235 END IF
3236!
3237! Define bottom wind-induced, bottom V-wave stress.
3238!
3239 IF (varout(idvbws,ng)) THEN
3240 vinfo( 1)=vname(1,idvbws)
3241 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
3242 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idvbws))
3243 ELSE
3244 vinfo( 2)=vname(2,idvbws)
3245 END IF
3246 vinfo( 3)=vname(3,idvbws)
3247 vinfo(14)=vname(4,idvbws)
3248 vinfo(16)=vname(1,idtime)
3249# if defined WRITE_WATER && defined MASKING
3250 vinfo(20)='mask_rho'
3251# endif
3252 vinfo(21)=vname(6,idvbws)
3253 vinfo(22)='coordinates'
3254 aval(5)=real(iinfo(1,idvbws,ng),r8)
3255 s(ng)%pioVar(idvbws)%dkind=pio_fout
3256 s(ng)%pioVar(idvbws)%gtype=r2dvar
3257!
3258 status=def_var(ng, model, s(ng)%pioFile, &
3259 & s(ng)%pioVar(idvbws)%vd, &
3260 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
3261 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3262 END IF
3263!
3264! Define maximum wind and current, bottom U-wave stress.
3265!
3266 IF (varout(idubcs,ng)) THEN
3267 vinfo( 1)=vname(1,idubcs)
3268 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
3269 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idubcs))
3270 ELSE
3271 vinfo( 2)=vname(2,idubcs)
3272 END IF
3273 vinfo( 3)=vname(3,idubcs)
3274 vinfo(14)=vname(4,idubcs)
3275 vinfo(16)=vname(1,idtime)
3276# if defined WRITE_WATER && defined MASKING
3277 vinfo(20)='mask_rho'
3278# endif
3279 vinfo(21)=vname(6,idubcs)
3280 vinfo(22)='coordinates'
3281 aval(5)=real(iinfo(1,idubcs,ng),r8)
3282 s(ng)%pioVar(idubcs)%dkind=pio_fout
3283 s(ng)%pioVar(idubcs)%gtype=r2dvar
3284!
3285 status=def_var(ng, model, s(ng)%pioFile, &
3286 & s(ng)%pioVar(idubcs)%vd, &
3287 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
3288 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3289 END IF
3290!
3291! Define maximum wind and current, bottom V-wave stress.
3292!
3293 IF (varout(idvbcs,ng)) THEN
3294 vinfo( 1)=vname(1,idvbcs)
3295 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
3296 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idvbcs))
3297 ELSE
3298 vinfo( 2)=vname(2,idvbcs)
3299 END IF
3300 vinfo( 3)=vname(3,idvbcs)
3301 vinfo(14)=vname(4,idvbcs)
3302 vinfo(16)=vname(1,idtime)
3303# if defined WRITE_WATER && defined MASKING
3304 vinfo(20)='mask_rho'
3305# endif
3306 vinfo(21)=vname(6,idvbcs)
3307 vinfo(22)='coordinates'
3308 aval(5)=real(iinfo(1,idvbcs,ng),r8)
3309 s(ng)%pioVar(idvbcs)%dkind=pio_fout
3310 s(ng)%pioVar(idvbcs)%gtype=r2dvar
3311!
3312 status=def_var(ng, model, s(ng)%pioFile, &
3313 & s(ng)%pioVar(idvbcs)%vd, &
3314 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
3315 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3316 END IF
3317!
3318! Define maximum wave and current bottom stress magnitude.
3319!
3320 IF (varout(iduvwc,ng)) THEN
3321 vinfo( 1)=vname(1,iduvwc)
3322 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
3323 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,iduvwc))
3324 ELSE
3325 vinfo( 2)=vname(2,iduvwc)
3326 END IF
3327 vinfo( 3)=vname(3,iduvwc)
3328 vinfo(14)=vname(4,iduvwc)
3329 vinfo(16)=vname(1,idtime)
3330# if defined WRITE_WATER && defined MASKING
3331 vinfo(20)='mask_rho'
3332# endif
3333 vinfo(21)=vname(6,iduvwc)
3334 vinfo(22)='coordinates'
3335 aval(5)=real(iinfo(1,iduvwc,ng),r8)
3336 s(ng)%pioVar(iduvwc)%dkind=pio_fout
3337 s(ng)%pioVar(iduvwc)%gtype=r2dvar
3338!
3339 status=def_var(ng, model, s(ng)%pioFile, &
3340 & s(ng)%pioVar(iduvwc)%vd, &
3341 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
3342 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3343 END IF
3344!
3345! Define wind-induced, bed wave orbital U-velocity.
3346!
3347 IF (varout(idubot,ng)) THEN
3348 vinfo( 1)=vname(1,idubot)
3349 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
3350 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idubot))
3351 ELSE
3352 vinfo( 2)=vname(2,idubot)
3353 END IF
3354 vinfo( 3)=vname(3,idubot)
3355 vinfo(14)=vname(4,idubot)
3356 vinfo(16)=vname(1,idtime)
3357# if defined WRITE_WATER && defined MASKING
3358 vinfo(20)='mask_rho'
3359# endif
3360 vinfo(21)=vname(6,idubot)
3361 vinfo(22)='coordinates'
3362 aval(5)=real(iinfo(1,idubot,ng),r8)
3363 s(ng)%pioVar(idubot)%dkind=pio_fout
3364 s(ng)%pioVar(idubot)%gtype=r2dvar
3365!
3366 status=def_var(ng, model, s(ng)%pioFile, &
3367 & s(ng)%pioVar(idubot)%vd, &
3368 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
3369 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3370 END IF
3371!
3372! Define wind-induced, bed wave orbital V-velocity.
3373!
3374 IF (varout(idvbot,ng)) THEN
3375 vinfo( 1)=vname(1,idvbot)
3376 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
3377 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idvbot))
3378 ELSE
3379 vinfo( 2)=vname(2,idvbot)
3380 END IF
3381 vinfo( 3)=vname(3,idvbot)
3382 vinfo(14)=vname(4,idvbot)
3383 vinfo(16)=vname(1,idtime)
3384# if defined WRITE_WATER && defined MASKING
3385 vinfo(20)='mask_rho'
3386# endif
3387 vinfo(21)=vname(6,idvbot)
3388 vinfo(22)='coordinates'
3389 aval(5)=real(iinfo(1,idvbot,ng),r8)
3390 s(ng)%pioVar(idvbot)%dkind=pio_fout
3391 s(ng)%pioVar(idvbot)%gtype=r2dvar
3392!
3393 status=def_var(ng, model, s(ng)%pioFile, &
3394 & s(ng)%pioVar(idvbot)%vd, &
3395 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
3396 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3397 END IF
3398!
3399! Define bottom U-momentum above bed.
3400!
3401 IF (varout(idubur,ng)) THEN
3402 vinfo( 1)=vname(1,idubur)
3403 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
3404 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idubur))
3405 ELSE
3406 vinfo( 2)=vname(2,idubur)
3407 END IF
3408 vinfo( 3)=vname(3,idubur)
3409 vinfo(14)=vname(4,idubur)
3410 vinfo(16)=vname(1,idtime)
3411# if defined WRITE_WATER && defined MASKING
3412 vinfo(20)='mask_rho'
3413# endif
3414 vinfo(21)=vname(6,idubur)
3415 vinfo(22)='coordinates'
3416 aval(5)=real(iinfo(1,idubur,ng),r8)
3417 s(ng)%pioVar(idubur)%dkind=pio_fout
3418 s(ng)%pioVar(idubur)%gtype=r2dvar
3419!
3420 status=def_var(ng, model, s(ng)%pioFile, &
3421 & s(ng)%pioVar(idubur)%vd, &
3422 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
3423 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3424 END IF
3425!
3426! Define bottom V-momentum above bed.
3427!
3428 IF (varout(idvbvr,ng)) THEN
3429 vinfo( 1)=vname(1,idvbvr)
3430 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
3431 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idvbvr))
3432 ELSE
3433 vinfo( 2)=vname(2,idvbvr)
3434 END IF
3435 vinfo( 3)=vname(3,idvbvr)
3436 vinfo(14)=vname(4,idvbvr)
3437 vinfo(16)=vname(1,idtime)
3438# if defined WRITE_WATER && defined MASKING
3439 vinfo(20)='mask_rho'
3440# endif
3441 vinfo(21)=vname(6,idvbvr)
3442 vinfo(22)='coordinates'
3443 aval(5)=real(iinfo(1,idvbvr,ng),r8)
3444 s(ng)%pioVar(idvbvr)%dkind=pio_fout
3445 s(ng)%pioVar(idvbvr)%gtype=r2dvar
3446!
3447 status=def_var(ng, model, s(ng)%pioFile, &
3448 & s(ng)%pioVar(idvbvr)%vd, &
3449 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
3450 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3451 END IF
3452# endif
3453
3454# if defined UV_KIRBY && defined AVERAGES
3455!
3456! Define U-velocity from Kirby and Chen.
3457!
3458 IF (varout(iduwav,ng)) THEN
3459 vinfo( 1)=vname(1,iduwav)
3460 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,iduwav))
3461 vinfo( 3)=vname(3,iduwav)
3462 vinfo(14)=vname(4,iduwav)
3463 vinfo(16)=vname(1,idtime)
3464# if defined WRITE_WATER && defined MASKING
3465 vinfo(20)='mask_rho'
3466# endif
3467 vinfo(21)=vname(6,iduwav)
3468 vinfo(22)='coordinates'
3469 aval(5)=real(iinfo(1,iduwav,ng),r8)
3470 avg(ng)%pioVar(iduwav)%dkind=pio_fout
3471 avg(ng)%pioVar(iduwav)%gtype=r2dvar
3472!
3473 status=def_var(ng, model, s(ng)%pioFile, &
3474 & s(ng)%pioVar(iduwav)%vd, &
3475 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
3476 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3477 END IF
3478!
3479! Define V-velocity from Kirby and Chen.
3480!
3481 IF (varout(idvwav,ng)) THEN
3482 vinfo( 1)=vname(1,idvwav)
3483 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idvwav))
3484 vinfo( 3)=vname(3,idvwav)
3485 vinfo(14)=vname(4,idvwav)
3486 vinfo(16)=vname(1,idtime)
3487# if defined WRITE_WATER && defined MASKING
3488 vinfo(20)='mask_rho'
3489# endif
3490 vinfo(21)=vname(6,idvwav)
3491 vinfo(22)='coordinates'
3492 aval(5)=real(iinfo(1,idvwav,ng),r8)
3493 avg(ng)%pioVar(idvwav)%dkind=pio_fout
3494 avg(ng)%pioVar(idvwav)%gtype=r2dvar
3495!
3496 status=def_var(ng, model, s(ng)%pioFile, &
3497 & s(ng)%pioVar(idvwav)%vd, &
3498 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
3499 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3500 END IF
3501# endif
3502
3503# ifdef WAVES_HEIGHT
3504!
3505! Define wind-induced significant wave height.
3506!
3507 IF (varout(idwamp,ng)) THEN
3508 vinfo( 1)=vname(1,idwamp)
3509 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
3510 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idwamp))
3511 ELSE
3512 vinfo( 2)=vname(2,idwamp)
3513 END IF
3514 vinfo( 3)=vname(3,idwamp)
3515 vinfo(14)=vname(4,idwamp)
3516 vinfo(16)=vname(1,idtime)
3517# if defined WRITE_WATER && defined MASKING
3518 vinfo(20)='mask_rho'
3519# endif
3520 vinfo(21)=vname(6,idwamp)
3521 vinfo(22)='coordinates'
3522 aval(5)=real(iinfo(1,idwamp,ng),r8)
3523 s(ng)%pioVar(idwamp)%dkind=pio_fout
3524 s(ng)%pioVar(idwamp)%gtype=r2dvar
3525!
3526 status=def_var(ng, model, s(ng)%pioFile, &
3527 & s(ng)%pioVar(idwamp)%vd, &
3528 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
3529 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3530 END IF
3531
3532# ifdef AVERAGES
3533!
3534! Define wind-induced significant wave height squared.
3535!
3536 IF (varout(idwam2,ng)) THEN
3537 vinfo( 1)=vname(1,idwam2)
3538 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idwam2))
3539 vinfo( 3)=vname(3,idwam2)
3540 vinfo(14)=vname(4,idwam2)
3541 vinfo(16)=vname(1,idtime)
3542# if defined WRITE_WATER && defined MASKING
3543 vinfo(20)='mask_rho'
3544# endif
3545 vinfo(21)=vname(6,idwam2)
3546 vinfo(22)='coordinates'
3547 aval(5)=real(iinfo(1,idwam2,ng),r8)
3548 avg(ng)%pioVar(idwam2)%dkind=pio_fout
3549 avg(ng)%pioVar(idwam2)%gtype=r2dvar
3550!
3551 status=def_var(ng, model, s(ng)%pioFile, &
3552 & s(ng)%pioVar(idwam2)%vd, &
3553 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
3554 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3555 END IF
3556# endif
3557# endif
3558
3559# ifdef WAVES_LENGTH
3560!
3561! Define wind-induced mean wavelength.
3562!
3563 IF (varout(idwlen,ng)) THEN
3564 vinfo( 1)=vname(1,idwlen)
3565 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
3566 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idwlen))
3567 ELSE
3568 vinfo( 2)=vname(2,idwlen)
3569 END IF
3570 vinfo( 3)=vname(3,idwlen)
3571 vinfo(14)=vname(4,idwlen)
3572 vinfo(16)=vname(1,idtime)
3573# if defined WRITE_WATER && defined MASKING
3574 vinfo(20)='mask_rho'
3575# endif
3576 vinfo(21)=vname(6,idwlen)
3577 vinfo(22)='coordinates'
3578 aval(5)=real(iinfo(1,idwlen,ng),r8)
3579 s(ng)%pioVar(idwlen)%dkind=pio_fout
3580 s(ng)%pioVar(idwlen)%gtype=r2dvar
3581!
3582 status=def_var(ng, model, s(ng)%pioFile, &
3583 & s(ng)%pioVar(idwlen)%vd, &
3584 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
3585 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3586 END IF
3587# endif
3588
3589# ifdef WAVES_LENGTHP
3590!
3591! Define wind-induced peak wave wavelength.
3592!
3593 IF (varout(idwlep,ng)) THEN
3594 vinfo( 1)=vname(1,idwlep)
3595 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
3596 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idwlep))
3597 ELSE
3598 vinfo( 2)=vname(2,idwlep)
3599 END IF
3600 vinfo( 3)=vname(3,idwlep)
3601 vinfo(14)=vname(4,idwlep)
3602 vinfo(16)=vname(1,idtime)
3603# if defined WRITE_WATER && defined MASKING
3604 vinfo(20)='mask_rho'
3605# endif
3606 vinfo(21)=vname(6,idwlep)
3607 vinfo(22)='coordinates'
3608 aval(5)=real(iinfo(1,idwlep,ng),r8)
3609 s(ng)%pioVar(idwlep)%dkind=pio_fout
3610 s(ng)%pioVar(idwlep)%gtype=r2dvar
3611!
3612 status=def_var(ng, model, s(ng)%pioFile, &
3613 & s(ng)%pioVar(idwlep)%vd, &
3614 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
3615 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3616 END IF
3617# endif
3618
3619# ifdef WAVES_DIR
3620!
3621! Define wind-induced mean wave direction.
3622!
3623 IF (varout(idwdir,ng)) THEN
3624 vinfo( 1)=vname(1,idwdir)
3625 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
3626 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idwdir))
3627 ELSE
3628 vinfo( 2)=vname(2,idwdir)
3629 END IF
3630 vinfo( 3)=vname(3,idwdir)
3631 vinfo(14)=vname(4,idwdir)
3632 vinfo(16)=vname(1,idtime)
3633# if defined WRITE_WATER && defined MASKING
3634 vinfo(20)='mask_rho'
3635# endif
3636 vinfo(21)=vname(6,idwdir)
3637 vinfo(22)='coordinates'
3638 aval(5)=real(iinfo(1,idwdir,ng),r8)
3639 s(ng)%pioVar(idwdir)%dkind=pio_fout
3640 s(ng)%pioVar(idwdir)%gtype=r2dvar
3641!
3642 status=def_var(ng, model, s(ng)%pioFile, &
3643 & s(ng)%pioVar(idwdir)%vd, &
3644 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
3645 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3646 END IF
3647# endif
3648
3649# ifdef WAVES_DIRP
3650!
3651! Define wind-induced peak wave direction.
3652!
3653 IF (varout(idwdip,ng)) THEN
3654 vinfo( 1)=vname(1,idwdip)
3655 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
3656 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idwdip))
3657 ELSE
3658 vinfo( 2)=vname(2,idwdip)
3659 END IF
3660 vinfo( 3)=vname(3,idwdip)
3661 vinfo(14)=vname(4,idwdip)
3662 vinfo(16)=vname(1,idtime)
3663# if defined WRITE_WATER && defined MASKING
3664 vinfo(20)='mask_rho'
3665# endif
3666 vinfo(21)=vname(6,idwdip)
3667 vinfo(22)='coordinates'
3668 aval(5)=real(iinfo(1,idwdip,ng),r8)
3669 s(ng)%pioVar(idwdip)%dkind=pio_fout
3670 s(ng)%pioVar(idwdip)%gtype=r2dvar
3671!
3672 status=def_var(ng, model, s(ng)%pioFile, &
3673 & s(ng)%pioVar(idwdip)%vd, &
3674 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
3675 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3676 END IF
3677# endif
3678
3679# ifdef WAVES_TOP_PERIOD
3680!
3681! Define wind-induced surface wave period.
3682!
3683 IF (varout(idwptp,ng)) THEN
3684 vinfo( 1)=vname(1,idwptp)
3685 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
3686 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idwptp))
3687 ELSE
3688 vinfo( 2)=vname(2,idwptp)
3689 END IF
3690 vinfo( 3)=vname(3,idwptp)
3691 vinfo(14)=vname(4,idwptp)
3692 vinfo(16)=vname(1,idtime)
3693# if defined WRITE_WATER && defined MASKING
3694 vinfo(20)='mask_rho'
3695# endif
3696 vinfo(21)=vname(6,idwptp)
3697 vinfo(22)='coordinates'
3698 aval(5)=real(iinfo(1,idwptp,ng),r8)
3699 s(ng)%pioVar(idwptp)%dkind=pio_fout
3700 s(ng)%pioVar(idwptp)%gtype=r2dvar
3701!
3702 status=def_var(ng, model, s(ng)%pioFile, &
3703 & s(ng)%pioVar(idwptp)%vd, &
3704 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
3705 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3706 END IF
3707# endif
3708
3709# ifdef WAVES_BOT_PERIOD
3710!
3711! Define wind-induced bottom wave period.
3712!
3713 IF (varout(idwpbt,ng)) THEN
3714 vinfo( 1)=vname(1,idwpbt)
3715 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
3716 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idwpbt))
3717 ELSE
3718 vinfo( 2)=vname(2,idwpbt)
3719 END IF
3720 vinfo( 3)=vname(3,idwpbt)
3721 vinfo(14)=vname(4,idwpbt)
3722 vinfo(16)=vname(1,idtime)
3723# if defined WRITE_WATER && defined MASKING
3724 vinfo(20)='mask_rho'
3725# endif
3726 vinfo(21)=vname(6,idwpbt)
3727 vinfo(22)='coordinates'
3728 aval(5)=real(iinfo(1,idwpbt,ng),r8)
3729 s(ng)%pioVar(idwpbt)%dkind=pio_fout
3730 s(ng)%pioVar(idwpbt)%gtype=r2dvar
3731!
3732 status=def_var(ng, model, s(ng)%pioFile, &
3733 & s(ng)%pioVar(idwpbt)%vd, &
3734 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
3735 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3736 END IF
3737
3738# endif
3739
3740# ifdef WAVES_DSPR
3741!
3742! Define waves directional spreading.
3743!
3744 IF (varout(idwvds,ng)) THEN
3745 vinfo( 1)=vname(1,idwvds)
3746 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
3747 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idwvds))
3748 ELSE
3749 vinfo( 2)=vname(2,idwvds)
3750 END IF
3751 vinfo( 3)=vname(3,idwvds)
3752 vinfo(14)=vname(4,idwvds)
3753 vinfo(16)=vname(1,idtime)
3754# if defined WRITE_WATER && defined MASKING
3755 vinfo(20)='mask_rho'
3756# endif
3757 vinfo(21)=vname(6,idwvds)
3758 vinfo(22)='coordinates'
3759 aval(5)=real(iinfo(1,idwvds,ng),r8)
3760 s(ng)%pioVar(idwvds)%dkind=pio_fout
3761 s(ng)%pioVar(idwvds)%gtype=r2dvar
3762!
3763 status=def_var(ng, model, s(ng)%pioFile, &
3764 & s(ng)%pioVar(idwvds)%vd, &
3765 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
3766 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3767 END IF
3768!
3769! Define waves spectrum peakeness.
3770!
3771 IF (varout(idwvqp,ng)) THEN
3772 vinfo( 1)=vname(1,idwvqp)
3773 IF (s(ng)%ncid.eq.avg(ng)%ncid) THEN
3774 WRITE (vinfo( 2),'(a,1x,a)') prefix, trim(vname(2,idwvqp))
3775 ELSE
3776 vinfo( 2)=vname(2,idwvqp)
3777 END IF
3778 vinfo( 3)=vname(3,idwvqp)
3779 vinfo(14)=vname(4,idwvqp)
3780 vinfo(16)=vname(1,idtime)
3781# if defined WRITE_WATER && defined MASKING
3782 vinfo(20)='mask_rho'
3783# endif
3784 vinfo(21)=vname(6,idwvqp)
3785 vinfo(22)='coordinates'
3786 aval(5)=real(iinfo(1,idwvqp,ng),r8)
3787 s(ng)%pioVar(idwvqp)%dkind=pio_fout
3788 s(ng)%pioVar(idwvqp)%gtype=r2dvar
3789!
3790 status=def_var(ng, model, s(ng)%pioFile, &
3791 & s(ng)%pioVar(idwvqp)%vd, &
3792 & pio_fout, nvd3, t2dgrd, aval, vinfo, ncname)
3793 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3794 END IF
3795# endif
3796
3797 END IF define
3798!
3799!-----------------------------------------------------------------------
3800! Otherwise, check existing output file and prepare for appending
3801! data.
3802!-----------------------------------------------------------------------
3803!
3804 query : IF (.not.ldef) THEN
3805!
3806! Initialize locallogical switches.
3807!
3808 DO i=1,nv
3809 got_var(i)=.false.
3810 END DO
3811!
3812! Scan variable list from input NetCDF and activate switches for
3813! Waves Effect on Currents variables. Get variable IDs.
3814!
3815 DO i=1,n_var
3816 IF (trim(var_name(i)).eq.trim(vname(1,idtime))) THEN
3817 got_var(idtime)=.true.
3818 s(ng)%pioVar(idtime)%vd=var_desc(i)
3819 s(ng)%pioVar(idtime)%dkind=pio_tout
3820 s(ng)%pioVar(idtime)%gtype=0
3821# if defined BBL_MODEL || defined SED_BEDLOAD_VANDERA || \
3822 defined wav_coupling
3823 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idworb))) THEN
3824 got_var(idworb)=.true.
3825 s(ng)%pioVar(idworb)%vd=var_desc(i)
3826 s(ng)%pioVar(idworb)%dkind=pio_fout
3827 s(ng)%pioVar(idworb)%gtype=r2dvar
3828# endif
3829# ifdef BBL_MODEL
3830 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubrs))) THEN
3831 got_var(idubrs)=.true.
3832 s(ng)%pioVar(idubrs)%vd=var_desc(i)
3833 s(ng)%pioVar(idubrs)%dkind=pio_fout
3834 s(ng)%pioVar(idubrs)%gtype=r2dvar
3835 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbrs))) THEN
3836 got_var(idvbrs)=.true.
3837 s(ng)%pioVar(idvbrs)%vd=var_desc(i)
3838 s(ng)%pioVar(idvbrs)%dkind=pio_fout
3839 s(ng)%pioVar(idvbrs)%gtype=r2dvar
3840 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubws))) THEN
3841 got_var(idubws)=.true.
3842 s(ng)%pioVar(idubws)%vd=var_desc(i)
3843 s(ng)%pioVar(idubws)%dkind=pio_fout
3844 s(ng)%pioVar(idubws)%gtype=r2dvar
3845 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbws))) THEN
3846 got_var(idvbws)=.true.
3847 s(ng)%pioVar(idvbws)%vd=var_desc(i)
3848 s(ng)%pioVar(idvbws)%dkind=pio_fout
3849 s(ng)%pioVar(idvbws)%gtype=r2dvar
3850 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubcs))) THEN
3851 got_var(idubcs)=.true.
3852 s(ng)%pioVar(idubcs)%vd=var_desc(i)
3853 s(ng)%pioVar(idubcs)%dkind=pio_fout
3854 s(ng)%pioVar(idubcs)%gtype=r2dvar
3855 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbcs))) THEN
3856 got_var(idvbcs)=.true.
3857 s(ng)%pioVar(idvbcs)%vd=var_desc(i)
3858 s(ng)%pioVar(idvbcs)%dkind=pio_fout
3859 s(ng)%pioVar(idvbcs)%gtype=r2dvar
3860 ELSE IF (trim(var_name(i)).eq.trim(vname(1,iduvwc))) THEN
3861 got_var(iduvwc)=.true.
3862 s(ng)%pioVar(iduvwc)%vd=var_desc(i)
3863 s(ng)%pioVar(iduvwc)%dkind=pio_fout
3864 s(ng)%pioVar(iduvwc)%gtype=r2dvar
3865 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubot))) THEN
3866 got_var(idubot)=.true.
3867 s(ng)%pioVar(idubot)%vd=var_desc(i)
3868 s(ng)%pioVar(idubot)%dkind=pio_fout
3869 s(ng)%pioVar(idubot)%gtype=r2dvar
3870 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbot))) THEN
3871 got_var(idvbot)=.true.
3872 s(ng)%pioVar(idvbot)%vd=var_desc(i)
3873 s(ng)%pioVar(idvbot)%dkind=pio_fout
3874 s(ng)%pioVar(idvbot)%gtype=r2dvar
3875 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubur))) THEN
3876 got_var(idubur)=.true.
3877 s(ng)%pioVar(idubur)%vd=var_desc(i)
3878 s(ng)%pioVar(idubur)%dkind=pio_fout
3879 s(ng)%pioVar(idubur)%gtype=r2dvar
3880 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbvr))) THEN
3881 got_var(idvbvr)=.true.
3882 s(ng)%pioVar(idvbvr)%vd=var_desc(i)
3883 s(ng)%pioVar(idvbvr)%dkind=pio_fout
3884 s(ng)%pioVar(idvbvr)%gtype=r2dvar
3885# endif
3886# if defined UV_KIRBY && defined AVERAGES
3887 ELSE IF (trim(var_name(i)).eq.trim(vname(1,iduwav))) THEN
3888 got_var(iduwav)=.true.
3889 s(ng)%pioVar(iduwav)%vd=var_desc(i)
3890 s(ng)%pioVar(iduwav)%dkind=pio_fout
3891 s(ng)%pioVar(iduwav)%gtype=r2dvar
3892 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvwav))) THEN
3893 got_var(idvwav)=.true.
3894 s(ng)%pioVar(idvwav)%vd=var_desc(i)
3895 s(ng)%pioVar(idvwav)%dkind=pio_fout
3896 s(ng)%pioVar(idvwav)%gtype=r2dvar
3897# endif
3898# ifdef WAVES_HEIGHT
3899 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwamp))) THEN
3900 got_var(idwamp)=.true.
3901 s(ng)%pioVar(idwamp)%vd=var_desc(i)
3902 s(ng)%pioVar(idwamp)%dkind=pio_fout
3903 s(ng)%pioVar(idwamp)%gtype=r2dvar
3904# ifdef AVERAGES
3905 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwam2))) THEN
3906 got_var(idwam2)=.true.
3907 avg(ng)%pioVar(idwam2)%vd=var_desc(i)
3908 avg(ng)%pioVar(idwam2)%dkind=pio_fout
3909 avg(ng)%pioVar(idwam2)%gtype=r2dvar
3910# endif
3911# endif
3912# ifdef WAVES_LENGTH
3913 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwlen))) THEN
3914 got_var(idwlen)=.true.
3915 s(ng)%pioVar(idwlen)%vd=var_desc(i)
3916 s(ng)%pioVar(idwlen)%dkind=pio_fout
3917 s(ng)%pioVar(idwlen)%gtype=r2dvar
3918# endif
3919# ifdef WAVES_LENGTHP
3920 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwlep))) THEN
3921 got_var(idwlep)=.true.
3922 s(ng)%pioVar(idwlep)%vd=var_desc(i)
3923 s(ng)%pioVar(idwlep)%dkind=pio_fout
3924 s(ng)%pioVar(idwlep)%gtype=r2dvar
3925# endif
3926# ifdef WAVES_DIR
3927 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwdir))) THEN
3928 got_var(idwdir)=.true.
3929 s(ng)%pioVar(idwdir)%vd=var_desc(i)
3930 s(ng)%pioVar(idwdir)%dkind=pio_fout
3931 s(ng)%pioVar(idwdir)%gtype=r2dvar
3932# endif
3933# ifdef WAVES_DIRP
3934 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwdip))) THEN
3935 got_var(idwdip)=.true.
3936 s(ng)%pioVar(idwdip)%vd=var_desc(i)
3937 s(ng)%pioVar(idwdip)%dkind=pio_fout
3938 s(ng)%pioVar(idwdip)%gtype=r2dvar
3939# endif
3940# ifdef WAVES_TOP_PERIOD
3941 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwptp))) THEN
3942 got_var(idwptp)=.true.
3943 s(ng)%pioVar(idwptp)%vd=var_desc(i)
3944 s(ng)%pioVar(idwptp)%dkind=pio_fout
3945 s(ng)%pioVar(idwptp)%gtype=r2dvar
3946# endif
3947# ifdef WAVES_BOT_PERIOD
3948 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwpbt))) THEN
3949 got_var(idwpbt)=.true.
3950 s(ng)%pioVar(idwpbt)%vd=var_desc(i)
3951 s(ng)%pioVar(idwpbt)%dkind=pio_fout
3952 s(ng)%pioVar(idwpbt)%gtype=r2dvar
3953# endif
3954# ifdef WAVES_DSPR
3955 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwvds))) THEN
3956 got_var(idwvds)=.true.
3957 s(ng)%pioVar(idwvds)%vd=var_desc(i)
3958 s(ng)%pioVar(idwvds)%dkind=pio_fout
3959 s(ng)%pioVar(idwvds)%gtype=r2dvar
3960 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwvqp))) THEN
3961 got_var(idwvqp)=.true.
3962 s(ng)%pioVar(idwvqp)%vd=var_desc(i)
3963 s(ng)%pioVar(idwvqp)%dkind=pio_fout
3964 s(ng)%pioVar(idwvqp)%gtype=r2dvar
3965# endif
3966 END DO
3967!
3968! Check if output variables are available in input NetCDF file.
3969!
3970 IF (.not.got_var(idtime)) THEN
3971 IF (master) WRITE (stdout,10) trim(vname(1,idtime)), &
3972 & trim(ncname)
3973 exit_flag=3
3974 RETURN
3975 END IF
3976# if defined BBL_MODEL || defined SED_BEDLOAD_VANDERA || \
3977 defined wav_coupling
3978 IF (.not.got_var(idworb).and.varout(idworb,ng)) THEN
3979 IF (master) WRITE (stdout,10) trim(vname(1,idworb)), &
3980 & trim(ncname)
3981 exit_flag=3
3982 RETURN
3983 END IF
3984# endif
3985# ifdef BBL_MODEL
3986 IF (.not.got_var(idubrs).and.varout(idubrs,ng)) THEN
3987 IF (master) WRITE (stdout,10) trim(vname(1,idubrs)), &
3988 & trim(ncname)
3989 exit_flag=3
3990 RETURN
3991 END IF
3992 IF (.not.got_var(idvbrs).and.varout(idvbrs,ng)) THEN
3993 IF (master) WRITE (stdout,10) trim(vname(1,idvbrs)), &
3994 & trim(ncname)
3995 exit_flag=3
3996 RETURN
3997 END IF
3998 IF (.not.got_var(idubws).and.varout(idubws,ng)) THEN
3999 IF (master) WRITE (stdout,10) trim(vname(1,idubws)), &
4000 & trim(ncname)
4001 exit_flag=3
4002 RETURN
4003 END IF
4004 IF (.not.got_var(idvbws).and.varout(idvbws,ng)) THEN
4005 IF (master) WRITE (stdout,10) trim(vname(1,idvbws)), &
4006 & trim(ncname)
4007 exit_flag=3
4008 RETURN
4009 END IF
4010 IF (.not.got_var(idubcs).and.varout(idubcs,ng)) THEN
4011 IF (master) WRITE (stdout,10) trim(vname(1,idubcs)), &
4012 & trim(ncname)
4013 exit_flag=3
4014 RETURN
4015 END IF
4016 IF (.not.got_var(idvbcs).and.varout(idvbcs,ng)) THEN
4017 IF (master) WRITE (stdout,10) trim(vname(1,idvbcs)), &
4018 & trim(ncname)
4019 exit_flag=3
4020 RETURN
4021 END IF
4022 IF (.not.got_var(iduvwc).and.varout(iduvwc,ng)) THEN
4023 IF (master) WRITE (stdout,10) trim(vname(1,iduvwc)), &
4024 & trim(ncname)
4025 exit_flag=3
4026 RETURN
4027 END IF
4028 IF (.not.got_var(idubot).and.varout(idubot,ng)) THEN
4029 IF (master) WRITE (stdout,10) trim(vname(1,idubot)), &
4030 & trim(ncname)
4031 exit_flag=3
4032 RETURN
4033 END IF
4034 IF (.not.got_var(idvbot).and.varout(idvbot,ng)) THEN
4035 IF (master) WRITE (stdout,10) trim(vname(1,idvbot)), &
4036 & trim(ncname)
4037 exit_flag=3
4038 RETURN
4039 END IF
4040 IF (.not.got_var(idubur).and.varout(idubur,ng)) THEN
4041 IF (master) WRITE (stdout,10) trim(vname(1,idubur)), &
4042 & trim(ncname)
4043 exit_flag=3
4044 RETURN
4045 END IF
4046 IF (.not.got_var(idvbvr).and.varout(idvbvr,ng)) THEN
4047 IF (master) WRITE (stdout,10) trim(vname(1,idvbvr)), &
4048 & trim(ncname)
4049 exit_flag=3
4050 RETURN
4051 END IF
4052# endif
4053# if defined UV_KIRBY && defined AVERAGES
4054 IF (.not.got_var(iduwav).and.varout(iduwav,ng)) THEN
4055 IF (master) WRITE (stdout,10) trim(vname(1,iduwav)), &
4056 & trim(ncname)
4057 exit_flag=3
4058 RETURN
4059 END IF
4060 IF (.not.got_var(idvwav).and.varout(idvwav,ng)) THEN
4061 IF (master) WRITE (stdout,10) trim(vname(1,idvwav)), &
4062 & trim(ncname)
4063 exit_flag=3
4064 RETURN
4065 END IF
4066# endif
4067# ifdef WAVES_HEIGHT
4068 IF (.not.got_var(idwamp).and.varout(idwamp,ng)) THEN
4069 IF (master) WRITE (stdout,10) trim(vname(1,idwamp)), &
4070 & trim(ncname)
4071 exit_flag=3
4072 RETURN
4073 END IF
4074# ifdef AVERAGES
4075 IF (.not.got_var(idwam2).and.aout(idwam2,ng)) THEN
4076 IF (master) WRITE (stdout,10) trim(vname(1,idwam2)), &
4077 & trim(ncname)
4078 exit_flag=3
4079 RETURN
4080 END IF
4081# endif
4082# endif
4083# ifdef WAVES_LENGTH
4084 IF (.not.got_var(idwlen).and.varout(idwlen,ng)) THEN
4085 IF (master) WRITE (stdout,10) trim(vname(1,idwlen)), &
4086 & trim(ncname)
4087 exit_flag=3
4088 RETURN
4089 END IF
4090# endif
4091# ifdef WAVES_LENGTHP
4092 IF (.not.got_var(idwlep).and.varout(idwlep,ng)) THEN
4093 IF (master) WRITE (stdout,10) trim(vname(1,idwlep)), &
4094 & trim(ncname)
4095 exit_flag=3
4096 RETURN
4097 END IF
4098# endif
4099# ifdef WAVES_DIR
4100 IF (.not.got_var(idwdir).and.varout(idwdir,ng)) THEN
4101 IF (master) WRITE (stdout,10) trim(vname(1,idwdir)), &
4102 & trim(ncname)
4103 exit_flag=3
4104 RETURN
4105 END IF
4106# endif
4107# ifdef WAVES_DIRP
4108 IF (.not.got_var(idwdip).and.varout(idwdip,ng)) THEN
4109 IF (master) WRITE (stdout,10) trim(vname(1,idwdip)), &
4110 & trim(ncname)
4111 exit_flag=3
4112 RETURN
4113 END IF
4114# endif
4115# ifdef WAVES_TOP_PERIOD
4116 IF (.not.got_var(idwptp).and.varout(idwptp,ng)) THEN
4117 IF (master) WRITE (stdout,10) trim(vname(1,idwptp)), &
4118 & trim(ncname)
4119 exit_flag=3
4120 RETURN
4121 END IF
4122# endif
4123# ifdef WAVES_BOT_PERIOD
4124 IF (.not.got_var(idwpbt).and.varout(idwpbt,ng)) THEN
4125 IF (master) WRITE (stdout,10) trim(vname(1,idwpbt)), &
4126 & trim(ncname)
4127 exit_flag=3
4128 RETURN
4129 END IF
4130# endif
4131# ifdef WAVES_DSPR
4132 IF (.not.got_var(idwvds).and.varout(idwvds,ng)) THEN
4133 IF (master) WRITE (stdout,10) trim(vname(1,idwvds)), &
4134 & trim(ncname)
4135 exit_flag=3
4136 RETURN
4137 END IF
4138 IF (.not.got_var(idwvqp).and.varout(idwvqp,ng)) THEN
4139 IF (master) WRITE (stdout,10) trim(vname(1,idwvqp)), &
4140 & trim(ncname)
4141 exit_flag=3
4142 RETURN
4143 END IF
4144# endif
4145 END IF query
4146!
4147 10 FORMAT (/,' BBL_DEF_PIO - unable to find variable: ',a,2x, &
4148 & ' in output NetCDF file: ',a)
4149!
4150 RETURN
4151 END SUBROUTINE bbl_def_pio
4152!
4153!***********************************************************************
4154 SUBROUTINE bbl_wrt_pio (ng, model, tile, &
4155 & LBi, UBi, LBj, UBj, &
4156 & VarOut, S)
4157!***********************************************************************
4158!
4159 USE mod_pio_netcdf
4160!
4161! Imported variable declarations.
4162!
4163 logical, intent(in) :: varout(nv,ngrids)
4164!
4165 integer, intent(in) :: ng, model, tile
4166 integer, intent(in) :: lbi, ubi, lbj, ubj
4167!
4168 TYPE(t_io), intent(inout) :: s(ngrids)
4169!
4170! Local variable declarations.
4171!
4172 logical :: linstataneous
4173!
4174 integer :: status
4175!
4176 real(dp) :: scale
4177!
4178 real(r8), allocatable :: wrk2d(:,:)
4179!
4180 character (len=*), parameter :: myfile = &
4181 & __FILE__//", bbl_wrt_pio"
4182!
4183 TYPE (io_desc_t), pointer :: iodesc
4184!
4185 sourcefile=myfile
4186!
4187!-----------------------------------------------------------------------
4188! Write out sediment output variables into specified NetCDF file.
4189!-----------------------------------------------------------------------
4190!
4191 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4192!
4193! Set instantaneous fields.
4194!
4195 IF ((s(ng)%ncid.eq.s(ng)%ncid).or. &
4196 & (s(ng)%ncid.eq.qck(ng)%ncid)) THEN
4197 linstataneous=.true.
4198 ELSE
4199 linstataneous=.false. ! time-averged fiels
4200 END IF
4201
4202# if defined BBL_MODEL || defined SED_BEDLOAD_VANDERA || \
4203 defined wav_coupling
4204!
4205! Write out wind-induced wave bottom orbital velocity.
4206!
4207 IF (varout(idworb,ng)) THEN
4208 scale=1.0_dp
4209 IF (s(ng)%pioVar(idworb)%dkind.eq.pio_double) THEN
4210 iodesc => iodesc_dp_r2dvar(ng)
4211 ELSE
4212 iodesc => iodesc_sp_r2dvar(ng)
4213 END IF
4214 IF (linstataneous) THEN
4215 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idworb, &
4216 & s(ng)%pioVar(idworb), &
4217 & s(ng)%Rindex, &
4218 & iodesc, &
4219 & lbi, ubi, lbj, ubj, scale, &
4220# ifdef MASKING
4221 & grid(ng) % rmask, &
4222# endif
4223 & forces(ng) % Uwave_rms)
4224# ifdef AVERAGES
4225 ELSE
4226 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idworb, &
4227 & s(ng)%pioVar(idworb), &
4228 & s(ng)%Rindex, &
4229 & iodesc, &
4230 & lbi, ubi, lbj, ubj, scale, &
4231# ifdef MASKING
4232 & grid(ng) % rmask, &
4233# endif
4234 & average(ng) % avgWorb)
4235# endif
4236 END IF
4237 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
4238 IF (master) THEN
4239 WRITE (stdout,10) trim(vname(1,idworb)), s(ng)%Rindex
4240 END IF
4241 exit_flag=3
4242 ioerror=status
4243 RETURN
4244 END IF
4245 END IF
4246# endif
4247
4248# ifdef BBL_MODEL
4249!
4250! Write out current-induced, bottom U-stress at RHO-points.
4251!
4252 IF (varout(idubrs,ng)) THEN
4253 scale=-rho0
4254 IF (s(ng)%pioVar(idubrs)%dkind.eq.pio_double) THEN
4255 iodesc => iodesc_dp_r2dvar(ng)
4256 ELSE
4257 iodesc => iodesc_sp_r2dvar(ng)
4258 END IF
4259 IF (linstataneous) THEN
4260 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idubrs, &
4261 & s(ng)%pioVar(idubrs), &
4262 & s(ng)%Rindex, &
4263 & iodesc, &
4264 & lbi, ubi, lbj, ubj, scale, &
4265# ifdef MASKING
4266 & grid(ng) % rmask, &
4267# endif
4268 & bbl(ng) % bustrc)
4269# ifdef AVERAGES
4270 ELSE
4271 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idubrs, &
4272 & s(ng)%pioVar(idubrs), &
4273 & s(ng)%Rindex, &
4274 & iodesc, &
4275 & lbi, ubi, lbj, ubj, scale, &
4276# ifdef MASKING
4277 & grid(ng) % rmask, &
4278# endif
4279 & average(ng) % avgUbrs)
4280# endif
4281 END IF
4282 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
4283 IF (master) THEN
4284 WRITE (stdout,10) trim(vname(1,idubrs)), s(ng)%Rindex
4285 END IF
4286 exit_flag=3
4287 ioerror=status
4288 RETURN
4289 END IF
4290 END IF
4291!
4292! Write out current-induced, bottom V-stress at RHO-points.
4293!
4294 IF (varout(idvbrs,ng)) THEN
4295 scale=-rho0
4296 IF (s(ng)%pioVar(idvbrs)%dkind.eq.pio_double) THEN
4297 iodesc => iodesc_dp_r2dvar(ng)
4298 ELSE
4299 iodesc => iodesc_sp_r2dvar(ng)
4300 END IF
4301 IF (linstataneous) THEN
4302 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idvbrs, &
4303 & s(ng)%pioVar(idvbrs), &
4304 & s(ng)%Rindex, &
4305 & iodesc, &
4306 & lbi, ubi, lbj, ubj, scale, &
4307# ifdef MASKING
4308 & grid(ng) % rmask, &
4309# endif
4310 & bbl(ng) % bvstrc)
4311# ifdef AVERAGES
4312 ELSE
4313 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idvbrs, &
4314 & s(ng)%pioVar(idvbrs), &
4315 & s(ng)%Rindex, &
4316 & iodesc, &
4317 & lbi, ubi, lbj, ubj, scale, &
4318# ifdef MASKING
4319 & grid(ng) % rmask, &
4320# endif
4321 & average(ng) % avgVbrs)
4322# endif
4323 END IF
4324 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
4325 IF (master) THEN
4326 WRITE (stdout,10) trim(vname(1,idvbrs)), s(ng)%Rindex
4327 END IF
4328 exit_flag=3
4329 ioerror=status
4330 RETURN
4331 END IF
4332 END IF
4333!
4334! Write out wind-induced, bottom U-stress at RHO-points.
4335!
4336 IF (varout(idubws,ng)) THEN
4337 scale=rho0
4338 IF (s(ng)%pioVar(idubws)%dkind.eq.pio_double) THEN
4339 iodesc => iodesc_dp_r2dvar(ng)
4340 ELSE
4341 iodesc => iodesc_sp_r2dvar(ng)
4342 END IF
4343 IF (linstataneous) THEN
4344 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idubws, &
4345 & s(ng)%pioVar(idubws), &
4346 & s(ng)%Rindex, &
4347 & iodesc, &
4348 & lbi, ubi, lbj, ubj, scale, &
4349# ifdef MASKING
4350 & grid(ng) % rmask, &
4351# endif
4352 & bbl(ng) % bustrw)
4353# ifdef AVERAGES
4354 ELSE
4355 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idubws, &
4356 & s(ng)%pioVar(idubws), &
4357 & s(ng)%Rindex, &
4358 & iodesc, &
4359 & lbi, ubi, lbj, ubj, scale, &
4360# ifdef MASKING
4361 & grid(ng) % rmask, &
4362# endif
4363 & average(ng) % avgUbws)
4364# endif
4365 END IF
4366 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
4367 IF (master) THEN
4368 WRITE (stdout,10) trim(vname(1,idubws)), s(ng)%Rindex
4369 END IF
4370 exit_flag=3
4371 ioerror=status
4372 RETURN
4373 END IF
4374 END IF
4375!
4376! Write out wind-induced, bottom V-stress at RHO-points.
4377!
4378 IF (varout(idvbws,ng)) THEN
4379 scale=rho0
4380 IF (s(ng)%pioVar(idvbws)%dkind.eq.pio_double) THEN
4381 iodesc => iodesc_dp_r2dvar(ng)
4382 ELSE
4383 iodesc => iodesc_sp_r2dvar(ng)
4384 END IF
4385 IF (linstataneous) THEN
4386 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idvbws, &
4387 & s(ng)%pioVar(idvbws), &
4388 & s(ng)%Rindex, &
4389 & iodesc, &
4390 & lbi, ubi, lbj, ubj, scale, &
4391# ifdef MASKING
4392 & grid(ng) % rmask, &
4393# endif
4394 & bbl(ng) % bvstrw)
4395# ifdef AVERAGES
4396 ELSE
4397 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idvbws, &
4398 & s(ng)%pioVar(idvbws), &
4399 & s(ng)%Rindex, &
4400 & iodesc, &
4401 & lbi, ubi, lbj, ubj, scale, &
4402# ifdef MASKING
4403 & grid(ng) % rmask, &
4404# endif
4405 & average(ng) % avgVbws)
4406# endif
4407 END IF
4408 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
4409 IF (master) THEN
4410 WRITE (stdout,10) trim(vname(1,idvbws)), s(ng)%Rindex
4411 END IF
4412 exit_flag=3
4413 ioerror=status
4414 RETURN
4415 END IF
4416 END IF
4417!
4418! Write out maximum wind and current, bottom U-stress at RHO-points.
4419!
4420 IF (varout(idubcs,ng)) THEN
4421 scale=rho0
4422 IF (s(ng)%pioVar(idubcs)%dkind.eq.pio_double) THEN
4423 iodesc => iodesc_dp_r2dvar(ng)
4424 ELSE
4425 iodesc => iodesc_sp_r2dvar(ng)
4426 END IF
4427 IF (linstataneous) THEN
4428 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idubcs, &
4429 & s(ng)%pioVar(idubcs), &
4430 & s(ng)%Rindex, &
4431 & iodesc, &
4432 & lbi, ubi, lbj, ubj, scale, &
4433# ifdef MASKING
4434 & grid(ng) % rmask, &
4435# endif
4436 & bbl(ng) % bustrcwmax)
4437# ifdef AVERAGES
4438 ELSE
4439 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idubcs, &
4440 & s(ng)%pioVar(idubcs), &
4441 & s(ng)%Rindex, &
4442 & iodesc, &
4443 & lbi, ubi, lbj, ubj, scale, &
4444# ifdef MASKING
4445 & grid(ng) % rmask, &
4446# endif
4447 & average(ng) % avgUbcs)
4448# endif
4449 END IF
4450 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
4451 IF (master) THEN
4452 WRITE (stdout,10) trim(vname(1,idubcs)), s(ng)%Rindex
4453 END IF
4454 exit_flag=3
4455 ioerror=status
4456 RETURN
4457 END IF
4458 END IF
4459!
4460! Write out maximum wind and current, bottom V-stress at RHO-points.
4461!
4462 IF (varout(idvbcs,ng)) THEN
4463 scale=rho0
4464 IF (s(ng)%pioVar(idvbcs)%dkind.eq.pio_double) THEN
4465 iodesc => iodesc_dp_r2dvar(ng)
4466 ELSE
4467 iodesc => iodesc_sp_r2dvar(ng)
4468 END IF
4469 IF (linstataneous) THEN
4470 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idvbcs, &
4471 & s(ng)%pioVar(idvbcs), &
4472 & s(ng)%Rindex, &
4473 & iodesc, &
4474 & lbi, ubi, lbj, ubj, scale, &
4475# ifdef MASKING
4476 & grid(ng) % rmask, &
4477# endif
4478 & bbl(ng) % bvstrcwmax)
4479# ifdef AVERAGES
4480 ELSE
4481 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idvbcs, &
4482 & s(ng)%pioVar(idvbcs), &
4483 & s(ng)%Rindex, &
4484 & iodesc, &
4485 & lbi, ubi, lbj, ubj, scale, &
4486# ifdef MASKING
4487 & grid(ng) % rmask, &
4488# endif
4489 & average(ng) % avgVbcs)
4490# endif
4491 END IF
4492 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
4493 IF (master) THEN
4494 WRITE (stdout,10) trim(vname(1,idvbcs)), s(ng)%Rindex
4495 END IF
4496 exit_flag=3
4497 ioerror=status
4498 RETURN
4499 END IF
4500 END IF
4501!
4502! Write out maximum wave and current bottom stress magnitude.
4503!
4504 IF (varout(iduvwc,ng)) THEN
4505 scale=rho0
4506 IF (s(ng)%pioVar(iduvwc)%dkind.eq.pio_double) THEN
4507 iodesc => iodesc_dp_r2dvar(ng)
4508 ELSE
4509 iodesc => iodesc_sp_r2dvar(ng)
4510 END IF
4511 IF (linstataneous) THEN
4512 IF (.not.allocated(wrk2d)) THEN
4513 allocate ( wrk2d(lbi:ubi, lbj:ubj) )
4514 wrk2d(lbi:ubi,lbj:ubj)=0.0_r8
4515 END IF
4516 wrk2d=sqrt(bbl(ng)%bustrcwmax*bbl(ng)%bustrcwmax+ &
4517 & bbl(ng)%bvstrcwmax*bbl(ng)%bvstrcwmax+1.0e-10_r8)
4518!
4519 status=nf_fwrite2d(ng, model, s(ng)%pioFile, iduvwc, &
4520 & s(ng)%pioVar(iduvwc), &
4521 & s(ng)%Rindex, &
4522 & iodesc, &
4523 & lbi, ubi, lbj, ubj, scale, &
4524# ifdef MASKING
4525 & grid(ng) % rmask, &
4526# endif
4527 & wrk2d)
4528 deallocate (wrk2d)
4529# ifdef AVERAGES
4530 ELSE
4531 status=nf_fwrite2d(ng, model, s(ng)%pioFile, iduvwc, &
4532 & s(ng)%pioVar(iduvwc), &
4533 & s(ng)%Rindex, &
4534 & iodesc, &
4535 & lbi, ubi, lbj, ubj, scale, &
4536# ifdef MASKING
4537 & grid(ng) % rmask, &
4538# endif
4539 & average(ng) % avgUVwc)
4540# endif
4541 END IF
4542 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
4543 IF (master) THEN
4544 WRITE (stdout,10) trim(vname(1,iduvwc)), s(ng)%Rindex
4545 END IF
4546 exit_flag=3
4547 ioerror=status
4548 RETURN
4549 END IF
4550 END IF
4551!
4552! Write out wind-induced, bed wave orbital U-velocity at RHO-points.
4553!
4554 IF (varout(idubot,ng)) THEN
4555 scale=1.0_dp
4556 IF (s(ng)%pioVar(idubot)%dkind.eq.pio_double) THEN
4557 iodesc => iodesc_dp_r2dvar(ng)
4558 ELSE
4559 iodesc => iodesc_sp_r2dvar(ng)
4560 END IF
4561 IF (linstataneous) THEN
4562 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idubot, &
4563 & s(ng)%pioVar(idubot), &
4564 & s(ng)%Rindex, &
4565 & iodesc, &
4566 & lbi, ubi, lbj, ubj, scale, &
4567# ifdef MASKING
4568 & grid(ng) % rmask, &
4569# endif
4570 & bbl(ng) % Ubot)
4571# ifdef AVERAGES
4572 ELSE
4573 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idubot, &
4574 & s(ng)%pioVar(idubot), &
4575 & s(ng)%Rindex, &
4576 & iodesc, &
4577 & lbi, ubi, lbj, ubj, scale, &
4578# ifdef MASKING
4579 & grid(ng) % rmask, &
4580# endif
4581 & average(ng) % avgUbot)
4582# endif
4583 END IF
4584 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
4585 IF (master) THEN
4586 WRITE (stdout,10) trim(vname(1,idubot)), s(ng)%Rindex
4587 END IF
4588 exit_flag=3
4589 ioerror=status
4590 RETURN
4591 END IF
4592 END IF
4593!
4594! Write out wind-induced, bed wave orbital V-velocity at RHO-points
4595!
4596 IF (varout(idvbot,ng)) THEN
4597 scale=1.0_dp
4598 IF (s(ng)%pioVar(idvbot)%dkind.eq.pio_double) THEN
4599 iodesc => iodesc_dp_r2dvar(ng)
4600 ELSE
4601 iodesc => iodesc_sp_r2dvar(ng)
4602 END IF
4603 IF (linstataneous) THEN
4604 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idvbot, &
4605 & s(ng)%pioVar(idvbot), &
4606 & s(ng)%Rindex, &
4607 & iodesc, &
4608 & lbi, ubi, lbj, ubj, scale, &
4609# ifdef MASKING
4610 & grid(ng) % rmask, &
4611# endif
4612 & bbl(ng) % Vbot)
4613# ifdef AVERAGES
4614 ELSE
4615 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idvbot, &
4616 & s(ng)%pioVar(idvbot), &
4617 & s(ng)%Rindex, &
4618 & iodesc, &
4619 & lbi, ubi, lbj, ubj, scale, &
4620# ifdef MASKING
4621 & grid(ng) % rmask, &
4622# endif
4623 & average(ng) % avgVbot)
4624# endif
4625 END IF
4626 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
4627 IF (master) THEN
4628 WRITE (stdout,10) trim(vname(1,idvbot)), s(ng)%Rindex
4629 END IF
4630 exit_flag=3
4631 ioerror=status
4632 RETURN
4633 END IF
4634 END IF
4635!
4636! Write out bottom U-velocity above bed at RHO-points.
4637!
4638 IF (varout(idubur,ng)) THEN
4639 scale=1.0_dp
4640 IF (s(ng)%pioVar(idubur)%dkind.eq.pio_double) THEN
4641 iodesc => iodesc_dp_r2dvar(ng)
4642 ELSE
4643 iodesc => iodesc_sp_r2dvar(ng)
4644 END IF
4645 IF (linstataneous) THEN
4646 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idubur, &
4647 & s(ng)%pioVar(idubur), &
4648 & s(ng)%Rindex, &
4649 & iodesc, &
4650 & lbi, ubi, lbj, ubj, scale, &
4651# ifdef MASKING
4652 & grid(ng) % rmask, &
4653# endif
4654 & bbl(ng) % Ur)
4655# ifdef AVERAGES
4656 ELSE
4657 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idubur, &
4658 & s(ng)%pioVar(idubur), &
4659 & s(ng)%Rindex, &
4660 & iodesc, &
4661 & lbi, ubi, lbj, ubj, scale, &
4662# ifdef MASKING
4663 & grid(ng) % rmask, &
4664# endif
4665 & average(ng) % avgUbur)
4666# endif
4667 END IF
4668 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
4669 IF (master) THEN
4670 WRITE (stdout,10) trim(vname(1,idubur)), s(ng)%Rindex
4671 END IF
4672 exit_flag=3
4673 ioerror=status
4674 RETURN
4675 END IF
4676 END IF
4677!
4678! Write out bottom V-velocity above bed at RHO-points.
4679!
4680 IF (varout(idvbvr,ng)) THEN
4681 scale=1.0_dp
4682 IF (s(ng)%pioVar(idvbvr)%dkind.eq.pio_double) THEN
4683 iodesc => iodesc_dp_r2dvar(ng)
4684 ELSE
4685 iodesc => iodesc_sp_r2dvar(ng)
4686 END IF
4687 IF (linstataneous) THEN
4688 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idvbvr, &
4689 & s(ng)%pioVar(idvbvr), &
4690 & s(ng)%Rindex, &
4691 & iodesc, &
4692 & lbi, ubi, lbj, ubj, scale, &
4693# ifdef MASKING
4694 & grid(ng) % rmask, &
4695# endif
4696 & bbl(ng) % Vr)
4697# ifdef AVERAGES
4698 ELSE
4699 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idvbvr, &
4700 & s(ng)%pioVar(idvbvr), &
4701 & s(ng)%Rindex, &
4702 & iodesc, &
4703 & lbi, ubi, lbj, ubj, scale, &
4704# ifdef MASKING
4705 & grid(ng) % rmask, &
4706# endif
4707 & average(ng) % avgVbvr)
4708# endif
4709 END IF
4710 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
4711 IF (master) THEN
4712 WRITE (stdout,10) trim(vname(1,idvbvr)), s(ng)%Rindex
4713 END IF
4714 exit_flag=3
4715 ioerror=status
4716 RETURN
4717 END IF
4718 END IF
4719# endif
4720
4721# if defined UV_KIRBY && defined AVERAGES
4722!
4723! Write out U-velocity from Kirby and Chen.
4724!
4725 IF (varout(iduwav,ng)) THEN
4726 IF (.not.linstataneous) THEN
4727 scale=1.0_dp
4728 IF (s(ng)%pioVar(iduwav)%dkind.eq.pio_double) THEN
4729 iodesc => iodesc_dp_r2dvar(ng)
4730 ELSE
4731 iodesc => iodesc_sp_r2dvar(ng)
4732 END IF
4733 status=nf_fwrite2d(ng, model, s(ng)%pioFile, iduwav, &
4734 & s(ng)%pioVar(iduwav), &
4735 & s(ng)%Rindex, &
4736 & iodesc, &
4737 & lbi, ubi, lbj, ubj, scale, &
4738# ifdef MASKING
4739 & grid(ng) % rmask, &
4740# endif
4741 & average(ng) % avgUwav)
4742 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4743 IF (master) THEN
4744 WRITE (stdout,10) trim(vname(1,iduwav)), s(ng)%Rindex
4745 END IF
4746 exit_flag=3
4747 ioerror=status
4748 RETURN
4749 END IF
4750 END IF
4751 END IF
4752!
4753! Write out V-velocity from Kirby and Chen.
4754!
4755 IF (varout(idvwav,ng)) THEN
4756 IF (.not.linstataneous) THEN
4757 scale=1.0_dp
4758 IF (s(ng)%pioVar(idvwav)%dkind.eq.pio_double) THEN
4759 iodesc => iodesc_dp_r2dvar(ng)
4760 ELSE
4761 iodesc => iodesc_sp_r2dvar(ng)
4762 END IF
4763 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idvwav, &
4764 & s(ng)%pioVar(idvwav), &
4765 & s(ng)%Rindex, &
4766 & iodesc, &
4767 & lbi, ubi, lbj, ubj, scale, &
4768# ifdef MASKING
4769 & grid(ng) % rmask, &
4770# endif
4771 & average(ng) % avgVwav)
4772 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4773 IF (master) THEN
4774 WRITE (stdout,10) trim(vname(1,idvwav)), s(ng)%Rindex
4775 END IF
4776 exit_flag=3
4777 ioerror=status
4778 RETURN
4779 END IF
4780 END IF
4781 END IF
4782# endif
4783
4784# ifdef WAVES_HEIGHT
4785!
4786! Write out wind-induced sifnificant wave height.
4787!
4788 IF (varout(idwamp,ng)) THEN
4789 scale=1.0_dp
4790 IF (s(ng)%pioVar(idwamp)%dkind.eq.pio_double) THEN
4791 iodesc => iodesc_dp_r2dvar(ng)
4792 ELSE
4793 iodesc => iodesc_sp_r2dvar(ng)
4794 END IF
4795 IF (linstataneous) THEN
4796 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idwamp, &
4797 & s(ng)%pioVar(idwamp), &
4798 & s(ng)%Rindex, &
4799 & iodesc, &
4800 & lbi, ubi, lbj, ubj, scale, &
4801# ifdef MASKING
4802 & grid(ng) % rmask, &
4803# endif
4804 & forces(ng) % Hwave)
4805# ifdef AVERAGES
4806 ELSE
4807 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idwamp, &
4808 & s(ng)%pioVar(idwamp), &
4809 & s(ng)%Rindex, &
4810 & iodesc, &
4811 & lbi, ubi, lbj, ubj, scale, &
4812# ifdef MASKING
4813 & grid(ng) % rmask, &
4814# endif
4815 & average(ng) % avgWamp)
4816# endif
4817 END IF
4818 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
4819 IF (master) THEN
4820 WRITE (stdout,10) trim(vname(1,idwamp)), s(ng)%Rindex
4821 END IF
4822 exit_flag=3
4823 ioerror=status
4824 RETURN
4825 END IF
4826 END IF
4827
4828# ifdef AVERAGES
4829!
4830! Write out wind-induced significant wave height squared.
4831!
4832 IF (varout(idwam2,ng)) THEN
4833 IF (.not.linstataneous) THEN
4834 scale=1.0_dp
4835 IF (avg(ng)%pioVar(idwam2)%dkind.eq.pio_double) THEN
4836 iodesc => iodesc_dp_r2dvar(ng)
4837 ELSE
4838 iodesc => iodesc_sp_r2dvar(ng)
4839 END IF
4840 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idwam2, &
4841 & s(ng)%pioVar(idwam2), &
4842 & s(ng)%Rindex, &
4843 & iodesc, &
4844 & lbi, ubi, lbj, ubj, scale, &
4845# ifdef MASKING
4846 & grid(ng) % rmask, &
4847# endif
4848 & average(ng) % avgWam2)
4849# endif
4850 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
4851 IF (master) THEN
4852 WRITE (stdout,10) trim(vname(1,idwam2)), avg(ng)%Rindex
4853 END IF
4854 exit_flag=3
4855 ioerror=status
4856 RETURN
4857 END IF
4858 END IF
4859 END IF
4860# endif
4861
4862# ifdef WAVES_LENGTH
4863!
4864! Write out wind-induced mean wavelength.
4865!
4866 IF (varout(idwlen,ng)) THEN
4867 scale=1.0_dp
4868 IF (s(ng)%pioVar(idwlen)%dkind.eq.pio_double) THEN
4869 iodesc => iodesc_dp_r2dvar(ng)
4870 ELSE
4871 iodesc => iodesc_sp_r2dvar(ng)
4872 END IF
4873 IF (linstataneous) THEN
4874 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idwlen, &
4875 & s(ng)%pioVar(idwlen), &
4876 & s(ng)%Rindex, &
4877 & iodesc, &
4878 & lbi, ubi, lbj, ubj, scale, &
4879# ifdef MASKING
4880 & grid(ng) % rmask, &
4881# endif
4882 & forces(ng) % Lwave)
4883# ifdef AVERAGES
4884 ELSE
4885 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idwlen, &
4886 & s(ng)%pioVar(idwlen), &
4887 & s(ng)%Rindex, &
4888 & iodesc, &
4889 & lbi, ubi, lbj, ubj, scale, &
4890# ifdef MASKING
4891 & grid(ng) % rmask, &
4892# endif
4893 & average(ng) % avgWlen)
4894# endif
4895 END IF
4896 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
4897 IF (master) THEN
4898 WRITE (stdout,10) trim(vname(1,idwlen)), s(ng)%Rindex
4899 END IF
4900 exit_flag=3
4901 ioerror=status
4902 RETURN
4903 END IF
4904 END IF
4905# endif
4906
4907# ifdef WAVES_LENGTHP
4908!
4909! Write out wind-induced peak wave wavelength.
4910!
4911 IF (varout(idwlep,ng)) THEN
4912 scale=1.0_dp
4913 IF (s(ng)%pioVar(idwlen)%dkind.eq.pio_double) THEN
4914 iodesc => iodesc_dp_r2dvar(ng)
4915 ELSE
4916 iodesc => iodesc_sp_r2dvar(ng)
4917 END IF
4918 IF (linstataneous) THEN
4919 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idwlep, &
4920 & s(ng)%pioVar(idwlep), &
4921 & s(ng)%Rindex, &
4922 & iodesc, &
4923 & lbi, ubi, lbj, ubj, scale, &
4924# ifdef MASKING
4925 & grid(ng) % rmask, &
4926# endif
4927 & forces(ng) % Lwavep)
4928# ifdef AVERAGES
4929 ELSE
4930 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idwlep, &
4931 & s(ng)%pioVar(idwlep), &
4932 & s(ng)%Rindex, &
4933 & iodesc, &
4934 & lbi, ubi, lbj, ubj, scale, &
4935# ifdef MASKING
4936 & grid(ng) % rmask, &
4937# endif
4938 & average(ng) % avgWlep)
4939# endif
4940 END IF
4941 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
4942 IF (master) THEN
4943 WRITE (stdout,10) trim(vname(1,idwlep)), s(ng)%Rindex
4944 END IF
4945 exit_flag=3
4946 ioerror=status
4947 RETURN
4948 END IF
4949 END IF
4950# endif
4951
4952# ifdef WAVES_DIR
4953!
4954! Write out wind-induced mean wave direction.
4955!
4956 IF (varout(idwdir,ng)) THEN
4957 scale=rad2deg
4958 IF (s(ng)%pioVar(idwdir)%dkind.eq.pio_double) THEN
4959 iodesc => iodesc_dp_r2dvar(ng)
4960 ELSE
4961 iodesc => iodesc_sp_r2dvar(ng)
4962 END IF
4963 IF (linstataneous) THEN
4964 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idwdir, &
4965 & s(ng)%pioVar(idwdir), &
4966 & s(ng)%Rindex, &
4967 & iodesc, &
4968 & lbi, ubi, lbj, ubj, scale, &
4969# ifdef MASKING
4970 & grid(ng) % rmask, &
4971# endif
4972 & forces(ng) % Dwave)
4973# ifdef AVERAGES
4974 ELSE
4975 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idwdir, &
4976 & s(ng)%pioVar(idwdir), &
4977 & s(ng)%Rindex, &
4978 & iodesc, &
4979 & lbi, ubi, lbj, ubj, scale, &
4980# ifdef MASKING
4981 & grid(ng) % rmask, &
4982# endif
4983 & average(ng) % avgWdir)
4984# endif
4985 END IF
4986 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
4987 IF (master) THEN
4988 WRITE (stdout,10) trim(vname(1,idwdir)), s(ng)%Rindex
4989 END IF
4990 exit_flag=3
4991 ioerror=status
4992 RETURN
4993 END IF
4994 END IF
4995# endif
4996
4997# ifdef WAVES_DIRP
4998!
4999! Write out wind-induced peak wave direction.
5000!
5001 IF (varout(idwdip,ng)) THEN
5002 scale=rad2deg
5003 IF (s(ng)%pioVar(idwdir)%dkind.eq.pio_double) THEN
5004 iodesc => iodesc_dp_r2dvar(ng)
5005 ELSE
5006 iodesc => iodesc_sp_r2dvar(ng)
5007 END IF
5008 IF (linstataneous) THEN
5009 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idwdip, &
5010 & s(ng)%pioVar(idwdip), &
5011 & s(ng)%Rindex, &
5012 & iodesc, &
5013 & lbi, ubi, lbj, ubj, scale, &
5014# ifdef MASKING
5015 & grid(ng) % rmask, &
5016# endif
5017 & forces(ng) % Dwavep)
5018 ELSE
5019 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idwdip, &
5020 & s(ng)%pioVar(idwdip), &
5021 & s(ng)%Rindex, &
5022 & iodesc, &
5023 & lbi, ubi, lbj, ubj, scale, &
5024# ifdef MASKING
5025 & grid(ng) % rmask, &
5026# endif
5027 & average(ng) % avgWdip)
5028 END IF
5029 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
5030 IF (master) THEN
5031 WRITE (stdout,10) trim(vname(1,idwdip)), s(ng)%Rindex
5032 END IF
5033 exit_flag=3
5034 ioerror=status
5035 RETURN
5036 END IF
5037 END IF
5038# endif
5039
5040# ifdef WAVES_TOP_PERIOD
5041!
5042! Write out wind-induced surface wave period.
5043!
5044 IF (varout(idwptp,ng)) THEN
5045 scale=1.0_dp
5046 IF (s(ng)%pioVar(idwptp)%dkind.eq.pio_double) THEN
5047 iodesc => iodesc_dp_r2dvar(ng)
5048 ELSE
5049 iodesc => iodesc_sp_r2dvar(ng)
5050 END IF
5051 IF (linstataneous) THEN
5052 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idwptp, &
5053 & s(ng)%pioVar(idwptp), &
5054 & s(ng)%Rindex, &
5055 & iodesc, &
5056 & lbi, ubi, lbj, ubj, scale, &
5057# ifdef MASKING
5058 & grid(ng) % rmask, &
5059# endif
5060 & forces(ng) % Pwave_top)
5061# ifdef AVERAGES
5062 ELSE
5063 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idwptp, &
5064 & s(ng)%pioVar(idwptp), &
5065 & s(ng)%Rindex, &
5066 & iodesc, &
5067 & lbi, ubi, lbj, ubj, scale, &
5068# ifdef MASKING
5069 & grid(ng) % rmask, &
5070# endif
5071 & average(ng) % avgWptp)
5072# endif
5073 END IF
5074 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
5075 IF (master) THEN
5076 WRITE (stdout,10) trim(vname(1,idwptp)), s(ng)%Rindex
5077 END IF
5078 exit_flag=3
5079 ioerror=status
5080 RETURN
5081 END IF
5082 END IF
5083# endif
5084
5085# ifdef WAVES_BOT_PERIOD
5086!
5087! Write out wind-induced bottom wave period.
5088!
5089 IF (varout(idwpbt,ng)) THEN
5090 scale=1.0_dp
5091 IF (s(ng)%pioVar(idwpbt)%dkind.eq.pio_double) THEN
5092 iodesc => iodesc_dp_r2dvar(ng)
5093 ELSE
5094 iodesc => iodesc_sp_r2dvar(ng)
5095 END IF
5096 IF (linstataneous) THEN
5097 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idwpbt, &
5098 & s(ng)%pioVar(idwpbt), &
5099 & s(ng)%Rindex, &
5100 & iodesc, &
5101 & lbi, ubi, lbj, ubj, scale, &
5102# ifdef MASKING
5103 & grid(ng) % rmask, &
5104# endif
5105 & forces(ng) % Pwave_bot)
5106# ifdef AVERAGES
5107 ELSE
5108 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idwpbt, &
5109 & s(ng)%pioVar(idwpbt), &
5110 & s(ng)%Rindex, &
5111 & iodesc, &
5112 & lbi, ubi, lbj, ubj, scale, &
5113# ifdef MASKING
5114 & grid(ng) % rmask, &
5115# endif
5116 & average(ng) % avgWpbt)
5117# endif
5118 END IF
5119 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
5120 IF (master) THEN
5121 WRITE (sqtdout,10) trim(vname(1,idwpbt)), s(ng)%Rindex
5122 END IF
5123 exit_flag=3
5124 ioerror=status
5125 RETURN
5126 END IF
5127 END IF
5128# endif
5129
5130# ifdef WAVES_DSPR
5131!
5132! Write out waves directional spreading.
5133!
5134 IF (varout(idwvds,ng)) THEN
5135 IF (linstataneous) THEN
5136 scale=1.0_dp
5137 IF (s(ng)%pioVar(idwvds)%dkind.eq.pio_double) THEN
5138 iodesc => iodesc_dp_r2dvar(ng)
5139 ELSE
5140 iodesc => iodesc_sp_r2dvar(ng)
5141 END IF
5142 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idwvds, &
5143 & s(ng)%pioVar(idwvds), &
5144 & s(ng)%Rindex, &
5145 & iodesc, &
5146 & lbi, ubi, lbj, ubj, scale, &
5147# ifdef MASKING
5148 & grid(ng) % rmask, &
5149# endif
5150 & forces(ng) % Wave_ds)
5151 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
5152 IF (master) THEN
5153 WRITE (sqtdout,10) trim(vname(1,idwvds)), s(ng)%Rindex
5154 END IF
5155 exit_flag=3
5156 ioerror=status
5157 RETURN
5158 END IF
5159 END IF
5160 END IF
5161!
5162! Write out waves spectrum peakeness.
5163!
5164 IF (varout(idwvqp,ng)) THEN
5165 IF (linstataneous) THEN
5166 scale=1.0_dp
5167 IF (s(ng)%pioVar(idwvds)%dkind.eq.pio_double) THEN
5168 iodesc => iodesc_dp_r2dvar(ng)
5169 ELSE
5170 iodesc => iodesc_sp_r2dvar(ng)
5171 END IF
5172 status=nf_fwrite2d(ng, model, s(ng)%pioFile, idwvqp, &
5173 & s(ng)%pioVar(idwvqp), &
5174 & s(ng)%Rindex, &
5175 & iodesc, &
5176 & lbi, ubi, lbj, ubj, scale, &
5177# ifdef MASKING
5178 & grid(ng) % rmask, &
5179# endif
5180 & forces(ng) % Wave_qp)
5181 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
5182 IF (master) THEN
5183 WRITE (sqtdout,10) trim(vname(1,idwvqp)), s(ng)%Rindex
5184 END IF
5185 exit_flag=3
5186 ioerror=status
5187 RETURN
5188 END IF
5189 END IF
5190 END IF
5191# endif
5192!
5193 10 FORMAT (/," BBL_WRT_PIO - error while writing variable '", &
5194 & a,"', time record = ",i0,/,11x,'into file: ',a)
5195!
5196 RETURN
5197 END SUBROUTINE sediement_wrt_pio
5198
5199# ifdef STATIONS
5200!
5201!***********************************************************************
5202 SUBROUTINE bbl_def_station_pio (ng, model, ldef, VarOut, S, &
5203 & pgrd, rgrd)
5204!***********************************************************************
5205!
5206 USE mod_netcdf
5207!
5208! Imported variable declarations.
5209!
5210 logical, intent(in) :: ldef, varout(nv,ngrids)
5211!
5212 integer, intent(in) :: ng, model
5213 integer, intent(in), optional :: pgrd(:), rgrd(:)
5214!
5215 TYPE(t_io), intent(inout) :: s(ngrids)
5216!
5217! Local variable declarations.
5218!
5219 logical :: got_var(nv)
5220!
5221 integer, parameter :: natt = 25
5222
5223 integer :: i, j, status
5224!
5225 real(r8) :: aval(6)
5226!
5227 character (len=120) :: vinfo(natt)
5228 character (len=256) :: ncname
5229!
5230 character (len=*), parameter :: myfile = &
5231 & __FILE__//", bbl_def_station_nf90"
5232!
5233 sourcefile=myfile
5234!
5235!-----------------------------------------------------------------------
5236! Define sediment output stations variables.
5237!-----------------------------------------------------------------------
5238!
5239 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5240 ncname=s(ng)%name
5241!
5242 define : IF (ldef) THEN
5243!
5244! Initialize local information variable arrays.
5245!
5246 DO i=1,natt
5247 DO j=1,len(vinfo(1))
5248 vinfo(i)(j:j)=' '
5249 END DO
5250 END DO
5251 DO i=1,6
5252 aval(i)=0.0_r8
5253 END DO
5254
5255# ifdef WAVES_UB
5256!
5257! Define wind-induced wave bottom orbital velocity.
5258!
5259 IF (varout(idworb,ng)) THEN
5260 vinfo( 1)=vname(1,idworb)
5261 vinfo( 2)=vname(2,idworb)
5262 vinfo( 3)=vname(3,idworb)
5263 vinfo(14)=vname(4,idworb)
5264 vinfo(16)=vname(1,idtime)
5265 s(ng)%pioVar(idworb)%dkind=pio_fout
5266 s(ng)%pioVar(idworb)%gtype=0
5267!
5268 status=def_var(ng, model, s(ng)%pioFile, &
5269 & s(ng)%pioVar(idworb)%vd, &
5270 & pio_fout, 2, pgrd, aval, vinfo, ncname, &
5271 & setfillval = .true., &
5272 & setparaccess = .true.)
5273 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5274 END IF
5275# endif
5276
5277# ifdef BBL_MODEL
5278!
5279! Define bottom U-current stress.
5280!
5281 IF (varout(idubrs,ng)) THEN
5282 vinfo( 1)=vname(1,idubrs)
5283 vinfo( 2)=vname(2,idubrs)
5284 vinfo( 3)=vname(3,idubrs)
5285 vinfo(14)=vname(4,idubrs)
5286 vinfo(16)=vname(1,idtime)
5287 s(ng)%pioVar(idubrs)%dkind=pio_fout
5288 s(ng)%pioVar(idubrs)%gtype=0
5289!
5290 status=def_var(ng, model, s(ng)%pioFile, &
5291 & s(ng)%pioVar(idubrs)%vd, &
5292 & pio_fout, 2, pgrd, aval, vinfo, ncname, &
5293 & setfillval = .true., &
5294 & setparaccess = .true.)
5295 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5296 END IF
5297!
5298! Define bottom V-current stress.
5299!
5300 IF (varout(idvbrs,ng)) THEN
5301 vinfo( 1)=vname(1,idvbrs)
5302 vinfo( 2)=vname(2,idvbrs)
5303 vinfo( 3)=vname(3,idvbrs)
5304 vinfo(14)=vname(4,idvbrs)
5305 vinfo(16)=vname(1,idtime)
5306 s(ng)%pioVar(idvbrs)%dkind=pio_fout
5307 s(ng)%pioVar(idvbrs)%gtype=0
5308!
5309 status=def_var(ng, model, s(ng)%pioFile, &
5310 & s(ng)%pioVar(idvbrs)%vd, &
5311 & pio_fout, 2, pgrd, aval, vinfo, ncname, &
5312 & setfillval = .true., &
5313 & setparaccess = .true.)
5314 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5315 END IF
5316!
5317! Define wind-induced, bottom U-wave stress.
5318!
5319 IF (varout(idubws,ng)) THEN
5320 vinfo( 1)=vname(1,idubws)
5321 vinfo( 2)=vname(2,idubws)
5322 vinfo( 3)=vname(3,idubws)
5323 vinfo(14)=vname(4,idubws)
5324 vinfo(16)=vname(1,idtime)
5325 s(ng)%pioVar(idubws)%dkind=pio_fout
5326 s(ng)%pioVar(idubws)%gtype=0
5327!
5328 status=def_var(ng, model, s(ng)%pioFile, &
5329 & s(ng)%pioVar(idubws)%vd, &
5330 & pio_fout, 2, pgrd, aval, vinfo, ncname, &
5331 & setfillval = .true., &
5332 & setparaccess = .true.)
5333 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5334 END IF
5335!
5336! Define bottom wind-induced, bottom V-wave stress.
5337!
5338 IF (varout(idvbws,ng)) THEN
5339 vinfo( 1)=vname(1,idvbws)
5340 vinfo( 2)=vname(2,idvbws)
5341 vinfo( 3)=vname(3,idvbws)
5342 vinfo(14)=vname(4,idvbws)
5343 vinfo(16)=vname(1,idtime)
5344 s(ng)%pioVar(idvbws)%dkind=pio_fout
5345 s(ng)%pioVar(idvbws)%gtype=0
5346!
5347 status=def_var(ng, model, s(ng)%pioFile, &
5348 & s(ng)%pioVar(idvbws)%vd, &
5349 & pio_fout, 2, pgrd, aval, vinfo, ncname, &
5350 & setfillval = .true., &
5351 & setparaccess = .true.)
5352 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5353 END IF
5354!
5355! Define maximum wind and current, bottom U-wave stress.
5356!
5357 IF (varout(idubcs,ng)) THEN
5358 vinfo( 1)=vname(1,idubcs)
5359 vinfo( 2)=vname(2,idubcs)
5360 vinfo( 3)=vname(3,idubcs)
5361 vinfo(14)=vname(4,idubcs)
5362 vinfo(16)=vname(1,idtime)
5363 s(ng)%pioVar(idubcs)%dkind=pio_fout
5364 s(ng)%pioVar(idubcs)%gtype=0
5365!
5366 status=def_var(ng, model, s(ng)%pioFile, &
5367 & s(ng)%pioVar(idubcs)%vd, &
5368 & pio_fout, 2, pgrd, aval, vinfo, ncname, &
5369 & setfillval = .true., &
5370 & setparaccess = .true.)
5371 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5372 END IF
5373!
5374! Define maximum wind and current, bottom V-wave stress.
5375!
5376 IF (varout(idvbcs,ng)) THEN
5377 vinfo( 1)=vname(1,idvbcs)
5378 vinfo( 2)=vname(2,idvbcs)
5379 vinfo( 3)=vname(3,idvbcs)
5380 vinfo(14)=vname(4,idvbcs)
5381 vinfo(16)=vname(1,idtime)
5382 s(ng)%pioVar(idvbcs)%dkind=pio_fout
5383 s(ng)%pioVar(idvbcs)%gtype=0
5384!
5385 status=def_var(ng, model, s(ng)%pioFile, &
5386 & s(ng)%pioVar(idvbcs)%vd, &
5387 & pio_fout, 2, pgrd, aval, vinfo, ncname, &
5388 & setfillval = .true., &
5389 & setparaccess = .true.)
5390 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5391 END IF
5392!
5393! Define wind-induced, bed wave orbital U-velocity.
5394!
5395 IF (varout(idubot,ng)) THEN
5396 vinfo( 1)=vname(1,idubot)
5397 vinfo( 2)=vname(2,idubot)
5398 vinfo( 3)=vname(3,idubot)
5399 vinfo(14)=vname(4,idubot)
5400 vinfo(16)=vname(1,idtime)
5401 s(ng)%pioVar(idubot)%dkind=pio_fout
5402 s(ng)%pioVar(idubot)%gtype=0
5403!
5404 status=def_var(ng, model, s(ng)%pioFile, &
5405 & s(ng)%pioVar(idubot)%vd, &
5406 & pio_fout, 2, pgrd, aval, vinfo, ncname, &
5407 & setfillval = .true., &
5408 & setparaccess = .true.)
5409 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5410 END IF
5411!
5412! Define wind-induced, bed wave orbital V-velocity.
5413!
5414 IF (varout(idvbot,ng)) THEN
5415 vinfo( 1)=vname(1,idvbot)
5416 vinfo( 2)=vname(2,idvbot)
5417 vinfo( 3)=vname(3,idvbot)
5418 vinfo(14)=vname(4,idvbot)
5419 vinfo(16)=vname(1,idtime)
5420 s(ng)%pioVar(idvbot)%dkind=pio_fout
5421 s(ng)%pioVar(idvbot)%gtype=0
5422!
5423 status=def_var(ng, model, s(ng)%pioFile, &
5424 & s(ng)%pioVar(idvbot)%vd, &
5425 & pio_fout, 2, pgrd, aval, vinfo, ncname, &
5426 & setfillval = .true., &
5427 & setparaccess = .true.)
5428 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5429 END IF
5430!
5431! Define bottom U-momentum above bed.
5432!
5433 IF (varout(idubur,ng)) THEN
5434 vinfo( 1)=vname(1,idubur)
5435 vinfo( 2)=vname(2,idubur)
5436 vinfo( 3)=vname(3,idubur)
5437 vinfo(14)=vname(4,idubur)
5438 vinfo(16)=vname(1,idtime)
5439 s(ng)%pioVar(idubur)%dkind=pio_fout
5440 s(ng)%pioVar(idubur)%gtype=0
5441!
5442 status=def_var(ng, model, s(ng)%pioFile, &
5443 & s(ng)%pioVar(idubur)%vd, &
5444 & pio_fout, 2, pgrd, aval, vinfo, ncname, &
5445 & setfillval = .true., &
5446 & setparaccess = .true.)
5447 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5448 END IF
5449!
5450! Define bottom V-momentum above bed.
5451!
5452 IF (varout(idvbvr,ng)) THEN
5453 vinfo( 1)=vname(1,idvbvr)
5454 vinfo( 2)=vname(2,idvbvr)
5455 vinfo( 3)=vname(3,idvbvr)
5456 vinfo(14)=vname(4,idvbvr)
5457 vinfo(16)=vname(1,idtime)
5458 s(ng)%pioVar(idvbvr)%dkind=pio_fout
5459 s(ng)%pioVar(idvbvr)%gtype=0
5460!
5461 status=def_var(ng, model, s(ng)%pioFile, &
5462 & s(ng)%pioVar(idvbvr)%vd, &
5463 & pio_fout, 2, pgrd, aval, vinfo, ncname, &
5464 & setfillval = .true., &
5465 & setparaccess = .true.)
5466 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5467 END IF
5468# endif
5469
5470# ifdef WAVES_HEIGHT
5471!
5472! Define wind-induced significant wave height.
5473!
5474 IF (varout(idwamp,ng)) THEN
5475 vinfo( 1)=vname(1,idwamp)
5476 vinfo( 2)=vname(2,idwamp)
5477 vinfo( 3)=vname(3,idwamp)
5478 vinfo(14)=vname(4,idwamp)
5479 vinfo(16)=vname(1,idtime)
5480 s(ng)%pioVar(idwamp)%dkind=pio_fout
5481 s(ng)%pioVar(idwamp)%gtype=0
5482!
5483 status=def_var(ng, model, s(ng)%pioFile, &
5484 & s(ng)%pioVar(idwamp)%vd, &
5485 & pio_fout, 2, pgrd, aval, vinfo, ncname, &
5486 & setfillval = .true., &
5487 & setparaccess = .true.)
5488 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5489 END IF
5490# endif
5491
5492# ifdef WAVES_LENGTH
5493!
5494! Define wind-induced mean wavelenght.
5495!
5496 IF (varout(idwlen,ng)) THEN
5497 vinfo( 1)=vname(1,idwlen)
5498 vinfo( 2)=vname(2,idwlen)
5499 vinfo( 3)=vname(3,idwlen)
5500 vinfo(14)=vname(4,idwlen)
5501 vinfo(16)=vname(1,idtime)
5502 s(ng)%pioVar(idwlen)%dkind=pio_fout
5503 s(ng)%pioVar(idwlen)%gtype=0
5504!
5505 status=def_var(ng, model, s(ng)%pioFile, &
5506 & s(ng)%pioVar(idwlen)%vd, &
5507 & pio_fout, 2, pgrd, aval, vinfo, ncname, &
5508 & setfillval = .true., &
5509 & setparaccess = .true.)
5510 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5511 END IF
5512# endif
5513
5514# ifdef WAVES_LENGTHP
5515!
5516! Define wind-induced peak wave wavelength.
5517!
5518 IF (varout(idwlep,ng)) THEN
5519 vinfo( 1)=vname(1,idwlep)
5520 vinfo( 2)=vname(2,idwlep)
5521 vinfo( 3)=vname(3,idwlep)
5522 vinfo(14)=vname(4,idwlep)
5523 vinfo(16)=vname(1,idtime)
5524 s(ng)%pioVar(idwlep)%dkind=pio_fout
5525 s(ng)%pioVar(idwlep)%gtype=0
5526!
5527 status=def_var(ng, model, s(ng)%pioFile, &
5528 & s(ng)%pioVar(idwlep)%vd, &
5529 & pio_fout, 2, pgrd, aval, vinfo, ncname, &
5530 & setfillval = .true., &
5531 & setparaccess = .true.)
5532 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5533 END IF
5534# endif
5535
5536# ifdef WAVES_DIR
5537!
5538! Define wind-induced wave direction.
5539!
5540 IF (varout(idwdir,ng)) THEN
5541 vinfo( 1)=vname(1,idwdir)
5542 vinfo( 2)=vname(2,idwdir)
5543 vinfo( 3)=vname(3,idwdir)
5544 vinfo(14)=vname(4,idwdir)
5545 vinfo(16)=vname(1,idtime)
5546 s(ng)%pioVar(idwdir)%dkind=pio_fout
5547 s(ng)%pioVar(idwdir)%gtype=0
5548!
5549 status=def_var(ng, model, s(ng)%pioFile, &
5550 & s(ng)%pioVar(idwdir)%vd, &
5551 & pio_fout, 2, pgrd, aval, vinfo, ncname, &
5552 & setfillval = .true., &
5553 & setparaccess = .true.)
5554 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5555 END IF
5556# endif
5557
5558# ifdef WAVES_DIRP
5559!
5560! Define wind-induced peak wave direction.
5561!
5562 IF (varout(idwdip,ng)) THEN
5563 vinfo( 1)=vname(1,idwdip)
5564 vinfo( 2)=vname(2,idwdip)
5565 vinfo( 3)=vname(3,idwdip)
5566 vinfo(14)=vname(4,idwdip)
5567 vinfo(16)=vname(1,idtime)
5568 s(ng)%pioVar(idwdip)%dkind=pio_fout
5569 s(ng)%pioVar(idwdip)%gtype=0
5570!
5571 status=def_var(ng, model, s(ng)%pioFile, &
5572 & s(ng)%pioVar(idwdip)%vd, &
5573 & pio_fout, 2, pgrd, aval, vinfo, ncname, &
5574 & setfillval = .true., &
5575 & setparaccess = .true.)
5576 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5577 END IF
5578# endif
5579
5580# ifdef WAVES_TOP_PERIOD
5581!
5582! Define wind-induced surface wave period.
5583!
5584 IF (varout(idwptp,ng)) THEN
5585 vinfo( 1)=vname(1,idwptp)
5586 vinfo( 2)=vname(2,idwptp)
5587 vinfo( 3)=vname(3,idwptp)
5588 vinfo(14)=vname(4,idwptp)
5589 vinfo(16)=vname(1,idtime)
5590 s(ng)%pioVar(idwptp)%dkind=pio_fout
5591 s(ng)%pioVar(idwptp)%gtype=0
5592!
5593 status=def_var(ng, model, s(ng)%pioFile, &
5594 & s(ng)%pioVar(idwptp)%vd, &
5595 & pio_fout, 2, pgrd, aval, vinfo, ncname, &
5596 & setfillval = .true., &
5597 & setparaccess = .true.)
5598 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5599 END IF
5600# endif
5601
5602# ifdef WAVES_BOT_PERIOD
5603!
5604! Define wind-induced bottom wave period.
5605!
5606 IF (varout(idwpbt,ng)) THEN
5607 vinfo( 1)=vname(1,idwpbt)
5608 vinfo( 2)=vname(2,idwpbt)
5609 vinfo( 3)=vname(3,idwpbt)
5610 vinfo(14)=vname(4,idwpbt)
5611 vinfo(16)=vname(1,idtime)
5612 s(ng)%pioVar(idwpbt)%dkind=pio_fout
5613 s(ng)%pioVar(idwpbt)%gtype=0
5614!
5615 status=def_var(ng, model, s(ng)%pioFile, &
5616 & s(ng)%pioVar(idwpbt)%vd, &
5617 & pio_fout, 2, pgrd, aval, vinfo, ncname, &
5618 & setfillval = .true., &
5619 & setparaccess = .true.)
5620 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5621 END IF
5622# endif
5623
5624# ifdef WAVES_DSPR
5625!
5626! Define waves directional spreading.
5627!
5628 IF (varout(idwvds,ng)) THEN
5629 vinfo( 1)=vname(1,idwvds)
5630 vinfo( 2)=vname(2,idwvds)
5631 vinfo( 3)=vname(3,idwvds)
5632 vinfo(14)=vname(4,idwvds)
5633 vinfo(16)=vname(1,idtime)
5634 s(ng)%pioVar(idwvds)%dkind=pio_fout
5635 s(ng)%pioVar(idwvds)%gtype=0
5636!
5637 status=def_var(ng, model, s(ng)%pioFile, &
5638 & s(ng)%pioVar(idwvds)%vd, &
5639 & pio_fout, 2, pgrd, aval, vinfo, ncname, &
5640 & setfillval = .true., &
5641 & setparaccess = .true.)
5642 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5643 END IF
5644!
5645! Define wave spectrum peakedness.
5646!
5647 IF (varout(idwvqp,ng)) THEN
5648 vinfo( 1)=vname(1,idwvqp)
5649 vinfo( 2)=vname(2,idwvqp)
5650 vinfo( 3)=vname(3,idwvqp)
5651 vinfo(14)=vname(4,idwvqp)
5652 vinfo(16)=vname(1,idtime)
5653 s(ng)%pioVar(idwvqp)%dkind=pio_fout
5654 s(ng)%pioVar(idwvqp)%gtype=0
5655!
5656 status=def_var(ng, model, s(ng)%pioFile, &
5657 & s(ng)%pioVar(idwvqp)%vd, &
5658 & pio_fout, 2, pgrd, aval, vinfo, ncname, &
5659 & setfillval = .true., &
5660 & setparaccess = .true.)
5661 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5662 END IF
5663# endif
5664
5665 END IF define
5666!
5667!-----------------------------------------------------------------------
5668! Open an existing stations file, check its contents, and prepare for
5669! appending data.
5670!-----------------------------------------------------------------------
5671!
5672 query : IF (.not.ldef) THEN
5673!
5674! Initialize logical switches.
5675!
5676 DO i=1,nv
5677 got_var(i)=.false.
5678 END DO
5679!
5680! Scan variable list from input NetCDF and activate switches for
5681! stations variables. Get variable IDs.
5682!
5683 DO i=1,n_var
5684 IF (trim(var_name(i)).eq.trim(vname(1,idtime))) THEN
5685 got_var(idtime)=.true.
5686 s(ng)%pioVar(idtime)%vd=var_desc(i)
5687 s(ng)%pioVar(idtime)%dkind=pio_tout
5688 s(ng)%pioVar(idtime)%gtype=0
5689# ifdef WAVES_UB
5690 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idworb))) THEN
5691 got_var(idworb)=.true.
5692 s(ng)%pioVar(idworb)%vd=var_desc(i)
5693 s(ng)%pioVar(idworb)%dkind=pio_fout
5694 s(ng)%pioVar(idworb)%gtype=0
5695# endif
5696# ifdef BBL_MODEL
5697 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubrs))) THEN
5698 got_var(idubrs)=.true.
5699 s(ng)%pioVar(idubrs)%vd=var_desc(i)
5700 s(ng)%pioVar(idubrs)%dkind=pio_fout
5701 s(ng)%pioVar(idubrs)%gtype=0
5702 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbrs))) THEN
5703 got_var(idvbrs)=.true.
5704 s(ng)%pioVar(idvbrs)%vd=var_desc(i)
5705 s(ng)%pioVar(idvbrs)%dkind=pio_fout
5706 s(ng)%pioVar(idvbrs)%gtype=0
5707 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubws))) THEN
5708 got_var(idubws)=.true.
5709 s(ng)%pioVar(idubws)%vd=var_desc(i)
5710 s(ng)%pioVar(idubws)%dkind=pio_fout
5711 s(ng)%pioVar(idubws)%gtype=0
5712 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbws))) THEN
5713 got_var(idvbws)=.true.
5714 s(ng)%pioVar(idvbws)%vd=var_desc(i)
5715 s(ng)%pioVar(idvbws)%dkind=pio_fout
5716 s(ng)%pioVar(idvbws)%gtype=0
5717 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubcs))) THEN
5718 got_var(idubcs)=.true.
5719 s(ng)%pioVar(idubcs)%vd=var_desc(i)
5720 s(ng)%pioVar(idubcs)%dkind=pio_fout
5721 s(ng)%pioVar(idubcs)%gtype=0
5722 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbcs))) THEN
5723 got_var(idvbcs)=.true.
5724 s(ng)%pioVar(idvbcs)%vd=var_desc(i)
5725 s(ng)%pioVar(idvbcs)%dkind=pio_fout
5726 s(ng)%pioVar(idvbcs)%gtype=0
5727 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubot))) THEN
5728 got_var(idubot)=.true.
5729 s(ng)%pioVar(idubot)%vd=var_desc(i)
5730 s(ng)%pioVar(idubot)%dkind=pio_fout
5731 s(ng)%pioVar(idubot)%gtype=0
5732 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbot))) THEN
5733 got_var(idvbot)=.true.
5734 s(ng)%pioVar(idvbot)%vd=var_desc(i)
5735 s(ng)%pioVar(idvbot)%dkind=pio_fout
5736 s(ng)%pioVar(idvbot)%gtype=0
5737 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idubur))) THEN
5738 got_var(idubur)=.true.
5739 s(ng)%pioVar(idubur)%vd=var_desc(i)
5740 s(ng)%pioVar(idubur)%dkind=pio_fout
5741 s(ng)%pioVar(idubur)%gtype=0
5742 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idvbvr))) THEN
5743 got_var(idvbvr)=.true.
5744 s(ng)%pioVar(idvbvr)%vd=var_desc(i)
5745 s(ng)%pioVar(idvbvr)%dkind=pio_fout
5746 s(ng)%pioVar(idvbvr)%gtype=0
5747# endif
5748# ifdef WAVES_HEIGHT
5749 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwamp))) THEN
5750 got_var(idwamp)=.true.
5751 s(ng)%pioVar(idwamp)%vd=var_desc(i)
5752 s(ng)%pioVar(idwamp)%dkind=pio_fout
5753 s(ng)%pioVar(idwamp)%gtype=0
5754# endif
5755# ifdef WAVES_LENGTH
5756 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwlen))) THEN
5757 got_var(idwlen)=.true.
5758 s(ng)%pioVar(idwlen)%vd=var_desc(i)
5759 s(ng)%pioVar(idwlen)%dkind=pio_fout
5760 s(ng)%pioVar(idwlen)%gtype=0
5761# endif
5762# ifdef WAVES_LENGTHP
5763 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwlep))) THEN
5764 got_var(idwlep)=.true.
5765 s(ng)%pioVar(idwlep)%vd=var_desc(i)
5766 s(ng)%pioVar(idwlep)%dkind=pio_fout
5767 s(ng)%pioVar(idwlep)%gtype=0
5768# endif
5769# ifdef WAVES_DIR
5770 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwdir))) THEN
5771 got_var(idwdir)=.true.
5772 s(ng)%pioVar(idwdir)%vd=var_desc(i)
5773 s(ng)%pioVar(idwdir)%dkind=pio_fout
5774 s(ng)%pioVar(idwdir)%gtype=0
5775# endif
5776# ifdef WAVES_DIRP
5777 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwdip))) THEN
5778 got_var(idwdip)=.true.
5779 s(ng)%pioVar(idwdip)%vd=var_desc(i)
5780 s(ng)%pioVar(idwdip)%dkind=pio_fout
5781 s(ng)%pioVar(idwdip)%gtype=0
5782# endif
5783# ifdef WAVES_TOP_PERIOD
5784 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwptp))) THEN
5785 got_var(idwptp)=.true.
5786 s(ng)%pioVar(idwptp)%vd=var_desc(i)
5787 s(ng)%pioVar(idwptp)%dkind=pio_fout
5788 s(ng)%pioVar(idwptp)%gtype=0
5789# endif
5790# ifdef WAVES_BOT_PERIOD
5791 ELSE IF (trim(var_name(i)).eq.trim(vname(1,idwpbt))) THEN
5792 got_var(idwpbt)=.true.
5793 s(ng)%pioVar(idwpbt)%vd=var_desc(i)
5794 s(ng)%pioVar(idwpbt)%dkind=pio_fout
5795 s(ng)%pioVar(idwpbt)%gtype=0
5796# endif
5797 END IF
5798 END DO
5799!
5800! Check if station variables are available in input NetCDF file.
5801!
5802# ifdef BBL_MODEL
5803 IF (.not.got_var(idubrs).and.varout(idubrs,ng)) THEN
5804 IF (master) WRITE (stdout,10) trim(vname(1,idubrs)), &
5805 & trim(ncname)
5806 exit_flag=3
5807 RETURN
5808 END IF
5809 IF (.not.got_var(idvbrs).and.varout(idvbrs,ng)) THEN
5810 IF (master) WRITE (stdout,10) trim(vname(1,idvbrs)), &
5811 & trim(ncname)
5812 exit_flag=3
5813 RETURN
5814 END IF
5815 IF (.not.got_var(idubws).and.varout(idubws,ng)) THEN
5816 IF (master) WRITE (stdout,10) trim(vname(1,idubws)), &
5817 & trim(ncname)
5818 exit_flag=3
5819 RETURN
5820 END IF
5821 IF (.not.got_var(idvbws).and.varout(idvbws,ng)) THEN
5822 IF (master) WRITE (stdout,10) trim(vname(1,idvbws)), &
5823 & trim(ncname)
5824 exit_flag=3
5825 RETURN
5826 END IF
5827 IF (.not.got_var(idubcs).and.varout(idubcs,ng)) THEN
5828 IF (master) WRITE (stdout,10) trim(vname(1,idubcs)), &
5829 & trim(ncname)
5830 exit_flag=3
5831 RETURN
5832 END IF
5833 IF (.not.got_var(idvbcs).and.varout(idvbcs,ng)) THEN
5834 IF (master) WRITE (stdout,10) trim(vname(1,idvbcs)), &
5835 & trim(ncname)
5836 exit_flag=3
5837 RETURN
5838 END IF
5839 IF (.not.got_var(idubot).and.varout(idubot,ng)) THEN
5840 IF (master) WRITE (stdout,10) trim(vname(1,idubot)), &
5841 & trim(ncname)
5842 exit_flag=3
5843 RETURN
5844 END IF
5845 IF (.not.got_var(idvbot).and.varout(idvbot,ng)) THEN
5846 IF (master) WRITE (stdout,10) trim(vname(1,idvbot)), &
5847 & trim(ncname)
5848 exit_flag=3
5849 RETURN
5850 END IF
5851 IF (.not.got_var(idubur).and.varout(idubur,ng)) THEN
5852 IF (master) WRITE (stdout,10) trim(vname(1,idubur)), &
5853 & trim(ncname)
5854 exit_flag=3
5855 RETURN
5856 END IF
5857 IF (.not.got_var(idvbvr).and.varout(idvbvr,ng)) THEN
5858 IF (master) WRITE (stdout,10) trim(vname(1,idvbvr)), &
5859 & trim(ncname)
5860 exit_flag=3
5861 RETURN
5862 END IF
5863# endif
5864# ifdef WAVES_UB
5865 IF (.not.got_var(idworb).and.varout(idworb,ng)) THEN
5866 IF (master) WRITE (stdout,10) trim(vname(1,idworb)), &
5867 & trim(ncname)
5868 exit_flag=3
5869 RETURN
5870 END IF
5871# endif
5872# ifdef WAVES_HEIGHT
5873 IF (.not.got_var(idwamp).and.varout(idwamp,ng)) THEN
5874 IF (master) WRITE (stdout,10) trim(vname(1,idwamp)), &
5875 & trim(ncname)
5876 exit_flag=3
5877 RETURN
5878 END IF
5879# endif
5880# ifdef WAVES_LENGTH
5881 IF (.not.got_var(idwlen).and.varout(idwlen,ng)) THEN
5882 IF (master) WRITE (stdout,10) trim(vname(1,idwlen)), &
5883 & trim(ncname)
5884 exit_flag=3
5885 RETURN
5886 END IF
5887# endif
5888# ifdef WAVES_LENGTHP
5889 IF (.not.got_var(idwlep).and.varout(idwlep,ng)) THEN
5890 IF (master) WRITE (stdout,10) trim(vname(1,idwlep)), &
5891 & trim(ncname)
5892 exit_flag=3
5893 RETURN
5894 END IF
5895# endif
5896# ifdef WAVES_DIR
5897 IF (.not.got_var(idwdir).and.varout(idwdir,ng)) THEN
5898 IF (master) WRITE (stdout,10) trim(vname(1,idwdir)), &
5899 & trim(ncname)
5900 exit_flag=3
5901 RETURN
5902 END IF
5903# endif
5904# ifdef WAVES_DIRP
5905 IF (.not.got_var(idwdip).and.varout(idwdip,ng)) THEN
5906 IF (master) WRITE (stdout,10) trim(vname(1,idwdip)), &
5907 & trim(ncname)
5908 exit_flag=3
5909 RETURN
5910 END IF
5911# endif
5912# ifdef WAVES_TOP_PERIOD
5913 IF (.not.got_var(idwptp).and.varout(idwptp,ng)) THEN
5914 IF (master) WRITE (stdout,10) trim(vname(1,idwptp)), &
5915 & trim(ncname)
5916 exit_flag=3
5917 RETURN
5918 END IF
5919# endif
5920# ifdef WAVES_BOT_PERIOD
5921 IF (.not.got_var(idwpbt).and.varout(idwpbt,ng)) THEN
5922 IF (master) WRITE (stdout,10) trim(vname(1,idwpbt)), &
5923 & trim(ncname)
5924 exit_flag=3
5925 RETURN
5926 END IF
5927# endif
5928# ifdef WAVES_DSPR
5929 IF (.not.got_var(idwvds).and.varout(idwvds,ng)) THEN
5930 IF (master) WRITE (stdout,10) trim(vname(1,idwvds)), &
5931 & trim(ncname)
5932 exit_flag=3
5933 RETURN
5934 END IF
5935 IF (.not.got_var(idwvqp).and.varout(idwvqp,ng)) THEN
5936 IF (master) WRITE (stdout,10) trim(vname(1,idwvqp)), &
5937 & trim(ncname)
5938 exit_flag=3
5939 RETURN
5940 END IF
5941# endif
5942!
5943 10 FORMAT (/,' BBL_DEF_STATION_PIO - unable to find variable: ', &
5944 & a,2x,' in stations NetCDF file: ',a)
5945!
5946 RETURN
5947 END SUBROUTINE bbl_def_station_pio
5948!
5949!***********************************************************************
5950 SUBROUTINE bbl_wrt_station_pio (ng, model, tile, &
5951 & LBi, UBi, LBj, UBj, &
5952 & VarOut, S)
5953!***********************************************************************
5954!
5955 USE mod_pio_netcdf
5956!
5957! Imported variable declarations.
5958!
5959 logical, intent(in) :: varout(nv,ngrids)
5960!
5961 integer, intent(in) :: ng, model, tile
5962 integer, intent(in) :: lbi, ubi, lbj, ubj
5963!
5964 TYPE(t_io), intent(inout) :: s(ngrids)
5965!
5966! Local variable declarations.
5967!
5968 logical :: cgrid
5969!
5970 integer :: nposr, nposw
5971 integer :: i, k, np, status
5972!
5973 real(dp) :: scale
5974!
5975 real(r8), dimension(Nstation(ng)) :: xpos, ypos, zpos, psta
5976# ifdef SOLVE3D
5977 real(r8), dimension(Nstation(ng)*(N(ng))) :: xposr, yposr, zposr
5978 real(r8), dimension(Nstation(ng)*(N(ng)+1)) :: rsta
5979# endif
5980!
5981 character (len=*), parameter :: myfile = &
5982 & __FILE__//", bbl_wrt_station_pio"
5983!
5984 sourcefile=myfile
5985!
5986!-----------------------------------------------------------------------
5987! Write out sediment output variables into specified stations NetCDF
5988! file.
5989!-----------------------------------------------------------------------
5990!
5991 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5992!
5993! Set switch to extract station data at native C-grid position (TRUE)
5994! or at RHO-points (FALSE).
5995!
5996# ifdef STATIONS_CGRID
5997 cgrid=.true.
5998# else
5999 cgrid=.false.
6000# endif
6001!
6002! Set positions for generic extraction routine.
6003!
6004 nposr=nstation(ng)*n(ng)
6005 nposw=nstation(ng)*(n(ng)+1)
6006 DO i=1,nstation(ng)
6007 xpos(i)=scalars(ng)%SposX(i)
6008 ypos(i)=scalars(ng)%SposY(i)
6009 zpos(i)=1.0_r8
6010# ifdef SOLVE3D
6011 DO k=1,n(ng)
6012 np=k+(i-1)*n(ng)
6013 xposr(np)=scalars(ng)%SposX(i)
6014 yposr(np)=scalars(ng)%SposY(i)
6015 zposr(np)=real(k,r8)
6016 END DO
6017# endif
6018 END DO
6019!
6020# ifdef WAVES_UB
6021!
6022! Write out wind-induced wave bottom orbital velocity.
6023!
6024 IF (varout(idworb,ng)) THEN
6025 scale=rad2deg
6026 CALL extract_sta2d (ng, model, cgrid, idworb, r2dvar, &
6027 & lbi, ubi, lbj, ubj, &
6028 & scale, forces(ng) % Ub_swan, &
6029 & nstation(ng), xpos, ypos, psta)
6030 CALL pio_netcdf_put_fvar (ng, model, s(ng)%name, &
6031 & trim(vname(1,idworb)), psta, &
6032 & (/1,s(ng)%Rindex/), &
6033 & (/nstation(ng),1/), &
6034 & piofile = s(ng)%pioFile, &
6035 & piovar = s(ng)%pioVar(idworb)%vd)
6036 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6037 END IF
6038# endif
6039
6040# ifdef BBL_MODEL
6041!
6042! Write out current-induced, bottom U-stress.
6043!
6044 IF (varout(idubrs,ng)) THEN
6045 scale=-rho0
6046 CALL extract_sta2d (ng, model, cgrid, idubrs, r2dvar, &
6047 & lbi, ubi, lbj, ubj, &
6048 & scale, bbl(ng)%bustrc, &
6049 & nstation(ng), xpos, ypos, psta)
6050 CALL pio_netcdf_put_fvar (ng, model, s(ng)%name, &
6051 & trim(vname(1,idubrs)), psta, &
6052 & (/1,s(ng)%Rindex/), &
6053 & (/nstation(ng),1/), &
6054 & piofile = s(ng)%pioFile, &
6055 & piovar = s(ng)%pioVar(idubrs)%vd)
6056 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6057 END IF
6058!
6059! Write out current-induced, bottom V-stress.
6060!
6061 IF (varout(idvbrs,ng)) THEN
6062 scale=-rho0
6063 CALL extract_sta2d (ng, model, cgrid, idvbrs, r2dvar, &
6064 & lbi, ubi, lbj, ubj, &
6065 & scale, bbl(ng)%bvstrc, &
6066 & nstation(ng), xpos, ypos, psta)
6067 CALL pio_netcdf_put_fvar (ng, model, s(ng)%name, &
6068 & trim(vname(1,idvbrs)), psta, &
6069 & (/1,s(ng)%Rindex/), &
6070 & (/nstation(ng),1/), &
6071 & piofile = s(ng)%pioFile, &
6072 & piovar = s(ng)%pioVar(idvbrs)%vd)
6073 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6074 END IF
6075!
6076! Write out wind-induced, bottom U-stress.
6077!
6078 IF (varout(idubws,ng)) THEN
6079 scale=rho0
6080 CALL extract_sta2d (ng, model, cgrid, idubws, r2dvar, &
6081 & lbi, ubi, lbj, ubj, &
6082 & scale, bbl(ng)%bustrw, &
6083 & nstation(ng), xpos, ypos, psta)
6084 CALL pio_netcdf_put_fvar (ng, model, s(ng)%name, &
6085 & trim(vname(1,idubws)), psta, &
6086 & (/1,s(ng)%Rindex/), &
6087 & (/nstation(ng),1/), &
6088 & piofile = s(ng)%pioFile, &
6089 & piovar = s(ng)%pioVar(idubws)%vd)
6090 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6091 END IF
6092!
6093! Write out wind-induced, bottom V-wave stress.
6094!
6095 IF (varout(idvbws,ng)) THEN
6096 scale=rho0
6097 CALL extract_sta2d (ng, model, cgrid, idvbws, r2dvar, &
6098 & lbi, ubi, lbj, ubj, &
6099 & scale, bbl(ng)%bvstrw, &
6100 & nstation(ng), xpos, ypos, psta)
6101 CALL pio_netcdf_put_fvar (ng, model, s(ng)%name, &
6102 & trim(vname(1,idvbws)), psta, &
6103 & (/1,s(ng)%Rindex/), &
6104 & (/nstation(ng),1/), &
6105 & piofile = s(ng)%pioFile, &
6106 & piovar = s(ng)%pioVar(idvbws)%vd)
6107 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6108 END IF
6109!
6110! Write out maximum wind and current, bottom U-stress.
6111!
6112 IF (varout(idubcs,ng)) THEN
6113 scale=rho0
6114 CALL extract_sta2d (ng, model, cgrid, idubcs, r2dvar, &
6115 & lbi, ubi, lbj, ubj, &
6116 & scale, bbl(ng)%bustrcwmax, &
6117 & nstation(ng), xpos, ypos, psta)
6118 CALL pio_netcdf_put_fvar (ng, model, s(ng)%name, &
6119 & trim(vname(1,idubcs)), psta, &
6120 & (/1,s(ng)%Rindex/), &
6121 & (/nstation(ng),1/), &
6122 & piofile = s(ng)%pioFile, &
6123 & piovar = s(ng)%pioVar(idubcs)%vd)
6124 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6125 END IF
6126!
6127! Write out maximum wind and current, bottom V-stress.
6128!
6129 IF (varout(idvbcs,ng)) THEN
6130 scale=rho0
6131 CALL extract_sta2d (ng, model, cgrid, idvbcs, r2dvar, &
6132 & lbi, ubi, lbj, ubj, &
6133 & scale, bbl(ng)%bvstrcwmax, &
6134 & nstation(ng), xpos, ypos, psta)
6135 CALL pio_netcdf_put_fvar (ng, model, s(ng)%name, &
6136 & trim(vname(1,idvbcs)), psta, &
6137 & (/1,s(ng)%Rindex/), &
6138 & (/nstation(ng),1/), &
6139 & piofile = s(ng)%pioFile, &
6140 & piovar = s(ng)%pioVar(idvbcs)%vd)
6141 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6142 END IF
6143!
6144! Write out wind-induced, bed wave orbital U-velocity.
6145!
6146 IF (varout(idubot,ng)) THEN
6147 scale=1.0_dp
6148 CALL extract_sta2d (ng, model, cgrid, idubot, r2dvar, &
6149 & lbi, ubi, lbj, ubj, &
6150 & scale, bbl(ng)%Ubot, &
6151 & nstation(ng), xpos, ypos, psta)
6152 CALL pio_netcdf_put_fvar (ng, model, s(ng)%name, &
6153 & trim(vname(1,idubot)), psta, &
6154 & (/1,s(ng)%Rindex/), &
6155 & (/nstation(ng),1/), &
6156 & piofile = s(ng)%pioFile, &
6157 & piovar = s(ng)%pioVar(idubot)%vd)
6158 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6159 END IF
6160!
6161! Write out wind-induced, bed wave orbital V-velocity.
6162!
6163 IF (varout(idvbot,ng)) THEN
6164 scale=1.0_dp
6165 CALL extract_sta2d (ng, model, cgrid, idvbot, r2dvar, &
6166 & lbi, ubi, lbj, ubj, &
6167 & scale, bbl(ng)%Vbot, &
6168 & nstation(ng), xpos, ypos, psta)
6169 CALL pio_netcdf_put_fvar (ng, model, s(ng)%name, &
6170 & trim(vname(1,idvbot)), psta, &
6171 & (/1,s(ng)%Rindex/), &
6172 & (/nstation(ng),1/), &
6173 & piofile = s(ng)%pioFile, &
6174 & piovar = s(ng)%pioVar(idvbot)%vd)
6175 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6176 END IF
6177!
6178! Write out bottom U-velocity above bed.
6179!
6180 IF (varout(idubur,ng)) THEN
6181 scale=1.0_dp
6182 CALL extract_sta2d (ng, model, cgrid, idubur, r2dvar, &
6183 & lbi, ubi, lbj, ubj, &
6184 & scale, bbl(ng)%Ur, &
6185 & nstation(ng), xpos, ypos, psta)
6186 CALL pio_netcdf_put_fvar (ng, model, s(ng)%name, &
6187 & trim(vname(1,idubur)), psta, &
6188 & (/1,s(ng)%Rindex/), &
6189 & (/nstation(ng),1/), &
6190 & piofile = s(ng)%pioFile, &
6191 & piovar = s(ng)%pioVar(idubur)%vd)
6192 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6193 END IF
6194!
6195! Write out bottom V-velocity above bed.
6196!
6197 IF (varout(idvbvr,ng)) THEN
6198 scale=1.0_dp
6199 CALL extract_sta2d (ng, model, cgrid, idvbvr, r2dvar, &
6200 & lbi, ubi, lbj, ubj, &
6201 & scale, bbl(ng)%Vr, &
6202 & nstation(ng), xpos, ypos, psta)
6203 CALL pio_netcdf_put_fvar (ng, model, s(ng)%name, &
6204 & trim(vname(1,idvbvr)), psta, &
6205 & (/1,s(ng)%Rindex/), &
6206 & (/nstation(ng),1/), &
6207 & piofile = s(ng)%pioFile, &
6208 & piovar = s(ng)%pioVar(idvbvr)%vd)
6209 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6210 END IF
6211# endif
6212
6213# ifdef WAVES_HEIGHT
6214!
6215! Write out wind-induced significant wave height.
6216!
6217 IF (varout(idwamp,ng)) THEN
6218 scale=1.0_dp
6219 CALL extract_sta2d (ng, model, cgrid, idwamp, r2dvar, &
6220 & lbi, ubi, lbj, ubj, &
6221 & scale, forces(ng) % Hwave, &
6222 & nstation(ng), xpos, ypos, psta)
6223 CALL pio_netcdf_put_fvar (ng, model, s(ng)%name, &
6224 & trim(vname(1,idwamp)), psta, &
6225 & (/1,s(ng)%Rindex/), &
6226 & (/nstation(ng),1/), &
6227 & piofile = s(ng)%pioFile, &
6228 & piovar = s(ng)%pioVar(idwamp)%vd)
6229 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6230 END IF
6231# endif
6232
6233# ifdef WAVES_LENGTH
6234!
6235! Write out wind-induced mean wavelenght.
6236!
6237 IF (varout(idwlen,ng)) THEN
6238 scale=1.0_dp
6239 CALL extract_sta2d (ng, model, cgrid, idwlen, r2dvar, &
6240 & lbi, ubi, lbj, ubj, &
6241 & scale, forces(ng) % Lwave, &
6242 & nstation(ng), xpos, ypos, psta)
6243 CALL pio_netcdf_put_fvar (ng, model, s(ng)%name, &
6244 & trim(vname(1,idwlen)), psta, &
6245 & (/1,s(ng)%Rindex/), &
6246 & (/nstation(ng),1/), &
6247 & piofile = s(ng)%pioFile, &
6248 & piovar = s(ng)%pioVar(idwlen)%vd)
6249 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6250 END IF
6251# endif
6252
6253# ifdef WAVES_LENGTHP
6254!
6255! Write out wind-induced peak wave wavelength.
6256!
6257 IF (varout(idwlep,ng)) THEN
6258 scale=1.0_dp
6259 CALL extract_sta2d (ng, model, cgrid, idwlep, r2dvar, &
6260 & lbi, ubi, lbj, ubj, &
6261 & scale, forces(ng) % Lwavep, &
6262 & nstation(ng), xpos, ypos, psta)
6263 CALL pio_netcdf_put_fvar (ng, model, s(ng)%name, &
6264 & trim(vname(1,idwlep)), psta, &
6265 & (/1,s(ng)%Rindex/), &
6266 & (/nstation(ng),1/), &
6267 & piofile = s(ng)%pioFile, &
6268 & piovar = s(ng)%pioVar(idwlep)%vd)
6269 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6270 END IF
6271# endif
6272
6273# ifdef WAVES_DIR
6274!
6275! Write out wind-induced mean wave direction.
6276!
6277 IF (varout(idwdir,ng)) THEN
6278 scale=rad2deg
6279 CALL extract_sta2d (ng, model, cgrid, idwdir, r2dvar, &
6280 & lbi, ubi, lbj, ubj, &
6281 & scale, forces(ng) % Dwave, &
6282 & nstation(ng), xpos, ypos, psta)
6283 CALL pio_netcdf_put_fvar (ng, model, s(ng)%name, &
6284 & trim(vname(1,idwdir)), psta, &
6285 & (/1,s(ng)%Rindex/), &
6286 & (/nstation(ng),1/), &
6287 & piofile = s(ng)%pioFile, &
6288 & piovar = s(ng)%pioVar(idwdir)%vd)
6289 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6290 END IF
6291# endif
6292
6293# ifdef WAVES_DIRP
6294!
6295! Write out wind-induced peak wave direction.
6296!
6297 IF (varout(idwdip,ng)) THEN
6298 scale=rad2deg
6299 CALL extract_sta2d (ng, model, cgrid, idwdip, r2dvar, &
6300 & lbi, ubi, lbj, ubj, &
6301 & scale, forces(ng) % Dwavep, &
6302 & nstation(ng), xpos, ypos, psta)
6303 CALL pio_netcdf_put_fvar (ng, model, s(ng)%name, &
6304 & trim(vname(1,idwdip)), psta, &
6305 & (/1,s(ng)%Rindex/), &
6306 & (/nstation(ng),1/), &
6307 & piofile = s(ng)%pioFile, &
6308 & piovar = s(ng)%pioVar(idwdip)%vd)
6309 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6310 END IF
6311# endif
6312
6313# ifdef WAVES_TOP_PERIOD
6314!
6315! Write out wind-induced surface wave period.
6316!
6317 IF (varout(idwptp,ng)) THEN
6318 scale=rad2deg
6319 CALL extract_sta2d (ng, model, cgrid, idwptp, r2dvar, &
6320 & lbi, ubi, lbj, ubj, &
6321 & scale, forces(ng) % Pwave_top, &
6322 & nstation(ng), xpos, ypos, psta)
6323 CALL pio_netcdf_put_fvar (ng, model, s(ng)%name, &
6324 & trim(vname(1,idwptp)), psta, &
6325 & (/1,s(ng)%Rindex/), &
6326 & (/nstation(ng),1/), &
6327 & piofile = s(ng)%pioFile, &
6328 & piovar = s(ng)%pioVar(idwptp)%vd)
6329 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6330 END IF
6331# endif
6332
6333# ifdef WAVES_BOT_PERIOD
6334!
6335! Write out wind-induced bottom wave period.
6336!
6337 IF (varout(idwpbt,ng)) THEN
6338 scale=rad2deg
6339 CALL extract_sta2d (ng, model, cgrid, idwpbt, r2dvar, &
6340 & lbi, ubi, lbj, ubj, &
6341 & scale, forces(ng) % Pwave_bot, &
6342 & nstation(ng), xpos, ypos, psta)
6343 CALL pio_netcdf_put_fvar (ng, model, s(ng)%name, &
6344 & trim(vname(1,idwpbt)), psta, &
6345 & (/1,s(ng)%Rindex/), &
6346 & (/nstation(ng),1/), &
6347 & piofile = s(ng)%pioFile, &
6348 & piovar = s(ng)%pioVar(idwpbt)%vd)
6349 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6350 END IF
6351# endif
6352
6353# if defined WAVES_DSPR
6354!
6355! Write out waves directional spreading.
6356!
6357 IF (varout(idwvds,ng)) THEN
6358 scale=1.0_dp
6359 CALL extract_sta2d (ng, model, cgrid, idwvds, r2dvar, &
6360 & lbi, ubi, lbj, ubj, &
6361 & scale, forces(ng) % Wave_ds, &
6362 & nstation(ng), xpos, ypos, psta)
6363 CALL pio_netcdf_put_fvar (ng, model, s(ng)%name, &
6364 & trim(vname(1,idwvds)), psta, &
6365 & (/1,s(ng)%Rindex/), &
6366 & (/nstation(ng),1/), &
6367 & piofile = s(ng)%pioFile, &
6368 & piovar = s(ng)%pioVar(idwvds)%vd)
6369 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6370 END IF
6371!
6372! Write out wave spectrum peakedness.
6373!
6374 IF (varout(idwvqp,ng)) THEN
6375 scale=1.0_dp
6376 CALL extract_sta2d (ng, model, cgrid, idwvqp, r2dvar, &
6377 & lbi, ubi, lbj, ubj, &
6378 & scale, forces(ng) % Wave_qp, &
6379 & nstation(ng), xpos, ypos, psta)
6380 CALL pio_netcdf_put_fvar (ng, model, s(ng)%name, &
6381 & trim(vname(1,idwvqp)), psta, &
6382 & (/1,s(ng)%Rindex/), &
6383 & (/nstation(ng),1/), &
6384 & piofile = s(ng)%pioFile, &
6385 & piovar = s(ng)%pioVar(idwvqp)%vd)
6386 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6387 END IF
6388# endif
6389!
6390 RETURN
6391 END SUBROUTINE bbl_wrt_station_pio
6392# endif
6393# endif
6394#endif
6395!
6396 END MODULE bbl_output_mod
def_var_mod::def_var
Definition def_var.F:88
mod_netcdf::netcdf_put_fvar
Definition mod_netcdf.F:82
mod_pio_netcdf::pio_netcdf_put_fvar
Definition mod_pio_netcdf.F:94
nf_fwrite2d_mod::nf_fwrite2d
Definition nf_fwrite2d.F:77
nf_fwrite3d_mod::nf_fwrite3d
Definition nf_fwrite3d.F:78
bbl_output_mod
Definition bbl_output.F:2
bbl_output_mod::bbl_wrt_station_pio
subroutine, public bbl_wrt_station_pio(ng, model, tile, lbi, ubi, lbj, ubj, varout, s)
Definition bbl_output.F:5953
bbl_output_mod::bbl_def_station_pio
subroutine, public bbl_def_station_pio(ng, model, ldef, varout, s, pgrd, rgrd)
Definition bbl_output.F:5204
bbl_output_mod::bbl_def_station_nf90
subroutine, public bbl_def_station_nf90(ng, model, ldef, varout, s, pgrd, rgrd)
Definition bbl_output.F:1053
bbl_output_mod::bbl_wrt_station_nf90
subroutine, public bbl_wrt_station_nf90(ng, model, tile, lbi, ubi, lbj, ubj, varout, s)
Definition bbl_output.F:2621
bbl_output_mod::bbl_wrt_pio
subroutine, public bbl_wrt_pio(ng, model, tile, lbi, ubi, lbj, ubj, varout, s)
Definition bbl_output.F:4157
bbl_output_mod::bbl_wrt_nf90
subroutine, public bbl_wrt_nf90(ng, model, tile, lbi, ubi, lbj, ubj, varout, s)
Definition bbl_output.F:1702
bbl_output_mod::bbl_def_nf90
subroutine, public bbl_def_nf90(ng, model, ldef, varout, s, t2dgrd, u2dgrd, v2dgrd)
Definition bbl_output.F:83
bbl_output_mod::bbl_def_pio
subroutine, public bbl_def_pio(ng, model, ldef, varout, s, t2dgrd, u2dgrd, v2dgrd)
Definition bbl_output.F:3047
def_var_mod
Definition def_var.F:2
extract_sta_mod
Definition extract_sta.F:2
extract_sta_mod::extract_sta2d
subroutine extract_sta2d(ng, model, cgrid, ifield, gtype, lbi, ubi, lbj, ubj, ascl, a, npos, xpos, ypos, apos)
Definition extract_sta.F:65
extract_sta_mod::extract_sta3d
subroutine extract_sta3d(ng, model, cgrid, ifield, gtype, lbi, ubi, lbj, ubj, lbk, ubk, ascl, a, npos, xpos, ypos, zpos, apos)
Definition extract_sta.F:335
mod_average
Definition mod_average.F:2
mod_average::average
type(t_average), dimension(:), allocatable average
Definition mod_average.F:351
mod_bbl
Definition mod_bbl.F:2
mod_bbl::bbl
type(t_bbl), dimension(:), allocatable bbl
Definition mod_bbl.F:62
mod_forces
Definition mod_forces.F:2
mod_forces::forces
type(t_forces), dimension(:), allocatable forces
Definition mod_forces.F:554
mod_grid
Definition mod_grid.F:2
mod_grid::grid
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
mod_iounits
Definition mod_iounits.F:2
mod_iounits::ioerror
integer ioerror
Definition mod_iounits.F:313
mod_iounits::qck
type(t_io), dimension(:), allocatable qck
Definition mod_iounits.F:237
mod_iounits::avg
type(t_io), dimension(:), allocatable avg
Definition mod_iounits.F:202
mod_iounits::stdout
integer stdout
Definition mod_iounits.F:195
mod_iounits::sourcefile
character(len=256) sourcefile
Definition mod_iounits.F:317
mod_mixing
Definition mod_mixing.F:2
mod_ncparam
Definition mod_ncparam.F:2
mod_ncparam::idvbrs
integer idvbrs
Definition mod_ncparam.F:367
mod_ncparam::iduvwc
integer iduvwc
Definition mod_ncparam.F:344
mod_ncparam::idubur
integer idubur
Definition mod_ncparam.F:334
mod_ncparam::nv
integer, parameter nv
Definition mod_ncparam.F:105
mod_ncparam::idwlen
integer idwlen
Definition mod_ncparam.F:412
mod_ncparam::idvbvr
integer idvbvr
Definition mod_ncparam.F:369
mod_ncparam::idwlep
integer idwlep
Definition mod_ncparam.F:413
mod_ncparam::idvbot
integer idvbot
Definition mod_ncparam.F:366
mod_ncparam::idvbws
integer idvbws
Definition mod_ncparam.F:370
mod_ncparam::iduwav
integer iduwav
Definition mod_ncparam.F:345
mod_ncparam::idwam2
integer idwam2
Definition mod_ncparam.F:403
mod_ncparam::vname
character(len=maxlen), dimension(6, 0:nv) vname
Definition mod_ncparam.F:591
mod_ncparam::idtime
integer idtime
Definition mod_ncparam.F:307
mod_ncparam::iinfo
integer, dimension(:,:,:), allocatable iinfo
Definition mod_ncparam.F:578
mod_ncparam::idwdip
integer idwdip
Definition mod_ncparam.F:408
mod_ncparam::idvbcs
integer idvbcs
Definition mod_ncparam.F:363
mod_ncparam::idwamp
integer idwamp
Definition mod_ncparam.F:402
mod_ncparam::idwdir
integer idwdir
Definition mod_ncparam.F:409
mod_ncparam::idwptp
integer idwptp
Definition mod_ncparam.F:416
mod_ncparam::idubcs
integer idubcs
Definition mod_ncparam.F:328
mod_ncparam::idubot
integer idubot
Definition mod_ncparam.F:331
mod_ncparam::idubrs
integer idubrs
Definition mod_ncparam.F:332
mod_ncparam::idubws
integer idubws
Definition mod_ncparam.F:335
mod_ncparam::idwpbt
integer idwpbt
Definition mod_ncparam.F:417
mod_ncparam::idworb
integer idworb
Definition mod_ncparam.F:415
mod_ncparam::idvwav
integer idvwav
Definition mod_ncparam.F:383
mod_ncparam::idwvds
integer idwvds
Definition mod_ncparam.F:420
mod_ncparam::aout
logical, dimension(:,:), allocatable aout
Definition mod_ncparam.F:166
mod_ncparam::idwvqp
integer idwvqp
Definition mod_ncparam.F:422
mod_netcdf
Definition mod_netcdf.F:2
mod_netcdf::nf_fout
integer, parameter nf_fout
Definition mod_netcdf.F:188
mod_netcdf::var_name
character(len=100), dimension(mvars) var_name
Definition mod_netcdf.F:169
mod_netcdf::var_id
integer, dimension(mvars) var_id
Definition mod_netcdf.F:160
mod_netcdf::n_var
integer n_var
Definition mod_netcdf.F:152
mod_ocean
Definition mod_ocean.F:2
mod_parallel
Definition mod_parallel.F:2
mod_parallel::master
logical master
Definition mod_parallel.F:40
mod_param
Definition mod_param.F:2
mod_param::n
integer, dimension(:), allocatable n
Definition mod_param.F:479
mod_param::nstation
integer, dimension(:), allocatable nstation
Definition mod_param.F:557
mod_param::ngrids
integer ngrids
Definition mod_param.F:113
mod_param::r2dvar
integer, parameter r2dvar
Definition mod_param.F:717
mod_pio_netcdf
Definition mod_pio_netcdf.F:2
mod_pio_netcdf::pio_fout
integer, parameter pio_fout
Definition mod_pio_netcdf.F:569
mod_pio_netcdf::var_desc
type(var_desc_t), dimension(:), pointer var_desc
Definition mod_pio_netcdf.F:437
mod_pio_netcdf::iodesc_sp_r2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_r2dvar
Definition mod_pio_netcdf.F:194
mod_pio_netcdf::pio_tout
integer, parameter pio_tout
Definition mod_pio_netcdf.F:588
mod_pio_netcdf::iodesc_dp_r2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_r2dvar
Definition mod_pio_netcdf.F:233
mod_scalars
Definition mod_scalars.F:2
mod_scalars::exit_flag
integer exit_flag
Definition mod_scalars.F:559
mod_scalars::scalars
type(t_scalars), dimension(:), allocatable scalars
Definition mod_scalars.F:65
mod_scalars::rad2deg
real(dp), parameter rad2deg
Definition mod_scalars.F:815
mod_scalars::rho0
real(dp) rho0
Definition mod_scalars.F:787
mod_scalars::noerror
integer noerror
Definition mod_scalars.F:561
mod_sedbed
Definition sedbed_mod.h:1
mod_sediment
Definition sediment_mod.h:1
mod_stepping
Definition mod_stepping.F:2
nf_fwrite2d_mod
Definition nf_fwrite2d.F:2
nf_fwrite3d_mod
Definition nf_fwrite3d.F:2
omega_mod
Definition omega.F:2
omega_mod::scale_omega
subroutine, public scale_omega(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, pm, pn, w, wscl)
Definition omega.F:382
strings_mod
Definition strings.F:2
strings_mod::founderror
logical function, public founderror(flag, noerr, line, routine)
Definition strings.F:52
mod_iounits::t_io
Definition mod_iounits.F:164