Changeset 12377 for NEMO/trunk/src/OCE/ZDF
- Timestamp:
- 2020-02-12T15:39:06+01:00 (4 years ago)
- Location:
- NEMO/trunk
- Files:
-
- 13 edited
-
. (modified) (1 prop)
-
src/OCE/ZDF/zdfddm.F90 (modified) (5 diffs)
-
src/OCE/ZDF/zdfdrg.F90 (modified) (10 diffs)
-
src/OCE/ZDF/zdfevd.F90 (modified) (6 diffs)
-
src/OCE/ZDF/zdfgls.F90 (modified) (24 diffs)
-
src/OCE/ZDF/zdfiwm.F90 (modified) (16 diffs)
-
src/OCE/ZDF/zdfmxl.F90 (modified) (6 diffs)
-
src/OCE/ZDF/zdfosm.F90 (modified) (41 diffs)
-
src/OCE/ZDF/zdfphy.F90 (modified) (12 diffs)
-
src/OCE/ZDF/zdfric.F90 (modified) (7 diffs)
-
src/OCE/ZDF/zdfsh2.F90 (modified) (5 diffs)
-
src/OCE/ZDF/zdfswm.F90 (modified) (4 diffs)
-
src/OCE/ZDF/zdftke.F90 (modified) (18 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEAD ext/AGRIF5 ^/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL
-
- Property svn:externals
-
NEMO/trunk/src/OCE/ZDF/zdfddm.F90
r10068 r12377 30 30 31 31 !! * Substitutions 32 # include " vectopt_loop_substitute.h90"32 # include "do_loop_substitute.h90" 33 33 !!---------------------------------------------------------------------- 34 34 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 38 38 CONTAINS 39 39 40 SUBROUTINE zdf_ddm( kt, p_avm, p_avt, p_avs )40 SUBROUTINE zdf_ddm( kt, Kmm, p_avm, p_avt, p_avs ) 41 41 !!---------------------------------------------------------------------- 42 42 !! *** ROUTINE zdf_ddm *** … … 68 68 !! References : Merryfield et al., JPO, 29, 1124-1142, 1999. 69 69 !!---------------------------------------------------------------------- 70 INTEGER, INTENT(in ) :: kt ! ocean time-step indexocean time step 70 INTEGER, INTENT(in ) :: kt ! ocean time-step index 71 INTEGER, INTENT(in ) :: Kmm ! ocean time level index 71 72 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: p_avm ! Kz on momentum (w-points) 72 73 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: p_avt ! Kz on temperature (w-points) … … 91 92 !!gm and many acces in memory 92 93 93 DO jj = 1, jpj !== R=zrau = (alpha / beta) (dk[t] / dk[s]) ==! 94 DO ji = 1, jpi 95 zrw = ( gdepw_n(ji,jj,jk ) - gdept_n(ji,jj,jk) ) & 96 !!gm please, use e3w_n below 97 & / ( gdept_n(ji,jj,jk-1) - gdept_n(ji,jj,jk) ) 98 ! 99 zaw = ( rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem) * zrw ) & 100 & * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 101 zbw = ( rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal) * zrw ) & 102 & * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 103 ! 104 zdt = zaw * ( tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) 105 zds = zbw * ( tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) 106 IF( ABS( zds) <= 1.e-20_wp ) zds = 1.e-20_wp 107 zrau(ji,jj) = MAX( 1.e-20, zdt / zds ) ! only retains positive value of zrau 108 END DO 109 END DO 94 DO_2D_11_11 95 zrw = ( gdepw(ji,jj,jk ,Kmm) - gdept(ji,jj,jk,Kmm) ) & 96 !!gm please, use e3w(:,:,:,Kmm) below 97 & / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) ) 98 ! 99 zaw = ( rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem) * zrw ) & 100 & * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 101 zbw = ( rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal) * zrw ) & 102 & * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 103 ! 104 zdt = zaw * ( ts(ji,jj,jk-1,jp_tem,Kmm) - ts(ji,jj,jk,jp_tem,Kmm) ) 105 zds = zbw * ( ts(ji,jj,jk-1,jp_sal,Kmm) - ts(ji,jj,jk,jp_sal,Kmm) ) 106 IF( ABS( zds) <= 1.e-20_wp ) zds = 1.e-20_wp 107 zrau(ji,jj) = MAX( 1.e-20, zdt / zds ) ! only retains positive value of zrau 108 END_2D 110 109 111 DO jj = 1, jpj !== indicators ==! 112 DO ji = 1, jpi 113 ! stability indicator: msks=1 if rn2>0; 0 elsewhere 114 IF( rn2(ji,jj,jk) + 1.e-12 <= 0. ) THEN ; zmsks(ji,jj) = 0._wp 115 ELSE ; zmsks(ji,jj) = 1._wp 116 ENDIF 117 ! salt fingering indicator: msksf=1 if R>1; 0 elsewhere 118 IF( zrau(ji,jj) <= 1. ) THEN ; zmskf(ji,jj) = 0._wp 119 ELSE ; zmskf(ji,jj) = 1._wp 120 ENDIF 121 ! diffusive layering indicators: 122 ! ! mskdl1=1 if 0< R <1; 0 elsewhere 123 IF( zrau(ji,jj) >= 1. ) THEN ; zmskd1(ji,jj) = 0._wp 124 ELSE ; zmskd1(ji,jj) = 1._wp 125 ENDIF 126 ! ! mskdl2=1 if 0< R <0.5; 0 elsewhere 127 IF( zrau(ji,jj) >= 0.5 ) THEN ; zmskd2(ji,jj) = 0._wp 128 ELSE ; zmskd2(ji,jj) = 1._wp 129 ENDIF 130 ! mskdl3=1 if 0.5< R <1; 0 elsewhere 131 IF( zrau(ji,jj) <= 0.5 .OR. zrau(ji,jj) >= 1. ) THEN ; zmskd3(ji,jj) = 0._wp 132 ELSE ; zmskd3(ji,jj) = 1._wp 133 ENDIF 134 END DO 135 END DO 110 DO_2D_11_11 111 ! stability indicator: msks=1 if rn2>0; 0 elsewhere 112 IF( rn2(ji,jj,jk) + 1.e-12 <= 0. ) THEN ; zmsks(ji,jj) = 0._wp 113 ELSE ; zmsks(ji,jj) = 1._wp 114 ENDIF 115 ! salt fingering indicator: msksf=1 if R>1; 0 elsewhere 116 IF( zrau(ji,jj) <= 1. ) THEN ; zmskf(ji,jj) = 0._wp 117 ELSE ; zmskf(ji,jj) = 1._wp 118 ENDIF 119 ! diffusive layering indicators: 120 ! ! mskdl1=1 if 0< R <1; 0 elsewhere 121 IF( zrau(ji,jj) >= 1. ) THEN ; zmskd1(ji,jj) = 0._wp 122 ELSE ; zmskd1(ji,jj) = 1._wp 123 ENDIF 124 ! ! mskdl2=1 if 0< R <0.5; 0 elsewhere 125 IF( zrau(ji,jj) >= 0.5 ) THEN ; zmskd2(ji,jj) = 0._wp 126 ELSE ; zmskd2(ji,jj) = 1._wp 127 ENDIF 128 ! mskdl3=1 if 0.5< R <1; 0 elsewhere 129 IF( zrau(ji,jj) <= 0.5 .OR. zrau(ji,jj) >= 1. ) THEN ; zmskd3(ji,jj) = 0._wp 130 ELSE ; zmskd3(ji,jj) = 1._wp 131 ENDIF 132 END_2D 136 133 ! mask zmsk in order to have avt and avs masked 137 134 zmsks(:,:) = zmsks(:,:) * wmask(:,:,jk) … … 141 138 ! ------------------ 142 139 ! Constant eddy coefficient: reset to the background value 143 DO jj = 1, jpj 144 DO ji = 1, jpi 145 zinr = 1._wp / zrau(ji,jj) 146 ! salt fingering 147 zrr = zrau(ji,jj) / rn_hsbfr 148 zrr = zrr * zrr 149 zavfs = rn_avts / ( 1 + zrr*zrr*zrr ) * zmsks(ji,jj) * zmskf(ji,jj) 150 zavft = 0.7 * zavfs * zinr 151 ! diffusive layering 152 zavdt = 1.3635e-6 * EXP( 4.6 * EXP( -0.54*(zinr-1.) ) ) * zmsks(ji,jj) * zmskd1(ji,jj) 153 zavds = zavdt * zmsks(ji,jj) * ( ( 1.85 * zrau(ji,jj) - 0.85 ) * zmskd3(ji,jj) & 154 & + 0.15 * zrau(ji,jj) * zmskd2(ji,jj) ) 155 ! add to the eddy viscosity coef. previously computed 156 p_avs(ji,jj,jk) = p_avt(ji,jj,jk) + zavfs + zavds 157 p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zavft + zavdt 158 p_avm(ji,jj,jk) = p_avm(ji,jj,jk) + MAX( zavft + zavdt, zavfs + zavds ) 159 END DO 160 END DO 140 DO_2D_11_11 141 zinr = 1._wp / zrau(ji,jj) 142 ! salt fingering 143 zrr = zrau(ji,jj) / rn_hsbfr 144 zrr = zrr * zrr 145 zavfs = rn_avts / ( 1 + zrr*zrr*zrr ) * zmsks(ji,jj) * zmskf(ji,jj) 146 zavft = 0.7 * zavfs * zinr 147 ! diffusive layering 148 zavdt = 1.3635e-6 * EXP( 4.6 * EXP( -0.54*(zinr-1.) ) ) * zmsks(ji,jj) * zmskd1(ji,jj) 149 zavds = zavdt * zmsks(ji,jj) * ( ( 1.85 * zrau(ji,jj) - 0.85 ) * zmskd3(ji,jj) & 150 & + 0.15 * zrau(ji,jj) * zmskd2(ji,jj) ) 151 ! add to the eddy viscosity coef. previously computed 152 p_avs(ji,jj,jk) = p_avt(ji,jj,jk) + zavfs + zavds 153 p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zavft + zavdt 154 p_avm(ji,jj,jk) = p_avm(ji,jj,jk) + MAX( zavft + zavdt, zavfs + zavds ) 155 END_2D 161 156 ! ! =============== 162 157 END DO ! End of slab 163 158 ! ! =============== 164 159 ! 165 IF( ln_ctl) THEN160 IF(sn_cfctl%l_prtctl) THEN 166 161 CALL prt_ctl(tab3d_1=avt , clinfo1=' ddm - t: ', tab3d_2=avs , clinfo2=' s: ', kdim=jpk) 167 162 ENDIF -
NEMO/trunk/src/OCE/ZDF/zdfdrg.F90
r11536 r12377 73 73 74 74 !! * Substitutions 75 # include " vectopt_loop_substitute.h90"75 # include "do_loop_substitute.h90" 76 76 !!---------------------------------------------------------------------- 77 77 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 81 81 CONTAINS 82 82 83 SUBROUTINE zdf_drg( kt, k_mk, pCdmin, pCdmax, pz0, pke0, pCd0, & ! <<== in83 SUBROUTINE zdf_drg( kt, Kmm, k_mk, pCdmin, pCdmax, pz0, pke0, pCd0, & ! <<== in 84 84 & pCdU ) ! ==>> out : bottom drag [m/s] 85 85 !!---------------------------------------------------------------------- … … 99 99 !!---------------------------------------------------------------------- 100 100 INTEGER , INTENT(in ) :: kt ! ocean time-step index 101 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 101 102 ! ! !! !== top or bottom variables ==! 102 103 INTEGER , DIMENSION(:,:), INTENT(in ) :: k_mk ! wet level (1st or last) … … 114 115 ! 115 116 IF( l_log_not_linssh ) THEN !== "log layer" ==! compute Cd and -Cd*|U| 116 DO jj = 2, jpjm1 117 DO ji = 2, jpim1 118 imk = k_mk(ji,jj) ! ocean bottom level at t-points 119 zut = un(ji,jj,imk) + un(ji-1,jj,imk) ! 2 x velocity at t-point 120 zvt = vn(ji,jj,imk) + vn(ji,jj-1,imk) 121 zzz = 0.5_wp * e3t_n(ji,jj,imk) ! altitude below/above (top/bottom) the boundary 122 ! 117 DO_2D_00_00 118 imk = k_mk(ji,jj) ! ocean bottom level at t-points 119 zut = uu(ji,jj,imk,Kmm) + uu(ji-1,jj,imk,Kmm) ! 2 x velocity at t-point 120 zvt = vv(ji,jj,imk,Kmm) + vv(ji,jj-1,imk,Kmm) 121 zzz = 0.5_wp * e3t(ji,jj,imk,Kmm) ! altitude below/above (top/bottom) the boundary 122 ! 123 123 !!JC: possible WAD implementation should modify line below if layers vanish 124 zcd = ( vkarmn / LOG( zzz / pz0 ) )**2 125 zcd = pCd0(ji,jj) * MIN( MAX( pCdmin , zcd ) , pCdmax ) ! here pCd0 = mask*boost 126 pCdU(ji,jj) = - zcd * SQRT( 0.25 * ( zut*zut + zvt*zvt ) + pke0 ) 127 END DO 128 END DO 124 zcd = ( vkarmn / LOG( zzz / pz0 ) )**2 125 zcd = pCd0(ji,jj) * MIN( MAX( pCdmin , zcd ) , pCdmax ) ! here pCd0 = mask*boost 126 pCdU(ji,jj) = - zcd * SQRT( 0.25 * ( zut*zut + zvt*zvt ) + pke0 ) 127 END_2D 129 128 ELSE !== standard Cd ==! 130 DO jj = 2, jpjm1 131 DO ji = 2, jpim1 132 imk = k_mk(ji,jj) ! ocean bottom level at t-points 133 zut = un(ji,jj,imk) + un(ji-1,jj,imk) ! 2 x velocity at t-point 134 zvt = vn(ji,jj,imk) + vn(ji,jj-1,imk) 135 ! ! here pCd0 = mask*boost * drag 136 pCdU(ji,jj) = - pCd0(ji,jj) * SQRT( 0.25 * ( zut*zut + zvt*zvt ) + pke0 ) 137 END DO 138 END DO 139 ENDIF 140 ! 141 IF(ln_ctl) CALL prt_ctl( tab2d_1=pCdU, clinfo1=' Cd*U ') 129 DO_2D_00_00 130 imk = k_mk(ji,jj) ! ocean bottom level at t-points 131 zut = uu(ji,jj,imk,Kmm) + uu(ji-1,jj,imk,Kmm) ! 2 x velocity at t-point 132 zvt = vv(ji,jj,imk,Kmm) + vv(ji,jj-1,imk,Kmm) 133 ! ! here pCd0 = mask*boost * drag 134 pCdU(ji,jj) = - pCd0(ji,jj) * SQRT( 0.25 * ( zut*zut + zvt*zvt ) + pke0 ) 135 END_2D 136 ENDIF 137 ! 138 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=pCdU, clinfo1=' Cd*U ') 142 139 ! 143 140 END SUBROUTINE zdf_drg 144 141 145 142 146 SUBROUTINE zdf_drg_exp( kt, pub, pvb, pua, pva )143 SUBROUTINE zdf_drg_exp( kt, Kmm, pub, pvb, pua, pva ) 147 144 !!---------------------------------------------------------------------- 148 145 !! *** ROUTINE zdf_drg_exp *** … … 157 154 !!--------------------------------------------------------------------- 158 155 INTEGER , INTENT(in ) :: kt ! ocean time-step index 156 INTEGER , INTENT(in ) :: Kmm ! time level indices 159 157 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pub, pvb ! the two components of the before velocity 160 158 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pua, pva ! the two components of the velocity tendency … … 176 174 ENDIF 177 175 178 DO jj = 2, jpjm1 179 DO ji = 2, jpim1 180 ikbu = mbku(ji,jj) ! deepest wet ocean u- & v-levels 181 ikbv = mbkv(ji,jj) 176 DO_2D_00_00 177 ikbu = mbku(ji,jj) ! deepest wet ocean u- & v-levels 178 ikbv = mbkv(ji,jj) 179 ! 180 ! Apply stability criteria on absolute value : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt) 181 zCdu = 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / e3u(ji,jj,ikbu,Kmm) 182 zCdv = 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / e3v(ji,jj,ikbv,Kmm) 183 ! 184 pua(ji,jj,ikbu) = pua(ji,jj,ikbu) + MAX( zCdu , zm1_2dt ) * pub(ji,jj,ikbu) 185 pva(ji,jj,ikbv) = pva(ji,jj,ikbv) + MAX( zCdv , zm1_2dt ) * pvb(ji,jj,ikbv) 186 END_2D 187 ! 188 IF( ln_isfcav ) THEN ! ocean cavities 189 DO_2D_00_00 190 ikbu = miku(ji,jj) ! first wet ocean u- & v-levels 191 ikbv = mikv(ji,jj) 182 192 ! 183 193 ! Apply stability criteria on absolute value : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt) 184 zCdu = 0.5*( rCdU_ bot(ji+1,jj)+rCdU_bot(ji,jj) ) / e3u_n(ji,jj,ikbu)185 zCdv = 0.5*( rCdU_ bot(ji,jj+1)+rCdU_bot(ji,jj) ) / e3v_n(ji,jj,ikbv)194 zCdu = 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / e3u(ji,jj,ikbu,Kmm) ! NB: Cdtop masked 195 zCdv = 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / e3v(ji,jj,ikbv,Kmm) 186 196 ! 187 197 pua(ji,jj,ikbu) = pua(ji,jj,ikbu) + MAX( zCdu , zm1_2dt ) * pub(ji,jj,ikbu) 188 198 pva(ji,jj,ikbv) = pva(ji,jj,ikbv) + MAX( zCdv , zm1_2dt ) * pvb(ji,jj,ikbv) 189 END DO 190 END DO 191 ! 192 IF( ln_isfcav ) THEN ! ocean cavities 193 DO jj = 2, jpjm1 194 DO ji = 2, jpim1 195 ikbu = miku(ji,jj) ! first wet ocean u- & v-levels 196 ikbv = mikv(ji,jj) 197 ! 198 ! Apply stability criteria on absolute value : abs(bfr/e3) < 1/(2dt) => bfr/e3 > -1/(2dt) 199 zCdu = 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / e3u_n(ji,jj,ikbu) ! NB: Cdtop masked 200 zCdv = 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / e3v_n(ji,jj,ikbv) 201 ! 202 pua(ji,jj,ikbu) = pua(ji,jj,ikbu) + MAX( zCdu , zm1_2dt ) * pub(ji,jj,ikbu) 203 pva(ji,jj,ikbv) = pva(ji,jj,ikbv) + MAX( zCdv , zm1_2dt ) * pvb(ji,jj,ikbv) 204 END DO 205 END DO 199 END_2D 206 200 ENDIF 207 201 ! … … 209 203 ztrdu(:,:,:) = pua(:,:,:) - ztrdu(:,:,:) 210 204 ztrdv(:,:,:) = pva(:,:,:) - ztrdv(:,:,:) 211 CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt )205 CALL trd_dyn( ztrdu(:,:,:), ztrdv(:,:,:), jpdyn_bfr, kt, Kmm ) 212 206 DEALLOCATE( ztrdu, ztrdv ) 213 207 ENDIF 214 208 ! ! print mean trends (used for debugging) 215 IF( ln_ctl) CALL prt_ctl( tab3d_1=pua, clinfo1=' bfr - Ua: ', mask1=umask, &216 & tab3d_2=pva, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' )209 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pua, clinfo1=' bfr - Ua: ', mask1=umask, & 210 & tab3d_2=pva, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 217 211 ! 218 212 END SUBROUTINE zdf_drg_exp … … 236 230 ! !== drag nature ==! 237 231 ! 238 REWIND( numnam_ref ) ! Namelist namdrg in reference namelist239 232 READ ( numnam_ref, namdrg, IOSTAT = ios, ERR = 901) 240 233 901 IF( ios /= 0 ) CALL ctl_nam( ios , 'namdrg in reference namelist' ) 241 REWIND( numnam_cfg ) ! Namelist namdrg in configuration namelist242 234 READ ( numnam_cfg, namdrg, IOSTAT = ios, ERR = 902 ) 243 235 902 IF( ios > 0 ) CALL ctl_nam( ios , 'namdrg in configuration namelist' ) … … 335 327 ! !== read namlist ==! 336 328 ! 337 REWIND( numnam_ref ) ! Namelist cl_namdrg in reference namelist338 329 IF(ll_top) READ ( numnam_ref, namdrg_top, IOSTAT = ios, ERR = 901) 339 330 IF(ll_bot) READ ( numnam_ref, namdrg_bot, IOSTAT = ios, ERR = 901) 340 331 901 IF( ios /= 0 ) CALL ctl_nam( ios , TRIM(cl_namref) ) 341 REWIND( numnam_cfg ) ! Namelist cd_namdrg in configuration namelist342 332 IF(ll_top) READ ( numnam_cfg, namdrg_top, IOSTAT = ios, ERR = 902 ) 343 333 IF(ll_bot) READ ( numnam_cfg, namdrg_bot, IOSTAT = ios, ERR = 902 ) … … 431 421 l_log_not_linssh = .FALSE. !- don't update Cd at each time step 432 422 ! 433 DO jj = 1, jpj ! pCd0 = mask (and boosted) logarithmic drag coef. 434 DO ji = 1, jpi 435 zzz = 0.5_wp * e3t_0(ji,jj,k_mk(ji,jj)) 436 zcd = ( vkarmn / LOG( zzz / rn_z0 ) )**2 437 pCd0(ji,jj) = zmsk_boost(ji,jj) * MIN( MAX( rn_Cd0 , zcd ) , rn_Cdmax ) ! rn_Cd0 < Cd0 < rn_Cdmax 438 END DO 439 END DO 423 DO_2D_11_11 424 zzz = 0.5_wp * e3t_0(ji,jj,k_mk(ji,jj)) 425 zcd = ( vkarmn / LOG( zzz / rn_z0 ) )**2 426 pCd0(ji,jj) = zmsk_boost(ji,jj) * MIN( MAX( rn_Cd0 , zcd ) , rn_Cdmax ) ! rn_Cd0 < Cd0 < rn_Cdmax 427 END_2D 440 428 ELSE !* Cd updated at each time-step ==> pCd0 = mask * boost 441 429 IF(lwp) WRITE(numout,*) -
NEMO/trunk/src/OCE/ZDF/zdfevd.F90
r10068 r12377 31 31 PUBLIC zdf_evd ! called by step.F90 32 32 33 !! * Substitutions 34 # include "do_loop_substitute.h90" 33 35 !!---------------------------------------------------------------------- 34 36 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 38 40 CONTAINS 39 41 40 SUBROUTINE zdf_evd( kt, p_avm, p_avt )42 SUBROUTINE zdf_evd( kt, Kmm, Krhs, p_avm, p_avt ) 41 43 !!---------------------------------------------------------------------- 42 44 !! *** ROUTINE zdf_evd *** … … 56 58 !!---------------------------------------------------------------------- 57 59 INTEGER , INTENT(in ) :: kt ! ocean time-step indexocean time step 60 INTEGER , INTENT(in ) :: Kmm, Krhs ! time level indices 58 61 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: p_avm, p_avt ! momentum and tracer Kz (w-points) 59 62 ! … … 84 87 ! END WHERE 85 88 ! 86 DO jk = 1, jpkm1 87 DO jj = 2, jpjm1 88 DO ji = 2, jpim1 89 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN 90 p_avt(ji,jj,jk) = rn_evd * wmask(ji,jj,jk) 91 p_avm(ji,jj,jk) = rn_evd * wmask(ji,jj,jk) 92 ENDIF 93 END DO 94 END DO 95 END DO 89 DO_3D_00_00( 1, jpkm1 ) 90 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN 91 p_avt(ji,jj,jk) = rn_evd * wmask(ji,jj,jk) 92 p_avm(ji,jj,jk) = rn_evd * wmask(ji,jj,jk) 93 ENDIF 94 END_3D 96 95 ! 97 96 zavm_evd(:,:,:) = p_avm(:,:,:) - zavm_evd(:,:,:) ! change in avm due to evd … … 104 103 ! END WHERE 105 104 106 DO jk = 1, jpkm1 107 DO jj = 2, jpjm1 108 DO ji = 2, jpim1 109 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) & 110 p_avt(ji,jj,jk) = rn_evd * wmask(ji,jj,jk) 111 END DO 112 END DO 113 END DO 105 DO_3D_00_00( 1, jpkm1 ) 106 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) & 107 p_avt(ji,jj,jk) = rn_evd * wmask(ji,jj,jk) 108 END_3D 114 109 ! 115 110 END SELECT … … 117 112 zavt_evd(:,:,:) = p_avt(:,:,:) - zavt_evd(:,:,:) ! change in avt due to evd 118 113 CALL iom_put( "avt_evd", zavt_evd ) ! output this change 119 IF( l_trdtra ) CALL trd_tra( kt, 'TRA', jp_tem, jptra_evd, zavt_evd )114 IF( l_trdtra ) CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_evd, zavt_evd ) 120 115 ! 121 116 END SUBROUTINE zdf_evd -
NEMO/trunk/src/OCE/ZDF/zdfgls.F90
r11536 r12377 104 104 105 105 !! * Substitutions 106 # include " vectopt_loop_substitute.h90"106 # include "do_loop_substitute.h90" 107 107 !!---------------------------------------------------------------------- 108 108 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 124 124 125 125 126 SUBROUTINE zdf_gls( kt, p_sh2, p_avm, p_avt )126 SUBROUTINE zdf_gls( kt, Kbb, Kmm, p_sh2, p_avm, p_avt ) 127 127 !!---------------------------------------------------------------------- 128 128 !! *** ROUTINE zdf_gls *** … … 134 134 !! 135 135 INTEGER , INTENT(in ) :: kt ! ocean time step 136 INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level indices 136 137 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: p_sh2 ! shear production term 137 138 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: p_avm, p_avt ! momentum and tracer Kz (w-points) … … 166 167 167 168 ! 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 172 ustar2_surf(ji,jj) = r1_rau0 * taum(ji,jj) * tmask(ji,jj,1) 173 ! 169 DO_2D_00_00 170 ! 171 ! surface friction 172 ustar2_surf(ji,jj) = r1_rau0 * taum(ji,jj) * tmask(ji,jj,1) 173 ! 174 174 !!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 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*( uu(ji,jj,mbkt(ji,jj),Kbb)+uu(ji-1,jj,mbkt(ji,jj),Kbb) ) )**2 & 179 & + ( zmskv*( vv(ji,jj,mbkt(ji,jj),Kbb)+vv(ji,jj-1,mbkt(ji,jj),Kbb) ) )**2 ) 180 END_2D 182 181 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 182 DO_2D_00_00 183 zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 184 zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) ) ! (CAUTION: CdU<0) 185 ustar2_top(ji,jj) = - rCdU_top(ji,jj) * SQRT( ( zmsku*( uu(ji,jj,mikt(ji,jj),Kbb)+uu(ji-1,jj,mikt(ji,jj),Kbb) ) )**2 & 186 & + ( zmskv*( vv(ji,jj,mikt(ji,jj),Kbb)+vv(ji,jj-1,mikt(ji,jj),Kbb) ) )**2 ) 187 END_2D 191 188 ENDIF 192 189 … … 206 203 END SELECT 207 204 ! 208 DO jk = 2, jpkm1 !== Compute dissipation rate ==! 209 DO jj = 1, jpjm1 210 DO ji = 1, jpim1 211 eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / hmxl_n(ji,jj,jk) 212 END DO 213 END DO 214 END DO 205 DO_3D_10_10( 2, jpkm1 ) 206 eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / hmxl_n(ji,jj,jk) 207 END_3D 215 208 216 209 ! Save tke at before time step … … 219 212 220 213 IF( nn_clos == 0 ) THEN ! Mellor-Yamada 221 DO jk = 2, jpkm1 222 DO jj = 2, jpjm1 223 DO ji = fs_2, fs_jpim1 ! vector opt. 224 zup = hmxl_n(ji,jj,jk) * gdepw_n(ji,jj,mbkt(ji,jj)+1) 225 zdown = vkarmn * gdepw_n(ji,jj,jk) * ( -gdepw_n(ji,jj,jk) + gdepw_n(ji,jj,mbkt(ji,jj)+1) ) 226 zcoef = ( zup / MAX( zdown, rsmall ) ) 227 zwall (ji,jj,jk) = ( 1._wp + re2 * zcoef*zcoef ) * tmask(ji,jj,jk) 228 END DO 229 END DO 230 END DO 214 DO_3D_00_00( 2, jpkm1 ) 215 zup = hmxl_n(ji,jj,jk) * gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) 216 zdown = vkarmn * gdepw(ji,jj,jk,Kmm) * ( -gdepw(ji,jj,jk,Kmm) + gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) ) 217 zcoef = ( zup / MAX( zdown, rsmall ) ) 218 zwall (ji,jj,jk) = ( 1._wp + re2 * zcoef*zcoef ) * tmask(ji,jj,jk) 219 END_3D 231 220 ENDIF 232 221 … … 244 233 ! Warning : after this step, en : right hand side of the matrix 245 234 246 DO jk = 2, jpkm1 247 DO jj = 2, jpjm1 248 DO ji = 2, jpim1 249 ! 250 buoy = - p_avt(ji,jj,jk) * rn2(ji,jj,jk) ! stratif. destruction 251 ! 252 diss = eps(ji,jj,jk) ! dissipation 253 ! 254 zdir = 0.5_wp + SIGN( 0.5_wp, p_sh2(ji,jj,jk) + buoy ) ! zdir =1(=0) if shear(ji,jj,jk)+buoy >0(<0) 255 ! 256 zesh2 = zdir*(p_sh2(ji,jj,jk)+buoy)+(1._wp-zdir)*p_sh2(ji,jj,jk) ! production term 257 zdiss = zdir*(diss/en(ji,jj,jk)) +(1._wp-zdir)*(diss-buoy)/en(ji,jj,jk) ! dissipation term 235 DO_3D_00_00( 2, jpkm1 ) 236 ! 237 buoy = - p_avt(ji,jj,jk) * rn2(ji,jj,jk) ! stratif. destruction 238 ! 239 diss = eps(ji,jj,jk) ! dissipation 240 ! 241 zdir = 0.5_wp + SIGN( 0.5_wp, p_sh2(ji,jj,jk) + buoy ) ! zdir =1(=0) if shear(ji,jj,jk)+buoy >0(<0) 242 ! 243 zesh2 = zdir*(p_sh2(ji,jj,jk)+buoy)+(1._wp-zdir)*p_sh2(ji,jj,jk) ! production term 244 zdiss = zdir*(diss/en(ji,jj,jk)) +(1._wp-zdir)*(diss-buoy)/en(ji,jj,jk) ! dissipation term 258 245 !!gm better coding, identical results 259 246 ! zesh2 = p_sh2(ji,jj,jk) + zdir*buoy ! production term 260 247 ! zdiss = ( diss - (1._wp-zdir)*buoy ) / en(ji,jj,jk) ! dissipation term 261 248 !!gm 262 ! 263 ! Compute a wall function from 1. to rsc_psi*zwall/rsc_psi0 264 ! Note that as long that Dirichlet boundary conditions are NOT set at the first and last levels (GOTM style) 265 ! there is no need to set a boundary condition for zwall_psi at the top and bottom boundaries. 266 ! Otherwise, this should be rsc_psi/rsc_psi0 267 IF( ln_sigpsi ) THEN 268 zsigpsi = MIN( 1._wp, zesh2 / eps(ji,jj,jk) ) ! 0. <= zsigpsi <= 1. 269 zwall_psi(ji,jj,jk) = rsc_psi / & 270 & ( zsigpsi * rsc_psi + (1._wp-zsigpsi) * rsc_psi0 / MAX( zwall(ji,jj,jk), 1._wp ) ) 271 ELSE 272 zwall_psi(ji,jj,jk) = 1._wp 273 ENDIF 274 ! 275 ! building the matrix 276 zcof = rfact_tke * tmask(ji,jj,jk) 277 ! ! lower diagonal, in fact not used for jk = 2 (see surface conditions) 278 zd_lw(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk ) + p_avm(ji,jj,jk-1) ) / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk) ) 279 ! ! upper diagonal, in fact not used for jk = ibotm1 (see bottom conditions) 280 zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk ) ) / ( e3t_n(ji,jj,jk ) * e3w_n(ji,jj,jk) ) 281 ! ! diagonal 282 zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) + rdt * zdiss * wmask(ji,jj,jk) 283 ! ! right hand side in en 284 en(ji,jj,jk) = en(ji,jj,jk) + rdt * zesh2 * wmask(ji,jj,jk) 285 END DO 286 END DO 287 END DO 249 ! 250 ! Compute a wall function from 1. to rsc_psi*zwall/rsc_psi0 251 ! Note that as long that Dirichlet boundary conditions are NOT set at the first and last levels (GOTM style) 252 ! there is no need to set a boundary condition for zwall_psi at the top and bottom boundaries. 253 ! Otherwise, this should be rsc_psi/rsc_psi0 254 IF( ln_sigpsi ) THEN 255 zsigpsi = MIN( 1._wp, zesh2 / eps(ji,jj,jk) ) ! 0. <= zsigpsi <= 1. 256 zwall_psi(ji,jj,jk) = rsc_psi / & 257 & ( zsigpsi * rsc_psi + (1._wp-zsigpsi) * rsc_psi0 / MAX( zwall(ji,jj,jk), 1._wp ) ) 258 ELSE 259 zwall_psi(ji,jj,jk) = 1._wp 260 ENDIF 261 ! 262 ! building the matrix 263 zcof = rfact_tke * tmask(ji,jj,jk) 264 ! ! lower diagonal, in fact not used for jk = 2 (see surface conditions) 265 zd_lw(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk ) + p_avm(ji,jj,jk-1) ) / ( e3t(ji,jj,jk-1,Kmm) * e3w(ji,jj,jk,Kmm) ) 266 ! ! upper diagonal, in fact not used for jk = ibotm1 (see bottom conditions) 267 zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk ) ) / ( e3t(ji,jj,jk ,Kmm) * e3w(ji,jj,jk,Kmm) ) 268 ! ! diagonal 269 zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) + rdt * zdiss * wmask(ji,jj,jk) 270 ! ! right hand side in en 271 en(ji,jj,jk) = en(ji,jj,jk) + rdt * zesh2 * wmask(ji,jj,jk) 272 END_3D 288 273 ! 289 274 zdiag(:,:,jpk) = 1._wp … … 306 291 ! 307 292 ! One level below 308 en (:,:,2) = MAX( rc02r * ustar2_surf(:,:) * ( 1._wp + rsbc_tke1 * ((zhsro(:,:)+gdepw _n(:,:,2)) &293 en (:,:,2) = MAX( rc02r * ustar2_surf(:,:) * ( 1._wp + rsbc_tke1 * ((zhsro(:,:)+gdepw(:,:,2,Kmm)) & 309 294 & / zhsro(:,:) )**(1.5_wp*ra_sf) )**(2._wp/3._wp) , rn_emin ) 310 295 zd_lw(:,:,2) = 0._wp … … 325 310 zdiag(:,:,2) = zdiag(:,:,2) + zd_lw(:,:,2) ! Remove zd_lw from zdiag 326 311 zd_lw(:,:,2) = 0._wp 327 zkar (:,:) = (rl_sf + (vkarmn-rl_sf)*(1.-EXP(-rtrans*gdept _n(:,:,1)/zhsro(:,:)) ))312 zkar (:,:) = (rl_sf + (vkarmn-rl_sf)*(1.-EXP(-rtrans*gdept(:,:,1,Kmm)/zhsro(:,:)) )) 328 313 zflxs(:,:) = rsbc_tke2 * ustar2_surf(:,:)**1.5_wp * zkar(:,:) & 329 & * ( ( zhsro(:,:)+gdept _n(:,:,1) ) / zhsro(:,:) )**(1.5_wp*ra_sf)330 !!gm why not : * ( 1._wp + gdept _n(:,:,1) / zhsro(:,:) )**(1.5_wp*ra_sf)331 en(:,:,2) = en(:,:,2) + zflxs(:,:) / e3w _n(:,:,2)314 & * ( ( zhsro(:,:)+gdept(:,:,1,Kmm) ) / zhsro(:,:) )**(1.5_wp*ra_sf) 315 !!gm why not : * ( 1._wp + gdept(:,:,1,Kmm) / zhsro(:,:) )**(1.5_wp*ra_sf) 316 en(:,:,2) = en(:,:,2) + zflxs(:,:) / e3w(:,:,2,Kmm) 332 317 ! 333 318 ! … … 342 327 ! ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = rn_lmin 343 328 ! ! Balance between the production and the dissipation terms 344 DO jj = 2, jpjm1 345 DO ji = fs_2, fs_jpim1 ! vector opt. 329 DO_2D_00_00 346 330 !!gm This means that bottom and ocean w-level above have a specified "en" value. Sure ???? 347 331 !! With thick deep ocean level thickness, this may be quite large, no ??? 348 332 !! in particular in ocean cavities where top stratification can be large... 349 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point 350 ibotm1 = mbkt(ji,jj) ! k-1 bottom level of w-point but >=1 333 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point 334 ibotm1 = mbkt(ji,jj) ! k-1 bottom level of w-point but >=1 335 ! 336 z_en = MAX( rc02r * ustar2_bot(ji,jj), rn_emin ) 337 ! 338 ! Dirichlet condition applied at: 339 ! Bottom level (ibot) & Just above it (ibotm1) 340 zd_lw(ji,jj,ibot) = 0._wp ; zd_lw(ji,jj,ibotm1) = 0._wp 341 zd_up(ji,jj,ibot) = 0._wp ; zd_up(ji,jj,ibotm1) = 0._wp 342 zdiag(ji,jj,ibot) = 1._wp ; zdiag(ji,jj,ibotm1) = 1._wp 343 en (ji,jj,ibot) = z_en ; en (ji,jj,ibotm1) = z_en 344 END_2D 345 ! 346 IF( ln_isfcav) THEN ! top boundary (ocean cavity) 347 DO_2D_00_00 348 itop = mikt(ji,jj) ! k top w-point 349 itopp1 = mikt(ji,jj) + 1 ! k+1 1st w-point below the top one 350 ! ! mask at the ocean surface points 351 z_en = MAX( rc02r * ustar2_top(ji,jj), rn_emin ) * ( 1._wp - tmask(ji,jj,1) ) 351 352 ! 352 z_en = MAX( rc02r * ustar2_bot(ji,jj), rn_emin ) 353 ! 353 !!gm TO BE VERIFIED !!! 354 354 ! Dirichlet condition applied at: 355 ! Bottom level (ibot) & Just above it (ibotm1) 356 zd_lw(ji,jj,ibot) = 0._wp ; zd_lw(ji,jj,ibotm1) = 0._wp 357 zd_up(ji,jj,ibot) = 0._wp ; zd_up(ji,jj,ibotm1) = 0._wp 358 zdiag(ji,jj,ibot) = 1._wp ; zdiag(ji,jj,ibotm1) = 1._wp 359 en (ji,jj,ibot) = z_en ; en (ji,jj,ibotm1) = z_en 360 END DO 361 END DO 362 ! 363 IF( ln_isfcav) THEN ! top boundary (ocean cavity) 364 DO jj = 2, jpjm1 365 DO ji = fs_2, fs_jpim1 ! vector opt. 366 itop = mikt(ji,jj) ! k top w-point 367 itopp1 = mikt(ji,jj) + 1 ! k+1 1st w-point below the top one 368 ! ! mask at the ocean surface points 369 z_en = MAX( rc02r * ustar2_top(ji,jj), rn_emin ) * ( 1._wp - tmask(ji,jj,1) ) 370 ! 371 !!gm TO BE VERIFIED !!! 372 ! Dirichlet condition applied at: 373 ! top level (itop) & Just below it (itopp1) 374 zd_lw(ji,jj,itop) = 0._wp ; zd_lw(ji,jj,itopp1) = 0._wp 375 zd_up(ji,jj,itop) = 0._wp ; zd_up(ji,jj,itopp1) = 0._wp 376 zdiag(ji,jj,itop) = 1._wp ; zdiag(ji,jj,itopp1) = 1._wp 377 en (ji,jj,itop) = z_en ; en (ji,jj,itopp1) = z_en 378 END DO 379 END DO 355 ! top level (itop) & Just below it (itopp1) 356 zd_lw(ji,jj,itop) = 0._wp ; zd_lw(ji,jj,itopp1) = 0._wp 357 zd_up(ji,jj,itop) = 0._wp ; zd_up(ji,jj,itopp1) = 0._wp 358 zdiag(ji,jj,itop) = 1._wp ; zdiag(ji,jj,itopp1) = 1._wp 359 en (ji,jj,itop) = z_en ; en (ji,jj,itopp1) = z_en 360 END_2D 380 361 ENDIF 381 362 ! 382 363 CASE ( 1 ) ! Neumman boundary condition 383 364 ! 384 DO jj = 2, jpjm1 385 DO ji = fs_2, fs_jpim1 ! vector opt. 386 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point 387 ibotm1 = mbkt(ji,jj) ! k-1 bottom level of w-point but >=1 388 ! 389 z_en = MAX( rc02r * ustar2_bot(ji,jj), rn_emin ) 365 DO_2D_00_00 366 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point 367 ibotm1 = mbkt(ji,jj) ! k-1 bottom level of w-point but >=1 368 ! 369 z_en = MAX( rc02r * ustar2_bot(ji,jj), rn_emin ) 370 ! 371 ! Bottom level Dirichlet condition: 372 ! Bottom level (ibot) & Just above it (ibotm1) 373 ! Dirichlet ! Neumann 374 zd_lw(ji,jj,ibot) = 0._wp ! ! Remove zd_up from zdiag 375 zdiag(ji,jj,ibot) = 1._wp ; zdiag(ji,jj,ibotm1) = zdiag(ji,jj,ibotm1) + zd_up(ji,jj,ibotm1) 376 zd_up(ji,jj,ibot) = 0._wp ; zd_up(ji,jj,ibotm1) = 0._wp 377 END_2D 378 IF( ln_isfcav) THEN ! top boundary (ocean cavity) 379 DO_2D_00_00 380 itop = mikt(ji,jj) ! k top w-point 381 itopp1 = mikt(ji,jj) + 1 ! k+1 1st w-point below the top one 382 ! ! mask at the ocean surface points 383 z_en = MAX( rc02r * ustar2_top(ji,jj), rn_emin ) * ( 1._wp - tmask(ji,jj,1) ) 390 384 ! 391 385 ! Bottom level Dirichlet condition: 392 386 ! Bottom level (ibot) & Just above it (ibotm1) 393 387 ! Dirichlet ! Neumann 394 zd_lw(ji,jj,ibot) = 0._wp ! ! Remove zd_up from zdiag 395 zdiag(ji,jj,ibot) = 1._wp ; zdiag(ji,jj,ibotm1) = zdiag(ji,jj,ibotm1) + zd_up(ji,jj,ibotm1) 396 zd_up(ji,jj,ibot) = 0._wp ; zd_up(ji,jj,ibotm1) = 0._wp 397 END DO 398 END DO 399 IF( ln_isfcav) THEN ! top boundary (ocean cavity) 400 DO jj = 2, jpjm1 401 DO ji = fs_2, fs_jpim1 ! vector opt. 402 itop = mikt(ji,jj) ! k top w-point 403 itopp1 = mikt(ji,jj) + 1 ! k+1 1st w-point below the top one 404 ! ! mask at the ocean surface points 405 z_en = MAX( rc02r * ustar2_top(ji,jj), rn_emin ) * ( 1._wp - tmask(ji,jj,1) ) 406 ! 407 ! Bottom level Dirichlet condition: 408 ! Bottom level (ibot) & Just above it (ibotm1) 409 ! Dirichlet ! Neumann 410 zd_lw(ji,jj,itop) = 0._wp ! ! Remove zd_up from zdiag 411 zdiag(ji,jj,itop) = 1._wp ; zdiag(ji,jj,itopp1) = zdiag(ji,jj,itopp1) + zd_up(ji,jj,itopp1) 412 zd_up(ji,jj,itop) = 0._wp ; zd_up(ji,jj,itopp1) = 0._wp 413 END DO 414 END DO 388 zd_lw(ji,jj,itop) = 0._wp ! ! Remove zd_up from zdiag 389 zdiag(ji,jj,itop) = 1._wp ; zdiag(ji,jj,itopp1) = zdiag(ji,jj,itopp1) + zd_up(ji,jj,itopp1) 390 zd_up(ji,jj,itop) = 0._wp ; zd_up(ji,jj,itopp1) = 0._wp 391 END_2D 415 392 ENDIF 416 393 ! … … 420 397 ! ---------------------------------------------------------- 421 398 ! 422 DO jk = 2, jpkm1 ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 423 DO jj = 2, jpjm1 424 DO ji = fs_2, fs_jpim1 ! vector opt. 425 zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 426 END DO 427 END DO 428 END DO 429 DO jk = 2, jpk ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 430 DO jj = 2, jpjm1 431 DO ji = fs_2, fs_jpim1 ! vector opt. 432 zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1) 433 END DO 434 END DO 435 END DO 436 DO jk = jpk-1, 2, -1 ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 437 DO jj = 2, jpjm1 438 DO ji = fs_2, fs_jpim1 ! vector opt. 439 en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 440 END DO 441 END DO 442 END DO 399 DO_3D_00_00( 2, jpkm1 ) 400 zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 401 END_3D 402 DO_3D_00_00( 2, jpk ) 403 zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1) 404 END_3D 405 DO_3DS_00_00( jpk-1, 2, -1 ) 406 en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 407 END_3D 443 408 ! ! set the minimum value of tke 444 409 en(:,:,:) = MAX( en(:,:,:), rn_emin ) … … 453 418 ! 454 419 CASE( 0 ) ! k-kl (Mellor-Yamada) 455 DO jk = 2, jpkm1 456 DO jj = 2, jpjm1 457 DO ji = fs_2, fs_jpim1 ! vector opt. 458 psi(ji,jj,jk) = eb(ji,jj,jk) * hmxl_b(ji,jj,jk) 459 END DO 460 END DO 461 END DO 420 DO_3D_00_00( 2, jpkm1 ) 421 psi(ji,jj,jk) = eb(ji,jj,jk) * hmxl_b(ji,jj,jk) 422 END_3D 462 423 ! 463 424 CASE( 1 ) ! k-eps 464 DO jk = 2, jpkm1 465 DO jj = 2, jpjm1 466 DO ji = fs_2, fs_jpim1 ! vector opt. 467 psi(ji,jj,jk) = eps(ji,jj,jk) 468 END DO 469 END DO 470 END DO 425 DO_3D_00_00( 2, jpkm1 ) 426 psi(ji,jj,jk) = eps(ji,jj,jk) 427 END_3D 471 428 ! 472 429 CASE( 2 ) ! k-w 473 DO jk = 2, jpkm1 474 DO jj = 2, jpjm1 475 DO ji = fs_2, fs_jpim1 ! vector opt. 476 psi(ji,jj,jk) = SQRT( eb(ji,jj,jk) ) / ( rc0 * hmxl_b(ji,jj,jk) ) 477 END DO 478 END DO 479 END DO 430 DO_3D_00_00( 2, jpkm1 ) 431 psi(ji,jj,jk) = SQRT( eb(ji,jj,jk) ) / ( rc0 * hmxl_b(ji,jj,jk) ) 432 END_3D 480 433 ! 481 434 CASE( 3 ) ! generic 482 DO jk = 2, jpkm1 483 DO jj = 2, jpjm1 484 DO ji = fs_2, fs_jpim1 ! vector opt. 485 psi(ji,jj,jk) = rc02 * eb(ji,jj,jk) * hmxl_b(ji,jj,jk)**rnn 486 END DO 487 END DO 488 END DO 435 DO_3D_00_00( 2, jpkm1 ) 436 psi(ji,jj,jk) = rc02 * eb(ji,jj,jk) * hmxl_b(ji,jj,jk)**rnn 437 END_3D 489 438 ! 490 439 END SELECT … … 497 446 ! Warning : after this step, en : right hand side of the matrix 498 447 499 DO jk = 2, jpkm1 500 DO jj = 2, jpjm1 501 DO ji = fs_2, fs_jpim1 ! vector opt. 502 ! 503 ! psi / k 504 zratio = psi(ji,jj,jk) / eb(ji,jj,jk) 505 ! 506 ! psi3+ : stable : B=-KhN²<0 => N²>0 if rn2>0 zdir = 1 (stable) otherwise zdir = 0 (unstable) 507 zdir = 0.5_wp + SIGN( 0.5_wp, rn2(ji,jj,jk) ) 508 ! 509 rpsi3 = zdir * rpsi3m + ( 1._wp - zdir ) * rpsi3p 510 ! 511 ! shear prod. - stratif. destruction 512 prod = rpsi1 * zratio * p_sh2(ji,jj,jk) 513 ! 514 ! stratif. destruction 515 buoy = rpsi3 * zratio * (- p_avt(ji,jj,jk) * rn2(ji,jj,jk) ) 516 ! 517 ! shear prod. - stratif. destruction 518 diss = rpsi2 * zratio * zwall(ji,jj,jk) * eps(ji,jj,jk) 519 ! 520 zdir = 0.5_wp + SIGN( 0.5_wp, prod + buoy ) ! zdir =1(=0) if shear(ji,jj,jk)+buoy >0(<0) 521 ! 522 zesh2 = zdir * ( prod + buoy ) + (1._wp - zdir ) * prod ! production term 523 zdiss = zdir * ( diss / psi(ji,jj,jk) ) + (1._wp - zdir ) * (diss-buoy) / psi(ji,jj,jk) ! dissipation term 524 ! 525 ! building the matrix 526 zcof = rfact_psi * zwall_psi(ji,jj,jk) * tmask(ji,jj,jk) 527 ! ! lower diagonal 528 zd_lw(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk ) + p_avm(ji,jj,jk-1) ) / ( e3t_n(ji,jj,jk-1) * e3w_n(ji,jj,jk) ) 529 ! ! upper diagonal 530 zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk ) ) / ( e3t_n(ji,jj,jk ) * e3w_n(ji,jj,jk) ) 531 ! ! diagonal 532 zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) + rdt * zdiss * wmask(ji,jj,jk) 533 ! ! right hand side in psi 534 psi(ji,jj,jk) = psi(ji,jj,jk) + rdt * zesh2 * wmask(ji,jj,jk) 535 END DO 536 END DO 537 END DO 448 DO_3D_00_00( 2, jpkm1 ) 449 ! 450 ! psi / k 451 zratio = psi(ji,jj,jk) / eb(ji,jj,jk) 452 ! 453 ! psi3+ : stable : B=-KhN²<0 => N²>0 if rn2>0 zdir = 1 (stable) otherwise zdir = 0 (unstable) 454 zdir = 0.5_wp + SIGN( 0.5_wp, rn2(ji,jj,jk) ) 455 ! 456 rpsi3 = zdir * rpsi3m + ( 1._wp - zdir ) * rpsi3p 457 ! 458 ! shear prod. - stratif. destruction 459 prod = rpsi1 * zratio * p_sh2(ji,jj,jk) 460 ! 461 ! stratif. destruction 462 buoy = rpsi3 * zratio * (- p_avt(ji,jj,jk) * rn2(ji,jj,jk) ) 463 ! 464 ! shear prod. - stratif. destruction 465 diss = rpsi2 * zratio * zwall(ji,jj,jk) * eps(ji,jj,jk) 466 ! 467 zdir = 0.5_wp + SIGN( 0.5_wp, prod + buoy ) ! zdir =1(=0) if shear(ji,jj,jk)+buoy >0(<0) 468 ! 469 zesh2 = zdir * ( prod + buoy ) + (1._wp - zdir ) * prod ! production term 470 zdiss = zdir * ( diss / psi(ji,jj,jk) ) + (1._wp - zdir ) * (diss-buoy) / psi(ji,jj,jk) ! dissipation term 471 ! 472 ! building the matrix 473 zcof = rfact_psi * zwall_psi(ji,jj,jk) * tmask(ji,jj,jk) 474 ! ! lower diagonal 475 zd_lw(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk ) + p_avm(ji,jj,jk-1) ) / ( e3t(ji,jj,jk-1,Kmm) * e3w(ji,jj,jk,Kmm) ) 476 ! ! upper diagonal 477 zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk ) ) / ( e3t(ji,jj,jk ,Kmm) * e3w(ji,jj,jk,Kmm) ) 478 ! ! diagonal 479 zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) + rdt * zdiss * wmask(ji,jj,jk) 480 ! ! right hand side in psi 481 psi(ji,jj,jk) = psi(ji,jj,jk) + rdt * zesh2 * wmask(ji,jj,jk) 482 END_3D 538 483 ! 539 484 zdiag(:,:,jpk) = 1._wp … … 554 499 ! 555 500 ! One level below 556 zkar (:,:) = (rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdepw _n(:,:,2)/zhsro(:,:) )))557 zdep (:,:) = (zhsro(:,:) + gdepw _n(:,:,2)) * zkar(:,:)501 zkar (:,:) = (rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdepw(:,:,2,Kmm)/zhsro(:,:) ))) 502 zdep (:,:) = (zhsro(:,:) + gdepw(:,:,2,Kmm)) * zkar(:,:) 558 503 psi (:,:,2) = rc0**rpp * en(:,:,2)**rmm * zdep(:,:)**rnn * tmask(:,:,1) 559 504 zd_lw(:,:,2) = 0._wp … … 575 520 ! 576 521 ! Set psi vertical flux at the surface: 577 zkar (:,:) = rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdept _n(:,:,1)/zhsro(:,:) )) ! Lengh scale slope578 zdep (:,:) = ((zhsro(:,:) + gdept _n(:,:,1)) / zhsro(:,:))**(rmm*ra_sf)522 zkar (:,:) = rl_sf + (vkarmn-rl_sf)*(1._wp-EXP(-rtrans*gdept(:,:,1,Kmm)/zhsro(:,:) )) ! Lengh scale slope 523 zdep (:,:) = ((zhsro(:,:) + gdept(:,:,1,Kmm)) / zhsro(:,:))**(rmm*ra_sf) 579 524 zflxs(:,:) = (rnn + rsbc_tke1 * (rnn + rmm*ra_sf) * zdep(:,:))*(1._wp + rsbc_tke1*zdep(:,:))**(2._wp*rmm/3._wp-1_wp) 580 525 zdep (:,:) = rsbc_psi1 * (zwall_psi(:,:,1)*p_avm(:,:,1)+zwall_psi(:,:,2)*p_avm(:,:,2)) * & 581 & ustar2_surf(:,:)**rmm * zkar(:,:)**rnn * (zhsro(:,:) + gdept _n(:,:,1))**(rnn-1.)526 & ustar2_surf(:,:)**rmm * zkar(:,:)**rnn * (zhsro(:,:) + gdept(:,:,1,Kmm))**(rnn-1.) 582 527 zflxs(:,:) = zdep(:,:) * zflxs(:,:) 583 psi (:,:,2) = psi(:,:,2) + zflxs(:,:) / e3w _n(:,:,2)528 psi (:,:,2) = psi(:,:,2) + zflxs(:,:) / e3w(:,:,2,Kmm) 584 529 ! 585 530 END SELECT … … 596 541 ! ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = vkarmn * r_z0_bot 597 542 ! ! Balance between the production and the dissipation terms 598 DO jj = 2, jpjm1 599 DO ji = fs_2, fs_jpim1 ! vector opt. 600 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point 601 ibotm1 = mbkt(ji,jj) ! k-1 bottom level of w-point but >=1 602 zdep(ji,jj) = vkarmn * r_z0_bot 603 psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn 604 zd_lw(ji,jj,ibot) = 0._wp 605 zd_up(ji,jj,ibot) = 0._wp 606 zdiag(ji,jj,ibot) = 1._wp 607 ! 608 ! Just above last level, Dirichlet condition again (GOTM like) 609 zdep(ji,jj) = vkarmn * ( r_z0_bot + e3t_n(ji,jj,ibotm1) ) 610 psi (ji,jj,ibotm1) = rc0**rpp * en(ji,jj,ibot )**rmm * zdep(ji,jj)**rnn 611 zd_lw(ji,jj,ibotm1) = 0._wp 612 zd_up(ji,jj,ibotm1) = 0._wp 613 zdiag(ji,jj,ibotm1) = 1._wp 614 END DO 615 END DO 543 DO_2D_00_00 544 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point 545 ibotm1 = mbkt(ji,jj) ! k-1 bottom level of w-point but >=1 546 zdep(ji,jj) = vkarmn * r_z0_bot 547 psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn 548 zd_lw(ji,jj,ibot) = 0._wp 549 zd_up(ji,jj,ibot) = 0._wp 550 zdiag(ji,jj,ibot) = 1._wp 551 ! 552 ! Just above last level, Dirichlet condition again (GOTM like) 553 zdep(ji,jj) = vkarmn * ( r_z0_bot + e3t(ji,jj,ibotm1,Kmm) ) 554 psi (ji,jj,ibotm1) = rc0**rpp * en(ji,jj,ibot )**rmm * zdep(ji,jj)**rnn 555 zd_lw(ji,jj,ibotm1) = 0._wp 556 zd_up(ji,jj,ibotm1) = 0._wp 557 zdiag(ji,jj,ibotm1) = 1._wp 558 END_2D 616 559 ! 617 560 CASE ( 1 ) ! Neumman boundary condition 618 561 ! 619 DO jj = 2, jpjm1 620 DO ji = fs_2, fs_jpim1 ! vector opt. 621 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point 622 ibotm1 = mbkt(ji,jj) ! k-1 bottom level of w-point but >=1 623 ! 624 ! Bottom level Dirichlet condition: 625 zdep(ji,jj) = vkarmn * r_z0_bot 626 psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn 627 ! 628 zd_lw(ji,jj,ibot) = 0._wp 629 zd_up(ji,jj,ibot) = 0._wp 630 zdiag(ji,jj,ibot) = 1._wp 631 ! 632 ! Just above last level: Neumann condition with flux injection 633 zdiag(ji,jj,ibotm1) = zdiag(ji,jj,ibotm1) + zd_up(ji,jj,ibotm1) ! Remove zd_up from zdiag 634 zd_up(ji,jj,ibotm1) = 0. 635 ! 636 ! Set psi vertical flux at the bottom: 637 zdep(ji,jj) = r_z0_bot + 0.5_wp*e3t_n(ji,jj,ibotm1) 638 zflxb = rsbc_psi2 * ( p_avm(ji,jj,ibot) + p_avm(ji,jj,ibotm1) ) & 639 & * (0.5_wp*(en(ji,jj,ibot)+en(ji,jj,ibotm1)))**rmm * zdep(ji,jj)**(rnn-1._wp) 640 psi(ji,jj,ibotm1) = psi(ji,jj,ibotm1) + zflxb / e3w_n(ji,jj,ibotm1) 641 END DO 642 END DO 562 DO_2D_00_00 563 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point 564 ibotm1 = mbkt(ji,jj) ! k-1 bottom level of w-point but >=1 565 ! 566 ! Bottom level Dirichlet condition: 567 zdep(ji,jj) = vkarmn * r_z0_bot 568 psi (ji,jj,ibot) = rc0**rpp * en(ji,jj,ibot)**rmm * zdep(ji,jj)**rnn 569 ! 570 zd_lw(ji,jj,ibot) = 0._wp 571 zd_up(ji,jj,ibot) = 0._wp 572 zdiag(ji,jj,ibot) = 1._wp 573 ! 574 ! Just above last level: Neumann condition with flux injection 575 zdiag(ji,jj,ibotm1) = zdiag(ji,jj,ibotm1) + zd_up(ji,jj,ibotm1) ! Remove zd_up from zdiag 576 zd_up(ji,jj,ibotm1) = 0. 577 ! 578 ! Set psi vertical flux at the bottom: 579 zdep(ji,jj) = r_z0_bot + 0.5_wp*e3t(ji,jj,ibotm1,Kmm) 580 zflxb = rsbc_psi2 * ( p_avm(ji,jj,ibot) + p_avm(ji,jj,ibotm1) ) & 581 & * (0.5_wp*(en(ji,jj,ibot)+en(ji,jj,ibotm1)))**rmm * zdep(ji,jj)**(rnn-1._wp) 582 psi(ji,jj,ibotm1) = psi(ji,jj,ibotm1) + zflxb / e3w(ji,jj,ibotm1,Kmm) 583 END_2D 643 584 ! 644 585 END SELECT … … 647 588 ! ---------------- 648 589 ! 649 DO jk = 2, jpkm1 ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 650 DO jj = 2, jpjm1 651 DO ji = fs_2, fs_jpim1 ! vector opt. 652 zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 653 END DO 654 END DO 655 END DO 656 DO jk = 2, jpk ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 657 DO jj = 2, jpjm1 658 DO ji = fs_2, fs_jpim1 ! vector opt. 659 zd_lw(ji,jj,jk) = psi(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1) 660 END DO 661 END DO 662 END DO 663 DO jk = jpk-1, 2, -1 ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 664 DO jj = 2, jpjm1 665 DO ji = fs_2, fs_jpim1 ! vector opt. 666 psi(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * psi(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 667 END DO 668 END DO 669 END DO 590 DO_3D_00_00( 2, jpkm1 ) 591 zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 592 END_3D 593 DO_3D_00_00( 2, jpk ) 594 zd_lw(ji,jj,jk) = psi(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1) 595 END_3D 596 DO_3DS_00_00( jpk-1, 2, -1 ) 597 psi(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * psi(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 598 END_3D 670 599 671 600 ! Set dissipation … … 675 604 ! 676 605 CASE( 0 ) ! k-kl (Mellor-Yamada) 677 DO jk = 1, jpkm1 678 DO jj = 2, jpjm1 679 DO ji = fs_2, fs_jpim1 ! vector opt. 680 eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / MAX( psi(ji,jj,jk), rn_epsmin) 681 END DO 682 END DO 683 END DO 606 DO_3D_00_00( 1, jpkm1 ) 607 eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / MAX( psi(ji,jj,jk), rn_epsmin) 608 END_3D 684 609 ! 685 610 CASE( 1 ) ! k-eps 686 DO jk = 1, jpkm1 687 DO jj = 2, jpjm1 688 DO ji = fs_2, fs_jpim1 ! vector opt. 689 eps(ji,jj,jk) = psi(ji,jj,jk) 690 END DO 691 END DO 692 END DO 611 DO_3D_00_00( 1, jpkm1 ) 612 eps(ji,jj,jk) = psi(ji,jj,jk) 613 END_3D 693 614 ! 694 615 CASE( 2 ) ! k-w 695 DO jk = 1, jpkm1 696 DO jj = 2, jpjm1 697 DO ji = fs_2, fs_jpim1 ! vector opt. 698 eps(ji,jj,jk) = rc04 * en(ji,jj,jk) * psi(ji,jj,jk) 699 END DO 700 END DO 701 END DO 616 DO_3D_00_00( 1, jpkm1 ) 617 eps(ji,jj,jk) = rc04 * en(ji,jj,jk) * psi(ji,jj,jk) 618 END_3D 702 619 ! 703 620 CASE( 3 ) ! generic … … 705 622 zex1 = ( 1.5_wp + rmm/rnn ) 706 623 zex2 = -1._wp / rnn 707 DO jk = 1, jpkm1 708 DO jj = 2, jpjm1 709 DO ji = fs_2, fs_jpim1 ! vector opt. 710 eps(ji,jj,jk) = zcoef * en(ji,jj,jk)**zex1 * psi(ji,jj,jk)**zex2 711 END DO 712 END DO 713 END DO 624 DO_3D_00_00( 1, jpkm1 ) 625 eps(ji,jj,jk) = zcoef * en(ji,jj,jk)**zex1 * psi(ji,jj,jk)**zex2 626 END_3D 714 627 ! 715 628 END SELECT … … 717 630 ! Limit dissipation rate under stable stratification 718 631 ! -------------------------------------------------- 719 DO jk = 1, jpkm1 ! Note that this set boundary conditions on hmxl_n at the same time 720 DO jj = 2, jpjm1 721 DO ji = fs_2, fs_jpim1 ! vector opt. 722 ! limitation 723 eps (ji,jj,jk) = MAX( eps(ji,jj,jk), rn_epsmin ) 724 hmxl_n(ji,jj,jk) = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / eps(ji,jj,jk) 725 ! Galperin criterium (NOTE : Not required if the proper value of C3 in stable cases is calculated) 726 zrn2 = MAX( rn2(ji,jj,jk), rsmall ) 727 IF( ln_length_lim ) hmxl_n(ji,jj,jk) = MIN( rn_clim_galp * SQRT( 2._wp * en(ji,jj,jk) / zrn2 ), hmxl_n(ji,jj,jk) ) 728 END DO 729 END DO 730 END DO 632 DO_3D_00_00( 1, jpkm1 ) 633 ! limitation 634 eps (ji,jj,jk) = MAX( eps(ji,jj,jk), rn_epsmin ) 635 hmxl_n(ji,jj,jk) = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / eps(ji,jj,jk) 636 ! Galperin criterium (NOTE : Not required if the proper value of C3 in stable cases is calculated) 637 zrn2 = MAX( rn2(ji,jj,jk), rsmall ) 638 IF( ln_length_lim ) hmxl_n(ji,jj,jk) = MIN( rn_clim_galp * SQRT( 2._wp * en(ji,jj,jk) / zrn2 ), hmxl_n(ji,jj,jk) ) 639 END_3D 731 640 732 641 ! … … 737 646 ! 738 647 CASE ( 0 , 1 ) ! Galperin or Kantha-Clayson stability functions 739 DO jk = 2, jpkm1 740 DO jj = 2, jpjm1 741 DO ji = fs_2, fs_jpim1 ! vector opt. 742 ! zcof = l²/q² 743 zcof = hmxl_b(ji,jj,jk) * hmxl_b(ji,jj,jk) / ( 2._wp*eb(ji,jj,jk) ) 744 ! Gh = -N²l²/q² 745 gh = - rn2(ji,jj,jk) * zcof 746 gh = MIN( gh, rgh0 ) 747 gh = MAX( gh, rghmin ) 748 ! Stability functions from Kantha and Clayson (if C2=C3=0 => Galperin) 749 sh = ra2*( 1._wp-6._wp*ra1/rb1 ) / ( 1.-3.*ra2*gh*(6.*ra1+rb2*( 1._wp-rc3 ) ) ) 750 sm = ( rb1**(-1._wp/3._wp) + ( 18._wp*ra1*ra1 + 9._wp*ra1*ra2*(1._wp-rc2) )*sh*gh ) / (1._wp-9._wp*ra1*ra2*gh) 751 ! 752 ! Store stability function in zstt and zstm 753 zstt(ji,jj,jk) = rc_diff * sh * tmask(ji,jj,jk) 754 zstm(ji,jj,jk) = rc_diff * sm * tmask(ji,jj,jk) 755 END DO 756 END DO 757 END DO 648 DO_3D_00_00( 2, jpkm1 ) 649 ! zcof = l²/q² 650 zcof = hmxl_b(ji,jj,jk) * hmxl_b(ji,jj,jk) / ( 2._wp*eb(ji,jj,jk) ) 651 ! Gh = -N²l²/q² 652 gh = - rn2(ji,jj,jk) * zcof 653 gh = MIN( gh, rgh0 ) 654 gh = MAX( gh, rghmin ) 655 ! Stability functions from Kantha and Clayson (if C2=C3=0 => Galperin) 656 sh = ra2*( 1._wp-6._wp*ra1/rb1 ) / ( 1.-3.*ra2*gh*(6.*ra1+rb2*( 1._wp-rc3 ) ) ) 657 sm = ( rb1**(-1._wp/3._wp) + ( 18._wp*ra1*ra1 + 9._wp*ra1*ra2*(1._wp-rc2) )*sh*gh ) / (1._wp-9._wp*ra1*ra2*gh) 658 ! 659 ! Store stability function in zstt and zstm 660 zstt(ji,jj,jk) = rc_diff * sh * tmask(ji,jj,jk) 661 zstm(ji,jj,jk) = rc_diff * sm * tmask(ji,jj,jk) 662 END_3D 758 663 ! 759 664 CASE ( 2, 3 ) ! Canuto stability functions 760 DO jk = 2, jpkm1 761 DO jj = 2, jpjm1 762 DO ji = fs_2, fs_jpim1 ! vector opt. 763 ! zcof = l²/q² 764 zcof = hmxl_b(ji,jj,jk)*hmxl_b(ji,jj,jk) / ( 2._wp * eb(ji,jj,jk) ) 765 ! Gh = -N²l²/q² 766 gh = - rn2(ji,jj,jk) * zcof 767 gh = MIN( gh, rgh0 ) 768 gh = MAX( gh, rghmin ) 769 gh = gh * rf6 770 ! Gm = M²l²/q² Shear number 771 shr = p_sh2(ji,jj,jk) / MAX( p_avm(ji,jj,jk), rsmall ) 772 gm = MAX( shr * zcof , 1.e-10 ) 773 gm = gm * rf6 774 gm = MIN ( (rd0 - rd1*gh + rd3*gh*gh) / (rd2-rd4*gh) , gm ) 775 ! Stability functions from Canuto 776 rcff = rd0 - rd1*gh +rd2*gm + rd3*gh*gh - rd4*gh*gm + rd5*gm*gm 777 sm = (rs0 - rs1*gh + rs2*gm) / rcff 778 sh = (rs4 - rs5*gh + rs6*gm) / rcff 779 ! 780 ! Store stability function in zstt and zstm 781 zstt(ji,jj,jk) = rc_diff * sh * tmask(ji,jj,jk) 782 zstm(ji,jj,jk) = rc_diff * sm * tmask(ji,jj,jk) 783 END DO 784 END DO 785 END DO 665 DO_3D_00_00( 2, jpkm1 ) 666 ! zcof = l²/q² 667 zcof = hmxl_b(ji,jj,jk)*hmxl_b(ji,jj,jk) / ( 2._wp * eb(ji,jj,jk) ) 668 ! Gh = -N²l²/q² 669 gh = - rn2(ji,jj,jk) * zcof 670 gh = MIN( gh, rgh0 ) 671 gh = MAX( gh, rghmin ) 672 gh = gh * rf6 673 ! Gm = M²l²/q² Shear number 674 shr = p_sh2(ji,jj,jk) / MAX( p_avm(ji,jj,jk), rsmall ) 675 gm = MAX( shr * zcof , 1.e-10 ) 676 gm = gm * rf6 677 gm = MIN ( (rd0 - rd1*gh + rd3*gh*gh) / (rd2-rd4*gh) , gm ) 678 ! Stability functions from Canuto 679 rcff = rd0 - rd1*gh +rd2*gm + rd3*gh*gh - rd4*gh*gm + rd5*gm*gm 680 sm = (rs0 - rs1*gh + rs2*gm) / rcff 681 sh = (rs4 - rs5*gh + rs6*gm) / rcff 682 ! 683 ! Store stability function in zstt and zstm 684 zstt(ji,jj,jk) = rc_diff * sh * tmask(ji,jj,jk) 685 zstm(ji,jj,jk) = rc_diff * sm * tmask(ji,jj,jk) 686 END_3D 786 687 ! 787 688 END SELECT … … 794 695 ! default value, in case jpk > mbkt(ji,jj)+1. Not needed but avoid a bug when looking for undefined values (-fpe0) 795 696 zstm(:,:,jpk) = 0. 796 DO jj = 2, jpjm1 ! update bottom with good values 797 DO ji = fs_2, fs_jpim1 ! vector opt. 798 zstm(ji,jj,mbkt(ji,jj)+1) = zstm(ji,jj,mbkt(ji,jj)) 799 END DO 800 END DO 697 DO_2D_00_00 698 zstm(ji,jj,mbkt(ji,jj)+1) = zstm(ji,jj,mbkt(ji,jj)) 699 END_2D 801 700 802 701 zstt(:,:, 1) = wmask(:,:, 1) ! default value not needed but avoid a bug when looking for undefined values (-fpe0) … … 811 710 ! later overwritten by surface/bottom boundaries conditions, so we don't really care of p_avm(:,:1) and p_avm(:,:jpk) 812 711 ! for zd_lw and zd_up but they have to be defined to avoid a bug when looking for undefined values (-fpe0) 813 DO jk = 1, jpk 814 DO jj = 2, jpjm1 815 DO ji = fs_2, fs_jpim1 ! vector opt. 816 zsqen = SQRT( 2._wp * en(ji,jj,jk) ) * hmxl_n(ji,jj,jk) 817 zavt = zsqen * zstt(ji,jj,jk) 818 zavm = zsqen * zstm(ji,jj,jk) 819 p_avt(ji,jj,jk) = MAX( zavt, avtb(jk) ) * wmask(ji,jj,jk) ! apply mask for zdfmxl routine 820 p_avm(ji,jj,jk) = MAX( zavm, avmb(jk) ) ! Note that avm is not masked at the surface and the bottom 821 END DO 822 END DO 823 END DO 712 DO_3D_00_00( 1, jpk ) 713 zsqen = SQRT( 2._wp * en(ji,jj,jk) ) * hmxl_n(ji,jj,jk) 714 zavt = zsqen * zstt(ji,jj,jk) 715 zavm = zsqen * zstm(ji,jj,jk) 716 p_avt(ji,jj,jk) = MAX( zavt, avtb(jk) ) * wmask(ji,jj,jk) ! apply mask for zdfmxl routine 717 p_avm(ji,jj,jk) = MAX( zavm, avmb(jk) ) ! Note that avm is not masked at the surface and the bottom 718 END_3D 824 719 p_avt(:,:,1) = 0._wp 825 720 ! 826 IF( ln_ctl) THEN721 IF(sn_cfctl%l_prtctl) THEN 827 722 CALL prt_ctl( tab3d_1=en , clinfo1=' gls - e: ', tab3d_2=p_avt, clinfo2=' t: ', kdim=jpk) 828 723 CALL prt_ctl( tab3d_1=p_avm, clinfo1=' gls - m: ', kdim=jpk ) … … 857 752 !!---------------------------------------------------------- 858 753 ! 859 REWIND( numnam_ref ) ! Namelist namzdf_gls in reference namelist : Vertical eddy diffivity and viscosity using gls turbulent closure scheme860 754 READ ( numnam_ref, namzdf_gls, IOSTAT = ios, ERR = 901) 861 755 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_gls in reference namelist' ) 862 756 863 REWIND( numnam_cfg ) ! Namelist namzdf_gls in configuration namelist : Vertical eddy diffivity and viscosity using gls turbulent closure scheme864 757 READ ( numnam_cfg, namzdf_gls, IOSTAT = ios, ERR = 902 ) 865 758 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namzdf_gls in configuration namelist' ) -
NEMO/trunk/src/OCE/ZDF/zdfiwm.F90
r11536 r12377 49 49 50 50 !! * Substitutions 51 # include " vectopt_loop_substitute.h90"51 # include "do_loop_substitute.h90" 52 52 !!---------------------------------------------------------------------- 53 53 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 69 69 70 70 71 SUBROUTINE zdf_iwm( kt, p_avm, p_avt, p_avs )71 SUBROUTINE zdf_iwm( kt, Kmm, p_avm, p_avt, p_avs ) 72 72 !!---------------------------------------------------------------------- 73 73 !! *** ROUTINE zdf_iwm *** … … 118 118 !!---------------------------------------------------------------------- 119 119 INTEGER , INTENT(in ) :: kt ! ocean time step 120 INTEGER , INTENT(in ) :: Kmm ! time level index 120 121 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: p_avm ! momentum Kz (w-points) 121 122 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: p_avt, p_avs ! tracer Kz (w-points) … … 148 149 ! !* Critical slope mixing: distribute energy over the time-varying ocean depth, 149 150 ! using an exponential decay from the seafloor. 150 DO jj = 1, jpj ! part independent of the level 151 DO ji = 1, jpi 152 zhdep(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1) ! depth of the ocean 153 zfact(ji,jj) = rau0 * ( 1._wp - EXP( -zhdep(ji,jj) / hcri_iwm(ji,jj) ) ) 154 IF( zfact(ji,jj) /= 0._wp ) zfact(ji,jj) = ecri_iwm(ji,jj) / zfact(ji,jj) 155 END DO 156 END DO 157 !!gm gde3w ==>>> check for ssh taken into account.... seem OK gde3w_n=gdept_n - sshn 158 DO jk = 2, jpkm1 ! complete with the level-dependent part 159 DO jj = 1, jpj 160 DO ji = 1, jpi 161 IF ( zfact(ji,jj) == 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN ! optimization 162 zemx_iwm(ji,jj,jk) = 0._wp 163 ELSE 164 zemx_iwm(ji,jj,jk) = zfact(ji,jj) * ( EXP( ( gde3w_n(ji,jj,jk ) - zhdep(ji,jj) ) / hcri_iwm(ji,jj) ) & 165 & - EXP( ( gde3w_n(ji,jj,jk-1) - zhdep(ji,jj) ) / hcri_iwm(ji,jj) ) ) & 166 & / ( gde3w_n(ji,jj,jk) - gde3w_n(ji,jj,jk-1) ) 167 ENDIF 168 END DO 169 END DO 170 !!gm delta(gde3w_n) = e3t_n !! Please verify the grid-point position w versus t-point 151 DO_2D_11_11 152 zhdep(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1) ! depth of the ocean 153 zfact(ji,jj) = rau0 * ( 1._wp - EXP( -zhdep(ji,jj) / hcri_iwm(ji,jj) ) ) 154 IF( zfact(ji,jj) /= 0._wp ) zfact(ji,jj) = ecri_iwm(ji,jj) / zfact(ji,jj) 155 END_2D 156 !!gm gde3w ==>>> check for ssh taken into account.... seem OK gde3w_n=gdept(:,:,:,Kmm) - ssh(:,:,Kmm) 157 DO_3D_11_11( 2, jpkm1 ) 158 IF ( zfact(ji,jj) == 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN ! optimization 159 zemx_iwm(ji,jj,jk) = 0._wp 160 ELSE 161 zemx_iwm(ji,jj,jk) = zfact(ji,jj) * ( EXP( ( gde3w(ji,jj,jk ) - zhdep(ji,jj) ) / hcri_iwm(ji,jj) ) & 162 & - EXP( ( gde3w(ji,jj,jk-1) - zhdep(ji,jj) ) / hcri_iwm(ji,jj) ) ) & 163 & / ( gde3w(ji,jj,jk) - gde3w(ji,jj,jk-1) ) 164 ENDIF 165 END_3D 166 !!gm delta(gde3w) = e3t(:,:,:,Kmm) !! Please verify the grid-point position w versus t-point 171 167 !!gm it seems to me that only 1/hcri_iwm is used ==> compute it one for all 172 168 173 END DO174 169 175 170 ! !* Pycnocline-intensified mixing: distribute energy over the time-varying … … 182 177 zfact(:,:) = 0._wp 183 178 DO jk = 2, jpkm1 ! part independent of the level 184 zfact(:,:) = zfact(:,:) + e3w_n(:,:,jk) * SQRT( MAX( 0._wp, rn2(:,:,jk) ) ) * wmask(:,:,jk) 185 END DO 186 ! 187 DO jj = 1, jpj 188 DO ji = 1, jpi 189 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = epyc_iwm(ji,jj) / ( rau0 * zfact(ji,jj) ) 190 END DO 191 END DO 179 zfact(:,:) = zfact(:,:) + e3w(:,:,jk,Kmm) * SQRT( MAX( 0._wp, rn2(:,:,jk) ) ) * wmask(:,:,jk) 180 END DO 181 ! 182 DO_2D_11_11 183 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = epyc_iwm(ji,jj) / ( rau0 * zfact(ji,jj) ) 184 END_2D 192 185 ! 193 186 DO jk = 2, jpkm1 ! complete with the level-dependent part … … 199 192 zfact(:,:) = 0._wp 200 193 DO jk = 2, jpkm1 ! part independent of the level 201 zfact(:,:) = zfact(:,:) + e3w_n(:,:,jk) * MAX( 0._wp, rn2(:,:,jk) ) * wmask(:,:,jk) 202 END DO 203 ! 204 DO jj= 1, jpj 205 DO ji = 1, jpi 206 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = epyc_iwm(ji,jj) / ( rau0 * zfact(ji,jj) ) 207 END DO 208 END DO 194 zfact(:,:) = zfact(:,:) + e3w(:,:,jk,Kmm) * MAX( 0._wp, rn2(:,:,jk) ) * wmask(:,:,jk) 195 END DO 196 ! 197 DO_2D_11_11 198 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = epyc_iwm(ji,jj) / ( rau0 * zfact(ji,jj) ) 199 END_2D 209 200 ! 210 201 DO jk = 2, jpkm1 ! complete with the level-dependent part … … 220 211 zfact(:,:) = 0._wp 221 212 DO jk = 2, jpkm1 222 zfact(:,:) = zfact(:,:) + e3w _n(:,:,jk) * SQRT( MAX( 0._wp, rn2(:,:,jk) ) ) * wmask(:,:,jk)213 zfact(:,:) = zfact(:,:) + e3w(:,:,jk,Kmm) * SQRT( MAX( 0._wp, rn2(:,:,jk) ) ) * wmask(:,:,jk) 223 214 zwkb(:,:,jk) = zfact(:,:) 224 215 END DO 225 216 !!gm even better: 226 217 ! DO jk = 2, jpkm1 227 ! zwkb(:,:) = zwkb(:,:) + e3w _n(:,:,jk) * SQRT( MAX( 0._wp, rn2(:,:,jk) ) )218 ! zwkb(:,:) = zwkb(:,:) + e3w(:,:,jk,Kmm) * SQRT( MAX( 0._wp, rn2(:,:,jk) ) ) 228 219 ! END DO 229 220 ! zfact(:,:) = zwkb(:,:,jpkm1) … … 231 222 !!gm 232 223 ! 233 DO jk = 2, jpkm1 234 DO jj = 1, jpj 235 DO ji = 1, jpi 236 IF( zfact(ji,jj) /= 0 ) zwkb(ji,jj,jk) = zhdep(ji,jj) * ( zfact(ji,jj) - zwkb(ji,jj,jk) ) & 237 & * wmask(ji,jj,jk) / zfact(ji,jj) 238 END DO 239 END DO 240 END DO 224 DO_3D_11_11( 2, jpkm1 ) 225 IF( zfact(ji,jj) /= 0 ) zwkb(ji,jj,jk) = zhdep(ji,jj) * ( zfact(ji,jj) - zwkb(ji,jj,jk) ) & 226 & * wmask(ji,jj,jk) / zfact(ji,jj) 227 END_3D 241 228 zwkb(:,:,1) = zhdep(:,:) * wmask(:,:,1) 242 229 ! 243 DO jk = 2, jpkm1 244 DO jj = 1, jpj 245 DO ji = 1, jpi 246 IF ( rn2(ji,jj,jk) <= 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN ! optimization 247 zweight(ji,jj,jk) = 0._wp 248 ELSE 249 zweight(ji,jj,jk) = rn2(ji,jj,jk) * hbot_iwm(ji,jj) & 250 & * ( EXP( -zwkb(ji,jj,jk) / hbot_iwm(ji,jj) ) - EXP( -zwkb(ji,jj,jk-1) / hbot_iwm(ji,jj) ) ) 251 ENDIF 252 END DO 253 END DO 254 END DO 230 DO_3D_11_11( 2, jpkm1 ) 231 IF ( rn2(ji,jj,jk) <= 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN ! optimization 232 zweight(ji,jj,jk) = 0._wp 233 ELSE 234 zweight(ji,jj,jk) = rn2(ji,jj,jk) * hbot_iwm(ji,jj) & 235 & * ( EXP( -zwkb(ji,jj,jk) / hbot_iwm(ji,jj) ) - EXP( -zwkb(ji,jj,jk-1) / hbot_iwm(ji,jj) ) ) 236 ENDIF 237 END_3D 255 238 ! 256 239 zfact(:,:) = 0._wp … … 259 242 END DO 260 243 ! 261 DO jj = 1, jpj 262 DO ji = 1, jpi 263 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = ebot_iwm(ji,jj) / ( rau0 * zfact(ji,jj) ) 264 END DO 265 END DO 244 DO_2D_11_11 245 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = ebot_iwm(ji,jj) / ( rau0 * zfact(ji,jj) ) 246 END_2D 266 247 ! 267 248 DO jk = 2, jpkm1 ! complete with the level-dependent part 268 249 zemx_iwm(:,:,jk) = zemx_iwm(:,:,jk) + zweight(:,:,jk) * zfact(:,:) * wmask(:,:,jk) & 269 & / ( gde3w _n(:,:,jk) - gde3w_n(:,:,jk-1) )270 !!gm use of e3t _njust above?250 & / ( gde3w(:,:,jk) - gde3w(:,:,jk-1) ) 251 !!gm use of e3t(:,:,:,Kmm) just above? 271 252 END DO 272 253 ! 273 254 !!gm this is to be replaced by just a constant value znu=1.e-6 m2/s 274 255 ! Calculate molecular kinematic viscosity 275 znu_t(:,:,:) = 1.e-4_wp * ( 17.91_wp - 0.53810_wp * ts n(:,:,:,jp_tem) + 0.00694_wp * tsn(:,:,:,jp_tem) * tsn(:,:,:,jp_tem) &276 & + 0.02305_wp * ts n(:,:,:,jp_sal) ) * tmask(:,:,:) * r1_rau0256 znu_t(:,:,:) = 1.e-4_wp * ( 17.91_wp - 0.53810_wp * ts(:,:,:,jp_tem,Kmm) + 0.00694_wp * ts(:,:,:,jp_tem,Kmm) * ts(:,:,:,jp_tem,Kmm) & 257 & + 0.02305_wp * ts(:,:,:,jp_sal,Kmm) ) * tmask(:,:,:) * r1_rau0 277 258 DO jk = 2, jpkm1 278 259 znu_w(:,:,jk) = 0.5_wp * ( znu_t(:,:,jk-1) + znu_t(:,:,jk) ) * wmask(:,:,jk) … … 291 272 ! 292 273 IF( ln_mevar ) THEN ! Variable mixing efficiency case : modify zav_wave in the 293 DO jk = 2, jpkm1 ! energetic (Reb > 480) and buoyancy-controlled (Reb <10.224 ) regimes 294 DO jj = 1, jpj 295 DO ji = 1, jpi 296 IF( zReb(ji,jj,jk) > 480.00_wp ) THEN 297 zav_wave(ji,jj,jk) = 3.6515_wp * znu_w(ji,jj,jk) * SQRT( zReb(ji,jj,jk) ) 298 ELSEIF( zReb(ji,jj,jk) < 10.224_wp ) THEN 299 zav_wave(ji,jj,jk) = 0.052125_wp * znu_w(ji,jj,jk) * zReb(ji,jj,jk) * SQRT( zReb(ji,jj,jk) ) 300 ENDIF 301 END DO 302 END DO 303 END DO 274 DO_3D_11_11( 2, jpkm1 ) 275 IF( zReb(ji,jj,jk) > 480.00_wp ) THEN 276 zav_wave(ji,jj,jk) = 3.6515_wp * znu_w(ji,jj,jk) * SQRT( zReb(ji,jj,jk) ) 277 ELSEIF( zReb(ji,jj,jk) < 10.224_wp ) THEN 278 zav_wave(ji,jj,jk) = 0.052125_wp * znu_w(ji,jj,jk) * zReb(ji,jj,jk) * SQRT( zReb(ji,jj,jk) ) 279 ENDIF 280 END_3D 304 281 ENDIF 305 282 ! … … 311 288 zztmp = 0._wp 312 289 !!gm used of glosum 3D.... 313 DO jk = 2, jpkm1 314 DO jj = 1, jpj 315 DO ji = 1, jpi 316 zztmp = zztmp + e3w_n(ji,jj,jk) * e1e2t(ji,jj) & 317 & * MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) 318 END DO 319 END DO 320 END DO 290 DO_3D_11_11( 2, jpkm1 ) 291 zztmp = zztmp + e3w(ji,jj,jk,Kmm) * e1e2t(ji,jj) & 292 & * MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) 293 END_3D 321 294 CALL mpp_sum( 'zdfiwm', zztmp ) 322 295 zztmp = rau0 * zztmp ! Global integral of rauo * Kz * N^2 = power contributing to mixing … … 337 310 IF( ln_tsdiff ) THEN !* Option for differential mixing of salinity and temperature 338 311 ztmp1 = 0.505_wp + 0.495_wp * TANH( 0.92_wp * ( LOG10( 1.e-20_wp ) - 0.60_wp ) ) 339 DO jk = 2, jpkm1 ! Calculate S/T diffusivity ratio as a function of Reb 340 DO jj = 1, jpj 341 DO ji = 1, jpi 342 ztmp2 = zReb(ji,jj,jk) * 5._wp * r1_6 343 IF ( ztmp2 > 1.e-20_wp .AND. wmask(ji,jj,jk) == 1._wp ) THEN 344 zav_ratio(ji,jj,jk) = 0.505_wp + 0.495_wp * TANH( 0.92_wp * ( LOG10(ztmp2) - 0.60_wp ) ) 345 ELSE 346 zav_ratio(ji,jj,jk) = ztmp1 * wmask(ji,jj,jk) 347 ENDIF 348 END DO 349 END DO 350 END DO 312 DO_3D_11_11( 2, jpkm1 ) 313 ztmp2 = zReb(ji,jj,jk) * 5._wp * r1_6 314 IF ( ztmp2 > 1.e-20_wp .AND. wmask(ji,jj,jk) == 1._wp ) THEN 315 zav_ratio(ji,jj,jk) = 0.505_wp + 0.495_wp * TANH( 0.92_wp * ( LOG10(ztmp2) - 0.60_wp ) ) 316 ELSE 317 zav_ratio(ji,jj,jk) = ztmp1 * wmask(ji,jj,jk) 318 ENDIF 319 END_3D 351 320 CALL iom_put( "av_ratio", zav_ratio ) 352 321 DO jk = 2, jpkm1 !* update momentum & tracer diffusivity with wave-driven mixing … … 374 343 z2d(:,:) = 0._wp 375 344 DO jk = 2, jpkm1 376 z2d(:,:) = z2d(:,:) + e3w _n(:,:,jk) * z3d(:,:,jk) * wmask(:,:,jk)345 z2d(:,:) = z2d(:,:) + e3w(:,:,jk,Kmm) * z3d(:,:,jk) * wmask(:,:,jk) 377 346 END DO 378 347 z2d(:,:) = rau0 * z2d(:,:) … … 383 352 CALL iom_put( "emix_iwm", zemx_iwm ) 384 353 385 IF( ln_ctl) CALL prt_ctl(tab3d_1=zav_wave , clinfo1=' iwm - av_wave: ', tab3d_2=avt, clinfo2=' avt: ', kdim=jpk)354 IF(sn_cfctl%l_prtctl) CALL prt_ctl(tab3d_1=zav_wave , clinfo1=' iwm - av_wave: ', tab3d_2=avt, clinfo2=' avt: ', kdim=jpk) 386 355 ! 387 356 END SUBROUTINE zdf_iwm … … 414 383 !! de Lavergne et al. in prep., 2017 415 384 !!---------------------------------------------------------------------- 416 INTEGER :: ji, jj, jk ! dummy loop indices417 385 INTEGER :: inum ! local integer 418 386 INTEGER :: ios … … 422 390 !!---------------------------------------------------------------------- 423 391 ! 424 REWIND( numnam_ref ) ! Namelist namzdf_iwm in reference namelist : Wave-driven mixing425 392 READ ( numnam_ref, namzdf_iwm, IOSTAT = ios, ERR = 901) 426 393 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_iwm in reference namelist' ) 427 394 ! 428 REWIND( numnam_cfg ) ! Namelist namzdf_iwm in configuration namelist : Wave-driven mixing429 395 READ ( numnam_cfg, namzdf_iwm, IOSTAT = ios, ERR = 902 ) 430 396 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namzdf_iwm in configuration namelist' ) -
NEMO/trunk/src/OCE/ZDF/zdfmxl.F90
r10425 r12377 12 12 !!---------------------------------------------------------------------- 13 13 USE oce ! ocean dynamics and tracers variables 14 USE isf_oce ! ice shelf 14 15 USE dom_oce ! ocean space and time domain variables 15 16 USE trc_oce , ONLY: l_offline ! ocean space and time domain variables … … 35 36 REAL(wp), PUBLIC :: avt_c = 5.e-4_wp ! Kz criterion for the turbocline depth 36 37 38 !! * Substitutions 39 # include "do_loop_substitute.h90" 37 40 !!---------------------------------------------------------------------- 38 41 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 57 60 58 61 59 SUBROUTINE zdf_mxl( kt )62 SUBROUTINE zdf_mxl( kt, Kmm ) 60 63 !!---------------------------------------------------------------------- 61 64 !! *** ROUTINE zdfmxl *** … … 75 78 !!---------------------------------------------------------------------- 76 79 INTEGER, INTENT(in) :: kt ! ocean time-step index 80 INTEGER, INTENT(in) :: Kmm ! ocean time level index 77 81 ! 78 82 INTEGER :: ji, jj, jk ! dummy loop indices … … 94 98 hmlp(:,:) = 0._wp ! here hmlp used as a dummy variable, integrating vertically N^2 95 99 zN2_c = grav * rho_c * r1_rau0 ! convert density criteria into N^2 criteria 96 DO jk = nlb10, jpkm1 97 DO jj = 1, jpj ! Mixed layer level: w-level 98 DO ji = 1, jpi 99 ikt = mbkt(ji,jj) 100 hmlp(ji,jj) = hmlp(ji,jj) + MAX( rn2b(ji,jj,jk) , 0._wp ) * e3w_n(ji,jj,jk) 101 IF( hmlp(ji,jj) < zN2_c ) nmln(ji,jj) = MIN( jk , ikt ) + 1 ! Mixed layer level 102 END DO 103 END DO 104 END DO 100 DO_3D_11_11( nlb10, jpkm1 ) 101 ikt = mbkt(ji,jj) 102 hmlp(ji,jj) = hmlp(ji,jj) + MAX( rn2b(ji,jj,jk) , 0._wp ) * e3w(ji,jj,jk,Kmm) 103 IF( hmlp(ji,jj) < zN2_c ) nmln(ji,jj) = MIN( jk , ikt ) + 1 ! Mixed layer level 104 END_3D 105 105 ! 106 106 ! w-level of the turbocline and mixing layer (iom_use) 107 107 imld(:,:) = mbkt(:,:) + 1 ! Initialization to the number of w ocean point 108 DO jk = jpkm1, nlb10, -1 ! from the bottom to nlb10 109 DO jj = 1, jpj 110 DO ji = 1, jpi 111 IF( avt (ji,jj,jk) < avt_c * wmask(ji,jj,jk) ) imld(ji,jj) = jk ! Turbocline 112 END DO 113 END DO 114 END DO 108 DO_3DS_11_11( jpkm1, nlb10, -1 ) 109 IF( avt (ji,jj,jk) < avt_c * wmask(ji,jj,jk) ) imld(ji,jj) = jk ! Turbocline 110 END_3D 115 111 ! depth of the mixing and mixed layers 116 DO jj = 1, jpj 117 DO ji = 1, jpi 118 iiki = imld(ji,jj) 119 iikn = nmln(ji,jj) 120 hmld (ji,jj) = gdepw_n(ji,jj,iiki ) * ssmask(ji,jj) ! Turbocline depth 121 hmlp (ji,jj) = gdepw_n(ji,jj,iikn ) * ssmask(ji,jj) ! Mixed layer depth 122 hmlpt(ji,jj) = gdept_n(ji,jj,iikn-1) * ssmask(ji,jj) ! depth of the last T-point inside the mixed layer 123 END DO 124 END DO 112 DO_2D_11_11 113 iiki = imld(ji,jj) 114 iikn = nmln(ji,jj) 115 hmld (ji,jj) = gdepw(ji,jj,iiki ,Kmm) * ssmask(ji,jj) ! Turbocline depth 116 hmlp (ji,jj) = gdepw(ji,jj,iikn ,Kmm) * ssmask(ji,jj) ! Mixed layer depth 117 hmlpt(ji,jj) = gdept(ji,jj,iikn-1,Kmm) * ssmask(ji,jj) ! depth of the last T-point inside the mixed layer 118 END_2D 125 119 ! 126 120 IF( .NOT.l_offline ) THEN … … 137 131 ENDIF 138 132 ! 139 IF( ln_ctl) CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' nmln : ', tab2d_2=hmlp, clinfo2=' hmlp : ' )133 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=REAL(nmln,wp), clinfo1=' nmln : ', tab2d_2=hmlp, clinfo2=' hmlp : ' ) 140 134 ! 141 135 END SUBROUTINE zdf_mxl -
NEMO/trunk/src/OCE/ZDF/zdfosm.F90
r11536 r12377 42 42 !!---------------------------------------------------------------------- 43 43 USE oce ! ocean dynamics and active tracers 44 ! uses w nfrom previous time step (which is now wb) to calculate hbl44 ! uses ww from previous time step (which is now wb) to calculate hbl 45 45 USE dom_oce ! ocean space and time domain 46 46 USE zdf_oce ! ocean vertical physics … … 103 103 INTEGER :: idebug = 236 104 104 INTEGER :: jdebug = 228 105 !! * Substitutions 106 # include "do_loop_substitute.h90" 105 107 !!---------------------------------------------------------------------- 106 108 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 122 124 123 125 124 SUBROUTINE zdf_osm( kt, p_avm, p_avt )126 SUBROUTINE zdf_osm( kt, Kbb, Kmm, Krhs, p_avm, p_avt ) 125 127 !!---------------------------------------------------------------------- 126 128 !! *** ROUTINE zdf_osm *** … … 157 159 !! the equation number. (LMD94, here after) 158 160 !!---------------------------------------------------------------------- 159 INTEGER , INTENT(in ) :: kt ! ocean time step 161 INTEGER , INTENT(in ) :: kt ! ocean time step 162 INTEGER , INTENT(in ) :: Kbb, Kmm, Krhs ! ocean time level indices 160 163 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: p_avm, p_avt ! momentum and tracer Kz (w-points) 161 164 !! … … 295 298 zz0 = rn_abs ! surface equi-partition in 2-bands 296 299 zz1 = 1. - rn_abs 297 DO jj = 2, jpjm1 298 DO ji = 2, jpim1 299 ! Surface downward irradiance (so always +ve) 300 zrad0(ji,jj) = qsr(ji,jj) * r1_rau0_rcp 301 ! Downwards irradiance at base of boundary layer 302 zradh(ji,jj) = zrad0(ji,jj) * ( zz0 * EXP( -hbl(ji,jj)/rn_si0 ) + zz1 * EXP( -hbl(ji,jj)/rn_si1) ) 303 ! Downwards irradiance averaged over depth of the OSBL 304 zradav(ji,jj) = zrad0(ji,jj) * ( zz0 * ( 1.0 - EXP( -hbl(ji,jj)/rn_si0 ) )*rn_si0 & 305 & + zz1 * ( 1.0 - EXP( -hbl(ji,jj)/rn_si1 ) )*rn_si1 ) / hbl(ji,jj) 306 END DO 307 END DO 300 DO_2D_00_00 301 ! Surface downward irradiance (so always +ve) 302 zrad0(ji,jj) = qsr(ji,jj) * r1_rau0_rcp 303 ! Downwards irradiance at base of boundary layer 304 zradh(ji,jj) = zrad0(ji,jj) * ( zz0 * EXP( -hbl(ji,jj)/rn_si0 ) + zz1 * EXP( -hbl(ji,jj)/rn_si1) ) 305 ! Downwards irradiance averaged over depth of the OSBL 306 zradav(ji,jj) = zrad0(ji,jj) * ( zz0 * ( 1.0 - EXP( -hbl(ji,jj)/rn_si0 ) )*rn_si0 & 307 & + zz1 * ( 1.0 - EXP( -hbl(ji,jj)/rn_si1 ) )*rn_si1 ) / hbl(ji,jj) 308 END_2D 308 309 ! Turbulent surface fluxes and fluxes averaged over depth of the OSBL 309 DO jj = 2, jpjm1 310 DO ji = 2, jpim1 311 zthermal = rab_n(ji,jj,1,jp_tem) 312 zbeta = rab_n(ji,jj,1,jp_sal) 313 ! Upwards surface Temperature flux for non-local term 314 zwth0(ji,jj) = - qns(ji,jj) * r1_rau0_rcp * tmask(ji,jj,1) 315 ! Upwards surface salinity flux for non-local term 316 zws0(ji,jj) = - ( ( emp(ji,jj)-rnf(ji,jj) ) * tsn(ji,jj,1,jp_sal) + sfx(ji,jj) ) * r1_rau0 * tmask(ji,jj,1) 317 ! Non radiative upwards surface buoyancy flux 318 zwb0(ji,jj) = grav * zthermal * zwth0(ji,jj) - grav * zbeta * zws0(ji,jj) 319 ! turbulent heat flux averaged over depth of OSBL 320 zwthav(ji,jj) = 0.5 * zwth0(ji,jj) - ( 0.5*( zrad0(ji,jj) + zradh(ji,jj) ) - zradav(ji,jj) ) 321 ! turbulent salinity flux averaged over depth of the OBSL 322 zwsav(ji,jj) = 0.5 * zws0(ji,jj) 323 ! turbulent buoyancy flux averaged over the depth of the OBSBL 324 zwbav(ji,jj) = grav * zthermal * zwthav(ji,jj) - grav * zbeta * zwsav(ji,jj) 325 ! Surface upward velocity fluxes 326 zuw0(ji,jj) = -utau(ji,jj) * r1_rau0 * tmask(ji,jj,1) 327 zvw0(ji,jj) = -vtau(ji,jj) * r1_rau0 * tmask(ji,jj,1) 328 ! Friction velocity (zustar), at T-point : LMD94 eq. 2 329 zustar(ji,jj) = MAX( SQRT( SQRT( zuw0(ji,jj) * zuw0(ji,jj) + zvw0(ji,jj) * zvw0(ji,jj) ) ), 1.0e-8 ) 330 zcos_wind(ji,jj) = -zuw0(ji,jj) / ( zustar(ji,jj) * zustar(ji,jj) ) 331 zsin_wind(ji,jj) = -zvw0(ji,jj) / ( zustar(ji,jj) * zustar(ji,jj) ) 332 END DO 333 END DO 310 DO_2D_00_00 311 zthermal = rab_n(ji,jj,1,jp_tem) 312 zbeta = rab_n(ji,jj,1,jp_sal) 313 ! Upwards surface Temperature flux for non-local term 314 zwth0(ji,jj) = - qns(ji,jj) * r1_rau0_rcp * tmask(ji,jj,1) 315 ! Upwards surface salinity flux for non-local term 316 zws0(ji,jj) = - ( ( emp(ji,jj)-rnf(ji,jj) ) * ts(ji,jj,1,jp_sal,Kmm) + sfx(ji,jj) ) * r1_rau0 * tmask(ji,jj,1) 317 ! Non radiative upwards surface buoyancy flux 318 zwb0(ji,jj) = grav * zthermal * zwth0(ji,jj) - grav * zbeta * zws0(ji,jj) 319 ! turbulent heat flux averaged over depth of OSBL 320 zwthav(ji,jj) = 0.5 * zwth0(ji,jj) - ( 0.5*( zrad0(ji,jj) + zradh(ji,jj) ) - zradav(ji,jj) ) 321 ! turbulent salinity flux averaged over depth of the OBSL 322 zwsav(ji,jj) = 0.5 * zws0(ji,jj) 323 ! turbulent buoyancy flux averaged over the depth of the OBSBL 324 zwbav(ji,jj) = grav * zthermal * zwthav(ji,jj) - grav * zbeta * zwsav(ji,jj) 325 ! Surface upward velocity fluxes 326 zuw0(ji,jj) = -utau(ji,jj) * r1_rau0 * tmask(ji,jj,1) 327 zvw0(ji,jj) = -vtau(ji,jj) * r1_rau0 * tmask(ji,jj,1) 328 ! Friction velocity (zustar), at T-point : LMD94 eq. 2 329 zustar(ji,jj) = MAX( SQRT( SQRT( zuw0(ji,jj) * zuw0(ji,jj) + zvw0(ji,jj) * zvw0(ji,jj) ) ), 1.0e-8 ) 330 zcos_wind(ji,jj) = -zuw0(ji,jj) / ( zustar(ji,jj) * zustar(ji,jj) ) 331 zsin_wind(ji,jj) = -zvw0(ji,jj) / ( zustar(ji,jj) * zustar(ji,jj) ) 332 END_2D 334 333 ! Calculate Stokes drift in direction of wind (zustke) and Stokes penetration depth (dstokes) 335 334 SELECT CASE (nn_osm_wave) 336 335 ! Assume constant La#=0.3 337 336 CASE(0) 338 DO jj = 2, jpjm1 339 DO ji = 2, jpim1 340 zus_x = zcos_wind(ji,jj) * zustar(ji,jj) / 0.3**2 341 zus_y = zsin_wind(ji,jj) * zustar(ji,jj) / 0.3**2 342 zustke(ji,jj) = MAX ( SQRT( zus_x*zus_x + zus_y*zus_y), 1.0e-8 ) 343 ! dstokes(ji,jj) set to constant value rn_osm_dstokes from namelist in zdf_osm_init 344 END DO 345 END DO 337 DO_2D_00_00 338 zus_x = zcos_wind(ji,jj) * zustar(ji,jj) / 0.3**2 339 zus_y = zsin_wind(ji,jj) * zustar(ji,jj) / 0.3**2 340 zustke(ji,jj) = MAX ( SQRT( zus_x*zus_x + zus_y*zus_y), 1.0e-8 ) 341 ! dstokes(ji,jj) set to constant value rn_osm_dstokes from namelist in zdf_osm_init 342 END_2D 346 343 ! Assume Pierson-Moskovitz wind-wave spectrum 347 344 CASE(1) 348 DO jj = 2, jpjm1 349 DO ji = 2, jpim1 350 ! Use wind speed wndm included in sbc_oce module 351 zustke(ji,jj) = MAX ( 0.016 * wndm(ji,jj), 1.0e-8 ) 352 dstokes(ji,jj) = 0.12 * wndm(ji,jj)**2 / grav 353 END DO 354 END DO 345 DO_2D_00_00 346 ! Use wind speed wndm included in sbc_oce module 347 zustke(ji,jj) = MAX ( 0.016 * wndm(ji,jj), 1.0e-8 ) 348 dstokes(ji,jj) = 0.12 * wndm(ji,jj)**2 / grav 349 END_2D 355 350 ! Use ECMWF wave fields as output from SBCWAVE 356 351 CASE(2) 357 352 zfac = 2.0_wp * rpi / 16.0_wp 358 DO jj = 2, jpjm1 359 DO ji = 2, jpim1 360 ! The Langmur number from the ECMWF model appears to give La<0.3 for wind-driven seas. 361 ! The coefficient 0.8 gives La=0.3 in this situation. 362 ! It could represent the effects of the spread of wave directions 363 ! around the mean wind. The effect of this adjustment needs to be tested. 364 zustke(ji,jj) = MAX ( 1.0 * ( zcos_wind(ji,jj) * ut0sd(ji,jj ) + zsin_wind(ji,jj) * vt0sd(ji,jj) ), & 365 & zustar(ji,jj) / ( 0.45 * 0.45 ) ) 366 dstokes(ji,jj) = MAX(zfac * hsw(ji,jj)*hsw(ji,jj) / ( MAX(zustke(ji,jj)*wmp(ji,jj), 1.0e-7 ) ), 5.0e-1) !rn_osm_dstokes ! 367 END DO 368 END DO 353 DO_2D_00_00 354 ! The Langmur number from the ECMWF model appears to give La<0.3 for wind-driven seas. 355 ! The coefficient 0.8 gives La=0.3 in this situation. 356 ! It could represent the effects of the spread of wave directions 357 ! around the mean wind. The effect of this adjustment needs to be tested. 358 zustke(ji,jj) = MAX ( 1.0 * ( zcos_wind(ji,jj) * ut0sd(ji,jj ) + zsin_wind(ji,jj) * vt0sd(ji,jj) ), & 359 & zustar(ji,jj) / ( 0.45 * 0.45 ) ) 360 dstokes(ji,jj) = MAX(zfac * hsw(ji,jj)*hsw(ji,jj) / ( MAX(zustke(ji,jj)*wmp(ji,jj), 1.0e-7 ) ), 5.0e-1) !rn_osm_dstokes ! 361 END_2D 369 362 END SELECT 370 363 371 364 ! Langmuir velocity scale (zwstrl), La # (zla) 372 365 ! mixed scale (zvstr), convective velocity scale (zwstrc) 373 DO jj = 2, jpjm1 374 DO ji = 2, jpim1 375 ! Langmuir velocity scale (zwstrl), at T-point 376 zwstrl(ji,jj) = ( zustar(ji,jj) * zustar(ji,jj) * zustke(ji,jj) )**pthird 377 ! Modify zwstrl to allow for small and large values of dstokes/hbl. 378 ! Intended as a possible test. Doesn't affect LES results for entrainment, 379 ! but hasn't been shown to be correct as dstokes/h becomes large or small. 380 zwstrl(ji,jj) = zwstrl(ji,jj) * & 381 & (1.12 * ( 1.0 - ( 1.0 - EXP( -hbl(ji,jj) / dstokes(ji,jj) ) ) * dstokes(ji,jj) / hbl(ji,jj) ))**pthird * & 382 & ( 1.0 - EXP( -15.0 * dstokes(ji,jj) / hbl(ji,jj) )) 383 ! define La this way so effects of Stokes penetration depth on velocity scale are included 384 zla(ji,jj) = SQRT ( zustar(ji,jj) / zwstrl(ji,jj) )**3 385 ! Velocity scale that tends to zustar for large Langmuir numbers 386 zvstr(ji,jj) = ( zwstrl(ji,jj)**3 + & 387 & ( 1.0 - EXP( -0.5 * zla(ji,jj)**2 ) ) * zustar(ji,jj) * zustar(ji,jj) * zustar(ji,jj) )**pthird 388 389 ! limit maximum value of Langmuir number as approximate treatment for shear turbulence. 390 ! Note zustke and zwstrl are not amended. 391 IF ( zla(ji,jj) >= 0.45 ) zla(ji,jj) = 0.45 392 ! 393 ! get convective velocity (zwstrc), stabilty scale (zhol) and logical conection flag lconv 394 IF ( zwbav(ji,jj) > 0.0) THEN 395 zwstrc(ji,jj) = ( 2.0 * zwbav(ji,jj) * 0.9 * hbl(ji,jj) )**pthird 396 zhol(ji,jj) = -0.9 * hbl(ji,jj) * 2.0 * zwbav(ji,jj) / (zvstr(ji,jj)**3 + epsln ) 397 lconv(ji,jj) = .TRUE. 398 ELSE 399 zhol(ji,jj) = -hbl(ji,jj) * 2.0 * zwbav(ji,jj)/ (zvstr(ji,jj)**3 + epsln ) 400 lconv(ji,jj) = .FALSE. 401 ENDIF 402 END DO 403 END DO 366 DO_2D_00_00 367 ! Langmuir velocity scale (zwstrl), at T-point 368 zwstrl(ji,jj) = ( zustar(ji,jj) * zustar(ji,jj) * zustke(ji,jj) )**pthird 369 ! Modify zwstrl to allow for small and large values of dstokes/hbl. 370 ! Intended as a possible test. Doesn't affect LES results for entrainment, 371 ! but hasn't been shown to be correct as dstokes/h becomes large or small. 372 zwstrl(ji,jj) = zwstrl(ji,jj) * & 373 & (1.12 * ( 1.0 - ( 1.0 - EXP( -hbl(ji,jj) / dstokes(ji,jj) ) ) * dstokes(ji,jj) / hbl(ji,jj) ))**pthird * & 374 & ( 1.0 - EXP( -15.0 * dstokes(ji,jj) / hbl(ji,jj) )) 375 ! define La this way so effects of Stokes penetration depth on velocity scale are included 376 zla(ji,jj) = SQRT ( zustar(ji,jj) / zwstrl(ji,jj) )**3 377 ! Velocity scale that tends to zustar for large Langmuir numbers 378 zvstr(ji,jj) = ( zwstrl(ji,jj)**3 + & 379 & ( 1.0 - EXP( -0.5 * zla(ji,jj)**2 ) ) * zustar(ji,jj) * zustar(ji,jj) * zustar(ji,jj) )**pthird 380 381 ! limit maximum value of Langmuir number as approximate treatment for shear turbulence. 382 ! Note zustke and zwstrl are not amended. 383 IF ( zla(ji,jj) >= 0.45 ) zla(ji,jj) = 0.45 384 ! 385 ! get convective velocity (zwstrc), stabilty scale (zhol) and logical conection flag lconv 386 IF ( zwbav(ji,jj) > 0.0) THEN 387 zwstrc(ji,jj) = ( 2.0 * zwbav(ji,jj) * 0.9 * hbl(ji,jj) )**pthird 388 zhol(ji,jj) = -0.9 * hbl(ji,jj) * 2.0 * zwbav(ji,jj) / (zvstr(ji,jj)**3 + epsln ) 389 lconv(ji,jj) = .TRUE. 390 ELSE 391 zhol(ji,jj) = -hbl(ji,jj) * 2.0 * zwbav(ji,jj)/ (zvstr(ji,jj)**3 + epsln ) 392 lconv(ji,jj) = .FALSE. 393 ENDIF 394 END_2D 404 395 405 396 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 407 398 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 408 399 ! BL must be always 2 levels deep. 409 hbl(:,:) = MAX(hbl(:,:), gdepw _n(:,:,3) )400 hbl(:,:) = MAX(hbl(:,:), gdepw(:,:,3,Kmm) ) 410 401 ibld(:,:) = 3 411 DO jk = 4, jpkm1 412 DO jj = 2, jpjm1 413 DO ji = 2, jpim1 414 IF ( hbl(ji,jj) >= gdepw_n(ji,jj,jk) ) THEN 415 ibld(ji,jj) = MIN(mbkt(ji,jj), jk) 416 ENDIF 402 DO_3D_00_00( 4, jpkm1 ) 403 IF ( hbl(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) THEN 404 ibld(ji,jj) = MIN(mbkt(ji,jj), jk) 405 ENDIF 406 END_3D 407 408 DO_2D_00_00 409 zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 410 zbeta = rab_n(ji,jj,1,jp_sal) 411 zt = 0._wp 412 zs = 0._wp 413 zu = 0._wp 414 zv = 0._wp 415 ! average over depth of boundary layer 416 zthick=0._wp 417 DO jm = 2, ibld(ji,jj) 418 zthick=zthick+e3t(ji,jj,jm,Kmm) 419 zt = zt + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_tem,Kmm) 420 zs = zs + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_sal,Kmm) 421 zu = zu + e3t(ji,jj,jm,Kmm) & 422 & * ( uu(ji,jj,jm,Kbb) + uu(ji - 1,jj,jm,Kbb) ) & 423 & / MAX( 1. , umask(ji,jj,jm) + umask(ji - 1,jj,jm) ) 424 zv = zv + e3t(ji,jj,jm,Kmm) & 425 & * ( vv(ji,jj,jm,Kbb) + vv(ji,jj - 1,jm,Kbb) ) & 426 & / MAX( 1. , vmask(ji,jj,jm) + vmask(ji,jj - 1,jm) ) 417 427 END DO 418 END DO 419 END DO 420 421 DO jj = 2, jpjm1 ! Vertical slab 422 DO ji = 2, jpim1 423 zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 424 zbeta = rab_n(ji,jj,1,jp_sal) 425 zt = 0._wp 426 zs = 0._wp 427 zu = 0._wp 428 zv = 0._wp 429 ! average over depth of boundary layer 430 zthick=0._wp 431 DO jm = 2, ibld(ji,jj) 432 zthick=zthick+e3t_n(ji,jj,jm) 433 zt = zt + e3t_n(ji,jj,jm) * tsn(ji,jj,jm,jp_tem) 434 zs = zs + e3t_n(ji,jj,jm) * tsn(ji,jj,jm,jp_sal) 435 zu = zu + e3t_n(ji,jj,jm) & 436 & * ( ub(ji,jj,jm) + ub(ji - 1,jj,jm) ) & 437 & / MAX( 1. , umask(ji,jj,jm) + umask(ji - 1,jj,jm) ) 438 zv = zv + e3t_n(ji,jj,jm) & 439 & * ( vb(ji,jj,jm) + vb(ji,jj - 1,jm) ) & 440 & / MAX( 1. , vmask(ji,jj,jm) + vmask(ji,jj - 1,jm) ) 441 END DO 442 zt_bl(ji,jj) = zt / zthick 443 zs_bl(ji,jj) = zs / zthick 444 zu_bl(ji,jj) = zu / zthick 445 zv_bl(ji,jj) = zv / zthick 446 zdt_bl(ji,jj) = zt_bl(ji,jj) - tsn(ji,jj,ibld(ji,jj),jp_tem) 447 zds_bl(ji,jj) = zs_bl(ji,jj) - tsn(ji,jj,ibld(ji,jj),jp_sal) 448 zdu_bl(ji,jj) = zu_bl(ji,jj) - ( ub(ji,jj,ibld(ji,jj)) + ub(ji-1,jj,ibld(ji,jj) ) ) & 449 & / MAX(1. , umask(ji,jj,ibld(ji,jj) ) + umask(ji-1,jj,ibld(ji,jj) ) ) 450 zdv_bl(ji,jj) = zv_bl(ji,jj) - ( vb(ji,jj,ibld(ji,jj)) + vb(ji,jj-1,ibld(ji,jj) ) ) & 451 & / MAX(1. , vmask(ji,jj,ibld(ji,jj) ) + vmask(ji,jj-1,ibld(ji,jj) ) ) 452 zdb_bl(ji,jj) = grav * zthermal * zdt_bl(ji,jj) - grav * zbeta * zds_bl(ji,jj) 453 IF ( lconv(ji,jj) ) THEN ! Convective 454 zwb_ent(ji,jj) = -( 2.0 * 0.2 * zwbav(ji,jj) & 455 & + 0.135 * zla(ji,jj) * zwstrl(ji,jj)**3/hbl(ji,jj) ) 456 457 zvel_max = - ( 1.0 + 1.0 * ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_rdt / hbl(ji,jj) ) & 458 & * zwb_ent(ji,jj) / ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 428 zt_bl(ji,jj) = zt / zthick 429 zs_bl(ji,jj) = zs / zthick 430 zu_bl(ji,jj) = zu / zthick 431 zv_bl(ji,jj) = zv / zthick 432 zdt_bl(ji,jj) = zt_bl(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_tem,Kmm) 433 zds_bl(ji,jj) = zs_bl(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_sal,Kmm) 434 zdu_bl(ji,jj) = zu_bl(ji,jj) - ( uu(ji,jj,ibld(ji,jj),Kbb) + uu(ji-1,jj,ibld(ji,jj) ,Kbb) ) & 435 & / MAX(1. , umask(ji,jj,ibld(ji,jj) ) + umask(ji-1,jj,ibld(ji,jj) ) ) 436 zdv_bl(ji,jj) = zv_bl(ji,jj) - ( vv(ji,jj,ibld(ji,jj),Kbb) + vv(ji,jj-1,ibld(ji,jj) ,Kbb) ) & 437 & / MAX(1. , vmask(ji,jj,ibld(ji,jj) ) + vmask(ji,jj-1,ibld(ji,jj) ) ) 438 zdb_bl(ji,jj) = grav * zthermal * zdt_bl(ji,jj) - grav * zbeta * zds_bl(ji,jj) 439 IF ( lconv(ji,jj) ) THEN ! Convective 440 zwb_ent(ji,jj) = -( 2.0 * 0.2 * zwbav(ji,jj) & 441 & + 0.135 * zla(ji,jj) * zwstrl(ji,jj)**3/hbl(ji,jj) ) 442 443 zvel_max = - ( 1.0 + 1.0 * ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_rdt / hbl(ji,jj) ) & 444 & * zwb_ent(ji,jj) / ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 459 445 ! Entrainment including component due to shear turbulence. Modified Langmuir component, but gives same result for La=0.3 For testing uncomment. 460 446 ! zwb_ent(ji,jj) = -( 2.0 * 0.2 * zwbav(ji,jj) & … … 463 449 ! zvel_max = - ( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_rdt / zhbl(ji,jj) ) * zwb_ent(ji,jj) / & 464 450 ! & ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 465 zzdhdt = - zwb_ent(ji,jj) / ( zvel_max + MAX(zdb_bl(ji,jj),0.0) ) 466 ELSE ! Stable 467 zzdhdt = 0.32 * ( hbli(ji,jj) / hbl(ji,jj) -1.0 ) * zwstrl(ji,jj)**3 / hbli(ji,jj) & 468 & + ( ( 0.32 / 3.0 ) * exp ( -2.5 * ( hbli(ji,jj) / hbl(ji,jj) - 1.0 ) ) & 469 & - ( 0.32 / 3.0 - 0.135 * zla(ji,jj) ) * exp ( -12.5 * ( hbli(ji,jj) / hbl(ji,jj) ) ) ) & 470 & * zwstrl(ji,jj)**3 / hbli(ji,jj) 471 zzdhdt = zzdhdt + zwbav(ji,jj) 472 IF ( zzdhdt < 0._wp ) THEN 473 ! For long timsteps factor in brackets slows the rapid collapse of the OSBL 474 zpert = 2.0 * ( 1.0 + 2.0 * zwstrl(ji,jj) * rn_rdt / hbl(ji,jj) ) * zwstrl(ji,jj)**2 / hbl(ji,jj) 475 ELSE 476 zpert = 2.0 * ( 1.0 + 2.0 * zwstrl(ji,jj) * rn_rdt / hbl(ji,jj) ) * zwstrl(ji,jj)**2 / hbl(ji,jj) & 477 & + MAX( zdb_bl(ji,jj), 0.0 ) 478 ENDIF 479 zzdhdt = 2.0 * zzdhdt / zpert 480 ENDIF 481 zdhdt(ji,jj) = zzdhdt 482 END DO 483 END DO 451 zzdhdt = - zwb_ent(ji,jj) / ( zvel_max + MAX(zdb_bl(ji,jj),0.0) ) 452 ELSE ! Stable 453 zzdhdt = 0.32 * ( hbli(ji,jj) / hbl(ji,jj) -1.0 ) * zwstrl(ji,jj)**3 / hbli(ji,jj) & 454 & + ( ( 0.32 / 3.0 ) * exp ( -2.5 * ( hbli(ji,jj) / hbl(ji,jj) - 1.0 ) ) & 455 & - ( 0.32 / 3.0 - 0.135 * zla(ji,jj) ) * exp ( -12.5 * ( hbli(ji,jj) / hbl(ji,jj) ) ) ) & 456 & * zwstrl(ji,jj)**3 / hbli(ji,jj) 457 zzdhdt = zzdhdt + zwbav(ji,jj) 458 IF ( zzdhdt < 0._wp ) THEN 459 ! For long timsteps factor in brackets slows the rapid collapse of the OSBL 460 zpert = 2.0 * ( 1.0 + 2.0 * zwstrl(ji,jj) * rn_rdt / hbl(ji,jj) ) * zwstrl(ji,jj)**2 / hbl(ji,jj) 461 ELSE 462 zpert = 2.0 * ( 1.0 + 2.0 * zwstrl(ji,jj) * rn_rdt / hbl(ji,jj) ) * zwstrl(ji,jj)**2 / hbl(ji,jj) & 463 & + MAX( zdb_bl(ji,jj), 0.0 ) 464 ENDIF 465 zzdhdt = 2.0 * zzdhdt / zpert 466 ENDIF 467 zdhdt(ji,jj) = zzdhdt 468 END_2D 484 469 485 470 ! Calculate averages over depth of boundary layer … … 487 472 ibld(:,:) = 3 488 473 489 zhbl_t(:,:) = hbl(:,:) + (zdhdt(:,:) - wn(ji,jj,ibld(ji,jj)))* rn_rdt ! certainly need wb here, so subtract it 490 zhbl_t(:,:) = MIN(zhbl_t(:,:), ht_n(:,:)) 491 zdhdt(:,:) = MIN(zdhdt(:,:), (zhbl_t(:,:) - hbl(:,:))/rn_rdt + wn(ji,jj,ibld(ji,jj))) ! adjustment to represent limiting by ocean bottom 492 493 DO jk = 4, jpkm1 494 DO jj = 2, jpjm1 495 DO ji = 2, jpim1 496 IF ( zhbl_t(ji,jj) >= gdepw_n(ji,jj,jk) ) THEN 497 ibld(ji,jj) = MIN(mbkt(ji,jj), jk) 498 ENDIF 499 END DO 500 END DO 501 END DO 474 zhbl_t(:,:) = hbl(:,:) + (zdhdt(:,:) - ww(ji,jj,ibld(ji,jj)))* rn_rdt ! certainly need wb here, so subtract it 475 zhbl_t(:,:) = MIN(zhbl_t(:,:), ht(:,:)) 476 zdhdt(:,:) = MIN(zdhdt(:,:), (zhbl_t(:,:) - hbl(:,:))/rn_rdt + ww(ji,jj,ibld(ji,jj))) ! adjustment to represent limiting by ocean bottom 477 478 DO_3D_00_00( 4, jpkm1 ) 479 IF ( zhbl_t(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) THEN 480 ibld(ji,jj) = MIN(mbkt(ji,jj), jk) 481 ENDIF 482 END_3D 502 483 503 484 ! 504 485 ! Step through model levels taking account of buoyancy change to determine the effect on dhdt 505 486 ! 506 DO jj = 2, jpjm1 507 DO ji = 2, jpim1 508 IF ( ibld(ji,jj) - imld(ji,jj) > 1 ) THEN 487 DO_2D_00_00 488 IF ( ibld(ji,jj) - imld(ji,jj) > 1 ) THEN 509 489 ! 510 490 ! If boundary layer changes by more than one level, need to check for stable layers between initial and final depths. 511 491 ! 512 513 514 515 516 492 zhbl_s = hbl(ji,jj) 493 jm = imld(ji,jj) 494 zthermal = rab_n(ji,jj,1,jp_tem) 495 zbeta = rab_n(ji,jj,1,jp_sal) 496 IF ( lconv(ji,jj) ) THEN 517 497 !unstable 518 519 520 521 522 zdb = MAX( grav * ( zthermal * ( zt_bl(ji,jj) - tsn(ji,jj,jm,jp_tem) ) &523 & - zbeta * ( zs_bl(ji,jj) - tsn(ji,jj,jm,jp_sal) ) ), 0.0 ) + zvel_max524 525 zhbl_s = zhbl_s + MIN( - zwb_ent(ji,jj) / zdb * rn_rdt / FLOAT(ibld(ji,jj)-imld(ji,jj) ), e3w_n(ji,jj,jk) )526 zhbl_s = MIN(zhbl_s, ht_n(ji,jj))527 528 IF ( zhbl_s >= gdepw_n(ji,jj,jm+1) ) jm = jm + 1529 530 531 532 533 498 zvel_max = - ( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_rdt / hbl(ji,jj) ) & 499 & * zwb_ent(ji,jj) / ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 500 501 DO jk = imld(ji,jj), ibld(ji,jj) 502 zdb = MAX( grav * ( zthermal * ( zt_bl(ji,jj) - ts(ji,jj,jm,jp_tem,Kmm) ) & 503 & - zbeta * ( zs_bl(ji,jj) - ts(ji,jj,jm,jp_sal,Kmm) ) ), 0.0 ) + zvel_max 504 505 zhbl_s = zhbl_s + MIN( - zwb_ent(ji,jj) / zdb * rn_rdt / FLOAT(ibld(ji,jj)-imld(ji,jj) ), e3w(ji,jj,jk,Kmm) ) 506 zhbl_s = MIN(zhbl_s, ht(ji,jj)) 507 508 IF ( zhbl_s >= gdepw(ji,jj,jm+1,Kmm) ) jm = jm + 1 509 END DO 510 hbl(ji,jj) = zhbl_s 511 ibld(ji,jj) = jm 512 hbli(ji,jj) = hbl(ji,jj) 513 ELSE 534 514 ! stable 535 DO jk = imld(ji,jj), ibld(ji,jj) 536 zdb = MAX( grav * ( zthermal * ( zt_bl(ji,jj) - tsn(ji,jj,jm,jp_tem) ) & 537 & - zbeta * ( zs_bl(ji,jj) - tsn(ji,jj,jm,jp_sal) ) ), 0.0 ) & 538 & + 2.0 * zwstrl(ji,jj)**2 / zhbl_s 539 540 zhbl_s = zhbl_s + ( & 541 & 0.32 * ( hbli(ji,jj) / zhbl_s -1.0 ) & 542 & * zwstrl(ji,jj)**3 / hbli(ji,jj) & 543 & + ( ( 0.32 / 3.0 ) * EXP( - 2.5 * ( hbli(ji,jj) / zhbl_s -1.0 ) ) & 544 & - ( 0.32 / 3.0 - 0.0485 ) * EXP( - 12.5 * ( hbli(ji,jj) / zhbl_s ) ) ) & 545 & * zwstrl(ji,jj)**3 / hbli(ji,jj) ) / zdb * e3w_n(ji,jj,jk) / zdhdt(ji,jj) ! ALMG to investigate whether need to include wn here 546 547 zhbl_s = MIN(zhbl_s, ht_n(ji,jj)) 548 IF ( zhbl_s >= gdepw_n(ji,jj,jm) ) jm = jm + 1 549 END DO 550 hbl(ji,jj) = MAX(zhbl_s, gdepw_n(ji,jj,3) ) 551 ibld(ji,jj) = MAX(jm, 3 ) 552 IF ( hbl(ji,jj) > hbli(ji,jj) ) hbli(ji,jj) = hbl(ji,jj) 553 ENDIF ! IF ( lconv ) 515 DO jk = imld(ji,jj), ibld(ji,jj) 516 zdb = MAX( grav * ( zthermal * ( zt_bl(ji,jj) - ts(ji,jj,jm,jp_tem,Kmm) ) & 517 & - zbeta * ( zs_bl(ji,jj) - ts(ji,jj,jm,jp_sal,Kmm) ) ), 0.0 ) & 518 & + 2.0 * zwstrl(ji,jj)**2 / zhbl_s 519 520 zhbl_s = zhbl_s + ( & 521 & 0.32 * ( hbli(ji,jj) / zhbl_s -1.0 ) & 522 & * zwstrl(ji,jj)**3 / hbli(ji,jj) & 523 & + ( ( 0.32 / 3.0 ) * EXP( - 2.5 * ( hbli(ji,jj) / zhbl_s -1.0 ) ) & 524 & - ( 0.32 / 3.0 - 0.0485 ) * EXP( - 12.5 * ( hbli(ji,jj) / zhbl_s ) ) ) & 525 & * zwstrl(ji,jj)**3 / hbli(ji,jj) ) / zdb * e3w(ji,jj,jk,Kmm) / zdhdt(ji,jj) ! ALMG to investigate whether need to include ww here 526 527 zhbl_s = MIN(zhbl_s, ht(ji,jj)) 528 IF ( zhbl_s >= gdepw(ji,jj,jm,Kmm) ) jm = jm + 1 529 END DO 530 hbl(ji,jj) = MAX(zhbl_s, gdepw(ji,jj,3,Kmm) ) 531 ibld(ji,jj) = MAX(jm, 3 ) 532 IF ( hbl(ji,jj) > hbli(ji,jj) ) hbli(ji,jj) = hbl(ji,jj) 533 ENDIF ! IF ( lconv ) 534 ELSE 535 ! change zero or one model level. 536 hbl(ji,jj) = zhbl_t(ji,jj) 537 IF ( lconv(ji,jj) ) THEN 538 hbli(ji,jj) = hbl(ji,jj) 554 539 ELSE 555 ! change zero or one model level. 556 hbl(ji,jj) = zhbl_t(ji,jj) 557 IF ( lconv(ji,jj) ) THEN 558 hbli(ji,jj) = hbl(ji,jj) 559 ELSE 560 hbl(ji,jj) = MAX(hbl(ji,jj), gdepw_n(ji,jj,3) ) 561 IF ( hbl(ji,jj) > hbli(ji,jj) ) hbli(ji,jj) = hbl(ji,jj) 562 ENDIF 540 hbl(ji,jj) = MAX(hbl(ji,jj), gdepw(ji,jj,3,Kmm) ) 541 IF ( hbl(ji,jj) > hbli(ji,jj) ) hbli(ji,jj) = hbl(ji,jj) 563 542 ENDIF 564 zhbl(ji,jj) = gdepw_n(ji,jj,ibld(ji,jj))565 END DO566 END DO543 ENDIF 544 zhbl(ji,jj) = gdepw(ji,jj,ibld(ji,jj),Kmm) 545 END_2D 567 546 dstokes(:,:) = MIN ( dstokes(:,:), hbl(:,:)/3. ) ! Limit delta for shallow boundary layers for calculating flux-gradient terms. 568 547 … … 570 549 ! Consider later combining this into the loop above and looking for columns 571 550 ! where the index for base of the boundary layer have changed 572 DO jj = 2, jpjm1 ! Vertical slab 573 DO ji = 2, jpim1 574 zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 575 zbeta = rab_n(ji,jj,1,jp_sal) 576 zt = 0._wp 577 zs = 0._wp 578 zu = 0._wp 579 zv = 0._wp 580 ! average over depth of boundary layer 581 zthick=0._wp 582 DO jm = 2, ibld(ji,jj) 583 zthick=zthick+e3t_n(ji,jj,jm) 584 zt = zt + e3t_n(ji,jj,jm) * tsn(ji,jj,jm,jp_tem) 585 zs = zs + e3t_n(ji,jj,jm) * tsn(ji,jj,jm,jp_sal) 586 zu = zu + e3t_n(ji,jj,jm) & 587 & * ( ub(ji,jj,jm) + ub(ji - 1,jj,jm) ) & 588 & / MAX( 1. , umask(ji,jj,jm) + umask(ji - 1,jj,jm) ) 589 zv = zv + e3t_n(ji,jj,jm) & 590 & * ( vb(ji,jj,jm) + vb(ji,jj - 1,jm) ) & 591 & / MAX( 1. , vmask(ji,jj,jm) + vmask(ji,jj - 1,jm) ) 592 END DO 593 zt_bl(ji,jj) = zt / zthick 594 zs_bl(ji,jj) = zs / zthick 595 zu_bl(ji,jj) = zu / zthick 596 zv_bl(ji,jj) = zv / zthick 597 zdt_bl(ji,jj) = zt_bl(ji,jj) - tsn(ji,jj,ibld(ji,jj),jp_tem) 598 zds_bl(ji,jj) = zs_bl(ji,jj) - tsn(ji,jj,ibld(ji,jj),jp_sal) 599 zdu_bl(ji,jj) = zu_bl(ji,jj) - ( ub(ji,jj,ibld(ji,jj)) + ub(ji-1,jj,ibld(ji,jj) ) ) & 600 & / MAX(1. , umask(ji,jj,ibld(ji,jj) ) + umask(ji-1,jj,ibld(ji,jj) ) ) 601 zdv_bl(ji,jj) = zv_bl(ji,jj) - ( vb(ji,jj,ibld(ji,jj)) + vb(ji,jj-1,ibld(ji,jj) ) ) & 602 & / MAX(1. , vmask(ji,jj,ibld(ji,jj) ) + vmask(ji,jj-1,ibld(ji,jj) ) ) 603 zdb_bl(ji,jj) = grav * zthermal * zdt_bl(ji,jj) - grav * zbeta * zds_bl(ji,jj) 604 zhbl(ji,jj) = gdepw_n(ji,jj,ibld(ji,jj)) 605 IF ( lconv(ji,jj) ) THEN 606 IF ( zdb_bl(ji,jj) > 0._wp )THEN 607 IF ( ( zwstrc(ji,jj) / zvstr(ji,jj) )**3 <= 0.5 ) THEN ! near neutral stability 608 zari = 4.5 * ( zvstr(ji,jj)**2 ) & 609 & / ( zdb_bl(ji,jj) * zhbl(ji,jj) ) + 0.01 610 ELSE ! unstable 611 zari = 4.5 * ( zwstrc(ji,jj)**2 ) & 612 & / ( zdb_bl(ji,jj) * zhbl(ji,jj) ) + 0.01 613 ENDIF 614 IF ( zari > 0.2 ) THEN ! This test checks for weakly stratified pycnocline 615 zari = 0.2 616 zwb_ent(ji,jj) = 0._wp 617 ENDIF 618 inhml = MAX( INT( zari * zhbl(ji,jj) / e3t_n(ji,jj,ibld(ji,jj)) ) , 1 ) 551 DO_2D_00_00 552 zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 553 zbeta = rab_n(ji,jj,1,jp_sal) 554 zt = 0._wp 555 zs = 0._wp 556 zu = 0._wp 557 zv = 0._wp 558 ! average over depth of boundary layer 559 zthick=0._wp 560 DO jm = 2, ibld(ji,jj) 561 zthick=zthick+e3t(ji,jj,jm,Kmm) 562 zt = zt + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_tem,Kmm) 563 zs = zs + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_sal,Kmm) 564 zu = zu + e3t(ji,jj,jm,Kmm) & 565 & * ( uu(ji,jj,jm,Kbb) + uu(ji - 1,jj,jm,Kbb) ) & 566 & / MAX( 1. , umask(ji,jj,jm) + umask(ji - 1,jj,jm) ) 567 zv = zv + e3t(ji,jj,jm,Kmm) & 568 & * ( vv(ji,jj,jm,Kbb) + vv(ji,jj - 1,jm,Kbb) ) & 569 & / MAX( 1. , vmask(ji,jj,jm) + vmask(ji,jj - 1,jm) ) 570 END DO 571 zt_bl(ji,jj) = zt / zthick 572 zs_bl(ji,jj) = zs / zthick 573 zu_bl(ji,jj) = zu / zthick 574 zv_bl(ji,jj) = zv / zthick 575 zdt_bl(ji,jj) = zt_bl(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_tem,Kmm) 576 zds_bl(ji,jj) = zs_bl(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_sal,Kmm) 577 zdu_bl(ji,jj) = zu_bl(ji,jj) - ( uu(ji,jj,ibld(ji,jj),Kbb) + uu(ji-1,jj,ibld(ji,jj) ,Kbb) ) & 578 & / MAX(1. , umask(ji,jj,ibld(ji,jj) ) + umask(ji-1,jj,ibld(ji,jj) ) ) 579 zdv_bl(ji,jj) = zv_bl(ji,jj) - ( vv(ji,jj,ibld(ji,jj),Kbb) + vv(ji,jj-1,ibld(ji,jj) ,Kbb) ) & 580 & / MAX(1. , vmask(ji,jj,ibld(ji,jj) ) + vmask(ji,jj-1,ibld(ji,jj) ) ) 581 zdb_bl(ji,jj) = grav * zthermal * zdt_bl(ji,jj) - grav * zbeta * zds_bl(ji,jj) 582 zhbl(ji,jj) = gdepw(ji,jj,ibld(ji,jj),Kmm) 583 IF ( lconv(ji,jj) ) THEN 584 IF ( zdb_bl(ji,jj) > 0._wp )THEN 585 IF ( ( zwstrc(ji,jj) / zvstr(ji,jj) )**3 <= 0.5 ) THEN ! near neutral stability 586 zari = 4.5 * ( zvstr(ji,jj)**2 ) & 587 & / ( zdb_bl(ji,jj) * zhbl(ji,jj) ) + 0.01 588 ELSE ! unstable 589 zari = 4.5 * ( zwstrc(ji,jj)**2 ) & 590 & / ( zdb_bl(ji,jj) * zhbl(ji,jj) ) + 0.01 591 ENDIF 592 IF ( zari > 0.2 ) THEN ! This test checks for weakly stratified pycnocline 593 zari = 0.2 594 zwb_ent(ji,jj) = 0._wp 595 ENDIF 596 inhml = MAX( INT( zari * zhbl(ji,jj) / e3t(ji,jj,ibld(ji,jj),Kmm) ) , 1 ) 597 imld(ji,jj) = MAX( ibld(ji,jj) - inhml, 1) 598 zhml(ji,jj) = gdepw(ji,jj,imld(ji,jj),Kmm) 599 zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 600 ELSE ! IF (zdb_bl) 601 imld(ji,jj) = ibld(ji,jj) - 1 602 zhml(ji,jj) = gdepw(ji,jj,imld(ji,jj),Kmm) 603 zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 604 ENDIF 605 ELSE ! IF (lconv) 606 IF ( zdhdt(ji,jj) >= 0.0 ) THEN ! probably shouldn't include wm here 607 ! boundary layer deepening 608 IF ( zdb_bl(ji,jj) > 0._wp ) THEN 609 ! pycnocline thickness set by stratification - use same relationship as for neutral conditions. 610 zari = MIN( 4.5 * ( zvstr(ji,jj)**2 ) & 611 & / ( zdb_bl(ji,jj) * zhbl(ji,jj) ) + 0.01 , 0.2 ) 612 inhml = MAX( INT( zari * zhbl(ji,jj) / e3t(ji,jj,ibld(ji,jj),Kmm) ) , 1 ) 619 613 imld(ji,jj) = MAX( ibld(ji,jj) - inhml, 1) 620 zhml(ji,jj) = gdepw _n(ji,jj,imld(ji,jj))614 zhml(ji,jj) = gdepw(ji,jj,imld(ji,jj),Kmm) 621 615 zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 622 ELSE ! IF (zdb_bl)616 ELSE 623 617 imld(ji,jj) = ibld(ji,jj) - 1 624 zhml(ji,jj) = gdepw _n(ji,jj,imld(ji,jj))618 zhml(ji,jj) = gdepw(ji,jj,imld(ji,jj),Kmm) 625 619 zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 626 ENDIF 627 ELSE ! IF (lconv) 628 IF ( zdhdt(ji,jj) >= 0.0 ) THEN ! probably shouldn't include wm here 629 ! boundary layer deepening 630 IF ( zdb_bl(ji,jj) > 0._wp ) THEN 631 ! pycnocline thickness set by stratification - use same relationship as for neutral conditions. 632 zari = MIN( 4.5 * ( zvstr(ji,jj)**2 ) & 633 & / ( zdb_bl(ji,jj) * zhbl(ji,jj) ) + 0.01 , 0.2 ) 634 inhml = MAX( INT( zari * zhbl(ji,jj) / e3t_n(ji,jj,ibld(ji,jj)) ) , 1 ) 635 imld(ji,jj) = MAX( ibld(ji,jj) - inhml, 1) 636 zhml(ji,jj) = gdepw_n(ji,jj,imld(ji,jj)) 637 zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 638 ELSE 639 imld(ji,jj) = ibld(ji,jj) - 1 640 zhml(ji,jj) = gdepw_n(ji,jj,imld(ji,jj)) 641 zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 642 ENDIF ! IF (zdb_bl > 0.0) 643 ELSE ! IF(dhdt >= 0) 644 ! boundary layer collapsing. 645 imld(ji,jj) = ibld(ji,jj) 646 zhml(ji,jj) = zhbl(ji,jj) 647 zdh(ji,jj) = 0._wp 648 ENDIF ! IF (dhdt >= 0) 649 ENDIF ! IF (lconv) 650 END DO 651 END DO 620 ENDIF ! IF (zdb_bl > 0.0) 621 ELSE ! IF(dhdt >= 0) 622 ! boundary layer collapsing. 623 imld(ji,jj) = ibld(ji,jj) 624 zhml(ji,jj) = zhbl(ji,jj) 625 zdh(ji,jj) = 0._wp 626 ENDIF ! IF (dhdt >= 0) 627 ENDIF ! IF (lconv) 628 END_2D 652 629 653 630 ! Average over the depth of the mixed layer in the convective boundary layer 654 631 ! Also calculate entrainment fluxes for temperature and salinity 655 DO jj = 2, jpjm1 ! Vertical slab 656 DO ji = 2, jpim1 657 zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 658 zbeta = rab_n(ji,jj,1,jp_sal) 659 IF ( lconv(ji,jj) ) THEN 632 DO_2D_00_00 633 zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 634 zbeta = rab_n(ji,jj,1,jp_sal) 635 IF ( lconv(ji,jj) ) THEN 636 zt = 0._wp 637 zs = 0._wp 638 zu = 0._wp 639 zv = 0._wp 640 ! average over depth of boundary layer 641 zthick=0._wp 642 DO jm = 2, imld(ji,jj) 643 zthick=zthick+e3t(ji,jj,jm,Kmm) 644 zt = zt + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_tem,Kmm) 645 zs = zs + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_sal,Kmm) 646 zu = zu + e3t(ji,jj,jm,Kmm) & 647 & * ( uu(ji,jj,jm,Kbb) + uu(ji - 1,jj,jm,Kbb) ) & 648 & / MAX( 1. , umask(ji,jj,jm) + umask(ji - 1,jj,jm) ) 649 zv = zv + e3t(ji,jj,jm,Kmm) & 650 & * ( vv(ji,jj,jm,Kbb) + vv(ji,jj - 1,jm,Kbb) ) & 651 & / MAX( 1. , vmask(ji,jj,jm) + vmask(ji,jj - 1,jm) ) 652 END DO 653 zt_ml(ji,jj) = zt / zthick 654 zs_ml(ji,jj) = zs / zthick 655 zu_ml(ji,jj) = zu / zthick 656 zv_ml(ji,jj) = zv / zthick 657 zdt_ml(ji,jj) = zt_ml(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_tem,Kmm) 658 zds_ml(ji,jj) = zs_ml(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_sal,Kmm) 659 zdu_ml(ji,jj) = zu_ml(ji,jj) - ( uu(ji,jj,ibld(ji,jj),Kbb) + uu(ji-1,jj,ibld(ji,jj) ,Kbb) ) & 660 & / MAX(1. , umask(ji,jj,ibld(ji,jj) ) + umask(ji-1,jj,ibld(ji,jj) ) ) 661 zdv_ml(ji,jj) = zv_ml(ji,jj) - ( vv(ji,jj,ibld(ji,jj),Kbb) + vv(ji,jj-1,ibld(ji,jj) ,Kbb) ) & 662 & / MAX(1. , vmask(ji,jj,ibld(ji,jj) ) + vmask(ji,jj-1,ibld(ji,jj) ) ) 663 zdb_ml(ji,jj) = grav * zthermal * zdt_ml(ji,jj) - grav * zbeta * zds_ml(ji,jj) 664 ELSE 665 ! stable, if entraining calulate average below interface layer. 666 IF ( zdhdt(ji,jj) >= 0._wp ) THEN 660 667 zt = 0._wp 661 668 zs = 0._wp … … 665 672 zthick=0._wp 666 673 DO jm = 2, imld(ji,jj) 667 zthick=zthick+e3t _n(ji,jj,jm)668 zt = zt + e3t _n(ji,jj,jm) * tsn(ji,jj,jm,jp_tem)669 zs = zs + e3t _n(ji,jj,jm) * tsn(ji,jj,jm,jp_sal)670 zu = zu + e3t _n(ji,jj,jm) &671 & * ( u b(ji,jj,jm) + ub(ji - 1,jj,jm) ) &674 zthick=zthick+e3t(ji,jj,jm,Kmm) 675 zt = zt + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_tem,Kmm) 676 zs = zs + e3t(ji,jj,jm,Kmm) * ts(ji,jj,jm,jp_sal,Kmm) 677 zu = zu + e3t(ji,jj,jm,Kmm) & 678 & * ( uu(ji,jj,jm,Kbb) + uu(ji - 1,jj,jm,Kbb) ) & 672 679 & / MAX( 1. , umask(ji,jj,jm) + umask(ji - 1,jj,jm) ) 673 zv = zv + e3t _n(ji,jj,jm) &674 & * ( v b(ji,jj,jm) + vb(ji,jj - 1,jm) ) &680 zv = zv + e3t(ji,jj,jm,Kmm) & 681 & * ( vv(ji,jj,jm,Kbb) + vv(ji,jj - 1,jm,Kbb) ) & 675 682 & / MAX( 1. , vmask(ji,jj,jm) + vmask(ji,jj - 1,jm) ) 676 683 END DO … … 679 686 zu_ml(ji,jj) = zu / zthick 680 687 zv_ml(ji,jj) = zv / zthick 681 zdt_ml(ji,jj) = zt_ml(ji,jj) - ts n(ji,jj,ibld(ji,jj),jp_tem)682 zds_ml(ji,jj) = zs_ml(ji,jj) - ts n(ji,jj,ibld(ji,jj),jp_sal)683 zdu_ml(ji,jj) = zu_ml(ji,jj) - ( u b(ji,jj,ibld(ji,jj)) + ub(ji-1,jj,ibld(ji,jj)) ) &688 zdt_ml(ji,jj) = zt_ml(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_tem,Kmm) 689 zds_ml(ji,jj) = zs_ml(ji,jj) - ts(ji,jj,ibld(ji,jj),jp_sal,Kmm) 690 zdu_ml(ji,jj) = zu_ml(ji,jj) - ( uu(ji,jj,ibld(ji,jj),Kbb) + uu(ji-1,jj,ibld(ji,jj) ,Kbb) ) & 684 691 & / MAX(1. , umask(ji,jj,ibld(ji,jj) ) + umask(ji-1,jj,ibld(ji,jj) ) ) 685 zdv_ml(ji,jj) = zv_ml(ji,jj) - ( v b(ji,jj,ibld(ji,jj)) + vb(ji,jj-1,ibld(ji,jj)) ) &692 zdv_ml(ji,jj) = zv_ml(ji,jj) - ( vv(ji,jj,ibld(ji,jj),Kbb) + vv(ji,jj-1,ibld(ji,jj) ,Kbb) ) & 686 693 & / MAX(1. , vmask(ji,jj,ibld(ji,jj) ) + vmask(ji,jj-1,ibld(ji,jj) ) ) 687 694 zdb_ml(ji,jj) = grav * zthermal * zdt_ml(ji,jj) - grav * zbeta * zds_ml(ji,jj) 688 ELSE689 ! stable, if entraining calulate average below interface layer.690 IF ( zdhdt(ji,jj) >= 0._wp ) THEN691 zt = 0._wp692 zs = 0._wp693 zu = 0._wp694 zv = 0._wp695 ! average over depth of boundary layer696 zthick=0._wp697 DO jm = 2, imld(ji,jj)698 zthick=zthick+e3t_n(ji,jj,jm)699 zt = zt + e3t_n(ji,jj,jm) * tsn(ji,jj,jm,jp_tem)700 zs = zs + e3t_n(ji,jj,jm) * tsn(ji,jj,jm,jp_sal)701 zu = zu + e3t_n(ji,jj,jm) &702 & * ( ub(ji,jj,jm) + ub(ji - 1,jj,jm) ) &703 & / MAX( 1. , umask(ji,jj,jm) + umask(ji - 1,jj,jm) )704 zv = zv + e3t_n(ji,jj,jm) &705 & * ( vb(ji,jj,jm) + vb(ji,jj - 1,jm) ) &706 & / MAX( 1. , vmask(ji,jj,jm) + vmask(ji,jj - 1,jm) )707 END DO708 zt_ml(ji,jj) = zt / zthick709 zs_ml(ji,jj) = zs / zthick710 zu_ml(ji,jj) = zu / zthick711 zv_ml(ji,jj) = zv / zthick712 zdt_ml(ji,jj) = zt_ml(ji,jj) - tsn(ji,jj,ibld(ji,jj),jp_tem)713 zds_ml(ji,jj) = zs_ml(ji,jj) - tsn(ji,jj,ibld(ji,jj),jp_sal)714 zdu_ml(ji,jj) = zu_ml(ji,jj) - ( ub(ji,jj,ibld(ji,jj)) + ub(ji-1,jj,ibld(ji,jj) ) ) &715 & / MAX(1. , umask(ji,jj,ibld(ji,jj) ) + umask(ji-1,jj,ibld(ji,jj) ) )716 zdv_ml(ji,jj) = zv_ml(ji,jj) - ( vb(ji,jj,ibld(ji,jj)) + vb(ji,jj-1,ibld(ji,jj) ) ) &717 & / MAX(1. , vmask(ji,jj,ibld(ji,jj) ) + vmask(ji,jj-1,ibld(ji,jj) ) )718 zdb_ml(ji,jj) = grav * zthermal * zdt_ml(ji,jj) - grav * zbeta * zds_ml(ji,jj)719 ENDIF720 695 ENDIF 721 END DO722 END DO696 ENDIF 697 END_2D 723 698 ! 724 699 ! rotate mean currents and changes onto wind align co-ordinates 725 700 ! 726 701 727 DO jj = 2, jpjm1 728 DO ji = 2, jpim1 729 ztemp = zu_ml(ji,jj) 730 zu_ml(ji,jj) = zu_ml(ji,jj) * zcos_wind(ji,jj) + zv_ml(ji,jj) * zsin_wind(ji,jj) 731 zv_ml(ji,jj) = zv_ml(ji,jj) * zcos_wind(ji,jj) - ztemp * zsin_wind(ji,jj) 732 ztemp = zdu_ml(ji,jj) 733 zdu_ml(ji,jj) = zdu_ml(ji,jj) * zcos_wind(ji,jj) + zdv_ml(ji,jj) * zsin_wind(ji,jj) 734 zdv_ml(ji,jj) = zdv_ml(ji,jj) * zsin_wind(ji,jj) - ztemp * zsin_wind(ji,jj) 735 ! 736 ztemp = zu_bl(ji,jj) 737 zu_bl = zu_bl(ji,jj) * zcos_wind(ji,jj) + zv_bl(ji,jj) * zsin_wind(ji,jj) 738 zv_bl(ji,jj) = zv_bl(ji,jj) * zcos_wind(ji,jj) - ztemp * zsin_wind(ji,jj) 739 ztemp = zdu_bl(ji,jj) 740 zdu_bl(ji,jj) = zdu_bl(ji,jj) * zcos_wind(ji,jj) + zdv_bl(ji,jj) * zsin_wind(ji,jj) 741 zdv_bl(ji,jj) = zdv_bl(ji,jj) * zsin_wind(ji,jj) - ztemp * zsin_wind(ji,jj) 742 END DO 743 END DO 702 DO_2D_00_00 703 ztemp = zu_ml(ji,jj) 704 zu_ml(ji,jj) = zu_ml(ji,jj) * zcos_wind(ji,jj) + zv_ml(ji,jj) * zsin_wind(ji,jj) 705 zv_ml(ji,jj) = zv_ml(ji,jj) * zcos_wind(ji,jj) - ztemp * zsin_wind(ji,jj) 706 ztemp = zdu_ml(ji,jj) 707 zdu_ml(ji,jj) = zdu_ml(ji,jj) * zcos_wind(ji,jj) + zdv_ml(ji,jj) * zsin_wind(ji,jj) 708 zdv_ml(ji,jj) = zdv_ml(ji,jj) * zsin_wind(ji,jj) - ztemp * zsin_wind(ji,jj) 709 ! 710 ztemp = zu_bl(ji,jj) 711 zu_bl = zu_bl(ji,jj) * zcos_wind(ji,jj) + zv_bl(ji,jj) * zsin_wind(ji,jj) 712 zv_bl(ji,jj) = zv_bl(ji,jj) * zcos_wind(ji,jj) - ztemp * zsin_wind(ji,jj) 713 ztemp = zdu_bl(ji,jj) 714 zdu_bl(ji,jj) = zdu_bl(ji,jj) * zcos_wind(ji,jj) + zdv_bl(ji,jj) * zsin_wind(ji,jj) 715 zdv_bl(ji,jj) = zdv_bl(ji,jj) * zsin_wind(ji,jj) - ztemp * zsin_wind(ji,jj) 716 END_2D 744 717 745 718 zuw_bse = 0._wp 746 719 zvw_bse = 0._wp 747 DO jj = 2, jpjm1 748 DO ji = 2, jpim1 749 750 IF ( lconv(ji,jj) ) THEN 751 IF ( zdb_bl(ji,jj) > 0._wp ) THEN 752 zwth_ent(ji,jj) = zwb_ent(ji,jj) * zdt_ml(ji,jj) / (zdb_ml(ji,jj) + epsln) 753 zws_ent(ji,jj) = zwb_ent(ji,jj) * zds_ml(ji,jj) / (zdb_ml(ji,jj) + epsln) 754 ENDIF 755 ELSE 756 zwth_ent(ji,jj) = -2.0 * zwthav(ji,jj) * ( (1.0 - 0.8) - ( 1.0 - 0.8)**(3.0/2.0) ) 757 zws_ent(ji,jj) = -2.0 * zwsav(ji,jj) * ( (1.0 - 0.8 ) - ( 1.0 - 0.8 )**(3.0/2.0) ) 720 DO_2D_00_00 721 722 IF ( lconv(ji,jj) ) THEN 723 IF ( zdb_bl(ji,jj) > 0._wp ) THEN 724 zwth_ent(ji,jj) = zwb_ent(ji,jj) * zdt_ml(ji,jj) / (zdb_ml(ji,jj) + epsln) 725 zws_ent(ji,jj) = zwb_ent(ji,jj) * zds_ml(ji,jj) / (zdb_ml(ji,jj) + epsln) 758 726 ENDIF 759 END DO 760 END DO 727 ELSE 728 zwth_ent(ji,jj) = -2.0 * zwthav(ji,jj) * ( (1.0 - 0.8) - ( 1.0 - 0.8)**(3.0/2.0) ) 729 zws_ent(ji,jj) = -2.0 * zwsav(ji,jj) * ( (1.0 - 0.8 ) - ( 1.0 - 0.8 )**(3.0/2.0) ) 730 ENDIF 731 END_2D 761 732 762 733 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 764 735 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 765 736 766 DO jj = 2, jpjm1 767 DO ji = 2, jpim1 768 ! 769 IF ( lconv (ji,jj) ) THEN 770 ! Unstable conditions 771 IF( zdb_bl(ji,jj) > 0._wp ) THEN 772 ! calculate pycnocline profiles, no need if zdb_bl <= 0. since profile is zero and arrays have been initialized to zero 773 ztgrad = ( zdt_ml(ji,jj) / zdh(ji,jj) ) 774 zsgrad = ( zds_ml(ji,jj) / zdh(ji,jj) ) 775 zbgrad = ( zdb_ml(ji,jj) / zdh(ji,jj) ) 776 DO jk = 2 , ibld(ji,jj) 777 znd = -( gdepw_n(ji,jj,jk) - zhml(ji,jj) ) / zdh(ji,jj) 778 zdtdz_pyc(ji,jj,jk) = ztgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 779 zdbdz_pyc(ji,jj,jk) = zbgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 780 zdsdz_pyc(ji,jj,jk) = zsgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 781 END DO 782 ENDIF 783 ELSE 784 ! stable conditions 785 ! if pycnocline profile only defined when depth steady of increasing. 786 IF ( zdhdt(ji,jj) >= 0.0 ) THEN ! Depth increasing, or steady. 787 IF ( zdb_bl(ji,jj) > 0._wp ) THEN 788 IF ( zhol(ji,jj) >= 0.5 ) THEN ! Very stable - 'thick' pycnocline 789 ztgrad = zdt_bl(ji,jj) / zhbl(ji,jj) 790 zsgrad = zds_bl(ji,jj) / zhbl(ji,jj) 791 zbgrad = zdb_bl(ji,jj) / zhbl(ji,jj) 792 DO jk = 2, ibld(ji,jj) 793 znd = gdepw_n(ji,jj,jk) / zhbl(ji,jj) 794 zdtdz_pyc(ji,jj,jk) = ztgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 795 zdbdz_pyc(ji,jj,jk) = zbgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 796 zdsdz_pyc(ji,jj,jk) = zsgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 797 END DO 798 ELSE ! Slightly stable - 'thin' pycnoline - needed when stable layer begins to form. 799 ztgrad = zdt_bl(ji,jj) / zdh(ji,jj) 800 zsgrad = zds_bl(ji,jj) / zdh(ji,jj) 801 zbgrad = zdb_bl(ji,jj) / zdh(ji,jj) 802 DO jk = 2, ibld(ji,jj) 803 znd = -( gdepw_n(ji,jj,jk) - zhml(ji,jj) ) / zdh(ji,jj) 804 zdtdz_pyc(ji,jj,jk) = ztgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 805 zdbdz_pyc(ji,jj,jk) = zbgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 806 zdsdz_pyc(ji,jj,jk) = zsgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 807 END DO 808 ENDIF ! IF (zhol >=0.5) 809 ENDIF ! IF (zdb_bl> 0.) 810 ENDIF ! IF (zdhdt >= 0) zdhdt < 0 not considered since pycnocline profile is zero, profile arrays are intialized to zero 811 ENDIF ! IF (lconv) 812 ! 813 END DO 814 END DO 815 ! 816 DO jj = 2, jpjm1 817 DO ji = 2, jpim1 818 ! 819 IF ( lconv (ji,jj) ) THEN 820 ! Unstable conditions 821 zugrad = ( zdu_ml(ji,jj) / zdh(ji,jj) ) + 0.275 * zustar(ji,jj)*zustar(ji,jj) / & 822 & (( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * zhml(ji,jj) ) / zla(ji,jj)**(8.0/3.0) 823 zvgrad = ( zdv_ml(ji,jj) / zdh(ji,jj) ) + 3.5 * ff_t(ji,jj) * zustke(ji,jj) / & 824 & ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 825 DO jk = 2 , ibld(ji,jj)-1 826 znd = -( gdepw_n(ji,jj,jk) - zhml(ji,jj) ) / zdh(ji,jj) 827 zdudz_pyc(ji,jj,jk) = zugrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 828 zdvdz_pyc(ji,jj,jk) = zvgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 829 END DO 830 ELSE 831 ! stable conditions 832 zugrad = 3.25 * zdu_bl(ji,jj) / zhbl(ji,jj) 833 zvgrad = 2.75 * zdv_bl(ji,jj) / zhbl(ji,jj) 834 DO jk = 2, ibld(ji,jj) 835 znd = gdepw_n(ji,jj,jk) / zhbl(ji,jj) 836 IF ( znd < 1.0 ) THEN 837 zdudz_pyc(ji,jj,jk) = zugrad * EXP( -40.0 * ( znd - 1.0 )**2 ) 838 ELSE 839 zdudz_pyc(ji,jj,jk) = zugrad * EXP( -20.0 * ( znd - 1.0 )**2 ) 840 ENDIF 841 zdvdz_pyc(ji,jj,jk) = zvgrad * EXP( -20.0 * ( znd - 0.85 )**2 ) 737 DO_2D_00_00 738 ! 739 IF ( lconv (ji,jj) ) THEN 740 ! Unstable conditions 741 IF( zdb_bl(ji,jj) > 0._wp ) THEN 742 ! calculate pycnocline profiles, no need if zdb_bl <= 0. since profile is zero and arrays have been initialized to zero 743 ztgrad = ( zdt_ml(ji,jj) / zdh(ji,jj) ) 744 zsgrad = ( zds_ml(ji,jj) / zdh(ji,jj) ) 745 zbgrad = ( zdb_ml(ji,jj) / zdh(ji,jj) ) 746 DO jk = 2 , ibld(ji,jj) 747 znd = -( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zdh(ji,jj) 748 zdtdz_pyc(ji,jj,jk) = ztgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 749 zdbdz_pyc(ji,jj,jk) = zbgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 750 zdsdz_pyc(ji,jj,jk) = zsgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 842 751 END DO 843 752 ENDIF 844 ! 845 END DO 846 END DO 753 ELSE 754 ! stable conditions 755 ! if pycnocline profile only defined when depth steady of increasing. 756 IF ( zdhdt(ji,jj) >= 0.0 ) THEN ! Depth increasing, or steady. 757 IF ( zdb_bl(ji,jj) > 0._wp ) THEN 758 IF ( zhol(ji,jj) >= 0.5 ) THEN ! Very stable - 'thick' pycnocline 759 ztgrad = zdt_bl(ji,jj) / zhbl(ji,jj) 760 zsgrad = zds_bl(ji,jj) / zhbl(ji,jj) 761 zbgrad = zdb_bl(ji,jj) / zhbl(ji,jj) 762 DO jk = 2, ibld(ji,jj) 763 znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 764 zdtdz_pyc(ji,jj,jk) = ztgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 765 zdbdz_pyc(ji,jj,jk) = zbgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 766 zdsdz_pyc(ji,jj,jk) = zsgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 767 END DO 768 ELSE ! Slightly stable - 'thin' pycnoline - needed when stable layer begins to form. 769 ztgrad = zdt_bl(ji,jj) / zdh(ji,jj) 770 zsgrad = zds_bl(ji,jj) / zdh(ji,jj) 771 zbgrad = zdb_bl(ji,jj) / zdh(ji,jj) 772 DO jk = 2, ibld(ji,jj) 773 znd = -( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zdh(ji,jj) 774 zdtdz_pyc(ji,jj,jk) = ztgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 775 zdbdz_pyc(ji,jj,jk) = zbgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 776 zdsdz_pyc(ji,jj,jk) = zsgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 777 END DO 778 ENDIF ! IF (zhol >=0.5) 779 ENDIF ! IF (zdb_bl> 0.) 780 ENDIF ! IF (zdhdt >= 0) zdhdt < 0 not considered since pycnocline profile is zero, profile arrays are intialized to zero 781 ENDIF ! IF (lconv) 782 ! 783 END_2D 784 ! 785 DO_2D_00_00 786 ! 787 IF ( lconv (ji,jj) ) THEN 788 ! Unstable conditions 789 zugrad = ( zdu_ml(ji,jj) / zdh(ji,jj) ) + 0.275 * zustar(ji,jj)*zustar(ji,jj) / & 790 & (( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * zhml(ji,jj) ) / zla(ji,jj)**(8.0/3.0) 791 zvgrad = ( zdv_ml(ji,jj) / zdh(ji,jj) ) + 3.5 * ff_t(ji,jj) * zustke(ji,jj) / & 792 & ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 793 DO jk = 2 , ibld(ji,jj)-1 794 znd = -( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zdh(ji,jj) 795 zdudz_pyc(ji,jj,jk) = zugrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 796 zdvdz_pyc(ji,jj,jk) = zvgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 797 END DO 798 ELSE 799 ! stable conditions 800 zugrad = 3.25 * zdu_bl(ji,jj) / zhbl(ji,jj) 801 zvgrad = 2.75 * zdv_bl(ji,jj) / zhbl(ji,jj) 802 DO jk = 2, ibld(ji,jj) 803 znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 804 IF ( znd < 1.0 ) THEN 805 zdudz_pyc(ji,jj,jk) = zugrad * EXP( -40.0 * ( znd - 1.0 )**2 ) 806 ELSE 807 zdudz_pyc(ji,jj,jk) = zugrad * EXP( -20.0 * ( znd - 1.0 )**2 ) 808 ENDIF 809 zdvdz_pyc(ji,jj,jk) = zvgrad * EXP( -20.0 * ( znd - 0.85 )**2 ) 810 END DO 811 ENDIF 812 ! 813 END_2D 847 814 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 848 815 ! Eddy viscosity/diffusivity and non-gradient terms in the flux-gradient relationship … … 860 827 ! zvisml_sc = zwstrl * zhbl * EXP ( -( zhol / 0.183_wp )**2 ) 861 828 ! ENDWHERE 862 DO jj = 2, jpjm1 863 DO ji = 2, jpim1 864 IF ( lconv(ji,jj) ) THEN 865 zdifml_sc(ji,jj) = zhml(ji,jj) * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 866 zvisml_sc(ji,jj) = zdifml_sc(ji,jj) 867 zdifpyc_sc(ji,jj) = 0.165 * ( zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3 )**pthird * zdh(ji,jj) 868 zvispyc_sc(ji,jj) = 0.142 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * zdh(ji,jj) 869 zbeta_d_sc(ji,jj) = 1.0 - (0.165 / 0.8 * zdh(ji,jj) / zhbl(ji,jj) )**p2third 870 zbeta_v_sc(ji,jj) = 1.0 - 2.0 * (0.142 /0.375) * zdh(ji,jj) / zhml(ji,jj) 871 ELSE 872 zdifml_sc(ji,jj) = zvstr(ji,jj) * zhbl(ji,jj) * EXP ( -( zhol(ji,jj) / 0.6_wp )**2 ) 873 zvisml_sc(ji,jj) = zvstr(ji,jj) * zhbl(ji,jj) * EXP ( -( zhol(ji,jj) / 0.6_wp )**2 ) 874 END IF 875 END DO 876 END DO 829 DO_2D_00_00 830 IF ( lconv(ji,jj) ) THEN 831 zdifml_sc(ji,jj) = zhml(ji,jj) * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 832 zvisml_sc(ji,jj) = zdifml_sc(ji,jj) 833 zdifpyc_sc(ji,jj) = 0.165 * ( zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3 )**pthird * zdh(ji,jj) 834 zvispyc_sc(ji,jj) = 0.142 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * zdh(ji,jj) 835 zbeta_d_sc(ji,jj) = 1.0 - (0.165 / 0.8 * zdh(ji,jj) / zhbl(ji,jj) )**p2third 836 zbeta_v_sc(ji,jj) = 1.0 - 2.0 * (0.142 /0.375) * zdh(ji,jj) / zhml(ji,jj) 837 ELSE 838 zdifml_sc(ji,jj) = zvstr(ji,jj) * zhbl(ji,jj) * EXP ( -( zhol(ji,jj) / 0.6_wp )**2 ) 839 zvisml_sc(ji,jj) = zvstr(ji,jj) * zhbl(ji,jj) * EXP ( -( zhol(ji,jj) / 0.6_wp )**2 ) 840 END IF 841 END_2D 877 842 ! 878 DO jj = 2, jpjm1 879 DO ji = 2, jpim1 880 IF ( lconv(ji,jj) ) THEN 881 DO jk = 2, imld(ji,jj) ! mixed layer diffusivity 882 zznd_ml = gdepw_n(ji,jj,jk) / zhml(ji,jj) 843 DO_2D_00_00 844 IF ( lconv(ji,jj) ) THEN 845 DO jk = 2, imld(ji,jj) ! mixed layer diffusivity 846 zznd_ml = gdepw(ji,jj,jk,Kmm) / zhml(ji,jj) 847 ! 848 zdiffut(ji,jj,jk) = 0.8 * zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_d_sc(ji,jj) * zznd_ml )**1.5 849 ! 850 zviscos(ji,jj,jk) = 0.375 * zvisml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_v_sc(ji,jj) * zznd_ml ) & 851 & * ( 1.0 - 0.5 * zznd_ml**2 ) 852 END DO 853 ! pycnocline - if present linear profile 854 IF ( zdh(ji,jj) > 0._wp ) THEN 855 DO jk = imld(ji,jj)+1 , ibld(ji,jj) 856 zznd_pyc = -( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zdh(ji,jj) 883 857 ! 884 zdiffut(ji,jj,jk) = 0.8 * zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_d_sc(ji,jj) * zznd_ml )**1.5858 zdiffut(ji,jj,jk) = zdifpyc_sc(ji,jj) * ( 1.0 + zznd_pyc ) 885 859 ! 886 zviscos(ji,jj,jk) = 0.375 * zvisml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_v_sc(ji,jj) * zznd_ml ) & 887 & * ( 1.0 - 0.5 * zznd_ml**2 ) 860 zviscos(ji,jj,jk) = zvispyc_sc(ji,jj) * ( 1.0 + zznd_pyc ) 888 861 END DO 889 ! pycnocline - if present linear profile 890 IF ( zdh(ji,jj) > 0._wp ) THEN 891 DO jk = imld(ji,jj)+1 , ibld(ji,jj) 892 zznd_pyc = -( gdepw_n(ji,jj,jk) - zhml(ji,jj) ) / zdh(ji,jj) 893 ! 894 zdiffut(ji,jj,jk) = zdifpyc_sc(ji,jj) * ( 1.0 + zznd_pyc ) 895 ! 896 zviscos(ji,jj,jk) = zvispyc_sc(ji,jj) * ( 1.0 + zznd_pyc ) 897 END DO 898 ENDIF 899 ! Temporay fix to ensure zdiffut is +ve; won't be necessary with wn taken out 900 zdiffut(ji,jj,ibld(ji,jj)) = zdhdt(ji,jj)* e3t_n(ji,jj,ibld(ji,jj)) 901 ! could be taken out, take account of entrainment represents as a diffusivity 902 ! should remove w from here, represents entrainment 903 ELSE 904 ! stable conditions 905 DO jk = 2, ibld(ji,jj) 906 zznd_ml = gdepw_n(ji,jj,jk) / zhbl(ji,jj) 907 zdiffut(ji,jj,jk) = 0.75 * zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zznd_ml )**1.5 908 zviscos(ji,jj,jk) = 0.375 * zvisml_sc(ji,jj) * zznd_ml * (1.0 - zznd_ml) * ( 1.0 - zznd_ml**2 ) 909 END DO 910 ENDIF ! end if ( lconv ) 862 ENDIF 863 ! Temporay fix to ensure zdiffut is +ve; won't be necessary with ww taken out 864 zdiffut(ji,jj,ibld(ji,jj)) = zdhdt(ji,jj)* e3t(ji,jj,ibld(ji,jj),Kmm) 865 ! could be taken out, take account of entrainment represents as a diffusivity 866 ! should remove w from here, represents entrainment 867 ELSE 868 ! stable conditions 869 DO jk = 2, ibld(ji,jj) 870 zznd_ml = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 871 zdiffut(ji,jj,jk) = 0.75 * zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zznd_ml )**1.5 872 zviscos(ji,jj,jk) = 0.375 * zvisml_sc(ji,jj) * zznd_ml * (1.0 - zznd_ml) * ( 1.0 - zznd_ml**2 ) 873 END DO 874 ENDIF ! end if ( lconv ) 911 875 ! 912 END DO ! end of ji loop 913 END DO ! end of jj loop 876 END_2D 914 877 915 878 ! … … 928 891 929 892 930 DO jj = 2, jpjm1 931 DO ji = 2, jpim1 932 IF ( lconv(ji,jj) ) THEN 933 DO jk = 2, imld(ji,jj) 934 zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj) 935 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 1.35 * EXP ( -zznd_d ) * ( 1.0 - EXP ( -2.0 * zznd_d ) ) * zsc_wth_1(ji,jj) 936 ! 937 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 1.35 * EXP ( -zznd_d ) * ( 1.0 - EXP ( -2.0 * zznd_d ) ) * zsc_ws_1(ji,jj) 938 END DO ! end jk loop 939 ELSE ! else for if (lconv) 893 DO_2D_00_00 894 IF ( lconv(ji,jj) ) THEN 895 DO jk = 2, imld(ji,jj) 896 zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 897 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 1.35 * EXP ( -zznd_d ) * ( 1.0 - EXP ( -2.0 * zznd_d ) ) * zsc_wth_1(ji,jj) 898 ! 899 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 1.35 * EXP ( -zznd_d ) * ( 1.0 - EXP ( -2.0 * zznd_d ) ) * zsc_ws_1(ji,jj) 900 END DO ! end jk loop 901 ELSE ! else for if (lconv) 940 902 ! Stable conditions 941 DO jk = 2, ibld(ji,jj) 942 zznd_d=gdepw_n(ji,jj,jk) / dstokes(ji,jj) 943 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 1.5 * EXP ( -0.9 * zznd_d ) & 944 & * ( 1.0 - EXP ( -4.0 * zznd_d ) ) * zsc_wth_1(ji,jj) 945 ! 946 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 1.5 * EXP ( -0.9 * zznd_d ) & 947 & * ( 1.0 - EXP ( -4.0 * zznd_d ) ) * zsc_ws_1(ji,jj) 948 END DO 949 ENDIF ! endif for check on lconv 950 951 END DO ! end of ji loop 952 END DO ! end of jj loop 903 DO jk = 2, ibld(ji,jj) 904 zznd_d=gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 905 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 1.5 * EXP ( -0.9 * zznd_d ) & 906 & * ( 1.0 - EXP ( -4.0 * zznd_d ) ) * zsc_wth_1(ji,jj) 907 ! 908 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 1.5 * EXP ( -0.9 * zznd_d ) & 909 & * ( 1.0 - EXP ( -4.0 * zznd_d ) ) * zsc_ws_1(ji,jj) 910 END DO 911 ENDIF ! endif for check on lconv 912 913 END_2D 953 914 954 915 … … 963 924 ENDWHERE 964 925 965 DO jj = 2, jpjm1 966 DO ji = 2, jpim1 967 IF ( lconv(ji,jj) ) THEN 968 DO jk = 2, imld(ji,jj) 969 zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj) 970 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + ( -0.05 * EXP ( -0.4 * zznd_d ) * zsc_uw_1(ji,jj) & 971 & + 0.00125 * EXP ( - zznd_d ) * zsc_uw_2(ji,jj) ) & 972 & * ( 1.0 - EXP ( -2.0 * zznd_d ) ) 926 DO_2D_00_00 927 IF ( lconv(ji,jj) ) THEN 928 DO jk = 2, imld(ji,jj) 929 zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 930 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + ( -0.05 * EXP ( -0.4 * zznd_d ) * zsc_uw_1(ji,jj) & 931 & + 0.00125 * EXP ( - zznd_d ) * zsc_uw_2(ji,jj) ) & 932 & * ( 1.0 - EXP ( -2.0 * zznd_d ) ) 973 933 ! 974 975 976 977 934 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) - 0.65 * 0.15 * EXP ( - zznd_d ) & 935 & * ( 1.0 - EXP ( -2.0 * zznd_d ) ) * zsc_vw_1(ji,jj) 936 END DO ! end jk loop 937 ELSE 978 938 ! Stable conditions 979 DO jk = 2, ibld(ji,jj) ! corrected to ibld 980 zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj) 981 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) - 0.75 * 1.3 * EXP ( -0.5 * zznd_d ) & 982 & * ( 1.0 - EXP ( -4.0 * zznd_d ) ) * zsc_uw_1(ji,jj) 983 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + 0._wp 984 END DO ! end jk loop 985 ENDIF 986 END DO ! ji loop 987 END DO ! jj loo 939 DO jk = 2, ibld(ji,jj) ! corrected to ibld 940 zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 941 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) - 0.75 * 1.3 * EXP ( -0.5 * zznd_d ) & 942 & * ( 1.0 - EXP ( -4.0 * zznd_d ) ) * zsc_uw_1(ji,jj) 943 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + 0._wp 944 END DO ! end jk loop 945 ENDIF 946 END_2D 988 947 989 948 ! Buoyancy term in flux-gradient relationship [note : includes ROI ratio (X0.3) and pressure (X0.5)] … … 997 956 ENDWHERE 998 957 999 DO jj = 2, jpjm1 1000 DO ji = 2, jpim1 1001 IF (lconv(ji,jj) ) THEN 1002 DO jk = 2, imld(ji,jj) 1003 zznd_ml = gdepw_n(ji,jj,jk) / zhml(ji,jj) 1004 ! calculate turbulent length scale 1005 zl_c = 0.9 * ( 1.0 - EXP ( - 7.0 * ( zznd_ml - zznd_ml**3 / 3.0 ) ) ) & 1006 & * ( 1.0 - EXP ( -15.0 * ( 1.1 - zznd_ml ) ) ) 1007 zl_l = 2.0 * ( 1.0 - EXP ( - 2.0 * ( zznd_ml - zznd_ml**3 / 3.0 ) ) ) & 1008 & * ( 1.0 - EXP ( - 5.0 * ( 1.0 - zznd_ml ) ) ) * ( 1.0 + dstokes(ji,jj) / zhml (ji,jj) ) 1009 zl_eps = zl_l + ( zl_c - zl_l ) / ( 1.0 + EXP ( 3.0 * LOG10 ( - zhol(ji,jj) ) ) ) ** (3.0/2.0) 1010 ! non-gradient buoyancy terms 1011 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * 0.5 * zsc_wth_1(ji,jj) * zl_eps * zhml(ji,jj) / ( 0.15 + zznd_ml ) 1012 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * 0.5 * zsc_ws_1(ji,jj) * zl_eps * zhml(ji,jj) / ( 0.15 + zznd_ml ) 1013 END DO 1014 ELSE 1015 DO jk = 2, ibld(ji,jj) 1016 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zsc_wth_1(ji,jj) 1017 ghams(ji,jj,jk) = ghams(ji,jj,jk) + zsc_ws_1(ji,jj) 1018 END DO 1019 ENDIF 1020 END DO ! ji loop 1021 END DO ! jj loop 958 DO_2D_00_00 959 IF (lconv(ji,jj) ) THEN 960 DO jk = 2, imld(ji,jj) 961 zznd_ml = gdepw(ji,jj,jk,Kmm) / zhml(ji,jj) 962 ! calculate turbulent length scale 963 zl_c = 0.9 * ( 1.0 - EXP ( - 7.0 * ( zznd_ml - zznd_ml**3 / 3.0 ) ) ) & 964 & * ( 1.0 - EXP ( -15.0 * ( 1.1 - zznd_ml ) ) ) 965 zl_l = 2.0 * ( 1.0 - EXP ( - 2.0 * ( zznd_ml - zznd_ml**3 / 3.0 ) ) ) & 966 & * ( 1.0 - EXP ( - 5.0 * ( 1.0 - zznd_ml ) ) ) * ( 1.0 + dstokes(ji,jj) / zhml (ji,jj) ) 967 zl_eps = zl_l + ( zl_c - zl_l ) / ( 1.0 + EXP ( 3.0 * LOG10 ( - zhol(ji,jj) ) ) ) ** (3.0/2.0) 968 ! non-gradient buoyancy terms 969 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * 0.5 * zsc_wth_1(ji,jj) * zl_eps * zhml(ji,jj) / ( 0.15 + zznd_ml ) 970 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * 0.5 * zsc_ws_1(ji,jj) * zl_eps * zhml(ji,jj) / ( 0.15 + zznd_ml ) 971 END DO 972 ELSE 973 DO jk = 2, ibld(ji,jj) 974 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zsc_wth_1(ji,jj) 975 ghams(ji,jj,jk) = ghams(ji,jj,jk) + zsc_ws_1(ji,jj) 976 END DO 977 ENDIF 978 END_2D 1022 979 1023 980 … … 1031 988 ENDWHERE 1032 989 1033 DO jj = 2, jpjm1 1034 DO ji = 2, jpim1 1035 IF ( lconv(ji,jj) ) THEN 1036 DO jk = 2 , imld(ji,jj) 1037 zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj) 1038 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + 0.3 * 0.5 * ( zsc_uw_1(ji,jj) + 0.125 * EXP( -0.5 * zznd_d ) & 1039 & * ( 1.0 - EXP( -0.5 * zznd_d ) ) & 1040 & * zsc_uw_2(ji,jj) ) 1041 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zsc_vw_1(ji,jj) 1042 END DO ! jk loop 1043 ELSE 1044 ! stable conditions 1045 DO jk = 2, ibld(ji,jj) 1046 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zsc_uw_1(ji,jj) 1047 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zsc_vw_1(ji,jj) 1048 END DO 1049 ENDIF 1050 END DO ! ji loop 1051 END DO ! jj loop 990 DO_2D_00_00 991 IF ( lconv(ji,jj) ) THEN 992 DO jk = 2 , imld(ji,jj) 993 zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 994 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + 0.3 * 0.5 * ( zsc_uw_1(ji,jj) + 0.125 * EXP( -0.5 * zznd_d ) & 995 & * ( 1.0 - EXP( -0.5 * zznd_d ) ) & 996 & * zsc_uw_2(ji,jj) ) 997 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zsc_vw_1(ji,jj) 998 END DO ! jk loop 999 ELSE 1000 ! stable conditions 1001 DO jk = 2, ibld(ji,jj) 1002 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zsc_uw_1(ji,jj) 1003 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zsc_vw_1(ji,jj) 1004 END DO 1005 ENDIF 1006 END_2D 1052 1007 1053 1008 ! Transport term in flux-gradient relationship [note : includes ROI ratio (X0.3) ] … … 1061 1016 ENDWHERE 1062 1017 1063 DO jj = 2, jpjm1 1064 DO ji = 2, jpim1 1065 IF ( lconv(ji,jj) ) THEN 1066 DO jk = 2, imld(ji,jj) 1067 zznd_ml=gdepw_n(ji,jj,jk) / zhml(ji,jj) 1068 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * zsc_wth_1(ji,jj) & 1069 & * ( -2.0 + 2.75 * ( ( 1.0 + 0.6 * zznd_ml**4 ) & 1070 & - EXP( - 6.0 * zznd_ml ) ) ) & 1071 & * ( 1.0 - EXP( - 15.0 * ( 1.0 - zznd_ml ) ) ) 1072 ! 1073 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * zsc_ws_1(ji,jj) & 1074 & * ( -2.0 + 2.75 * ( ( 1.0 + 0.6 * zznd_ml**4 ) & 1075 & - EXP( - 6.0 * zznd_ml ) ) ) & 1076 & * ( 1.0 - EXP ( -15.0 * ( 1.0 - zznd_ml ) ) ) 1077 END DO 1078 ELSE 1079 DO jk = 2, ibld(ji,jj) 1080 zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj) 1081 znd = gdepw_n(ji,jj,jk) / zhbl(ji,jj) 1082 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * ( -4.06 * EXP( -2.0 * zznd_d ) * (1.0 - EXP( -4.0 * zznd_d ) ) + & 1083 & 7.5 * EXP ( -10.0 * ( 0.95 - znd )**2 ) * ( 1.0 - znd ) ) * zsc_wth_1(ji,jj) 1084 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * ( -4.06 * EXP( -2.0 * zznd_d ) * (1.0 - EXP( -4.0 * zznd_d ) ) + & 1085 & 7.5 * EXP ( -10.0 * ( 0.95 - znd )**2 ) * ( 1.0 - znd ) ) * zsc_ws_1(ji,jj) 1086 END DO 1087 ENDIF 1088 ENDDO ! ji loop 1089 END DO ! jj loop 1018 DO_2D_00_00 1019 IF ( lconv(ji,jj) ) THEN 1020 DO jk = 2, imld(ji,jj) 1021 zznd_ml=gdepw(ji,jj,jk,Kmm) / zhml(ji,jj) 1022 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * zsc_wth_1(ji,jj) & 1023 & * ( -2.0 + 2.75 * ( ( 1.0 + 0.6 * zznd_ml**4 ) & 1024 & - EXP( - 6.0 * zznd_ml ) ) ) & 1025 & * ( 1.0 - EXP( - 15.0 * ( 1.0 - zznd_ml ) ) ) 1026 ! 1027 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * zsc_ws_1(ji,jj) & 1028 & * ( -2.0 + 2.75 * ( ( 1.0 + 0.6 * zznd_ml**4 ) & 1029 & - EXP( - 6.0 * zznd_ml ) ) ) & 1030 & * ( 1.0 - EXP ( -15.0 * ( 1.0 - zznd_ml ) ) ) 1031 END DO 1032 ELSE 1033 DO jk = 2, ibld(ji,jj) 1034 zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 1035 znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 1036 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * ( -4.06 * EXP( -2.0 * zznd_d ) * (1.0 - EXP( -4.0 * zznd_d ) ) + & 1037 & 7.5 * EXP ( -10.0 * ( 0.95 - znd )**2 ) * ( 1.0 - znd ) ) * zsc_wth_1(ji,jj) 1038 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * ( -4.06 * EXP( -2.0 * zznd_d ) * (1.0 - EXP( -4.0 * zznd_d ) ) + & 1039 & 7.5 * EXP ( -10.0 * ( 0.95 - znd )**2 ) * ( 1.0 - znd ) ) * zsc_ws_1(ji,jj) 1040 END DO 1041 ENDIF 1042 END_2D 1090 1043 1091 1044 … … 1100 1053 ENDWHERE 1101 1054 1102 DO jj = 2, jpjm1 1103 DO ji = 2, jpim1 1104 IF ( lconv(ji,jj) ) THEN 1105 DO jk = 2, imld(ji,jj) 1106 zznd_ml = gdepw_n(ji,jj,jk) / zhml(ji,jj) 1107 zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj) 1055 DO_2D_00_00 1056 IF ( lconv(ji,jj) ) THEN 1057 DO jk = 2, imld(ji,jj) 1058 zznd_ml = gdepw(ji,jj,jk,Kmm) / zhml(ji,jj) 1059 zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 1060 ghamu(ji,jj,jk) = ghamu(ji,jj,jk)& 1061 & + 0.3 * ( -2.0 + 2.5 * ( 1.0 + 0.1 * zznd_ml**4 ) - EXP ( -8.0 * zznd_ml ) ) * zsc_uw_1(ji,jj) 1062 ! 1063 ghamv(ji,jj,jk) = ghamv(ji,jj,jk)& 1064 & + 0.3 * 0.1 * ( EXP( -zznd_d ) + EXP( -5.0 * ( 1.0 - zznd_ml ) ) ) * zsc_vw_1(ji,jj) 1065 END DO 1066 ELSE 1067 DO jk = 2, ibld(ji,jj) 1068 znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 1069 zznd_d = gdepw(ji,jj,jk,Kmm) / dstokes(ji,jj) 1070 IF ( zznd_d <= 2.0 ) THEN 1071 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + 0.5 * 0.3 & 1072 &* ( 2.25 - 3.0 * ( 1.0 - EXP( - 1.25 * zznd_d ) ) * ( 1.0 - EXP( -2.0 * zznd_d ) ) ) * zsc_uw_1(ji,jj) 1073 ! 1074 ELSE 1108 1075 ghamu(ji,jj,jk) = ghamu(ji,jj,jk)& 1109 & + 0. 3 * ( -2.0 + 2.5 * ( 1.0 + 0.1 * zznd_ml**4 ) - EXP ( -8.0 * zznd_ml ) ) * zsc_uw_1(ji,jj)1076 & + 0.5 * 0.3 * ( 1.0 - EXP( -5.0 * ( 1.0 - znd ) ) ) * zsc_uw_2(ji,jj) 1110 1077 ! 1111 ghamv(ji,jj,jk) = ghamv(ji,jj,jk)& 1112 & + 0.3 * 0.1 * ( EXP( -zznd_d ) + EXP( -5.0 * ( 1.0 - zznd_ml ) ) ) * zsc_vw_1(ji,jj) 1113 END DO 1114 ELSE 1115 DO jk = 2, ibld(ji,jj) 1116 znd = gdepw_n(ji,jj,jk) / zhbl(ji,jj) 1117 zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj) 1118 IF ( zznd_d <= 2.0 ) THEN 1119 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + 0.5 * 0.3 & 1120 &* ( 2.25 - 3.0 * ( 1.0 - EXP( - 1.25 * zznd_d ) ) * ( 1.0 - EXP( -2.0 * zznd_d ) ) ) * zsc_uw_1(ji,jj) 1121 ! 1122 ELSE 1123 ghamu(ji,jj,jk) = ghamu(ji,jj,jk)& 1124 & + 0.5 * 0.3 * ( 1.0 - EXP( -5.0 * ( 1.0 - znd ) ) ) * zsc_uw_2(ji,jj) 1125 ! 1126 ENDIF 1127 1128 ghamv(ji,jj,jk) = ghamv(ji,jj,jk)& 1129 & + 0.3 * 0.15 * SIN( 3.14159 * ( 0.65 * zznd_d ) ) * EXP( -0.25 * zznd_d**2 ) * zsc_vw_1(ji,jj) 1130 ghamv(ji,jj,jk) = ghamv(ji,jj,jk)& 1131 & + 0.3 * 0.15 * EXP( -5.0 * ( 1.0 - znd ) ) * ( 1.0 - EXP( -20.0 * ( 1.0 - znd ) ) ) * zsc_vw_2(ji,jj) 1132 END DO 1133 ENDIF 1134 END DO 1135 END DO 1078 ENDIF 1079 1080 ghamv(ji,jj,jk) = ghamv(ji,jj,jk)& 1081 & + 0.3 * 0.15 * SIN( 3.14159 * ( 0.65 * zznd_d ) ) * EXP( -0.25 * zznd_d**2 ) * zsc_vw_1(ji,jj) 1082 ghamv(ji,jj,jk) = ghamv(ji,jj,jk)& 1083 & + 0.3 * 0.15 * EXP( -5.0 * ( 1.0 - znd ) ) * ( 1.0 - EXP( -20.0 * ( 1.0 - znd ) ) ) * zsc_vw_2(ji,jj) 1084 END DO 1085 ENDIF 1086 END_2D 1136 1087 ! 1137 1088 ! Make surface forced velocity non-gradient terms go to zero at the base of the mixed layer. 1138 1089 1139 DO jj = 2, jpjm1 1140 DO ji = 2, jpim1 1141 IF ( lconv(ji,jj) ) THEN 1142 DO jk = 2, ibld(ji,jj) 1143 znd = ( gdepw_n(ji,jj,jk) - zhml(ji,jj) ) / zhml(ji,jj) !ALMG to think about 1144 IF ( znd >= 0.0 ) THEN 1145 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * ( 1.0 - EXP( -30.0 * znd**2 ) ) 1146 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * ( 1.0 - EXP( -30.0 * znd**2 ) ) 1147 ELSE 1148 ghamu(ji,jj,jk) = 0._wp 1149 ghamv(ji,jj,jk) = 0._wp 1150 ENDIF 1151 END DO 1152 ELSE 1153 DO jk = 2, ibld(ji,jj) 1154 znd = ( gdepw_n(ji,jj,jk) - zhml(ji,jj) ) / zhml(ji,jj) !ALMG to think about 1155 IF ( znd >= 0.0 ) THEN 1156 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * ( 1.0 - EXP( -10.0 * znd**2 ) ) 1157 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * ( 1.0 - EXP( -10.0 * znd**2 ) ) 1158 ELSE 1159 ghamu(ji,jj,jk) = 0._wp 1160 ghamv(ji,jj,jk) = 0._wp 1161 ENDIF 1162 END DO 1163 ENDIF 1164 END DO 1165 END DO 1090 DO_2D_00_00 1091 IF ( lconv(ji,jj) ) THEN 1092 DO jk = 2, ibld(ji,jj) 1093 znd = ( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zhml(ji,jj) !ALMG to think about 1094 IF ( znd >= 0.0 ) THEN 1095 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * ( 1.0 - EXP( -30.0 * znd**2 ) ) 1096 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * ( 1.0 - EXP( -30.0 * znd**2 ) ) 1097 ELSE 1098 ghamu(ji,jj,jk) = 0._wp 1099 ghamv(ji,jj,jk) = 0._wp 1100 ENDIF 1101 END DO 1102 ELSE 1103 DO jk = 2, ibld(ji,jj) 1104 znd = ( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zhml(ji,jj) !ALMG to think about 1105 IF ( znd >= 0.0 ) THEN 1106 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * ( 1.0 - EXP( -10.0 * znd**2 ) ) 1107 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * ( 1.0 - EXP( -10.0 * znd**2 ) ) 1108 ELSE 1109 ghamu(ji,jj,jk) = 0._wp 1110 ghamv(ji,jj,jk) = 0._wp 1111 ENDIF 1112 END DO 1113 ENDIF 1114 END_2D 1166 1115 1167 1116 ! pynocline contributions 1168 1117 ! Temporary fix to avoid instabilities when zdb_bl becomes very very small 1169 1118 zsc_uw_1 = 0._wp ! 50.0 * zla**(8.0/3.0) * zustar**2 * zhbl / ( zdb_bl + epsln ) 1170 DO jj = 2, jpjm1 1171 DO ji = 2, jpim1 1172 DO jk= 2, ibld(ji,jj) 1173 znd = gdepw_n(ji,jj,jk) / zhbl(ji,jj) 1174 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zdiffut(ji,jj,jk) * zdtdz_pyc(ji,jj,jk) 1175 ghams(ji,jj,jk) = ghams(ji,jj,jk) + zdiffut(ji,jj,jk) * zdsdz_pyc(ji,jj,jk) 1176 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zviscos(ji,jj,jk) * zdudz_pyc(ji,jj,jk) 1177 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zsc_uw_1(ji,jj) * ( 1.0 - znd )**(7.0/4.0) * zdbdz_pyc(ji,jj,jk) 1178 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zviscos(ji,jj,jk) * zdvdz_pyc(ji,jj,jk) 1119 DO_2D_00_00 1120 DO jk= 2, ibld(ji,jj) 1121 znd = gdepw(ji,jj,jk,Kmm) / zhbl(ji,jj) 1122 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zdiffut(ji,jj,jk) * zdtdz_pyc(ji,jj,jk) 1123 ghams(ji,jj,jk) = ghams(ji,jj,jk) + zdiffut(ji,jj,jk) * zdsdz_pyc(ji,jj,jk) 1124 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zviscos(ji,jj,jk) * zdudz_pyc(ji,jj,jk) 1125 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zsc_uw_1(ji,jj) * ( 1.0 - znd )**(7.0/4.0) * zdbdz_pyc(ji,jj,jk) 1126 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zviscos(ji,jj,jk) * zdvdz_pyc(ji,jj,jk) 1127 END DO 1128 END_2D 1129 1130 ! Entrainment contribution. 1131 1132 DO_2D_00_00 1133 IF ( lconv(ji,jj) ) THEN 1134 DO jk = 1, imld(ji,jj) - 1 1135 znd=gdepw(ji,jj,jk,Kmm) / zhml(ji,jj) 1136 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zwth_ent(ji,jj) * znd 1137 ghams(ji,jj,jk) = ghams(ji,jj,jk) + zws_ent(ji,jj) * znd 1138 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zuw_bse(ji,jj) * znd 1139 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zvw_bse(ji,jj) * znd 1140 END DO 1141 DO jk = imld(ji,jj), ibld(ji,jj) 1142 znd = -( gdepw(ji,jj,jk,Kmm) - zhml(ji,jj) ) / zdh(ji,jj) 1143 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zwth_ent(ji,jj) * ( 1.0 + znd ) 1144 ghams(ji,jj,jk) = ghams(ji,jj,jk) + zws_ent(ji,jj) * ( 1.0 + znd ) 1145 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zuw_bse(ji,jj) * ( 1.0 + znd ) 1146 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zvw_bse(ji,jj) * ( 1.0 + znd ) 1179 1147 END DO 1180 END DO 1181 END DO 1182 1183 ! Entrainment contribution. 1184 1185 DO jj=2, jpjm1 1186 DO ji = 2, jpim1 1187 IF ( lconv(ji,jj) ) THEN 1188 DO jk = 1, imld(ji,jj) - 1 1189 znd=gdepw_n(ji,jj,jk) / zhml(ji,jj) 1190 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zwth_ent(ji,jj) * znd 1191 ghams(ji,jj,jk) = ghams(ji,jj,jk) + zws_ent(ji,jj) * znd 1192 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zuw_bse(ji,jj) * znd 1193 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zvw_bse(ji,jj) * znd 1194 END DO 1195 DO jk = imld(ji,jj), ibld(ji,jj) 1196 znd = -( gdepw_n(ji,jj,jk) - zhml(ji,jj) ) / zdh(ji,jj) 1197 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zwth_ent(ji,jj) * ( 1.0 + znd ) 1198 ghams(ji,jj,jk) = ghams(ji,jj,jk) + zws_ent(ji,jj) * ( 1.0 + znd ) 1199 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zuw_bse(ji,jj) * ( 1.0 + znd ) 1200 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zvw_bse(ji,jj) * ( 1.0 + znd ) 1201 END DO 1202 ENDIF 1203 ghamt(ji,jj,ibld(ji,jj)) = 0._wp 1204 ghams(ji,jj,ibld(ji,jj)) = 0._wp 1205 ghamu(ji,jj,ibld(ji,jj)) = 0._wp 1206 ghamv(ji,jj,ibld(ji,jj)) = 0._wp 1207 END DO ! ji loop 1208 END DO ! jj loop 1148 ENDIF 1149 ghamt(ji,jj,ibld(ji,jj)) = 0._wp 1150 ghams(ji,jj,ibld(ji,jj)) = 0._wp 1151 ghamu(ji,jj,ibld(ji,jj)) = 0._wp 1152 ghamv(ji,jj,ibld(ji,jj)) = 0._wp 1153 END_2D 1209 1154 1210 1155 … … 1220 1165 ! rotate non-gradient velocity terms back to model reference frame 1221 1166 1222 DO jj = 2, jpjm1 1223 DO ji = 2, jpim1 1224 DO jk = 2, ibld(ji,jj) 1225 ztemp = ghamu(ji,jj,jk) 1226 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * zcos_wind(ji,jj) - ghamv(ji,jj,jk) * zsin_wind(ji,jj) 1227 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * zcos_wind(ji,jj) + ztemp * zsin_wind(ji,jj) 1228 END DO 1167 DO_2D_00_00 1168 DO jk = 2, ibld(ji,jj) 1169 ztemp = ghamu(ji,jj,jk) 1170 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * zcos_wind(ji,jj) - ghamv(ji,jj,jk) * zsin_wind(ji,jj) 1171 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * zcos_wind(ji,jj) + ztemp * zsin_wind(ji,jj) 1229 1172 END DO 1230 END DO1173 END_2D 1231 1174 1232 1175 IF(ln_dia_osm) THEN … … 1236 1179 ! KPP-style Ri# mixing 1237 1180 IF( ln_kpprimix) THEN 1238 DO jk = 2, jpkm1 !* Shear production at uw- and vw-points (energy conserving form) 1239 DO jj = 1, jpjm1 1240 DO ji = 1, jpim1 ! vector opt. 1241 z3du(ji,jj,jk) = 0.5 * ( un(ji,jj,jk-1) - un(ji ,jj,jk) ) & 1242 & * ( ub(ji,jj,jk-1) - ub(ji ,jj,jk) ) * wumask(ji,jj,jk) & 1243 & / ( e3uw_n(ji,jj,jk) * e3uw_b(ji,jj,jk) ) 1244 z3dv(ji,jj,jk) = 0.5 * ( vn(ji,jj,jk-1) - vn(ji,jj ,jk) ) & 1245 & * ( vb(ji,jj,jk-1) - vb(ji,jj ,jk) ) * wvmask(ji,jj,jk) & 1246 & / ( e3vw_n(ji,jj,jk) * e3vw_b(ji,jj,jk) ) 1247 END DO 1181 DO_3D_10_10( 2, jpkm1 ) 1182 z3du(ji,jj,jk) = 0.5 * ( uu(ji,jj,jk-1,Kmm) - uu(ji ,jj,jk,Kmm) ) & 1183 & * ( uu(ji,jj,jk-1,Kbb) - uu(ji ,jj,jk,Kbb) ) * wumask(ji,jj,jk) & 1184 & / ( e3uw(ji,jj,jk,Kmm) * e3uw(ji,jj,jk,Kbb) ) 1185 z3dv(ji,jj,jk) = 0.5 * ( vv(ji,jj,jk-1,Kmm) - vv(ji,jj ,jk,Kmm) ) & 1186 & * ( vv(ji,jj,jk-1,Kbb) - vv(ji,jj ,jk,Kbb) ) * wvmask(ji,jj,jk) & 1187 & / ( e3vw(ji,jj,jk,Kmm) * e3vw(ji,jj,jk,Kbb) ) 1188 END_3D 1189 ! 1190 DO_3D_00_00( 2, jpkm1 ) 1191 ! ! shear prod. at w-point weightened by mask 1192 zesh2 = ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) ) & 1193 & + ( z3dv(ji,jj-1,jk) + z3dv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) ) 1194 ! ! local Richardson number 1195 zri = MAX( rn2b(ji,jj,jk), 0._wp ) / MAX(zesh2, epsln) 1196 zfri = MIN( zri / rn_riinfty , 1.0_wp ) 1197 zfri = ( 1.0_wp - zfri * zfri ) 1198 zrimix(ji,jj,jk) = zfri * zfri * zfri * wmask(ji, jj, jk) 1199 END_3D 1200 1201 DO_2D_00_00 1202 DO jk = ibld(ji,jj) + 1, jpkm1 1203 zdiffut(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri 1204 zviscos(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri 1248 1205 END DO 1249 END DO 1250 ! 1251 DO jk = 2, jpkm1 1252 DO jj = 2, jpjm1 1253 DO ji = 2, jpim1 ! vector opt. 1254 ! ! shear prod. at w-point weightened by mask 1255 zesh2 = ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) ) & 1256 & + ( z3dv(ji,jj-1,jk) + z3dv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) ) 1257 ! ! local Richardson number 1258 zri = MAX( rn2b(ji,jj,jk), 0._wp ) / MAX(zesh2, epsln) 1259 zfri = MIN( zri / rn_riinfty , 1.0_wp ) 1260 zfri = ( 1.0_wp - zfri * zfri ) 1261 zrimix(ji,jj,jk) = zfri * zfri * zfri * wmask(ji, jj, jk) 1262 END DO 1263 END DO 1264 END DO 1265 1266 DO jj = 2, jpjm1 1267 DO ji = 2, jpim1 1268 DO jk = ibld(ji,jj) + 1, jpkm1 1269 zdiffut(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri 1270 zviscos(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri 1271 END DO 1272 END DO 1273 END DO 1206 END_2D 1274 1207 1275 1208 END IF ! ln_kpprimix = .true. … … 1277 1210 ! KPP-style set diffusivity large if unstable below BL 1278 1211 IF( ln_convmix) THEN 1279 DO jj = 2, jpjm1 1280 DO ji = 2, jpim1 1281 DO jk = ibld(ji,jj) + 1, jpkm1 1282 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) zdiffut(ji,jj,jk) = rn_difconv 1283 END DO 1212 DO_2D_00_00 1213 DO jk = ibld(ji,jj) + 1, jpkm1 1214 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) zdiffut(ji,jj,jk) = rn_difconv 1284 1215 END DO 1285 END DO1216 END_2D 1286 1217 END IF ! ln_convmix = .true. 1287 1218 … … 1291 1222 ! GN 25/8: need to change tmask --> wmask 1292 1223 1293 DO jk = 2, jpkm1 1294 DO jj = 2, jpjm1 1295 DO ji = 2, jpim1 1296 p_avt(ji,jj,jk) = MAX( zdiffut(ji,jj,jk), avtb(jk) ) * tmask(ji,jj,jk) 1297 p_avm(ji,jj,jk) = MAX( zviscos(ji,jj,jk), avmb(jk) ) * tmask(ji,jj,jk) 1298 END DO 1299 END DO 1300 END DO 1224 DO_3D_00_00( 2, jpkm1 ) 1225 p_avt(ji,jj,jk) = MAX( zdiffut(ji,jj,jk), avtb(jk) ) * tmask(ji,jj,jk) 1226 p_avm(ji,jj,jk) = MAX( zviscos(ji,jj,jk), avmb(jk) ) * tmask(ji,jj,jk) 1227 END_3D 1301 1228 ! Lateral boundary conditions on ghamu and ghamv, currently on W-grid (sign unchanged), needed to caclulate gham[uv] on u and v grids 1302 1229 CALL lbc_lnk_multi( 'zdfosm', p_avt, 'W', 1. , p_avm, 'W', 1., & 1303 1230 & ghamu, 'W', 1. , ghamv, 'W', 1. ) 1304 DO jk = 2, jpkm1 1305 DO jj = 2, jpjm1 1306 DO ji = 2, jpim1 1307 ghamu(ji,jj,jk) = ( ghamu(ji,jj,jk) + ghamu(ji+1,jj,jk) ) & 1308 & / MAX( 1., tmask(ji,jj,jk) + tmask (ji + 1,jj,jk) ) * umask(ji,jj,jk) 1309 1310 ghamv(ji,jj,jk) = ( ghamv(ji,jj,jk) + ghamv(ji,jj+1,jk) ) & 1311 & / MAX( 1., tmask(ji,jj,jk) + tmask (ji,jj+1,jk) ) * vmask(ji,jj,jk) 1312 1313 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) * tmask(ji,jj,jk) 1314 ghams(ji,jj,jk) = ghams(ji,jj,jk) * tmask(ji,jj,jk) 1315 END DO 1316 END DO 1317 END DO 1231 DO_3D_00_00( 2, jpkm1 ) 1232 ghamu(ji,jj,jk) = ( ghamu(ji,jj,jk) + ghamu(ji+1,jj,jk) ) & 1233 & / MAX( 1., tmask(ji,jj,jk) + tmask (ji + 1,jj,jk) ) * umask(ji,jj,jk) 1234 1235 ghamv(ji,jj,jk) = ( ghamv(ji,jj,jk) + ghamv(ji,jj+1,jk) ) & 1236 & / MAX( 1., tmask(ji,jj,jk) + tmask (ji,jj+1,jk) ) * vmask(ji,jj,jk) 1237 1238 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) * tmask(ji,jj,jk) 1239 ghams(ji,jj,jk) = ghams(ji,jj,jk) * tmask(ji,jj,jk) 1240 END_3D 1318 1241 ! Lateral boundary conditions on final outputs for gham[ts], on W-grid (sign unchanged) 1319 1242 ! Lateral boundary conditions on final outputs for gham[uv], on [UV]-grid (sign unchanged) … … 1364 1287 1365 1288 1366 SUBROUTINE zdf_osm_init 1289 SUBROUTINE zdf_osm_init( Kmm ) 1367 1290 !!---------------------------------------------------------------------- 1368 1291 !! *** ROUTINE zdf_osm_init *** … … 1376 1299 !! ** input : Namlist namosm 1377 1300 !!---------------------------------------------------------------------- 1301 INTEGER, INTENT(in) :: Kmm ! time level index (middle) 1302 ! 1378 1303 INTEGER :: ios ! local integer 1379 1304 INTEGER :: ji, jj, jk ! dummy loop indices … … 1384 1309 !!---------------------------------------------------------------------- 1385 1310 ! 1386 REWIND( numnam_ref ) ! Namelist namzdf_osm in reference namelist : Osmosis ML model1387 1311 READ ( numnam_ref, namzdf_osm, IOSTAT = ios, ERR = 901) 1388 1312 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_osm in reference namelist' ) 1389 1313 1390 REWIND( numnam_cfg ) ! Namelist namzdf_tke in configuration namelist : Turbulent Kinetic Energy1391 1314 READ ( numnam_cfg, namzdf_osm, IOSTAT = ios, ERR = 902 ) 1392 1315 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namzdf_osm in configuration namelist' ) … … 1423 1346 IF( zdf_osm_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_osm_init : unable to allocate arrays' ) 1424 1347 1425 call osm_rst( nit000, 'READ' ) !* read or initialize hbl1348 call osm_rst( nit000, Kmm, 'READ' ) !* read or initialize hbl 1426 1349 1427 1350 IF( ln_zdfddm) THEN … … 1459 1382 etmean(:,:,:) = 0.e0 1460 1383 1461 DO jk = 1, jpkm1 1462 DO jj = 2, jpjm1 1463 DO ji = 2, jpim1 ! vector opt. 1464 etmean(ji,jj,jk) = tmask(ji,jj,jk) & 1465 & / MAX( 1., umask(ji-1,jj ,jk) + umask(ji,jj,jk) & 1466 & + vmask(ji ,jj-1,jk) + vmask(ji,jj,jk) ) 1467 END DO 1468 END DO 1469 END DO 1384 DO_3D_00_00( 1, jpkm1 ) 1385 etmean(ji,jj,jk) = tmask(ji,jj,jk) & 1386 & / MAX( 1., umask(ji-1,jj ,jk) + umask(ji,jj,jk) & 1387 & + vmask(ji ,jj-1,jk) + vmask(ji,jj,jk) ) 1388 END_3D 1470 1389 1471 1390 CASE ( 1 ) ! horizontal average … … 1477 1396 etmean(:,:,:) = 0.e0 1478 1397 1479 DO jk = 1, jpkm1 1480 DO jj = 2, jpjm1 1481 DO ji = 2, jpim1 ! vector opt. 1482 etmean(ji,jj,jk) = tmask(ji, jj,jk) & 1483 & / MAX( 1., 2.* tmask(ji,jj,jk) & 1484 & +.5 * ( tmask(ji-1,jj+1,jk) + tmask(ji-1,jj-1,jk) & 1485 & +tmask(ji+1,jj+1,jk) + tmask(ji+1,jj-1,jk) ) & 1486 & +1. * ( tmask(ji-1,jj ,jk) + tmask(ji ,jj+1,jk) & 1487 & +tmask(ji ,jj-1,jk) + tmask(ji+1,jj ,jk) ) ) 1488 END DO 1489 END DO 1490 END DO 1398 DO_3D_00_00( 1, jpkm1 ) 1399 etmean(ji,jj,jk) = tmask(ji, jj,jk) & 1400 & / MAX( 1., 2.* tmask(ji,jj,jk) & 1401 & +.5 * ( tmask(ji-1,jj+1,jk) + tmask(ji-1,jj-1,jk) & 1402 & +tmask(ji+1,jj+1,jk) + tmask(ji+1,jj-1,jk) ) & 1403 & +1. * ( tmask(ji-1,jj ,jk) + tmask(ji ,jj+1,jk) & 1404 & +tmask(ji ,jj-1,jk) + tmask(ji+1,jj ,jk) ) ) 1405 END_3D 1491 1406 1492 1407 CASE DEFAULT … … 1517 1432 1518 1433 1519 SUBROUTINE osm_rst( kt, cdrw )1434 SUBROUTINE osm_rst( kt, Kmm, cdrw ) 1520 1435 !!--------------------------------------------------------------------- 1521 1436 !! *** ROUTINE osm_rst *** … … 1527 1442 !!---------------------------------------------------------------------- 1528 1443 1529 INTEGER, INTENT(in) :: kt 1444 INTEGER , INTENT(in) :: kt ! ocean time step index 1445 INTEGER , INTENT(in) :: Kmm ! ocean time level index (middle) 1530 1446 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 1531 1447 … … 1545 1461 id1 = iom_varid( numror, 'wn' , ldstop = .FALSE. ) 1546 1462 IF( id1 > 0 ) THEN ! 'wn' exists; read 1547 CALL iom_get( numror, jpdom_autoglo, 'wn', w n, ldxios = lrxios )1548 WRITE(numout,*) ' ===>>>> : w nread from restart file'1463 CALL iom_get( numror, jpdom_autoglo, 'wn', ww, ldxios = lrxios ) 1464 WRITE(numout,*) ' ===>>>> : ww read from restart file' 1549 1465 ELSE 1550 w n(:,:,:) = 0._wp1551 WRITE(numout,*) ' ===>>>> : w nnot in restart file, set to zero initially'1466 ww(:,:,:) = 0._wp 1467 WRITE(numout,*) ' ===>>>> : ww not in restart file, set to zero initially' 1552 1468 END IF 1553 1469 id1 = iom_varid( numror, 'hbl' , ldstop = .FALSE. ) … … 1568 1484 IF( TRIM(cdrw) == 'WRITE') THEN !* Write hbli into the restart file, then return 1569 1485 IF(lwp) WRITE(numout,*) '---- osm-rst ----' 1570 CALL iom_rstput( kt, nitrst, numrow, 'wn' , w n, ldxios = lwxios )1486 CALL iom_rstput( kt, nitrst, numrow, 'wn' , ww , ldxios = lwxios ) 1571 1487 CALL iom_rstput( kt, nitrst, numrow, 'hbl' , hbl , ldxios = lwxios ) 1572 1488 CALL iom_rstput( kt, nitrst, numrow, 'hbli' , hbli, ldxios = lwxios ) … … 1580 1496 ALLOCATE( imld_rst(jpi,jpj) ) 1581 1497 ! w-level of the mixing and mixed layers 1582 CALL eos_rab( ts n, rab_n)1583 CALL bn2(ts n, rab_n, rn2)1498 CALL eos_rab( ts(:,:,:,:,Kmm), rab_n, Kmm ) 1499 CALL bn2(ts(:,:,:,:,Kmm), rab_n, rn2, Kmm) 1584 1500 imld_rst(:,:) = nlb10 ! Initialization to the number of w ocean point 1585 1501 hbl(:,:) = 0._wp ! here hbl used as a dummy variable, integrating vertically N^2 … … 1587 1503 ! 1588 1504 hbl(:,:) = 0._wp ! here hbl used as a dummy variable, integrating vertically N^2 1589 DO jk = 1, jpkm1 1590 DO jj = 1, jpj ! Mixed layer level: w-level 1591 DO ji = 1, jpi 1592 ikt = mbkt(ji,jj) 1593 hbl(ji,jj) = hbl(ji,jj) + MAX( rn2(ji,jj,jk) , 0._wp ) * e3w_n(ji,jj,jk) 1594 IF( hbl(ji,jj) < zN2_c ) imld_rst(ji,jj) = MIN( jk , ikt ) + 1 ! Mixed layer level 1595 END DO 1596 END DO 1597 END DO 1505 DO_3D_11_11( 1, jpkm1 ) 1506 ikt = mbkt(ji,jj) 1507 hbl(ji,jj) = hbl(ji,jj) + MAX( rn2(ji,jj,jk) , 0._wp ) * e3w(ji,jj,jk,Kmm) 1508 IF( hbl(ji,jj) < zN2_c ) imld_rst(ji,jj) = MIN( jk , ikt ) + 1 ! Mixed layer level 1509 END_3D 1598 1510 ! 1599 DO jj = 1, jpj 1600 DO ji = 1, jpi 1601 iiki = imld_rst(ji,jj) 1602 hbl (ji,jj) = gdepw_n(ji,jj,iiki ) * ssmask(ji,jj) ! Turbocline depth 1603 END DO 1604 END DO 1511 DO_2D_11_11 1512 iiki = imld_rst(ji,jj) 1513 hbl (ji,jj) = gdepw(ji,jj,iiki ,Kmm) * ssmask(ji,jj) ! Turbocline depth 1514 END_2D 1605 1515 hbl = MAX(hbl,epsln) 1606 1516 hbli(:,:) = hbl(:,:) … … 1610 1520 1611 1521 1612 SUBROUTINE tra_osm( kt )1522 SUBROUTINE tra_osm( kt, Kmm, pts, Krhs ) 1613 1523 !!---------------------------------------------------------------------- 1614 1524 !! *** ROUTINE tra_osm *** … … 1620 1530 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds ! 3D workspace 1621 1531 !!---------------------------------------------------------------------- 1622 INTEGER, INTENT(in) :: kt 1532 INTEGER , INTENT(in) :: kt ! time step index 1533 INTEGER , INTENT(in) :: Kmm, Krhs ! time level indices 1534 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation 1535 ! 1623 1536 INTEGER :: ji, jj, jk 1624 1537 ! … … 1630 1543 1631 1544 IF( l_trdtra ) THEN !* Save ta and sa trends 1632 ALLOCATE( ztrdt(jpi,jpj,jpk) ) ; ztrdt(:,:,:) = tsa(:,:,:,jp_tem)1633 ALLOCATE( ztrds(jpi,jpj,jpk) ) ; ztrds(:,:,:) = tsa(:,:,:,jp_sal)1545 ALLOCATE( ztrdt(jpi,jpj,jpk) ) ; ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 1546 ALLOCATE( ztrds(jpi,jpj,jpk) ) ; ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) 1634 1547 ENDIF 1635 1548 1636 1549 ! add non-local temperature and salinity flux 1637 DO jk = 1, jpkm1 1638 DO jj = 2, jpjm1 1639 DO ji = 2, jpim1 1640 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) & 1641 & - ( ghamt(ji,jj,jk ) & 1642 & - ghamt(ji,jj,jk+1) ) /e3t_n(ji,jj,jk) 1643 tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) & 1644 & - ( ghams(ji,jj,jk ) & 1645 & - ghams(ji,jj,jk+1) ) / e3t_n(ji,jj,jk) 1646 END DO 1647 END DO 1648 END DO 1550 DO_3D_00_00( 1, jpkm1 ) 1551 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) & 1552 & - ( ghamt(ji,jj,jk ) & 1553 & - ghamt(ji,jj,jk+1) ) /e3t(ji,jj,jk,Kmm) 1554 pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) & 1555 & - ( ghams(ji,jj,jk ) & 1556 & - ghams(ji,jj,jk+1) ) / e3t(ji,jj,jk,Kmm) 1557 END_3D 1649 1558 1650 1559 1651 1560 ! save the non-local tracer flux trends for diagnostic 1652 1561 IF( l_trdtra ) THEN 1653 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)1654 ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)1562 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 1563 ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 1655 1564 !!bug gm jpttdzdf ==> jpttosm 1656 CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdf, ztrdt )1657 CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdf, ztrds )1565 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_zdf, ztrdt ) 1566 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_zdf, ztrds ) 1658 1567 DEALLOCATE( ztrdt ) ; DEALLOCATE( ztrds ) 1659 1568 ENDIF 1660 1569 1661 IF( ln_ctl) THEN1662 CALL prt_ctl( tab3d_1= tsa(:,:,:,jp_tem), clinfo1=' osm - Ta: ', mask1=tmask, &1663 & tab3d_2= tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )1570 IF(sn_cfctl%l_prtctl) THEN 1571 CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' osm - Ta: ', mask1=tmask, & 1572 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 1664 1573 ENDIF 1665 1574 ! … … 1684 1593 1685 1594 1686 SUBROUTINE dyn_osm( kt )1595 SUBROUTINE dyn_osm( kt, Kmm, puu, pvv, Krhs ) 1687 1596 !!---------------------------------------------------------------------- 1688 1597 !! *** ROUTINE dyn_osm *** … … 1693 1602 !! ** Method : ??? 1694 1603 !!---------------------------------------------------------------------- 1695 INTEGER, INTENT(in) :: kt ! 1604 INTEGER , INTENT( in ) :: kt ! ocean time step index 1605 INTEGER , INTENT( in ) :: Kmm, Krhs ! ocean time level indices 1606 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! ocean velocities and RHS of momentum equation 1696 1607 ! 1697 1608 INTEGER :: ji, jj, jk ! dummy loop indices … … 1705 1616 !code saving tracer trends removed, replace with trdmxl_oce 1706 1617 1707 DO jk = 1, jpkm1 ! add non-local u and v fluxes 1708 DO jj = 2, jpjm1 1709 DO ji = 2, jpim1 1710 ua(ji,jj,jk) = ua(ji,jj,jk) & 1711 & - ( ghamu(ji,jj,jk ) & 1712 & - ghamu(ji,jj,jk+1) ) / e3u_n(ji,jj,jk) 1713 va(ji,jj,jk) = va(ji,jj,jk) & 1714 & - ( ghamv(ji,jj,jk ) & 1715 & - ghamv(ji,jj,jk+1) ) / e3v_n(ji,jj,jk) 1716 END DO 1717 END DO 1718 END DO 1618 DO_3D_00_00( 1, jpkm1 ) 1619 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) & 1620 & - ( ghamu(ji,jj,jk ) & 1621 & - ghamu(ji,jj,jk+1) ) / e3u(ji,jj,jk,Kmm) 1622 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) & 1623 & - ( ghamv(ji,jj,jk ) & 1624 & - ghamv(ji,jj,jk+1) ) / e3v(ji,jj,jk,Kmm) 1625 END_3D 1719 1626 ! 1720 1627 ! code for saving tracer trends removed -
NEMO/trunk/src/OCE/ZDF/zdfphy.F90
r11536 r12377 61 61 CONTAINS 62 62 63 SUBROUTINE zdf_phy_init 63 SUBROUTINE zdf_phy_init( Kmm ) 64 64 !!---------------------------------------------------------------------- 65 65 !! *** ROUTINE zdf_phy_init *** … … 70 70 !! set horizontal shape and vertical profile of background mixing coef. 71 71 !!---------------------------------------------------------------------- 72 INTEGER, INTENT(in) :: Kmm ! time level index (middle) 73 ! 72 74 INTEGER :: jk ! dummy loop indices 73 75 INTEGER :: ioptio, ios ! local integers … … 91 93 ! 92 94 ! !== Namelist ==! 93 REWIND( numnam_ref ) ! Namelist namzdf in reference namelist : Vertical mixing parameters94 95 READ ( numnam_ref, namzdf, IOSTAT = ios, ERR = 901) 95 96 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf in reference namelist' ) 96 97 ! 97 REWIND( numnam_cfg ) ! Namelist namzdf in reference namelist : Vertical mixing parameters98 98 READ ( numnam_cfg, namzdf, IOSTAT = ios, ERR = 902 ) 99 99 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namzdf in configuration namelist' ) … … 191 191 ioptio = 0 192 192 IF( ln_zdfcst ) THEN ; ioptio = ioptio + 1 ; nzdf_phy = np_CST ; ENDIF 193 IF( ln_zdfric ) THEN ; ioptio = ioptio + 1 ; nzdf_phy = np_RIC ; CALL zdf_ric_init ; ENDIF194 IF( ln_zdftke ) THEN ; ioptio = ioptio + 1 ; nzdf_phy = np_TKE ; CALL zdf_tke_init ; ENDIF195 IF( ln_zdfgls ) THEN ; ioptio = ioptio + 1 ; nzdf_phy = np_GLS ; CALL zdf_gls_init ; ENDIF196 IF( ln_zdfosm ) THEN ; ioptio = ioptio + 1 ; nzdf_phy = np_OSM ; CALL zdf_osm_init ; ENDIF193 IF( ln_zdfric ) THEN ; ioptio = ioptio + 1 ; nzdf_phy = np_RIC ; CALL zdf_ric_init ; ENDIF 194 IF( ln_zdftke ) THEN ; ioptio = ioptio + 1 ; nzdf_phy = np_TKE ; CALL zdf_tke_init( Kmm ) ; ENDIF 195 IF( ln_zdfgls ) THEN ; ioptio = ioptio + 1 ; nzdf_phy = np_GLS ; CALL zdf_gls_init ; ENDIF 196 IF( ln_zdfosm ) THEN ; ioptio = ioptio + 1 ; nzdf_phy = np_OSM ; CALL zdf_osm_init( Kmm ) ; ENDIF 197 197 ! 198 198 IF( ioptio /= 1 ) CALL ctl_stop( 'zdf_phy_init: one and only one vertical diffusion option has to be defined ' ) … … 219 219 220 220 221 SUBROUTINE zdf_phy( kt )221 SUBROUTINE zdf_phy( kt, Kbb, Kmm, Krhs ) 222 222 !!---------------------------------------------------------------------- 223 223 !! *** ROUTINE zdf_phy *** … … 231 231 !! bottom stress..... <<<<====verifier ! 232 232 !!---------------------------------------------------------------------- 233 INTEGER, INTENT(in) :: kt ! ocean time-step index 233 INTEGER, INTENT(in) :: kt ! ocean time-step index 234 INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! ocean time level indices 234 235 ! 235 236 INTEGER :: ji, jj, jk ! dummy loop indice … … 242 243 ! 243 244 ! !* bottom drag 244 CALL zdf_drg( kt, mbkt, r_Cdmin_bot, r_Cdmax_bot, & ! <<== in245 CALL zdf_drg( kt, Kmm, mbkt , r_Cdmin_bot, r_Cdmax_bot, & ! <<== in 245 246 & r_z0_bot, r_ke0_bot, rCd0_bot, & 246 247 & rCdU_bot ) ! ==>> out : bottom drag [m/s] 247 248 IF( ln_isfcav ) THEN !* top drag (ocean cavities) 248 CALL zdf_drg( kt, mikt, r_Cdmin_top, r_Cdmax_top, & ! <<== in249 CALL zdf_drg( kt, Kmm, mikt , r_Cdmin_top, r_Cdmax_top, & ! <<== in 249 250 & r_z0_top, r_ke0_top, rCd0_top, & 250 251 & rCdU_top ) ! ==>> out : bottom drag [m/s] … … 255 256 ! 256 257 IF( l_zdfsh2 ) & !* shear production at w-points (energy conserving form) 257 CALL zdf_sh2( ub, vb, un, vn, avm_k, & ! <<== in258 & 258 CALL zdf_sh2( Kbb, Kmm, avm_k, & ! <<== in 259 & zsh2 ) ! ==>> out : shear production 259 260 ! 260 261 SELECT CASE ( nzdf_phy ) !* Vertical eddy viscosity and diffusivity coefficients at w-points 261 CASE( np_RIC ) ; CALL zdf_ric( kt, gdept_n, zsh2, avm_k, avt_k ) ! Richardson number dependent Kz262 CASE( np_TKE ) ; CALL zdf_tke( kt 263 CASE( np_GLS ) ; CALL zdf_gls( kt 264 CASE( np_OSM ) ; CALL zdf_osm( kt 262 CASE( np_RIC ) ; CALL zdf_ric( kt, Kmm, zsh2, avm_k, avt_k ) ! Richardson number dependent Kz 263 CASE( np_TKE ) ; CALL zdf_tke( kt, Kbb, Kmm, zsh2, avm_k, avt_k ) ! TKE closure scheme for Kz 264 CASE( np_GLS ) ; CALL zdf_gls( kt, Kbb, Kmm, zsh2, avm_k, avt_k ) ! GLS closure scheme for Kz 265 CASE( np_OSM ) ; CALL zdf_osm( kt, Kbb, Kmm, Krhs, avm_k, avt_k ) ! OSMOSIS closure scheme for Kz 265 266 ! CASE( np_CST ) ! Constant Kz (reset avt, avm to the background value) 266 267 ! ! avt_k and avm_k set one for all at initialisation phase … … 281 282 ENDIF 282 283 ! 283 IF( ln_zdfevd ) CALL zdf_evd( kt, avm, avt ) !* convection: enhanced vertical eddy diffusivity284 IF( ln_zdfevd ) CALL zdf_evd( kt, Kmm, Krhs, avm, avt ) !* convection: enhanced vertical eddy diffusivity 284 285 ! 285 286 ! !* double diffusive mixing 286 287 IF( ln_zdfddm ) THEN ! update avt and compute avs 287 CALL zdf_ddm( kt, avm, avt, avs )288 CALL zdf_ddm( kt, Kmm, avm, avt, avs ) 288 289 ELSE ! same mixing on all tracers 289 290 avs(2:jpim1,2:jpjm1,1:jpkm1) = avt(2:jpim1,2:jpjm1,1:jpkm1) … … 291 292 ! 292 293 ! !* wave-induced mixing 293 IF( ln_zdfswm ) CALL zdf_swm( kt, avm, avt, avs ) ! surface wave (Qiao et al. 2004)294 IF( ln_zdfiwm ) CALL zdf_iwm( kt, avm, avt, avs ) ! internal wave (de Lavergne et al 2017)294 IF( ln_zdfswm ) CALL zdf_swm( kt, Kmm, avm, avt, avs ) ! surface wave (Qiao et al. 2004) 295 IF( ln_zdfiwm ) CALL zdf_iwm( kt, Kmm, avm, avt, avs ) ! internal wave (de Lavergne et al 2017) 295 296 296 297 #if defined key_agrif … … 313 314 ENDIF 314 315 ! 315 CALL zdf_mxl( kt ) !* mixed layer depth, and level316 CALL zdf_mxl( kt, Kmm ) !* mixed layer depth, and level 316 317 ! 317 318 IF( lrst_oce ) THEN !* write TKE, GLS or RIC fields in the restart file … … 319 320 IF( ln_zdfgls ) CALL gls_rst( kt, 'WRITE' ) 320 321 IF( ln_zdfric ) CALL ric_rst( kt, 'WRITE' ) 321 ! NB. OSMOSIS restart (osm_rst) will be called in step.F90 after w nhas been updated322 ! NB. OSMOSIS restart (osm_rst) will be called in step.F90 after ww has been updated 322 323 ENDIF 323 324 ! -
NEMO/trunk/src/OCE/ZDF/zdfric.F90
r11536 r12377 50 50 51 51 !! * Substitutions 52 # include " vectopt_loop_substitute.h90"52 # include "do_loop_substitute.h90" 53 53 !!---------------------------------------------------------------------- 54 54 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 78 78 !!---------------------------------------------------------------------- 79 79 ! 80 REWIND( numnam_ref ) ! Namelist namzdf_ric in reference namelist : Vertical diffusion Kz depends on Richardson number81 80 READ ( numnam_ref, namzdf_ric, IOSTAT = ios, ERR = 901) 82 81 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_ric in reference namelist' ) 83 82 84 REWIND( numnam_cfg ) ! Namelist namzdf_ric in configuration namelist : Vertical diffusion Kz depends on Richardson number85 83 READ ( numnam_cfg, namzdf_ric, IOSTAT = ios, ERR = 902 ) 86 84 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namzdf_ric in configuration namelist' ) … … 112 110 113 111 114 SUBROUTINE zdf_ric( kt, pdept, p_sh2, p_avm, p_avt )112 SUBROUTINE zdf_ric( kt, Kmm, p_sh2, p_avm, p_avt ) 115 113 !!---------------------------------------------------------------------- 116 114 !! *** ROUTINE zdfric *** … … 125 123 !! avt = avm0 / (1 + rn_alp*ri) 126 124 !! with ri = N^2 / dz(u)**2 127 !! = e3w**2 * rn2/[ mi( dk(u b) )+mj( dk(vb) ) ]125 !! = e3w**2 * rn2/[ mi( dk(uu(:,:,:,Kbb)) )+mj( dk(vv(:,:,:,Kbb)) ) ] 128 126 !! avm0= rn_avmri / (1 + rn_alp*Ri)**nn_ric 129 127 !! where ri is the before local Richardson number, … … 152 150 !!---------------------------------------------------------------------- 153 151 INTEGER , INTENT(in ) :: kt ! ocean time-step 154 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pdept ! depth of t-point [m]152 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 155 153 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: p_sh2 ! shear production term 156 154 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: p_avm, p_avt ! momentum and tracer Kz (w-points) … … 162 160 ! 163 161 ! !== avm and avt = F(Richardson number) ==! 164 DO jk = 2, jpkm1 165 DO jj = 1, jpjm1 166 DO ji = 1, jpim1 ! coefficient = F(richardson number) (avm-weighted Ri) 167 zcfRi = 1._wp / ( 1._wp + rn_alp * MAX( 0._wp , avm(ji,jj,jk) * rn2(ji,jj,jk) / ( p_sh2(ji,jj,jk) + 1.e-20 ) ) ) 168 zav = rn_avmri * zcfRi**nn_ric 169 ! ! avm and avt coefficients 170 p_avm(ji,jj,jk) = MAX( zav , avmb(jk) ) * wmask(ji,jj,jk) 171 p_avt(ji,jj,jk) = MAX( zav * zcfRi , avtb(jk) ) * wmask(ji,jj,jk) 172 END DO 173 END DO 174 END DO 162 DO_3D_10_10( 2, jpkm1 ) 163 zcfRi = 1._wp / ( 1._wp + rn_alp * MAX( 0._wp , avm(ji,jj,jk) * rn2(ji,jj,jk) / ( p_sh2(ji,jj,jk) + 1.e-20 ) ) ) 164 zav = rn_avmri * zcfRi**nn_ric 165 ! ! avm and avt coefficients 166 p_avm(ji,jj,jk) = MAX( zav , avmb(jk) ) * wmask(ji,jj,jk) 167 p_avt(ji,jj,jk) = MAX( zav * zcfRi , avtb(jk) ) * wmask(ji,jj,jk) 168 END_3D 175 169 ! 176 170 !!gm BUG <<<<==== This param can't work at low latitude … … 179 173 IF( ln_mldw ) THEN !== set a minimum value in the Ekman layer ==! 180 174 ! 181 DO jj = 2, jpjm1 !* Ekman depth 182 DO ji = 2, jpim1 183 zustar = SQRT( taum(ji,jj) * r1_rau0 ) 184 zhek = rn_ekmfc * zustar / ( ABS( ff_t(ji,jj) ) + rsmall ) ! Ekman depth 185 zh_ekm(ji,jj) = MAX( rn_mldmin , MIN( zhek , rn_mldmax ) ) ! set allowed range 186 END DO 187 END DO 188 DO jk = 2, jpkm1 !* minimum mixing coeff. within the Ekman layer 189 DO jj = 2, jpjm1 190 DO ji = 2, jpim1 191 IF( pdept(ji,jj,jk) < zh_ekm(ji,jj) ) THEN 192 p_avm(ji,jj,jk) = MAX( p_avm(ji,jj,jk), rn_wvmix ) * wmask(ji,jj,jk) 193 p_avt(ji,jj,jk) = MAX( p_avt(ji,jj,jk), rn_wtmix ) * wmask(ji,jj,jk) 194 ENDIF 195 END DO 196 END DO 197 END DO 175 DO_2D_00_00 176 zustar = SQRT( taum(ji,jj) * r1_rau0 ) 177 zhek = rn_ekmfc * zustar / ( ABS( ff_t(ji,jj) ) + rsmall ) ! Ekman depth 178 zh_ekm(ji,jj) = MAX( rn_mldmin , MIN( zhek , rn_mldmax ) ) ! set allowed range 179 END_2D 180 DO_3D_00_00( 2, jpkm1 ) 181 IF( gdept(ji,jj,jk,Kmm) < zh_ekm(ji,jj) ) THEN 182 p_avm(ji,jj,jk) = MAX( p_avm(ji,jj,jk), rn_wvmix ) * wmask(ji,jj,jk) 183 p_avt(ji,jj,jk) = MAX( p_avt(ji,jj,jk), rn_wtmix ) * wmask(ji,jj,jk) 184 ENDIF 185 END_3D 198 186 ENDIF 199 187 ! -
NEMO/trunk/src/OCE/ZDF/zdfsh2.F90
r10069 r12377 11 11 !! zdf_sh2 : compute mixing the shear production term of TKE 12 12 !!---------------------------------------------------------------------- 13 USE oce 13 14 USE dom_oce ! domain: ocean 14 15 ! … … 21 22 PUBLIC zdf_sh2 ! called by zdftke, zdfglf, and zdfric 22 23 24 !! * Substitutions 25 # include "do_loop_substitute.h90" 23 26 !!---------------------------------------------------------------------- 24 27 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 28 31 CONTAINS 29 32 30 SUBROUTINE zdf_sh2( pub, pvb, pun, pvn, p_avm, p_sh2 )33 SUBROUTINE zdf_sh2( Kbb, Kmm, p_avm, p_sh2 ) 31 34 !!---------------------------------------------------------------------- 32 35 !! *** ROUTINE zdf_sh2 *** … … 47 50 !! References : Bruchard, OM 2002 48 51 !! --------------------------------------------------------------------- 49 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pub, pvb, pun, pvn ! before, now horizontal velocities52 INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level indices 50 53 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: p_avm ! vertical eddy viscosity (w-points) 51 54 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: p_sh2 ! shear production of TKE (w-points) … … 56 59 ! 57 60 DO jk = 2, jpkm1 58 DO jj = 1, jpjm1 !* 2 x shear production at uw- and vw-points (energy conserving form) 59 DO ji = 1, jpim1 60 zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) & 61 & * ( pun(ji,jj,jk-1) - pun(ji,jj,jk) ) & 62 & * ( pub(ji,jj,jk-1) - pub(ji,jj,jk) ) / ( e3uw_n(ji,jj,jk) * e3uw_b(ji,jj,jk) ) * wumask(ji,jj,jk) 63 zsh2v(ji,jj) = ( p_avm(ji,jj+1,jk) + p_avm(ji,jj,jk) ) & 64 & * ( pvn(ji,jj,jk-1) - pvn(ji,jj,jk) ) & 65 & * ( pvb(ji,jj,jk-1) - pvb(ji,jj,jk) ) / ( e3vw_n(ji,jj,jk) * e3vw_b(ji,jj,jk) ) * wvmask(ji,jj,jk) 66 END DO 67 END DO 68 DO jj = 2, jpjm1 !* shear production at w-point 69 DO ji = 2, jpim1 ! coast mask: =2 at the coast ; =1 otherwise (NB: wmask useless as zsh2 are masked) 70 p_sh2(ji,jj,jk) = 0.25 * ( ( zsh2u(ji-1,jj) + zsh2u(ji,jj) ) * ( 2. - umask(ji-1,jj,jk) * umask(ji,jj,jk) ) & 71 & + ( zsh2v(ji,jj-1) + zsh2v(ji,jj) ) * ( 2. - vmask(ji,jj-1,jk) * vmask(ji,jj,jk) ) ) 72 END DO 73 END DO 61 DO_2D_10_10 62 zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) & 63 & * ( uu(ji,jj,jk-1,Kmm) - uu(ji,jj,jk,Kmm) ) & 64 & * ( uu(ji,jj,jk-1,Kbb) - uu(ji,jj,jk,Kbb) ) / ( e3uw(ji,jj,jk,Kmm) * e3uw(ji,jj,jk,Kbb) ) * wumask(ji,jj,jk) 65 zsh2v(ji,jj) = ( p_avm(ji,jj+1,jk) + p_avm(ji,jj,jk) ) & 66 & * ( vv(ji,jj,jk-1,Kmm) - vv(ji,jj,jk,Kmm) ) & 67 & * ( vv(ji,jj,jk-1,Kbb) - vv(ji,jj,jk,Kbb) ) / ( e3vw(ji,jj,jk,Kmm) * e3vw(ji,jj,jk,Kbb) ) * wvmask(ji,jj,jk) 68 END_2D 69 DO_2D_00_00 70 p_sh2(ji,jj,jk) = 0.25 * ( ( zsh2u(ji-1,jj) + zsh2u(ji,jj) ) * ( 2. - umask(ji-1,jj,jk) * umask(ji,jj,jk) ) & 71 & + ( zsh2v(ji,jj-1) + zsh2v(ji,jj) ) * ( 2. - vmask(ji,jj-1,jk) * vmask(ji,jj,jk) ) ) 72 END_2D 74 73 END DO 75 74 ! -
NEMO/trunk/src/OCE/ZDF/zdfswm.F90
r10069 r12377 27 27 PUBLIC zdf_swm_init ! routine called in zdf_phy_init 28 28 29 !! * Substitutions 30 # include "do_loop_substitute.h90" 29 31 !!---------------------------------------------------------------------- 30 32 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 34 36 CONTAINS 35 37 36 SUBROUTINE zdf_swm( kt, p_avm, p_avt, p_avs )38 SUBROUTINE zdf_swm( kt, Kmm, p_avm, p_avt, p_avs ) 37 39 !!--------------------------------------------------------------------- 38 40 !! *** ROUTINE zdf_swm *** … … 52 54 !!--------------------------------------------------------------------- 53 55 INTEGER , INTENT(in ) :: kt ! ocean time step 56 INTEGER , INTENT(in ) :: Kmm ! time level index 54 57 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: p_avm ! momentum Kz (w-points) 55 58 REAL(wp), DIMENSION(:,:,:) , INTENT(inout) :: p_avt, p_avs ! tracer Kz (w-points) … … 60 63 ! 61 64 zcoef = 1._wp * 0.353553_wp 62 DO jk = 2, jpkm1 63 DO jj = 2, jpjm1 64 DO ji = 2, jpim1 65 zqb = zcoef * hsw(ji,jj) * tsd2d(ji,jj) * EXP( -3. * wnum(ji,jj) * gdepw_n(ji,jj,jk) ) * wmask(ji,jj,jk) 66 ! 67 p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zqb 68 p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zqb 69 p_avm(ji,jj,jk) = p_avm(ji,jj,jk) + zqb 70 END DO 71 END DO 72 END DO 65 DO_3D_00_00( 2, jpkm1 ) 66 zqb = zcoef * hsw(ji,jj) * tsd2d(ji,jj) * EXP( -3. * wnum(ji,jj) * gdepw(ji,jj,jk,Kmm) ) * wmask(ji,jj,jk) 67 ! 68 p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zqb 69 p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zqb 70 p_avm(ji,jj,jk) = p_avm(ji,jj,jk) + zqb 71 END_3D 73 72 ! 74 73 END SUBROUTINE zdf_swm -
NEMO/trunk/src/OCE/ZDF/zdftke.F90
r11536 r12377 89 89 90 90 !! * Substitutions 91 # include " vectopt_loop_substitute.h90"91 # include "do_loop_substitute.h90" 92 92 !!---------------------------------------------------------------------- 93 93 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 109 109 110 110 111 SUBROUTINE zdf_tke( kt, p_sh2, p_avm, p_avt )111 SUBROUTINE zdf_tke( kt, Kbb, Kmm, p_sh2, p_avm, p_avt ) 112 112 !!---------------------------------------------------------------------- 113 113 !! *** ROUTINE zdf_tke *** … … 155 155 !!---------------------------------------------------------------------- 156 156 INTEGER , INTENT(in ) :: kt ! ocean time step 157 INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level indices 157 158 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: p_sh2 ! shear production term 158 159 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: p_avm, p_avt ! momentum and tracer Kz (w-points) 159 160 !!---------------------------------------------------------------------- 160 161 ! 161 CALL tke_tke( gdepw_n, e3t_n, e3w_n, p_sh2, p_avm, p_avt ) ! now tke (en)162 ! 163 CALL tke_avn( gdepw_n, e3t_n, e3w_n, p_avm, p_avt ) ! now avt, avm, dissl162 CALL tke_tke( Kbb, Kmm, p_sh2, p_avm, p_avt ) ! now tke (en) 163 ! 164 CALL tke_avn( Kbb, Kmm, p_avm, p_avt ) ! now avt, avm, dissl 164 165 ! 165 166 END SUBROUTINE zdf_tke 166 167 167 168 168 SUBROUTINE tke_tke( pdepw, p_e3t, p_e3w, p_sh2, p_avm, p_avt )169 SUBROUTINE tke_tke( Kbb, Kmm, p_sh2, p_avm, p_avt ) 169 170 !!---------------------------------------------------------------------- 170 171 !! *** ROUTINE tke_tke *** … … 186 187 USE zdf_oce , ONLY : en ! ocean vertical physics 187 188 !! 188 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pdepw ! depth of w-points 189 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: p_e3t, p_e3w ! level thickness (t- & w-points) 189 INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level indices 190 190 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: p_sh2 ! shear production term 191 191 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: p_avm, p_avt ! vertical eddy viscosity & diffusivity (w-points) … … 215 215 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 216 216 217 DO jj = 2, jpjm1 ! en(1) = rn_ebb taum / rau0 (min value rn_emin0) 218 DO ji = fs_2, fs_jpim1 ! vector opt. 219 en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1) 220 END DO 221 END DO 217 DO_2D_00_00 218 en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1) 219 END_2D 222 220 IF ( ln_isfcav ) THEN 223 DO jj = 2, jpjm1 ! en(mikt(ji,jj)) = rn_emin 224 DO ji = fs_2, fs_jpim1 ! vector opt. 225 en(ji,jj,mikt(ji,jj)) = rn_emin * tmask(ji,jj,1) 226 END DO 227 END DO 221 DO_2D_00_00 222 en(ji,jj,mikt(ji,jj)) = rn_emin * tmask(ji,jj,1) 223 END_2D 228 224 ENDIF 229 225 ! … … 238 234 IF( ln_drg ) THEN !== friction used as top/bottom boundary condition on TKE 239 235 ! 240 DO jj = 2, jpjm1 ! bottom friction 241 DO ji = fs_2, fs_jpim1 ! vector opt. 242 zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 243 zmskv = ( 2. - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) 244 ! ! where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000. (CAUTION CdU<0) 245 zebot = - 0.001875_wp * rCdU_bot(ji,jj) * SQRT( ( zmsku*( ub(ji,jj,mbkt(ji,jj))+ub(ji-1,jj,mbkt(ji,jj)) ) )**2 & 246 & + ( zmskv*( vb(ji,jj,mbkt(ji,jj))+vb(ji,jj-1,mbkt(ji,jj)) ) )**2 ) 247 en(ji,jj,mbkt(ji,jj)+1) = MAX( zebot, rn_emin ) * ssmask(ji,jj) 248 END DO 249 END DO 236 DO_2D_00_00 237 zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 238 zmskv = ( 2. - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) 239 ! ! where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000. (CAUTION CdU<0) 240 zebot = - 0.001875_wp * rCdU_bot(ji,jj) * SQRT( ( zmsku*( uu(ji,jj,mbkt(ji,jj),Kbb)+uu(ji-1,jj,mbkt(ji,jj),Kbb) ) )**2 & 241 & + ( zmskv*( vv(ji,jj,mbkt(ji,jj),Kbb)+vv(ji,jj-1,mbkt(ji,jj),Kbb) ) )**2 ) 242 en(ji,jj,mbkt(ji,jj)+1) = MAX( zebot, rn_emin ) * ssmask(ji,jj) 243 END_2D 250 244 IF( ln_isfcav ) THEN ! top friction 251 DO jj = 2, jpjm1 252 DO ji = fs_2, fs_jpim1 ! vector opt. 253 zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 254 zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) ) 255 ! ! where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000. (CAUTION CdU<0) 256 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 & + ( 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 259 END DO 260 END DO 245 DO_2D_00_00 246 zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 247 zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) ) 248 ! ! where 0.001875 = (rn_ebb0/rau0) * 0.5 = 3.75*0.5/1000. (CAUTION CdU<0) 249 zetop = - 0.001875_wp * rCdU_top(ji,jj) * SQRT( ( zmsku*( uu(ji,jj,mikt(ji,jj),Kbb)+uu(ji-1,jj,mikt(ji,jj),Kbb) ) )**2 & 250 & + ( zmskv*( vv(ji,jj,mikt(ji,jj),Kbb)+vv(ji,jj-1,mikt(ji,jj),Kbb) ) )**2 ) 251 en(ji,jj,mikt(ji,jj)) = MAX( zetop, rn_emin ) * (1._wp - tmask(ji,jj,1)) ! masked at ocean surface 252 END_2D 261 253 ENDIF 262 254 ! … … 268 260 ! 269 261 ! !* total energy produce by LC : cumulative sum over jk 270 zpelc(:,:,1) = MAX( rn2b(:,:,1), 0._wp ) * pdepw(:,:,1) * p_e3w(:,:,1)262 zpelc(:,:,1) = MAX( rn2b(:,:,1), 0._wp ) * gdepw(:,:,1,Kmm) * e3w(:,:,1,Kmm) 271 263 DO jk = 2, jpk 272 zpelc(:,:,jk) = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * pdepw(:,:,jk) * p_e3w(:,:,jk)264 zpelc(:,:,jk) = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * gdepw(:,:,jk,Kmm) * e3w(:,:,jk,Kmm) 273 265 END DO 274 266 ! !* finite Langmuir Circulation depth 275 267 zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag ) 276 268 imlc(:,:) = mbkt(:,:) + 1 ! Initialization to the number of w ocean point (=2 over land) 277 DO jk = jpkm1, 2, -1 278 DO jj = 1, jpj ! Last w-level at which zpelc>=0.5*us*us 279 DO ji = 1, jpi ! with us=0.016*wind(starting from jpk-1) 280 zus = zcof * taum(ji,jj) 281 IF( zpelc(ji,jj,jk) > zus ) imlc(ji,jj) = jk 282 END DO 283 END DO 284 END DO 269 DO_3DS_11_11( jpkm1, 2, -1 ) 270 zus = zcof * taum(ji,jj) 271 IF( zpelc(ji,jj,jk) > zus ) imlc(ji,jj) = jk 272 END_3D 285 273 ! ! finite LC depth 286 DO jj = 1, jpj 287 DO ji = 1, jpi 288 zhlc(ji,jj) = pdepw(ji,jj,imlc(ji,jj)) 289 END DO 290 END DO 274 DO_2D_11_11 275 zhlc(ji,jj) = gdepw(ji,jj,imlc(ji,jj),Kmm) 276 END_2D 291 277 zcof = 0.016 / SQRT( zrhoa * zcdrag ) 292 DO jj = 2, jpjm1 293 DO ji = fs_2, fs_jpim1 ! vector opt. 294 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. 297 END DO 298 END DO 299 DO jk = 2, jpkm1 !* TKE Langmuir circulation source term added to en 300 DO jj = 2, jpjm1 301 DO ji = fs_2, fs_jpim1 ! vector opt. 302 IF ( zfr_i(ji,jj) /= 0. ) THEN 303 ! vertical velocity due to LC 304 IF ( pdepw(ji,jj,jk) - zhlc(ji,jj) < 0 .AND. wmask(ji,jj,jk) /= 0. ) THEN 305 ! ! 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_i 307 ! ! TKE Langmuir circulation source term 308 en(ji,jj,jk) = en(ji,jj,jk) + rdt * zfr_i(ji,jj) * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj) 309 ENDIF 310 ENDIF 311 END DO 312 END DO 313 END DO 278 DO_2D_00_00 279 zus = zcof * SQRT( taum(ji,jj) ) ! Stokes drift 280 zfr_i(ji,jj) = ( 1._wp - 4._wp * fr_i(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok 281 IF (zfr_i(ji,jj) < 0. ) zfr_i(ji,jj) = 0. 282 END_2D 283 DO_3D_00_00( 2, jpkm1 ) 284 IF ( zfr_i(ji,jj) /= 0. ) THEN 285 ! vertical velocity due to LC 286 IF ( gdepw(ji,jj,jk,Kmm) - zhlc(ji,jj) < 0 .AND. wmask(ji,jj,jk) /= 0. ) THEN 287 ! ! vertical velocity due to LC 288 zwlc = rn_lc * SIN( rpi * gdepw(ji,jj,jk,Kmm) / zhlc(ji,jj) ) ! warning: optimization: zus^3 is in zfr_i 289 ! ! TKE Langmuir circulation source term 290 en(ji,jj,jk) = en(ji,jj,jk) + rdt * zfr_i(ji,jj) * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj) 291 ENDIF 292 ENDIF 293 END_3D 314 294 ! 315 295 ENDIF … … 323 303 ! 324 304 IF( nn_pdl == 1 ) THEN !* Prandtl number = F( Ri ) 325 DO jk = 2, jpkm1 326 DO jj = 2, jpjm1 327 DO ji = 2, jpim1 328 ! ! local Richardson number 329 zri = MAX( rn2b(ji,jj,jk), 0._wp ) * p_avm(ji,jj,jk) / ( p_sh2(ji,jj,jk) + rn_bshear ) 330 ! ! inverse of Prandtl number 331 apdlr(ji,jj,jk) = MAX( 0.1_wp, ri_cri / MAX( ri_cri , zri ) ) 332 END DO 333 END DO 334 END DO 305 DO_3D_00_00( 2, jpkm1 ) 306 ! ! local Richardson number 307 zri = MAX( rn2b(ji,jj,jk), 0._wp ) * p_avm(ji,jj,jk) / ( p_sh2(ji,jj,jk) + rn_bshear ) 308 ! ! inverse of Prandtl number 309 apdlr(ji,jj,jk) = MAX( 0.1_wp, ri_cri / MAX( ri_cri , zri ) ) 310 END_3D 335 311 ENDIF 336 312 ! 337 DO jk = 2, jpkm1 !* Matrix and right hand side in en 338 DO jj = 2, jpjm1 339 DO ji = fs_2, fs_jpim1 ! vector opt. 340 zcof = zfact1 * tmask(ji,jj,jk) 341 ! ! A minimum of 2.e-5 m2/s is imposed on TKE vertical 342 ! ! eddy coefficient (ensure numerical stability) 343 zzd_up = zcof * MAX( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk ) , 2.e-5_wp ) & ! upper diagonal 344 & / ( p_e3t(ji,jj,jk ) * p_e3w(ji,jj,jk ) ) 345 zzd_lw = zcof * MAX( p_avm(ji,jj,jk ) + p_avm(ji,jj,jk-1) , 2.e-5_wp ) & ! lower diagonal 346 & / ( p_e3t(ji,jj,jk-1) * p_e3w(ji,jj,jk ) ) 347 ! 348 zd_up(ji,jj,jk) = zzd_up ! Matrix (zdiag, zd_up, zd_lw) 349 zd_lw(ji,jj,jk) = zzd_lw 350 zdiag(ji,jj,jk) = 1._wp - zzd_lw - zzd_up + zfact2 * dissl(ji,jj,jk) * wmask(ji,jj,jk) 351 ! 352 ! ! right hand side in en 353 en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( p_sh2(ji,jj,jk) & ! shear 354 & - p_avt(ji,jj,jk) * rn2(ji,jj,jk) & ! stratification 355 & + zfact3 * dissl(ji,jj,jk) * en(ji,jj,jk) & ! dissipation 356 & ) * wmask(ji,jj,jk) 357 END DO 358 END DO 359 END DO 313 DO_3D_00_00( 2, jpkm1 ) 314 zcof = zfact1 * tmask(ji,jj,jk) 315 ! ! A minimum of 2.e-5 m2/s is imposed on TKE vertical 316 ! ! eddy coefficient (ensure numerical stability) 317 zzd_up = zcof * MAX( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk ) , 2.e-5_wp ) & ! upper diagonal 318 & / ( e3t(ji,jj,jk ,Kmm) * e3w(ji,jj,jk ,Kmm) ) 319 zzd_lw = zcof * MAX( p_avm(ji,jj,jk ) + p_avm(ji,jj,jk-1) , 2.e-5_wp ) & ! lower diagonal 320 & / ( e3t(ji,jj,jk-1,Kmm) * e3w(ji,jj,jk ,Kmm) ) 321 ! 322 zd_up(ji,jj,jk) = zzd_up ! Matrix (zdiag, zd_up, zd_lw) 323 zd_lw(ji,jj,jk) = zzd_lw 324 zdiag(ji,jj,jk) = 1._wp - zzd_lw - zzd_up + zfact2 * dissl(ji,jj,jk) * wmask(ji,jj,jk) 325 ! 326 ! ! right hand side in en 327 en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( p_sh2(ji,jj,jk) & ! shear 328 & - p_avt(ji,jj,jk) * rn2(ji,jj,jk) & ! stratification 329 & + zfact3 * dissl(ji,jj,jk) * en(ji,jj,jk) & ! dissipation 330 & ) * wmask(ji,jj,jk) 331 END_3D 360 332 ! !* Matrix inversion from level 2 (tke prescribed at level 1) 361 DO jk = 3, jpkm1 ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 362 DO jj = 2, jpjm1 363 DO ji = fs_2, fs_jpim1 ! vector opt. 364 zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 365 END DO 366 END DO 367 END DO 368 DO jj = 2, jpjm1 ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 369 DO ji = fs_2, fs_jpim1 ! vector opt. 370 zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1) ! Surface boudary conditions on tke 371 END DO 372 END DO 373 DO jk = 3, jpkm1 374 DO jj = 2, jpjm1 375 DO ji = fs_2, fs_jpim1 ! vector opt. 376 zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) *zd_lw(ji,jj,jk-1) 377 END DO 378 END DO 379 END DO 380 DO jj = 2, jpjm1 ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 381 DO ji = fs_2, fs_jpim1 ! vector opt. 382 en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1) 383 END DO 384 END DO 385 DO jk = jpk-2, 2, -1 386 DO jj = 2, jpjm1 387 DO ji = fs_2, fs_jpim1 ! vector opt. 388 en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 389 END DO 390 END DO 391 END DO 392 DO jk = 2, jpkm1 ! set the minimum value of tke 393 DO jj = 2, jpjm1 394 DO ji = fs_2, fs_jpim1 ! vector opt. 395 en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * wmask(ji,jj,jk) 396 END DO 397 END DO 398 END DO 333 DO_3D_00_00( 3, jpkm1 ) 334 zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 335 END_3D 336 DO_2D_00_00 337 zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1) ! Surface boudary conditions on tke 338 END_2D 339 DO_3D_00_00( 3, jpkm1 ) 340 zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) *zd_lw(ji,jj,jk-1) 341 END_3D 342 DO_2D_00_00 343 en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1) 344 END_2D 345 DO_3DS_00_00( jpk-2, 2, -1 ) 346 en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 347 END_3D 348 DO_3D_00_00( 2, jpkm1 ) 349 en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * wmask(ji,jj,jk) 350 END_3D 399 351 ! 400 352 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< … … 402 354 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 403 355 !!gm BUG : in the exp remove the depth of ssh !!! 404 !!gm i.e. use gde3w in argument ( pdepw)356 !!gm i.e. use gde3w in argument (gdepw(:,:,:,Kmm)) 405 357 406 358 407 359 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.25 409 DO jj = 2, jpjm1 410 DO ji = fs_2, fs_jpim1 ! vector opt. 411 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) 413 END DO 414 END DO 415 END DO 360 DO_3D_00_00( 2, jpkm1 ) 361 en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) ) & 362 & * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 363 END_3D 416 364 ELSEIF( nn_etau == 2 ) THEN !* act only at the base of the mixed layer (jk=nmln) (rn_efr fraction) 417 DO jj = 2, jpjm1 418 DO ji = fs_2, fs_jpim1 ! vector opt. 419 jk = nmln(ji,jj) 420 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) 422 END DO 423 END DO 365 DO_2D_00_00 366 jk = nmln(ji,jj) 367 en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) ) & 368 & * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 369 END_2D 424 370 ELSEIF( nn_etau == 3 ) THEN !* penetration belox the mixed layer (HF variability) 425 DO jk = 2, jpkm1 426 DO jj = 2, jpjm1 427 DO ji = fs_2, fs_jpim1 ! vector opt. 428 ztx2 = utau(ji-1,jj ) + utau(ji,jj) 429 zty2 = vtau(ji ,jj-1) + vtau(ji,jj) 430 ztau = 0.5_wp * SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1) ! module of the mean stress 431 zdif = taum(ji,jj) - ztau ! mean of modulus - modulus of the mean 432 zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add ) ! apply some modifications... 433 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) 435 END DO 436 END DO 437 END DO 371 DO_3D_00_00( 2, jpkm1 ) 372 ztx2 = utau(ji-1,jj ) + utau(ji,jj) 373 zty2 = vtau(ji ,jj-1) + vtau(ji,jj) 374 ztau = 0.5_wp * SQRT( ztx2 * ztx2 + zty2 * zty2 ) * tmask(ji,jj,1) ! module of the mean stress 375 zdif = taum(ji,jj) - ztau ! mean of modulus - modulus of the mean 376 zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add ) ! apply some modifications... 377 en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) ) & 378 & * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 379 END_3D 438 380 ENDIF 439 381 ! … … 441 383 442 384 443 SUBROUTINE tke_avn( pdepw, p_e3t, p_e3w, p_avm, p_avt )385 SUBROUTINE tke_avn( Kbb, Kmm, p_avm, p_avt ) 444 386 !!---------------------------------------------------------------------- 445 387 !! *** ROUTINE tke_avn *** … … 477 419 USE zdf_oce , ONLY : en, avtb, avmb, avtb_2d ! ocean vertical physics 478 420 !! 479 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pdepw ! depth (w-points) 480 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: p_e3t, p_e3w ! level thickness (t- & w-points) 421 INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level indices 481 422 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_avm, p_avt ! vertical eddy viscosity & diffusivity (w-points) 482 423 ! … … 500 441 IF( ln_mxl0 ) THEN ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rau0*g) 501 442 zraug = vkarmn * 2.e5_wp / ( rau0 * grav ) 502 DO jj = 2, jpjm1 503 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 443 DO_2D_00_00 444 zmxlm(ji,jj,1) = MAX( rn_mxl0, zraug * taum(ji,jj) * tmask(ji,jj,1) ) 445 END_2D 507 446 ELSE 508 447 zmxlm(:,:,1) = rn_mxl0 509 448 ENDIF 510 449 ! 511 DO jk = 2, jpkm1 ! interior value : l=sqrt(2*e/n^2) 512 DO jj = 2, jpjm1 513 DO ji = fs_2, fs_jpim1 ! vector opt. 514 zrn2 = MAX( rn2(ji,jj,jk), rsmall ) 515 zmxlm(ji,jj,jk) = MAX( rmxl_min, SQRT( 2._wp * en(ji,jj,jk) / zrn2 ) ) 516 END DO 517 END DO 518 END DO 450 DO_3D_00_00( 2, jpkm1 ) 451 zrn2 = MAX( rn2(ji,jj,jk), rsmall ) 452 zmxlm(ji,jj,jk) = MAX( rmxl_min, SQRT( 2._wp * en(ji,jj,jk) / zrn2 ) ) 453 END_3D 519 454 ! 520 455 ! !* Physical limits for the mixing length … … 526 461 ! 527 462 !!gm Not sure of that coding for ISF.... 528 ! where wmask = 0 set zmxlm == p_e3w463 ! where wmask = 0 set zmxlm == e3w(:,:,:,Kmm) 529 464 CASE ( 0 ) ! bounded by the distance to surface and bottom 530 DO jk = 2, jpkm1 531 DO jj = 2, jpjm1 532 DO ji = fs_2, fs_jpim1 ! vector opt. 533 zemxl = MIN( pdepw(ji,jj,jk) - pdepw(ji,jj,mikt(ji,jj)), zmxlm(ji,jj,jk), & 534 & pdepw(ji,jj,mbkt(ji,jj)+1) - pdepw(ji,jj,jk) ) 535 ! wmask prevent zmxlm = 0 if jk = mikt(ji,jj) 536 zmxlm(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN( zmxlm(ji,jj,jk) , p_e3w(ji,jj,jk) ) * (1 - wmask(ji,jj,jk)) 537 zmxld(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN( zmxlm(ji,jj,jk) , p_e3w(ji,jj,jk) ) * (1 - wmask(ji,jj,jk)) 538 END DO 539 END DO 540 END DO 465 DO_3D_00_00( 2, jpkm1 ) 466 zemxl = MIN( gdepw(ji,jj,jk,Kmm) - gdepw(ji,jj,mikt(ji,jj),Kmm), zmxlm(ji,jj,jk), & 467 & gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) - gdepw(ji,jj,jk,Kmm) ) 468 ! wmask prevent zmxlm = 0 if jk = mikt(ji,jj) 469 zmxlm(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN( zmxlm(ji,jj,jk) , e3w(ji,jj,jk,Kmm) ) * (1 - wmask(ji,jj,jk)) 470 zmxld(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN( zmxlm(ji,jj,jk) , e3w(ji,jj,jk,Kmm) ) * (1 - wmask(ji,jj,jk)) 471 END_3D 541 472 ! 542 473 CASE ( 1 ) ! bounded by the vertical scale factor 543 DO jk = 2, jpkm1 544 DO jj = 2, jpjm1 545 DO ji = fs_2, fs_jpim1 ! vector opt. 546 zemxl = MIN( p_e3w(ji,jj,jk), zmxlm(ji,jj,jk) ) 547 zmxlm(ji,jj,jk) = zemxl 548 zmxld(ji,jj,jk) = zemxl 549 END DO 550 END DO 551 END DO 474 DO_3D_00_00( 2, jpkm1 ) 475 zemxl = MIN( e3w(ji,jj,jk,Kmm), zmxlm(ji,jj,jk) ) 476 zmxlm(ji,jj,jk) = zemxl 477 zmxld(ji,jj,jk) = zemxl 478 END_3D 552 479 ! 553 480 CASE ( 2 ) ! |dk[xml]| bounded by e3t : 554 DO jk = 2, jpkm1 ! from the surface to the bottom : 555 DO jj = 2, jpjm1 556 DO ji = fs_2, fs_jpim1 ! vector opt. 557 zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk-1) + p_e3t(ji,jj,jk-1), zmxlm(ji,jj,jk) ) 558 END DO 559 END DO 560 END DO 561 DO jk = jpkm1, 2, -1 ! from the bottom to the surface : 562 DO jj = 2, jpjm1 563 DO ji = fs_2, fs_jpim1 ! vector opt. 564 zemxl = MIN( zmxlm(ji,jj,jk+1) + p_e3t(ji,jj,jk+1), zmxlm(ji,jj,jk) ) 565 zmxlm(ji,jj,jk) = zemxl 566 zmxld(ji,jj,jk) = zemxl 567 END DO 568 END DO 569 END DO 481 DO_3D_00_00( 2, jpkm1 ) 482 zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk-1) + e3t(ji,jj,jk-1,Kmm), zmxlm(ji,jj,jk) ) 483 END_3D 484 DO_3DS_00_00( jpkm1, 2, -1 ) 485 zemxl = MIN( zmxlm(ji,jj,jk+1) + e3t(ji,jj,jk+1,Kmm), zmxlm(ji,jj,jk) ) 486 zmxlm(ji,jj,jk) = zemxl 487 zmxld(ji,jj,jk) = zemxl 488 END_3D 570 489 ! 571 490 CASE ( 3 ) ! lup and ldown, |dk[xml]| bounded by e3t : 572 DO jk = 2, jpkm1 ! from the surface to the bottom : lup 573 DO jj = 2, jpjm1 574 DO ji = fs_2, fs_jpim1 ! vector opt. 575 zmxld(ji,jj,jk) = MIN( zmxld(ji,jj,jk-1) + p_e3t(ji,jj,jk-1), zmxlm(ji,jj,jk) ) 576 END DO 577 END DO 578 END DO 579 DO jk = jpkm1, 2, -1 ! from the bottom to the surface : ldown 580 DO jj = 2, jpjm1 581 DO ji = fs_2, fs_jpim1 ! vector opt. 582 zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk+1) + p_e3t(ji,jj,jk+1), zmxlm(ji,jj,jk) ) 583 END DO 584 END DO 585 END DO 586 DO jk = 2, jpkm1 587 DO jj = 2, jpjm1 588 DO ji = fs_2, fs_jpim1 ! vector opt. 589 zemlm = MIN ( zmxld(ji,jj,jk), zmxlm(ji,jj,jk) ) 590 zemlp = SQRT( zmxld(ji,jj,jk) * zmxlm(ji,jj,jk) ) 591 zmxlm(ji,jj,jk) = zemlm 592 zmxld(ji,jj,jk) = zemlp 593 END DO 594 END DO 595 END DO 491 DO_3D_00_00( 2, jpkm1 ) 492 zmxld(ji,jj,jk) = MIN( zmxld(ji,jj,jk-1) + e3t(ji,jj,jk-1,Kmm), zmxlm(ji,jj,jk) ) 493 END_3D 494 DO_3DS_00_00( jpkm1, 2, -1 ) 495 zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk+1) + e3t(ji,jj,jk+1,Kmm), zmxlm(ji,jj,jk) ) 496 END_3D 497 DO_3D_00_00( 2, jpkm1 ) 498 zemlm = MIN ( zmxld(ji,jj,jk), zmxlm(ji,jj,jk) ) 499 zemlp = SQRT( zmxld(ji,jj,jk) * zmxlm(ji,jj,jk) ) 500 zmxlm(ji,jj,jk) = zemlm 501 zmxld(ji,jj,jk) = zemlp 502 END_3D 596 503 ! 597 504 END SELECT … … 600 507 ! ! Vertical eddy viscosity and diffusivity (avm and avt) 601 508 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 602 DO jk = 1, jpkm1 !* vertical eddy viscosity & diffivity at w-points 603 DO jj = 2, jpjm1 604 DO ji = fs_2, fs_jpim1 ! vector opt. 605 zsqen = SQRT( en(ji,jj,jk) ) 606 zav = rn_ediff * zmxlm(ji,jj,jk) * zsqen 607 p_avm(ji,jj,jk) = MAX( zav, avmb(jk) ) * wmask(ji,jj,jk) 608 p_avt(ji,jj,jk) = MAX( zav, avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk) 609 dissl(ji,jj,jk) = zsqen / zmxld(ji,jj,jk) 610 END DO 611 END DO 612 END DO 509 DO_3D_00_00( 1, jpkm1 ) 510 zsqen = SQRT( en(ji,jj,jk) ) 511 zav = rn_ediff * zmxlm(ji,jj,jk) * zsqen 512 p_avm(ji,jj,jk) = MAX( zav, avmb(jk) ) * wmask(ji,jj,jk) 513 p_avt(ji,jj,jk) = MAX( zav, avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk) 514 dissl(ji,jj,jk) = zsqen / zmxld(ji,jj,jk) 515 END_3D 613 516 ! 614 517 ! 615 518 IF( nn_pdl == 1 ) THEN !* Prandtl number case: update avt 616 DO jk = 2, jpkm1 617 DO jj = 2, jpjm1 618 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) 620 END DO 621 END DO 622 END DO 623 ENDIF 624 ! 625 IF(ln_ctl) THEN 519 DO_3D_00_00( 2, jpkm1 ) 520 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) 521 END_3D 522 ENDIF 523 ! 524 IF(sn_cfctl%l_prtctl) THEN 626 525 CALL prt_ctl( tab3d_1=en , clinfo1=' tke - e: ', tab3d_2=p_avt, clinfo2=' t: ', kdim=jpk) 627 526 CALL prt_ctl( tab3d_1=p_avm, clinfo1=' tke - m: ', kdim=jpk ) … … 631 530 632 531 633 SUBROUTINE zdf_tke_init 532 SUBROUTINE zdf_tke_init( Kmm ) 634 533 !!---------------------------------------------------------------------- 635 534 !! *** ROUTINE zdf_tke_init *** … … 647 546 USE zdf_oce , ONLY : ln_zdfiwm ! Internal Wave Mixing flag 648 547 !! 649 INTEGER :: ji, jj, jk ! dummy loop indices 650 INTEGER :: ios 548 INTEGER, INTENT(in) :: Kmm ! time level index 549 INTEGER :: ji, jj, jk ! dummy loop indices 550 INTEGER :: ios 651 551 !! 652 552 NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb , rn_emin , & … … 656 556 !!---------------------------------------------------------------------- 657 557 ! 658 REWIND( numnam_ref ) ! Namelist namzdf_tke in reference namelist : Turbulent Kinetic Energy659 558 READ ( numnam_ref, namzdf_tke, IOSTAT = ios, ERR = 901) 660 559 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_tke in reference namelist' ) 661 560 662 REWIND( numnam_cfg ) ! Namelist namzdf_tke in configuration namelist : Turbulent Kinetic Energy663 561 READ ( numnam_cfg, namzdf_tke, IOSTAT = ios, ERR = 902 ) 664 562 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namzdf_tke in configuration namelist' ) … … 725 623 ENDIF 726 624 727 IF( nn_etau == 2 ) CALL zdf_mxl( nit000 ) ! Initialization of nmln625 IF( nn_etau == 2 ) CALL zdf_mxl( nit000, Kmm ) ! Initialization of nmln 728 626 729 627 ! !* depth of penetration of surface tke
Note: See TracChangeset
for help on using the changeset viewer.
