ROMS
Loading...
Searching...
No Matches
ana_drag.h
Go to the documentation of this file.
1!!
2 SUBROUTINE ana_drag (ng, tile, model)
3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This routine sets analytical, spatially varying bottom roughness !
12! length (m), or linear drag coefficients (m/s), or quadratic drag !
13! coefficients (nondimensional) at RHO-points. It depends on the !
14! activated bottom stress formulation. !
15! !
16! There are many ways to compute spatially varying drag parameters: !
17! !
18! * Partition the grid into different provinces with different !
19! with different values (regimes). !
20! * A piecewise value that depends on the water depth. !
21! * Empirical formulas in terms of water depth (Chezy formula) !
22! * Inverse techniques using adjoint parameter estimation, but !
23! it is beyond the scope of this routine. !
24! !
25! The User should experiment to get the appropriate distribution !
26! for their application. !
27! !
28!=======================================================================
29!
30 USE mod_param
31 USE mod_grid
32 USE mod_ncparam
33!
34! Imported variable declarations.
35!
36 integer, intent(in) :: ng, tile, model
37!
38! Local variable declarations.
39!
40 character (len=*), parameter :: MyFile = &
41 & __FILE__
42!
43#include "tile.h"
44!
45 CALL ana_drag_tile (ng, tile, model, &
46 & lbi, ubi, lbj, ubj, &
47 & imins, imaxs, jmins, jmaxs, &
48#if defined SEDIMENT || defined BBL_MODEL
49 & sedbed(ng) % bottom, &
50#endif
51#if defined UV_LOGDRAG
52 & grid(ng) % ZoBot)
53#elif defined UV_LDRAG
54 & grid(ng) % rdrag)
55#elif defined UV_QDRAG
56 & grid(ng) % rdrag2)
57#endif
58!
59! Set analytical header file name used.
60!
61#ifdef DISTRIBUTE
62 IF (lanafile) THEN
63#else
64 IF (lanafile.and.(tile.eq.0)) THEN
65#endif
66 ananame( 2)=myfile
67 END IF
68!
69 RETURN
70 END SUBROUTINE ana_drag
71!
72!***********************************************************************
73 SUBROUTINE ana_drag_tile (ng, tile, model, &
74 & LBi, UBi, LBj, UBj, &
75 & IminS, ImaxS, JminS, JmaxS, &
76#if defined SEDIMENT || defined BBL_MODEL
77 & bottom, &
78#endif
79#if defined UV_LOGDRAG
80 & ZoBot)
81#elif defined UV_LDRAG
82 & rdrag)
83#elif defined UV_QDRAG
84 & rdrag2)
85#endif
86!***********************************************************************
87!
88 USE mod_param
89 USE mod_parallel
90 USE mod_grid
91 USE mod_ncparam
92 USE mod_iounits
93 USE mod_scalars
94#if defined SEDIMENT || defined BBL_MODEL
95 USE mod_sediment
96#endif
97!
99#ifdef DISTRIBUTE
101#endif
102 USE stats_mod, ONLY : stats_2dfld
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# if defined SEDIMENT || defined BBL_MODEL
112 real(r8), intent(out) :: bottom(LBi:,LBj:,:)
113# endif
114# if defined UV_LOGDRAG
115 real(r8), intent(out) :: ZoBot(LBi:,LBj:)
116# elif defined UV_LDRAG
117 real(r8), intent(out) :: rdrag(LBi:,LBj:)
118# elif defined UV_QDRAG
119 real(r8), intent(out) :: rdrag2(LBi:,LBj:)
120# endif
121
122#else
123
124# if defined SEDIMENT || defined BBL_MODEL
125 real(r8), intent(out) :: bottom(LBi:UBi,LBj:UBj,MBOTP)
126# endif
127# if defined UV_LOGDRAG
128 real(r8), intent(out) :: ZoBot(LBi:UBi,LBj:UBj)
129# elif defined UV_LDRAG
130 real(r8), intent(out) :: rdrag(LBi:UBi,LBj:UBj)
131# elif defined UV_QDRAG
132 real(r8), intent(out) :: rdrag2(LBi:UBi,LBj:UBj)
133# endif
134#endif
135!
136! Local variable declarations.
137!
138 logical, save :: first = .true.
139!
140 integer :: i, j
141!
142 real(r8) :: cff
143!
144 TYPE (T_STATS), save :: Stats
145
146#include "set_bounds.h"
147!
148!-----------------------------------------------------------------------
149! Initialize field statistics structure.
150!-----------------------------------------------------------------------
151!
152 IF (first) THEN
153 first=.false.
154 stats % checksum=0_i8b
155 stats % count=0
156 stats % min=large
157 stats % max=-large
158 stats % avg=0.0_r8
159 stats % rms=0.0_r8
160 END IF
161!
162!-----------------------------------------------------------------------
163#if defined UV_LOGDRAG
164! Set spatially varying bottom roughness length (m).
165#elif defined UV_LDRAG
166! Set spatially varying linear drag coefficient (m/s).
167#elif defined UV_QDRAG
168! Set spatially varying quadratic drag coefficient (nondimensional)
169#endif
170!-----------------------------------------------------------------------
171!
172#if defined UPWELLING
173# if defined UV_LOGDRAG
174 DO j=jstrt,jendt
175 DO i=istrt,iendt
176 zobot(i,j)=0.05_r8*(1.0_r8+tanh(grid(ng)%h(i,j)/50.0_r8))
177 END DO
178 END DO
179# elif defined UV_LDRAG
180 DO j=jstrt,jendt
181 DO i=istrt,iendt
182 rdrag(i,j)=0.002_r8*(1.0_r8-tanh(grid(ng)%h(i,j)/150.0_r8))
183 END DO
184 END DO
185# elif defined UV_QDRAG
186 DO j=jstrt,jendt ! based on Chezy coefficient (g/c^2)
187 DO i=istrt,iendt
188 cff=1.8_r8*grid(ng)%h(i,j)*log(grid(ng)%h(i,j))
189 rdrag2(i,j)=g/(cff*cff)
190 END DO
191 END DO
192# endif
193#else
194# if defined UV_LOGDRAG
195 DO j=jstrt,jendt
196 DO i=istrt,iendt
197 zobot(i,j)=???
198 END DO
199 END DO
200# elif defined UV_LDRAG
201 DO j=jstrt,jendt
202 DO i=istrt,iendt
203 rdrag(i,j)=???
204 END DO
205 END DO
206# elif defined UV_QDRAG
207 DO j=jstrt,jendt
208 DO i=istrt,iendt
209 rdrag2(i,j)=???
210 END DO
211 END DO
212# endif
213#endif
214!
215! Report statistics.
216!
217#if defined UV_LOGDRAG
218 CALL stats_2dfld (ng, tile, inlm, r2dvar, stats, 0, &
219 & lbi, ubi, lbj, ubj, zobot)
220 IF (domain(ng)%NorthEast_Corner(tile)) THEN
221 WRITE (stdout,10) 'time invariant, bottom roughness '// &
222 & 'length scale: ZoBot', &
223 & ng, stats%min, stats%max
224 END IF
225#elif defined UV_LDRAG
226 CALL stats_2dfld (ng, tile, inlm, r2dvar, stats, 0, &
227 & lbi, ubi, lbj, ubj, rdrag)
228 IF (domain(ng)%NorthEast_Corner(tile)) THEN
229 WRITE (stdout,10) 'linear bottom drag coefficient: rdrag', &
230 & ng, stats%min, stats%max
231 END IF
232#elif defined UV_QDRAG
233 CALL stats_2dfld (ng, tile, inlm, r2dvar, stats, 0, &
234 & lbi, ubi, lbj, ubj, rdrag2)
235 IF (domain(ng)%NorthEast_Corner(tile)) THEN
236 WRITE (stdout,10) 'quadratic bottom drag coefficient: rdrag2', &
237 & ng, stats%min, stats%max
238 END IF
239#endif
240!
241! Exchange boundary data.
242!
243 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
244 CALL exchange_r2d_tile (ng, tile, &
245 & lbi, ubi, lbj, ubj, &
246#if defined UV_LOGDRAG
247 & zobot)
248#elif defined UV_LDRAG
249 & rdrag)
250#elif defined UV_QDRAG
251 & rdrag2)
252#endif
253 END IF
254
255#ifdef DISTRIBUTE
256 CALL mp_exchange2d (ng, tile, model, 1, &
257 & lbi, ubi, lbj, ubj, &
258 & nghostpoints, &
259 & ewperiodic(ng), nsperiodic(ng), &
260# if defined UV_LOGDRAG
261 & zobot)
262# elif defined UV_LDRAG
263 & rdrag)
264# elif defined UV_QDRAG
265 & rdrag2)
266# endif
267#endif
268
269#if defined UV_LOGDRAG && (defined SEDIMENT || defined BBL_MODEL)
270!
271!-----------------------------------------------------------------------
272! Load bottom roughness length into bottom properties array.
273!-----------------------------------------------------------------------
274!
275 DO j=jstrt,jendt
276 DO i=istrt,iendt
277 bottom(i,j,izdef)=zobot(i,j)
278 END DO
279 END DO
280#endif
281!
282 10 FORMAT (3x,' ANA_DRAG - ',a,/,19x, &
283 & '(Grid = ',i2.2,', Min = ',1p,e15.8,0p, &
284 & ' Max = ',1p,e15.8,0p,')')
285!
286 RETURN
287 END SUBROUTINE ana_drag_tile
subroutine ana_drag_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, bottom, zobot)
Definition ana_drag.h:81
subroutine ana_drag(ng, tile, model)
Definition ana_drag.h:3
subroutine exchange_r2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
integer stdout
logical lanafile
character(len=256), dimension(39) ananame
integer, parameter inlm
Definition mod_param.F:662
integer nghostpoints
Definition mod_param.F:710
type(t_domain), dimension(:), allocatable domain
Definition mod_param.F:329
integer, parameter r2dvar
Definition mod_param.F:717
logical, dimension(:), allocatable ewperiodic
logical, dimension(:), allocatable nsperiodic
real(dp), parameter large
real(dp) g
integer, parameter izdef
subroutine mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, a, b, c, d)
subroutine, public stats_2dfld(ng, tile, model, gtype, s, extract_flag, lbi, ubi, lbj, ubj, f, fmask, debug)
Definition stats.F:47