Changeset 13662 for NEMO/branches/2019/dev_r11842_SI3-10_EAP/src/OCE/ZDF
- Timestamp:
- 2020-10-22T20:49:56+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11842_SI3-10_EAP
- Files:
-
- 6 edited
-
. (modified) (1 prop)
-
src/OCE/ZDF/zdfdrg.F90 (modified) (7 diffs)
-
src/OCE/ZDF/zdfgls.F90 (modified) (18 diffs)
-
src/OCE/ZDF/zdfosm.F90 (modified) (1 diff)
-
src/OCE/ZDF/zdfphy.F90 (modified) (2 diffs)
-
src/OCE/ZDF/zdftke.F90 (modified) (18 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11842_SI3-10_EAP
- Property svn:externals
-
old new 1 ^/utils/build/arch@HEAD arch 2 ^/utils/build/makenemo@HEAD makenemo 3 ^/utils/build/mk@HEAD mk 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev@HEAD ext/AGRIF 6 ^/vendors/FCM@HEAD ext/FCM 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 1 ^/utils/build/arch@12130 arch 2 ^/utils/build/makenemo@12191 makenemo 3 ^/utils/build/mk@11662 mk 4 ^/utils/tools_r4.0-HEAD@12672 tools 5 ^/vendors/AGRIF/dev@10586 ext/AGRIF 6 ^/vendors/FCM@10134 ext/FCM 7 ^/vendors/IOIPSL@9655 ext/IOIPSL 8 9 # SETTE mapping (inactive) 10 #^/utils/CI/sette@12135 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11842_SI3-10_EAP/src/OCE/ZDF/zdfdrg.F90
r11536 r13662 32 32 USE lib_mpp ! distributed memory computing 33 33 USE prtctl ! Print control 34 USE sbc_oce , ONLY : nn_ice 34 35 35 36 IMPLICIT NONE … … 41 42 42 43 ! !!* Namelist namdrg: nature of drag coefficient namelist * 43 LOGICAL :: ln_OFF! free-slip : Cd = 044 LOGICAL , PUBLIC :: ln_drg_OFF ! free-slip : Cd = 0 44 45 LOGICAL :: ln_lin ! linear drag: Cd = Cd0_lin 45 46 LOGICAL :: ln_non_lin ! non-linear drag: Cd = Cd0_nl |U| 46 47 LOGICAL :: ln_loglayer ! logarithmic drag: Cd = vkarmn/log(z/z0) 47 48 LOGICAL , PUBLIC :: ln_drgimp ! implicit top/bottom friction flag 48 49 LOGICAL , PUBLIC :: ln_drgice_imp ! implicit ice-ocean drag 49 50 ! !!* Namelist namdrg_top & _bot: TOP or BOTTOM coefficient namelist * 50 51 REAL(wp) :: rn_Cd0 !: drag coefficient [ - ] … … 231 232 INTEGER :: ios, ioptio ! local integers 232 233 !! 233 NAMELIST/namdrg/ ln_ OFF, ln_lin, ln_non_lin, ln_loglayer, ln_drgimp234 NAMELIST/namdrg/ ln_drg_OFF, ln_lin, ln_non_lin, ln_loglayer, ln_drgimp, ln_drgice_imp 234 235 !!---------------------------------------------------------------------- 235 236 ! … … 244 245 IF(lwm) WRITE ( numond, namdrg ) 245 246 ! 247 IF( ln_drgice_imp .AND. nn_ice /= 2 ) ln_drgice_imp = .FALSE. 248 ! 246 249 IF(lwp) THEN 247 250 WRITE(numout,*) … … 249 252 WRITE(numout,*) '~~~~~~~~~~~~' 250 253 WRITE(numout,*) ' Namelist namdrg : top/bottom friction choices' 251 WRITE(numout,*) ' free-slip : Cd = 0 ln_ OFF = ', ln_OFF254 WRITE(numout,*) ' free-slip : Cd = 0 ln_drg_OFF = ', ln_drg_OFF 252 255 WRITE(numout,*) ' linear drag : Cd = Cd0 ln_lin = ', ln_lin 253 256 WRITE(numout,*) ' non-linear drag: Cd = Cd0_nl |U| ln_non_lin = ', ln_non_lin 254 257 WRITE(numout,*) ' logarithmic drag: Cd = vkarmn/log(z/z0) ln_loglayer = ', ln_loglayer 255 258 WRITE(numout,*) ' implicit friction ln_drgimp = ', ln_drgimp 259 WRITE(numout,*) ' implicit ice-ocean drag ln_drgice_imp =', ln_drgice_imp 256 260 ENDIF 257 261 ! 258 262 ioptio = 0 ! set ndrg and control check 259 IF( ln_ OFF) THEN ; ndrg = np_OFF ; ioptio = ioptio + 1 ; ENDIF263 IF( ln_drg_OFF ) THEN ; ndrg = np_OFF ; ioptio = ioptio + 1 ; ENDIF 260 264 IF( ln_lin ) THEN ; ndrg = np_lin ; ioptio = ioptio + 1 ; ENDIF 261 265 IF( ln_non_lin ) THEN ; ndrg = np_non_lin ; ioptio = ioptio + 1 ; ENDIF … … 264 268 IF( ioptio /= 1 ) CALL ctl_stop( 'zdf_drg_init: Choose ONE type of drag coef in namdrg' ) 265 269 ! 270 IF ( ln_drgice_imp.AND.(.NOT.ln_drgimp) ) & 271 & CALL ctl_stop( 'zdf_drg_init: ln_drgice_imp=T requires ln_drgimp=T' ) 266 272 ! 267 273 ! !== BOTTOM drag setting ==! (applied at seafloor) … … 270 276 CALL drg_init( 'BOTTOM' , mbkt , & ! <== in 271 277 & r_Cdmin_bot, r_Cdmax_bot, r_z0_bot, r_ke0_bot, rCd0_bot, rCdU_bot ) ! ==> out 272 273 278 ! 274 279 ! !== TOP drag setting ==! (applied at the top of ocean cavities) 275 280 ! 276 IF( ln_isfcav ) THEN ! Ocean cavities: top friction setting 277 ALLOCATE( rCd0_top(jpi,jpj), rCdU_top(jpi,jpj) ) 281 IF( ln_isfcav.OR.ln_drgice_imp ) THEN ! Ocean cavities: top friction setting 282 ALLOCATE( rCdU_top(jpi,jpj) ) 283 ENDIF 284 ! 285 IF( ln_isfcav ) THEN 286 ALLOCATE( rCd0_top(jpi,jpj)) 278 287 CALL drg_init( 'TOP ' , mikt , & ! <== in 279 288 & r_Cdmin_top, r_Cdmax_top, r_z0_top, r_ke0_top, rCd0_top, rCdU_top ) ! ==> out -
NEMO/branches/2019/dev_r11842_SI3-10_EAP/src/OCE/ZDF/zdfgls.F90
r11536 r13662 19 19 USE dom_oce ! ocean space and time domain 20 20 USE domvvl ! ocean space and time domain : variable volume layer 21 USE zdfdrg , ONLY : ln_drg_OFF ! top/bottom free-slip flag 21 22 USE zdfdrg , ONLY : r_z0_top , r_z0_bot ! top/bottom roughness 22 23 USE zdfdrg , ONLY : rCdU_top , rCdU_bot ! top/bottom friction … … 53 54 INTEGER :: nn_bc_bot ! bottom boundary condition (=0/1) 54 55 INTEGER :: nn_z0_met ! Method for surface roughness computation 56 INTEGER :: nn_z0_ice ! Roughness accounting for sea ice 55 57 INTEGER :: nn_stab_func ! stability functions G88, KC or Canuto (=0/1/2) 56 58 INTEGER :: nn_clos ! closure 0/1/2/3 MY82/k-eps/k-w/gen … … 61 63 REAL(wp) :: rn_crban ! Craig and Banner constant for surface breaking waves mixing 62 64 REAL(wp) :: rn_hsro ! Minimum surface roughness 65 REAL(wp) :: rn_hsri ! Ice ocean roughness 63 66 REAL(wp) :: rn_frac_hs ! Fraction of wave height as surface roughness (if nn_z0_met > 1) 64 67 … … 150 153 REAL(wp), DIMENSION(jpi,jpj) :: zflxs ! Turbulence fluxed induced by internal waves 151 154 REAL(wp), DIMENSION(jpi,jpj) :: zhsro ! Surface roughness (surface waves) 155 REAL(wp), DIMENSION(jpi,jpj) :: zice_fra ! Tapering of wave breaking under sea ice 152 156 REAL(wp), DIMENSION(jpi,jpj,jpk) :: eb ! tke at time before 153 157 REAL(wp), DIMENSION(jpi,jpj,jpk) :: hmxl_b ! mixing length at time before … … 165 169 ustar2_bot (:,:) = 0._wp 166 170 171 SELECT CASE ( nn_z0_ice ) 172 CASE( 0 ) ; zice_fra(:,:) = 0._wp 173 CASE( 1 ) ; zice_fra(:,:) = TANH( fr_i(:,:) * 10._wp ) 174 CASE( 2 ) ; zice_fra(:,:) = fr_i(:,:) 175 CASE( 3 ) ; zice_fra(:,:) = MIN( 4._wp * fr_i(:,:) , 1._wp ) 176 END SELECT 177 167 178 ! Compute surface, top and bottom friction at T-points 168 DO jj = 2, jpjm1 169 DO ji = fs_2, fs_jpim1 ! vector opt. 170 ! 171 ! surface friction 179 DO jj = 2, jpjm1 !== surface ocean friction 180 DO ji = fs_2, fs_jpim1 ! vector opt. 172 181 ustar2_surf(ji,jj) = r1_rau0 * taum(ji,jj) * tmask(ji,jj,1) 173 ! 182 END DO 183 END DO 184 ! 174 185 !!gm Rq we may add here r_ke0(_top/_bot) ? ==>> think about that... 175 ! bottom friction (explicit before friction) 176 zmsku = ( 2._wp - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 177 zmskv = ( 2._wp - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) ! (CAUTION: CdU<0) 178 ustar2_bot(ji,jj) = - rCdU_bot(ji,jj) * SQRT( ( zmsku*( ub(ji,jj,mbkt(ji,jj))+ub(ji-1,jj,mbkt(ji,jj)) ) )**2 & 179 & + ( zmskv*( vb(ji,jj,mbkt(ji,jj))+vb(ji,jj-1,mbkt(ji,jj)) ) )**2 ) 180 END DO 181 END DO 182 IF( ln_isfcav ) THEN !top friction 183 DO jj = 2, jpjm1 184 DO ji = fs_2, fs_jpim1 ! vector opt. 185 zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 186 zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) ) ! (CAUTION: CdU<0) 187 ustar2_top(ji,jj) = - rCdU_top(ji,jj) * SQRT( ( zmsku*( ub(ji,jj,mikt(ji,jj))+ub(ji-1,jj,mikt(ji,jj)) ) )**2 & 188 & + ( zmskv*( vb(ji,jj,mikt(ji,jj))+vb(ji,jj-1,mikt(ji,jj)) ) )**2 ) 189 END DO 190 END DO 186 ! 187 IF( .NOT.ln_drg_OFF ) THEN !== top/bottom friction (explicit before friction) 188 DO jj = 2, jpjm1 ! bottom friction 189 DO ji = fs_2, fs_jpim1 ! vector opt. 190 zmsku = ( 2._wp - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 191 zmskv = ( 2._wp - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) ! (CAUTION: CdU<0) 192 ustar2_bot(ji,jj) = - rCdU_bot(ji,jj) * SQRT( ( zmsku*( ub(ji,jj,mbkt(ji,jj))+ub(ji-1,jj,mbkt(ji,jj)) ) )**2 & 193 & + ( zmskv*( vb(ji,jj,mbkt(ji,jj))+vb(ji,jj-1,mbkt(ji,jj)) ) )**2 ) 194 END DO 195 END DO 196 IF( ln_isfcav ) THEN !top friction 197 DO jj = 2, jpjm1 198 DO ji = fs_2, fs_jpim1 ! vector opt. 199 zmsku = ( 2._wp - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 200 zmskv = ( 2._wp - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) ) ! (CAUTION: CdU<0) 201 ustar2_top(ji,jj) = - rCdU_top(ji,jj) * SQRT( ( zmsku*( ub(ji,jj,mikt(ji,jj))+ub(ji-1,jj,mikt(ji,jj)) ) )**2 & 202 & + ( zmskv*( vb(ji,jj,mikt(ji,jj))+vb(ji,jj-1,mikt(ji,jj)) ) )**2 ) 203 END DO 204 END DO 205 ENDIF 191 206 ENDIF 192 207 … … 203 218 zhsro(:,:) = MAX(rsbc_zs2 * ustar2_surf(:,:) * zdep(:,:)**1.5, rn_hsro) ! zhsro = rn_frac_hs * Hsw (eq. 11) 204 219 CASE ( 3 ) ! Roughness given by the wave model (coupled or read in file) 205 zhsro(:,:) = rn_frac_hs * hsw(:,:) ! (rn_frac_hs=1.6 see Eq. (5) of Rascle et al. 2008 )220 zhsro(:,:) = MAX(rn_frac_hs * hsw(:,:), rn_hsro) ! (rn_frac_hs=1.6 see Eq. (5) of Rascle et al. 2008 ) 206 221 END SELECT 207 222 ! 223 ! adapt roughness where there is sea ice 224 zhsro(:,:) = ( (1._wp-zice_fra(:,:)) * zhsro(:,:) + zice_fra(:,:) * rn_hsri )*tmask(:,:,1) + (1._wp - tmask(:,:,1))*rn_hsro 225 ! 208 226 DO jk = 2, jpkm1 !== Compute dissipation rate ==! 209 DO jj = 1, jpjm1210 DO ji = 1, jpim1227 DO jj = 2, jpjm1 228 DO ji = 2, jpim1 211 229 eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / hmxl_n(ji,jj,jk) 212 230 END DO … … 300 318 CASE ( 0 ) ! Dirichlet boundary condition (set e at k=1 & 2) 301 319 ! First level 302 en (:,:,1) = MAX( rn_emin , rc02r * ustar2_surf(:,:) * (1._wp + rsbc_tke1)**r2_3 )320 en (:,:,1) = MAX( rn_emin , rc02r * ustar2_surf(:,:) * (1._wp + (1._wp-zice_fra(:,:))*rsbc_tke1)**r2_3 ) 303 321 zd_lw(:,:,1) = en(:,:,1) 304 322 zd_up(:,:,1) = 0._wp … … 306 324 ! 307 325 ! One level below 308 en (:,:,2) = MAX( rc02r * ustar2_surf(:,:) * ( 1._wp + rsbc_tke1 * ((zhsro(:,:)+gdepw_n(:,:,2))&309 & / zhsro(:,:) )**(1.5_wp*ra_sf) )**(2._wp/3._wp) 326 en (:,:,2) = MAX( rc02r * ustar2_surf(:,:) * ( 1._wp + (1._wp-zice_fra(:,:))*rsbc_tke1 * ((zhsro(:,:)+gdepw_n(:,:,2)) & 327 & / zhsro(:,:) )**(1.5_wp*ra_sf) )**(2._wp/3._wp) , rn_emin ) 310 328 zd_lw(:,:,2) = 0._wp 311 329 zd_up(:,:,2) = 0._wp … … 316 334 ! 317 335 ! Dirichlet conditions at k=1 318 en (:,:,1) = MAX( rc02r * ustar2_surf(:,:) * (1._wp + rsbc_tke1)**r2_3 , rn_emin )336 en (:,:,1) = MAX( rc02r * ustar2_surf(:,:) * (1._wp + (1._wp-zice_fra(:,:))*rsbc_tke1)**r2_3 , rn_emin ) 319 337 zd_lw(:,:,1) = en(:,:,1) 320 338 zd_up(:,:,1) = 0._wp … … 326 344 zd_lw(:,:,2) = 0._wp 327 345 zkar (:,:) = (rl_sf + (vkarmn-rl_sf)*(1.-EXP(-rtrans*gdept_n(:,:,1)/zhsro(:,:)) )) 328 zflxs(:,:) = rsbc_tke2 * ustar2_surf(:,:)**1.5_wp * zkar(:,:) &346 zflxs(:,:) = rsbc_tke2 * (1._wp-zice_fra(:,:)) * ustar2_surf(:,:)**1.5_wp * zkar(:,:) & 329 347 & * ( ( zhsro(:,:)+gdept_n(:,:,1) ) / zhsro(:,:) )**(1.5_wp*ra_sf) 330 348 !!gm why not : * ( 1._wp + gdept_n(:,:,1) / zhsro(:,:) )**(1.5_wp*ra_sf) … … 427 445 END DO 428 446 END DO 429 DO jk = 2, jpk 447 DO jk = 2, jpkm1 ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 430 448 DO jj = 2, jpjm1 431 449 DO ji = fs_2, fs_jpim1 ! vector opt. … … 434 452 END DO 435 453 END DO 436 DO jk = jpk -1, 2, -1 ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk454 DO jk = jpkm1, 2, -1 ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 437 455 DO jj = 2, jpjm1 438 456 DO ji = fs_2, fs_jpim1 ! vector opt. … … 577 595 zkar (:,:) = rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdept_n(:,:,1)/zhsro(:,:) )) ! Lengh scale slope 578 596 zdep (:,:) = ((zhsro(:,:) + gdept_n(:,:,1)) / zhsro(:,:))**(rmm*ra_sf) 579 zflxs(:,:) = (rnn + rsbc_tke1 * (rnn + rmm*ra_sf) * zdep(:,:))*(1._wp + rsbc_tke1*zdep(:,:))**(2._wp*rmm/3._wp-1_wp) 597 zflxs(:,:) = (rnn + (1._wp-zice_fra(:,:))*rsbc_tke1 * (rnn + rmm*ra_sf) * zdep(:,:)) & 598 & *(1._wp + (1._wp-zice_fra(:,:))*rsbc_tke1*zdep(:,:))**(2._wp*rmm/3._wp-1_wp) 580 599 zdep (:,:) = rsbc_psi1 * (zwall_psi(:,:,1)*p_avm(:,:,1)+zwall_psi(:,:,2)*p_avm(:,:,2)) * & 581 600 & ustar2_surf(:,:)**rmm * zkar(:,:)**rnn * (zhsro(:,:) + gdept_n(:,:,1))**(rnn-1.) … … 654 673 END DO 655 674 END DO 656 DO jk = 2, jpk 675 DO jk = 2, jpkm1 ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 657 676 DO jj = 2, jpjm1 658 677 DO ji = fs_2, fs_jpim1 ! vector opt. … … 661 680 END DO 662 681 END DO 663 DO jk = jpk -1, 2, -1 ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk682 DO jk = jpkm1, 2, -1 ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 664 683 DO jj = 2, jpjm1 665 684 DO ji = fs_2, fs_jpim1 ! vector opt. … … 850 869 REAL(wp):: zcr ! local scalar 851 870 !! 852 NAMELIST/namzdf_gls/rn_emin, rn_epsmin, ln_length_lim, &853 & rn_clim_galp, ln_sigpsi, rn_hsro, 854 & rn_crban, rn_charn, rn_frac_hs, &855 & nn_bc_surf, nn_bc_bot, nn_z0_met, 871 NAMELIST/namzdf_gls/rn_emin, rn_epsmin, ln_length_lim, & 872 & rn_clim_galp, ln_sigpsi, rn_hsro, rn_hsri, & 873 & rn_crban, rn_charn, rn_frac_hs, & 874 & nn_bc_surf, nn_bc_bot, nn_z0_met, nn_z0_ice, & 856 875 & nn_stab_func, nn_clos 857 876 !!---------------------------------------------------------- … … 881 900 WRITE(numout,*) ' Charnock coefficient rn_charn = ', rn_charn 882 901 WRITE(numout,*) ' Surface roughness formula nn_z0_met = ', nn_z0_met 902 WRITE(numout,*) ' surface wave breaking under ice nn_z0_ice = ', nn_z0_ice 903 SELECT CASE( nn_z0_ice ) 904 CASE( 0 ) ; WRITE(numout,*) ' ==>>> no impact of ice cover on surface wave breaking' 905 CASE( 1 ) ; WRITE(numout,*) ' ==>>> roughness uses rn_hsri and is weigthed by 1-TANH( fr_i(:,:) * 10 )' 906 CASE( 2 ) ; WRITE(numout,*) ' ==>>> roughness uses rn_hsri and is weighted by 1-fr_i(:,:)' 907 CASE( 3 ) ; WRITE(numout,*) ' ==>>> roughness uses rn_hsri and is weighted by 1-MIN( 1, 4 * fr_i(:,:) )' 908 CASE DEFAULT 909 CALL ctl_stop( 'zdf_gls_init: wrong value for nn_z0_ice, should be 0,1,2, or 3') 910 END SELECT 883 911 WRITE(numout,*) ' Wave height frac. (used if nn_z0_met=2) rn_frac_hs = ', rn_frac_hs 884 912 WRITE(numout,*) ' Stability functions nn_stab_func = ', nn_stab_func 885 913 WRITE(numout,*) ' Type of closure nn_clos = ', nn_clos 886 914 WRITE(numout,*) ' Surface roughness (m) rn_hsro = ', rn_hsro 915 WRITE(numout,*) ' Ice-ocean roughness (used if nn_z0_ice/=0) rn_hsri = ', rn_hsri 887 916 WRITE(numout,*) 888 917 WRITE(numout,*) ' Namelist namdrg_top/_bot: used values:' … … 896 925 897 926 ! !* Check of some namelist values 898 IF( nn_bc_surf < 0 .OR. nn_bc_surf > 1 ) CALL ctl_stop( 'zdf_gls_init: bad flag: nn_bc_surf is 0 or 1' )899 IF( nn_bc_surf < 0 .OR. nn_bc_surf > 1 ) CALL ctl_stop( 'zdf_gls_init: bad flag: nn_bc_surf is 0 or 1' )900 IF( nn_z0_met < 0 .OR. nn_z0_met > 3 ) CALL ctl_stop( 'zdf_gls_init: bad flag: nn_z0_met is 0, 1, 2 or 3' )901 IF( nn_z0_met == 3 .AND. .NOT. ln_wave ) CALL ctl_stop( 'zdf_gls_init: nn_z0_met=3 requires ln_wave=T' )902 IF( nn_stab_func < 0 .OR. nn_stab_func > 3 ) CALL ctl_stop( 'zdf_gls_init: bad flag: nn_stab_func is 0, 1, 2 and 3' )903 IF( nn_clos < 0 .OR. nn_clos > 3 ) CALL ctl_stop( 'zdf_gls_init: bad flag: nn_clos is 0, 1, 2 or 3' )927 IF( nn_bc_surf < 0 .OR. nn_bc_surf > 1 ) CALL ctl_stop( 'zdf_gls_init: bad flag: nn_bc_surf is 0 or 1' ) 928 IF( nn_bc_surf < 0 .OR. nn_bc_surf > 1 ) CALL ctl_stop( 'zdf_gls_init: bad flag: nn_bc_surf is 0 or 1' ) 929 IF( nn_z0_met < 0 .OR. nn_z0_met > 3 ) CALL ctl_stop( 'zdf_gls_init: bad flag: nn_z0_met is 0, 1, 2 or 3' ) 930 IF( nn_z0_met == 3 .AND. .NOT. (ln_wave .AND. ln_sdw ) ) CALL ctl_stop( 'zdf_gls_init: nn_z0_met=3 requires ln_wave=T and ln_sdw=T' ) 931 IF( nn_stab_func < 0 .OR. nn_stab_func > 3 ) CALL ctl_stop( 'zdf_gls_init: bad flag: nn_stab_func is 0, 1, 2 and 3' ) 932 IF( nn_clos < 0 .OR. nn_clos > 3 ) CALL ctl_stop( 'zdf_gls_init: bad flag: nn_clos is 0, 1, 2 or 3' ) 904 933 905 934 SELECT CASE ( nn_clos ) !* set the parameters for the chosen closure -
NEMO/branches/2019/dev_r11842_SI3-10_EAP/src/OCE/ZDF/zdfosm.F90
r11536 r13662 1420 1420 ENDIF 1421 1421 1422 1423 ! ! Check wave coupling settings ! 1424 ! ! Further work needed - see ticket #2447 ! 1425 IF( nn_osm_wave == 2 ) THEN 1426 IF (.NOT. ( ln_wave .AND. ln_sdw )) & 1427 & CALL ctl_stop( 'zdf_osm_init : ln_zdfosm and nn_osm_wave=2, ln_wave and ln_sdw must be true' ) 1428 END IF 1429 1422 1430 ! ! allocate zdfosm arrays 1423 1431 IF( zdf_osm_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_osm_init : unable to allocate arrays' ) -
NEMO/branches/2019/dev_r11842_SI3-10_EAP/src/OCE/ZDF/zdfphy.F90
r11536 r13662 28 28 USE sbc_oce ! surface module (only for nn_isf in the option compatibility test) 29 29 USE sbcrnf ! surface boundary condition: runoff variables 30 USE sbc_ice ! sea ice drag 30 31 #if defined key_agrif 31 32 USE agrif_oce_interp ! interpavm … … 252 253 ENDIF 253 254 ! 255 #if defined key_si3 256 IF ( ln_drgice_imp) THEN 257 IF ( ln_isfcav ) THEN 258 rCdU_top(:,:) = rCdU_top(:,:) + ssmask(:,:) * tmask(:,:,1) * rCdU_ice(:,:) 259 ELSE 260 rCdU_top(:,:) = rCdU_ice(:,:) 261 ENDIF 262 ENDIF 263 #endif 264 ! 254 265 ! !== Kz from chosen turbulent closure ==! (avm_k, avt_k) 255 266 ! -
NEMO/branches/2019/dev_r11842_SI3-10_EAP/src/OCE/ZDF/zdftke.F90
r11536 r13662 28 28 !! 3.6 ! 2014-11 (P. Mathiot) add ice shelf capability 29 29 !! 4.0 ! 2017-04 (G. Madec) remove CPP ddm key & avm at t-point only 30 !! - ! 2017-05 (G. Madec) add top/bottom friction as boundary condition (ln_drg)30 !! - ! 2017-05 (G. Madec) add top/bottom friction as boundary condition 31 31 !!---------------------------------------------------------------------- 32 32 … … 46 46 USE zdfmxl ! vertical physics: mixed layer 47 47 ! 48 #if defined key_si3 49 USE ice, ONLY: hm_i, h_i 50 #endif 51 #if defined key_cice 52 USE sbc_ice, ONLY: h_i 53 #endif 48 54 USE in_out_manager ! I/O manager 49 55 USE iom ! I/O manager library … … 62 68 ! !!** Namelist namzdf_tke ** 63 69 LOGICAL :: ln_mxl0 ! mixing length scale surface value as function of wind stress or not 70 INTEGER :: nn_mxlice ! type of scaling under sea-ice (=0/1/2/3) 71 REAL(wp) :: rn_mxlice ! ice thickness value when scaling under sea-ice 64 72 INTEGER :: nn_mxl ! type of mixing length (=0/1/2/3) 65 73 REAL(wp) :: rn_mxl0 ! surface min value of mixing length (kappa*z_o=0.4*0.1 m) [m] … … 71 79 REAL(wp) :: rn_emin0 ! surface minimum value of tke [m2/s2] 72 80 REAL(wp) :: rn_bshear ! background shear (>0) currently a numerical threshold (do not change it) 73 LOGICAL :: ln_drg ! top/bottom friction forcing flag74 81 INTEGER :: nn_etau ! type of depth penetration of surface tke (=0/1/2/3) 75 82 INTEGER :: nn_htau ! type of tke profile of penetration (=0/1) 76 83 REAL(wp) :: rn_efr ! fraction of TKE surface value which penetrates in the ocean 77 REAL(wp) :: rn_eice ! =0 ON below sea-ice, =4 OFF when ice fraction > 1/478 84 LOGICAL :: ln_lc ! Langmuir cells (LC) as a source term of TKE or not 79 85 REAL(wp) :: rn_lc ! coef to compute vertical velocity of Langmuir cells 86 INTEGER :: nn_eice ! attenutaion of langmuir & surface wave breaking under ice (=0/1/2/3) 80 87 81 88 REAL(wp) :: ri_cri ! critic Richardson number (deduced from rn_ediff and rn_ediss values) … … 191 198 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: p_avm, p_avt ! vertical eddy viscosity & diffusivity (w-points) 192 199 ! 193 INTEGER :: ji, jj, jk ! dummy loop arguments200 INTEGER :: ji, jj, jk ! dummy loop arguments 194 201 REAL(wp) :: zetop, zebot, zmsku, zmskv ! local scalars 195 202 REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3 196 203 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 197 REAL(wp) :: zbbrau, z ri! local scalars198 REAL(wp) :: zfact1, zfact2, zfact3 ! - 199 REAL(wp) :: ztx2 , zty2 , zcof ! - 200 REAL(wp) :: ztau , zdif ! - 201 REAL(wp) :: zus , zwlc , zind ! - 202 REAL(wp) :: zzd_up, zzd_lw ! - 204 REAL(wp) :: zbbrau, zbbirau, zri ! local scalars 205 REAL(wp) :: zfact1, zfact2, zfact3 ! - - 206 REAL(wp) :: ztx2 , zty2 , zcof ! - - 207 REAL(wp) :: ztau , zdif ! - - 208 REAL(wp) :: zus , zwlc , zind ! - - 209 REAL(wp) :: zzd_up, zzd_lw ! - - 203 210 INTEGER , DIMENSION(jpi,jpj) :: imlc 204 REAL(wp), DIMENSION(jpi,jpj) :: z hlc, zfr_i211 REAL(wp), DIMENSION(jpi,jpj) :: zice_fra, zhlc, zus3 205 212 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpelc, zdiag, zd_up, zd_lw 206 213 !!-------------------------------------------------------------------- 207 214 ! 208 zbbrau = rn_ebb / rau0 ! Local constant initialisation 209 zfact1 = -.5_wp * rdt 210 zfact2 = 1.5_wp * rdt * rn_ediss 211 zfact3 = 0.5_wp * rn_ediss 215 zbbrau = rn_ebb / rau0 ! Local constant initialisation 216 zbbirau = 3.75_wp / rau0 217 zfact1 = -0.5_wp * rdt 218 zfact2 = 1.5_wp * rdt * rn_ediss 219 zfact3 = 0.5_wp * rn_ediss 220 ! 221 ! ice fraction considered for attenuation of langmuir & wave breaking 222 SELECT CASE ( nn_eice ) 223 CASE( 0 ) ; zice_fra(:,:) = 0._wp 224 CASE( 1 ) ; zice_fra(:,:) = TANH( fr_i(:,:) * 10._wp ) 225 CASE( 2 ) ; zice_fra(:,:) = fr_i(:,:) 226 CASE( 3 ) ; zice_fra(:,:) = MIN( 4._wp * fr_i(:,:) , 1._wp ) 227 END SELECT 212 228 ! 213 229 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 214 230 ! ! Surface/top/bottom boundary condition on tke 215 231 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 216 232 ! 217 233 DO jj = 2, jpjm1 ! en(1) = rn_ebb taum / rau0 (min value rn_emin0) 218 234 DO ji = fs_2, fs_jpim1 ! vector opt. 235 !! clem: this should be the right formulation but it makes the model unstable unless drags are calculated implicitly 236 !! one way around would be to increase zbbirau 237 !! en(ji,jj,1) = MAX( rn_emin0, ( ( 1._wp - fr_i(ji,jj) ) * zbbrau + & 238 !! & fr_i(ji,jj) * zbbirau ) * taum(ji,jj) ) * tmask(ji,jj,1) 219 239 en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1) 220 240 END DO 221 241 END DO 222 IF ( ln_isfcav ) THEN223 DO jj = 2, jpjm1 ! en(mikt(ji,jj)) = rn_emin224 DO ji = fs_2, fs_jpim1 ! vector opt.225 en(ji,jj,mikt(ji,jj)) = rn_emin * tmask(ji,jj,1)226 END DO227 END DO228 ENDIF229 242 ! 230 243 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< … … 236 249 ! Note that stress averaged is done using an wet-only calculation of u and v at t-point like in zdfsh2 237 250 ! 238 IF( ln_drg ) THEN!== friction used as top/bottom boundary condition on TKE239 ! 240 DO jj = 2, jpjm1 ! bottom friction251 IF( .NOT.ln_drg_OFF ) THEN !== friction used as top/bottom boundary condition on TKE 252 ! 253 DO jj = 2, jpjm1 ! bottom friction 241 254 DO ji = fs_2, fs_jpim1 ! vector opt. 242 255 zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) … … 256 269 zetop = - 0.001875_wp * rCdU_top(ji,jj) * SQRT( ( zmsku*( ub(ji,jj,mikt(ji,jj))+ub(ji-1,jj,mikt(ji,jj)) ) )**2 & 257 270 & + ( zmskv*( vb(ji,jj,mikt(ji,jj))+vb(ji,jj-1,mikt(ji,jj)) ) )**2 ) 258 en(ji,jj,mikt(ji,jj)) = MAX( zetop, rn_emin ) * (1._wp - tmask(ji,jj,1)) ! masked at ocean surface 271 en(ji,jj,mikt(ji,jj)) = en(ji,jj,1) * tmask(ji,jj,1) & 272 & + MAX( zetop, rn_emin ) * (1._wp - tmask(ji,jj,1)) * ssmask(ji,jj) 259 273 END DO 260 274 END DO … … 293 307 DO ji = fs_2, fs_jpim1 ! vector opt. 294 308 zus = zcof * SQRT( taum(ji,jj) ) ! Stokes drift 295 zfr_i(ji,jj) = ( 1._wp - 4._wp * fr_i(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok 296 IF (zfr_i(ji,jj) < 0. ) zfr_i(ji,jj) = 0. 309 zus3(ji,jj) = MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok 297 310 END DO 298 311 END DO … … 300 313 DO jj = 2, jpjm1 301 314 DO ji = fs_2, fs_jpim1 ! vector opt. 302 IF ( z fr_i(ji,jj) /= 0.) THEN315 IF ( zus3(ji,jj) /= 0._wp ) THEN 303 316 ! vertical velocity due to LC 304 317 IF ( pdepw(ji,jj,jk) - zhlc(ji,jj) < 0 .AND. wmask(ji,jj,jk) /= 0. ) THEN 305 318 ! ! vertical velocity due to LC 306 zwlc = rn_lc * SIN( rpi * pdepw(ji,jj,jk) / zhlc(ji,jj) ) ! warning: optimization: zus^3 is in zfr_i319 zwlc = rn_lc * SIN( rpi * pdepw(ji,jj,jk) / zhlc(ji,jj) ) 307 320 ! ! TKE Langmuir circulation source term 308 en(ji,jj,jk) = en(ji,jj,jk) + rdt * z fr_i(ji,jj) * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj)321 en(ji,jj,jk) = en(ji,jj,jk) + rdt * zus3(ji,jj) * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj) 309 322 ENDIF 310 323 ENDIF … … 406 419 407 420 IF( nn_etau == 1 ) THEN !* penetration below the mixed layer (rn_efr fraction) 408 DO jk = 2, jpkm1 ! rn_eice =0 ON below sea-ice, =4 OFF when ice fraction > 0.25421 DO jk = 2, jpkm1 ! nn_eice=0 : ON below sea-ice ; nn_eice>0 : partly OFF 409 422 DO jj = 2, jpjm1 410 423 DO ji = fs_2, fs_jpim1 ! vector opt. 411 424 en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) ) & 412 & * MAX( 0.,1._wp - rn_eice *fr_i(ji,jj) )* wmask(ji,jj,jk) * tmask(ji,jj,1)425 & * MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 413 426 END DO 414 427 END DO … … 419 432 jk = nmln(ji,jj) 420 433 en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) ) & 421 & * MAX( 0.,1._wp - rn_eice *fr_i(ji,jj) )* wmask(ji,jj,jk) * tmask(ji,jj,1)434 & * MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 422 435 END DO 423 436 END DO … … 432 445 zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add ) ! apply some modifications... 433 446 en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) ) & 434 & * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1)447 & * MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 435 448 END DO 436 449 END DO … … 484 497 REAL(wp) :: zrn2, zraug, zcoef, zav ! local scalars 485 498 REAL(wp) :: zdku, zdkv, zsqen ! - - 486 REAL(wp) :: zemxl, zemlm, zemlp ! - -499 REAL(wp) :: zemxl, zemlm, zemlp, zmaxice ! - - 487 500 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmxlm, zmxld ! 3D workspace 488 501 !!-------------------------------------------------------------------- … … 497 510 zmxlm(:,:,:) = rmxl_min 498 511 zmxld(:,:,:) = rmxl_min 499 ! 512 ! 500 513 IF( ln_mxl0 ) THEN ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rau0*g) 514 ! 501 515 zraug = vkarmn * 2.e5_wp / ( rau0 * grav ) 502 DO jj = 2, jpjm1 516 #if ! defined key_si3 && ! defined key_cice 517 DO jj = 2, jpjm1 ! No sea-ice 503 518 DO ji = fs_2, fs_jpim1 504 zmxlm(ji,jj,1) = MAX( rn_mxl0, zraug * taum(ji,jj) * tmask(ji,jj,1) ) 505 END DO 506 END DO 507 ELSE 519 zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1) 520 END DO 521 END DO 522 #else 523 524 SELECT CASE( nn_mxlice ) ! Type of scaling under sea-ice 525 ! 526 CASE( 0 ) ! No scaling under sea-ice 527 DO jj = 2, jpjm1 528 DO ji = fs_2, fs_jpim1 529 zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1) 530 END DO 531 END DO 532 ! 533 CASE( 1 ) ! scaling with constant sea-ice thickness 534 DO jj = 2, jpjm1 535 DO ji = fs_2, fs_jpim1 536 zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 537 & fr_i(ji,jj) * rn_mxlice ) * tmask(ji,jj,1) 538 END DO 539 END DO 540 ! 541 CASE( 2 ) ! scaling with mean sea-ice thickness 542 DO jj = 2, jpjm1 543 DO ji = fs_2, fs_jpim1 544 #if defined key_si3 545 zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 546 & fr_i(ji,jj) * hm_i(ji,jj) * 2._wp ) * tmask(ji,jj,1) 547 #elif defined key_cice 548 zmaxice = MAXVAL( h_i(ji,jj,:) ) 549 zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 550 & fr_i(ji,jj) * zmaxice ) * tmask(ji,jj,1) 551 #endif 552 END DO 553 END DO 554 ! 555 CASE( 3 ) ! scaling with max sea-ice thickness 556 DO jj = 2, jpjm1 557 DO ji = fs_2, fs_jpim1 558 zmaxice = MAXVAL( h_i(ji,jj,:) ) 559 zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 560 & fr_i(ji,jj) * zmaxice ) * tmask(ji,jj,1) 561 END DO 562 END DO 563 ! 564 END SELECT 565 #endif 566 ! 567 DO jj = 2, jpjm1 568 DO ji = fs_2, fs_jpim1 569 zmxlm(ji,jj,1) = MAX( rn_mxl0, zmxlm(ji,jj,1) ) 570 END DO 571 END DO 572 ! 573 ELSE 508 574 zmxlm(:,:,1) = rn_mxl0 509 575 ENDIF … … 617 683 DO jj = 2, jpjm1 618 684 DO ji = fs_2, fs_jpim1 ! vector opt. 619 p_avt(ji,jj,jk) = MAX( apdlr(ji,jj,jk) * p_avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * tmask(ji,jj,jk)685 p_avt(ji,jj,jk) = MAX( apdlr(ji,jj,jk) * p_avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk) 620 686 END DO 621 687 END DO … … 650 716 INTEGER :: ios 651 717 !! 652 NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb , rn_emin , & 653 & rn_emin0, rn_bshear, nn_mxl , ln_mxl0 , & 654 & rn_mxl0 , nn_pdl , ln_drg , ln_lc , rn_lc, & 655 & nn_etau , nn_htau , rn_efr , rn_eice 718 NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb , rn_emin , & 719 & rn_emin0, rn_bshear, nn_mxl , ln_mxl0 , & 720 & rn_mxl0 , nn_mxlice, rn_mxlice, & 721 & nn_pdl , ln_lc , rn_lc, & 722 & nn_etau , nn_htau , rn_efr , nn_eice 656 723 !!---------------------------------------------------------------------- 657 724 ! … … 682 749 WRITE(numout,*) ' surface mixing length = F(stress) or not ln_mxl0 = ', ln_mxl0 683 750 WRITE(numout,*) ' surface mixing length minimum value rn_mxl0 = ', rn_mxl0 684 WRITE(numout,*) ' top/bottom friction forcing flag ln_drg = ', ln_drg 751 IF( ln_mxl0 ) THEN 752 WRITE(numout,*) ' type of scaling under sea-ice nn_mxlice = ', nn_mxlice 753 IF( nn_mxlice == 1 ) & 754 WRITE(numout,*) ' ice thickness when scaling under sea-ice rn_mxlice = ', rn_mxlice 755 SELECT CASE( nn_mxlice ) ! Type of scaling under sea-ice 756 CASE( 0 ) ; WRITE(numout,*) ' ==>>> No scaling under sea-ice' 757 CASE( 1 ) ; WRITE(numout,*) ' ==>>> scaling with constant sea-ice thickness' 758 CASE( 2 ) ; WRITE(numout,*) ' ==>>> scaling with mean sea-ice thickness' 759 CASE( 3 ) ; WRITE(numout,*) ' ==>>> scaling with max sea-ice thickness' 760 CASE DEFAULT 761 CALL ctl_stop( 'zdf_tke_init: wrong value for nn_mxlice, should be 0,1,2,3 or 4') 762 END SELECT 763 ENDIF 685 764 WRITE(numout,*) ' Langmuir cells parametrization ln_lc = ', ln_lc 686 765 WRITE(numout,*) ' coef to compute vertical velocity of LC rn_lc = ', rn_lc … … 688 767 WRITE(numout,*) ' type of tke penetration profile nn_htau = ', nn_htau 689 768 WRITE(numout,*) ' fraction of TKE that penetrates rn_efr = ', rn_efr 690 WRITE(numout,*) ' below sea-ice: =0 ON rn_eice = ', rn_eice 691 WRITE(numout,*) ' =4 OFF when ice fraction > 1/4 ' 692 IF( ln_drg ) THEN 769 WRITE(numout,*) ' langmuir & surface wave breaking under ice nn_eice = ', nn_eice 770 SELECT CASE( nn_eice ) 771 CASE( 0 ) ; WRITE(numout,*) ' ==>>> no impact of ice cover on langmuir & surface wave breaking' 772 CASE( 1 ) ; WRITE(numout,*) ' ==>>> weigthed by 1-TANH( fr_i(:,:) * 10 )' 773 CASE( 2 ) ; WRITE(numout,*) ' ==>>> weighted by 1-fr_i(:,:)' 774 CASE( 3 ) ; WRITE(numout,*) ' ==>>> weighted by 1-MIN( 1, 4 * fr_i(:,:) )' 775 CASE DEFAULT 776 CALL ctl_stop( 'zdf_tke_init: wrong value for nn_eice, should be 0,1,2, or 3') 777 END SELECT 778 IF( .NOT.ln_drg_OFF ) THEN 693 779 WRITE(numout,*) 694 780 WRITE(numout,*) ' Namelist namdrg_top/_bot: used values:'
Note: See TracChangeset
for help on using the changeset viewer.
