ROMS
Loading...
Searching...
No Matches
wvelocity.F
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE wvelocity_mod
3#ifdef SOLVE3D
4!
5!git $Id$
6!=======================================================================
7! Copyright (c) 2002-2025 The ROMS Group !
8! Licensed under a MIT/X style license !
9! See License_ROMS.md Hernan G. Arango !
10!========================================== Alexander F. Shchepetkin ===
11! !
12! This subroutines computes vertical velocity (m/s) at W-points !
13! from the vertical mass flux (omega*hz/m*n). This computation !
14! is done solely for output purposes. !
15! !
16!=======================================================================
17!
18 implicit none
19
20 PRIVATE
21 PUBLIC :: wvelocity
22
23 CONTAINS
24!
25!***********************************************************************
26 SUBROUTINE wvelocity (ng, tile, Ninp)
27!***********************************************************************
28!
29 USE mod_param
30 USE mod_coupling
31 USE mod_grid
32 USE mod_ocean
33 USE mod_stepping
34!
35! Imported variable declarations.
36!
37 integer, intent(in) :: ng, tile, ninp
38!
39! Local variable declarations.
40!
41# include "tile.h"
42!
43 CALL wvelocity_tile (ng, tile, &
44 & lbi, ubi, lbj, ubj, &
45 & imins, imaxs, jmins, jmaxs, &
46 & ninp, &
47 & grid(ng) % pm, &
48 & grid(ng) % pn, &
49 & grid(ng) % z_r, &
50 & grid(ng) % z_w, &
51 & coupling(ng) % DU_avg1, &
52 & coupling(ng) % DV_avg1, &
53 & ocean(ng) % u, &
54 & ocean(ng) % v, &
55 & ocean(ng) % W, &
56# ifdef OMEGA_IMPLICIT
57 & ocean(ng) % Wi, &
58# endif
59 & ocean(ng) % wvel)
60 RETURN
61 END SUBROUTINE wvelocity
62!
63!***********************************************************************
64 SUBROUTINE wvelocity_tile (ng, tile, &
65 & LBi, UBi, LBj, UBj, &
66 & IminS, ImaxS, JminS, JmaxS, &
67 & Ninp, &
68 & pm, pn, z_r, z_w, &
69 & DU_avg1, DV_avg1, &
70 & u, v, W, &
71# ifdef OMEGA_IMPLICIT
72 & Wi, &
73# endif
74 & wvel)
75!***********************************************************************
76!
77 USE mod_param
78 USE mod_ncparam
79 USE mod_scalars
80!
81 USE bc_3d_mod, ONLY : bc_w3d_tile
82 USE exchange_2d_mod
83# ifdef DISTRIBUTE
84 USE mp_exchange_mod, ONLY : mp_exchange2d, mp_exchange3d
85# endif
86!
87! Imported variable declarations.
88!
89 integer, intent(in) :: ng, tile
90 integer, intent(in) :: LBi, UBi, LBj, UBj
91 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
92 integer, intent(in) :: Ninp
93!
94# ifdef ASSUMED_SHAPE
95 real(r8), intent(in) :: pm(LBi:,LBj:)
96 real(r8), intent(in) :: pn(LBi:,LBj:)
97 real(r8), intent(in) :: z_r(LBi:,LBj:,:)
98 real(r8), intent(in) :: z_w(LBi:,LBj:,0:)
99 real(r8), intent(inout) :: DU_avg1(LBi:,LBj:)
100 real(r8), intent(inout) :: DV_avg1(LBi:,LBj:)
101 real(r8), intent(in) :: u(LBi:,LBj:,:,:)
102 real(r8), intent(in) :: v(LBi:,LBj:,:,:)
103 real(r8), intent(in) :: W(LBi:,LBj:,0:)
104# ifdef OMEGA_IMPLICIT
105 real(r8), intent(in) :: Wi(LBi:,LBj:,0:)
106# endif
107 real(r8), intent(out) :: wvel(LBi:,LBj:,0:)
108# else
109 real(r8), intent(in) :: pm(LBi:UBi,LBj:UBj)
110 real(r8), intent(in) :: pn(LBi:UBi,LBj:UBj)
111 real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
112 real(r8), intent(in) :: z_w(LBi:UBi,LBj:UBj,0:N(ng))
113 real(r8), intent(inout) :: DU_avg1(LBi:UBi,LBj:UBj)
114 real(r8), intent(inout) :: DV_avg1(LBi:UBi,LBj:UBj)
115 real(r8), intent(in) :: u(LBi:UBi,LBj:UBj,N(ng),2)
116 real(r8), intent(in) :: v(LBi:UBi,LBj:UBj,N(ng),2)
117 real(r8), intent(in) :: W(LBi:UBi,LBj:UBj,0:N(ng))
118# ifdef OMEGA_IMPLICIT
119 real(r8), intent(in) :: Wi(LBi:UBi,LBj:UBj,0:N(ng))
120# endif
121 real(r8), intent(out) :: wvel(LBi:UBi,LBj:UBj,0:N(ng))
122# endif
123!
124! Local variable declarations.
125!
126 integer :: i, j, k
127
128 real(r8) :: cff1, cff2, cff3, cff4, cff5, slope
129
130 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,N(ng)) :: vert
131
132 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: wrk
133
134# include "set_bounds.h"
135!
136!-----------------------------------------------------------------------
137! Compute "true" vertical velocity (m/s).
138!-----------------------------------------------------------------------
139!
140! In ROMS, the terrain-following vertical velocity, omega, is given by:
141!
142! Hz * omega = w - d(z)/d(t) - div(z)
143!
144! where w is the "true" vertical velocity and
145!
146! div(z) = pm * u * d(z)/d(xi) + pn * v * d(z)/d(eta)
147!
148! The vertical coordinate is a function of several parameter but only
149! the free-surface is time dependent. However, in sediment applications
150! with stratigraphy, the bathymetry (h) also evolves in time.
151!
152! Exchange time-averaged fields.
153!
154 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
155 CALL exchange_u2d_tile (ng, tile, &
156 & lbi, ubi, lbj, ubj, &
157 & du_avg1)
158 CALL exchange_v2d_tile (ng, tile, &
159 & lbi, ubi, lbj, ubj, &
160 & dv_avg1)
161 END IF
162
163# ifdef DISTRIBUTE
164 CALL mp_exchange2d (ng, tile, inlm, 2, &
165 & lbi, ubi, lbj, ubj, &
166 & nghostpoints, &
167 & ewperiodic(ng), nsperiodic(ng), &
168 & du_avg1, dv_avg1)
169# endif
170!
171! Compute contribution due to quasi-horizontal motions along
172! S-coordinate surfaces: (Ui + Vj)*GRADs(z).
173!
174 DO k=1,n(ng)
175 DO j=jstr,jend
176 DO i=istr,iend+1
177 wrk(i,j)=u(i,j,k,ninp)*(z_r(i,j,k)-z_r(i-1,j,k))* &
178 & (pm(i-1,j)+pm(i,j))
179 END DO
180 DO i=istr,iend
181 vert(i,j,k)=0.25_r8*(wrk(i,j)+wrk(i+1,j))
182 END DO
183 END DO
184 DO j=jstr,jend+1
185 DO i=istr,iend
186 wrk(i,j)=v(i,j,k,ninp)*(z_r(i,j,k)-z_r(i,j-1,k))* &
187 & (pn(i,j-1)+pn(i,j))
188 END DO
189 END DO
190 DO j=jstr,jend
191 DO i=istr,iend
192 vert(i,j,k)=vert(i,j,k)+0.25_r8*(wrk(i,j)+wrk(i,j+1))
193 END DO
194 END DO
195 END DO
196!
197! Compute contribution due to time tendency of the free-surface,
198! d(zeta)/d(t), which is the vertical velocity at the free-surface
199! and it is expressed in terms of barotropic mass flux divergence.
200! Notice that it is divided by the total depth of the water column.
201! This is needed because this contribution is linearly distributed
202! throughout the water column by multiplying it by the distance from
203! the bottom to the depth at which the vertical velocity is computed.
204!
205 cff1=3.0_r8/8.0_r8
206 cff2=3.0_r8/4.0_r8
207 cff3=1.0_r8/8.0_r8
208 cff4=9.0_r8/16.0_r8
209 cff5=1.0_r8/16.0_r8
210
211 j_loop : DO j=jstr,jend
212 DO i=istr,iend
213 wrk(i,j)=(du_avg1(i,j)-du_avg1(i+1,j)+ &
214 & dv_avg1(i,j)-dv_avg1(i,j+1))/ &
215 & (z_w(i,j,n(ng))-z_w(i,j,0))
216 END DO
217!
218! Notice that a cubic interpolation is used to shift the "vert"
219! contribution from vertical RHO- to W-points.
220!
221 DO i=istr,iend
222 slope=(z_r(i,j,1)-z_w(i,j,0))/ &
223 & (z_r(i,j,2)-z_r(i,j,1)) ! extrapolation slope
224 wvel(i,j,0)=cff1*(vert(i,j,1)- &
225 & slope*(vert(i,j,2)- &
226 & vert(i,j,1)))+ &
227 & cff2*vert(i,j,1)- &
228 & cff3*vert(i,j,2)
229 wvel(i,j,1)=pm(i,j)*pn(i,j)* &
230 & (w(i,j,1)+ &
231# ifdef OMEGA_IMPLICIT
232 & wi(i,j,1)+ &
233# endif
234 & wrk(i,j)*(z_w(i,j,1)-z_w(i,j,0)))+ &
235 & cff1*vert(i,j,1)+ &
236 & cff2*vert(i,j,2)- &
237 & cff3*vert(i,j,3)
238 END DO
239 DO k=2,n(ng)-2
240 DO i=istr,iend
241 wvel(i,j,k)=pm(i,j)*pn(i,j)* &
242 & (w(i,j,k)+ &
243# ifdef OMEGA_IMPLICIT
244 & wi(i,j,k)+ &
245# endif
246 & wrk(i,j)*(z_w(i,j,k)-z_w(i,j,0)))+ &
247 & cff4*(vert(i,j,k )+vert(i,j,k+1))- &
248 & cff5*(vert(i,j,k-1)+vert(i,j,k+2))
249 END DO
250 END DO
251 DO i=istr,iend
252 slope=(z_w(i,j,n(ng))-z_r(i,j,n(ng) ))/ &
253 & (z_r(i,j,n(ng))-z_r(i,j,n(ng)-1)) ! extrapolation slope
254 wvel(i,j,n(ng))=pm(i,j)*pn(i,j)* &
255 & wrk(i,j)*(z_w(i,j,n(ng))-z_w(i,j,0))+ &
256 & cff1*(vert(i,j,n(ng))+ &
257 & slope*(vert(i,j,n(ng) )- &
258 & vert(i,j,n(ng)-1)))+ &
259 & cff2*vert(i,j,n(ng) )- &
260 & cff3*vert(i,j,n(ng)-1)
261 wvel(i,j,n(ng)-1)=pm(i,j)*pn(i,j)* &
262 & (w(i,j,n(ng)-1)+ &
263# ifdef OMEGA_IMPLICIT
264 & wi(i,j,n(ng)-1)+ &
265# endif
266 & wrk(i,j)*(z_w(i,j,n(ng)-1)-z_w(i,j,0)))+ &
267 & cff1*vert(i,j,n(ng) )+ &
268 & cff2*vert(i,j,n(ng)-1)- &
269 & cff3*vert(i,j,n(ng)-2)
270 END DO
271 END DO j_loop
272!
273! Set lateral boundary conditions.
274!
275 CALL bc_w3d_tile (ng, tile, &
276 & lbi, ubi, lbj, ubj, 0, n(ng), &
277 & wvel)
278# ifdef DISTRIBUTE
279 CALL mp_exchange3d (ng, tile, inlm, 1, &
280 & lbi, ubi, lbj, ubj, 0, n(ng), &
281 & nghostpoints, &
282 & ewperiodic(ng), nsperiodic(ng), &
283 & wvel)
284# endif
285
286 RETURN
287 END SUBROUTINE wvelocity_tile
288#endif
289 END MODULE wvelocity_mod
bc_3d_mod
Definition bc_3d.F:2
bc_3d_mod::bc_w3d_tile
subroutine bc_w3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
Definition bc_3d.F:591
exchange_2d_mod
Definition exchange_2d.F:2
exchange_2d_mod::exchange_u2d_tile
subroutine exchange_u2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition exchange_2d.F:440
exchange_2d_mod::exchange_v2d_tile
subroutine exchange_v2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition exchange_2d.F:627
mod_coupling
Definition mod_coupling.F:2
mod_coupling::coupling
type(t_coupling), dimension(:), allocatable coupling
Definition mod_coupling.F:102
mod_grid
Definition mod_grid.F:2
mod_grid::grid
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
mod_ncparam
Definition mod_ncparam.F:2
mod_ocean
Definition mod_ocean.F:2
mod_ocean::ocean
type(t_ocean), dimension(:), allocatable ocean
Definition mod_ocean.F:351
mod_param
Definition mod_param.F:2
mod_param::inlm
integer, parameter inlm
Definition mod_param.F:662
mod_param::nghostpoints
integer nghostpoints
Definition mod_param.F:710
mod_scalars
Definition mod_scalars.F:2
mod_scalars::ewperiodic
logical, dimension(:), allocatable ewperiodic
Definition mod_scalars.F:510
mod_scalars::nsperiodic
logical, dimension(:), allocatable nsperiodic
Definition mod_scalars.F:511
mod_stepping
Definition mod_stepping.F:2
mp_exchange_mod
Definition mp_exchange.F:2
mp_exchange_mod::mp_exchange2d
subroutine mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, a, b, c, d)
Definition mp_exchange.F:294
mp_exchange_mod::mp_exchange3d
subroutine mp_exchange3d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, nghost, ew_periodic, ns_periodic, a, b, c, d)
Definition mp_exchange.F:2037
wvelocity_mod
Definition wvelocity.F:2
wvelocity_mod::wvelocity
subroutine, public wvelocity(ng, tile, ninp)
Definition wvelocity.F:27
wvelocity_mod::wvelocity_tile
subroutine wvelocity_tile(ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, ninp, pm, pn, z_r, z_w, du_avg1, dv_avg1, u, v, w, wvel)
Definition wvelocity.F:75