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.
ldfdyn.F90 in NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/src/SWE – NEMO

source: NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/src/SWE/ldfdyn.F90 @ 13005

Last change on this file since 13005 was 13005, checked in by gm, 4 years ago

ADE and more options to AM98 config
  • Property svn:keywords set to Id
File size: 32.2 KB
Line 
1MODULE ldfdyn
2   !!======================================================================
3   !!                       ***  MODULE  ldfdyn  ***
4   !! Ocean physics:  lateral viscosity coefficient
5   !!=====================================================================
6   !! History :  OPA  ! 1997-07  (G. Madec)  multi dimensional coefficients
7   !!   NEMO     1.0  ! 2002-09  (G. Madec)  F90: Free form and module
8   !!            3.7  ! 2014-01  (F. Lemarie, G. Madec)  restructuration/simplification of ahm specification,
9   !!                 !                                  add velocity dependent coefficient and optional read in file
10   !!----------------------------------------------------------------------
11
12   !!----------------------------------------------------------------------
13   !!   ldf_dyn_init  : initialization, namelist read, and parameters control
14   !!   ldf_dyn       : update lateral eddy viscosity coefficients at each time step
15   !!----------------------------------------------------------------------
16   USE oce             ! ocean dynamics and tracers   
17   USE dom_oce         ! ocean space and time domain
18   USE phycst          ! physical constants
19   USE ldfslp          ! lateral diffusion: slopes of mixing orientation
20   USE ldfc1d_c2d      ! lateral diffusion: 1D and 2D cases
21   !
22   USE in_out_manager  ! I/O manager
23   USE iom             ! I/O module for ehanced bottom friction file
24   USE timing          ! Timing
25   USE lib_mpp         ! distribued memory computing library
26   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
27   !
28   USE usrdef_nam , ONLY : ln_dynldf_lap_PM
29   !
30   IMPLICIT NONE
31   PRIVATE
32
33   PUBLIC   ldf_dyn_init   ! called by nemogcm.F90
34   PUBLIC   ldf_dyn        ! called by step.F90
35
36   !                                    !!* Namelist namdyn_ldf : lateral mixing on momentum *
37   LOGICAL , PUBLIC ::   ln_dynldf_OFF   !: No operator (i.e. no explicit diffusion)
38   LOGICAL , PUBLIC ::   ln_dynldf_lap   !: laplacian operator
39   LOGICAL , PUBLIC ::   ln_dynldf_blp   !: bilaplacian operator
40   LOGICAL , PUBLIC ::   ln_dynldf_lev   !: iso-level direction
41   LOGICAL , PUBLIC ::   ln_dynldf_hor   !: horizontal (geopotential) direction
42!  LOGICAL , PUBLIC ::   ln_dynldf_iso   !: iso-neutral direction                        (see ldfslp)
43   INTEGER , PUBLIC ::   nn_ahm_ijk_t    !: choice of time & space variations of the lateral eddy viscosity coef.
44   !                                        !  time invariant coefficients:  aht = 1/2  Ud*Ld   (lap case)
45   !                                           !                             bht = 1/12 Ud*Ld^3 (blp case)
46   REAL(wp), PUBLIC ::   rn_Uv                 !: lateral viscous velocity  [m/s]
47   REAL(wp), PUBLIC ::   rn_Lv                 !: lateral viscous length    [m]
48   !                                        ! Smagorinsky viscosity  (nn_ahm_ijk_t = 32)
49   REAL(wp), PUBLIC ::   rn_csmc               !: Smagorinsky constant of proportionality
50   REAL(wp), PUBLIC ::   rn_minfac             !: Multiplicative factor of theorectical minimum Smagorinsky viscosity
51   REAL(wp), PUBLIC ::   rn_maxfac             !: Multiplicative factor of theorectical maximum Smagorinsky viscosity
52   !                                        ! iso-neutral laplacian (ln_dynldf_lap=ln_dynldf_iso=T)
53   REAL(wp), PUBLIC ::   rn_ahm_b              !: lateral laplacian background eddy viscosity  [m2/s]
54
55   !                                    !!* Parameter to control the type of lateral viscous operator
56   INTEGER, PARAMETER, PUBLIC ::   np_ERROR  =-10                       !: error in setting the operator
57   INTEGER, PARAMETER, PUBLIC ::   np_no_ldf = 00                       !: without operator (i.e. no lateral viscous trend)
58   !                          !!      laplacian     !    bilaplacian    !
59   INTEGER, PARAMETER, PUBLIC ::   np_lap    = 10   ,   np_blp    = 20  !: iso-level operator
60   INTEGER, PARAMETER, PUBLIC ::   np_lap_i  = 11                       !: iso-neutral or geopotential operator
61   !
62   INTEGER           , PUBLIC ::   nldf_dyn         !: type of lateral diffusion used defined from ln_dynldf_... (namlist logicals)
63   LOGICAL           , PUBLIC ::   l_ldfdyn_time    !: flag for time variation of the lateral eddy viscosity coef.
64!!an
65   !LOGICAL           , PUBLIC ::   ll_dynldf_lap_PM !: flag for P.Marchand modification on viscosity
66!!an
67   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ahmt, ahmf   !: eddy viscosity coef. at T- and F-points [m2/s or m4/s]
68   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dtensq       !: horizontal tension squared         (Smagorinsky only)
69   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   dshesq       !: horizontal shearing strain squared (Smagorinsky only)
70   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   esqt, esqf   !: Square of the local gridscale (e1e2/(e1+e2))**2           
71
72   REAL(wp) ::   r1_2    = 0.5_wp            ! =1/2
73   REAL(wp) ::   r1_4    = 0.25_wp           ! =1/4
74   REAL(wp) ::   r1_8    = 0.125_wp          ! =1/8
75   REAL(wp) ::   r1_12   = 1._wp / 12._wp    ! =1/12
76   REAL(wp) ::   r1_288  = 1._wp / 288._wp   ! =1/( 12^2 * 2 )
77
78   !! * Substitutions
79#  include "do_loop_substitute.h90"
80   !!----------------------------------------------------------------------
81   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
82   !! $Id$
83   !! Software governed by the CeCILL license (see ./LICENSE)
84   !!----------------------------------------------------------------------
85CONTAINS
86
87   SUBROUTINE ldf_dyn_init
88      !!----------------------------------------------------------------------
89      !!                  ***  ROUTINE ldf_dyn_init  ***
90      !!                   
91      !! ** Purpose :   set the horizontal ocean dynamics physics
92      !!
93      !! ** Method  :   the eddy viscosity coef. specification depends on:
94      !!              - the operator:
95      !!             ln_dynldf_lap = T     laplacian operator
96      !!             ln_dynldf_blp = T   bilaplacian operator
97      !!              - the parameter nn_ahm_ijk_t:
98      !!    nn_ahm_ijk_t  =  0 => = constant
99      !!                  = 10 => = F(z) :     = constant with a reduction of 1/4 with depth
100      !!                  =-20 => = F(i,j)     = shape read in 'eddy_viscosity.nc' file
101      !!                  = 20    = F(i,j)     = F(e1,e2) or F(e1^3,e2^3) (lap or bilap case)
102      !!                  =-30 => = F(i,j,k)   = shape read in 'eddy_viscosity.nc'  file
103      !!                  = 30    = F(i,j,k)   = 2D (case 20) + decrease with depth (case 10)
104      !!                  = 31    = F(i,j,k,t) = F(local velocity) (  |u|e  /12   laplacian operator
105      !!                                                           or |u|e^3/12 bilaplacian operator )
106      !!                  = 32    = F(i,j,k,t) = F(local deformation rate and gridscale) (D and L) (Smagorinsky) 
107      !!                                                           (   L^2|D|      laplacian operator
108      !!                                                           or  L^4|D|/8  bilaplacian operator )
109      !!----------------------------------------------------------------------
110      INTEGER  ::   ji, jj, jk                     ! dummy loop indices
111      INTEGER  ::   ioptio, ierr, inum, ios, inn   ! local integer
112      REAL(wp) ::   zah0, zah_max, zUfac           ! local scalar
113      REAL(wp) ::   zsum                           ! local scalar
114      CHARACTER(len=5) ::   cl_Units               ! units (m2/s or m4/s)
115      !!
116      NAMELIST/namdyn_ldf/ ln_dynldf_OFF, ln_dynldf_lap, ln_dynldf_blp,   &   ! type of operator
117         &                 ln_dynldf_lev, ln_dynldf_hor, ln_dynldf_iso,   &   ! acting direction of the operator
118         &                 nn_ahm_ijk_t , rn_Uv    , rn_Lv,   rn_ahm_b,   &   ! lateral eddy coefficient
119         &                 rn_csmc      , rn_minfac    , rn_maxfac            ! Smagorinsky settings
120      !!----------------------------------------------------------------------
121      !
122      READ  ( numnam_ref, namdyn_ldf, IOSTAT = ios, ERR = 901)
123901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_ldf in reference namelist' )
124
125      READ  ( numnam_cfg, namdyn_ldf, IOSTAT = ios, ERR = 902 )
126902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_ldf in configuration namelist' )
127      IF(lwm) WRITE ( numond, namdyn_ldf )
128
129      IF(lwp) THEN                      ! Parameter print
130         WRITE(numout,*)
131         WRITE(numout,*) 'ldf_dyn : lateral momentum physics'
132         WRITE(numout,*) '~~~~~~~'
133         WRITE(numout,*) '   Namelist namdyn_ldf : set lateral mixing parameters'
134         !
135         WRITE(numout,*) '      type :'
136         WRITE(numout,*) '         no explicit diffusion                ln_dynldf_OFF = ', ln_dynldf_OFF
137         WRITE(numout,*) '         laplacian operator                   ln_dynldf_lap = ', ln_dynldf_lap
138         WRITE(numout,*) '         bilaplacian operator                 ln_dynldf_blp = ', ln_dynldf_blp
139         !
140         WRITE(numout,*) '      direction of action :'
141         WRITE(numout,*) '         iso-level                            ln_dynldf_lev = ', ln_dynldf_lev
142         WRITE(numout,*) '         horizontal (geopotential)            ln_dynldf_hor = ', ln_dynldf_hor
143         WRITE(numout,*) '         iso-neutral                          ln_dynldf_iso = ', ln_dynldf_iso
144         !
145         WRITE(numout,*) '      coefficients :'
146         WRITE(numout,*) '         type of time-space variation         nn_ahm_ijk_t  = ', nn_ahm_ijk_t
147         WRITE(numout,*) '         lateral viscous velocity  (if cst)      rn_Uv      = ', rn_Uv, ' m/s'
148         WRITE(numout,*) '         lateral viscous length    (if cst)      rn_Lv      = ', rn_Lv, ' m'
149         WRITE(numout,*) '         background viscosity (iso-lap case)     rn_ahm_b   = ', rn_ahm_b, ' m2/s'
150         !
151         WRITE(numout,*) '      Smagorinsky settings (nn_ahm_ijk_t  = 32) :'
152         WRITE(numout,*) '         Smagorinsky coefficient              rn_csmc       = ', rn_csmc
153         WRITE(numout,*) '         factor multiplier for eddy visc.'
154         WRITE(numout,*) '            lower limit (default 1.0)         rn_minfac    = ', rn_minfac
155         WRITE(numout,*) '            upper limit (default 1.0)         rn_maxfac    = ', rn_maxfac
156      ENDIF
157
158      !
159      !           !==  type of lateral operator used  ==!   (set nldf_dyn)
160      !           !=====================================!
161      !
162      nldf_dyn = np_ERROR
163      ioptio = 0
164      IF( ln_dynldf_OFF ) THEN   ;   nldf_dyn = np_no_ldf   ;   ioptio = ioptio + 1   ;   ENDIF
165      IF( ln_dynldf_lap ) THEN   ;                              ioptio = ioptio + 1   ;   ENDIF
166      IF( ln_dynldf_blp ) THEN   ;                              ioptio = ioptio + 1   ;   ENDIF
167      IF( ioptio /= 1   )   CALL ctl_stop( 'dyn_ldf_init: use ONE of the 3 operator options (NONE/lap/blp)' )
168      !
169      IF(.NOT.ln_dynldf_OFF ) THEN     !==  direction ==>> type of operator  ==!
170         ioptio = 0
171         IF( ln_dynldf_lev )   ioptio = ioptio + 1
172         IF( ln_dynldf_hor )   ioptio = ioptio + 1
173         IF( ln_dynldf_iso )   ioptio = ioptio + 1
174         IF( ioptio /= 1   )   CALL ctl_stop( 'dyn_ldf_init: use ONE of the 3 direction options (level/hor/iso)' )
175         !
176         !                             ! Set nldf_dyn, the type of lateral diffusion, from ln_dynldf_... logicals
177         ierr = 0
178         IF( ln_dynldf_lap ) THEN         ! laplacian operator
179            IF( ln_zco ) THEN                   ! z-coordinate
180               IF ( ln_dynldf_lev )   nldf_dyn = np_lap     ! iso-level = horizontal (no rotation)
181               IF ( ln_dynldf_hor )   nldf_dyn = np_lap     ! iso-level = horizontal (no rotation)
182               IF ( ln_dynldf_iso )   nldf_dyn = np_lap_i   ! iso-neutral            (   rotation)
183            ENDIF
184            IF( ln_zps ) THEN                   ! z-coordinate with partial step
185               IF ( ln_dynldf_lev )   nldf_dyn = np_lap     ! iso-level              (no rotation)
186               IF ( ln_dynldf_hor )   nldf_dyn = np_lap     ! iso-level              (no rotation)
187               IF ( ln_dynldf_iso )   nldf_dyn = np_lap_i   ! iso-neutral            (   rotation)
188            ENDIF
189            IF( ln_sco ) THEN                   ! s-coordinate
190               IF ( ln_dynldf_lev )   nldf_dyn = np_lap     ! iso-level = horizontal (no rotation)
191               IF ( ln_dynldf_hor )   nldf_dyn = np_lap_i   ! horizontal             (   rotation)
192               IF ( ln_dynldf_iso )   nldf_dyn = np_lap_i   ! iso-neutral            (   rotation)
193            ENDIF
194         ENDIF
195         !
196         IF( ln_dynldf_blp ) THEN         ! bilaplacian operator
197            IF( ln_zco ) THEN                   ! z-coordinate
198               IF( ln_dynldf_lev )   nldf_dyn = np_blp   ! iso-level = horizontal (no rotation)
199               IF( ln_dynldf_hor )   nldf_dyn = np_blp   ! iso-level = horizontal (no rotation)
200               IF( ln_dynldf_iso )   ierr = 2            ! iso-neutral            (   rotation)
201            ENDIF
202            IF( ln_zps ) THEN                   ! z-coordinate with partial step
203               IF( ln_dynldf_lev )   nldf_dyn = np_blp   ! iso-level              (no rotation)
204               IF( ln_dynldf_hor )   nldf_dyn = np_blp   ! iso-level              (no rotation)
205               IF( ln_dynldf_iso )   ierr = 2            ! iso-neutral            (   rotation)
206            ENDIF
207            IF( ln_sco ) THEN                   ! s-coordinate
208               IF( ln_dynldf_lev )   nldf_dyn = np_blp   ! iso-level              (no rotation)
209               IF( ln_dynldf_hor )   ierr = 2            ! horizontal             (   rotation)
210               IF( ln_dynldf_iso )   ierr = 2            ! iso-neutral            (   rotation)
211            ENDIF
212         ENDIF
213         !
214         IF( ierr == 2 )   CALL ctl_stop( 'rotated bi-laplacian operator does not exist' )
215         !
216         IF( nldf_dyn == np_lap_i )   l_ldfslp = .TRUE.  ! rotation require the computation of the slopes
217         !
218      ENDIF
219      !
220      IF(lwp) THEN
221         WRITE(numout,*)
222         SELECT CASE( nldf_dyn )
223         CASE( np_no_ldf )   ;   WRITE(numout,*) '   ==>>>   NO lateral viscosity'
224         CASE( np_lap    )   ;   WRITE(numout,*) '   ==>>>   iso-level laplacian operator'
225         CASE( np_lap_i  )   ;   WRITE(numout,*) '   ==>>>   rotated laplacian operator with iso-level background'
226         CASE( np_blp    )   ;   WRITE(numout,*) '   ==>>>   iso-level bi-laplacian operator'
227         END SELECT
228         WRITE(numout,*)
229      ENDIF
230     
231      !
232      !           !==  Space/time variation of eddy coefficients  ==!
233      !           !=================================================!
234      !
235      l_ldfdyn_time = .FALSE.                ! no time variation except in case defined below
236      !
237      IF( ln_dynldf_OFF ) THEN
238         IF(lwp) WRITE(numout,*) '   ==>>>   No viscous operator selected. ahmt and ahmf are not allocated'
239         RETURN
240         !
241      ELSE                                   !==  a lateral diffusion operator is used  ==!
242         !
243         !                                         ! allocate the ahm arrays
244         ALLOCATE( ahmt(jpi,jpj,jpk) , ahmf(jpi,jpj,jpk) , STAT=ierr )
245         IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_dyn_init: failed to allocate arrays')
246         !
247         ahmt(:,:,:) = 0._wp                       ! init to 0 needed
248         ahmf(:,:,:) = 0._wp
249         !
250         !                                         ! value of lap/blp eddy mixing coef.
251         IF(     ln_dynldf_lap ) THEN   ;   zUfac = r1_2 *rn_Uv   ;   inn = 1   ;   cl_Units = ' m2/s'   !   laplacian
252         ELSEIF( ln_dynldf_blp ) THEN   ;   zUfac = r1_12*rn_Uv   ;   inn = 3   ;   cl_Units = ' m4/s'   ! bilaplacian
253         ENDIF
254         zah0    = zUfac *    rn_Lv**inn              ! mixing coefficient
255         zah_max = zUfac * (ra*rad)**inn              ! maximum reachable coefficient (value at the Equator)
256         !
257         SELECT CASE(  nn_ahm_ijk_t  )             !* Specification of space-time variations of ahmt, ahmf
258         !
259         CASE(   0  )      !==  constant  ==!
260            IF(lwp) WRITE(numout,*) '   ==>>>   eddy viscosity. = constant = ', zah0, cl_Units
261            ahmt(:,:,1:jpkm1) = zah0
262            ahmf(:,:,1:jpkm1) = zah0
263            !
264         CASE(  10  )      !==  fixed profile  ==!
265            IF(lwp) WRITE(numout,*) '   ==>>>   eddy viscosity = F( depth )'
266            IF(lwp) WRITE(numout,*) '           surface viscous coef. = constant = ', zah0, cl_Units
267            ahmt(:,:,1) = zah0                        ! constant surface value
268            ahmf(:,:,1) = zah0
269            CALL ldf_c1d( 'DYN', ahmt(:,:,1), ahmf(:,:,1), ahmt, ahmf )
270            !
271         CASE ( -20 )      !== fixed horizontal shape read in file  ==!
272            IF(lwp) WRITE(numout,*) '   ==>>>   eddy viscosity = F(i,j) read in eddy_viscosity.nc file'
273            CALL iom_open( 'eddy_viscosity_2D.nc', inum )
274            CALL iom_get ( inum, jpdom_data, 'ahmt_2d', ahmt(:,:,1) )
275            CALL iom_get ( inum, jpdom_data, 'ahmf_2d', ahmf(:,:,1) )
276            CALL iom_close( inum )
277            DO jk = 2, jpkm1
278               ahmt(:,:,jk) = ahmt(:,:,1)
279               ahmf(:,:,jk) = ahmf(:,:,1)
280            END DO
281            !
282         CASE(  20  )      !== fixed horizontal shape  ==!
283            IF(lwp) WRITE(numout,*) '   ==>>>   eddy viscosity = F( e1, e2 ) or F( e1^3, e2^3 ) (lap. or blp. case)'
284            IF(lwp) WRITE(numout,*) '           using a fixed viscous velocity = ', rn_Uv  ,' m/s   and   Lv = Max(e1,e2)'
285            IF(lwp) WRITE(numout,*) '           maximum reachable coefficient (at the Equator) = ', zah_max, cl_Units, '  for e1=1°)'
286            CALL ldf_c2d( 'DYN', zUfac      , inn        , ahmt, ahmf )         ! surface value proportional to scale factor^inn
287            !
288         CASE( -30  )      !== fixed 3D shape read in file  ==!
289            IF(lwp) WRITE(numout,*) '   ==>>>   eddy viscosity = F(i,j,k) read in eddy_viscosity_3D.nc file'
290            CALL iom_open( 'eddy_viscosity_3D.nc', inum )
291            CALL iom_get ( inum, jpdom_data, 'ahmt_3d', ahmt )
292            CALL iom_get ( inum, jpdom_data, 'ahmf_3d', ahmf )
293            CALL iom_close( inum )
294            !
295         CASE(  30  )       !==  fixed 3D shape  ==!
296            IF(lwp) WRITE(numout,*) '   ==>>>   eddy viscosity = F( latitude, longitude, depth )'
297            IF(lwp) WRITE(numout,*) '           using a fixed viscous velocity = ', rn_Uv  ,' m/s   and   Ld = Max(e1,e2)'
298            IF(lwp) WRITE(numout,*) '           maximum reachable coefficient (at the Equator) = ', zah_max, cl_Units, '  for e1=1°)'
299            CALL ldf_c2d( 'DYN', zUfac      , inn        , ahmt, ahmf )         ! surface value proportional to scale factor^inn
300            CALL ldf_c1d( 'DYN', ahmt(:,:,1), ahmf(:,:,1), ahmt, ahmf )  ! reduction with depth
301            !
302         CASE(  31  )       !==  time varying 3D field  ==!
303            IF(lwp) WRITE(numout,*) '   ==>>>   eddy viscosity = F( latitude, longitude, depth , time )'
304            IF(lwp) WRITE(numout,*) '           proportional to the local velocity : 1/2 |u|e (lap) or 1/12 |u|e^3 (blp)'
305            !
306            l_ldfdyn_time = .TRUE.     ! will be calculated by call to ldf_dyn routine in step.F90
307            !
308         CASE(  32  )       !==  time varying 3D field  ==!
309            IF(lwp) WRITE(numout,*) '   ==>>>   eddy viscosity = F( latitude, longitude, depth , time )'
310            IF(lwp) WRITE(numout,*) '           proportional to the local deformation rate and gridscale (Smagorinsky)'
311            !
312            l_ldfdyn_time = .TRUE.     ! will be calculated by call to ldf_dyn routine in step.F90
313            !
314            !                          ! allocate arrays used in ldf_dyn.
315            ALLOCATE( dtensq(jpi,jpj,jpk) , dshesq(jpi,jpj,jpk) , esqt(jpi,jpj) , esqf(jpi,jpj) , STAT=ierr )
316            IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'ldf_dyn_init: failed to allocate Smagorinsky arrays')
317            !
318            DO_2D_11_11
319               esqt(ji,jj) = ( 2._wp * e1e2t(ji,jj) / ( e1t(ji,jj) + e2t(ji,jj) ) )**2 
320               esqf(ji,jj) = ( 2._wp * e1e2f(ji,jj) / ( e1f(ji,jj) + e2f(ji,jj) ) )**2 
321            END_2D
322            !
323         CASE DEFAULT
324            CALL ctl_stop('ldf_dyn_init: wrong choice for nn_ahm_ijk_t, the type of space-time variation of ahm')
325         END SELECT
326         !
327         IF( .NOT.l_ldfdyn_time ) THEN             !* No time variation
328            IF(     ln_dynldf_lap ) THEN                 !   laplacian operator (mask only)
329!!an          !
330            WRITE(numout,*) '   ln_dynldf_lap_PM = ',ln_dynldf_lap_PM 
331               IF(     ln_dynldf_lap_PM ) THEN                 !   laplacian operator (mask only)
332!! mask tension at the coast (equivalent of ghostpoints at T)
333                  DO jk = 1, jpk
334                     DO jj = 1, jpjm1
335                        DO ji = 1, jpim1      ! NO vector opt.
336                           ! si sum(fmask)==3 = mouillé (on touche pas)
337                           ! si sum = 2 alors on met a 0 zsum = fmask + fmask + fmask,.. et si zsum < 2 -> 0 sinon = 1
338                           zsum =   fmask(ji,jj  ,jk) + fmask(ji+1,jj  ,jk)   &
339                              &   + fmask(ji,jj+1,jk) + fmask(ji+1,jj+1,jk)
340                           IF ( zsum < 2._wp )   ahmt(ji,jj,jk) = 0
341                           !
342                           !ahmt(ji,jj,jk) = ahmt(ji,jj,jk) * fmask(ji,jj  ,jk) * fmask(ji+1,jj  ,jk)   &
343                           !   &                            * fmask(ji,jj+1,jk) * fmask(ji+1,jj+1,jk)
344                        END DO
345                     END DO
346                  END DO
347                  ahmt(jpi,:,1:jpkm1) =  0._wp
348                  ahmt(:,jpj,1:jpkm1) =  0._wp
349                  WRITE(numout,*) '  ahmt x0'
350!! apply no slip at the coast (ssfmask = 1 within the domain and at the coast contrary to fmask in free slip)
351                   DO jk = 1, jpkm1
352                      ahmf(:,:,jk) =    ahmf(:,:,jk) * ( 2._wp * ssfmask(:,:) - fmask(:,:,jk) )
353                   END DO
354                   WRITE(numout,*) '  ahmf x2'
355               ELSE
356               ! classic boundary condition on the viscosity coefficient
357                  ahmt(:,:,1:jpkm1) =       ahmt(:,:,1:jpkm1)   * tmask(:,:,1:jpkm1)
358                  WRITE(numout,*) ' ahmt tmasked '
359                  ahmf(:,:,1:jpkm1) =       ahmf(:,:,1:jpkm1)   * fmask(:,:,1:jpkm1)
360                  WRITE(numout,*) ' ahmf fmasked '
361               ENDIF
362!!an         !                 
363            ELSEIF( ln_dynldf_blp ) THEN                 ! bilaplacian operator (square root + mask)
364               ahmt(:,:,1:jpkm1) = SQRT( ahmt(:,:,1:jpkm1) ) * tmask(:,:,1:jpkm1)
365               ahmf(:,:,1:jpkm1) = SQRT( ahmf(:,:,1:jpkm1) ) * fmask(:,:,1:jpkm1)
366            ENDIF
367         ENDIF
368         !
369      ENDIF
370      !
371   END SUBROUTINE ldf_dyn_init
372
373
374   SUBROUTINE ldf_dyn( kt, Kbb )
375      !!----------------------------------------------------------------------
376      !!                  ***  ROUTINE ldf_dyn  ***
377      !!
378      !! ** Purpose :   update at kt the momentum lateral mixing coeff. (ahmt and ahmf)
379      !!
380      !! ** Method  :   time varying eddy viscosity coefficients:
381      !!
382      !!    nn_ahm_ijk_t = 31    ahmt, ahmf = F(i,j,k,t) = F(local velocity)
383      !!                         ( |u|e /12  or  |u|e^3/12 for laplacian or bilaplacian operator )
384      !!
385      !!    nn_ahm_ijk_t = 32    ahmt, ahmf = F(i,j,k,t) = F(local deformation rate and gridscale) (D and L) (Smagorinsky) 
386      !!                         ( L^2|D|    or  L^4|D|/8  for laplacian or bilaplacian operator )
387      !!
388      !! ** note    :    in BLP cases the sqrt of the eddy coef is returned, since bilaplacian is en re-entrant laplacian
389      !! ** action  :    ahmt, ahmf   updated at each time step
390      !!----------------------------------------------------------------------
391      INTEGER, INTENT(in) ::   kt   ! time step index
392      INTEGER, INTENT(in) ::   Kbb  ! ocean time level indices
393      !
394      INTEGER  ::   ji, jj, jk   ! dummy loop indices
395      REAL(wp) ::   zu2pv2_ij_p1, zu2pv2_ij, zu2pv2_ij_m1, zemax   ! local scalar (option 31)
396      REAL(wp) ::   zcmsmag, zstabf_lo, zstabf_up, zdelta, zdb     ! local scalar (option 32)
397      !!----------------------------------------------------------------------
398      !
399      IF( ln_timing )   CALL timing_start('ldf_dyn')
400      !
401      SELECT CASE(  nn_ahm_ijk_t  )       !== Eddy vicosity coefficients ==!
402      !
403      CASE(  31  )       !==  time varying 3D field  ==!   = F( local velocity )
404         !
405         IF( ln_dynldf_lap   ) THEN        ! laplacian operator : |u| e /12 = |u/144| e
406            DO jk = 1, jpkm1
407               DO_2D_00_00
408                  zu2pv2_ij    = uu(ji  ,jj  ,jk,Kbb) * uu(ji  ,jj  ,jk,Kbb) + vv(ji  ,jj  ,jk,Kbb) * vv(ji  ,jj  ,jk,Kbb)
409                  zu2pv2_ij_m1 = uu(ji-1,jj  ,jk,Kbb) * uu(ji-1,jj  ,jk,Kbb) + vv(ji  ,jj-1,jk,Kbb) * vv(ji  ,jj-1,jk,Kbb)
410                  zemax = MAX( e1t(ji,jj) , e2t(ji,jj) )
411                  ahmt(ji,jj,jk) = SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * r1_288 ) * zemax * tmask(ji,jj,jk)      ! 288= 12*12 * 2
412               END_2D
413               DO_2D_10_10
414                  zu2pv2_ij_p1 = uu(ji  ,jj+1,jk, Kbb) * uu(ji  ,jj+1,jk, Kbb) + vv(ji+1,jj  ,jk, Kbb) * vv(ji+1,jj  ,jk, Kbb)
415                  zu2pv2_ij    = uu(ji  ,jj  ,jk, Kbb) * uu(ji  ,jj  ,jk, Kbb) + vv(ji  ,jj  ,jk, Kbb) * vv(ji  ,jj  ,jk, Kbb)
416                  zemax = MAX( e1f(ji,jj) , e2f(ji,jj) )
417                  ahmf(ji,jj,jk) = SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * r1_288 ) * zemax * fmask(ji,jj,jk)      ! 288= 12*12 * 2
418               END_2D
419            END DO
420         ELSEIF( ln_dynldf_blp ) THEN      ! bilaplacian operator : sqrt( |u| e^3 /12 ) = sqrt( |u/144| e ) * e
421            DO jk = 1, jpkm1
422               DO_2D_00_00
423                  zu2pv2_ij    = uu(ji  ,jj  ,jk,Kbb) * uu(ji  ,jj  ,jk,Kbb) + vv(ji  ,jj  ,jk,Kbb) * vv(ji  ,jj  ,jk,Kbb)
424                  zu2pv2_ij_m1 = uu(ji-1,jj  ,jk,Kbb) * uu(ji-1,jj  ,jk,Kbb) + vv(ji  ,jj-1,jk,Kbb) * vv(ji  ,jj-1,jk,Kbb)
425                  zemax = MAX( e1t(ji,jj) , e2t(ji,jj) )
426                  ahmt(ji,jj,jk) = SQRT(  SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * r1_288 ) * zemax  ) * zemax * tmask(ji,jj,jk)
427               END_2D
428               DO_2D_10_10
429                  zu2pv2_ij_p1 = uu(ji  ,jj+1,jk, Kbb) * uu(ji  ,jj+1,jk, Kbb) + vv(ji+1,jj  ,jk, Kbb) * vv(ji+1,jj  ,jk, Kbb)
430                  zu2pv2_ij    = uu(ji  ,jj  ,jk, Kbb) * uu(ji  ,jj  ,jk, Kbb) + vv(ji  ,jj  ,jk, Kbb) * vv(ji  ,jj  ,jk, Kbb)
431                  zemax = MAX( e1f(ji,jj) , e2f(ji,jj) )
432                  ahmf(ji,jj,jk) = SQRT(  SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * r1_288 ) * zemax  ) * zemax * fmask(ji,jj,jk)
433               END_2D
434            END DO
435         ENDIF
436         !
437         CALL lbc_lnk_multi( 'ldfdyn', ahmt, 'T', 1.,  ahmf, 'F', 1. )
438         !
439         !
440      CASE(  32  )       !==  time varying 3D field  ==!   = F( local deformation rate and gridscale ) (Smagorinsky)
441         !
442         IF( ln_dynldf_lap .OR. ln_dynldf_blp  ) THEN        ! laplacian operator : (C_smag/pi)^2 L^2 |D|
443            !
444            zcmsmag   = (rn_csmc/rpi)**2                                            ! (C_smag/pi)^2
445            zstabf_lo = rn_minfac * rn_minfac / ( 2._wp * 12._wp * 12._wp * zcmsmag ) ! lower limit stability factor scaling
446            zstabf_up = rn_maxfac / ( 4._wp * zcmsmag * 2._wp * rn_Dt )               ! upper limit stability factor scaling
447            IF( ln_dynldf_blp ) zstabf_lo = ( 16._wp / 9._wp ) * zstabf_lo          ! provide |U|L^3/12 lower limit instead
448            !                                                                       ! of |U|L^3/16 in blp case
449            DO jk = 1, jpkm1
450               !
451               DO_2D_00_00
452                  zdb =    ( uu(ji,jj,jk,Kbb) * r1_e2u(ji,jj) -  uu(ji-1,jj,jk,Kbb) * r1_e2u(ji-1,jj) )  &
453                       &                      * r1_e1t(ji,jj) * e2t(ji,jj)                           &
454                       & - ( vv(ji,jj,jk,Kbb) * r1_e1v(ji,jj) -  vv(ji,jj-1,jk,Kbb) * r1_e1v(ji,jj-1) )  &
455                       &                      * r1_e2t(ji,jj) * e1t(ji,jj)
456                  dtensq(ji,jj,jk) = zdb * zdb * tmask(ji,jj,jk)
457               END_2D
458               !
459               DO_2D_10_10
460                  zdb =   (  uu(ji,jj+1,jk,Kbb) * r1_e1u(ji,jj+1) -  uu(ji,jj,jk,Kbb) * r1_e1u(ji,jj) )  &
461                       &                        * r1_e2f(ji,jj)   * e1f(ji,jj)                       &
462                       & + ( vv(ji+1,jj,jk,Kbb) * r1_e2v(ji+1,jj) -  vv(ji,jj,jk,Kbb) * r1_e2v(ji,jj) )  &
463                       &                        * r1_e1f(ji,jj)   * e2f(ji,jj)
464                  dshesq(ji,jj,jk) = zdb * zdb * fmask(ji,jj,jk)
465               END_2D
466               !
467            END DO
468            !
469            CALL lbc_lnk_multi( 'ldfdyn', dtensq, 'T', 1. )  ! lbc_lnk on dshesq not needed
470            !
471            DO jk = 1, jpkm1
472              !
473               DO_2D_00_00
474                  !
475                  zu2pv2_ij    = uu(ji  ,jj  ,jk,Kbb) * uu(ji  ,jj  ,jk,Kbb) + vv(ji  ,jj  ,jk,Kbb) * vv(ji  ,jj  ,jk,Kbb)
476                  zu2pv2_ij_m1 = uu(ji-1,jj  ,jk,Kbb) * uu(ji-1,jj  ,jk,Kbb) + vv(ji  ,jj-1,jk,Kbb) * vv(ji  ,jj-1,jk,Kbb)
477                  !
478                  zdelta         = zcmsmag * esqt(ji,jj)                                        ! L^2 * (C_smag/pi)^2
479                  ahmt(ji,jj,jk) = zdelta * SQRT(          dtensq(ji  ,jj,jk) +                         &
480                     &                            r1_4 * ( dshesq(ji  ,jj,jk) + dshesq(ji  ,jj-1,jk) +  &
481                     &                                     dshesq(ji-1,jj,jk) + dshesq(ji-1,jj-1,jk) ) )
482                  ahmt(ji,jj,jk) = MAX( ahmt(ji,jj,jk), SQRT( (zu2pv2_ij + zu2pv2_ij_m1) * zdelta * zstabf_lo ) ) ! Impose lower limit == minfac  * |U|L/2
483                  ahmt(ji,jj,jk) = MIN( ahmt(ji,jj,jk),                                    zdelta * zstabf_up )   ! Impose upper limit == maxfac  * L^2/(4*2dt)
484                  !
485               END_2D
486               !
487               DO_2D_10_10
488                  !
489                  zu2pv2_ij_p1 = uu(ji  ,jj+1,jk, kbb) * uu(ji  ,jj+1,jk, kbb) + vv(ji+1,jj  ,jk, kbb) * vv(ji+1,jj  ,jk, kbb)
490                  zu2pv2_ij    = uu(ji  ,jj  ,jk, kbb) * uu(ji  ,jj  ,jk, kbb) + vv(ji  ,jj  ,jk, kbb) * vv(ji  ,jj  ,jk, kbb)
491                  !
492                  zdelta         = zcmsmag * esqf(ji,jj)                                        ! L^2 * (C_smag/pi)^2
493                  ahmf(ji,jj,jk) = zdelta * SQRT(          dshesq(ji  ,jj,jk) +                         &
494                     &                            r1_4 * ( dtensq(ji  ,jj,jk) + dtensq(ji  ,jj+1,jk) +  &
495                     &                                     dtensq(ji+1,jj,jk) + dtensq(ji+1,jj+1,jk) ) )
496                  ahmf(ji,jj,jk) = MAX( ahmf(ji,jj,jk), SQRT( (zu2pv2_ij + zu2pv2_ij_p1) * zdelta * zstabf_lo ) ) ! Impose lower limit == minfac  * |U|L/2
497                  ahmf(ji,jj,jk) = MIN( ahmf(ji,jj,jk),                                    zdelta * zstabf_up )   ! Impose upper limit == maxfac  * L^2/(4*2dt)
498                  !
499               END_2D
500               !
501            END DO
502            !
503         ENDIF
504         !
505         IF( ln_dynldf_blp ) THEN      ! bilaplacian operator : sqrt( (C_smag/pi)^2 L^4 |D|/8)
506            !                          !                      = sqrt( A_lap_smag L^2/8 )
507            !                          ! stability limits already applied to laplacian values
508            !                          ! effective default limits are 1/12 |U|L^3 < B_hm < 1//(32*2dt) L^4
509            DO jk = 1, jpkm1
510               DO_2D_00_00
511                  ahmt(ji,jj,jk) = SQRT( r1_8 * esqt(ji,jj) * ahmt(ji,jj,jk) )
512               END_2D
513               DO_2D_10_10
514                  ahmf(ji,jj,jk) = SQRT( r1_8 * esqf(ji,jj) * ahmf(ji,jj,jk) )
515               END_2D
516            END DO
517            !
518         ENDIF
519         !
520         CALL lbc_lnk_multi( 'ldfdyn', ahmt, 'T', 1. , ahmf, 'F', 1. )
521         !
522      END SELECT
523      !
524      CALL iom_put( "ahmt_2d", ahmt(:,:,1) )   ! surface u-eddy diffusivity coeff.
525      CALL iom_put( "ahmf_2d", ahmf(:,:,1) )   ! surface v-eddy diffusivity coeff.
526      CALL iom_put( "ahmt_3d", ahmt(:,:,:) )   ! 3D      u-eddy diffusivity coeff.
527      CALL iom_put( "ahmf_3d", ahmf(:,:,:) )   ! 3D      v-eddy diffusivity coeff.
528      !
529      IF( ln_timing )   CALL timing_stop('ldf_dyn')
530      !
531   END SUBROUTINE ldf_dyn
532
533   !!======================================================================
534END MODULE ldfdyn
Note: See TracBrowser for help on using the repository browser.