2 SUBROUTINE ana_drag (ng, tile, model)
36 integer,
intent(in) :: ng, tile, model
40 character (len=*),
parameter :: MyFile = &
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, &
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
94#if defined SEDIMENT || defined BBL_MODEL
106 integer,
intent(in) :: ng, tile, model
107 integer,
intent(in) :: LBi, UBi, LBj, UBj
108 integer,
intent(in) :: IminS, ImaxS, JminS, JmaxS
111# if defined SEDIMENT || defined BBL_MODEL
112 real(r8),
intent(out) :: bottom(LBi:,LBj:,:)
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:)
124# if defined SEDIMENT || defined BBL_MODEL
125 real(r8),
intent(out) :: bottom(LBi:UBi,LBj:UBj,MBOTP)
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)
138 logical,
save :: first = .true.
144 TYPE (T_STATS),
save :: Stats
146#include "set_bounds.h"
154 stats % checksum=0_i8b
163#if defined UV_LOGDRAG
165#elif defined UV_LDRAG
167#elif defined UV_QDRAG
173# if defined UV_LOGDRAG
176 zobot(i,j)=0.05_r8*(1.0_r8+tanh(
grid(ng)%h(i,j)/50.0_r8))
179# elif defined UV_LDRAG
182 rdrag(i,j)=0.002_r8*(1.0_r8-tanh(
grid(ng)%h(i,j)/150.0_r8))
185# elif defined UV_QDRAG
188 cff=1.8_r8*
grid(ng)%h(i,j)*log(
grid(ng)%h(i,j))
189 rdrag2(i,j)=
g/(cff*cff)
194# if defined UV_LOGDRAG
200# elif defined UV_LDRAG
206# elif defined UV_QDRAG
217#if defined UV_LOGDRAG
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
225#elif defined UV_LDRAG
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
232#elif defined UV_QDRAG
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
245 & lbi, ubi, lbj, ubj, &
246#if defined UV_LOGDRAG
248#elif defined UV_LDRAG
250#elif defined UV_QDRAG
257 & lbi, ubi, lbj, ubj, &
260# if defined UV_LOGDRAG
262# elif defined UV_LDRAG
264# elif defined UV_QDRAG
269#if defined UV_LOGDRAG && (defined SEDIMENT || defined BBL_MODEL)
277 bottom(i,j,
izdef)=zobot(i,j)
282 10
FORMAT (3x,
' ANA_DRAG - ',a,/,19x, &
283 &
'(Grid = ',i2.2,
', Min = ',1p,e15.8,0p, &
284 &
' Max = ',1p,e15.8,0p,
')')
subroutine ana_drag_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, bottom, zobot)
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)