- Timestamp:
- 2020-07-04T10:22:08+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/r4.0-HEAD_r12713_clem_dan_fixcpl/src/OCE/ZDF/zdftke.F90
r13006 r13249 83 83 INTEGER :: nn_htau ! type of tke profile of penetration (=0/1) 84 84 REAL(wp) :: rn_efr ! fraction of TKE surface value which penetrates in the ocean 85 REAL(wp) :: rn_eice ! =0 ON below sea-ice, =4 OFF when ice fraction > 1/486 85 LOGICAL :: ln_lc ! Langmuir cells (LC) as a source term of TKE or not 87 86 REAL(wp) :: rn_lc ! coef to compute vertical velocity of Langmuir cells 87 INTEGER :: nn_eice ! attenutaion of langmuir & surface wave breaking under ice (=0/1/2/3) 88 88 89 89 REAL(wp) :: ri_cri ! critic Richardson number (deduced from rn_ediff and rn_ediss values) … … 199 199 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: p_avm, p_avt ! vertical eddy viscosity & diffusivity (w-points) 200 200 ! 201 INTEGER :: ji, jj, jk ! dummy loop arguments201 INTEGER :: ji, jj, jk ! dummy loop arguments 202 202 REAL(wp) :: zetop, zebot, zmsku, zmskv ! local scalars 203 203 REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3 204 204 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 205 REAL(wp) :: zbbrau, z ri! local scalars206 REAL(wp) :: zfact1, zfact2, zfact3 ! - 207 REAL(wp) :: ztx2 , zty2 , zcof ! - 208 REAL(wp) :: ztau , zdif ! - 209 REAL(wp) :: zus , zwlc , zind ! - 210 REAL(wp) :: zzd_up, zzd_lw ! - 205 REAL(wp) :: zbbrau, zbbirau, zri ! local scalars 206 REAL(wp) :: zfact1, zfact2, zfact3 ! - - 207 REAL(wp) :: ztx2 , zty2 , zcof ! - - 208 REAL(wp) :: ztau , zdif ! - - 209 REAL(wp) :: zus , zwlc , zind ! - - 210 REAL(wp) :: zzd_up, zzd_lw ! - - 211 211 INTEGER , DIMENSION(jpi,jpj) :: imlc 212 REAL(wp), DIMENSION(jpi,jpj) :: z hlc, zfr_i212 REAL(wp), DIMENSION(jpi,jpj) :: zice_fra, zhlc, zus3 213 213 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpelc, zdiag, zd_up, zd_lw 214 214 !!-------------------------------------------------------------------- 215 215 ! 216 zbbrau = rn_ebb / rau0 ! Local constant initialisation 217 zfact1 = -.5_wp * rdt 218 zfact2 = 1.5_wp * rdt * rn_ediss 219 zfact3 = 0.5_wp * rn_ediss 216 zbbrau = rn_ebb / rau0 ! Local constant initialisation 217 zbbirau = 3.75_wp / rau0 218 zfact1 = -0.5_wp * rdt 219 zfact2 = 1.5_wp * rdt * rn_ediss 220 zfact3 = 0.5_wp * rn_ediss 221 ! 222 ! ice fraction considered for attenuation of langmuir & wave breaking 223 SELECT CASE ( nn_eice ) 224 CASE( 0 ) ; zice_fra(:,:) = 0._wp 225 CASE( 1 ) ; zice_fra(:,:) = TANH( fr_i(:,:) * 10._wp ) 226 CASE( 2 ) ; zice_fra(:,:) = fr_i(:,:) 227 CASE( 3 ) ; zice_fra(:,:) = MIN( 4._wp * fr_i(:,:) , 1._wp ) 228 END SELECT 220 229 ! 221 230 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 222 231 ! ! Surface/top/bottom boundary condition on tke 223 232 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 224 233 ! 225 234 DO jj = 2, jpjm1 ! en(1) = rn_ebb taum / rau0 (min value rn_emin0) 226 235 DO ji = fs_2, fs_jpim1 ! vector opt. 227 en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1) 236 en(ji,jj,1) = MAX( rn_emin0, ( ( 1._wp - fr_i(ji,jj) ) * zbbrau + & 237 & fr_i(ji,jj) * zbbirau ) * taum(ji,jj) ) * tmask(ji,jj,1) 228 238 END DO 229 239 END DO … … 257 267 zetop = - 0.001875_wp * rCdU_top(ji,jj) * SQRT( ( zmsku*( ub(ji,jj,mikt(ji,jj))+ub(ji-1,jj,mikt(ji,jj)) ) )**2 & 258 268 & + ( zmskv*( vb(ji,jj,mikt(ji,jj))+vb(ji,jj-1,mikt(ji,jj)) ) )**2 ) 259 en(ji,jj,mikt(ji,jj)) = en(ji,jj,1) * tmask(ji,jj,1) & 269 en(ji,jj,mikt(ji,jj)) = en(ji,jj,1) * tmask(ji,jj,1) & 260 270 & + MAX( zetop, rn_emin ) * (1._wp - tmask(ji,jj,1)) * ssmask(ji,jj) 261 271 END DO … … 295 305 DO ji = fs_2, fs_jpim1 ! vector opt. 296 306 zus = zcof * SQRT( taum(ji,jj) ) ! Stokes drift 297 zfr_i(ji,jj) = ( 1._wp - 4._wp * fr_i(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok 298 IF (zfr_i(ji,jj) < 0. ) zfr_i(ji,jj) = 0. 307 zus3(ji,jj) = ( 1._wp - zice_fra(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok 299 308 END DO 300 309 END DO … … 302 311 DO jj = 2, jpjm1 303 312 DO ji = fs_2, fs_jpim1 ! vector opt. 304 IF ( z fr_i(ji,jj) /= 0. ) THEN313 IF ( zus3(ji,jj) /= 0. ) THEN 305 314 ! vertical velocity due to LC 306 315 IF ( pdepw(ji,jj,jk) - zhlc(ji,jj) < 0 .AND. wmask(ji,jj,jk) /= 0. ) THEN 307 316 ! ! vertical velocity due to LC 308 zwlc = rn_lc * SIN( rpi * pdepw(ji,jj,jk) / zhlc(ji,jj) ) ! warning: optimization: zus^3 is in zfr_i317 zwlc = rn_lc * SIN( rpi * pdepw(ji,jj,jk) / zhlc(ji,jj) ) 309 318 ! ! TKE Langmuir circulation source term 310 en(ji,jj,jk) = en(ji,jj,jk) + rdt * z fr_i(ji,jj) * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj)319 en(ji,jj,jk) = en(ji,jj,jk) + rdt * zus3(ji,jj) * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj) 311 320 ENDIF 312 321 ENDIF … … 408 417 409 418 IF( nn_etau == 1 ) THEN !* penetration below the mixed layer (rn_efr fraction) 410 DO jk = 2, jpkm1 ! rn_eice =0 ON below sea-ice, =4 OFF when ice fraction > 0.25419 DO jk = 2, jpkm1 ! nn_eice=0 : ON below sea-ice ; nn_eice>0 : partly OFF 411 420 DO jj = 2, jpjm1 412 421 DO ji = fs_2, fs_jpim1 ! vector opt. 413 422 en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) ) & 414 & * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) )* wmask(ji,jj,jk) * tmask(ji,jj,1)423 & * ( 1._wp - zice_fra(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 415 424 END DO 416 425 END DO … … 421 430 jk = nmln(ji,jj) 422 431 en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) ) & 423 & * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) )* wmask(ji,jj,jk) * tmask(ji,jj,1)432 & * ( 1._wp - zice_fra(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 424 433 END DO 425 434 END DO … … 434 443 zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add ) ! apply some modifications... 435 444 en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -pdepw(ji,jj,jk) / htau(ji,jj) ) & 436 & * MAX(0.,1._wp - rn_eice *fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1)445 & * ( 1._wp - zice_fra(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 437 446 END DO 438 447 END DO … … 499 508 zmxlm(:,:,:) = rmxl_min 500 509 zmxld(:,:,:) = rmxl_min 501 ! 502 IF( ln_mxl0 ) THEN ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rau0*g)510 ! 511 IF( ln_mxl0 ) THEN ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rau0*g) 503 512 ! 504 513 zraug = vkarmn * 2.e5_wp / ( rau0 * grav ) 505 514 #if ! defined key_si3 && ! defined key_cice 506 DO jj = 2, jpjm1 515 DO jj = 2, jpjm1 ! No sea-ice 507 516 DO ji = fs_2, fs_jpim1 508 517 zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1) … … 510 519 END DO 511 520 #else 521 512 522 SELECT CASE( nn_mxlice ) ! Type of scaling under sea-ice 513 523 ! … … 519 529 END DO 520 530 ! 521 CASE( 1 ) 531 CASE( 1 ) ! scaling with constant sea-ice thickness 522 532 DO jj = 2, jpjm1 523 533 DO ji = fs_2, fs_jpim1 524 zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * rn_mxlice ) * tmask(ji,jj,1) 534 zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 535 & fr_i(ji,jj) * rn_mxlice ) * tmask(ji,jj,1) 525 536 END DO 526 537 END DO 527 538 ! 528 CASE( 2 ) 539 CASE( 2 ) ! scaling with mean sea-ice thickness 529 540 DO jj = 2, jpjm1 530 541 DO ji = fs_2, fs_jpim1 531 542 #if defined key_si3 532 zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * hm_i(ji,jj) * 2. ) * tmask(ji,jj,1) 543 zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 544 & fr_i(ji,jj) * hm_i(ji,jj) * 2._wp ) * tmask(ji,jj,1) 533 545 #elif defined key_cice 534 546 zmaxice = MAXVAL( h_i(ji,jj,:) ) 535 zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * zmaxice ) * tmask(ji,jj,1) 547 zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 548 & fr_i(ji,jj) * zmaxice ) * tmask(ji,jj,1) 536 549 #endif 537 550 END DO 538 551 END DO 539 552 ! 540 CASE( 3 ) 553 CASE( 3 ) ! scaling with max sea-ice thickness 541 554 DO jj = 2, jpjm1 542 555 DO ji = fs_2, fs_jpim1 543 556 zmaxice = MAXVAL( h_i(ji,jj,:) ) 544 zmxlm(ji,jj,1) = ( ( 1. - fr_i(ji,jj) ) * zraug * taum(ji,jj) + fr_i(ji,jj) * zmaxice ) * tmask(ji,jj,1) 557 zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 558 & fr_i(ji,jj) * zmaxice ) * tmask(ji,jj,1) 545 559 END DO 546 560 END DO … … 704 718 & rn_mxl0 , nn_mxlice, rn_mxlice, & 705 719 & nn_pdl , ln_drg , ln_lc , rn_lc, & 706 & nn_etau , nn_htau , rn_efr , rn_eice720 & nn_etau , nn_htau , rn_efr , nn_eice 707 721 !!---------------------------------------------------------------------- 708 722 ! … … 737 751 IF( nn_mxlice == 1 ) & 738 752 WRITE(numout,*) ' ice thickness when scaling under sea-ice rn_mxlice = ', rn_mxlice 753 SELECT CASE( nn_mxlice ) ! Type of scaling under sea-ice 754 CASE( 0 ) ; WRITE(numout,*) ' ==>>> No scaling under sea-ice' 755 CASE( 1 ) ; WRITE(numout,*) ' ==>>> scaling with constant sea-ice thickness' 756 CASE( 2 ) ; WRITE(numout,*) ' ==>>> scaling with mean sea-ice thickness' 757 CASE( 3 ) ; WRITE(numout,*) ' ==>>> scaling with max sea-ice thickness' 758 CASE DEFAULT 759 CALL ctl_stop( 'zdf_tke_init: wrong value for nn_mxlice, should be 0,1,2,3 or 4') 760 END SELECT 739 761 ENDIF 740 762 WRITE(numout,*) ' top/bottom friction forcing flag ln_drg = ', ln_drg … … 744 766 WRITE(numout,*) ' type of tke penetration profile nn_htau = ', nn_htau 745 767 WRITE(numout,*) ' fraction of TKE that penetrates rn_efr = ', rn_efr 746 WRITE(numout,*) ' below sea-ice: =0 ON rn_eice = ', rn_eice 747 WRITE(numout,*) ' =4 OFF when ice fraction > 1/4 ' 768 WRITE(numout,*) ' langmuir & surface wave breaking under ice nn_eice = ', nn_eice 769 SELECT CASE( nn_eice ) 770 CASE( 0 ) ; WRITE(numout,*) ' ==>>> no impact of ice cover on langmuir & surface wave breaking' 771 CASE( 1 ) ; WRITE(numout,*) ' ==>>> weigthed by 1-TANH( fr_i(:,:) * 10 )' 772 CASE( 2 ) ; WRITE(numout,*) ' ==>>> weighted by 1-fr_i(:,:)' 773 CASE( 3 ) ; WRITE(numout,*) ' ==>>> weighted by 1-MIN( 1, 4 * fr_i(:,:) )' 774 CASE DEFAULT 775 CALL ctl_stop( 'zdf_tke_init: wrong value for nn_eice, should be 0,1,2, or 3') 776 END SELECT 748 777 IF( ln_drg ) THEN 749 778 WRITE(numout,*)
Note: See TracChangeset
for help on using the changeset viewer.
