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.
zdfddm.F90 in branches/UKMO/dev_r5518_GO6_package_text_diagnostics/NEMOGCM/NEMO/OPA_SRC/ZDF – NEMO

source: branches/UKMO/dev_r5518_GO6_package_text_diagnostics/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90 @ 10774

Last change on this file since 10774 was 10774, checked in by andmirek, 5 years ago

GMED 450 add flush after prints

File size: 13.8 KB
Line 
1MODULE zdfddm
2   !!======================================================================
3   !!                       ***  MODULE  zdfddm  ***
4   !! Ocean physics : double diffusion mixing parameterization
5   !!======================================================================
6   !! History :  OPA  ! 2000-08  (G. Madec)  double diffusive mixing
7   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module
8   !!            3.3  ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
9   !!            3.6  ! 2013-04  (G. Madec, F. Roquet) zrau compute locally using interpolation of alpha & beta
10   !!----------------------------------------------------------------------
11#if defined key_zdfddm   ||   defined key_esopa
12   !!----------------------------------------------------------------------
13   !!   'key_zdfddm' :                                     double diffusion
14   !!----------------------------------------------------------------------
15   !!   zdf_ddm       : compute the Ks for salinity
16   !!   zdf_ddm_init  : read namelist and control the parameters
17   !!----------------------------------------------------------------------
18   USE oce             ! ocean dynamics and tracers variables
19   USE dom_oce         ! ocean space and time domain variables
20   USE zdf_oce         ! ocean vertical physics variables
21   USE eosbn2         ! equation of state
22   !
23   USE in_out_manager  ! I/O manager
24   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
25   USE prtctl          ! Print control
26   USE lib_mpp         ! MPP library
27   USE wrk_nemo        ! work arrays
28   USE timing          ! Timing
29
30   IMPLICIT NONE
31   PRIVATE
32
33   PUBLIC   zdf_ddm       ! called by step.F90
34   PUBLIC   zdf_ddm_init  ! called by opa.F90
35   PUBLIC   zdf_ddm_alloc ! called by nemogcm.F90
36
37   LOGICAL , PUBLIC, PARAMETER ::   lk_zdfddm = .TRUE.  !: double diffusive mixing flag
38
39   REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::   avs   !: salinity vertical diffusivity coeff. at w-point
40
41   !                       !!* Namelist namzdf_ddm : double diffusive mixing *
42   REAL(wp) ::   rn_avts    ! maximum value of avs for salt fingering
43   REAL(wp) ::   rn_hsbfr   ! heat/salt buoyancy flux ratio
44
45   !! * Substitutions
46#  include "domzgr_substitute.h90"
47#  include "vectopt_loop_substitute.h90"
48   !!----------------------------------------------------------------------
49   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
50   !! $Id$
51   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
52   !!----------------------------------------------------------------------
53CONTAINS
54
55   INTEGER FUNCTION zdf_ddm_alloc()
56      !!----------------------------------------------------------------------
57      !!                ***  ROUTINE zdf_ddm_alloc  ***
58      !!----------------------------------------------------------------------
59      ALLOCATE( avs(jpi,jpj,jpk) , STAT= zdf_ddm_alloc )
60      IF( lk_mpp             )   CALL mpp_sum ( zdf_ddm_alloc )
61      IF( zdf_ddm_alloc /= 0 )   CALL ctl_warn('zdf_ddm_alloc: failed to allocate arrays')
62   END FUNCTION zdf_ddm_alloc
63
64
65   SUBROUTINE zdf_ddm( kt )
66      !!----------------------------------------------------------------------
67      !!                  ***  ROUTINE zdf_ddm  ***
68      !!                   
69      !! ** Purpose :   Add to the vertical eddy diffusivity coefficient the
70      !!              effect of salt fingering and diffusive convection.
71      !!
72      !! ** Method  :   Diapycnal mixing is increased in case of double
73      !!      diffusive mixing (i.e. salt fingering and diffusive layering)
74      !!      following Merryfield et al. (1999). The rate of double diffusive
75      !!      mixing depend on the buoyancy ratio (R=alpha/beta dk[T]/dk[S]):
76      !!         * salt fingering (Schmitt 1981):
77      !!      for R > 1 and rn2 > 0 : zavfs = rn_avts / ( 1 + (R/rn_hsbfr)^6 )
78      !!      for R > 1 and rn2 > 0 : zavfs = O
79      !!      otherwise                : zavft = 0.7 zavs / R
80      !!         * diffusive layering (Federov 1988):
81      !!      for 0< R < 1 and N^2 > 0 : zavdt = 1.3635e-6 * exp( 4.6 exp(-0.54 (1/R-1) ) )
82      !!      otherwise                   : zavdt = 0
83      !!      for .5 < R < 1 and N^2 > 0 : zavds = zavdt (1.885 R -0.85)
84      !!      for  0 < R <.5 and N^2 > 0 : zavds = zavdt 0.15 R     
85      !!      otherwise                     : zavds = 0
86      !!         * update the eddy diffusivity:
87      !!      avt = avt + zavft + zavdt
88      !!      avs = avs + zavfs + zavds
89      !!      avmu, avmv are required to remain at least above avt and avs.
90      !!     
91      !! ** Action  :   avt, avs : updated vertical eddy diffusivity coef. for T & S
92      !!
93      !! References :   Merryfield et al., JPO, 29, 1124-1142, 1999.
94      !!----------------------------------------------------------------------
95      INTEGER, INTENT(in) ::   kt   ! ocean time-step indexocean time step
96      !
97      INTEGER  ::   ji, jj , jk     ! dummy loop indices
98      REAL(wp) ::   zaw, zbw, zrw   ! local scalars
99      REAL(wp) ::   zdt, zds
100      REAL(wp) ::   zinr, zrr       !   -      -
101      REAL(wp) ::   zavft, zavfs    !   -      -
102      REAL(wp) ::   zavdt, zavds    !   -      -
103      REAL(wp), POINTER, DIMENSION(:,:) ::   zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3
104      !!----------------------------------------------------------------------
105      !
106      IF( nn_timing == 1 )  CALL timing_start('zdf_ddm')
107      !
108      CALL wrk_alloc( jpi,jpj, zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3 )
109      !
110      !                                                ! ===============
111      DO jk = 2, jpkm1                                 ! Horizontal slab
112         !                                             ! ===============
113         ! Define the mask
114         ! ---------------
115         DO jj = 1, jpj                                ! R=zrau = (alpha / beta) (dk[t] / dk[s])
116            DO ji = 1, jpi
117               zrw =   ( fsdepw(ji,jj,jk  ) - fsdept(ji,jj,jk) )   &
118                  &  / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) ) 
119               !
120               zaw = (  rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem) * zrw  )  &
121                   &    * tmask(ji,jj,jk) * tmask(ji,jj,jk-1)
122               zbw = (  rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal) * zrw  )  &
123                   &    * tmask(ji,jj,jk) * tmask(ji,jj,jk-1)
124               !
125               zdt = zaw * ( tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) )
126               zds = zbw * ( tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) 
127               IF( ABS( zds) <= 1.e-20_wp )   zds = 1.e-20_wp
128               zrau(ji,jj) = MAX(  1.e-20, zdt / zds  )    ! only retains positive value of zrau
129            END DO
130         END DO
131
132         DO jj = 1, jpj                                     ! indicators:
133            DO ji = 1, jpi
134               ! stability indicator: msks=1 if rn2>0; 0 elsewhere
135               IF( rn2(ji,jj,jk) + 1.e-12  <= 0. ) THEN   ;   zmsks(ji,jj) = 0._wp
136               ELSE                                       ;   zmsks(ji,jj) = 1._wp
137               ENDIF
138               ! salt fingering indicator: msksf=1 if R>1; 0 elsewhere           
139               IF( zrau(ji,jj) <= 1.             ) THEN   ;   zmskf(ji,jj) = 0._wp
140               ELSE                                       ;   zmskf(ji,jj) = 1._wp
141               ENDIF
142               ! diffusive layering indicators:
143               !     ! mskdl1=1 if 0< R <1; 0 elsewhere
144               IF( zrau(ji,jj) >= 1.             ) THEN   ;   zmskd1(ji,jj) = 0._wp
145               ELSE                                       ;   zmskd1(ji,jj) = 1._wp
146               ENDIF
147               !     ! mskdl2=1 if 0< R <0.5; 0 elsewhere
148               IF( zrau(ji,jj) >= 0.5            ) THEN   ;   zmskd2(ji,jj) = 0._wp
149               ELSE                                       ;   zmskd2(ji,jj) = 1._wp
150               ENDIF
151               !   mskdl3=1 if 0.5< R <1; 0 elsewhere
152               IF( zrau(ji,jj) <= 0.5 .OR. zrau(ji,jj) >= 1. ) THEN   ;   zmskd3(ji,jj) = 0._wp
153               ELSE                                                   ;   zmskd3(ji,jj) = 1._wp
154               ENDIF
155            END DO
156         END DO
157         ! mask zmsk in order to have avt and avs masked
158         zmsks(:,:) = zmsks(:,:) * wmask(:,:,jk)
159
160
161         ! Update avt and avs
162         ! ------------------
163         ! Constant eddy coefficient: reset to the background value
164!CDIR NOVERRCHK
165         DO jj = 1, jpj
166!CDIR NOVERRCHK
167            DO ji = 1, jpi
168               zinr = 1._wp / zrau(ji,jj)
169               ! salt fingering
170               zrr = zrau(ji,jj) / rn_hsbfr
171               zrr = zrr * zrr
172               zavfs = rn_avts / ( 1 + zrr*zrr*zrr ) * zmsks(ji,jj) * zmskf(ji,jj)
173               zavft = 0.7 * zavfs * zinr
174               ! diffusive layering
175               zavdt = 1.3635e-6 * EXP(  4.6 * EXP( -0.54*(zinr-1.) )  ) * zmsks(ji,jj) * zmskd1(ji,jj)
176               zavds = zavdt * zmsks(ji,jj) * (  ( 1.85 * zrau(ji,jj) - 0.85 ) * zmskd3(ji,jj)   &
177                  &                             +  0.15 * zrau(ji,jj)          * zmskd2(ji,jj)  )
178               ! add to the eddy viscosity coef. previously computed
179# if defined key_zdftmx_new
180               ! key_zdftmx_new: New internal wave-driven param: use avs value computed by zdftmx
181               avs (ji,jj,jk) = avs(ji,jj,jk) + zavfs + zavds
182# else
183               avs (ji,jj,jk) = avt(ji,jj,jk) + zavfs + zavds
184# endif
185               avt (ji,jj,jk) = avt(ji,jj,jk) + zavft + zavdt
186               avm (ji,jj,jk) = avm(ji,jj,jk) + MAX( zavft + zavdt, zavfs + zavds )
187            END DO
188         END DO
189
190
191         ! Increase avmu, avmv if necessary
192         ! --------------------------------
193!!gm to be changed following the definition of avm.
194         DO jj = 1, jpjm1
195            DO ji = 1, fs_jpim1   ! vector opt.
196               avmu(ji,jj,jk) = MAX( avmu(ji,jj,jk),    &
197                  &                  avt(ji,jj,jk), avt(ji+1,jj,jk),   &
198                  &                  avs(ji,jj,jk), avs(ji+1,jj,jk) )  * wumask(ji,jj,jk)
199               avmv(ji,jj,jk) = MAX( avmv(ji,jj,jk),    &
200                  &                  avt(ji,jj,jk), avt(ji,jj+1,jk),   &
201                  &                  avs(ji,jj,jk), avs(ji,jj+1,jk) )  * wvmask(ji,jj,jk)
202            END DO
203         END DO
204         !                                                ! ===============
205      END DO                                              !   End of slab
206      !                                                   ! ===============
207      !
208      CALL lbc_lnk( avt , 'W', 1._wp )     ! Lateral boundary conditions   (unchanged sign)
209      CALL lbc_lnk( avs , 'W', 1._wp )
210      CALL lbc_lnk( avm , 'W', 1._wp )
211      CALL lbc_lnk( avmu, 'U', 1._wp ) 
212      CALL lbc_lnk( avmv, 'V', 1._wp )
213
214      IF(ln_ctl) THEN
215         CALL prt_ctl(tab3d_1=avt , clinfo1=' ddm  - t: ', tab3d_2=avs , clinfo2=' s: ', ovlap=1, kdim=jpk)
216         CALL prt_ctl(tab3d_1=avmu, clinfo1=' ddm  - u: ', mask1=umask, &
217            &         tab3d_2=avmv, clinfo2=       ' v: ', mask2=vmask, ovlap=1, kdim=jpk)
218      ENDIF
219      !
220      CALL wrk_dealloc( jpi,jpj, zrau, zmsks, zmskf, zmskd1, zmskd2, zmskd3 )
221      !
222      IF( nn_timing == 1 )  CALL timing_stop('zdf_ddm')
223      !
224   END SUBROUTINE zdf_ddm
225   
226   
227   SUBROUTINE zdf_ddm_init
228      !!----------------------------------------------------------------------
229      !!                  ***  ROUTINE zdf_ddm_init  ***
230      !!
231      !! ** Purpose :   Initialization of double diffusion mixing scheme
232      !!
233      !! ** Method  :   Read the namzdf_ddm namelist and check the parameter values
234      !!              called by zdf_ddm at the first timestep (nit000)
235      !!----------------------------------------------------------------------
236      INTEGER ::   ios   ! local integer
237      !!
238      NAMELIST/namzdf_ddm/ rn_avts, rn_hsbfr
239      !!----------------------------------------------------------------------
240      !
241      REWIND( numnam_ref )              ! Namelist namzdf_ddm in reference namelist : Double diffusion mixing scheme
242      READ  ( numnam_ref, namzdf_ddm, IOSTAT = ios, ERR = 901)
243901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_ddm in reference namelist', lwp )
244
245      REWIND( numnam_cfg )              ! Namelist namzdf_ddm in configuration namelist : Double diffusion mixing scheme
246      READ  ( numnam_cfg, namzdf_ddm, IOSTAT = ios, ERR = 902 )
247902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_ddm in configuration namelist', lwp )
248      IF(lwm .AND. nprint > 2) WRITE ( numond, namzdf_ddm )
249      !
250      IF(lwp) THEN                    ! Parameter print
251         WRITE(numout,*)
252         WRITE(numout,*) 'zdf_ddm : double diffusive mixing'
253         WRITE(numout,*) '~~~~~~~'
254         WRITE(numout,*) '   Namelist namzdf_ddm : set dd mixing parameter'
255         WRITE(numout,*) '      maximum avs for dd mixing      rn_avts   = ', rn_avts
256         WRITE(numout,*) '      heat/salt buoyancy flux ratio  rn_hsbfr  = ', rn_hsbfr
257         IF(lflush) CALL flush(numout)
258      ENDIF
259      !
260      !                               ! allocate zdfddm arrays
261      IF( zdf_ddm_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'zdf_ddm_init : unable to allocate arrays' )
262      !                               ! initialization to masked Kz
263      avs(:,:,:) = rn_avt0 * wmask(:,:,:) 
264      !
265   END SUBROUTINE zdf_ddm_init
266
267#else
268   !!----------------------------------------------------------------------
269   !!   Default option :          Dummy module          No double diffusion
270   !!----------------------------------------------------------------------
271   LOGICAL, PUBLIC, PARAMETER ::   lk_zdfddm = .FALSE.   !: double diffusion flag
272CONTAINS
273   SUBROUTINE zdf_ddm( kt )           ! Dummy routine
274      WRITE(*,*) 'zdf_ddm: You should not have seen this print! error?', kt
275   END SUBROUTINE zdf_ddm
276   SUBROUTINE zdf_ddm_init            ! Dummy routine
277   END SUBROUTINE zdf_ddm_init
278#endif
279
280   !!======================================================================
281END MODULE zdfddm
Note: See TracBrowser for help on using the repository browser.