ROMS
Loading...
Searching...
No Matches
Functions/Subroutines
omega_mod Module Reference

Functions/Subroutines

subroutine, public omega (ng, tile, model)
 
subroutine omega_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nstp, nnew, omn, bed_thick, huon, hvom, z_w, w)
 
subroutine, public scale_omega (ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, pm, pn, w, wscl)
 

Function/Subroutine Documentation

◆ omega()

subroutine, public omega_mod::omega ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 41 of file omega.F.

42!***********************************************************************
43!
44 USE mod_param
45 USE mod_grid
46 USE mod_ocean
47# if defined SEDIMENT && defined SED_MORPH
48 USE mod_sedbed
49 USE mod_stepping
50# endif
51!
52! Imported variable declarations.
53!
54 integer, intent(in) :: ng, tile, model
55!
56! Local variable declarations.
57!
58 character (len=*), parameter :: MyFile = &
59 & __FILE__
60!
61# include "tile.h"
62!
63# ifdef PROFILE
64 CALL wclock_on (ng, model, 13, __line__, myfile)
65# endif
66 CALL omega_tile (ng, tile, model, &
67 & lbi, ubi, lbj, ubj, &
68 & imins, imaxs, jmins, jmaxs, &
69# if defined SEDIMENT && defined SED_MORPH
70 & nstp(ng), nnew(ng), &
71 & grid(ng) % omn, &
72 & sedbed(ng) % bed_thick, &
73# endif
74 & grid(ng) % Huon, &
75 & grid(ng) % Hvom, &
76# ifdef OMEGA_IMPLICIT
77 & grid(ng) % pm, &
78 & grid(ng) % pn, &
79# endif
80 & grid(ng) % z_w, &
81# if defined WEC_VF
82 & ocean(ng) % W_stokes, &
83# endif
84# ifdef OMEGA_IMPLICIT
85 & ocean(ng) % Wi, &
86# endif
87 & ocean(ng) % W)
88# ifdef PROFILE
89 CALL wclock_off (ng, model, 13, __line__, myfile)
90# endif
91!
92 RETURN
mod_grid
Definition mod_grid.F:2
mod_grid::grid
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
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_sedbed
Definition sedbed_mod.h:1
mod_sedbed::sedbed
type(t_sedbed), dimension(:), allocatable sedbed
Definition sedbed_mod.h:157
mod_stepping
Definition mod_stepping.F:2
mod_stepping::nnew
integer, dimension(:), allocatable nnew
Definition mod_stepping.F:69
mod_stepping::nstp
integer, dimension(:), allocatable nstp
Definition mod_stepping.F:71
wclock_off
recursive subroutine wclock_off(ng, model, region, line, routine)
Definition timers.F:148
wclock_on
recursive subroutine wclock_on(ng, model, region, line, routine)
Definition timers.F:3

References mod_grid::grid, mod_stepping::nnew, mod_stepping::nstp, mod_ocean::ocean, omega_tile(), mod_sedbed::sedbed, wclock_off(), and wclock_on().

Referenced by ad_initial(), ad_main3d(), initial(), main3d(), roms_kernel_mod::nlm_initial(), rp_initial(), rp_main3d(), and tl_main3d().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ omega_tile()

subroutine omega_mod::omega_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) nstp,
integer, intent(in) nnew,
real(r8), dimension(lbi:,lbj:), intent(in) omn,
real(r8), dimension(lbi:,lbj:,:), intent(in) bed_thick,
real(r8), dimension(lbi:,lbj:,:), intent(in) huon,
real(r8), dimension(lbi:,lbj:,:), intent(in) hvom,
real(r8), dimension(lbi:,lbj:,0:), intent(in) z_w,
real(r8), dimension(lbi:,lbj:,0:), intent(out) w )
private

Definition at line 96 of file omega.F.

115!***********************************************************************
116!
117 USE mod_param
118 USE mod_scalars
119 USE mod_sources
120!
121 USE bc_3d_mod, ONLY : bc_w3d_tile
122# ifdef DISTRIBUTE
123 USE mp_exchange_mod, ONLY : mp_exchange3d
124# endif
125!
126! Imported variable declarations.
127!
128 integer, intent(in) :: ng, tile, model
129 integer, intent(in) :: LBi, UBi, LBj, UBj
130 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
131# if defined SEDIMENT && defined SED_MORPH
132 integer, intent(in) :: nstp, nnew
133# endif
134!
135# ifdef ASSUMED_SHAPE
136# if defined SEDIMENT && defined SED_MORPH
137 real(r8), intent(in) :: omn(LBi:,LBj:)
138 real(r8), intent(in) :: bed_thick(LBi:,LBj:,:)
139# endif
140 real(r8), intent(in) :: Huon(LBi:,LBj:,:)
141 real(r8), intent(in) :: Hvom(LBi:,LBj:,:)
142# ifdef OMEGA_IMPLICIT
143 real(r8), intent(in) :: pm(LBi:,LBj:)
144 real(r8), intent(in) :: pn(LBi:,LBj:)
145# endif
146 real(r8), intent(in) :: z_w(LBi:,LBj:,0:)
147# if defined WEC_VF
148 real(r8), intent(in) :: W_stokes(LBi:,LBj:,0:)
149# endif
150# ifdef OMEGA_IMPLICIT
151 real(r8), intent(out) :: Wi(LBi:,LBj:,0:)
152# endif
153 real(r8), intent(out) :: W(LBi:,LBj:,0:)
154
155# else
156
157# if defined SEDIMENT && defined SED_MORPH
158 real(r8), intent(in) :: omn(LBi:UBi,LBj:UBj)
159 real(r8), intent(in) :: bed_thick(LBi:UBi,LBj:UBj,3)
160# endif
161 real(r8), intent(in) :: Huon(LBi:UBi,LBj:UBj,N(ng))
162 real(r8), intent(in) :: Hvom(LBi:UBi,LBj:UBj,N(ng))
163# ifdef OMEGA_IMPLICIT
164 real(r8), intent(in) :: pm(LBi:UBi,LBj:UBj)
165 real(r8), intent(in) :: pn(LBi:UBi,LBj:UBj)
166# endif
167 real(r8), intent(in) :: z_w(LBi:UBi,LBj:UBj,0:N(ng))
168# if defined WEC_VF
169 real(r8), intent(in) :: W_stokes(LBi:UBi,LBj:UBj,0:N(ng))
170# endif
171# ifdef OMEGA_IMPLICIT
172 real(r8), intent(out) :: Wi(LBi:UBi,LBj:UBj,0:N(ng))
173# endif
174 real(r8), intent(out) :: W(LBi:UBi,LBj:UBj,0:N(ng))
175# endif
176!
177! Local variable declarations.
178!
179 integer :: i, ii, is, j, jj, k
180# if defined SEDIMENT && defined SED_MORPH
181 real(r8) :: cff1
182# endif
183 real(r8), dimension(IminS:ImaxS) :: wrk
184# ifdef OMEGA_IMPLICIT
185 real(r8), dimension(IminS:ImaxS,0:N(ng)) :: Cu_adv
186 real(r8) :: cff
187 real(r8) :: cw, c2d, dh, cw_max, cw_max2, cw_min
188!
189 real(r8), parameter :: amax = 0.75_r8 ! Maximum Courant number
190 real(r8), parameter :: amin = 0.60_r8 ! Minimum Courant number
191 real(r8), parameter :: cmnx_ratio = amin/amax
192 real(r8), parameter :: cutoff = 2.0_r8-amin/amax
193 real(r8), parameter :: r4cmx = 1.0_r8/(4.0_r8-4.0_r8*amin/amax)
194# endif
195
196# include "set_bounds.h"
197!
198!------------------------------------------------------------------------
199! Vertically integrate horizontal mass flux divergence:
200!
201! Starting with zero vertical velocity at the bottom, integrate
202! from the bottom (k=0) to the free-surface (k=N). The w(:,:,N(ng))
203! contains the vertical velocity at the free-surface, d(zeta)/d(t).
204! Notice that barotropic mass flux divergence is not used directly.
205!------------------------------------------------------------------------
206!
207# if defined SEDIMENT && defined SED_MORPH
208! For sediment bed change, we need to include the mass change of
209! water volume due to change of the sea floor. This is similar to
210! the LwSrc point source approach.
211!
212 cff1=1.0_r8/(dt(ng)*n(ng))
213!
214# endif
215 DO j=jstr,jend
216 DO i=istr,iend
217 w(i,j,0)=0.0_r8
218# if defined SEDIMENT && defined SED_MORPH
219 wrk(i)=cff1*(bed_thick(i,j,nstp)- &
220 & bed_thick(i,j,nnew))*omn(i,j)
221# endif
222 END DO
223 DO k=1,n(ng)
224 DO i=istr,iend
225 w(i,j,k)=w(i,j,k-1)- &
226# if defined SEDIMENT && defined SED_MORPH
227 & wrk(i)- &
228# endif
229 & (huon(i+1,j,k)-huon(i,j,k)+ &
230 & hvom(i,j+1,k)-hvom(i,j,k))
231
232# ifdef OMEGA_IMPLICIT
233!
234! Compute the horizontal Courant number.
235!
236 cu_adv(i,k)=max(huon(i+1,j ,k),0.0_r8)- &
237 & min(huon(i ,j ,k),0.0_r8)+ &
238 & max(hvom(i ,j+1,k),0.0_r8)- &
239 & min(hvom(i ,j ,k),0.0_r8)
240# endif
241 END DO
242 END DO
243!
244! Apply mass point sources (volume vertical influx), if any.
245!
246! Overwrite W(Isrc,Jsrc,k) with the same divergence of Huon,Hvom as
247! above but add in point source Qsrc(k) and reaccumulate the vertical
248! sum to obtain the correct net Qbar given in user input - J. Levin
249! (Jupiter Intelligence Inc.) and J. Wilkin
250!
251! Dsrc(is) = 2, flow across grid cell w-face (positive or negative)
252!
253 IF (lwsrc(ng)) THEN
254 DO is=1,nsrc(ng)
255 IF (int(sources(ng)%Dsrc(is)).eq.2) THEN
256 ii=sources(ng)%Isrc(is)
257 jj=sources(ng)%Jsrc(is)
258 IF (((istrr.le.ii).and.(ii.le.iendr)).and. &
259 & ((jstrr.le.jj).and.(jj.le.jendr)).and. &
260 & (j.eq.jj)) THEN
261# if defined SEDIMENT && defined SED_MORPH
262 wrk(ii)=cff1*(bed_thick(ii,jj,nstp)- &
263 & bed_thick(ii,jj,nnew))*omn(ii,jj)
264# endif
265 DO k=1,n(ng)
266 w(ii,jj,k)=w(ii,jj,k-1)- &
267# if defined SEDIMENT && defined SED_MORPH
268 & wrk(ii)- &
269# endif
270 & (huon(ii+1,jj,k)-huon(ii,jj,k)+ &
271 & hvom(ii,jj+1,k)-hvom(ii,jj,k))+ &
272 & sources(ng)%Qsrc(is,k)
273 END DO
274 END IF
275 END IF
276 END DO
277 END IF
278!
279 DO i=istr,iend
280 wrk(i)=w(i,j,n(ng))/(z_w(i,j,n(ng))-z_w(i,j,0))
281# ifdef OMEGA_IMPLICIT
282 cu_adv(i,0)=dt(ng)*pm(i,j)*pn(i,j)
283# endif
284 END DO
285!
286! In order to insure zero vertical velocity at the free-surface,
287! subtract the vertical velocities of the moving S-coordinates
288! isosurfaces. These isosurfaces are proportional to d(zeta)/d(t).
289! The proportionally coefficients are a linear function of the
290! S-coordinate with zero value at the bottom (k=0) and unity at
291! the free-surface (k=N).
292!
293 DO k=n(ng)-1,1,-1
294 DO i=istr,iend
295 w(i,j,k)=w(i,j,k)- &
296# if defined WEC_VF
297 & w_stokes(i,j,k)- &
298# endif
299 & wrk(i)*(z_w(i,j,k)-z_w(i,j,0))
300
301# ifdef OMEGA_IMPLICIT
302!
303! Determine implicit part "Wi" of vertical advection: "W" becomes the
304! explicit part "We".
305!
306 wi(i,j,k)=w(i,j,k)
307 IF (wi(i,j,k).ge.0.0_r8) THEN ! Three different variants
308 c2d=cu_adv(i,k) ! for computing 2D Courant
309 dh=z_w(i,j,k)-z_w(i,j,k-1) ! number at the interface:
310 ELSE ! (1) use value from the
311 c2d=cu_adv(i,k+1) ! grid box upstream in
312 dh=z_w(i,j,k+1)-z_w(i,j,k) ! vertical direction;
313 END IF
314!
315!! c2d=0.5_r8*(Cu_adv(i,k )+ &
316!! & Cu_adv(i,k+1)) ! (2) average the two; or
317!! dh=0.5_r8*(z_w(i,j,k+1)- &
318!! & z_w(i,j,k-1))
319!!
320!! c2d=MAX(Cu_adv(i,k), &
321!! & Cu_adv(i,k+1)) ! (3) pick its maximum
322!! dh=MIN(z_w(i,j,k+1)-z_w(i,j,k), &
323!! z_w(i,j,k)-z_w(i,j,k-1))
324!!
325 cw_max=amax*dh-c2d*cu_adv(i,0) ! compare the vertical
326 IF (cw_max.ge.0.0_r8) THEN ! displacement to dz*amax.
327 cw_max2=cw_max*cw_max ! Partition W into Wi and
328 cw_min=cw_max*cmnx_ratio ! We.
329 cw=abs(wi(i,j,k))*cu_adv(i,0)
330 IF (cw.le.cw_min) THEN
331 cff=cw_max2
332 ELSE IF (cw.le.cutoff*cw_max) THEN
333 cff=cw_max2+r4cmx*(cw-cw_min)**2
334 ELSE
335 cff=cw_max*cw
336 END IF
337!
338 w(i,j,k)=cw_max2*wi(i,j,k)/cff
339 wi(i,j,k)=wi(i,j,k)-w(i,j,k)
340 ELSE ! All the displacement is
341 w(i,j,k)=0.0_r8 ! greater than amax*dz, so
342 END IF ! keep it all into Wi.
343# endif
344 END DO
345 END DO
346 DO i=istr,iend
347 w(i,j,n(ng))=0.0_r8
348 END DO
349 END DO
350!
351! Set lateral boundary conditions.
352!
353 CALL bc_w3d_tile (ng, tile, &
354 & lbi, ubi, lbj, ubj, 0, n(ng), &
355 & w)
356# ifdef OMEGA_IMPLICIT
357 CALL bc_w3d_tile (ng, tile, &
358 & lbi, ubi, lbj, ubj, 0, n(ng), &
359 & wi)
360# endif
361# ifdef DISTRIBUTE
362 CALL mp_exchange3d (ng, tile, model, 1, &
363 & lbi, ubi, lbj, ubj, 0, n(ng), &
364 & nghostpoints, &
365 & ewperiodic(ng), nsperiodic(ng), &
366 & w)
367# ifdef OMEGA_IMPLICIT
368 CALL mp_exchange3d (ng, tile, model, 1, &
369 & lbi, ubi, lbj, ubj, 0, n(ng), &
370 & nghostpoints, &
371 & ewperiodic(ng), nsperiodic(ng), &
372 & wi)
373# endif
374# endif
375!
376 RETURN
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
mod_param::n
integer, dimension(:), allocatable n
Definition mod_param.F:479
mod_param::nghostpoints
integer nghostpoints
Definition mod_param.F:710
mod_scalars
Definition mod_scalars.F:2
mod_scalars::dt
real(dp), dimension(:), allocatable dt
Definition mod_scalars.F:269
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_scalars::lwsrc
logical, dimension(:), allocatable lwsrc
Definition mod_scalars.F:543
mod_sources
Definition mod_sources.F:2
mod_sources::sources
type(t_sources), dimension(:), allocatable sources
Definition mod_sources.F:90
mod_sources::nsrc
integer, dimension(:), allocatable nsrc
Definition mod_sources.F:97
mp_exchange_mod
Definition mp_exchange.F:2
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

References bc_3d_mod::bc_w3d_tile(), mod_scalars::dt, mod_scalars::ewperiodic, mod_scalars::lwsrc, mp_exchange_mod::mp_exchange3d(), mod_param::nghostpoints, mod_scalars::nsperiodic, mod_sources::nsrc, and mod_sources::sources.

Referenced by omega().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ scale_omega()

subroutine, public omega_mod::scale_omega ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) lbk,
integer, intent(in) ubk,
real(r8), dimension(lbi:,lbj:), intent(in) pm,
real(r8), dimension(lbi:,lbj:), intent(in) pn,
real(r8), dimension(lbi:,lbj:,lbk:), intent(in) w,
real(r8), dimension(lbi:,lbj:,lbk:), intent(out) wscl )

Definition at line 380 of file omega.F.

382!***********************************************************************
383!
384 USE mod_param
385 USE mod_ncparam
386 USE mod_scalars
387!
388 USE exchange_3d_mod, ONLY : exchange_w3d_tile
389# ifdef DISTRIBUTE
390 USE mp_exchange_mod, ONLY : mp_exchange3d
391# endif
392!
393! Imported variable declarations.
394!
395 integer, intent(in) :: ng, tile
396 integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk
397!
398# ifdef ASSUMED_SHAPE
399 real(r8), intent(in) :: pm(LBi:,LBj:)
400 real(r8), intent(in) :: pn(LBi:,LBj:)
401 real(r8), intent(in) :: W(LBi:,LBj:,LBk:)
402 real(r8), intent(out) :: Wscl(LBi:,LBj:,LBk:)
403# else
404 real(r8), intent(in) :: pm(LBi:UBi,LBj:UBj)
405 real(r8), intent(in) :: pn(LBi:UBi,LBj:UBj)
406 real(r8), intent(in) :: W(LBi:UBi,LBj:UBj,LBk:UBk)
407 real(r8), intent(out) :: Wscl(LBi:UBi,LBj:UBj,LBk:UBk)
408# endif
409!
410! Local variable declarations.
411!
412 integer :: i, j, k
413
414# include "set_bounds.h"
415!
416!-----------------------------------------------------------------------
417! Scale omega vertical velocity to m/s.
418!-----------------------------------------------------------------------
419!
420 DO k=lbk,ubk
421 DO j=jstrr,jendr
422 DO i=istrr,iendr
423 wscl(i,j,k)=w(i,j,k)*pm(i,j)*pn(i,j)
424 END DO
425 END DO
426 END DO
427!
428! Exchange boundary data.
429!
430 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
431 CALL exchange_w3d_tile (ng, tile, &
432 & lbi, ubi, lbj, ubj, lbk, ubk, &
433 & wscl)
434 END IF
435
436# ifdef DISTRIBUTE
437 CALL mp_exchange3d (ng, tile, inlm, 1, &
438 & lbi, ubi, lbj, ubj, 0, n(ng), &
439 & nghostpoints, &
440 & ewperiodic(ng), nsperiodic(ng), &
441 & wscl)
442# endif
443!
444 RETURN
exchange_3d_mod
Definition exchange_3d.F:2
exchange_3d_mod::exchange_w3d_tile
subroutine exchange_w3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
Definition exchange_3d.F:920
mod_ncparam
Definition mod_ncparam.F:2
mod_param::inlm
integer, parameter inlm
Definition mod_param.F:662

References mod_scalars::ewperiodic, exchange_3d_mod::exchange_w3d_tile(), mod_param::inlm, mp_exchange_mod::mp_exchange3d(), mod_param::n, mod_param::nghostpoints, and mod_scalars::nsperiodic.

Referenced by ad_wrt_his_mod::ad_wrt_his_nf90(), ad_wrt_his_mod::ad_wrt_his_pio(), wrt_his_mod::wrt_his_nf90(), wrt_his_mod::wrt_his_pio(), wrt_quick_mod::wrt_quick_nf90(), and wrt_quick_mod::wrt_quick_pio().

Here is the call graph for this function:
Here is the caller graph for this function: