ROMS
Loading...
Searching...
No Matches
rp_uv3dmix2_geo.h
Go to the documentation of this file.
1 MODULE rp_uv3dmix2_mod
2!
3!git $Id$
4!================================================== Hernan G. Arango ===
5! Copyright (c) 2002-2025 The ROMS Group Andrew M. Moore !
6! Licensed under a MIT/X style license !
7! See License_ROMS.md !
8!=======================================================================
9! !
10! This routine computes representers tangent linear harmonic mixing !
11! of momentum, rotated along geopotentials, from the horizontal !
12! divergence of the stress tensor. A transverse isotropy is assumed !
13! so the stress tensor is split into vertical and horizontal !
14! subtensors. !
15! !
16! Reference: !
17! !
18! Wajsowicz, R.C, 1993: A consistent formulation of the !
19! anisotropic stress tensor for use in models of the !
20! large-scale ocean circulation, JCP, 105, 333-338. !
21! !
22! Sadourny, R. and K. Maynard, 1997: Formulations of !
23! lateral diffusion in geophysical fluid dynamics !
24! models, In Numerical Methods of Atmospheric and !
25! Oceanic Modelling. Lin, Laprise, and Ritchie, !
26! Eds., NRC Research Press, 547-556. !
27! !
28! Griffies, S.M. and R.W. Hallberg, 2000: Biharmonic !
29! friction with a Smagorinsky-like viscosity for !
30! use in large-scale eddy-permitting ocean models, !
31! Monthly Weather Rev., 128, 8, 2935-2946. !
32! !
33!=======================================================================
34!
35 implicit none
36!
37 PRIVATE
38 PUBLIC rp_uv3dmix2
39!
40 CONTAINS
41!
42!***********************************************************************
43 SUBROUTINE rp_uv3dmix2 (ng, tile)
44!***********************************************************************
45!
46 USE mod_param
47 USE mod_coupling
48#ifdef DIAGNOSTICS_UV
49!! USE mod_diags
50#endif
51 USE mod_grid
52 USE mod_mixing
53 USE mod_ocean
54 USE mod_stepping
55!
56! Imported variable declarations.
57!
58 integer, intent(in) :: ng, tile
59!
60! Local variable declarations.
61!
62 character (len=*), parameter :: myfile = &
63 & __FILE__
64!
65#include "tile.h"
66!
67#ifdef PROFILE
68 CALL wclock_on (ng, irpm, 31, __line__, myfile)
69#endif
70 CALL rp_uv3dmix2_geo_tile (ng, tile, &
71 & lbi, ubi, lbj, ubj, &
72 & imins, imaxs, jmins, jmaxs, &
73 & nrhs(ng), nnew(ng), &
74#ifdef MASKING
75 & grid(ng) % pmask, &
76 & grid(ng) % rmask, &
77 & grid(ng) % umask, &
78 & grid(ng) % vmask, &
79#endif
80 & grid(ng) % om_p, &
81 & grid(ng) % om_r, &
82 & grid(ng) % om_u, &
83 & grid(ng) % om_v, &
84 & grid(ng) % on_p, &
85 & grid(ng) % on_r, &
86 & grid(ng) % on_u, &
87 & grid(ng) % on_v, &
88 & grid(ng) % pm, &
89 & grid(ng) % pn, &
90 & grid(ng) % Hz, &
91 & grid(ng) % tl_Hz, &
92 & grid(ng) % z_r, &
93 & grid(ng) % tl_z_r, &
94#ifdef VISC_3DCOEF
95 & mixing(ng) % visc3d_r, &
96 & mixing(ng) % tl_visc3d_r, &
97#else
98 & mixing(ng) % visc2_p, &
99 & mixing(ng) % visc2_r, &
100#endif
101#ifdef DIAGNOSTICS_UV
102!! & DIAGS(ng) % DiaRUfrc, &
103!! & DIAGS(ng) % DiaRVfrc, &
104!! & DIAGS(ng) % DiaU3wrk, &
105!! & DIAGS(ng) % DiaV3wrk, &
106#endif
107 & ocean(ng) % u, &
108 & ocean(ng) % v, &
109 & ocean(ng) % tl_u, &
110 & ocean(ng) % tl_v, &
111 & coupling(ng) % tl_rufrc, &
112 & coupling(ng) % tl_rvfrc)
113#ifdef PROFILE
114 CALL wclock_off (ng, irpm, 31, __line__, myfile)
115#endif
116!
117 RETURN
118 END SUBROUTINE rp_uv3dmix2
119
120!
121!***********************************************************************
122 SUBROUTINE rp_uv3dmix2_geo_tile (ng, tile, &
123 & LBi, UBi, LBj, UBj, &
124 & IminS, ImaxS, JminS, JmaxS, &
125 & nrhs, nnew, &
126#ifdef MASKING
127 & pmask, rmask, umask, vmask, &
128#endif
129 & om_p, om_r, om_u, om_v, &
130 & on_p, on_r, on_u, on_v, &
131 & pm, pn, &
132 & Hz, tl_Hz, &
133 & z_r, tl_z_r, &
134#ifdef VISC_3DCOEF
135 & visc3d_r, tl_visc3d_r, &
136#else
137 & visc2_p, visc2_r, &
138#endif
139#ifdef DIAGNOSTICS_UV
140!! & DiaRUfrc, DiaRVfrc, &
141!! & DiaU3wrk, DiaV3wrk, &
142#endif
143 & u, v, &
144 & tl_u, tl_v, &
145 & tl_rufrc, tl_rvfrc)
146!***********************************************************************
147!
148 USE mod_param
149 USE mod_scalars
150!
151! Imported variable declarations.
152!
153 integer, intent(in) :: ng, tile
154 integer, intent(in) :: LBi, UBi, LBj, UBj
155 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
156 integer, intent(in) :: nrhs, nnew
157
158#ifdef ASSUMED_SHAPE
159# ifdef MASKING
160 real(r8), intent(in) :: pmask(LBi:,LBj:)
161 real(r8), intent(in) :: rmask(LBi:,LBj:)
162 real(r8), intent(in) :: umask(LBi:,LBj:)
163 real(r8), intent(in) :: vmask(LBi:,LBj:)
164# endif
165 real(r8), intent(in) :: om_p(LBi:,LBj:)
166 real(r8), intent(in) :: om_r(LBi:,LBj:)
167 real(r8), intent(in) :: om_u(LBi:,LBj:)
168 real(r8), intent(in) :: om_v(LBi:,LBj:)
169 real(r8), intent(in) :: on_p(LBi:,LBj:)
170 real(r8), intent(in) :: on_r(LBi:,LBj:)
171 real(r8), intent(in) :: on_u(LBi:,LBj:)
172 real(r8), intent(in) :: on_v(LBi:,LBj:)
173 real(r8), intent(in) :: pm(LBi:,LBj:)
174 real(r8), intent(in) :: pn(LBi:,LBj:)
175 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
176 real(r8), intent(in) :: tl_Hz(LBi:,LBj:,:)
177 real(r8), intent(in) :: z_r(LBi:,LBj:,:)
178 real(r8), intent(in) :: tl_z_r(LBi:,LBj:,:)
179# ifdef VISC_3DCOEF
180 real(r8), intent(in) :: visc3d_r(LBi:,LBj:,:)
181# else
182 real(r8), intent(in) :: visc2_p(LBi:,LBj:)
183 real(r8), intent(in) :: visc2_r(LBi:,LBj:)
184# endif
185 real(r8), intent(in) :: u(LBi:,LBj:,:,:)
186 real(r8), intent(in) :: v(LBi:,LBj:,:,:)
187
188# ifdef DIAGNOSTICS_UV
189!! real(r8), intent(inout) :: DiaRUfrc(LBi:,LBj:,:,:)
190!! real(r8), intent(inout) :: DiaRVfrc(LBi:,LBj:,:,:)
191!! real(r8), intent(inout) :: DiaU3wrk(LBi:,LBj:,:,:)
192!! real(r8), intent(inout) :: DiaV3wrk(LBi:,LBj:,:,:)
193# endif
194 real(r8), intent(inout) :: tl_rufrc(LBi:,LBj:)
195 real(r8), intent(inout) :: tl_rvfrc(LBi:,LBj:)
196 real(r8), intent(inout) :: tl_u(LBi:,LBj:,:,:)
197 real(r8), intent(inout) :: tl_v(LBi:,LBj:,:,:)
198# ifdef VISC_3DCOEF
199 real(r8), intent(inout) :: tl_visc3d_r(LBi:,LBj:,:)
200# endif
201
202#else
203# ifdef MASKING
204 real(r8), intent(in) :: pmask(LBi:UBi,LBj:UBj)
205 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
206 real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
207 real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
208# endif
209 real(r8), intent(in) :: om_p(LBi:UBi,LBj:UBj)
210 real(r8), intent(in) :: om_r(LBi:UBi,LBj:UBj)
211 real(r8), intent(in) :: om_u(LBi:UBi,LBj:UBj)
212 real(r8), intent(in) :: om_v(LBi:UBi,LBj:UBj)
213 real(r8), intent(in) :: on_p(LBi:UBi,LBj:UBj)
214 real(r8), intent(in) :: on_r(LBi:UBi,LBj:UBj)
215 real(r8), intent(in) :: on_u(LBi:UBi,LBj:UBj)
216 real(r8), intent(in) :: on_v(LBi:UBi,LBj:UBj)
217 real(r8), intent(in) :: pm(LBi:UBi,LBj:UBj)
218 real(r8), intent(in) :: pn(LBi:UBi,LBj:UBj)
219 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,N(ng))
220 real(r8), intent(in) :: tl_Hz(LBi:UBi,LBj:UBj,N(ng))
221 real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
222 real(r8), intent(in) :: tl_z_r(LBi:UBi,LBj:UBj,N(ng))
223# ifdef VISC_3DCOEF
224 real(r8), intent(in) :: visc3d_r(LBi:UBi,LBj:UBj,N(ng))
225# else
226 real(r8), intent(in) :: visc2_p(LBi:UBi,LBj:UBj)
227 real(r8), intent(in) :: visc2_r(LBi:UBi,LBj:UBj)
228# endif
229 real(r8), intent(in) :: u(LBi:UBi,LBj:UBj,N(ng),2)
230 real(r8), intent(in) :: v(LBi:UBi,LBj:UBj,N(ng),2)
231
232# ifdef DIAGNOSTICS_UV
233!! real(r8), intent(inout) :: DiaRUfrc(LBi:UBi,LBj:UBj,3,NDM2d-1)
234!! real(r8), intent(inout) :: DiaRVfrc(LBi:UBi,LBj:UBj,3,NDM2d-1)
235!! real(r8), intent(inout) :: DiaU3wrk(LBi:UBi,LBj:UBj,N(ng),NDM3d)
236!! real(r8), intent(inout) :: DiaV3wrk(LBi:UBi,LBj:UBj,N(ng),NDM3d)
237# endif
238 real(r8), intent(inout) :: tl_rufrc(LBi:UBi,LBj:UBj)
239 real(r8), intent(inout) :: tl_rvfrc(LBi:UBi,LBj:UBj)
240 real(r8), intent(inout) :: tl_u(LBi:UBi,LBj:UBj,N(ng),2)
241 real(r8), intent(inout) :: tl_v(LBi:UBi,LBj:UBj,N(ng),2)
242# ifdef VISC_3DCOEF
243 real(r8), intent(inout) :: tl_visc3d_r(LBi:UBi,LBj:UBj,N(ng))
244# endif
245#endif
246!
247! Local variable declarations.
248!
249 integer :: i, j, k, k1, k2
250
251 real(r8) :: cff, fac1, fac2, pm_p, pn_p
252 real(r8) :: cff1, cff2, cff3, cff4
253 real(r8) :: cff5, cff6, cff7, cff8
254 real(r8) :: dmUdz, dnUdz, dmVdz, dnVdz
255#ifdef VISC_3DCOEF
256 real(r8) :: visc_p
257 real(r8) :: tl_fac1, tl_fac2, tl_visc_p
258#endif
259 real(r8) :: tl_cff
260 real(r8) :: tl_cff1, tl_cff2, tl_cff3, tl_cff4
261 real(r8) :: tl_cff5, tl_cff6, tl_cff7, tl_cff8
262 real(r8) :: tl_dmUdz, tl_dnUdz, tl_dmVdz, tl_dnVdz
263
264 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: UFx
265 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: VFe
266
267 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tl_UFe
268 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tl_UFx
269 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tl_VFe
270 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: tl_VFx
271
272 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dmUde
273 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dmVde
274 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dnUdx
275 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dnVdx
276 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dUdz
277 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dVdz
278 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dZde_p
279 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dZde_r
280 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dZdx_p
281 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: dZdx_r
282
283 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_UFse
284 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_UFsx
285 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_VFse
286 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_VFsx
287 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_dmUde
288 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_dmVde
289 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_dnUdx
290 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_dnVdx
291 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_dUdz
292 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_dVdz
293 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_dZde_p
294 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_dZde_r
295 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_dZdx_p
296 real(r8), dimension(IminS:ImaxS,JminS:JmaxS,2) :: tl_dZdx_r
297
298#include "set_bounds.h"
299!
300!-----------------------------------------------------------------------
301! Compute horizontal harmonic viscosity along geopotential surfaces.
302!-----------------------------------------------------------------------
303!
304! Compute horizontal and vertical gradients. Notice the recursive
305! blocking sequence. The vertical placement of the gradients is:
306!
307! dZdx_r, dZde_r, dnUdx, dmVde(:,:,k1) k rho-points
308! dZdx_r, dZde_r, dnUdx, dmVde(:,:,k2) k+1 rho-points
309! dZdx_p, dZde_p, dnVdx, dmUde(:,:,k1) k psi-points
310! dZdx_p, dZde_p, dnVdx, dmUde(:,:,k2) k+1 psi-points
311! UFse, UFsx, dUdz(:,:,k1) k-1/2 WU-points
312! UFse, UFsx, dUdz(:,:,k2) k+1/2 WU-points
313! VFse, VFsx, dVdz(:,:,k1) k-1/2 WV-points
314! VFse, VFsx, dVdz(:,:,k2) k+1/2 WV-points
315!
316 k2=1
317 k_loop : DO k=0,n(ng)
318 k1=k2
319 k2=3-k1
320 IF (k.lt.n(ng)) THEN
321!
322! Compute slopes (nondimensional) at RHO- and PSI-points.
323!
324 DO j=jstr-1,jend+1
325 DO i=istru-1,iend+1
326 cff=0.5_r8*(pm(i-1,j)+pm(i,j))
327#ifdef MASKING
328 cff=cff*umask(i,j)
329#endif
330 ufx(i,j)=cff*(z_r(i ,j,k+1)- &
331 & z_r(i-1,j,k+1))
332 tl_ufx(i,j)=cff*(tl_z_r(i ,j,k+1)- &
333 & tl_z_r(i-1,j,k+1))
334 END DO
335 END DO
336 DO j=jstrv-1,jend+1
337 DO i=istr-1,iend+1
338 cff=0.5_r8*(pn(i,j-1)+pn(i,j))
339#ifdef MASKING
340 cff=cff*vmask(i,j)
341#endif
342 vfe(i,j)=cff*(z_r(i,j ,k+1)- &
343 & z_r(i,j-1,k+1))
344 tl_vfe(i,j)=cff*(tl_z_r(i,j ,k+1)- &
345 & tl_z_r(i,j-1,k+1))
346 END DO
347 END DO
348!
349 DO j=jstr,jend+1
350 DO i=istr,iend+1
351 dzdx_p(i,j,k2)=0.5_r8*(ufx(i,j-1)+ &
352 & ufx(i,j ))
353 tl_dzdx_p(i,j,k2)=0.5_r8*(tl_ufx(i,j-1)+ &
354 & tl_ufx(i,j ))
355 dzde_p(i,j,k2)=0.5_r8*(vfe(i-1,j)+ &
356 & vfe(i ,j))
357 tl_dzde_p(i,j,k2)=0.5_r8*(tl_vfe(i-1,j)+ &
358 & tl_vfe(i ,j))
359 END DO
360 END DO
361 DO j=jstrv-1,jend
362 DO i=istru-1,iend
363 dzdx_r(i,j,k2)=0.5_r8*(ufx(i ,j)+ &
364 & ufx(i+1,j))
365 tl_dzdx_r(i,j,k2)=0.5_r8*(tl_ufx(i ,j)+ &
366 & tl_ufx(i+1,j))
367 dzde_r(i,j,k2)=0.5_r8*(vfe(i,j )+ &
368 & vfe(i,j+1))
369 tl_dzde_r(i,j,k2)=0.5_r8*(tl_vfe(i,j )+ &
370 & tl_vfe(i,j+1))
371 END DO
372 END DO
373!
374! Compute momentum horizontal (1/m/s) and vertical (1/s) gradients.
375!
376 DO j=jstrv-1,jend
377 DO i=istru-1,iend
378 cff=0.5_r8*pm(i,j)
379#ifdef MASKING
380 cff=cff*rmask(i,j)
381#endif
382 dnudx(i,j,k2)=cff*((pn(i ,j)+pn(i+1,j))* &
383 & u(i+1,j,k+1,nrhs)- &
384 & (pn(i-1,j)+pn(i ,j))* &
385 & u(i ,j,k+1,nrhs))
386 tl_dnudx(i,j,k2)=cff*((pn(i ,j)+pn(i+1,j))* &
387 & tl_u(i+1,j,k+1,nrhs)- &
388 & (pn(i-1,j)+pn(i ,j))* &
389 & tl_u(i ,j,k+1,nrhs))
390 END DO
391 END DO
392
393 DO j=jstr,jend+1
394 DO i=istr,iend+1
395 cff=0.125_r8*(pn(i-1,j )+pn(i,j )+ &
396 & pn(i-1,j-1)+pn(i,j-1))
397#ifdef MASKING
398 cff=cff*pmask(i,j)
399#endif
400 dmude(i,j,k2)=cff*((pm(i-1,j )+pm(i,j ))* &
401 & u(i,j ,k+1,nrhs)- &
402 & (pm(i-1,j-1)+pm(i,j-1))* &
403 & u(i,j-1,k+1,nrhs))
404 tl_dmude(i,j,k2)=cff*((pm(i-1,j )+pm(i,j ))* &
405 & tl_u(i,j ,k+1,nrhs)- &
406 & (pm(i-1,j-1)+pm(i,j-1))* &
407 & tl_u(i,j-1,k+1,nrhs))
408 END DO
409 END DO
410
411 DO j=jstr,jend+1
412 DO i=istr,iend+1
413 cff=0.125_r8*(pm(i-1,j )+pm(i,j )+ &
414 & pm(i-1,j-1)+pm(i,j-1))
415#ifdef MASKING
416 cff=cff*pmask(i,j)
417#endif
418 dnvdx(i,j,k2)=cff*((pn(i ,j-1)+pn(i ,j))* &
419 & v(i ,j,k+1,nrhs)- &
420 & (pn(i-1,j-1)+pn(i-1,j))* &
421 & v(i-1,j,k+1,nrhs))
422 tl_dnvdx(i,j,k2)=cff*((pn(i ,j-1)+pn(i ,j))* &
423 & tl_v(i ,j,k+1,nrhs)- &
424 & (pn(i-1,j-1)+pn(i-1,j))* &
425 & tl_v(i-1,j,k+1,nrhs))
426 END DO
427 END DO
428
429 DO j=jstrv-1,jend
430 DO i=istru-1,iend
431 cff=0.5_r8*pn(i,j)
432#ifdef MASKING
433 cff=cff*rmask(i,j)
434#endif
435 dmvde(i,j,k2)=cff*((pm(i,j )+pm(i,j+1))* &
436 & v(i,j+1,k+1,nrhs)- &
437 & (pm(i,j-1)+pm(i,j ))* &
438 & v(i,j ,k+1,nrhs))
439 tl_dmvde(i,j,k2)=cff*((pm(i,j )+pm(i,j+1))* &
440 & tl_v(i,j+1,k+1,nrhs)- &
441 & (pm(i,j-1)+pm(i,j ))* &
442 & tl_v(i,j ,k+1,nrhs))
443 END DO
444 END DO
445 END IF
446
447 IF ((k.eq.0).or.(k.eq.n(ng))) THEN
448 DO j=jstr-1,jend+1
449 DO i=istru-1,iend+1
450 dudz(i,j,k2)=0.0_r8
451 tl_dudz(i,j,k2)=0.0_r8
452 END DO
453 END DO
454 DO j=jstrv-1,jend+1
455 DO i=istr-1,iend+1
456 dvdz(i,j,k2)=0.0_r8
457 tl_dvdz(i,j,k2)=0.0_r8
458 END DO
459 END DO
460
461 DO j=jstr,jend
462 DO i=istru,iend
463!^ UFsx(i,j,k2)=0.0_r8
464!^
465 tl_ufsx(i,j,k2)=0.0_r8
466!^ UFse(i,j,k2)=0.0_r8
467!^
468 tl_ufse(i,j,k2)=0.0_r8
469 END DO
470 END DO
471 DO j=jstrv,jend
472 DO i=istr,iend
473!^ VFsx(i,j,k2)=0.0_r8
474!^
475 tl_vfsx(i,j,k2)=0.0_r8
476!^ VFse(i,j,k2)=0.0_r8
477!^
478 tl_vfse(i,j,k2)=0.0_r8
479 END DO
480 END DO
481 ELSE
482 DO j=jstr-1,jend+1
483 DO i=istru-1,iend+1
484 cff=1.0_r8/(0.5_r8*(z_r(i-1,j,k+1)-z_r(i-1,j,k)+ &
485 & z_r(i ,j,k+1)-z_r(i ,j,k)))
486 tl_cff=-cff*cff*(0.5_r8*(tl_z_r(i-1,j,k+1)- &
487 & tl_z_r(i-1,j,k )+ &
488 & tl_z_r(i ,j,k+1)- &
489 & tl_z_r(i ,j,k )))+ &
490#ifdef TL_IOMS
491 & 2.0_r8*cff
492#endif
493 dudz(i,j,k2)=cff*(u(i,j,k+1,nrhs)- &
494 & u(i,j,k ,nrhs))
495 tl_dudz(i,j,k2)=tl_cff*(u(i,j,k+1,nrhs)- &
496 & u(i,j,k ,nrhs))+ &
497 & cff*(tl_u(i,j,k+1,nrhs)- &
498 & tl_u(i,j,k ,nrhs))- &
499#ifdef TL_IOMS
500 & dudz(i,j,k2)
501#endif
502 END DO
503 END DO
504
505 DO j=jstrv-1,jend+1
506 DO i=istr-1,iend+1
507 cff=1.0_r8/(0.5_r8*(z_r(i,j-1,k+1)-z_r(i,j-1,k)+ &
508 & z_r(i,j ,k+1)-z_r(i,j ,k)))
509 tl_cff=-cff*cff*(0.5_r8*(tl_z_r(i,j-1,k+1)- &
510 & tl_z_r(i,j-1,k )+ &
511 & tl_z_r(i,j ,k+1)- &
512 & tl_z_r(i,j ,k )))+ &
513#ifdef TL_IOMS
514 & 2.0_r8*cff
515#endif
516 dvdz(i,j,k2)=cff*(v(i,j,k+1,nrhs)- &
517 & v(i,j,k ,nrhs))
518 tl_dvdz(i,j,k2)=tl_cff*(v(i,j,k+1,nrhs)- &
519 & v(i,j,k ,nrhs))+ &
520 & cff*(tl_v(i,j,k+1,nrhs)- &
521 & tl_v(i,j,k ,nrhs))- &
522#ifdef TL_IOMS
523 & dvdz(i,j,k2)
524#endif
525 END DO
526 END DO
527 END IF
528!
529! Compute components of the rotated viscous flux (m5/s2) along
530! geopotential surfaces in the XI- and ETA-directions.
531!
532 IF (k.gt.0) THEN
533 DO j=jstrv-1,jend
534 DO i=istru-1,iend
535 cff1=min(dzdx_r(i,j,k1),0.0_r8)
536 cff2=max(dzdx_r(i,j,k1),0.0_r8)
537 cff3=min(dzde_r(i,j,k1),0.0_r8)
538 cff4=max(dzde_r(i,j,k1),0.0_r8)
539 tl_cff1=(0.5_r8+sign(0.5_r8,-dzdx_r(i,j,k1)))* &
540 & tl_dzdx_r(i,j,k1)
541 tl_cff2=(0.5_r8+sign(0.5_r8, dzdx_r(i,j,k1)))* &
542 & tl_dzdx_r(i,j,k1)
543 tl_cff3=(0.5_r8+sign(0.5_r8,-dzde_r(i,j,k1)))* &
544 & tl_dzde_r(i,j,k1)
545 tl_cff4=(0.5_r8+sign(0.5_r8, dzde_r(i,j,k1)))* &
546 & tl_dzde_r(i,j,k1)
547#ifdef VISC_3DCOEF
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#else
562!^ cff=Hz(i,j,k)* &
563!^ & (on_r(i,j)*(dnUdx(i,j,k1)- &
564!^ & 0.5_r8*pn(i,j)* &
565!^ & (cff1*(dUdz(i ,j,k1)+ &
566!^ & dUdz(i+1,j,k2))+ &
567!^ & cff2*(dUdz(i ,j,k2)+ &
568!^ & dUdz(i+1,j,k1))))- &
569!^ & om_r(i,j)*(dmVde(i,j,k1)- &
570!^ & 0.5_r8*pm(i,j)* &
571!^ & (cff3*(dVdz(i,j ,k1)+ &
572!^ & dVdz(i,j+1,k2))+ &
573!^ & cff4*(dVdz(i,j ,k2)+ &
574!^ & dVdz(i,j+1,k1)))))
575!^
576#endif
577 tl_cff=tl_hz(i,j,k)* &
578 & (on_r(i,j)*(dnudx(i,j,k1)- &
579 & 0.5_r8*pn(i,j)* &
580 & (cff1*(dudz(i ,j,k1)+ &
581 & dudz(i+1,j,k2))+ &
582 & cff2*(dudz(i ,j,k2)+ &
583 & dudz(i+1,j,k1))))- &
584 & om_r(i,j)*(dmvde(i,j,k1)- &
585 & 0.5_r8*pm(i,j)* &
586 & (cff3*(dvdz(i,j ,k1)+ &
587 & dvdz(i,j+1,k2))+ &
588 & cff4*(dvdz(i,j ,k2)+ &
589 & dvdz(i,j+1,k1)))))+ &
590 & hz(i,j,k)* &
591 & (on_r(i,j)*(tl_dnudx(i,j,k1)- &
592 & 0.5_r8*pn(i,j)* &
593 & (tl_cff1*(dudz(i ,j,k1)+ &
594 & dudz(i+1,j,k2))+ &
595 & cff1*(tl_dudz(i ,j,k1)+ &
596 & tl_dudz(i+1,j,k2))+ &
597 & tl_cff2*(dudz(i ,j,k2)+ &
598 & dudz(i+1,j,k1))+ &
599 & cff2*(tl_dudz(i ,j,k2)+ &
600 & tl_dudz(i+1,j,k1))))- &
601 & om_r(i,j)*(tl_dmvde(i,j,k1)- &
602 & 0.5_r8*pm(i,j)* &
603 & (tl_cff3*(dvdz(i,j ,k1)+ &
604 & dvdz(i,j+1,k2))+ &
605 & cff3*(tl_dvdz(i,j ,k1)+ &
606 & tl_dvdz(i,j+1,k2))+ &
607 & tl_cff4*(dvdz(i,j ,k2)+ &
608 & dvdz(i,j+1,k1))+ &
609 & cff4*(tl_dvdz(i,j ,k2)+ &
610 & tl_dvdz(i,j+1,k1)))))- &
611#ifdef TL_IOMS
612 & hz(i,j,k)* &
613 & (on_r(i,j)*(dnudx(i,j,k1)- &
614 & pn(i,j)* &
615 & (cff1*(dudz(i ,j,k1)+ &
616 & dudz(i+1,j,k2))+ &
617 & cff2*(dudz(i ,j,k2)+ &
618 & dudz(i+1,j,k1))))- &
619 & om_r(i,j)*(dmvde(i,j,k1)- &
620 & pm(i,j)* &
621 & (cff3*(dvdz(i,j ,k1)+ &
622 & dvdz(i,j+1,k2))+ &
623 & cff4*(dvdz(i,j ,k2)+ &
624 & dvdz(i,j+1,k1)))))
625#endif
626#ifdef MASKING
627# ifdef VISC_3DCOEF
628 cff=cff*rmask(i,j)
629# else
630!^ cff=cff*rmask(i,j)
631!^
632# endif
633 tl_cff=tl_cff*rmask(i,j)
634#endif
635#ifdef VISC_3DCOEF
636 ufx(i,j)=on_r(i,j)*on_r(i,j)*visc3d_r(i,j,k)*cff
637 tl_ufx(i,j)=on_r(i,j)*on_r(i,j)* &
638 & (tl_visc3d_r(i,j,k)*cff+ &
639 & visc3d_r(i,j,k)*tl_cff)- &
640# ifdef TL_IOMS
641 & ufx(i,j)
642# endif
643 vfe(i,j)=om_r(i,j)*om_r(i,j)*visc3d_r(i,j,k)*cff
644 tl_vfe(i,j)=om_r(i,j)*om_r(i,j)* &
645 & (tl_visc3d_r(i,j,k)*cff+ &
646 & visc3d_r(i,j,k)*tl_cff)- &
647# ifdef TL_IOMS
648 & vfe(i,j)
649# endif
650#else
651!^ UFx(i,j)=on_r(i,j)*on_r(i,j)*visc2_r(i,j)*cff
652!^
653 tl_ufx(i,j)=on_r(i,j)*on_r(i,j)*visc2_r(i,j)*tl_cff
654!^ VFe(i,j)=om_r(i,j)*om_r(i,j)*visc2_r(i,j)*cff
655!^
656 tl_vfe(i,j)=om_r(i,j)*om_r(i,j)*visc2_r(i,j)*tl_cff
657#endif
658 END DO
659 END DO
660
661 DO j=jstr,jend+1
662 DO i=istr,iend+1
663 pm_p=0.25_r8*(pm(i-1,j-1)+pm(i-1,j)+ &
664 & pm(i ,j-1)+pm(i ,j))
665 pn_p=0.25_r8*(pn(i-1,j-1)+pn(i-1,j)+ &
666 & pn(i ,j-1)+pn(i ,j))
667 cff1=min(dzdx_p(i,j,k1),0.0_r8)
668 cff2=max(dzdx_p(i,j,k1),0.0_r8)
669 cff3=min(dzde_p(i,j,k1),0.0_r8)
670 cff4=max(dzde_p(i,j,k1),0.0_r8)
671 tl_cff1=(0.5_r8+sign(0.5_r8,-dzdx_p(i,j,k1)))* &
672 & tl_dzdx_p(i,j,k1)
673 tl_cff2=(0.5_r8+sign(0.5_r8, dzdx_p(i,j,k1)))* &
674 & tl_dzdx_p(i,j,k1)
675 tl_cff3=(0.5_r8+sign(0.5_r8,-dzde_p(i,j,k1)))* &
676 & tl_dzde_p(i,j,k1)
677 tl_cff4=(0.5_r8+sign(0.5_r8, dzde_p(i,j,k1)))* &
678 & tl_dzde_p(i,j,k1)
679#ifdef VISC_3DCOEF
680 cff=0.25_r8* &
681 & (hz(i-1,j ,k)+hz(i,j ,k)+ &
682 & hz(i-1,j-1,k)+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#else
696!^ cff=0.25_r8* &
697!^ & (Hz(i-1,j ,k)+Hz(i,j ,k)+ &
698!^ & Hz(i-1,j-1,k)+Hz(i,j-1,k))* &
699!^ & (on_p(i,j)*(dnVdx(i,j,k1)- &
700!^ & 0.5_r8*pn_p* &
701!^ & (cff1*(dVdz(i-1,j,k1)+ &
702!^ & dVdz(i ,j,k2))+ &
703!^ & cff2*(dVdz(i-1,j,k2)+ &
704!^ & dVdz(i ,j,k1))))+ &
705!^ & om_p(i,j)*(dmUde(i,j,k1)- &
706!^ & 0.5_r8*pm_p* &
707!^ & (cff3*(dUdz(i,j-1,k1)+ &
708!^ & dUdz(i,j ,k2))+ &
709!^ & cff4*(dUdz(i,j-1,k2)+ &
710!^ & dUdz(i,j ,k1)))))
711!^
712#endif
713 tl_cff=0.25_r8* &
714 & ((tl_hz(i-1,j ,k)+tl_hz(i,j ,k)+ &
715 & tl_hz(i-1,j-1,k)+tl_hz(i,j-1,k))* &
716 & (on_p(i,j)*(dnvdx(i,j,k1)- &
717 & 0.5_r8*pn_p* &
718 & (cff1*(dvdz(i-1,j,k1)+ &
719 & dvdz(i ,j,k2))+ &
720 & cff2*(dvdz(i-1,j,k2)+ &
721 & dvdz(i ,j,k1))))+ &
722 & om_p(i,j)*(dmude(i,j,k1)- &
723 & 0.5_r8*pm_p* &
724 & (cff3*(dudz(i,j-1,k1)+ &
725 & dudz(i,j ,k2))+ &
726 & cff4*(dudz(i,j-1,k2)+ &
727 & dudz(i,j ,k1)))))+ &
728 & (hz(i-1,j ,k)+hz(i,j ,k)+ &
729 & hz(i-1,j-1,k)+hz(i,j-1,k))* &
730 & (on_p(i,j)*(tl_dnvdx(i,j,k1)- &
731 & 0.5_r8*pn_p* &
732 & (tl_cff1*(dvdz(i-1,j,k1)+ &
733 & dvdz(i ,j,k2))+ &
734 & cff1*(tl_dvdz(i-1,j,k1)+ &
735 & tl_dvdz(i ,j,k2))+ &
736 & tl_cff2*(dvdz(i-1,j,k2)+ &
737 & dvdz(i ,j,k1))+ &
738 & cff2*(tl_dvdz(i-1,j,k2)+ &
739 & tl_dvdz(i ,j,k1))))+ &
740 & om_p(i,j)*(tl_dmude(i,j,k1)- &
741 & 0.5_r8*pm_p* &
742 & (tl_cff3*(dudz(i,j-1,k1)+ &
743 & dudz(i,j ,k2))+ &
744 & cff3*(tl_dudz(i,j-1,k1)+ &
745 & tl_dudz(i,j ,k2))+ &
746 & tl_cff4*(dudz(i,j-1,k2)+ &
747 & dudz(i,j ,k1))+ &
748 & cff4*(tl_dudz(i,j-1,k2)+ &
749 & tl_dudz(i,j ,k1))))))- &
750#ifdef TL_IOMS
751 & 0.25_r8* &
752 & (hz(i-1,j ,k)+hz(i,j ,k)+ &
753 & hz(i-1,j-1,k)+hz(i,j-1,k))* &
754 & (on_p(i,j)*(dnvdx(i,j,k1)- &
755 & pn_p* &
756 & (cff1*(dvdz(i-1,j,k1)+ &
757 & dvdz(i ,j,k2))+ &
758 & cff2*(dvdz(i-1,j,k2)+ &
759 & dvdz(i ,j,k1))))+ &
760 & om_p(i,j)*(dmude(i,j,k1)- &
761 & pm_p* &
762 & (cff3*(dudz(i,j-1,k1)+ &
763 & dudz(i,j ,k2))+ &
764 & cff4*(dudz(i,j-1,k2)+ &
765 & dudz(i,j ,k1)))))
766#endif
767#ifdef MASKING
768# ifdef VISC_3DCOEF
769 cff=cff*pmask(i,j)
770# else
771!^ cff=cff*pmask(i,j)
772!^
773# endif
774 tl_cff=tl_cff*pmask(i,j)
775#endif
776#ifdef VISC_3DCOEF
777 visc_p=0.25_r8* &
778 & (visc3d_r(i-1,j-1,k)+visc3d_r(i-1,j,k)+ &
779 & visc3d_r(i ,j-1,k)+visc3d_r(i ,j,k))
780 tl_visc_p=0.25_r8* &
781 & (tl_visc3d_r(i-1,j-1,k)+tl_visc3d_r(i-1,j,k)+ &
782 & tl_visc3d_r(i ,j-1,k)+tl_visc3d_r(i ,j,k))
783 ufe(i,j)=om_p(i,j)*om_p(i,j)*visc_p*cff
784 tl_ufe(i,j)=om_p(i,j)*om_p(i,j)* &
785 & (tl_visc_p*cff+visc_p*tl_cff)- &
786# ifdef TL_IOMS
787 & ufe(i,j)
788# endif
789 vfx(i,j)=on_p(i,j)*on_p(i,j)*visc_p*cff
790 tl_vfx(i,j)=on_p(i,j)*on_p(i,j)* &
791 & (tl_visc_p*cff+visc_p*tl_cff)- &
792# ifdef TL_IOMS
793 & vfx(i,j)
794# endif
795#else
796!^ UFe(i,j)=om_p(i,j)*om_p(i,j)*visc2_p(i,j)*cff
797!^
798 tl_ufe(i,j)=om_p(i,j)*om_p(i,j)*visc2_p(i,j)*tl_cff
799!^ VFx(i,j)=on_p(i,j)*on_p(i,j)*visc2_p(i,j)*cff
800!^
801 tl_vfx(i,j)=on_p(i,j)*on_p(i,j)*visc2_p(i,j)*tl_cff
802#endif
803 END DO
804 END DO
805!
806! Compute vertical flux (m2/s2) due to sloping terrain-following
807! surfaces.
808!
809 IF (k.lt.n(ng)) THEN
810 DO j=jstr,jend
811 DO i=istru,iend
812#ifdef VISC_3DCOEF
813 cff=0.125_r8* &
814 & (visc3d_r(i-1,j,k )+visc3d_r(i,j,k )+ &
815 & visc3d_r(i-1,j,k+1)+visc3d_r(i,j,k+1))
816 tl_cff=0.125_r8* &
817 & (tl_visc3d_r(i-1,j,k )+tl_visc3d_r(i,j,k )+ &
818 & tl_visc3d_r(i-1,j,k+1)+tl_visc3d_r(i,j,k+1))
819 fac1=cff*on_u(i,j)
820 tl_fac1=tl_cff*on_u(i,j)
821 fac2=cff*om_u(i,j)
822 tl_fac2=tl_cff*om_u(i,j)
823#else
824 cff=0.25_r8*(visc2_r(i-1,j)+visc2_r(i,j))
825 fac1=cff*on_u(i,j)
826 fac2=cff*om_u(i,j)
827#endif
828 cff=0.5_r8*(pn(i-1,j)+pn(i,j))
829 dnudz=cff*dudz(i,j,k2)
830 tl_dnudz=cff*tl_dudz(i,j,k2)
831 dnvdz=cff*0.25_r8*(dvdz(i-1,j+1,k2)+ &
832 & dvdz(i ,j+1,k2)+ &
833 & dvdz(i-1,j ,k2)+ &
834 & dvdz(i ,j ,k2))
835 tl_dnvdz=cff*0.25_r8*(tl_dvdz(i-1,j+1,k2)+ &
836 & tl_dvdz(i ,j+1,k2)+ &
837 & tl_dvdz(i-1,j ,k2)+ &
838 & tl_dvdz(i ,j ,k2))
839 cff=0.5_r8*(pm(i-1,j)+pm(i,j))
840 dmudz=cff*dudz(i,j,k2)
841 tl_dmudz=cff*tl_dudz(i,j,k2)
842 dmvdz=cff*0.25_r8*(dvdz(i-1,j+1,k2)+ &
843 & dvdz(i ,j+1,k2)+ &
844 & dvdz(i-1,j ,k2)+ &
845 & dvdz(i ,j ,k2))
846 tl_dmvdz=cff*0.25_r8*(tl_dvdz(i-1,j+1,k2)+ &
847 & tl_dvdz(i ,j+1,k2)+ &
848 & tl_dvdz(i-1,j ,k2)+ &
849 & tl_dvdz(i ,j ,k2))
850
851 cff1=min(dzdx_r(i-1,j,k1),0.0_r8)
852 cff2=min(dzdx_r(i ,j,k2),0.0_r8)
853 cff3=max(dzdx_r(i-1,j,k2),0.0_r8)
854 cff4=max(dzdx_r(i ,j,k1),0.0_r8)
855 tl_cff1=(0.5_r8+sign(0.5_r8,-dzdx_r(i-1,j,k1)))* &
856 & tl_dzdx_r(i-1,j,k1)
857 tl_cff2=(0.5_r8+sign(0.5_r8,-dzdx_r(i ,j,k2)))* &
858 & tl_dzdx_r(i ,j,k2)
859 tl_cff3=(0.5_r8+sign(0.5_r8, dzdx_r(i-1,j,k2)))* &
860 & tl_dzdx_r(i-1,j,k2)
861 tl_cff4=(0.5_r8+sign(0.5_r8, dzdx_r(i ,j,k1)))* &
862 & tl_dzdx_r(i ,j,k1)
863!^ UFsx(i,j,k2)=fac1* &
864!^ & (cff1*(cff1*dnUdz-dnUdx(i-1,j,k1))+ &
865!^ & cff2*(cff2*dnUdz-dnUdx(i ,j,k2))+ &
866!^ & cff3*(cff3*dnUdz-dnUdx(i-1,j,k2))+ &
867!^ & cff4*(cff4*dnUdz-dnUdx(i ,j,k1)))
868!^
869 tl_ufsx(i,j,k2)=fac1* &
870 & (tl_cff1*(cff1*dnudz-dnudx(i-1,j,k1))+ &
871 & tl_cff2*(cff2*dnudz-dnudx(i ,j,k2))+ &
872 & tl_cff3*(cff3*dnudz-dnudx(i-1,j,k2))+ &
873 & tl_cff4*(cff4*dnudz-dnudx(i ,j,k1))+ &
874 & cff1*(tl_cff1*dnudz+cff1*tl_dnudz- &
875 & tl_dnudx(i-1,j,k1))+ &
876 & cff2*(tl_cff2*dnudz+cff2*tl_dnudz- &
877 & tl_dnudx(i ,j,k2))+ &
878 & cff3*(tl_cff3*dnudz+cff3*tl_dnudz- &
879 & tl_dnudx(i-1,j,k2))+ &
880 & cff4*(tl_cff4*dnudz+cff4*tl_dnudz- &
881 & tl_dnudx(i ,j,k1)))- &
882#ifdef TL_IOMS
883 & fac1* &
884 & (cff1*(2.0_r8*cff1*dnudz- &
885 & dnudx(i-1,j,k1))+ &
886 & cff2*(2.0_r8*cff2*dnudz- &
887 & dnudx(i ,j,k2))+ &
888 & cff3*(2.0_r8*cff3*dnudz- &
889 & dnudx(i-1,j,k2))+ &
890 & cff4*(2.0_r8*cff4*dnudz- &
891 & dnudx(i ,j,k1)))
892#endif
893#ifdef VISC_3DCOEF
894 tl_ufsx(i,j,k2)=tl_ufsx(i,j,k2)+ &
895 & tl_fac1* &
896 & (cff1*(cff1*dnudz-dnudx(i-1,j,k1))+ &
897 & cff2*(cff2*dnudz-dnudx(i ,j,k2))+ &
898 & cff3*(cff3*dnudz-dnudx(i-1,j,k2))+ &
899 & cff4*(cff4*dnudz-dnudx(i ,j,k1)))
900#endif
901
902 cff1=min(dzde_p(i,j ,k1),0.0_r8)
903 cff2=min(dzde_p(i,j+1,k2),0.0_r8)
904 cff3=max(dzde_p(i,j ,k2),0.0_r8)
905 cff4=max(dzde_p(i,j+1,k1),0.0_r8)
906 tl_cff1=(0.5_r8+sign(0.5_r8,-dzde_p(i,j ,k1)))* &
907 & tl_dzde_p(i,j ,k1)
908 tl_cff2=(0.5_r8+sign(0.5_r8,-dzde_p(i,j+1,k2)))* &
909 & tl_dzde_p(i,j+1,k2)
910 tl_cff3=(0.5_r8+sign(0.5_r8, dzde_p(i,j ,k2)))* &
911 & tl_dzde_p(i,j ,k2)
912 tl_cff4=(0.5_r8+sign(0.5_r8, dzde_p(i,j+1,k1)))* &
913 & tl_dzde_p(i,j+1,k1)
914!^ UFse(i,j,k2)=fac2* &
915!^ & (cff1*(cff1*dmUdz-dmUde(i,j ,k1))+ &
916!^ & cff2*(cff2*dmUdz-dmUde(i,j+1,k2))+ &
917!^ & cff3*(cff3*dmUdz-dmUde(i,j ,k2))+ &
918!^ & cff4*(cff4*dmUdz-dmUde(i,j+1,k1)))
919!^
920 tl_ufse(i,j,k2)=fac2* &
921 & (tl_cff1*(cff1*dmudz-dmude(i,j ,k1))+ &
922 & tl_cff2*(cff2*dmudz-dmude(i,j+1,k2))+ &
923 & tl_cff3*(cff3*dmudz-dmude(i,j ,k2))+ &
924 & tl_cff4*(cff4*dmudz-dmude(i,j+1,k1))+ &
925 & cff1*(tl_cff1*dmudz+cff1*tl_dmudz- &
926 & tl_dmude(i,j ,k1))+ &
927 & cff2*(tl_cff2*dmudz+cff2*tl_dmudz- &
928 & tl_dmude(i,j+1,k2))+ &
929 & cff3*(tl_cff3*dmudz+cff3*tl_dmudz- &
930 & tl_dmude(i,j ,k2))+ &
931 & cff4*(tl_cff4*dmudz+cff4*tl_dmudz- &
932 & tl_dmude(i,j+1,k1)))- &
933#ifdef TL_IOMS
934 & fac2* &
935 & (cff1*(2.0_r8*cff1*dmudz- &
936 & dmude(i,j ,k1))+ &
937 & cff2*(2.0_r8*cff2*dmudz- &
938 & dmude(i,j+1,k2))+ &
939 & cff3*(2.0_r8*cff3*dmudz- &
940 & dmude(i,j ,k2))+ &
941 & cff4*(2.0_r8*cff4*dmudz- &
942 & dmude(i,j+1,k1)))
943#endif
944#ifdef VISC_3DCOEF
945 tl_ufse(i,j,k2)=tl_ufse(i,j,k2)+ &
946 & tl_fac2* &
947 & (cff1*(cff1*dmudz-dmude(i,j ,k1))+ &
948 & cff2*(cff2*dmudz-dmude(i,j+1,k2))+ &
949 & cff3*(cff3*dmudz-dmude(i,j ,k2))+ &
950 & cff4*(cff4*dmudz-dmude(i,j+1,k1)))
951#endif
952
953 cff1=min(dzde_p(i,j ,k1),0.0_r8)
954 cff2=min(dzde_p(i,j+1,k2),0.0_r8)
955 cff3=max(dzde_p(i,j ,k2),0.0_r8)
956 cff4=max(dzde_p(i,j+1,k1),0.0_r8)
957 cff5=min(dzdx_p(i,j ,k1),0.0_r8)
958 cff6=min(dzdx_p(i,j+1,k2),0.0_r8)
959 cff7=max(dzdx_p(i,j ,k2),0.0_r8)
960 cff8=max(dzdx_p(i,j+1,k1),0.0_r8)
961 tl_cff1=(0.5_r8+sign(0.5_r8,-dzde_p(i,j ,k1)))* &
962 & tl_dzde_p(i,j ,k1)
963 tl_cff2=(0.5_r8+sign(0.5_r8,-dzde_p(i,j+1,k2)))* &
964 & tl_dzde_p(i,j+1,k2)
965 tl_cff3=(0.5_r8+sign(0.5_r8, dzde_p(i,j ,k2)))* &
966 & tl_dzde_p(i,j ,k2)
967 tl_cff4=(0.5_r8+sign(0.5_r8, dzde_p(i,j+1,k1)))* &
968 & tl_dzde_p(i,j+1,k1)
969 tl_cff5=(0.5_r8+sign(0.5_r8,-dzdx_p(i,j ,k1)))* &
970 & tl_dzdx_p(i,j ,k1)
971 tl_cff6=(0.5_r8+sign(0.5_r8,-dzdx_p(i,j+1,k2)))* &
972 & tl_dzdx_p(i,j+1,k2)
973 tl_cff7=(0.5_r8+sign(0.5_r8, dzdx_p(i,j ,k2)))* &
974 & tl_dzdx_p(i,j ,k2)
975 tl_cff8=(0.5_r8+sign(0.5_r8, dzdx_p(i,j+1,k1)))* &
976 & tl_dzdx_p(i,j+1,k1)
977!^ UFsx(i,j,k2)=UFsx(i,j,k2)+ &
978!^ & fac1* &
979!^ & (cff1*(cff5*dnVdz-dnVdx(i,j ,k1))+ &
980!^ & cff2*(cff6*dnVdz-dnVdx(i,j+1,k2))+ &
981!^ & cff3*(cff7*dnVdz-dnVdx(i,j ,k2))+ &
982!^ & cff4*(cff8*dnVdz-dnVdx(i,j+1,k1)))
983!^
984 tl_ufsx(i,j,k2)=tl_ufsx(i,j,k2)+ &
985 & fac1* &
986 & (tl_cff1*(cff5*dnvdz-dnvdx(i,j ,k1))+ &
987 & tl_cff2*(cff6*dnvdz-dnvdx(i,j+1,k2))+ &
988 & tl_cff3*(cff7*dnvdz-dnvdx(i,j ,k2))+ &
989 & tl_cff4*(cff8*dnvdz-dnvdx(i,j+1,k1))+ &
990 & cff1*(tl_cff5*dnvdz+cff5*tl_dnvdz- &
991 & tl_dnvdx(i,j ,k1))+ &
992 & cff2*(tl_cff6*dnvdz+cff6*tl_dnvdz- &
993 & tl_dnvdx(i,j+1,k2))+ &
994 & cff3*(tl_cff7*dnvdz+cff7*tl_dnvdz- &
995 & tl_dnvdx(i,j ,k2))+ &
996 & cff4*(tl_cff8*dnvdz+cff8*tl_dnvdz- &
997 & tl_dnvdx(i,j+1,k1)))- &
998#ifdef TL_IOMS
999 & fac1* &
1000 & (cff1*(2.0_r8*cff5*dnvdz- &
1001 & dnvdx(i,j ,k1))+ &
1002 & cff2*(2.0_r8*cff6*dnvdz- &
1003 & dnvdx(i,j+1,k2))+ &
1004 & cff3*(2.0_r8*cff7*dnvdz- &
1005 & dnvdx(i,j ,k2))+ &
1006 & cff4*(2.0_r8*cff8*dnvdz- &
1007 & dnvdx(i,j+1,k1)))
1008#endif
1009#ifdef VISC_3DCOEF
1010 tl_ufsx(i,j,k2)=tl_ufsx(i,j,k2)+ &
1011 & tl_fac1* &
1012 & (cff1*(cff5*dnvdz-dnvdx(i,j ,k1))+ &
1013 & cff2*(cff6*dnvdz-dnvdx(i,j+1,k2))+ &
1014 & cff3*(cff7*dnvdz-dnvdx(i,j ,k2))+ &
1015 & cff4*(cff8*dnvdz-dnvdx(i,j+1,k1)))
1016#endif
1017
1018 cff1=min(dzdx_r(i-1,j,k1),0.0_r8)
1019 cff2=min(dzdx_r(i ,j,k2),0.0_r8)
1020 cff3=max(dzdx_r(i-1,j,k2),0.0_r8)
1021 cff4=max(dzdx_r(i ,j,k1),0.0_r8)
1022 cff5=min(dzde_r(i-1,j,k1),0.0_r8)
1023 cff6=min(dzde_r(i ,j,k2),0.0_r8)
1024 cff7=max(dzde_r(i-1,j,k2),0.0_r8)
1025 cff8=max(dzde_r(i ,j,k1),0.0_r8)
1026 tl_cff1=(0.5_r8+sign(0.5_r8,-dzdx_r(i-1,j,k1)))* &
1027 & tl_dzdx_r(i-1,j,k1)
1028 tl_cff2=(0.5_r8+sign(0.5_r8,-dzdx_r(i ,j,k2)))* &
1029 & tl_dzdx_r(i ,j,k2)
1030 tl_cff3=(0.5_r8+sign(0.5_r8, dzdx_r(i-1,j,k2)))* &
1031 & tl_dzdx_r(i-1,j,k2)
1032 tl_cff4=(0.5_r8+sign(0.5_r8, dzdx_r(i ,j,k1)))* &
1033 & tl_dzdx_r(i ,j,k1)
1034 tl_cff5=(0.5_r8+sign(0.5_r8,-dzde_r(i-1,j,k1)))* &
1035 & tl_dzde_r(i-1,j,k1)
1036 tl_cff6=(0.5_r8+sign(0.5_r8,-dzde_r(i ,j,k2)))* &
1037 & tl_dzde_r(i ,j,k2)
1038 tl_cff7=(0.5_r8+sign(0.5_r8, dzde_r(i-1,j,k2)))* &
1039 & tl_dzde_r(i-1,j,k2)
1040 tl_cff8=(0.5_r8+sign(0.5_r8, dzde_r(i ,j,k1)))* &
1041 & tl_dzde_r(i ,j,k1)
1042!^ UFse(i,j,k2)=UFse(i,j,k2)- &
1043!^ & fac2* &
1044!^ & (cff1*(cff5*dmVdz-dmVde(i-1,j,k1))+ &
1045!^ & cff2*(cff6*dmVdz-dmVde(i ,j,k2))+ &
1046!^ & cff3*(cff7*dmVdz-dmVde(i-1,j,k2))+ &
1047!^ & cff4*(cff8*dmVdz-dmVde(i ,j,k1)))
1048!^
1049 tl_ufse(i,j,k2)=tl_ufse(i,j,k2)- &
1050 & fac2* &
1051 & (tl_cff1*(cff5*dmvdz-dmvde(i-1,j,k1))+ &
1052 & tl_cff2*(cff6*dmvdz-dmvde(i ,j,k2))+ &
1053 & tl_cff3*(cff7*dmvdz-dmvde(i-1,j,k2))+ &
1054 & tl_cff4*(cff8*dmvdz-dmvde(i ,j,k1))+ &
1055 & cff1*(tl_cff5*dmvdz+cff5*tl_dmvdz- &
1056 & tl_dmvde(i-1,j,k1))+ &
1057 & cff2*(tl_cff6*dmvdz+cff6*tl_dmvdz- &
1058 & tl_dmvde(i ,j,k2))+ &
1059 & cff3*(tl_cff7*dmvdz+cff7*tl_dmvdz- &
1060 & tl_dmvde(i-1,j,k2))+ &
1061 & cff4*(tl_cff8*dmvdz+cff8*tl_dmvdz- &
1062 & tl_dmvde(i ,j,k1)))+ &
1063#ifdef TL_IOMS
1064 & fac2* &
1065 & (cff1*(2.0_r8*cff5*dmvdz- &
1066 & dmvde(i-1,j,k1))+ &
1067 & cff2*(2.0_r8*cff6*dmvdz- &
1068 & dmvde(i ,j,k2))+ &
1069 & cff3*(2.0_r8*cff7*dmvdz- &
1070 & dmvde(i-1,j,k2))+ &
1071 & cff4*(2.0_r8*cff8*dmvdz- &
1072 & dmvde(i ,j,k1)))
1073#endif
1074#ifdef VISC_3DCOEF
1075 tl_ufse(i,j,k2)=tl_ufse(i,j,k2)- &
1076 & tl_fac2* &
1077 & (cff1*(cff5*dmvdz-dmvde(i-1,j,k1))+ &
1078 & cff2*(cff6*dmvdz-dmvde(i ,j,k2))+ &
1079 & cff3*(cff7*dmvdz-dmvde(i-1,j,k2))+ &
1080 & cff4*(cff8*dmvdz-dmvde(i ,j,k1)))
1081#endif
1082 END DO
1083 END DO
1084!
1085 DO j=jstrv,jend
1086 DO i=istr,iend
1087#ifdef VISC_3DCOEF
1088 cff=0.125_r8* &
1089 & (visc3d_r(i,j-1,k )+visc3d_r(i,j,k )+ &
1090 & visc3d_r(i,j-1,k+1)+visc3d_r(i,j,k+1))
1091 tl_cff=0.125_r8* &
1092 & (tl_visc3d_r(i,j-1,k )+tl_visc3d_r(i,j,k )+ &
1093 & tl_visc3d_r(i,j-1,k+1)+tl_visc3d_r(i,j,k+1))
1094 fac1=cff*on_v(i,j)
1095 tl_fac1=tl_cff*on_v(i,j)
1096 fac2=cff*om_v(i,j)
1097 tl_fac2=tl_cff*om_v(i,j)
1098#else
1099 cff=0.25_r8*(visc2_r(i,j-1)+visc2_r(i,j))
1100 fac1=cff*on_v(i,j)
1101 fac2=cff*om_v(i,j)
1102#endif
1103 cff=0.5_r8*(pn(i,j-1)+pn(i,j))
1104 dnudz=cff*0.25_r8*(dudz(i ,j ,k2)+ &
1105 & dudz(i+1,j ,k2)+ &
1106 & dudz(i ,j-1,k2)+ &
1107 & dudz(i+1,j-1,k2))
1108 tl_dnudz=cff*0.25_r8*(tl_dudz(i ,j ,k2)+ &
1109 & tl_dudz(i+1,j ,k2)+ &
1110 & tl_dudz(i ,j-1,k2)+ &
1111 & tl_dudz(i+1,j-1,k2))
1112 dnvdz=cff*dvdz(i,j,k2)
1113 tl_dnvdz=cff*tl_dvdz(i,j,k2)
1114 cff=0.5_r8*(pm(i,j-1)+pm(i,j))
1115 dmudz=cff*0.25_r8*(dudz(i ,j ,k2)+ &
1116 & dudz(i+1,j ,k2)+ &
1117 & dudz(i ,j-1,k2)+ &
1118 & dudz(i+1,j-1,k2))
1119 tl_dmudz=cff*0.25_r8*(tl_dudz(i ,j ,k2)+ &
1120 & tl_dudz(i+1,j ,k2)+ &
1121 & tl_dudz(i ,j-1,k2)+ &
1122 & tl_dudz(i+1,j-1,k2))
1123 dmvdz=cff*dvdz(i,j,k2)
1124 tl_dmvdz=cff*tl_dvdz(i,j,k2)
1125
1126 cff1=min(dzdx_p(i ,j,k1),0.0_r8)
1127 cff2=min(dzdx_p(i+1,j,k2),0.0_r8)
1128 cff3=max(dzdx_p(i ,j,k2),0.0_r8)
1129 cff4=max(dzdx_p(i+1,j,k1),0.0_r8)
1130 tl_cff1=(0.5_r8+sign(0.5_r8,-dzdx_p(i ,j,k1)))* &
1131 & tl_dzdx_p(i ,j,k1)
1132 tl_cff2=(0.5_r8+sign(0.5_r8,-dzdx_p(i+1,j,k2)))* &
1133 & tl_dzdx_p(i+1,j,k2)
1134 tl_cff3=(0.5_r8+sign(0.5_r8, dzdx_p(i ,j,k2)))* &
1135 & tl_dzdx_p(i ,j,k2)
1136 tl_cff4=(0.5_r8+sign(0.5_r8, dzdx_p(i+1,j,k1)))* &
1137 & tl_dzdx_p(i+1,j,k1)
1138!^ VFsx(i,j,k2)=fac1* &
1139!^ & (cff1*(cff1*dnVdz-dnVdx(i ,j,k1))+ &
1140!^ & cff2*(cff2*dnVdz-dnVdx(i+1,j,k2))+ &
1141!^ & cff3*(cff3*dnVdz-dnVdx(i ,j,k2))+ &
1142!^ & cff4*(cff4*dnVdz-dnVdx(i+1,j,k1)))
1143!^
1144 tl_vfsx(i,j,k2)=fac1* &
1145 & (tl_cff1*(cff1*dnvdz-dnvdx(i ,j,k1))+ &
1146 & tl_cff2*(cff2*dnvdz-dnvdx(i+1,j,k2))+ &
1147 & tl_cff3*(cff3*dnvdz-dnvdx(i ,j,k2))+ &
1148 & tl_cff4*(cff4*dnvdz-dnvdx(i+1,j,k1))+ &
1149 & cff1*(tl_cff1*dnvdz+cff1*tl_dnvdz- &
1150 & tl_dnvdx(i ,j,k1))+ &
1151 & cff2*(tl_cff2*dnvdz+cff2*tl_dnvdz- &
1152 & tl_dnvdx(i+1,j,k2))+ &
1153 & cff3*(tl_cff3*dnvdz+cff3*tl_dnvdz- &
1154 & tl_dnvdx(i ,j,k2))+ &
1155 & cff4*(tl_cff4*dnvdz+cff4*tl_dnvdz- &
1156 & tl_dnvdx(i+1,j,k1)))- &
1157#ifdef TL_IOMS
1158 & fac1* &
1159 & (cff1*(2.0_r8*cff1*dnvdz- &
1160 & dnvdx(i ,j,k1))+ &
1161 & cff2*(2.0_r8*cff2*dnvdz- &
1162 & dnvdx(i+1,j,k2))+ &
1163 & cff3*(2.0_r8*cff3*dnvdz- &
1164 & dnvdx(i ,j,k2))+ &
1165 & cff4*(2.0_r8*cff4*dnvdz- &
1166 & dnvdx(i+1,j,k1)))
1167#endif
1168#ifdef VISC_3DCOEF
1169 tl_vfsx(i,j,k2)=tl_vfsx(i,j,k2)+ &
1170 & tl_fac1* &
1171 & (cff1*(cff1*dnvdz-dnvdx(i ,j,k1))+ &
1172 & cff2*(cff2*dnvdz-dnvdx(i+1,j,k2))+ &
1173 & cff3*(cff3*dnvdz-dnvdx(i ,j,k2))+ &
1174 & cff4*(cff4*dnvdz-dnvdx(i+1,j,k1)))
1175#endif
1176
1177 cff1=min(dzde_r(i,j-1,k1),0.0_r8)
1178 cff2=min(dzde_r(i,j ,k2),0.0_r8)
1179 cff3=max(dzde_r(i,j-1,k2),0.0_r8)
1180 cff4=max(dzde_r(i,j ,k1),0.0_r8)
1181 tl_cff1=(0.5_r8+sign(0.5_r8,-dzde_r(i,j-1,k1)))* &
1182 & tl_dzde_r(i,j-1,k1)
1183 tl_cff2=(0.5_r8+sign(0.5_r8,-dzde_r(i,j ,k2)))* &
1184 & tl_dzde_r(i,j ,k2)
1185 tl_cff3=(0.5_r8+sign(0.5_r8, dzde_r(i,j-1,k2)))* &
1186 & tl_dzde_r(i,j-1,k2)
1187 tl_cff4=(0.5_r8+sign(0.5_r8, dzde_r(i,j ,k1)))* &
1188 & tl_dzde_r(i,j ,k1)
1189!^ VFse(i,j,k2)=fac2* &
1190!^ & (cff1*(cff1*dmVdz-dmVde(i,j-1,k1))+ &
1191!^ & cff2*(cff2*dmVdz-dmVde(i,j ,k2))+ &
1192!^ & cff3*(cff3*dmVdz-dmVde(i,j-1,k2))+ &
1193!^ & cff4*(cff4*dmVdz-dmVde(i,j ,k1)))
1194!^
1195 tl_vfse(i,j,k2)=fac2* &
1196 & (tl_cff1*(cff1*dmvdz-dmvde(i,j-1,k1))+ &
1197 & tl_cff2*(cff2*dmvdz-dmvde(i,j ,k2))+ &
1198 & tl_cff3*(cff3*dmvdz-dmvde(i,j-1,k2))+ &
1199 & tl_cff4*(cff4*dmvdz-dmvde(i,j ,k1))+ &
1200 & cff1*(tl_cff1*dmvdz+cff1*tl_dmvdz- &
1201 & tl_dmvde(i,j-1,k1))+ &
1202 & cff2*(tl_cff2*dmvdz+cff2*tl_dmvdz- &
1203 & tl_dmvde(i,j ,k2))+ &
1204 & cff3*(tl_cff3*dmvdz+cff3*tl_dmvdz- &
1205 & tl_dmvde(i,j-1,k2))+ &
1206 & cff4*(tl_cff4*dmvdz+cff4*tl_dmvdz- &
1207 & tl_dmvde(i,j ,k1)))- &
1208#ifdef TL_IOMS
1209 & fac2* &
1210 & (cff1*(2.0_r8*cff1*dmvdz- &
1211 & dmvde(i,j-1,k1))+ &
1212 & cff2*(2.0_r8*cff2*dmvdz- &
1213 & dmvde(i,j ,k2))+ &
1214 & cff3*(2.0_r8*cff3*dmvdz- &
1215 & dmvde(i,j-1,k2))+ &
1216 & cff4*(2.0_r8*cff4*dmvdz- &
1217 & dmvde(i,j ,k1)))
1218#endif
1219#ifdef VISC_3DCOEF
1220 tl_vfse(i,j,k2)=tl_vfse(i,j,k2)+ &
1221 & tl_fac2* &
1222 & (cff1*(cff1*dmvdz-dmvde(i,j-1,k1))+ &
1223 & cff2*(cff2*dmvdz-dmvde(i,j ,k2))+ &
1224 & cff3*(cff3*dmvdz-dmvde(i,j-1,k2))+ &
1225 & cff4*(cff4*dmvdz-dmvde(i,j ,k1)))
1226#endif
1227
1228 cff1=min(dzde_r(i,j-1,k1),0.0_r8)
1229 cff2=min(dzde_r(i,j ,k2),0.0_r8)
1230 cff3=max(dzde_r(i,j-1,k2),0.0_r8)
1231 cff4=max(dzde_r(i,j ,k1),0.0_r8)
1232 cff5=min(dzdx_r(i,j-1,k1),0.0_r8)
1233 cff6=min(dzdx_r(i,j ,k2),0.0_r8)
1234 cff7=max(dzdx_r(i,j-1,k2),0.0_r8)
1235 cff8=max(dzdx_r(i,j ,k1),0.0_r8)
1236 tl_cff1=(0.5_r8+sign(0.5_r8,-dzde_r(i,j-1,k1)))* &
1237 & tl_dzde_r(i,j-1,k1)
1238 tl_cff2=(0.5_r8+sign(0.5_r8,-dzde_r(i,j ,k2)))* &
1239 & tl_dzde_r(i,j ,k2)
1240 tl_cff3=(0.5_r8+sign(0.5_r8, dzde_r(i,j-1,k2)))* &
1241 & tl_dzde_r(i,j-1,k2)
1242 tl_cff4=(0.5_r8+sign(0.5_r8, dzde_r(i,j ,k1)))* &
1243 & tl_dzde_r(i,j ,k1)
1244 tl_cff5=(0.5_r8+sign(0.5_r8,-dzdx_r(i,j-1,k1)))* &
1245 & tl_dzdx_r(i,j-1,k1)
1246 tl_cff6=(0.5_r8+sign(0.5_r8,-dzdx_r(i,j ,k2)))* &
1247 & tl_dzdx_r(i,j ,k2)
1248 tl_cff7=(0.5_r8+sign(0.5_r8, dzdx_r(i,j-1,k2)))* &
1249 & tl_dzdx_r(i,j-1,k2)
1250 tl_cff8=(0.5_r8+sign(0.5_r8, dzdx_r(i,j ,k1)))* &
1251 & tl_dzdx_r(i,j ,k1)
1252!^ VFsx(i,j,k2)=VFsx(i,j,k2)- &
1253!^ & fac1* &
1254!^ & (cff1*(cff5*dnUdz-dnUdx(i,j-1,k1))+ &
1255!^ & cff2*(cff6*dnUdz-dnUdx(i,j ,k2))+ &
1256!^ & cff3*(cff7*dnUdz-dnUdx(i,j-1,k2))+ &
1257!^ & cff4*(cff8*dnUdz-dnUdx(i,j ,k1)))
1258!^
1259 tl_vfsx(i,j,k2)=tl_vfsx(i,j,k2)- &
1260 & fac1* &
1261 & (tl_cff1*(cff5*dnudz-dnudx(i,j-1,k1))+ &
1262 & tl_cff2*(cff6*dnudz-dnudx(i,j ,k2))+ &
1263 & tl_cff3*(cff7*dnudz-dnudx(i,j-1,k2))+ &
1264 & tl_cff4*(cff8*dnudz-dnudx(i,j ,k1))+ &
1265 & cff1*(tl_cff5*dnudz+cff5*tl_dnudz- &
1266 & tl_dnudx(i,j-1,k1))+ &
1267 & cff2*(tl_cff6*dnudz+cff6*tl_dnudz- &
1268 & tl_dnudx(i,j ,k2))+ &
1269 & cff3*(tl_cff7*dnudz+cff7*tl_dnudz- &
1270 & tl_dnudx(i,j-1,k2))+ &
1271 & cff4*(tl_cff8*dnudz+cff8*tl_dnudz- &
1272 & tl_dnudx(i,j ,k1)))+ &
1273#ifdef TL_IOMS
1274 & fac1* &
1275 & (cff1*(2.0_r8*cff5*dnudz- &
1276 & dnudx(i,j-1,k1))+ &
1277 & cff2*(2.0_r8*cff6*dnudz- &
1278 & dnudx(i,j ,k2))+ &
1279 & cff3*(2.0_r8*cff7*dnudz- &
1280 & dnudx(i,j-1,k2))+ &
1281 & cff4*(2.0_r8*cff8*dnudz- &
1282 & dnudx(i,j ,k1)))
1283#endif
1284#ifdef VISC_3DCOEF
1285 tl_vfsx(i,j,k2)=tl_vfsx(i,j,k2)- &
1286 & tl_fac1* &
1287 & (cff1*(cff5*dnudz-dnudx(i,j-1,k1))+ &
1288 & cff2*(cff6*dnudz-dnudx(i,j ,k2))+ &
1289 & cff3*(cff7*dnudz-dnudx(i,j-1,k2))+ &
1290 & cff4*(cff8*dnudz-dnudx(i,j ,k1)))
1291#endif
1292
1293 cff1=min(dzdx_p(i ,j,k1),0.0_r8)
1294 cff2=min(dzdx_p(i+1,j,k2),0.0_r8)
1295 cff3=max(dzdx_p(i ,j,k2),0.0_r8)
1296 cff4=max(dzdx_p(i+1,j,k1),0.0_r8)
1297 cff5=min(dzde_p(i ,j,k1),0.0_r8)
1298 cff6=min(dzde_p(i+1,j,k2),0.0_r8)
1299 cff7=max(dzde_p(i ,j,k2),0.0_r8)
1300 cff8=max(dzde_p(i+1,j,k1),0.0_r8)
1301 tl_cff1=(0.5_r8+sign(0.5_r8,-dzdx_p(i ,j,k1)))* &
1302 & tl_dzdx_p(i ,j,k1)
1303 tl_cff2=(0.5_r8+sign(0.5_r8,-dzdx_p(i+1,j,k2)))* &
1304 & tl_dzdx_p(i+1,j,k2)
1305 tl_cff3=(0.5_r8+sign(0.5_r8, dzdx_p(i ,j,k2)))* &
1306 & tl_dzdx_p(i ,j,k2)
1307 tl_cff4=(0.5_r8+sign(0.5_r8, dzdx_p(i+1,j,k1)))* &
1308 & tl_dzdx_p(i+1,j,k1)
1309 tl_cff5=(0.5_r8+sign(0.5_r8,-dzde_p(i ,j,k1)))* &
1310 & tl_dzde_p(i ,j,k1)
1311 tl_cff6=(0.5_r8+sign(0.5_r8,-dzde_p(i+1,j,k2)))* &
1312 & tl_dzde_p(i+1,j,k2)
1313 tl_cff7=(0.5_r8+sign(0.5_r8, dzde_p(i ,j,k2)))* &
1314 & tl_dzde_p(i ,j,k2)
1315 tl_cff8=(0.5_r8+sign(0.5_r8, dzde_p(i+1,j,k1)))* &
1316 & tl_dzde_p(i+1,j,k1)
1317!^ VFse(i,j,k2)=VFse(i,j,k2)+ &
1318!^ & fac2* &
1319!^ & (cff1*(cff5*dmUdz-dmUde(i ,j,k1))+ &
1320!^ & cff2*(cff6*dmUdz-dmUde(i+1,j,k2))+ &
1321!^ & cff3*(cff7*dmUdz-dmUde(i ,j,k2))+ &
1322!^ & cff4*(cff8*dmUdz-dmUde(i+1,j,k1)))
1323!^
1324 tl_vfse(i,j,k2)=tl_vfse(i,j,k2)+ &
1325 & fac2* &
1326 & (tl_cff1*(cff5*dmudz-dmude(i ,j,k1))+ &
1327 & tl_cff2*(cff6*dmudz-dmude(i+1,j,k2))+ &
1328 & tl_cff3*(cff7*dmudz-dmude(i ,j,k2))+ &
1329 & tl_cff4*(cff8*dmudz-dmude(i+1,j,k1))+ &
1330 & cff1*(tl_cff5*dmudz+cff5*tl_dmudz- &
1331 & tl_dmude(i ,j,k1))+ &
1332 & cff2*(tl_cff6*dmudz+cff6*tl_dmudz- &
1333 & tl_dmude(i+1,j,k2))+ &
1334 & cff3*(tl_cff7*dmudz+cff7*tl_dmudz- &
1335 & tl_dmude(i ,j,k2))+ &
1336 & cff4*(tl_cff8*dmudz+cff8*tl_dmudz- &
1337 & tl_dmude(i+1,j,k1)))- &
1338#ifdef TL_IOMS
1339 & fac2* &
1340 & (cff1*(2.0_r8*cff5*dmudz- &
1341 & dmude(i ,j,k1))+ &
1342 & cff2*(2.0_r8*cff6*dmudz- &
1343 & dmude(i+1,j,k2))+ &
1344 & cff3*(2.0_r8*cff7*dmudz- &
1345 & dmude(i ,j,k2))+ &
1346 & cff4*(2.0_r8*cff8*dmudz- &
1347 & dmude(i+1,j,k1)))
1348#endif
1349#ifdef VISC_3DCOEF
1350 tl_vfse(i,j,k2)=tl_vfse(i,j,k2)+ &
1351 & tl_fac2* &
1352 & (cff1*(cff5*dmudz-dmude(i ,j,k1))+ &
1353 & cff2*(cff6*dmudz-dmude(i+1,j,k2))+ &
1354 & cff3*(cff7*dmudz-dmude(i ,j,k2))+ &
1355 & cff4*(cff8*dmudz-dmude(i+1,j,k1)))
1356#endif
1357 END DO
1358 END DO
1359 END IF
1360!
1361! Time-step harmonic, geopotential viscosity term. Notice that
1362! momentum at this stage is HzU and HzV and has m2/s units. Add
1363! contribution for barotropic forcing terms.
1364#ifdef DIAGNOSTICS_UV
1365!! The rotated vertical term cannot be split from the horizontal
1366!! terms because of the 2D/3D momentum coupling.
1367#endif
1368!
1369 DO j=jstr,jend
1370 DO i=istru,iend
1371 cff=dt(ng)*0.25_r8*(pm(i-1,j)+pm(i,j))*(pn(i-1,j)+pn(i,j))
1372!^ cff1=0.5_r8*(pn(i-1,j)+pn(i,j))*(UFx(i,j )-UFx(i-1,j))
1373!^
1374 tl_cff1=0.5_r8*(pn(i-1,j)+pn(i,j))* &
1375 & (tl_ufx(i,j )-tl_ufx(i-1,j))
1376!^ cff2=0.5_r8*(pm(i-1,j)+pm(i,j))*(UFe(i,j+1)-UFe(i ,j))
1377!^
1378 tl_cff2=0.5_r8*(pm(i-1,j)+pm(i,j))* &
1379 & (tl_ufe(i,j+1)-tl_ufe(i ,j))
1380!^ cff3=UFsx(i,j,k2)-UFsx(i,j,k1)
1381!^
1382 tl_cff3=tl_ufsx(i,j,k2)-tl_ufsx(i,j,k1)
1383!^ cff4=UFse(i,j,k2)-UFse(i,j,k1)
1384!^
1385 tl_cff4=tl_ufse(i,j,k2)-tl_ufse(i,j,k1)
1386!^ cff5=cff*(cff1+cff2)
1387!^
1388 tl_cff5=cff*(tl_cff1+tl_cff2)
1389!^ cff6=dt(ng)*(cff3+cff4)
1390!^
1391 tl_cff6=dt(ng)*(tl_cff3+tl_cff4)
1392!^ rufrc(i,j)=rufrc(i,j)+cff1+cff2+cff3+cff4
1393!^
1394 tl_rufrc(i,j)=tl_rufrc(i,j)+ &
1395 & tl_cff1+tl_cff2+tl_cff3+tl_cff4
1396!^ u(i,j,k,nnew)=u(i,j,k,nnew)+cff5+cff6
1397!^
1398 tl_u(i,j,k,nnew)=tl_u(i,j,k,nnew)+tl_cff5+tl_cff6
1399#ifdef DIAGNOSTICS_UV
1400!! DiaRUfrc(i,j,3,M2hvis)=DiaRUfrc(i,j,3,M2hvis)+cff1+cff2+ &
1401!! & cff3+cff4
1402!! DiaRUfrc(i,j,3,M2xvis)=DiaRUfrc(i,j,3,M2xvis)+cff1+cff3
1403!! DiaRUfrc(i,j,3,M2yvis)=DiaRUfrc(i,j,3,M2yvis)+cff2+cff4
1404!! DiaU3wrk(i,j,k,M3hvis)=cff5+cff6
1405!! DiaU3wrk(i,j,k,M3xvis)=cff*cff1+dt(ng)*cff3
1406!! DiaU3wrk(i,j,k,M3yvis)=cff*cff2+dt(ng)*cff4
1407#endif
1408 END DO
1409 END DO
1410
1411 DO j=jstrv,jend
1412 DO i=istr,iend
1413 cff=dt(ng)*0.25_r8*(pm(i,j)+pm(i,j-1))*(pn(i,j)+pn(i,j-1))
1414!^ cff1=0.5_r8*(pn(i,j-1)+pn(i,j))*(VFx(i+1,j)-VFx(i,j ))
1415!^
1416 tl_cff1=0.5_r8*(pn(i,j-1)+pn(i,j))* &
1417 & (tl_vfx(i+1,j)-tl_vfx(i,j ))
1418!^ cff2=0.5_r8*(pm(i,j-1)+pm(i,j))*(VFe(i ,j)-VFe(i,j-1))
1419!^
1420 tl_cff2=0.5_r8*(pm(i,j-1)+pm(i,j))* &
1421 & (tl_vfe(i ,j)-tl_vfe(i,j-1))
1422!^ cff3=VFsx(i,j,k2)-VFsx(i,j,k1)
1423!^
1424 tl_cff3=tl_vfsx(i,j,k2)-tl_vfsx(i,j,k1)
1425!^ cff4=VFse(i,j,k2)-VFse(i,j,k1)
1426!^
1427 tl_cff4=tl_vfse(i,j,k2)-tl_vfse(i,j,k1)
1428!^ cff5=cff*(cff1-cff2)
1429!^
1430 tl_cff5=cff*(tl_cff1-tl_cff2)
1431!^ cff6=dt(ng)*(cff3+cff4)
1432!^
1433 tl_cff6=dt(ng)*(tl_cff3+tl_cff4)
1434!^ rvfrc(i,j)=rvfrc(i,j)+cff1-cff2+cff3+cff4
1435!^
1436 tl_rvfrc(i,j)=tl_rvfrc(i,j)+ &
1437 & tl_cff1-tl_cff2+tl_cff3+tl_cff4
1438!^ v(i,j,k,nnew)=v(i,j,k,nnew)+cff5+cff6
1439!^
1440 tl_v(i,j,k,nnew)=tl_v(i,j,k,nnew)+tl_cff5+tl_cff6
1441#ifdef DIAGNOSTICS_UV
1442!! DiaRVfrc(i,j,3,M2hvis)=DiaRVfrc(i,j,3,M2hvis)+cff1-cff2+ &
1443!! & cff3+cff4
1444!! DiaRVfrc(i,j,3,M2xvis)=DiaRVfrc(i,j,3,M2xvis)+cff1+cff3
1445!! DiaRVfrc(i,j,3,M2yvis)=DiaRVfrc(i,j,3,M2yvis)-cff2+cff4
1446!! DiaV3wrk(i,j,k,M3hvis)=cff5+cff6
1447!! DiaV3wrk(i,j,k,M3xvis)= cff*cff1+dt(ng)*cff3
1448!! DiaV3wrk(i,j,k,M3yvis)=-cff*cff2+dt(ng)*cff4
1449#endif
1450 END DO
1451 END DO
1452 END IF
1453 END DO k_loop
1454!
1455 RETURN
1456 END SUBROUTINE rp_uv3dmix2_geo_tile
1457
1458 END MODULE rp_uv3dmix2_mod
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::irpm
integer, parameter irpm
Definition mod_param.F:664
mod_scalars
Definition mod_scalars.F:2
mod_scalars::dt
real(dp), dimension(:), allocatable dt
Definition mod_scalars.F:269
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
rp_uv3dmix2_mod
Definition rp_uv3dmix2_geo.h:1
rp_uv3dmix2_mod::rp_uv3dmix2
subroutine, public rp_uv3dmix2(ng, tile)
Definition rp_uv3dmix2_geo.h:44
rp_uv3dmix2_mod::rp_uv3dmix2_geo_tile
subroutine rp_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)
Definition rp_uv3dmix2_geo.h:146
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