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

Functions/Subroutines

subroutine, public uv3dmix2 (ng, tile)
 
subroutine uv3dmix2_geo_tile (ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nrhs, nnew, pmask, rmask, umask, vmask, pmask_wet, rmask_wet, umask_wet, vmask_wet, om_p, om_r, om_u, om_v, on_p, on_r, on_u, on_v, pm, pn, hz, z_r, visc3d_r, visc2_p, visc2_r, diarufrc, diarvfrc, diau3wrk, diav3wrk, u, v, rufrc, rvfrc)
 
subroutine uv3dmix2_s_tile (ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nrhs, nnew, pmask, pmask_wet, hz, om_p, om_r, on_p, on_r, pm, pmon_p, pmon_r, pn, pnom_p, pnom_r, visc3d_r, visc2_p, visc2_r, diarufrc, diarvfrc, diau3wrk, diav3wrk, rufrc, rvfrc, u, v)
 

Function/Subroutine Documentation

◆ uv3dmix2()

subroutine public uv3dmix2_mod::uv3dmix2 ( integer, intent(in) ng,
integer, intent(in) tile )

Definition at line 42 of file uv3dmix2_geo.h.

43!***********************************************************************
44!
45 USE mod_param
46 USE mod_coupling
47#ifdef DIAGNOSTICS_UV
48 USE mod_diags
49#endif
50 USE mod_grid
51 USE mod_mixing
52 USE mod_ocean
53 USE mod_stepping
54!
55! Imported variable declarations.
56!
57 integer, intent(in) :: ng, tile
58!
59! Local variable declarations.
60!
61 character (len=*), parameter :: MyFile = &
62 & __FILE__
63!
64#include "tile.h"
65!
66#ifdef PROFILE
67 CALL wclock_on (ng, inlm, 31, __line__, myfile)
68#endif
69 CALL uv3dmix2_geo_tile (ng, tile, &
70 & lbi, ubi, lbj, ubj, &
71 & imins, imaxs, jmins, jmaxs, &
72 & nrhs(ng), nnew(ng), &
73#ifdef MASKING
74 & grid(ng) % pmask, &
75 & grid(ng) % rmask, &
76 & grid(ng) % umask, &
77 & grid(ng) % vmask, &
78#endif
79#ifdef WET_DRY
80 & grid(ng) % pmask_wet, &
81 & grid(ng) % rmask_wet, &
82 & grid(ng) % umask_wet, &
83 & grid(ng) % vmask_wet, &
84#endif
85 & grid(ng) % om_p, &
86 & grid(ng) % om_r, &
87 & grid(ng) % om_u, &
88 & grid(ng) % om_v, &
89 & grid(ng) % on_p, &
90 & grid(ng) % on_r, &
91 & grid(ng) % on_u, &
92 & grid(ng) % on_v, &
93 & grid(ng) % pm, &
94 & grid(ng) % pn, &
95 & grid(ng) % Hz, &
96 & grid(ng) % z_r, &
97#ifdef VISC_3DCOEF
98 & mixing(ng) % visc3d_r, &
99#else
100 & mixing(ng) % visc2_p, &
101 & mixing(ng) % visc2_r, &
102#endif
103#ifdef DIAGNOSTICS_UV
104 & diags(ng) % DiaRUfrc, &
105 & diags(ng) % DiaRVfrc, &
106 & diags(ng) % DiaU3wrk, &
107 & diags(ng) % DiaV3wrk, &
108#endif
109 & ocean(ng) % u, &
110 & ocean(ng) % v, &
111 & coupling(ng) % rufrc, &
112 & coupling(ng) % rvfrc)
113#ifdef PROFILE
114 CALL wclock_off (ng, inlm, 31, __line__, myfile)
115#endif
116!
117 RETURN
mod_coupling
Definition mod_coupling.F:2
mod_coupling::coupling
type(t_coupling), dimension(:), allocatable coupling
Definition mod_coupling.F:102
mod_diags
Definition mod_diags.F:2
mod_diags::diags
type(t_diags), dimension(:), allocatable diags
Definition mod_diags.F:100
mod_grid
Definition mod_grid.F:2
mod_grid::grid
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
mod_mixing
Definition mod_mixing.F:2
mod_mixing::mixing
type(t_mixing), dimension(:), allocatable mixing
Definition mod_mixing.F:399
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_stepping
Definition mod_stepping.F:2
mod_stepping::nrhs
integer, dimension(:), allocatable nrhs
Definition mod_stepping.F:70
mod_stepping::nnew
integer, dimension(:), allocatable nnew
Definition mod_stepping.F:69
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_coupling::coupling, mod_diags::diags, mod_grid::grid, mod_param::inlm, mod_mixing::mixing, mod_stepping::nnew, mod_stepping::nrhs, mod_ocean::ocean, uv3dmix2_geo_tile(), wclock_off(), and wclock_on().

Referenced by rhs3d_mod::rhs3d().

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

◆ uv3dmix2_geo_tile()

subroutine uv3dmix2_mod::uv3dmix2_geo_tile ( 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) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) nrhs,
integer, intent(in) nnew,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) pmask,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) rmask,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) umask,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) vmask,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) pmask_wet,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) rmask_wet,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) umask_wet,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) vmask_wet,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) om_p,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) om_r,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) om_u,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) om_v,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) on_p,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) on_r,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) on_u,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) on_v,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) pm,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) pn,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng)), intent(in) hz,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng)), intent(in) z_r,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng)), intent(in) visc3d_r,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) visc2_p,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) visc2_r,
real(r8), dimension(lbi:ubi,lbj:ubj,3,ndm2d-1), intent(inout) diarufrc,
real(r8), dimension(lbi:ubi,lbj:ubj,3,ndm2d-1), intent(inout) diarvfrc,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),ndm3d), intent(inout) diau3wrk,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),ndm3d), intent(inout) diav3wrk,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(inout) u,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(inout) v,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(inout) rufrc,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(inout) rvfrc )
private

Definition at line 121 of file uv3dmix2_geo.h.

147!***********************************************************************
148!
149 USE mod_param
150 USE mod_scalars
151!
152! Imported variable declarations.
153!
154 integer, intent(in) :: ng, tile
155 integer, intent(in) :: LBi, UBi, LBj, UBj
156 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
157 integer, intent(in) :: nrhs, nnew
158
159#ifdef ASSUMED_SHAPE
160# ifdef MASKING
161 real(r8), intent(in) :: pmask(LBi:,LBj:)
162 real(r8), intent(in) :: rmask(LBi:,LBj:)
163 real(r8), intent(in) :: umask(LBi:,LBj:)
164 real(r8), intent(in) :: vmask(LBi:,LBj:)
165# endif
166# ifdef WET_DRY
167 real(r8), intent(in) :: pmask_wet(LBi:,LBj:)
168 real(r8), intent(in) :: rmask_wet(LBi:,LBj:)
169 real(r8), intent(in) :: umask_wet(LBi:,LBj:)
170 real(r8), intent(in) :: vmask_wet(LBi:,LBj:)
171# endif
172 real(r8), intent(in) :: om_p(LBi:,LBj:)
173 real(r8), intent(in) :: om_r(LBi:,LBj:)
174 real(r8), intent(in) :: om_u(LBi:,LBj:)
175 real(r8), intent(in) :: om_v(LBi:,LBj:)
176 real(r8), intent(in) :: on_p(LBi:,LBj:)
177 real(r8), intent(in) :: on_r(LBi:,LBj:)
178 real(r8), intent(in) :: on_u(LBi:,LBj:)
179 real(r8), intent(in) :: on_v(LBi:,LBj:)
180 real(r8), intent(in) :: pm(LBi:,LBj:)
181 real(r8), intent(in) :: pn(LBi:,LBj:)
182 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
183 real(r8), intent(in) :: z_r(LBi:,LBj:,:)
184# ifdef VISC_3DCOEF
185 real(r8), intent(in) :: visc3d_r(LBi:,LBj:,:)
186# else
187 real(r8), intent(in) :: visc2_p(LBi:,LBj:)
188 real(r8), intent(in) :: visc2_r(LBi:,LBj:)
189# endif
190# ifdef DIAGNOSTICS_UV
191 real(r8), intent(inout) :: DiaRUfrc(LBi:,LBj:,:,:)
192 real(r8), intent(inout) :: DiaRVfrc(LBi:,LBj:,:,:)
193 real(r8), intent(inout) :: DiaU3wrk(LBi:,LBj:,:,:)
194 real(r8), intent(inout) :: DiaV3wrk(LBi:,LBj:,:,:)
195# endif
196 real(r8), intent(inout) :: rufrc(LBi:,LBj:)
197 real(r8), intent(inout) :: rvfrc(LBi:,LBj:)
198 real(r8), intent(inout) :: u(LBi:,LBj:,:,:)
199 real(r8), intent(inout) :: v(LBi:,LBj:,:,:)
200#else
201# ifdef MASKING
202 real(r8), intent(in) :: pmask(LBi:UBi,LBj:UBj)
203 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
204 real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
205 real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
206# endif
207# ifdef WET_DRY
208 real(r8), intent(in) :: pmask_wet(LBi:UBi,LBj:UBj)
209 real(r8), intent(in) :: rmask_wet(LBi:UBi,LBj:UBj)
210 real(r8), intent(in) :: umask_wet(LBi:UBi,LBj:UBj)
211 real(r8), intent(in) :: vmask_wet(LBi:UBi,LBj:UBj)
212# endif
213 real(r8), intent(in) :: om_p(LBi:UBi,LBj:UBj)
214 real(r8), intent(in) :: om_r(LBi:UBi,LBj:UBj)
215 real(r8), intent(in) :: om_u(LBi:UBi,LBj:UBj)
216 real(r8), intent(in) :: om_v(LBi:UBi,LBj:UBj)
217 real(r8), intent(in) :: on_p(LBi:UBi,LBj:UBj)
218 real(r8), intent(in) :: on_r(LBi:UBi,LBj:UBj)
219 real(r8), intent(in) :: on_u(LBi:UBi,LBj:UBj)
220 real(r8), intent(in) :: on_v(LBi:UBi,LBj:UBj)
221 real(r8), intent(in) :: pm(LBi:UBi,LBj:UBj)
222 real(r8), intent(in) :: pn(LBi:UBi,LBj:UBj)
223 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
224 real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
225# ifdef VISC_3DCOEF
226 real(r8), intent(in) :: visc3d_r(LBi:UBi,LBj:UBj,N(ng))
227# else
228 real(r8), intent(in) :: visc2_p(LBi:UBi,LBj:UBj)
229 real(r8), intent(in) :: visc2_r(LBi:UBi,LBj:UBj)
230# endif
231# ifdef DIAGNOSTICS_UV
232 real(r8), intent(inout) :: DiaRUfrc(LBi:UBi,LBj:UBj,3,NDM2d-1)
233 real(r8), intent(inout) :: DiaRVfrc(LBi:UBi,LBj:UBj,3,NDM2d-1)
234 real(r8), intent(inout) :: DiaU3wrk(LBi:UBi,LBj:UBj,N(ng),NDM3d)
235 real(r8), intent(inout) :: DiaV3wrk(LBi:UBi,LBj:UBj,N(ng),NDM3d)
236# endif
237 real(r8), intent(inout) :: rufrc(LBi:UBi,LBj:UBj)
238 real(r8), intent(inout) :: rvfrc(LBi:UBi,LBj:UBj)
239 real(r8), intent(inout) :: u(LBi:UBi,LBj:UBj,N(ng),2)
240 real(r8), intent(inout) :: v(LBi:UBi,LBj:UBj,N(ng),2)
241#endif
242!
243! Local variable declarations.
244!
245 integer :: i, j, k, k1, k2
246
247 real(r8) :: cff, fac1, fac2, pm_p, pn_p
248 real(r8) :: cff1, cff2, cff3, cff4
249 real(r8) :: cff5, cff6, cff7, cff8
250 real(r8) :: dmUdz, dnUdz, dmVdz, dnVdz
251#ifdef VISC_3DCOEF
252 real(r8) :: visc_p
253#endif
254 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: UFe
255 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: VFe
256 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: UFx
257 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: VFx
258
259 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: UFse
260 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: UFsx
261 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: VFse
262 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: VFsx
263 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dmUde
264 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dmVde
265 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dnUdx
266 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dnVdx
267 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dUdz
268 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dVdz
269 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dZde_p
270 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dZde_r
271 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dZdx_p
272 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dZdx_r
273
274#include "set_bounds.h"
275!
276!-----------------------------------------------------------------------
277! Compute horizontal harmonic viscosity along geopotential surfaces.
278!-----------------------------------------------------------------------
279!
280! Compute horizontal and vertical gradients. Notice the recursive
281! blocking sequence. The vertical placement of the gradients is:
282!
283! dZdx_r, dZde_r, dnUdx, dmVde(:,:,k1) k rho-points
284! dZdx_r, dZde_r, dnUdx, dmVde(:,:,k2) k+1 rho-points
285! dZdx_p, dZde_p, dnVdx, dmUde(:,:,k1) k psi-points
286! dZdx_p, dZde_p, dnVdx, dmUde(:,:,k2) k+1 psi-points
287! UFse, UFsx, dUdz(:,:,k1) k-1/2 WU-points
288! UFse, UFsx, dUdz(:,:,k2) k+1/2 WU-points
289! VFse, VFsx, dVdz(:,:,k1) k-1/2 WV-points
290! VFse, VFsx, dVdz(:,:,k2) k+1/2 WV-points
291!
292 k2=1
293 k_loop : DO k=0,n(ng)
294 k1=k2
295 k2=3-k1
296 IF (k.lt.n(ng)) THEN
297!
298! Compute slopes (nondimensional) at RHO- and PSI-points.
299!
300 DO j=jstr-1,jend+1
301 DO i=istru-1,iend+1
302 cff=0.5_r8*(pm(i-1,j)+pm(i,j))
303#ifdef MASKING
304 cff=cff*umask(i,j)
305#endif
306#ifdef WET_DRY
307 cff=cff*umask_wet(i,j)
308#endif
309 ufx(i,j)=cff*(z_r(i ,j,k+1)- &
310 & z_r(i-1,j,k+1))
311 END DO
312 END DO
313 DO j=jstrv-1,jend+1
314 DO i=istr-1,iend+1
315 cff=0.5_r8*(pn(i,j-1)+pn(i,j))
316#ifdef MASKING
317 cff=cff*vmask(i,j)
318#endif
319#ifdef WET_DRY
320 cff=cff*vmask_wet(i,j)
321#endif
322 vfe(i,j)=cff*(z_r(i,j ,k+1)- &
323 & z_r(i,j-1,k+1))
324 END DO
325 END DO
326!
327 DO j=jstr,jend+1
328 DO i=istr,iend+1
329 dzdx_p(i,j,k2)=0.5_r8*(ufx(i,j-1)+ &
330 & ufx(i,j ))
331 dzde_p(i,j,k2)=0.5_r8*(vfe(i-1,j)+ &
332 & vfe(i ,j))
333 END DO
334 END DO
335 DO j=jstrv-1,jend
336 DO i=istru-1,iend
337 dzdx_r(i,j,k2)=0.5_r8*(ufx(i ,j)+ &
338 & ufx(i+1,j))
339 dzde_r(i,j,k2)=0.5_r8*(vfe(i,j )+ &
340 & vfe(i,j+1))
341 END DO
342 END DO
343!
344! Compute momentum horizontal (1/m/s) and vertical (1/s) gradients.
345!
346 DO j=jstrv-1,jend
347 DO i=istru-1,iend
348 cff=0.5_r8*pm(i,j)
349#ifdef MASKING
350 cff=cff*rmask(i,j)
351#endif
352#ifdef WET_DRY
353 cff=cff*rmask_wet(i,j)
354#endif
355 dnudx(i,j,k2)=cff*((pn(i ,j)+pn(i+1,j))* &
356 & u(i+1,j,k+1,nrhs)- &
357 & (pn(i-1,j)+pn(i ,j))* &
358 & u(i ,j,k+1,nrhs))
359 END DO
360 END DO
361
362 DO j=jstr,jend+1
363 DO i=istr,iend+1
364 cff=0.125_r8*(pn(i-1,j )+pn(i,j )+ &
365 & pn(i-1,j-1)+pn(i,j-1))
366#ifdef MASKING
367 cff=cff*pmask(i,j)
368#endif
369#ifdef WET_DRY
370 cff=cff*pmask_wet(i,j)
371#endif
372 dmude(i,j,k2)=cff*((pm(i-1,j )+pm(i,j ))* &
373 & u(i,j ,k+1,nrhs)- &
374 & (pm(i-1,j-1)+pm(i,j-1))* &
375 & u(i,j-1,k+1,nrhs))
376 END DO
377 END DO
378
379 DO j=jstr,jend+1
380 DO i=istr,iend+1
381 cff=0.125_r8*(pm(i-1,j )+pm(i,j )+ &
382 & pm(i-1,j-1)+pm(i,j-1))
383#ifdef MASKING
384 cff=cff*pmask(i,j)
385#endif
386#ifdef WET_DRY
387 cff=cff*pmask_wet(i,j)
388#endif
389 dnvdx(i,j,k2)=cff*((pn(i ,j-1)+pn(i ,j))* &
390 & v(i ,j,k+1,nrhs)- &
391 & (pn(i-1,j-1)+pn(i-1,j))* &
392 & v(i-1,j,k+1,nrhs))
393 END DO
394 END DO
395
396 DO j=jstrv-1,jend
397 DO i=istru-1,iend
398 cff=0.5_r8*pn(i,j)
399#ifdef MASKING
400 cff=cff*rmask(i,j)
401#endif
402#ifdef WET_DRY
403 cff=cff*rmask_wet(i,j)
404#endif
405 dmvde(i,j,k2)=cff*((pm(i,j )+pm(i,j+1))* &
406 & v(i,j+1,k+1,nrhs)- &
407 & (pm(i,j-1)+pm(i,j ))* &
408 & v(i,j ,k+1,nrhs))
409 END DO
410 END DO
411 END IF
412
413 IF ((k.eq.0).or.(k.eq.n(ng))) THEN
414 DO j=jstr-1,jend+1
415 DO i=istru-1,iend+1
416 dudz(i,j,k2)=0.0_r8
417 END DO
418 END DO
419 DO j=jstrv-1,jend+1
420 DO i=istr-1,iend+1
421 dvdz(i,j,k2)=0.0_r8
422 END DO
423 END DO
424
425 DO j=jstr,jend
426 DO i=istru,iend
427 ufsx(i,j,k2)=0.0_r8
428 ufse(i,j,k2)=0.0_r8
429 END DO
430 END DO
431 DO j=jstrv,jend
432 DO i=istr,iend
433 vfsx(i,j,k2)=0.0_r8
434 vfse(i,j,k2)=0.0_r8
435 END DO
436 END DO
437 ELSE
438 DO j=jstr-1,jend+1
439 DO i=istru-1,iend+1
440 cff=1.0_r8/(0.5_r8*(z_r(i-1,j,k+1)-z_r(i-1,j,k)+ &
441 & z_r(i ,j,k+1)-z_r(i ,j,k)))
442 dudz(i,j,k2)=cff*(u(i,j,k+1,nrhs)- &
443 & u(i,j,k ,nrhs))
444 END DO
445 END DO
446
447 DO j=jstrv-1,jend+1
448 DO i=istr-1,iend+1
449 cff=1.0_r8/(0.5_r8*(z_r(i,j-1,k+1)-z_r(i,j-1,k)+ &
450 & z_r(i,j ,k+1)-z_r(i,j ,k)))
451 dvdz(i,j,k2)=cff*(v(i,j,k+1,nrhs)- &
452 & v(i,j,k ,nrhs))
453 END DO
454 END DO
455 END IF
456!
457! Compute components of the rotated viscous flux (m5/s2) along
458! geopotential surfaces in the XI- and ETA-directions.
459!
460 IF (k.gt.0) THEN
461 DO j=jstrv-1,jend
462 DO i=istru-1,iend
463 cff1=min(dzdx_r(i,j,k1),0.0_r8)
464 cff2=max(dzdx_r(i,j,k1),0.0_r8)
465 cff3=min(dzde_r(i,j,k1),0.0_r8)
466 cff4=max(dzde_r(i,j,k1),0.0_r8)
467 cff=hz(i,j,k)* &
468 & (on_r(i,j)*(dnudx(i,j,k1)- &
469 & 0.5_r8*pn(i,j)* &
470 & (cff1*(dudz(i ,j,k1)+ &
471 & dudz(i+1,j,k2))+ &
472 & cff2*(dudz(i ,j,k2)+ &
473 & dudz(i+1,j,k1))))- &
474 & om_r(i,j)*(dmvde(i,j,k1)- &
475 & 0.5_r8*pm(i,j)* &
476 & (cff3*(dvdz(i,j ,k1)+ &
477 & dvdz(i,j+1,k2))+ &
478 & cff4*(dvdz(i,j ,k2)+ &
479 & dvdz(i,j+1,k1)))))
480#ifdef MASKING
481 cff=cff*rmask(i,j)
482#endif
483#ifdef WET_DRY
484 cff=cff*rmask_wet(i,j)
485#endif
486#ifdef VISC_3DCOEF
487 ufx(i,j)=on_r(i,j)*on_r(i,j)*visc3d_r(i,j,k)*cff
488 vfe(i,j)=om_r(i,j)*om_r(i,j)*visc3d_r(i,j,k)*cff
489#else
490 ufx(i,j)=on_r(i,j)*on_r(i,j)*visc2_r(i,j)*cff
491 vfe(i,j)=om_r(i,j)*om_r(i,j)*visc2_r(i,j)*cff
492#endif
493 END DO
494 END DO
495
496 DO j=jstr,jend+1
497 DO i=istr,iend+1
498 pm_p=0.25_r8*(pm(i-1,j-1)+pm(i-1,j)+ &
499 & pm(i ,j-1)+pm(i ,j))
500 pn_p=0.25_r8*(pn(i-1,j-1)+pn(i-1,j)+ &
501 & pn(i ,j-1)+pn(i ,j))
502 cff1=min(dzdx_p(i,j,k1),0.0_r8)
503 cff2=max(dzdx_p(i,j,k1),0.0_r8)
504 cff3=min(dzde_p(i,j,k1),0.0_r8)
505 cff4=max(dzde_p(i,j,k1),0.0_r8)
506 cff=0.25_r8* &
507 & (hz(i-1,j ,k)+hz(i,j ,k)+ &
508 & hz(i-1,j-1,k)+hz(i,j-1,k))* &
509 & (on_p(i,j)*(dnvdx(i,j,k1)- &
510 & 0.5_r8*pn_p* &
511 & (cff1*(dvdz(i-1,j,k1)+ &
512 & dvdz(i ,j,k2))+ &
513 & cff2*(dvdz(i-1,j,k2)+ &
514 & dvdz(i ,j,k1))))+ &
515 & om_p(i,j)*(dmude(i,j,k1)- &
516 & 0.5_r8*pm_p* &
517 & (cff3*(dudz(i,j-1,k1)+ &
518 & dudz(i,j ,k2))+ &
519 & cff4*(dudz(i,j-1,k2)+ &
520 & dudz(i,j ,k1)))))
521#ifdef MASKING
522 cff=cff*pmask(i,j)
523#endif
524#ifdef WET_DRY
525 cff=cff*pmask_wet(i,j)
526#endif
527#ifdef VISC_3DCOEF
528 visc_p=0.25_r8* &
529 & (visc3d_r(i-1,j-1,k)+visc3d_r(i-1,j,k)+ &
530 & visc3d_r(i ,j-1,k)+visc3d_r(i ,j,k))
531 ufe(i,j)=om_p(i,j)*om_p(i,j)*visc_p*cff
532 vfx(i,j)=on_p(i,j)*on_p(i,j)*visc_p*cff
533#else
534 ufe(i,j)=om_p(i,j)*om_p(i,j)*visc2_p(i,j)*cff
535 vfx(i,j)=on_p(i,j)*on_p(i,j)*visc2_p(i,j)*cff
536#endif
537 END DO
538 END DO
539!
540! Compute vertical flux (m2/s2) due to sloping terrain-following
541! surfaces.
542!
543 IF (k.lt.n(ng)) THEN
544 DO j=jstr,jend
545 DO i=istru,iend
546#ifdef VISC_3DCOEF
547 cff=0.125_r8* &
548 & (visc3d_r(i-1,j,k )+visc3d_r(i,j,k )+ &
549 & visc3d_r(i-1,j,k+1)+visc3d_r(i,j,k+1))
550 fac1=cff*on_u(i,j)
551 fac2=cff*om_u(i,j)
552#else
553 cff=0.25_r8*(visc2_r(i-1,j)+visc2_r(i,j))
554 fac1=cff*on_u(i,j)
555 fac2=cff*om_u(i,j)
556#endif
557 cff=0.5_r8*(pn(i-1,j)+pn(i,j))
558 dnudz=cff*dudz(i,j,k2)
559 dnvdz=cff*0.25_r8*(dvdz(i-1,j+1,k2)+ &
560 & dvdz(i ,j+1,k2)+ &
561 & dvdz(i-1,j ,k2)+ &
562 & dvdz(i ,j ,k2))
563 cff=0.5_r8*(pm(i-1,j)+pm(i,j))
564 dmudz=cff*dudz(i,j,k2)
565 dmvdz=cff*0.25_r8*(dvdz(i-1,j+1,k2)+ &
566 & dvdz(i ,j+1,k2)+ &
567 & dvdz(i-1,j ,k2)+ &
568 & dvdz(i ,j ,k2))
569
570 cff1=min(dzdx_r(i-1,j,k1),0.0_r8)
571 cff2=min(dzdx_r(i ,j,k2),0.0_r8)
572 cff3=max(dzdx_r(i-1,j,k2),0.0_r8)
573 cff4=max(dzdx_r(i ,j,k1),0.0_r8)
574 ufsx(i,j,k2)=fac1* &
575 & (cff1*(cff1*dnudz-dnudx(i-1,j,k1))+ &
576 & cff2*(cff2*dnudz-dnudx(i ,j,k2))+ &
577 & cff3*(cff3*dnudz-dnudx(i-1,j,k2))+ &
578 & cff4*(cff4*dnudz-dnudx(i ,j,k1)))
579
580 cff1=min(dzde_p(i,j ,k1),0.0_r8)
581 cff2=min(dzde_p(i,j+1,k2),0.0_r8)
582 cff3=max(dzde_p(i,j ,k2),0.0_r8)
583 cff4=max(dzde_p(i,j+1,k1),0.0_r8)
584 ufse(i,j,k2)=fac2* &
585 & (cff1*(cff1*dmudz-dmude(i,j ,k1))+ &
586 & cff2*(cff2*dmudz-dmude(i,j+1,k2))+ &
587 & cff3*(cff3*dmudz-dmude(i,j ,k2))+ &
588 & cff4*(cff4*dmudz-dmude(i,j+1,k1)))
589
590 cff1=min(dzde_p(i,j ,k1),0.0_r8)
591 cff2=min(dzde_p(i,j+1,k2),0.0_r8)
592 cff3=max(dzde_p(i,j ,k2),0.0_r8)
593 cff4=max(dzde_p(i,j+1,k1),0.0_r8)
594 cff5=min(dzdx_p(i,j ,k1),0.0_r8)
595 cff6=min(dzdx_p(i,j+1,k2),0.0_r8)
596 cff7=max(dzdx_p(i,j ,k2),0.0_r8)
597 cff8=max(dzdx_p(i,j+1,k1),0.0_r8)
598 ufsx(i,j,k2)=ufsx(i,j,k2)+ &
599 & fac1* &
600 & (cff1*(cff5*dnvdz-dnvdx(i,j ,k1))+ &
601 & cff2*(cff6*dnvdz-dnvdx(i,j+1,k2))+ &
602 & cff3*(cff7*dnvdz-dnvdx(i,j ,k2))+ &
603 & cff4*(cff8*dnvdz-dnvdx(i,j+1,k1)))
604
605 cff1=min(dzdx_r(i-1,j,k1),0.0_r8)
606 cff2=min(dzdx_r(i ,j,k2),0.0_r8)
607 cff3=max(dzdx_r(i-1,j,k2),0.0_r8)
608 cff4=max(dzdx_r(i ,j,k1),0.0_r8)
609 cff5=min(dzde_r(i-1,j,k1),0.0_r8)
610 cff6=min(dzde_r(i ,j,k2),0.0_r8)
611 cff7=max(dzde_r(i-1,j,k2),0.0_r8)
612 cff8=max(dzde_r(i ,j,k1),0.0_r8)
613 ufse(i,j,k2)=ufse(i,j,k2)- &
614 & fac2* &
615 & (cff1*(cff5*dmvdz-dmvde(i-1,j,k1))+ &
616 & cff2*(cff6*dmvdz-dmvde(i ,j,k2))+ &
617 & cff3*(cff7*dmvdz-dmvde(i-1,j,k2))+ &
618 & cff4*(cff8*dmvdz-dmvde(i ,j,k1)))
619 END DO
620 END DO
621!
622 DO j=jstrv,jend
623 DO i=istr,iend
624#ifdef VISC_3DCOEF
625 cff=0.125_r8* &
626 & (visc3d_r(i,j-1,k )+visc3d_r(i,j,k )+ &
627 & visc3d_r(i,j-1,k+1)+visc3d_r(i,j,k+1))
628 fac1=cff*on_v(i,j)
629 fac2=cff*om_v(i,j)
630#else
631 cff=0.25_r8*(visc2_r(i,j-1)+visc2_r(i,j))
632 fac1=cff*on_v(i,j)
633 fac2=cff*om_v(i,j)
634#endif
635 cff=0.5_r8*(pn(i,j-1)+pn(i,j))
636 dnudz=cff*0.25_r8*(dudz(i ,j ,k2)+ &
637 & dudz(i+1,j ,k2)+ &
638 & dudz(i ,j-1,k2)+ &
639 & dudz(i+1,j-1,k2))
640 dnvdz=cff*dvdz(i,j,k2)
641 cff=0.5_r8*(pm(i,j-1)+pm(i,j))
642 dmudz=cff*0.25_r8*(dudz(i ,j ,k2)+ &
643 & dudz(i+1,j ,k2)+ &
644 & dudz(i ,j-1,k2)+ &
645 & dudz(i+1,j-1,k2))
646 dmvdz=cff*dvdz(i,j,k2)
647
648 cff1=min(dzdx_p(i ,j,k1),0.0_r8)
649 cff2=min(dzdx_p(i+1,j,k2),0.0_r8)
650 cff3=max(dzdx_p(i ,j,k2),0.0_r8)
651 cff4=max(dzdx_p(i+1,j,k1),0.0_r8)
652 vfsx(i,j,k2)=fac1* &
653 & (cff1*(cff1*dnvdz-dnvdx(i ,j,k1))+ &
654 & cff2*(cff2*dnvdz-dnvdx(i+1,j,k2))+ &
655 & cff3*(cff3*dnvdz-dnvdx(i ,j,k2))+ &
656 & cff4*(cff4*dnvdz-dnvdx(i+1,j,k1)))
657
658 cff1=min(dzde_r(i,j-1,k1),0.0_r8)
659 cff2=min(dzde_r(i,j ,k2),0.0_r8)
660 cff3=max(dzde_r(i,j-1,k2),0.0_r8)
661 cff4=max(dzde_r(i,j ,k1),0.0_r8)
662 vfse(i,j,k2)=fac2* &
663 & (cff1*(cff1*dmvdz-dmvde(i,j-1,k1))+ &
664 & cff2*(cff2*dmvdz-dmvde(i,j ,k2))+ &
665 & cff3*(cff3*dmvdz-dmvde(i,j-1,k2))+ &
666 & cff4*(cff4*dmvdz-dmvde(i,j ,k1)))
667
668 cff1=min(dzde_r(i,j-1,k1),0.0_r8)
669 cff2=min(dzde_r(i,j ,k2),0.0_r8)
670 cff3=max(dzde_r(i,j-1,k2),0.0_r8)
671 cff4=max(dzde_r(i,j ,k1),0.0_r8)
672 cff5=min(dzdx_r(i,j-1,k1),0.0_r8)
673 cff6=min(dzdx_r(i,j ,k2),0.0_r8)
674 cff7=max(dzdx_r(i,j-1,k2),0.0_r8)
675 cff8=max(dzdx_r(i,j ,k1),0.0_r8)
676 vfsx(i,j,k2)=vfsx(i,j,k2)- &
677 & fac1* &
678 & (cff1*(cff5*dnudz-dnudx(i,j-1,k1))+ &
679 & cff2*(cff6*dnudz-dnudx(i,j ,k2))+ &
680 & cff3*(cff7*dnudz-dnudx(i,j-1,k2))+ &
681 & cff4*(cff8*dnudz-dnudx(i,j ,k1)))
682
683 cff1=min(dzdx_p(i ,j,k1),0.0_r8)
684 cff2=min(dzdx_p(i+1,j,k2),0.0_r8)
685 cff3=max(dzdx_p(i ,j,k2),0.0_r8)
686 cff4=max(dzdx_p(i+1,j,k1),0.0_r8)
687 cff5=min(dzde_p(i ,j,k1),0.0_r8)
688 cff6=min(dzde_p(i+1,j,k2),0.0_r8)
689 cff7=max(dzde_p(i ,j,k2),0.0_r8)
690 cff8=max(dzde_p(i+1,j,k1),0.0_r8)
691 vfse(i,j,k2)=vfse(i,j,k2)+ &
692 & fac2* &
693 & (cff1*(cff5*dmudz-dmude(i ,j,k1))+ &
694 & cff2*(cff6*dmudz-dmude(i+1,j,k2))+ &
695 & cff3*(cff7*dmudz-dmude(i ,j,k2))+ &
696 & cff4*(cff8*dmudz-dmude(i+1,j,k1)))
697 END DO
698 END DO
699 END IF
700!
701! Time-step harmonic, geopotential viscosity term. Notice that
702! momentum at this stage is HzU and HzV and has m2/s units. Add
703! contribution for barotropic forcing terms.
704#ifdef DIAGNOSTICS_UV
705! The rotated vertical term cannot be split from the horizontal
706! terms because of the 2D/3D momentum coupling.
707#endif
708!
709 DO j=jstr,jend
710 DO i=istru,iend
711 cff=dt(ng)*0.25_r8*(pm(i-1,j)+pm(i,j))*(pn(i-1,j)+pn(i,j))
712 cff1=0.5_r8*(pn(i-1,j)+pn(i,j))*(ufx(i,j )-ufx(i-1,j))
713 cff2=0.5_r8*(pm(i-1,j)+pm(i,j))*(ufe(i,j+1)-ufe(i ,j))
714 cff3=ufsx(i,j,k2)-ufsx(i,j,k1)
715 cff4=ufse(i,j,k2)-ufse(i,j,k1)
716 cff5=cff*(cff1+cff2)
717 cff6=dt(ng)*(cff3+cff4)
718 rufrc(i,j)=rufrc(i,j)+cff1+cff2+cff3+cff4
719 u(i,j,k,nnew)=u(i,j,k,nnew)+cff5+cff6
720#ifdef DIAGNOSTICS_UV
721 diarufrc(i,j,3,m2hvis)=diarufrc(i,j,3,m2hvis)+cff1+cff2+ &
722 & cff3+cff4
723 diarufrc(i,j,3,m2xvis)=diarufrc(i,j,3,m2xvis)+cff1+cff3
724 diarufrc(i,j,3,m2yvis)=diarufrc(i,j,3,m2yvis)+cff2+cff4
725 diau3wrk(i,j,k,m3hvis)=cff5+cff6
726 diau3wrk(i,j,k,m3xvis)=cff*cff1+dt(ng)*cff3
727 diau3wrk(i,j,k,m3yvis)=cff*cff2+dt(ng)*cff4
728#endif
729 END DO
730 END DO
731
732 DO j=jstrv,jend
733 DO i=istr,iend
734 cff=dt(ng)*0.25_r8*(pm(i,j)+pm(i,j-1))*(pn(i,j)+pn(i,j-1))
735 cff1=0.5_r8*(pn(i,j-1)+pn(i,j))*(vfx(i+1,j)-vfx(i,j ))
736 cff2=0.5_r8*(pm(i,j-1)+pm(i,j))*(vfe(i ,j)-vfe(i,j-1))
737 cff3=vfsx(i,j,k2)-vfsx(i,j,k1)
738 cff4=vfse(i,j,k2)-vfse(i,j,k1)
739 cff5=cff*(cff1-cff2)
740 cff6=dt(ng)*(cff3+cff4)
741 rvfrc(i,j)=rvfrc(i,j)+cff1-cff2+cff3+cff4
742 v(i,j,k,nnew)=v(i,j,k,nnew)+cff5+cff6
743#ifdef DIAGNOSTICS_UV
744 diarvfrc(i,j,3,m2hvis)=diarvfrc(i,j,3,m2hvis)+cff1-cff2+ &
745 & cff3+cff4
746 diarvfrc(i,j,3,m2xvis)=diarvfrc(i,j,3,m2xvis)+cff1+cff3
747 diarvfrc(i,j,3,m2yvis)=diarvfrc(i,j,3,m2yvis)-cff2+cff4
748 diav3wrk(i,j,k,m3hvis)=cff5+cff6
749 diav3wrk(i,j,k,m3xvis)= cff*cff1+dt(ng)*cff3
750 diav3wrk(i,j,k,m3yvis)=-cff*cff2+dt(ng)*cff4
751#endif
752 END DO
753 END DO
754 END IF
755 END DO k_loop
756!
757 RETURN
mod_param::n
integer, dimension(:), allocatable n
Definition mod_param.F:479
mod_scalars
Definition mod_scalars.F:2
mod_scalars::dt
real(dp), dimension(:), allocatable dt
Definition mod_scalars.F:269
mod_scalars::m3xvis
integer m3xvis
Definition mod_scalars.F:193
mod_scalars::m2hvis
integer m2hvis
Definition mod_scalars.F:168
mod_scalars::m3hvis
integer m3hvis
Definition mod_scalars.F:192
mod_scalars::m3yvis
integer m3yvis
Definition mod_scalars.F:194
mod_scalars::m2yvis
integer m2yvis
Definition mod_scalars.F:170
mod_scalars::m2xvis
integer m2xvis
Definition mod_scalars.F:169

References mod_scalars::dt, mod_scalars::m2hvis, mod_scalars::m2xvis, mod_scalars::m2yvis, mod_scalars::m3hvis, mod_scalars::m3xvis, and mod_scalars::m3yvis.

Referenced by uv3dmix2().

Here is the caller graph for this function:

◆ uv3dmix2_s_tile()

subroutine uv3dmix2_mod::uv3dmix2_s_tile ( 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) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) nrhs,
integer, intent(in) nnew,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) pmask,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) pmask_wet,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng)), intent(in) hz,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) om_p,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) om_r,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) on_p,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) on_r,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) pm,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) pmon_p,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) pmon_r,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) pn,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) pnom_p,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) pnom_r,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng)), intent(in) visc3d_r,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) visc2_p,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) visc2_r,
real(r8), dimension(lbi:ubi,lbj:ubj,3,ndm2d-1), intent(inout) diarufrc,
real(r8), dimension(lbi:ubi,lbj:ubj,3,ndm2d-1), intent(inout) diarvfrc,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),ndm3d), intent(inout) diau3wrk,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),ndm3d), intent(inout) diav3wrk,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(inout) rufrc,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(inout) rvfrc,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(inout) u,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(inout) v )
private

Definition at line 114 of file uv3dmix2_s.h.

138!***********************************************************************
139!
140 USE mod_param
141 USE mod_scalars
142!
143! Imported variable declarations.
144!
145 integer, intent(in) :: ng, tile
146 integer, intent(in) :: LBi, UBi, LBj, UBj
147 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
148 integer, intent(in) :: nrhs, nnew
149
150#ifdef ASSUMED_SHAPE
151# ifdef MASKING
152 real(r8), intent(in) :: pmask(LBi:,LBj:)
153# endif
154# ifdef WET_DRY
155 real(r8), intent(in) :: pmask_wet(LBi:,LBj:)
156# endif
157 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
158 real(r8), intent(in) :: om_p(LBi:,LBj:)
159 real(r8), intent(in) :: om_r(LBi:,LBj:)
160 real(r8), intent(in) :: on_p(LBi:,LBj:)
161 real(r8), intent(in) :: on_r(LBi:,LBj:)
162 real(r8), intent(in) :: pm(LBi:,LBj:)
163 real(r8), intent(in) :: pmon_p(LBi:,LBj:)
164 real(r8), intent(in) :: pmon_r(LBi:,LBj:)
165 real(r8), intent(in) :: pn(LBi:,LBj:)
166 real(r8), intent(in) :: pnom_p(LBi:,LBj:)
167 real(r8), intent(in) :: pnom_r(LBi:,LBj:)
168# ifdef VISC_3DCOEF
169 real(r8), intent(in) :: visc3d_r(LBi:,LBj:,:)
170# else
171 real(r8), intent(in) :: visc2_p(LBi:,LBj:)
172 real(r8), intent(in) :: visc2_r(LBi:,LBj:)
173# endif
174# ifdef DIAGNOSTICS_UV
175 real(r8), intent(inout) :: DiaRUfrc(LBi:,LBj:,:,:)
176 real(r8), intent(inout) :: DiaRVfrc(LBi:,LBj:,:,:)
177 real(r8), intent(inout) :: DiaU3wrk(LBi:,LBj:,:,:)
178 real(r8), intent(inout) :: DiaV3wrk(LBi:,LBj:,:,:)
179# endif
180 real(r8), intent(inout) :: rufrc(LBi:,LBj:)
181 real(r8), intent(inout) :: rvfrc(LBi:,LBj:)
182 real(r8), intent(inout) :: u(LBi:,LBj:,:,:)
183 real(r8), intent(inout) :: v(LBi:,LBj:,:,:)
184#else
185# ifdef MASKING
186 real(r8), intent(in) :: pmask(LBi:UBi,LBj:UBj)
187# endif
188# ifdef WET_DRY
189 real(r8), intent(in) :: pmask_wet(LBi:UBi,LBj:UBj)
190# endif
191 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
192 real(r8), intent(in) :: om_p(LBi:UBi,LBj:UBj)
193 real(r8), intent(in) :: om_r(LBi:UBi,LBj:UBj)
194 real(r8), intent(in) :: on_p(LBi:UBi,LBj:UBj)
195 real(r8), intent(in) :: on_r(LBi:UBi,LBj:UBj)
196 real(r8), intent(in) :: pm(LBi:UBi,LBj:UBj)
197 real(r8), intent(in) :: pmon_p(LBi:UBi,LBj:UBj)
198 real(r8), intent(in) :: pmon_r(LBi:UBi,LBj:UBj)
199 real(r8), intent(in) :: pn(LBi:UBi,LBj:UBj)
200 real(r8), intent(in) :: pnom_p(LBi:UBi,LBj:UBj)
201 real(r8), intent(in) :: pnom_r(LBi:UBi,LBj:UBj)
202# ifdef VISC_3DCOEF
203 real(r8), intent(in) :: visc3d_r(LBi:UBi,LBj:UBj,N(ng))
204# else
205 real(r8), intent(in) :: visc2_p(LBi:UBi,LBj:UBj)
206 real(r8), intent(in) :: visc2_r(LBi:UBi,LBj:UBj)
207# endif
208# ifdef DIAGNOSTICS_UV
209 real(r8), intent(inout) :: DiaRUfrc(LBi:UBi,LBj:UBj,3,NDM2d-1)
210 real(r8), intent(inout) :: DiaRVfrc(LBi:UBi,LBj:UBj,3,NDM2d-1)
211 real(r8), intent(inout) :: DiaU3wrk(LBi:UBi,LBj:UBj,N(ng),NDM3d)
212 real(r8), intent(inout) :: DiaV3wrk(LBi:UBi,LBj:UBj,N(ng),NDM3d)
213# endif
214 real(r8), intent(inout) :: rufrc(LBi:UBi,LBj:UBj)
215 real(r8), intent(inout) :: rvfrc(LBi:UBi,LBj:UBj)
216 real(r8), intent(inout) :: u(LBi:UBi,LBj:UBj,N(ng),2)
217 real(r8), intent(inout) :: v(LBi:UBi,LBj:UBj,N(ng),2)
218#endif
219!
220! Local variable declarations.
221!
222 integer :: i, j, k
223
224 real(r8) :: cff, cff1, cff2, cff3
225#ifdef VISC_3DCOEF
226 real(r8) :: visc_p
227#endif
228 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: UFe
229 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: VFe
230 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: UFx
231 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: VFx
232
233#include "set_bounds.h"
234!
235!-----------------------------------------------------------------------
236! Compute horizontal harmonic viscosity along constant S-surfaces.
237!-----------------------------------------------------------------------
238!
239 k_loop : DO k=1,n(ng)
240!
241! Compute flux-components of the horizontal divergence of the stress
242! tensor (m5/s2) in XI- and ETA-directions.
243!
244 DO j=jstrv-1,jend
245 DO i=istru-1,iend
246 cff=hz(i,j,k)*0.5_r8* &
247 & (pmon_r(i,j)* &
248 & ((pn(i ,j)+pn(i+1,j))*u(i+1,j,k,nrhs)- &
249 & (pn(i-1,j)+pn(i ,j))*u(i ,j,k,nrhs))- &
250 & pnom_r(i,j)* &
251 & ((pm(i,j )+pm(i,j+1))*v(i,j+1,k,nrhs)- &
252 & (pm(i,j-1)+pm(i,j ))*v(i,j ,k,nrhs)))
253#ifdef VISC_3DCOEF
254 ufx(i,j)=on_r(i,j)*on_r(i,j)*visc3d_r(i,j,k)*cff
255 vfe(i,j)=om_r(i,j)*om_r(i,j)*visc3d_r(i,j,k)*cff
256#else
257 ufx(i,j)=on_r(i,j)*on_r(i,j)*visc2_r(i,j)*cff
258 vfe(i,j)=om_r(i,j)*om_r(i,j)*visc2_r(i,j)*cff
259#endif
260 END DO
261 END DO
262 DO j=jstr,jend+1
263 DO i=istr,iend+1
264 cff=0.125_r8*(hz(i-1,j ,k)+hz(i,j ,k)+ &
265 & hz(i-1,j-1,k)+hz(i,j-1,k))* &
266 & (pmon_p(i,j)* &
267 & ((pn(i ,j-1)+pn(i ,j))*v(i ,j,k,nrhs)- &
268 & (pn(i-1,j-1)+pn(i-1,j))*v(i-1,j,k,nrhs))+ &
269 & pnom_p(i,j)* &
270 & ((pm(i-1,j )+pm(i,j ))*u(i,j ,k,nrhs)- &
271 & (pm(i-1,j-1)+pm(i,j-1))*u(i,j-1,k,nrhs)))
272#ifdef MASKING
273 cff=cff*pmask(i,j)
274#endif
275#ifdef WET_DRY
276 cff=cff*pmask_wet(i,j)
277#endif
278#ifdef VISC_3DCOEF
279 visc_p=0.25_r8*(visc3d_r(i-1,j-1,k)+visc3d_r(i-1,j,k)+ &
280 & visc3d_r(i ,j-1,k)+visc3d_r(i ,j,k))
281 ufe(i,j)=om_p(i,j)*om_p(i,j)*visc_p*cff
282 vfx(i,j)=on_p(i,j)*on_p(i,j)*visc_p*cff
283#else
284 ufe(i,j)=om_p(i,j)*om_p(i,j)*visc2_p(i,j)*cff
285 vfx(i,j)=on_p(i,j)*on_p(i,j)*visc2_p(i,j)*cff
286#endif
287 END DO
288 END DO
289!
290! Time-step harmonic, S-surfaces viscosity term. Notice that momentum
291! at this stage is HzU and HzV and has m2/s units. Add contribution for
292! barotropic forcing terms.
293!
294 DO j=jstr,jend
295 DO i=istru,iend
296 cff=dt(ng)*0.25_r8*(pm(i-1,j)+pm(i,j))*(pn(i-1,j)+pn(i,j))
297 cff1=0.5_r8*(pn(i-1,j)+pn(i,j))*(ufx(i,j )-ufx(i-1,j))
298 cff2=0.5_r8*(pm(i-1,j)+pm(i,j))*(ufe(i,j+1)-ufe(i ,j))
299 cff3=cff*(cff1+cff2)
300 rufrc(i,j)=rufrc(i,j)+cff1+cff2
301 u(i,j,k,nnew)=u(i,j,k,nnew)+cff3
302#ifdef DIAGNOSTICS_UV
303 diarufrc(i,j,3,m2hvis)=diarufrc(i,j,3,m2hvis)+cff1+cff2
304 diarufrc(i,j,3,m2xvis)=diarufrc(i,j,3,m2xvis)+cff1
305 diarufrc(i,j,3,m2yvis)=diarufrc(i,j,3,m2yvis)+cff2
306 diau3wrk(i,j,k,m3hvis)=cff3
307 diau3wrk(i,j,k,m3xvis)=cff*cff1
308 diau3wrk(i,j,k,m3yvis)=cff*cff2
309#endif
310 END DO
311 END DO
312 DO j=jstrv,jend
313 DO i=istr,iend
314 cff=dt(ng)*0.25_r8*(pm(i,j)+pm(i,j-1))*(pn(i,j)+pn(i,j-1))
315 cff1=0.5_r8*(pn(i,j-1)+pn(i,j))*(vfx(i+1,j)-vfx(i,j ))
316 cff2=0.5_r8*(pm(i,j-1)+pm(i,j))*(vfe(i ,j)-vfe(i,j-1))
317 cff3=cff*(cff1-cff2)
318 rvfrc(i,j)=rvfrc(i,j)+cff1-cff2
319 v(i,j,k,nnew)=v(i,j,k,nnew)+cff3
320#ifdef DIAGNOSTICS_UV
321 diarvfrc(i,j,3,m2hvis)=diarvfrc(i,j,3,m2hvis)+cff1-cff2
322 diarvfrc(i,j,3,m2xvis)=diarvfrc(i,j,3,m2xvis)+cff1
323 diarvfrc(i,j,3,m2yvis)=diarvfrc(i,j,3,m2yvis)-cff2
324 diav3wrk(i,j,k,m3hvis)=cff3
325 diav3wrk(i,j,k,m3xvis)= cff*cff1
326 diav3wrk(i,j,k,m3yvis)=-cff*cff2
327#endif
328 END DO
329 END DO
330 END DO k_loop
331!
332 RETURN

References mod_scalars::dt, mod_scalars::m2hvis, mod_scalars::m2xvis, mod_scalars::m2yvis, mod_scalars::m3hvis, mod_scalars::m3xvis, and mod_scalars::m3yvis.