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

Functions/Subroutines

subroutine, public tl_uv3dmix2 (ng, tile)
 
subroutine tl_uv3dmix2_geo_tile (ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nrhs, nnew, pmask, rmask, umask, vmask, om_p, om_r, om_u, om_v, on_p, on_r, on_u, on_v, pm, pn, hz, tl_hz, z_r, tl_z_r, visc3d_r, tl_visc3d_r, visc2_p, visc2_r, u, v, tl_u, tl_v, tl_rufrc, tl_rvfrc)
 
subroutine tl_uv3dmix2_s_tile (ng, tile, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nrhs, nnew, pmask, hz, tl_hz, om_p, om_r, on_p, on_r, pm, pmon_p, pmon_r, pn, pnom_p, pnom_r, visc2_p, visc2_r, u, v, tl_rufrc, tl_rvfrc, tl_u, tl_v)
 

Function/Subroutine Documentation

◆ tl_uv3dmix2()

subroutine public tl_uv3dmix2_mod::tl_uv3dmix2 ( integer, intent(in) ng,
integer, intent(in) tile )

Definition at line 42 of file tl_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, itlm, 31, __line__, myfile)
68#endif
69 CALL tl_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 & grid(ng) % om_p, &
80 & grid(ng) % om_r, &
81 & grid(ng) % om_u, &
82 & grid(ng) % om_v, &
83 & grid(ng) % on_p, &
84 & grid(ng) % on_r, &
85 & grid(ng) % on_u, &
86 & grid(ng) % on_v, &
87 & grid(ng) % pm, &
88 & grid(ng) % pn, &
89 & grid(ng) % Hz, &
90 & grid(ng) % tl_Hz, &
91 & grid(ng) % z_r, &
92 & grid(ng) % tl_z_r, &
93#ifdef VISC_3DCOEF
94 & mixing(ng) % visc3d_r, &
95 & mixing(ng) % tl_visc3d_r, &
96#else
97 & mixing(ng) % visc2_p, &
98 & mixing(ng) % visc2_r, &
99#endif
100#ifdef DIAGNOSTICS_UV
101!! & DIAGS(ng) % DiaRUfrc, &
102!! & DIAGS(ng) % DiaRVfrc, &
103!! & DIAGS(ng) % DiaU3wrk, &
104!! & DIAGS(ng) % DiaV3wrk, &
105#endif
106 & ocean(ng) % u, &
107 & ocean(ng) % v, &
108 & ocean(ng) % tl_u, &
109 & ocean(ng) % tl_v, &
110 & coupling(ng) % tl_rufrc, &
111 & coupling(ng) % tl_rvfrc)
112#ifdef PROFILE
113 CALL wclock_off (ng, itlm, 31, __line__, myfile)
114#endif
115!
116 RETURN
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_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::itlm
integer, parameter itlm
Definition mod_param.F:663
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_grid::grid, mod_param::itlm, mod_mixing::mixing, mod_stepping::nnew, mod_stepping::nrhs, mod_ocean::ocean, tl_uv3dmix2_geo_tile(), wclock_off(), and wclock_on().

Referenced by tl_rhs3d_mod::tl_rhs3d().

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

◆ tl_uv3dmix2_geo_tile()

subroutine tl_uv3dmix2_mod::tl_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) 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) tl_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) tl_z_r,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng)), intent(in) visc3d_r,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng)), intent(inout) tl_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,n(ng),2), intent(in) u,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(in) v,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(inout) tl_u,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(inout) tl_v,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(inout) tl_rufrc,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(inout) tl_rvfrc )
private

Definition at line 120 of file tl_uv3dmix2_geo.h.

144!***********************************************************************
145!
146 USE mod_param
147 USE mod_scalars
148!
149! Imported variable declarations.
150!
151 integer, intent(in) :: ng, tile
152 integer, intent(in) :: LBi, UBi, LBj, UBj
153 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
154 integer, intent(in) :: nrhs, nnew
155
156#ifdef ASSUMED_SHAPE
157# ifdef MASKING
158 real(r8), intent(in) :: pmask(LBi:,LBj:)
159 real(r8), intent(in) :: rmask(LBi:,LBj:)
160 real(r8), intent(in) :: umask(LBi:,LBj:)
161 real(r8), intent(in) :: vmask(LBi:,LBj:)
162# endif
163 real(r8), intent(in) :: om_p(LBi:,LBj:)
164 real(r8), intent(in) :: om_r(LBi:,LBj:)
165 real(r8), intent(in) :: om_u(LBi:,LBj:)
166 real(r8), intent(in) :: om_v(LBi:,LBj:)
167 real(r8), intent(in) :: on_p(LBi:,LBj:)
168 real(r8), intent(in) :: on_r(LBi:,LBj:)
169 real(r8), intent(in) :: on_u(LBi:,LBj:)
170 real(r8), intent(in) :: on_v(LBi:,LBj:)
171 real(r8), intent(in) :: pm(LBi:,LBj:)
172 real(r8), intent(in) :: pn(LBi:,LBj:)
173 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
174 real(r8), intent(in) :: tl_Hz(LBi:,LBj:,:)
175 real(r8), intent(in) :: z_r(LBi:,LBj:,:)
176 real(r8), intent(in) :: tl_z_r(LBi:,LBj:,:)
177# ifdef VISC_3DCOEF
178 real(r8), intent(in) :: visc3d_r(LBi:,LBj:,:)
179# else
180 real(r8), intent(in) :: visc2_p(LBi:,LBj:)
181 real(r8), intent(in) :: visc2_r(LBi:,LBj:)
182# endif
183 real(r8), intent(in) :: u(LBi:,LBj:,:,:)
184 real(r8), intent(in) :: v(LBi:,LBj:,:,:)
185
186# ifdef DIAGNOSTICS_UV
187!! real(r8), intent(inout) :: DiaRUfrc(LBi:,LBj:,:,:)
188!! real(r8), intent(inout) :: DiaRVfrc(LBi:,LBj:,:,:)
189!! real(r8), intent(inout) :: DiaU3wrk(LBi:,LBj:,:,:)
190!! real(r8), intent(inout) :: DiaV3wrk(LBi:,LBj:,:,:)
191# endif
192 real(r8), intent(inout) :: tl_rufrc(LBi:,LBj:)
193 real(r8), intent(inout) :: tl_rvfrc(LBi:,LBj:)
194 real(r8), intent(inout) :: tl_u(LBi:,LBj:,:,:)
195 real(r8), intent(inout) :: tl_v(LBi:,LBj:,:,:)
196# ifdef VISC_3DCOEF
197 real(r8), intent(inout) :: tl_visc3d_r(LBi:,LBj:,:)
198# endif
199
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 real(r8), intent(in) :: om_p(LBi:UBi,LBj:UBj)
208 real(r8), intent(in) :: om_r(LBi:UBi,LBj:UBj)
209 real(r8), intent(in) :: om_u(LBi:UBi,LBj:UBj)
210 real(r8), intent(in) :: om_v(LBi:UBi,LBj:UBj)
211 real(r8), intent(in) :: on_p(LBi:UBi,LBj:UBj)
212 real(r8), intent(in) :: on_r(LBi:UBi,LBj:UBj)
213 real(r8), intent(in) :: on_u(LBi:UBi,LBj:UBj)
214 real(r8), intent(in) :: on_v(LBi:UBi,LBj:UBj)
215 real(r8), intent(in) :: pm(LBi:UBi,LBj:UBj)
216 real(r8), intent(in) :: pn(LBi:UBi,LBj:UBj)
217 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
218 real(r8), intent(in) :: tl_Hz(LBi:UBi,LBj:UBj,N(ng))
219 real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
220 real(r8), intent(in) :: tl_z_r(LBi:UBi,LBj:UBj,N(ng))
221# ifdef VISC_3DCOEF
222 real(r8), intent(in) :: visc3d_r(LBi:UBi,LBj:UBj,N(ng))
223# else
224 real(r8), intent(in) :: visc2_p(LBi:UBi,LBj:UBj)
225 real(r8), intent(in) :: visc2_r(LBi:UBi,LBj:UBj)
226# endif
227 real(r8), intent(in) :: u(LBi:UBi,LBj:UBj,N(ng),2)
228 real(r8), intent(in) :: v(LBi:UBi,LBj:UBj,N(ng),2)
229
230# ifdef DIAGNOSTICS_UV
231!! real(r8), intent(inout) :: DiaRUfrc(LBi:UBi,LBj:UBj,3,NDM2d-1)
232!! real(r8), intent(inout) :: DiaRVfrc(LBi:UBi,LBj:UBj,3,NDM2d-1)
233!! real(r8), intent(inout) :: DiaU3wrk(LBi:UBi,LBj:UBj,N(ng),NDM3d)
234!! real(r8), intent(inout) :: DiaV3wrk(LBi:UBi,LBj:UBj,N(ng),NDM3d)
235# endif
236 real(r8), intent(inout) :: tl_rufrc(LBi:UBi,LBj:UBj)
237 real(r8), intent(inout) :: tl_rvfrc(LBi:UBi,LBj:UBj)
238 real(r8), intent(inout) :: tl_u(LBi:UBi,LBj:UBj,N(ng),2)
239 real(r8), intent(inout) :: tl_v(LBi:UBi,LBj:UBj,N(ng),2)
240# ifdef VISC_3DCOEF
241 real(r8), intent(inout) :: tl_visc3d_r(LBi:UBi,LBj:UBj,N(ng))
242# endif
243#endif
244!
245! Local variable declarations.
246!
247 integer :: i, j, k, k1, k2
248
249 real(r8) :: cff, fac1, fac2, pm_p, pn_p
250 real(r8) :: cff1, cff2, cff3, cff4
251 real(r8) :: cff5, cff6, cff7, cff8
252 real(r8) :: dmUdz, dnUdz, dmVdz, dnVdz
253#ifdef VISC_3DCOEF
254 real(r8) :: visc_p
255 real(r8) :: tl_fac1, tl_fac2, tl_visc_p
256#endif
257 real(r8) :: tl_cff
258 real(r8) :: tl_cff1, tl_cff2, tl_cff3, tl_cff4
259 real(r8) :: tl_cff5, tl_cff6, tl_cff7, tl_cff8
260 real(r8) :: tl_dmUdz, tl_dnUdz, tl_dmVdz, tl_dnVdz
261
262 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: UFx
263 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: VFe
264
265 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tl_UFe
266 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tl_UFx
267 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tl_VFe
268 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tl_VFx
269
270 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dmUde
271 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dmVde
272 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dnUdx
273 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dnVdx
274 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dUdz
275 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dVdz
276 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dZde_p
277 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dZde_r
278 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dZdx_p
279 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dZdx_r
280
281 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_UFse
282 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_UFsx
283 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_VFse
284 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_VFsx
285 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_dmUde
286 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_dmVde
287 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_dnUdx
288 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_dnVdx
289 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_dUdz
290 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_dVdz
291 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_dZde_p
292 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_dZde_r
293 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_dZdx_p
294 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_dZdx_r
295
296#include "set_bounds.h"
297!
298!-----------------------------------------------------------------------
299! Compute horizontal harmonic viscosity along geopotential surfaces.
300!-----------------------------------------------------------------------
301!
302! Compute horizontal and vertical gradients. Notice the recursive
303! blocking sequence. The vertical placement of the gradients is:
304!
305! dZdx_r, dZde_r, dnUdx, dmVde(:,:,k1) k rho-points
306! dZdx_r, dZde_r, dnUdx, dmVde(:,:,k2) k+1 rho-points
307! dZdx_p, dZde_p, dnVdx, dmUde(:,:,k1) k psi-points
308! dZdx_p, dZde_p, dnVdx, dmUde(:,:,k2) k+1 psi-points
309! UFse, UFsx, dUdz(:,:,k1) k-1/2 WU-points
310! UFse, UFsx, dUdz(:,:,k2) k+1/2 WU-points
311! VFse, VFsx, dVdz(:,:,k1) k-1/2 WV-points
312! VFse, VFsx, dVdz(:,:,k2) k+1/2 WV-points
313!
314 k2=1
315 k_loop : DO k=0,n(ng)
316 k1=k2
317 k2=3-k1
318 IF (k.lt.n(ng)) THEN
319!
320! Compute slopes (nondimensional) at RHO- and PSI-points.
321!
322 DO j=jstr-1,jend+1
323 DO i=istru-1,iend+1
324 cff=0.5_r8*(pm(i-1,j)+pm(i,j))
325#ifdef MASKING
326 cff=cff*umask(i,j)
327#endif
328 ufx(i,j)=cff*(z_r(i ,j,k+1)- &
329 & z_r(i-1,j,k+1))
330 tl_ufx(i,j)=cff*(tl_z_r(i ,j,k+1)- &
331 & tl_z_r(i-1,j,k+1))
332 END DO
333 END DO
334 DO j=jstrv-1,jend+1
335 DO i=istr-1,iend+1
336 cff=0.5_r8*(pn(i,j-1)+pn(i,j))
337#ifdef MASKING
338 cff=cff*vmask(i,j)
339#endif
340 vfe(i,j)=cff*(z_r(i,j ,k+1)- &
341 & z_r(i,j-1,k+1))
342 tl_vfe(i,j)=cff*(tl_z_r(i,j ,k+1)- &
343 & tl_z_r(i,j-1,k+1))
344 END DO
345 END DO
346!
347 DO j=jstr,jend+1
348 DO i=istr,iend+1
349 dzdx_p(i,j,k2)=0.5_r8*(ufx(i,j-1)+ &
350 & ufx(i,j ))
351 tl_dzdx_p(i,j,k2)=0.5_r8*(tl_ufx(i,j-1)+ &
352 & tl_ufx(i,j ))
353 dzde_p(i,j,k2)=0.5_r8*(vfe(i-1,j)+ &
354 & vfe(i ,j))
355 tl_dzde_p(i,j,k2)=0.5_r8*(tl_vfe(i-1,j)+ &
356 & tl_vfe(i ,j))
357 END DO
358 END DO
359 DO j=jstrv-1,jend
360 DO i=istru-1,iend
361 dzdx_r(i,j,k2)=0.5_r8*(ufx(i ,j)+ &
362 & ufx(i+1,j))
363 tl_dzdx_r(i,j,k2)=0.5_r8*(tl_ufx(i ,j)+ &
364 & tl_ufx(i+1,j))
365 dzde_r(i,j,k2)=0.5_r8*(vfe(i,j )+ &
366 & vfe(i,j+1))
367 tl_dzde_r(i,j,k2)=0.5_r8*(tl_vfe(i,j )+ &
368 & tl_vfe(i,j+1))
369 END DO
370 END DO
371!
372! Compute momentum horizontal (1/m/s) and vertical (1/s) gradients.
373!
374 DO j=jstrv-1,jend
375 DO i=istru-1,iend
376 cff=0.5_r8*pm(i,j)
377#ifdef MASKING
378 cff=cff*rmask(i,j)
379#endif
380 dnudx(i,j,k2)=cff*((pn(i ,j)+pn(i+1,j))* &
381 & u(i+1,j,k+1,nrhs)- &
382 & (pn(i-1,j)+pn(i ,j))* &
383 & u(i ,j,k+1,nrhs))
384 tl_dnudx(i,j,k2)=cff*((pn(i ,j)+pn(i+1,j))* &
385 & tl_u(i+1,j,k+1,nrhs)- &
386 & (pn(i-1,j)+pn(i ,j))* &
387 & tl_u(i ,j,k+1,nrhs))
388 END DO
389 END DO
390
391 DO j=jstr,jend+1
392 DO i=istr,iend+1
393 cff=0.125_r8*(pn(i-1,j )+pn(i,j )+ &
394 & pn(i-1,j-1)+pn(i,j-1))
395#ifdef MASKING
396 cff=cff*pmask(i,j)
397#endif
398 dmude(i,j,k2)=cff*((pm(i-1,j )+pm(i,j ))* &
399 & u(i,j ,k+1,nrhs)- &
400 & (pm(i-1,j-1)+pm(i,j-1))* &
401 & u(i,j-1,k+1,nrhs))
402 tl_dmude(i,j,k2)=cff*((pm(i-1,j )+pm(i,j ))* &
403 & tl_u(i,j ,k+1,nrhs)- &
404 & (pm(i-1,j-1)+pm(i,j-1))* &
405 & tl_u(i,j-1,k+1,nrhs))
406 END DO
407 END DO
408
409 DO j=jstr,jend+1
410 DO i=istr,iend+1
411 cff=0.125_r8*(pm(i-1,j )+pm(i,j )+ &
412 & pm(i-1,j-1)+pm(i,j-1))
413#ifdef MASKING
414 cff=cff*pmask(i,j)
415#endif
416 dnvdx(i,j,k2)=cff*((pn(i ,j-1)+pn(i ,j))* &
417 & v(i ,j,k+1,nrhs)- &
418 & (pn(i-1,j-1)+pn(i-1,j))* &
419 & v(i-1,j,k+1,nrhs))
420 tl_dnvdx(i,j,k2)=cff*((pn(i ,j-1)+pn(i ,j))* &
421 & tl_v(i ,j,k+1,nrhs)- &
422 & (pn(i-1,j-1)+pn(i-1,j))* &
423 & tl_v(i-1,j,k+1,nrhs))
424 END DO
425 END DO
426
427 DO j=jstrv-1,jend
428 DO i=istru-1,iend
429 cff=0.5_r8*pn(i,j)
430#ifdef MASKING
431 cff=cff*rmask(i,j)
432#endif
433 dmvde(i,j,k2)=cff*((pm(i,j )+pm(i,j+1))* &
434 & v(i,j+1,k+1,nrhs)- &
435 & (pm(i,j-1)+pm(i,j ))* &
436 & v(i,j ,k+1,nrhs))
437 tl_dmvde(i,j,k2)=cff*((pm(i,j )+pm(i,j+1))* &
438 & tl_v(i,j+1,k+1,nrhs)- &
439 & (pm(i,j-1)+pm(i,j ))* &
440 & tl_v(i,j ,k+1,nrhs))
441 END DO
442 END DO
443 END IF
444
445 IF ((k.eq.0).or.(k.eq.n(ng))) THEN
446 DO j=jstr-1,jend+1
447 DO i=istru-1,iend+1
448 dudz(i,j,k2)=0.0_r8
449 tl_dudz(i,j,k2)=0.0_r8
450 END DO
451 END DO
452 DO j=jstrv-1,jend+1
453 DO i=istr-1,iend+1
454 dvdz(i,j,k2)=0.0_r8
455 tl_dvdz(i,j,k2)=0.0_r8
456 END DO
457 END DO
458
459 DO j=jstr,jend
460 DO i=istru,iend
461!^ UFsx(i,j,k2)=0.0_r8
462!^
463 tl_ufsx(i,j,k2)=0.0_r8
464!^ UFse(i,j,k2)=0.0_r8
465!^
466 tl_ufse(i,j,k2)=0.0_r8
467 END DO
468 END DO
469 DO j=jstrv,jend
470 DO i=istr,iend
471!^ VFsx(i,j,k2)=0.0_r8
472!^
473 tl_vfsx(i,j,k2)=0.0_r8
474!^ VFse(i,j,k2)=0.0_r8
475!^
476 tl_vfse(i,j,k2)=0.0_r8
477 END DO
478 END DO
479 ELSE
480 DO j=jstr-1,jend+1
481 DO i=istru-1,iend+1
482 cff=1.0_r8/(0.5_r8*(z_r(i-1,j,k+1)-z_r(i-1,j,k)+ &
483 & z_r(i ,j,k+1)-z_r(i ,j,k)))
484 tl_cff=-cff*cff*(0.5_r8*(tl_z_r(i-1,j,k+1)- &
485 & tl_z_r(i-1,j,k )+ &
486 & tl_z_r(i ,j,k+1)- &
487 & tl_z_r(i ,j,k )))
488 dudz(i,j,k2)=cff*(u(i,j,k+1,nrhs)- &
489 & u(i,j,k ,nrhs))
490 tl_dudz(i,j,k2)=tl_cff*(u(i,j,k+1,nrhs)- &
491 & u(i,j,k ,nrhs))+ &
492 & cff*(tl_u(i,j,k+1,nrhs)- &
493 & tl_u(i,j,k ,nrhs))
494 END DO
495 END DO
496
497 DO j=jstrv-1,jend+1
498 DO i=istr-1,iend+1
499 cff=1.0_r8/(0.5_r8*(z_r(i,j-1,k+1)-z_r(i,j-1,k)+ &
500 & z_r(i,j ,k+1)-z_r(i,j ,k)))
501 tl_cff=-cff*cff*(0.5_r8*(tl_z_r(i,j-1,k+1)- &
502 & tl_z_r(i,j-1,k )+ &
503 & tl_z_r(i,j ,k+1)- &
504 & tl_z_r(i,j ,k )))
505 dvdz(i,j,k2)=cff*(v(i,j,k+1,nrhs)- &
506 & v(i,j,k ,nrhs))
507 tl_dvdz(i,j,k2)=tl_cff*(v(i,j,k+1,nrhs)- &
508 & v(i,j,k ,nrhs))+ &
509 & cff*(tl_v(i,j,k+1,nrhs)- &
510 & tl_v(i,j,k ,nrhs))
511 END DO
512 END DO
513 END IF
514!
515! Compute components of the rotated viscous flux (m5/s2) along
516! geopotential surfaces in the XI- and ETA-directions.
517!
518 IF (k.gt.0) THEN
519 DO j=jstrv-1,jend
520 DO i=istru-1,iend
521 cff1=min(dzdx_r(i,j,k1),0.0_r8)
522 cff2=max(dzdx_r(i,j,k1),0.0_r8)
523 cff3=min(dzde_r(i,j,k1),0.0_r8)
524 cff4=max(dzde_r(i,j,k1),0.0_r8)
525 tl_cff1=(0.5_r8+sign(0.5_r8,-dzdx_r(i,j,k1)))* &
526 & tl_dzdx_r(i,j,k1)
527 tl_cff2=(0.5_r8+sign(0.5_r8, dzdx_r(i,j,k1)))* &
528 & tl_dzdx_r(i,j,k1)
529 tl_cff3=(0.5_r8+sign(0.5_r8,-dzde_r(i,j,k1)))* &
530 & tl_dzde_r(i,j,k1)
531 tl_cff4=(0.5_r8+sign(0.5_r8, dzde_r(i,j,k1)))* &
532 & tl_dzde_r(i,j,k1)
533#ifdef VISC_3DCOEF
534 cff=hz(i,j,k)* &
535 & (on_r(i,j)*(dnudx(i,j,k1)- &
536 & 0.5_r8*pn(i,j)* &
537 & (cff1*(dudz(i ,j,k1)+ &
538 & dudz(i+1,j,k2))+ &
539 & cff2*(dudz(i ,j,k2)+ &
540 & dudz(i+1,j,k1))))- &
541 & om_r(i,j)*(dmvde(i,j,k1)- &
542 & 0.5_r8*pm(i,j)* &
543 & (cff3*(dvdz(i,j ,k1)+ &
544 & dvdz(i,j+1,k2))+ &
545 & cff4*(dvdz(i,j ,k2)+ &
546 & dvdz(i,j+1,k1)))))
547#else
548!^ cff=Hz(i,j,k)* &
549!^ & (on_r(i,j)*(dnUdx(i,j,k1)- &
550!^ & 0.5_r8*pn(i,j)* &
551!^ & (cff1*(dUdz(i ,j,k1)+ &
552!^ & dUdz(i+1,j,k2))+ &
553!^ & cff2*(dUdz(i ,j,k2)+ &
554!^ & dUdz(i+1,j,k1))))- &
555!^ & om_r(i,j)*(dmVde(i,j,k1)- &
556!^ & 0.5_r8*pm(i,j)* &
557!^ & (cff3*(dVdz(i,j ,k1)+ &
558!^ & dVdz(i,j+1,k2))+ &
559!^ & cff4*(dVdz(i,j ,k2)+ &
560!^ & dVdz(i,j+1,k1)))))
561!^
562#endif
563 tl_cff=tl_hz(i,j,k)* &
564 & (on_r(i,j)*(dnudx(i,j,k1)- &
565 & 0.5_r8*pn(i,j)* &
566 & (cff1*(dudz(i ,j,k1)+ &
567 & dudz(i+1,j,k2))+ &
568 & cff2*(dudz(i ,j,k2)+ &
569 & dudz(i+1,j,k1))))- &
570 & om_r(i,j)*(dmvde(i,j,k1)- &
571 & 0.5_r8*pm(i,j)* &
572 & (cff3*(dvdz(i,j ,k1)+ &
573 & dvdz(i,j+1,k2))+ &
574 & cff4*(dvdz(i,j ,k2)+ &
575 & dvdz(i,j+1,k1)))))+ &
576 & hz(i,j,k)* &
577 & (on_r(i,j)*(tl_dnudx(i,j,k1)- &
578 & 0.5_r8*pn(i,j)* &
579 & (tl_cff1*(dudz(i ,j,k1)+ &
580 & dudz(i+1,j,k2))+ &
581 & cff1*(tl_dudz(i ,j,k1)+ &
582 & tl_dudz(i+1,j,k2))+ &
583 & tl_cff2*(dudz(i ,j,k2)+ &
584 & dudz(i+1,j,k1))+ &
585 & cff2*(tl_dudz(i ,j,k2)+ &
586 & tl_dudz(i+1,j,k1))))- &
587 & om_r(i,j)*(tl_dmvde(i,j,k1)- &
588 & 0.5_r8*pm(i,j)* &
589 & (tl_cff3*(dvdz(i,j ,k1)+ &
590 & dvdz(i,j+1,k2))+ &
591 & cff3*(tl_dvdz(i,j ,k1)+ &
592 & tl_dvdz(i,j+1,k2))+ &
593 & tl_cff4*(dvdz(i,j ,k2)+ &
594 & dvdz(i,j+1,k1))+ &
595 & cff4*(tl_dvdz(i,j ,k2)+ &
596 & tl_dvdz(i,j+1,k1)))))
597#ifdef MASKING
598# ifdef VISC_3DCOEF
599 cff=cff*rmask(i,j)
600# else
601!^ cff=cff*rmask(i,j)
602!^
603# endif
604 tl_cff=tl_cff*rmask(i,j)
605#endif
606#ifdef VISC_3DCOEF
607!^ UFx(i,j)=on_r(i,j)*on_r(i,j)*visc3d_r(i,j,k)*cff
608!^
609 tl_ufx(i,j)=on_r(i,j)*on_r(i,j)* &
610 & (tl_visc3d_r(i,j,k)*cff+ &
611 & visc3d_r(i,j,k)*tl_cff)
612!^ VFe(i,j)=om_r(i,j)*om_r(i,j)*visc3d_r(i,j,k)*cff
613!^
614 tl_vfe(i,j)=om_r(i,j)*om_r(i,j)* &
615 & (tl_visc3d_r(i,j,k)*cff+ &
616 & visc3d_r(i,j,k)*tl_cff)
617#else
618!^ UFx(i,j)=on_r(i,j)*on_r(i,j)*visc2_r(i,j)*cff
619!^
620 tl_ufx(i,j)=on_r(i,j)*on_r(i,j)*visc2_r(i,j)*tl_cff
621!^ VFe(i,j)=om_r(i,j)*om_r(i,j)*visc2_r(i,j)*cff
622!^
623 tl_vfe(i,j)=om_r(i,j)*om_r(i,j)*visc2_r(i,j)*tl_cff
624#endif
625 END DO
626 END DO
627
628 DO j=jstr,jend+1
629 DO i=istr,iend+1
630 pm_p=0.25_r8*(pm(i-1,j-1)+pm(i-1,j)+ &
631 & pm(i ,j-1)+pm(i ,j))
632 pn_p=0.25_r8*(pn(i-1,j-1)+pn(i-1,j)+ &
633 & pn(i ,j-1)+pn(i ,j))
634 cff1=min(dzdx_p(i,j,k1),0.0_r8)
635 cff2=max(dzdx_p(i,j,k1),0.0_r8)
636 cff3=min(dzde_p(i,j,k1),0.0_r8)
637 cff4=max(dzde_p(i,j,k1),0.0_r8)
638 tl_cff1=(0.5_r8+sign(0.5_r8,-dzdx_p(i,j,k1)))* &
639 & tl_dzdx_p(i,j,k1)
640 tl_cff2=(0.5_r8+sign(0.5_r8, dzdx_p(i,j,k1)))* &
641 & tl_dzdx_p(i,j,k1)
642 tl_cff3=(0.5_r8+sign(0.5_r8,-dzde_p(i,j,k1)))* &
643 & tl_dzde_p(i,j,k1)
644 tl_cff4=(0.5_r8+sign(0.5_r8, dzde_p(i,j,k1)))* &
645 & tl_dzde_p(i,j,k1)
646#ifdef VISC_3DCOEF
647 cff=0.25_r8* &
648 & (hz(i-1,j ,k)+hz(i,j ,k)+ &
649 & hz(i-1,j-1,k)+hz(i,j-1,k))* &
650 & (on_p(i,j)*(dnvdx(i,j,k1)- &
651 & 0.5_r8*pn_p* &
652 & (cff1*(dvdz(i-1,j,k1)+ &
653 & dvdz(i ,j,k2))+ &
654 & cff2*(dvdz(i-1,j,k2)+ &
655 & dvdz(i ,j,k1))))+ &
656 & om_p(i,j)*(dmude(i,j,k1)- &
657 & 0.5_r8*pm_p* &
658 & (cff3*(dudz(i,j-1,k1)+ &
659 & dudz(i,j ,k2))+ &
660 & cff4*(dudz(i,j-1,k2)+ &
661 & dudz(i,j ,k1)))))
662#else
663!^ cff=0.25_r8* &
664!^ & (Hz(i-1,j ,k)+Hz(i,j ,k)+ &
665!^ & Hz(i-1,j-1,k)+Hz(i,j-1,k))* &
666!^ & (on_p(i,j)*(dnVdx(i,j,k1)- &
667!^ & 0.5_r8*pn_p* &
668!^ & (cff1*(dVdz(i-1,j,k1)+ &
669!^ & dVdz(i ,j,k2))+ &
670!^ & cff2*(dVdz(i-1,j,k2)+ &
671!^ & dVdz(i ,j,k1))))+ &
672!^ & om_p(i,j)*(dmUde(i,j,k1)- &
673!^ & 0.5_r8*pm_p* &
674!^ & (cff3*(dUdz(i,j-1,k1)+ &
675!^ & dUdz(i,j ,k2))+ &
676!^ & cff4*(dUdz(i,j-1,k2)+ &
677!^ & dUdz(i,j ,k1)))))
678!^
679#endif
680 tl_cff=0.25_r8* &
681 & ((tl_hz(i-1,j ,k)+tl_hz(i,j ,k)+ &
682 & tl_hz(i-1,j-1,k)+tl_hz(i,j-1,k))* &
683 & (on_p(i,j)*(dnvdx(i,j,k1)- &
684 & 0.5_r8*pn_p* &
685 & (cff1*(dvdz(i-1,j,k1)+ &
686 & dvdz(i ,j,k2))+ &
687 & cff2*(dvdz(i-1,j,k2)+ &
688 & dvdz(i ,j,k1))))+ &
689 & om_p(i,j)*(dmude(i,j,k1)- &
690 & 0.5_r8*pm_p* &
691 & (cff3*(dudz(i,j-1,k1)+ &
692 & dudz(i,j ,k2))+ &
693 & cff4*(dudz(i,j-1,k2)+ &
694 & dudz(i,j ,k1)))))+ &
695 & (hz(i-1,j ,k)+hz(i,j ,k)+ &
696 & hz(i-1,j-1,k)+hz(i,j-1,k))* &
697 & (on_p(i,j)*(tl_dnvdx(i,j,k1)- &
698 & 0.5_r8*pn_p* &
699 & (tl_cff1*(dvdz(i-1,j,k1)+ &
700 & dvdz(i ,j,k2))+ &
701 & cff1*(tl_dvdz(i-1,j,k1)+ &
702 & tl_dvdz(i ,j,k2))+ &
703 & tl_cff2*(dvdz(i-1,j,k2)+ &
704 & dvdz(i ,j,k1))+ &
705 & cff2*(tl_dvdz(i-1,j,k2)+ &
706 & tl_dvdz(i ,j,k1))))+ &
707 & om_p(i,j)*(tl_dmude(i,j,k1)- &
708 & 0.5_r8*pm_p* &
709 & (tl_cff3*(dudz(i,j-1,k1)+ &
710 & dudz(i,j ,k2))+ &
711 & cff3*(tl_dudz(i,j-1,k1)+ &
712 & tl_dudz(i,j ,k2))+ &
713 & tl_cff4*(dudz(i,j-1,k2)+ &
714 & dudz(i,j ,k1))+ &
715 & cff4*(tl_dudz(i,j-1,k2)+ &
716 & tl_dudz(i,j ,k1))))))
717#ifdef MASKING
718# ifdef VISC_3DCOEF
719 cff=cff*pmask(i,j)
720# else
721!^ cff=cff*pmask(i,j)
722!^
723# endif
724 tl_cff=tl_cff*pmask(i,j)
725#endif
726#ifdef VISC_3DCOEF
727 visc_p=0.25_r8* &
728 & (visc3d_r(i-1,j-1,k)+visc3d_r(i-1,j,k)+ &
729 & visc3d_r(i ,j-1,k)+visc3d_r(i ,j,k))
730 tl_visc_p=0.25_r8* &
731 & (tl_visc3d_r(i-1,j-1,k)+tl_visc3d_r(i-1,j,k)+ &
732 & tl_visc3d_r(i ,j-1,k)+tl_visc3d_r(i ,j,k))
733!^ UFe(i,j)=om_p(i,j)*om_p(i,j)*visc_p*cff
734!^
735 tl_ufe(i,j)=om_p(i,j)*om_p(i,j)* &
736 & (tl_visc_p*cff+visc_p*tl_cff)
737!^ VFx(i,j)=on_p(i,j)*on_p(i,j)*visc_p*cff
738!^
739 tl_vfx(i,j)=on_p(i,j)*on_p(i,j)* &
740 & (tl_visc_p*cff+visc_p*tl_cff)
741#else
742!^ UFe(i,j)=om_p(i,j)*om_p(i,j)*visc2_p(i,j)*cff
743!^
744 tl_ufe(i,j)=om_p(i,j)*om_p(i,j)*visc2_p(i,j)*tl_cff
745!^ VFx(i,j)=on_p(i,j)*on_p(i,j)*visc2_p(i,j)*cff
746!^
747 tl_vfx(i,j)=on_p(i,j)*on_p(i,j)*visc2_p(i,j)*tl_cff
748#endif
749 END DO
750 END DO
751!
752! Compute vertical flux (m2/s2) due to sloping terrain-following
753! surfaces.
754!
755 IF (k.lt.n(ng)) THEN
756 DO j=jstr,jend
757 DO i=istru,iend
758#ifdef VISC_3DCOEF
759 cff=0.125_r8* &
760 & (visc3d_r(i-1,j,k )+visc3d_r(i,j,k )+ &
761 & visc3d_r(i-1,j,k+1)+visc3d_r(i,j,k+1))
762 tl_cff=0.125_r8* &
763 & (tl_visc3d_r(i-1,j,k )+tl_visc3d_r(i,j,k )+ &
764 & tl_visc3d_r(i-1,j,k+1)+tl_visc3d_r(i,j,k+1))
765 fac1=cff*on_u(i,j)
766 tl_fac1=tl_cff*on_u(i,j)
767 fac2=cff*om_u(i,j)
768 tl_fac2=tl_cff*om_u(i,j)
769#else
770 cff=0.25_r8*(visc2_r(i-1,j)+visc2_r(i,j))
771 fac1=cff*on_u(i,j)
772 fac2=cff*om_u(i,j)
773#endif
774 cff=0.5_r8*(pn(i-1,j)+pn(i,j))
775 dnudz=cff*dudz(i,j,k2)
776 tl_dnudz=cff*tl_dudz(i,j,k2)
777 dnvdz=cff*0.25_r8*(dvdz(i-1,j+1,k2)+ &
778 & dvdz(i ,j+1,k2)+ &
779 & dvdz(i-1,j ,k2)+ &
780 & dvdz(i ,j ,k2))
781 tl_dnvdz=cff*0.25_r8*(tl_dvdz(i-1,j+1,k2)+ &
782 & tl_dvdz(i ,j+1,k2)+ &
783 & tl_dvdz(i-1,j ,k2)+ &
784 & tl_dvdz(i ,j ,k2))
785 cff=0.5_r8*(pm(i-1,j)+pm(i,j))
786 dmudz=cff*dudz(i,j,k2)
787 tl_dmudz=cff*tl_dudz(i,j,k2)
788 dmvdz=cff*0.25_r8*(dvdz(i-1,j+1,k2)+ &
789 & dvdz(i ,j+1,k2)+ &
790 & dvdz(i-1,j ,k2)+ &
791 & dvdz(i ,j ,k2))
792 tl_dmvdz=cff*0.25_r8*(tl_dvdz(i-1,j+1,k2)+ &
793 & tl_dvdz(i ,j+1,k2)+ &
794 & tl_dvdz(i-1,j ,k2)+ &
795 & tl_dvdz(i ,j ,k2))
796
797 cff1=min(dzdx_r(i-1,j,k1),0.0_r8)
798 cff2=min(dzdx_r(i ,j,k2),0.0_r8)
799 cff3=max(dzdx_r(i-1,j,k2),0.0_r8)
800 cff4=max(dzdx_r(i ,j,k1),0.0_r8)
801 tl_cff1=(0.5_r8+sign(0.5_r8,-dzdx_r(i-1,j,k1)))* &
802 & tl_dzdx_r(i-1,j,k1)
803 tl_cff2=(0.5_r8+sign(0.5_r8,-dzdx_r(i ,j,k2)))* &
804 & tl_dzdx_r(i ,j,k2)
805 tl_cff3=(0.5_r8+sign(0.5_r8, dzdx_r(i-1,j,k2)))* &
806 & tl_dzdx_r(i-1,j,k2)
807 tl_cff4=(0.5_r8+sign(0.5_r8, dzdx_r(i ,j,k1)))* &
808 & tl_dzdx_r(i ,j,k1)
809!^ UFsx(i,j,k2)=fac1* &
810!^ & (cff1*(cff1*dnUdz-dnUdx(i-1,j,k1))+ &
811!^ & cff2*(cff2*dnUdz-dnUdx(i ,j,k2))+ &
812!^ & cff3*(cff3*dnUdz-dnUdx(i-1,j,k2))+ &
813!^ & cff4*(cff4*dnUdz-dnUdx(i ,j,k1)))
814!^
815 tl_ufsx(i,j,k2)=fac1* &
816 & (tl_cff1*(cff1*dnudz-dnudx(i-1,j,k1))+ &
817 & tl_cff2*(cff2*dnudz-dnudx(i ,j,k2))+ &
818 & tl_cff3*(cff3*dnudz-dnudx(i-1,j,k2))+ &
819 & tl_cff4*(cff4*dnudz-dnudx(i ,j,k1))+ &
820 & cff1*(tl_cff1*dnudz+cff1*tl_dnudz- &
821 & tl_dnudx(i-1,j,k1))+ &
822 & cff2*(tl_cff2*dnudz+cff2*tl_dnudz- &
823 & tl_dnudx(i ,j,k2))+ &
824 & cff3*(tl_cff3*dnudz+cff3*tl_dnudz- &
825 & tl_dnudx(i-1,j,k2))+ &
826 & cff4*(tl_cff4*dnudz+cff4*tl_dnudz- &
827 & tl_dnudx(i ,j,k1)))
828#ifdef VISC_3DCOEF
829 tl_ufsx(i,j,k2)=tl_ufsx(i,j,k2)+ &
830 & tl_fac1* &
831 & (cff1*(cff1*dnudz-dnudx(i-1,j,k1))+ &
832 & cff2*(cff2*dnudz-dnudx(i ,j,k2))+ &
833 & cff3*(cff3*dnudz-dnudx(i-1,j,k2))+ &
834 & cff4*(cff4*dnudz-dnudx(i ,j,k1)))
835#endif
836
837 cff1=min(dzde_p(i,j ,k1),0.0_r8)
838 cff2=min(dzde_p(i,j+1,k2),0.0_r8)
839 cff3=max(dzde_p(i,j ,k2),0.0_r8)
840 cff4=max(dzde_p(i,j+1,k1),0.0_r8)
841 tl_cff1=(0.5_r8+sign(0.5_r8,-dzde_p(i,j ,k1)))* &
842 & tl_dzde_p(i,j ,k1)
843 tl_cff2=(0.5_r8+sign(0.5_r8,-dzde_p(i,j+1,k2)))* &
844 & tl_dzde_p(i,j+1,k2)
845 tl_cff3=(0.5_r8+sign(0.5_r8, dzde_p(i,j ,k2)))* &
846 & tl_dzde_p(i,j ,k2)
847 tl_cff4=(0.5_r8+sign(0.5_r8, dzde_p(i,j+1,k1)))* &
848 & tl_dzde_p(i,j+1,k1)
849!^ UFse(i,j,k2)=fac2* &
850!^ & (cff1*(cff1*dmUdz-dmUde(i,j ,k1))+ &
851!^ & cff2*(cff2*dmUdz-dmUde(i,j+1,k2))+ &
852!^ & cff3*(cff3*dmUdz-dmUde(i,j ,k2))+ &
853!^ & cff4*(cff4*dmUdz-dmUde(i,j+1,k1)))
854!^
855 tl_ufse(i,j,k2)=fac2* &
856 & (tl_cff1*(cff1*dmudz-dmude(i,j ,k1))+ &
857 & tl_cff2*(cff2*dmudz-dmude(i,j+1,k2))+ &
858 & tl_cff3*(cff3*dmudz-dmude(i,j ,k2))+ &
859 & tl_cff4*(cff4*dmudz-dmude(i,j+1,k1))+ &
860 & cff1*(tl_cff1*dmudz+cff1*tl_dmudz- &
861 & tl_dmude(i,j ,k1))+ &
862 & cff2*(tl_cff2*dmudz+cff2*tl_dmudz- &
863 & tl_dmude(i,j+1,k2))+ &
864 & cff3*(tl_cff3*dmudz+cff3*tl_dmudz- &
865 & tl_dmude(i,j ,k2))+ &
866 & cff4*(tl_cff4*dmudz+cff4*tl_dmudz- &
867 & tl_dmude(i,j+1,k1)))
868#ifdef VISC_3DCOEF
869 tl_ufse(i,j,k2)=tl_ufse(i,j,k2)+ &
870 & tl_fac2* &
871 & (cff1*(cff1*dmudz-dmude(i,j ,k1))+ &
872 & cff2*(cff2*dmudz-dmude(i,j+1,k2))+ &
873 & cff3*(cff3*dmudz-dmude(i,j ,k2))+ &
874 & cff4*(cff4*dmudz-dmude(i,j+1,k1)))
875#endif
876
877 cff1=min(dzde_p(i,j ,k1),0.0_r8)
878 cff2=min(dzde_p(i,j+1,k2),0.0_r8)
879 cff3=max(dzde_p(i,j ,k2),0.0_r8)
880 cff4=max(dzde_p(i,j+1,k1),0.0_r8)
881 cff5=min(dzdx_p(i,j ,k1),0.0_r8)
882 cff6=min(dzdx_p(i,j+1,k2),0.0_r8)
883 cff7=max(dzdx_p(i,j ,k2),0.0_r8)
884 cff8=max(dzdx_p(i,j+1,k1),0.0_r8)
885 tl_cff1=(0.5_r8+sign(0.5_r8,-dzde_p(i,j ,k1)))* &
886 & tl_dzde_p(i,j ,k1)
887 tl_cff2=(0.5_r8+sign(0.5_r8,-dzde_p(i,j+1,k2)))* &
888 & tl_dzde_p(i,j+1,k2)
889 tl_cff3=(0.5_r8+sign(0.5_r8, dzde_p(i,j ,k2)))* &
890 & tl_dzde_p(i,j ,k2)
891 tl_cff4=(0.5_r8+sign(0.5_r8, dzde_p(i,j+1,k1)))* &
892 & tl_dzde_p(i,j+1,k1)
893 tl_cff5=(0.5_r8+sign(0.5_r8,-dzdx_p(i,j ,k1)))* &
894 & tl_dzdx_p(i,j ,k1)
895 tl_cff6=(0.5_r8+sign(0.5_r8,-dzdx_p(i,j+1,k2)))* &
896 & tl_dzdx_p(i,j+1,k2)
897 tl_cff7=(0.5_r8+sign(0.5_r8, dzdx_p(i,j ,k2)))* &
898 & tl_dzdx_p(i,j ,k2)
899 tl_cff8=(0.5_r8+sign(0.5_r8, dzdx_p(i,j+1,k1)))* &
900 & tl_dzdx_p(i,j+1,k1)
901!^ UFsx(i,j,k2)=UFsx(i,j,k2)+ &
902!^ & fac1* &
903!^ & (cff1*(cff5*dnVdz-dnVdx(i,j ,k1))+ &
904!^ & cff2*(cff6*dnVdz-dnVdx(i,j+1,k2))+ &
905!^ & cff3*(cff7*dnVdz-dnVdx(i,j ,k2))+ &
906!^ & cff4*(cff8*dnVdz-dnVdx(i,j+1,k1)))
907!^
908 tl_ufsx(i,j,k2)=tl_ufsx(i,j,k2)+ &
909 & fac1* &
910 & (tl_cff1*(cff5*dnvdz-dnvdx(i,j ,k1))+ &
911 & tl_cff2*(cff6*dnvdz-dnvdx(i,j+1,k2))+ &
912 & tl_cff3*(cff7*dnvdz-dnvdx(i,j ,k2))+ &
913 & tl_cff4*(cff8*dnvdz-dnvdx(i,j+1,k1))+ &
914 & cff1*(tl_cff5*dnvdz+cff5*tl_dnvdz- &
915 & tl_dnvdx(i,j ,k1))+ &
916 & cff2*(tl_cff6*dnvdz+cff6*tl_dnvdz- &
917 & tl_dnvdx(i,j+1,k2))+ &
918 & cff3*(tl_cff7*dnvdz+cff7*tl_dnvdz- &
919 & tl_dnvdx(i,j ,k2))+ &
920 & cff4*(tl_cff8*dnvdz+cff8*tl_dnvdz- &
921 & tl_dnvdx(i,j+1,k1)))
922#ifdef VISC_3DCOEF
923 tl_ufsx(i,j,k2)=tl_ufsx(i,j,k2)+ &
924 & tl_fac1* &
925 & (cff1*(cff5*dnvdz-dnvdx(i,j ,k1))+ &
926 & cff2*(cff6*dnvdz-dnvdx(i,j+1,k2))+ &
927 & cff3*(cff7*dnvdz-dnvdx(i,j ,k2))+ &
928 & cff4*(cff8*dnvdz-dnvdx(i,j+1,k1)))
929#endif
930
931 cff1=min(dzdx_r(i-1,j,k1),0.0_r8)
932 cff2=min(dzdx_r(i ,j,k2),0.0_r8)
933 cff3=max(dzdx_r(i-1,j,k2),0.0_r8)
934 cff4=max(dzdx_r(i ,j,k1),0.0_r8)
935 cff5=min(dzde_r(i-1,j,k1),0.0_r8)
936 cff6=min(dzde_r(i ,j,k2),0.0_r8)
937 cff7=max(dzde_r(i-1,j,k2),0.0_r8)
938 cff8=max(dzde_r(i ,j,k1),0.0_r8)
939 tl_cff1=(0.5_r8+sign(0.5_r8,-dzdx_r(i-1,j,k1)))* &
940 & tl_dzdx_r(i-1,j,k1)
941 tl_cff2=(0.5_r8+sign(0.5_r8,-dzdx_r(i ,j,k2)))* &
942 & tl_dzdx_r(i ,j,k2)
943 tl_cff3=(0.5_r8+sign(0.5_r8, dzdx_r(i-1,j,k2)))* &
944 & tl_dzdx_r(i-1,j,k2)
945 tl_cff4=(0.5_r8+sign(0.5_r8, dzdx_r(i ,j,k1)))* &
946 & tl_dzdx_r(i ,j,k1)
947 tl_cff5=(0.5_r8+sign(0.5_r8,-dzde_r(i-1,j,k1)))* &
948 & tl_dzde_r(i-1,j,k1)
949 tl_cff6=(0.5_r8+sign(0.5_r8,-dzde_r(i ,j,k2)))* &
950 & tl_dzde_r(i ,j,k2)
951 tl_cff7=(0.5_r8+sign(0.5_r8, dzde_r(i-1,j,k2)))* &
952 & tl_dzde_r(i-1,j,k2)
953 tl_cff8=(0.5_r8+sign(0.5_r8, dzde_r(i ,j,k1)))* &
954 & tl_dzde_r(i ,j,k1)
955!^ UFse(i,j,k2)=UFse(i,j,k2)- &
956!^ & fac2* &
957!^ & (cff1*(cff5*dmVdz-dmVde(i-1,j,k1))+ &
958!^ & cff2*(cff6*dmVdz-dmVde(i ,j,k2))+ &
959!^ & cff3*(cff7*dmVdz-dmVde(i-1,j,k2))+ &
960!^ & cff4*(cff8*dmVdz-dmVde(i ,j,k1)))
961!^
962 tl_ufse(i,j,k2)=tl_ufse(i,j,k2)- &
963 & fac2* &
964 & (tl_cff1*(cff5*dmvdz-dmvde(i-1,j,k1))+ &
965 & tl_cff2*(cff6*dmvdz-dmvde(i ,j,k2))+ &
966 & tl_cff3*(cff7*dmvdz-dmvde(i-1,j,k2))+ &
967 & tl_cff4*(cff8*dmvdz-dmvde(i ,j,k1))+ &
968 & cff1*(tl_cff5*dmvdz+cff5*tl_dmvdz- &
969 & tl_dmvde(i-1,j,k1))+ &
970 & cff2*(tl_cff6*dmvdz+cff6*tl_dmvdz- &
971 & tl_dmvde(i ,j,k2))+ &
972 & cff3*(tl_cff7*dmvdz+cff7*tl_dmvdz- &
973 & tl_dmvde(i-1,j,k2))+ &
974 & cff4*(tl_cff8*dmvdz+cff8*tl_dmvdz- &
975 & tl_dmvde(i ,j,k1)))
976#ifdef VISC_3DCOEF
977 tl_ufse(i,j,k2)=tl_ufse(i,j,k2)- &
978 & tl_fac2* &
979 & (cff1*(cff5*dmvdz-dmvde(i-1,j,k1))+ &
980 & cff2*(cff6*dmvdz-dmvde(i ,j,k2))+ &
981 & cff3*(cff7*dmvdz-dmvde(i-1,j,k2))+ &
982 & cff4*(cff8*dmvdz-dmvde(i ,j,k1)))
983#endif
984 END DO
985 END DO
986!
987 DO j=jstrv,jend
988 DO i=istr,iend
989#ifdef VISC_3DCOEF
990 cff=0.125_r8* &
991 & (visc3d_r(i,j-1,k )+visc3d_r(i,j,k )+ &
992 & visc3d_r(i,j-1,k+1)+visc3d_r(i,j,k+1))
993 tl_cff=0.125_r8* &
994 & (tl_visc3d_r(i,j-1,k )+tl_visc3d_r(i,j,k )+ &
995 & tl_visc3d_r(i,j-1,k+1)+tl_visc3d_r(i,j,k+1))
996 fac1=cff*on_v(i,j)
997 tl_fac1=tl_cff*on_v(i,j)
998 fac2=cff*om_v(i,j)
999 tl_fac2=tl_cff*om_v(i,j)
1000#else
1001 cff=0.25_r8*(visc2_r(i,j-1)+visc2_r(i,j))
1002 fac1=cff*on_v(i,j)
1003 fac2=cff*om_v(i,j)
1004#endif
1005 cff=0.5_r8*(pn(i,j-1)+pn(i,j))
1006 dnudz=cff*0.25_r8*(dudz(i ,j ,k2)+ &
1007 & dudz(i+1,j ,k2)+ &
1008 & dudz(i ,j-1,k2)+ &
1009 & dudz(i+1,j-1,k2))
1010 tl_dnudz=cff*0.25_r8*(tl_dudz(i ,j ,k2)+ &
1011 & tl_dudz(i+1,j ,k2)+ &
1012 & tl_dudz(i ,j-1,k2)+ &
1013 & tl_dudz(i+1,j-1,k2))
1014 dnvdz=cff*dvdz(i,j,k2)
1015 tl_dnvdz=cff*tl_dvdz(i,j,k2)
1016 cff=0.5_r8*(pm(i,j-1)+pm(i,j))
1017 dmudz=cff*0.25_r8*(dudz(i ,j ,k2)+ &
1018 & dudz(i+1,j ,k2)+ &
1019 & dudz(i ,j-1,k2)+ &
1020 & dudz(i+1,j-1,k2))
1021 tl_dmudz=cff*0.25_r8*(tl_dudz(i ,j ,k2)+ &
1022 & tl_dudz(i+1,j ,k2)+ &
1023 & tl_dudz(i ,j-1,k2)+ &
1024 & tl_dudz(i+1,j-1,k2))
1025 dmvdz=cff*dvdz(i,j,k2)
1026 tl_dmvdz=cff*tl_dvdz(i,j,k2)
1027
1028 cff1=min(dzdx_p(i ,j,k1),0.0_r8)
1029 cff2=min(dzdx_p(i+1,j,k2),0.0_r8)
1030 cff3=max(dzdx_p(i ,j,k2),0.0_r8)
1031 cff4=max(dzdx_p(i+1,j,k1),0.0_r8)
1032 tl_cff1=(0.5_r8+sign(0.5_r8,-dzdx_p(i ,j,k1)))* &
1033 & tl_dzdx_p(i ,j,k1)
1034 tl_cff2=(0.5_r8+sign(0.5_r8,-dzdx_p(i+1,j,k2)))* &
1035 & tl_dzdx_p(i+1,j,k2)
1036 tl_cff3=(0.5_r8+sign(0.5_r8, dzdx_p(i ,j,k2)))* &
1037 & tl_dzdx_p(i ,j,k2)
1038 tl_cff4=(0.5_r8+sign(0.5_r8, dzdx_p(i+1,j,k1)))* &
1039 & tl_dzdx_p(i+1,j,k1)
1040!^ VFsx(i,j,k2)=fac1* &
1041!^ & (cff1*(cff1*dnVdz-dnVdx(i ,j,k1))+ &
1042!^ & cff2*(cff2*dnVdz-dnVdx(i+1,j,k2))+ &
1043!^ & cff3*(cff3*dnVdz-dnVdx(i ,j,k2))+ &
1044!^ & cff4*(cff4*dnVdz-dnVdx(i+1,j,k1)))
1045!^
1046 tl_vfsx(i,j,k2)=fac1* &
1047 & (tl_cff1*(cff1*dnvdz-dnvdx(i ,j,k1))+ &
1048 & tl_cff2*(cff2*dnvdz-dnvdx(i+1,j,k2))+ &
1049 & tl_cff3*(cff3*dnvdz-dnvdx(i ,j,k2))+ &
1050 & tl_cff4*(cff4*dnvdz-dnvdx(i+1,j,k1))+ &
1051 & cff1*(tl_cff1*dnvdz+cff1*tl_dnvdz- &
1052 & tl_dnvdx(i ,j,k1))+ &
1053 & cff2*(tl_cff2*dnvdz+cff2*tl_dnvdz- &
1054 & tl_dnvdx(i+1,j,k2))+ &
1055 & cff3*(tl_cff3*dnvdz+cff3*tl_dnvdz- &
1056 & tl_dnvdx(i ,j,k2))+ &
1057 & cff4*(tl_cff4*dnvdz+cff4*tl_dnvdz- &
1058 & tl_dnvdx(i+1,j,k1)))
1059#ifdef VISC_3DCOEF
1060 tl_vfsx(i,j,k2)=tl_vfsx(i,j,k2)+ &
1061 & tl_fac1* &
1062 & (cff1*(cff1*dnvdz-dnvdx(i ,j,k1))+ &
1063 & cff2*(cff2*dnvdz-dnvdx(i+1,j,k2))+ &
1064 & cff3*(cff3*dnvdz-dnvdx(i ,j,k2))+ &
1065 & cff4*(cff4*dnvdz-dnvdx(i+1,j,k1)))
1066#endif
1067
1068 cff1=min(dzde_r(i,j-1,k1),0.0_r8)
1069 cff2=min(dzde_r(i,j ,k2),0.0_r8)
1070 cff3=max(dzde_r(i,j-1,k2),0.0_r8)
1071 cff4=max(dzde_r(i,j ,k1),0.0_r8)
1072 tl_cff1=(0.5_r8+sign(0.5_r8,-dzde_r(i,j-1,k1)))* &
1073 & tl_dzde_r(i,j-1,k1)
1074 tl_cff2=(0.5_r8+sign(0.5_r8,-dzde_r(i,j ,k2)))* &
1075 & tl_dzde_r(i,j ,k2)
1076 tl_cff3=(0.5_r8+sign(0.5_r8, dzde_r(i,j-1,k2)))* &
1077 & tl_dzde_r(i,j-1,k2)
1078 tl_cff4=(0.5_r8+sign(0.5_r8, dzde_r(i,j ,k1)))* &
1079 & tl_dzde_r(i,j ,k1)
1080!^ VFse(i,j,k2)=fac2* &
1081!^ & (cff1*(cff1*dmVdz-dmVde(i,j-1,k1))+ &
1082!^ & cff2*(cff2*dmVdz-dmVde(i,j ,k2))+ &
1083!^ & cff3*(cff3*dmVdz-dmVde(i,j-1,k2))+ &
1084!^ & cff4*(cff4*dmVdz-dmVde(i,j ,k1)))
1085!^
1086 tl_vfse(i,j,k2)=fac2* &
1087 & (tl_cff1*(cff1*dmvdz-dmvde(i,j-1,k1))+ &
1088 & tl_cff2*(cff2*dmvdz-dmvde(i,j ,k2))+ &
1089 & tl_cff3*(cff3*dmvdz-dmvde(i,j-1,k2))+ &
1090 & tl_cff4*(cff4*dmvdz-dmvde(i,j ,k1))+ &
1091 & cff1*(tl_cff1*dmvdz+cff1*tl_dmvdz- &
1092 & tl_dmvde(i,j-1,k1))+ &
1093 & cff2*(tl_cff2*dmvdz+cff2*tl_dmvdz- &
1094 & tl_dmvde(i,j ,k2))+ &
1095 & cff3*(tl_cff3*dmvdz+cff3*tl_dmvdz- &
1096 & tl_dmvde(i,j-1,k2))+ &
1097 & cff4*(tl_cff4*dmvdz+cff4*tl_dmvdz- &
1098 & tl_dmvde(i,j ,k1)))
1099#ifdef VISC_3DCOEF
1100 tl_vfse(i,j,k2)=tl_vfse(i,j,k2)+ &
1101 & tl_fac2* &
1102 & (cff1*(cff1*dmvdz-dmvde(i,j-1,k1))+ &
1103 & cff2*(cff2*dmvdz-dmvde(i,j ,k2))+ &
1104 & cff3*(cff3*dmvdz-dmvde(i,j-1,k2))+ &
1105 & cff4*(cff4*dmvdz-dmvde(i,j ,k1)))
1106#endif
1107
1108 cff1=min(dzde_r(i,j-1,k1),0.0_r8)
1109 cff2=min(dzde_r(i,j ,k2),0.0_r8)
1110 cff3=max(dzde_r(i,j-1,k2),0.0_r8)
1111 cff4=max(dzde_r(i,j ,k1),0.0_r8)
1112 cff5=min(dzdx_r(i,j-1,k1),0.0_r8)
1113 cff6=min(dzdx_r(i,j ,k2),0.0_r8)
1114 cff7=max(dzdx_r(i,j-1,k2),0.0_r8)
1115 cff8=max(dzdx_r(i,j ,k1),0.0_r8)
1116 tl_cff1=(0.5_r8+sign(0.5_r8,-dzde_r(i,j-1,k1)))* &
1117 & tl_dzde_r(i,j-1,k1)
1118 tl_cff2=(0.5_r8+sign(0.5_r8,-dzde_r(i,j ,k2)))* &
1119 & tl_dzde_r(i,j ,k2)
1120 tl_cff3=(0.5_r8+sign(0.5_r8, dzde_r(i,j-1,k2)))* &
1121 & tl_dzde_r(i,j-1,k2)
1122 tl_cff4=(0.5_r8+sign(0.5_r8, dzde_r(i,j ,k1)))* &
1123 & tl_dzde_r(i,j ,k1)
1124 tl_cff5=(0.5_r8+sign(0.5_r8,-dzdx_r(i,j-1,k1)))* &
1125 & tl_dzdx_r(i,j-1,k1)
1126 tl_cff6=(0.5_r8+sign(0.5_r8,-dzdx_r(i,j ,k2)))* &
1127 & tl_dzdx_r(i,j ,k2)
1128 tl_cff7=(0.5_r8+sign(0.5_r8, dzdx_r(i,j-1,k2)))* &
1129 & tl_dzdx_r(i,j-1,k2)
1130 tl_cff8=(0.5_r8+sign(0.5_r8, dzdx_r(i,j ,k1)))* &
1131 & tl_dzdx_r(i,j ,k1)
1132!^ VFsx(i,j,k2)=VFsx(i,j,k2)- &
1133!^ & fac1* &
1134!^ & (cff1*(cff5*dnUdz-dnUdx(i,j-1,k1))+ &
1135!^ & cff2*(cff6*dnUdz-dnUdx(i,j ,k2))+ &
1136!^ & cff3*(cff7*dnUdz-dnUdx(i,j-1,k2))+ &
1137!^ & cff4*(cff8*dnUdz-dnUdx(i,j ,k1)))
1138!^
1139 tl_vfsx(i,j,k2)=tl_vfsx(i,j,k2)- &
1140 & fac1* &
1141 & (tl_cff1*(cff5*dnudz-dnudx(i,j-1,k1))+ &
1142 & tl_cff2*(cff6*dnudz-dnudx(i,j ,k2))+ &
1143 & tl_cff3*(cff7*dnudz-dnudx(i,j-1,k2))+ &
1144 & tl_cff4*(cff8*dnudz-dnudx(i,j ,k1))+ &
1145 & cff1*(tl_cff5*dnudz+cff5*tl_dnudz- &
1146 & tl_dnudx(i,j-1,k1))+ &
1147 & cff2*(tl_cff6*dnudz+cff6*tl_dnudz- &
1148 & tl_dnudx(i,j ,k2))+ &
1149 & cff3*(tl_cff7*dnudz+cff7*tl_dnudz- &
1150 & tl_dnudx(i,j-1,k2))+ &
1151 & cff4*(tl_cff8*dnudz+cff8*tl_dnudz- &
1152 & tl_dnudx(i,j ,k1)))
1153#ifdef VISC_3DCOEF
1154 tl_vfsx(i,j,k2)=tl_vfsx(i,j,k2)- &
1155 & tl_fac1* &
1156 & (cff1*(cff5*dnudz-dnudx(i,j-1,k1))+ &
1157 & cff2*(cff6*dnudz-dnudx(i,j ,k2))+ &
1158 & cff3*(cff7*dnudz-dnudx(i,j-1,k2))+ &
1159 & cff4*(cff8*dnudz-dnudx(i,j ,k1)))
1160#endif
1161
1162 cff1=min(dzdx_p(i ,j,k1),0.0_r8)
1163 cff2=min(dzdx_p(i+1,j,k2),0.0_r8)
1164 cff3=max(dzdx_p(i ,j,k2),0.0_r8)
1165 cff4=max(dzdx_p(i+1,j,k1),0.0_r8)
1166 cff5=min(dzde_p(i ,j,k1),0.0_r8)
1167 cff6=min(dzde_p(i+1,j,k2),0.0_r8)
1168 cff7=max(dzde_p(i ,j,k2),0.0_r8)
1169 cff8=max(dzde_p(i+1,j,k1),0.0_r8)
1170 tl_cff1=(0.5_r8+sign(0.5_r8,-dzdx_p(i ,j,k1)))* &
1171 & tl_dzdx_p(i ,j,k1)
1172 tl_cff2=(0.5_r8+sign(0.5_r8,-dzdx_p(i+1,j,k2)))* &
1173 & tl_dzdx_p(i+1,j,k2)
1174 tl_cff3=(0.5_r8+sign(0.5_r8, dzdx_p(i ,j,k2)))* &
1175 & tl_dzdx_p(i ,j,k2)
1176 tl_cff4=(0.5_r8+sign(0.5_r8, dzdx_p(i+1,j,k1)))* &
1177 & tl_dzdx_p(i+1,j,k1)
1178 tl_cff5=(0.5_r8+sign(0.5_r8,-dzde_p(i ,j,k1)))* &
1179 & tl_dzde_p(i ,j,k1)
1180 tl_cff6=(0.5_r8+sign(0.5_r8,-dzde_p(i+1,j,k2)))* &
1181 & tl_dzde_p(i+1,j,k2)
1182 tl_cff7=(0.5_r8+sign(0.5_r8, dzde_p(i ,j,k2)))* &
1183 & tl_dzde_p(i ,j,k2)
1184 tl_cff8=(0.5_r8+sign(0.5_r8, dzde_p(i+1,j,k1)))* &
1185 & tl_dzde_p(i+1,j,k1)
1186!^ VFse(i,j,k2)=VFse(i,j,k2)+ &
1187!^ & fac2* &
1188!^ & (cff1*(cff5*dmUdz-dmUde(i ,j,k1))+ &
1189!^ & cff2*(cff6*dmUdz-dmUde(i+1,j,k2))+ &
1190!^ & cff3*(cff7*dmUdz-dmUde(i ,j,k2))+ &
1191!^ & cff4*(cff8*dmUdz-dmUde(i+1,j,k1)))
1192!^
1193 tl_vfse(i,j,k2)=tl_vfse(i,j,k2)+ &
1194 & fac2* &
1195 & (tl_cff1*(cff5*dmudz-dmude(i ,j,k1))+ &
1196 & tl_cff2*(cff6*dmudz-dmude(i+1,j,k2))+ &
1197 & tl_cff3*(cff7*dmudz-dmude(i ,j,k2))+ &
1198 & tl_cff4*(cff8*dmudz-dmude(i+1,j,k1))+ &
1199 & cff1*(tl_cff5*dmudz+cff5*tl_dmudz- &
1200 & tl_dmude(i ,j,k1))+ &
1201 & cff2*(tl_cff6*dmudz+cff6*tl_dmudz- &
1202 & tl_dmude(i+1,j,k2))+ &
1203 & cff3*(tl_cff7*dmudz+cff7*tl_dmudz- &
1204 & tl_dmude(i ,j,k2))+ &
1205 & cff4*(tl_cff8*dmudz+cff8*tl_dmudz- &
1206 & tl_dmude(i+1,j,k1)))
1207#ifdef VISC_3DCOEF
1208 tl_vfse(i,j,k2)=tl_vfse(i,j,k2)+ &
1209 & tl_fac2* &
1210 & (cff1*(cff5*dmudz-dmude(i ,j,k1))+ &
1211 & cff2*(cff6*dmudz-dmude(i+1,j,k2))+ &
1212 & cff3*(cff7*dmudz-dmude(i ,j,k2))+ &
1213 & cff4*(cff8*dmudz-dmude(i+1,j,k1)))
1214#endif
1215 END DO
1216 END DO
1217 END IF
1218!
1219! Time-step harmonic, geopotential viscosity term. Notice that
1220! momentum at this stage is HzU and HzV and has m2/s units. Add
1221! contribution for barotropic forcing terms.
1222#ifdef DIAGNOSTICS_UV
1223!! The rotated vertical term cannot be split from the horizontal
1224!! terms because of the 2D/3D momentum coupling.
1225#endif
1226!
1227 DO j=jstr,jend
1228 DO i=istru,iend
1229 cff=dt(ng)*0.25_r8*(pm(i-1,j)+pm(i,j))*(pn(i-1,j)+pn(i,j))
1230!^ cff1=0.5_r8*(pn(i-1,j)+pn(i,j))*(UFx(i,j )-UFx(i-1,j))
1231!^
1232 tl_cff1=0.5_r8*(pn(i-1,j)+pn(i,j))* &
1233 & (tl_ufx(i,j )-tl_ufx(i-1,j))
1234!^ cff2=0.5_r8*(pm(i-1,j)+pm(i,j))*(UFe(i,j+1)-UFe(i ,j))
1235!^
1236 tl_cff2=0.5_r8*(pm(i-1,j)+pm(i,j))* &
1237 & (tl_ufe(i,j+1)-tl_ufe(i ,j))
1238!^ cff3=UFsx(i,j,k2)-UFsx(i,j,k1)
1239!^
1240 tl_cff3=tl_ufsx(i,j,k2)-tl_ufsx(i,j,k1)
1241!^ cff4=UFse(i,j,k2)-UFse(i,j,k1)
1242!^
1243 tl_cff4=tl_ufse(i,j,k2)-tl_ufse(i,j,k1)
1244!^ cff5=cff*(cff1+cff2)
1245!^
1246 tl_cff5=cff*(tl_cff1+tl_cff2)
1247!^ cff6=dt(ng)*(cff3+cff4)
1248!^
1249 tl_cff6=dt(ng)*(tl_cff3+tl_cff4)
1250!^ rufrc(i,j)=rufrc(i,j)+cff1+cff2+cff3+cff4
1251!^
1252 tl_rufrc(i,j)=tl_rufrc(i,j)+ &
1253 & tl_cff1+tl_cff2+tl_cff3+tl_cff4
1254!^ u(i,j,k,nnew)=u(i,j,k,nnew)+cff5+cff6
1255!^
1256 tl_u(i,j,k,nnew)=tl_u(i,j,k,nnew)+tl_cff5+tl_cff6
1257#ifdef DIAGNOSTICS_UV
1258!! DiaRUfrc(i,j,3,M2hvis)=DiaRUfrc(i,j,3,M2hvis)+cff1+cff2+ &
1259!! & cff3+cff4
1260!! DiaRUfrc(i,j,3,M2xvis)=DiaRUfrc(i,j,3,M2xvis)+cff1+cff3
1261!! DiaRUfrc(i,j,3,M2yvis)=DiaRUfrc(i,j,3,M2yvis)+cff2+cff4
1262!! DiaU3wrk(i,j,k,M3hvis)=cff5+cff6
1263!! DiaU3wrk(i,j,k,M3xvis)=cff*cff1+dt(ng)*cff3
1264!! DiaU3wrk(i,j,k,M3yvis)=cff*cff2+dt(ng)*cff4
1265#endif
1266 END DO
1267 END DO
1268
1269 DO j=jstrv,jend
1270 DO i=istr,iend
1271 cff=dt(ng)*0.25_r8*(pm(i,j)+pm(i,j-1))*(pn(i,j)+pn(i,j-1))
1272!^ cff1=0.5_r8*(pn(i,j-1)+pn(i,j))*(VFx(i+1,j)-VFx(i,j ))
1273!^
1274 tl_cff1=0.5_r8*(pn(i,j-1)+pn(i,j))* &
1275 & (tl_vfx(i+1,j)-tl_vfx(i,j ))
1276!^ cff2=0.5_r8*(pm(i,j-1)+pm(i,j))*(VFe(i ,j)-VFe(i,j-1))
1277!^
1278 tl_cff2=0.5_r8*(pm(i,j-1)+pm(i,j))* &
1279 & (tl_vfe(i ,j)-tl_vfe(i,j-1))
1280!^ cff3=VFsx(i,j,k2)-VFsx(i,j,k1)
1281!^
1282 tl_cff3=tl_vfsx(i,j,k2)-tl_vfsx(i,j,k1)
1283!^ cff4=VFse(i,j,k2)-VFse(i,j,k1)
1284!^
1285 tl_cff4=tl_vfse(i,j,k2)-tl_vfse(i,j,k1)
1286!^ cff5=cff*(cff1-cff2)
1287!^
1288 tl_cff5=cff*(tl_cff1-tl_cff2)
1289!^ cff6=dt(ng)*(cff3+cff4)
1290!^
1291 tl_cff6=dt(ng)*(tl_cff3+tl_cff4)
1292!^ rvfrc(i,j)=rvfrc(i,j)+cff1-cff2+cff3+cff4
1293!^
1294 tl_rvfrc(i,j)=tl_rvfrc(i,j)+ &
1295 & tl_cff1-tl_cff2+tl_cff3+tl_cff4
1296!^ v(i,j,k,nnew)=v(i,j,k,nnew)+cff5+cff6
1297!^
1298 tl_v(i,j,k,nnew)=tl_v(i,j,k,nnew)+tl_cff5+tl_cff6
1299#ifdef DIAGNOSTICS_UV
1300!! DiaRVfrc(i,j,3,M2hvis)=DiaRVfrc(i,j,3,M2hvis)+cff1-cff2+ &
1301!! & cff3+cff4
1302!! DiaRVfrc(i,j,3,M2xvis)=DiaRVfrc(i,j,3,M2xvis)+cff1+cff3
1303!! DiaRVfrc(i,j,3,M2yvis)=DiaRVfrc(i,j,3,M2yvis)-cff2+cff4
1304!! DiaV3wrk(i,j,k,M3hvis)=cff5+cff6
1305!! DiaV3wrk(i,j,k,M3xvis)= cff*cff1+dt(ng)*cff3
1306!! DiaV3wrk(i,j,k,M3yvis)=-cff*cff2+dt(ng)*cff4
1307#endif
1308 END DO
1309 END DO
1310 END IF
1311 END DO k_loop
1312!
1313 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

References mod_scalars::dt.

Referenced by tl_uv3dmix2().

Here is the caller graph for this function:

◆ tl_uv3dmix2_s_tile()

subroutine tl_uv3dmix2_mod::tl_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,n(ng)), intent(in) hz,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng)), intent(in) tl_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), intent(in) visc2_p,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) visc2_r,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(in) u,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(in) v,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(inout) tl_rufrc,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(inout) tl_rvfrc,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(inout) tl_u,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(inout) tl_v )
private

Definition at line 113 of file tl_uv3dmix2_s.h.

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

References mod_scalars::dt.