New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
zdfsh2.F90 in NEMO/branches/UKMO/dev_r9950_old_tidal_mixing/src/OCE/ZDF – NEMO

source: NEMO/branches/UKMO/dev_r9950_old_tidal_mixing/src/OCE/ZDF/zdfsh2.F90 @ 10324

Last change on this file since 10324 was 10324, checked in by davestorkey, 5 years ago

UKMO/dev_r9950_old_tidal_mixing: Update to be relative to rev 10321 of NEMO4_beta_mirror branch.

  • Property svn:keywords set to Id
File size: 4.2 KB
Line 
1MODULE zdfsh2
2   !!======================================================================
3   !!                       ***  MODULE  zdfsh2  ***
4   !! Ocean physics:  shear production term of TKE
5   !!=====================================================================
6   !! History :   -   !  2014-10  (A. Barthelemy, G. Madec)  original code
7   !!   NEMO     4.0  !  2017-04  (G. Madec)  remove u-,v-pts avm
8   !!----------------------------------------------------------------------
9
10   !!----------------------------------------------------------------------
11   !!   zdf_sh2       : compute mixing the shear production term of TKE
12   !!----------------------------------------------------------------------
13   USE dom_oce        ! domain: ocean
14   !
15   USE in_out_manager ! I/O manager
16   USE lib_mpp        ! MPP library
17
18   IMPLICIT NONE
19   PRIVATE
20
21   PUBLIC   zdf_sh2        ! called by zdftke, zdfglf, and zdfric
22   
23   !!----------------------------------------------------------------------
24   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
25   !! $Id$
26   !! Software governed by the CeCILL license (see ./LICENSE)
27   !!----------------------------------------------------------------------
28CONTAINS
29
30   SUBROUTINE zdf_sh2( pub, pvb, pun, pvn, p_avm, p_sh2  ) 
31      !!----------------------------------------------------------------------
32      !!                   ***  ROUTINE zdf_sh2  ***
33      !!
34      !! ** Purpose :   Compute the shear production term of a TKE equation
35      !!
36      !! ** Method  : - a stable discretization of this term is linked to the
37      !!                time-space discretization of the vertical diffusion
38      !!                of the OGCM. NEMO uses C-grid, a leap-frog environment
39      !!                and an implicit computation of vertical mixing term,
40      !!                so the shear production at w-point is given by:
41      !!                   sh2 = mi[   mi(avm) * dk[ub]/e3ub * dk[un]/e3un   ]
42      !!                       + mj[   mj(avm) * dk[vb]/e3vb * dk[vn]/e3vn   ]
43      !!                NB: wet-point only horizontal averaging of shear
44      !!
45      !! ** Action  : - p_sh2 shear prod. term at w-point (inner domain only)
46      !!                                                   *****
47      !! References :   Bruchard, OM 2002
48      !! ---------------------------------------------------------------------
49      REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   pub, pvb, pun, pvn   ! before, now horizontal velocities
50      REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   p_avm                ! vertical eddy viscosity (w-points)
51      REAL(wp), DIMENSION(:,:,:) , INTENT(  out) ::   p_sh2                ! shear production of TKE (w-points)
52      !
53      INTEGER  ::   ji, jj, jk   ! dummy loop arguments
54      REAL(wp), DIMENSION(jpi,jpj) ::   zsh2u, zsh2v   ! 2D workspace
55      !!--------------------------------------------------------------------
56      !
57      DO jk = 2, jpkm1
58         DO jj = 1, jpjm1        !* 2 x shear production at uw- and vw-points (energy conserving form)
59            DO ji = 1, jpim1
60               zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) &
61                  &         * (   pun(ji,jj,jk-1) -   pun(ji,jj,jk) ) &
62                  &         * (   pub(ji,jj,jk-1) -   pub(ji,jj,jk) ) / ( e3uw_n(ji,jj,jk) * e3uw_b(ji,jj,jk) ) * wumask(ji,jj,jk)
63               zsh2v(ji,jj) = ( p_avm(ji,jj+1,jk) + p_avm(ji,jj,jk) ) &
64                  &         * (   pvn(ji,jj,jk-1) -   pvn(ji,jj,jk) ) &
65                  &         * (   pvb(ji,jj,jk-1) -   pvb(ji,jj,jk) ) / ( e3vw_n(ji,jj,jk) * e3vw_b(ji,jj,jk) ) * wvmask(ji,jj,jk)
66            END DO
67         END DO
68         DO jj = 2, jpjm1        !* shear production at w-point
69            DO ji = 2, jpim1           ! coast mask: =2 at the coast ; =1 otherwise (NB: wmask useless as zsh2 are masked)
70               p_sh2(ji,jj,jk) = 0.25 * (   ( zsh2u(ji-1,jj) + zsh2u(ji,jj) ) * ( 2. - umask(ji-1,jj,jk) * umask(ji,jj,jk) )   &
71                  &                       + ( zsh2v(ji,jj-1) + zsh2v(ji,jj) ) * ( 2. - vmask(ji,jj-1,jk) * vmask(ji,jj,jk) )   )
72            END DO
73         END DO
74      END DO 
75      !
76   END SUBROUTINE zdf_sh2
77
78   !!======================================================================
79END MODULE zdfsh2
Note: See TracBrowser for help on using the repository browser.