Changeset 10883 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/ZDF/zdftke.F90
- Timestamp:
- 2019-04-18T14:29:58+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/ZDF/zdftke.F90
r10874 r10883 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) … … 243 243 zmskv = ( 2. - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) 244 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*( u b(ji,jj,mbkt(ji,jj))+ub(ji-1,jj,mbkt(ji,jj)) ) )**2 &246 & + ( zmskv*( v b(ji,jj,mbkt(ji,jj))+vb(ji,jj-1,mbkt(ji,jj)) ) )**2 )245 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 & 246 & + ( zmskv*( vv(ji,jj,mbkt(ji,jj),Kbb)+vv(ji,jj-1,mbkt(ji,jj),Kbb) ) )**2 ) 247 247 en(ji,jj,mbkt(ji,jj)+1) = MAX( zebot, rn_emin ) * ssmask(ji,jj) 248 248 END DO … … 254 254 zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) ) 255 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*( u b(ji,jj,mikt(ji,jj))+ub(ji-1,jj,mikt(ji,jj)) ) )**2 &257 & + ( zmskv*( v b(ji,jj,mikt(ji,jj))+vb(ji,jj-1,mikt(ji,jj)) ) )**2 )256 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 & 257 & + ( zmskv*( vv(ji,jj,mikt(ji,jj),Kbb)+vv(ji,jj-1,mikt(ji,jj),Kbb) ) )**2 ) 258 258 en(ji,jj,mikt(ji,jj)) = MAX( zetop, rn_emin ) * (1._wp - tmask(ji,jj,1)) ! masked at ocean surface 259 259 END DO … … 268 268 ! 269 269 ! !* total energy produce by LC : cumulative sum over jk 270 zpelc(:,:,1) = MAX( rn2b(:,:,1), 0._wp ) * pdepw(:,:,1) * p_e3w(:,:,1)270 zpelc(:,:,1) = MAX( rn2b(:,:,1), 0._wp ) * gdepw(:,:,1,Kmm) * e3w(:,:,1,Kmm) 271 271 DO jk = 2, jpk 272 zpelc(:,:,jk) = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * pdepw(:,:,jk) * p_e3w(:,:,jk)272 zpelc(:,:,jk) = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * gdepw(:,:,jk,Kmm) * e3w(:,:,jk,Kmm) 273 273 END DO 274 274 ! !* finite Langmuir Circulation depth … … 286 286 DO jj = 1, jpj 287 287 DO ji = 1, jpi 288 zhlc(ji,jj) = pdepw(ji,jj,imlc(ji,jj))288 zhlc(ji,jj) = gdepw(ji,jj,imlc(ji,jj),Kmm) 289 289 END DO 290 290 END DO … … 302 302 IF ( zfr_i(ji,jj) /= 0. ) THEN 303 303 ! vertical velocity due to LC 304 IF ( pdepw(ji,jj,jk) - zhlc(ji,jj) < 0 .AND. wmask(ji,jj,jk) /= 0. ) THEN304 IF ( gdepw(ji,jj,jk,Kmm) - zhlc(ji,jj) < 0 .AND. wmask(ji,jj,jk) /= 0. ) THEN 305 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_i306 zwlc = rn_lc * SIN( rpi * gdepw(ji,jj,jk,Kmm) / zhlc(ji,jj) ) ! warning: optimization: zus^3 is in zfr_i 307 307 ! ! TKE Langmuir circulation source term 308 308 en(ji,jj,jk) = en(ji,jj,jk) + rdt * zfr_i(ji,jj) * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj) … … 342 342 ! ! eddy coefficient (ensure numerical stability) 343 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) )344 & / ( e3t(ji,jj,jk ,Kmm) * e3w(ji,jj,jk ,Kmm) ) 345 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) )346 & / ( e3t(ji,jj,jk-1,Kmm) * e3w(ji,jj,jk ,Kmm) ) 347 347 ! 348 348 zd_up(ji,jj,jk) = zzd_up ! Matrix (zdiag, zd_up, zd_lw) … … 402 402 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 403 403 !!gm BUG : in the exp remove the depth of ssh !!! 404 !!gm i.e. use gde3w in argument ( pdepw)404 !!gm i.e. use gde3w in argument (gdepw(:,:,:,Kmm)) 405 405 406 406 … … 409 409 DO jj = 2, jpjm1 410 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) ) &411 en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) ) & 412 412 & * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 413 413 END DO … … 418 418 DO ji = fs_2, fs_jpim1 ! vector opt. 419 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) ) &420 en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) ) & 421 421 & * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 422 422 END DO … … 431 431 zdif = taum(ji,jj) - ztau ! mean of modulus - modulus of the mean 432 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) ) &433 en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) ) & 434 434 & * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 435 435 END DO … … 441 441 442 442 443 SUBROUTINE tke_avn( pdepw, p_e3t, p_e3w, p_avm, p_avt )443 SUBROUTINE tke_avn( Kbb, Kmm, p_avm, p_avt ) 444 444 !!---------------------------------------------------------------------- 445 445 !! *** ROUTINE tke_avn *** … … 477 477 USE zdf_oce , ONLY : en, avtb, avmb, avtb_2d ! ocean vertical physics 478 478 !! 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) 479 INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level indices 481 480 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: p_avm, p_avt ! vertical eddy viscosity & diffusivity (w-points) 482 481 ! … … 526 525 ! 527 526 !!gm Not sure of that coding for ISF.... 528 ! where wmask = 0 set zmxlm == p_e3w527 ! where wmask = 0 set zmxlm == e3w(:,:,:,Kmm) 529 528 CASE ( 0 ) ! bounded by the distance to surface and bottom 530 529 DO jk = 2, jpkm1 531 530 DO jj = 2, jpjm1 532 531 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) )532 zemxl = MIN( gdepw(ji,jj,jk,Kmm) - gdepw(ji,jj,mikt(ji,jj),Kmm), zmxlm(ji,jj,jk), & 533 & gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) - gdepw(ji,jj,jk,Kmm) ) 535 534 ! 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))535 zmxlm(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN( zmxlm(ji,jj,jk) , e3w(ji,jj,jk,Kmm) ) * (1 - wmask(ji,jj,jk)) 536 zmxld(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN( zmxlm(ji,jj,jk) , e3w(ji,jj,jk,Kmm) ) * (1 - wmask(ji,jj,jk)) 538 537 END DO 539 538 END DO … … 544 543 DO jj = 2, jpjm1 545 544 DO ji = fs_2, fs_jpim1 ! vector opt. 546 zemxl = MIN( p_e3w(ji,jj,jk), zmxlm(ji,jj,jk) )545 zemxl = MIN( e3w(ji,jj,jk,Kmm), zmxlm(ji,jj,jk) ) 547 546 zmxlm(ji,jj,jk) = zemxl 548 547 zmxld(ji,jj,jk) = zemxl … … 555 554 DO jj = 2, jpjm1 556 555 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) )556 zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk-1) + e3t(ji,jj,jk-1,Kmm), zmxlm(ji,jj,jk) ) 558 557 END DO 559 558 END DO … … 562 561 DO jj = 2, jpjm1 563 562 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) )563 zemxl = MIN( zmxlm(ji,jj,jk+1) + e3t(ji,jj,jk+1,Kmm), zmxlm(ji,jj,jk) ) 565 564 zmxlm(ji,jj,jk) = zemxl 566 565 zmxld(ji,jj,jk) = zemxl … … 573 572 DO jj = 2, jpjm1 574 573 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) )574 zmxld(ji,jj,jk) = MIN( zmxld(ji,jj,jk-1) + e3t(ji,jj,jk-1,Kmm), zmxlm(ji,jj,jk) ) 576 575 END DO 577 576 END DO … … 580 579 DO jj = 2, jpjm1 581 580 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) )581 zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk+1) + e3t(ji,jj,jk+1,Kmm), zmxlm(ji,jj,jk) ) 583 582 END DO 584 583 END DO
Note: See TracChangeset
for help on using the changeset viewer.
