- Timestamp:
- 2017-06-06T15:55:44+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r8093 r8143 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 31 !!---------------------------------------------------------------------- 31 32 … … 43 44 USE sbc_oce ! surface boundary condition: ocean 44 45 USE zdf_oce ! vertical physics: ocean variables 45 !!gm new46 46 USE zdfdrg ! vertical physics: top/bottom drag coef. 47 !!gm48 47 USE zdfmxl ! vertical physics: mixed layer 49 48 #if defined key_agrif … … 57 56 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 58 57 USE prtctl ! Print control 59 USE wrk_nemo ! work arrays60 58 USE timing ! Timing 61 59 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) … … 79 77 REAL(wp) :: rn_emin0 ! surface minimum value of tke [m2/s2] 80 78 REAL(wp) :: rn_bshear ! background shear (>0) currently a numerical threshold (do not change it) 79 LOGICAL :: ln_drg ! top/bottom friction forcing flag 81 80 INTEGER :: nn_etau ! type of depth penetration of surface tke (=0/1/2/3) 82 INTEGER :: nn_htau ! type of tke profile of penetration (=0/1)83 REAL(wp) :: rn_efr ! fraction of TKE surface value which penetrates in the ocean81 INTEGER :: nn_htau ! type of tke profile of penetration (=0/1) 82 REAL(wp) :: rn_efr ! fraction of TKE surface value which penetrates in the ocean 84 83 LOGICAL :: ln_lc ! Langmuir cells (LC) as a source term of TKE or not 85 REAL(wp) :: rn_lc ! coef to compute vertical velocity of Langmuir cells84 REAL(wp) :: rn_lc ! coef to compute vertical velocity of Langmuir cells 86 85 87 86 REAL(wp) :: ri_cri ! critic Richardson number (deduced from rn_ediff and rn_ediss values) … … 204 203 ! 205 204 INTEGER :: ji, jj, jk ! dummy loop arguments 206 !!bfr REAL(wp) :: zebot, zmshu, zmskv! local scalars207 REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3208 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient209 REAL(wp) :: zbbrau, zri ! local scalars210 REAL(wp) :: zfact1, zfact2, zfact3 ! - -211 REAL(wp) :: ztx2 , zty2 , zcof ! - -212 REAL(wp) :: ztau , zdif ! - -213 REAL(wp) :: zus , zwlc , zind ! - -214 REAL(wp) :: zzd_up, zzd_lw ! - -205 REAL(wp) :: zetop, zebot, zmsku, zmskv ! local scalars 206 REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3 207 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 208 REAL(wp) :: zbbrau, zri ! local scalars 209 REAL(wp) :: zfact1, zfact2, zfact3 ! - - 210 REAL(wp) :: ztx2 , zty2 , zcof ! - - 211 REAL(wp) :: ztau , zdif ! - - 212 REAL(wp) :: zus , zwlc , zind ! - - 213 REAL(wp) :: zzd_up, zzd_lw ! - - 215 214 INTEGER , DIMENSION(jpi,jpj) :: imlc 216 215 REAL(wp), DIMENSION(jpi,jpj) :: zhlc … … 227 226 ! 228 227 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 229 ! ! Surface boundary condition on tke 230 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 228 ! ! Surface/top/bottom boundary condition on tke 229 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 230 231 DO jj = 2, jpjm1 ! en(1) = rn_ebb taum / rau0 (min value rn_emin0) 232 DO ji = fs_2, fs_jpim1 ! vector opt. 233 en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1) 234 END DO 235 END DO 231 236 IF ( ln_isfcav ) THEN 232 237 DO jj = 2, jpjm1 ! en(mikt(ji,jj)) = rn_emin … … 235 240 END DO 236 241 END DO 237 END IF 238 DO jj = 2, jpjm1 ! en(1) = rn_ebb taum / rau0 (min value rn_emin0) 239 DO ji = fs_2, fs_jpim1 ! vector opt. 240 en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1) 241 END DO 242 END DO 242 ENDIF 243 243 244 !!bfr - start commented area245 244 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 246 245 ! ! Bottom boundary condition on tke 247 246 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 248 247 ! 249 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 250 ! Tests to date have found the bottom boundary condition on tke to have very little effect. 251 ! The condition is coded here for completion but commented out until there is proof that the 252 ! computational cost is justified 253 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 254 ! en(bot) = (rn_ebb0/rau0)*0.5*sqrt(u_botfr^2+v_botfr^2) (min value rn_emin) 255 !!gm old 256 !! DO jj = 2, jpjm1 257 !! DO ji = fs_2, fs_jpim1 ! vector opt. 258 !! ztx2 = bfrua(ji-1,jj) * ub(ji-1,jj,mbku(ji-1,jj)) + & 259 !! bfrua(ji ,jj) * ub(ji ,jj,mbku(ji ,jj) ) 260 !! zty2 = bfrva(ji,jj ) * vb(ji,jj ,mbkv(ji,jj )) + & 261 !! bfrva(ji,jj-1) * vb(ji,jj-1,mbkv(ji,jj-1) ) 262 !! zebot = 0.001875_wp * SQRT( ztx2 * ztx2 + zty2 * zty2 ) ! where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000. 263 !! en(ji,jj,mbkt(ji,jj)+1) = MAX( zebot, rn_emin ) * ssmask(ji,jj) 264 !! END DO 265 !! END DO 266 !!gm new 267 !! 268 !! ====>>>> add below an wet-only calculation of u and v at t-point like in zdfsh2: 269 !! zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 270 !! zmskv = ( 2. - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) 271 !! 272 !! 273 !! DO jj = 2, jpjm1 274 !! DO ji = fs_2, fs_jpim1 ! vector opt. 275 !! zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 276 !! zmskv = ( 2. - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) 277 !! ! ! where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000. (CAUTION CdU<0) 278 !! zebot = - 0.001875_wp * rCdU_bot(ji,jj) * SQRT( ( zmsku*( ub(ji,jj,mbkt(ji,jj))+ub(ji-1,jj,mbkt(ji,jj)) ) )**2 279 !! & + ( zmskv*( vb(ji,jj,mbkt(ji,jj))+vb(ji,jj-1,mbkt(ji,jj)) ) )**2 ) 280 !! en(ji,jj,mbkt(ji,jj)+1) = MAX( zebot, rn_emin ) * ssmask(ji,jj) 281 !! END DO 282 !! END DO 283 !! IF( ln_isfcav ) THEN !top friction 284 !! DO jj = 2, jpjm1 285 !! DO ji = fs_2, fs_jpim1 ! vector opt. 286 !! zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 287 !! zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) ) 288 !! ! ! where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000. (CAUTION CdU<0) 289 !! zebot = - 0.001875_wp * rCdU_top(ji,jj) * SQRT( ( zmsku*( ub(ji,jj,mikt(ji,jj))+ub(ji-1,jj,mikt(ji,jj)) ) )**2 290 !! & + ( zmskv*( vb(ji,jj,mikt(ji,jj))+vb(ji,jj-1,mikt(ji,jj)) ) )**2 ) 291 !! en(ji,jj,mikt(ji,jj)+1) = MAX( zebot, rn_emin ) * (1._wp - tmask(ji,jj,1)) ! masked at ocean surface 292 !! END DO 293 !! END DO 294 !! ENDIF 295 !! 296 !!bfr - end commented area 248 ! en(bot) = (ebb0/rau0)*0.5*sqrt(u_botfr^2+v_botfr^2) (min value rn_emin) 249 ! where ebb0 does not includes surface wave enhancement (i.e. ebb0=3.75) 250 ! Note that stress averaged is done using an wet-only calculation of u and v at t-point like in zdfsh2 251 ! 252 IF( ln_drg ) THEN !== friction used as top/bottom boundary condition on TKE 253 ! 254 DO jj = 2, jpjm1 ! bottom friction 255 DO ji = fs_2, fs_jpim1 ! vector opt. 256 zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 257 zmskv = ( 2. - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) 258 ! ! where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000. (CAUTION CdU<0) 259 zebot = - 0.001875_wp * rCdU_bot(ji,jj) * SQRT( ( zmsku*( ub(ji,jj,mbkt(ji,jj))+ub(ji-1,jj,mbkt(ji,jj)) ) )**2 & 260 & + ( zmskv*( vb(ji,jj,mbkt(ji,jj))+vb(ji,jj-1,mbkt(ji,jj)) ) )**2 ) 261 en(ji,jj,mbkt(ji,jj)+1) = MAX( zebot, rn_emin ) * ssmask(ji,jj) 262 END DO 263 END DO 264 IF( ln_isfcav ) THEN ! top friction 265 DO jj = 2, jpjm1 266 DO ji = fs_2, fs_jpim1 ! vector opt. 267 zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 268 zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) ) 269 ! ! where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000. (CAUTION CdU<0) 270 zetop = - 0.001875_wp * rCdU_top(ji,jj) * SQRT( ( zmsku*( ub(ji,jj,mikt(ji,jj))+ub(ji-1,jj,mikt(ji,jj)) ) )**2 & 271 & + ( zmskv*( vb(ji,jj,mikt(ji,jj))+vb(ji,jj-1,mikt(ji,jj)) ) )**2 ) 272 en(ji,jj,mikt(ji,jj)) = MAX( zetop, rn_emin ) * (1._wp - tmask(ji,jj,1)) ! masked at ocean surface 273 END DO 274 END DO 275 ENDIF 276 ! 277 ENDIF 297 278 ! 298 279 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< … … 426 407 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 427 408 !!gm BUG : in the exp remove the depth of ssh !!! 409 !!gm i.e. use gde3w in argument (pdepw) 428 410 429 411 … … 678 660 NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb , rn_emin , & 679 661 & rn_emin0, rn_bshear, nn_mxl , ln_mxl0 , & 680 & rn_mxl0 , nn_pdl , ln_ lc, rn_lc , &662 & rn_mxl0 , nn_pdl , ln_drg , ln_lc , rn_lc , & 681 663 & nn_etau , nn_htau , rn_efr 682 664 !!---------------------------------------------------------------------- … … 703 685 WRITE(numout,*) ' minimum value of tke rn_emin = ', rn_emin 704 686 WRITE(numout,*) ' surface minimum value of tke rn_emin0 = ', rn_emin0 687 WRITE(numout,*) ' prandl number flag nn_pdl = ', nn_pdl 705 688 WRITE(numout,*) ' background shear (>0) rn_bshear = ', rn_bshear 706 689 WRITE(numout,*) ' mixing length type nn_mxl = ', nn_mxl 707 WRITE(numout,*) ' prandl number flag nn_pdl = ', nn_pdl708 WRITE(numout,*) ' surface mixing length = F(stress) or not ln_mxl0 = ', ln_mxl0709 WRITE(numout,*) ' surface mixing length minimum value rn_mxl0 = ', rn_mxl0710 WRITE(numout,*) ' flag to take into acc. Langmuir circ.ln_lc = ', ln_lc711 WRITE(numout,*) ' coef to compute verticla velocity of LC rn_lc= ', rn_lc690 WRITE(numout,*) ' surface mixing length = F(stress) or not ln_mxl0 = ', ln_mxl0 691 WRITE(numout,*) ' surface mixing length minimum value rn_mxl0 = ', rn_mxl0 692 WRITE(numout,*) ' top/bottom friction forcing flag ln_drg = ', ln_drg 693 WRITE(numout,*) ' Langmuir cells parametrization ln_lc = ', ln_lc 694 WRITE(numout,*) ' coef to compute vertical velocity of LC rn_lc = ', rn_lc 712 695 WRITE(numout,*) ' test param. to add tke induced by wind nn_etau = ', nn_etau 713 WRITE(numout,*) ' flag for computation of exp. tke profilenn_htau = ', nn_htau714 WRITE(numout,*) ' fraction of en which pene. the thermoclinern_efr = ', rn_efr696 WRITE(numout,*) ' type of tke penetration profile nn_htau = ', nn_htau 697 WRITE(numout,*) ' fraction of TKE that penetrates rn_efr = ', rn_efr 715 698 WRITE(numout,*) 716 WRITE(numout,*) ' critical Richardson nb with your parameters ri_cri = ', ri_cri 699 IF( ln_drg ) THEN 700 WRITE(numout,*) ' Namelist namdrg_top/_bot: used values:' 701 WRITE(numout,*) ' top ocean cavity roughness (m) rn_z0(_top)= ', r_z0_top 702 WRITE(numout,*) ' Bottom seafloor roughness (m) rn_z0(_bot)= ', r_z0_bot 703 ENDIF 704 WRITE(numout,*) 705 WRITE(numout,*) 706 WRITE(numout,*) ' ==>> critical Richardson nb with your parameters ri_cri = ', ri_cri 717 707 WRITE(numout,*) 718 708 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
