Ticket #514: ana_wwave.h

File ana_wwave.h, 11.2 KB (added by abever, 13 years ago)

Working ana_wwave.h

Line 
1 SUBROUTINE ana_wwave (ng, tile, model)
2!
3!! svn $Id: ana_wwave.h 523 2011-01-05 03:21:38Z arango $
4!!======================================================================
5!! Copyright (c) 2002-2011 The ROMS/TOMS Group !
6!! Licensed under a MIT/X style license !
7!! See License_ROMS.txt !
8!=======================================================================
9! !
10! This subroutine sets wind induced wave amplitude, direction and !
11! period to be used in the bottom boundary layer formulation. !
12! !
13!=======================================================================
14!
15 USE mod_param
16 USE mod_forces
17 USE mod_grid
18 USE mod_ncparam
19!
20! Imported variable declarations.
21!
22 integer, intent(in) :: ng, tile, model
23
24#include "tile.h"
25!
26 CALL ana_wwave_tile (ng, tile, model, &
27 & LBi, UBi, LBj, UBj, &
28 & IminS, ImaxS, JminS, JmaxS, &
29#if defined BBL_MODEL || defined NEARSHORE_MELLOR
30 & FORCES(ng) % Dwave, &
31#endif
32#ifdef WAVES_HEIGHT
33 & FORCES(ng) % Hwave, &
34#endif
35#ifdef WAVES_LENGTH
36 & FORCES(ng) % Lwave, &
37#endif
38#ifdef WAVES_TOP_PERIOD
39 & FORCES(ng) % Pwave_top, &
40#endif
41#ifdef WAVES_BOT_PERIOD
42 & FORCES(ng) % Pwave_bot, &
43#endif
44#ifdef WAVES_UB
45 & FORCES(ng) % Ub_swan, &
46#endif
47#ifdef TKE_WAVEDISS
48 & FORCES(ng) % wave_dissip, &
49#endif
50 & GRID(ng) % angler, &
51 & GRID(ng) % h)
52!
53! Set analytical header file name used.
54!
55#ifdef DISTRIBUTE
56 IF (Lanafile) THEN
57#else
58 IF (Lanafile.and.(tile.eq.0)) THEN
59#endif
60 ANANAME(37)=__FILE__
61 END IF
62
63 RETURN
64 END SUBROUTINE ana_wwave
65!
66!***********************************************************************
67 SUBROUTINE ana_wwave_tile (ng, tile, model, &
68 & LBi, UBi, LBj, UBj, &
69 & IminS, ImaxS, JminS, JmaxS, &
70#if defined BBL_MODEL || defined NEARSHORE_MELLOR
71 & Dwave, &
72#endif
73#ifdef WAVES_HEIGHT
74 & Hwave, &
75#endif
76#ifdef WAVES_LENGTH
77 & Lwave, &
78#endif
79#ifdef WAVES_TOP_PERIOD
80 & Pwave_top, &
81#endif
82#ifdef WAVES_BOT_PERIOD
83 & Pwave_bot, &
84#endif
85#ifdef WAVES_UB
86 & Ub_swan, &
87#endif
88#ifdef TKE_WAVEDISS
89 & wave_dissip, &
90#endif
91 & angler, h)
92!***********************************************************************
93!
94 USE mod_param
95 USE mod_scalars
96!
97#if defined EW_PERIODIC || defined NS_PERIODIC
98 USE exchange_2d_mod, ONLY : exchange_r2d_tile
99#endif
100#ifdef DISTRIBUTE
101 USE mp_exchange_mod, ONLY : mp_exchange2d
102#endif
103!
104! Imported variable declarations.
105!
106 integer, intent(in) :: ng, tile, model
107 integer, intent(in) :: LBi, UBi, LBj, UBj
108 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
109!
110#ifdef ASSUMED_SHAPE
111 real(r8), intent(in) :: angler(LBi:,LBj:)
112 real(r8), intent(in) :: h(LBi:,LBj:)
113# if defined BBL_MODEL || defined NEARSHORE_MELLOR
114 real(r8), intent(inout) :: Dwave(LBi:,LBj:)
115# endif
116# ifdef WAVES_HEIGHT
117 real(r8), intent(inout) :: Hwave(LBi:,LBj:)
118# endif
119# ifdef WAVES_LENGTH
120 real(r8), intent(inout) :: Lwave(LBi:,LBj:)
121# endif
122# ifdef WAVES_TOP_PERIOD
123 real(r8), intent(inout) :: Pwave_top(LBi:,LBj:)
124# endif
125# ifdef WAVES_BOT_PERIOD
126 real(r8), intent(inout) :: Pwave_bot(LBi:,LBj:)
127# endif
128# ifdef WAVES_UB
129 real(r8), intent(inout) :: Ub_swan(LBi:,LBj:)
130# endif
131# ifdef TKE_WAVEDISS
132 real(r8), intent(inout) :: wave_dissip(LBi:,LBj:)
133# endif
134
135#else
136
137 real(r8), intent(in) :: angler(LBi:UBi,LBj:UBj)
138 real(r8), intent(in) :: h(LBi:UBi,LBj:UBj)
139# if defined BBL_MODEL || defined NEARSHORE_MELLOR
140 real(r8), intent(inout) :: Dwave(LBi:UBi,LBj:UBj)
141# endif
142# ifdef WAVES_HEIGHT
143 real(r8), intent(inout) :: Hwave(LBi:UBi,LBj:UBj)
144# endif
145# ifdef WAVES_LENGTH
146 real(r8), intent(inout) :: Lwave(LBi:UBi,LBj:UBj)
147# endif
148# ifdef WAVES_TOP_PERIOD
149 real(r8), intent(inout) :: Pwave_top(LBi:UBi,LBj:UBj)
150# endif
151# ifdef WAVES_BOT_PERIOD
152 real(r8), intent(inout) :: Pwave_bot(LBi:UBi,LBj:UBj)
153# endif
154# ifdef WAVES_UB
155 real(r8), intent(inout) :: Ub_swan(LBi:UBi,LBj:UBj)
156# endif
157# ifdef TKE_WAVEDISS
158 real(r8), intent(inout) :: wave_dissip(LBi:UBi,LBj:UBj)
159# endif
160#endif
161!
162! Local variable declarations.
163!
164#ifdef DISTRIBUTE
165# ifdef EW_PERIODIC
166 logical :: EWperiodic=.TRUE.
167# else
168 logical :: EWperiodic=.FALSE.
169# endif
170# ifdef NS_PERIODIC
171 logical :: NSperiodic=.TRUE.
172# else
173 logical :: NSperiodic=.FALSE.
174# endif
175#endif
176 integer :: i, j
177 real(r8) :: cff, wdir
178#if defined LAKE_SIGNELL
179 real(r8) :: cff1, mxst, ramp_u, ramp_time, ramp_d
180#endif
181
182#include "set_bounds.h"
183!
184!-----------------------------------------------------------------------
185! Set wind induced wave amplitude (m), direction (radians) and
186! period (s) at RHO-points.
187!-----------------------------------------------------------------------
188!
189#if defined BL_TEST
190 wdir=210.0_r8*deg2rad
191 DO j=JstrR,JendR
192 DO i=IstrR,IendR
193 Hwave(i,j)=0.5_r8
194 Dwave(i,j)=wdir
195 Pwave_bot(i,j)=8.0_r8
196 END DO
197 END DO
198#elif defined LAKE_SIGNELL
199 mxst=0.25_r8 ! Wave amplitude (1/2 wave height) (meters)
200 ramp_u=15.0_r8 ! start ramp UP at RAMP_UP (hours)
201 ramp_time=10.0_r8 ! ramp from 0 to 1 over RAMP_TIME (hours)
202 ramp_d=50.0_r8 ! start ramp DOWN at RAMP_DOWN (hours)
203 DO j=JstrR,JendR
204 DO i=IstrR,IendR
205 Dwave(i,j)=270.0_r8*deg2rad
206 Pwave_bot(i,j)=5.0_r8
207 cff1=MIN((0.5_r8*(TANH((time(ng)/3600.0_r8-ramp_u)/ &
208 & (ramp_time/5.0_r8))+1.0_r8)), &
209 & (1.0_r8-(0.5_r8*(TANH((time(ng)/3600.0_r8-ramp_d)/ &
210 & (ramp_time/5.0_r8))+1.0_r8))))
211 Hwave(i,j)=MAX((cff1*mxst),0.01_r8)
212 END DO
213 END DO
214#elif defined NJ_BIGHT
215!! wdir=210.0_r8*deg2rad
216 wdir=150.0_r8*deg2rad
217 IF ((tdays(ng)-dstart).lt.1.5_r8) THEN
218 cff=TANH(0.5_r8*(tdays(ng)-dstart))
219 cff=1.0_r8
220 ELSE
221 cff=1.0_r8
222 END IF
223 DO j=JstrR,JendR
224 DO i=IstrR,IendR
225 Hwave(i,j)=0.12_r8
226 Dwave(i,j)=wdir-angler(i,j)
227 Pwave_bot(i,j)=10.0_r8
228 END DO
229 END DO
230#elif defined SED_TOY
231 DO j=JstrR,JendR
232 DO i=IstrR,IendR
233 Hwave(i,j)=2.0_r8
234 Dwave(i,j)=90.0_r8*deg2rad
235 Pwave_bot(i,j)=8.0_r8
236 Lwave(i,j)=20.0_r8
237 END DO
238 END DO
239#else
240 ana_wwave: No values provided for Hwave, Dwave, Pwave, Lwave.
241#endif
242#if defined EW_PERIODIC || defined NS_PERIODIC
243# if defined WAVES_DIR
244 CALL exchange_r2d_tile (ng, tile, &
245 & LBi, UBi, LBj, UBj, &
246 & Dwave)
247# endif
248# ifdef WAVES_HEIGHT
249 CALL exchange_r2d_tile (ng, tile, &
250 & LBi, UBi, LBj, UBj, &
251 & Hwave)
252# endif
253# ifdef WAVES_LENGTH
254 CALL exchange_r2d_tile (ng, tile, &
255 & LBi, UBi, LBj, UBj, &
256 & Lwave)
257# endif
258# ifdef WAVES_TOP_PERIOD
259 CALL exchange_r2d_tile (ng, tile, &
260 & LBi, UBi, LBj, UBj, &
261 & Pwave_top)
262# endif
263# ifdef WAVES_BOT_PERIOD
264 CALL exchange_r2d_tile (ng, tile, &
265 & LBi, UBi, LBj, UBj, &
266 & Pwave_bot)
267# endif
268# ifdef WAVES_UB
269 CALL exchange_r2d_tile (ng, tile, &
270 & LBi, UBi, LBj, UBj, &
271 & Ub_swan)
272# endif
273# ifdef TKE_WAVEDISS
274 CALL exchange_r2d_tile (ng, tile, &
275 & LBi, UBi, LBj, UBj, &
276 & wave_dissip)
277# endif
278#endif
279#ifdef DISTRIBUTE
280# if defined WAVES_DIR
281 CALL mp_exchange2d (ng, tile, model, 3, &
282 & LBi, UBi, LBj, UBj, &
283 & NghostPoints, EWperiodic, NSperiodic, &
284 & Dwave)
285# endif
286# ifdef WAVES_HEIGHT
287 CALL mp_exchange2d (ng, tile, model, 3, &
288 & LBi, UBi, LBj, UBj, &
289 & NghostPoints, EWperiodic, NSperiodic, &
290 & Hwave)
291# endif
292# ifdef WAVES_LENGTH
293 CALL mp_exchange2d (ng, tile, model, 3, &
294 & LBi, UBi, LBj, UBj, &
295 & NghostPoints, EWperiodic, NSperiodic, &
296 & Lwave)
297# endif
298# ifdef WAVES_TOP_PERIOD
299 CALL mp_exchange2d (ng, tile, model, 3, &
300 & LBi, UBi, LBj, UBj, &
301 & NghostPoints, EWperiodic, NSperiodic, &
302 & Pwave_top)
303# endif
304# ifdef WAVES_BOT_PERIOD
305 CALL mp_exchange2d (ng, tile, model, 3, &
306 & LBi, UBi, LBj, UBj, &
307 & NghostPoints, EWperiodic, NSperiodic, &
308 & Pwave_bot)
309# endif
310# ifdef WAVES_UB
311 CALL mp_exchange2d (ng, tile, model, 3, &
312 & LBi, UBi, LBj, UBj, &
313 & NghostPoints, EWperiodic, NSperiodic, &
314 & Ub_swan)
315# endif
316# ifdef TKE_WAVEDISS
317 CALL mp_exchange2d (ng, tile, model, 3, &
318 & LBi, UBi, LBj, UBj, &
319 & NghostPoints, EWperiodic, NSperiodic, &
320 & wave_dissip)
321# endif
322#endif
323
324 RETURN
325 END SUBROUTINE ana_wwave_tile